diff options
123 files changed, 13147 insertions, 4190 deletions
@@ -8,9 +8,327 @@ or in the .../src/5/0/unsupported directory for sub-version releases.) ----------------- -Version 5.003_95 ----------------- +--------------- + Cast and Crew +--------------- + +To save space, and 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 <aas@aas.no> + Kenneth Albanowski <kjahds@kjahds.com> + Charles Bailey <bailey@hmivax.humgen.upenn.edu> + Graham Barr <gbarr@ti.com> + Spider Boardman <spider@orb.nashua.nh.us> + Tim Bunce <Tim.Bunce@ig.co.uk> + Tom Christiansen <tchrist@perl.com> + Hallvard B Furuseth <h.b.furuseth@usit.uio.no> + Gurusamy Sarathy <gsar@engin.umich.edu> + Jarkko Hietaniemi <jhi@iki.fi> + Nick Ing-Simmons <nik@tiuk.ti.com> + Andreas Koenig <a.koenig@mind.de> + Paul Marquess <pmarquess@bfsec.bt.co.uk> + Jeff Okamoto <okamoto@hpcc123.corp.hp.com> + Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de> + Tom Phoenix <rootbeer@teleport.com> + Norbert Pueschel <pueschel@imsdd.meb.uni-bonn.de> + Roderick Schertler <roderick@argon.org> + Ilya Zakharevich <ilya@math.ohio-state.edu> + +And the Keepers of the Patch Pumpkin: + + Andy Dougherty <doughera@lafcol.lafayette.edu> + Chip Salzenberg <chip@pobox.com> + + +------------------ + 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<wantarray> 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<scalar(reverse)> mean C<scalar(reverse $_)>" + From: Chip Salzenberg + Files: pp.c + + Title: "Fix lexical suicide from C<my $x = $x> 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 <spp@psa.pencom.com> + 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 <eserte@cs.tu-berlin.de> + 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<my $x; ++$x->{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 <dougm@opengroup.org> + 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<print $_> in debugger" + From: Ilya Zakharevich <ilya@math.ohio-state.edu> + 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: <pz4tdu7j57.fsf@eeyore.ibcinc.com> + Date: 29 Mar 1997 11:33:24 -0500 + Files: lib/Sys/Syslog.pm + + Title: "C<new SelectSaver $fh> 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 <hv@crypt.compulink.co.uk> 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" <rjray@uswest.com> + Msg-ID: <rjray-9702272117.AA001223633@snakepit.ecte.uswc.uswest.com> + Date: Thu, 27 Mar 1997 14:17:38 -0700 + Files: lib/AutoSplit.pm + + TESTS + + (no 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 <rmb1@cise.npl.co.uk> + 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: <Pine.SOL.3.95q.970326140905.10178A-100000@fractal.lafayette. + Date: Wed, 26 Mar 1997 14:27:52 -0500 (EST) + Files: INSTALL + + Title: "Patch for perl.pod" + From: wmiddlet@Adobe.COM (William Middleton) + Msg-ID: <199703262305.PAA13121@ducks> + 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 <rootbeer@teleport.com> + Msg-ID: <Pine.GSO.3.96.970331122546.14185C-100000@kelly.teleport.com> + Date: Mon, 31 Mar 1997 13:05:54 -0800 (PST) + Files: pod/perlsub.pod + + Title: "Improve documentation of C<return>" + 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 <gnat@frii.com>" + 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<or> 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" <caryr@mxim.com> + 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 @@ -44,14 +362,13 @@ Version 5.003_95 Files: hints/bsdos.sh Title: "Another MachTen Patch" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.96.970324152150.20610P-100000@kelly.teleport.com> Date: Mon, 24 Mar 1997 15:26:48 -0800 (PST) Files: hints/machten_2.sh Title: "Win32 update (five patches)" - From: Gurusamy Sarathy <gsar@engin.umich.edu> and - nick@ni-s.u-net.com (Nick Ing-Simmons) + 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 @@ -95,7 +412,7 @@ Version 5.003_95 Files: lib/UNIVERSAL.pm Title: "Term::Readline patch for AmigaOS" - From: "Norbert Pueschel" <pueschel@imsdd.meb.uni-bonn.de> + 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 @@ -117,7 +434,7 @@ Version 5.003_95 DOCUMENTATION Title: "INSTALL-1.8 to INSTALL-1.9 updates" - From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> + From: Andy Dougherty Msg-ID: <Pine.SOL.3.95q.970325135138.3374A-100000@fractal.lafayette.e Date: Tue, 25 Mar 1997 13:52:53 -0500 (EST) Files: INSTALL @@ -155,7 +472,7 @@ Version 5.003_95 Files: pod/perlref.pod Title: "Pod problems & fixes" - From: Hallvard B Furuseth <h.b.furuseth@usit.uio.no> + 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 @@ -164,7 +481,7 @@ Version 5.003_95 pod/perlpod.pod pod/pod2html.PL Title: "DB_File documentation fix" - From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + 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 @@ -174,9 +491,9 @@ Version 5.003_95 Files: pod/perlfaq*.pod ----------------- -Version 5.003_94 ----------------- +------------------ + Version 5.003_94 +------------------ CORE LANGUAGE CHANGES @@ -226,7 +543,7 @@ Version 5.003_94 CORE PORTABILITY Title: "Don't say 'static var = 1'" - From: Jarkko Hietaniemi <jhi@iki.fi> + From: Jarkko Hietaniemi Msg-ID: <199703091319.PAA24714@alpha.hut.fi> Date: Sun, 9 Mar 1997 15:19:57 +0200 (EET) Files: malloc.c @@ -238,33 +555,32 @@ Version 5.003_94 Files: hints/bsdos.sh Title: "More MachTen hints" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.95q.970316133852.27997A-100000@kelly.teleport.com Date: Sun, 16 Mar 1997 13:40:35 -0800 (PST) Files: hints/machten_2.sh Title: "HP/UX hint comments" - From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> + From: Andy Dougherty Msg-ID: <Pine.SOL.3.95q.970321153918.28770B-100000@fractal.lafayette. Date: Fri, 21 Mar 1997 15:43:07 -0500 (EST) Files: hints/hpux.sh Title: "VMS update" - From: bailey@hmivax.humgen.upenn.edu (Charles Bailey) + From: Charles Bailey Msg-ID: <1997Mar11.220056.1873182@hmivax.humgen.upenn.edu> 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 <bailey@HMIVAX.HUMGEN.UPENN.EDU> + 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 <gsar@engin.umich.edu> and - Nick Ing-Simmons <nik@tiuk.ti.com> + 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 @@ -310,7 +626,7 @@ Version 5.003_94 Files: ext/POSIX/POSIX.xs mg.c pp_ctl.c toke.c Title: "printf format corrections for -DDEBUGGING" - From: Roderick Schertler <roderick@argon.org> + 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 @@ -343,7 +659,7 @@ Version 5.003_94 Files: installman installperl Title: "3_93 doesn't install pods" - From: Spider Boardman <spider@orb.nashua.nh.us> + From: Spider Boardman Msg-ID: <199703160721.CAA08339@Orb.Nashua.NH.US> Date: Sun, 16 Mar 1997 02:21:35 -0500 Files: installperl @@ -353,7 +669,7 @@ Version 5.003_94 Files: installperl Title: "Make hint files' warnings more visible" - From: Hallvard B Furuseth <h.b.furuseth@usit.uio.no> + 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 @@ -365,7 +681,7 @@ Version 5.003_94 LIBRARY AND EXTENSIONS Title: "New module: autouse.pm" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + 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 @@ -375,13 +691,13 @@ Version 5.003_94 Files: lib/Math/Complex.pm t/lib/complex.t Title: "Refresh DB_File to 1.12" - From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + 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 <roderick@argon.org> + From: Roderick Schertler Msg-ID: <pzlo7ut03b.fsf@eeyore.ibcinc.com> Date: 11 Mar 1997 19:39:36 -0500 Files: lib/Symbol.pm @@ -406,7 +722,7 @@ Version 5.003_94 lib/Getopt/Long.pm Title: "Problems with SKIP in makemaker" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + 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 @@ -416,7 +732,7 @@ Version 5.003_94 Files: lib/Exporter.pm Title: "fix for Exporter's $SIG{__WARN__} handler" - From: Roderick Schertler <roderick@argon.org> + From: Roderick Schertler Msg-ID: <2282.858296451@eeyore.ibcinc.com> Date: Thu, 13 Mar 1997 18:40:51 -0500 Files: lib/Exporter.pm @@ -448,7 +764,7 @@ Version 5.003_94 UTILITIES Title: "Re: bug in pod2man (5.00326): section=3 for .pm modules" - From: Roderick Schertler <roderick@argon.org> + From: Roderick Schertler Msg-ID: <pzn2sat1hg.fsf@eeyore.ibcinc.com> Date: 11 Mar 1997 19:09:31 -0500 Files: pod/pod2man.PL @@ -456,7 +772,7 @@ Version 5.003_94 DOCUMENTATION Title: "perlfaq.pod" - From: Tom Christiansen <tchrist@jhereg.perl.com> + 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 @@ -471,7 +787,7 @@ Version 5.003_94 pod/perlsec.pod pod/perlvar.pod Title: "INSTALL: How to enable debugging" - From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> + From: Andy Dougherty Msg-ID: <Pine.SOL.3.95q.970321112326.1414A-100000@fractal.lafayette.e Date: Fri, 21 Mar 1997 11:25:32 -0500 (EST) Files: INSTALL @@ -493,37 +809,37 @@ Version 5.003_94 Files: pod/perlmod.pod Title: "Patch to document illegal characters" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.96.970314090558.15346J-100000@kelly.teleport.com> 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 <bailey@HMIVAX.HUMGEN.UPENN.EDU> + 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 <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.95q.970310143125.22489V-100000@kelly.teleport.com Date: Mon, 10 Mar 1997 14:33:20 -0800 (PST) Files: pod/perlsub.pod Title: "Illegal character in input" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.95q.970310151512.22489a-100000@kelly.teleport.com Date: Mon, 10 Mar 1997 15:21:21 -0800 (PST) Files: pod/perldiag.pod Title: "Patch for docs Re: Lost backslash" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.96.970319071438.24834G-100000@kelly.teleport.com> Date: Wed, 19 Mar 1997 07:28:57 -0800 (PST) Files: pod/perlop.pod Title: "XSUB's doc fix" - From: Roderick Schertler <roderick@argon.org> + 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 @@ -554,7 +870,7 @@ Version 5.003_94 Files: pod/*.pod Title: "clarify example in perlfunc" - From: Jarkko Hietaniemi <jhi@iki.fi> + From: Jarkko Hietaniemi Msg-ID: <199703201746.TAA25195@alpha.hut.fi> Date: Thu, 20 Mar 1997 19:46:01 +0200 (EET) Files: pod/perlfunc.pod @@ -564,9 +880,9 @@ Version 5.003_94 Files: ext/DB_File/DB_File.pm ----------------- -Version 5.003_93 ----------------- +------------------ + Version 5.003_93 +------------------ Me, last time: "This release will be the public beta of 5.004, @@ -577,7 +893,7 @@ Me, now: CORE LANGUAGE CHANGES Title: "Don't autovivify array and hash elements in sub parameters" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + 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 @@ -599,14 +915,14 @@ Me, now: CORE PORTABILITY Title: "VMS update" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + 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" <pueschel@imsdd.meb.uni-bonn.de> + From: Norbert Pueschel Msg-ID: <77724767@Armageddon.meb.uni-bonn.de> Date: Sat, 08 Mar 1997 12:50:15 +0100 Files: hints/amigaos.sh @@ -622,7 +938,7 @@ Me, now: Files: op.c perl.c proto.h Title: "perl -P path patch" - From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> + From: Andy Dougherty Msg-ID: <Pine.SOL.3.95q.970308120242.23766D-100000@fractal.lafayette. Date: Sat, 08 Mar 1997 12:45:08 -0500 (EST) Files: config_H config_h.SH perl.c plan9/config.plan9 t/comp/cpp.t @@ -637,13 +953,13 @@ Me, now: Files: Configure Title: "Allow './Configure -Uoptimize'" - From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> + From: Andy Dougherty Msg-ID: <Pine.SOL.3.95q.970306110532.11070A-100000@fractal.lafayette. Date: Thu, 06 Mar 1997 11:15:47 -0500 (EST) Files: Configure Title: "Use 'test -f', not 'test -x'" - From: Spider Boardman <spider@web.zk3.dec.com> + From: Spider Boardman Msg-ID: <199703080053.TAA13943@web.zk3.dec.com> Date: Fri, 7 Mar 1997 19:53:00 -0500 Files: Configure @@ -663,13 +979,13 @@ Me, now: Files: lib/Carp.pm Title: "@EXPORT_FAIL fix for Exporter.pm" - From: Roderick Schertler <roderick@argon.org> + 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 <roderick@argon.org> + 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 @@ -695,7 +1011,7 @@ Me, now: DOCUMENTATION Title: "Consolidated INSTALL updates since _92" - From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> + From: Andy Dougherty Msg-ID: <Pine.SOL.3.95q.970308131806.23766F-100000@fractal.lafayette. Date: Sat, 08 Mar 1997 13:21:22 -0500 (EST) @@ -709,13 +1025,13 @@ Me, now: Files: pod/perlform.pod Title: "OS/2 doc update" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199703080537.AAA25157@monk.mps.ohio-state.edu> Date: Sat, 8 Mar 1997 00:37:30 -0500 (EST) Files: README.os2 Title: "PODs corrections" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + 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 @@ -728,9 +1044,9 @@ Me, now: pod/perlop.pod pod/perlsub.pod ----------------- -Version 5.003_92 ----------------- +------------------ + Version 5.003_92 +------------------ This release will be the public beta of 5.004, or my name isn't Larson T. Pettifogger. @@ -754,19 +1070,19 @@ Larson T. Pettifogger. Files: hints/hpux.sh Title: "Re: The continuing MachTen saga" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.95q.970305091611.3572E-100000@kelly.teleport.com> Date: Wed, 5 Mar 1997 09:47:22 -0800 (PST) Files: hints/machten_2.sh Title: "OS/2 patches" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + 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 <bailey@HMIVAX.HUMGEN.UPENN.EDU> + 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 @@ -808,7 +1124,7 @@ Larson T. Pettifogger. Files: op.c Title: "Eliminate format-string type warnings" - From: Hallvard B Furuseth <h.b.furuseth@usit.uio.no> + 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 @@ -821,7 +1137,7 @@ Larson T. Pettifogger. BUILD PROCESS Title: "near-harmless bug in _91's Configure" - From: Roderick Schertler <roderick@argon.org> + From: Roderick Schertler Msg-ID: <pzg1yfuiza.fsf@eeyore.ibcinc.com> Date: 01 Mar 1997 21:26:49 -0500 Files: Configure @@ -833,7 +1149,7 @@ Larson T. Pettifogger. LIBRARY AND EXTENSIONS Title: "Newer ReadLine" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + 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 @@ -871,7 +1187,7 @@ Larson T. Pettifogger. Files: t/TEST Title: "Smarter t/op/taint.t" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.95q.970303103047.24000A-100000@kelly.teleport.com Date: Mon, 3 Mar 1997 10:31:54 -0800 (PST) Files: t/op/taint.t @@ -899,7 +1215,7 @@ Larson T. Pettifogger. DOCUMENTATION Title: "Add taint checks and srand to perldelta" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.95q.970302115355.23058D-100000@kelly.teleport.com Date: Sun, 2 Mar 1997 11:56:08 -0800 (PST) Files: pod/perldelta.pod @@ -909,26 +1225,25 @@ Larson T. Pettifogger. Files: pod/perldelta.pod Title: "Improve sample module header" - From: Tom Christiansen <tchrist@jhereg.perl.com>, - Graham Barr <gbarr@ti.com> + From: Tom Christiansen and Graham Barr Msg-ID: <199703011732.KAA14693@jhereg.perl.com> Date: Sat, 01 Mar 1997 10:32:31 -0700 Files: pod/perlmod.pod Title: "Clarify C<crypt> documentation" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.95q.970228131112.12357D-100000@kelly.teleport.com Date: Fri, 28 Feb 1997 13:18:25 -0800 (PST) Files: pod/perlfunc.pod Title: "Update list of CPAN sites" - From: Jarkko Hietaniemi <jhi@iki.fi> + From: Jarkko Hietaniemi Msg-ID: <199703021454.QAA07446@alpha.hut.fi> Date: Sun, 2 Mar 1997 16:54:22 +0200 (EET) Files: pod/perlmod.pod Title: "Enhance description of 'server error'" - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Msg-ID: <199702041903.VAA16070@alpha.hut.fi> Date: Tue, 4 Feb 1997 21:03:23 +0200 (EET) Files: pod/perldiag.pod @@ -938,16 +1253,16 @@ Larson T. Pettifogger. Files: pod/*.pod ----------------- -Version 5.003_91 ----------------- +------------------ + 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 <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199702250725.CAA09192@aatma.engin.umich.edu>, <199702251925.OAA15498@aatma.engin.umich.edu>, <199702252200.RAA16853@aatma.engin.umich.edu> @@ -964,7 +1279,7 @@ This is (should be? must be!) the public beta of 5.004. Files: pp_sys.c Title: "Don't taint magic hash keys unnecessarily" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Msg-ID: <01IFXL9TY74Y00661G@hmivax.humgen.upenn.edu> Date: Fri, 28 Feb 1997 02:11:26 -0500 (EST) Files: hv.c @@ -972,7 +1287,7 @@ This is (should be? must be!) the public beta of 5.004. CORE PORTABILITY Title: "VMS patches post _90" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + 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 @@ -1001,19 +1316,19 @@ This is (should be? must be!) the public beta of 5.004. Files: perl.c pp.c pp_sys.c toke.c util.c Title: "Clean up and document API for hashes" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + 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 <ilya@math.ohio-state.edu> + 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 <ilya@math.ohio-state.edu> + 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 @@ -1023,7 +1338,7 @@ This is (should be? must be!) the public beta of 5.004. Files: pp_hot.c Title: "Silence bogus typo warning on $DB::postponed" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199702271802.NAA12505@aatma.engin.umich.edu> Date: Thu, 27 Feb 1997 13:02:30 -0500 Files: op.c @@ -1031,7 +1346,7 @@ This is (should be? must be!) the public beta of 5.004. BUILD PROCESS Title: "Sanity check linking with $libs" - From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> + From: Andy Dougherty Msg-ID: <Pine.SOL.3.95q.970225221634.2486A-100000@fractal.lafayette.edu> Date: Tue, 25 Feb 1997 14:13:45 -0500 (EST) Files: Configure @@ -1045,7 +1360,7 @@ This is (should be? must be!) the public beta of 5.004. Files: Configure Title: "Update OS/2 Configure diff" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + 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 @@ -1057,7 +1372,7 @@ This is (should be? must be!) the public beta of 5.004. Files: lib/perl5db.pl Title: "Make IPC::Open3 work without fork()" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + 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 @@ -1069,7 +1384,7 @@ This is (should be? must be!) the public beta of 5.004. Files: lib/Getopt/Long.pm lib/diagnostics.pm Title: "Don't warn on use of CCFLAGS" - From: Andreas Koenig <k@anna.in-berlin.de> + 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 @@ -1083,13 +1398,13 @@ This is (should be? must be!) the public beta of 5.004. TESTS Title: "New test op/taint.t" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.95q.970225101328.18288M-100000@kelly.teleport.com Date: Tue, 25 Feb 1997 11:36:53 -0800 (PST) Files: MANIFEST t/op/taint.t Title: "Patch to t/op/rand.t" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.95q.970225181321.13796Q-100000@kelly.teleport.com Date: Tue, 25 Feb 1997 18:19:34 -0800 (PST) Files: t/op/rand.t @@ -1107,7 +1422,7 @@ This is (should be? must be!) the public beta of 5.004. DOCUMENTATION Title: "Warn about intrusive sfio behavior" - From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> + From: Andy Dougherty Msg-ID: <Pine.SOL.3.95q.970228112136.24038G-100000@fractal.lafayette. Date: Fri, 28 Feb 1997 11:35:49 -0500 (EST) Files: INSTALL @@ -1130,9 +1445,9 @@ This is (should be? must be!) the public beta of 5.004. pod/perltoc.pod ----------------- -Version 5.003_90 ----------------- +------------------ + Version 5.003_90 +------------------ At last, a mil[le]stone: The first beta of Perl 5.004. @@ -1145,20 +1460,20 @@ At last, a mil[le]stone: The first beta of Perl 5.004. CORE PORTABILITY Title: "Ultrix hints" - From: Spider Boardman <spider@Orb.Nashua.NH.US> + 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 <jhi@iki.fi> + 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" <pueschel@imsdd.meb.uni-bonn.de> + 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 @@ -1185,7 +1500,7 @@ At last, a mil[le]stone: The first beta of Perl 5.004. BUILD PROCESS Title: "Re: ccdlflags don't quite work" - From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> + From: Andy Dougherty Msg-ID: <Pine.SOL.3.95q.970224160630.5700E-100000@fractal.lafayette.e Date: Mon, 24 Feb 1997 16:07:07 -0500 (EST) Files: Configure @@ -1195,13 +1510,13 @@ At last, a mil[le]stone: The first beta of Perl 5.004. Files: Configure Title: "'installperl -v' doesn't do enough" - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman Msg-ID: <199702241342.IAA25945@Orb.Nashua.NH.US> Date: Mon, 24 Feb 1997 08:42:59 -0500 Files: installperl Title: "installperl breaks running system (for a while)" - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman Msg-ID: <199702241412.JAA11829@Orb.Nashua.NH.US> Date: Mon, 24 Feb 1997 09:12:11 -0500 Files: installperl @@ -1209,23 +1524,23 @@ At last, a mil[le]stone: The first beta of Perl 5.004. LIBRARY AND EXTENSIONS Title: "Don't clobber $1 et al in debugger's DB::sub()" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Files: lib/perl5db.pl Title: "Fix fd leak in IO::Pipe" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <pzn2sv722y.fsf@eeyore.ibcinc.com> Date: 23 Feb 1997 14:29:57 -0500 Files: ext/IO/lib/IO/Pipe.pm Title: "Pod::Text fixes" - From: Roderick Schertler <roderick@gate.net> + 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 <Tim.Bunce@ig.co.uk> + 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 @@ -1237,7 +1552,7 @@ At last, a mil[le]stone: The first beta of Perl 5.004. TESTS Title: "More thoroughly test rand() and srand()" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Files: t/op/rand.t Title: "Don't use <*> where readdir() will do" @@ -1253,19 +1568,19 @@ At last, a mil[le]stone: The first beta of Perl 5.004. UTILITIES Title: "Post-28 INSTALL updates" - From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> + From: Andy Dougherty Msg-ID: <Pine.SOL.3.95q.970224170713.5700H-100000@fractal.lafayette.e Date: Mon, 24 Feb 1997 17:09:09 -0500 (EST) Files: INSTALL Title: "Re: Hash key created by subroutine call? (fwd) " - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199702242229.RAA04395@aatma.engin.umich.edu> 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 <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199702240854.DAA27128@aatma.engin.umich.edu> and <199702242009.PAA02849@aatma.engin.umich.edu> Date: Mon, 24 Feb 1997 @@ -1273,7 +1588,7 @@ At last, a mil[le]stone: The first beta of Perl 5.004. utils/perlbug.PL Title: "pumpkin-1.9.pod" - From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> + From: Andy Dougherty Msg-ID: <Pine.SOL.3.95q.970224155702.5700D-100000@fractal.lafayette.e Date: Mon, 24 Feb 1997 16:06:02 -0500 (EST) Files: Porting/pumpkin.pod @@ -1281,19 +1596,19 @@ At last, a mil[le]stone: The first beta of Perl 5.004. DOCUMENTATION Title: "Fix typo in 'Tolkien quotation typo' fix" - From: Jarkko Hietaniemi <jhi@hut.fi> + From: Jarkko Hietaniemi Files: Changes Title: "Document one-argument limitation with #! line" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.95q.970223182745.15989A-100000@kelly.teleport.com Date: Sun, 23 Feb 1997 18:41:02 -0800 (PST) Files: pod/perldiag.pod pod/perlsec.pod ----------------- -Version 5.003_28 ----------------- +------------------ + Version 5.003_28 +------------------ This release is beta candidate #6. If this isn't good enough to go beta, I'll eat a floppy disk. (Okay, it's a chocolate floppy, but still....) @@ -1317,7 +1632,7 @@ I'll eat a floppy disk. (Okay, it's a chocolate floppy, but still....) Files: run.c Title: "When overloading, don't throw away nomethod's value" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Files: gv.c Title: "Optimize keys() and values() in void context" @@ -1327,7 +1642,7 @@ I'll eat a floppy disk. (Okay, it's a chocolate floppy, but still....) CORE PORTABILITY Title: "New hints for Digital UNIX" - From: Jarkko Hietaniemi <jhi@iki.fi> + From: Jarkko Hietaniemi Files: hints/dec_osf.sh Title: "No version of AIX has working setre[ug]id()" @@ -1335,7 +1650,7 @@ I'll eat a floppy disk. (Okay, it's a chocolate floppy, but still....) Files: hints/aix.sh Title: "VMS patches post _27" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + 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 @@ -1345,7 +1660,7 @@ I'll eat a floppy disk. (Okay, it's a chocolate floppy, but still....) vms/vms.c vms/vmsish.h Title: "Re: OS/2 patch for _27" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + 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 @@ -1372,7 +1687,7 @@ I'll eat a floppy disk. (Okay, it's a chocolate floppy, but still....) Files: op.c Title: "Minor update to malloc.c" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + 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 @@ -1388,13 +1703,13 @@ I'll eat a floppy disk. (Okay, it's a chocolate floppy, but still....) LIBRARY AND EXTENSIONS Title: "Debugger patch" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + 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 <ilya@math.ohio-state.edu> + 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 @@ -1437,7 +1752,7 @@ I'll eat a floppy disk. (Okay, it's a chocolate floppy, but still....) DOCUMENTATION Title: "INSTALL updates since _26" - From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> + From: Andy Dougherty Msg-ID: <Pine.SOL.3.95q.970218155815.2014F-100000@fractal.lafayette.e Date: Tue, 18 Feb 1997 16:00:08 -0500 (EST) Files: INSTALL @@ -1455,7 +1770,7 @@ I'll eat a floppy disk. (Okay, it's a chocolate floppy, but still....) Files: pod/perldelta.pod pod/perlop.pod Title: "Document C<$?> vs. $SIG{CHLD}" - From: Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de> + From: Ulrich Pfeifer Files: pod/perlvar.pod Title: "Add pumpkin.pod" @@ -1470,28 +1785,28 @@ I'll eat a floppy disk. (Okay, it's a chocolate floppy, but still....) pod/perltie.pod pod/perltoc.pod pod/perltrap.pod x2p/a2p.pod ----------------- -Version 5.003_27 ----------------- +------------------ + 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 <aas@bergen.sn.no> + 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 <aas@bergen.sn.no> + From: Gisle Aas Msg-ID: <hwwsbpeq2.fsf@bergen.sn.no> Date: 14 Feb 1997 15:52:21 +0000 Files: pod/perldelta.pod pod/perlobj.pod t/op/universal.t universal.c Title: "Allow C<setpgrp $$>" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <pzraigyshr.fsf@eeyore.ibcinc.com> Date: 16 Feb 1997 23:19:12 -0500 Files: pp_sys.c @@ -1511,7 +1826,7 @@ This release is beta candidate #5: Our last, best hope for a beta. CORE PORTABILITY Title: "Eliminate $^S; add C<use vmsish qw(status exit time)>" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + 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 @@ -1528,7 +1843,7 @@ This release is beta candidate #5: Our last, best hope for a beta. Files: hints/sco.sh unixish.h Title: "Digital UNIX hints" - From: Jarkko Hietaniemi <jhi@iki.fi> + 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 @@ -1551,13 +1866,13 @@ This release is beta candidate #5: Our last, best hope for a beta. Files: perl.c Title: "Re: Fragile signals" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + 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 <roderick@gate.net> + From: Roderick Schertler Msg-ID: <pz7mkc1h0g.fsf@eeyore.ibcinc.com> 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 @@ -1614,11 +1929,11 @@ This release is beta candidate #5: Our last, best hope for a beta. lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Mksymlists.pm Title: "Refresh CPAN.pm to 1.21" - From: Andreas Koenig <a.koenig@mind.de> + From: Andreas Koenig Files: lib/CPAN.pm lib/CPAN/FirstTime.pm lib/CPAN/Nox.pm Title: "Refresh Test::Harness to 1.15" - From: Andreas Koenig <a.koenig@mind.de> + From: Andreas Koenig Files: lib/Test/Harness.pm TESTS @@ -1630,7 +1945,7 @@ This release is beta candidate #5: Our last, best hope for a beta. UTILITIES Title: "pod2man: missing '-' in name section shouldn't be fatal" - From: Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de> + From: Ulrich Pfeifer Msg-ID: <yfmzpxcimsa.fsf@ls6.informatik.uni-dortmund.de> Date: 10 Feb 1997 18:38:45 +0100 Files: pod/pod2man.PL @@ -1638,7 +1953,7 @@ This release is beta candidate #5: Our last, best hope for a beta. DOCUMENTATION Title: "Update To-Do list" - From: Tim Bunce <Tim.Bunce@ig.co.uk> + From: Tim Bunce Msg-ID: <9702101900.AA25293@toad.ig.co.uk> Date: Mon, 10 Feb 1997 19:00:59 +0000 Files: Todo @@ -1648,9 +1963,9 @@ This release is beta candidate #5: Our last, best hope for a beta. Files: pod/perldiag.pod ----------------- -Version 5.003_26 ----------------- +------------------ + Version 5.003_26 +------------------ This release is beta candidate #4. "Once more, dear friends...." @@ -1671,7 +1986,7 @@ This release is beta candidate #4. "Once more, dear friends...." Files: mg.c perl.h pp_sys.c Title: "VMS patches post _25" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + 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 @@ -1700,13 +2015,13 @@ This release is beta candidate #4. "Once more, dear friends...." Files: cop.h pp_ctl.c Title: "Regexp optimizations" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + 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 <aas@bergen.sn.no> + From: Gisle Aas Msg-ID: <hbu9uz1si.fsf@bergen.sn.no> Date: 09 Feb 1997 11:55:41 +0100 Files: sv.c @@ -1726,19 +2041,19 @@ This release is beta candidate #4. "Once more, dear friends...." BUILD PROCESS Title: "Fix usage message in configure.gnu" - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Files: configure.gnu LIBRARY AND EXTENSIONS Title: "DB_File 1.11 patch" - From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + 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 <aas@bergen.sn.no> + From: Gisle Aas Msg-ID: <199702051342.OAA02753@bergen.sn.no> Date: Wed, 5 Feb 1997 14:42:49 +0100 Files: lib/File/Compare.pm @@ -1754,7 +2069,7 @@ This release is beta candidate #4. "Once more, dear friends...." TESTS Title: "Fix closure.t for AmigaOS (again)" - From: "Norbert Pueschel" <pueschel@imsdd.meb.uni-bonn.de> + 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 @@ -1762,13 +2077,13 @@ This release is beta candidate #4. "Once more, dear friends...." UTILITIES Title: "perldoc -f <perlfunc>" - From: Gisle Aas <aas@bergen.sn.no> + 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 <jhi@iki.fi> + From: Jarkko Hietaniemi Msg-ID: <199702042023.WAA13143@alpha.hut.fi> Date: Tue, 4 Feb 1997 22:23:34 +0200 (EET) Files: pod/pod2man.PL @@ -1786,9 +2101,9 @@ This release is beta candidate #4. "Once more, dear friends...." Files: pod/perltie.pod ----------------- -Version 5.003_25 ----------------- +------------------ + Version 5.003_25 +------------------ This release is beta candidate #3. Here's hoping... @@ -1811,7 +2126,7 @@ This release is beta candidate #3. Here's hoping... CORE PORTABILITY Title: "VMS patches for _24" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + 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 @@ -1821,13 +2136,13 @@ This release is beta candidate #3. Here's hoping... vms/ext/filespec.t vms/vms.c vms/vmsish.h Title: "hints/dec_osf.sh: polishing the comments" - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + 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" <pueschel@imsdd.meb.uni-bonn.de> + From: Norbert Pueschel Msg-ID: <77724724@Armageddon.meb.uni-bonn.de> Date: Wed, 29 Jan 1997 11:39:49 +0100 Files: hints/amigaos.sh @@ -1847,7 +2162,7 @@ This release is beta candidate #3. Here's hoping... Files: pp_sys.c Title: "Fix /\G/g with patterns that match empty string" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Files: pp_hot.c Title: "Fix scalar leak in av_unshift" @@ -1875,11 +2190,11 @@ This release is beta candidate #3. Here's hoping... LIBRARY AND EXTENSIONS Title: "Refresh CPAN to 1.19" - From: Andreas Koenig <a.koenig@mind.de> + From: Andreas Koenig Files: lib/Bundle/CPAN.pm lib/CPAN.pm lib/CPAN/FirstTime.pm Title: "Debugger update" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199702030406.XAA23029@monk.mps.ohio-state.edu> Date: Sun, 2 Feb 1997 23:06:34 -0500 (EST) Files: lib/perl5db.pl @@ -1893,7 +2208,7 @@ This release is beta candidate #3. Here's hoping... Files: ext/POSIX/POSIX.xs Title: "Make IO::Handle::gets() an alias of getline" - From: Gisle Aas <aas@bergen.sn.no> + From: Gisle Aas Msg-ID: <199701301103.MAA11291@bergen.sn.no> Date: Thu, 30 Jan 1997 12:03:15 +0100 Files: ext/IO/lib/IO/Handle.pm lib/IO/Handle.pm @@ -1901,7 +2216,7 @@ This release is beta candidate #3. Here's hoping... TESTS Title: "More Amiga test patches" - From: "Norbert Pueschel" <pueschel@imsdd.meb.uni-bonn.de> + From: Norbert Pueschel Msg-ID: <77724725@Armageddon.meb.uni-bonn.de> Date: Wed, 29 Jan 1997 16:07:33 +0100 Files: README.amiga t/lib/safe2.t t/op/closure.t @@ -1937,7 +2252,7 @@ This release is beta candidate #3. Here's hoping... Files: pod/perldelta.pod Title: "perlfunc.pod tweaks" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <20526.854659255@eeyore.ibcinc.com> Date: Thu, 30 Jan 1997 16:20:55 -0500 Files: pod/perlfunc.pod @@ -1953,9 +2268,9 @@ This release is beta candidate #3. Here's hoping... Files: pod/perldiag.pod ----------------- -Version 5.003_24 ----------------- +------------------ + Version 5.003_24 +------------------ This release is the second candidate for a public beta test. It's, well, bunches better than _23. @@ -1963,19 +2278,19 @@ It's, well, bunches better than _23. CORE LANGUAGE CHANGES Title: "glob defaults to $_" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199701270809.DAA00934@aatma.engin.umich.edu> Date: Mon, 27 Jan 1997 03:09:13 -0500 Files: op.c opcode.pl pod/perlfunc.pod t/op/glob.t Title: "Re: an overloading bug " - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199701270007.TAA26525@aatma.engin.umich.edu> Date: Sun, 26 Jan 1997 19:07:45 -0500 Files: pod/perldiag.pod pod/perlfunc.pod pp_ctl.c Title: "Don't warn on C<$\ = undef>" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: mg.c CORE PORTABILITY @@ -1985,7 +2300,7 @@ It's, well, bunches better than _23. Files: MANIFEST win32/* Title: "Amiga files" - From: Norbert Pueschel <pueschel@imsdd.meb.uni-bonn.de> + From: Norbert Pueschel Msg-ID: <77724712@Armageddon.meb.uni-bonn.de> Date: Sun, 26 Jan 1997 17:42:15 +0100 Files: MANIFEST README.amiga hints/amigaos.sh @@ -1999,27 +2314,27 @@ It's, well, bunches better than _23. OTHER CORE CHANGES Title: "Prevent premature death of @_ during leavesub" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_hot.c t/op/misc.t Title: "Deref old stash when re-blessing" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: sv.c Title: "Don't abort when RCHECK and DEBUGGING" - From: Tim Bunce <Tim.Bunce@ig.co.uk> + From: Tim Bunce Msg-ID: <9701272339.AA16537@toad.ig.co.uk> Date: Mon, 27 Jan 1997 23:39:48 +0000 Files: malloc.c Title: "Fix overloading macro conflict with Digital 'cc -fast'" - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Msg-ID: <199701272216.AAA04557@alpha.hut.fi> Date: Tue, 28 Jan 1997 00:16:49 +0200 (EET) Files: perl.h Title: "global.sym: typo?" - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Msg-ID: <199701261937.VAA07556@alpha.hut.fi> Date: Sun, 26 Jan 1997 21:37:59 +0200 (EET) Files: global.sym @@ -2027,39 +2342,39 @@ It's, well, bunches better than _23. BUILD PROCESS Title: "Put all extensions' modules in $archlib" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: installperl Title: "Configure fixes: set $archlib, omit _NO_PROTO" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Configure Title: "Make configure{,.gnu} ignore --cache-file option" - From: Norbert Pueschel <pueschel@imsdd.meb.uni-bonn.de> + From: Norbert Pueschel Files: configure configure.gnu LIBRARY AND EXTENSIONS Title: "Version checking in XS bootstrap is optional" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: XSUB.h Title: "Update $VERSION of DynaLoader and POSIX" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: ext/DynaLoader/DynaLoader.pm ext/POSIX/POSIX.pm Title: "Refresh Text::Wrap to 97.011701" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: lib/Text/Wrap.pm Title: "Fcntl.xs: F_[GS]ETOWN were in wrong case branch" - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Msg-ID: <199701251510.RAA05142@alpha.hut.fi> Date: Sat, 25 Jan 1997 17:10:20 +0200 (EET) Files: ext/Fcntl/Fcntl.pm ext/Fcntl/Fcntl.xs Title: "Fix $Is_VMS typo in Test::Harness" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: lib/Test/Harness.pm Title: "Allow for really big keys in Tie::SubstrHash" @@ -2069,19 +2384,19 @@ It's, well, bunches better than _23. Files: lib/Tie/SubstrHash.pm Title: "Avoid newRV_noinc() in IO, for compiling with old Perls" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: ext/IO/IO.xs TESTS Title: "New test op/closure.t" - From: Tom Phoenix <rootbeer@teleport.com>, Ulrich Pfeifer + From: Tom Phoenix, Ulrich Pfeifer Files: MANIFEST t/op/closure.t UTILITIES Title: "xsubpp handing of void funcs breaks extensions using XST_m*()" - From: Tim Bunce <Tim.Bunce@ig.co.uk> + From: Tim Bunce Msg-ID: <9701271659.AA15137@toad.ig.co.uk> Date: Mon, 27 Jan 1997 16:59:06 +0000 Files: lib/ExtUtils/xsubpp @@ -2089,17 +2404,17 @@ It's, well, bunches better than _23. DOCUMENTATION Title: "perldelta Fcntl enhancement" - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Msg-ID: <199701251505.RAA22159@alpha.hut.fi> Date: Sat, 25 Jan 1997 17:05:34 +0200 (EET) Files: pod/perldelta.pod Title: "Updates to perldelta re: Fcntl, DB_File, Net::Ping" - From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + From: Paul Marquess Files: pod/perldelta.pod Title: "Document restrictions on gv_fetchmethod() and perl_call_sv()" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pod/perldelta.pod pod/perlguts.pod Title: "perldiag.pod: No comma allowed after %s" @@ -2109,7 +2424,7 @@ It's, well, bunches better than _23. Files: pod/perldiag.pod Title: "perlfunc.pod: localtime" - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Msg-ID: <199701251629.SAA08114@alpha.hut.fi> Date: Sat, 25 Jan 1997 18:29:37 +0200 (EET) Files: pod/perlfunc.pod @@ -2121,38 +2436,38 @@ It's, well, bunches better than _23. Files: pod/perlfunc.pod Title: "Updates to guts" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199701270034.TAA13177@monk.mps.ohio-state.edu> Date: Sun, 26 Jan 1997 19:34:18 -0500 (EST) Files: pod/perlguts.pod Title: "perltoot fixes" - From: Tom Christiansen <tchrist@mox.perl.com> + From: Tom Christiansen Msg-ID: <6807.854214205@jinete> Date: Sat, 25 Jan 1997 09:43:25 -0800 Files: pod/perltoot.pod Title: "5.003_23: small typo in perlsyn.pod" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199701270824.DAA01169@aatma.engin.umich.edu> Date: Mon, 27 Jan 1997 03:24:25 -0500 Files: pod/perlsyn.pod ----------------- -Version 5.003_23 ----------------- +------------------ + Version 5.003_23 +------------------ This release is our first candidate for a public beta test. CORE LANGUAGE CHANGES Title: "Disallow changing $_[0] in __DIE__ handlers" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pod/perlfunc.pod util.c Title: "Fix overloading with inheritance and AUTOLOAD" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199701202226.RAA05072@monk.mps.ohio-state.edu> Date: Mon, 20 Jan 1997 17:26:32 -0500 (EST) Files: gv.c lib/diagnostics.pm lib/overload.pm pod/perldebug.pod @@ -2166,21 +2481,21 @@ This release is our first candidate for a public beta test. Files: toke.c Title: "Revert $^X to old behavior (plus HP-UX bug fix)" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: hints/hpux.sh toke.c Title: "Protect against '0' in 'stmt while <HANDLE>'" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c Title: "Don't warn when closure uses var at file scope" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c CORE PORTABILITY Title: "VMS patches for _22" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Msg-ID: <01IEGBJ2TMYS003PCL@hmivax.humgen.upenn.edu> Date: Mon, 20 Jan 1997 22:50:21 -0500 (EST) Files: ext/POSIX/POSIX.xs lib/ExtUtils/MM_VMS.pm lib/ExtUtils/xsubpp @@ -2189,7 +2504,7 @@ This release is our first candidate for a public beta test. vms/Makefile vms/config.vms vms/descrip.mms vms/perly_c.vms Title: "Re: Perl 5.003_21: OS/2 patches" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199701170446.XAA28939@monk.mps.ohio-state.edu> Date: Thu, 16 Jan 1997 23:46:40 -0500 (EST) Files: os2/Changes os2/os2.c @@ -2199,7 +2514,7 @@ This release is our first candidate for a public beta test. Files: plan9/config.plan9 plan9/mkfile Title: "Bugfixes for AmigaOS" - From: "Norbert Pueschel" <pueschel@imsdd.meb.uni-bonn.de> + From: Norbert Pueschel Msg-ID: <77724691@Armageddon.meb.uni-bonn.de> Date: Wed, 22 Jan 1997 00:13:54 +0100 Files: hints/amigaos.sh lib/File/Basename.pm @@ -2211,7 +2526,7 @@ This release is our first candidate for a public beta test. Files: hints/dec_osf.sh Title: "on NeXT: gdbm problem fixed" - From: Andreas Koenig <k@anna.in-berlin.de> + From: Andreas Koenig Msg-ID: <199701210201.DAA17794@anna.in-berlin.de> Date: Tue, 21 Jan 1997 03:01:32 +0100 Files: hints/next_3.sh hints/next_3_0.sh @@ -2237,49 +2552,49 @@ This release is our first candidate for a public beta test. OTHER CORE CHANGES Title: "Make PERL5LIB and -I work like C<use lib>" - From: Tim Bunce <Tim.Bunce@ig.co.uk> + From: Tim Bunce Msg-ID: <9701231523.AA26613@toad.ig.co.uk> Date: Thu, 23 Jan 1997 15:23:27 +0000 Files: lib/lib.pm perl.c Title: "Fix /\G.a/" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: regcomp.c regcomp.h regexec.c regexp.h toke.c Title: "Extend stack in pp_undef (!)" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp.c Title: "Allow for sub to be redefined while executing" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: cop.h pp_hot.c t/op/misc.t Title: "Eliminate redundant flag CVf_FORMAT" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: cv.h op.c perl.c perly.c perly.y proto.h sv.c toke.c Title: "Generate IVs when possible in abs() and int()" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp.c Title: "Efficiency patchlet for pp_aassign()" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199701210305.WAA05451@monk.mps.ohio-state.edu> Date: Mon, 20 Jan 1997 22:05:39 -0500 (EST) Files: pp_hot.c Title: "When sorting, promote to PVNV only for built-in comparison" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_ctl.c Title: "Remove "suidperl security patch" message" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: perl.c BUILD PROCESS Title: "Make configure.gnu a copy of configure; make configure writea - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: MANIFEST configure.gnu Title: "Regen Configure with metaconfig: +ARCHNAME, -FILE_filbuf" @@ -2289,23 +2604,23 @@ This release is our first candidate for a public beta test. utils/perlbug.PL vms/config.vms vms/fndvers.com Title: "Compile with optimization when testing memory functions" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Configure Title: "Minor patch for Debian installation" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: installperl LIBRARY AND EXTENSIONS Title: "Debugger update" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199701190455.XAA02579@monk.mps.ohio-state.edu> Date: Sat, 18 Jan 1997 23:54:59 -0500 (EST) Files: lib/perl5db.pl Title: "DynaLoader enhancement: support RTLD_GLOBAL" - From: Nick Ing-Simmons <nik@tiuk.ti.com> + From: Nick Ing-Simmons Msg-ID: <199701240937.JAA11443@pluto.tiuk.ti.com> Date: Fri, 24 Jan 1997 09:37:18 GMT Files: ext/DynaLoader/DynaLoader.pm ext/DynaLoader/dl_aix.xs @@ -2320,21 +2635,21 @@ This release is our first candidate for a public beta test. Files: ext/Fcntl/Fcntl.pm ext/Fcntl/Fcntl.xs Title: "Refresh IO to 1.15 (plus DESTROY and new_tmpfile fixes)" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: 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/Socket.pm t/lib/io_pipe.t Title: "Allow IO.xs to remain at 1.15 while $VERSION is 1.1501" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: XSUB.h ext/IO/Makefile.PL ext/IO/lib/IO/Handle.pm Title: "Refresh CPAN to 1.15" - From: Andreas Koenig <a.koenig@mind.de> + From: Andreas Koenig Files: lib/CPAN.pm lib/CPAN/FirstTime.pm Title: "Add E* and SA_* constants" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <23338.853986967@eeyore.ibcinc.com> Date: Wed, 22 Jan 1997 21:36:07 -0500 Files: ext/POSIX/POSIX.pm ext/POSIX/POSIX.pod ext/POSIX/POSIX.xs @@ -2348,18 +2663,18 @@ This release is our first candidate for a public beta test. Files: t/base/lex.t Title: "Fix tests of $^X and $0 to work with QNX" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: t/lib/io_pipe.t t/lib/open2.t t/lib/open3.t t/op/magic.t Title: "Patch tests for systems without fork()" - From: "Norbert Pueschel" <pueschel@imsdd.meb.uni-bonn.de> + From: Norbert Pueschel Msg-ID: <77724697@Armageddon.meb.uni-bonn.de> Date: Thu, 23 Jan 1997 23:51:28 +0100 Files: t/io/pipe.t t/lib/filehand.t t/lib/io_pipe.t t/lib/io_sock.t t/lib/open2.t t/lib/open3.t t/op/fork.t Title: "Test patches for OS/2" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199701170448.XAA28948@monk.mps.ohio-state.edu> Date: Thu, 16 Jan 1997 23:48:18 -0500 (EST) Files: os2/OS2/ExtAttr/t/os2_ea.t os2/OS2/PrfDB/t/os2_prfdb.t @@ -2375,11 +2690,11 @@ This release is our first candidate for a public beta test. UTILITIES Title: "Translate \200 to È in pod2html" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pod/pod2html.PL Title: "VMS patches: '.com' extension on scripts" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Msg-ID: <01IELNPDLYJM003E7J@hmivax.humgen.upenn.edu> Date: Fri, 24 Jan 1997 18:42:29 -0500 (EST) Files: pod/checkpods.PL pod/pod2html.PL pod/pod2latex.PL @@ -2397,56 +2712,56 @@ This release is our first candidate for a public beta test. DOCUMENTATION Title: "First cut at INSTALL edit" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: INSTALL Title: "Additional docs for __DIE__ and __WARN__" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Files: pod/perlfunc.pod pod/perlrun.pod pod/perlvar.pod Title: "Document #line directive" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199701240908.EAA23846@aatma.engin.umich.edu> Date: Fri, 24 Jan 1997 04:08:44 -0500 Files: pod/perlsyn.pod pod/perltoc.pod Title: "Perlguts version 30" - From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com> + From: Jeff Okamoto Msg-ID: <199701172117.AA116515863@hpcc123.corp.hp.com> Date: Fri, 17 Jan 1997 13:17:43 -0800 Files: pod/perlguts.pod Title: "delta for perldelta" - From: Tom Christiansen <tchrist@mox.perl.com> + From: Tom Christiansen Msg-ID: <804.854121463@jinete> Date: Fri, 24 Jan 1997 07:57:43 -0800 Files: pod/perlnews.pod pod/perltoc.pod Title: "Updates to perldelta" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199701211610.LAA06227@monk.mps.ohio-state.edu> Date: Mon, 20 Jan 1997 06:48:49 -0500 (EST) Files: pod/perlnews.pod pod/perltoc.pod Title: "perlnews.pod diff for the Fcntl" - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Msg-ID: <199701211600.SAA30117@alpha.hut.fi> Date: Tue, 21 Jan 1997 18:00:56 +0200 (EET) Files: pod/perlnews.pod Title: "Rename perlnews -> perldelta per Tom's request" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: MANIFEST pod/Makefile pod/buildtoc pod/perl.pod pod/perldelta.pod pod/perltoc.pod pod/roffitall Title: "Remove bad advice from perllocale.pod" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pod/perllocale.pod ----------------- -Version 5.003_22 ----------------- +------------------ + Version 5.003_22 +------------------ This release is primarily made up of bug fixes, the foremost among which repairs a showstopper memory corruption bug in formats. @@ -2454,43 +2769,43 @@ which repairs a showstopper memory corruption bug in formats. CORE LANGUAGE CHANGES Title: "Fix parsing of C< ${ xyz } >" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: toke.c Title: "Don't parse method calls in strings" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: toke.c Title: "Fix overly picky carping about leading '{' in regex" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: regcomp.c OTHER CORE CHANGES Title: "Fix memory corruption from formats" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c perl.c perly.c perly.c.diff perly.y proto.h sv.c toke.c BUILD PROCESS Title: "Fix '_mopop' typo" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Makefile.SH LIBRARY AND EXTENSIONS Title: "Gut IO::Handle::DESTROY" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: ext/IO/lib/IO/Handle.pm Title: "RiscOS is case-insensitive" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: lib/File/Basename.pm TESTS Title: "Fix thinko in db-recno.t" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: t/lib/db-recno.t UTILITIES @@ -2508,7 +2823,7 @@ which repairs a showstopper memory corruption bug in formats. Files: INSTALL pod/roffitall Title: "srand() doc update" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <24195.853379065@eeyore.ibcinc.com> Date: Wed, 15 Jan 1997 20:44:25 -0500 Files: pod/perlfunc.pod @@ -2520,9 +2835,9 @@ which repairs a showstopper memory corruption bug in formats. Files: configpm ----------------- -Version 5.003_21 ----------------- +------------------ + Version 5.003_21 +------------------ This release includes several important bug fixes, and a couple of minor but valuable language tweaks. Please read on for a list of the @@ -2531,27 +2846,27 @@ significant changes: CORE LANGUAGE CHANGES Title: "Fix overloading via inherited autoloaded functions" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199701131022.FAA22830@monk.mps.ohio-state.edu> Date: Mon, 13 Jan 1997 05:22:47 -0500 (EST) Files: gv.c lib/overload.pm pod/perldiag.pod t/pragma/overload.t Title: "Method call fixes: Don't cache in alias, don't skip undef" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: global.sym gv.c gv.h hv.c op.c pod/perlguts.pod pod/perltoc.pod pp.c pp_ctl.c pp_hot.c proto.h scope.c sv.c t/op/method.t Title: "Formats can be closures" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: cv.h op.c perly.c perly.c.diff perly.y pp_sys.c sv.h Title: "Quote 'foo' in C<$x{-foo}>" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: toke.c Title: "Forbid C< x->{y} > and C< x->[0] > under C<strict refs>" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c pod/perldiag.pod t/pragma/strict-refs Title: "Allow <=> to return undef when operands are not ordered" @@ -2559,19 +2874,19 @@ significant changes: Files: MANIFEST pp.c t/op/cmp.t Title: "Fail regex that starts with '{'" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: regcomp.c CORE PORTABILITY Title: "Re: Perl 5.003_20: OS/2 patches" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199701101102.GAA19051@monk.mps.ohio-state.edu> Date: Fri, 10 Jan 1997 06:02:16 -0500 (EST) Files: hints/os2.sh os2/Changes os2/os2.c os2/os2ish.h pp_sys.c Title: "VMS patches for _20" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Msg-ID: <01IE7MGK7ULQ003K5M@hmivax.humgen.upenn.edu> Date: Tue, 14 Jan 1997 17:34:43 -0500 (EST) Files: configpm dosish.h os2/os2ish.h plan9/plan9ish.h proto.h @@ -2593,21 +2908,21 @@ significant changes: Files: Configure hints/machten.sh Title: "Rename aux.sh to aux_3.sh for MS-LOSS" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: MANIFEST hints/aux_3.sh OTHER CORE CHANGES Title: "Fix C< eval { my $x; eval '$x' } >" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c t/op/misc.t Title: "Don't warn if eval '' uses outer func's lexicals" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c Title: "Avoid memory wastage in wait(); make pidstatus global" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: global.sym interp.sym perl.c perl.h pp_sys.c Title: "Forbid ++ and -- on readonly values" @@ -2617,39 +2932,39 @@ significant changes: Files: pp.c pp_hot.c Title: "Keep array from dying during foreach(@array)" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: cop.h pp_ctl.c Title: "Fix C< $a="simple"; split /($a)/o >" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp.c t/op/misc.t Title: "Fix infinite loop for undef function in @SIG{__WARN__,__DIE__}" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: util.c Title: "Fix for anon-lists with tied entries coredump" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199701100745.CAA13057@aatma.engin.umich.edu> Date: Fri, 10 Jan 1997 02:45:11 -0500 Files: pp.c Title: "Don't set SVf_PADBUSY on immortal SVs" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c Title: "Patch for Object subroutines" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199701080156.UAA15366@monk.mps.ohio-state.edu> Date: Tue, 7 Jan 1997 20:56:02 -0500 (EST) Files: cop.h Title: "Use an SVt_PVLV to hold stacked OP pointers when debugging" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp.c pp_hot.c Title: "Undo change that freed large pad vars" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: scope.c BUILD PROCESS @@ -2667,7 +2982,7 @@ significant changes: Files: Configure Title: "Make installperl quieter; only shared libraries need 0555" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: installperl TESTS @@ -2679,15 +2994,15 @@ significant changes: Files: t/TEST Title: "UNIVERSAL tests" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Files: MANIFEST t/op/universal.t Title: "Test deletion of array during foreach" - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Files: t/op/misc.t Title: "patch for db-recno.t" - From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + From: Paul Marquess Msg-ID: <9701121509.AA11147@claudius.bfsec.bt.co.uk> Date: Sun, 12 Jan 1997 15:09:33 +0000 (GMT) Files: t/lib/db-recno.t @@ -2695,7 +3010,7 @@ significant changes: LIBRARY AND EXTENSIONS Title: "Localize info about filesystems being case-forgiving" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: lib/File/Basename.pm pod/checkpods.PL pod/pod2html.PL pod/pod2latex.PL pod/pod2man.PL pod/pod2text.PL utils/c2ph.PL utils/h2ph.PL utils/h2xs.PL utils/perlbug.PL @@ -2711,39 +3026,39 @@ significant changes: Files: lib/Getopt/Long.pm Title: "Refresh DB_File to 1.10" - From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + From: Paul Marquess Msg-ID: <9701141247.AA21242@claudius.bfsec.bt.co.uk> Date: Tue, 14 Jan 97 12:47:40 GMT Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs Title: "Re: FileCache::cacheout clobbers $_" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <pz3ewb3189.fsf@eeyore.ibcinc.com> Date: 08 Jan 1997 23:45:58 -0500 Files: lib/FileCache.pm lib/cacheout.pl Title: "PATCH: AutoSplit" - From: Graham Barr <bodg@tiuk.ti.com> + From: Graham Barr Msg-ID: <9603111010.AA29935@tiuk.ti.com> Date: 11 Mar 1996 06:01:58 -0500 Files: lib/AutoSplit.pm Title: "Re: Uninitialized value in Carp.pm ? " - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199701141815.NAA07960@aatma.engin.umich.edu> Date: Tue, 14 Jan 1997 13:15:25 -0500 Files: lib/Carp.pm Title: "Avoid "uninitialized" warnings from POSIX::constant()" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: ext/POSIX/POSIX.pm Title: "Eliminate warning from C<use overload>" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: lib/overload.pm Title: "low priority patches" - From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + From: Paul Marquess Msg-ID: <9701081655.AA27349@claudius.bfsec.bt.co.uk> Date: Wed, 8 Jan 97 16:55:02 GMT Files: lib/Cwd.pm t/comp/redef.t t/lib/db-btree.t @@ -2751,13 +3066,13 @@ significant changes: UTILITIES Title: "Re: xsubpp and Tk ==> segfault" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199701080825.DAA15813@monk.mps.ohio-state.edu> Date: Wed, 8 Jan 1997 03:25:47 -0500 (EST) Files: lib/ExtUtils/xsubpp Title: "Re: MakeMaker and 'make uninstall'" - From: Andreas Koenig <k@anna.in-berlin.de> + From: Andreas Koenig Msg-ID: <199701101243.NAA26400@anna.in-berlin.de> Date: Fri, 10 Jan 1997 13:43:39 +0100 Files: lib/ExtUtils/MM_Unix.pm @@ -2769,13 +3084,13 @@ significant changes: Files: utils/perldoc.PL Title: "Yet another perldoc option" - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Msg-ID: <199610022200.AAA15334@furubotn.sn.no> Date: Thu, 3 Oct 1996 00:00:35 +0200 Files: utils/perldoc.PL Title: "Re: perldoc, temp files, async pagers" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <pzwwtoom8p.fsf@eeyore.ibcinc.com> Date: 07 Jan 1997 22:54:14 -0500 Files: utils/perldoc.PL @@ -2795,32 +3110,32 @@ significant changes: Files: pod/perlsyn.pod Title: "Document use of pos() and /\G/" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199701132013.PAA26606@aatma.engin.umich.edu> Date: Mon, 13 Jan 1997 15:13:12 -0500 Files: pod/perlfunc.pod pod/perlnews.pod pod/perlop.pod pod/perlre.pod pod/perltoc.pod pod/perltrap.pod Title: "Fix example #4 in perlXStut" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199701050739.CAA11112@monk.mps.ohio-state.edu> Date: Sun, 5 Jan 1997 02:39:45 -0500 (EST) Files: pod/perlxstut.pod Title: "Document new closure warnings" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c pod/perldiag.pod Title: "Misc. doc patches missing in _20" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <102.852695733@eeyore.ibcinc.com> Date: Tue, 07 Jan 1997 22:55:33 -0500 Files: pod/perlsub.pod pod/perltoc.pod pod/perlvar.pod ----------------- -Version 5.003_20 ----------------- +------------------ + Version 5.003_20 +------------------ The only language change in this release is the recension of support for named closures: Now, no subroutine declared "sub foo {}" can be @@ -2834,11 +3149,11 @@ updates, and expanded tests. This is good stuff. "I love you, man!" CORE LANGUAGE CHANGES Title: "Rescind named closures" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Makefile.SH op.c perly.c perly.c.diff perly.y pp_hot.c Title: "Fix: empty @_ when calling empty-proto subs without parens" - From: Graham Barr <bodg@tiuk.ti.com> + From: Graham Barr Msg-ID: <32CE30F0.7E8425A5@tiuk.ti.com> Date: Sat, 04 Jan 1997 10:29:04 +0000 Files: perly.c perly.y @@ -2846,23 +3161,23 @@ updates, and expanded tests. This is good stuff. "I love you, man!" CORE PORTABILITY Title: "Fix $^X on systems that set it to Perl's basename" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: hints/hpux.sh toke.c Title: "Configure/perl5/Compartmented Mode Workstation (fwd)" - From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> + From: Andy Dougherty Msg-ID: <Pine.SOL.3.95.970106131505.1662C-100000@fractal.lafayette.ed Date: Mon, 06 Jan 1997 13:15:38 -0500 (EST) Files: Configure hints/dec_osf.sh Title: "Remove obsolete file "dl_os2.xs"." - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Files: MANIFEST OTHER CORE CHANGES Title: "Fix C< sub foo (&@); sub bar (&); foo {}, bar {}, bar {} >" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: perly.c perly.c.diff perly.y Title: "plug for safe/opcode leaks" @@ -2872,11 +3187,11 @@ updates, and expanded tests. This is good stuff. "I love you, man!" Files: op.c Title: "Finish OP= warnings: none on ^=" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: doop.c pp.c t/op/assignwarn.t Title: "Fix Dynaloader failures with DProf" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199701061718.MAA26909@aatma.engin.umich.edu> Date: Mon, 06 Jan 1997 12:18:46 -0500 Files: pp_hot.c @@ -2884,11 +3199,11 @@ updates, and expanded tests. This is good stuff. "I love you, man!" BUILD PROCESS Title: "Make Configure default to the first domain in /etc/resolv.conf" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Configure Title: "Start all helper scripts with $startsh" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Configure Title: "Support libperl.so under FreeBSD" @@ -2900,13 +3215,13 @@ updates, and expanded tests. This is good stuff. "I love you, man!" TESTS Title: "New test: comp/proto.t" - From: Graham Barr <bodg@tiuk.ti.com> + From: Graham Barr Msg-ID: <32D0C21F.3FB28D51@tiuk.ti.com> Date: Mon, 06 Jan 1997 09:13:03 +0000 Files: MANIFEST t/comp/proto.t Title: "More magic variable tests" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <7043.852565192@eeyore.ibcinc.com> Date: Mon, 06 Jan 1997 10:39:52 -0500 Files: t/harness t/op/magic.t @@ -2920,13 +3235,13 @@ updates, and expanded tests. This is good stuff. "I love you, man!" Files: lib/File/Basename.pm t/lib/basename.t Title: "sigaction() problems" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <12808.852583324@eeyore.ibcinc.com> Date: Mon, 06 Jan 1997 15:42:04 -0500 Files: ext/POSIX/POSIX.pm ext/POSIX/POSIX.pod Title: "Fix importation of FileHandle methods; fix POSIX docs" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: ext/POSIX/POSIX.pm ext/POSIX/POSIX.pod lib/FileHandle.pm Title: "Patch: make hints files warn about db-recno failures" @@ -2946,31 +3261,31 @@ updates, and expanded tests. This is good stuff. "I love you, man!" DOCUMENTATION Title: "tiny doc patches" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <23338.852394333@eeyore.ibcinc.com> Date: Sat, 04 Jan 1997 11:12:13 -0500 Files: pod/perlapio.pod pod/perlnews.pod pod/perltoc.pod Title: "doc patch for defined on perlfunc.pod" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <pz91686ek1.fsf@eeyore.ibcinc.com> Date: 04 Jan 1997 21:28:30 -0500 Files: pod/perlfunc.pod Title: "doc patch: perldsc" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <pzafqo6eo9.fsf@eeyore.ibcinc.com> Date: 04 Jan 1997 21:25:58 -0500 Files: pod/perldsc.pod pod/perltoc.pod Title: "Re: constant function inlining" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <pzk9pp1b95.fsf@eeyore.ibcinc.com> Date: 07 Jan 1997 15:27:50 -0500 Files: pod/perldiag.pod pod/perlsub.pod Title: "scalar caller doc fix" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <18245.852608060@eeyore.ibcinc.com> Date: Mon, 06 Jan 1997 22:34:20 -0500 Files: pod/perlfunc.pod @@ -2982,13 +3297,13 @@ updates, and expanded tests. This is good stuff. "I love you, man!" Files: pod/perlpod.pod Title: "Misc perlfunc updates" - From: Tom Christiansen <tchrist@mox.perl.com> + From: Tom Christiansen Files: pod/perlfunc.pod pod/perltoc.pod ----------------- -Version 5.003_19 ----------------- +------------------ + Version 5.003_19 +------------------ Lots of internal cleanup in this patch, especially plugged memory leaks when embedded Perl interpreters shut down and restart. The @@ -3002,22 +3317,22 @@ Here's a list of the more significant changes... CORE LANGUAGE CHANGES Title: "Make method cache invisible to user code" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: dump.c gv.c gv.h hv.c op.c perl.c pp_hot.c pp_sys.c sv.c toke.c Title: "Never parse "{m,s,y,tr,q{,q,w,x}}:{,:}" as package or label" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: toke.c CORE PORTABILITY Title: "Fix $^X under HP-UX" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: hints/hpux.sh toke.c Title: "New hints/hpux.sh" - From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com> + From: Jeff Okamoto Msg-ID: <199612312309.AA283393772@hpcc123.corp.hp.com> Date: Tue, 31 Dec 1996 15:09:32 -0800 Files: hints/hpux.sh @@ -3025,25 +3340,25 @@ Here's a list of the more significant changes... OTHER CORE CHANGES Title: "Fix segv when calling named closures" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_hot.c Title: "Finish rationalizing "undef value" warnings" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: doop.c pp.c sv.c t/op/assignwarn.t Title: "Arrange for all "_<file" entries to be in %main::" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: gv.c lib/perl5db.pl Title: "Introduce CVf_NODEBUG flag" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199701012042.PAA25994@aatma.engin.umich.edu> Date: Wed, 01 Jan 1997 15:42:05 -0500 Files: cv.h pp_hot.c Title: "Reword 'may be "0"' warning per Larry; fix its line number" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c pod/perldiag.pod Title: "5.003_18: perl_{con,des}truct fixes" @@ -3053,17 +3368,17 @@ Here's a list of the more significant changes... Files: perl.c perl.h pod/perlembed.pod pod/perltoc.pod t/op/sysio.t Title: "Fix lost value from READLINE after TIEHANDLE" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Files: pp_hot.c sv.h Title: "Free memory of large lexical variables when leaving scope" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: scope.c TESTS Title: "Create t/pragma directory; populate with new and old" - From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + From: Paul Marquess Files: MANIFEST Makefile.SH t/TEST t/comp/use.t t/lib/locale.t t/op/overload.t t/op/use.t t/pragma/locale.t t/pragma/overload.t t/pragma/strict-refs t/pragma/strict-subs t/pragma/strict-vars @@ -3077,7 +3392,7 @@ Here's a list of the more significant changes... LIBRARY AND EXTENSIONS Title: "Make libs clean under '-w'" - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Files: lib/AutoSplit.pm lib/Devel/SelfStubber.pm lib/Env.pm lib/Math/Complex.pm lib/Pod/Functions.pm lib/Search/Dict.pm lib/SelfLoader.pm lib/Term/Complete.pm lib/chat2.pl @@ -3087,13 +3402,13 @@ Here's a list of the more significant changes... DOCUMENTATION Title: "Perlguts, version 28" - From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com> + From: Jeff Okamoto Msg-ID: <199701032110.AA102535846@hpcc123.corp.hp.com> Date: Fri, 3 Jan 1997 13:10:46 -0800 Files: pod/perlguts.pod Title: "Re: perldelta, take 3" - From: Tim Bunce <Tim.Bunce@ig.co.uk> + From: Tim Bunce Msg-ID: <9701031748.AA15335@toad.ig.co.uk> Date: Fri, 3 Jan 1997 17:48:46 +0000 Files: pod/perlnews.pod @@ -3104,93 +3419,93 @@ Here's a list of the more significant changes... pod/perlguts.pod Title: "expanded flock() docs" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <4481.852337871@eeyore.ibcinc.com> Date: Fri, 03 Jan 1997 19:31:11 -0500 Files: pod/perlfunc.pod Title: "Use Text::Wrap in buildtoc; run buildtoc" - From: Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de> + From: Ulrich Pfeifer Files: pod/buildtoc pod/perltoc.pod Title: "Remove obsolete perlovl.pod" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: MANIFEST plan9/mkfile pod/perlovl.pod vms/Makefile vms/descrip.mms ----------------- -Version 5.003_18 ----------------- +------------------ + Version 5.003_18 +------------------ Yet further down the road to 5.004.... CORE LANGUAGE CHANGES Title: "Inherited overloading" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199612291312.IAA02134@monk.mps.ohio-state.edu> Date: Sun, 29 Dec 1996 08:12:54 -0500 (EST) Files: gv.c lib/overload.pm perl.h sv.c sv.h t/op/overload.t Title: "Hide lexicals from C<use>d or C<require>d module (!)" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_ctl.c Title: "Closures at file scope must be anonymous" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c Title: "Warn on '{if,while} ($x = X)' where X is glob, readdir, or <FH>" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c pod/perldiag.pod Title: "Warn on 'undef $x; $x OP 1' where OP is *=, /=, %=, or **=" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp.c CORE PORTABILITY Title: "Ultrix setlocale() workaround" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: hints/ultrix_4.sh util.c OTHER CORE CHANGES Title: "Get rid of 'Leaked scalars'" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: cop.h gv.c op.c Title: "Don't forget $c in C<(($a,$b,$c)=(1,2))=(3,4,5)>" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_hot.c Title: "Fix core dump on perl_construct()/perl_destruct() loop" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: perl.c Title: "Add missing syms to global.sym; update magic doc" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: global.sym pod/perlguts.pod TESTS Title: "Expanded locale.t and misc.t" - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Files: t/lib/locale.t t/lib/misc.t Title: "Expanded my.t" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: t/lib/my.t Title: "test harness for C<use x.xxxx>" - From: Graham Barr <bodg@tiuk.ti.com> + From: Graham Barr Msg-ID: <32C76882.3F3C7999@tiuk.ti.com> Date: Mon, 30 Dec 1996 07:00:18 +0000 Files: MANIFEST t/op/use.t Title: "More tests" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.95.961229170736.15213M-100000@solaris.teleport.co Date: Sun, 29 Dec 1996 17:46:21 -0800 (PST) Files: t/op/each.t t/op/oct.t t/op/quotemeta.t t/op/rand.t @@ -3198,13 +3513,13 @@ Yet further down the road to 5.004.... LIBRARY AND EXTENSIONS Title: "Improving Config.pm" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.95.961230091244.13467L-100000@solaris.teleport.co Date: Mon, 30 Dec 1996 09:24:16 -0800 (PST) Files: configpm Title: "File::Copy under OS/2" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199612280347.WAA00293@monk.mps.ohio-state.edu> Date: Fri, 27 Dec 1996 22:47:24 -0500 (EST) Files: lib/File/Copy.pm t/lib/filecopy.t @@ -3223,15 +3538,15 @@ Yet further down the road to 5.004.... pod/perlre.pod pod/perlsec.pod Title: "Re: perldiag.pod entry for "Scalar value @%s{%s} ..."" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <2043.852051019@eeyore.ibcinc.com> Date: Tue, 31 Dec 1996 11:50:19 -0500 Files: pod/perldiag.pod ----------------- -Version 5.003_17 ----------------- +------------------ + Version 5.003_17 +------------------ The rate of patches is slowing down.... I see 5.004 at the end of the tunnel! (Hey, what's that whistle?) @@ -3239,7 +3554,7 @@ tunnel! (Hey, what's that whistle?) CORE LANGUAGE CHANGES Title: "Support named closures" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: cv.h op.c perl.c pp.c pp_ctl.c pp_hot.c CORE PORTABILITY @@ -3255,7 +3570,7 @@ tunnel! (Hey, what's that whistle?) Files: hints/freebsd.sh Title: "Minor OS/2 fixes" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199612252105.QAA11890@monk.mps.ohio-state.edu> Date: Wed, 25 Dec 1996 16:05:42 -0500 (EST) Files: os2/os2ish.h pod/perlxstut.pod @@ -3263,11 +3578,11 @@ tunnel! (Hey, what's that whistle?) OTHER CORE CHANGES Title: "Fix {,un}tainting of $1 etc. when C<use locale>" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: mg.c sv.c Title: "Limit effects of "=pod" to a single file" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: toke.c TESTS @@ -3277,19 +3592,19 @@ tunnel! (Hey, what's that whistle?) Files: MANIFEST t/lib/locale.t t/op/method.t Title: "Test C< ()=() >" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: t/op/misc.t LIBRARY AND EXTENSIONS Title: "Refresh MakeMaker to 5.39" - From: Andreas Koenig <k@anna.in-berlin.de> + From: Andreas Koenig Files: lib/ExtUtils/Install.pm lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Mksymlists.pm Title: "Newer debugger" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199612261954.OAA12999@monk.mps.ohio-state.edu> Date: Thu, 26 Dec 1996 14:54:34 -0500 (EST) Files: lib/perl5db.pl @@ -3297,27 +3612,27 @@ tunnel! (Hey, what's that whistle?) DOCUMENTATION Title: "Perlguts, version 27" - From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com> + From: Jeff Okamoto Msg-ID: <199612250144.AA059528263@hpcc123.corp.hp.com> Date: Tue, 24 Dec 1996 17:44:23 -0800 Files: pod/perlguts.pod Title: "perlpod.pod patch for _16" - From: Kenneth Albanowski <kjahds@kjahds.com> + From: Kenneth Albanowski Msg-ID: <Pine.LNX.3.93.961224225906.337B-100000@kjahds.com> Date: Tue, 24 Dec 1996 23:00:10 -0500 (EST) Files: pod/perlpod.pod Title: "tiny perllocale.pod diff for _16" - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Msg-ID: <199612261306.PAA21161@alpha.hut.fi> Date: Thu, 26 Dec 1996 15:06:04 +0200 (EET) Files: pod/perllocale.pod ----------------- -Version 5.003_16 ----------------- +------------------ + Version 5.003_16 +------------------ This patch is all bug fixes, library updates, and documentation updates. We'll get to 5.004 RSN, I promise. :-) @@ -3325,7 +3640,7 @@ updates. We'll get to 5.004 RSN, I promise. :-) CORE LANGUAGE CHANGES Title: "Fix closures that are not in subroutines" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c CORE PORTABILITY @@ -3339,25 +3654,25 @@ updates. We'll get to 5.004 RSN, I promise. :-) OTHER CORE CHANGES Title: "Fix 'foreach(@ARGV) { while (<>) { push @p,$_ } }'" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: cop.h pp_hot.c scope.c Title: "Eliminate warnings from C< undef $x; $x OP= "foo" >" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: doop.c pp.c pp.h pp_hot.c Title: "Try again to improve method caching" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199612240113.UAA09487@monk.mps.ohio-state.edu> Date: Mon, 23 Dec 1996 20:13:56 -0500 (EST) Files: gv.c sv.c Title: "Be more careful about 'o' magic memory management" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: mg.c sv.c Title: "Fix bad pointer refs when localized object loses magic" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: scope.c LIBRARY AND EXTENSIONS @@ -3382,7 +3697,7 @@ updates. We'll get to 5.004 RSN, I promise. :-) BUILD PROCESS AND UTILITIES Title: "Don't recurse into subdirs twice on 'make realclean'" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Makefile.SH Title: "Use root EXTERN.h when compiling x2p/malloc.c." @@ -3396,17 +3711,17 @@ updates. We'll get to 5.004 RSN, I promise. :-) DOCUMENTATION Title: "Edit INSTALL to describe new binary compat setup" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: INSTALL Title: "Update to perllocale.pod" - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Files: pod/perllocale.pod ----------------- -Version 5.003_15 ----------------- +------------------ + Version 5.003_15 +------------------ As soon as I posted 5.003_14, I found a fatal error in it. :-( @@ -3414,72 +3729,72 @@ This release is strictly a bug fix -- it removes some function caching changes that were supposed to be improvements, but weren't. ----------------- -Version 5.003_14 ----------------- +------------------ + Version 5.003_14 +------------------ We seem to have achieved "release candidate" status. CORE LANGUAGE CHANGES Title: "Eliminate support for {if,unless,while,until} BLOCK BLOCK" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: perly.c perly.c.diff perly.y toke.c Title: "Taint $x after $x =~ s/pat/xyz/ if pat or xyz is tainted by locale" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: cop.h mg.c pp_ctl.c pp_hot.c Title: "Complete support for modifying undefined array members in foreach" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: global.sym mg.c perl.h pp.c pp_hot.c proto.h sv.c OTHER CORE CHANGES Title: "patch for regex bug: (x|x){n}" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199612210259.VAA10170@aatma.engin.umich.edu> Date: Fri, 20 Dec 1996 21:59:22 -0500 Files: regexec.c Title: "Bug in debugger with import manipulations" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199612231037.FAA08617@monk.mps.ohio-state.edu> Date: Mon, 23 Dec 1996 05:37:48 -0500 (EST) Files: pp_hot.c Title: "Import and dynamic methods" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199612230645.BAA08378@monk.mps.ohio-state.edu> Date: Mon, 23 Dec 1996 01:45:37 -0500 (EST) Files: gv.c hv.c sv.c Title: "malloc.c patch" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199612220748.CAA07164@monk.mps.ohio-state.edu> Date: Sun, 22 Dec 1996 02:48:58 -0500 (EST) Files: malloc.c Title: "sv_gets patch" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199612220824.DAA07235@monk.mps.ohio-state.edu> Date: Sun, 22 Dec 1996 03:24:04 -0500 (EST) Files: pp_hot.c Title: "pos $str patch" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199612220831.DAA07247@monk.mps.ohio-state.edu> Date: Sun, 22 Dec 1996 03:31:21 -0500 (EST) Files: mg.c pp_hot.c t/op/pat.t Title: "Prevent warnings when STDCHAR is unsigned" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: perlio.c perlio.h PORTABILITY Title: "Fix bugs in bincompat3 usage" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: perl.h perl_exp.SH Title: "Support shared libperl on SunOS" @@ -3487,7 +3802,7 @@ We seem to have achieved "release candidate" status. Files: Makefile.SH Title: "Configure on OS/2" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199612202325.SAA05505@monk.mps.ohio-state.edu> Date: Fri, 20 Dec 1996 18:25:30 -0500 (EST) Files: Configure @@ -3499,11 +3814,11 @@ We seem to have achieved "release candidate" status. Files: hints/isc.sh op.c pp_sys.c universal.c Title: "Use "proto" instead of "_" in sdbm.h" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: ext/SDBM_File/sdbm/sdbm.h Title: "VMS patches to 5.003_13" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Msg-ID: <01IDBYYFYPIS002ASE@hmivax.humgen.upenn.edu> Date: Mon, 23 Dec 1996 01:26:47 -0500 (EST) Files: deb.c ext/POSIX/POSIX.xs gv.c lib/File/Copy.pm mg.c perl.c @@ -3516,11 +3831,11 @@ We seem to have achieved "release candidate" status. UTILITIES, LIBRARY, AND EXTENSIONS Title: "Remove libnet" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: MANIFEST pod/perlmod.pod Title: "Refresh CPAN module to 1.08" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: lib/CPAN.pm lib/CPAN/FirstTime.pm Title: "Refresh ExtUtils::Manifest to version 1.28" @@ -3528,15 +3843,15 @@ We seem to have achieved "release candidate" status. Files: lib/ExtUtils/Manifest.pm Title: "Update IO->VERSION() to 1.1201 for CPAN's sake" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: ext/IO/lib/IO/Handle.pm lib/IO/Handle.pm Title: "Remodel File::Copy." - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: lib/File/Copy.pm Title: "dumb bug in User::pwent.pm" - From: Tom Christiansen <tchrist@mox.perl.com> + From: Tom Christiansen Msg-ID: <199612201145.EAA27860@mox.perl.com> Date: Fri, 20 Dec 1996 04:45:37 -0700 Files: lib/User/pwent.pm @@ -3544,7 +3859,7 @@ We seem to have achieved "release candidate" status. DOCUMENTATION Title: "Better support for =for" - From: Kenneth Albanowski <kjahds@kjahds.com> + From: Kenneth Albanowski Msg-ID: <Pine.LNX.3.93.961220163747.298T-100000@kjahds.com> Date: Fri, 20 Dec 1996 16:43:35 -0500 (EST) Files: lib/Pod/Text.pm pod/pod2latex.PL pod/pod2man.PL @@ -3556,26 +3871,26 @@ We seem to have achieved "release candidate" status. Files: pod/perllocale.pod Title: "Perlguts, version 26" - From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com> + From: Jeff Okamoto Msg-ID: <199612201943.AA048111018@hpcc123.corp.hp.com> Date: Fri, 20 Dec 1996 11:43:38 -0800 Files: pod/perlguts.pod Title: "Update pod/Makefile; s/perli18n/perllocale/" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: ext/POSIX/POSIX.pod lib/I18N/Collate.pm pod/Makefile pod/perl.pod pod/perlmod.pod pod/perlnews.pod pod/roffitall Title: "obstruct pod2man doc tweaks" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <3923.851106237@eeyore.ibcinc.com> Date: Fri, 20 Dec 1996 13:23:57 -0500 Files: lib/Class/Template.pm lib/Time/tm.pm ----------------- -Version 5.003_13 ----------------- +------------------ + Version 5.003_13 +------------------ The watchword here is "synchronization." There were a couple of show-stopper bugs in 5.003_12, so I'm issuing this patch to bring @@ -3584,33 +3899,33 @@ everyone up to a common working base. CORE LANGUAGE CHANGES Title: "Disallow labels named q, qq, qw, qx, s, y, and tr" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: toke.c Title: "Make evals' lexicals visible to nested evals" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_ctl.c OTHER CORE CHANGES Title: "Fix core dump bug with anoncode" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c Title: "Allow DESTROY to make refs to dying objects" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: sv.c PORTABILITY Title: "Add missing backslash in Configure" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Configure UTILITIES, LIBRARY, AND EXTENSIONS Title: "Include libnet-1.01 instead of old Net::FTP" - From: Graham Barr <Graham.Barr@tiuk.ti.com> + From: Graham Barr Files: MANIFEST lib/Net/Cmd.pm lib/Net/Domain.pm lib/Net/DummyInetd.pm lib/Net/FTP.pm lib/Net/NNTP.pm lib/Net/Netrc.pm lib/Net/POP3.pm lib/Net/SMTP.pm @@ -3622,7 +3937,7 @@ everyone up to a common working base. Files: lib/Net/FTP.pm Title: "Re: Open3.pm tries to close unopened file handle" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <pzloavmd9h.fsf@eeyore.ibcinc.com> Date: 18 Dec 1996 22:19:54 -0500 Files: MANIFEST lib/IPC/Open2.pm lib/IPC/Open3.pm lib/open2.pl @@ -3630,20 +3945,20 @@ everyone up to a common working base. t/lib/open3.t Title: "Long-standing problem in Socket module" - From: Spider Boardman <spider@orb.nashua.nh.us> + From: Spider Boardman Msg-ID: <199612190418.XAA07291@Orb.Nashua.NH.US> Date: Wed, 18 Dec 1996 23:18:14 -0500 Files: Configure Porting/Glossary config_H config_h.SH ext/Socket/Socket.pm ext/Socket/Socket.xs Title: "flock() constants" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <26669.850977437@eeyore.ibcinc.com> Date: Thu, 19 Dec 1996 01:37:17 -0500 Files: ext/Fcntl/Fcntl.pm ext/Fcntl/Fcntl.xs pod/perlfunc.pod Title: "Re: find2perl . -xdev BROKEN still" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <pzvi9yig3h.fsf@eeyore.ibcinc.com> Date: 19 Dec 1996 12:44:34 -0500 Files: lib/File/Find.pm lib/find.pl lib/finddepth.pl @@ -3651,21 +3966,21 @@ everyone up to a common working base. DOCUMENTATION Title: "small doc tweaks for _12" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <1826.851011557@eeyore.ibcinc.com> Date: Thu, 19 Dec 1996 11:05:57 -0500 Files: lib/UNIVERSAL.pm pod/perldiag.pod pod/perltie.pod Title: "Re: missing E<> POD directive in perlpod.pod" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <pzwwueimak.fsf@eeyore.ibcinc.com> Date: 19 Dec 1996 10:30:43 -0500 Files: pod/perlpod.pod pod/pod2html.PL ----------------- -Version 5.003_12 ----------------- +------------------ + Version 5.003_12 +------------------ This patch is huge. A multitude of bug fixes, new modules (especially CPAN and Net::FTP), a couple of new Configure variables, updated @@ -3675,109 +3990,109 @@ the more significant changes in 5.003_12: CORE LANGUAGE CHANGES Title: "Support C<delete @hash{@keys}>" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c op.h opcode.pl pod/perldiag.pod pod/perlfunc.pod pp.c t/op/delete.t Title: "Autovivify scalars" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: dump.c op.c op.h pp.c pp_hot.c Title: "Allow any word, including keyword, as label" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: toke.c OTHER CORE CHANGES Title: "Allow assignment to empty array values during foreach()" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: cop.h global.sym mg.c op.c perl.h pp_hot.c proto.h sv.c Title: "Fix nested closures" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c opcode.pl pp.c pp_ctl.c pp_hot.c Title: "Fix core dump on auto-vivification" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_hot.c Title: "Fix core dump on C<open $undef_var, "X">" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_sys.c Title: "Fix -T/-B on globs and globrefs" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_sys.c Title: "Fix memory management of $`, $&, and $'" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_hot.c regexec.c Title: "Fix paren matching during backtracking" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: regexec.c Title: "Fix memory leak and std{in,out,err} death in perl_{con,de}str - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: miniperlmain.c perl.c perl.h sv.c Title: "Discard garbage bytes at end of prototype()" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp.c Title: "Fix local($pack::{foo})" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: global.sym pp.c pp_hot.c proto.h scope.c Title: "Fix for AmigaOS - inplace operation" - From: "Norbert Pueschel" <pueschel@imsdd.meb.uni-bonn.de> + From: Norbert Pueschel Msg-ID: <77724601@Armageddon.meb.uni-bonn.de> Date: Sun, 08 Dec 1996 15:33:00 +0100 Files: doio.c Title: "Disable warn, die, and parse hooks _before_ global destruction - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: perl.c Title: "Re: Bug in formline " - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199612081958.OAA26025@aatma.engin.umich.edu> Date: Sun, 08 Dec 1996 14:58:32 -0500 Files: pp_ctl.c Title: "Fix C<@a = ($a,$b,$c,$d) = (1,2)>" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_hot.c Title: "Fix %ENV assignment when environment starts out empty" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: hv.c Title: "Properly support and document newRV{,_inc,_noinc}" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: global.sym pod/perlguts.pod sv.c sv.h Title: "Support SvREADONLY on arrays" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: av.c Title: "Allow lvalue pos inside recursive function" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c pp.c pp_ctl.c pp_hot.c PORTABILITY Title: "Eliminate PerlIO warnings when setting cnt to -1" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: perlio.c Title: "Make $privlib contents compatible with 5.003" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: INSTALL ext/Opcode/Safe.pm installperl lib/FileHandle.pm lib/Test/Harness.pm Title: "Support $bincompat3 config variable; update metaconfig units" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Configure MANIFEST compat3.sym config_h.SH embed.pl global.sym old_embed.pl old_global.sym old_perl_exp.SH perl_exp.SH @@ -3788,11 +4103,11 @@ the more significant changes in 5.003_12: Files: Configure config_H config_h.SH pp.c Title: "Make $startperl a relative path if people want portable scrip - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Configure Title: "Homogenize use of "eval exec" hack" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Porting/Glossary eg/README eg/nih eg/sysvipc/ipcmsg eg/sysvipc/ipcsem eg/sysvipc/ipcshm lib/diagnostics.pm makeaperl.SH pod/checkpods.PL pod/perlrun.pod @@ -3808,7 +4123,7 @@ the more significant changes in 5.003_12: Files: Configure MANIFEST hints/lynxos.sh t/op/stat.t Title: "In Linux hints, set suidsafe=no and dosuid=yes" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: hints/linux.sh Title: "5.003_11 on UnixWare 2.1.1 - Only one small UnixWare buglet" @@ -3818,17 +4133,17 @@ the more significant changes in 5.003_12: Files: hints/svr4.sh Title: "Re: db-recno.t failures with _11 on Freebsd 2.1-stable" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <pzohg0r5tr.fsf@eeyore.ibcinc.com> Date: 11 Dec 1996 18:58:56 -0500 Files: INSTALL hints/freebsd.sh Title: "OS/2 updates from Ilya" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Files: README.os2 os2/Changes os2/Makefile.SHs os2/os2.c os2/os2ish.h Title: "VMS patches to 5.003_11" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Msg-ID: <01ICTR32LCZG001A1D@hmivax.humgen.upenn.edu> Date: Mon, 09 Dec 1996 23:16:10 -0500 (EST) Files: MANIFEST regexec.c t/lib/filehand.t util.c vms/* @@ -3836,7 +4151,7 @@ the more significant changes in 5.003_12: TESTING Title: "recurse recurse recurse ..." - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Msg-ID: <199612092144.XAA29025@alpha.hut.fi> Date: Mon, 9 Dec 1996 23:44:27 +0200 (EET) Files: MANIFEST t/op/recurse.t @@ -3844,7 +4159,7 @@ the more significant changes in 5.003_12: UTILITIES, LIBRARY, AND EXTENSIONS Title: "Add CPAN and Net::FTP" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: MANIFEST lib/CPAN.pm lib/CPAN/FirstTime.pm lib/CPAN/Nox.pm lib/Net/FTP.pm lib/Net/Netrc.pm lib/Net/Socket.pm pod/perlmod.pod @@ -3856,47 +4171,47 @@ the more significant changes in 5.003_12: Files: lib/Text/Tabs.pm lib/Text/Wrap.pm Title: "Add File::Compare" - From: Nick Ing-Simmons <nik@tiuk.ti.com> + From: Nick Ing-Simmons Msg-ID: <199612161844.SAA02152@pluto> Date: Mon, 16 Dec 1996 18:44:59 GMT Files: MANIFEST lib/File/Compare.pm pod/perlmod.pod Title: "Add Tie::RefHash" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199612152358.SAA28665@aatma.engin.umich.edu> Date: Sun, 15 Dec 1996 18:58:08 -0500 Files: MANIFEST lib/Tie/RefHash.pm pod/perlmod.pod Title: "Put "splain" in utils." - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Makefile.SH installperl utils/Makefile utils/splain.PL Title: "Some h2ph fixes" - From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com> + From: Jeff Okamoto Msg-ID: <199612131934.AA289845652@hpcc123.corp.hp.com> Date: Fri, 13 Dec 1996 11:34:12 -0800 Files: utils/h2ph.PL Title: "xsubpp patch to add #line" - From: nick@ni-s.u-net.com (Nick Ing-Simmons) + From: Nick Ing-Simmons Msg-ID: <199612162153.VAA03590@ni-s.u-net.com> Date: Mon, 16 Dec 1996 21:53:56 GMT Files: lib/ExtUtils/xsubpp Title: "Re: Proposed addition to File::Copy: move" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Msg-ID: <01ICZBN0LRC8001A1D@hmivax.humgen.upenn.edu> Date: Sat, 14 Dec 1996 00:27:29 -0500 (EST) Files: lib/File/Copy.pm t/lib/filecopy.t Title: "DB_File 1.09 patch" - From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + From: Paul Marquess Msg-ID: <9612181037.AA10123@claudius.bfsec.bt.co.uk> Date: Wed, 18 Dec 96 10:37:58 GMT Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs Title: "Debugger update" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199612111038.FAA24363@monk.mps.ohio-state.edu> Date: Wed, 11 Dec 1996 05:38:28 -0500 (EST) Files: lib/perl5db.pl @@ -3909,13 +4224,13 @@ the more significant changes in 5.003_12: pod/perlnews.pod Title: "perltoot.pod" - From: Tom Christiansen <tchrist@mox.perl.com> + From: Tom Christiansen Msg-ID: <199612091444.HAA09947@toy.perl.com> Date: Mon, 09 Dec 1996 07:44:10 -0700 Files: MANIFEST pod/perltoot.pod Title: "Perlguts, version 25" - From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com> + From: Jeff Okamoto Msg-ID: <199612061940.AA055461228@hpcc123.corp.hp.com> Date: Fri, 6 Dec 96 11:40:27 PST Files: pod/perlguts.pod @@ -3933,14 +4248,14 @@ the more significant changes in 5.003_12: Files: pod/*.pod Title: "Misc doc updates" - From: Tom Christiansen <tchrist@mox.perl.com> + From: Tom Christiansen Msg-ID: <199612150156.SAA12506@mox.perl.com> Date: Sat, 14 Dec 1996 18:56:33 -0700 Files: pod/* ----------------- -Version 5.003_11 ----------------- +------------------ + Version 5.003_11 +------------------ This patch is (still) closing in on 5.004. Nothing dramatic, lots of value. @@ -3948,91 +4263,91 @@ value. CORE LANGUAGE CHANGES Title: "Fix precedence problems with subs as uniops or listops" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: perly.c perly.c.diff perly.h perly.y Title: "Don't reset $. on open()" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_sys.c Title: "Support *glob{IO} (eventually deprecate *glob{FILEHANDLE})" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pod/perlref.pod pp_hot.c sv.c Title: "Don't let expression context force return context" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c Title: "Properly convert "1E2" et al to IV/UV" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: doio.c sv.c Title: "Fix modulo operator in UV realm" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp.c Title: "Fix stat(_) after stat(HANDLE)" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_sys.c Title: "Fix: s/// and "$x =~ $y" under 'use locale'" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c toke.c OTHER CORE CHANGES Title: "Eliminate spurious warning when splicing undefs" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp.c sv.h Title: "Eliminate spurious warning from "x=" operator" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c Title: "Fix line numbers near control structures" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c perly.c perly.c.diff perly.y proto.h Title: "Don't let scalar unpack() underflow stack" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp.c Title: "Fix core dump from precedence bug in "@foo" warning" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: toke.c Title: "Move die() to utils.c; add varargs hack to croak()" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_ctl.c util.c Title: "Avoid memcmp() for magnitude test if it thinks char is signed" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Configure config_H config_h.SH doop.c ext/SDBM_File/sdbm/pair.c ext/SDBM_File/sdbm/sdbm.h handy.h hv.c perl.h pp_hot.c proto.h regexec.c sv.c toke.c util.c Title: "Less malloc in magic" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: mg.c Title: "Re: 5.003_09: PADTMP fix" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199611281150.GAA06884@monk.mps.ohio-state.edu> Date: Thu, 28 Nov 1996 06:50:58 -0500 (EST) Files: pod/perlguts.pod Title: "Fully paramaterize locales; disable all if NO_LOCALE" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: ext/POSIX/POSIX.xs op.c perl.h pp.c pp_sys.c sv.c util.c PORTABILITY AND TESTING Title: "Bitwise op fix for Alpha" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp.c Title: "hints/dgux.sh update" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <24178.849309616@eeyore.ibcinc.com> Date: Fri, 29 Nov 1996 18:20:16 -0500 Files: hints/dgux.sh @@ -4044,7 +4359,7 @@ value. Files: hints/hpux.sh Title: "VMS patches for 5.003_10" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Msg-ID: <01ICMALO8NMS001A1D@hmivax.humgen.upenn.edu> Date: Wed, 04 Dec 1996 16:40:12 -0500 (EST) Files: EXTERN.h INTERN.h old_perl_exp.SH perl.c perl.h perl_exp.SH @@ -4053,7 +4368,7 @@ value. vms/gen_shrfls.pl vms/genconfig.pl vms/vmsish.h Title: "_10+ under OS/2" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199612011107.GAA10805@monk.mps.ohio-state.edu> Date: Sun, 1 Dec 1996 06:07:19 -0500 (EST) Files: malloc.c os2/diff.configure @@ -4061,7 +4376,7 @@ value. LIBRARY AND EXTENSIONS Title: "{in,ob}structive pods" - From: Tom Christiansen <tchrist@mox.perl.com> + From: Tom Christiansen Msg-ID: <199611301652.JAA24201@toy.perl.com> Date: Sat, 30 Nov 1996 09:52:57 -0700 Files: MANIFEST lib/Class/Template.pm lib/File/stat.pm @@ -4070,44 +4385,44 @@ value. lib/Time/tm.pm lib/User/grent.pm lib/User/pwent.pm Title: "FileHandle that 'ISA' IO::File" - From: Nick Ing-Simmons <nik@tiuk.ti.com> + From: Nick Ing-Simmons Msg-ID: <199612021718.RAA04416@pluto> Date: Mon, 2 Dec 1996 17:18:02 GMT Files: MANIFEST lib/FileHandle.pm Title: "Make IO::File::import use its parameters" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: ext/IO/lib/IO/File.pm Title: "10+ debugger patch" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199612011137.GAA10864@monk.mps.ohio-state.edu> Date: Sun, 1 Dec 1996 06:37:31 -0500 (EST) Files: lib/perl5db.pl perl.c pod/perldebug.pod Title: "Don't call CORE::close in file handle DESTROY method" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: ext/IO/lib/IO/Handle.pm Title: "Re: Namespace cleanup: Does SDBM need binary compatibility?" - From: Hallvard B Furuseth <h.b.furuseth@usit.uio.no> + From: Hallvard B Furuseth Msg-ID: <199612031445.PAA19056@bombur2.uio.no> Date: Tue, 3 Dec 1996 15:45:27 +0100 (MET) Files: ext/SDBM_File/sdbm/pair.h ext/SDBM_File/sdbm/sdbm.3 Title: "DB_File 1.07" - From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + From: Paul Marquess Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs t/lib/db-btree.t t/lib/db-recno.t Title: "DB_File 1.08" - From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + From: Paul Marquess Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs ----------------- -Version 5.003_10 ----------------- +------------------ + Version 5.003_10 +------------------ This patch is closing in on 5.004. It contains lots of small and valuable changes, but nothing dramatic. @@ -4115,7 +4430,7 @@ valuable changes, but nothing dramatic. CORE LANGUAGE CHANGES Title: "Allow &{sub {...}} without warning" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: toke.c Title: "Make parens optional on [gs]ethost and [gs]et{pw,gr} functions @@ -4123,25 +4438,25 @@ valuable changes, but nothing dramatic. Files: toke.c Title: "Fix syntax error with "$x [0]" and "$x {y}" and "@x {y}"" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: toke.c OTHER CORE CHANGES Title: "Fix regex matching of chars with high bit set" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: regexec.c Title: "Hash key memory corruption fix and naming cleanup" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: hv.c hv.h perl.h Title: "Undo broken perf. patch (PADTMP stealing)" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: sv.c Title: "Make SV unstudied in sv_gets()" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: sv.c Title: "Better support for UVs" @@ -4151,51 +4466,51 @@ valuable changes, but nothing dramatic. Title: "Minor locale cleanups" (Accept "POSIX" locale as standard like "C". Reset locale to 'C' when testing strtod() in t/lib/posix.t.) - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: t/lib/posix.t util.c Title: "Always taint result of sprintf() on float" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: doop.c Title: "Fix spurious warning from bitwise string ops" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: doop.c Title: "Eliminate warning on {,sys}read(,$newvar,)" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: doop.c pp_sys.c Title: "Don't call fcntl(fileno(rsfp)) if !rsfp" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: perl.c Title: "Save message when calling __DIE__ hook" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_ctl.c Title: "Namespace cleanup" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: global.sym old_global.sym perl.h Title: "Modify perl_exp.SH; create old_perl_exp.SH; document old_*" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Configure INSTALL MANIFEST old_perl_exp.SH perl_exp.SH PORTABILITY Title: "Reliable signal patch" - From: Kenneth Albanowski <kjahds@kjahds.com> + From: Kenneth Albanowski Msg-ID: <Pine.LNX.3.93.961126053209.294J-100000@kjahds.com> Date: Tue, 26 Nov 1996 05:40:50 -0500 (EST) Files: global.sym mg.c old_global.sym perl.h pp_sys.c proto.h util.c Title: "Emulate missing flock() with either fcntl() or lockf()" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_sys.c Title: "3_09: minor patches for OS/2" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199611270830.DAA04985@monk.mps.ohio-state.edu> Date: Wed, 27 Nov 1996 03:30:05 -0500 (EST) Files: doio.c global.sym malloc.c old_global.sym os2/Makefile.SHs @@ -4211,7 +4526,7 @@ valuable changes, but nothing dramatic. t/TEST toke.c util.c x2p/proto.h Title: "Re: updated patch on the sysread, syswrite for VMS" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Msg-ID: <01ICB648K2XG001A1D@hmivax.humgen.upenn.edu> Date: Tue, 26 Nov 1996 17:28:23 -0500 (EST) Files: t/op/sysio.t @@ -4219,37 +4534,37 @@ valuable changes, but nothing dramatic. LIBRARY AND EXTENSIONS Title: "Minor patch to debugger" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199611290533.AAA08053@monk.mps.ohio-state.edu> Date: Fri, 29 Nov 1996 00:33:49 -0500 (EST) Files: lib/perl5db.pl Title: "AutoLoader::AUTOLOAD optimization" - From: nick@ni-s.u-net.com (Nick Ing-Simmons) + From: Nick Ing-Simmons Msg-ID: <199611231954.TAA09921@ni-s.u-net.com> Date: Sat, 23 Nov 1996 19:54:52 GMT Files: lib/AutoLoader.pm Title: "Diagnostic cleanup" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: lib/diagnostics.pm pod/perldiag.pod DOCUMENTATION Title: "Improve documentation for sysread() and syswrite()" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pod/perlfunc.pod Title: "Document how to use $SIG{ALRM} and alarm()" - From: Roderick Schertler <roderick@ibcinc.com> + From: Roderick Schertler Msg-ID: <5898.849026569@eeyore.ibcinc.com> Date: Tue, 26 Nov 1996 11:42:49 -0500 Files: pod/perlfunc.pod ----------------- -Version 5.003_09 ----------------- +------------------ + Version 5.003_09 +------------------ This patch was a compendium of various fixes and enhancements from many people, including some serious improvement in lexical variable @@ -4259,17 +4574,17 @@ scoping and locale handling. Title: "Lexical locales" (make effectiveness of locales depend on C<use locale>) - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: too many to list Title: "Lexical scoping cleanup" (tighten scoping of lexical variables, somewhat on the new constructs and somewhat on the old) - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: many... but mostly perly.y and toke.c Title: "Re: memory corruption / security bug in sysread,syswrite + pa - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Msg-ID: <199611251946.VAA30459@alpha.hut.fi> Date: Mon, 25 Nov 1996 21:46:31 +0200 (EET) Files: MANIFEST pod/perldiag.pod pod/perlfunc.pod pp_sys.c @@ -4278,11 +4593,11 @@ scoping and locale handling. OTHER CORE CHANGES Title: "Configure fix for handling DynaLoader" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Configure Title: "Properly prototype safe{malloc,calloc,realloc,free}." - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: proto.h Title: "UnixWare 2.1 fix for perl5.003_08 - cope with fp->_cnt < -1, @@ -4292,55 +4607,55 @@ scoping and locale handling. Files: sv.c Title: ""static" call to UNIVERSAL::can" - From: Nick.Ing-Simmons@tiuk.ti.com + From: Nick Ing-Simmons Msg-ID: <199611211547.PAA15878@pluto> Date: Thu, 21 Nov 1996 15:47:46 GMT Files: universal.c Title: "die -> croak" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199611212111.QAA17070@aatma.engin.umich.edu> Date: Thu, 21 Nov 1996 16:11:21 -0500 Files: pp_ctl.c Title: "Patch for embed.pl when !EMBED && !MULTIPLICITY" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: embed.pl Title: "Add new symbols to old_global.sym, too." - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: global.sym old_global.sym Title: "Cleanup of {,un}pack('w')." - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp.c Title: "Cleanups from Ilya." - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: gv.c malloc.c pod/perlguts.pod pp_ctl.c Title: "Fix for unpack('w') on 64-bit systems." - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp.c Title: "Re: LC_NUMERIC support is ready + performance" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199611260308.WAA02677@monk.mps.ohio-state.edu> Date: Mon, 25 Nov 1996 22:08:27 -0500 (EST) Files: sv.c Title: "Hash key sharing improvements from Ilya." - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: hv.c hv.h proto.h Title: "Mortal stack pre-allocation from Ilya." - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp.c pp.h pp_ctl.c pp_hot.c pp_sys.c PORTABILITY Title: "VMS patches post-5.003_08" - From: bailey@hmivax.humgen.upenn.edu (Charles Bailey) + From: Charles Bailey Msg-ID: <1996Nov22.181631.1603238@hmivax.humgen.upenn.edu> Date: Fri, 22 Nov 1996 18:16:31 -0500 (EST) Files: lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_VMS.pm @@ -4350,20 +4665,20 @@ scoping and locale handling. vms/vmsish.h Title: "5.003_08: OS/2-specific bugs/enhancements" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199611241147.GAA00490@monk.mps.ohio-state.edu> Date: Sun, 24 Nov 1996 06:47:25 -0500 (EST) Files: README.os2 hints/os2.sh os2/Changes os2/Makefile.SHs os2/OS2/PrfDB/PrfDB.pm os2/os2.c Title: "HP patches didn't make it into _08 (fwd)" - From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com> + From: Jeff Okamoto Msg-ID: <199611260215.AA100414526@hpcc123.corp.hp.com> Date: Mon, 25 Nov 96 18:15:26 PST Files: ext/DynaLoader/dl_hpux.xs Title: "Another HP "patch" that didn't make it (new hints file)" - From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com> + From: Jeff Okamoto Msg-ID: <199611252116.AA245766577@hpcc123.corp.hp.com> Date: Mon, 25 Nov 1996 13:16:17 -0800 Files: hints/hpux.sh @@ -4371,15 +4686,15 @@ scoping and locale handling. LIBRARY AND EXTENSIONS Title: "Elide spurious space in db-hash.t" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: t/lib/db-hash.t Title: "Update documentation and warning in I18N::Collate." - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: lib/I18N/Collate.pm Title: "Fix bitwise op test; clean up a couple of others" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: t/lib/bigintpm.t t/op/bop.t t/op/overload.t Title: "minimal timelocal.pl for _09" @@ -4389,11 +4704,11 @@ scoping and locale handling. Files: lib/Time/Local.pm Title: "Socket test improvement from Ilya." - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: t/lib/io_sock.t Title: "Re: blib" - From: nick@ni-s.u-net.com (Nick Ing-Simmons) + From: Nick Ing-Simmons Msg-ID: <199611230917.JAA00471@ni-s.u-net.com> Date: Sat, 23 Nov 1996 09:17:40 GMT Files: lib/blib.pm @@ -4401,19 +4716,19 @@ scoping and locale handling. DOCUMENTATION Title: "perldiag documentation patch." - From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + From: Paul Marquess Msg-ID: <9611201607.AA12729@claudius.bfsec.bt.co.uk> Date: Wed, 20 Nov 96 16:07:28 GMT Files: pod/perldiag.pod Title: "a missing perldiag entry" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199611212024.PAA15758@aatma.engin.umich.edu> Date: Thu, 21 Nov 1996 15:24:02 -0500 Files: pod/perldiag.pod Title: "perlfunc patch" - From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + From: Paul Marquess Msg-ID: <9611201404.AA12477@claudius.bfsec.bt.co.uk> Date: Wed, 20 Nov 96 14:04:08 GMT Files: pod/perlfunc.pod @@ -4425,19 +4740,19 @@ scoping and locale handling. Files: pod/perlpod.pod Title: "Update locale documentation." - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pod/perli18n.pod BUNDLED UTILITIES Title: "Fix type mismatches in x2p's safe{alloc,realloc,free}." - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: x2p/util.c ----------------- -Version 5.003_08 ----------------- +------------------ + Version 5.003_08 +------------------ This patch was a compendium of various fixes and enhancements from many people. Here are some of the more significant changes. @@ -4446,13 +4761,13 @@ many people. Here are some of the more significant changes. CORE LANGUAGE CHANGES Title: "Make C<no FOO> fail if C<unimport FOO> fails" - From: Tim Bunce <Tim.Bunce@ig.co.uk> + From: Tim Bunce Files: gv.c Title: "Bitwise op sign rationalization" (Make bitwise ops result in unsigned values, unless C<use integer> is in effect. Includes initial support for UVs.) - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c opcode.pl pod/perlop.pod pod/perltoc.pod pp.c pp.h pp_hot.c proto.h sv.c t/op/bop.t @@ -4463,78 +4778,78 @@ many people. Here are some of the more significant changes. structure. Also adds new construct "for my", which automatically declares the control variable "my" and limits its scope to the loop.) - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c perly.c perly.c.diff perly.h perly.y proto.h toke.c Title: "Fix ++/-- after int conversion (e.g. 'printf "%d"')" (This patch makes Perl correctly ignore SvIVX() if either NOK or POK is true, since SvIVX() may be a truncated or overflowed version of the real value.) - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp.c pp_hot.c sv.c Title: "Make code match Camel II re: functions that use $_" - From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + From: Paul Marquess Files: opcode.pl Title: "Provide scalar context on left side of "->"" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: perly.c perly.y Title: "Quote bearword package/handle FOO in "funcname FOO => 'bar'"" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: toke.c OTHER CORE CHANGES Title: "Warn on overflow of octal and hex integers" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: proto.h toke.c util.c Title: "If -w active, warn for commas and hashes ('#') in qw()" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: toke.c Title: "Fixes for pack('w')" - From: Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de> + From: Ulrich Pfeifer Files: pp.c t/op/pack.t Title: "More complete output from sv_dump()" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Files: sv.c Title: "Major '..' and debugger patches" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Files: lib/perl5db.pl op.c pp_ctl.c scope.c scope.h Title: "Fix for formline()" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Files: global.sym mg.c perl.h pod/perldiag.pod pp_ctl.c proto.h sv.c t/op/write.t Title: "Fix stack botch in untie and binmode" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Files: pp_sys.c Title: "Complete EMBED, including symbols from interp.sym" (New define EMBEDMYMALLOC makes embedding total by avoiding "Mymalloc" etc.) - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: MANIFEST embed.pl ext/DynaLoader/dlutils.c ext/SDBM_File/sdbm/sdbm.h global.sym handy.h malloc.c perl.h pp_sys.c proto.h regexec.c toke.c util.c x2p/Makefile.SH x2p/a2p.h x2p/handy.h x2p/util.h Title: "Support old embedding for people who want it" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: MANIFEST Makefile.SH old_embed.pl old_global.sym PORTABILITY Title: "Miscellaneous VMS fixes" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Files: lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_VMS.pm lib/Math/Complex.pm lib/Time/Local.pm lib/timelocal.pl perl.h perl_exp.SH proto.h t/TEST t/io/read.t @@ -4555,14 +4870,14 @@ many people. Here are some of the more significant changes. plan9/genconfig.pl plan9/mkfile plan9/setup.rc Title: "Patch to make Perl work under AmigaOS" - From: "Norbert Pueschel" <pueschel@imsdd.meb.uni-bonn.de> + From: Norbert Pueschel Files: MANIFEST hints/amigaos.sh installman lib/File/Basename.pm lib/File/Find.pm pod/pod2man.PL pp_sys.c util.c LIBRARY AND EXTENSIONS Title: "DB_File 1.05" - From: Paul Marquess (pmarquess@bfsec.bt.co.uk) + From: Paul Marquess Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs t/lib/db-hash.t Title: "Getopts::Std patch for hash support" @@ -4571,7 +4886,7 @@ many people. Here are some of the more significant changes. Title: "Kludge for bareword handles" (Add 'require IO::Handle' at beginning of FileHandle.pm) - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: ext/FileHandle/FileHandle.pm Title: "Re: strtod / strtol patch for POSIX module" @@ -4582,13 +4897,13 @@ many people. Here are some of the more significant changes. BUNDLED UTILITIES Title: "Fix a2p translation of '{print "a" "b" "c"}'" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: x2p/a2p.c x2p/a2p.y ----------------- -Version 5.003_07 ----------------- +------------------ + Version 5.003_07 +------------------ This patch was primarily to fix bugs or include little things I missed in 5.003_06. 5.003_07 is intended to be stable enough to merit serious @@ -4682,14 +4997,14 @@ Index: MANIFEST Add mention of t/lib/io_taint.t Date: Wed, 9 Oct 1996 22:29:44 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich os2/Changes added. Index: Makefile.SH Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich All the executable targets are moved into the same chunk with shared library target, which is delegated to @@ -4755,14 +5070,14 @@ Index: ext/SDBM_File/sdbm/sdbm.h Index: gv.c Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Better error message for overload. Index: hints/os2.sh Date: Wed, 9 Oct 1996 22:29:44 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Some optimization (speedup in loading GNU utilities with some memory present - 32M should be quite enough). @@ -4777,14 +5092,14 @@ Index: hints/sco.sh Index: installperl Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Restore timestamps under OS/2 (needed for binary install). Index: lib/Cwd.pm Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Use builtin methods if present under OS/2 (maybe should be done outside of OS/2 too?). @@ -4792,28 +5107,28 @@ Index: lib/Cwd.pm Index: lib/ExtUtils/MM_Unix.pm Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Made `use strict'-clean even in parts shadowed by Autoloading. Index: lib/ExtUtils/typemap Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich `bool' entry added. Index: lib/ExtUtils/xsubpp Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Logic for processing RETVAL documented (at last!). Index: lib/File/Copy.pm Date: Thu, 10 Oct 1996 00:42:29 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Subject: Cleanup after new test Below are patches for File::Copy (copying to filehandles was just @@ -4822,7 +5137,7 @@ Index: lib/File/Copy.pm Index: lib/FindBin.pm Date: Fri, 20 Sep 1996 15:04:04 +0200 - From: Gisle Aas <aas@bergen.sn.no> + From: Gisle Aas Subject: Documentation patch to the FindBin module Index: lib/Getopt/Long.pm @@ -4844,7 +5159,7 @@ Index: lib/newgetopt.pl Index: makedepend.SH Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich weed out perl_exp.SH, config_h.SH (They have these funny names to avoid names like perl.exp.SH @@ -4853,7 +5168,7 @@ Index: makedepend.SH Index: mg.c Date: Thu, 10 Oct 1996 14:33:08 +0000 () - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Subject: Re: Group fix for 5.003_06 The group problems recently experienced are due to a small error @@ -4862,20 +5177,20 @@ Index: mg.c Index: os2/Changes Date: Wed, 9 Oct 1996 22:29:44 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich sys/un.h is not very useful without Merlin toolkit. updates for fork()ing. Date: Wed, 9 Oct 1996 22:29:44 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich added. Index: os2/Makefile.SHs Date: Wed, 9 Oct 1996 22:29:44 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Convoluted process to create chimera executables added. aout_clean is done automatically on clean. @@ -4883,7 +5198,7 @@ Index: os2/Makefile.SHs Index: os2/OS2/ExtAttr/t/os2_ea.t Date: Wed, 9 Oct 1996 22:29:44 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Use `unlink' where appropriate. @@ -4894,7 +5209,7 @@ Index: os2/diff.configure Index: os2/os2.c Date: Wed, 9 Oct 1996 22:29:44 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich /bin/sh is translated to the configured value of location of sh.exe. popen() used even if we can fork (as we do now). @@ -4903,7 +5218,7 @@ Index: os2/os2.c Index: os2/os2ish.h Date: Wed, 9 Oct 1996 22:29:44 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich sys/un.h is not very useful without Merlin toolkit. updates for fork()ing. @@ -4915,7 +5230,7 @@ Index: patchlevel.h Index: perl.c Date: Wed, 9 Oct 1996 19:03:41 +0000 - From: Tim Bunce <Tim.Bunce@ig.co.uk> + From: Tim Bunce Subject: Infinte loop with perl_destruct_level and $SIG{__WARN__} I've just started using purify on a perl with DBD::Oracle linked in @@ -4926,7 +5241,7 @@ Index: perl.c of problems typified by this example and folowed by a core dump: Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Copywrite of OS/2 port now has \n\n. Now deletes -e file (again!) if compilation is interrupted. @@ -5000,7 +5315,7 @@ Index: plan9/versnum Index: pod/perldiag.pod Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich mention that malloc in berkeley DB is broken, and PERL_BADFREE. OS/2-specific messages added. @@ -5008,7 +5323,7 @@ Index: pod/perldiag.pod Index: pod/perlfunc.pod Date: 20 Sep 1996 13:17:14 +0200 - From: Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de> + From: Ulrich Pfeifer Subject: Re: Patch for ASN.1 compressed integer in pack/unpack Index: pod/perli18n.pod @@ -5018,7 +5333,7 @@ Index: pod/perli18n.pod Index: pod/perlop.pod Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Crossrefs corrected. @@ -5030,14 +5345,14 @@ Index: pod/perltrap.pod Index: pod/perlvar.pod Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich $^E under OS/2. Index: pp.c Date: 20 Sep 1996 13:17:14 +0200 - From: Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de> + From: Ulrich Pfeifer Subject: Re: Patch for ASN.1 compressed integer in pack/unpack Index: pp_sys.c @@ -5051,7 +5366,7 @@ Index: pp_sys.c Index: sv.c Date: Tue, 08 Oct 1996 23:54:47 -0400 - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: Re: Sorting lists of integers doesn't always work >> > print sort (4,1,2,3); @@ -5070,7 +5385,7 @@ Index: sv.c Index: t/lib/anydbm.t Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich File mode under OS/2 is not what you expect. However, this has nothing to do with databases, _and_ there is a test @@ -5082,7 +5397,7 @@ Index: t/lib/anydbm.t Index: t/lib/db-btree.t Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich File mode under OS/2 is not what you expect. However, this has nothing to do with databases, _and_ there is a test @@ -5094,7 +5409,7 @@ Index: t/lib/db-btree.t Index: t/lib/db-hash.t Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich File mode under OS/2 is not what you expect. However, this has nothing to do with databases, _and_ there is a test @@ -5106,7 +5421,7 @@ Index: t/lib/db-hash.t Index: t/lib/db-recno.t Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich File mode under OS/2 is not what you expect. However, this has nothing to do with databases, _and_ there is a test @@ -5118,7 +5433,7 @@ Index: t/lib/db-recno.t Index: t/lib/gdbm.t Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich File mode under OS/2 is not what you expect. However, this has nothing to do with databases, _and_ there is a test @@ -5130,7 +5445,7 @@ Index: t/lib/gdbm.t Index: t/lib/io_pipe.t Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Better error message on dying. @@ -5154,7 +5469,7 @@ Index: t/lib/io_taint.t Index: t/lib/ndbm.t Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich File mode under OS/2 is not what you expect. However, this has nothing to do with databases, _and_ there is a test @@ -5166,7 +5481,7 @@ Index: t/lib/ndbm.t Index: t/lib/odbm.t Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich File mode under OS/2 is not what you expect. However, this has nothing to do with databases, _and_ there is a test @@ -5178,7 +5493,7 @@ Index: t/lib/odbm.t Index: t/lib/sdbm.t Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich File mode under OS/2 is not what you expect. However, this has nothing to do with databases, _and_ there is a test @@ -5190,7 +5505,7 @@ Index: t/lib/sdbm.t Index: t/lib/socket.t Date: Thu, 10 Oct 1996 01:09:59 -0400 - From: Spider Boardman <spider@orb.nashua.nh.us> + From: Spider Boardman Subject: Re: 5.003_06 is available (results on ULTRIX) fix t/lib/socket.t to treat TCP like the stream protocol it is @@ -5199,19 +5514,19 @@ Index: t/lib/socket.t Index: t/op/pack.t Date: 20 Sep 1996 13:17:14 +0200 - From: Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de> + From: Ulrich Pfeifer Subject: Re: Patch for ASN.1 compressed integer in pack/unpack Index: t/op/sort.t Date: Wed, 09 Oct 1996 00:41:27 -0400 - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: more t/op/sort.t tests Index: util.c Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich uses my_syspopen, my_syspclose ifdef OS2. my_pclose is defined as my_syspclose ifdef OS2 and can FORK (as OS2 does). @@ -5237,9 +5552,10 @@ Index: x2p/cflags.SH pathname of the file being extracted. ----------------- -Version 5.003_06 ----------------- +------------------ + Version 5.003_06 +------------------ + This patch was primarily to fix bugs, improve the documentation, and work towards restoring binary compatibility with 5.003. The details are described below. A very brief summary is: @@ -5291,7 +5607,7 @@ Here are the specific file-by-file changes. # The full description is below. # Please execute the following commands before applying this patch. # (You can feed this patch to 'sh' to do so.) -# Andy Dougherty <doughera@lafcol.lafayette.edu> +# -- Andy Dougherty # We'll create some new tests, but patch won't automatically make them # executable. @@ -5327,12 +5643,6 @@ designed so you can examine each change with a command such as csplit may complain, since many csplit's have an arbitrary limit of 100 files. Still, you can manually split the file or roll your own.) -Patch and enjoy, - - Andy Dougherty doughera@lafcol.lafayette.edu - Dept. of Physics - Lafayette College, Easton PA 18042 - Index: Changes Updated for 5.003_06. @@ -5353,7 +5663,7 @@ Index: Configure Index: INSTALL Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -5363,7 +5673,7 @@ Index: INSTALL Index: MANIFEST Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -5371,13 +5681,13 @@ Index: MANIFEST out are applied. Date: Sat, 28 Sep 1996 15:11:06 +0200 - From: Andreas Koenig <k@anna.in-berlin.de> + From: Andreas Koenig Subject: Dale's posting as patch (Was: Perl 5.003_5 make fails on NS3.2 - CURED) Handle NeXT, POSIX, and setpgid in pp_sys.c and POSIX. Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -5408,13 +5718,13 @@ Index: configure Index: doio.c Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 Index: doop.c Date: Mon, 30 Sep 1996 01:13:28 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman Subject: Re: pre extending hash? - need speed The patch below (which is relative to perl5.001l) implements @@ -5536,7 +5846,7 @@ Index: ext/NDBM_File/hints/dynixptx.pl Index: ext/Opcode/Opcode.pm Date: Fri, 20 Sep 1996 12:59:21 +0200 - From: Gisle Aas <aas@bergen.sn.no> + From: Gisle Aas Subject: Re: Symbol.pm clobbers $_ at startup The same kind of problem seem to be present in Opcode.pm: @@ -5560,7 +5870,7 @@ Index: ext/Opcode/Safe.pm Index: ext/POSIX/POSIX.pod Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -5570,7 +5880,7 @@ Index: ext/POSIX/POSIX.pod Index: ext/POSIX/POSIX.xs Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -5581,7 +5891,7 @@ Index: ext/POSIX/POSIX.xs Index: ext/POSIX/hints/next_3.pl Date: Sat, 28 Sep 1996 15:11:06 +0200 - From: Andreas Koenig <k@anna.in-berlin.de> + From: Andreas Koenig Subject: Dale's posting as patch (Was: Perl 5.003_5 make fails on NS3.2 - CURED) Handle NeXT, POSIX, and setpgid in pp_sys.c and POSIX. @@ -5606,7 +5916,7 @@ Index: global.sym Provide new 3-arg forms gv_fullname3() and gv_efullname3(). Date: Mon, 30 Sep 1996 01:13:28 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman Subject: Re: pre extending hash? - need speed The patch below (which is relative to perl5.001l) implements @@ -5616,7 +5926,7 @@ Index: global.sym improved. Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -5631,7 +5941,7 @@ Index: gv.c Index: handy.h Date: Sat, 21 Sep 1996 21:33:15 -0400 (EDT) - From: Kenneth Albanowski <kjahds@kjahds.com> + From: Kenneth Albanowski Subject: Full LONG_MAX & co. patch over 5.003_05 This patch contains the changes I've collected for the various _MAX issues @@ -5651,7 +5961,7 @@ Index: hints/next_3.sh the optimizier. Date: Sat, 28 Sep 1996 15:11:06 +0200 - From: Andreas Koenig <k@anna.in-berlin.de> + From: Andreas Koenig Subject: Dale's posting as patch (Was: Perl 5.003_5 make fails on NS3.2 - CURED) Handle NeXT, POSIX, and setpgid in pp_sys.c and POSIX. @@ -5659,7 +5969,7 @@ Index: hints/next_3.sh Index: hv.c Date: Fri, 20 Sep 1996 15:38:57 -0400 - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: Re: "Attempt to free non-existent shared string"? (with patch) I found a subtle problem with the lazydelete mechanism (which is used @@ -5673,7 +5983,7 @@ Index: hv.c flag. Date: Mon, 30 Sep 1996 01:13:28 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman Subject: Re: pre extending hash? - need speed The patch below (which is relative to perl5.001l) implements @@ -5685,7 +5995,7 @@ Index: hv.c Index: hv.h Date: Fri, 20 Sep 1996 15:38:57 -0400 - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: Re: "Attempt to free non-existent shared string"? (with patch) I found a subtle problem with the lazydelete mechanism (which is used @@ -5719,21 +6029,21 @@ Index: installperl Index: lib/AutoLoader.pm Date: Mon Sep 9 09:29:44 1996 - From: Gisle Aas <aas@bergen.sn.no> + From: Gisle Aas Subject: Re: problem with 'die' and UserAgent > This is a patch to the AutoLoader.pm (from 5.003) that fixes the problem: This is a better patch (no need to test for /::DESTROY$/ twice): Date: Mon, 30 Sep 1996 00:54:37 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman The test and patches for AutoLoader were also non-functional, since the regexp context (curpm) was still being clobbered by the filename manipulations: Date: Sun, 06 Oct 1996 16:15:07 +0200 - From: Gisle Aas <aas@bergen.sn.no> + From: Gisle Aas Subject: Re: Can't locate auto/U/autosplit.ix It would IMHO be much better if the AutoLoader exported the AUTOLOAD() @@ -5746,7 +6056,7 @@ Index: lib/AutoLoader.pm Index: lib/Benchmark.pm Date: Sat, 28 Sep 1996 17:01:22 +0300 (EET DST) - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Subject: a really really tiny typo Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST) @@ -5831,7 +6141,7 @@ Index: lib/ExtUtils/MM_VMS.pm 5.003_05 pods, including the pods embedded in library modules. Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 Index: lib/ExtUtils/MakeMaker.pm @@ -5853,7 +6163,7 @@ Index: lib/ExtUtils/Manifest.pm 5.003_05 pods, including the pods embedded in library modules. Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 Index: lib/ExtUtils/Mksymlists.pm @@ -5872,24 +6182,24 @@ Index: lib/ExtUtils/xsubpp Index: lib/File/Basename.pm Date: Fri, 20 Sep 1996 14:11:05 +0200 - From: Gisle Aas <aas@bergen.sn.no> + From: Gisle Aas Subject: File::BaseName: "/" is legal path separator for MSDOS The File::BaseName module should allow "/" as path separator when fileparse_set_fstype("MSDOS") is in effect: Date: Fri, 20 Sep 1996 13:58:52 +0200 - From: Gisle Aas <aas@bergen.sn.no> + From: Gisle Aas Subject: File::Basename documentation patch Date: Mon, 30 Sep 1996 00:54:37 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman For t/lib/basename.t, though, the associated patch for File::Basename was also wrong: Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 Index: lib/File/Copy.pm @@ -5943,7 +6253,7 @@ Index: lib/Getopt/Long.pm Index: lib/I18N/Collate.pm Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -5971,7 +6281,7 @@ Index: lib/IPC/Open3.pm Index: lib/Math/BigInt.pm Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -5999,7 +6309,7 @@ Index: lib/Pod/Text.pm Index: lib/Search/Dict.pm Date: Sat, 21 Sep 1996 23:02:42 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: look() in Search::Dict should use lc() istead of tr/A-Z/a-z/ The Search::Dict look() function should use the lc() function instead @@ -6018,7 +6328,7 @@ Index: lib/SelfLoader.pm Index: lib/Symbol.pm Date: Fri, 20 Sep 1996 12:38:14 +0200 - From: Gisle Aas <aas@bergen.sn.no> + From: Gisle Aas Subject: Symbol.pm clobbers $_ at startup perl -le 'BEGIN {$_="foo";} use Symbol; print qualify($_)' @@ -6046,7 +6356,7 @@ Index: lib/Sys/Hostname.pm Index: lib/Term/Cap.pm Date: 23 Sep 1996 14:11:38 +0200 - From: Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de> + From: Ulrich Pfeifer Subject: Patch for Term::Cap 'use Term::Cap' produces a warning when diagnosics are active. The @@ -6083,13 +6393,13 @@ Index: lib/Test/Harness.pm 5.003_05 pods, including the pods embedded in library modules. Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 Index: lib/Text/Abbrev.pm Date: 23 Sep 1996 11:33:01 +0200 - From: Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de> + From: Ulrich Pfeifer Subject: Text::Abbrev (Re: More standard library test scripts) This patch merges the Text::Abbrev related patches/tests from Gisle @@ -6129,7 +6439,7 @@ Index: lib/UNIVERSAL.pm Index: lib/bigint.pl Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -6157,7 +6467,7 @@ Index: lib/overload.pm Index: lib/perl5db.pl Date: Mon, 30 Sep 1996 00:34:58 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Subject: Re: dereferencing a hash from the debugger won't work Index: lib/splain @@ -6195,14 +6505,14 @@ Index: mg.c Provide new 3-arg forms gv_fullname3() and gv_efullname3(). Date: Sun, 29 Sep 1996 22:18:19 -0400 (EDT) - From: Chip Salzenberg <salzench@nielsenmedia.com> + From: Chip Salzenberg Subject: 5.003_05: Fix numeric value of $! This patch undoes a bit of over-zealous integerization in mg.c, related to the numeric value of $!. Date: Mon, 30 Sep 1996 01:13:28 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman Subject: Re: pre extending hash? - need speed The patch below (which is relative to perl5.001l) implements @@ -6212,11 +6522,11 @@ Index: mg.c improved. Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 Date: Fri, 4 Oct 1996 12:38:31 -0400 (EDT) - From: Chip Salzenberg <salzench@nielsenmedia.com> + From: Chip Salzenberg Subject: 5.003_05: Fix numeric $! and $^E This patch undoes a bit of over-zealous integerization in mg.c, @@ -6231,7 +6541,7 @@ Index: op.c Provide new 3-arg forms gv_fullname3() and gv_efullname3(). Date: Mon, 30 Sep 1996 01:13:28 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman Subject: Re: pre extending hash? - need speed The patch below (which is relative to perl5.001l) implements @@ -6266,26 +6576,26 @@ Index: patchlevel.h Index: perl.c - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Subject: Re: -T flag and removal of `.' from @INC support C<perl -e'attached code'> Date: Tue, 01 Oct 1996 19:02:17 -0400 - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: Re: 2 core dumps (patch) Message-Id: <199610012302.TAA08395@aatma.engin.umich.edu> The problem is an uninitialized SV slot in errgv. Here's a patch. Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 Index: perl.h Date: Sat, 21 Sep 1996 21:33:15 -0400 (EDT) - From: Kenneth Albanowski <kjahds@kjahds.com> + From: Kenneth Albanowski Subject: Full LONG_MAX & co. patch over 5.003_05 This patch contains the changes I've collected for the various _MAX issues @@ -6296,7 +6606,7 @@ Index: perl.h ambiguous) and to explicitly cast all of the constants. Date: Mon, 30 Sep 1996 01:13:28 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman Subject: Re: pre extending hash? - need speed The patch below (which is relative to perl5.001l) implements @@ -6309,7 +6619,7 @@ Index: perl.h 5.003. Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -6335,13 +6645,13 @@ Index: perlsdio.h Undef Irix getc_unlocked and putc_unlocked #defines. Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 Index: pod/Makefile Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -6369,7 +6679,7 @@ Index: pod/perl.pod Changed Larry's address to larry@wall.org. Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -6439,7 +6749,7 @@ Index: pod/perldiag.pod 5.003_05 pods, including the pods embedded in library modules. Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 Index: pod/perldsc.pod @@ -6492,7 +6802,7 @@ Index: pod/perlguts.pod From: "Daniel S. Lewart" <lewart@vadds.cvm.uiuc.edu> Subject: POD spelling patches Date: Mon, 23 Sep 96 13:18:01 PDT - From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com> + From: Jeff Okamoto Subject: Re: perlguts API Listing patch Here's the lastest complete version for inclusion into _06 or .004. This @@ -6508,7 +6818,7 @@ Index: pod/perlguts.pod Index: pod/perli18n.pod Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -6551,7 +6861,7 @@ Index: pod/perlmod.pod 5.003_05 pods, including the pods embedded in library modules. Date: Wed, 02 Oct 1996 16:52:08 -0400 - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Subject: documentation for $? in END Document the behavior with $? WRT END subroutines. @@ -6575,7 +6885,7 @@ Index: pod/perlop.pod 5.003_05 pods, including the pods embedded in library modules. Date: Fri, 4 Oct 1996 10:36:19 -0400 (EDT) - From: Kenneth Albanowski <kjahds@kjahds.com> + From: Kenneth Albanowski Subject: Re: Suggestion for improving man page Add alternative names for various escape sequences. @@ -6607,7 +6917,7 @@ Index: pod/perlre.pod 5.003_05 pods, including the pods embedded in library modules. Date: Fri, 4 Oct 1996 10:36:19 -0400 (EDT) - From: Kenneth Albanowski <kjahds@kjahds.com> + From: Kenneth Albanowski Subject: Re: Suggestion for improving man page Add alternative names for various escape sequences. @@ -6702,7 +7012,7 @@ Index: pod/perltoc.pod Index: pod/perltrap.pod Date: Wed, 11 Sep 1996 13:26:18 -0400 - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: a perl425 trap Here's an addition that should be self-explanatory. @@ -6725,7 +7035,7 @@ Index: pod/perlvar.pod 5.003_05 pods, including the pods embedded in library modules. Date: Wed, 02 Oct 1996 16:52:08 -0400 - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Subject: documentation for $? in END Document the behavior with $? WRT END subroutines. @@ -6789,7 +7099,7 @@ Index: pp_ctl.c Provide new 3-arg forms gv_fullname3() and gv_efullname3(). Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -6854,7 +7164,7 @@ Index: pp_sys.c then closed and re-opened, retained the untaintedness. Date: Mon, 30 Sep 1996 00:54:37 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman First, with IO::untaint, the patches as posted resulted in a miniperl which couldn't open files, so the autosplitting of the @@ -6867,7 +7177,7 @@ Index: proto.h Provide new 3-arg forms gv_fullname3() and gv_efullname3(). Date: Mon, 30 Sep 1996 01:13:28 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman Subject: Re: pre extending hash? - need speed The patch below (which is relative to perl5.001l) implements @@ -6877,7 +7187,7 @@ Index: proto.h improved. Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -6895,7 +7205,7 @@ Index: sv.c Provide new 3-arg forms gv_fullname3() and gv_efullname3(). Date: Mon, 30 Sep 1996 01:13:28 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman Subject: Re: pre extending hash? - need speed The patch below (which is relative to perl5.001l) implements @@ -6905,7 +7215,7 @@ Index: sv.c improved. Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 I've added some DEBUG_Ps to sv.c which give a trace of the @@ -6916,7 +7226,7 @@ Index: sv.c already adds a profile of op usage to its advertised output.) Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -6944,7 +7254,7 @@ Index: sv.h * Add the "untaint" keyword. Date: Fri, 20 Sep 1996 15:38:57 -0400 - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: Re: "Attempt to free non-existent shared string"? (with patch) I found a subtle problem with the lazydelete mechanism (which is used @@ -6960,7 +7270,7 @@ Index: sv.h Index: t/base/term.t Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -6970,7 +7280,7 @@ Index: t/base/term.t Index: t/comp/package.t Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -6980,7 +7290,7 @@ Index: t/comp/package.t Index: t/lib/abbrev.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -6988,7 +7298,7 @@ Index: t/lib/abbrev.t out are applied. Date: 23 Sep 1996 11:33:01 +0200 - From: Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de> + From: Ulrich Pfeifer Subject: Text::Abbrev (Re: More standard library test scripts) This patch merges the Text::Abbrev related patches/tests from Gisle @@ -6997,7 +7307,7 @@ Index: t/lib/abbrev.t Index: t/lib/anydbm.t Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -7007,7 +7317,7 @@ Index: t/lib/anydbm.t Index: t/lib/autoloader.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -7015,7 +7325,7 @@ Index: t/lib/autoloader.t out are applied. Date: Mon, 30 Sep 1996 00:54:37 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman The test and patches for AutoLoader were also non-functional, since the regexp context (curpm) was still being clobbered by the @@ -7024,7 +7334,7 @@ Index: t/lib/autoloader.t Index: t/lib/basename.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -7032,12 +7342,12 @@ Index: t/lib/basename.t out are applied. Date: Mon, 30 Sep 1996 00:54:37 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman Fix the number of tests. Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 A different set of tests for File::Basename and friends. @@ -7045,7 +7355,7 @@ Index: t/lib/basename.t Index: t/lib/checktree.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -7064,7 +7374,7 @@ Index: t/lib/complex.t Index: t/lib/db-btree.t Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -7074,7 +7384,7 @@ Index: t/lib/db-btree.t Index: t/lib/db-hash.t Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -7084,7 +7394,7 @@ Index: t/lib/db-hash.t Index: t/lib/env.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -7094,7 +7404,7 @@ Index: t/lib/env.t Index: t/lib/fatal.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -7104,7 +7414,7 @@ Index: t/lib/fatal.t Index: t/lib/filecache.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -7114,7 +7424,7 @@ Index: t/lib/filecache.t Index: t/lib/filecopy.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -7124,7 +7434,7 @@ Index: t/lib/filecopy.t Index: t/lib/filefind.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -7134,7 +7444,7 @@ Index: t/lib/filefind.t Index: t/lib/filepath.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -7144,7 +7454,7 @@ Index: t/lib/filepath.t Index: t/lib/findbin.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -7154,7 +7464,7 @@ Index: t/lib/findbin.t Index: t/lib/gdbm.t Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -7164,7 +7474,7 @@ Index: t/lib/gdbm.t Index: t/lib/getopt.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -7174,7 +7484,7 @@ Index: t/lib/getopt.t Index: t/lib/hostname.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -7184,7 +7494,7 @@ Index: t/lib/hostname.t Index: t/lib/ndbm.t Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -7194,7 +7504,7 @@ Index: t/lib/ndbm.t Index: t/lib/odbm.t Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -7204,7 +7514,7 @@ Index: t/lib/odbm.t Index: t/lib/parsewords.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -7214,7 +7524,7 @@ Index: t/lib/parsewords.t Index: t/lib/sdbm.t Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -7224,7 +7534,7 @@ Index: t/lib/sdbm.t Index: t/lib/searchdict.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -7234,7 +7544,7 @@ Index: t/lib/searchdict.t Index: t/lib/selectsaver.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -7244,7 +7554,7 @@ Index: t/lib/selectsaver.t Index: t/lib/symbol.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -7252,7 +7562,7 @@ Index: t/lib/symbol.t out are applied. Date: Mon, 30 Sep 1996 00:54:37 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman The various new lib/*.t tests didn't all work. For some, it was only because the count of tests was wrong: @@ -7260,7 +7570,7 @@ Index: t/lib/symbol.t Index: t/lib/texttabs.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -7270,7 +7580,7 @@ Index: t/lib/texttabs.t Index: t/lib/textwrap.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -7280,7 +7590,7 @@ Index: t/lib/textwrap.t Index: t/lib/timelocal.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -7290,7 +7600,7 @@ Index: t/lib/timelocal.t Index: t/op/each.t Date: Mon, 30 Sep 1996 01:13:28 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman Subject: Re: pre extending hash? - need speed The patch below (which is relative to perl5.001l) implements @@ -7300,7 +7610,7 @@ Index: t/op/each.t improved. Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -7310,7 +7620,7 @@ Index: t/op/each.t Index: t/op/glob.t Date: Tue, 01 Oct 1996 16:37:03 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: Re: glob test 1 failing...bad test or bug Under AIX 4.1.4, with LOCALE set en_GB (British english) glob test one @@ -7322,7 +7632,7 @@ Index: t/op/glob.t Index: t/op/magic.t Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -7330,7 +7640,7 @@ Index: t/op/magic.t Index: t/op/readdir.t Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -7340,7 +7650,7 @@ Index: t/op/readdir.t Index: t/op/sort.t Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -7350,7 +7660,7 @@ Index: t/op/sort.t Index: toke.c Date: Sat, 14 Sep 1996 17:08:16 -0400 - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: whitespace induced lexer errors (with patch) I finally got around to fixing skipspace() to not indiscriminately @@ -7358,7 +7668,7 @@ Index: toke.c expectation decisions in the lexer). Date: Sat, 14 Sep 1996 18:55:16 -0400 - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: perl lexer won't accept C<my($a,$b);$a<=>$b;> Date: Thu, 19 Sep 1996 11:58:22 -0400 @@ -7382,7 +7692,7 @@ Index: toke.c Index: util.c Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -7438,7 +7748,7 @@ Index: utils/h2xs.PL Index: utils/perldoc.PL Date: Sun, 29 Sep 1996 22:00:09 -0400 (EDT) - From: Kenneth Albanowski <kjahds@kjahds.com> + From: Kenneth Albanowski Subject: perldoc patch Ilya has found that this change makes perldoc much more useful under OS/2. @@ -7446,31 +7756,31 @@ Index: utils/perldoc.PL Index: vms/config.vms Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 Index: vms/descrip.mms Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 Index: vms/genconfig.pl Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 Index: vms/perlvms.pod Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 Index: vms/vms.c Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 Index: x2p/a2p.pod @@ -7490,9 +7800,10 @@ Index: x2p/s2p.PL This patch just changed the old s2p.man page into a pod page. I then embedded the pod into the s2p script. ----------------- -Version 5.003_05 ----------------- + +------------------ + Version 5.003_05 +------------------ This patch was primarily to fix bugs and to clean up some of the remaining issues from in 5.003_04. The details are described below. @@ -7545,7 +7856,7 @@ Here are the specific file-by-file changes. # The full description is below. # Please execute the following commands before applying this patch. # (You can feed this patch to 'sh' to do so.) -# Andy Dougherty <doughera@lafcol.lafayette.edu> +# -- Andy Dougherty # We'll create a new test, but patch won't automatically make it # executable. @@ -7568,12 +7879,6 @@ designed so you can examine each change with a command such as csplit -k perl5.003_05.pat '/^Index:/' '{99}' -Patch and enjoy, - - Andy Dougherty doughera@lafcol.lafayette.edu - Dept. of Physics - Lafayette College, Easton PA 18042 - Index: Changes Updated for 5.003_05. @@ -7643,7 +7948,7 @@ Index: av.h Subject: turbidity in av.[ch] Date: Sun, 10 Dec 1995 00:21:31 -0500 - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Some unclean code that I noticed today. @@ -7660,7 +7965,7 @@ Index: config_h.SH Index: emacs/cperl-mode.el - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Subject: Newer CPerl-mode Index: ext/DB_File/DB_File.pm @@ -7674,14 +7979,14 @@ Index: ext/DB_File/DB_File.xs Index: ext/Fcntl/Fcntl.pm Date: Thu, 5 Sep 1996 18:19:14 -0400 (EDT) - From: Chip Salzenberg <salzench@nielsenmedia.com> + From: Chip Salzenberg Subject: No AutoLoader for Fcntl Just like Socket, Fcntl doesn't need splitting and AutoLoading. Index: ext/FileHandle/FileHandle.pm - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Subject: FileHandle::DESTROY for fd 0 This fixes FileHandle::DESTROY when called on stdin. @@ -7702,7 +8007,7 @@ Index: ext/ODBM_File/hints/ultrix.pl Index: ext/Socket/Socket.pm Date: Thu, 5 Sep 1996 09:58:08 +0200 - From: Andreas Koenig <k@anna.in-berlin.de> + From: Andreas Koenig Subject: Patch to inhibit autosplit on Socket.pm This patch inhibits production and use of a completely useless @@ -7742,14 +8047,14 @@ Index: hints/sunos_4_1.sh Index: hv.c Date: Thu, 05 Sep 1996 00:25:28 -0400 - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: minor misc. cleanup This patch makes some minor cleanups to the sources. No change in functionality whatsoever. Date: Thu, 05 Sep 1996 02:52:21 -0400 - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: debugger problems--another patch (was Re: 5.003_04) @@ -7855,7 +8160,7 @@ Index: lib/open3.pl Index: lib/syslog.pl Date: Tue, 03 Sep 1996 20:33:54 -0400 - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Subject: syslog.pl `use Socket' lossage syslog.pl tries but fails to use @@ -7883,7 +8188,7 @@ Index: mg.c (lines near 584) Part of VMS changes. I don't know what this did. Date: Fri, 23 Aug 1996 17:20:22 -0400 (EDT) - From: Chip Salzenberg <salzench@nielsenmedia.com> + From: Chip Salzenberg Subject: Integerize mg.c; eliminate warning on C< local($)) > This patch converts magic variables ($!, $^E, etc.) to use integers @@ -7904,7 +8209,7 @@ Index: nostdio.h Index: op.c - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: Re: \ ( @array ) busted for lexical @array (once more) Index: patchlevel.h @@ -7968,7 +8273,7 @@ Index: pod/perlipc.pod Index: pod/perlref.pod - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: Re: \ ( @array ) busted for lexical @array (once more) Index: pod/perltie.pod @@ -8004,14 +8309,14 @@ Index: pod/perlvar.pod Index: pp.c Date: Fri, 23 Aug 1996 17:22:40 -0400 (EDT) - From: Chip Salzenberg <salzench@nielsenmedia.com> + From: Chip Salzenberg Subject: Minor integer speedups in mathematics This patch provides minor speedups by using integer math and SVt_IV values when performing bitwise operations and modulus. Date: Tue, 3 Sep 1996 17:49:22 -0400 (EDT) - From: Kenneth Albanowski <kjahds@kjahds.com> + From: Kenneth Albanowski Subject: Pack Patch (was Re: 5.002 - pack/unpack does not do "I" right) (double)auint cast added for call to sv_setnv(). @@ -8019,7 +8324,7 @@ Index: pp.c Index: pp_hot.c Date: Thu, 05 Sep 1996 00:25:28 -0400 - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: minor misc. cleanup This patch makes some minor cleanups to the sources. No change @@ -8049,7 +8354,7 @@ Index: sv.c Perl_debug_log instead. Date: Fri, 23 Aug 1996 17:26:42 -0400 (EDT) - From: Chip Salzenberg <salzench@nielsenmedia.com> + From: Chip Salzenberg Subject: Minor potential bug in AV creation I wasn't the one who originated this patch. But it looks like it @@ -8107,18 +8412,18 @@ Index: t/op/misc.t Index: t/op/pack.t Date: Tue, 3 Sep 1996 17:49:22 -0400 (EDT) - From: Kenneth Albanowski <kjahds@kjahds.com> + From: Kenneth Albanowski Subject: Pack Patch (was Re: 5.002 - pack/unpack does not do "I" right) Index: t/op/ref.t - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: Re: \ ( @array ) busted for lexical @array (once more) Index: universal.c Date: Thu, 29 Aug 96 07:05:10 BST - From: Graham Barr <bodg@tiuk.ti.com> + From: Graham Barr Subject: Re: UNIVERSAL::class busted yes, but I also noticed that this does not check that the reference @@ -8137,7 +8442,7 @@ Index: util.c Index: utils/h2xs.PL Date: Fri, 6 Sep 1996 06:09:20 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Subject: updated h2xs Changes: @@ -8206,9 +8511,10 @@ Index: vms/vmsish.h VMS 5.003_05 Update. ----------------- -Version 5.003_04 ----------------- + +------------------ + Version 5.003_04 +------------------ This patch was primarily to fix bugs and to clean up some of the changes made in 5.003_03. The details are described below. @@ -8247,7 +8553,7 @@ Here are the specific file-by-file changes. # The full description is below. # Please execute the following commands before applying this patch. # (You can feed this patch to 'sh' to do so.) -# Andy Dougherty <doughera@lafcol.lafayette.edu> +# -- Andy Dougherty # Obsolete perl4 hint file. rm -f hints/dnix.sh @@ -8275,13 +8581,6 @@ designed so you can examine each change with a command such as csplit -k perl5.003_04.pat '/^Index:/' '{99}' -Patch and enjoy, - - Andy Dougherty doughera@lafcol.lafayette.edu - Dept. of Physics - Lafayette College, Easton PA 18042 - - Index: Changes Updated for 5.003_04. @@ -8342,8 +8641,7 @@ Index: config_h.SH The /*#define FOO /**/ is a perfectly legal un-nested comment, and I wish IBM would fix it's blasted compiler instead. In the meantime we'll take mercy on the poor AIX user and get rid of the screenfulls - of stupid warning messages. Thanks to Hallvard B Furuseth - <h.b.furuseth@usit.uio.no> for the fix. + of stupid warning messages. Thanks to Hallvard B Furuseth for the fix. Index: dump.c @@ -8646,7 +8944,7 @@ Index: sv.c reduce code size and improve maintainability by combining some common code in gv_fullname() and gv_efullname(). - From: Chip Salzenberg <salzench@nielsenmedia.com> + From: Chip Salzenberg Subject: Track SVs for destruction when -DPURIFY When checking for memory leaks, I compiled Perl with "-DPURIFY". @@ -8738,9 +9036,10 @@ Index: utils/perldoc.PL HP-UX nroff -man output. (col -x isn't portable -- SunOS doesn't support the -x option.) ----------------- -Version 5.003_03 ----------------- + +------------------ + Version 5.003_03 +------------------ Most of the changes in 5.003_03 are to make the build and installation process more robust. The details are described below. A very brief @@ -8775,7 +9074,7 @@ Here are the specific file-by-file changes. # The full description is below. # Please execute the following commands before applying this patch. # (You can feed this patch to 'sh' to do so.) -# Andy Dougherty <doughera@lafcol.lafayette.edu> +# -- Andy Dougherty # Absorbed into Changes5.002 rm -f Changes.Conf @@ -8814,12 +9113,6 @@ designed so you can examine each change with a command such as csplit -k perl5.003_03.pat '/^Index:/' '{99}' -Patch and enjoy, - - Andy Dougherty doughera@lafcol.lafayette.edu - Dept. of Physics - Lafayette College, Easton PA 18042 - Index: Changes Include 5.003_03 change notes. @@ -9355,9 +9648,11 @@ Index: x2p/str.c Use Configure's FILE_filbuf macro instead of a raw _filbuf. ----------------- -Version 5.003_02 ----------------- + +------------------ + Version 5.003_02 +------------------ + o Visible Changes to Core Functionality - Redefining constant subs, or changing sub's prototype now give warnings. - Fixes for ++/-- of values close to max/min size of an integer @@ -9397,9 +9692,10 @@ o Changes in OS-specific and Build-time Support - Applied OS/2 patches. - Typo patch for VMS. ----------------- -Version 5.003_01 ----------------- + +------------------ + Version 5.003_01 +------------------ Version 5.003_01 contains bugfixes and additions accumulated since version 5.002_01, since the patch to version 5.003 was deliberately @@ -23,10 +23,24 @@ # define EXTCONST globalref # define dEXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly #else -# define EXT extern -# define dEXT -# define EXTCONST extern const -# define dEXTCONST const +# if defined(_MSC_VER) && defined(_WIN32) +# ifdef PERLDLL +# define EXT __declspec(dllexport) +# define dEXT +# define EXTCONST __declspec(dllexport) const +# define dEXTCONST const +# else +# define EXT __declspec(dllimport) +# define dEXT +# define EXTCONST __declspec(dllimport) const +# define dEXTCONST const +# endif +# else +# define EXT extern +# define dEXT +# define EXTCONST extern const +# define dEXTCONST const +# endif #endif #undef INIT @@ -40,6 +40,24 @@ dosish.h Some defines for MS/DOSish machines dump.c Debugging output eg/ADB An adb wrapper to put in your crash dir eg/README Intro to example perl scripts +eg/cgi/RunMeFirst Setup script for CGI examples +eg/cgi/clickable_image.cgi CGI example +eg/cgi/cookie.cgi CGI example +eg/cgi/crash.cgi CGI example +eg/cgi/customize.cgi CGI example +eg/cgi/diff_upload.cgi CGI example +eg/cgi/file_upload.cgi CGI example +eg/cgi/frameset.cgi CGI example +eg/cgi/index.html Index page for CGI examples +eg/cgi/internal_links.cgi CGI example +eg/cgi/javascript.cgi CGI example +eg/cgi/monty.cgi CGI example +eg/cgi/multiple_forms.cgi CGI example +eg/cgi/nph-clock.cgi CGI example +eg/cgi/popup.cgi CGI example +eg/cgi/save_state.cgi CGI example +eg/cgi/tryit.cgi CGI example +eg/cgi/wilogo.gif.uu Small image for CGI examples eg/changes A program to list recently changed files eg/client A sample client eg/down A program to do things to subdirectories @@ -272,6 +290,7 @@ hints/utekv.sh Hints for named architecture hints/uts.sh Hints for named architecture hv.c Hash value code hv.h Hash value header +installhtml Perl script to install html files for pods installman Perl script to install man pages for pods installperl Perl script to do "make install" dirty work interp.sym Interpreter specific symbols to hide in a struct @@ -282,6 +301,12 @@ lib/AutoLoader.pm Autoloader base class lib/AutoSplit.pm Split up autoload functions lib/Benchmark.pm Measure execution time lib/Bundle/CPAN.pm The CPAN bundle +lib/CGI.pm Web server interface +lib/CGI/Apache.pm Web server interface +lib/CGI/Carp.pm Web server interface +lib/CGI/Fast.pm Web server interface +lib/CGI/Push.pm Web server interface +lib/CGI/Switch.pm Web server interface lib/CPAN.pm Interface to Comprehensive Perl Archive Network lib/CPAN/FirstTime.pm Utility for creating CPAN config files lib/CPAN/Nox.pm Runs CPAN while avoiding compiled extensions @@ -332,6 +357,7 @@ lib/Net/netent.pm By-name interface to Perl's built-in getnet* lib/Net/protoent.pm By-name interface to Perl's built-in getproto* lib/Net/servent.pm By-name interface to Perl's built-in getserv* lib/Pod/Functions.pm used by pod/splitpod +lib/Pod/Html.pm Convert POD data to HTML lib/Pod/Text.pm Convert POD data to formatted ASCII text lib/Search/Dict.pm Perform binary search on dictionaries lib/SelectSaver.pm Enforce proper select scoping @@ -368,9 +394,8 @@ lib/bigint.pl An arbitrary precision integer arithmetic package lib/bigrat.pl An arbitrary precision rational arithmetic package lib/blib.pm For "use blib" lib/cacheout.pl Manages output filehandles when you need too many -lib/chat2.inter A chat2 with interaction -lib/chat2.pl Randal's famous expect-ish routines lib/complete.pl A command completion subroutine +lib/constant.pm For "use constant" lib/ctime.pl A ctime workalike lib/diagnostics.pm Print verbose diagnostics lib/dotsh.pl Code to "dot" in a shell script @@ -652,6 +677,7 @@ t/lib/texttabs.t See if Text::Tabs works t/lib/textwrap.t See if Text::Wrap works t/lib/timelocal.t See if Time::Local works t/op/append.t See if . works +t/op/arith.t See if arithmetic works t/op/array.t See if array operations work t/op/assignwarn.t See if OP= operators warn correctly for undef targets t/op/auto.t See if autoincrement et all work @@ -716,6 +742,7 @@ t/op/universal.t See if UNIVERSAL class works t/op/unshift.t See if unshift works t/op/vec.t See if vectors work t/op/write.t See if write works +t/pragma/constant.t See if compile-time constants work t/pragma/locale.t See if locale support (i18n and l10n) works t/pragma/overload.t See if operator overloading works t/pragma/strict-refs Tests of "use strict 'refs'" for strict.t @@ -792,8 +819,8 @@ win32/VC-2.0/perl.mak Win32 port win32/VC-2.0/perldll.mak Win32 port win32/VC-2.0/perlglob.mak Win32 port win32/autosplit.pl Win32 port -win32/bin/PL2BAT.BAT Win32 port win32/bin/network.pl Win32 port +win32/bin/pl2bat.bat Win32 port win32/bin/search.bat Win32 port win32/bin/test.bat Win32 port win32/bin/webget.bat Win32 port @@ -814,6 +841,7 @@ win32/makeperldef.pl Win32 port win32/miniperl.mak Win32 port win32/modules.mak Win32 port win32/perl.mak Win32 port +win32/perl.rc Win32 port win32/perldll.mak Win32 port win32/perlglob.c Win32 port win32/perlglob.mak Win32 port @@ -70,8 +70,8 @@ print CONFIG "\n", print CONFIG "my \$summary = <<'!END!';\n"; open(MYCONFIG,"<myconfig") || die "open myconfig failed: $!"; -1 while( ($_=<MYCONFIG>) !~ /^Summary of/); -do { print CONFIG $_ } until ($_ = <MYCONFIG>) =~ /^\s*$/; +1 while defined($_ = <MYCONFIG>) && !/^Summary of/; +do { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/; close(MYCONFIG); print CONFIG "\n!END!\n", <<'EOT'; @@ -265,9 +265,10 @@ struct context { /* "gimme" values */ #define G_SCALAR 0 #define G_ARRAY 1 +#define G_VOID 128 /* skip this bit when adding flags below */ /* extra flags for perl_call_* routines */ #define G_DISCARD 2 /* Call FREETMPS. */ #define G_EVAL 4 /* Assume eval {} around subroutine call. */ #define G_NOARGS 8 /* Don't construct a @_ array. */ -#define G_KEEPERR 16 /* Append errors to $@ rather than overwriting it */ +#define G_KEEPERR 16 /* Append errors to $@, don't overwrite it */ @@ -649,6 +649,7 @@ dARGS HV *hv = (HV*)POPs; register HE *entry; SV *tmpstr; + I32 gimme = GIMME_V; I32 dokeys = (op->op_type == OP_KEYS); I32 dovalues = (op->op_type == OP_VALUES); @@ -667,10 +668,10 @@ dARGS (void)hv_iterinit(hv); /* always reset iterator regardless */ - if (op->op_private & OPpLEAVE_VOID) + if (gimme == G_VOID) RETURN; - if (GIMME != G_ARRAY) { + if (gimme == G_SCALAR) { I32 i; dTARGET; @@ -131,14 +131,20 @@ register OP *op; #endif if (op->op_flags) { *buf = '\0'; - if (op->op_flags & OPf_KNOW) { - if (op->op_flags & OPf_LIST) - (void)strcat(buf,"LIST,"); - else - (void)strcat(buf,"SCALAR,"); - } - else + switch (op->op_flags & OPf_WANT) { + case OPf_WANT_VOID: + (void)strcat(buf,"VOID,"); + break; + case OPf_WANT_SCALAR: + (void)strcat(buf,"SCALAR,"); + break; + case OPf_WANT_LIST: + (void)strcat(buf,"LIST,"); + break; + default: (void)strcat(buf,"UNKNOWN,"); + break; + } if (op->op_flags & OPf_KIDS) (void)strcat(buf,"KIDS,"); if (op->op_flags & OPf_PARENS) diff --git a/eg/cgi/RunMeFirst b/eg/cgi/RunMeFirst new file mode 100644 index 0000000000..c96d79eb62 --- /dev/null +++ b/eg/cgi/RunMeFirst @@ -0,0 +1,29 @@ +#!/usr/local/bin/perl + +# Make a world-writeable directory for saving state. +$ww = 'WORLD_WRITABLE'; +unless (-w $ww) { + $u = umask 0; + mkdir $ww, 0777; + umask $u; +} + +# Decode the sample image. +for $bin (qw(wilogo.gif)) { + unless (open UU, "$bin.uu") { warn "Can't open $bin.uu: $!\n"; next } + unless (open BIN, "> $bin") { warn "Can't create $bin: $!\n"; next } + $_ = <UU>; + while (<UU>) { + chomp; + last if /^end/; + print BIN unpack "u", $_; + } + close BIN; + close UU; +} + +# Create symlinks from *.txt to *.cgi for documentation purposes. +foreach (<*.cgi>) { + ($target = $_) =~ s/cgi$/txt/; + symlink $_, $target unless -e $target; +} diff --git a/eg/cgi/clickable_image.cgi b/eg/cgi/clickable_image.cgi new file mode 100644 index 0000000000..81daf09690 --- /dev/null +++ b/eg/cgi/clickable_image.cgi @@ -0,0 +1,26 @@ +#!/usr/local/bin/perl + +use CGI; +$query = new CGI; +print $query->header; +print $query->start_html("A Clickable Image"); +print <<END; +<H1>A Clickable Image</H1> +</A> +END +print "Sorry, this isn't very exciting!\n"; + +print $query->startform; +print $query->image_button('picture',"./wilogo.gif"); +print "Give me a: ",$query->popup_menu('letter',['A','B','C','D','E','W']),"\n"; # +print "<P>Magnification: ",$query->radio_group('magnification',['1X','2X','4X','20X']),"\n"; +print "<HR>\n"; + +if ($query->param) { + print "<P>Magnification, <EM>",$query->param('magnification'),"</EM>\n"; + print "<P>Selected Letter, <EM>",$query->param('letter'),"</EM>\n"; + ($x,$y) = ($query->param('picture.x'),$query->param('picture.y')); + print "<P>Selected Position <EM>($x,$y)</EM>\n"; +} + +print $query->end_html; diff --git a/eg/cgi/cookie.cgi b/eg/cgi/cookie.cgi new file mode 100644 index 0000000000..98adda196e --- /dev/null +++ b/eg/cgi/cookie.cgi @@ -0,0 +1,88 @@ +#!/usr/local/bin/perl + +use CGI qw(:standard); + +@ANIMALS=sort qw/lion tiger bear pig porcupine ferret zebra gnu ostrich + emu moa goat weasel yak chicken sheep hyena dodo lounge-lizard + squirrel rat mouse hedgehog racoon baboon kangaroo hippopotamus + giraffe/; + +# Recover the previous animals from the magic cookie. +# The cookie has been formatted as an associative array +# mapping animal name to the number of animals. +%zoo = cookie('animals'); + +# Recover the new animal(s) from the parameter 'new_animal' +@new = param('new_animals'); + +# If the action is 'add', then add new animals to the zoo. Otherwise +# delete them. +foreach (@new) { + if (param('action') eq 'Add') { + $zoo{$_}++; + } elsif (param('action') eq 'Delete') { + $zoo{$_}-- if $zoo{$_}; + delete $zoo{$_} unless $zoo{$_}; + } +} + +# Add new animals to old, and put them in a cookie +$the_cookie = cookie(-name=>'animals', + -value=>\%zoo, + -expires=>'+1h'); + +# Print the header, incorporating the cookie and the expiration date... +print header(-cookie=>$the_cookie); + +# Now we're ready to create our HTML page. +print start_html('Animal crackers'); + +print <<EOF; +<h1>Animal Crackers</h1> +Choose the animals you want to add to the zoo, and click "add". +Come back to this page any time within the next hour and the list of +animals in the zoo will be resurrected. You can even quit Netscape +completely! +<p> +Try adding the same animal several times to the list. Does this +remind you vaguely of a shopping cart? +<p> +<em>This script only works with Netscape browsers</em> +<p> +<center> +<table border> +<tr><th>Add/Delete<th>Current Contents +EOF + ; + +print "<tr><td>",start_form; +print scrolling_list(-name=>'new_animals', + -values=>[@ANIMALS], + -multiple=>1, + -override=>1, + -size=>10),"<br>"; +print submit(-name=>'action',-value=>'Delete'), + submit(-name=>'action',-value=>'Add'); +print end_form; + +print "<td>"; +if (%zoo) { # make a table + print "<ul>\n"; + foreach (sort keys %zoo) { + print "<li>$zoo{$_} $_\n"; + } + print "</ul>\n"; +} else { + print "<strong>The zoo is empty.</strong>\n"; +} +print "</table></center>"; + +print <<EOF; +<hr> +<ADDRESS>Lincoln D. Stein</ADDRESS><BR> +<A HREF="./">More Examples</A> +EOF + ; +print end_html; + + diff --git a/eg/cgi/crash.cgi b/eg/cgi/crash.cgi new file mode 100644 index 0000000000..64f03c7b3d --- /dev/null +++ b/eg/cgi/crash.cgi @@ -0,0 +1,6 @@ +#!/usr/local/bin/perl + +use CGI::Carp qw(fatalsToBrowser); + +# This line invokes a fatal error message at compile time. +foo bar baz; diff --git a/eg/cgi/customize.cgi b/eg/cgi/customize.cgi new file mode 100644 index 0000000000..d932f4ba23 --- /dev/null +++ b/eg/cgi/customize.cgi @@ -0,0 +1,92 @@ +#!/usr/local/bin/perl + +use CGI qw(:standard :html3); + +# Some constants to use in our form. +@colors=qw/aqua black blue fuschia gray green lime maroon navy olive + purple red silver teal white yellow/; +@sizes=("<default>",1..7); + +# recover the "preferences" cookie. +%preferences = cookie('preferences'); + +# If the user wants to change the background color or her +# name, they will appear among our CGI parameters. +foreach ('text','background','name','size') { + $preferences{$_} = param($_) || $preferences{$_}; +} + +# Set some defaults +$preferences{'background'} = $preferences{'background'} || 'silver'; +$preferences{'text'} = $preferences{'text'} || 'black'; + +# Refresh the cookie so that it doesn't expire. This also +# makes any changes the user made permanent. +$the_cookie = cookie(-name=>'preferences', + -value=>\%preferences, + -expires=>'+30d'); +print header(-cookie=>$the_cookie); + +# Adjust the title to incorporate the user's name, if provided. +$title = $preferences{'name'} ? + "Welcome back, $preferences{name}!" : "Customizable Page"; + +# Create the HTML page. We use several of Netscape's +# extended tags to control the background color and the +# font size. It's safe to use Netscape features here because +# cookies don't work anywhere else anyway. +print start_html(-title=>$title, + -bgcolor=>$preferences{'background'}, + -text=>$preferences{'text'} + ); + +print basefont({SIZE=>$preferences{size}}) if $preferences{'size'} > 0; + +print h1($title),<<END; +You can change the appearance of this page by submitting +the fill-out form below. If you return to this page any time +within 30 days, your preferences will be restored. +END + ; + +# Create the form +print hr(), + start_form, + + "Your first name: ", + textfield(-name=>'name', + -default=>$preferences{'name'}, + -size=>30),br, + + table( + TR( + td("Preferred"), + td("Page color:"), + td(popup_menu(-name=>'background', + -values=>\@colors, + -default=>$preferences{'background'}) + ), + ), + TR( + td(''), + td("Text color:"), + td(popup_menu(-name=>'text', + -values=>\@colors, + -default=>$preferences{'text'}) + ) + ), + TR( + td(''), + td("Font size:"), + td(popup_menu(-name=>'size', + -values=>\@sizes, + -default=>$preferences{'size'}) + ) + ) + ), + + submit(-label=>'Set preferences'), + hr; + +print a({HREF=>"/"},'Go to the home page'); + diff --git a/eg/cgi/diff_upload.cgi b/eg/cgi/diff_upload.cgi new file mode 100644 index 0000000000..913f9ca179 --- /dev/null +++ b/eg/cgi/diff_upload.cgi @@ -0,0 +1,68 @@ +#!/usr/local/bin/perl + +$DIFF = "/usr/bin/diff"; +$PERL = "/usr/bin/perl"; + +use CGI qw(:standard); +use CGI::Carp; + +print header; +print start_html("File Diff Example"); +print "<strong>Version </strong>$CGI::VERSION<p>"; + +print <<EOF; +<H1>File Diff Example</H1> +Enter two files. When you press "submit" their diff will be +produced. +EOF + ; + +# Start a multipart form. +print start_multipart_form; +print "File #1:",filefield(-name=>'file1',-size=>45),"<BR>\n"; +print "File #2:",filefield(-name=>'file2',-size=>45),"<BR>\n"; +print "Diff type: ",radio_group(-name=>'type', + -value=>['context','normal']),"<br>\n"; +print reset,submit(-name=>'submit',-value=>'Do Diff'); +print endform; + +# Process the form if there is a file name entered +$file1 = param('file1'); +$file2 = param('file2'); + +$|=1; # for buffering +if ($file1 && $file2) { + $realfile1 = tmpFileName($file1); + $realfile2 = tmpFileName($file2); + print "<HR>\n"; + print "<H2>$file1 vs $file2</H2>\n"; + + print "<PRE>\n"; + $options = "-c" if param('type') eq 'context'; + system "$DIFF $options $realfile1 $realfile2 | $PERL -pe 's/>/>/g; s/</</g;'"; + close $file1; + close $file2; + print "</PRE>\n"; +} + +print <<EOF; +<HR> +<A HREF="../cgi_docs.html">CGI documentation</A> +<HR> +<ADDRESS> +<A HREF="/~lstein">Lincoln D. Stein</A> +</ADDRESS><BR> +Last modified 17 July 1996 +EOF + ; +print end_html; + +sub sanitize { + my $name = shift; + my($safe) = $name=~/([a-zA-Z0-9._~#,]+)/; + unless ($safe) { + print "<strong>$name is not a valid Unix filename -- sorry</strong>"; + exit 0; + } + return $safe; +} diff --git a/eg/cgi/file_upload.cgi b/eg/cgi/file_upload.cgi new file mode 100644 index 0000000000..1f9eaec332 --- /dev/null +++ b/eg/cgi/file_upload.cgi @@ -0,0 +1,63 @@ +#!/usr/local/bin/perl + +use CGI qw(:standard); +use CGI::Carp; + +print header(); +print start_html("File Upload Example"); +print strong("Version "),$CGI::VERSION,p; + +print h1("File Upload Example"), + 'This example demonstrates how to prompt the remote user to + select a remote file for uploading. ', + strong("This feature only works with Netscape 2.0 browsers."), + p, + 'Select the ',cite('browser'),' button to choose a text file + to upload. When you press the submit button, this script + will count the number of lines, words, and characters in + the file.'; + +@types = ('count lines','count words','count characters'); + +# Start a multipart form. +print start_multipart_form(), + "Enter the file to process:", + filefield('filename','',45), + br, + checkbox_group('count',\@types,\@types), + p, + reset,submit('submit','Process File'), + endform; + +# Process the form if there is a file name entered +if ($file = param('filename')) { + $tmpfile=tmpFileName($file); + print hr(), + h2($file), + h3($tmpfile); + my($lines,$words,$characters,@words) = (0,0,0,0); + while (<$file>) { + $lines++; + $words += @words=split(/\s+/); + $characters += length($_); + } + close $file; + grep($stats{$_}++,param('count')); + if (%stats) { + print strong("Lines: "),$lines,br if $stats{'count lines'}; + print strong("Words: "),$words,br if $stats{'count words'}; + print strong("Characters: "),$characters,br if $stats{'count characters'}; + } else { + print strong("No statistics selected."); + } +} + +print hr(), + a({href=>"../cgi_docs.html"},"CGI documentation"), + hr, + address( + a({href=>'/~lstein'},"Lincoln D. Stein")), + br, + 'Last modified July 17, 1996', + end_html; + diff --git a/eg/cgi/frameset.cgi b/eg/cgi/frameset.cgi new file mode 100644 index 0000000000..ff730268e9 --- /dev/null +++ b/eg/cgi/frameset.cgi @@ -0,0 +1,81 @@ +#!/usr/local/bin/perl + +use CGI; +$query = new CGI; +print $query->header; +$TITLE="Frameset Example"; + +# We use the path information to distinguish between calls +# to the script to: +# (1) create the frameset +# (2) create the query form +# (3) create the query response + +$path_info = $query->path_info; + +# If no path information is provided, then we create +# a side-by-side frame set +if (!$path_info) { + &print_frameset; + exit 0; +} + +# If we get here, then we either create the query form +# or we create the response. +&print_html_header; +&print_query if $path_info=~/query/; +&print_response if $path_info=~/response/; +&print_end; + + +# Create the frameset +sub print_frameset { + $script_name = $query->script_name; + print <<EOF; +<html><head><title>$TITLE</title></head> +<frameset cols="50,50"> +<frame src="$script_name/query" name="query"> +<frame src="$script_name/response" name="response"> +</frameset> +EOF + ; + exit 0; +} + +sub print_html_header { + print $query->start_html($TITLE); +} + +sub print_end { + print qq{<P><hr><A HREF="cgi_docs.html">Go to the documentation</A>}; + print $query->end_html; +} + +sub print_query { + $script_name = $query->script_name; + print "<H1>Frameset Query</H1>\n"; + print $query->startform(-action=>"$script_name/response",-TARGET=>"response"); + print "What's your name? ",$query->textfield('name'); + print "<P>What's the combination?<P>", + $query->checkbox_group(-name=>'words', + -values=>['eenie','meenie','minie','moe']); + + print "<P>What's your favorite color? ", + $query->popup_menu(-name=>'color', + -values=>['red','green','blue','chartreuse']), + "<P>"; + print $query->submit; + print $query->endform; +} + +sub print_response { + print "<H1>Frameset Result</H1>\n"; + unless ($query->param) { + print "<b>No query submitted yet.</b>"; + return; + } + print "Your name is <EM>",$query->param(name),"</EM>\n"; + print "<P>The keywords are: <EM>",join(", ",$query->param(words)),"</EM>\n"; + print "<P>Your favorite color is <EM>",$query->param(color),"</EM>\n"; +} + diff --git a/eg/cgi/index.html b/eg/cgi/index.html new file mode 100644 index 0000000000..9eafd5f108 --- /dev/null +++ b/eg/cgi/index.html @@ -0,0 +1,111 @@ +<HTML> <HEAD> +<TITLE>More Examples of Scripts Created with CGI.pm</TITLE> +</HEAD> + +<BODY> +<H1>More Examples of Scripts Created with CGI.pm</H1> + +<H2> Basic Non Sequitur Questionnaire</H2> +<UL> + <LI> <A HREF="tryit.cgi">Try the script</A> + <LI> <A HREF="tryit.txt">Look at its source code</A> +</UL> + +<H2> Advanced Non Sequitur Questionnaire</H2> +<UL> + <LI> <A HREF="monty.cgi">Try the script</A> + <LI> <A HREF="monty.txt">Look at its source code</A> +</UL> + +<H2> Save and restore the state of a form to a file</H2> +<UL> + <LI> <A HREF="save_state.cgi">Try the script</A> + <LI> <A HREF="save_state.txt">Look at its source code</A> +</UL> + +<H2> Read the coordinates from a clickable image map</H2> +<UL> + <LI> <A HREF="clickable_image.cgi">Try the script</A> + <LI> <A HREF="clickable_image.txt">Look at its source code</A> +</UL> + +<H2> Multiple independent forms on the same page</H2> +<UL> + <LI> <A HREF="multiple_forms.cgi">Try the script</A> + <LI> <A HREF="multiple_forms.txt">Look at its source code</A> +</UL> + +<H2> How to maintain state on a page with internal links</H2> +<UL> + <LI> <A HREF="internal_links.cgi">Try the script</A> + <LI> <A HREF="internal_links.txt">Look at its source code</A> +</UL> + +<h2>Echo fatal script errors to the browser</h2> +<ul> + <li><a href="crash.cgi">Try the script</a> + <li><a href="crash.txt">Look at its source code</a> +</ul> + +<EM>The Following Scripts only Work with Netscape 2.0 & Internet Explorer only!</EM> + +<H2> Prompt for a file to upload and process it</H2> +<UL> + <LI> <A HREF="file_upload.cgi">Try the script</A> + <LI> <A HREF="file_upload.txt">Look at its source code</A> +</UL> + +<h2> A Continuously-Updated Page using Server Push</h2> +<ul> + <li><a href="nph-clock.cgi">Try the script</a> + <li><a href="nph-clock.txt">Look at its source code</a> +</ul> + +<h2>Compute the "diff" between two uploaded files</h2> +<ul> + <li><a href="diff_upload.cgi">Try the script</a> + <li><a href="diff_upload.txt">Look at its source code</a> +</ul> + +<h2>Maintain state over a long period with a cookie</h2> +<ul> + <li><a href="cookie.cgi">Try the script</a> + <li><a href="cookie.txt">Look at its source code</a> +</ul> + +<h2>Permanently customize the appearance of a page</h2> +<ul> + <li><a href="customize.cgi">Try the script</a> + <li><a href="customize.txt">Look at its source code</a> +</ul> + +<h2> Popup the response in a new window</h2> +<ul> + <li><a href="popup.cgi">Try the script</a> + <li><a href="popup.txt">Look at its source code</a> +</ul> + +<h2> Side-by-side form and response using frames</h2> +<ul> + <li><a href="frameset.cgi">Try the script</a> + <li><a href="frameset.txt">Look at its source code</a> +</ul> + +<h2>Verify the Contents of a fill-out form with JavaScript</h2> +<ul> + <li><a href="javascript.cgi">Try the script</a> + <li><a href="javascript.txt">Look at its source code</a> +</ul> + +<HR> +<MENU> + <LI> <A HREF="../cgi_docs.html">CGI.pm documentation</A> + <LI> <A HREF="../CGI.pm.tar.gz">Download the CGI.pm distribution</A> +</MENU> +<HR> +<ADDRESS>Lincoln D. Stein, lstein@genome.wi.mit.edu<br> +<a href="/">Whitehead Institute/MIT Center for Genome Research</a></ADDRESS> +<!-- hhmts start --> +Last modified: Mon Dec 2 06:23:25 EST 1996 +<!-- hhmts end --> +</BODY> </HTML> diff --git a/eg/cgi/internal_links.cgi b/eg/cgi/internal_links.cgi new file mode 100644 index 0000000000..4806966842 --- /dev/null +++ b/eg/cgi/internal_links.cgi @@ -0,0 +1,33 @@ +#!/usr/local/bin/perl + +use CGI; +$query = new CGI; + +# We generate a regular HTML file containing a very long list +# and a popup menu that does nothing except to show that we +# don't lose the state information. +print $query->header; +print $query->start_html("Internal Links Example"); +print "<H1>Internal Links Example</H1>\n"; +print "Click <cite>Submit Query</cite> to create a state. Then scroll down and", + " click on any of the <cite>Jump to top</cite> links. This is not very exciting."; + +print "<A NAME=\"start\"></A>\n"; # an anchor point at the top + +# pick a default starting value; +$query->param('amenu','FOO1') unless $query->param('amenu'); + +print $query->startform; +print $query->popup_menu('amenu',[('FOO1'..'FOO9')]); +print $query->submit,$query->endform; + +# We create a long boring list for the purposes of illustration. +$myself = $query->self_url; +print "<OL>\n"; +for (1..100) { + print qq{<LI>List item #$_ <A HREF="$myself#start">Jump to top</A>\n}; +} +print "</OL>\n"; + +print $query->end_html; + diff --git a/eg/cgi/javascript.cgi b/eg/cgi/javascript.cgi new file mode 100644 index 0000000000..20496c0e80 --- /dev/null +++ b/eg/cgi/javascript.cgi @@ -0,0 +1,105 @@ +#!/usr/local/bin/perl + +# This script illustrates how to use JavaScript to validage fill-out +# forms. +use CGI qw(:standard); + +# Here's the javascript code that we include in the document. +$JSCRIPT=<<EOF; + // validate that the user is the right age. Return + // false to prevent the form from being submitted. + function validateForm() { + var today = new Date(); + var birthday = validateDate(document.form1.birthdate); + if (birthday == 0) { + document.form1.birthdate.focus() + document.form1.birthdate.select(); + return false; + } + var milliseconds = today.getTime()-birthday; + var years = milliseconds/(1000 * 60 * 60 * 24 * 365.25); + if ((years > 20) || (years < 5)) { + alert("You must be between the ages of 5 and 20 to submit this form"); + document.form1.birthdate.focus(); + document.form1.birthdate.select(); + return false; + } + // Since we've calculated the age in years already, + // we might as well send it up to our CGI script. + document.form1.age.value=Math.floor(years); + return true; + } + + // make sure that the contents of the supplied + // field contain a valid date. + function validateDate(element) { + var date = Date.parse(element.value); + if (0 == date) { + alert("Please enter date in format MMM DD, YY"); + element.focus(); + element.select(); + } + return date; + } + + // Compliments, compliments + function doPraise(element) { + if (element.checked) { + self.status=element.value + " is an excellent choice!"; + return true; + } else { + return false; + } + } + + function checkColor(element) { + var color = element.options[element.selectedIndex].text; + if (color == "blonde") { + if (confirm("Is it true that blondes have more fun?")) + alert("Darn. That leaves me out."); + } else + alert(color + " is a fine choice!"); + } +EOF + ; + +# here's where the execution begins +print header; +print start_html(-title=>'Personal Profile',-script=>$JSCRIPT); + +print h1("Big Brother Wants to Know All About You"), + strong("Note: "),"This page uses JavaScript and requires", + "Netscape 2.0 or higher to do anything special."; + +&print_prompt(); +print hr; +&print_response() if param; +print end_html; + +sub print_prompt { + print start_form(-name=>'form1', + -onSubmit=>"return validateForm()"),"\n"; + print "Birthdate (e.g. Jan 3, 1972): ", + textfield(-name=>'birthdate', + -onBlur=>"validateDate(this)"),"<p>\n"; + print "Sex: ",radio_group(-name=>'gender', + -value=>[qw/male female/], + -onClick=>"doPraise(this)"),"<p>\n"; + print "Hair color: ",popup_menu(-name=>'color', + -value=>[qw/brunette blonde red gray/], + -default=>'red', + -onChange=>"checkColor(this)"),"<p>\n"; + print hidden(-name=>'age',-value=>0); + print submit(); + print end_form; +} + +sub print_response { + import_names('Q'); + print h2("Your profile"), + "You are a ",b($Q::age)," year old ",b($Q::color,$Q::gender),".", + "You should be ashamed of yourself for lying so ", + "blatantly to big brother!", + hr; +} + diff --git a/eg/cgi/monty.cgi b/eg/cgi/monty.cgi new file mode 100644 index 0000000000..b7c0f6a8f6 --- /dev/null +++ b/eg/cgi/monty.cgi @@ -0,0 +1,83 @@ +#!/usr/local/bin/perl + +use CGI; + +$query = new CGI; + +print $query->header; +print $query->start_html("Example CGI.pm Form"); +print "<H1> Example CGI.pm Form</H1>\n"; +&print_prompt($query); +&do_work($query); +&print_tail; +print $query->end_html; + +sub print_prompt { + my($query) = @_; + + print $query->start_multipart_form; + print "<EM>What's your name?</EM><BR>"; + print $query->textfield('name'); + print $query->checkbox('Not my real name'); + + print "<P><EM>Where can you find English Sparrows?</EM><BR>"; + print $query->checkbox_group( + -name=>'Sparrow locations', + -values=>[England,France,Spain,Asia,Hoboken], + -linebreak=>'yes', + -defaults=>[England,Asia]); + + print "<P><EM>How far can they fly?</EM><BR>", + $query->radio_group( + -name=>'how far', + -values=>['10 ft','1 mile','10 miles','real far'], + -default=>'1 mile'); + + print "<P><EM>What's your favorite color?</EM> "; + print $query->popup_menu(-name=>'Color', + -values=>['black','brown','red','yellow'], + -default=>'red'); + + print $query->hidden('Reference','Monty Python and the Holy Grail'); + + print "<P><EM>What have you got there?</EM><BR>"; + print $query->scrolling_list( + -name=>'possessions', + -values=>['A Coconut','A Grail','An Icon', + 'A Sword','A Ticket'], + -size=>5, + -multiple=>'true'); + + print "<P><EM>Any parting comments?</EM><BR>"; + print $query->textarea(-name=>'Comments', + -rows=>10, + -columns=>50); + + print "<P>",$query->reset; + print $query->submit('Action','Shout'); + print $query->submit('Action','Scream'); + print $query->endform; + print "<HR>\n"; + } + +sub do_work { + my($query) = @_; + my(@values,$key); + + print "<H2>Here are the current settings in this form</H2>"; + + foreach $key ($query->param) { + print "<STRONG>$key</STRONG> -> "; + @values = $query->param($key); + print join(", ",@values),"<BR>\n"; + } +} + +sub print_tail { + print <<END; +<HR> +<ADDRESS>Lincoln D. Stein</ADDRESS><BR> +<A HREF="/">Home Page</A> +END + ; +} diff --git a/eg/cgi/multiple_forms.cgi b/eg/cgi/multiple_forms.cgi new file mode 100644 index 0000000000..b38bf93e96 --- /dev/null +++ b/eg/cgi/multiple_forms.cgi @@ -0,0 +1,54 @@ +#!/usr/local/bin/perl + +use CGI; + +$query = new CGI; +print $query->header; +print $query->start_html('Multiple Forms'); +print "<H1>Multiple Forms</H1>\n"; + +# Print the first form +print $query->startform; +$name = $query->remote_user || 'anonymous@' . $query->remote_host; + +print "What's your name? ",$query->textfield('name',$name,50); +print "<P>What's the combination?<P>", + $query->checkbox_group('words',['eenie','meenie','minie','moe']); +print "<P>What's your favorite color? ", + $query->popup_menu('color',['red','green','blue','chartreuse']), + "<P>"; +print $query->submit('form_1','Send Form 1'); +print $query->endform; + +# Print the second form +print "<HR>\n"; +print $query->startform; +print "Some radio buttons: ",$query->radio_group('radio buttons', + [qw{one two three four five}],'three'),"\n"; +print "<P>What's the password? ",$query->password_field('pass','secret'); +print $query->defaults,$query->submit('form_2','Send Form 2'),"\n"; +print $query->endform; + +print "<HR>\n"; + +$query->import_names('Q'); +if ($Q::form_1) { + print "<H2>Form 1 Submitted</H2>\n"; + print "Your name is <EM>$Q::name</EM>\n"; + print "<P>The combination is: <EM>{",join(",",@Q::words),"}</EM>\n"; + print "<P>Your favorite color is <EM>$Q::color</EM>\n"; +} elsif ($Q::form_2) { + print <<EOF; +<H2>Form 2 Submitted</H2> +<P>The value of the radio buttons is <EM>$Q::radio_buttons</EM> +<P>The secret password is <EM>$Q::pass</EM> +EOF + ; +} +print qq{<P><A HREF="./">Other examples</A>}; +print qq{<P><A HREF="../cgi_docs.html">Go to the documentation</A>}; + +print $query->end_html; + + + diff --git a/eg/cgi/nph-clock.cgi b/eg/cgi/nph-clock.cgi new file mode 100644 index 0000000000..55a2fbe545 --- /dev/null +++ b/eg/cgi/nph-clock.cgi @@ -0,0 +1,18 @@ +#!/usr/local/bin/perl -w + +use CGI::Push qw(:standard :html3); + +do_push(-next_page=>\&draw_time,-delay=>1); + +sub draw_time { + my $time = `/bin/date`; + return start_html('Tick Tock'), + div({-align=>CENTER}, + h1('Virtual Clock'), + h2($time) + ), + hr, + a({-href=>'index.html'},'More examples'), + end_html(); +} + diff --git a/eg/cgi/popup.cgi b/eg/cgi/popup.cgi new file mode 100644 index 0000000000..88cea1da9c --- /dev/null +++ b/eg/cgi/popup.cgi @@ -0,0 +1,32 @@ +#!/usr/local/bin/perl + +use CGI; +$query = new CGI; +print $query->header; +print $query->start_html('Popup Window'); + + +if (!$query->param) { + print "<H1>Ask your Question</H1>\n"; + print $query->startform(-target=>'_new'); + print "What's your name? ",$query->textfield('name'); + print "<P>What's the combination?<P>", + $query->checkbox_group(-name=>'words', + -values=>['eenie','meenie','minie','moe'], + -defaults=>['eenie','moe']); + + print "<P>What's your favorite color? ", + $query->popup_menu(-name=>'color', + -values=>['red','green','blue','chartreuse']), + "<P>"; + print $query->submit; + print $query->endform; + +} else { + print "<H1>And the Answer is...</H1>\n"; + print "Your name is <EM>",$query->param(name),"</EM>\n"; + print "<P>The keywords are: <EM>",join(", ",$query->param(words)),"</EM>\n"; + print "<P>Your favorite color is <EM>",$query->param(color),"</EM>\n"; +} +print qq{<P><A HREF="cgi_docs.html">Go to the documentation</A>}; +print $query->end_html; diff --git a/eg/cgi/save_state.cgi b/eg/cgi/save_state.cgi new file mode 100644 index 0000000000..be79051bd6 --- /dev/null +++ b/eg/cgi/save_state.cgi @@ -0,0 +1,67 @@ +#!/usr/local/bin/perl + +use CGI; +$query = new CGI; + +print $query->header; +print $query->start_html("Save and Restore Example"); +print "<H1>Save and Restore Example</H1>\n"; + +# Here's where we take action on the previous request +&save_parameters($query) if $query->param('action') eq 'SAVE'; +$query = &restore_parameters($query) if $query->param('action') eq 'RESTORE'; + +# Here's where we create the form +print $query->startform; +print "Popup 1: ",$query->popup_menu('popup1',[qw{red green purple magenta orange chartreuse brown}]),"\n"; +print "Popup 2: ",$query->popup_menu('popup2',[qw{lion tiger bear zebra potto wildebeest frog emu gazelle}]),"\n"; +print "<P>"; +$default_name = $query->remote_addr . '.sav'; +print "Save/restore state from file: ",$query->textfield('savefile',$default_name),"\n"; +print "<P>"; +print $query->submit('action','SAVE'),$query->submit('action','RESTORE'); +print "<P>",$query->defaults; +print $query->endform; + +# Here we print out a bit at the end +print $query->end_html; + +sub save_parameters { + local($query) = @_; + local($filename) = &clean_name($query->param('savefile')); + if (open(FILE,">$filename")) { + $query->save(FILE); + close FILE; + print "<STRONG>State has been saved to file $filename</STRONG>\n"; + print "<P>If you remember this name you can restore the state later.\n"; + } else { + print "<STRONG>Error:</STRONG> couldn't write to file $filename: $!\n"; + } +} + +sub restore_parameters { + local($query) = @_; + local($filename) = &clean_name($query->param('savefile')); + if (open(FILE,$filename)) { + $query = new CGI(FILE); # Throw out the old query, replace it with a new one + close FILE; + print "<STRONG>State has been restored from file $filename</STRONG>\n"; + } else { + print "<STRONG>Error:</STRONG> couldn't restore file $filename: $!\n"; + } + return $query; +} + + +# Very important subroutine -- get rid of all the naughty +# metacharacters from the file name. If there are, we +# complain bitterly and die. +sub clean_name { + local($name) = @_; + unless ($name=~/^[\w\._\-]+$/) { + print "<STRONG>$name has naughty characters. Only "; + print "alphanumerics are allowed. You can't use absolute names.</STRONG>"; + die "Attempt to use naughty characters"; + } + return "WORLD_WRITABLE/$name"; +} diff --git a/eg/cgi/tryit.cgi b/eg/cgi/tryit.cgi new file mode 100644 index 0000000000..155cd72a59 --- /dev/null +++ b/eg/cgi/tryit.cgi @@ -0,0 +1,35 @@ +#!/usr/local/bin/perl + +use CGI ':standard'; + +print header; +print start_html('A Simple Example'), + h1('A Simple Example'), + start_form, + "What's your name? ",textfield('name'), + p, + "What's the combination?", + p, + checkbox_group(-name=>'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; +} +print a({href=>'../cgi_docs.html'},'Go to the documentation'); + diff --git a/eg/cgi/wilogo.gif.uu b/eg/cgi/wilogo.gif.uu new file mode 100644 index 0000000000..a183bc02d5 --- /dev/null +++ b/eg/cgi/wilogo.gif.uu @@ -0,0 +1,14 @@ +begin 644 wilogo.gif +M1TE&.#=A7@!$`(```'X2F?___RP`````7@!$```"_D2.J<#MKF)ZU,A3,[OO +M(IUY']A%9"6AW$F)+#2]Y:BNLF6_\;WMH<?#I72^VP+D"@*)F&"O25KRDM&B +M[%C-7;4_J)*6'4ZE&O`W8"1OQ5UGPWRBIKDPM!MW9J]-[;LUKL;$5W.'YQ3( +M(O<&-^>F*(A55\BX%UEI^;<VB0BH1RFX2=<IELE4^*0'N?-I>OJ8N%(*Z^4G +M.OJJ>8HZ.(>;JRMD><E[!KQHB^3;:APL6Z8\RKPK/)O:*-WLW&7]*\UYR]J) +M?<P=1MR-_6VN76,WGAV^32W^3CZ_SCY3;W__C-R^CU^\%M#T!9PVL(ZZ&>X" +M%A1XSM]!A?T8/C0T$1XMJG\B&G+,"-&C/(VS0(842;`)M'S>_OE8F#"=2S#* +M8LHLAS'D1Y,42UGY9O,F-T:X@@JEE@D1RW>/D@8R.DZ-+*E0CQ:9JJ5JU!SQ +MR&BU2D.;E*4'ER0TNY%G2A/Y.G[=VG%81+5K_UG$21<A6;=YP9'5B++O7:@7 +M\]J5]]?DX7:)%<]5%=B/55>-GQW55;$8L\RW6J8-9>QM7<^A/SMZK!ESY$,+ +(KPA.EJ```#L` +` +end @@ -53,6 +53,7 @@ #define band_amg Perl_band_amg #define bind_match Perl_bind_match #define block_end Perl_block_end +#define block_gimme Perl_block_gimme #define block_start Perl_block_start #define bool__amg Perl_bool__amg #define bor_amg Perl_bor_amg @@ -219,7 +220,7 @@ #define gv_AVadd Perl_gv_AVadd #define gv_HVadd Perl_gv_HVadd #define gv_IOadd Perl_gv_IOadd -#define gv_autoload Perl_gv_autoload +#define gv_autoload4 Perl_gv_autoload4 #define gv_check Perl_gv_check #define gv_efullname Perl_gv_efullname #define gv_efullname3 Perl_gv_efullname3 @@ -1257,7 +1258,6 @@ #define minus_n (curinterp->Iminus_n) #define minus_p (curinterp->Iminus_p) #define multiline (curinterp->Imultiline) -#define mustcatch (curinterp->Imustcatch) #define mystack_base (curinterp->Imystack_base) #define mystack_mark (curinterp->Imystack_mark) #define mystack_max (curinterp->Imystack_max) @@ -1298,6 +1298,7 @@ #define sortstack (curinterp->Isortstack) #define sortstash (curinterp->Isortstash) #define splitstr (curinterp->Isplitstr) +#define start_env (curinterp->Istart_env) #define statcache (curinterp->Istatcache) #define statgv (curinterp->Istatgv) #define statname (curinterp->Istatname) @@ -1410,7 +1411,6 @@ #define Iminus_n minus_n #define Iminus_p minus_p #define Imultiline multiline -#define Imustcatch mustcatch #define Imystack_base mystack_base #define Imystack_mark mystack_mark #define Imystack_max mystack_max @@ -1451,6 +1451,7 @@ #define Isortstack sortstack #define Isortstash sortstash #define Isplitstr splitstr +#define Istart_env start_env #define Istatcache statcache #define Istatgv statgv #define Istatname statname @@ -1572,7 +1573,6 @@ #define minus_n Perl_minus_n #define minus_p Perl_minus_p #define multiline Perl_multiline -#define mustcatch Perl_mustcatch #define mystack_base Perl_mystack_base #define mystack_mark Perl_mystack_mark #define mystack_max Perl_mystack_max @@ -1612,6 +1612,7 @@ #define sortstack Perl_sortstack #define sortstash Perl_sortstash #define splitstr Perl_splitstr +#define start_env Perl_start_env #define statcache Perl_statcache #define statgv Perl_statgv #define statname Perl_statname diff --git a/global.sym b/global.sym index 91372705c0..60c3836a36 100644 --- a/global.sym +++ b/global.sym @@ -317,6 +317,7 @@ av_undef av_unshift bind_match block_end +block_gimme block_start boot_core_UNIVERSAL call_list @@ -436,7 +437,7 @@ gp_ref gv_AVadd gv_HVadd gv_IOadd -gv_autoload +gv_autoload4 gv_check gv_efullname gv_efullname3 @@ -264,17 +264,18 @@ char* name; if (strEQ(name,"import")) gv = (GV*)&sv_yes; else - gv = gv_autoload(stash, name, nend - name); + gv = gv_autoload4(stash, name, nend - name, TRUE); } return gv; } GV* -gv_autoload(stash, name, len) +gv_autoload4(stash, name, len, method) HV* stash; char* name; STRLEN len; +I32 method; { static char autoload[] = "AUTOLOAD"; static STRLEN autolen = 8; @@ -286,9 +287,16 @@ STRLEN len; if (len == autolen && strnEQ(name, autoload, autolen)) return Nullgv; - if (!(gv = gv_fetchmeth(stash, autoload, autolen, 0))) - return Nullgv; - cv = GvCV(gv); + if (method) { + if (!(gv = gv_fetchmeth(stash, autoload, autolen, FALSE))) + return Nullgv; + cv = GvCV(gv); + } + else { + GV** gvp = (GV**)hv_fetch(stash, autoload, autolen, FALSE); + if (!gvp || !(gv = *gvp) || !(cv = GvCVu(gv))) + return Nullgv; + } /* * Given &FOO::AUTOLOAD, set $FOO::AUTOLOAD to desired function name. @@ -1282,14 +1290,14 @@ int flags; dSP; BINOP myop; SV* res; - bool oldmustcatch = mustcatch; + bool oldcatch = CATCH_GET; + CATCH_SET(TRUE); Zero(&myop, 1, BINOP); myop.op_last = (OP *) &myop; myop.op_next = Nullop; - myop.op_flags = OPf_KNOW|OPf_STACKED; + myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED; - mustcatch = TRUE; ENTER; SAVESPTR(op); op = (OP *) &myop; @@ -1301,7 +1309,7 @@ int flags; EXTEND(sp, notfound + 5); PUSHs(lr>0? right: left); PUSHs(lr>0? left: right); - PUSHs( assign ? &sv_undef : (lr>0? &sv_yes: &sv_no)); + PUSHs( assign ? &sv_undef : boolSV(lr>0) ); if (notfound) { PUSHs( sv_2mortal(newSVpv((char *)AMG_names[method + assignshift],0)) ); } @@ -1315,7 +1323,7 @@ int flags; res=POPs; PUTBACK; - mustcatch = oldmustcatch; + CATCH_SET(oldcatch); if (postpr) { int ans; @@ -1344,7 +1352,7 @@ int flags; case not_amg: ans=!SvOK(res); break; } - return ans? &sv_yes: &sv_no; + return boolSV(ans); } else if (method==copy_amg) { if (!SvROK(res)) { croak("Copy method did not return a reference"); diff --git a/hints/dgux.sh b/hints/dgux.sh index d751e63a64..03b285dbd4 100644 --- a/hints/dgux.sh +++ b/hints/dgux.sh @@ -18,7 +18,7 @@ # your $LD_LIBRARY_PATH to include the source directory when you build, # test and install the software. # -# -Roderick Schertler <roderick@gate.net> +# -Roderick Schertler <roderick@argon.org> # Here are the things from some old DGUX hints files which are different diff --git a/installhtml b/installhtml new file mode 100644 index 0000000000..a33dec3895 --- /dev/null +++ b/installhtml @@ -0,0 +1,560 @@ +#!/usr/bin/perl -w + +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=<name>:...:<name>] [--podroot=<name>] + [--htmldir=<name>] [--htmlroot=<name>] [--norecurse] [--recurse] + [--splithead=<name>,...,<name>] [--splititem=<name>,...,<name>] + [--libpods=<name>,...,<name>] [--verbose] + +=head1 DESCRIPTION + +I<installhtml> 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<--podpath> POD search path + +The list of diretories to search for .pod and .pm files to be converted. +Default is `podroot/.'. + +=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<--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<--recurse> recurse on subdirectories + +Whether or not to convert all .pm and .pod files found in subdirectories +too. Default is to not recurse. + +=item B<--splithead> POD files to split on =head directive + +Colon-seperated list of pod files to split by the =head directive. These +files should have names specified relative to podroot. + +=item B<--splititem> POD files to split on =item directive + +Colon-seperated list of all pod files to split by the =item directive. +I<installhtml> does not do the actual split, rather it invokes I<splitpod> +to do the dirty work. As with --splithead, these files should have names +specified relative to podroot. + +=item B<--libpods> library PODs for LE<lt>E<gt> links + +Colon-seperated 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.pod \ + --splititem=pod/perlfunc \ + --libpods=perlfunc:perlguts:perlvar:perlrun:perlop \ + --recurse \ + --verbose + +=head1 AUTHOR + +Chris Hall E<lt>hallc@cs.colorado.eduE<gt> + +=head1 TODO + +=cut + +$usage =<<END_OF_USAGE; +Usage: $0 --help --podpath=<name>:...:<name> --podroot=<name> + --htmldir=<name> --htmlroot=<name> --norecurse --recurse + --splithead=<name>,...,<name> --splititem=<name>,...,<name> + --libpods=<name>,...,<name> --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 occurance + of a pod =head[1-6] directive. + --splititem - comma-separated list of .pod or .pm files to split using + splitpod. + --splitpod - where the program splitpod can be found (\$podroot/pod by + default). + --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"; + + +# 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 (<H>) { + 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 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 "<DL COMPACT>\n"; + foreach $file (@files) { + $/ = ""; + + open(IN, "<$dir/$file") || + die "$0: error opening $dir/$file for input: $!\n"; + @filedata = <IN>; + close(IN); + + # pull out the NAME section + ($name) = grep(/NAME=/, @filedata); + $name =~ m,/H1>\s(\S+)\s[\s-]*(.*?)\s*$,sm; + print HTML qq(<A HREF="$dir/$file">); + print HTML "<DT>$1</A><DD>$2\n" if defined $1; +# print HTML qq(<A HREF="$dir/$file">$1</A><BR>\n") if defined $1; + + next; + + @index = grep(/<!-- INDEX BEGIN -->.*<!-- INDEX END -->/s, + @filedata); + for (@index) { + s/<!-- INDEX BEGIN -->(\s*<!--)(.*)(-->\s*)<!-- INDEX END -->/$2/s; + s,#,$dir/$file#,g; + # print HTML "$_\n"; + print HTML "$_\n<P><HR><P>\n"; + } + } + print HTML "</DL>\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(); + 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"; + system("./splitpod", "../$filename"); + } + 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 = <SPLITIN>; + 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/interp.sym b/interp.sym index a82c2c4843..80ef5b59dd 100644 --- a/interp.sym +++ b/interp.sym @@ -85,7 +85,6 @@ minus_l minus_n minus_p multiline -mustcatch mystack_base mystack_mark mystack_max @@ -126,6 +125,7 @@ sortcop sortstack sortstash splitstr +start_env statcache statgv statname diff --git a/lib/CGI.pm b/lib/CGI.pm new file mode 100644 index 0000000000..3ddd4d999b --- /dev/null +++ b/lib/CGI.pm @@ -0,0 +1,4885 @@ +package CGI; +require 5.001; + +# 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-1997 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/ + +# Set this to 1 to enable copious autoloader debugging messages +$AUTOLOAD_DEBUG=0; + +# 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; + +$CGI::revision = '$Id: CGI.pm,v 2.32 1997/3/19 10:10 lstein Exp $'; +$CGI::VERSION='2.32'; + +# OVERRIDE THE OS HERE IF CGI.pm GUESSES WRONG +# $OS = 'UNIX'; +# $OS = 'MACINTOSH'; +# $OS = 'WINDOWS'; +# $OS = 'VMS'; +# $OS = 'OS2'; + +# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES. +# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING. +# $TempFile::TMPDIRECTORY = '/usr/tmp'; + +# ------------------ START OF THE LIBRARY ------------ + +# 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=~/Mac/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}; + +# Turn on NPH scripts by default when running under IIS server! +$NPH++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/; + +# Turn on special checking for Doug MacEachern's modperl +if ($MOD_PERL = $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-Perl/) { + $NPH++; + $| = 1; + $SEQNO = 1; +} + +# This is really "\r\n", but the meaning of \n is different +# in MacPerl, so we resort to octal here. +$CRLF = "\015\012"; + +if ($needs_binmode) { + $CGI::DefaultClass->binmode(main::STDOUT); + $CGI::DefaultClass->binmode(main::STDIN); + $CGI::DefaultClass->binmode(main::STDERR); +} + +# Cute feature, but it broke when the overload mechanism changed... +# %OVERLOAD = ('""'=>'as_string'); + +%EXPORT_TAGS = ( + ':html2'=>[h1..h6,qw/p br hr ol ul li dl dt dd menu code var strong em + tt 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/], + ':html3'=>[qw/div table caption th td TR Tr super sub strike applet PARAM embed basefont/], + ':netscape'=>[qw/blink frameset frame script font 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 + remote_user user_name header redirect import_names put/], + ':ssl' => [qw/https/], + ':cgi-lib' => [qw/ReadParse PrintHeader HtmlTop HtmlBot SplitParam/], + ':html' => [qw/:html2 :html3 :netscape/], + ':standard' => [qw/:html2 :form :cgi/], + ':all' => [qw/:html2 :html3 :netscape :form :cgi/] + ); + +# to import symbols into caller +sub import { + my $self = shift; + my ($callpack, $callfile, $callline) = caller; + foreach (@_) { + $NPH++, next if $_ eq ':nph'; + foreach (&expand_tags($_)) { + tr/a-zA-Z0-9_//cd; # don't allow weird function names + $EXPORT{$_}++; + } + } + # 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 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; + $CGI::DefaultClass->_reset_globals() if $MOD_PERL; + $initializer = to_filehandle($initializer) if $initializer; + $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]; +} + +#### 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; +} + +sub self_or_default { + return @_ if defined($_[0]) && !ref($_[0]) && ($_[0] eq 'CGI'); + unless (defined($_[0]) && + ref($_[0]) && + (ref($_[0]) eq 'CGI' || + eval "\$_[0]->isaCGI()")) { # optimize for the common case + $CGI::DefaultClass->_reset_globals() + if defined($Q) && $MOD_PERL && $CGI::DefaultClass->_new_request(); + $Q = $CGI::DefaultClass->new unless defined($Q); + unshift(@_,$Q); + } + return @_; +} + +sub _new_request { + return undef unless (defined(Apache->seqno()) or eval { require Apache }); + if (Apache->seqno() != $SEQNO) { + $SEQNO = Apache->seqno(); + return 1; + } else { + return undef; + } +} + +sub _reset_globals { + undef $Q; + undef @QUERY_PARAM; +} + +sub self_or_CGI { + local $^W=0; # prevent a warning + if (defined($_[0]) && + (substr(ref($_[0]),0,3) eq 'CGI' + || eval "\$_[0]->isaCGI()")) { + return @_; + } else { + return ($DefaultClass,@_); + } +} + +sub isaCGI { + return 1; +} + +#### Method: import_names +# Import all parameters into the given namespace. +# Assumes namespace 'Q' if not specified +#### +sub import_names { + my($self,$namespace) = self_or_default(@_); + $namespace = 'Q' unless defined($namespace); + die "Can't import names into 'main'\n" + if $namespace eq 'main'; + my($param,@value,$var); + foreach $param ($self->param) { + # protect against silly names + ($var = $param)=~tr/a-zA-Z0-9_/_/c; + $var = "${namespace}::$var"; + @value = $self->param($param); + @{$var} = @value; + ${$var} = $value[0]; + } +} + +#### 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; +} + +######################################## +# 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,@lines); + my($meth) = ''; + + # 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'}); + + # If initializer is defined, then read parameters + # from it. + METHOD: { + if (defined($initializer)) { + + if (ref($initializer) && ref($initializer) eq 'HASH') { + foreach (keys %$initializer) { + $self->param('-name'=>$_,'-value'=>$initializer->{$_}); + } + last METHOD; + } + + $initializer = $$initializer if ref($initializer); + if (defined(fileno($initializer))) { + while (<$initializer>) { + chomp; + last if /^=/; + push(@lines,$_); + } + # massage back into standard format + if ("@lines" =~ /=/) { + $query_string=join("&",@lines); + } else { + $query_string=join("+",@lines); + } + last METHOD; + } + $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'}; + last METHOD; + } + + # If the method is POST, fetch the query from standard + # input. + if ($meth eq 'POST') { + + if (defined($ENV{'CONTENT_TYPE'}) + && + $ENV{'CONTENT_TYPE'}=~m|^multipart/form-data|) { + my($boundary) = $ENV{'CONTENT_TYPE'}=~/boundary=(\S+)/; + $self->read_multipart($boundary,$ENV{'CONTENT_LENGTH'}); + + } else { + + $self->read_from_client(\*STDIN,\$query_string,$ENV{'CONTENT_LENGTH'},0) + if $ENV{'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 .= ($query_string ? '&' : '') . $ENV{'QUERY_STRING'} if $ENV{'QUERY_STRING'}; + last METHOD; + } + + # If neither is set, 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; + } + + # We now have the query string in hand. We do slightly + # different things for keyword lists and parameter lists. + if ($query_string) { + 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 $string = shift; + if ($string && !ref($string)) { + my($package) = caller(1); + my($tmp) = $string=~/[':]/ ? $string : "$package\:\:$string"; + return $tmp if defined(fileno($tmp)); + } + return $string; +} + +# Create a new multipart buffer +sub new_MultipartBuffer { + my($self,$boundary,$length,$filehandle) = @_; + return MultipartBuffer->new($self,$boundary,$length,$filehandle); +} + +# Read data from a file handle +sub read_from_client { + my($self, $fh, $buff, $len, $offset) = @_; + local $^W=0; # prevent a warning + return read($fh, $$buff, $len, $offset); +} + +# put a filehandle into binary mode (DOS) +sub binmode { + binmode($_[1]); +} + +# 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 { + my($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 { + my($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_keywordlist { + my($self,$tosplit) = @_; + $tosplit = &unescape($tosplit); # unescape the keywords + $tosplit=~tr/+/ /; # pluses to spaces + my(@keywords) = split(/\s+/,$tosplit); + return @keywords; +} + +sub parse_params { + my($self,$tosplit) = @_; + my(@pairs) = split('&',$tosplit); + my($param,$value); + foreach (@pairs) { + ($param,$value) = split('='); + $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'}}; +} + + + +#### Method as_string +# +# synonym for "dump" +#### +sub as_string { + &dump(@_); +} + +sub AUTOLOAD { + print STDERR "CGI::AUTOLOAD for $AUTOLOAD\n" if $CGI::AUTOLOAD_DEBUG; + my($func) = $AUTOLOAD; + my($pack,$func_name) = $func=~/(.+)::([^:]+)$/; + $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 $@; + } + my($code) = $sub->{$func_name}; + + $code = "sub $AUTOLOAD { }" if (!$code and $func_name eq 'DESTROY'); + if (!$code) { + if ($EXPORT{':any'} || + $EXPORT{$func_name} || + (%EXPORT_OK || grep(++$EXPORT_OK{$_},&expand_tags(':html'))) + && $EXPORT_OK{$func_name}) { + $code = $sub->{'HTML_FUNC'}; + $code=~s/func_name/$func_name/mg; + } + } + die "Undefined subroutine $AUTOLOAD\n" unless $code; + eval "package $pack; $code"; + if ($@) { + $@ =~ s/ at .*\n//; + die $@; + } + goto &{"$pack\:\:$func_name"}; +} + +# 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; + + return @param unless (defined($param[0]) && substr($param[0],0,1) eq '-') + || $self->use_named_parameters; + + my $i; + for ($i=0;$i<@param;$i+=2) { + $param[$i]=~s/^\-//; # get rid of initial - if present + $param[$i]=~tr/a-z/A-Z/; # parameters are upper case + } + + my(%param) = @param; # convert into associative array + my(@return_array); + + my($key)=''; + foreach $key (@$order) { + my($value); + # this is an awful hack to fix spurious warnings when the + # -w switch is set. + if (ref($key) && ref($key) eq 'ARRAY') { + foreach (@$key) { + last if defined($value); + $value = $param{$_}; + delete $param{$_}; + } + } else { + $value = $param{$key}; + delete $param{$key}; + } + push(@return_array,$value); + } + push (@return_array,$self->make_attributes(\%param)) if %param; + return (@return_array); +} + +############################################################################### +################# 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 + +'HTML_FUNC' => <<'END_OF_FUNC', +sub func_name { + + # 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' || + eval "\$_[0]->isaCGI()")); + + my($attr) = ''; + if (ref($_[0]) && ref($_[0]) eq 'HASH') { + my(@attr) = CGI::make_attributes('',shift); + $attr = " @attr" if @attr; + } + my($tag,$untag) = ("\U<func_name\E$attr>","\U</func_name>\E"); + return $tag unless @_; + if (ref($_[0]) eq 'ARRAY') { + my(@r); + foreach (@{$_[0]}) { + push(@r,"$tag$_$untag"); + } + return "@r"; + } else { + return "$tag@_$untag"; + } +} +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 @values; + my(@result) = @{$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); +} +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 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 + +#### 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 + push(@att,$attr->{$_} ne '' ? qq/$key="$attr->{$_}"/ : qq/$key/); + } + return @att; +} +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 '<UL></UL>' unless $self->param; + push(@result,"<UL>"); + foreach $param ($self->param) { + my($name)=$self->escapeHTML($param); + push(@result,"<LI><STRONG>$param</STRONG>"); + push(@result,"<UL>"); + foreach $value ($self->param($param)) { + $value = $self->escapeHTML($value); + push(@result,"<LI>$value"); + } + push(@result,"</UL>"); + } + push(@result,"</UL>\n"); + return join("\n",@result); +} +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(@_); + my($param); + my($package) = caller; +# Check that this still works! +# $filehandle = $filehandle=~/[':]/ ? $filehandle : "$package\:\:$filehandle"; + $filehandle = to_filehandle($filehandle); + 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: 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); + + # rearrange() was designed for the HTML portion, so we + # need to fix it up a little. + foreach (@other) { + next unless my($header,$value) = /([^\s=]+)=(.+)/; + substr($header,1,1000)=~tr/A-Z/a-z/; + ($value)=$value=~/^"(.*)"$/; + $_ = "$header: $value"; + } + + $type = $type || 'text/html'; + + push(@header,'HTTP/1.0 ' . ($status || '200 OK')) if $nph || $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) ? @{$cookie} : $cookie; + foreach (@cookie) { + push(@header,"Set-cookie: $_"); + } + } + # 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)) if $expires; + push(@header,"Date: " . &expires(0)) if $expires; + push(@header,"Pragma: no-cache") if $self->cache(); + push(@header,@other); + push(@header,"Content-type: $type"); + + my $header = join($CRLF,@header); + return $header . "${CRLF}${CRLF}"; +} +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([[URI,URL],TARGET,COOKIE,NPH],@p); + $url = $url || $self->self_url; + my(@o); + foreach (@other) { push(@o,split("=")); } + push(@o, + '-Status'=>'302 Found', + '-Location'=>$url, + '-URI'=>$url, + '-nph'=>($nph||$NPH)); + push(@o,'-Target'=>$target) if $target; + push(@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) +# $meta -> (optional) Meta information tags +# @other -> (optional) any other named parameters you'd like to incorporate into +# the <BODY> tag. +#### +'start_html' => <<'END_OF_FUNC', +sub start_html { + my($self,@p) = &self_or_default(@_); + my($title,$author,$base,$xbase,$script,$target,$meta,@other) = + $self->rearrange([TITLE,AUTHOR,BASE,XBASE,SCRIPT,TARGET,META],@p); + + # strangely enough, the title needs to be escaped as HTML + # while the author needs to be escaped as a URL + $title = $self->escapeHTML($title || 'Untitled Document'); + $author = $self->escapeHTML($author); + my(@result); + push(@result,'<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">'); + push(@result,"<HTML><HEAD><TITLE>$title</TITLE>"); + push(@result,"<LINK REV=MADE HREF=\"mailto:$author\">") if $author; + + if ($base || $xbase || $target) { + my $href = $xbase || $self->url(); + my $t = $target ? qq/ TARGET="$target"/ : ''; + push(@result,qq/<BASE HREF="$href"$t>/); + } + + if ($meta && ref($meta) && (ref($meta) eq 'HASH')) { + foreach (keys %$meta) { push(@result,qq(<META NAME="$_" CONTENT="$meta->{$_}">)); } + } + push(@result,<<END) if $script; +<SCRIPT> +<!-- Hide script from HTML-compliant browsers +$script +// End script hiding. --> +</SCRIPT> +END + ; + my($other) = @other ? " @other" : ''; + push(@result,"</HEAD><BODY$other>"); + return join("\n",@result); +} +END_OF_FUNC + + +#### Method: end_html +# End an HTML document. +# Trivial method for completeness. Just returns "</BODY>" +#### +'end_html' => <<'END_OF_FUNC', +sub end_html { + return "</BODY></HTML>"; +} +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 <ISINDEX> 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 "<ISINDEX $action$other>"; +} +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/<FORM METHOD="$method" $action ENCTYPE="$enctype"$other>\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,"</FORM>"); +} +END_OF_FUNC + + +#### Method: end_form +# synonym for endform +'end_form' => <<'END_OF_FUNC', +sub end_form { + &endform; +} +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 <INPUT TYPE="text"> field +# +'textfield' => <<'END_OF_FUNC', +sub textfield { + my($self,@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/<INPUT TYPE="text" NAME="$name" VALUE="$current"$s$m$other>/; +} +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 <INPUT TYPE="text"> field +# +'filefield' => <<'END_OF_FUNC', +sub filefield { + my($self,@p) = self_or_default(@_); + + my($name,$default,$size,$maxlength,$override,@other) = + $self->rearrange([NAME,[DEFAULT,VALUE],SIZE,MAXLENGTH,[OVERRIDE,FORCE]],@p); + + $current = $override ? $default : + (defined($self->param($name)) ? $self->param($name) : $default); + + $name = defined($name) ? $self->escapeHTML($name) : ''; + my($s) = defined($size) ? qq/ SIZE=$size/ : ''; + my($m) = defined($maxlength) ? qq/ MAXLENGTH=$maxlength/ : ''; + $current = defined($current) ? $self->escapeHTML($current) : ''; + $other = ' ' . join(" ",@other); + return qq/<INPUT TYPE="file" NAME="$name" VALUE="$current"$s$m$other>/; +} +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 <INPUT TYPE="password"> field +# +'password_field' => <<'END_OF_FUNC', +sub password_field { + my ($self,@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); + + $name = defined($name) ? $self->escapeHTML($name) : ''; + $current = defined($current) ? $self->escapeHTML($current) : ''; + my($s) = defined($size) ? qq/ SIZE=$size/ : ''; + my($m) = defined($maxlength) ? qq/ MAXLENGTH=$maxlength/ : ''; + my($other) = @other ? " @other" : ''; + return qq/<INPUT TYPE="password" NAME="$name" VALUE="$current"$s$m$other>/; +} +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 <TEXTAREA></TEXTAREA> 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{<TEXTAREA NAME="$name"$r$c$other>$current</TEXTAREA>}; +} +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 <INPUT TYPE="button"> 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/<INPUT TYPE="button"$name$val$script$other>/; +} +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 <INPUT TYPE="submit"> 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 $label; + $value = $value || $label; + my($val) = ''; + $val = qq/ VALUE="$value"/ if defined($value); + my($other) = @other ? " @other" : ''; + return qq/<INPUT TYPE="submit"$name$val$other>/; +} +END_OF_FUNC + + +#### Method: reset +# Create a "reset" button. +# Parameters: +# $name -> (optional) Name for the button. +# Returns: +# A string containing a <INPUT TYPE="reset"> 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/<INPUT TYPE="reset"$value$other>/; +} +END_OF_FUNC + + +#### Method: defaults +# Create a "defaults" button. +# Parameters: +# $name -> (optional) Name for the button. +# Returns: +# A string containing a <INPUT TYPE="submit" NAME=".defaults"> 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/<INPUT TYPE="submit" NAME=".defaults"$value$other>/; +} +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 <INPUT TYPE="checkbox"> 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); + + if (!$override && defined($self->param($name))) { + $value = $self->param($name) unless defined $value; + $checked = $self->param($name) eq $value ? ' CHECKED' : ''; + } else { + $checked = $checked ? ' CHECKED' : ''; + $value = defined $value ? $value : 'on'; + } + 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 <<END; +<INPUT TYPE="checkbox" NAME="$name" VALUE="$value"$checked$other>$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 <INPUT TYPE="checkbox"> 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 ? "<BR>" : ''; + $name=$self->escapeHTML($name); + + # Create the elements + my(@elements); + my(@values) = $values ? @$values : $self->param($name); + my($other) = @other ? " @other" : ''; + foreach (@values) { + $checked = $checked{$_} ? ' CHECKED' : ''; + $label = ''; + unless (defined($nolabels) && $nolabels) { + $label = $_; + $label = $labels->{$_} if defined($labels) && $labels->{$_}; + $label = $self->escapeHTML($label); + } + $_ = $self->escapeHTML($_); + push(@elements,qq/<INPUT TYPE="checkbox" NAME="$name" VALUE="$_"$checked$other>${label} ${break}/); + } + $self->register_parameter($name); + return wantarray ? @elements : join('',@elements) unless $columns; + return _tableize($rows,$columns,$rowheaders,$colheaders,@elements); +} +END_OF_FUNC + + +# Escape HTML -- used internally +'escapeHTML' => <<'END_OF_FUNC', +sub escapeHTML { + my($self,$toencode) = @_; + return undef unless defined($toencode); + return $toencode if $self->{'dontescape'}; + $toencode=~s/&/&/g; + $toencode=~s/\"/"/g; + $toencode=~s/>/>/g; + $toencode=~s/</</g; + return $toencode; +} +END_OF_FUNC + + +# Internal procedure - don't use +'_tableize' => <<'END_OF_FUNC', +sub _tableize { + my($rows,$columns,$rowheaders,$colheaders,@elements) = @_; + my($result); + + $rows = int(0.99 + @elements/$columns) unless $rows; + # rearrange into a pretty table + $result = "<TABLE>"; + my($row,$column); + unshift(@$colheaders,'') if @$colheaders && @$rowheaders; + $result .= "<TR>" if @{$colheaders}; + foreach (@{$colheaders}) { + $result .= "<TH>$_</TH>"; + } + for ($row=0;$row<$rows;$row++) { + $result .= "<TR>"; + $result .= "<TH>$rowheaders->[$row]</TH>" if @$rowheaders; + for ($column=0;$column<$columns;$column++) { + $result .= "<TD>" . $elements[$column*$rows + $row] . "</TD>"; + } + $result .= "</TR>"; + } + $result .= "</TABLE>"; + 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 <INPUT TYPE="radio"> 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 $checked; + $name=$self->escapeHTML($name); + + my(@elements); + my(@values) = $values ? @$values : $self->param($name); + my($other) = @other ? " @other" : ''; + foreach (@values) { + my($checkit) = $checked eq $_ ? ' CHECKED' : ''; + my($break) = $linebreak ? '<BR>' : ''; + my($label)=''; + unless (defined($nolabels) && $nolabels) { + $label = $_; + $label = $labels->{$_} if defined($labels) && $labels->{$_}; + $label = $self->escapeHTML($label); + } + $_=$self->escapeHTML($_); + push(@elements,qq/<INPUT TYPE="radio" NAME="$name" VALUE="$_"$checkit$other>${label} ${break}/); + } + $self->register_parameter($name); + return wantarray ? @elements : join('',@elements) unless $columns; + 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 ? @$values : $self->param($name); + $result = qq/<SELECT NAME="$name"$other>\n/; + foreach (@values) { + my($selectit) = defined($selected) ? ($selected eq $_ ? 'SELECTED' : '' ) : ''; + my($label) = $_; + $label = $labels->{$_} if defined($labels) && $labels->{$_}; + my($value) = $self->escapeHTML($_); + $label=$self->escapeHTML($label); + $result .= "<OPTION $selectit VALUE=\"$value\">$label\n"; + } + + $result .= "</SELECT>\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); + my(@values) = $values ? @$values : $self->param($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/<SELECT NAME="$name"$has_size$is_multiple$other>\n/; + foreach (@values) { + my($selectit) = $selected{$_} ? 'SELECTED' : ''; + my($label) = $_; + $label = $labels->{$_} if defined($labels) && $labels->{$_}; + $label=$self->escapeHTML($label); + my($value)=$self->escapeHTML($_); + $result .= "<OPTION $selectit VALUE=\"$value\">$label\n"; + } + $result .= "</SELECT>\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 <INPUT TYPE="hidden" NAME="name" VALUE="value"> +#### +'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 ( 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/<INPUT TYPE="hidden" NAME="$name" VALUE="$_">/); + } + 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 <INPUT TYPE="image" NAME="name" SRC="url" ALIGN="alignment"> +#### +'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/<INPUT TYPE="image" NAME="$name" SRC="$src"$align$other>/; +} +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) = self_or_default(@_); + my($query_string) = $self->query_string; + my $protocol = $self->protocol(); + my $name = "$protocol://" . $self->server_name; + $name .= ":" . $self->server_port + unless $self->server_port == 80; + $name .= $self->script_name; + $name .= $self->path_info if $self->path_info; + return $name unless $query_string; + return "$name?$query_string"; +} +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) = self_or_default(@_); + my $protocol = $self->protocol(); + my $name = "$protocol://" . $self->server_name; + $name .= ":" . $self->server_port + unless $self->server_port == 80; + $name .= $self->script_name; + return $name; +} + +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-YY HH:MM:SS GMT (optional) +#### +'cookie' => <<'END_OF_FUNC', +# temporary, for debugging. +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); + + + # if no value is supplied, then we retrieve the + # value of the cookie, if any. For efficiency, we cache the parsed + # cookie in our state variables. + unless (defined($value)) { + unless ($self->{'.cookies'}) { + my(@pairs) = split("; ",$self->raw_cookie); + foreach (@pairs) { + my($key,$value) = split("="); + my(@values) = map unescape($_),split('&',$value); + $self->{'.cookies'}->{unescape($key)} = [@values]; + } + } + + # If no name is supplied, then retrieve the names of all our cookies. + return () unless $self->{'.cookies'}; + return wantarray ? @{$self->{'.cookies'}->{$name}} : $self->{'.cookies'}->{$name}->[0] + if defined($name) && $name ne ''; + return keys %{$self->{'.cookies'}}; + } + my(@values); + + # Pull out our parameters. + if (ref($value)) { + if (ref($value) eq 'ARRAY') { + @values = @$value; + } elsif (ref($value) eq 'HASH') { + @values = %$value; + } + } else { + @values = ($value); + } + @values = map escape($_),@values; + + # I.E. requires the path to be present. + ($path = $ENV{'SCRIPT_NAME'})=~s![^/]+$!! unless $path; + + my(@constant_values); + push(@constant_values,"domain=$domain") if $domain; + push(@constant_values,"path=$path") if $path; + push(@constant_values,"expires=".&expires($expires)) if $expires; + push(@constant_values,'secure') if $secure; + + my($key) = &escape($name); + my($cookie) = join("=",$key,join("&",@values)); + return join("; ",$cookie,@constant_values); +} +END_OF_FUNC + + +# This internal routine creates an expires string exactly some number of +# hours from the current time in GMT. This is the format +# required by Netscape cookies, and I think it works for the HTTP +# Expires: header as well. +'expires' => <<'END_OF_FUNC', +sub expires { + my($time) = @_; + my(@MON)=qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/; + my(@WDAY) = qw/Sunday Monday Tuesday Wednesday Thursday Friday Saturday/; + 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 || ($time eq 'now')) { + $offset = 0; + } elsif ($time=~/^([+-]?\d+)([mhdMy]?)/) { + $offset = ($mult{$2} || 1)*$1; + } else { + return $time; + } + my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime(time+$offset); + $year += 1900 unless $year < 100; + return sprintf("%s, %02d-%s-%02d %02d:%02d:%02d GMT", + $WDAY[$wday],$mday,$MON[$mon],$year,$hour,$min,$sec); +} +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 { + return $ENV{'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: cookie +# Returns the magic cookie for the session. +# To set the magic cookie for new transations, +# try print $q->header('-Set-cookie'=>'my cookie') +#### +'raw_cookie' => <<'END_OF_FUNC', +sub raw_cookie { + my($self) = self_or_CGI(@_); + 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 { + return http('host') || server_name(); +} +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 $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 $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 + +# -------------- 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->hidden('-name'=>'.cgifields', + '-values'=>[keys %{$self->{'.parametersToAdd'}}], + '-override'=>1); +} +END_OF_FUNC + +'read_from_cmdline' => <<'END_OF_FUNC', +sub read_from_cmdline { + require "shellwords.pl"; + my($input,@words); + my($query_string); + if (@ARGV) { + $input = join(" ",@ARGV); + } else { + print STDERR "(offline mode: enter name=value pairs on standard input)\n"; + chomp(@lines = <>); # remove newlines + $input = join(" ",@lines); + } + + # minimal handling of escape characters + $input=~s/\\=/%3D/g; + $input=~s/\\&/%26/g; + + @words = &shellwords($input); + 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) = @_; + my($buffer) = $self->new_MultipartBuffer($boundary,$length); + return unless $buffer; + my(%header,$body); + while (!$buffer->eof) { + %header = $buffer->readHeader; + + # In beta1 it was "Content-disposition". In beta2 it's "Content-Disposition" + # Sheesh. + my($key) = $header{'Content-disposition'} ? 'Content-disposition' : 'Content-Disposition'; + my($param)= $header{$key}=~/ name="([^\"]*)"/; + + # possible bug: our regular expression expects the filename= part to fall + # at the end of the line. Netscape doesn't escape quotation marks in file names!!! + my($filename) = $header{$key}=~/ 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; + } + + # 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. + my($tmpfile) = new TempFile; + my $tmp = $tmpfile->as_string; + + open (OUT,">$tmp") || die "CGI open of $tmpfile: $!\n"; + $CGI::DefaultClass->binmode(OUT) if $CGI::needs_binmode; + chmod 0666,$tmp; # make sure anyone can delete it. + my $data; + while ($data = $buffer->read) { + print OUT $data; + } + close OUT; + + # Now create a new filehandle in the caller's namespace. + # The name of this filehandle just happens to be identical + # to the original filename (NOT the name of the temporary + # file, which is hidden!) + my($filehandle); + if ($filename=~/^[a-zA-Z_]/) { + my($frame,$cp)=(1); + do { $cp = caller($frame++); } until !eval("'$cp'->isaCGI()"); + $filehandle = "$cp\:\:$filename"; + } else { + $filehandle = "\:\:$filename"; + } + + open($filehandle,$tmp) || die "CGI open of $tmp: $!\n"; + $CGI::DefaultClass->binmode($filehandle) if $CGI::needs_binmode; + + push(@{$self->{$param}},$filename); + + # Under Unix, it would be safe to let the temporary file + # be deleted immediately. However, I fear that other operating + # systems are not so forgiving. Therefore we save a reference + # to the temporary file in the CGI object so that the file + # isn't unlinked until the CGI object itself goes out of + # scope. This is a bit hacky, but it has the interesting side + # effect that one can access the name of the tmpfile by + # asking for $query->{$query->param('foo')}, where 'foo' + # is the name of the file upload field. + $self->{'.tmpfiles'}->{$filename}= { + name=>$tmpfile, + info=>{%header} + } + } +} +END_OF_FUNC + +'tmpFileName' => <<'END_OF_FUNC', +sub tmpFileName { + my($self,$filename) = self_or_default(@_); + return $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 + +); +END_OF_AUTOLOAD +; + +# Globals and stubs for other packages that we use +package MultipartBuffer; + +# how many bytes to read at a time. We use +# a 5K buffer by default. +$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; + +############################################################################### +################# 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) = @_; + 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 + $boundary = "--$boundary"; + # Read the topmost (boundary) line plus the CRLF + my($null) = ''; + $length -= $interface->read_from_client($IN,\$null,length($boundary)+2,0); + + } 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; + + return bless $self,ref $package || $package; +} +END_OF_FUNC + +'readHeader' => <<'END_OF_FUNC', +sub readHeader { + my($self) = @_; + my($end); + my($ok) = 0; + do { + $self->fillBuffer($FILLUNIT); + $ok++ if ($end = index($self->{BUFFER},"${CRLF}${CRLF}")) >= 0; + $ok++ if $self->{BUFFER} eq ''; + $FILLUNIT *= 2 if length($self->{BUFFER}) >= $FILLUNIT; + } until $ok; + + my($header) = substr($self->{BUFFER},0,$end+2); + substr($self->{BUFFER},0,$end+4) = ''; + my %return; + while ($header=~/^([\w-]+): (.*)$CRLF/mog) { + $return{$1}=$2; + } + 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}); + + # 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 Netscape Commerce 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; +unless ($TMPDIRECTORY) { + @TEMP=("${SL}usr${SL}tmp","${SL}var${SL}tmp","${SL}tmp","${SL}temp","${SL}Temporary Items"); + foreach (@TEMP) { + do {$TMPDIRECTORY = $_; last} if -d $_ && -w _; + } +} + +$TMPDIRECTORY = "." unless $TMPDIRECTORY; +$SEQUENCE="CGItemp${$}0000"; + +# 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) = @_; + $SEQUENCE++; + my $directory = "${TMPDIRECTORY}${SL}${SEQUENCE}"; + 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=<<EOF; + $CGI::VERSION; + $MultipartBuffer::SPIN_LOOP_MAX; + $MultipartBuffer::CRLF; + $MultipartBuffer::TIMEOUT; + $MultipartBuffer::FILLUNIT; + $TempFile::SEQUENCE; +EOF + ; +} + +$revision; + +__END__ + +=head1 NAME + +CGI - Simple Common Gateway Interface Class + +=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 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 INSTALLATION: + +To install this package, just change to the directory in which this +file is found and type the following: + + perl Makefile.PL + make + make install + +This will copy CGI.pm to your perl library directory for use by all +perl scripts. You probably must be root to do this. Now you can +load the CGI routines in your Perl scripts with the line: + + use CGI; + +If you don't have sufficient privileges to install CGI.pm in the Perl +library directory, you can put CGI.pm into some convenient spot, such +as your home directory, or in cgi-bin itself and prefix all Perl +scripts that call it with something along the lines of the following +preamble: + + use lib '/home/davis/lib'; + use CGI; + +If you are using a version of perl earlier than 5.002 (such as NT perl), use +this instead: + + BEGIN { + unshift(@INC,'/home/davis/lib'); + } + use CGI; + +The CGI distribution also comes with a cute module called L<CGI::Carp>. +It redefines the die(), warn(), confess() and croak() error routines +so that they write nicely formatted error messages into the server's +error log (or to the output stream of your choice). This avoids long +hours of groping through the error and access logs, trying to figure +out which CGI script is generating error messages. If you choose, +you can even have fatal error messages echoed to the browser to avoid +the annoying and uninformative "Server Error" message. + +=head1 DESCRIPTION + +=head2 CREATING A NEW QUERY OBJECT: + + $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 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'); + +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 <ISINDEX> 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 <ISINDEX> 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<import()>. As of version 2.20, +this name has been removed completely to avoid conflict with the built-in +Perl module B<import> 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. + +=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. + +=head2 SAVING THE STATE OF THE FORM 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<new>. 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. + +=head2 CREATING A SELF-REFERENCING URL THAT PRESERVES STATE INFORMATION: + + $myself = $query->self_url; + print "<A HREF=$myself>I'm talking to myself.</A>"; + +self_url() will return a URL, that, when selected, will reinvoke +this script with all its state information intact. This is most +useful when you want to jump around within the document using +internal anchors but you don't want to disrupt the current contents +of the form(s). Something like this will do the trick. + + $myself = $query->self_url; + print "<A HREF=$myself#table1>See table 1</A>"; + print "<A HREF=$myself#table2>See table 2</A>"; + print "<A HREF=$myself#yourself>See for yourself</A>"; + +If you don't want to get the whole query string, call +the method url() to return just the URL for the script: + + $myself = $query->url; + print "<A HREF=$myself>No query string in this baby!</A>\n"; + +You can also retrieve the unprocessed query string with query_string(): + + $the_string = $query->query_string; + +=head2 COMPATIBILITY WITH CGI-LIB.PL + +To make it easier to port existing programs that use cgi-lib.pl +the compatibility routine "ReadParse" is provided. Porting is +simple: + +OLD VERSION + require "cgi-lib.pl"; + &ReadParse; + print "The value of the antique is $in{antique}.\n"; + +NEW VERSION + use CGI; + CGI::ReadParse + print "The value of the antique is $in{antique}.\n"; + +CGI.pm's ReadParse() routine creates a tied variable named %in, +which can be accessed to obtain the query variables. Like +ReadParse, you can also provide your own variable. Infrequently +used features of ReadParse, such as the creation of @in and $in +variables, are not supported. + +Once you use ReadParse, you can retrieve the query object itself +this way: + + $q = $in{CGI}; + print $q->textfield(-name=>'wow', + -value=>'does this really work?'); + +This allows you to start using the more interesting features +of CGI.pm without rewriting your old scripts from scratch. + +=head2 CALLING CGI FUNCTIONS THAT TAKE MULTIPLE ARGUMENTS + +In versions of CGI.pm prior to 2.0, it could get difficult to remember +the proper order of arguments in CGI function calls that accepted five +or six different arguments. As of 2.0, there's a better way to pass +arguments to the various CGI functions. In this style, you pass a +series of name=>argument pairs, like this: + + $field = $query->radio_group(-name=>'OS', + -values=>[Unix,Windows,Macintosh], + -default=>'Unix'); + +The advantages of this style are that you don't have to remember the +exact order of the arguments, and if you leave out a parameter, in +most cases it will default to some reasonable value. If you provide +a parameter that the method doesn't recognize, it will usually do +something useful with it, such as incorporating it into the HTML form +tag. For example if Netscape decides next week to add a new +JUSTIFICATION parameter to the text field tags, you can start using +the feature without waiting for a new version of CGI.pm: + + $field = $query->textfield(-name=>'State', + -default=>'gaseous', + -justification=>'RIGHT'); + +This will result in an HTML tag that looks like this: + + <INPUT TYPE="textfield" NAME="State" VALUE="gaseous" + JUSTIFICATION="RIGHT"> + +Parameter names are case insensitive: you can use -name, or -Name or +-NAME. You don't have to use the hyphen if you don't want to. After +creating a CGI object, call the B<use_named_parameters()> 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'); + +Actually, CGI.pm only looks for a hyphen in the first parameter. So +you can leave it off subsequent parameters if you like. Something to +be wary of is the potential that a string constant like "values" will +collide with a keyword (and in fact it does!) While Perl usually +figures out when you're referring to a function and when you're +referring to a string, you probably should put quotation marks around +all string constants just to play it safe. + +=head2 CREATING THE HTTP HEADER: + + 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. If you want to +add additional fields to the header, just tack them on to the end: + + print $query->header('text/html','200 OK','Content-Length: 3002'); + +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 +parameters will be stripped of their initial hyphens and turned into +header fields, allowing you to specify any HTTP header you desire. + +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-96 00:40:33 GMT at the indicated time & date + +(CGI::expires() is the static function call used internally that turns +relative time intervals into HTTP dates. You can call it directly if +you wish.) + +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 INSTRUCTION + + print $query->redirect('http://somewhere.else/in/movie/land'); + +redirects the browser elsewhere. If you use redirection like this, +you should B<not> 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 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 use named parameters: + + 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 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'}, + -BGCOLOR=>'blue'); + + -or- + + print $query->start_html('Secrets of the Pyramids', + 'fred@capricorn.org','true', + 'BGCOLOR="blue"'); + +This will return a canned HTML header and the opening <BODY> 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 <BODY> tag. + +The argument B<-xbase> allows you to provide an HREF for the <BASE> 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 <META> tags that look something like this: + + <META NAME="keywords" CONTENT="pharaoh secret mummy"> + <META NAME="description" CONTENT="copyright 1996 King Tut"> + +There is no support for the HTTP-EQUIV type of <META> tag. This is +because you can modify the HTTP header directly with the B<header()> +method. + +JAVASCRIPTING: The B<-script>, B<-onLoad> 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 <SCRIPT> block inside +the HTML (not HTTP) header. The block is placed in the header in +order to give your page a fighting chance of having all its JavaScript +functions in place even if the user presses the stop button before the +page has loaded completely. CGI.pm attempts to format the script in +such a way that JavaScript-naive browsers will not choke on the code: +unfortunately there are some browsers, such as Chimera for Unix, that +get confused by it nevertheless. + +The B<-onLoad> and B<-onUnload> parameters point to fragments of JavaScript +code to execute when the page is respectively opened and closed by the +browser. Usually these parameters are calls to functions defined in the +B<-script> field: + + $query = new CGI; + print $query->header; + $JSCRIPT=<<END; + // Ask a silly question + function riddle_me_this() { + var r = prompt("What walks on four legs in the morning, " + + "two legs in the afternoon, " + + "and three legs in the evening?"); + response(r); + } + // Get a silly answer + function response(answer) { + if (answer == "man") + alert("Right you are!"); + else + alert("Wrong! Guess again."); + } + END + print $query->start_html(-title=>'The Riddle of the Sphinx', + -script=>$JSCRIPT); + +See + + http://home.netscape.com/eng/mozilla/2.0/handbook/javascript/ + +for more information about JavaScript. + +The old-style positional parameters are as follows: + +=over 4 + +=item B<Parameters:> + +=item 1. + +The title + +=item 2. + +The author's e-mail address (will create a <LINK REV="MADE"> tag if present + +=item 3. + +A 'true' flag if you want to include a <BASE> tag in the header. This +helps resolve relative addresses to absolute ones when the document is moved, +but makes the document hierarchy non-portable. Use with care! + +=item 4, 5, 6... + +Any other parameters you want to include in the <BODY> tag. This is a good +place to put Netscape extensions, such as colors and wallpaper patterns. + +=back + +=head2 ENDING THE HTML DOCUMENT: + + print $query->end_html + +This ends an HTML document by printing the </BODY></HTML> tags. + +=head1 CREATING FORMS: + +I<General note> The various form-creating methods all return strings +to the caller, containing the tag or tags that will create the requested +form element. You are responsible for actually printing out these strings. +It's set up this way so that you can place formatting tags +around the form elements. + +I<Another note> The default values that you specify for the forms are only +used the B<first> time the script is invoked (when there is no query +string). On subsequent invocations of the script (when there is a query +string), the former values are used even if they are blank. + +If you want to change the value of a field from its previous value, you have two +choices: + +(1) call the param() method to set it. + +(2) use the -override (alias -force) parameter (a new feature in version 2.15). +This forces the default value to be used, regardless of the previous value: + + print $query->textfield(-name=>'field_name', + -default=>'starting value', + -override=>1, + -size=>50, + -maxlength=>80); + +I<Yet another note> By default, the text and labels of form elements are +escaped according to HTML rules. This means that you can safely use +"<CLICK ME>" as the label for a button. However, it also interferes with +your ability to incorporate special HTML character sequences, such as Á, +into your fields. If you wish to turn off automatic escaping, call the +autoEscape() method with a false value immediately after creating the CGI object: + + $query = new CGI; + $query->autoEscape(undef); + + +=head2 CREATING AN ISINDEX TAG + + print $query->isindex(-action=>$action); + + -or- + + print $query->isindex($action); + +Prints out an <ISINDEX> tag. Not very exciting. The parameter +-action specifies the URL of the script to process the query. The +default is to process the query with the current script. + +=head2 STARTING AND ENDING A FORM + + print $query->startform(-method=>$method, + -action=>$action, + -encoding=>$encoding); + <... various form stuff ...> + print $query->endform; + + -or- + + print $query->startform($method,$action,$encoding); + <... various form stuff ...> + print $query->endform; + +startform() will return a <FORM> tag with the optional method, +action and form encoding that you specify. The defaults are: + + method: POST + action: this script + encoding: application/x-www-form-urlencoded + +endform() returns the closing </FORM> tag. + +Startform()'s encoding method tells the browser how to package the various +fields of the form before sending the form to the server. Two +values are possible: + +=over 4 + +=item B<application/x-www-form-urlencoded> + +This is the older type of encoding used by all browsers prior to +Netscape 2.0. It is compatible with many CGI scripts and is +suitable for short fields containing text data. For your +convenience, CGI.pm stores the name of this encoding +type in B<$CGI::URL_ENCODED>. + +=item B<multipart/form-data> + +This is the newer type of encoding introduced by Netscape 2.0. +It is suitable for forms that contain very large fields or that +are intended for transferring binary data. Most importantly, +it enables the "file upload" feature of Netscape 2.0 forms. For +your convenience, CGI.pm stores the name of this encoding type +in B<$CGI::MULTIPART> + +Forms that use this type of encoding are not easily interpreted +by CGI scripts unless they use CGI.pm or another library designed +to handle them. + +=back + +For compatibility, the startform() method uses the older form of +encoding by default. If you want to use the newer form of encoding +by default, you can call B<start_multipart_form()> instead of +B<startform()>. + +JAVASCRIPTING: The B<-name> and B<-onSubmit> parameters are provided +for use with JavaScript. The -name parameter gives the +form a name so that it can be identified and manipulated by +JavaScript functions. -onSubmit should point to a JavaScript +function that will be executed just before the form is submitted to your +server. You can use this opportunity to check the contents of the form +for consistency and completeness. If you find something wrong, you +can put up an alert box or maybe fix things up yourself. You can +abort the submission by returning false from this function. + +Usually the bulk of JavaScript functions are defined in a <SCRIPT> +block in the HTML header and -onSubmit points to one of these function +call. See start_html() for details. + +=head2 CREATING A TEXT FIELD + + print $query->textfield(-name=>'field_name', + -default=>'starting value', + -size=>50, + -maxlength=>80); + -or- + + print $query->textfield('field_name','starting value',50,80); + +textfield() will return a text input field. + +=over 4 + +=item B<Parameters> + +=item 1. + +The first parameter is the required name for the field (-name). + +=item 2. + +The optional second parameter is the default starting value for the field +contents (-default). + +=item 3. + +The optional third parameter is the size of the field in + characters (-size). + +=item 4. + +The optional fourth parameter is the maximum number of characters the + field will accept (-maxlength). + +=back + +As with all these methods, the field will be initialized with its +previous contents from earlier invocations of the script. +When the form is processed, the value of the text field can be +retrieved with: + + $value = $query->param('foo'); + +If you want to reset it from its initial value after the script has been +called once, you can do so like this: + + $query->param('foo',"I'm taking over this value!"); + +NEW AS OF VERSION 2.15: If you don't want the field to take on its previous +value, you can force its current value by using the -override (alias -force) +parameter: + + print $query->textfield(-name=>'field_name', + -default=>'starting value', + -override=>1, + -size=>50, + -maxlength=>80); + +JAVASCRIPTING: You can also provide B<-onChange>, B<-onFocus>, B<-onBlur> +and B<-onSelect> parameters to register JavaScript event handlers. +The onChange handler will be called whenever the user changes the +contents of the text field. You can do text validation if you like. +onFocus and onBlur are called respectively when the insertion point +moves into and out of the text field. onSelect is called when the +user changes the portion of the text that is selected. + +=head2 CREATING A BIG TEXT FIELD + + print $query->textarea(-name=>'foo', + -default=>'starting value', + -rows=>10, + -columns=>50); + + -or + + print $query->textarea('foo','starting value',10,50); + +textarea() is just like textfield, but it allows you to specify +rows and columns for a multiline text entry box. You can provide +a starting value for the field, which can be long and contain +multiple lines. + +JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur> +and B<-onSelect> parameters are recognized. See textfield(). + +=head2 CREATING A PASSWORD FIELD + + print $query->password_field(-name=>'secret', + -value=>'starting value', + -size=>50, + -maxlength=>80); + -or- + + print $query->password_field('secret','starting value',50,80); + +password_field() is identical to textfield(), except that its contents +will be starred out on the web page. + +JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur> +and B<-onSelect> parameters are recognized. See textfield(). + +=head2 CREATING A FILE UPLOAD FIELD + + print $query->filefield(-name=>'uploaded_file', + -default=>'starting value', + -size=>50, + -maxlength=>80); + -or- + + print $query->filefield('uploaded_file','starting value',50,80); + +filefield() will return a file upload field for Netscape 2.0 browsers. +In order to take full advantage of this I<you must use the new +multipart encoding scheme> for the form. You can do this either +by calling B<startform()> with an encoding type of B<$CGI::MULTIPART>, +or by calling the new method B<start_multipart_form()> instead of +vanilla B<startform()>. + +=over 4 + +=item B<Parameters> + +=item 1. + +The first parameter is the required name for the field (-name). + +=item 2. + +The optional second parameter is the starting value for the field contents +to be used as the default file name (-default). + +The beta2 version of Netscape 2.0 currently doesn't pay any attention +to this field, and so the starting value will always be blank. Worse, +the field loses its "sticky" behavior and forgets its previous +contents. The starting value field is called for in the HTML +specification, however, and possibly later versions of Netscape will +honor it. + +=item 3. + +The optional third parameter is the size of the field in +characters (-size). + +=item 4. + +The optional fourth parameter is the maximum number of characters the +field will accept (-maxlength). + +=back + +When the form is processed, you can retrieve the entered filename +by calling param(). + + $filename = $query->param('uploaded_file'); + +In Netscape Gold, the filename that gets returned is the full local filename +on the B<remote user's> machine. If the remote user is on a Unix +machine, the filename will follow Unix conventions: + + /path/to/the/file + +On an MS-DOS/Windows and OS/2 machines, the filename will follow DOS conventions: + + C:\PATH\TO\THE\FILE.MSW + +On a Macintosh machine, the filename will follow Mac conventions: + + HD 40:Desktop Folder:Sort Through:Reminders + +The filename returned is also a file handle. You can read the contents +of the file using standard Perl file reading calls: + + # Read a text file and print it out + while (<$filename>) { + print; + } + + # Copy a binary file to somewhere safe + open (OUTFILE,">>/usr/local/web/users/feedback"); + while ($bytesread=read($filename,$buffer,1024)) { + print OUTFILE $buffer; + } + +When a file is uploaded the browser usually sends along some +information along with it in the format of headers. The information +usually includes the MIME content type. Future browsers may send +other information as well (such as modification date and size). To +retrieve this information, call uploadInfo(). It returns a reference to +an associative array containing all the document headers. + + $filename = $query->param('uploaded_file'); + $type = $query->uploadInfo($filename)->{'Content-Type'}; + unless ($type eq 'text/html') { + die "HTML FILES ONLY!"; + } + +If you are using a machine that recognizes "text" and "binary" data +modes, be sure to understand when and how to use them (see the Camel book). +Otherwise you may find that binary files are corrupted during file uploads. + +JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur> +and B<-onSelect> parameters are recognized. See textfield() +for details. + +=head2 CREATING A POPUP MENU + + print $query->popup_menu('menu_name', + ['eenie','meenie','minie'], + 'meenie'); + + -or- + + %labels = ('eenie'=>'your first choice', + 'meenie'=>'your second choice', + 'minie'=>'your third choice'); + print $query->popup_menu('menu_name', + ['eenie','meenie','minie'], + 'meenie',\%labels); + + -or (named parameter style)- + + print $query->popup_menu(-name=>'menu_name', + -values=>['eenie','meenie','minie'], + -default=>'meenie', + -labels=>\%labels); + +popup_menu() creates a menu. + +=over 4 + +=item 1. + +The required first argument is the menu's name (-name). + +=item 2. + +The required second argument (-values) is an array B<reference> +containing the list of menu items in the menu. You can pass the +method an anonymous array, as shown in the example, or a reference to +a named array, such as "\@foo". + +=item 3. + +The optional third parameter (-default) is the name of the default +menu choice. If not specified, the first item will be the default. +The values of the previous choice will be maintained across queries. + +=item 4. + +The optional fourth parameter (-labels) is provided for people who +want to use different values for the user-visible label inside the +popup menu nd the value returned to your script. It's a pointer to an +associative array relating menu values to user-visible labels. If you +leave this parameter blank, the menu values will be displayed by +default. (You can also leave a label undefined if you want to). + +=back + +When the form is processed, the selected value of the popup menu can +be retrieved using: + + $popup_menu_value = $query->param('menu_name'); + +JAVASCRIPTING: popup_menu() recognizes the following event handlers: +B<-onChange>, B<-onFocus>, and B<-onBlur>. See the textfield() +section for details on when these handlers are called. + +=head2 CREATING A SCROLLING LIST + + print $query->scrolling_list('list_name', + ['eenie','meenie','minie','moe'], + ['eenie','moe'],5,'true'); + -or- + + print $query->scrolling_list('list_name', + ['eenie','meenie','minie','moe'], + ['eenie','moe'],5,'true', + \%labels); + + -or- + + print $query->scrolling_list(-name=>'list_name', + -values=>['eenie','meenie','minie','moe'], + -default=>['eenie','moe'], + -size=>5, + -multiple=>'true', + -labels=>\%labels); + +scrolling_list() creates a scrolling list. + +=over 4 + +=item B<Parameters:> + +=item 1. + +The first and second arguments are the list name (-name) and values +(-values). As in the popup menu, the second argument should be an +array reference. + +=item 2. + +The optional third argument (-default) can be either a reference to a +list containing the values to be selected by default, or can be a +single value to select. If this argument is missing or undefined, +then nothing is selected when the list first appears. In the named +parameter version, you can use the synonym "-defaults" for this +parameter. + +=item 3. + +The optional fourth argument is the size of the list (-size). + +=item 4. + +The optional fifth argument can be set to true to allow multiple +simultaneous selections (-multiple). Otherwise only one selection +will be allowed at a time. + +=item 5. + +The optional sixth argument is a pointer to an associative array +containing long user-visible labels for the list items (-labels). +If not provided, the values will be displayed. + +When this form is processed, all selected list items will be returned as +a list under the parameter name 'list_name'. The values of the +selected items can be retrieved with: + + @selected = $query->param('list_name'); + +=back + +JAVASCRIPTING: scrolling_list() recognizes the following event handlers: +B<-onChange>, B<-onFocus>, and B<-onBlur>. See textfield() for +the description of when these handlers are called. + +=head2 CREATING A GROUP OF RELATED CHECKBOXES + + print $query->checkbox_group(-name=>'group_name', + -values=>['eenie','meenie','minie','moe'], + -default=>['eenie','moe'], + -linebreak=>'true', + -labels=>\%labels); + + print $query->checkbox_group('group_name', + ['eenie','meenie','minie','moe'], + ['eenie','moe'],'true',\%labels); + + HTML3-COMPATIBLE BROWSERS ONLY: + + print $query->checkbox_group(-name=>'group_name', + -values=>['eenie','meenie','minie','moe'], + -rows=2,-columns=>2); + + +checkbox_group() creates a list of checkboxes that are related +by the same name. + +=over 4 + +=item B<Parameters:> + +=item 1. + +The first and second arguments are the checkbox name and values, +respectively (-name and -values). As in the popup menu, the second +argument should be an array reference. These values are used for the +user-readable labels printed next to the checkboxes as well as for the +values passed to your script in the query string. + +=item 2. + +The optional third argument (-default) can be either a reference to a +list containing the values to be checked by default, or can be a +single value to checked. If this argument is missing or undefined, +then nothing is selected when the list first appears. + +=item 3. + +The optional fourth argument (-linebreak) can be set to true to place +line breaks between the checkboxes so that they appear as a vertical +list. Otherwise, they will be strung together on a horizontal line. + +=item 4. + +The optional fifth argument is a pointer to an associative array +relating the checkbox values to the user-visible labels that will will +be printed next to them (-labels). If not provided, the values will +be used as the default. + +=item 5. + +B<HTML3-compatible browsers> (such as Netscape) can take advantage +of the optional +parameters B<-rows>, and B<-columns>. These parameters cause +checkbox_group() to return an HTML3 compatible table containing +the checkbox group formatted with the specified number of rows +and columns. You can provide just the -columns parameter if you +wish; checkbox_group will calculate the correct number of rows +for you. + +To include row and column headings in the returned table, you +can use the B<-rowheader> and B<-colheader> parameters. Both +of these accept a pointer to an array of headings to use. +The headings are just decorative. They don't reorganize the +interpretation of the checkboxes -- they're still a single named +unit. + +=back + +When the form is processed, all checked boxes will be returned as +a list under the parameter name 'group_name'. The values of the +"on" checkboxes can be retrieved with: + + @turned_on = $query->param('group_name'); + +The value returned by checkbox_group() is actually an array of button +elements. You can capture them and use them within tables, lists, +or in other creative ways: + + @h = $query->checkbox_group(-name=>'group_name',-values=>\@values); + &use_in_creative_way(@h); + +JAVASCRIPTING: checkbox_group() recognizes the B<-onClick> +parameter. This specifies a JavaScript code fragment or +function call to be executed every time the user clicks on +any of the buttons in the group. You can retrieve the identity +of the particular button clicked on using the "this" variable. + +=head2 CREATING A STANDALONE CHECKBOX + + print $query->checkbox(-name=>'checkbox_name', + -checked=>'checked', + -value=>'ON', + -label=>'CLICK ME'); + + -or- + + print $query->checkbox('checkbox_name','checked','ON','CLICK ME'); + +checkbox() is used to create an isolated checkbox that isn't logically +related to any others. + +=over 4 + +=item B<Parameters:> + +=item 1. + +The first parameter is the required name for the checkbox (-name). It +will also be used for the user-readable label printed next to the +checkbox. + +=item 2. + +The optional second parameter (-checked) specifies that the checkbox +is turned on by default. Synonyms are -selected and -on. + +=item 3. + +The optional third parameter (-value) specifies the value of the +checkbox when it is checked. If not provided, the word "on" is +assumed. + +=item 4. + +The optional fourth parameter (-label) is the user-readable label to +be attached to the checkbox. If not provided, the checkbox name is +used. + +=back + +The value of the checkbox can be retrieved using: + + $turned_on = $query->param('checkbox_name'); + +JAVASCRIPTING: checkbox() recognizes the B<-onClick> +parameter. See checkbox_group() for further details. + +=head2 CREATING A RADIO BUTTON GROUP + + print $query->radio_group(-name=>'group_name', + -values=>['eenie','meenie','minie'], + -default=>'meenie', + -linebreak=>'true', + -labels=>\%labels); + + -or- + + print $query->radio_group('group_name',['eenie','meenie','minie'], + 'meenie','true',\%labels); + + + HTML3-COMPATIBLE BROWSERS ONLY: + + print $query->radio_group(-name=>'group_name', + -values=>['eenie','meenie','minie','moe'], + -rows=2,-columns=>2); + +radio_group() creates a set of logically-related radio buttons +(turning one member of the group on turns the others off) + +=over 4 + +=item B<Parameters:> + +=item 1. + +The first argument is the name of the group and is required (-name). + +=item 2. + +The second argument (-values) is the list of values for the radio +buttons. The values and the labels that appear on the page are +identical. Pass an array I<reference> in the second argument, either +using an anonymous array, as shown, or by referencing a named array as +in "\@foo". + +=item 3. + +The optional third parameter (-default) is the name of the default +button to turn on. If not specified, the first item will be the +default. You can provide a nonexistent button name, such as "-" to +start up with no buttons selected. + +=item 4. + +The optional fourth parameter (-linebreak) can be set to 'true' to put +line breaks between the buttons, creating a vertical list. + +=item 5. + +The optional fifth parameter (-labels) is a pointer to an associative +array relating the radio button values to user-visible labels to be +used in the display. If not provided, the values themselves are +displayed. + +=item 6. + +B<HTML3-compatible browsers> (such as Netscape) can take advantage +of the optional +parameters B<-rows>, and B<-columns>. These parameters cause +radio_group() to return an HTML3 compatible table containing +the radio group formatted with the specified number of rows +and columns. You can provide just the -columns parameter if you +wish; radio_group will calculate the correct number of rows +for you. + +To include row and column headings in the returned table, you +can use the B<-rowheader> and B<-colheader> parameters. Both +of these accept a pointer to an array of headings to use. +The headings are just decorative. They don't reorganize the +interpetation of the radio buttons -- they're still a single named +unit. + +=back + +When the form is processed, the selected radio button can +be retrieved using: + + $which_radio_button = $query->param('group_name'); + +The value returned by radio_group() is actually an array of button +elements. You can capture them and use them within tables, lists, +or in other creative ways: + + @h = $query->radio_group(-name=>'group_name',-values=>\@values); + &use_in_creative_way(@h); + +=head2 CREATING A SUBMIT BUTTON + + print $query->submit(-name=>'button_name', + -value=>'value'); + + -or- + + print $query->submit('button_name','value'); + +submit() will create the query submission button. Every form +should have one of these. + +=over 4 + +=item B<Parameters:> + +=item 1. + +The first argument (-name) is optional. You can give the button a +name if you have several submission buttons in your form and you want +to distinguish between them. The name will also be used as the +user-visible label. Be aware that a few older browsers don't deal with this correctly and +B<never> send back a value from a button. + +=item 2. + +The second argument (-value) is also optional. This gives the button +a value that will be passed to your script in the query string. + +=back + +You can figure out which button was pressed by using different +values for each one: + + $which_one = $query->param('button_name'); + +JAVASCRIPTING: radio_group() recognizes the B<-onClick> +parameter. See checkbox_group() for further details. + +=head2 CREATING A RESET BUTTON + + print $query->reset + +reset() creates the "reset" button. Note that it restores the +form to its value from the last time the script was called, +NOT necessarily to the defaults. + +=head2 CREATING A DEFAULT BUTTON + + print $query->defaults('button_label') + +defaults() creates a button that, when invoked, will cause the +form to be completely reset to its defaults, wiping out all the +changes the user ever made. + +=head2 CREATING A HIDDEN FIELD + + print $query->hidden(-name=>'hidden_name', + -default=>['value1','value2'...]); + + -or- + + print $query->hidden('hidden_name','value1','value2'...); + +hidden() produces a text field that can't be seen by the user. It +is useful for passing state variable information from one invocation +of the script to the next. + +=over 4 + +=item B<Parameters:> + +=item 1. + +The first argument is required and specifies the name of this +field (-name). + +=item 2. + +The second argument is also required and specifies its value +(-default). In the named parameter style of calling, you can provide +a single value here or a reference to a whole list + +=back + +Fetch the value of a hidden field this way: + + $hidden_value = $query->param('hidden_name'); + +Note, that just like all the other form elements, the value of a +hidden field is "sticky". If you want to replace a hidden field with +some other values after the script has been called once you'll have to +do it manually: + + $query->param('hidden_name','new','values','here'); + +=head2 CREATING A CLICKABLE IMAGE BUTTON + + print $query->image_button(-name=>'button_name', + -src=>'/source/URL', + -align=>'MIDDLE'); + + -or- + + print $query->image_button('button_name','/source/URL','MIDDLE'); + +image_button() produces a clickable image. When it's clicked on the +position of the click is returned to your script as "button_name.x" +and "button_name.y", where "button_name" is the name you've assigned +to it. + +JAVASCRIPTING: image_button() recognizes the B<-onClick> +parameter. See checkbox_group() for further details. + +=over 4 + +=item B<Parameters:> + +=item 1. + +The first argument (-name) is required and specifies the name of this +field. + +=item 2. + +The second argument (-src) is also required and specifies the URL + +=item 3. +The third option (-align, optional) is an alignment type, and may be +TOP, BOTTOM or MIDDLE + +=back + +Fetch the value of the button this way: + $x = $query->param('button_name.x'); + $y = $query->param('button_name.y'); + +=head2 CREATING A JAVASCRIPT ACTION BUTTON + + print $query->button(-name=>'button_name', + -value=>'user visible label', + -onClick=>"do_something()"); + + -or- + + print $query->button('button_name',"do_something()"); + +button() produces a button that is compatible with Netscape 2.0's +JavaScript. When it's pressed the fragment of JavaScript code +pointed to by the B<-onClick> parameter will be executed. On +non-Netscape browsers this form element will probably not even +display. + +=head1 NETSCAPE COOKIES + +Netscape browsers versions 1.1 and higher support a so-called +"cookie" designed to help maintain state within a browser session. +CGI.pm has several methods that support cookies. + +A cookie is a name=value pair much like the named parameters in a CGI +query string. CGI scripts create one or more cookies and send +them to the browser in the HTTP header. The browser maintains a list +of cookies that belong to a particular Web server, and returns them +to the CGI script during subsequent interactions. + +In addition to the required name=value pair, each cookie has several +optional attributes: + +=over 4 + +=item 1. an expiration time + +This is a time/date string (in a special GMT format) that indicates +when a cookie expires. The cookie will be saved and returned to your +script until this expiration date is reached if the user exits +Netscape and restarts it. If an expiration date isn't specified, the cookie +will remain active until the user quits Netscape. + +=item 2. a domain + +This is a partial or complete domain name for which the cookie is +valid. The browser will return the cookie to any host that matches +the partial domain name. For example, if you specify a domain name +of ".capricorn.com", then Netscape will return the cookie to +Web servers running on any of the machines "www.capricorn.com", +"www2.capricorn.com", "feckless.capricorn.com", etc. Domain names +must contain at least two periods to prevent attempts to match +on top level domains like ".edu". If no domain is specified, then +the browser will only return the cookie to servers on the host the +cookie originated from. + +=item 3. a path + +If you provide a cookie path attribute, the browser will check it +against your script's URL before returning the cookie. For example, +if you specify the path "/cgi-bin", then the cookie will be returned +to each of the scripts "/cgi-bin/tally.pl", "/cgi-bin/order.pl", +and "/cgi-bin/customer_service/complain.pl", but not to the script +"/cgi-private/site_admin.pl". By default, path is set to "/", which +causes the cookie to be sent to any CGI script on your site. + +=item 4. a "secure" flag + +If the "secure" attribute is set, the cookie will only be sent to your +script if the CGI request is occurring on a secure channel, such as SSL. + +=back + +The interface to Netscape cookies is the B<cookie()> method: + + $cookie = $query->cookie(-name=>'sessionID', + -value=>'xyzzy', + -expires=>'+1h', + -path=>'/cgi-bin/database', + -domain=>'.capricorn.org', + -secure=>1); + print $query->header(-cookie=>$cookie); + +B<cookie()> creates a new cookie. Its parameters include: + +=over 4 + +=item B<-name> + +The name of the cookie (required). This can be any string at all. +Although Netscape limits its cookie names to non-whitespace +alphanumeric characters, CGI.pm removes this restriction by escaping +and unescaping cookies behind the scenes. + +=item B<-value> + +The value of the cookie. This can be any scalar value, +array reference, or even associative array reference. For example, +you can store an entire associative array into a cookie this way: + + $cookie=$query->cookie(-name=>'family information', + -value=>\%childrens_ages); + +=item B<-path> + +The optional partial path for which this cookie will be valid, as described +above. + +=item B<-domain> + +The optional partial domain for which this cookie will be valid, as described +above. + +=item B<-expires> + +The optional expiration date for this cookie. The format is as described +in the section on the B<header()> method: + + "+1h" one hour from now + +=item B<-secure> + +If set to true, this cookie will only be used within a secure +SSL session. + +=back + +The cookie created by cookie() must be incorporated into the HTTP +header within the string returned by the header() method: + + print $query->header(-cookie=>$my_cookie); + +To create multiple cookies, give header() an array reference: + + $cookie1 = $query->cookie(-name=>'riddle_name', + -value=>"The Sphynx's Question"); + $cookie2 = $query->cookie(-name=>'answers', + -value=>\%answers); + print $query->header(-cookie=>[$cookie1,$cookie2]); + +To retrieve a cookie, request it by name by calling cookie() +method without the B<-value> parameter: + + use CGI; + $query = new CGI; + %answers = $query->cookie(-name=>'answers'); + # $query->cookie('answers') will work too! + +The cookie and CGI namespaces are separate. If you have a parameter +named 'answers' and a cookie named 'answers', the values retrieved by +param() and cookie() are independent of each other. However, it's +simple to turn a CGI parameter into a cookie, and vice-versa: + + # turn a CGI parameter into a cookie + $c=$q->cookie(-name=>'answers',-value=>[$q->param('answers')]); + # vice-versa + $q->param(-name=>'answers',-value=>[$q->cookie('answers')]); + +See the B<cookie.cgi> example script for some ideas on how to use +cookies effectively. + +B<NOTE:> There appear to be some (undocumented) restrictions on +Netscape cookies. In Netscape 2.01, at least, I haven't been able to +set more than three cookies at a time. There may also be limits on +the length of cookies. If you need to store a lot of information, +it's probably better to create a unique session ID, store it in a +cookie, and use the session ID to locate an external file/database +saved on the server's side of the connection. + +=head1 WORKING WITH NETSCAPE FRAMES + +It's possible for CGI.pm scripts to write into several browser +panels and windows using Netscape's frame mechanism. +There are three techniques for defining new frames programmatically: + +=over 4 + +=item 1. Create a <Frameset> document + +After writing out the HTTP header, instead of creating a standard +HTML document using the start_html() call, create a <FRAMESET> +document that defines the frames on the page. Specify your script(s) +(with appropriate parameters) as the SRC for each of the frames. + +There is no specific support for creating <FRAMESET> sections +in CGI.pm, but the HTML is very simple to write. See the frame +documentation in Netscape's home pages for details + + http://home.netscape.com/assist/net_sites/frames.html + +=item 2. Specify the destination for the document in the HTTP header + +You may provide a B<-target> parameter to the header() method: + + print $q->header(-target=>'ResultsWindow'); + +This will tell Netscape to load the output of your script into the +frame named "ResultsWindow". If a frame of that name doesn't +already exist, Netscape will pop up a new window and load your +script's document into that. There are a number of magic names +that you can use for targets. See the frame documents on Netscape's +home pages for details. + +=item 3. Specify the destination for the document in the <FORM> tag + +You can specify the frame to load in the FORM tag itself. With +CGI.pm it looks like this: + + print $q->startform(-target=>'ResultsWindow'); + +When your script is reinvoked by the form, its output will be loaded +into the frame named "ResultsWindow". If one doesn't already exist +a new window will be created. + +=back + +The script "frameset.cgi" in the examples directory shows one way to +create pages in which the fill-out form and the response live in +side-by-side frames. + +=head1 DEBUGGING + +If you are running the script +from the command line or in the perl debugger, you can pass the script +a list of keywords or parameter=value pairs on the command line or +from standard input (you don't have to worry about tricking your +script into reading from environment variables). +You can pass keywords like this: + + your_script.pl keyword1 keyword2 keyword3 + +or this: + + your_script.pl keyword1+keyword2+keyword3 + +or this: + + your_script.pl name1=value1 name2=value2 + +or this: + + your_script.pl name1=value1&name2=value2 + +or even as newline-delimited parameters on standard input. + +When debugging, you can use quotes and backslashes to escape +characters in the familiar shell manner, letting you place +spaces and other funny characters in your parameter=value +pairs: + + your_script.pl "name1='I am a long value'" "name2=two\ words" + +=head2 DUMPING OUT ALL THE NAME/VALUE PAIRS + +The dump() method produces a string consisting of all the query's +name/value pairs formatted nicely as a nested list. This is useful +for debugging purposes: + + print $query->dump + + +Produces something that looks like: + + <UL> + <LI>name1 + <UL> + <LI>value1 + <LI>value2 + </UL> + <LI>name2 + <UL> + <LI>value1 + </UL> + </UL> + +You can pass a value of 'true' to dump() in order to get it to +print the results out as plain text, suitable for incorporating +into a <PRE> section. + +As a shortcut, as of version 1.56 you can interpolate the entire +CGI object into a string and it will be replaced with the +the a nice HTML dump shown above: + + $query=new CGI; + print "<H2>Current Values</H2> $query\n"; + +=head1 FETCHING ENVIRONMENT VARIABLES + +Some of the more useful environment variables can be fetched +through this interface. The methods are as follows: + +=over 4 + +=item B<accept()> + +Return a list of MIME types that the remote browser +accepts. If you give this method a single argument +corresponding to a MIME type, as in +$query->accept('text/html'), it will return a +floating point value corresponding to the browser's +preference for this type from 0.0 (don't want) to 1.0. +Glob types (e.g. text/*) in the browser's accept list +are handled correctly. + +=item B<raw_cookie()> + +Returns the HTTP_COOKIE variable, an HTTP extension +implemented by Netscape browsers version 1.1 +and higher. Cookies have a special format, and this +method call just returns the raw form (?cookie dough). +See cookie() for ways of setting and retrieving +cooked cookies. + +=item B<user_agent()> + +Returns the HTTP_USER_AGENT variable. If you give +this method a single argument, it will attempt to +pattern match on it, allowing you to do something +like $query->user_agent(netscape); + +=item B<path_info()> + +Returns additional path information from the script URL. +E.G. fetching /cgi-bin/your_script/additional/stuff will +result in $query->path_info() returning +"additional/stuff". + +NOTE: The Microsoft Internet Information Server +is broken with respect to additional path information. If +you use the Perl DLL library, the IIS server will attempt to +execute the additional path information as a Perl script. +If you use the ordinary file associations mapping, the +path information will be present in the environment, +but incorrect. The best thing to do is to avoid using additional +path information in CGI scripts destined for use with IIS. + +=item B<path_translated()> + +As per path_info() but returns the additional +path information translated into a physical path, e.g. +"/usr/local/etc/httpd/htdocs/additional/stuff". + +The Microsoft IIS is broken with respect to the translated +path as well. + +=item B<remote_host()> + +Returns either the remote host name or IP address. +if the former is unavailable. + +=item B<script_name()> +Return the script name as a partial URL, for self-refering +scripts. + +=item B<referer()> + +Return the URL of the page the browser was viewing +prior to fetching your script. Not available for all +browsers. + +=item B<auth_type ()> + +Return the authorization/verification method in use for this +script, if any. + +=item B<server_name ()> + +Returns the name of the server, usually the machine's host +name. + +=item B<virtual_host ()> + +When using virtual hosts, returns the name of the host that +the browser attempted to contact + +=item B<server_software ()> + +Returns the server software and version number. + +=item B<remote_user ()> + +Return the authorization/verification name used for user +verification, if this script is protected. + +=item B<user_name ()> + +Attempt to obtain the remote user's name, using a variety +of different techniques. This only works with older browsers +such as Mosaic. Netscape does not reliably report the user +name! + +=item B<request_method()> + +Returns the method used to access your script, usually +one of 'POST', 'GET' or 'HEAD'. + +=back + +=head1 CREATING HTML ELEMENTS: + +In addition to its shortcuts for creating form elements, CGI.pm +defines general HTML shortcut methods as well. HTML shortcuts are +named after a single HTML element and return a fragment of HTML text +that you can then print or manipulate as you like. + +This example shows how to use the HTML methods: + + $q = new CGI; + print $q->blockquote( + "Many years ago on the island of", + $q->a({href=>"http://crete.org/"},"Crete"), + "there lived a minotaur named", + $q->strong("Fred."), + ), + $q->hr; + +This results in the following HTML code (extra newlines have been +added for readability): + + <blockquote> + Many years ago on the island of + <a HREF="http://crete.org/">Crete</a> there lived + a minotaur named <strong>Fred.</strong> + </blockquote> + <hr> + +If you find the syntax for calling the HTML shortcuts awkward, you can +import them into your namespace and dispense with the object syntax +completely (see the next section for more details): + + use CGI shortcuts; # IMPORT HTML SHORTCUTS + print blockquote( + "Many years ago on the island of", + a({href=>"http://crete.org/"},"Crete"), + "there lived a minotaur named", + strong("Fred."), + ), + hr; + +=head2 PROVIDING ARGUMENTS TO HTML SHORTCUTS + +The HTML methods will accept zero, one or multiple arguments. If you +provide no arguments, you get a single tag: + + print hr; + # gives "<hr>" + +If you provide one or more string arguments, they are concatenated +together with spaces and placed between opening and closing tags: + + print h1("Chapter","1"); + # gives "<h1>Chapter 1</h1>" + +If the first argument is an associative array reference, then the keys +and values of the associative array become the HTML tag's attributes: + + print a({href=>'fred.html',target=>'_new'}, + "Open a new frame"); + # gives <a href="fred.html",target="_new">Open a new frame</a> + +You are free to use CGI.pm-style dashes in front of the attribute +names if you prefer: + + print img {-src=>'fred.gif',-align=>'LEFT'}; + # gives <img ALIGN="LEFT" SRC="fred.gif"> + +=head2 Generating new HTML tags + +Since no mere mortal can keep up with Netscape and Microsoft as they +battle it out for control of HTML, the code that generates HTML tags +is general and extensible. You can create new HTML tags freely just +by referring to them on the import line: + + use CGI shortcuts,winkin,blinkin,nod; + +Now, in addition to the standard CGI shortcuts, you've created HTML +tags named "winkin", "blinkin" and "nod". You can use them like this: + + print blinkin {color=>'blue',rate=>'fast'},"Yahoo!"; + # <blinkin COLOR="blue" RATE="fast">Yahoo!</blinkin> + +=head1 IMPORTING CGI METHOD CALLS INTO YOUR NAME SPACE + +As a convenience, you can import most of the CGI method calls directly +into your name space. The syntax for doing this is: + + use CGI <list of methods>; + +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<param()> and B<header()> +methods, and then use them directly: + + use CGI param,header; + print header('text/plain'); + $zipcode = param('zipcode'); + +You can import groups of methods by referring to a number of special +names: + +=over 4 + +=item B<cgi> + +Import all CGI-handling methods, such as B<param()>, B<path_info()> +and the like. + +=item B<form> + +Import all fill-out form generating methods, such as B<textfield()>. + +=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 +<table>, <super> and <sub>). + +=item B<netscape> + +Import all methods that generate Netscape-specific HTML extensions. + +=item B<shortcuts> + +Import all HTML-generating shortcuts (i.e. 'html2' + 'html3' + +'netscape')... + +=item B<standard> + +Import "standard" features, 'html2', '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 + +Note that in the interests of execution speed CGI.pm does B<not> use +the standard L<Exporter> 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<param()>, B<textfield()>, +B<submit()> 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 standard,html2; + 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; + +=head1 USING NPH SCRIPTS + +NPH, or "no-parsed-header", scripts bypass the server completely by +sending the complete HTTP header directly to the browser. This has +slight performance benefits, but is of most use for taking advantage +of HTTP extensions that are not directly supported by your server, +such as server push and PICS headers. + +Servers use a variety of conventions for designating CGI scripts as +NPH. Many Unix servers look at the beginning of the script's name for +the prefix "nph-". The Macintosh WebSTAR server and Microsoft's +Internet Information Server, in contrast, try to decide whether a +program is an NPH script by examining the first line of script output. + + +CGI.pm supports NPH scripts with a special NPH mode. When in this +mode, CGI.pm will output the necessary extra header information when +the header() and redirect() methods are +called. + +The Microsoft Internet Information Server requires NPH mode. As of version +2.30, CGI.pm will automatically detect when the script is running under IIS +and put itself into this mode. You do not need to do this manually, although +it won't hurt anything if you do. + +There are a number of ways to put CGI.pm into NPH mode: + +=over 4 + +=item In the B<use> statement +Simply add ":nph" to the list of symbols to be imported into your script: + + use CGI qw(:standard :nph) + +=item By calling the B<nph()> method: + +Call B<nph()> with a non-zero parameter at any point after using CGI.pm in your program. + + CGI->nph(1) + +=item By using B<-nph> parameters in the B<header()> and B<redirect()> statements: + + print $q->header(-nph=>1); + +=back + +=head1 AUTHOR INFORMATION + +Copyright 1995,1996, 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. + +Address bug reports and comments to: +lstein@genome.wi.mit.edu + +=head1 CREDITS + +Thanks very much to: + +=over 4 + +=item Matt Heffron (heffron@falstaff.css.beckman.com) + +=item James Taylor (james.taylor@srs.gov) + +=item Scott Anguish <sanguish@digifix.com> + +=item Mike Jewell (mlj3u@virginia.edu) + +=item Timothy Shimmin (tes@kbs.citri.edu.au) + +=item Joergen Haegg (jh@axis.se) + +=item Laurent Delfosse (delfosse@csgrad1.cs.wvu.edu) + +=item Richard Resnick (applepi1@aol.com) + +=item Craig Bishop (csb@barwonwater.vic.gov.au) + +=item Tony Curtis (tc@vcpc.univie.ac.at) + +=item Tim Bunce (Tim.Bunce@ig.co.uk) + +=item Tom Christiansen (tchrist@convex.com) + +=item Andreas Koenig (k@franz.ww.TU-Berlin.DE) + +=item Tim MacKenzie (Tim.MacKenzie@fulcrum.com.au) + +=item Kevin B. Hendricks (kbhend@dogwood.tyler.wm.edu) + +=item Stephen Dahmen (joyfire@inxpress.net) + +=item Ed Jordan (ed@fidalgo.net) + +=item David Alan Pisoni (david@cnation.com) + +=item ...and many many more... + +for suggestions and bug fixes. + +=back + +=head1 A COMPLETE EXAMPLE OF A SIMPLE FORM-BASED SCRIPT + + + #!/usr/local/bin/perl + + use CGI; + + $query = new CGI; + + print $query->header; + print $query->start_html("Example CGI.pm Form"); + print "<H1> Example CGI.pm Form</H1>\n"; + &print_prompt($query); + &do_work($query); + &print_tail; + print $query->end_html; + + sub print_prompt { + my($query) = @_; + + print $query->startform; + print "<EM>What's your name?</EM><BR>"; + print $query->textfield('name'); + print $query->checkbox('Not my real name'); + + print "<P><EM>Where can you find English Sparrows?</EM><BR>"; + print $query->checkbox_group( + -name=>'Sparrow locations', + -values=>[England,France,Spain,Asia,Hoboken], + -linebreak=>'yes', + -defaults=>[England,Asia]); + + print "<P><EM>How far can they fly?</EM><BR>", + $query->radio_group( + -name=>'how far', + -values=>['10 ft','1 mile','10 miles','real far'], + -default=>'1 mile'); + + print "<P><EM>What's your favorite color?</EM> "; + print $query->popup_menu(-name=>'Color', + -values=>['black','brown','red','yellow'], + -default=>'red'); + + print $query->hidden('Reference','Monty Python and the Holy Grail'); + + print "<P><EM>What have you got there?</EM><BR>"; + print $query->scrolling_list( + -name=>'possessions', + -values=>['A Coconut','A Grail','An Icon', + 'A Sword','A Ticket'], + -size=>5, + -multiple=>'true'); + + print "<P><EM>Any parting comments?</EM><BR>"; + print $query->textarea(-name=>'Comments', + -rows=>10, + -columns=>50); + + print "<P>",$query->reset; + print $query->submit('Action','Shout'); + print $query->submit('Action','Scream'); + print $query->endform; + print "<HR>\n"; + } + + sub do_work { + my($query) = @_; + my(@values,$key); + + print "<H2>Here are the current settings in this form</H2>"; + + foreach $key ($query->param) { + print "<STRONG>$key</STRONG> -> "; + @values = $query->param($key); + print join(", ",@values),"<BR>\n"; + } + } + + sub print_tail { + print <<END; + <HR> + <ADDRESS>Lincoln D. Stein</ADDRESS><BR> + <A HREF="/">Home Page</A> + END + } + +=head1 BUGS + +This module has grown large and monolithic. Furthermore it's doing many +things, such as handling URLs, parsing CGI input, writing HTML, etc., that +are also done in the LWP modules. It should be discarded in favor of +the CGI::* modules, but somehow I continue to work on it. + +Note that the code is truly contorted in order to avoid spurious +warnings when programs are run with the B<-w> switch. + +=head1 SEE ALSO + +L<CGI::Carp>, L<URI::URL>, L<CGI::Request>, L<CGI::MiniSvr>, +L<CGI::Base>, L<CGI::Form>, L<CGI::Apache>, L<CGI::Switch>, +L<CGI::Push>, L<CGI::Fast> + +=cut + diff --git a/lib/CGI/Apache.pm b/lib/CGI/Apache.pm new file mode 100644 index 0000000000..6666f19b55 --- /dev/null +++ b/lib/CGI/Apache.pm @@ -0,0 +1,90 @@ +package CGI::Apache; +use Apache (); +use vars qw(@ISA $VERSION); +require CGI; +@ISA = qw(CGI); + +$VERSION = (qw$Revision: 1.00 $)[1]; +$CGI::DefaultClass = 'CGI::Apache'; +$CGI::Apache::AutoloadClass = 'CGI'; + +sub new { + my($class) = shift; + my($r) = Apache->request; + %ENV = $r->cgi_env unless defined $ENV{GATEWAY_INTERFACE}; #PerlSetupEnv On + my $self = $class->SUPER::new(@_); + $self->{'.req'} = $r; + $self; +} + +sub header { + my ($self,@rest) = CGI::self_or_default(@_); + my $r = $self->{'.req'}; + $r->basic_http_header; + return CGI::header($self,@rest); +} + +sub print { + my($self,@rest) = CGI::self_or_default(@_); + $self->{'.req'}->print(@rest); +} + +sub read_from_client { + my($self, $fh, $buff, $len, $offset) = @_; + my $r = $self->{'.req'} || Apache->request; + return $r->read($$buff, $len, $offset); +} + +sub new_MultipartBuffer { + my $self = shift; + my $new = CGI::Apache::MultipartBuffer->new($self, @_); + $new->{'.req'} = $self->{'.req'} || Apache->request; + return $new; +} + +package CGI::Apache::MultipartBuffer; +use vars qw(@ISA); +@ISA = qw(MultipartBuffer); + +$CGI::Apache::MultipartBuffer::AutoloadClass = 'MultipartBuffer'; +*CGI::Apache::MultipartBuffer::read_from_client = + \&CGI::Apache::read_from_client; + + +1; + +__END__ + +=head1 NAME + +CGI::Apache - Make things work with CGI.pm against Perl-Apache API + +=head1 SYNOPSIS + + require CGI::Apache; + + my $q = new Apache::CGI; + + $q->print($q->header); + + #do things just like you do with CGI.pm + +=head1 DESCRIPTION + +When using the Perl-Apache API, your applications are faster, but the +enviroment is different than CGI. +This module attempts to set-up that environment as best it can. + +=head1 NOTE + +This module used to be named Apache::CGI. Sorry for the confusion. + +=head1 SEE ALSO + +perl(1), Apache(3), CGI(3) + +=head1 AUTHOR + +Doug MacEachern E<lt>dougm@osf.orgE<gt>, hacked over by Andreas König E<lt>a.koenig@mind.deE<gt>, modified by Lincoln Stein <lt>lstein@genome.wi.mit.edu<gt> + +=cut diff --git a/lib/CGI/Carp.pm b/lib/CGI/Carp.pm new file mode 100644 index 0000000000..4cd79467fd --- /dev/null +++ b/lib/CGI/Carp.pm @@ -0,0 +1,242 @@ +package CGI::Carp; + +=head1 NAME + +B<CGI::Carp> - CGI routines for writing to the HTTPD (or other) error log + +=head1 SYNOPSIS + + use CGI::Carp; + + croak "We're outta here!"; + confess "It was my fault: $!"; + carp "It was your fault!"; + warn "I'm confused"; + die "I'm dying.\n"; + +=head1 DESCRIPTION + +CGI scripts have a nasty habit of leaving warning messages in the error +logs that are neither time stamped nor fully identified. Tracking down +the script that caused the error is a pain. This fixes that. Replace +the usual + + use Carp; + +with + + use CGI::Carp + +And the standard warn(), die (), croak(), confess() and carp() calls +will automagically be replaced with functions that write out nicely +time-stamped messages to the HTTP server error log. + +For example: + + [Fri Nov 17 21:40:43 1995] test.pl: I'm confused at test.pl line 3. + [Fri Nov 17 21:40:43 1995] test.pl: Got an error message: Permission denied. + [Fri Nov 17 21:40:43 1995] test.pl: I'm dying. + +=head1 REDIRECTING ERROR MESSAGES + +By default, error messages are sent to STDERR. Most HTTPD servers +direct STDERR to the server's error log. Some applications may wish +to keep private error logs, distinct from the server's error log, or +they may wish to direct error messages to STDOUT so that the browser +will receive them. + +The C<carpout()> function is provided for this purpose. Since +carpout() is not exported by default, you must import it explicitly by +saying + + use CGI::Carp qw(carpout); + +The carpout() function requires one argument, which should be a +reference to an open filehandle for writing errors. It should be +called in a C<BEGIN> block at the top of the CGI application so that +compiler errors will be caught. Example: + + BEGIN { + use CGI::Carp qw(carpout); + open(LOG, ">>/usr/local/cgi-logs/mycgi-log") or + die("Unable to open mycgi-log: $!\n"); + carpout(LOG); + } + +carpout() does not handle file locking on the log for you at this point. + +The real STDERR is not closed -- it is moved to SAVEERR. Some +servers, when dealing with CGI scripts, close their connection to the +browser when the script closes STDOUT and STDERR. SAVEERR is used to +prevent this from happening prematurely. + +You can pass filehandles to carpout() in a variety of ways. The "correct" +way according to Tom Christiansen is to pass a reference to a filehandle +GLOB: + + carpout(\*LOG); + +This looks weird to mere mortals however, so the following syntaxes are +accepted as well: + + carpout(LOG); + carpout(main::LOG); + carpout(main'LOG); + carpout(\LOG); + carpout(\'main::LOG'); + + ... and so on + +Use of carpout() is not great for performance, so it is recommended +for debugging purposes or for moderate-use applications. A future +version of this module may delay redirecting STDERR until one of the +CGI::Carp methods is called to prevent the performance hit. + +=head1 MAKING PERL ERRORS APPEAR IN THE BROWSER WINDOW + +If you want to send fatal (die, confess) errors to the browser, ask to +import the special "fatalsToBrowser" subroutine: + + use CGI::Carp qw(fatalsToBrowser); + die "Bad error here"; + +Fatal errors will now be echoed to the browser as well as to the log. CGI::Carp +arranges to send a minimal HTTP header to the browser so that even errors that +occur in the early compile phase will be seen. +Nonfatal errors will still be directed to the log file only (unless redirected +with carpout). + +=head1 CHANGE LOG + +1.05 carpout() added and minor corrections by Marc Hedlund + <hedlund@best.com> on 11/26/95. + +1.06 fatalsToBrowser() no longer aborts for fatal errors within + eval() statements. + +=head1 AUTHORS + +Lincoln D. Stein <lstein@genome.wi.mit.edu>. Feel free to redistribute +this under the Perl Artistic License. + + +=head1 SEE ALSO + +Carp, CGI::Base, CGI::BasePlus, CGI::Request, CGI::MiniSvr, CGI::Form, +CGI::Response + +=cut + +require 5.000; +use Exporter; +use Carp; + +@ISA = qw(Exporter); +@EXPORT = qw(confess croak carp); +@EXPORT_OK = qw(carpout fatalsToBrowser); + +$main::SIG{__WARN__}=\&CGI::Carp::warn; +$main::SIG{__DIE__}=\&CGI::Carp::die; +$CGI::Carp::VERSION = '1.06'; + +# fancy import routine detects and handles 'errorWrap' specially. +sub import { + my $pkg = shift; + my(%routines); + grep($routines{$_}++,@_); + $WRAP++ if $routines{'fatalsToBrowser'}; + my($oldlevel) = $Exporter::ExportLevel; + $Exporter::ExportLevel = 1; + Exporter::import($pkg,keys %routines); + $Exporter::ExportLevel = $oldlevel; +} + +# These are the originals +sub realwarn { warn(@_); } +sub realdie { die(@_); } + +sub id { + my $level = shift; + my($pack,$file,$line,$sub) = caller($level); + my($id) = $file=~m|([^/]+)$|; + return ($file,$line,$id); +} + +sub stamp { + my $time = scalar(localtime); + my $frame = 0; + my ($id,$pack,$file); + do { + $id = $file; + ($pack,$file) = caller($frame++); + } until !$file; + ($id) = $id=~m|([^/]+)$|; + return "[$time] $id: "; +} + +sub warn { + my $message = shift; + my($file,$line,$id) = id(1); + $message .= " at $file line $line.\n" unless $message=~/\n$/; + my $stamp = stamp; + $message=~s/^/$stamp/gm; + realwarn $message; +} + +sub die { + my $message = shift; + my $time = scalar(localtime); + my($file,$line,$id) = id(1); + return undef if $file=~/^\(eval/; + $message .= " at $file line $line.\n" unless $message=~/\n$/; + &fatalsToBrowser($message) if $WRAP; + my $stamp = stamp; + $message=~s/^/$stamp/gm; + realdie $message; +} + +# Avoid generating "subroutine redefined" warnings with the following +# hack: +{ + local $^W=0; + eval <<EOF; +sub confess { CGI::Carp::die Carp::longmess \@_; } +sub croak { CGI::Carp::die Carp::shortmess \@_; } +sub carp { CGI::Carp::warn Carp::shortmess \@_; } +EOF + ; +} + +# We have to be ready to accept a filehandle as a reference +# or a string. +sub carpout { + my($in) = @_; + $in = $$in if ref($in); # compatability with Marc's method; + my($no) = fileno($in); + unless (defined($no)) { + my($package) = caller; + my($handle) = $in=~/[':]/ ? $in : "$package\:\:$in"; + $no = fileno($handle); + } + die "Invalid filehandle $in\n" unless $no; + + open(SAVEERR, ">&STDERR"); + open(STDERR, ">&$no") or + ( print SAVEERR "Unable to redirect STDERR: $!\n" and exit(1) ); +} + +# headers +sub fatalsToBrowser { + my($msg) = @_; + $msg=~s/>/>/g; + $msg=~s/</</g; + print STDOUT "Content-type: text/html\n\n"; + print STDOUT <<END; +<H1>Software error:</H1> +<CODE>$msg</CODE> +<P> +Please send mail to this site's webmaster for help. +END +} + +1; diff --git a/lib/CGI/Fast.pm b/lib/CGI/Fast.pm new file mode 100644 index 0000000000..03b54072c9 --- /dev/null +++ b/lib/CGI/Fast.pm @@ -0,0 +1,173 @@ +package CGI::Fast; + +# 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,1996, 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::Fast::VERSION='1.00a'; + +use CGI; +use FCGI; +@ISA = ('CGI'); + +# workaround for known bug in libfcgi +while (($ignore) = each %ENV) { } + +# override the initialization behavior so that +# state is NOT maintained between invocations +sub save_request { + # no-op +} + +# New is slightly different in that it calls FCGI's +# accept() method. +sub new { + return undef unless FCGI::accept() >= 0; + my($self,@param) = @_; + return $CGI::Q = $self->SUPER::new(@param); +} + +1; + +=head1 NAME + +CGI::Fast - CGI Interface for Fast CGI + +=head1 SYNOPSIS + + use CGI::Fast qw(:standard); + $COUNTER = 0; + while (new CGI::Fast) { + print header; + print start_html("Fast CGI Rocks"); + print + h1("Fast CGI Rocks"), + "Invocation number ",b($COUNTER++), + " PID ",b($$),".", + hr; + print end_html; + } + +=head1 DESCRIPTION + +CGI::Fast is a subclass of the CGI object created by +CGI.pm. It is specialized to work well with the Open Market +FastCGI standard, which greatly speeds up CGI scripts by +turning them into persistently running server processes. Scripts +that perform time-consuming initialization processes, such as +loading large modules or opening persistent database connections, +will see large performance improvements. + +=head1 OTHER PIECES OF THE PUZZLE + +In order to use CGI::Fast you'll need a FastCGI-enabled Web +server. Open Market's server is FastCGI-savvy. There are also +freely redistributable FastCGI modules for NCSA httpd 1.5 and Apache. +FastCGI-enabling modules for Microsoft Internet Information Server and +Netscape Communications Server have been announced. + +In addition, you'll need a version of the Perl interpreter that has +been linked with the FastCGI I/O library. Precompiled binaries are +available for several platforms, including DEC Alpha, HP-UX and +SPARC/Solaris, or you can rebuild Perl from source with patches +provided in the FastCGI developer's kit. The FastCGI Perl interpreter +can be used in place of your normal Perl without ill consequences. + +You can find FastCGI modules for Apache and NCSA httpd, precompiled +Perl interpreters, and the FastCGI developer's kit all at URL: + + http://www.fastcgi.com/ + +=head1 WRITING FASTCGI PERL SCRIPTS + +FastCGI scripts are persistent: one or more copies of the script +are started up when the server initializes, and stay around until +the server exits or they die a natural death. After performing +whatever one-time initialization it needs, the script enters a +loop waiting for incoming connections, processing the request, and +waiting some more. + +A typical FastCGI script will look like this: + + #!/usr/local/bin/perl # must be a FastCGI version of perl! + use CGI::Fast; + &do_some_initialization(); + while ($q = new CGI::Fast) { + &process_request($q); + } + +Each time there's a new request, CGI::Fast returns a +CGI object to your loop. The rest of the time your script +waits in the call to new(). When the server requests that +your script be terminated, new() will return undef. You can +of course exit earlier if you choose. A new version of the +script will be respawned to take its place (this may be +necessary in order to avoid Perl memory leaks in long-running +scripts). + +CGI.pm's default CGI object mode also works. Just modify the loop +this way: + + while (new CGI::Fast) { + &process_request; + } + +Calls to header(), start_form(), etc. will all operate on the +current request. + +=head1 INSTALLING FASTCGI SCRIPTS + +See the FastCGI developer's kit documentation for full details. On +the Apache server, the following line must be added to srm.conf: + + AddType application/x-httpd-fcgi .fcgi + +FastCGI scripts must end in the extension .fcgi. For each script you +install, you must add something like the following to srm.conf: + + AppClass /usr/etc/httpd/fcgi-bin/file_upload.fcgi -processes 2 + +This instructs Apache to launch two copies of file_upload.fcgi at +startup time. + +=head1 USING FASTCGI SCRIPTS AS CGI SCRIPTS + +Any script that works correctly as a FastCGI script will also work +correctly when installed as a vanilla CGI script. However it will +not see any performance benefit. + +=head1 CAVEATS + +I haven't tested this very much. + +=head1 AUTHOR INFORMATION + +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. + +Address bug reports and comments to: +lstein@genome.wi.mit.edu + +=head1 BUGS + +This section intentionally left blank. + +=head1 SEE ALSO + +L<CGI::Carp>, L<CGI> + +=cut diff --git a/lib/CGI/Push.pm b/lib/CGI/Push.pm new file mode 100644 index 0000000000..11421a7f23 --- /dev/null +++ b/lib/CGI/Push.pm @@ -0,0 +1,239 @@ +package CGI::Push; + +# 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,1996, 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::Push::VERSION='1.00'; +use CGI; +@ISA = ('CGI'); + +# add do_push() to exported tags +push(@{$CGI::EXPORT_TAGS{':standard'}},'do_push'); + +sub do_push { + my ($self,@p) = CGI::self_or_CGI(@_); + + # unbuffer output + $| = 1; + srand; + my ($random) = rand()*1E16; + my ($boundary) = "----------------------------------$random"; + + my (@header); + my ($type,$callback,$delay,$last_page,$cookie,$target,$expires,@other) = + $self->rearrange([TYPE,NEXT_PAGE,DELAY,LAST_PAGE,[COOKIE,COOKIES],TARGET,EXPIRES],@p); + $type = 'text/html' unless $type; + $callback = \&simple_counter unless $callback && ref($callback) eq 'CODE'; + $delay = 1 unless defined($delay); + + my(@o); + foreach (@other) { push(@o,split("=")); } + push(@o,'-Target'=>$target) if defined($target); + push(@o,'-Cookie'=>$cookie) if defined($cookie); + push(@o,'-Type'=>"multipart/x-mixed-replace; boundary=$boundary"); + push(@o,'-Server'=>"CGI.pm Push Module"); + push(@o,'-Status'=>'200 OK'); + push(@o,'-nph'=>1); + print $self->header(@o); + print "${boundary}$CGI::CRLF"; + + # now we enter a little loop + my @contents; + while (1) { + last unless (@contents = &$callback($self,++$COUNTER)) && defined($contents[0]); + print "Content-type: ${type}$CGI::CRLF$CGI::CRLF"; + print @contents,"$CGI::CRLF"; + print "${boundary}$CGI::CRLF"; + do_sleep($delay) if $delay; + } + print "Content-type: ${type}$CGI::CRLF$CGI::CRLF", + &$last_page($self,++$COUNTER), + "$CGI::CRLF${boundary}$CGI::CRLF" + if $last_page && ref($last_page) eq 'CODE'; +} + +sub simple_counter { + my ($self,$count) = @_; + return ( + CGI->start_html("CGI::Push Default Counter"), + CGI->h1("CGI::Push Default Counter"), + "This page has been updated ",CGI->strong($count)," times.", + CGI->hr(), + CGI->a({'-href'=>'http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html'},'CGI.pm home page'), + CGI->end_html + ); +} + +sub do_sleep { + my $delay = shift; + if ( ($delay >= 1) && ($delay!~/\./) ){ + sleep($delay); + } else { + select(undef,undef,undef,$delay); + } +} + +1; + +=head1 NAME + +CGI::Push - Simple Interface to Server Push + +=head1 SYNOPSIS + + use CGI::Push qw(:standard); + + do_push(-next_page=>\&next_page, + -last_page=>\&last_page, + -delay=>0.5); + + sub next_page { + my($q,$counter) = @_; + return undef if $counter >= 10; + return start_html('Test'), + h1('Visible'),"\n", + "This page has been called ", strong($counter)," times", + end_html(); + } + + sub last_page { + my($q,$counter) = @_; + return start_html('Done'), + h1('Finished'), + strong($counter),' iterations.', + end_html; + } + +=head1 DESCRIPTION + +CGI::Push is a subclass of the CGI object created by CGI.pm. It is +specialized for server push operations, which allow you to create +animated pages whose content changes at regular intervals. + +You provide CGI::Push with a pointer to a subroutine that will draw +one page. Every time your subroutine is called, it generates a new +page. The contents of the page will be transmitted to the browser +in such a way that it will replace what was there beforehand. The +technique will work with HTML pages as well as with graphics files, +allowing you to create animated GIFs. + +=head1 USING CGI::Push + +CGI::Push adds one new method to the standard CGI suite, do_push(). +When you call this method, you pass it a reference to a subroutine +that is responsible for drawing each new page, an interval delay, and +an optional subroutine for drawing the last page. Other optional +parameters include most of those recognized by the CGI header() +method. + +You may call do_push() in the object oriented manner or not, as you +prefer: + + use CGI::Push; + $q = new CGI::Push; + $q->do_push(-next_page=>\&draw_a_page); + + -or- + + use CGI::Push qw(:standard); + do_push(-next_page=>\&draw_a_page); + +Parameters are as follows: + +=over 4 + +=item -next_page + + do_push(-next_page=>\&my_draw_routine); + +This required parameter points to a reference to a subroutine responsible for +drawing each new page. The subroutine should expect two parameters +consisting of the CGI object and a counter indicating the number +of times the subroutine has been called. It should return the +contents of the page as an B<array> of one or more items to print. +It can return a false value (or an empty array) in order to abort the +redrawing loop and print out the final page (if any) + + sub my_draw_routine { + my($q,$counter) = @_; + return undef if $counter > 100; + return start_html('testing'), + h1('testing'), + "This page called $counter times"; + } + +=item -last_page + +This optional parameter points to a reference to the subroutine +responsible for drawing the last page of the series. It is called +after the -next_page routine returns a false value. The subroutine +itself should have exactly the same calling conventions as the +-next_page routine. + +=item -type + +This optional parameter indicates the content type of each page. It +defaults to "text/html". Currently, server push of heterogeneous +document types is not supported. + +=item -delay + +This indicates the delay, in seconds, between frames. Smaller delays +refresh the page faster. Fractional values are allowed. + +B<If not specified, -delay will default to 1 second> + +=item -cookie, -target, -expires + +These have the same meaning as the like-named parameters in +CGI::header(). + +=back + +=head1 INSTALLING CGI::Push SCRIPTS + +Server push scripts B<must> be installed as no-parsed-header (NPH) +scripts in order to work correctly. On Unix systems, this is most +often accomplished by prefixing the script's name with "nph-". +Recognition of NPH scripts happens automatically with WebSTAR and +Microsoft IIS. Users of other servers should see their documentation +for help. + +=head1 CAVEATS + +This is a new module. It hasn't been extensively tested. + +=head1 AUTHOR INFORMATION + +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. + +Address bug reports and comments to: +lstein@genome.wi.mit.edu + +=head1 BUGS + +This section intentionally left blank. + +=head1 SEE ALSO + +L<CGI::Carp>, L<CGI> + +=cut + diff --git a/lib/CGI/Switch.pm b/lib/CGI/Switch.pm new file mode 100644 index 0000000000..420fff7643 --- /dev/null +++ b/lib/CGI/Switch.pm @@ -0,0 +1,78 @@ +package CGI::Switch; +use Carp; +use strict; +use vars qw($VERSION @Pref); +$VERSION = '0.05'; +@Pref = qw(CGI::Apache CGI); #default + +sub import { + my($self,@arg) = @_; + @Pref = @arg if @arg; +} + +sub new { + shift; + my($file,$pack); + for $pack (@Pref) { + ($file = $pack) =~ s|::|/|g; + eval { require "$file.pm"; }; + if ($@) { +#XXX warn $@; + next; + } else { +#XXX warn "Going to try $pack\->new\n"; + my $obj; + eval {$obj = $pack->new(@_)}; + if ($@) { +#XXX warn $@; + } else { + return $obj; + } + } + } + Carp::croak "Couldn't load+construct any of @Pref\n"; +} + +# there's a trick in Lincoln's package that determines the calling +# package. The reason is to have a filehandle with the same name as +# the filename. To tell this trick that we are not the calling +# package we have to follow this dirty convention. It's a questionable +# trick imho, but for now I want to have something working +sub isaCGI { 1 } + +1; +__END__ + +=head1 NAME + +CGI::Switch - Try more than one constructors and return the first object available + +=head1 SYNOPSIS + + + use CGISwitch; + + -or- + + use CGI::Switch This, That, CGI::XA, Foo, Bar, CGI; + + my $q = new CGI::Switch; + +=head1 DESCRIPTION + +Per default the new() method tries to call new() in the three packages +Apache::CGI, CGI::XA, and CGI. It returns the first CGI object it +succeeds with. + +The import method allows you to set up the default order of the +modules to be tested. + +=head1 SEE ALSO + +perl(1), Apache(3), CGI(3), CGI::XA(3) + +=head1 AUTHOR + +Andreas König E<lt>a.koenig@mind.deE<gt> + +=cut diff --git a/lib/ExtUtils/typemap b/lib/ExtUtils/typemap index c65b1cf35d..20cc96f0b5 100644 --- a/lib/ExtUtils/typemap +++ b/lib/ExtUtils/typemap @@ -203,7 +203,7 @@ T_SYSRET T_ENUM sv_setiv($arg, (IV)$var); T_BOOL - $arg = $var ? &sv_yes : &sv_no; + $arg = boolSV($var); T_U_INT sv_setiv($arg, (IV)$var); T_SHORT diff --git a/lib/Pod/Html.pm b/lib/Pod/Html.pm new file mode 100644 index 0000000000..a00d21057b --- /dev/null +++ b/lib/Pod/Html.pm @@ -0,0 +1,1472 @@ +package Pod::Html; + +use Pod::Functions; +use Getopt::Long; # package for handling command-line parameters +require Exporter; +@ISA = Exporter; +@EXPORT = qw(pod2html htmlify); +use Cwd; + +use Carp; + +use strict; + +=head1 NAME + +Pod::HTML - module to convert pod files to HTML + +=head1 SYNOPSIS + + use Pod::HTML; + pod2html([options]); + +=head1 DESCRIPTION + +Converts files from pod format (see L<perlpod>) to HTML format. It +can automatically generate indexes and cross-references, and it keeps +a cache of things it knows how to cross-reference. + +=head1 ARGUMENTS + +Pod::Html 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 EXAMPLE + + pod2html("pod2html", + "--podpath=lib:ext:pod:vms", + "--podroot=/usr/src/perl", + "--htmlroot=/perl/nmanual", + "--libpods=perlfunc:perlguts:perlvar:perlrun:perlop", + "--recurse", + "--infile=foo.pod", + "--outfile=/perl/nmanual/foo.html"); + +=head1 AUTHOR + +Tom Christiansen, E<lt>tchrist@perl.comE<gt>. + +=head1 BUGS + +Has trouble with C<> etc in = commands. + +=head1 SEE ALSO + +L<perlpod> + +=head1 COPYRIGHT + +This program is distributed under the Artistic License. + +=cut + +my $dircache = "pod2html-dircache"; +my $itemcache = "pod2html-itemcache"; + +my @begin_stack = (); # begin/end stack + +my @libpods = (); # files to search for links from C<> directives +my $htmlroot = "/"; # http-server base directory from which all + # relative paths in $podpath stem. +my $htmlfile = ""; # write to stdout by default +my $podfile = ""; # read from stdin by default +my @podpath = (); # list of directories containing library pods. +my $podroot = "."; # filesystem base directory from which all + # relative paths in $podpath stem. +my $recurse = 1; # recurse on subdirectories in $podpath. +my $verbose = 0; # not verbose by default +my $doindex = 1; # non-zero if we should generate an index +my $listlevel = 0; # current list depth +my @listitem = (); # stack of HTML commands to use when a =item is + # encountered. the top of the stack is the + # current list. +my @listdata = (); # similar to @listitem, but for the text after + # an =item +my @listend = (); # similar to @listitem, but the text to use to + # end the list. +my $ignore = 1; # whether or not to format text. we don't + # format text until we hit our first pod + # directive. + +my %items_named = (); # for the multiples of the same item in perlfunc +my @items_seen = (); +my $netscape = 0; # whether or not to use netscape directives. +my $title; # title to give the pod(s) +my $top = 1; # true if we are at the top of the doc. used + # to prevent the first <HR> directive. +my $paragraph; # which paragraph we're processing (used + # for error messages) +my %pages = (); # associative array used to find the location + # of pages referenced by L<> links. +my %sections = (); # sections within this page +my %items = (); # associative array used to find the location + # of =item directives referenced by C<> links +sub init_globals { +$dircache = "pod2html-dircache"; +$itemcache = "pod2html-itemcache"; + +@begin_stack = (); # begin/end stack + +@libpods = (); # files to search for links from C<> directives +$htmlroot = "/"; # http-server base directory from which all + # relative paths in $podpath stem. +$htmlfile = ""; # write to stdout by default +$podfile = ""; # read from stdin by default +@podpath = (); # list of directories containing library pods. +$podroot = "."; # filesystem base directory from which all + # relative paths in $podpath stem. +$recurse = 1; # recurse on subdirectories in $podpath. +$verbose = 0; # not verbose by default +$doindex = 1; # non-zero if we should generate an index +$listlevel = 0; # current list depth +@listitem = (); # stack of HTML commands to use when a =item is + # encountered. the top of the stack is the + # current list. +@listdata = (); # similar to @listitem, but for the text after + # an =item +@listend = (); # similar to @listitem, but the text to use to + # end the list. +$ignore = 1; # whether or not to format text. we don't + # format text until we hit our first pod + # directive. + +@items_seen = (); +%items_named = (); +$netscape = 0; # whether or not to use netscape directives. +$title = ''; # title to give the pod(s) +$top = 1; # true if we are at the top of the doc. used + # to prevent the first <HR> directive. +$paragraph = ''; # which paragraph we're processing (used + # for error messages) +%pages = (); # associative array used to find the location + # of pages referenced by L<> links. +%sections = (); # sections within this page +%items = (); # associative array used to find the location + # of =item directives referenced by C<> links + +} + +sub pod2html { + local(@ARGV) = @_; + local($/); + local $_; + + init_globals(); + + # cache of %pages and %items from last time we ran pod2html + my $podpath = ''; + + #undef $opt_help if defined $opt_help; + + # parse the command-line parameters + parse_command_line(); + + # set some variables to their default values if necessary + local *POD; + unless (@ARGV && $ARGV[0]) { + $podfile = "-" unless $podfile; # stdin + open(POD, "<$podfile") + || die "$0: cannot open $podfile file for input: $!\n"; + } else { + $podfile = $ARGV[0]; # XXX: might be more filenames + *POD = *ARGV; + } + $htmlfile = "-" unless $htmlfile; # stdout + $htmlroot = "" if $htmlroot eq "/"; # so we don't get a // + + # read the pod a paragraph at a time + warn "Scanning for sections in input file(s)\n" if $verbose; + $/ = ""; + my @poddata = <POD>; + close(POD); + + # scan the pod for =head[1-6] directives and build an index + my $index = scan_headings(\%sections, @poddata); + + # open the output file + open(HTML, ">$htmlfile") + || die "$0: cannot open $htmlfile file for output: $!\n"; + + # put a title in the HTML file + $title = ''; + TITLE_SEARCH: { + for (my $i = 0; $i < @poddata; $i++) { + if ($poddata[$i] =~ /^=head1\s*NAME\b/m) { + for my $para ( @poddata[$i, $i+1] ) { + last TITLE_SEARCH if ($title) = $para =~ /(\S+\s+-+\s*.*)/s; + } + } + + } + } + unless ($title) { + $podfile =~ /^(.*)(\.[^.\/]+)?$/; + $title = ($podfile eq "-" ? 'No Title' : $1); + warn "found $title" if $verbose; + } + if ($title =~ /\.pm/) { + warn "$0: no title for $podfile"; + $title = $podfile; + } + print HTML <<END_OF_HEAD; + <HTML> + <HEAD> + <TITLE>$title</TITLE> + </HEAD> + + <BODY> + +END_OF_HEAD + + # load a cache of %pages and %items if possible. $tests will be + # non-zero if successful. + my $tests = 0; + if (-f $dircache && -f $itemcache) { + warn "scanning for item cache\n" if $verbose; + $tests = find_cache($dircache, $itemcache, $podpath, $podroot); + } + + # if we didn't succeed in loading the cache then we must (re)build + # %pages and %items. + if (!$tests) { + warn "scanning directories in pod-path\n" if $verbose; + scan_podpath($podroot, $recurse); + } + + # scan the pod for =item directives + scan_items("", \%items, @poddata); + + # put an index at the top of the file. note, if $doindex is 0 we + # still generate an index, but surround it with an html comment. + # that way some other program can extract it if desired. + $index =~ s/--+/-/g; + print HTML "<!-- INDEX BEGIN -->\n"; + print HTML "<!--\n" unless $doindex; + print HTML $index; + print HTML "-->\n" unless $doindex; + print HTML "<!-- INDEX END -->\n\n"; + print HTML "<HR>\n" if $doindex; + + # now convert this file + warn "Converting input file\n" if $verbose; + foreach my $i (0..$#poddata) { + $_ = $poddata[$i]; + $paragraph = $i+1; + if (/^(=.*)/s) { # is it a pod directive? + $ignore = 0; + $_ = $1; + if (/^=begin\s+(\S+)\s*(.*)/si) {# =begin + process_begin($1, $2); + } elsif (/^=end\s+(\S+)\s*(.*)/si) {# =end + process_end($1, $2); + } elsif (/^=cut/) { # =cut + process_cut(); + } elsif (/^=pod/) { # =pod + process_pod(); + } else { + next if @begin_stack && $begin_stack[-1] ne 'html'; + + if (/^=(head[1-6])\s+(.*)/s) { # =head[1-6] heading + process_head($1, $2); + } elsif (/^=item\s*(.*)/sm) { # =item text + process_item($1); + } elsif (/^=over\s*(.*)/) { # =over N + process_over(); + } elsif (/^=back/) { # =back + process_back(); + } elsif (/^=for\s+(\S+)\s+(.*)/si) {# =for + process_for($1,$2); + } else { + /^=(\S*)\s*/; + warn "$0: $podfile: unknown pod directive '$1' in " + . "paragraph $paragraph. ignoring.\n"; + } + } + $top = 0; + } + else { + next if $ignore; + next if @begin_stack && $begin_stack[-1] ne 'html'; + my $text = $_; + process_text(\$text, 1); + print HTML "$text\n<P>\n\n"; + } + } + + # finish off any pending directives + finish_list(); + print HTML <<END_OF_TAIL; + </BODY> + + </HTML> +END_OF_TAIL + + # close the html file + close(HTML); + + warn "Finished\n" if $verbose; +} + +############################################################################## + +my $usage; # see below +sub usage { + my $podfile = shift; + warn "$0: $podfile: @_\n" if @_; + die $usage; +} + +$usage =<<END_OF_USAGE; +Usage: $0 --help --htmlroot=<name> --infile=<name> --outfile=<name> + --podpath=<name>:...:<name> --podroot=<name> + --libpods=<name>:...:<name> --recurse --verbose --index + --netscape --norecurse --noindex + + --flush - flushes the item and directory caches. + --help - prints this message. + --htmlroot - http-server base directory from which all relative paths + in podpath stem (default is /). + --index - generate an index at the top of the resulting html + (default). + --infile - filename for the pod to convert (input taken from stdin + by default). + --libpods - colon-separated list of pages to search for =item pod + directives in as targets of C<> and implicit links (empty + by default). note, these are not filenames, but rather + page names like those that appear in L<> links. + --netscape - will use netscape html directives when applicable. + --nonetscape - will not use netscape directives (default). + --outfile - filename for the resulting html file (output sent to + stdout by default). + --podpath - colon-separated list of directories containing library + pods. empty by default. + --podroot - filesystem base directory from which all relative paths + in podpath stem (default is .). + --noindex - don't generate an index at the top of the resulting html. + --norecurse - don't recurse on those subdirectories listed in podpath. + --recurse - recurse on those subdirectories listed in podpath + (default behavior). + --title - title that will appear in resulting html file. + --verbose - self-explanatory + +END_OF_USAGE + +sub parse_command_line { + my ($opt_flush,$opt_help,$opt_htmlroot,$opt_index,$opt_infile,$opt_libpods,$opt_netscape,$opt_outfile,$opt_podpath,$opt_podroot,$opt_norecurse,$opt_recurse,$opt_title,$opt_verbose); + my $result = GetOptions( + 'flush' => \$opt_flush, + 'help' => \$opt_help, + 'htmlroot=s' => \$opt_htmlroot, + 'index!' => \$opt_index, + 'infile=s' => \$opt_infile, + 'libpods=s' => \$opt_libpods, + 'netscape!' => \$opt_netscape, + 'outfile=s' => \$opt_outfile, + 'podpath=s' => \$opt_podpath, + 'podroot=s' => \$opt_podroot, + 'norecurse' => \$opt_norecurse, + 'recurse!' => \$opt_recurse, + 'title=s' => \$opt_title, + 'verbose' => \$opt_verbose, + ); + usage("-", "invalid parameters") if not $result; + + usage("-") if defined $opt_help; # see if the user asked for help + $opt_help = ""; # just to make -w shut-up. + + $podfile = $opt_infile if defined $opt_infile; + $htmlfile = $opt_outfile if defined $opt_outfile; + + @podpath = split(":", $opt_podpath) if defined $opt_podpath; + @libpods = split(":", $opt_libpods) if defined $opt_libpods; + + warn "Flushing item and directory caches\n" + if $opt_verbose && defined $opt_flush; + unlink($dircache, $itemcache) if defined $opt_flush; + + $htmlroot = $opt_htmlroot if defined $opt_htmlroot; + $podroot = $opt_podroot if defined $opt_podroot; + + $doindex = $opt_index if defined $opt_index; + $recurse = $opt_recurse if defined $opt_recurse; + $title = $opt_title if defined $opt_title; + $verbose = defined $opt_verbose ? 1 : 0; + $netscape = $opt_netscape if defined $opt_netscape; +} + +# +# find_cache - tries to find if the caches stored in $dircache and $itemcache +# are valid caches of %pages and %items. if they are valid then it loads +# them and returns a non-zero value. +# +sub find_cache { + my($dircache, $itemcache, $podpath, $podroot) = @_; + my($tests); + local $_; + + $tests = 0; + + open(CACHE, "<$itemcache") || + die "$0: error opening $itemcache for reading: $!\n"; + $/ = "\n"; + + # is it the same podpath? + $_ = <CACHE>; + chomp($_); + $tests++ if (join(":", @podpath) eq $_); + + # is it the same podroot? + $_ = <CACHE>; + chomp($_); + $tests++ if ($podroot eq $_); + + # load the cache if its good + if ($tests != 2) { + close(CACHE); + + %items = (); + return 0; + } + + warn "loading item cache\n" if $verbose; + while (<CACHE>) { + /(.*?) (.*)$/; + $items{$1} = $2; + } + close(CACHE); + + warn "scanning for directory cache\n" if $verbose; + open(CACHE, "<$dircache") || + die "$0: error opening $dircache for reading: $!\n"; + $/ = "\n"; + $tests = 0; + + # is it the same podpath? + $_ = <CACHE>; + chomp($_); + $tests++ if (join(":", @podpath) eq $_); + + # is it the same podroot? + $_ = <CACHE>; + chomp($_); + $tests++ if ($podroot eq $_); + + # load the cache if its good + if ($tests != 2) { + close(CACHE); + + %pages = (); + %items = (); + return 0; + } + + warn "loading directory cache\n" if $verbose; + while (<CACHE>) { + /(.*?) (.*)$/; + $pages{$1} = $2; + } + + close(CACHE); + + return 1; +} + +# +# scan_podpath - scans the directories specified in @podpath for directories, +# .pod files, and .pm files. it also scans the pod files specified in +# @libpods for =item directives. +# +sub scan_podpath { + my($podroot, $recurse) = @_; + my($pwd, $dir); + my($libpod, $dirname, $pod, @files, @poddata); + + # scan each directory listed in @podpath + $pwd = getcwd(); + chdir($podroot) + || die "$0: error changing to directory $podroot: $!\n"; + foreach $dir (@podpath) { + scan_dir($dir, $recurse); + } + + # scan the pods listed in @libpods for =item directives + foreach $libpod (@libpods) { + # if the page isn't defined then we won't know where to find it + # on the system. + next unless defined $pages{$libpod} && $pages{$libpod}; + + # if there is a directory then use the .pod and .pm files within it. + if ($pages{$libpod} =~ /([^:]*[^(\.pod|\.pm)]):/) { + # find all the .pod and .pm files within the directory + $dirname = $1; + opendir(DIR, $dirname) || + die "$0: error opening directory $dirname: $!\n"; + @files = grep(/(\.pod|\.pm)$/ && ! -d $_, readdir(DIR)); + closedir(DIR); + + # scan each .pod and .pm file for =item directives + foreach $pod (@files) { + open(POD, "<$dirname/$pod") || + die "$0: error opening $dirname/$pod for input: $!\n"; + @poddata = <POD>; + close(POD); + + scan_items("$dirname/$pod", @poddata); + } + + # use the names of files as =item directives too. + foreach $pod (@files) { + $pod =~ /^(.*)(\.pod|\.pm)$/; + $items{$1} = "$dirname/$1.html" if $1; + } + } elsif ($pages{$libpod} =~ /([^:]*\.pod):/ || + $pages{$libpod} =~ /([^:]*\.pm):/) { + # scan the .pod or .pm file for =item directives + $pod = $1; + open(POD, "<$pod") || + die "$0: error opening $pod for input: $!\n"; + @poddata = <POD>; + close(POD); + + scan_items("$pod", @poddata); + } else { + warn "$0: shouldn't be here (line ".__LINE__."\n"; + } + } + @poddata = (); # clean-up a bit + + chdir($pwd) + || die "$0: error changing to directory $pwd: $!\n"; + + # cache the item list for later use + warn "caching items for later use\n" if $verbose; + open(CACHE, ">$itemcache") || + die "$0: error open $itemcache for writing: $!\n"; + + print CACHE join(":", @podpath) . "\n$podroot\n"; + foreach my $key (keys %items) { + print CACHE "$key $items{$key}\n"; + } + + close(CACHE); + + # cache the directory list for later use + warn "caching directories for later use\n" if $verbose; + open(CACHE, ">$dircache") || + die "$0: error open $dircache for writing: $!\n"; + + print CACHE join(":", @podpath) . "\n$podroot\n"; + foreach my $key (keys %pages) { + print CACHE "$key $pages{$key}\n"; + } + + close(CACHE); +} + +# +# scan_dir - scans the directory specified in $dir for subdirectories, .pod +# files, and .pm files. notes those that it finds. this information will +# be used later in order to figure out where the pages specified in L<> +# links are on the filesystem. +# +sub scan_dir { + my($dir, $recurse) = @_; + my($t, @subdirs, @pods, $pod, $dirname, @dirs); + local $_; + + @subdirs = (); + @pods = (); + + opendir(DIR, $dir) || + die "$0: error opening directory $dir: $!\n"; + while (defined($_ = readdir(DIR))) { + if (-d "$dir/$_" && $_ ne "." && $_ ne "..") { # directory + $pages{$_} = "" unless defined $pages{$_}; + $pages{$_} .= "$dir/$_:"; + push(@subdirs, $_); + } elsif (/\.pod$/) { # .pod + s/\.pod$//; + $pages{$_} = "" unless defined $pages{$_}; + $pages{$_} .= "$dir/$_.pod:"; + push(@pods, "$dir/$_.pod"); + } elsif (/\.pm$/) { # .pm + s/\.pm$//; + $pages{$_} = "" unless defined $pages{$_}; + $pages{$_} .= "$dir/$_.pm:"; + push(@pods, "$dir/$_.pm"); + } + } + closedir(DIR); + + # recurse on the subdirectories if necessary + if ($recurse) { + foreach my $subdir (@subdirs) { + scan_dir("$dir/$subdir", $recurse); + } + } +} + +# +# scan_headings - scan a pod file for head[1-6] tags, note the tags, and +# build an index. +# +sub scan_headings { + my($sections, @data) = @_; + my($tag, $which_head, $title, $listdepth, $index); + + $listdepth = 0; + $index = ""; + + # scan for =head directives, note their name, and build an index + # pointing to each of them. + foreach my $line (@data) { + if ($line =~ /^\s*=(head)([1-6])\s+(.*)/) { + ($tag,$which_head, $title) = ($1,$2,$3); + chomp($title); + $$sections{htmlify(0,$title)} = 1; + + if ($which_head > $listdepth) { + $index .= "\n" . ("\t" x $listdepth) . "<UL>\n"; + } elsif ($which_head < $listdepth) { + $listdepth--; + $index .= "\n" . ("\t" x $listdepth) . "</UL>\n"; + } + $listdepth = $which_head; + + $index .= "\n" . ("\t" x $listdepth) . "<LI>" . + "<A HREF=\"#" . htmlify(0,$title) . "\">$title</A>"; + } + } + + # finish off the lists + while ($listdepth--) { + $index .= "\n" . ("\t" x $listdepth) . "</UL>\n"; + } + + # get rid of bogus lists + $index =~ s,\t*<UL>\s*</UL>\n,,g; + + return $index; +} + +# +# scan_items - scans the pod specified by $pod for =item directives. we +# will use this information later on in resolving C<> links. +# +sub scan_items { + my($pod, @poddata) = @_; + my($i, $item); + local $_; + + $pod =~ s/\.pod$//; + $pod .= ".html" if $pod; + + foreach $i (0..$#poddata) { + $_ = $poddata[$i]; + + # remove any formatting instructions + s,[A-Z]<([^<>]*)>,$1,g; + + # figure out what kind of item it is and get the first word of + # it's name. + if (/^=item\s+(\w*)\s*.*$/s) { + if ($1 eq "*") { # bullet list + /\A=item\s+\*\s*(.*?)\s*\Z/s; + $item = $1; + } elsif ($1 =~ /^[0-9]+/) { # numbered list + /\A=item\s+[0-9]+\.?(.*?)\s*\Z/s; + $item = $1; + } else { +# /\A=item\s+(.*?)\s*\Z/s; + /\A=item\s+(\w*)/s; + $item = $1; + } + + $items{$item} = "$pod" if $item; + } + } +} + +# +# process_head - convert a pod head[1-6] tag and convert it to HTML format. +# +sub process_head { + my($tag, $heading) = @_; + my $firstword; + + # figure out the level of the =head + $tag =~ /head([1-6])/; + my $level = $1; + + # can't have a heading full of spaces and speechmarks and so on + $firstword = $heading; $firstword =~ s/\s*(\w+)\s.*/$1/; + + print HTML "<P>\n" unless $listlevel; + print HTML "<HR>\n" unless $listlevel || $top; + print HTML "<H$level>"; # unless $listlevel; + #print HTML "<H$level>" unless $listlevel; + my $convert = $heading; process_text(\$convert); + print HTML '<A NAME="' . htmlify(0,$heading) . "\">$convert</A>"; + print HTML "</H$level>"; # unless $listlevel; + print HTML "\n"; +} + +# +# process_item - convert a pod item tag and convert it to HTML format. +# +sub process_item { + my $text = $_[0]; + my($i, $quote, $name); + + my $need_preamble = 0; + my $this_entry; + + + # lots of documents start a list without doing an =over. this is + # bad! but, the proper thing to do seems to be to just assume + # they did do an =over. so warn them once and then continue. + warn "$0: $podfile: unexpected =item directive in paragraph $paragraph. ignoring.\n" + unless $listlevel; + process_over() unless $listlevel; + + return unless $listlevel; + + # remove formatting instructions from the text + 1 while $text =~ s/[A-Z]<([^<>]*)>/$1/g; + pre_escape(\$text); + + $need_preamble = $items_seen[$listlevel]++ == 0; + + # check if this is the first =item after an =over + $i = $listlevel - 1; + my $need_new = $listlevel >= @listitem; + + if ($text =~ /\A\*/) { # bullet + + if ($need_preamble) { + push(@listend, "</UL>"); + print HTML "<UL>\n"; + } + + print HTML "<LI><STRONG>"; + $text =~ /\A\*\s*(.*)\Z/s; + print HTML "<A NAME=\"item_" . htmlify(1,$1) . "\">" if $1 && !$items_named{$1}++; + $quote = 1; + #print HTML process_puretext($1, \$quote); + print HTML $1; + print HTML "</A>" if $1; + print HTML "</STRONG>"; + + } elsif ($text =~ /\A[0-9#]+/) { # numbered list + + if ($need_preamble) { + push(@listend, "</OL>"); + print HTML "<OL>\n"; + } + + print HTML "<LI><STRONG>"; + $text =~ /\A[0-9]+\.?(.*)\Z/s; + print HTML "<A NAME=\"item_" . htmlify(0,$1) . "\">" if $1; + $quote = 1; + #print HTML process_puretext($1, \$quote); + print HTML $1 if $1; + print HTML "</A>" if $1; + print HTML "</STRONG>"; + + } else { # all others + + if ($need_preamble) { + push(@listend, '</DL>'); + print HTML "<DL>\n"; + } + + print HTML "<DT><STRONG>"; + print HTML "<A NAME=\"item_" . htmlify(1,$text) . "\">" + if $text && !$items_named{($text =~ /(\S+)/)[0]}++; + # preceding craziness so that the duplicate leading bits in + # perlfunc work to find just the first one. otherwise + # open etc would have many names + $quote = 1; + #print HTML process_puretext($text, \$quote); + print HTML $text; + print HTML "</A>" if $text; + print HTML "</STRONG>"; + + print HTML '<DD>'; + } + + print HTML "\n"; +} + +# +# process_over - process a pod over tag and start a corresponding HTML +# list. +# +sub process_over { + # start a new list + $listlevel++; +} + +# +# process_back - process a pod back tag and convert it to HTML format. +# +sub process_back { + warn "$0: $podfile: unexpected =back directive in paragraph $paragraph. ignorning.\n" + unless $listlevel; + return unless $listlevel; + + # close off the list. note, I check to see if $listend[$listlevel] is + # defined because an =item directive may have never appeared and thus + # $listend[$listlevel] may have never been initialized. + $listlevel--; + print HTML $listend[$listlevel] if defined $listend[$listlevel]; + print HTML "\n"; + + # don't need the corresponding perl code anymore + pop(@listitem); + pop(@listdata); + pop(@listend); + + pop(@items_seen); +} + +# +# process_cut - process a pod cut tag, thus stop ignoring pod directives. +# +sub process_cut { + $ignore = 1; +} + +# +# process_pod - process a pod pod tag, thus ignore pod directives until we see a +# corresponding cut. +# +sub process_pod { + # no need to set $ignore to 0 cause the main loop did it +} + +# +# process_for - process a =for pod tag. if it's for html, split +# it out verbatim, otherwise ignore it. +# +sub process_for { + my($whom, $text) = @_; + if ( $whom =~ /^(pod2)?html$/i) { + print HTML $text; + } +} + +# +# process_begin - process a =begin pod tag. this pushes +# whom we're beginning on the begin stack. if there's a +# begin stack, we only print if it us. +# +sub process_begin { + my($whom, $text) = @_; + $whom = lc($whom); + push (@begin_stack, $whom); + if ( $whom =~ /^(pod2)?html$/) { + print HTML $text if $text; + } +} + +# +# process_end - process a =end pod tag. pop the +# begin stack. die if we're mismatched. +# +sub process_end { + my($whom, $text) = @_; + $whom = lc($whom); + if ($begin_stack[-1] ne $whom ) { + die "Unmatched begin/end at chunk $paragraph\n" + } + pop @begin_stack; +} + +# +# process_text - handles plaintext that appears in the input pod file. +# there may be pod commands embedded within the text so those must be +# converted to html commands. +# +sub process_text { + my($text, $escapeQuotes) = @_; + my($result, $rest, $s1, $s2, $s3, $s4, $match, $bf); + my($podcommand, $params, $tag, $quote); + + return if $ignore; + + $quote = 0; # status of double-quote conversion + $result = ""; + $rest = $$text; + + if ($rest =~ /^\s+/) { # preformatted text, no pod directives + $rest =~ s/\n+\Z//; + + $rest =~ s/&/&/g; + $rest =~ s/</</g; + $rest =~ s/>/>/g; + $rest =~ s/"/"/g; + + # try and create links for all occurrences of perl.* within + # the preformatted text. + $rest =~ s{ + (\s*)(perl\w+) + }{ + if (defined $pages{$2}) { # is a link + qq($1<A HREF="$htmlroot/$pages{$2}">$2</A>); + } else { + "$1$2"; + } + }xeg; + $rest =~ s/(<A HREF=)([^>:]*:)?([^>:]*)\.pod:([^>:]*:)?/$1$3.html/g; + + my $urls = '(' . join ('|', qw{ + http + telnet + mailto + news + gopher + file + wais + ftp + } ) + . ')'; + + my $ltrs = '\w'; + my $gunk = '/#~:.?+=&%@!\-'; + my $punc = '.:?\-'; + my $any = "${ltrs}${gunk}${punc}"; + + $rest =~ s{ + \b # start at word boundary + ( # begin $1 { + $urls : # need resource and a colon + [$any] +? # followed by on or more + # of any valid character, but + # be conservative and take only + # what you need to.... + ) # end $1 } + (?= # look-ahead non-consumptive assertion + [$punc]* # either 0 or more puntuation + [^$any] # followed by a non-url char + | # or else + $ # then end of the string + ) + }{<A HREF="$1">$1</A>}igox; + + $result = "<PRE>" # text should be as it is (verbatim) + . "$rest\n" + . "</PRE>\n"; + } else { # formatted text + # parse through the string, stopping each time we find a + # pod-escape. once the string has been throughly processed + # we can output it. + while ($rest) { + # check to see if there are any possible pod directives in + # the remaining part of the text. + if ($rest =~ m/[BCEIFLSZ]</) { + warn "\$rest\t= $rest\n" unless + $rest =~ /\A + ([^<]*?) + ([BCEIFLSZ]?) + < + (.*)\Z/xs; + + $s1 = $1; # pure text + $s2 = $2; # the type of pod-escape that follows + $s3 = '<'; # '<' + $s4 = $3; # the rest of the string + } else { + $s1 = $rest; + $s2 = ""; + $s3 = ""; + $s4 = ""; + } + + if ($s3 eq '<' && $s2) { # a pod-escape + $result .= ($escapeQuotes ? process_puretext($s1, \$quote) : $s1); + $podcommand = "$s2<"; + $rest = $s4; + + # find the matching '>' + $match = 1; + $bf = 0; + while ($match && !$bf) { + $bf = 1; + if ($rest =~ /\A([^<>]*[BCEIFLSZ]<)(.*)\Z/s) { + $bf = 0; + $match++; + $podcommand .= $1; + $rest = $2; + } elsif ($rest =~ /\A([^>]*>)(.*)\Z/s) { + $bf = 0; + $match--; + $podcommand .= $1; + $rest = $2; + } + } + + if ($match != 0) { + warn <<WARN; +$0: $podfile: cannot find matching > for $s2 in paragraph $paragraph. +WARN + $result .= substr $podcommand, 0, 2; + $rest = substr($podcommand, 2) . $rest; + next; + } + + # pull out the parameters to the pod-escape + $podcommand =~ /^([BCFEILSZ]?)<(.*)>$/s; + $tag = $1; + $params = $2; + + # process the text within the pod-escape so that any escapes + # which must occur do. + process_text(\$params, 0) unless $tag eq 'L'; + + $s1 = $params; + if (!$tag || $tag eq " ") { # <> : no tag + $s1 = "<$params>"; + } elsif ($tag eq "L") { # L<> : link + $s1 = process_L($params); + } elsif ($tag eq "I" || # I<> : italicize text + $tag eq "B" || # B<> : bold text + $tag eq "F") { # F<> : file specification + $s1 = process_BFI($tag, $params); + } elsif ($tag eq "C") { # C<> : literal code + $s1 = process_C($params, 1); + } elsif ($tag eq "E") { # E<> : escape + $s1 = process_E($params); + } elsif ($tag eq "Z") { # Z<> : zero-width character + $s1 = process_Z($params); + } elsif ($tag eq "S") { # S<> : non-breaking space + $s1 = process_S($params); + } elsif ($tag eq "X") { # S<> : non-breaking space + $s1 = process_X($params); + } else { + warn "$0: $podfile: unhandled tag '$tag' in paragraph $paragraph\n"; + } + + $result .= "$s1"; + } else { + # for pure text we must deal with implicit links and + # double-quotes among other things. + $result .= ($escapeQuotes ? process_puretext("$s1$s2$s3", \$quote) : "$s1$s2$s3"); + $rest = $s4; + } + } + } + $$text = $result; +} + +sub html_escape { + my $rest = $_[0]; + $rest =~ s/&/&/g; + $rest =~ s/</</g; + $rest =~ s/>/>/g; + $rest =~ s/"/"/g; + return $rest; +} + +# +# process_puretext - process pure text (without pod-escapes) converting +# double-quotes and handling implicit C<> links. +# +sub process_puretext { + my($text, $quote) = @_; + my(@words, $result, $rest, $lead, $trail); + + # convert double-quotes to single-quotes + $text =~ s/\A([^"]*)"/$1''/s if $$quote; + while ($text =~ s/\A([^"]*)["]([^"]*)["]/$1``$2''/sg) {} + + $$quote = ($text =~ m/"/ ? 1 : 0); + $text =~ s/\A([^"]*)"/$1``/s if $$quote; + + # keep track of leading and trailing white-space + $lead = ($text =~ /\A(\s*)/s ? $1 : ""); + $trail = ($text =~ /(\s*)\Z/s ? $1 : ""); + + # collapse all white space into a single space + $text =~ s/\s+/ /g; + @words = split(" ", $text); + + # process each word individually + foreach my $word (@words) { + # see if we can infer a link + if ($word =~ /^\w+\(/) { + # has parenthesis so should have been a C<> ref + $word = process_C($word); +# $word =~ /^[^()]*]\(/; +# if (defined $items{$1} && $items{$1}) { +# $word = "\n<CODE><A HREF=\"$htmlroot/$items{$1}#item_" +# . htmlify(0,$word) +# . "\">$word</A></CODE>"; +# } elsif (defined $items{$word} && $items{$word}) { +# $word = "\n<CODE><A HREF=\"$htmlroot/$items{$word}#item_" +# . htmlify(0,$word) +# . "\">$word</A></CODE>"; +# } else { +# $word = "\n<CODE><A HREF=\"#item_" +# . htmlify(0,$word) +# . "\">$word</A></CODE>"; +# } + } elsif ($word =~ /^[\$\@%&*]+\w+$/) { + # perl variables, should be a C<> ref + $word = process_C($word, 1); + } elsif ($word =~ m,^\w+://\w,) { + # looks like a URL + $word = qq(<A HREF="$word">$word</A>); + } elsif ($word =~ /[\w.-]+\@\w+\.\w/) { + # looks like an e-mail address + $word = qq(<A HREF="MAILTO:$word">$word</A>); + } elsif ($word !~ /[a-z]/ && $word =~ /[A-Z]/) { # all uppercase? + $word = html_escape($word) if $word =~ /[&<>]/; + $word = "\n<FONT SIZE=-1>$word</FONT>" if $netscape; + } else { + $word = html_escape($word) if $word =~ /[&<>]/; + } + } + + # build a new string based upon our conversion + $result = ""; + $rest = join(" ", @words); + while (length($rest) > 75) { + if ( $rest =~ m/^(.{0,75})\s(.*?)$/o || + $rest =~ m/^(\S*)\s(.*?)$/o) { + + $result .= "$1\n"; + $rest = $2; + } else { + $result .= "$rest\n"; + $rest = ""; + } + } + $result .= $rest if $rest; + + # restore the leading and trailing white-space + $result = "$lead$result$trail"; + + return $result; +} + +# +# pre_escape - convert & in text to $amp; +# +sub pre_escape { + my($str) = @_; + + $$str =~ s,&,&,g; +} + +# +# process_L - convert a pod L<> directive to a corresponding HTML link. +# most of the links made are inferred rather than known about directly +# (i.e it's not known whether the =head\d section exists in the target file, +# or whether a .pod file exists in the case of split files). however, the +# guessing usually works. +# +# Unlike the other directives, this should be called with an unprocessed +# string, else tags in the link won't be matched. +# +sub process_L { + my($str) = @_; + my($s1, $s2, $linktext, $page, $section, $link); # work strings + + $str =~ s/\n/ /g; # undo word-wrapped tags + $s1 = $str; + for ($s1) { + # a :: acts like a / + s,::,/,; + + # make sure sections start with a / + s,^",/",g; + s,^,/,g if (!m,/, && / /); + + # check if there's a section specified + if (m,^(.*?)/"?(.*?)"?$,) { # yes + ($page, $section) = ($1, $2); + } else { # no + ($page, $section) = ($str, ""); + } + + # check if we know that this is a section in this page + if (!defined $pages{$page} && defined $sections{$page}) { + $section = $page; + $page = ""; + } + } + + if ($page eq "") { + $link = "#" . htmlify(0,$section); + $linktext = $section; + } elsif (!defined $pages{$page}) { + warn "$0: $podfile: cannot resolve L<$str> in paragraph $paragraph: no such page '$page'\n"; + $link = ""; + $linktext = $page; + } else { + $linktext = ($section ? "$section" : "the $page manpage"); + $section = htmlify(0,$section) if $section ne ""; + + # if there is a directory by the name of the page, then assume that an + # appropriate section will exist in the subdirectory + if ($section ne "" && $pages{$page} =~ /([^:]*[^(\.pod|\.pm)]):/) { + $link = "$htmlroot/$1/$section.html"; + + # since there is no directory by the name of the page, the section will + # have to exist within a .html of the same name. thus, make sure there + # is a .pod or .pm that might become that .html + } else { + $section = "#$section"; + # check if there is a .pod with the page name + if ($pages{$page} =~ /([^:]*)\.pod:/) { + $link = "$htmlroot/$1.html$section"; + } elsif ($pages{$page} =~ /([^:]*)\.pm:/) { + $link = "$htmlroot/$1.html$section"; + } else { + warn "$0: $podfile: cannot resolve L$str in paragraph $paragraph: ". + "no .pod or .pm found\n"; + $link = ""; + $linktext = $section; + } + } + } + + process_text(\$linktext, 0); + if ($link) { + $s1 = "<A HREF=\"$link\">$linktext</A>"; + } else { + $s1 = "<EM>$linktext</EM>"; + } + return $s1; +} + +# +# process_BFI - process any of the B<>, F<>, or I<> pod-escapes and +# convert them to corresponding HTML directives. +# +sub process_BFI { + my($tag, $str) = @_; + my($s1); # work string + my(%repltext) = ( 'B' => 'STRONG', + 'F' => 'EM', + 'I' => 'EM'); + + # extract the modified text and convert to HTML + $s1 = "<$repltext{$tag}>$str</$repltext{$tag}>"; + return $s1; +} + +# +# process_C - process the C<> pod-escape. +# +sub process_C { + my($str, $doref) = @_; + my($s1, $s2); + + $s1 = $str; + $s1 =~ s/\([^()]*\)//g; # delete parentheses + $str = $s2 = $s1; + $s1 =~ s/\W//g; # delete bogus characters + + # if there was a pod file that we found earlier with an appropriate + # =item directive, then create a link to that page. + if ($doref && defined $items{$s1}) { + $s1 = ($items{$s1} ? + "<A HREF=\"$htmlroot/$items{$s1}#item_" . htmlify(0,$s2) . "\">$str</A>" : + "<A HREF=\"#item_" . htmlify(0,$s2) . "\">$str</A>"); + $s1 =~ s,(perl\w+/(\S+)\.html)#item_\2\b,$1,; + confess "s1 has space: $s1" if $s1 =~ /HREF="[^"]*\s[^"]*"/; + } else { + $s1 = "<CODE>$str</CODE>"; + # warn "$0: $podfile: cannot resolve C<$str> in paragraph $paragraph\n" if $verbose + } + + + return $s1; +} + +# +# process_E - process the E<> pod directive which seems to escape a character. +# +sub process_E { + my($str) = @_; + + for ($str) { + s,([^/].*),\&$1\;,g; + } + + return $str; +} + +# +# process_Z - process the Z<> pod directive which really just amounts to +# ignoring it. this allows someone to start a paragraph with an = +# +sub process_Z { + my($str) = @_; + + # there is no equivalent in HTML for this so just ignore it. + $str = ""; + return $str; +} + +# +# process_S - process the S<> pod directive which means to convert all +# spaces in the string to non-breaking spaces (in HTML-eze). +# +sub process_S { + my($str) = @_; + + # convert all spaces in the text to non-breaking spaces in HTML. + $str =~ s/ / /g; + return $str; +} + +# +# process_X - this is supposed to make an index entry. we'll just +# ignore it. +# +sub process_X { + return ''; +} + + +# +# finish_list - finish off any pending HTML lists. this should be called +# after the entire pod file has been read and converted. +# +sub finish_list { + while ($listlevel >= 0) { + print HTML "</DL>\n"; + $listlevel--; + } +} + +# +# htmlify - converts a pod section specification to a suitable section +# specification for HTML. if first arg is 1, only takes 1st word. +# +sub htmlify { + my($compact, $heading) = @_; + + if ($compact) { + $heading =~ /^(\w+)/; + $heading = $1; + } + + # $heading = lc($heading); + $heading =~ s/[^\w\s]/_/g; + $heading =~ s/(\s+)/ /g; + $heading =~ s/^\s*(.*?)\s*$/$1/s; + $heading =~ s/ /_/g; + $heading =~ s/\A(.{32}).*\Z/$1/s; + $heading =~ s/\s+\Z//; + $heading =~ s/_{2,}/_/g; + + return $heading; +} + +BEGIN { +} + +1; + diff --git a/lib/Term/Cap.pm b/lib/Term/Cap.pm index 5a73ecfc52..0b3b4aa4ad 100644 --- a/lib/Term/Cap.pm +++ b/lib/Term/Cap.pm @@ -185,13 +185,16 @@ sub Tgetent { ## public -- static method # This is eval'ed inside the while loop for each file $search = q{ - while ($_ = <TERMCAP>) { + while (<TERMCAP>) { next if /^\\t/ || /^#/; if ($_ =~ m/(^|\\|)${termpat}[:|]/o) { chomp; s/^[^:]*:// if $first++; $state = 0; - while ($_ =~ s/\\\\$//) { $_ .= <TERMCAP>; chomp; } + while ($_ =~ s/\\\\$//) { + defined(my $x = <TERMCAP>) or last; + $_ .= $x; chomp; + } last; } } diff --git a/lib/Text/ParseWords.pm b/lib/Text/ParseWords.pm index f2e1514972..ce6f0009fc 100644 --- a/lib/Text/ParseWords.pm +++ b/lib/Text/ParseWords.pm @@ -9,6 +9,8 @@ use Carp; @EXPORT = qw(shellwords quotewords); @EXPORT_OK = qw(old_shellwords); +*AUTOLOAD = *AutoLoader::AUTOLOAD; + =head1 NAME Text::ParseWords - parse text into an array of tokens diff --git a/lib/chat2.inter b/lib/chat2.inter deleted file mode 100644 index 6934f1cc28..0000000000 --- a/lib/chat2.inter +++ /dev/null @@ -1,495 +0,0 @@ -Article 20992 of comp.lang.perl: -Path: netlabs!news.cerf.net!mvb.saic.com!MathWorks.Com!europa.eng.gtefsd.com!howland.reston.ans.net!cs.utexas.edu!swrinde!ihnp4.ucsd.edu!ames!koriel!male.EBay.Sun.COM!jethro.Corp.Sun.COM!eric -From: eric.arnold@sun.com (Eric Arnold) -Newsgroups: comp.lang.perl -Subject: Re: Need a bidirectional filter for interactive Unix applications -Date: 15 Apr 94 21:24:03 GMT -Organization: Sun Microsystems -Lines: 478 -Sender: news@sun.com -Message-ID: <ERIC.94Apr15212403@sun.com> -References: <dgfCo9F2J.Jzw@netcom.com> <1994Apr15.110134.4581@chemabs.uucp> -NNTP-Posting-Host: animus.corp.sun.com -X-Newsreader: prn Ver 1.09 -In-reply-to: btf64@cas.org's message of Fri, 15 Apr 1994 11:01:34 GMT - -In article <1994Apr15.110134.4581@chemabs.uucp> - btf64@cas.org (Bernard T. French) writes: - ->In article <dgfCo9F2J.Jzw@netcom.com> dgf@netcom.com (David Feldman) writes: ->>I need to write a bidirectional filter that would (ideally) sit between a -.. ->>program's stdin & stdout to point to a pty pair known to perl. The perl app- ->>lication would talk to the user's crt/keyboard, translate (application-specific) ->>the input & output streams, and pass these as appropriate to/from the pty pair, -.. -> -> I'm afraid I can't offer you a perl solution, but err..... there is a ->Tcl solution. There is a Tcl extension called "expect" that is designed to - -There *is* an old, established Perl solution: "chat2.pl" which does -everything (well, basically) "expect" does but you get it in the -expressive Perl environment. "chat2.pl" is delivered with the Perl -source. - -Randal: "interact()" still hasn't made it into Perl5alpha8 -"chat2.pl", so I've included a version which does. - --Eric - - -## chat.pl: chat with a server -## V2.01.alpha.7 91/06/16 -## Randal L. Schwartz - -package chat; - -$sockaddr = 'S n a4 x8'; -chop($thishost = `hostname`); $thisaddr = (gethostbyname($thishost))[4]; -$thisproc = pack($sockaddr, 2, 0, $thisaddr); - -# *S = symbol for current I/O, gets assigned *chatsymbol.... -$next = "chatsymbol000000"; # next one -$nextpat = "^chatsymbol"; # patterns that match next++, ++, ++, ++ - - -## $handle = &chat'open_port("server.address",$port_number); -## opens a named or numbered TCP server - -sub open_port { ## public - local($server, $port) = @_; - - local($serveraddr,$serverproc); - - *S = ++$next; - if ($server =~ /^(\d+)+\.(\d+)\.(\d+)\.(\d+)$/) { - $serveraddr = pack('C4', $1, $2, $3, $4); - } else { - local(@x) = gethostbyname($server); - return undef unless @x; - $serveraddr = $x[4]; - } - $serverproc = pack($sockaddr, 2, $port, $serveraddr); - unless (socket(S, 2, 1, 6)) { - # XXX hardwired $AF_SOCKET, $SOCK_STREAM, 'tcp' - # but who the heck would change these anyway? (:-) - ($!) = ($!, close(S)); # close S while saving $! - return undef; - } - unless (bind(S, $thisproc)) { - ($!) = ($!, close(S)); # close S while saving $! - return undef; - } - unless (connect(S, $serverproc)) { - ($!) = ($!, close(S)); # close S while saving $! - return undef; - } - select((select(S), $| = 1)[0]); - $next; # return symbol for switcharound -} - -## ($host, $port, $handle) = &chat'open_listen([$port_number]); -## opens a TCP port on the current machine, ready to be listened to -## if $port_number is absent or zero, pick a default port number -## process must be uid 0 to listen to a low port number - -sub open_listen { ## public - - *S = ++$next; - local($thisport) = shift || 0; - local($thisproc_local) = pack($sockaddr, 2, $thisport, $thisaddr); - local(*NS) = "__" . time; - unless (socket(NS, 2, 1, 6)) { - # XXX hardwired $AF_SOCKET, $SOCK_STREAM, 'tcp' - # but who the heck would change these anyway? (:-) - ($!) = ($!, close(NS)); - return undef; - } - unless (bind(NS, $thisproc_local)) { - ($!) = ($!, close(NS)); - return undef; - } - unless (listen(NS, 1)) { - ($!) = ($!, close(NS)); - return undef; - } - select((select(NS), $| = 1)[0]); - local($family, $port, @myaddr) = - unpack("S n C C C C x8", getsockname(NS)); - $S{"needs_accept"} = *NS; # so expect will open it - (@myaddr, $port, $next); # returning this -} - -## $handle = &chat'open_proc("command","arg1","arg2",...); -## opens a /bin/sh on a pseudo-tty - -sub open_proc { ## public - local(@cmd) = @_; - - *S = ++$next; - local(*TTY) = "__TTY" . time; - local($pty,$tty,$pty_handle) = &_getpty(S,TTY); - - #local($pty,$tty,$pty_handle) = &getpty(S,TTY); - #$Tty = $tty; - - die "Cannot find a new pty" unless defined $pty; - local($pid) = fork; - die "Cannot fork: $!" unless defined $pid; - unless ($pid) { - close STDIN; close STDOUT; close STDERR; - #close($pty_handle); - setpgrp(0,$$); - if (open(DEVTTY, "/dev/tty")) { - ioctl(DEVTTY,0x20007471,0); # XXX s/b &TIOCNOTTY - close DEVTTY; - } - open(STDIN,"<&TTY"); - open(STDOUT,">&TTY"); - open(STDERR,">&STDOUT"); - die "Oops" unless fileno(STDERR) == 2; # sanity - close(S); - - exec @cmd; - die "Cannot exec @cmd: $!"; - } - close(TTY); - $PID{$next} = $pid; - $next; # return symbol for switcharound - -} - -# $S is the read-ahead buffer - -## $return = &chat'expect([$handle,] $timeout_time, -## $pat1, $body1, $pat2, $body2, ... ) -## $handle is from previous &chat'open_*(). -## $timeout_time is the time (either relative to the current time, or -## absolute, ala time(2)) at which a timeout event occurs. -## $pat1, $pat2, and so on are regexs which are matched against the input -## stream. If a match is found, the entire matched string is consumed, -## and the corresponding body eval string is evaled. -## -## Each pat is a regular-expression (probably enclosed in single-quotes -## in the invocation). ^ and $ will work, respecting the current value of $*. -## If pat is 'TIMEOUT', the body is executed if the timeout is exceeded. -## If pat is 'EOF', the body is executed if the process exits before -## the other patterns are seen. -## -## Pats are scanned in the order given, so later pats can contain -## general defaults that won't be examined unless the earlier pats -## have failed. -## -## The result of eval'ing body is returned as the result of -## the invocation. Recursive invocations are not thought -## through, and may work only accidentally. :-) -## -## undef is returned if either a timeout or an eof occurs and no -## corresponding body has been defined. -## I/O errors of any sort are treated as eof. - -$nextsubname = "expectloop000000"; # used for subroutines - -sub expect { ## public - if ($_[0] =~ /$nextpat/) { - *S = shift; - } - local($endtime) = shift; - - local($timeout,$eof) = (1,1); - local($caller) = caller; - local($rmask, $nfound, $timeleft, $thisbuf); - local($cases, $pattern, $action, $subname); - $endtime += time if $endtime < 600_000_000; - - if (defined $S{"needs_accept"}) { # is it a listen socket? - local(*NS) = $S{"needs_accept"}; - delete $S{"needs_accept"}; - $S{"needs_close"} = *NS; - unless(accept(S,NS)) { - ($!) = ($!, close(S), close(NS)); - return undef; - } - select((select(S), $| = 1)[0]); - } - - # now see whether we need to create a new sub: - - unless ($subname = $expect_subname{$caller,@_}) { - # nope. make a new one: - $expect_subname{$caller,@_} = $subname = $nextsubname++; - - $cases .= <<"EDQ"; # header is funny to make everything elsif's -sub $subname { - LOOP: { - if (0) { ; } -EDQ - while (@_) { - ($pattern,$action) = splice(@_,0,2); - if ($pattern =~ /^eof$/i) { - $cases .= <<"EDQ"; - elsif (\$eof) { - package $caller; - $action; - } -EDQ - $eof = 0; - } elsif ($pattern =~ /^timeout$/i) { - $cases .= <<"EDQ"; - elsif (\$timeout) { - package $caller; - $action; - } -EDQ - $timeout = 0; - } else { - $pattern =~ s#/#\\/#g; - $cases .= <<"EDQ"; - elsif (\$S =~ /$pattern/) { - \$S = \$'; - package $caller; - $action; - } -EDQ - } - } - $cases .= <<"EDQ" if $eof; - elsif (\$eof) { - undef; - } -EDQ - $cases .= <<"EDQ" if $timeout; - elsif (\$timeout) { - undef; - } -EDQ - $cases .= <<'ESQ'; - else { - $rmask = ""; - vec($rmask,fileno(S),1) = 1; - ($nfound, $rmask) = - select($rmask, undef, undef, $endtime - time); - if ($nfound) { - $nread = sysread(S, $thisbuf, 1024); - if ($nread > 0) { - $S .= $thisbuf; - } else { - $eof++, redo LOOP; # any error is also eof - } - } else { - $timeout++, redo LOOP; # timeout - } - redo LOOP; - } - } -} -ESQ - eval $cases; die "$cases:\n$@" if $@; - } - $eof = $timeout = 0; - do $subname(); -} - -## &chat'print([$handle,] @data) -## $handle is from previous &chat'open(). -## like print $handle @data - -sub print { ## public - if ($_[0] =~ /$nextpat/) { - *S = shift; - } - print S @_; -} - -## &chat'close([$handle,]) -## $handle is from previous &chat'open(). -## like close $handle - -sub close { ## public - local($pid); - if ($_[0] =~ /$nextpat/) { - $pid = $PID{$_[0]}; - *S = shift; - } else { - $pid = $PID{$next}; - } - close(S); - waitpid($pid,0); - if (defined $S{"needs_close"}) { # is it a listen socket? - local(*NS) = $S{"needs_close"}; - delete $S{"needs_close"}; - close(NS); - } -} - -## @ready_handles = &chat'select($timeout, @handles) -## select()'s the handles with a timeout value of $timeout seconds. -## Returns an array of handles that are ready for I/O. -## Both user handles and chat handles are supported (but beware of -## stdio's buffering for user handles). - -sub select { ## public - local($timeout) = shift; - local(@handles) = @_; - local(%handlename) = (); - local(%ready) = (); - local($caller) = caller; - local($rmask) = ""; - for (@handles) { - if (/$nextpat/o) { # one of ours... see if ready - local(*SYM) = $_; - if (length($SYM)) { - $timeout = 0; # we have a winner - $ready{$_}++; - } - $handlename{fileno($_)} = $_; - } else { - $handlename{fileno(/'/ ? $_ : "$caller\'$_")} = $_; - } - } - for (sort keys %handlename) { - vec($rmask, $_, 1) = 1; - } - select($rmask, undef, undef, $timeout); - for (sort keys %handlename) { - $ready{$handlename{$_}}++ if vec($rmask,$_,1); - } - sort keys %ready; -} - -# ($pty,$tty) = $chat'_getpty(PTY,TTY): -# internal procedure to get the next available pty. -# opens pty on handle PTY, and matching tty on handle TTY. -# returns undef if can't find a pty. - -sub _getpty { ## private - local($_PTY,$_TTY) = @_; - $_PTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e; - $_TTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e; - local($pty,$tty); - for $bank (112..127) { - next unless -e sprintf("/dev/pty%c0", $bank); - for $unit (48..57) { - $pty = sprintf("/dev/pty%c%c", $bank, $unit); - open($_PTY,"+>$pty") || next; - select((select($_PTY), $| = 1)[0]); - ($tty = $pty) =~ s/pty/tty/; - open($_TTY,"+>$tty") || next; - select((select($_TTY), $| = 1)[0]); - system "stty nl>$tty"; - return ($pty,$tty,$_PTY); - } - } - undef; -} - - -sub getpty { - local( $pty_handle, $tty_handle ) = @_; - -print "--------in getpty----------\n"; - $pty_handle =~ s/^([^']+)$/(caller)[$[]."'".$1/e; - $pty_handle =~ s/^([^']+)$/(caller)[$[]."'".$1/e; - - #$pty_handle = ++$next_handle; - chop( @ptys = `ls /dev/pty*` ); - - for $pty ( @ptys ) - { - open($pty_handle,"+>$pty") || next; - select((select($pty_handle), $| = 1)[0]); - ($tty = $pty) =~ s/pty/tty/; - - open($tty_handle,"+>$tty") || next; - select((select($tty_handle), $| = 1)[0]); - ($tty = $pty) =~ s/pty/tty/; - - return ($pty, $tty, $pty_handle ); - } - return undef; -} - - - -# from: Randal L. Schwartz - -# Usage: -# -# ($chathandle = &chat'open_proc("/bin/sh")) || die "cannot open shell"; -# system("stty cbreak raw -echo >/dev/tty\n"); -# &chat'interact($chathandle); -# &chat'close($chathandle); -# system("stty -cbreak -raw echo >/dev/tty\n"); - -sub interact -{ - local( $chathandle ) = @_; - - &chat'print($chathandle, "stty sane\n"); - select(STDOUT) ; $| = 1; # unbuffer STDOUT - - #print "tty=$Tty,whoami=",`whoami`,"\n"; - #&change_utmp( "", $Tty, "eric", "", time() ); - - { - @ready = &chat'select(30, STDIN,$chathandle); - print "after select, ready=",join(",",@ready),"\n"; - #(warn "[waiting]"), redo unless @ready; - if (grep($_ eq $chathandle, @ready)) { - print "checking $chathandle\n"; - last unless $text = &chat'expect($chathandle,0,'[\s\S]+','$&'); - print "$chathandle OK\n"; - print "got=($text)"; - #print $text; - } - if (grep($_ eq STDIN, @ready)) { - print "checking STDIN\n"; - last unless sysread(STDIN,$buf,1024) > 0; - print "STDIN OK\n"; - &chat'print($chathandle,$buf); - } - redo; - } - #&change_utmp( $Tty, "$Tty", "", "", 0 ); - print "leaving interact, \$!=$!\n"; -} - -## $handle = &chat'open_duphandle(handle); -## duplicates an input file handle to conform to chat format - -sub open_duphandle { ## public - *S = ++$next; - open(S,"<&$_[0]"); - $next; # return symbol for switcharound -} - -#Here is an example which uses this routine. -# -# # The following lines makes stdin unbuffered -# -# $BSD = -f '/vmunix'; -# -# if ($BSD) { -# system "stty cbreak </dev/tty >/dev/tty 2>&1"; -# } -# else { -# system "stty", '-icanon'; -# system "stty", 'eol', '^A'; -# } -# -# require 'mychat2.pl'; -# -# &chat'open_duphandle(STDIN); -# -# print -# &chat'expect(3, -# '[A-Z]', '" :-)"', -# '.', '" :-("', -# TIMEOUT, '"-o-"', -# EOF, '"\$\$"'), -# "\n"; - - -1; - - diff --git a/lib/chat2.pl b/lib/chat2.pl deleted file mode 100644 index 8320270175..0000000000 --- a/lib/chat2.pl +++ /dev/null @@ -1,368 +0,0 @@ -# chat.pl: chat with a server -# Based on: V2.01.alpha.7 91/06/16 -# Randal L. Schwartz (was <merlyn@stonehenge.com>) -# multihome additions by A.Macpherson@bnr.co.uk -# allow for /dev/pts based systems by Joe Doupnik <JRD@CC.USU.EDU> - -package chat; - -require 'sys/socket.ph'; - -if( defined( &main'PF_INET ) ){ - $pf_inet = &main'PF_INET; - $sock_stream = &main'SOCK_STREAM; - local($name, $aliases, $proto) = getprotobyname( 'tcp' ); - $tcp_proto = $proto; -} -else { - # XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp' - # but who the heck would change these anyway? (:-) - $pf_inet = 2; - $sock_stream = 1; - $tcp_proto = 6; -} - - -$sockaddr = 'S n a4 x8'; -chop($thishost = `hostname`); - -# *S = symbol for current I/O, gets assigned *chatsymbol.... -$next = "chatsymbol000000"; # next one -$nextpat = "^chatsymbol"; # patterns that match next++, ++, ++, ++ - - -## $handle = &chat'open_port("server.address",$port_number); -## opens a named or numbered TCP server - -sub open_port { ## public - local($server, $port) = @_; - - local($serveraddr,$serverproc); - - # We may be multi-homed, start with 0, fixup once connexion is made - $thisaddr = "\0\0\0\0" ; - $thisproc = pack($sockaddr, 2, 0, $thisaddr); - - *S = ++$next; - if ($server =~ /^(\d+)+\.(\d+)\.(\d+)\.(\d+)$/) { - $serveraddr = pack('C4', $1, $2, $3, $4); - } else { - local(@x) = gethostbyname($server); - return undef unless @x; - $serveraddr = $x[4]; - } - $serverproc = pack($sockaddr, 2, $port, $serveraddr); - unless (socket(S, $pf_inet, $sock_stream, $tcp_proto)) { - ($!) = ($!, close(S)); # close S while saving $! - return undef; - } - unless (bind(S, $thisproc)) { - ($!) = ($!, close(S)); # close S while saving $! - return undef; - } - unless (connect(S, $serverproc)) { - ($!) = ($!, close(S)); # close S while saving $! - return undef; - } -# We opened with the local address set to ANY, at this stage we know -# which interface we are using. This is critical if our machine is -# multi-homed, with IP forwarding off, so fix-up. - local($fam,$lport); - ($fam,$lport,$thisaddr) = unpack($sockaddr, getsockname(S)); - $thisproc = pack($sockaddr, 2, 0, $thisaddr); -# end of post-connect fixup - select((select(S), $| = 1)[0]); - $next; # return symbol for switcharound -} - -## ($host, $port, $handle) = &chat'open_listen([$port_number]); -## opens a TCP port on the current machine, ready to be listened to -## if $port_number is absent or zero, pick a default port number -## process must be uid 0 to listen to a low port number - -sub open_listen { ## public - - *S = ++$next; - local($thisport) = shift || 0; - local($thisproc_local) = pack($sockaddr, 2, $thisport, $thisaddr); - local(*NS) = "__" . time; - unless (socket(NS, $pf_inet, $sock_stream, $tcp_proto)) { - ($!) = ($!, close(NS)); - return undef; - } - unless (bind(NS, $thisproc_local)) { - ($!) = ($!, close(NS)); - return undef; - } - unless (listen(NS, 1)) { - ($!) = ($!, close(NS)); - return undef; - } - select((select(NS), $| = 1)[0]); - local($family, $port, @myaddr) = - unpack("S n C C C C x8", getsockname(NS)); - $S{"needs_accept"} = *NS; # so expect will open it - (@myaddr, $port, $next); # returning this -} - -## $handle = &chat'open_proc("command","arg1","arg2",...); -## opens a /bin/sh on a pseudo-tty - -sub open_proc { ## public - local(@cmd) = @_; - - *S = ++$next; - local(*TTY) = "__TTY" . time; - local($pty,$tty) = &_getpty(S,TTY); - die "Cannot find a new pty" unless defined $pty; - $pid = fork; - die "Cannot fork: $!" unless defined $pid; - unless ($pid) { - close STDIN; close STDOUT; close STDERR; - setpgrp(0,$$); - if (open(DEVTTY, "/dev/tty")) { - ioctl(DEVTTY,0x20007471,0); # XXX s/b &TIOCNOTTY - close DEVTTY; - } - open(STDIN,"<&TTY"); - open(STDOUT,">&TTY"); - open(STDERR,">&STDOUT"); - die "Oops" unless fileno(STDERR) == 2; # sanity - close(S); - exec @cmd; - die "Cannot exec @cmd: $!"; - } - close(TTY); - $next; # return symbol for switcharound -} - -# $S is the read-ahead buffer - -## $return = &chat'expect([$handle,] $timeout_time, -## $pat1, $body1, $pat2, $body2, ... ) -## $handle is from previous &chat'open_*(). -## $timeout_time is the time (either relative to the current time, or -## absolute, ala time(2)) at which a timeout event occurs. -## $pat1, $pat2, and so on are regexs which are matched against the input -## stream. If a match is found, the entire matched string is consumed, -## and the corresponding body eval string is evaled. -## -## Each pat is a regular-expression (probably enclosed in single-quotes -## in the invocation). ^ and $ will work, respecting the current value of $*. -## If pat is 'TIMEOUT', the body is executed if the timeout is exceeded. -## If pat is 'EOF', the body is executed if the process exits before -## the other patterns are seen. -## -## Pats are scanned in the order given, so later pats can contain -## general defaults that won't be examined unless the earlier pats -## have failed. -## -## The result of eval'ing body is returned as the result of -## the invocation. Recursive invocations are not thought -## through, and may work only accidentally. :-) -## -## undef is returned if either a timeout or an eof occurs and no -## corresponding body has been defined. -## I/O errors of any sort are treated as eof. - -$nextsubname = "expectloop000000"; # used for subroutines - -sub expect { ## public - if ($_[0] =~ /$nextpat/) { - *S = shift; - } - local($endtime) = shift; - - local($timeout,$eof) = (1,1); - local($caller) = caller; - local($rmask, $nfound, $timeleft, $thisbuf); - local($cases, $pattern, $action, $subname); - $endtime += time if $endtime < 600_000_000; - - if (defined $S{"needs_accept"}) { # is it a listen socket? - local(*NS) = $S{"needs_accept"}; - delete $S{"needs_accept"}; - $S{"needs_close"} = *NS; - unless(accept(S,NS)) { - ($!) = ($!, close(S), close(NS)); - return undef; - } - select((select(S), $| = 1)[0]); - } - - # now see whether we need to create a new sub: - - unless ($subname = $expect_subname{$caller,@_}) { - # nope. make a new one: - $expect_subname{$caller,@_} = $subname = $nextsubname++; - - $cases .= <<"EDQ"; # header is funny to make everything elsif's -sub $subname { - LOOP: { - if (0) { ; } -EDQ - while (@_) { - ($pattern,$action) = splice(@_,0,2); - if ($pattern =~ /^eof$/i) { - $cases .= <<"EDQ"; - elsif (\$eof) { - package $caller; - $action; - } -EDQ - $eof = 0; - } elsif ($pattern =~ /^timeout$/i) { - $cases .= <<"EDQ"; - elsif (\$timeout) { - package $caller; - $action; - } -EDQ - $timeout = 0; - } else { - $pattern =~ s#/#\\/#g; - $cases .= <<"EDQ"; - elsif (\$S =~ /$pattern/) { - \$S = \$'; - package $caller; - $action; - } -EDQ - } - } - $cases .= <<"EDQ" if $eof; - elsif (\$eof) { - undef; - } -EDQ - $cases .= <<"EDQ" if $timeout; - elsif (\$timeout) { - undef; - } -EDQ - $cases .= <<'ESQ'; - else { - $rmask = ""; - vec($rmask,fileno(S),1) = 1; - ($nfound, $rmask) = - select($rmask, undef, undef, $endtime - time); - if ($nfound) { - $nread = sysread(S, $thisbuf, 1024); - if ($nread > 0) { - $S .= $thisbuf; - } else { - $eof++, redo LOOP; # any error is also eof - } - } else { - $timeout++, redo LOOP; # timeout - } - redo LOOP; - } - } -} -ESQ - eval $cases; die "$cases:\n$@" if $@; - } - $eof = $timeout = 0; - &$subname(); -} - -## &chat'print([$handle,] @data) -## $handle is from previous &chat'open(). -## like print $handle @data - -sub print { ## public - if ($_[0] =~ /$nextpat/) { - *S = shift; - } - print S @_; - if( $chat'debug ){ - print STDERR "printed:"; - print STDERR @_; - } -} - -## &chat'close([$handle,]) -## $handle is from previous &chat'open(). -## like close $handle - -sub close { ## public - if ($_[0] =~ /$nextpat/) { - *S = shift; - } - close(S); - if (defined $S{"needs_close"}) { # is it a listen socket? - local(*NS) = $S{"needs_close"}; - delete $S{"needs_close"}; - close(NS); - } -} - -## @ready_handles = &chat'select($timeout, @handles) -## select()'s the handles with a timeout value of $timeout seconds. -## Returns an array of handles that are ready for I/O. -## Both user handles and chat handles are supported (but beware of -## stdio's buffering for user handles). - -sub select { ## public - local($timeout) = shift; - local(@handles) = @_; - local(%handlename) = (); - local(%ready) = (); - local($caller) = caller; - local($rmask) = ""; - for (@handles) { - if (/$nextpat/o) { # one of ours... see if ready - local(*SYM) = $_; - if (length($SYM)) { - $timeout = 0; # we have a winner - $ready{$_}++; - } - $handlename{fileno($_)} = $_; - } else { - $handlename{fileno(/'/ ? $_ : "$caller\'$_")} = $_; - } - } - for (sort keys %handlename) { - vec($rmask, $_, 1) = 1; - } - select($rmask, undef, undef, $timeout); - for (sort keys %handlename) { - $ready{$handlename{$_}}++ if vec($rmask,$_,1); - } - sort keys %ready; -} - -# ($pty,$tty) = $chat'_getpty(PTY,TTY): -# internal procedure to get the next available pty. -# opens pty on handle PTY, and matching tty on handle TTY. -# returns undef if can't find a pty. -# Modify "/dev/pty" to "/dev/pts" for Dell Unix v2.2 (aka SVR4.04). Joe Doupnik. - -sub _getpty { ## private - local($_PTY,$_TTY) = @_; - $_PTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e; - $_TTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e; - local($pty, $tty, $kind); - if( -e "/dev/pts000" ){ ## mods by Joe Doupnik Dec 1992 - $kind = "pts"; ## SVR4 Streams - } else { - $kind = "pty"; ## BSD Clist stuff - } - for $bank (112..127) { - next unless -e sprintf("/dev/$kind%c0", $bank); - for $unit (48..57) { - $pty = sprintf("/dev/$kind%c%c", $bank, $unit); - open($_PTY,"+>$pty") || next; - select((select($_PTY), $| = 1)[0]); - ($tty = $pty) =~ s/pty/tty/; - open($_TTY,"+>$tty") || next; - select((select($_TTY), $| = 1)[0]); - system "stty nl>$tty"; - return ($pty,$tty); - } - } - undef; -} - -1; diff --git a/lib/constant.pm b/lib/constant.pm new file mode 100644 index 0000000000..4416cf2ade --- /dev/null +++ b/lib/constant.pm @@ -0,0 +1,162 @@ +package constant; + +$VERSION = '1.00'; + +=head1 NAME + +constant - Perl pragma to declare constants + +=head1 SYNOPSIS + + use constant BUFFER_SIZE => 4096; + use constant ONE_YEAR => 365.2425 * 24 * 60 * 60; + use constant PI => 4 * atan2 1, 1; + use constant DEBUGGING => 0; + use constant ORACLE => 'oracle@cs.indiana.edu'; + use constant USERNAME => scalar getpwuid($<); + use constant USERINFO => getpwuid($<); + + sub deg2rad { PI * $_[0] / 180 } + + print "This line does nothing" unless DEBUGGING; + +=head1 DESCRIPTION + +This will declare a symbol to be a constant with the given scalar +or list value. + +When you declare a constant such as C<PI> using the method shown +above, each machine your script runs upon can have as many digits +of accuracy as it can use. Also, your program will be easier to +read, more likely to be maintained (and maintained correctly), and +far less likely to send a space probe to the wrong planet because +nobody noticed the one equation in which you wrote C<3.14195>. + +=head1 NOTES + +The value or values are evaluated in a list context. You may override +this with C<scalar> as shown above. + +These constants do not directly interpolate into double-quotish +strings, although you may do so indirectly. (See L<perlref> for +details about how this works.) + + print "The value of PI is @{[ PI ]}.\n"; + +List constants are returned as lists, not as arrays. + + $homedir = USERINFO[7]; # WRONG + $homedir = (USERINFO)[7]; # Right + +The use of all caps for constant names is merely a convention, +although it is recommended in order to make constants stand out +and to help avoid collisions with other barewords, keywords, and +subroutine names. Constant names must begin with a letter. + +Constant symbols are package scoped (rather than block scoped, as +C<use strict> is). That is, you can refer to a constant from package +Other as C<Other::CONST>. + +As with all C<use> directives, defining a constant happens at +compile time. Thus, it's probably not correct to put a constant +declaration inside of a conditional statement (like C<if ($foo) +{ use constant ... }>). + +Omitting the value for a symbol gives it the value of C<undef> in +a scalar context or the empty list, C<()>, in a list context. This +isn't so nice as it may sound, though, because in this case you +must either quote the symbol name, or use a big arrow, (C<=E<gt>>), +with nothing to point to. It is probably best to declare these +explicitly. + + use constant UNICORNS => (); + use constant LOGFILE => undef; + +The result from evaluating a list constant in a scalar context is +not documented, and is B<not> guaranteed to be any particular value +in the future. In particular, you should not rely upon it being +the number of elements in the list, especially since it is not +B<necessarily> that value in the current implementation. + +Magical values, tied values, and references can be made into +constants at compile time, allowing for way cool stuff like this. + + use constant E2BIG => ($! = 7); + print E2BIG, "\n"; # something like "Arg list too long" + print 0+E2BIG, "\n"; # "7" + +=head1 TECHNICAL NOTE + +In the current implementation, scalar constants are actually +inlinable subroutines. As of version 5.004 of Perl, the appropriate +scalar constant is inserted directly in place of some subroutine +calls, thereby saving the overhead of a subroutine call. See +L<perlsub/"Constant Functions"> for details about how and when this +happens. + +=head1 BUGS + +In the current version of Perl, list constants are not inlined +and some symbols may be redefined without generating a warning. + +It is not possible to have a subroutine or keyword with the same +name as a constant. This is probably a Good Thing. + +Unlike constants in some languages, these cannot be overridden +on the command line or via environment variables. + +=head1 AUTHOR + +Tom Phoenix, E<lt>F<rootbeer@teleport.com>E<gt>, with help from +many other folks. + +=head1 COPYRIGHT + +Copyright (C) 1997, Tom Phoenix + +This module is free software; you can redistribute it or modify it +under the same terms as Perl itself. + +=cut + +use strict; +use Carp; +use vars qw($VERSION); + +#======================================================================= + +# Some of this stuff didn't work in version 5.003, alas. +require 5.003_20; + +#======================================================================= +# import() - import symbols into user's namespace +# +# What we actually do is define a function in the caller's namespace +# which returns the value. The function we create will normally +# be inlined as a constant, thereby avoiding further sub calling +# overhead. +#======================================================================= +sub import { + my $class = shift; + my $name = shift or return; # Ignore 'use constant;' + croak qq{Can't define "$name" as constant} . + qq{ (name contains invalid characters or is empty)} + unless $name =~ /^[^\W_0-9]\w*$/; + + my $pkg = caller; + { + no strict 'refs'; + if (@_ == 1) { + my $scalar = $_[0]; + *{"${pkg}::$name"} = sub () { $scalar }; + } elsif (@_) { + my @list = @_; + *{"${pkg}::$name"} = sub () { @list }; + } else { + *{"${pkg}::$name"} = sub () { }; + } + } + +} + +1; @@ -220,7 +220,11 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix) if (CvANON(compcv) || SvTYPE(compcv) == SVt_PVFM) { /* "It's closures all the way down." */ CvCLONE_on(compcv); - if (cv != startcv) { + if (cv == startcv) { + if (CvANON(compcv)) + oldsv = Nullsv; /* no need to keep ref */ + } + else { CV *bcv; for (bcv = startcv; bcv && bcv != cv && !CvCLONE(bcv); @@ -294,6 +298,7 @@ pad_findmy(name) char *name; { I32 off; + I32 pendoff = 0; SV *sv; SV **svp = AvARRAY(comppad_name); U32 seq = cop_seqmax; @@ -302,18 +307,25 @@ char *name; for (off = AvFILL(comppad_name); off > 0; off--) { if ((sv = svp[off]) && sv != &sv_undef && - seq <= SvIVX(sv) && - seq > I_32(SvNVX(sv)) && + (!SvIVX(sv) || + (seq <= SvIVX(sv) && + seq > I_32(SvNVX(sv)))) && strEQ(SvPVX(sv), name)) { - return (PADOFFSET)off; + if (SvIVX(sv)) + return (PADOFFSET)off; + pendoff = off; /* this pending def. will override import */ } } /* See if it's in a nested scope */ off = pad_findlex(name, 0, seq, CvOUTSIDE(compcv), cxstack_ix); - if (off) + if (off) { + /* If there is a pending local definition, this new alias must die */ + if (pendoff) + SvIVX(AvARRAY(comppad_name)[off]) = seq; return off; + } return 0; } @@ -596,12 +608,11 @@ OP *op; OP *kid; /* assumes no premature commitment */ - if (!op || (op->op_flags & OPf_KNOW) || op->op_type == OP_RETURN - || error_count) + if (!op || (op->op_flags & OPf_WANT) || error_count + || op->op_type == OP_RETURN) return op; - op->op_flags &= ~OPf_LIST; - op->op_flags |= OPf_KNOW; + op->op_flags = (op->op_flags & ~OPf_WANT) | OPf_WANT_SCALAR; switch (op->op_type) { case OP_REPEAT: @@ -632,8 +643,16 @@ OP *op; break; case OP_LEAVE: case OP_LEAVETRY: - scalar(cLISTOP->op_first); - /* FALL THROUGH */ + kid = cLISTOP->op_first; + scalar(kid); + while (kid = kid->op_sibling) { + if (kid->op_sibling) + scalarvoid(kid); + else + scalar(kid); + } + curcop = &compiling; + break; case OP_SCOPE: case OP_LINESEQ: case OP_LIST: @@ -657,12 +676,12 @@ OP *op; char* useless = 0; SV* sv; - if (!op || error_count) - return op; - if (op->op_flags & OPf_LIST) + /* assumes no premature commitment */ + if (!op || (op->op_flags & OPf_WANT) == OPf_WANT_LIST || error_count + || op->op_type == OP_RETURN) return op; - op->op_flags |= OPf_KNOW; + op->op_flags = (op->op_flags & ~OPf_WANT) | OPf_WANT_VOID; switch (op->op_type) { default: @@ -797,16 +816,22 @@ OP *op; curcop = ((COP*)op); /* for warning below */ if (op->op_flags & OPf_STACKED) break; + + case OP_REQUIRE: + /* since all requires must return a value, they're never void */ + op->op_flags &= ~OPf_WANT; + return scalar(op); + case OP_ENTERTRY: case OP_ENTER: case OP_SCALAR: if (!(op->op_flags & OPf_KIDS)) break; + /* FALL THROUGH */ case OP_SCOPE: case OP_LEAVE: case OP_LEAVETRY: case OP_LEAVELOOP: - op->op_private |= OPpLEAVE_VOID; case OP_LINESEQ: case OP_LIST: for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) @@ -818,11 +843,6 @@ OP *op; deprecate("implicit split to @_"); } break; - case OP_KEYS: - case OP_VALUES: - case OP_DELETE: - op->op_private |= OPpLEAVE_VOID; - break; } if (useless && dowarn) warn("Useless use of %s in void context", useless); @@ -848,11 +868,11 @@ OP *op; OP *kid; /* assumes no premature commitment */ - if (!op || (op->op_flags & OPf_KNOW) || op->op_type == OP_RETURN - || error_count) + if (!op || (op->op_flags & OPf_WANT) || error_count + || op->op_type == OP_RETURN) return op; - op->op_flags |= (OPf_KNOW | OPf_LIST); + op->op_flags = (op->op_flags & ~OPf_WANT) | OPf_WANT_LIST; switch (op->op_type) { case OP_FLOP: @@ -880,8 +900,16 @@ OP *op; break; case OP_LEAVE: case OP_LEAVETRY: - list(cLISTOP->op_first); - /* FALL THROUGH */ + kid = cLISTOP->op_first; + list(kid); + while (kid = kid->op_sibling) { + if (kid->op_sibling) + scalarvoid(kid); + else + list(kid); + } + curcop = &compiling; + break; case OP_SCOPE: case OP_LINESEQ: for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) { @@ -1623,7 +1651,7 @@ OP* op; if (!op || op->op_type != OP_LIST) op = newLISTOP(OP_LIST, 0, op, Nullop); else - op->op_flags &= ~(OPf_KNOW|OPf_LIST); + op->op_flags &= ~OPf_WANT; if (!(opargs[type] & OA_MARK)) null(cLISTOP->op_first); @@ -2390,7 +2418,7 @@ OP *right; tmpop->op_sibling = Nullop; /* don't free split */ right->op_next = tmpop->op_next; /* fix starting loc */ op_free(op); /* blow off assign */ - right->op_flags &= ~(OPf_KNOW|OPf_LIST); + right->op_flags &= ~OPf_WANT; /* "I don't know and I don't care." */ return right; } @@ -3137,21 +3165,36 @@ cv_const_sv(cv) CV* cv; { OP *o; - SV *sv = Nullsv; + SV *sv; - if(cv && SvPOK(cv) && !SvCUR(cv)) { - for (o = CvSTART(cv); o; o = o->op_next) { - OPCODE type = o->op_type; - - if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK) - continue; - if (type == OP_LEAVESUB || type == OP_RETURN) - break; - if (type != OP_CONST || sv) - return Nullsv; + if (!cv || !SvPOK(cv) || SvCUR(cv)) + return Nullsv; + sv = Nullsv; + for (o = CvSTART(cv); o; o = o->op_next) { + OPCODE type = o->op_type; + + if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK) + continue; + if (type == OP_LEAVESUB || type == OP_RETURN) + break; + if (sv) + return Nullsv; + if (type == OP_CONST) sv = ((SVOP*)o)->op_sv; + else if (type == OP_PADSV) { + AV* pad = (AV*)(AvARRAY(CvPADLIST(cv))[1]); + sv = pad ? AvARRAY(pad)[o->op_targ] : Nullsv; + if (!sv) + return Nullsv; + if (!SvREADONLY(sv)) { + if (SvREFCNT(sv) > 1) + return Nullsv; + SvREADONLY_on(sv); + } } + else + return Nullsv; } return sv; } @@ -3167,7 +3210,6 @@ OP *block; GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV); char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, na) : Nullch; register CV *cv; - AV *av; I32 ix; if (op) @@ -3241,18 +3283,44 @@ OP *block; return cv; } - av = newAV(); /* Will be @_ */ - av_extend(av, 0); - av_store(comppad, 0, (SV*)av); - AvFLAGS(av) = AVf_REIFY; + if (AvFILL(comppad_name) < AvFILL(comppad)) + av_store(comppad_name, AvFILL(comppad), Nullsv); - for (ix = AvFILL(comppad); ix > 0; ix--) { - if (!SvPADMY(curpad[ix]) && !SvIMMORTAL(curpad[ix])) - SvPADTMP_on(curpad[ix]); + if (CvCLONE(cv)) { + SV **namep = AvARRAY(comppad_name); + for (ix = AvFILL(comppad); ix > 0; ix--) { + SV *namesv; + + if (SvIMMORTAL(curpad[ix])) + continue; + /* + * The only things that a clonable function needs in its + * pad are references to outer lexicals and anonymous subs. + * The rest are created anew during cloning. + */ + if (!((namesv = namep[ix]) != Nullsv && + namesv != &sv_undef && + (SvFAKE(namesv) || + *SvPVX(namesv) == '&'))) + { + SvREFCNT_dec(curpad[ix]); + curpad[ix] = Nullsv; + } + } } + else { + AV *av = newAV(); /* Will be @_ */ + av_extend(av, 0); + av_store(comppad, 0, (SV*)av); + AvFLAGS(av) = AVf_REIFY; - if (AvFILL(comppad_name) < AvFILL(comppad)) - av_store(comppad_name, AvFILL(comppad), Nullsv); + for (ix = AvFILL(comppad); ix > 0; ix--) { + if (SvIMMORTAL(curpad[ix])) + continue; + if (!SvPADMY(curpad[ix])) + SvPADTMP_on(curpad[ix]); + } + } CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block)); CvSTART(cv) = LINKLIST(CvROOT(cv)); @@ -4575,9 +4643,9 @@ register OP* o; o->op_seq = op_seqmax++; break; case OP_STUB: - if ((o->op_flags & (OPf_KNOW|OPf_LIST)) != (OPf_KNOW|OPf_LIST)) { + if ((o->op_flags & OPf_WANT) != OPf_WANT_LIST) { o->op_seq = op_seqmax++; - break; /* Scalar stub must produce undef. List stub is noop */ + break; /* Scalar stub must produce undef. List stub is noop */ } goto nothin; case OP_NULL: @@ -41,11 +41,20 @@ typedef U32 PADOFFSET; U8 op_flags; \ U8 op_private; -#define GIMME (op->op_flags & OPf_KNOW ? op->op_flags & OPf_LIST : dowantarray()) +#define OP_GIMME(op,dfl) \ + (((op)->op_flags & OPf_WANT) == OPf_WANT_VOID ? G_VOID : \ + ((op)->op_flags & OPf_WANT) == OPf_WANT_SCALAR ? G_SCALAR : \ + ((op)->op_flags & OPf_WANT) == OPf_WANT_LIST ? G_ARRAY : \ + dfl) + +#define GIMME_V OP_GIMME(op, block_gimme()) /* Public flags */ -#define OPf_LIST 1 /* Do operator in list context. */ -#define OPf_KNOW 2 /* Context is known. */ + +#define OPf_WANT 3 /* Mask for "want" bits: */ +#define OPf_WANT_VOID 1 /* Want nothing */ +#define OPf_WANT_SCALAR 2 /* Want single value */ +#define OPf_WANT_LIST 3 /* Want list of any length */ #define OPf_KIDS 4 /* There is a firstborn child. */ #define OPf_PARENS 8 /* This operator was parenthesized. */ /* (Or block needs explicit scope entry.) */ @@ -65,6 +74,12 @@ typedef U32 PADOFFSET; /* On OP_ENTERSUB || OP_NULL, saw a "do". */ /* On OP_(ENTER|LEAVE)EVAL, don't clear $@ */ +/* old names; don't use in new code, but don't break them, either */ +#define OPf_LIST 1 +#define OPf_KNOW 2 +#define GIMME \ + (op->op_flags & OPf_KNOW ? op->op_flags & OPf_LIST : dowantarray()) + /* Private for lvalues */ #define OPpLVAL_INTRO 128 /* Lvalue must be localized */ @@ -105,11 +120,8 @@ typedef U32 PADOFFSET; /* Private for OP_LIST */ #define OPpLIST_GUESSED 64 /* Guessed that pushmark was needed. */ -/* Private for OP_LEAVE, OP_DELETE, and friends(?) */ -#define OPpLEAVE_VOID 64 /* No need to copy out values. */ - /* Private for OP_DELETE */ -#define OPpSLICE 32 /* Operating on a list of keys */ +#define OPpSLICE 64 /* Operating on a list of keys */ /* Private for OP_SORT, OP_PRTF, OP_SPRINTF, string cmp'n, and case changers */ #define OPpLOCALE 64 /* Use locale */ @@ -850,7 +850,7 @@ XS(XS_Cwd_sys_chdir) bool RETVAL; RETVAL = sys_chdir(path); - ST(0) = RETVAL ? &sv_yes : &sv_no; + ST(0) = boolSV(RETVAL); if (SvREFCNT(ST(0))) sv_2mortal(ST(0)); } XSRETURN(1); @@ -866,7 +866,7 @@ XS(XS_Cwd_change_drive) bool RETVAL; RETVAL = change_drive(d); - ST(0) = RETVAL ? &sv_yes : &sv_no; + ST(0) = boolSV(RETVAL); if (SvREFCNT(ST(0))) sv_2mortal(ST(0)); } XSRETURN(1); @@ -882,7 +882,7 @@ XS(XS_Cwd_sys_is_absolute) bool RETVAL; RETVAL = sys_is_absolute(path); - ST(0) = RETVAL ? &sv_yes : &sv_no; + ST(0) = boolSV(RETVAL); if (SvREFCNT(ST(0))) sv_2mortal(ST(0)); } XSRETURN(1); @@ -898,7 +898,7 @@ XS(XS_Cwd_sys_is_rooted) bool RETVAL; RETVAL = sys_is_rooted(path); - ST(0) = RETVAL ? &sv_yes : &sv_no; + ST(0) = boolSV(RETVAL); if (SvREFCNT(ST(0))) sv_2mortal(ST(0)); } XSRETURN(1); @@ -914,7 +914,7 @@ XS(XS_Cwd_sys_is_relative) bool RETVAL; RETVAL = sys_is_relative(path); - ST(0) = RETVAL ? &sv_yes : &sv_no; + ST(0) = boolSV(RETVAL); if (SvREFCNT(ST(0))) sv_2mortal(ST(0)); } XSRETURN(1); @@ -1101,7 +1101,7 @@ XS(XS_Cwd_extLibpath_set) } RETVAL = extLibpath_set(s, type); - ST(0) = RETVAL ? &sv_yes : &sv_no; + ST(0) = boolSV(RETVAL); if (SvREFCNT(ST(0))) sv_2mortal(ST(0)); } XSRETURN(1); diff --git a/patchlevel.h b/patchlevel.h index 6d4fe6eea1..2c1672de4c 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1,5 +1,5 @@ #define PATCHLEVEL 3 -#define SUBVERSION 95 +#define SUBVERSION 96 /* local_patches -- list of locally applied less-than-subversion patches. @@ -20,6 +20,10 @@ #include <unistd.h> #endif +#if !defined(STANDARD_C) && !defined(HAS_GETENV_PROTOTYPE) +char *getenv _((char *)); /* Usually in <stdlib.h> */ +#endif + dEXTCONST char rcsid[] = "perl.c\nPatch level: ###\n"; #ifdef IAMSUID @@ -140,6 +144,10 @@ register PerlInterpreter *sv_interp; init_ids(); + start_env.je_prev = NULL; + start_env.je_ret = -1; + start_env.je_mustcatch = TRUE; + top_env = &start_env; STATUS_ALL_SUCCESS; SET_NUMERIC_STANDARD(); @@ -432,9 +440,6 @@ PerlInterpreter *sv_interp; return; Safefree(sv_interp); } -#if !defined(STANDARD_C) && !defined(HAS_GETENV_PROTOTYPE) -char *getenv _((char *)); /* Usually in <stdlib.h> */ -#endif int perl_parse(sv_interp, xsinit, argc, argv, env) @@ -451,6 +456,7 @@ char **env; char *validarg = ""; I32 oldscope; AV* comppadlist; + dJMPENV; #ifdef SETUID_SCRIPTS_ARE_SECURE_NOW #ifdef IAMSUID @@ -498,9 +504,8 @@ setuid perl scripts securely.\n"); time(&basetime); oldscope = scopestack_ix; - mustcatch = FALSE; - switch (Sigsetjmp(top_env,1)) { + switch (JMPENV_PUSH) { case 1: STATUS_ALL_FAILURE; /* FALL THROUGH */ @@ -511,9 +516,10 @@ setuid perl scripts securely.\n"); curstash = defstash; if (endav) call_list(oldscope, endav); + JMPENV_POP; return STATUS_NATIVE_EXPORT; case 3: - mustcatch = FALSE; + JMPENV_POP; PerlIO_printf(PerlIO_stderr(), "panic: top_env\n"); return 1; } @@ -522,6 +528,7 @@ setuid perl scripts securely.\n"); sv = newSVpv("",0); /* first used for -I flags */ SAVEFREESV(sv); init_main_stash(); + for (argc--,argv++; argc > 0; argc--,argv++) { if (argv[0][0] != '-' || !argv[0][1]) break; @@ -619,13 +626,13 @@ setuid perl scripts securely.\n"); #else sv_catpv(Sv,"print \"\\nCharacteristics of this binary (from libperl): \\n\","); #endif -#if defined(DEBUGGING) || defined(NOEMBED) || defined(MULTIPLICITY) +#if defined(DEBUGGING) || defined(NO_EMBED) || defined(MULTIPLICITY) strcpy(buf,"\" Compile-time options:"); # ifdef DEBUGGING strcat(buf," DEBUGGING"); # endif -# ifdef NOEMBED - strcat(buf," NOEMBED"); +# ifdef NO_EMBED + strcat(buf," NO_EMBED"); # endif # ifdef MULTIPLICITY strcat(buf," MULTIPLICITY"); @@ -634,8 +641,8 @@ setuid perl scripts securely.\n"); sv_catpv(Sv,buf); #endif #if defined(LOCAL_PATCH_COUNT) - if (LOCAL_PATCH_COUNT > 0) - { int i; + if (LOCAL_PATCH_COUNT > 0) { + int i; sv_catpv(Sv,"print \" Locally applied patches:\\n\","); for (i = 1; i <= LOCAL_PATCH_COUNT; i++) { if (localpatches[i]) { @@ -645,17 +652,21 @@ setuid perl scripts securely.\n"); } } #endif - sprintf(buf,"\" Built under %s\\n\",",OSNAME); + sprintf(buf,"\" Built under %s\\n\"",OSNAME); sv_catpv(Sv,buf); #ifdef __DATE__ # ifdef __TIME__ - sprintf(buf,"\" Compiled at %s %s\\n\"",__DATE__,__TIME__); + sprintf(buf,",\" Compiled at %s %s\\n\"",__DATE__,__TIME__); # else - sprintf(buf,"\" Compiled on %s\\n\"",__DATE__); + sprintf(buf,",\" Compiled on %s\\n\"",__DATE__); # endif sv_catpv(Sv,buf); #endif - sv_catpv(Sv,"; $\"=\"\\n \"; print \" \\@INC:\\n @INC\\n\""); + sv_catpv(Sv, "; \ +$\"=\"\\n \"; \ +@env = map { \"$_=\\\"$ENV{$_}\\\"\" } sort grep {/^PERL/} keys %ENV; \ +print \" \\%ENV:\\n @env\\n\" if @env; \ +print \" \\@INC:\\n @INC\\n\";"); } else { Sv = newSVpv("config_vars(qw(",0); @@ -682,6 +693,24 @@ setuid perl scripts securely.\n"); } } switch_end: + + if (!tainting && (s = getenv("PERL5OPT"))) { + for (;;) { + while (isSPACE(*s)) + s++; + if (*s == '-') { + s++; + if (isSPACE(*s)) + continue; + } + if (!*s) + break; + if (!strchr("DIMUdmw", *s)) + croak("Illegal switch in PERL5OPT: -%c", *s); + s = moreswitches(s); + } + } + if (!scriptname) scriptname = argv[0]; if (e_fp) { @@ -784,6 +813,7 @@ setuid perl scripts securely.\n"); ENTER; restartop = 0; + JMPENV_POP; return 0; } @@ -791,6 +821,7 @@ int perl_run(sv_interp) PerlInterpreter *sv_interp; { + dJMPENV; I32 oldscope; if (!(curinterp = sv_interp)) @@ -798,7 +829,7 @@ PerlInterpreter *sv_interp; oldscope = scopestack_ix; - switch (Sigsetjmp(top_env,1)) { + switch (JMPENV_PUSH) { case 1: cxstack_ix = -1; /* start context stack again */ break; @@ -814,12 +845,13 @@ PerlInterpreter *sv_interp; if (getenv("PERL_DEBUG_MSTATS")) dump_mstats("after execution: "); #endif + JMPENV_POP; return STATUS_NATIVE_EXPORT; case 3: - mustcatch = FALSE; if (!restartop) { PerlIO_printf(PerlIO_stderr(), "panic: restartop\n"); FREETMPS; + JMPENV_POP; return 1; } if (curstack != mainstack) { @@ -858,6 +890,7 @@ PerlInterpreter *sv_interp; } my_exit(0); + /* NOTREACHED */ return 0; } @@ -968,10 +1001,10 @@ I32 flags; /* See G_* flags in cop.h */ SV** sp = stack_sp; I32 oldmark; I32 retval; - Sigjmp_buf oldtop; I32 oldscope; static CV *DBcv; - bool oldmustcatch = mustcatch; + bool oldcatch = CATCH_GET; + dJMPENV; if (flags & G_DISCARD) { ENTER; @@ -979,12 +1012,12 @@ I32 flags; /* See G_* flags in cop.h */ } Zero(&myop, 1, LOGOP); + myop.op_next = Nullop; if (!(flags & G_NOARGS)) myop.op_flags |= OPf_STACKED; - myop.op_next = Nullop; - myop.op_flags |= OPf_KNOW; - if (flags & G_ARRAY) - myop.op_flags |= OPf_LIST; + myop.op_flags |= ((flags & G_VOID) ? OPf_WANT_VOID : + (flags & G_ARRAY) ? OPf_WANT_LIST : + OPf_WANT_SCALAR); SAVESPTR(op); op = (OP*)&myop; @@ -1002,14 +1035,12 @@ I32 flags; /* See G_* flags in cop.h */ op->op_private |= OPpENTERSUB_DB; if (flags & G_EVAL) { - Copy(top_env, oldtop, 1, Sigjmp_buf); - cLOGOP->op_other = op; markstack_ptr--; /* we're trying to emulate pp_entertry() here */ { register CONTEXT *cx; - I32 gimme = GIMME; + I32 gimme = GIMME_V; ENTER; SAVETMPS; @@ -1027,8 +1058,7 @@ I32 flags; /* See G_* flags in cop.h */ } markstack_ptr++; - restart: - switch (Sigsetjmp(top_env,1)) { + switch (JMPENV_PUSH) { case 0: break; case 1: @@ -1038,17 +1068,16 @@ I32 flags; /* See G_* flags in cop.h */ /* my_exit() was called */ curstash = defstash; FREETMPS; - Copy(oldtop, top_env, 1, Sigjmp_buf); + JMPENV_POP; if (statusvalue) croak("Callback called exit"); my_exit_jump(); /* NOTREACHED */ case 3: - mustcatch = FALSE; if (restartop) { op = restartop; restartop = 0; - goto restart; + break; } stack_sp = stack_base + oldmark; if (flags & G_ARRAY) @@ -1061,7 +1090,7 @@ I32 flags; /* See G_* flags in cop.h */ } } else - mustcatch = TRUE; + CATCH_SET(TRUE); if (op == (OP*)&myop) op = pp_entersub(); @@ -1086,10 +1115,10 @@ I32 flags; /* See G_* flags in cop.h */ curpm = newpm; LEAVE; } - Copy(oldtop, top_env, 1, Sigjmp_buf); + JMPENV_POP; } else - mustcatch = oldmustcatch; + CATCH_SET(oldcatch); if (flags & G_DISCARD) { stack_sp = stack_base + oldmark; @@ -1111,8 +1140,8 @@ I32 flags; /* See G_* flags in cop.h */ SV** sp = stack_sp; I32 oldmark = sp - stack_base; I32 retval; - Sigjmp_buf oldtop; I32 oldscope; + dJMPENV; if (flags & G_DISCARD) { ENTER; @@ -1130,16 +1159,13 @@ I32 flags; /* See G_* flags in cop.h */ myop.op_flags = OPf_STACKED; myop.op_next = Nullop; myop.op_type = OP_ENTEREVAL; - myop.op_flags |= OPf_KNOW; + myop.op_flags |= ((flags & G_VOID) ? OPf_WANT_VOID : + (flags & G_ARRAY) ? OPf_WANT_LIST : + OPf_WANT_SCALAR); if (flags & G_KEEPERR) myop.op_flags |= OPf_SPECIAL; - if (flags & G_ARRAY) - myop.op_flags |= OPf_LIST; - - Copy(top_env, oldtop, 1, Sigjmp_buf); -restart: - switch (Sigsetjmp(top_env,1)) { + switch (JMPENV_PUSH) { case 0: break; case 1: @@ -1149,17 +1175,16 @@ restart: /* my_exit() was called */ curstash = defstash; FREETMPS; - Copy(oldtop, top_env, 1, Sigjmp_buf); + JMPENV_POP; if (statusvalue) croak("Callback called exit"); my_exit_jump(); /* NOTREACHED */ case 3: - mustcatch = FALSE; if (restartop) { op = restartop; restartop = 0; - goto restart; + break; } stack_sp = stack_base + oldmark; if (flags & G_ARRAY) @@ -1180,7 +1205,7 @@ restart: sv_setpv(GvSV(errgv),""); cleanup: - Copy(oldtop, top_env, 1, Sigjmp_buf); + JMPENV_POP; if (flags & G_DISCARD) { stack_sp = stack_base + oldmark; retval = 0; @@ -2442,25 +2467,23 @@ call_list(oldscope, list) I32 oldscope; AV* list; { - Sigjmp_buf oldtop; + dJMPENV; STRLEN len; line_t oldline = curcop->cop_line; - Copy(top_env, oldtop, 1, Sigjmp_buf); - while (AvFILL(list) >= 0) { CV *cv = (CV*)av_shift(list); SAVEFREESV(cv); - switch (Sigsetjmp(top_env,1)) { + switch (JMPENV_PUSH) { case 0: { SV* atsv = GvSV(errgv); PUSHMARK(stack_sp); perl_call_sv((SV*)cv, G_EVAL|G_DISCARD); (void)SvPV(atsv, len); if (len) { - Copy(oldtop, top_env, 1, Sigjmp_buf); + JMPENV_POP; curcop = &compiling; curcop->cop_line = oldline; if (list == beginav) @@ -2484,7 +2507,7 @@ AV* list; if (endav) call_list(oldscope, endav); FREETMPS; - Copy(oldtop, top_env, 1, Sigjmp_buf); + JMPENV_POP; curcop = &compiling; curcop->cop_line = oldline; if (statusvalue) { @@ -2501,14 +2524,13 @@ AV* list; FREETMPS; break; } - Copy(oldtop, top_env, 1, Sigjmp_buf); + JMPENV_POP; curcop = &compiling; curcop->cop_line = oldline; - Siglongjmp(top_env, 3); + JMPENV_JUMP(3); } + JMPENV_POP; } - - Copy(oldtop, top_env, 1, Sigjmp_buf); } void @@ -2576,5 +2598,5 @@ my_exit_jump() LEAVE; } - Siglongjmp(top_env, 2); + JMPENV_JUMP(2); } @@ -260,12 +260,6 @@ #define MEM_SIZE Size_t -#if _XOPEN_VERSION >= 4 -# define Sock_size_t Size_t -#else -# define Sock_size_t int -#endif - #if defined(STANDARD_C) && defined(I_STDDEF) # include <stddef.h> # define STRUCT_OFFSET(s,m) offsetof(s,m) @@ -1843,9 +1837,9 @@ IEXT line_t Icopline IINIT(NOLINE); IEXT CONTEXT * Icxstack; IEXT I32 Icxstack_ix IINIT(-1); IEXT I32 Icxstack_max IINIT(128); -IEXT Sigjmp_buf Itop_env; +IEXT JMPENV Istart_env; /* empty startup sigjmp() environment */ +IEXT JMPENV * Itop_env; /* ptr. to current sigjmp() environment */ IEXT I32 Irunlevel; -IEXT bool Imustcatch; /* doeval() must be caught locally */ /* stack stuff */ IEXT AV * Icurstack; /* THE STACK */ @@ -8,7 +8,7 @@ $/ = "\n\n"; # set paragraph mode $SHlinesep = "\n"; -while ($SHcmd = <>) { +while (defined($SHcmd = <>)) { $/ = $SHlinesep; eval $SHcmd; print $@ || "\n"; $SHlinesep = $/; $/ = ''; diff --git a/plan9/buildinfo b/plan9/buildinfo index 99818464e8..fedbafc6ee 100644 --- a/plan9/buildinfo +++ b/plan9/buildinfo @@ -1 +1 @@ -p9pvers = 5.003_95 +p9pvers = 5.003_96 diff --git a/pod/perlapio.pod b/pod/perlapio.pod index 2a2a99fc60..d88e44509c 100644 --- a/pod/perlapio.pod +++ b/pod/perlapio.pod @@ -7,16 +7,16 @@ perlapio - perl's IO abstraction interface. PerlIO *PerlIO_stdin(void); PerlIO *PerlIO_stdout(void); PerlIO *PerlIO_stderr(void); - + PerlIO *PerlIO_open(const char *,const char *); int PerlIO_close(PerlIO *); int PerlIO_stdoutf(const char *,...) int PerlIO_puts(PerlIO *,const char *); int PerlIO_putc(PerlIO *,int); - int PerlIO_write(PerlIO *,const void *,size_t); + int PerlIO_write(PerlIO *,const void *,size_t); int PerlIO_printf(PerlIO *, const char *,...); - int PerlIO_vprintf(PerlIO *, const char *, va_list); + int PerlIO_vprintf(PerlIO *, const char *, va_list); int PerlIO_flush(PerlIO *); int PerlIO_eof(PerlIO *); @@ -25,7 +25,7 @@ perlapio - perl's IO abstraction interface. int PerlIO_getc(PerlIO *); int PerlIO_ungetc(PerlIO *,int); - int PerlIO_read(PerlIO *,void *,size_t); + int PerlIO_read(PerlIO *,void *,size_t); int PerlIO_fileno(PerlIO *); PerlIO *PerlIO_fdopen(int, const char *); @@ -34,30 +34,30 @@ perlapio - perl's IO abstraction interface. FILE *PerlIO_findFILE(PerlIO *); void PerlIO_releaseFILE(PerlIO *,FILE *); - void PerlIO_setlinebuf(PerlIO *); + void PerlIO_setlinebuf(PerlIO *); long PerlIO_tell(PerlIO *); int PerlIO_seek(PerlIO *,off_t,int); - int PerlIO_getpos(PerlIO *,Fpos_t *) - int PerlIO_setpos(PerlIO *,Fpos_t *) + int PerlIO_getpos(PerlIO *,Fpos_t *) + int PerlIO_setpos(PerlIO *,Fpos_t *) void PerlIO_rewind(PerlIO *); - - int PerlIO_has_base(PerlIO *); - int PerlIO_has_cntptr(PerlIO *); - int PerlIO_fast_gets(PerlIO *); - int PerlIO_canset_cnt(PerlIO *); - - char *PerlIO_get_ptr(PerlIO *); - int PerlIO_get_cnt(PerlIO *); - void PerlIO_set_cnt(PerlIO *,int); - void PerlIO_set_ptrcnt(PerlIO *,char *,int); - char *PerlIO_get_base(PerlIO *); - int PerlIO_get_bufsiz(PerlIO *); + + int PerlIO_has_base(PerlIO *); + int PerlIO_has_cntptr(PerlIO *); + int PerlIO_fast_gets(PerlIO *); + int PerlIO_canset_cnt(PerlIO *); + + char *PerlIO_get_ptr(PerlIO *); + int PerlIO_get_cnt(PerlIO *); + void PerlIO_set_cnt(PerlIO *,int); + void PerlIO_set_ptrcnt(PerlIO *,char *,int); + char *PerlIO_get_base(PerlIO *); + int PerlIO_get_bufsiz(PerlIO *); =head1 DESCRIPTION Perl's source code should use the above functions instead of those -defined in ANSI C's I<stdio.h>, I<perlio.h> will the C<#define> them to +defined in ANSI C's I<stdio.h>, I<perlio.h> will the C<#define> them to the I/O mechanism selected at Configure time. The functions are modeled on those in I<stdio.h>, but parameter order @@ -67,15 +67,15 @@ has been "tidied up a little". =item B<PerlIO *> -This takes the place of FILE *. Unlike FILE * it should be treated as +This takes the place of FILE *. Unlike FILE * it should be treated as opaque (it is probably safe to assume it is a pointer to something). =item B<PerlIO_stdin()>, B<PerlIO_stdout()>, B<PerlIO_stderr()> Use these rather than C<stdin>, C<stdout>, C<stderr>. They are written to look like "function calls" rather than variables because this makes -it easier to I<make them> function calls if platform cannot export data -to loaded modules, or if (say) different "threads" might have different +it easier to I<make them> function calls if platform cannot export data +to loaded modules, or if (say) different "threads" might have different values. =item B<PerlIO_open(path, mode)>, B<PerlIO_fdopen(fd,mode)> @@ -93,7 +93,7 @@ so it is (currently) legal to use C<printf(fmt,...)> in perl sources. =item B<PerlIO_read(f,buf,count)>, B<PerlIO_write(f,buf,count)> -These correspond to fread() and fwrite(). Note that arguments +These correspond to fread() and fwrite(). Note that arguments are different, there is only one "count" and order has "file" first. @@ -101,7 +101,7 @@ are different, there is only one "count" and order has =item B<PerlIO_puts(s,f)>, B<PerlIO_putc(c,f)> -These correspond to fputs() and fputc(). +These correspond to fputs() and fputc(). Note that arguments have been revised to have "file" first. =item B<PerlIO_ungetc(c,f)> @@ -123,8 +123,8 @@ This corresponds to ferror(). =item B<PerlIO_fileno(f)> -This corresponds to fileno(), note that on some platforms, -the meaning of "fileno" may not match UNIX. +This corresponds to fileno(), note that on some platforms, +the meaning of "fileno" may not match Unix. =item B<PerlIO_clearerr(f)> @@ -145,7 +145,7 @@ This corresponds to fseek(). =item B<PerlIO_getpos(f,p)>, B<PerlIO_setpos(f,p)> -These correspond to fgetpos() and fsetpos(). If platform does not +These correspond to fgetpos() and fsetpos(). If platform does not have the stdio calls then they are implemented in terms of PerlIO_tell() and PerlIO_seek(). @@ -159,14 +159,14 @@ in terms of PerlIO_seek() at some point. This corresponds to tmpfile(), i.e., returns an anonymous PerlIO which will automatically be deleted when closed. -=back +=back =head2 Co-existence with stdio There is outline support for co-existence of PerlIO with stdio. -Obviously if PerlIO is implemented in terms of stdio there is +Obviously if PerlIO is implemented in terms of stdio there is no problem. However if perlio is implemented on top of (say) sfio -then mechanisms must exist to create a FILE * which can be passed +then mechanisms must exist to create a FILE * which can be passed to library code which is going to use stdio calls. =over 4 @@ -179,12 +179,12 @@ May need additional arguments, interface under review. =item B<PerlIO_exportFILE(f,flags)> Given an PerlIO * return a 'native' FILE * suitable for -passing to code expecting to be compiled and linked with +passing to code expecting to be compiled and linked with ANSI C I<stdio.h>. The fact that such a FILE * has been 'exported' is recorded, -and may affect future PerlIO operations on the original -PerlIO *. +and may affect future PerlIO operations on the original +PerlIO *. =item B<PerlIO_findFILE(f)> @@ -195,7 +195,7 @@ Place holder until interface is fully defined. Calling PerlIO_releaseFILE informs PerlIO that all use of FILE * is complete. It is removed from list of 'exported' -FILE *s, and associated PerlIO * should revert to original +FILE *s, and associated PerlIO * should revert to original behaviour. =item B<PerlIO_setlinebuf(f)> @@ -230,21 +230,21 @@ Return count of readable bytes in the buffer. =item B<PerlIO_canset_cnt(f)> -Implementation can adjust its idea of number of +Implementation can adjust its idea of number of bytes in the buffer. =item B<PerlIO_fast_gets(f)> -Implementation has all the interfaces required to +Implementation has all the interfaces required to allow perl's fast code to handle <FILE> mechanism. - PerlIO_fast_gets(f) = PerlIO_has_cntptr(f) && \ + PerlIO_fast_gets(f) = PerlIO_has_cntptr(f) && \ PerlIO_canset_cnt(f) && \ `Can set pointer into buffer' =item B<PerlIO_set_ptrcnt(f,p,c)> -Set pointer into buffer, and a count of bytes still in the +Set pointer into buffer, and a count of bytes still in the buffer. Should be used only to set pointer to within range implied by previous calls to C<PerlIO_get_ptr> and C<PerlIO_get_cnt>. @@ -255,7 +255,7 @@ Obscure - set count of bytes in the buffer. Deprecated. Currently used in only doio.c to force count < -1 to -1. Perhaps should be PerlIO_set_empty or similar. This call may actually do nothing if "count" is deduced from pointer -and a "limit". +and a "limit". =item B<PerlIO_has_base(f)> @@ -271,4 +271,4 @@ Return I<start> of buffer. Return I<total size> of buffer. -=back +=back diff --git a/pod/perlbot.pod b/pod/perlbot.pod index 30d00558b4..bc4e4da1f7 100644 --- a/pod/perlbot.pod +++ b/pod/perlbot.pod @@ -265,7 +265,7 @@ This example demonstrates an interface for the SDBM class. This creates a $ref->FETCH(@_); } sub STORE { - my $self = shift; + my $self = shift; if (defined $_[0]){ my $ref = $self->{'dbm'}; $ref->STORE(@_); @@ -420,7 +420,7 @@ method where that data is located. sub enter { my $self = shift; - + # Don't try to guess if we should use %Bar::fizzle # or %Foo::fizzle. The object already knows which # we should use, so just ask it. diff --git a/pod/perlcall.pod b/pod/perlcall.pod index 8236102f80..b69c539420 100644 --- a/pod/perlcall.pod +++ b/pod/perlcall.pod @@ -126,6 +126,31 @@ which can consist of any combination of the symbols defined below, OR'ed together. +=head2 G_VOID + +Calls the Perl subroutine in a void context. + +This flag has 2 effects: + +=over 5 + +=item 1. + +It indicates to the subroutine being called that it is executing in +a void context (if it executes I<wantarray> the result will be the +undefined value). + +=item 2. + +It ensures that nothing is actually returned from the subroutine. + +=back + +The value returned by the I<perl_call_*> function indicates how many +items have been returned by the Perl subroutine - in this case it will +be 0. + + =head2 G_SCALAR Calls the Perl subroutine in a scalar context. This is the default @@ -140,7 +165,6 @@ This flag has 2 effects: It indicates to the subroutine being called that it is executing in a scalar context (if it executes I<wantarray> the result will be false). - =item 2. It ensures that only a scalar is actually returned from the subroutine. @@ -164,7 +188,7 @@ accessible from the stack - think of the case where only one value is returned as being a list with only one element. Any other items that were returned will not exist by the time control returns from the I<perl_call_*> function. The section I<Returning a list in a scalar -context> shows an example of this behaviour. +context> shows an example of this behavior. =head2 G_ARRAY @@ -251,7 +275,7 @@ What has happened is that C<fred> accesses the C<@_> array which belongs to C<joe>. -=head2 G_EVAL +=head2 G_EVAL It is possible for the Perl subroutine you are calling to terminate abnormally, e.g., by calling I<die> explicitly or by not actually @@ -293,7 +317,7 @@ from the stack. =back -See I<Using G_EVAL> for details of using G_EVAL. +See I<Using G_EVAL> for details on using G_EVAL. =head2 G_KEEPERR @@ -326,14 +350,17 @@ The G_KEEPERR flag was introduced in Perl version 5.002. See I<Using G_KEEPERR> for an example of a situation that warrants the use of this flag. -=head2 Determining the Context +=head2 Determining the Context As mentioned above, you can determine the context of the currently -executing subroutine in Perl with I<wantarray>. The equivalent test can -be made in C by using the C<GIMME> macro. This will return C<G_SCALAR> -if you have been called in a scalar context and C<G_ARRAY> if in an -array context. An example of using the C<GIMME> macro is shown in -section I<Using GIMME>. +executing subroutine in Perl with I<wantarray>. The equivalent test +can be made in C by using the C<GIMME_V> macro, which returns +C<G_ARRAY> if you have been called in an array context, C<G_SCALAR> if +in a a scalar context, or C<G_VOID> if in a void context (i.e. the +return value will not be used). An older version of this macro is +called C<GIMME>; in a void context it returns C<G_SCALAR> instead of +C<G_VOID>. An example of using the C<GIMME_V> macro is shown in +section I<Using GIMME_V>. =head1 KNOWN PROBLEMS @@ -368,7 +395,7 @@ For example, say you want to call this Perl sub sub fred { eval { die "Fatal Error" ; } - print "Trapped error: $@\n" + print "Trapped error: $@\n" if $@ ; } @@ -565,7 +592,7 @@ Next, we come to XPUSHs. This is where the parameters actually get pushed onto the stack. In this case we are pushing a string and an integer. -See the L<perlguts/"XSUBs and the Argument Stack"> for details +See L<perlguts/"XSUBs and the Argument Stack"> for details on how the XPUSH macros work. =item 6. @@ -626,7 +653,7 @@ Points to note this time are =over 5 -=item 1. +=item 1. The only flag specified this time was G_SCALAR. That means the C<@_> array will be created and that the value returned by I<Adder> will @@ -654,7 +681,7 @@ temporaries we create. This means that the temporaries we get rid of will be limited to those which were created after these calls. The C<FREETMPS>/C<LEAVE> pair will get rid of any values returned by -the Perl subroutine, plus it will also dump the mortal SV's we have +the Perl subroutine, plus it will also dump the mortal SVs we have created. Having C<ENTER>/C<SAVETMPS> at the beginning of the code makes sure that no other mortals are destroyed. @@ -672,7 +699,7 @@ allocated to the Perl stack has been reallocated whilst in the I<perl_call_pv> call. If you are making use of the Perl stack pointer in your code you must -always refresh the your local copy using SPAGAIN whenever you make use +always refresh the local copy using SPAGAIN whenever you make use of the I<perl_call_*> functions or any other Perl internal function. =item 4. @@ -834,7 +861,7 @@ then the output will be Value 1 = 3 In this case the main point to note is that only the last item in the -list returned from the subroutine, I<Adder> actually made it back to +list is returned from the subroutine, I<AddSubtract> actually made it back to I<call_AddSubScalar>. @@ -977,7 +1004,7 @@ I<Subtract>. =item 2. -The code +The code if (SvTRUE(GvSV(errgv))) { @@ -1012,7 +1039,7 @@ version of the call_Subtract example above inside a destructor: package Foo; sub new { bless {}, $_[0] } - sub Subtract { + sub Subtract { my($a,$b) = @_; die "death can be fatal" if $a < $b ; $a - $b; @@ -1063,7 +1090,7 @@ Here is a snippet of XSUB which defines I<CallSubPV>. PUSHMARK(sp) ; perl_call_pv(name, G_DISCARD|G_NOARGS) ; -That is fine as far as it goes. The thing is, the Perl subroutine +That is fine as far as it goes. The thing is, the Perl subroutine can be specified as only a string. For Perl 4 this was adequate, but Perl 5 allows references to subroutines and anonymous subroutines. This is where I<perl_call_sv> is useful. @@ -1121,22 +1148,22 @@ particularly true for these cases CallSavedSub1() ; By the time each of the C<SaveSub1> statements above have been executed, -the SV*'s which corresponded to the parameters will no longer exist. +the SV*s which corresponded to the parameters will no longer exist. Expect an error message from Perl of the form Can't use an undefined value as a subroutine reference at ... for each of the C<CallSavedSub1> lines. -Similarly, with this code +Similarly, with this code $ref = \&fred ; SaveSub1($ref) ; $ref = 47 ; CallSavedSub1() ; -you can expect one of these messages (which you actually get is dependent on -the version of Perl you are using) +you can expect one of these messages (which you actually get is dependent on +the version of Perl you are using) Not a CODE reference at ... Undefined subroutine &main::47 called ... @@ -1159,7 +1186,7 @@ A similar but more subtle problem is illustrated with this code CallSavedSub1() ; This time whenever C<CallSavedSub1> get called it will execute the Perl -subroutine C<joe> (assuming it exists) rather than C<fred> as was +subroutine C<joe> (assuming it exists) rather than C<fred> as was originally requested in the call to C<SaveSub1>. To get around these problems it is necessary to take a full copy of the @@ -1260,7 +1287,7 @@ single element of the array. Here is an all Perl example of using it. will print 1: green - This is Class Mine version 1.0 + This is Class Mine version 1.0 Calling a Perl method from C is fairly straightforward. The following things are required @@ -1320,26 +1347,31 @@ The only thing to note is that in both the static and virtual methods, the method name is not passed via the stack - it is used as the first parameter to I<perl_call_method>. -=head2 Using GIMME +=head2 Using GIMME_V -Here is a trivial XSUB which prints the context in which it is +Here is a trivial XSUB which prints the context in which it is currently executing. void PrintContext() CODE: - if (GIMME == G_SCALAR) + I32 gimme = GIMME_V; + if (gimme == G_VOID) + printf ("Context is Void\n") ; + else if (gimme == G_SCALAR) printf ("Context is Scalar\n") ; else printf ("Context is Array\n") ; and here is some Perl to test it + PrintContext ; $a = PrintContext ; @a = PrintContext ; The output from that will be + Context is Void Context is Scalar Context is Array @@ -1418,26 +1450,26 @@ will be more like this perl --> XSUB --> event handler ... - event handler --> perl_call --> perl + event handler --> perl_call --> perl | - event handler <-- perl_call --<--+ + event handler <-- perl_call <----+ ... - event handler --> perl_call --> perl + event handler --> perl_call --> perl | - event handler <-- perl_call --<--+ + event handler <-- perl_call <----+ ... - event handler --> perl_call --> perl + event handler --> perl_call --> perl | - event handler <-- perl_call --<--+ + event handler <-- perl_call <----+ In this case the flow of control can consist of only the repeated sequence event handler --> perl_call --> perl -for the practically the complete duration of the program. This means -that control may I<never> drop back to the surrounding scope in Perl at -the extreme left. +for practically the complete duration of the program. This means that +control may I<never> drop back to the surrounding scope in Perl at the +extreme left. So what is the big problem? Well, if you are expecting Perl to tidy up those temporaries for you, you might be in for a long wait. For Perl @@ -1553,7 +1585,7 @@ This may expect the C I<ProcessRead> function of this form int fh ; char * buffer ; { - ... + ... } To provide a Perl interface to this library we need to be able to map @@ -1646,7 +1678,7 @@ the C<buffer> parameter like this Without the file handle there is no straightforward way to map from the C callback to the Perl subroutine. -In this case a possible way around this problem is to pre-define a +In this case a possible way around this problem is to predefine a series of C functions to act as the interface to Perl, thus #define MAX_CB 3 @@ -1763,7 +1795,7 @@ series of C functions to act as the interface to Perl, thus In this case the functions C<fn1>, C<fn2>, and C<fn3> are used to remember the Perl subroutine to be called. Each of the functions holds -a separate hard-wired index which is used in the function C<Pcb> to +a separate hardwired index which is used in the function C<Pcb> to access the C<Map> array and actually call the Perl subroutine. There are some obvious disadvantages with this technique. @@ -1771,10 +1803,10 @@ There are some obvious disadvantages with this technique. Firstly, the code is considerably more complex than with the previous example. -Secondly, there is a hard-wired limit (in this case 3) to the number of +Secondly, there is a hardwired limit (in this case 3) to the number of callbacks that can exist simultaneously. The only way to increase the limit is by modifying the code to add more functions and then -re-compiling. None the less, as long as the number of functions is +recompiling. None the less, as long as the number of functions is chosen with some care, it is still a workable solution and in some cases is the only one available. @@ -1878,7 +1910,7 @@ sets the stack up so that we can use the C<ST> macro. Unlike the original coding of this example, the returned values are not accessed in reverse order. So C<ST(0)> refers to the -first value returned by the Perl subroutine and C<ST(count-1)> +first value returned by the Perl subroutine and C<ST(count-1)> refers to the last. =back diff --git a/pod/perldata.pod b/pod/perldata.pod index b69e77e3d7..2a43319b51 100644 --- a/pod/perldata.pod +++ b/pod/perldata.pod @@ -145,12 +145,12 @@ type "filehandle", or anything else. Perl is a contextually polymorphic language whose scalars can be strings, numbers, or references (which includes objects). While strings and numbers are considered pretty much the same thing for nearly all purposes, references are strongly-typed -uncastable pointers with built-in reference-counting and destructor +uncastable pointers with builtin reference-counting and destructor invocation. A scalar value is interpreted as TRUE in the Boolean sense if it is not the null string or the number 0 (or its string equivalent, "0"). The -Boolean context is just a special kind of scalar context. +Boolean context is just a special kind of scalar context. There are actually two varieties of null scalars: defined and undefined. Undefined null scalars are returned when there is no real @@ -160,14 +160,14 @@ array. An undefined null scalar may become defined the first time you use it as if it were defined, but prior to that you can use the defined() operator to determine whether the value is defined or not. -To find out whether a given string is a valid non-zero number, it's usually +To find out whether a given string is a valid nonzero number, it's usually enough to test it against both numeric 0 and also lexical "0" (although this will cause B<-w> noises). That's because strings that aren't numbers count as 0, just as they do in B<awk>: if ($str == 0 && $str ne "0") { warn "That doesn't look like a number"; - } + } That's usually preferable because otherwise you won't treat IEEE notations like C<NaN> or C<Infinity> properly. At other times you might prefer to @@ -176,9 +176,9 @@ for details on regular expressions. warn "has nondigits" if /\D/; warn "not a whole number" unless /^\d+$/; - warn "not an integer" unless /^[+-]?\d+$/ - warn "not a decimal number" unless /^[+-]?\d+\.?\d*$/ - warn "not a C float" + warn "not an integer" unless /^[+-]?\d+$/ + warn "not a decimal number" unless /^[+-]?\d+\.?\d*$/ + warn "not a C float" unless /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/; The length of an array is a scalar value. You may find the length of @@ -310,7 +310,7 @@ say then any bareword that would NOT be interpreted as a subroutine call produces a compile-time error instead. The restriction lasts to the -end of the enclosing block. An inner block may countermand this +end of the enclosing block. An inner block may countermand this by saying C<no strict 'subs'>. Array variables are interpolated into double-quoted strings by joining all @@ -346,7 +346,7 @@ identifier, which is valid, and matches the first empty line.) The terminating string must appear by itself (unquoted and with no surrounding whitespace) on the terminating line. - print <<EOF; + print <<EOF; The price is $Price. EOF @@ -369,11 +369,11 @@ surrounding whitespace) on the terminating line. Here's a line or two. THIS - and here another. + and here's another. THAT -Just don't forget that you have to put a semicolon on the end -to finish the statement, as Perl doesn't know you're not going to +Just don't forget that you have to put a semicolon on the end +to finish the statement, as Perl doesn't know you're not going to try to do this: print <<ABC @@ -401,12 +401,12 @@ assigns the entire list value to array foo, but assigns the value of variable bar to variable foo. Note that the value of an actual array in a scalar context is the length of the array; the -following assigns to $foo the value 3: +following assigns the value 3 to $foo: @foo = ('cc', '-E', $bar); $foo = @foo; # $foo gets 3 -You may have an optional comma before the closing parenthesis of an +You may have an optional comma before the closing parenthesis of a list literal, so that you can say: @foo = ( @@ -434,7 +434,7 @@ interpolating an array with no elements is the same as if no array had been interpolated at that point. A list value may also be subscripted like a normal array. You must -put the list in parentheses to avoid ambiguity. Examples: +put the list in parentheses to avoid ambiguity. For example: # Stat returns list value. $time = (stat($file))[8]; @@ -514,7 +514,7 @@ or for initializing hash references to be used as records: or for using call-by-named-parameter to complicated functions: - $field = $query->radio_group( + $field = $query->radio_group( name => 'group_name', values => ['eenie','meenie','minie'], default => 'meenie', @@ -530,7 +530,7 @@ of how to arrange for an output ordering. Perl uses an internal type called a I<typeglob> to hold an entire symbol table entry. The type prefix of a typeglob is a C<*>, because -it represents all types. This used to be the preferred way to +it represents all types. This used to be the preferred way to pass arrays and hashes by reference into a function, but now that we have real references, this is seldom needed. It also used to be the preferred way to pass filehandles into a function, but now diff --git a/pod/perldebug.pod b/pod/perldebug.pod index 61263b6664..25abfd6b3c 100644 --- a/pod/perldebug.pod +++ b/pod/perldebug.pod @@ -13,7 +13,7 @@ Perl source debugger. This works like an interactive Perl environment, prompting for debugger commands that let you examine source code, set breakpoints, get stack backtraces, change the values of variables, etc. This is so convenient that you often fire up -the debugger all by itself just to test out Perl constructs +the debugger all by itself just to test out Perl constructs interactively to see what they do. For example: perl -d -e 42 @@ -23,7 +23,7 @@ typical compiled environment. Instead, the B<-d> flag tells the compiler to insert source information into the parse trees it's about to hand off to the interpreter. That means your code must first compile correctly for the debugger to work on it. Then when the interpreter starts up, it -pre-loads a Perl library file containing the debugger itself. +preloads a Perl library file containing the debugger itself. The program will halt I<right before> the first run-time executable statement (but see below regarding compile-time statements) and ask you @@ -47,7 +47,7 @@ The debugger understands the following commands: =item h [command] -Prints out a help message. +Prints out a help message. If you supply another debugger command as an argument to the C<h> command, it prints out the description for just that command. The special @@ -73,7 +73,7 @@ where STDOUT may be redirected to. =item x expr -Evaluates its expression in list context and dumps out the result +Evaluates its expression in list context and dumps out the result in a pretty-printed fashion. Nested data structures are printed out recursively, unlike the C<print> function. @@ -308,7 +308,7 @@ Run Tk while prompting (with ReadLine). Level of verbosity. By default the debugger is in a sane verbose mode, thus it will print backtraces on all the warnings and die-messages which are going to be printed out, and will print a message when -interesting uncaught signals arrive. +interesting uncaught signals arrive. To disable this behaviour, set these values to 0. If C<dieLevel> is 2, then the messages which will be caught by surrounding C<eval> are also @@ -328,11 +328,11 @@ C<|visual_perl_db>), then a short, "emacs like" message is used. If 0, allows I<stepping off> the end of the script. -=item C<PrintRet> +=item C<PrintRet> affects printing of return value after C<r> command. -=item C<frame> +=item C<frame> affects printing messages on entry and exit from subroutines. If C<frame & 2> is false, messages are printed on entry only. (Printing @@ -383,7 +383,7 @@ can enable either double-quotish dump, or single-quotish by setting it to C<"> or C<'>. By default, characters with high bit set are printed I<as is>. -=item C<UsageOnly> +=item C<UsageOnly> I<very> rudimentally per-package memory usage dump. Calculates total size of strings in variables in the package. @@ -429,7 +429,7 @@ ReadLine applications. =item C<NonStop> -If set, debugger goes into non-interactive mode until interrupted, or +If set, debugger goes into noninteractive mode until interrupted, or programmatically by setting $DB::signal or $DB::single. =back @@ -449,7 +449,7 @@ Other examples may include $ PERLDB_OPTS="N f A L=listing" perl -d myprogram -- runs script non-interactively, printing info on each entry into a +- runs script noninteractively, printing info on each entry into a subroutine and each executed line into the file F<listing>. (If you interrupt it, you would better reset C<LineInfo> to something "interactive"!) @@ -468,37 +468,37 @@ See L<"Debugger Internals"> below for more details. =item E<lt> [ command ] Set an action (Perl command) to happen before every debugger prompt. -A multi-line command may be entered by backslashing the newlines. If +A multiline command may be entered by backslashing the newlines. If C<command> is missing, resets the list of actions. =item E<lt>E<lt> command Add an action (Perl command) to happen before every debugger prompt. -A multi-line command may be entered by backslashing the newlines. +A multiline command may be entered by backslashing the newlines. =item E<gt> command Set an action (Perl command) to happen after the prompt when you've -just given a command to return to executing the script. A multi-line +just given a command to return to executing the script. A multiline command may be entered by backslashing the newlines. If C<command> is missing, resets the list of actions. =item E<gt>E<gt> command Adds an action (Perl command) to happen after the prompt when you've -just given a command to return to executing the script. A multi-line +just given a command to return to executing the script. A multiline command may be entered by backslashing the newlines. =item { [ command ] Set an action (debugger command) to happen before every debugger prompt. -A multi-line command may be entered by backslashing the newlines. If +A multiline command may be entered by backslashing the newlines. If C<command> is missing, resets the list of actions. =item {{ command Add an action (debugger command) to happen before every debugger prompt. -A multi-line command may be entered by backslashing the newlines. +A multiline command may be entered by backslashing the newlines. =item ! number @@ -539,7 +539,7 @@ your history across this, but internal settings and command line options may be lost. Currently the following setting are preserved: history, breakpoints, -actions, debugger C<O>ptions, and the following command-line +actions, debugger C<O>ptions, and the following command line options: B<-w>, B<-I>, and B<-e>. =item |dbcmd @@ -593,16 +593,16 @@ or even DB<<17>> where that number is the command number, which you'd use to access with -the built-in B<csh>-like history mechanism, e.g., C<!17> would repeat +the builtin B<csh>-like history mechanism, e.g., C<!17> would repeat command number 17. The number of angle brackets indicates the depth of the debugger. You could get more than one set of brackets, for example, if you'd already at a breakpoint and then printed out the result of a function call that itself also has a breakpoint, or you step into an expression via C<s/n/t expression> command. -=item Multi-line commands +=item Multiline commands -If you want to enter a multi-line command, such as a subroutine +If you want to enter a multiline command, such as a subroutine definition with several statements, or a format, you may escape the newline that would normally end the debugger command with a backslash. Here's an example: @@ -667,7 +667,7 @@ next executed line is marked by C<==E<gt>>. When C<frame> option is set, debugger would print entered (and optionally exited) subroutines in different styles. -What follows is the start of the listing of +What follows is the start of the listing of env "PERLDB_OPTS=f=1 N" perl -d -V @@ -795,7 +795,7 @@ is printed with proper indentation. If you have any compile-time executable statements (code within a BEGIN block or a C<use> statement), these will C<NOT> be stopped by debugger, although C<require>s will (and compile-time statements can be traced -with C<AutoTrace> option set in C<PERLDB_OPTS>). From your own Perl +with C<AutoTrace> option set in C<PERLDB_OPTS>). From your own Perl code, however, you can transfer control back to the debugger using the following statement, which is harmless if the debugger is not running: @@ -859,7 +859,7 @@ the Term::ReadKey and Term::ReadLine modules from CPAN, you will have full editing capabilities much like GNU I<readline>(3) provides. Look for these in the F<modules/by-module/Term> directory on CPAN. -A rudimentary command-line completion is also available. +A rudimentary command line completion is also available. Unfortunately, the names of lexical variables are not available for completion. @@ -901,7 +901,7 @@ in that profile. When you call the B<caller> function (see L<perlfunc/caller>) from the package DB, Perl sets the array @DB::args to contain the arguments the -corresponding stack frame was called with. +corresponding stack frame was called with. If perl is run with B<-d> option, the following additional features are enabled: @@ -1007,9 +1007,9 @@ statement, and would wait for your C<CR> to continue. The following debugger is quite functional: - { - package DB; - sub DB {} + { + package DB; + sub DB {} sub sub {print ++$i, " $sub\n"; &$sub} } @@ -1020,7 +1020,7 @@ package C<DB>. =head2 Debugger Internals At the start, the debugger reads your rc file (F<./.perldb> or -F<~/.perldb> under UNIX), which can set important options. This file may +F<~/.perldb> under Unix), which can set important options. This file may define a subroutine C<&afterinit> to be executed after the debugger is initialized. @@ -1042,7 +1042,7 @@ C<context> (C<$> or C<@>), C<sub> (subroutine name, or info about eval), C<args> (C<undef> or a reference to an array), C<file>, and C<line>. -The function C<DB::print_trace(FH, skip[, count[, short]])> prints +The function C<DB::print_trace(FH, skip[, count[, short]])> prints formatted info about caller frames. The last two functions may be convenient as arguments to C<E<lt>>, C<E<lt>E<lt>> commands. diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 46bd59b04f..ddd29c46d6 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -18,7 +18,7 @@ QNX, and AmigaOS. Most importantly, many bugs were fixed. See the F<Changes> file in the distribution for details. -=head2 Compilation Option: Binary Compatibility With 5.003 +=head2 Compilation option: Binary compatibility with 5.003 There is a new Configure question that asks if you want to maintain binary compatibility with Perl 5.003. If you choose binary @@ -27,6 +27,22 @@ might have symbol conflicts if you embed Perl in another application, just as in the 5.003 release. By default, binary compatibility is preserved at the expense of symbol table pollution. +=head2 $PERL5OPT environment variable + +You may now put Perl options in the $PERL5OPT environment variable. +Unless Perl is running with taint checks, it will interpret this +variable as if its contents had appeared on a "#!perl" line at the +beginning of your script, except that hyphens are optional. PERL5OPT +may only be used to set the following switches: B<-[DIMUdmw]>. + +=head2 More precise warnings + +If you removed the -w option from your Perl 5.003 scripts because it +made Perl too verbose, we recommend that you try putting it back when +you upgrade to Perl 5.004. Each new perl version tends to remove some +undesirable warnings, while adding new warnings that may catch bugs in +your scripts. + =head2 Subroutine arguments created only when they're modified In Perl 5.004, nonexistent array and hash elements used as subroutine @@ -51,7 +67,20 @@ After this code executes in Perl 5.004, $a{b} exists but $a[2] does not. In Perl 5.002 and 5.003, both $a{b} and $a[2] would have existed (but $a[2]'s value would have been undefined). -=head2 Fixed Parsing of $$<digit>, &$<digit>, etc. +=head2 Simple functions' C<AUTOLOAD> not looked up as method + +Before Perl 5.004, C<AUTOLOAD> functions were looked up as methods +(using the C<@ISA> hierarchy), even when the function to be autoloaded +was called as a plain function (e.g. C<Foo::bar()>), not a method. +Perl 5.004 no longer uses method lookup for C<AUTOLOAD>s of plain +functions. + +The simple rule is: Inheritance does not work when autoloading plain +functions. The simple fix for old code is: In any module that used to +depend on inheriting C<AUTOLOAD> from a base class named C<BaseClass>, +execute C<*AUTOLOAD = *BaseClass::AUTOLOAD>. + +=head2 Fixed parsing of $$<digit>, &$<digit>, etc. A bug in previous versions of Perl 5.0 prevented proper parsing of numeric special variables as symbolic references. That bug has been @@ -59,14 +88,22 @@ fixed. As a result, the string "$$0" is no longer equivalent to C<$$."0">, but rather to C<${$0}>. To get the old behavior, change "$$" followed by a digit to "${$}". -=head2 No Resetting of $. on Implicit Close +=head2 No resetting of $. on implicit close The documentation for Perl 5.0 has always stated that C<$.> is I<not> -reset when an already-open file handle is re-opened with no intervening -call to C<close>. Due to a bug, perl versions 5.000 through 5.0003 +reset when an already-open file handle is reopened with no intervening +call to C<close>. Due to a bug, perl versions 5.000 through 5.003 I<did> reset C<$.> under that circumstance; Perl 5.004 does not. -=head2 Changes to Tainting Checks +=head2 C<wantarray> may return undef + +The C<wantarray> operator returns true if a subroutine is expected to +return a list, and false otherwise. In Perl 5.004, C<wantarray> can +also return the undefined value if a subroutine's return value will +not be used at all, which allows subroutines to avoid a time-consuming +calculation of a return value if it isn't going to be used. + +=head2 Changes to tainting checks A bug in previous versions may have failed to detect some insecure conditions when taint checks are turned on. (Taint checks are used @@ -76,14 +113,14 @@ previously-working script to now fail -- which should be construed as a blessing, since that indicates a potentially-serious security hole was just plugged. -=head2 New Opcode Module and Revised Safe Module +=head2 New Opcode module and revised Safe module A new Opcode module supports the creation, manipulation and application of opcode masks. The revised Safe module has a new API and is implemented using the new Opcode module. Please read the new Opcode and Safe documentation. -=head2 Embedding Improvements +=head2 Embedding improvements In older versions of Perl it was not possible to create more than one Perl interpreter instance inside a single process without leaking like a @@ -92,7 +129,7 @@ fixed. However, you still must take care when embedding Perl in a C program. See the updated perlembed manpage for tips on how to manage your interpreters. -=head2 Internal Change: FileHandle Class Based on IO::* Classes +=head2 Internal change: FileHandle class based on IO::* classes File handles are now stored internally as type IO::Handle. The FileHandle module is still supported for backwards compatibility, but @@ -103,13 +140,13 @@ require, that you use the IO::* modules in new code. In harmony with this change, C<*GLOB{FILEHANDLE}> is now a backward-compatible synonym for C<*STDOUT{IO}>. -=head2 Internal Change: PerlIO internal IO abstraction interface +=head2 Internal change: PerlIO abstraction interface It is now possible to build Perl with AT&T's sfio IO package instead of stdio. See L<perlapio> for more details, and the F<INSTALL> file for how to use it. -=head2 New and Changed Built-in Variables +=head2 New and changed builtin variables =over @@ -142,7 +179,7 @@ there is no C<use English> long name for this variable. =back -=head2 New and Changed Built-in Functions +=head2 New and changed builtin functions =over @@ -225,7 +262,7 @@ number instead of a module name. If the version of the Perl interpreter is less than VERSION, then an error message is printed and Perl exits immediately. Because C<use> occurs at compile time, this check happens immediately during the compilation process, unlike C<require VERSION>, -which waits until run-time for the check. This is often useful if you +which waits until runtime for the check. This is often useful if you need to check the current Perl version before C<use>ing library modules which have changed in incompatible ways from older versions of Perl. (We try not to do this more than we have to.) @@ -283,7 +320,7 @@ zero-width assertion. See L<perlop> and L<perlre>. The C<m//x> construct has always been intended to ignore all unescaped whitespace. However, before Perl 5.004, whitespace had the effect of -esacping repeat modifier like "*" or "?". For example, C</a *b/x> was +escaping repeat modifiers like "*" or "?"; for example, C</a *b/x> was (mis)interpreted as C</a\*b/x>. This bug has been fixed in 5.004. =item nested C<sub{}> closures work now @@ -309,7 +346,7 @@ before, and is fine now: =back -=head2 New Built-in Methods +=head2 New builtin methods The C<UNIVERSAL> package automatically contains the following methods that are inherited by all other classes: @@ -359,7 +396,7 @@ You do not need to C<use UNIVERSAL> in order to make these methods available to your program. This is necessary only if you wish to have C<isa> available as a plain subroutine in the current package. -=head2 TIEHANDLE Now Supported +=head2 TIEHANDLE now supported See L<perltie> for other kinds of tie()s. @@ -428,7 +465,7 @@ possibly for cleaning up. =back -=head2 Malloc Enhancements +=head2 Malloc enhancements Four new compilation flags are recognized by malloc.c. (They have no effect if perl is compiled with system malloc().) @@ -487,7 +524,7 @@ negligible. =back -=head2 Miscellaneous Efficiency Enhancements +=head2 Miscellaneous efficiency enhancements Functions that have an empty prototype and that do nothing but return a fixed value are now inlined (e.g. C<sub PI () { 3.14159 }>). @@ -498,10 +535,16 @@ same hash, the hash keys never have to be reallocated. =head1 Pragmata -Four new pragmatic modules exist: +Six new pragmatic modules exist: =over +=item use autouse MODULE => qw(sub1 sub2 sub3) + +Defers C<require MODULE> 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 use blib =item use blib 'dir' @@ -513,10 +556,15 @@ parent directories. Intended for use on command line with B<-M> option as a way of testing arbitrary scripts against an uninstalled version of a package. +=item use constant NAME => VALUE + +Provides a convenient interface for creating compile-time constants, +See L<perlsub/"Constant Functions">. + =item use locale Tells the compiler to enable (or disable) the use of POSIX locales for -built-in operations. +builtin operations. When C<use locale> is in effect, the current LC_CTYPE locale is used for regular expressions and case mapping; LC_COLLATE for string @@ -548,7 +596,7 @@ relative to the local time zone, in the VMS tradition. =head1 Modules -=head2 Installation Directories +=head2 Installation directories The I<installperl> script now places the Perl source files for extensions in the architecture-specific library directory, which is @@ -558,31 +606,7 @@ library directory unchanged from a previous version, without running the risk of binary incompatibility between extensions' Perl source and shared libraries. -=head2 Fcntl - -New constants in the existing Fcntl modules are now supported, -provided that your operating system happens to support them: - - F_GETOWN F_SETOWN - O_ASYNC O_DEFER O_DSYNC O_FSYNC O_SYNC - O_EXLOCK O_SHLOCK - -These constants are intended for use with the Perl operators sysopen() -and fcntl() and the basic database modules like SDBM_File. For the -exact meaning of these and other Fcntl constants please refer to your -operating system's documentation for fcntl() and open(). - -In addition, the Fcntl module now provides these constants for use -with the Perl operator flock(): - - LOCK_SH LOCK_EX LOCK_NB LOCK_UN - -These constants are defined in all environments (because where there is -no flock() system call, Perl emulates it). However, for historical -reasons, these constants are not exported unless they are explicitly -requested with the ":flock" tag (e.g. C<use Fcntl ':flock'>). - -=head2 Module Information Summary +=head2 Module information summary Brand new modules, arranged by topic rather than strictly alphabetically: @@ -622,6 +646,30 @@ alphabetically: UNIVERSAL.pm Base class for *ALL* classes +=head2 Fcntl + +New constants in the existing Fcntl modules are now supported, +provided that your operating system happens to support them: + + F_GETOWN F_SETOWN + O_ASYNC O_DEFER O_DSYNC O_FSYNC O_SYNC + O_EXLOCK O_SHLOCK + +These constants are intended for use with the Perl operators sysopen() +and fcntl() and the basic database modules like SDBM_File. For the +exact meaning of these and other Fcntl constants please refer to your +operating system's documentation for fcntl() and open(). + +In addition, the Fcntl module now provides these constants for use +with the Perl operator flock(): + + LOCK_SH LOCK_EX LOCK_NB LOCK_UN + +These constants are defined in all environments (because where there is +no flock() system call, Perl emulates it). However, for historical +reasons, these constants are not exported unless they are explicitly +requested with the ":flock" tag (e.g. C<use Fcntl ':flock'>). + =head2 IO The IO module provides a simple mechanism to load all of the IO modules at one @@ -697,9 +745,9 @@ changes. Everything after DB_File 1.01 has been added since 5.003. Major rewrite - support added for both udp echo and real icmp pings. -=head2 Overridden Built-ins +=head2 Object-oriented overrides for builtin operators -Many of the Perl built-ins returning lists now have +Many of the Perl builtins returning lists now have object-oriented overrides. These are: File::stat @@ -768,7 +816,7 @@ on the first call). Internal handling of hash keys has changed. The old hashtable API is still fully supported, and will likely remain so. The additions to the API allow passing keys as C<SV*>s, so that C<tied> hashes can be given -real scalars as keys rather than plain strings (non-tied hashes still +real scalars as keys rather than plain strings (nontied hashes still can only use strings as keys). New extensions must use the new hash access functions and macros if they wish to use C<SV*> keys. These additions also make it feasible to manipulate C<HE*>s (hash entries), @@ -822,7 +870,7 @@ increasing order of desperation): (S) A severe warning (mandatory). (F) A fatal error (trappable). (P) An internal error you should never see (trappable). - (X) A very fatal error (non-trappable). + (X) A very fatal error (nontrappable). (A) An alien error message (not generated by Perl). =over @@ -849,13 +897,22 @@ or a hash slice, such as =item Allocation too large: %lx -(X) You can't allocate more than 64K on an MSDOS machine. +(X) You can't allocate more than 64K on an MS-DOS machine. =item Allocation too large (F) You can't allocate more than 2^31+"small amount" bytes. -=item Attempt to free non-existent shared string +=item Applying %s to %s will act on scalar(%s) + +(W) The pattern match (//), substitution (s///), and translation (tr///) +operators work on scalar values. If you apply one of them to an array +or a hash, it will convert the array or hash to a scalar value -- the +length of an array, or the population info of a hash -- and then work on +that scalar value. This is probably not what you meant to do. See +L<perlfunc/grep> and L<perlfunc/map> for alternatives. + +=item Attempt to free nonexistent shared string (P) Perl maintains a reference counted internal table of strings to optimize the storage and access of hash keys and other strings. This @@ -868,39 +925,54 @@ that can no longer be found in the table. as an lvalue, which is pretty strange. Perhaps you forgot to dereference it first. See L<perlfunc/substr>. -=item Unsupported function fork - -(F) Your version of executable does not support forking. - -Note that under some systems, like OS/2, there may be different flavors of -Perl executables, some of which may support fork, some not. Try changing -the name you call Perl by to C<perl_>, C<perl__>, and so on. - -=item Ill-formed logical name |%s| in prime_env_iter - -(W) A warning peculiar to VMS. A logical name was encountered when preparing -to iterate over %ENV which violates the syntactic rules governing logical -names. Since it cannot be translated normally, it is skipped, and will not -appear in %ENV. This may be a benign occurrence, as some software packages -might directly modify logical name tables and introduce non-standard names, -or it may indicate that a logical name table has been corrupted. - =item Can't use bareword ("%s") as %s ref while "strict refs" in use (F) Only hard references are allowed by "strict refs". Symbolic references are disallowed. See L<perlref>. +=item Cannot resolve method `%s' overloading `%s' in package `%s' + +(P) Internal error trying to resolve overloading specified by a method +name (as opposed to a subroutine reference). + =item Constant subroutine %s redefined (S) You redefined a subroutine which had previously been eligible for +inlining. See L<perlsub/"Constant Functions"for commentary and +workarounds. + +=item Constant subroutine %s undefined + +(S) You undefined a subroutine which had previously been eligible for inlining. See L<perlsub/"Constant Functions"> for commentary and workarounds. +=item Copy method did not return a reference + +(F) The method which overloads "=" is buggy. See L<overload/Copy Constructor>. + =item Died (F) You passed die() an empty string (the equivalent of C<die "">) or you called it with no args and both C<$@> and C<$_> were empty. +=item Exiting pseudo-block via %s + +(W) You are exiting a rather special block construct (like a sort block or +subroutine) by unconventional means, such as a goto, or a loop control +statement. See L<perlfunc/sort>. + +=item Illegal character %s (carriage return) + +(F) A carriage return character was found in the input. This is an +error, and not a warning, because carriage return characters can break +multi-line strings, including here documents (e.g., C<print E<lt>E<lt>EOF;>). + +=item Illegal switch in PERL5OPT: %s + +(X) The PERL5OPT environment variable may only be used to set the +following switches: B<-[DIMUdmw]>. + =item Integer overflow in hex number (S) The literal hex number you have specified is too big for your @@ -933,17 +1005,6 @@ pointing outside the buffer. This is difficult to imagine. The sole exception to this is that C<sysread()>ing past the buffer will extend the buffer and zero pad the new area. -=item Stub found while resolving method `%s' overloading `%s' in package `%s' - -(P) Overloading resolution over @ISA tree may be broken by importing stubs. -Stubs should never be implicitely created, but explicit calls to C<can> -may break this. - -=item Cannot resolve method `%s' overloading `%s' in package `s' - -(P) Internal error trying to resolve overloading specified by a method -name (as opposed to a subroutine reference). - =item Out of memory! (X|F) The malloc() function returned 0, indicating there was insufficient @@ -1017,18 +1078,46 @@ assigning to it and when evaluating its argument, while C<@foo{&bar}> behaves like a list when you assign to it, and provides a list context to its subscript, which can do weird things if you're expecting only one subscript. +=item Stub found while resolving method `%s' overloading `%s' in package `%s' + +(P) Overloading resolution over @ISA tree may be broken by importing stubs. +Stubs should never be implicitely created, but explicit calls to C<can> +may break this. + +=item Too late for "B<-T>" option + +(X) The #! line (or local equivalent) in a Perl script contains the +B<-T> option, but Perl was not invoked with B<-T> in its argument +list. This is an error because, by the time Perl discovers a B<-T> in +a script, it's too late to properly taint everything from the +environment. So Perl gives up. + =item untie attempted while %d inner references still exist (W) A copy of the object returned from C<tie> (or C<tied>) was still valid when C<untie> was called. -=item Value of %s construct can be "0"; test with defined() +=item Unrecognized character %s + +(F) The Perl parser has no idea what to do with the specified character +in your Perl script (or eval). Perhaps you tried to run a compressed +script, a binary program, or a directory as a Perl program. + +=item Unsupported function fork + +(F) Your version of executable does not support forking. + +Note that under some systems, like OS/2, there may be different flavors of +Perl executables, some of which may support fork, some not. Try changing +the name you call Perl by to C<perl_>, C<perl__>, and so on. + +=item Value of %s can be "0"; test with defined() -(W) In a conditional expression, you used <HANDLE>, <*> (glob), or -C<readdir> as a boolean value. Each of these constructs can return a -value of "0"; that would make the conditional expression false, which -is probably not what you intended. When using these constructs in -conditional expressions, test their values with the C<defined> operator. +(W) In a conditional expression, you used <HANDLE>, <*> (glob), C<each()>, +or C<readdir()> as a boolean value. Each of these constructs can return a +value of "0"; that would make the conditional expression false, which is +probably not what you intended. When using these constructs in conditional +expressions, test their values with the C<defined> operator. =item Variable "%s" may be unavailable @@ -1071,7 +1160,7 @@ will I<never> share the given variable. This problem can usually be solved by making the inner subroutine anonymous, using the C<sub {}> syntax. When inner anonymous subs that reference variables in outer subroutines are called or referenced, -they are automatically re-bound to the current values of such +they are automatically rebound to the current values of such variables. =item Warning: something's wrong @@ -1079,6 +1168,15 @@ variables. (W) You passed warn() an empty string (the equivalent of C<warn "">) or you called it with no args and C<$_> was empty. +=item Ill-formed logical name |%s| in prime_env_iter + +(W) A warning peculiar to VMS. A logical name was encountered when preparing +to iterate over %ENV which violates the syntactic rules governing logical +names. Since it cannot be translated normally, it is skipped, and will not +appear in %ENV. This may be a benign occurrence, as some software packages +might directly modify logical name tables and introduce nonstandard names, +or it may indicate that a logical name table has been corrupted. + =item Got an error from DosAllocMem (P) An error peculiar to OS/2. Most probably you're using an obsolete @@ -1094,7 +1192,7 @@ or prefix1 prefix2 -with non-empty prefix1 and prefix2. If C<prefix1> is indeed a prefix of +with nonempty prefix1 and prefix2. If C<prefix1> is indeed a prefix of a builtin library search path, prefix2 is substituted. The error may appear if components are not found, or are too long. See L<perlos2/"PERLLIB_PREFIX">. diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 90b811f691..a138bc6645 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -12,7 +12,7 @@ desperation): (S) A severe warning (mandatory). (F) A fatal error (trappable). (P) An internal error you should never see (trappable). - (X) A very fatal error (non-trappable). + (X) A very fatal error (nontrappable). (A) An alien error message (not generated by Perl). Optional warnings are enabled by using the B<-w> switch. Warnings may @@ -174,7 +174,7 @@ the return value of your socket() call? See L<perlfunc/accept>. =item Allocation too large: %lx -(X) You can't allocate more than 64K on an MSDOS machine. +(X) You can't allocate more than 64K on an MS-DOS machine. =item Allocation too large @@ -237,7 +237,7 @@ know which context to supply to the right side. be garbage collected on exit. An SV was discovered to be outside any of those arenas. -=item Attempt to free non-existent shared string +=item Attempt to free nonexistent shared string (P) Perl maintains a reference counted internal table of strings to optimize the storage and access of hash keys and other strings. This @@ -338,7 +338,7 @@ Perl yourself. (F) With "strict subs" in use, a bareword is only allowed as a subroutine identifier, in curly braces or to the left of the "=>" symbol. -Perhaps you need to pre-declare a subroutine? +Perhaps you need to predeclare a subroutine? =item BEGIN failed--compilation aborted @@ -389,7 +389,7 @@ will be considered a block that loops once. See L<perlfunc/last>. there isn't a current block. Note that an "if" or "else" block doesn't count as a "loopish" block, as doesn't a block given to sort(). You can usually double the curlies to get the same effect though, because the inner -curlies will be considered a block that loops once. See L<perlfunc/last>. +curlies will be considered a block that loops once. See L<perlfunc/next>. =item Can't "redo" outside a block @@ -397,7 +397,7 @@ curlies will be considered a block that loops once. See L<perlfunc/last>. there isn't a current block. Note that an "if" or "else" block doesn't count as a "loopish" block, as doesn't a block given to sort(). You can usually double the curlies to get the same effect though, because the inner -curlies will be considered a block that loops once. See L<perlfunc/last>. +curlies will be considered a block that loops once. See L<perlfunc/redo>. =item Can't bless non-reference value @@ -406,7 +406,7 @@ encapsulation of objects. See L<perlobj>. =item Can't break at that line -(S) A warning intended for while running within the debugger, indicating +(S) A warning intended to only be printed while running within the debugger, indicating the line number specified wasn't the location of a statement that could be stopped at. @@ -418,7 +418,7 @@ in it, let alone methods. See L<perlobj>. =item Can't call method "%s" on unblessed reference -(F) A method call must know what package it's supposed to run in. It +(F) A method call must know in what package it's supposed to run. It ordinarily finds this out from the object reference you supply, but you didn't supply an object reference in this case. A reference isn't an object reference until it has been blessed. See L<perlobj>. @@ -478,9 +478,9 @@ They must have ordinary identifiers as names. (S) The creation of the new file failed for the indicated reason. -=item Can't do in-place edit without backup +=item Can't do inplace edit without backup -(F) You're on a system such as MSDOS that gets confused if you try reading +(F) You're on a system such as MS-DOS that gets confused if you try reading from a deleted (but still opened) file. You have to say C<-i.bak>, or some such. @@ -563,14 +563,6 @@ levels, the following is missing its final parenthesis: (F) A fatal error occurred while trying to fork while opening a pipeline. -=item Unsupported function fork - -(F) Your version of executable does not support forking. - -Note that under some systems, like OS/2, there may be different flavors of -Perl executables, some of which may support fork, some not. Try changing -the name you call Perl by to C<perl_>, C<perl__>, and so on. - =item Can't get filespec - stale stat buffer? (S) A warning peculiar to VMS. This arises because of the difference between @@ -621,10 +613,10 @@ package name. =item Can't locate %s in @INC -(F) You said to do (or require, or use) a file that couldn't be found -in any of the libraries mentioned in @INC. Perhaps you need to set -the PERL5LIB environment variable to say where the extra library is, -or maybe the script needs to add the library name to @INC. Or maybe +(F) You said to do (or require, or use) a file that couldn't be found in +in any of the libraries mentioned in @INC. Perhaps you need to set the +PERL5LIB or PERL5OPT environment variable to say where the extra library +is, or maybe the script needs to add the library name to @INC. Or maybe you just misspelled the name of the file. See L<perlfunc/require>. =item Can't locate object method "%s" via package "%s" @@ -648,7 +640,7 @@ a B<-e> switch. Maybe your /tmp partition is full, or clobbered. (F) You aren't allowed to assign to the item indicated, or otherwise try to change it, such as with an auto-increment. -=item Can't modify non-existent substring +=item Can't modify nonexistent substring (P) The internal routine that does assignment to a substr() was handed a NULL. @@ -660,7 +652,7 @@ buffer. =item Can't open %s: %s -(S) An in-place edit couldn't open the original file for the indicated reason. +(S) An inplace edit couldn't open the original file for the indicated reason. Usually this is because you don't have read permission for the file. =item Can't open bidirectional pipe @@ -799,7 +791,7 @@ are disallowed. See L<perlref>. =item Can't use an undefined value as %s reference (F) A value used as either a hard reference or a symbolic reference must -be a defined value. This helps to de-lurk some insidious errors. +be a defined value. This helps to delurk some insidious errors. =item Can't use global %s in "my" @@ -906,7 +898,7 @@ On the other hand, maybe you just meant %hash and got carried away. (F) You passed die() an empty string (the equivalent of C<die "">) or you called it with no args and both C<$@> and C<$_> were empty. -=item Do you need to pre-declare %s? +=item Do you need to predeclare %s? (S) This is an educated guess made in conjunction with the message "%s found where operator expected". It often means a subroutine or module @@ -1106,18 +1098,18 @@ is now heavily deprecated. to iterate over %ENV which violates the syntactic rules governing logical names. Because it cannot be translated normally, it is skipped, and will not appear in %ENV. This may be a benign occurrence, as some software packages -might directly modify logical name tables and introduce non-standard names, +might directly modify logical name tables and introduce nonstandard names, or it may indicate that a logical name table has been corrupted. =item Illegal character %s (carriage return) (F) A carriage return character was found in the input. This is an error, and not a warning, because carriage return characters can break -here documents (e.g., C<print E<lt>E<lt>EOF;>). - -Under UNIX, this error is usually caused by executing Perl code -- +multi-line strings, including here documents (e.g., C<print E<lt>E<lt>EOF;>). + +Under Unix, this error is usually caused by executing Perl code -- either the main program, a module, or an eval'd string -- that was -transferred over a network connection from a non-UNIX system without +transferred over a network connection from a non-Unix system without properly converting the text file format. Under systems that use something other than '\n' to delimit lines of @@ -1147,6 +1139,11 @@ don't take to this kindly. (W) You may have tried to use an 8 or 9 in a octal number. Interpretation of the octal number stopped before the 8 or 9. +=item Illegal switch in PERL5OPT: %s + +(X) The PERL5OPT environment variable may only be used to set the +following switches: B<-[DIMUdmw]>. + =item In string, @%s now must be written as \@%s (F) It used to be that Perl would try to guess whether you wanted an @@ -1301,13 +1298,13 @@ catches that. But an easy way to do the same thing is: Another way is to assign to a substr() that's off the end of the string. -=item Modification of non-creatable array value attempted, subscript %d +=item Modification of noncreatable array value attempted, subscript %d (F) You tried to make an array value spring into existence, and the subscript was probably negative, even counting from end of the array backwards. -=item Modification of non-creatable hash value attempted, subscript "%s" +=item Modification of noncreatable hash value attempted, subscript "%s" (F) You tried to make a hash value spring into existence, and it couldn't be created for some peculiar reason. @@ -1382,7 +1379,7 @@ this error was triggered? =item No command into which to pipe on command line (F) An error peculiar to VMS. Perl handles its own command line redirection, -and found a '|' at the end of the command line, so it doesn't know whither you +and found a '|' at the end of the command line, so it doesn't know where you want to pipe the output from this command. =item No DB::DB routine defined @@ -1422,7 +1419,7 @@ from which to read data for stdin. (F) An error peculiar to VMS. Perl handles its own command line redirection, and found a lone 'E<gt>' at the end of the command line, so it doesn't know -whither you wanted to redirect stdout. +where you wanted to redirect stdout. =item No output file after E<gt> or E<gt>E<gt> on command line @@ -1596,7 +1593,7 @@ but realloc() wouldn't give it more memory, virtual or otherwise. =item Out of memory! (X|F) The malloc() function returned 0, indicating there was insufficient -remaining memory (or virtual memory) to satisfy the request. +remaining memory (or virtual memory) to satisfy the request. The request was judged to be small, so the possibility to trap it depends on the way perl was compiled. By default it is not trappable. @@ -1799,7 +1796,7 @@ used.) You probably wrote something like this: - @list = qw( + @list = qw( a # a comment b # another comment ); @@ -1807,8 +1804,8 @@ You probably wrote something like this: when you should have written this: @list = qw( - a - b + a + b ); If you really want comments, build your list the @@ -1826,7 +1823,7 @@ aren't needed to separate the items. (You may have used different delimiters than the parentheses shown here; braces are also frequently used.) -You probably wrote something like this: +You probably wrote something like this: qw! a, b, c !; @@ -1869,7 +1866,7 @@ Check your logic flow. =item Probable precedence problem on %s -(W) The compiler found a bare word where it expected a conditional, +(W) The compiler found a bareword where it expected a conditional, which often indicates that an || or && was parsed as part of the last argument of the previous construct, for example: @@ -1887,7 +1884,7 @@ Check your logic flow. =item Reallocation too large: %lx -(F) You can't allocate more than 64K on an MSDOS machine. +(F) You can't allocate more than 64K on an MS-DOS machine. =item Recompile perl with B<-D>DEBUGGING to use B<-D> switch @@ -1965,8 +1962,8 @@ L<perlref>. =item Script is not setuid/setgid in suidperl -(F) Oddly, the suidperl program was invoked on a script with its setuid -or setgid bit not set. This doesn't make much sense. +(F) Oddly, the suidperl program was invoked on a script without a setuid +or setgid bit set. This doesn't make much sense. =item Search pattern not terminated @@ -1976,7 +1973,7 @@ construct. Remember that bracketing delimiters count nesting level. =item seek() on unopened file (W) You tried to use the seek() function on a filehandle that was either -never opened or has been closed since. +never opened or has since been closed. =item select not implemented @@ -2102,7 +2099,7 @@ See L<perlfunc/split>. =item Stat on unopened file E<lt>%sE<gt> (W) You tried to use the stat() function (or an equivalent file test) -on a filehandle that was either never opened or has been closed since. +on a filehandle that was either never opened or has since been closed. =item Statement unlikely to be reached @@ -2195,7 +2192,7 @@ Check your logic flow. =item tell() on unopened file (W) You tried to use the tell() function on a filehandle that was either -never opened or has been closed since. +never opened or has since been closed. =item Test on unopened file E<lt>%sE<gt> @@ -2394,14 +2391,15 @@ See L<perlre>. =item Unquoted string "%s" may clash with future reserved word -(W) You used a bare word that might someday be claimed as a reserved word. +(W) You used a bareword that might someday be claimed as a reserved word. It's best to put such a word in quotes, or capitalize it somehow, or insert an underbar into it. You might also declare it as a subroutine. -=item Unrecognized character \%03o ignored +=item Unrecognized character %s -(S) A garbage character was found in the input, and ignored, in case it's -a weird control character on an EBCDIC machine, or some such. +(F) The Perl parser has no idea what to do with the specified character +in your Perl script (or eval). Perhaps you tried to run a compressed +script, a binary program, or a directory as a Perl program. =item Unrecognized signal name "%s" @@ -2418,12 +2416,20 @@ supplying the bad switch on your behalf.) (W) A file operation was attempted on a filename, and that operation failed, PROBABLY because the filename contained a newline, PROBABLY -because you forgot to chop() or chomp() it off. See L<perlfunc/chop>. +because you forgot to chop() or chomp() it off. See L<perlfunc/chomp>. =item Unsupported directory function "%s" called (F) Your machine doesn't support opendir() and readdir(). +=item Unsupported function fork + +(F) Your version of executable does not support forking. + +Note that under some systems, like OS/2, there may be different flavors of +Perl executables, some of which may support fork, some not. Try changing +the name you call Perl by to C<perl_>, C<perl__>, and so on. + =item Unsupported function %s (F) This machines doesn't implement the indicated function, apparently. @@ -2448,7 +2454,7 @@ Use an explicit printf() or sprintf() instead. =item Use of $* is deprecated -(D) This variable magically turned on multi-line pattern matching, both for +(D) This variable magically turned on multiline pattern matching, both for you and for any luckless subroutine that you happen to call. You should use the new C<//m> and C<//s> modifiers now to do that without the dangerous action-at-a-distance effects of C<$*>. @@ -2574,7 +2580,7 @@ will I<never> share the given variable. This problem can usually be solved by making the inner subroutine anonymous, using the C<sub {}> syntax. When inner anonymous subs that reference variables in outer subroutines are called or referenced, -they are automatically re-bound to the current values of such +they are automatically rebound to the current values of such variables. =item Variable syntax @@ -2705,13 +2711,13 @@ or prefix1 prefix2 -with non-empty prefix1 and prefix2. If C<prefix1> is indeed a prefix of +with nonempty prefix1 and prefix2. If C<prefix1> is indeed a prefix of a builtin library search path, prefix2 is substituted. The error may appear if components are not found, or are too long. See L<perlos2/"PERLLIB_PREFIX">. =item PERL_SH_DIR too long -(F) An error peculiar to OS/2. PERL_SH_DIR is the directory to find the +(F) An error peculiar to OS/2. PERL_SH_DIR is the directory to find the C<sh>-shell in. See L<perlos2/"PERL_SH_DIR">. =item Process terminated by SIG%s diff --git a/pod/perldsc.pod b/pod/perldsc.pod index 61c45b970c..e2b82df796 100644 --- a/pod/perldsc.pod +++ b/pod/perldsc.pod @@ -134,7 +134,7 @@ might do well to consider being a tad more explicit about it, like this: for $i (1..10) { @list = somefunc($i); - $counts[$i] = scalar @list; + $counts[$i] = scalar @list; } Here's the case of taking a reference to the same memory location @@ -328,7 +328,7 @@ There's also a lowercase B<x> command which is nearly the same. =head1 CODE EXAMPLES -Presented with little comment (these will get their own man pages someday) +Presented with little comment (these will get their own manpages someday) here are short code examples illustrating access of various types of data structures. @@ -457,7 +457,7 @@ types of data structures. } # print the whole thing sorted by number of members and name - foreach $family ( sort { + foreach $family ( sort { @{$HoL{$b}} <=> @{$HoL{$a}} || $a cmp $b diff --git a/pod/perlembed.pod b/pod/perlembed.pod index 7752156026..9111be1253 100644 --- a/pod/perlembed.pod +++ b/pod/perlembed.pod @@ -14,7 +14,7 @@ Do you want to: Read L<perlcall> and L<perlxs>. -=item B<Use a UNIX program from Perl?> +=item B<Use a Unix program from Perl?> Read about back-quotes and about C<system> and C<exec> in L<perlfunc>. @@ -96,29 +96,29 @@ Execute this statement for a hint about where to find CORE: perl -MConfig -e 'print $Config{archlib}' -Here's how you'd compile the example in the next section, +Here's how you'd compile the example in the next section, L<Adding a Perl interpreter to your C program>, on my Linux box: - % gcc -O2 -Dbool=char -DHAS_BOOL -I/usr/local/include + % gcc -O2 -Dbool=char -DHAS_BOOL -I/usr/local/include -I/usr/local/lib/perl5/i586-linux/5.003/CORE - -L/usr/local/lib/perl5/i586-linux/5.003/CORE + -L/usr/local/lib/perl5/i586-linux/5.003/CORE -o interp interp.c -lperl -lm -(That's all one line.) On my DEC Alpha running 5.00305, the incantation +(That's all one line.) On my DEC Alpha running 5.003_05, the incantation is a bit different: - % cc -O2 -Olimit 2900 -DSTANDARD_C -I/usr/local/include - -I/usr/local/lib/perl5/alpha-dec_osf/5.00305/CORE - -L/usr/local/lib/perl5/alpha-dec_osf/5.00305/CORE -L/usr/local/lib + % cc -O2 -Olimit 2900 -DSTANDARD_C -I/usr/local/include + -I/usr/local/lib/perl5/alpha-dec_osf/5.00305/CORE + -L/usr/local/lib/perl5/alpha-dec_osf/5.00305/CORE -L/usr/local/lib -D__LANGUAGE_C__ -D_NO_PROTO -o interp interp.c -lperl -lm How can you figure out what to add? Assuming your Perl is post-5.001, execute a C<perl -V> command and pay special attention to the "cc" and -"ccflags" information. +"ccflags" information. -You'll have to choose the appropriate compiler (I<cc>, I<gcc>, et al.) for +You'll have to choose the appropriate compiler (I<cc>, I<gcc>, et al.) for your machine: C<perl -MConfig -e 'print $Config{cc}'> will tell you what -to use. +to use. You'll also have to choose the appropriate library directory (I</usr/local/lib/...>) for your machine. If your compiler complains @@ -132,7 +132,7 @@ Perhaps those printed by perl -MConfig -e 'print $Config{libs}' -Provided your perl binary was properly configured and installed the +Provided your perl binary was properly configured and installed the B<ExtUtils::Embed> module will determine all of this information for you: @@ -145,14 +145,14 @@ this documentation came from your Perl distribution, then you're running 5.004 or better and you already have it.) The B<ExtUtils::Embed> kit on CPAN also contains all source code for -the examples in this document, tests, additional examples and other +the examples in this document, tests, additional examples and other information you may find useful. =head2 Adding a Perl interpreter to your C program In a sense, perl (the C program) is a good example of embedding Perl (the language), so I'll demonstrate embedding with I<miniperlmain.c>, -from the source distribution. Here's a bastardized, non-portable +from the source distribution. Here's a bastardized, nonportable version of I<miniperlmain.c> containing the essentials of embedding: #include <EXTERN.h> /* from the Perl distribution */ @@ -200,7 +200,7 @@ calling I<perl_run()>. =head2 Calling a Perl subroutine from your C program To call individual Perl subroutines, you can use any of the B<perl_call_*> -functions documented in the L<perlcall> man page. +functions documented in the L<perlcall> manpage. In this example we'll use I<perl_call_argv>. That's shown below, in a program I'll call I<showtime.c>. @@ -493,7 +493,7 @@ which produces the output (again, long lines have been wrapped here) match: with substitute: s/[aeiou]//gi...139 substitutions made. - Now text is: Whn h s t cnvnnc str nd th bll cms t sm mnt lk 76 cnts, + Now text is: Whn h s t cnvnnc str nd th bll cms t sm mnt lk 76 cnts, Mynrd s wr tht thr s smthng h *shld* d, smthng tht wll nbl hm t gt bck qrtr, bt h hs n d *wht*. H fmbls thrgh hs rd sqzy chngprs nd gvs th by thr xtr pnns wth hs dllr, hpng tht h mght lck nt th crrct mnt. Th by gvs @@ -519,7 +519,7 @@ described in L<perlcall>. Once you've understood those, embedding Perl in C is easy. -Because C has no built-in function for integer exponentiation, let's +Because C has no builtin function for integer exponentiation, let's make Perl's ** operator available to it (this is less useful than it sounds, because Perl implements ** with C's I<pow()> function). First I'll create a stub exponentiation function in I<power.pl>: @@ -592,7 +592,7 @@ When developing interactive and/or potentially long-running applications, it's a good idea to maintain a persistent interpreter rather than allocating and constructing a new interpreter multiple times. The major reason is speed: since Perl will only be loaded into -memory once. +memory once. However, you have to be more cautious with namespace and variable scoping when using a persistent interpreter. In previous examples @@ -627,47 +627,47 @@ itself after a certain number of requests, to ensure that memory consumption is minimized. You'll also want to scope your variables with L<perlfunc/my> whenever possible. - + package Embed::Persistent; #persistent.pl - + use strict; use vars '%Cache'; - + sub valid_package_name { my($string) = @_; $string =~ s/([^A-Za-z0-9\/])/sprintf("_%2x",unpack("C",$1))/eg; # second pass only for words starting with a digit $string =~ s|/(\d)|sprintf("/_%2x",unpack("C",$1))|eg; - + # Dress it up as a real package name $string =~ s|/|::|g; return "Embed" . $string; } - + #borrowed from Safe.pm sub delete_package { my $pkg = shift; my ($stem, $leaf); - + no strict 'refs'; $pkg = "main::$pkg\::"; # expand to full symbol table name ($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/; - + my $stem_symtab = *{$stem}{HASH}; - + delete $stem_symtab->{$leaf}; } - + sub eval_file { my($filename, $delete) = @_; my $package = valid_package_name($filename); my $mtime = -M $filename; if(defined $Cache{$package}{mtime} && - $Cache{$package}{mtime} <= $mtime) + $Cache{$package}{mtime} <= $mtime) { - # we have compiled this subroutine already, + # we have compiled this subroutine already, # it has not been updated on disk, nothing left to do print STDERR "already compiled $package->handler\n"; } @@ -677,7 +677,7 @@ with L<perlfunc/my> whenever possible. local($/) = undef; my $sub = <FH>; close FH; - + #wrap the code into a subroutine inside our unique package my $eval = qq{package $package; sub handler { $sub; }}; { @@ -686,35 +686,35 @@ with L<perlfunc/my> whenever possible. eval $eval; } die $@ if $@; - + #cache it unless we're cleaning out each time $Cache{$package}{mtime} = $mtime unless $delete; } - + eval {$package->handler;}; die $@ if $@; - + delete_package($package) if $delete; - + #take a look if you want #print Devel::Symdump->rnew($package)->as_string, $/; } - + 1; - + __END__ /* persistent.c */ - #include <EXTERN.h> - #include <perl.h> - + #include <EXTERN.h> + #include <perl.h> + /* 1 = clean out filename's symbol table after each request, 0 = don't */ #ifndef DO_CLEAN #define DO_CLEAN 0 #endif - + static PerlInterpreter *perl = NULL; - + int main(int argc, char **argv, char **env) { @@ -722,41 +722,40 @@ with L<perlfunc/my> whenever possible. char *args[] = { "", DO_CLEAN, NULL }; char filename [1024]; int exitstatus = 0; - + if((perl = perl_alloc()) == NULL) { fprintf(stderr, "no memory!"); exit(1); } - perl_construct(perl); - + perl_construct(perl); + exitstatus = perl_parse(perl, NULL, 2, embedding, NULL); - - if(!exitstatus) { + + if(!exitstatus) { exitstatus = perl_run(perl); - + while(printf("Enter file name: ") && gets(filename)) { - + /* call the subroutine, passing it the filename as an argument */ args[0] = filename; - perl_call_argv("Embed::Persistent::eval_file", + perl_call_argv("Embed::Persistent::eval_file", G_DISCARD | G_EVAL, args); - + /* check $@ */ - if(SvTRUE(GvSV(errgv))) + if(SvTRUE(GvSV(errgv))) fprintf(stderr, "eval error: %s\n", SvPV(GvSV(errgv),na)); } } - + perl_destruct_level = 0; - perl_destruct(perl); - perl_free(perl); + perl_destruct(perl); + perl_free(perl); exit(exitstatus); } - Now compile: - % cc -o persistent persistent.c `perl -MExtUtils::Embed -e ccopts -e ldopts` + % cc -o persistent persistent.c `perl -MExtUtils::Embed -e ccopts -e ldopts` Here's a example script file: @@ -782,7 +781,7 @@ Now run: Some rare applications will need to create more than one interpreter during a session. Such an application might sporadically decide to -release any resources associated with the interpreter. +release any resources associated with the interpreter. The program must take care to ensure that this takes place I<before> the next interpreter is constructed. By default, the global variable @@ -791,22 +790,22 @@ needed when a program has only one interpreter. Setting C<perl_destruct_level> to C<1> makes everything squeaky clean: - perl_destruct_level = 1; + perl_destruct_level = 1; while(1) { ... /* reset global variables here with perl_destruct_level = 1 */ - perl_construct(my_perl); + perl_construct(my_perl); ... /* clean and reset _everything_ during perl_destruct */ - perl_destruct(my_perl); - perl_free(my_perl); + perl_destruct(my_perl); + perl_free(my_perl); ... /* let's go do it again! */ } -When I<perl_destruct()> is called, the interpreter's syntax parse tree -and symbol tables are cleaned up, and global variables are reset. +When I<perl_destruct()> is called, the interpreter's syntax parse tree +and symbol tables are cleaned up, and global variables are reset. Now suppose we have more than one interpreter instance running at the same time. This is feasible, but only if you used the @@ -826,9 +825,9 @@ Let's give it a try: int main(int argc, char **argv, char **env) { - PerlInterpreter + PerlInterpreter *one_perl = perl_alloc(), - *two_perl = perl_alloc(); + *two_perl = perl_alloc(); char *one_args[] = { "one_perl", SAY_HELLO }; char *two_args[] = { "two_perl", SAY_HELLO }; diff --git a/pod/perlfaq.pod b/pod/perlfaq.pod index 8cbb343e7b..99aeae953d 100644 --- a/pod/perlfaq.pod +++ b/pod/perlfaq.pod @@ -91,7 +91,7 @@ Perl Porters. Copyright (c) 1997 Tom Christiansen and Nathan Torkington. All rights reserved. -=head2 Non-commercial Reproduction +=head2 Noncommercial Reproduction Permission is granted to distribute this document, in part or in full, via electronic means or printed copy providing that (1) that all credits diff --git a/pod/perlfaq1.pod b/pod/perlfaq1.pod index ad7c68a124..5d45c819c5 100644 --- a/pod/perlfaq1.pod +++ b/pod/perlfaq1.pod @@ -168,7 +168,7 @@ notice that perl is not itself written in Perl. The new native-code compiler for Perl may reduce the limitations given in the previous statement to some degree, but understand that Perl remains fundamentally a dynamically typed language, and not a -statically typed one. You certainly won't be chastized if you don't +statically typed one. You certainly won't be chastised if you don't trust nuclear-plant or brain-surgery monitoring code to it. And Larry will sleep easier, too -- Wall Street programs not withstanding. :-) @@ -193,7 +193,7 @@ programs, however, are usually neither strictly compiled nor strictly interpreted. They can be compiled to a bytecode form (something of a Perl virtual machine) or to completely different languages, like C or assembly language. You can't tell just by looking whether the source is destined -for a pure interpreter, a parse-tree interpreter, a byte-code interpreter, +for a pure interpreter, a parse-tree interpreter, a byte code interpreter, or a native-code compiler, so it's hard to give a definitive answer here. =head2 What is a JAPH? diff --git a/pod/perlfaq2.pod b/pod/perlfaq2.pod index 7fa34d9c27..95d542d566 100644 --- a/pod/perlfaq2.pod +++ b/pod/perlfaq2.pod @@ -62,7 +62,7 @@ eventually live on, and then type C<make install>. Most other approaches are doomed to failure. One simple way to check that things are in the right place is to print out -the hard-coded @INC which perl is looking for. +the hardcoded @INC which perl is looking for. perl -e 'print join("\n",@INC)' @@ -76,7 +76,7 @@ module/library directory?">. =head2 I grabbed the sources and tried to compile but gdbm/dynamic loading/malloc/linking/... failed. How do I make it work? Read the F<INSTALL> file, which is part of the source distribution. -It describes in detail how to cope with most idiosyncracies that the +It describes in detail how to cope with most idiosyncrasies that the Configure script can't work around for any given system or architecture. @@ -84,7 +84,7 @@ architecture. CPAN stands for Comprehensive Perl Archive Network, a huge archive replicated on dozens of machines all over the world. CPAN contains -source code, non-native ports, documentation, scripts, and many +source code, nonnative ports, documentation, scripts, and many third-party modules and extensions, designed for everything from commercial database interfaces to keyboard/screen control to web walking and CGI scripts. The master machine for CPAN is @@ -191,7 +191,7 @@ before you buy! What follows is a list of the books that the FAQ authors found personally useful. Your mileage may (but, we hope, probably won't) vary. -If you're already a hard-core systems programmer, then the Camel Book +If you're already a hardcore systems programmer, then the Camel Book just might suffice for you to learn Perl from. But if you're not, check out the "Llama Book". It currently doesn't cover perl5, but the 2nd edition is nearly done and should be out by summer 97: @@ -279,7 +279,7 @@ There is a mailing list for discussing Macintosh Perl. Contact "mac-perl-request@iis.ee.ethz.ch". Also see Matthias Neeracher's (the creator and maintainer of MacPerl) -webpage at http://www.iis.ee.ethz.ch/~neeri/macintosh/perl.html for +web page at http://www.iis.ee.ethz.ch/~neeri/macintosh/perl.html for many links to interesting MacPerl sites, and the applications/MPW tools, precompiled. @@ -405,19 +405,19 @@ If you are reporting a bug in the perl interpreter or the modules shipped with perl, use the perlbug program in the perl distribution or email your report to perlbug@perl.com. -If you are posting a bug with a non-standard port (see the answer to +If you are posting a bug with a nonstandard port (see the answer to "What platforms is Perl available for?"), a binary distribution, or a -non-standard module (such as Tk, CGI, etc), then please see the +nonstandard module (such as Tk, CGI, etc), then please see the documentation that came with it to determine the correct place to post bugs. -Read the perlbug man page (perl5.004 or later) for more information. +Read the perlbug manpage (perl5.004 or later) for more information. =head2 What is perl.com? perl.org? The Perl Institute? perl.org is the official vehicle for The Perl Institute. The motto of TPI is "helping people help Perl help people" (or something like -that). It's a non-profit organization supporting development, +that). It's a nonprofit organization supporting development, documentation, and dissemination of perl. Current directors of TPI include Larry Wall, Tom Christiansen, and Randal Schwartz, whom you may have heard of somewhere else around here. @@ -425,8 +425,8 @@ may have heard of somewhere else around here. The perl.com domain is Tom Christiansen's domain. He created it as a public service long before perl.org came about. It's the original PBS of the Perl world, a clearinghouse for information about all things -Perlian, accepting no paid advertisements, glossy gifs, or (gasp!) -java applets on its pages. +Perlian, accepting no paid advertisements, glossy GIFs, or (gasp!) +Java applets on its pages. =head2 How do I learn about object-oriented Perl programming? diff --git a/pod/perlfaq3.pod b/pod/perlfaq3.pod index 64dec98234..af7e53b8fe 100644 --- a/pod/perlfaq3.pod +++ b/pod/perlfaq3.pod @@ -11,7 +11,7 @@ and programming support. Have you looked at CPAN (see L<perlfaq2>)? The chances are that someone has already written a module that can solve your problem. -Have you read the appropriate man pages? Here's a brief index: +Have you read the appropriate manpages? Here's a brief index: Objects perlref, perlmod, perlobj, perltie Data Structures perlref, perllol, perldsc @@ -22,12 +22,12 @@ Have you read the appropriate man pages? Here's a brief index: Various http://www.perl.com/CPAN/doc/FMTEYEWTK/index.html (not a man-page but still useful) -L<perltoc> provides a crude table of contents for the perl man page set. +L<perltoc> provides a crude table of contents for the perl manpage set. =head2 How can I use Perl interactively? The typical approach uses the Perl debugger, described in the -perldebug(1) man page, on an "empty" program, like this: +perldebug(1) manpage, on an "empty" program, like this: perl -de 42 @@ -200,7 +200,7 @@ structure. If you're working with specialist data structures less memory than equivalent Perl modules. Another thing to try is learning whether your Perl was compiled with -the system malloc or with Perl's built-in malloc. Whichever one it +the system malloc or with Perl's builtin malloc. Whichever one it is, try using the other one and see whether this makes a difference. Information about malloc is in the F<INSTALL> file in the source distribution. You can find out whether you are using perl's malloc by @@ -235,7 +235,7 @@ use in other parts of your program. (NB: my() variables also execute about 10% faster than globals.) A global variable, of course, never goes out of scope, so you can't get its space automatically reclaimed, although undef()ing and/or delete()ing it will achieve the same effect. -In general, memory allocation and de-allocation isn't something you can +In general, memory allocation and deallocation isn't something you can or should be worrying about much in Perl, but even this capability (preallocation of data types) is in the works. @@ -244,15 +244,15 @@ or should be worrying about much in Perl, but even this capability Beyond the normal measures described to make general Perl programs faster or smaller, a CGI program has additional issues. It may be run several times per second. Given that each time it runs it will need -to be re-compiled and will often allocate a megabyte or more of system +to be recompiled and will often allocate a megabyte or more of system memory, this can be a killer. Compiling into C B<isn't going to help -you> because the process start-up overhead is where the bottleneck is. +you> because the process startup overhead is where the bottleneck is. There are at least two popular ways to avoid this overhead. One solution involves running the Apache HTTP server (available from http://www.apache.org/) with either of the mod_perl or mod_fastcgi plugin modules. With mod_perl and the Apache::* modules (from CPAN), -httpd will run with an embedded Perl interpreter which pre-compiles +httpd will run with an embedded Perl interpreter which precompiles your script and then executes it within the same address space without forking. The Apache extension also gives Perl access to the internal server API, so modules written in Perl can do just about anything a @@ -286,8 +286,8 @@ 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 +byte code compiler and interpreter described below, but crackers might +be able to decompile 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 @@ -301,12 +301,12 @@ Your access to it does not give you permission to use it blah blah blah." We are not lawyers, of course, so you should see a lawyer if you want to be sure your licence's wording will stand up in court. -=head2 How can I compile my Perl program into byte-code or C? +=head2 How can I compile my Perl program into byte code or C? Malcolm Beattie has written a multifunction backend compiler, available from CPAN, that can do both these things. It is as of Feb-1997 in late alpha release, which means it's fun to play with if -you're a programmer but not really for people looking for turn-key +you're a programmer but not really for people looking for turnkey solutions. I<Please> understand that merely compiling into C does not in and of @@ -334,14 +334,14 @@ you link your main perl binary with this, it will make it miniscule. For example, on one author's system, /usr/bin/perl is only 11k in size! -=head2 How can I get '#!perl' to work on [MSDOS,NT,...]? +=head2 How can I get '#!perl' to work on [MS-DOS,Windows NT,...]? For OS/2 just use 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). For DOS one should first invent a corresponding +`extproc' handling). For MS-DOS one should first invent a corresponding batch file, and codify it in C<ALTERNATIVE_SHEBANG> (see the F<INSTALL> file in the source distribution for more information). @@ -385,7 +385,7 @@ Yes. Read L<perlrun> for more information. Some examples follow. Ok, the last one was actually an obfuscated perl entry. :-) -=head2 Why don't perl one-liners work on my DOS/Mac/VMS system? +=head2 Why don't perl one-liners work on my MS-DOS/Macintosh/VMS system? The problem is usually that the command interpreters on those systems have rather different ideas about quoting than the Unix shells under @@ -398,10 +398,10 @@ For example: # Unix perl -e 'print "Hello world\n"' - # DOS, etc. + # MS-DOS, etc. perl -e "print \"Hello world\n\"" - # Mac + # Macintosh print "Hello world\n" (then Run "Myscript" or Shift-Command-R) @@ -409,15 +409,15 @@ For example: perl -e "print ""Hello world\n""" The problem is that none of this is reliable: it depends on the command -interpreter. Under Unix, the first two often work. Under DOS, it's +interpreter. Under Unix, the first two often work. Under MS-DOS, it's entirely possible neither works. If 4DOS was the command shell, I'd probably have better luck like this: perl -e "print <Ctrl-x>"Hello world\n<Ctrl-x>"" -Under the Mac, it depends which environment you are using. The MacPerl +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 Mac's non-ASCII +quoting variants, except that it makes free use of the Macintosh's non-ASCII characters as control characters. I'm afraid that there is no general solution to all of this. It is a @@ -470,7 +470,7 @@ my C program, what am I doing wrong? Download the ExtUtils::Embed kit from CPAN and run `make test'. If the tests pass, read the pods again and again and again. If they -fail, see L<perlbug> and send a bugreport with the output of +fail, see L<perlbug> and send a bug report with the output of C<make test TEST_VERBOSE=1> along with C<perl -V>. =head2 When I tried to run my script, I got this message. What does it diff --git a/pod/perlfaq4.pod b/pod/perlfaq4.pod index 34b7e5b0f3..d3a7e8ccb9 100644 --- a/pod/perlfaq4.pod +++ b/pod/perlfaq4.pod @@ -271,7 +271,7 @@ C<tr///> function like so: $string = "ThisXlineXhasXsomeXx'sXinXit": $count = ($string =~ tr/X//); - print "There are $count X charcters in the string"; + print "There are $count X characters in the string"; This is fine if you are just looking for a single character. However, if you are trying to count multiple character substrings within a @@ -900,7 +900,7 @@ they end up doing is not what they do with ordinary hashes. Using C<keys %hash> in a scalar context returns the number of keys in the hash I<and> resets the iterator associated with the hash. You may need to do this if you use C<last> to exit a loop early so that when you -re-enter it, the hash iterator has been reset. +reenter it, the hash iterator has been reset. =head2 How can I get the unique keys from two hashes? @@ -955,7 +955,7 @@ Normally, merely accessing a key's value for a nonexistent key does I<not> cause that key to be forever there. This is different than awk's behavior. -=head2 How can I make the Perl equivalent of a C structure/C++ class/hash +=head2 How can I make the Perl equivalent of a C structure/C++ class/hash or array of hashes or arrays? Use references (documented in L<perlref>). Examples of complex data @@ -983,7 +983,7 @@ versus "binary" files. See L<perlfunc/"binmode">. If you're concerned about 8-bit ASCII data, then see L<perllocale>. -If you want to deal with multi-byte characters, however, there are +If you want to deal with multibyte characters, however, there are some gotchas. See the section on Regular Expressions. =head2 How do I determine whether a scalar is a number/whole/integer/float? @@ -994,7 +994,7 @@ Assuming that you don't care about IEEE notations like "NaN" or warn "has nondigits" if /\D/; warn "not a whole number" unless /^\d+$/; warn "not an integer" unless /^-?\d+$/; # reject +3 - warn "not an integer" unless /^[+-]?\d+$/; + warn "not an integer" unless /^[+-]?\d+$/; warn "not a decimal number" unless /^-?\d+\.?\d*$/; # rejects .2 warn "not a decimal number" unless /^-?(?:\d+(?:\.\d*)?|\.\d+)$/; warn "not a C float" diff --git a/pod/perlfaq5.pod b/pod/perlfaq5.pod index 9c5e842793..47c6dead22 100644 --- a/pod/perlfaq5.pod +++ b/pod/perlfaq5.pod @@ -106,7 +106,7 @@ the changes you want, then copy that over the original. rename($new, $old) or die "can't rename $new to $old: $!"; Perl can do this sort of thing for you automatically with the C<-i> -command-line switch or the closely-related C<$^I> variable (see +command line switch or the closely-related C<$^I> variable (see L<perlrun> for more details). Note that C<-i> may require a suffix on some non-Unix systems; see the platform-specific documentation that came with your port. @@ -138,7 +138,7 @@ the last line of a file without making a copy or reading the whole file into memory: open (FH, "+< $file"); - while ( <FH> ) { $addr = tell(FH) unless eof(FH) } + while ( <FH> ) { $addr = tell(FH) unless eof(FH) } truncate(FH, $addr); Error checking is left as an exercise for the reader. @@ -233,7 +233,7 @@ one of its more specific derived classes. =head2 How can I set up a footer format to be used with write()? -There's no built-in way to do this, but L<perlform> has a couple of +There's no builtin way to do this, but L<perlform> has a couple of techniques to make it possible for the intrepid hacker. =head2 How can I write() into a string? @@ -358,7 +358,7 @@ permissions, timestamps, inode info, etc. =head2 How can I lock a file? -Perl's built-in flock() function (see L<perlfunc> for details) will call +Perl's builtin flock() function (see L<perlfunc> for details) will call flock(2) if that exists, fcntl(2) if it doesn't (on perl version 5.004 and later), and lockf(3) if neither of the two previous system calls exists. On some systems, it may even use a different form of native locking. @@ -409,10 +409,10 @@ over NFS, so this won't work (at least, not every time) over the net. Various schemes involving involving link() have been suggested, but these tend to involve busy-wait, which is also subdesirable. -=head2 I still don't get locking. I just want to increment the number +=head2 I still don't get locking. I just want to increment the number in the file. How can I do this? -Didn't anyone ever tell you web-page hit counters were useless? +Didn't anyone ever tell you web page hit counters were useless? Anyway, this is what to do: @@ -426,7 +426,7 @@ Anyway, this is what to do: # DO NOT UNLOCK THIS UNTIL YOU CLOSE close FH or die "can't close numfile: $!"; -Here's a much better web-page hit counter: +Here's a much better web page hit counter: $hits = int( (time() - 850_000_000) / rand(1_000) ); @@ -455,14 +455,14 @@ like this: Locking and error checking are left as an exercise for the reader. Don't forget them, or you'll be quite sorry. -Don't forget to set binmode() under DOS-like platforms when operating +Don't forget to set binmode() under MS-DOS-like platforms when operating on files that have anything other than straight text in them. See the docs on open() and on binmode() for more details. =head2 How do I get a file's timestamp in perl? If you want to retrieve the time at which the file was last read, -written, or had its meta-data (owner, etc) changed, you use the B<-M>, +written, or had its metadata (owner, etc) changed, you use the B<-M>, B<-A>, or B<-C> filetest operations as documented in L<perlfunc>. These retrieve the age of the file (measured against the start-time of your program) in days as a floating point number. To retrieve the "raw" @@ -602,7 +602,7 @@ The Term::ReadKey module from CPAN may be easier to use: printf "\nYou said %s, char number %03d\n", $key, ord $key; -For DOS systems, Dan Carson <dbc@tc.fluke.COM> reports the following: +For MS-DOS systems, Dan Carson <dbc@tc.fluke.COM> reports the following: To put the PC in "raw" mode, use ioctl with some magic numbers gleaned from msdos.c (Perl source file) and Ralf Brown's interrupt list (comes @@ -737,17 +737,17 @@ to, you may be able to do this: $rc = syscall(&SYS_close, $fd + 0); # must force numeric die "can't sysclose $fd: $!" unless $rc == -1; -=head2 Why can't I use "C:\temp\foo" in DOS paths? What doesn't `C:\temp\foo.exe` work? +=head2 Why can't I use "C:\temp\foo" in MS-DOS paths? What doesn't `C:\temp\foo.exe` work? Whoops! You just put a tab and a formfeed into that filename! Remember that within double quoted strings ("like\this"), the backslash is an escape character. The full list of these is in L<perlop/Quote and Quote-like Operators>. Unsurprisingly, you don't have a file called "c:(tab)emp(formfeed)oo" or -"c:(tab)emp(formfeed)oo.exe" on your DOS filesystem. +"c:(tab)emp(formfeed)oo.exe" on your MS-DOS filesystem. Either single-quote your strings, or (preferably) use forward slashes. -Since all DOS and Windows versions since something like MS-DOS 2.0 or so +Since all MS-DOS and Windows versions since something like MS-DOS 2.0 or so have treated C</> and C<\> the same in a path, you might as well use the one that doesn't clash with Perl -- or the POSIX shell, ANSI C and C++, awk, Tcl, Java, or Python, just to mention a few. @@ -755,7 +755,7 @@ awk, Tcl, Java, or Python, just to mention a few. =head2 Why doesn't glob("*.*") get all the files? Because even on non-Unix ports, Perl's glob function follows standard -Unix globbing semantics. You'll need C<glob("*")> to get all (non-hidden) +Unix globbing semantics. You'll need C<glob("*")> to get all (nonhidden) files. =head2 Why does Perl let me delete read-only files? Why does C<-i> clobber protected files? Isn't this a bug in Perl? diff --git a/pod/perlfaq6.pod b/pod/perlfaq6.pod index 0adebd72fe..1cec15c669 100644 --- a/pod/perlfaq6.pod +++ b/pod/perlfaq6.pod @@ -11,7 +11,7 @@ with regular expressions, but those answers are found elsewhere in this document (in the section on Data and the Networking one on networking, to be precise). -=head2 How can I hope to use regular expressions without creating illegible and unmaintainable code? +=head2 How can I hope to use regular expressions without creating illegible and unmaintainable code? Three techniques can make regular expressions maintainable and understandable. @@ -96,8 +96,8 @@ record read in. while ( <> ) { while ( /\b(\w\S+)(\s+\1)+\b/gi ) { print "Duplicate $1 at paragraph $.\n"; - } - } + } + } Here's code that finds sentences that begin with "From " (which would be mangled by many mailers): @@ -138,7 +138,7 @@ on matching balanced text. $/ must be a string, not a regular expression. Awk has to be better for something. :-) -Actually, you could do this if you don't mind reading the whole file into +Actually, you could do this if you don't mind reading the whole file into undef $/; @records = split /your_pattern/, <FH>; @@ -217,10 +217,10 @@ See L<perllocale>. =head2 How can I match a locale-smart version of C</[a-zA-Z]/>? One alphabetic character would be C</[^\W\d_]/>, no matter what locale -you're in. Non-alphabetics would be C</[\W\d_]/> (assuming you don't +you're in. Non-alphabetics would be C</[\W\d_]/> (assuming you don't consider an underscore a letter). -=head2 How can I quote a variable to use in a regexp? +=head2 How can I quote a variable to use in a regexp? The Perl parser will expand $variable and @variable references in regular expressions unless the delimiter is a single quote. Remember, @@ -240,7 +240,7 @@ Without the \Q, the regexp would also spuriously match "di". =head2 What is C</o> really for? -Using a variable in a regular expression match forces a re-evaluation +Using a variable in a regular expression match forces a reevaluation (and perhaps recompilation) each time through. The C</o> modifier locks in the regexp the first time it's used. This always happens in a constant regular expression, and in fact, the pattern was compiled @@ -325,13 +325,13 @@ playing hot potato. Use the split function: while (<>) { - foreach $word ( split ) { + foreach $word ( split ) { # do something with $word here - } - } + } + } -Note that this isn't really a word in the English sense; it's just -chunks of consecutive non-whitespace characters. +Note that this isn't really a word in the English sense; it's just +chunks of consecutive non-whitespace characters. To work with only alphanumeric sequences, you might consider @@ -344,25 +344,25 @@ To work with only alphanumeric sequences, you might consider =head2 How can I print out a word-frequency or line-frequency summary? To do this, you have to parse out each word in the input stream. We'll -pretend that by word you mean chunk of alphabetics, hyphens, or -apostrophes, rather than the non-whitespace chunk idea of a word given +pretend that by word you mean chunk of alphabetics, hyphens, or +apostrophes, rather than the non-whitespace chunk idea of a word given in the previous question: while (<>) { while ( /(\b[^\W_\d][\w'-]+\b)/g ) { # misses "`sheep'" $seen{$1}++; - } - } + } + } while ( ($word, $count) = each %seen ) { print "$count $word\n"; - } + } If you wanted to do the same thing for lines, you wouldn't need a regular expression: - while (<>) { + while (<>) { $seen{$_}++; - } + } while ( ($line, $count) = each %seen ) { print "$count $line"; } @@ -495,7 +495,7 @@ Of course, that could have been written as while (<>) { chomp; PARSER: { - if ( /\G( \d+\b )/gx { + if ( /\G( \d+\b )/gx { print "number: $1\n"; redo PARSER; } @@ -520,7 +520,7 @@ But then you lose the vertical alignment of the regular expressions. While it's true that Perl's regular expressions resemble the DFAs (deterministic finite automata) of the egrep(1) program, they are in -fact implemented as NFAs (non-deterministic finite automata) to allow +fact implemented as NFAs (nondeterministic finite automata) to allow backtracking and backreferencing. And they aren't POSIX-style either, because those guarantee worst-case behavior for all cases. (It seems that some people prefer guarantees of consistency, even when what's @@ -538,7 +538,7 @@ side-effects, and side-effects can be mystifying. There's no void grep() that's not better written as a C<for> (well, C<foreach>, technically) loop. -=head2 How can I match strings with multi-byte characters? +=head2 How can I match strings with multibyte characters? This is hard, and there's no good way. Perl does not directly support wide characters. It pretends that a byte and a character are @@ -578,7 +578,7 @@ Or like this: Or like this: while ($martian =~ m/\G([A-Z][A-Z]|.)/gs) { # \G probably unneeded - print "found GX!\n", last if $1 eq 'GX'; + print "found GX!\n", last if $1 eq 'GX'; } Or like this: @@ -586,11 +586,11 @@ Or like this: die "sorry, Perl doesn't (yet) have Martian support )-:\n"; In addition, a sample program which converts half-width to full-width -katakana (in Shift-JIS or EUC encoding) is available from CPAN as +katakana (in Shift-JIS or EUC encoding) is available from CPAN as =for Tom make it so -There are many double- (and multi-) byte encodings commonly used these +There are many double (and multi) byte encodings commonly used these days. Some versions of these have 1-, 2-, 3-, and 4-byte characters, all mixed. diff --git a/pod/perlfaq7.pod b/pod/perlfaq7.pod index 54380e62a4..c272c91e31 100644 --- a/pod/perlfaq7.pod +++ b/pod/perlfaq7.pod @@ -532,7 +532,7 @@ issue is the same here: my($foo) = <FILE>; # WRONG my $foo = <FILE>; # right -=head2 How do I redefine a built-in function, operator, or method? +=head2 How do I redefine a builtin function, operator, or method? Why do you want to do that? :-) @@ -576,7 +576,7 @@ how best to do this, so he left it out, even though it's been on the wish list since perl1. Here's a simple example of a switch based on pattern matching. We'll -do a multi-way conditional based on the type of reference stored in +do a multiway conditional based on the type of reference stored in $whatchamacallit: SWITCH: diff --git a/pod/perlfaq8.pod b/pod/perlfaq8.pod index 7250afbca5..bc8412bf6f 100644 --- a/pod/perlfaq8.pod +++ b/pod/perlfaq8.pod @@ -104,7 +104,7 @@ give the numeric values you want directly, using octal ("\015"), hex Even though with normal text files, a "\n" will do the trick, there is still no unified scheme for terminating a line that is portable -between Unix, DOS/Win, and Macintosh, except to terminate I<ALL> line +between Unix, MS-DOS/Windows, and Macintosh, except to terminate I<ALL> line ends with "\015\012", and strip what you don't need from the output. This applies especially to socket I/O and autoflushing, discussed next. @@ -208,7 +208,7 @@ You don't actually "trap" a control character. Instead, that character generates a signal, which you then trap. Signals are documented in L<perlipc/"Signals"> and chapter 6 of the Camel. -Be warned that very few C libraries are re-entrant. Therefore, if you +Be warned that very few C libraries are reentrant. Therefore, if you attempt to print() in a handler that got invoked during another stdio operation your internal structures will likely be in an inconsistent state, and your program will dump core. You can @@ -230,7 +230,7 @@ For example: However, because syscalls restart by default, you'll find that if you're in a "slow" call, such as E<lt>FHE<gt>, read(), connect(), or wait(), that the only way to terminate them is by "longjumping" out; -that is, by raising an exception. See the time-out handler for a +that is, by raising an exception. See the timeout handler for a blocking flock() in L<perlipc/"Signals"> or chapter 6 of the Camel. =head2 How do I modify the shadow password file on a Unix system? @@ -267,7 +267,7 @@ http://www.perl.com/CPAN/doc/misc/ancient/tutorial/eg/itimers.pl . =head2 How can I measure time under a second? In general, you may not be able to. The Time::HiRes module (available -from CPAN) provides this functionality for some systems. +from CPAN) provides this functionality for some systems. In general, you may not be able to. But if you system supports both the syscall() function in Perl as well as a system call like gettimeofday(2), @@ -311,7 +311,7 @@ END blocks you should also use Perl's exception-handling mechanism is its eval() operator. You can use eval() as setjmp and die() as longjmp. For details of this, see -the section on signals, especially the time-out handler for a blocking +the section on signals, especially the timeout handler for a blocking flock() in L<perlipc/"Signals"> and chapter 6 of the Camel. If exception handling is all you're interested in, try the @@ -352,7 +352,7 @@ Simple files like F<errno.h>, F<syscall.h>, and F<socket.h> were fine, but the hard ones like F<ioctl.h> nearly always need to hand-edited. Here's how to install the *.ph files: - 1. become super-user + 1. become superuser 2. cd /usr/include 3. h2ph *.h */*.h @@ -513,7 +513,7 @@ You have to do this: Just as with system(), no shell escapes happen when you exec() a list. -=head2 Why can't my script read from STDIN after I gave it EOF (^D on Unix, ^Z on MSDOS)? +=head2 Why can't my script read from STDIN after I gave it EOF (^D on Unix, ^Z on MS-DOS)? Because some stdio's set error and eof flags that need clearing. The POSIX module defines clearerr() that you can use. That is the @@ -552,7 +552,7 @@ Things that are awkward to do in the shell are easy to do in Perl, and this very awkwardness is what would make a shell->perl converter nigh-on impossible to write. By rewriting it, you'll think about what you're really trying to do, and hopefully will escape the shell's -pipeline datastream paradigm, which while convenient for some matters, +pipeline data stream paradigm, which while convenient for some matters, causes many inefficiencies. =head2 Can I use perl to run a telnet or ftp session? diff --git a/pod/perlfaq9.pod b/pod/perlfaq9.pod index 2c9a3e063b..9e6355f816 100644 --- a/pod/perlfaq9.pod +++ b/pod/perlfaq9.pod @@ -51,7 +51,7 @@ http://www.perl.com/CPAN/authors/Tom_Christiansen/scripts/striphtml.gz =head2 How do I extract URLs? -A quick but imperfect approach is +A quick but imperfect approach is #!/usr/bin/perl -n00 # qxurl - tchrist@perl.com @@ -127,7 +127,7 @@ server, or perhaps check some of the other FAQs referenced above. 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 +stored. Databases may be text, dbm, Berkeley 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: @@ -224,8 +224,8 @@ Again, the best way is often just to ask the user. =head2 How do I send/read mail? Sending mail: the Mail::Mailer module from CPAN (part of the MailTools -package) is UNIX-centric, while Mail::Internet uses Net::SMTP which is -not UNIX-centric. Reading mail: use the Mail::Folder module from CPAN +package) is Unix-centric, while Mail::Internet uses Net::SMTP which is +not Unix-centric. Reading mail: use the Mail::Folder module from CPAN (part of the MailFolder package) or the Mail::Internet module from CPAN (also part of the MailTools package). diff --git a/pod/perlform.pod b/pod/perlform.pod index 4e55e02800..75351b6934 100644 --- a/pod/perlform.pod +++ b/pod/perlform.pod @@ -5,20 +5,20 @@ 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 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<perlfunc>. 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 +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<perlfunc>. 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 name "STDOUT", and the default format for filehandle TEMP is name "TEMP". They just look the same. They aren't. @@ -30,7 +30,7 @@ Output record formats are declared as follows: . If name is omitted, format "STDOUT" is defined. FORMLIST consists of -a sequence of lines, each of which may be of one of three types: +a sequence of lines, each of which may be one of three types: =over 4 @@ -53,7 +53,7 @@ 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 +to do rudimentary multiline text block filling. The length of the field is supplied by padding out the field with multiple "E<lt>", "E<gt>", or "|" characters to specify, respectively, left justification, right justification, or centering. If the variable would exceed the width @@ -63,8 +63,8 @@ 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, -non-truncated values; it should appear by itself on a line. +Finally, the special field "@*" can be used for printing multiline, +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 @@ -105,7 +105,7 @@ 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 +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<perlfunc/write>. @@ -169,7 +169,7 @@ 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), + select((select(OUTF), $~ = "My_Other_Format", $^ = "My_Top_Format" )[0]); @@ -205,25 +205,25 @@ Much better! =head1 NOTES -Because the values line may contain arbitrary expressions (for at fields, +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 = + format Ident = @<<<<<<<<<<<<<<< &commify($n) . To get a real at or caret into the field, do this: - format Ident = + format Ident = I have an @ here. "@" . To center a whole line of text, do something like this: - format Ident = + format Ident = @||||||||||||||||||||||||||||||||||||||||||||||| "Some text line" . @@ -240,12 +240,12 @@ on the current number of columns, and then eval() it: . '$entry' . "\n"; . ".\n"; print $format if $Debugging; - eval $format; + eval $format; die $@ if $@; Which would generate a format looking something like this: - format STDOUT = + format STDOUT = ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< $entry ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~ @@ -254,7 +254,7 @@ Which would generate a format looking something like this: Here's a little program that's somewhat like fmt(1): - format = + format = ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~ $_ @@ -264,7 +264,7 @@ Here's a little program that's somewhat like fmt(1): while (<>) { s/\s*\n\s*/ /g; write; - } + } =head2 Footers @@ -277,10 +277,10 @@ 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<open(MESELF, "|-")> -(see L<perlfunc/open()>) and always write() to MESELF instead of -STDOUT. Have your child process massage its STDIN to rearrange -headers and footers however you like. Not very convenient, but doable. +Here's another strategy: Open a pipe to yourself, using C<open(MYSELF, "|-")> +(see L<perlfunc/open()>) 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 @@ -305,7 +305,7 @@ is to printf(), do this: $^A = ""; formline($format,@_); return $^A; - } + } $string = swrite(<<'END', 1, 2, 3); Check me out diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index c4de4a39ae..25c684af2e 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -48,7 +48,7 @@ example, the third line above produces: Useless use of integer addition in void context at - line 1. For functions that can be used in either a scalar or list context, -non-abortive failure is generally indicated in a scalar context by +nonabortive failure is generally indicated in a scalar context by returning the undefined value, and in a list context by returning the null list. @@ -126,7 +126,7 @@ stat, symlink, umask, unlink, utime caller, continue, die, do, dump, eval, exit, goto, last, next, redo, return, sub, wantarray -=item Keywords related to scoping +=item Keywords related to scoping caller, import, local, my, package, use @@ -225,7 +225,7 @@ operator may be any of: -e File exists. -z File has zero size. - -s File has non-zero size (returns size). + -s File has nonzero size (returns size). -f File is a plain file. -d File is a directory. @@ -275,7 +275,7 @@ are found, it's a C<-B> file, otherwise it's a C<-T> file. Also, any file containing null in the first block is considered a binary file. If C<-T> or C<-B> is used on a filehandle, the current stdio buffer is examined rather than the first block. Both C<-T> and C<-B> return TRUE on a null -file, or a file at EOF when testing a filehandle. Because you have to +file, or a file at EOF when testing a filehandle. Because you have to read a file to do the C<-T> test, on most occasions you want to use a C<-f> against the file first, as in C<next unless -f $file && -T $file>. @@ -300,7 +300,7 @@ symbolic link, not the real file.) Example: =item abs VALUE -=item abs +=item abs Returns the absolute value of its argument. If VALUE is omitted, uses $_. @@ -313,7 +313,7 @@ See example in L<perlipc/"Sockets: Client/Server Communication">. =item alarm SECONDS -=item alarm +=item alarm Arranges to have a SIGALRM delivered to this process after the specified number of seconds have elapsed. If SECONDS is not specified, @@ -326,8 +326,8 @@ starting a new one. The returned value is the amount of time remaining on the previous timer. For delays of finer granularity than one second, you may use Perl's -syscall() interface to access setitimer(2) if your system supports it, -or else see L</select()> below. It is not advised to intermix alarm() +syscall() interface to access setitimer(2) if your system supports it, +or else see L</select()>. It is usually a mistake to intermix alarm() and sleep() calls. If you want to use alarm() to time out a system call you need to use an @@ -370,9 +370,9 @@ L<perlipc/"Sockets: Client/Server Communication">. Arranges for the file to be read or written in "binary" mode in operating systems that distinguish between binary and text files. Files that are not in binary mode have CR LF sequences translated to LF on input and LF -translated to CR LF on output. Binmode has no effect under Unix; in DOS +translated to CR LF on output. Binmode has no effect under Unix; in MS-DOS and similarly archaic systems, it may be imperative--otherwise your -DOS-damaged C library may mangle your file. The key distinction between +MS-DOS-damaged C library may mangle your file. The key distinction between systems that need binmode and those that don't is their text file formats. Systems like Unix and Plan9 that delimit lines with a single character, and that encode that character in C as '\n', do not need @@ -406,7 +406,7 @@ With EXPR, it returns some extra information that the debugger uses to print a stack trace. The value of EXPR indicates how many call frames to go back before the current one. - ($package, $filename, $line, $subroutine, + ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require) = caller($i); Here $subroutine may be C<"(eval)"> if the frame is not a subroutine @@ -420,7 +420,7 @@ an C<L<eval EXPR>>) frame. Furthermore, when called from within the DB package, caller returns more detailed information: it sets the list variable @DB::args to be the -arguments with which that subroutine was invoked. +arguments with which the subroutine was invoked. =item chdir EXPR @@ -509,7 +509,7 @@ Returns the number of files successfully changed. $cnt = chown $uid, $gid, 'foo', 'bar'; chown $uid, $gid, @filenames; -Here's an example that looks up non-numeric uids in the passwd file: +Here's an example that looks up nonnumeric uids in the passwd file: print "User: "; chop($user = <STDIN>); @@ -522,14 +522,14 @@ Here's an example that looks up non-numeric uids in the passwd file: @ary = <${pattern}>; # expand filenames chown $uid, $gid, @ary; -On most systems, you are not allowed to change the ownership of the +On most systems, you are not allowed to change the ownership of the file unless you're the superuser, although you should be able to change the group to any of your secondary groups. On insecure systems, these restrictions may be relaxed, but this is not a portable assumption. =item chr NUMBER -=item chr +=item chr Returns the character represented by that NUMBER in the character set. For example, C<chr(65)> is "A" in ASCII. For the reverse, use L<ord>. @@ -538,7 +538,7 @@ If NUMBER is omitted, uses $_. =item chroot FILENAME -=item chroot +=item chroot This function works as the system call by the same name: it makes the named directory the new root directory for all further pathnames that @@ -627,9 +627,9 @@ their own password: die "Sorry...\n"; } else { print "ok\n"; - } + } -Of course, typing in your own password to whomever asks you +Of course, typing in your own password to whomever asks you for it is unwise. =item dbmclose HASH @@ -675,7 +675,7 @@ rich implementation. =item defined EXPR -=item defined +=item defined Returns a Boolean value telling whether EXPR has a value other than the undefined value C<undef>. If EXPR is not present, C<$_> will be @@ -738,7 +738,7 @@ them as not defined anymore, but you shoudln't do that unless you don't plan to use them again, because it saves time when you load them up again to have memory already ready to be filled. -This counter-intuitive behaviour of defined() on aggregates may be +This counterintuitive behaviour of defined() on aggregates may be changed, fixed, or broken in a future release of Perl. See also L<undef>, L<exists>, L<ref>. @@ -773,7 +773,7 @@ hash element lookup or hash slice: Outside of an eval(), prints the value of LIST to C<STDERR> and exits with the current value of C<$!> (errno). If C<$!> is 0, exits with the value of -C<($? E<gt>E<gt> 8)> (back-tick `command` status). If C<($? E<gt>E<gt> 8)> +C<($? E<gt>E<gt> 8)> (backtick `command` status). If C<($? E<gt>E<gt> 8)> is 0, exits with 255. Inside an eval(), the error message is stuffed into C<$@>, and the eval() is terminated with the undefined value; this makes die() the way to raise an exception. @@ -781,7 +781,7 @@ die() the way to raise an exception. Equivalent examples: die "Can't cd to spool: $!\n" unless chdir '/usr/spool/news'; - chdir '/usr/spool/news' or die "Can't cd to spool: $!\n" + chdir '/usr/spool/news' or die "Can't cd to spool: $!\n" If the value of EXPR does not end in a newline, the current script line number and input line number (if any) are also printed, and a newline @@ -832,7 +832,7 @@ except that it's more efficient, more concise, keeps track of the current filename for error messages, and searches all the B<-I> libraries if the file isn't in the current directory (see also the @INC array in L<perlvar/Predefined Names>). It's the same, however, in that it does -re-parse the file every time you call it, so you probably don't want to +reparse the file every time you call it, so you probably don't want to do this inside a loop. Note that inclusion of library modules is better done with the @@ -938,7 +938,7 @@ I<EACH> file in a while (E<lt>E<gt>) loop. Examples: } Practical hint: you almost never need to use C<eof> in Perl, because the -input operators return undef when they run out of data. +input operators return undef when they run out of data. =item eval EXPR @@ -971,7 +971,7 @@ form to trap run-time errors without incurring the penalty of recompiling each time. The error, if any, is still returned in C<$@>. Examples: - # make divide-by-zero non-fatal + # make divide-by-zero nonfatal eval { $answer = $a / $b; }; warn $@ if $@; # same thing, but less efficient @@ -1001,7 +1001,7 @@ die() again, which has the effect of changing their error messages: print $@ if $@; # prints "bar barfs here" } -With an eval(), you should be especially careful to remember what's +With an eval(), you should be especially careful to remember what's being looked at when: eval $x; # CASE 1 @@ -1020,7 +1020,7 @@ and 4 likewise behave in the same way: they run the code '$x', which does nothing but return the value of C<$x>. (Case 4 is preferred for purely visual reasons, but it also has the advantage of compiling at compile-time instead of at run-time.) Case 5 is a place where -normally you I<WOULD> like to use double quotes, except that in that +normally you I<WOULD> like to use double quotes, except that in this particular situation, you can just use symbolic references instead, as in case 6. @@ -1047,7 +1047,7 @@ If you don't really want to execute the first argument, but want to lie to the program you are executing about its own name, you can specify the program you actually want to run as an "indirect object" (without a comma) in front of the LIST. (This always forces interpretation of the -LIST as a multi-valued list, even if there is only a single scalar in +LIST as a multivalued list, even if there is only a single scalar in the list.) Example: $shell = '/bin/csh'; @@ -1085,7 +1085,7 @@ are called before exit.) Example: exit 0 if $ans =~ /^[Xx]/; See also die(). If EXPR is omitted, exits with 0 status. The only -univerally portable values for EXPR are 0 for success and 1 for error; +universally portable values for EXPR are 0 for success and 1 for error; all other values are subject to unpredictable interpretation depending on the environment in which the Perl program is running. @@ -1095,9 +1095,9 @@ which can be trapped by an eval(). =item exp EXPR -=item exp +=item exp -Returns I<e> (the natural logarithm base) to the power of EXPR. +Returns I<e> (the natural logarithm base) to the power of EXPR. If EXPR is omitted, gives C<exp($_)>. =item fcntl FILEHANDLE,FUNCTION,SCALAR @@ -1190,7 +1190,7 @@ zombies: $SIG{CHLD} = sub { wait }; -There's also the double-fork trick (error checking on +There's also the double-fork trick (error checking on fork() returns omitted); unless ($pid = fork) { @@ -1218,7 +1218,7 @@ you're done. You should reopen those to /dev/null if it's any issue. Declare a picture format with use by the write() function. For example: - format Something = + format Something = Test: @<<<<<<<< @||||| @>>>>> $str, $%, '$' . int($num) . @@ -1263,7 +1263,7 @@ single-characters, however. For that, try something more like: system "stty cbreak </dev/tty >/dev/tty 2>&1"; } else { - system "stty", '-icanon', 'eol', "\001"; + system "stty", '-icanon', 'eol', "\001"; } $key = getc(STDIN); @@ -1276,18 +1276,18 @@ single-characters, however. For that, try something more like: } print "\n"; -Determination of whether $BSD_STYLE should be set -is left as an exercise to the reader. +Determination of whether $BSD_STYLE should be set +is left as an exercise to the reader. The POSIX::getattr() function can do this more portably on systems alleging POSIX compliance. See also the C<Term::ReadKey> module from your nearest CPAN site; -details on CPAN can be found on L<perlmod/CPAN>. +details on CPAN can be found on L<perlmod/CPAN>. =item getlogin Returns the current login from F</etc/utmp>, if any. If null, use -getpwuid(). +getpwuid(). $login = getlogin || getpwuid($<) || "Kilroy"; @@ -1446,26 +1446,26 @@ L<perlop/"I/O Operators">. =item gmtime EXPR Converts a time as returned by the time function to a 9-element array -with the time localized for the standard Greenwich time zone. +with the time localized for the standard Greenwich time zone. Typically used as follows: - + # 0 1 2 3 4 5 6 7 8 ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time); All array elements are numeric, and come straight out of a struct tm. In particular this means that $mon has the range 0..11 and $wday has -the range 0..6. Also, $year is the number of years since 1900, I<not> -simply the last two digits of the year. +the range 0..6 with sunday as day 0. Also, $year is the number of +years since 1900, I<not> simply the last two digits of the year. If EXPR is omitted, does C<gmtime(time())>. -In a scalar context, prints out the ctime(3) value: +In a scalar context, returns the ctime(3) value: $now_string = gmtime; # e.g., "Thu Oct 13 04:54:34 1994" -Also see the F<timegm.pl> library, and the strftime(3) function available -via the POSIX module. +Also see the timegm() function provided by the Time::Local module, +and the strftime(3) function available via the POSIX module. =item goto LABEL @@ -1501,7 +1501,7 @@ will be able to tell that this routine was called first. =item grep EXPR,LIST -This is similar in spirit to, but not the same as, L<grep(1)> +This is similar in spirit to, but not the same as, grep(1) and its relatives. In particular, it is not limited to using regular expressions. @@ -1526,9 +1526,9 @@ actually modifies the element in the original list. =item hex EXPR -=item hex +=item hex -Interprets EXPR as a hex string and returns the corresponding +Interprets EXPR as a hex string and returns the corresponding value. (To convert strings that might start with either 0 or 0x see L<oct>.) If EXPR is omitted, uses $_. @@ -1537,10 +1537,10 @@ see L<oct>.) If EXPR is omitted, uses $_. =item import -There is no built-in import() function. It is merely an ordinary +There is no builtin import() function. It is merely an ordinary method (subroutine) defined (or inherited) by modules that wish to export names to another module. The use() function calls the import() method -for the package used. See also L</use>, L<perlmod>, and L<Exporter>. +for the package used. See also L</use()>, L<perlmod>, and L<Exporter>. =item index STR,SUBSTR,POSITION @@ -1554,7 +1554,7 @@ one less than the base, ordinarily -1. =item int EXPR -=item int +=item int Returns the integer portion of EXPR. If EXPR is omitted, uses $_. @@ -1568,7 +1568,7 @@ first to get the correct function definitions. If F<ioctl.ph> doesn't exist or doesn't have the correct definitions you'll have to roll your own, based on your C header files such as F<E<lt>sys/ioctl.hE<gt>>. (There is a Perl script called B<h2ph> that comes with the Perl kit which -may help you in this, but it's non-trivial.) SCALAR will be read and/or +may help you in this, but it's nontrivial.) SCALAR will be read and/or written depending on the FUNCTION--a pointer to the string value of SCALAR will be passed as the third argument of the actual ioctl call. (If SCALAR has no string value but does have a numeric value, that value will be @@ -1605,7 +1605,7 @@ system: =item join EXPR,LIST -Joins the separate strings of LIST or ARRAY into a single string with +Joins the separate strings of LIST into a single string with fields separated by the value of EXPR, and returns the string. Example: @@ -1635,7 +1635,7 @@ or how about sorted by key: print $key, '=', $ENV{$key}, "\n"; } -To sort an array by value, you'll need to use a C<sort{}> function. +To sort an array by value, you'll need to use a C<sort> function. Here's a descending numeric sort of a hash by its values: foreach $key (sort { $hash{$b} <=> $hash{$a} } keys %hash)) { @@ -1658,8 +1658,8 @@ as trying has no effect). =item kill LIST -Sends a signal to a list of processes. The first element of -the list must be the signal to send. Returns the number of +Sends a signal to a list of processes. The first element of +the list must be the signal to send. Returns the number of processes successfully signaled. $cnt = kill 1, $child1, $child2; @@ -1687,17 +1687,17 @@ C<continue> block, if any, is not executed: =item lc EXPR -=item lc +=item lc Returns an lowercased version of EXPR. This is the internal function -implementing the \L escape in double-quoted strings. +implementing the \L escape in double-quoted strings. Respects current LC_CTYPE locale if C<use locale> in force. See L<perllocale>. If EXPR is omitted, uses $_. =item lcfirst EXPR -=item lcfirst +=item lcfirst Returns the value of EXPR with the first character lowercased. This is the internal function implementing the \l escape in double-quoted strings. @@ -1707,7 +1707,7 @@ If EXPR is omitted, uses $_. =item length EXPR -=item length +=item length Returns the length in characters of the value of EXPR. If EXPR is omitted, returns length of $_. @@ -1739,24 +1739,27 @@ Converts a time as returned by the time function to a 9-element array with the time analyzed for the local time zone. Typically used as follows: + # 0 1 2 3 4 5 6 7 8 ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); All array elements are numeric, and come straight out of a struct tm. In particular this means that $mon has the range 0..11 and $wday has -the range 0..6 and $year is year-1900, that is, $year is 123 in year -2023. If EXPR is omitted, uses the current time ("localtime(time)"). +the range 0..6 with sunday as day 0. Also, $year is the number of +years since 1900, that is, $year is 123 in year 2023. + +If EXPR is omitted, uses the current time (C<localtime(time)>). In a scalar context, returns the ctime(3) value: $now_string = localtime; # e.g., "Thu Oct 13 04:54:34 1994" -Also see the Time::Local module, and the strftime(3) function available -via the POSIX module. +Also see the Time::Local module, and the strftime(3) and mktime(3) +function available via the POSIX module. =item log EXPR -=item log +=item log Returns logarithm (base I<e>) of EXPR. If EXPR is omitted, returns log of $_. @@ -1765,7 +1768,7 @@ of $_. =item lstat EXPR -=item lstat +=item lstat Does the same thing as the stat() function, but stats a symbolic link instead of the file the symbolic link points to. If symbolic links are @@ -1862,7 +1865,7 @@ See the "use" function, which "no" is the opposite of. =item oct EXPR -=item oct +=item oct Interprets EXPR as an octal string and returns the corresponding value. (If EXPR happens to start off with 0x, interprets it as @@ -1907,9 +1910,9 @@ L<IPC::Open2>, L<IPC::Open3>, and L<perlipc/"Bidirectional Communication"> for alternatives.) Opening '-' opens STDIN and opening 'E<gt>-' opens STDOUT. Open returns -non-zero upon success, the undefined value otherwise. If the open +nonzero upon success, the undefined value otherwise. If the open involved a pipe, the return value happens to be the pid of the -subprocess. +subprocess. If you're unfortunate enough to be running Perl on a system that distinguishes between text files and binary files (modern operating @@ -2006,7 +2009,7 @@ In the child process the filehandle isn't opened--i/o happens from/to the new STDOUT or STDIN. Typically this is used like the normal piped open when you want to exercise more control over just how the pipe command gets executed, such as when you are running setuid, and -don't want to have to scan shell commands for metacharacters. +don't want to have to scan shell commands for metacharacters. The following pairs are more or less equivalent: open(FOO, "|tr '[a-z]' '[A-Z]'"); @@ -2072,7 +2075,7 @@ DIRHANDLEs have their own namespace separate from FILEHANDLEs. =item ord EXPR -=item ord +=item ord Returns the numeric ascii value of the first character of EXPR. If EXPR is omitted, uses $_. For the reverse, see L<chr>. @@ -2206,7 +2209,7 @@ for examples of such things. =item pop ARRAY -=item pop +=item pop Pops and returns the last value of the array, shortening the array by 1. Has a similar effect to @@ -2220,7 +2223,7 @@ like shift(). =item pos SCALAR -=item pos +=item pos Returns the offset of where the last C<m//g> search left off for the variable is in question ($_ is used when the variable is not specified). May be @@ -2300,7 +2303,7 @@ Generalized quotes. See L<perlop>. =item quotemeta EXPR -=item quotemeta +=item quotemeta Returns the value of EXPR with all non-alphanumeric characters backslashed. (That is, all characters not matching @@ -2316,7 +2319,7 @@ If EXPR is omitted, uses $_. =item rand Returns a random fractional number between 0 and the value of EXPR. -(EXPR should be positive.) If EXPR is omitted, returns a value between +(EXPR should be positive.) If EXPR is omitted, returns a value between 0 and 1. Automatically calls srand() unless srand() has already been called. See also srand(). @@ -2353,7 +2356,7 @@ chdir() there, it would have been testing the wrong file. =item readlink EXPR -=item readlink +=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 @@ -2367,7 +2370,7 @@ data into variable SCALAR from the specified SOCKET filehandle. Actually does a C recvfrom(), so that it can returns 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. +as the system call of the same name. See L<perlipc/"UDP: Message Passing"> for examples. =item redo LABEL @@ -2399,7 +2402,7 @@ themselves about what was just input: =item ref EXPR -=item ref +=item ref Returns a TRUE value if EXPR is a reference, FALSE otherwise. If EXPR is not specified, $_ will be used. The value returned depends on the @@ -2413,15 +2416,15 @@ Builtin types include: CODE GLOB -If the referenced object has been blessed into a package, then that package +If the referenced object has been blessed into a package, then that package name is returned instead. You can think of ref() as a typeof() 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<perlref>. @@ -2470,12 +2473,12 @@ end such a file with "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 bare word, the require assumes a "F<.pm>" extension and +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 +to make it easy to load standard modules. This form of loading of modules does not risk altering your namespace. -For a yet-more-powerful import facility, see L</use> and +For a yet-more-powerful import facility, see L</use> and L<perlmod>. =item reset EXPR @@ -2500,9 +2503,17 @@ ARGV and ENV arrays. 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</my>. -=item return LIST +=item return EXPR + +=item return + +Returns from a subroutine, eval(), or do FILE with the value of the +given EXPR. Evaluation of EXPR may be in a 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 wantarray()). If no EXPR +is given, returns an empty list in a list context, an undefined value in +a scalar context, or nothing in a void context. -Returns from a subroutine, eval(), or do FILE with the value specified. (Note that in the absence of a return, a subroutine, eval, or do FILE will automatically return the value of the last expression evaluated.) @@ -2541,7 +2552,7 @@ last occurrence at or before that position. =item rmdir FILENAME -=item rmdir +=item rmdir Deletes the directory specified by FILENAME if it is empty. If it succeeds it returns 1, otherwise it returns 0 and sets C<$!> (errno). If @@ -2554,11 +2565,11 @@ The substitution operator. See L<perlop>. =item scalar EXPR Forces EXPR to be interpreted in a scalar context and returns the value -of EXPR. +of EXPR. @counts = ( scalar @a, scalar @b, scalar @c ); -There is no equivalent operator to force an expression to +There is no equivalent operator to force an expression to be interpolated in a 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 @@ -2571,7 +2582,7 @@ call of stdio. FILEHANDLE may be an expression whose value gives the name of the filehandle. The values for WHENCE are 0 to set the file pointer to POSITION, 1 to set the it to current plus POSITION, and 2 to set it to EOF plus offset. You may use the values SEEK_SET, SEEK_CUR, and SEEK_END for -this from POSIX module. Returns 1 upon success, 0 otherwise. +this from the POSIX module. Returns 1 upon success, 0 otherwise. 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 @@ -2661,7 +2672,7 @@ The usual idiom is: ($nfound,$timeleft) = select($rout=$rin, $wout=$win, $eout=$ein, $timeout); -or to block until something becomes ready just do this +or to block until something becomes ready just do this $nfound = select($rout=$rin, $wout=$win, $eout=$ein, undef); @@ -2781,12 +2792,12 @@ has the same interpretation as in the system call of the same name. =item sin EXPR -=item sin +=item sin Returns the sine of EXPR (expressed in radians). If EXPR is omitted, returns sine of $_. -For the inverse sine operation, you may use the POSIX::sin() +For the inverse sine operation, you may use the POSIX::asin() function, or use this relation: sub asin { atan2($_[0], sqrt(1 - $_[0] * $_[0])) } @@ -2805,8 +2816,8 @@ you requested, depending on how it counts seconds. Most modern systems always sleep the full amount. For delays of finer granularity than one second, you may use Perl's -syscall() interface to access setitimer(2) if your system supports it, -or else see L</select()> below. +syscall() interface to access setitimer(2) if your system supports it, +or else see L</select()> below. See also the POSIX module's sigpause() function. @@ -2862,7 +2873,7 @@ Examples: @articles = sort {$a cmp $b} @files; # now case-insensitively - @articles = sort { uc($a) cmp uc($b)} @files; + @articles = sort {uc($a) cmp uc($b)} @files; # same thing in reversed order @articles = sort {$b cmp $a} @files; @@ -2893,8 +2904,8 @@ Examples: print sort @george, 'to', @harry; # prints AbelAxedCainPunishedcatchaseddoggonetoxyz - # inefficiently sort by descending numeric compare using - # the first integer after the first = sign, or the + # inefficiently sort by descending numeric compare using + # the first integer after the first = sign, or the # whole record case-insensitively otherwise @new = sort { @@ -2907,10 +2918,10 @@ Examples: # we'll build auxiliary indices instead # for speed @nums = @caps = (); - for (@old) { + for (@old) { push @nums, /=(\d+)/; push @caps, uc($_); - } + } @new = @old[ sort { $nums[$b] <=> $nums[$a] @@ -3031,7 +3042,7 @@ produces the list value (1, '-', 10, ',', 20) -If you had the entire header of a normal Unix email message in $header, +If you had the entire header of a normal Unix email message in $header, you could split it up into fields and their values this way: $header =~ s/\n\s+/ /g; # fix continuation lines @@ -3053,12 +3064,12 @@ Example: open(passwd, '/etc/passwd'); while (<passwd>) { - ($login, $passwd, $uid, $gid, $gcos, + ($login, $passwd, $uid, $gid, $gcos, $home, $shell) = split(/:/); ... } -(Note that $shell above will still have a newline on it. See L</chop>, +(Note that $shell above will still have a newline on it. See L</chop>, L</chomp>, and L</join>.) =item sprintf FORMAT, LIST @@ -3075,7 +3086,7 @@ dump core when fed ludicrous arguments. =item sqrt EXPR -=item sqrt +=item sqrt Return the square root of EXPR. If EXPR is omitted, returns square root of $_. @@ -3113,11 +3124,11 @@ function is to "seed" the rand() function so that rand() can produce a different sequence each time you run your program. Just do it once at the top of your program, or you I<won't> get random numbers out of rand()! -Frequently called programs (like CGI scripts) that simply use +Frequently called programs (like CGI scripts) that simply use time ^ $$ -for a seed can fall prey to the mathematical property that +for a seed can fall prey to the mathematical property that a^b == (a+1)^(b+1) @@ -3127,7 +3138,7 @@ one-third of the time. So don't do that. =item stat EXPR -=item stat +=item stat Returns a 13-element array giving the status info for a file, either the file opened via FILEHANDLE, or named by EXPR. If EXPR is omitted, it @@ -3139,22 +3150,22 @@ follows: $atime,$mtime,$ctime,$blksize,$blocks) = stat($filename); -Not all fields are supported on all filesystem types. Here are the +Not all fields are supported on all filesystem types. Here are the meaning of the fields: - dev device number of filesystem - ino inode number - mode file mode (type and permissions) - nlink number of (hard) links to the file - uid numeric user ID of file's owner - gid numeric group ID of file's owner - rdev the device identifier (special files only) - size total size of file, in bytes - atime last access time since the epoch - mtime last modify time since the epoch - ctime inode change time (NOT creation time!) since the epoch - blksize preferred block size for file system I/O - blocks actual number of blocks allocated + 0 dev device number of filesystem + 1 ino inode number + 2 mode file mode (type and permissions) + 3 nlink number of (hard) links to the file + 4 uid numeric user ID of file's owner + 5 gid numeric group ID of file's owner + 6 rdev the device identifier (special files only) + 7 size total size of file, in bytes + 8 atime last access time since the epoch + 9 mtime last modify time since the epoch + 10 ctime inode change time (NOT creation time!) since the epoch + 11 blksize preferred block size for file system I/O + 12 blocks actual number of blocks allocated (The epoch was at 00:00 January 1, 1970 GMT.) @@ -3176,11 +3187,11 @@ Takes extra time to study SCALAR (C<$_> if unspecified) in anticipation of doing many pattern matches on the string before it is next modified. This may or may not save time, depending on the nature and number of patterns you are searching on, and on the distribution of character -frequencies in the string to be searched--you probably want to compare +frequencies in the string to be searched -- you probably want to compare run times with and without it to see which runs faster. Those loops which scan for many short constant strings (including the constant parts of more complex patterns) will benefit most. You may have only -one study active at a time--if you study a different scalar the first +one study active at a time -- if you study a different scalar the first is "unstudied". (The way study works is this: a linked list of every character in the string to be searched is made, so we know, for example, where all the 'k' characters are. From each search string, @@ -3264,7 +3275,7 @@ Returns 1 for success, 0 otherwise. On systems that don't support symbolic links, produces a fatal error at run time. To check for that, use eval: - $symlink_exists = (eval 'symlink("","");', $@ eq ''); + $symlink_exists = (eval {symlink("","")};, $@ eq ''); =item syscall LIST @@ -3334,41 +3345,41 @@ first, and the parent process waits for the child process to complete. Note that argument processing varies depending on the number of arguments. The return value is the exit status of the program as returned by the wait() call. To get the actual exit value divide by -256. See also L</exec>. This is I<NOT> what you want to use to capture -the output from a command, for that you should use merely back-ticks or +256. See also L</exec>. This is I<NOT> what you want to use to capture +the output from a command, for that you should use merely backticks or qx//, as described in L<perlop/"`STRING`">. -Because system() and back-ticks block SIGINT and SIGQUIT, killing the +Because system() and backticks block SIGINT and SIGQUIT, killing the program they're running doesn't actually interrupt your program. @args = ("command", "arg1", "arg2"); - system(@args) == 0 - or die "system @args failed: $?" + system(@args) == 0 + or die "system @args failed: $?" Here's a more elaborate example of analysing the return value from -system() on a UNIX system to check for all possibilities, including for -signals and coredumps. +system() on a Unix system to check for all possibilities, including for +signals and core dumps. $rc = 0xffff & system @args; printf "system(%s) returned %#04x: ", "@args", $rc; if ($rc == 0) { print "ran with normal exit\n"; - } + } elsif ($rc == 0xff00) { print "command failed: $!\n"; - } + } elsif ($rc > 0x80) { $rc >>= 8; print "ran with non-zero exit status $rc\n"; - } + } else { print "ran with "; if ($rc & 0x80) { $rc &= ~0x80; - print "coredump from "; - } + print "core dump from "; + } print "signal $rc\n" - } + } $ok = ($rc != 0); =item syswrite FILEHANDLE,SCALAR,LENGTH,OFFSET @@ -3384,7 +3395,7 @@ is available will be written. An OFFSET may be specified to write the data from some part of the string other than the beginning. A negative OFFSET specifies writing -from that many bytes counting backwards from the end of the string. +that many bytes counting backwards from the end of the string. =item tell FILEHANDLE @@ -3448,7 +3459,7 @@ A class implementing a scalar should have the following methods: TIESCALAR classname, LIST DESTROY this - FETCH this, + FETCH this, STORE this, value Unlike dbmopen(), the tie() function will not use or require a module @@ -3478,7 +3489,7 @@ seconds, for this process and the children of this process. =item tr/// -The translation operator. See L<perlop>. +The translation operator. Same as y///. See L<perlop>. =item truncate FILEHANDLE,LENGTH @@ -3490,7 +3501,7 @@ on your system. =item uc EXPR -=item uc +=item uc Returns an uppercased version of EXPR. This is the internal function implementing the \U escape in double-quoted strings. @@ -3500,7 +3511,7 @@ If EXPR is omitted, uses $_. =item ucfirst EXPR -=item ucfirst +=item ucfirst Returns the value of EXPR with the first character uppercased. This is the internal function implementing the \u escape in double-quoted strings. @@ -3521,8 +3532,8 @@ digits. See also L<oct>, if all you have is a string. =item undef -Undefines the value of EXPR, which must be an lvalue. Use on only a -scalar value, an entire array or hash, or a subroutine name (using +Undefines the value of EXPR, which must be an lvalue. Use only on a +scalar value, an entire array, an entire hash, or a subroutine name (using "&"). (Using undef() will probably not do what you expect on most predefined variables or DBM list values, so don't do that.) Always returns the undefined value. You can omit the EXPR, in which case @@ -3535,13 +3546,13 @@ pass as a parameter. Examples: undef @ary; undef %hash; undef &mysub; - return (wantarray ? () : undef) if $they_blew_it; + return (wantarray ? (undef, $errmsg) : undef) if $they_blew_it; select undef, undef, undef, 0.25; ($a, $b, undef, $c) = &foo; # Ignore third value returned =item unlink LIST -=item unlink +=item unlink Deletes a list of files. Returns the number of files successfully deleted. @@ -3618,7 +3629,7 @@ package. It is exactly equivalent to BEGIN { require Module; import Module LIST; } -except that Module I<must> be a bare word. +except that Module I<must> be a bareword. If the first argument to C<use> is a number, it is treated as a version number instead of a module name. If the version of the Perl interpreter @@ -3746,9 +3757,12 @@ not been harvested by the Perl script yet.) Returns TRUE if the context of the currently executing subroutine is looking for a list value. Returns FALSE if the context is looking -for a scalar. +for a scalar. Returns the undefined value if the context is looking +for no value (void context). - return wantarray ? () : undef; + return unless defined wantarray; # don't bother doing more + my @a = complex_calculation(); + return wantarray ? @a : "@a"; =item warn LIST @@ -3791,9 +3805,9 @@ examples. =item write -Writes a formatted record (possibly multi-line) to the specified file, +Writes a formatted record (possibly multiline) to the specified file, using the format associated with that file. By default the format for -a file is the one having the same name is the filehandle, but the +a file is the one having the same name as the filehandle, but the format for the current output channel (see the select() function) may be set explicitly by assigning the name of the format to the C<$~> variable. @@ -3817,6 +3831,6 @@ Note that write is I<NOT> the opposite of read. Unfortunately. =item y/// -The translation operator. See L<perlop>. +The translation operator. Same as tr///. See L<perlop>. =back diff --git a/pod/perlguts.pod b/pod/perlguts.pod index ff3d6cdc5d..c14e17d0bd 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -28,7 +28,7 @@ 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 SV's +=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, @@ -56,7 +56,7 @@ argument to C<newSVpv>. Be warned, though, that Perl will determine the string's length by using C<strlen>, which depends on the string terminating with a NUL character. -All SV's that will contain strings should, but need not, be terminated +All SVs that will contain strings should, but need not, 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. @@ -77,7 +77,7 @@ In the C<SvPV> macro, the length of the string returned is placed into the variable C<len> (this is a macro, so you do I<not> use C<&len>). If you do not care what the length of the data is, use the global variable C<na>. Remember, however, that Perl allows arbitrary strings of data that may both contain -NUL's and might not be terminated by a NUL. +NULs and might not be terminated by a NUL. If you want to know if the scalar value is TRUE, you can use: @@ -184,21 +184,21 @@ stored in your SV. The "p" stands for private. In general, though, it's best to use the C<Sv*V> macros. -=head2 Working with AV's +=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 SV's: +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<num> C<SV*>'s. Once the -AV has been created, the SV's can be destroyed, if so desired. +AV has been created, the SVs can be destroyed, if so desired. -Once the AV has been created, the following operations are possible on AV's: +Once the AV has been created, the following operations are possible on AVs: void av_push(AV*, SV*); SV* av_pop(AV*); @@ -242,13 +242,13 @@ by using the following: This returns NULL if the variable does not exist. -=head2 Working with HV's +=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 HV's: +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); @@ -256,7 +256,7 @@ Once the HV has been created, the following operations are possible on HV's: The C<klen> parameter is the length of the key being passed in (Note that you cannot pass 0 in as a value of C<klen> to tell Perl to measure the length of the key). The C<val> argument contains the SV pointer to the -scalar being stored, and C<hash> is the pre-computed hash value (zero if +scalar being stored, and C<hash> is the precomputed hash value (zero if you want C<hv_store> to calculate it for you). The C<lval> 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 @@ -468,7 +468,7 @@ There are additional macros whose values may be bitwise OR'ed with the C<TRUE> argument to enable certain extra features. Those bits are: GV_ADDMULTI Marks the variable as multiply defined, thus preventing the - "Indentifier <varname> used only once: possible typo" warning. + "Name <varname> used only once: possible typo" warning. GV_ADDWARN Issues the warning "Had to create <varname> unexpectedly" if the variable did not exist before the function was called. @@ -477,8 +477,8 @@ package. =head2 Reference Counts and Mortality -Perl uses an reference count-driven garbage collection mechanism. SV's, -AV's, or HV's (xV for short in the following) start their life with a +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. @@ -514,11 +514,11 @@ 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 xV's. These functions introduce the concept of "mortality". +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 xV's have their +an XSUB function. The actual determinant for when mortal xVs have their reference count decremented depends on two macros, SAVETMPS and FREETMPS. See L<perlcall> and L<perlxs> for more details on these macros. @@ -540,7 +540,7 @@ The first call creates a mortal SV, the second converts an existing SV to a mortal SV (and thus defers a call to C<SvREFCNT_dec>), and the third creates a mortal copy of an existing SV. -The mortal routines are not just for SV's -- AV's and HV's can be +The mortal routines are not just for SVs -- AVs and HVs can be made mortal by passing their address (type-casted to C<SV*>) to the C<sv_2mortal> or C<sv_mortalcopy> routines. @@ -601,7 +601,7 @@ as any other SV. For more information on references and blessings, consult L<perlref>. -=head2 Double-Typed SV's +=head2 Double-Typed SVs Scalar variables normally contain only one type of value, an integer, double, pointer, or reference. Perl will automatically convert the @@ -679,9 +679,9 @@ 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<name> and C<namlem> arguments are used to associate a string with -the magic, typically the name of a variable. C<namlem> is stored in the -C<mg_len> field and if C<name> is non-null and C<namlem> >= 0 a malloc'd +The C<name> and C<namlen> arguments are used to associate a string with +the magic, typically the name of a variable. C<namlen> is stored in the +C<mg_len> field and if C<name> is non-null and C<namlen> >= 0 a malloc'd copy of the name is stored in C<mg_ptr> field. The sv_magic function uses C<how> to determine which, if any, predefined @@ -800,7 +800,7 @@ at the top of the private data area and check that. This routine returns a pointer to the C<MAGIC> structure stored in the SV. If the SV does not have that magical feature, C<NULL> is returned. Also, -if the SV is not of type SVt_PVMG, Perl may core-dump. +if the SV is not of type SVt_PVMG, Perl may core dump. int mg_copy(SV* sv, SV* nsv, char* key, STRLEN klen); @@ -836,7 +836,7 @@ where C<sp> is the stack pointer, and C<num> 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 IV's, doubles, strings, and SV pointers respectively: +macros to push IVs, doubles, strings, and SV pointers respectively: PUSHi(IV) PUSHn(double) @@ -979,20 +979,20 @@ others, which use it via C<(X)PUSH[pni]>. =head2 Scratchpads -The question remains on when the SV's which are I<target>s for opcodes +The question remains on when the SVs which are I<target>s 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 SV's which are lexicals for the current unit and are +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<SVs_PADMY> set, and I<target>s have C<SVs_PADTMP> set. -The correspondence between OP's and I<target>s is not 1-to-1. Different -OP's in the compile tree of the unit can use the same target, if this +The correspondence between OPs and I<target>s 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 @@ -1343,7 +1343,7 @@ L<perlcall>. =item G_ARRAY -Used to indicate array context. See C<GIMME> and L<perlcall>. +Used to indicate array context. See C<GIMME_V>, C<GIMME> and L<perlcall>. =item G_DISCARD @@ -1356,8 +1356,14 @@ Used to force a Perl C<eval> wrapper around a callback. See L<perlcall>. =item GIMME -The XSUB-writer's equivalent to Perl's C<wantarray>. Returns C<G_SCALAR> or -C<G_ARRAY> for scalar or array context. +A backward-compatible version of C<GIMME_V> which can only return +C<G_SCALAR> or C<G_ARRAY>; in a void context, it returns C<G_SCALAR>. + +=item GIMME_V + +The XSUB-writer's equivalent to Perl's C<wantarray>. Returns +C<G_VOID>, C<G_SCALAR> or C<G_ARRAY> for void, scalar or array +context, respectively. =item G_NOARGS @@ -1365,7 +1371,11 @@ Indicates that no arguments are being sent to a callback. See L<perlcall>. =item G_SCALAR -Used to indicate scalar context. See C<GIMME> and L<perlcall>. +Used to indicate scalar context. See C<GIMME_V>, C<GIMME>, and L<perlcall>. + +=item G_VOID + +Used to indicate void context. See C<GIMME_V> and L<perlcall>. =item gv_fetchmeth @@ -1526,7 +1536,7 @@ returned. Deletes a key/value pair in the hash. The value SV is removed from the hash and returned to the caller. The C<flags> value will normally be zero; if set -to G_DISCARD then null will be returned. C<hash> can be a valid pre-computed +to G_DISCARD then null will be returned. C<hash> can be a valid precomputed hash value, or 0 to ask for it to be computed. SV* hv_delete_ent _((HV* tb, SV* key, I32 flags, U32 hash)); @@ -1541,7 +1551,7 @@ C<klen> is the length of the key. =item hv_exists_ent Returns a boolean indicating whether the specified hash key exists. C<hash> -can be a valid pre-computed hash value, or 0 to ask for it to be computed. +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)); @@ -1557,7 +1567,7 @@ dereferencing it to a C<SV*>. =item hv_fetch_ent Returns the hash entry which corresponds to the specified key in the hash. -C<hash> must be a valid pre-computed hash number for the given C<key>, or +C<hash> must be a valid precomputed hash number for the given C<key>, or 0 if you want the function to compute it. IF C<lval> 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<tb> is a tied hash @@ -1629,7 +1639,7 @@ Returns the package name of a stash. See C<SvSTASH>, C<CvSTASH>. =item hv_store Stores an SV in a hash. The hash key is specified as C<key> and C<klen> is -the length of the key. The C<hash> parameter is the pre-computed hash +the length of the key. The C<hash> parameter is the precomputed hash value; if it is zero then Perl will compute it. The return value will be null if the operation failed, otherwise it can be dereferenced to get the original C<SV*>. @@ -1639,7 +1649,7 @@ original C<SV*>. =item hv_store_ent Stores C<val> in a hash. The hash key is specified as C<key>. The C<hash> -parameter is the pre-computed hash value; if it is zero then Perl will +parameter is the precomputed hash value; if it is zero then Perl will compute it. The return value is the new hash entry so created. It will be null if the operation failed or if the entry was stored in a tied hash. Otherwise the contents of the return value can be accessed using the @@ -2118,7 +2128,7 @@ C<SPAGAIN>. =item SPAGAIN -Re-fetch the stack pointer. Used after a callback. See L<perlcall>. +Refetch the stack pointer. Used after a callback. See L<perlcall>. SPAGAIN; @@ -2910,4 +2920,4 @@ API Listing by Dean Roehrich <F<roehrich@cray.com>>. =head1 DATE -Version 31.3: 1997/3/14 +Version 31.4: 1997/3/30 diff --git a/pod/perlipc.pod b/pod/perlipc.pod index ab4a912bc6..7dc1c7a9b5 100644 --- a/pod/perlipc.pod +++ b/pod/perlipc.pod @@ -16,13 +16,13 @@ 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 +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. 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, so calling any print() functions (or even anything that needs to +reentrant, so calling any print() functions (or even anything that needs to malloc(3) more memory) could in theory trigger a memory fault and subsequent core dump. @@ -30,7 +30,7 @@ and subsequent core dump. 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 @@ -45,14 +45,14 @@ indexed by name to get the number: $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}) { + 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 @@ -65,10 +65,10 @@ 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 send a hang-up signal to all @@ -83,11 +83,11 @@ itself: 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. +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: @@ -95,18 +95,18 @@ handlers: $SIG{INT} = sub { die "\nOutta here!\n" }; But that will be problematic for the more complicated handlers that need -to re-install themselves. Because Perl's signal mechanism is currently +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 { + 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; } $SIG{CHLD} = \&REAPER; # now do something that forks... @@ -114,11 +114,11 @@ signal handlers like this: or even the more elaborate: use POSIX ":sys_wait_h"; - sub REAPER { + sub REAPER { my $child; while ($child = waitpid(-1,WNOHANG)) { $Kid_Status{$child} = $?; - } + } $SIG{CHLD} = \&REAPER; # still loathe sysV } $SIG{CHLD} = \&REAPER; @@ -134,11 +134,11 @@ using longjmp() or throw() in other languages. Here's an example: - eval { + eval { local $SIG{ALRM} = sub { die "alarm clock restart" }; - alarm 10; + alarm 10; flock(FH, 2); # blocking write lock - alarm 0; + alarm 0; }; if ($@ and $@ !~ /alarm clock restart/) { die } @@ -151,7 +151,7 @@ examples in it. 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 +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 @@ -160,16 +160,16 @@ 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') + 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. +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 @@ -185,9 +185,9 @@ to find out whether anyone (or anything) has accidentally removed our fifo. while (1) { unless (-p $FIFO) { unlink $FIFO; - system('mknod', $FIFO, 'p') + 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: $!"; @@ -204,7 +204,7 @@ 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") + 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"; @@ -217,7 +217,7 @@ And here's how to start up a child process you intend to read from: while (<STATUS>) { 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 @@ -231,7 +231,7 @@ read from the file F<f1>, the process F<cmd1>, standard input (F<tmpfile> in this case), the F<f2> file, the F<cmd2> command, and finally the F<f3> file. Pretty nifty, eh? -You might notice that you could use back-ticks for much the +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`; @@ -325,13 +325,13 @@ you opened whatever your kid writes to his STDOUT. use English; my $sleep_count = 0; - do { + 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 @@ -339,21 +339,21 @@ you opened whatever your kid writes to his STDOUT. close(KID_TO_WRITE) || warn "kid exited $?"; } else { # child ($EUID, $EGID) = ($UID, $GID); # suid progs only - open (FILE, "> /safe/file") + open (FILE, "> /safe/file") || die "can't open /safe/file: $!"; while (<STDIN>) { 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 back-ticks safely. +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 back-tick or pipe open for read: +Here's a safe backtick or pipe open for read: # add error processing as above $pid = open(KID_TO_READ, "-|"); @@ -361,7 +361,7 @@ Here's a safe back-tick or pipe open for read: if ($pid) { # parent while (<KID_TO_READ>) { # do something interesting - } + } close(KID_TO_READ) || warn "kid exited $?"; } else { # child @@ -369,7 +369,7 @@ Here's a safe back-tick or pipe open for read: exec($program, @options, @args) || die "can't exec program: $!"; # NOTREACHED - } + } And here's a safe pipe open for writing: @@ -381,7 +381,7 @@ And here's a safe pipe open for writing: if ($pid) { # parent for (@data) { print KID_TO_WRITE; - } + } close(KID_TO_WRITE) || warn "kid exited $?"; } else { # child @@ -389,11 +389,11 @@ And here's a safe pipe open for writing: 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 -multi-threading. If you'd like to learn more about threading, see the +multithreading. If you'd like to learn more about threading, see the F<modules> file mentioned below in the SEE ALSO section. =head2 Bidirectional Communication @@ -404,7 +404,7 @@ 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 +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. @@ -435,13 +435,13 @@ The problem with this is that Unix buffering is really going to ruin your day. Even though your C<Writer> 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 +in a similarly quick fashion. In this case, we could, because we gave I<cat> 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 +unless you yourself wrote the program on the other end of the double-ended pipe. -A solution to this is the non-standard F<Comm.pl> library. It uses +A solution to this is the nonstandard F<Comm.pl> library. It uses pseudo-ttys to make your program behave more reasonably: require 'Comm.pl'; @@ -452,8 +452,8 @@ pseudo-ttys to make your program behave more reasonably: } This way you don't have to have control over the source code of the -program you're using. The F<Comm> library also has expect() -and interact() functions. Find the library (and we hope its +program you're using. The F<Comm> library also has expect() +and interact() functions. Find the library (and we hope its successor F<IPC::Chat>) at your nearest CPAN archive as detailed in the SEE ALSO section below. @@ -510,16 +510,16 @@ Here's a sample TCP client using Internet-domain sockets: $proto = getprotobyname('tcp'); socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; connect(SOCK, $paddr) || die "connect: $!"; - while ($line = <SOCK>) { + while (defined($line = <SOCK>)) { 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 multi-homed hosts. If you want sit +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. @@ -531,14 +531,14 @@ instead. use Socket; use Carp; - sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" } + 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, + 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: $!"; @@ -553,16 +553,16 @@ instead. my($port,$iaddr) = sockaddr_in($paddr); my $name = gethostbyaddr($iaddr,AF_INET); - logmsg "connection from $name [", - inet_ntoa($iaddr), "] + logmsg "connection from $name [", + inet_ntoa($iaddr), "] at port $port"; - print Client "Hello there, $name, it's now ", + print Client "Hello there, $name, it's now ", scalar localtime, "\n"; - } + } -And here's a multi-threaded version. It's multi-threaded in that -like most typical servers, it spawns (forks) a slave server to +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. @@ -574,14 +574,14 @@ go back to service a new client. use Carp; sub spawn; # forward declaration - sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" } + 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, + 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: $!"; @@ -591,7 +591,7 @@ go back to service a new client. my $waitedpid = 0; my $paddr; - sub REAPER { + sub REAPER { $waitedpid = wait; $SIG{CHLD} = \&REAPER; # loathe sysV logmsg "reaped $waitedpid" . ($? ? " with exit $?" : ''); @@ -599,30 +599,30 @@ go back to service a new client. $SIG{CHLD} = \&REAPER; - for ( $waitedpid = 0; - ($paddr = accept(Client,Server)) || $waitedpid; - $waitedpid = 0, close Client) + 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), "] + logmsg "connection from $name [", + inet_ntoa($iaddr), "] at port $port"; - spawn sub { + spawn sub { print "Hello there, $name, it's now ", scalar localtime, "\n"; - exec '/usr/games/fortune' + exec '/usr/games/fortune' or confess "can't exec fortune: $!"; }; - } + } sub spawn { my $coderef = shift; - unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') { + unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') { confess "usage: spawn CODEREF"; } @@ -640,7 +640,7 @@ go back to service a new client. 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, @@ -666,11 +666,11 @@ differ from the system on which it's being run: use Socket; my $SECS_of_70_YEARS = 2208988800; - sub ctime { scalar localtime(shift) } + sub ctime { scalar localtime(shift) } - my $iaddr = gethostbyname('localhost'); - my $proto = getprotobyname('tcp'); - my $port = getservbyname('time', 'tcp'); + my $iaddr = gethostbyname('localhost'); + my $proto = getprotobyname('tcp'); + my $port = getservbyname('time', 'tcp'); my $paddr = sockaddr_in(0, $iaddr); my($host); @@ -695,7 +695,7 @@ differ from the system on which it's being run: 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 +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 @@ -705,7 +705,7 @@ 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: @@ -718,12 +718,12 @@ Here's a sample Unix-domain client: $rendezvous = shift || '/tmp/catsock'; socket(SOCK, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!"; connect(SOCK, sockaddr_un($rendezvous)) || die "connect: $!"; - while ($line = <SOCK>) { + while (defined($line = <SOCK>)) { print $line; - } + } exit; -And here's a corresponding server. +And here's a corresponding server. #!/usr/bin/perl -Tw require 5.002; @@ -746,17 +746,17 @@ And here's a corresponding server. $SIG{CHLD} = \&REAPER; - for ( $waitedpid = 0; - accept(Client,Server) || $waitedpid; - $waitedpid = 0, close Client) + for ( $waitedpid = 0; + accept(Client,Server) || $waitedpid; + $waitedpid = 0, close Client) { next if $waitedpid; logmsg "connection on $NAME"; - spawn sub { + 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(), @@ -799,8 +799,8 @@ with TCP, you'd have to use a different socket handle for each host. use Socket; use Sys::Hostname; - my ( $count, $hisiaddr, $hispaddr, $histime, - $host, $iaddr, $paddr, $port, $proto, + my ( $count, $hisiaddr, $hispaddr, $histime, + $host, $iaddr, $paddr, $port, $proto, $rin, $rout, $rtime, $SECS_of_70_YEARS); $SECS_of_70_YEARS = 2208988800; @@ -847,7 +847,7 @@ 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. +Here's a small example showing shared memory usage. $IPC_PRIVATE = 0; $IPC_RMID = 0; @@ -925,7 +925,7 @@ C<require "sys/ipc.ph">. Better yet, perhaps someone should create an C<IPC::SysV> module the way we have the C<Socket> module for normal client-server communications. -(... time passes) +(... time passes) Voila! Check out the IPC::SysV modules written by Jack Shirazi. You can find them at a CPAN store near you. @@ -961,8 +961,8 @@ 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. -Because few vendors provide C libraries that are safely -re-entrant, the prudent programmer will do little else within +Because few vendors provide C libraries that are safely +reentrant, the prudent programmer will do little else within a handler beyond die() to raise an exception and longjmp(3) out. =head1 AUTHOR diff --git a/pod/perllocale.pod b/pod/perllocale.pod index 31ab40a58d..ca8518f8f8 100644 --- a/pod/perllocale.pod +++ b/pod/perllocale.pod @@ -46,7 +46,7 @@ B<Definitions for the locales which you use must be installed>. 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, vary from system to system. Some systems -provide only a few, hard-wired, locales, and do not allow more to be +provide only a few, hardwired, 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 @@ -182,7 +182,7 @@ 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 which was in force when Perl started up: changes -to the environment made by the application after start-up may or may not +to the environment made by the application after startup may or may not be noticed, depending on the implementation of your system's C library. If the second argument does not correspond to a valid locale, the locale @@ -584,13 +584,13 @@ True/false results are never tainted. 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 +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... + # Command line sanity check omitted... $tainted_output_file = shift; open(F, ">$tainted_output_file") @@ -598,7 +598,7 @@ when taint checks are enabled. 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 +information - runs, creating the file named on its command line if it can. #/usr/local/bin/perl -T @@ -632,7 +632,7 @@ of a match involving C<\w> when C<use locale> is in effect. =item PERL_BADLANG A string that can suppress Perl's warning about failed locale settings -at start-up. Failure can occur if the locale support in the operating +at startup. Failure can occur if the locale support in the operating system is lacking (broken) is 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 which does not evaluate to integer zero - that diff --git a/pod/perllol.pod b/pod/perllol.pod index f15b24384e..ac36364ae0 100644 --- a/pod/perllol.pod +++ b/pod/perllol.pod @@ -16,7 +16,7 @@ old array @LoL that you can get at with two subscripts, like C<$LoL[3][2]>. Her a declaration of the array: # assign to our array a list of list references - @LoL = ( + @LoL = ( [ "fred", "barney" ], [ "george", "jane", "elroy" ], [ "homer", "marge", "bart" ], @@ -39,10 +39,10 @@ but rather just a reference to it, you could do something more like this: print $ref_to_LoL->[2][2]; -Notice that the outer bracket type has changed, and so our access syntax +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 +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] @@ -72,7 +72,7 @@ each line is a row and each word an element. If you're trying to develop an while (<>) { @tmp = split; push @LoL, [ @tmp ]; - } + } You might also have loaded that from a function: @@ -81,7 +81,7 @@ You might also have loaded that from a function: } Or you might have had a temporary variable sitting around with the -list in it. +list in it. for $i ( 1 .. 10 ) { @tmp = somefunc($i); @@ -93,8 +93,8 @@ 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. +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<use strict>, you'll have to add some declarations to make it happy: @@ -104,13 +104,13 @@ declarations to make it happy: 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: @@ -119,30 +119,30 @@ if you knew where you wanted to put it: 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. +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 ]; - } + } Actually, if you were using strict, you'd have to declare not only $ref_to_LoL as you had to declare @LoL, but you'd I<also> having to @@ -152,7 +152,7 @@ perl version 5.001m that's been fixed for the 5.002 release.) my $ref_to_LoL = []; while (<>) { push @$ref_to_LoL, [ split ]; - } + } Ok, 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: @@ -165,9 +165,9 @@ dealing with just matrices, it's often easiest to use simple assignment: for $x ( 3, 7, 9 ) { $LoL[$x][20] += func2($x); - } + } -It doesn't matter whether those elements are already +It doesn't matter whether those elements are already there or not: it'll gladly create them for you, setting intervening elements to C<undef> as need be. @@ -186,7 +186,7 @@ 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 +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: @@ -198,10 +198,10 @@ say print @LoL; # WRONG because you'll get just references listed, and perl will never -automatically dereference things for you. Instead, you have to +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. +set of subscripts. for $aref ( @LoL ) { print "\t [ @$aref ],\n"; @@ -221,7 +221,7 @@ or maybe even this. Notice the inner loop. } } -As you can see, it's getting a bit complicated. That's why +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 ) { @@ -254,10 +254,10 @@ Here's how to do one operation using a loop. We'll assume an @LoL variable as before. @part = (); - $x = 4; + $x = 4; for ($y = 7; $y < 13; $y++) { push @part, $LoL[$x][$y]; - } + } That same loop could be replaced with a slice operation: @@ -273,9 +273,9 @@ $x run from 4..8 and $y run from 7 to 12? Hmm... here's the simple way: for ($starty = $y = 7; $x <= 12; $y++) { $newLoL[$x - $startx][$y - $starty] = $LoL[$x][$y]; } - } + } -We can reduce some of the looping through slices +We can reduce some of the looping through slices for ($x = 4; $x <= 8; $x++) { push @newLoL, [ @{ $LoL[$x] } [ 7..12 ] ]; @@ -293,13 +293,13 @@ 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, + my ($x_lo, $x_hi, $y_lo, $y_hi) = @_; - return map { - [ @{ $lrr->[$_] } [ $y_lo .. $y_hi ] ] + return map { + [ @{ $lrr->[$_] } [ $y_lo .. $y_hi ] ] } $x_lo .. $x_hi; - } + } =head1 SEE ALSO diff --git a/pod/perlmod.pod b/pod/perlmod.pod index 194cd1125d..29f9059220 100644 --- a/pod/perlmod.pod +++ b/pod/perlmod.pod @@ -41,7 +41,7 @@ package's symbol table. All other symbols are kept in package C<main>, including all of the punctuation variables like $_. In addition, the identifiers STDIN, STDOUT, STDERR, ARGV, ARGVOUT, ENV, INC, and SIG are forced to be in package C<main>, even when used for other purposes than -their built-in one. Note also that, if you have a package called C<m>, +their builtin one. Note also that, if you have a package called C<m>, C<s>, or C<y>, 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 translation. @@ -77,8 +77,8 @@ 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'}; + 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. Here is F<dumpvar.pl> from the Perl library: @@ -328,7 +328,7 @@ the rest of the current file. This will not work if you use C<require> instead of C<use>. With require you can get into this problem: require Cwd; # make Cwd:: accessible - $here = Cwd::getcwd(); + $here = Cwd::getcwd(); use Cwd; # import names from Cwd:: $here = getcwd(); @@ -381,7 +381,7 @@ F<.pl> files will all eventually be converted into standard modules, and the F<.ph> files made by B<h2ph> will probably end up as extension modules made by B<h2xs>. (Some F<.ph> values may already be available through the POSIX module.) The B<pl2pm> file in the distribution may help in your -conversion, but it's just a mechanical process and therefore far from +conversion, but it's just a mechanical process and therefore far from bulletproof. =head2 Pragmatic Modules @@ -398,7 +398,7 @@ which lasts until the end of that BLOCK. Unlike the pragmas that effect the C<$^H> hints variable, the C<use vars> and C<use subs> declarations are not BLOCK-scoped. They allow -you to pre-declare a variables or subroutines within a particular +you to predeclare a variables or subroutines within a particular I<file> rather than just a block. Such declarations are effective for the entire file for which they were declared. You cannot rescind them with C<no vars> or C<no subs>. @@ -430,7 +430,7 @@ manipulate @INC at compile time =item locale -use or ignore current locale for built-in operations (see L<perllocale>) +use or ignore current locale for builtin operations (see L<perllocale>) =item ops @@ -450,7 +450,7 @@ restrict unsafe constructs =item subs -pre-declare sub names +predeclare sub names =item vmsish @@ -458,7 +458,7 @@ adopt certain VMS-specific behaviors =item vars -pre-declare global variable names +predeclare global variable names =back @@ -556,7 +556,7 @@ determine libraries to use and how to use them =item ExtUtils::MM_OS2 -methods to override UN*X behaviour in ExtUtils::MakeMaker +methods to override Unix behaviour in ExtUtils::MakeMaker =item ExtUtils::MM_Unix @@ -564,7 +564,7 @@ methods used by ExtUtils::MakeMaker =item ExtUtils::MM_VMS -methods to override UN*X behaviour in ExtUtils::MakeMaker +methods to override Unix behaviour in ExtUtils::MakeMaker =item ExtUtils::MakeMaker @@ -616,7 +616,7 @@ create or remove a series of directories =item File::stat -by-name interface to Perl's built-in stat() functions +by-name interface to Perl's builtin stat() functions =item FileCache @@ -704,19 +704,19 @@ Hello, anybody home? =item Net::hostent -by-name interface to Perl's built-in gethost*() functions +by-name interface to Perl's builtin gethost*() functions =item Net::netent -by-name interface to Perl's built-in getnet*() functions +by-name interface to Perl's builtin getnet*() functions =item Net::protoent -by-name interface to Perl's built-in getproto*() functions +by-name interface to Perl's builtin getproto*() functions =item Net::servent -by-name interface to Perl's built-in getserv*() functions +by-name interface to Perl's builtin getserv*() functions =item Opcode @@ -768,7 +768,7 @@ try every conceivable way to get hostname =item Sys::Syslog -interface to the UNIX syslog(3) calls +interface to the Unix syslog(3) calls =item Term::Cap @@ -800,7 +800,7 @@ implementation of the Soundex Algorithm as described by Knuth =item Text::Tabs -expand and unexpand tabs per the unix expand(1) and unexpand(1) +expand and unexpand tabs per the Unix expand(1) and unexpand(1) =item Text::Wrap @@ -828,11 +828,11 @@ efficiently compute time from local and GMT time =item Time::gmtime -by-name interface to Perl's built-in gmtime() function +by-name interface to Perl's builtin gmtime() function =item Time::localtime -by-name interface to Perl's built-in localtime() function +by-name interface to Perl's builtin localtime() function =item Time::tm @@ -844,11 +844,11 @@ base class for ALL classes (blessed references) =item User::grent -by-name interface to Perl's built-in getgr*() functions +by-name interface to Perl's builtin getgr*() functions =item User::pwent -by-name interface to Perl's built-in getpw*() functions +by-name interface to Perl's builtin getpw*() functions =back @@ -862,7 +862,8 @@ your system man(1) command. If that fails, try the I<perldoc> program. =head2 Extension Modules -Extension modules are written in C (or a mix of Perl and C) and get +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. @@ -1213,7 +1214,7 @@ 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 DOS then try to ensure each is +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? @@ -1279,8 +1280,8 @@ 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 license: The GNU -GPL and The Artistic License (see the files README, Copying, and +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 diff --git a/pod/perlobj.pod b/pod/perlobj.pod index 07a71dc203..765b7ffab7 100644 --- a/pod/perlobj.pod +++ b/pod/perlobj.pod @@ -9,7 +9,7 @@ See L<perlref> 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<perltoot>. -If you're still with us, then +If you're still with us, then here are three very simple definitions that you should find reassuring. =over 4 @@ -44,11 +44,11 @@ constructor: package Critter; sub new { bless {} } -The C<{}> constructs a reference to an anonymous hash containing no +The C<{}> constructs a reference to an anonymous hash containing no key/value pairs. 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 its reference to it could have been returned +it has been blessed, and the reference to it could have been returned directly, like this: sub new { @@ -82,7 +82,7 @@ so that your constructors may be inherited: Or if you expect people to call not just C<CLASS-E<gt>new()> but also C<$obj-E<gt>new()>, then use something like this. The initialize() -method used will be of whatever $class we blessed the +method used will be of whatever $class we blessed the object into: sub new { @@ -102,7 +102,7 @@ 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 +to only one class at a time. (Although of course it's free to inherit methods from many classes.) A clarification: Perl objects are blessed. References are not. Objects @@ -115,7 +115,7 @@ the following example: bless $a, BLAH; print "\$b is a ", ref($b), "\n"; -This reports $b as being a BLAH, so obviously bless() +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 @@ -130,7 +130,7 @@ 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. +through @ISA are known as base classes of the current class. 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 @@ -159,7 +159,7 @@ 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 or package it is being invoked on. There are just two -types of methods, which we'll call class and instance. +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.) @@ -324,7 +324,7 @@ You do not need to C<use UNIVERSAL> in order to make these methods available to your program. This is necessary only if you wish to have C<isa> available as a plain subroutine in the current package. -=head2 Destructors +=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 @@ -345,14 +345,14 @@ automatically when the current object is freed. 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. The left side of -E<gt> is not so -limited, because it's an infix operator, not a postfix operator. +limited, because it's an infix operator, not a postfix operator. -That means that below, A and B are equivalent to each other, and C and D -are equivalent, but AB and CD are different: +That means that in the following, A and B are equivalent to each other, and +C and D are equivalent, but A/B and C/D are different: - A: method $obref->{"fieldname"} + A: method $obref->{"fieldname"} B: (method $obref)->{"fieldname"} - C: $obref->{"fieldname"}->method() + C: $obref->{"fieldname"}->method() D: method {$obref->{"fieldname"}} =head2 Summary @@ -372,12 +372,12 @@ 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: +idea: { my $a; $a = \$a; - } + } Even thought $a I<should> go away, it can't. When building recursive data structures, you'll have to break the self-reference yourself explicitly @@ -391,7 +391,7 @@ node such as one might use in a sophisticated tree structure: $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 @@ -403,10 +403,10 @@ 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 -multi-threadable language. For example, this program demonstrates Perl's +multithreadable language. For example, this program demonstrates Perl's two-phased garbage collection: - #!/usr/bin/perl + #!/usr/bin/perl package Subtle; sub new { @@ -414,12 +414,12 @@ two-phased garbage collection: $test = \$test; warn "CREATING " . \$test; return bless \$test; - } + } sub DESTROY { my $self = shift; warn "DESTROYING $self"; - } + } package main; @@ -429,7 +429,7 @@ two-phased garbage collection: my $b = Subtle->new; $$a = 0; # break selfref warn "leaving block"; - } + } warn "just exited block"; warn "time to die..."; @@ -447,7 +447,7 @@ When run as F</tmp/test>, the following output is produced: DESTROYING Subtle=SCALAR(0x8e57c) during global destruction. Notice that "global destruction" bit there? That's the thread -garbage collector reaching the unreachable. +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 @@ -462,8 +462,8 @@ at a future date. =head1 SEE ALSO -A kinder, gentler tutorial on object-oriented programming in Perl can +A kinder, gentler tutorial on object-oriented programming in Perl can be found in L<perltoot>. -You should also check out L<perlbot> for other object tricks, traps, and tips, +You should also check out L<perlbot> for other object tricks, traps, and tips, as well as L<perlmod> for some style guides on constructing both modules and classes. diff --git a/pod/perlop.pod b/pod/perlop.pod index a0756678d1..4817aaf5fe 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -8,7 +8,7 @@ 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 +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) @@ -16,7 +16,7 @@ operate on scalar values only, not array values. nonassoc ++ -- right ** right ! ~ \ and unary + and - - left =~ !~ + left =~ !~ left * / % x left + - . left << >> @@ -42,7 +42,7 @@ In the following sections, these operators are covered in precedence order. =head2 Terms and List Operators (Leftward) -Any TERM is of highest precedence of Perl. These includes variables, +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 @@ -56,7 +56,7 @@ just like a normal function call. In the absence of parentheses, the precedence of list operators such as C<print>, C<sort>, or C<chmod> is either very high or very low depending on -whether you look at the left side of operator or the right side of it. +whether you are looking at the left side or the right side of the operator. For example, in @ary = (1, 3, sort 4, 2); @@ -81,11 +81,11 @@ Also note that print ($foo & 255) + 1, "\n"; -probably doesn't do what you expect at first glance. See +probably doesn't do what you expect at first glance. See L<Named Unary Operators> for more discussion of this. Also parsed as terms are the C<do {}> and C<eval {}> constructs, as -well as subroutine and method calls, and the anonymous +well as subroutine and method calls, and the anonymous constructors C<[]> and C<{}>. See also L<Quote and Quote-like Operators> toward the end of this section, @@ -110,7 +110,7 @@ See L<perlobj>. 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 built-in magic to it. If +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 @@ -179,7 +179,12 @@ Binary "*" multiplies two numbers. Binary "/" divides two numbers. -Binary "%" computes the modulus of the 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). Binary "x" is the repetition operator. In a scalar context, it returns a string consisting of the left operand repeated the number of @@ -347,12 +352,12 @@ operators depending on the context. In a 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<for (1..10)> loops and for doing slice operations on arrays. Be aware that under the current implementation, -a temporary array is created, so you'll burn a lot of memory if you +a temporary array is created, so you'll burn a lot of memory if you write something like this: for (1 .. 1_000_000) { # code - } + } In a scalar context, ".." returns a boolean value. The operator is bistable, like a flip-flop, and emulates the line-range (comma) operator @@ -416,11 +421,11 @@ 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, + 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. +or 3rd argument, whichever is selected. $a = $ok ? $b : $c; # get a scalar @a = $ok ? @b : @c; # get an array @@ -446,8 +451,8 @@ 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: +might trigger, such as from tie(). Other assignment operators work similarly. +The following are recognized: **= += *= &= <<= &&= -= /= |= >>= ||= @@ -533,12 +538,12 @@ Address-of operator. (But see the "\" operator for taking a reference.) =item unary * -Dereference-address operator. (Perl's prefix dereferencing +Dereference-address operator. (Perl's prefix dereferencing operators are typed: $, @, %, and &.) =item (TYPE) -Type casting operator. +Type casting operator. =back @@ -550,7 +555,7 @@ 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 +the same character fore and aft, but the 4 sorts of brackets (round, angle, square, curly) will all nest. Customary Generic Meaning Interpolates @@ -706,7 +711,7 @@ beginning. Examples: # scalar context $/ = ""; $* = 1; # $* deprecated in modern perls - while ($paragraph = <>) { + while (defined($paragraph = <>)) { while ($paragraph =~ /[a-z]['")]*[.!?]+['")]*\s/g) { $sentences++; } @@ -792,7 +797,7 @@ A double-quoted, interpolated string. A string which is interpolated and then 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. +context, it comes back as a single (potentially multiline) string. In list context, returns a list of lines (however you've defined lines with $/ or $INPUT_RECORD_SEPARATOR). @@ -847,7 +852,7 @@ Options are: 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</e> modifier overrides this, however). Unlike -Perl 4, Perl 5 treats back-ticks as normal delimiters; the replacement +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., @@ -892,7 +897,7 @@ Examples: s/([^ ]*) *([^ ]*)/$2 $1/; # reverse 1st two fields -Note the use of $ instead of \ in the last example. Unlike +Note the use of $ instead of \ in the last example. Unlike B<sed>, we use the \E<lt>I<digit>E<gt> form in only the left hand side. Anywhere else it's $E<lt>I<digit>E<gt>. @@ -915,12 +920,12 @@ Translates 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 translated. (The -string specified with =~ must be a scalar variable, an array element, -or an assignment to one of those, i.e., an lvalue.) For B<sed> devotees, -C<y> is provided as a synonym for C<tr>. 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<tr[A-Z][a-z]> -or C<tr(+-*/)/ABCD/>. +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.) +For B<sed> devotees, C<y> is provided as a synonym for C<tr>. 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<tr[A-Z][a-z]> or C<tr(+-*/)/ABCD/>. Options: @@ -983,8 +988,8 @@ an eval(): =head2 I/O Operators -There are several I/O operators you should know about. -A string is enclosed by back-ticks (grave accents) first undergoes +There are several I/O operators you should know about. +A string is 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 a scalar context, a single @@ -997,8 +1002,8 @@ of C<$?>). Unlike in B<csh>, 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 back-ticks is C<qx//>. (Because back-ticks -always undergo shell expansion as well, see L<perlsec> for +The generalized form of backticks is C<qx//>. (Because backticks +always undergo shell expansion as well, see L<perlsec> for security concerns.) Evaluating a filehandle in angle brackets yields the next line from @@ -1063,7 +1068,7 @@ continue as if the input were one big happy file. (But see example under eof() for how to reset line numbers on each file.) If you want to set @ARGV to your own list of files, go right ahead. If -you want to pass switches into your script, you can use one of the +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], /^-/) { @@ -1120,7 +1125,7 @@ machine.) Of course, the shortest way to do the above is: 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 +implementation of using a shell, the glob() routine may get "Arg list too long" errors (unless you've installed tcsh(1L) as F</bin/csh>). A glob evaluates its (embedded) argument only when it is starting a new @@ -1138,7 +1143,7 @@ than $file = <blurch*>; because the latter will alternate between returning a filename and -returning FALSE. +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 @@ -1159,14 +1164,14 @@ 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 +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 pre-compute the number that +the compiler will precompute the number that expression represents so that the interpreter won't have to. @@ -1180,7 +1185,7 @@ floating point. But by saying 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 +countermand this by saying no integer; diff --git a/pod/perlpod.pod b/pod/perlpod.pod index 6a13991437..1dfb3ac3d4 100644 --- a/pod/perlpod.pod +++ b/pod/perlpod.pod @@ -54,7 +54,7 @@ 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. +formatters use the first "=item" type to decide how to format the list. For, begin, and end let you include sections that are not interpreted as pod text, but passed directly to particular formatters. A formatter @@ -63,12 +63,12 @@ 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 <br> + =for html <br> <p> This is a raw HTML paragraph </p> 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. +paragraph with a matching "=end" are treated as a particular format. Here are some examples of how to use these: @@ -132,7 +132,7 @@ here and in commands: I<text> italicize text, used for emphasis or variables B<text> embolden text, used for switches and programs S<text> text contains non-breaking spaces - C<code> literal code + C<code> literal code L<name> A link (cross reference) to name L<name> manual page L<name/ident> item in manual page diff --git a/pod/perlre.pod b/pod/perlre.pod index 74a8bd9fd5..68964a0e9b 100644 --- a/pod/perlre.pod +++ b/pod/perlre.pod @@ -23,18 +23,18 @@ Do case-insensitive pattern matching. If C<use locale> is in effect, the case map is taken from the current locale. See L<perllocale>. -=item m +=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 +=item s Treat string as single line. That is, change "." to match any character whatsoever, even a newline, which it normally would not match. -=item x +=item x Extend your pattern's legibility by permitting whitespace and comments. @@ -49,7 +49,7 @@ The C</x> 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 meta-character introducing a comment, +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 that you'll have to either escape them or encode them using octal or hex escapes. Taken together, @@ -67,7 +67,7 @@ See L<Version 8 Regular Expressions> for details. In particular the following metacharacters have their standard I<egrep>-ish meanings: - \ Quote the next meta-character + \ 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) @@ -80,13 +80,13 @@ 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 +string as a multiline 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 +To facilitate multiline substitutions, the "." character never matches a newline unless you use the C</s> modifier, which in effect tells Perl to pretend the string is a single line--even if it isn't. The C</s> modifier also overrides the setting of C<$*>, in case you have some (badly behaved) older @@ -106,13 +106,11 @@ 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 sub-pattern is "greedy", that is, it will match as -many times as possible without causing the rest of the pattern not to match. -The standard quantifiers are all "greedy", in that they match as many -occurrences as possible (given a particular starting location) without -causing the pattern to fail. If you want it to match the minimum number -of times possible, follow the quantifier with a "?" after any of them. -Note that the meanings don't change, just the "gravity": +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 @@ -176,7 +174,7 @@ just like "^" and "$" except that they won't match multiple times when the C</m> 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(?!\n)>. The C<\G> assertion can be used to mix global -matches (using C<m//g>) and non-global ones, as described in +matches (using C<m//g>) and non-global ones, as described in L<perlop/"Regexp Quote-Like Operators">. It is also useful when writing C<lex>-like scanners, when you have several regexps which you want to match against consequent substrings of your @@ -230,14 +228,14 @@ You will note that all 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<lt>, \E<gt>, \{, or \} is always -interpreted as a literal character, not a meta-character. This makes it +interpreted as a literal character, not a metacharacter. This makes it simple to quote a string that you want to use for a pattern but that you are afraid might contain metacharacters. Quote simply all the non-alphanumeric characters: $pattern =~ s/(\W)/\\$1/g; -You can also use the built-in quotemeta() function to do this. +You can also use the builtin quotemeta() function to do this. An even easier way to quote metacharacters right in the match operator is to say @@ -420,7 +418,7 @@ 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 +tricker. Imagine you'd like to find a sequence of non-digits not followed by "123". You might try to write that as $_ = "ABC123"; @@ -454,14 +452,14 @@ 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. +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. +in the hope of matching the complete regular expression. -Well now, +Well now, the pattern really, I<really> wants to succeed, so it uses the standard regexp back-off-and-retry and lets C<\D*> expand to just "AB" this time. Now there's indeed something following "AB" that is not @@ -503,7 +501,7 @@ it would take literally forever--or until you ran out of stack space. In case you're not familiar with the "regular" Version 8 regexp routines, here are the pattern-matching rules not described above. -Any single character matches itself, unless it is a I<meta-character> +Any single character matches itself, unless it is a I<metacharacter> with a special meaning described here or above. You can cause characters which normally function as metacharacters to be interpreted literally by prefixing them with a "\" (e.g., "\." matches a ".", not any @@ -518,13 +516,13 @@ in the list. Within a list, the "-" character is used to specify a range, so that C<a-z> represents all the characters between "a" and "z", inclusive. -Characters may be specified using a meta-character syntax much like that +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<nnn>, where I<nnn> is a string of octal digits, matches the character whose ASCII value is I<nnn>. Similarly, \xI<nn>, where I<nn> are hexadecimal digits, matches the character whose ASCII value is I<nn>. The expression \cI<x> matches the -ASCII character control-I<x>. Finally, the "." meta-character matches any +ASCII character control-I<x>. Finally, the "." metacharacter matches any character except "\n" (unless you use C</s>). You can specify a series of alternatives for a pattern using "|" to @@ -539,14 +537,14 @@ start and end. 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|]>. -Within a pattern, you may designate sub-patterns for later reference by +Within a pattern, you may designate subpatterns for later reference by enclosing them in parentheses, and you may refer back to the I<n>th -sub-pattern later in the pattern using the meta-character \I<n>. -Sub-patterns are numbered based on the left to right order of their +subpattern later in the pattern using the metacharacter \I<n>. +Subpatterns are numbered based on the left to right order of their opening parenthesis. Note that a backreference matches whatever -actually matched the sub-pattern in the string being examined, not the -rules for that sub-pattern. Therefore, C<(0|0x)\d*\s\1\d*> will -match "0x1234 0x4321",but not "0x1234 01234", because sub-pattern 1 +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. diff --git a/pod/perlref.pod b/pod/perlref.pod index 4a0f14635c..cf793652f7 100644 --- a/pod/perlref.pod +++ b/pod/perlref.pod @@ -24,12 +24,12 @@ 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. +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 +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, like in the following paragraph, it usually is talking about a @@ -41,14 +41,14 @@ 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. -References can be constructed several ways. +References can be constructed 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 works in C.) Note +(This works much like the & (address-of) operator in C.) Note that this typically creates I<ANOTHER> 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 @@ -63,7 +63,7 @@ reference that the backslash returned. Here are some examples: It isn't possible to create a true reference to an IO handle (filehandle or dirhandle) using the backslash operator. See the explanation of the *foo{THING} syntax below. (However, you're apt to find Perl code -out there using globrefs as though they were IO handles, which is +out there using globrefs as though they were IO handles, which is grandfathered into continued functioning.) =item 2. @@ -74,7 +74,7 @@ brackets: $arrayref = [1, 2, ['a', 'b', 'c']]; Here we've constructed a reference to an anonymous array of three elements -whose final element is itself reference to another anonymous array of three +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<gt>[2][1]> would have the value "b".) @@ -83,10 +83,10 @@ 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); @list = \($a, @b, %c); # same thing! -As a special case, C<\(@foo)> returns a list of references to the contents +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. @@ -143,8 +143,8 @@ 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 provides a different -mechanism to do that already--see L<perlobj>. +do object-oriented stuff with it, though Perl already provides a different +mechanism to do that--see L<perlobj>. 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<only> way to get @@ -298,7 +298,7 @@ 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 + &{ $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 @@ -416,7 +416,7 @@ 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 +block. An inner block may countermand that with no strict 'refs'; @@ -429,7 +429,7 @@ invisible to this mechanism. For example: { 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. @@ -495,7 +495,7 @@ converted into a string: $x{ \$a } = $a; -If you try to dereference the key, it won't do a hard dereference, and +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 diff --git a/pod/perlrun.pod b/pod/perlrun.pod index a2e0764c7b..dd467a5050 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -44,7 +44,7 @@ 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 __END__ token.) +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 @@ -81,7 +81,7 @@ 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 partway through before finding a syntax error.) +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 @@ -102,7 +102,7 @@ Put as the first line in C<*.cmd> file (C<-S> due to a bug in cmd.exe's `extproc' handling). -=item DOS +=item MS-DOS Create a batch file to run your script, and codify it in C<ALTERNATIVE_SHEBANG> (see the F<dosish.h> file in the source @@ -138,10 +138,10 @@ For example: # Unix perl -e 'print "Hello world\n"' - # DOS, etc. + # MS-DOS, etc. perl -e "print \"Hello world\n\"" - # Mac + # Macintosh print "Hello world\n" (then Run "Myscript" or Shift-Command-R) @@ -149,7 +149,7 @@ For example: perl -e "print ""Hello world\n""" The problem is that none of this is reliable: it depends on the command -tirely possible neither works. If 4DOS was the command shell, this would +and it is entirely possible neither works. If 4DOS was the command shell, this would probably work better: perl -e "print <Ctrl-x>"Hello world\n<Ctrl-x>"" @@ -158,9 +158,9 @@ 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 Mac, it depends which environment you are using. The MacPerl +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 Mac's non-ASCII +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. @@ -211,7 +211,7 @@ An alternate delimiter may be specified using B<-F>. causes Perl to check the syntax of the script and then exit without executing it. Actually, it I<will> execute C<BEGIN>, C<END>, and C<use> blocks, -because these are considered as occurring outside the execution of +because these are considered as occurring outside the execution of your program. =item B<-d> @@ -254,11 +254,11 @@ equivalent to B<-Dtls>): =item B<-e> I<commandline> -may be used to enter one line of script. +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. +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. +be given to build up a multiline script. Make sure to use semicolons where you would in a normal program. =item B<-F>I<pattern> @@ -309,8 +309,8 @@ 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. -You can use C<eof> without parenthesis to locate the end of each input file, -in case you want to append to each file, or reset line numbering (see +You can use C<eof> without parenthesis 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<perlfunc/eof>). =item B<-I>I<directory> @@ -358,7 +358,7 @@ 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 built-in syntactic sugar means you can also say +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 @@ -547,6 +547,14 @@ 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 diff --git a/pod/perlsec.pod b/pod/perlsec.pod index 0d72cf0ca6..e21f97f21f 100644 --- a/pod/perlsec.pod +++ b/pod/perlsec.pod @@ -6,10 +6,10 @@ perlsec - Perl security 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 +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 -built-in functionality, it can rely less upon external (and possibly +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<taint @@ -29,7 +29,7 @@ and it is these checks especially that contribute to making a setuid 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 +else outside your program--at least, not by accident. All command line arguments, environment variables, locale information (see L<perllocale>), and 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 @@ -57,7 +57,7 @@ For example: $path = $ENV{'PATH'}; # $path now tainted - $ENV{'PATH'} = '/bin:/usr/bin'; + $ENV{'PATH'} = '/bin:/usr/bin'; $ENV{'IFS'} = '' if $ENV{'IFS'} ne ''; $path = $ENV{'PATH'}; # $path now NOT tainted @@ -82,7 +82,7 @@ For example: If you try to do something insecure, you will get a fatal error saying something like "Insecure dependency" or "Insecure PATH". Note that you can still write an insecure B<system> or B<exec>, but only by explicitly -doing something like the last example above. +doing something like the last example above. =head2 Laundering and Detecting Tainted Data @@ -91,9 +91,9 @@ trigger an "Insecure dependency" message, you can use the following I<is_tainted()> function. sub is_tainted { - return ! eval { - join('',@_), kill 0; - 1; + return ! eval { + join('',@_), kill 0; + 1; }; } @@ -106,7 +106,7 @@ 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 sub-patterns from a regular expression match. +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 @@ -119,7 +119,7 @@ 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.]+)$/) { + if ($data =~ /^([-\@\w.]+)$/) { $data = $1; # $data now untainted } else { die "Bad data in $data"; # log this somewhere @@ -146,12 +146,12 @@ block. See L<perllocale/SECURITY> for further discussion and examples. 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 +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 #! +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.) +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 @@ -164,7 +164,7 @@ 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. +makes sure you set the PATH. 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 @@ -177,8 +177,8 @@ prevent stupid mistakes, not to remove the need for thought. Perl does not call the shell to expand wild cards when you pass B<system> and B<exec> explicit parameter lists instead of strings with possible shell wildcards in them. Unfortunately, the B<open>, B<glob>, and -back-tick functions provide no such alternate calling convention, so more -subterfuge will be required. +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 @@ -193,13 +193,13 @@ 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 back-ticks reasonably safely. Notice how the B<exec> is +Here's a way to do backticks reasonably safely. Notice how the B<exec> 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. By the time we get to the B<exec>, tainting is turned off, however, so be careful what you call and what you pass it. - use English; + use English; die unless defined $pid = open(KID, "-|"); if ($pid) { # parent while (<KID>) { @@ -247,7 +247,7 @@ Alternately, it can simply ignore the setuid bit 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<suidperl> that is automatically -invoked for you if it's needed. +invoked for you if it's needed. However, if the kernel setuid script feature isn't disabled, Perl will complain loudly that your setuid script is insecure. You'll need to @@ -258,14 +258,14 @@ kernel bug that plagues setuid scripts. Here's a simple wrapper, written in C: #define REAL_PATH "/path/to/script" - main(ac, av) + main(ac, av) char **av; { execv(REAL_PATH, av); - } + } -Compile this wrapper into a binary executable and then make I<it> rather -than your script setuid or setgid. +Compile this wrapper into a binary executable and then make I<it> rather +than your script setuid or setgid. See the program B<wrapsuid> in the F<eg> directory of your Perl distribution for a convenient way to do this automatically for all your @@ -308,7 +308,7 @@ 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 +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 diff --git a/pod/perlstyle.pod b/pod/perlstyle.pod index 734b9ad032..8adb901139 100644 --- a/pod/perlstyle.pod +++ b/pod/perlstyle.pod @@ -6,7 +6,7 @@ perlstyle - Perl style guide 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. +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 @@ -17,7 +17,7 @@ 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. +a multiline BLOCK should line up with the keyword that started the construct. Beyond that, he has other preferences that aren't so strong: =over 4 @@ -32,7 +32,7 @@ Opening curly on same line as keyword, if possible, otherwise line up. =item * -Space before the opening curly of a multi-line BLOCK. +Space before the opening curly of a multiline BLOCK. =item * @@ -154,13 +154,13 @@ the middle. Just "outdent" it a little to make it more visible: =item * Don't be afraid to use loop labels--they're there to enhance -readability as well as to allow multi-level loop breaks. See the +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 +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. @@ -178,7 +178,7 @@ determined by the B<Configure> program when Perl was installed. Choose mnemonic identifiers. If you can't remember what mnemonic means, you've got a problem. -=item * +=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 @@ -190,19 +190,19 @@ reserves lowercase module names for "pragma" modules like C<integer> and C<strict>. 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 bites. +few sparse bytes. =item * -You may find it helpful to use letter case to indicate the scope -or nature of a variable. For example: +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 + $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-E<gt>as_string(). +Function and method names seem to work best as all lowercase. +E.g., $obj-E<gt>as_string(). You can use a leading underscore to indicate that a variable or function should not be used outside the package that defined it. @@ -227,12 +227,12 @@ 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. +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; + $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: $!"; diff --git a/pod/perlsub.pod b/pod/perlsub.pod index 6e2309dfb2..602e5c0dda 100644 --- a/pod/perlsub.pod +++ b/pod/perlsub.pod @@ -23,7 +23,7 @@ To import subroutines: To call subroutines: NAME(LIST); # & is optional with parentheses. - NAME LIST; # Parentheses optional if pre-declared/imported. + NAME LIST; # Parentheses optional if predeclared/imported. &NAME; # Passes current @_ to subroutine. =head1 DESCRIPTION @@ -58,10 +58,14 @@ it was assigned to.) Note that assigning to the whole array @_ removes the aliasing, and does not update any arguments. The return value of the subroutine is the value of the last expression -evaluated. Alternatively, a return statement may be used to specify the -returned value and exit the subroutine. If you return one or more arrays -and/or hashes, these will be flattened together into one large -indistinguishable list. +evaluated. Alternatively, a return statement may be used 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 my() list of these. Any variables you use in the function @@ -89,7 +93,7 @@ Example: sub get_line { $thisline = $lookahead; # GLOBAL VARIABLES!! - LINE: while ($lookahead = <STDIN>) { + LINE: while (defined($lookahead = <STDIN>)) { if ($lookahead =~ /^[ \t]/) { $thisline .= $lookahead; } @@ -118,8 +122,8 @@ do in-place modifications of @_ and change its caller's values. upcase_in($v1, $v2); # this changes $v1 and $v2 sub upcase_in { - for (@_) { tr/a-z/A-Z/ } - } + 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 @@ -127,17 +131,17 @@ argument were actually literal and you tried to change it, you'd take a upcase_in("frederick"); -It would be much safer if the upcase_in() function +It would be much safer if the upcase_in() 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/ } - # wantarray checks if we were called in list context + 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 @_ @@ -159,7 +163,7 @@ made @b an empty list. See L</"Pass by Reference"> for alternatives. A subroutine may be called using the "&" prefix. The "&" is optional in modern Perls, and so are the parentheses if the subroutine has been -pre-declared. (Note, however, that the "&" is I<NOT> optional when +predeclared. (Note, however, that the "&" is I<NOT> optional when you're just naming the subroutine, such as when it's used as an argument to defined() or undef(). Nor is it optional when you want to do an indirect subroutine call with a subroutine name or reference @@ -179,7 +183,7 @@ new users may wish to avoid. &foo(); # the same &foo; # foo() get current args, like foo(@_) !! - foo; # like foo() IFF sub foo pre-declared, else "foo" + foo; # like foo() IFF sub foo predeclared, else "foo" Not only does the "&" form make the argument list optional, but it also disables any prototype checking on the arguments you do provide. This @@ -226,7 +230,7 @@ this is used to name the parameters to a subroutine. Examples: my $arg = shift; # name doesn't matter $arg **= 1/3; return $arg; - } + } The "my" is simply a modifier on something you might assign to. So when you do assign to the variables in its argument list, the "my" doesn't @@ -253,7 +257,7 @@ the current statement. Thus, my $x = $x; -can be used to initialize the new $x with the value of the old $x, and +can be used to initialize the new $x with the value of the old $x, and the expression my $x = 123 and $x == 123 @@ -264,7 +268,7 @@ 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 (my $line = <>) { + while (defined(my $line = <>)) { $line = lc $line; } continue { print $line; @@ -367,28 +371,28 @@ 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; + 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 +If this function is being sourced in from a separate file via C<require> or C<use>, then this is probably just fine. If it's -all in the main program, you'll need to arrange for the my() +all in the main program, you'll need to arrange for the my() to be executed early, either by putting the whole block above -your pain program, or more likely, placing merely a BEGIN +your pain program, or more likely, placing merely a BEGIN sub around it to make sure it gets executed before your program starts to run: sub BEGIN { - my $secret_val = 0; + my $secret_val = 0; sub gimme_another { return ++$secret_val; - } - } + } + } See L<perlrun> about the BEGIN function. @@ -412,7 +416,7 @@ Synopsis: 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 + local *merlyn = \$randal; # just alias $merlyn, not @merlyn etc A local() modifies its listed variables to be local to the enclosing block, (or subroutine, C<eval{}>, or C<do>) and I<any called from @@ -433,9 +437,9 @@ subroutine. Examples: for $i ( 0 .. 9 ) { $digits{$i} = $i; - } + } # assume this function uses global %digits hash - parse_num(); + parse_num(); # now temporarily add to %digits hash if ($base12) { @@ -525,29 +529,29 @@ list of all their former last elements: my @retlist = (); foreach $aref ( @_ ) { push @retlist, pop @$aref; - } + } return @retlist; - } + } -Here's how you might write a function that returns a +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 ); + @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 +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. +a little expensive. Where people get into trouble is here: @@ -572,8 +576,8 @@ in order of how many elements they have in them: return ($cref, $dref); } else { return ($dref, $cref); - } - } + } + } It turns out that you can actually do this also: @@ -585,8 +589,8 @@ It turns out that you can actually do this also: 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 my() @@ -617,7 +621,7 @@ If you're planning on generating new filehandles, you could do this: 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<perlfunc/open()> for a somewhat cleaner way using the IO::Handle @@ -744,7 +748,7 @@ 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: @@ -760,15 +764,17 @@ in @foo. And the split() gets called in a scalar context and starts scribbling on your @_ parameter list. This is all very powerful, of course, and should be used only in moderation -to make the world a better place. +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 a -constant then it will be used in place of new-style calls to the -function. Old-style calls (that is, calls made using C<&>) are not -affected. +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<do>. Calls made using C<&> or C<do> are never +inlined. (See constant.pm for an easy way to declare most +constants.) All of the following functions would be inlined. @@ -781,8 +787,8 @@ All of the following functions would be inlined. sub FLAG_FOO () { 1 << 8 } sub FLAG_BAR () { 1 << 9 } sub FLAG_MASK () { FLAG_FOO | FLAG_BAR } - - sub OPT_BAZ () { 1 } + + sub OPT_BAZ () { not (0x1B58 & FLAG_MASK) } sub BAZ_VAL () { if (OPT_BAZ) { return 23; @@ -792,6 +798,13 @@ All of the following functions would be inlined. } } + sub N () { int(BAZ_VAL) / 3 } + BEGIN { + my $prod = 1; + for (1..N) { $prod *= $_ } + sub N_FACTORIAL () { $prod } + } + If you redefine a subroutine which 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 @@ -802,9 +815,8 @@ 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 - my $dummy; sub not_inlined () { - $dummy || 23 + 23 if $]; } =head2 Overriding Builtin Functions @@ -816,7 +828,7 @@ 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<subs> pragma (compiler directive) lets you, in effect, pre-declare subs +C<subs> 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'; @@ -864,12 +876,12 @@ should just call system() with those arguments. All you'd do is this: my $program = $AUTOLOAD; $program =~ s/.*:://; system($program, @_); - } + } date(); who('am', 'i'); ls('-l'); -In fact, if you pre-declare the functions you want to call that way, you don't +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); @@ -889,6 +901,6 @@ functions to perl code in L<perlxs>. =head1 SEE ALSO See L<perlref> for more on references. See L<perlxs> if you'd -like to learn about calling C subroutines from perl. See -L<perlmod> to learn about bundling up your functions in +like to learn about calling C subroutines from perl. See +L<perlmod> to learn about bundling up your functions in separate files. diff --git a/pod/perlsyn.pod b/pod/perlsyn.pod index 77dcc597a9..9c3f6617bd 100644 --- a/pod/perlsyn.pod +++ b/pod/perlsyn.pod @@ -32,20 +32,23 @@ 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 +the beginning or the end of the script. However, if you're using lexically-scoped private variables created with my(), 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 (prototyped to take one scalar parameter) without defining it by saying just: +subroutine without defining it by saying C<sub name>, thus: - sub myname ($); + sub myname; $me = myname $0 or die "can't get myname"; -Note that it functions as a list operator though, not as a unary -operator, so be careful to use C<or> instead of C<||> there. +Note that it functions as a list operator, not as a unary operator; so +be careful to use C<or> instead of C<||> in this case. However, if +you were to declare the subroutine as C<sub myname ($)>, then +C<myname> would functonion as a unary operator, so either C<or> or +C<||> would work. Subroutines declarations can also be loaded up with the C<require> statement or both loaded and imported into your namespace with a C<use> statement. @@ -65,7 +68,7 @@ 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<eval {}> and C<do {}> that look -like compound statements, but aren't (they're just TERMs in an expression), +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<SINGLE> modifier, @@ -178,25 +181,26 @@ want to skip ahead and get the next record. while (<>) { chomp; - if (s/\\$//) { - $_ .= <>; + if (s/\\$//) { + $_ .= <>; redo unless eof(); } # now process $_ - } + } which is Perl short-hand for the more explicitly written version: - LINE: while ($line = <ARGV>) { + LINE: while (defined($line = <ARGV>)) { chomp($line); - if ($line =~ s/\\$//) { - $line .= <ARGV>; + if ($line =~ s/\\$//) { + $line .= <ARGV>; redo LINE unless eof(); # not eof(ARGV)! } # now process $line - } + } -Or here's a simpleminded Pascal comment stripper (warning: assumes no { or } in strings). +Or here's a simpleminded Pascal comment stripper (warning: assumes no +{ or } in strings). LINE: while (<STDIN>) { while (s|({.*}.*){.*}|$1 |) {} @@ -246,15 +250,15 @@ for variables declared with C<my> in the initialization expression.) Besides the normal array index looping, C<for> 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 +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(); <STDIN>; prompt() ) { # do something - } + } =head2 Foreach Loops @@ -309,12 +313,12 @@ Here's how a C programmer might code up a particular algorithm in Perl: Whereas here's how a Perl programmer more comfortable with the idiom might do it: - OUTER: foreach my $wid (@ary1) { + 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 @@ -370,19 +374,19 @@ or or formatted so it stands out more as a "proper" switch statement: SWITCH: { - /^abc/ && do { - $abc = 1; - last SWITCH; + /^abc/ && do { + $abc = 1; + last SWITCH; }; - /^def/ && do { - $def = 1; - last SWITCH; + /^def/ && do { + $def = 1; + last SWITCH; }; - /^xyz/ && do { - $xyz = 1; - last SWITCH; + /^xyz/ && do { + $xyz = 1; + last SWITCH; }; $nothing = 1; } @@ -416,14 +420,14 @@ a temporary assignment to $_ for convenient matching: /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<do> block to return the proper value: $amode = do { - if ($flag & O_RDONLY) { "r" } - elsif ($flag & O_WRONLY) { ($flag & O_APPEND) ? "a" : "w" } + if ($flag & O_RDONLY) { "r" } + elsif ($flag & O_WRONLY) { ($flag & O_APPEND) ? "a" : "w" } elsif ($flag & O_RDWR) { if ($flag & O_CREAT) { "w+" } else { ($flag & O_APPEND) ? "a+" : "r+" } @@ -475,14 +479,14 @@ encounters a line that begins with an equal sign and a word, like this 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<perlpod>. +text is described in L<perlpod>. 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 + The snazzle() function will behave in the most spectacular form that you can possibly imagine, not even excepting cybernetic pyrotechnics. @@ -491,11 +495,11 @@ and your documentation text freely, as in sub snazzle($) { my $thingie = shift; ......... - } + } -Note that pod translators should look at only paragraphs beginning +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 +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. @@ -532,18 +536,18 @@ shell: 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'"; diff --git a/pod/perltoc.pod b/pod/perltoc.pod index baef9320aa..9a103bfaeb 100644 --- a/pod/perltoc.pod +++ b/pod/perltoc.pod @@ -66,7 +66,7 @@ authors =over -=item Non-commercial Reproduction +=item Noncommercial Reproduction =item Commercial Reproduction @@ -224,13 +224,13 @@ MacPerl, Perl5-Porters, NTPerl, Perl-Packrats =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 compile my Perl program into byte code or C? -=item How can I get '#!perl' to work on [MSDOS,NT,...]? +=item How can I get '#!perl' to work on [MS-DOS,Windows 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 Why don't perl one-liners work on my MS-DOS/Macintosh/VMS system? =item Where can I learn about CGI or Web programming in Perl? @@ -414,7 +414,7 @@ it? =item Why does passing a subroutine an undefined element in a hash create it? -=item How can I make the Perl equivalent of a C structure/C++ class/hash +=item How can I make the Perl equivalent of a C structure/C++ class/hash or array of hashes or arrays? =item How can I use a reference as a hash key? @@ -484,7 +484,7 @@ filehandles between subroutines? How do I make an array of filehandles? =item What can't I just open(FH, ">file.lock")? -=item I still don't get locking. I just want to increment the number +=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? @@ -511,7 +511,7 @@ in the file. How can I do this? =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 +=item Why can't I use "C:\temp\foo" in MS-DOS paths? What doesn't `C:\temp\foo.exe` work? =item Why doesn't glob("*.*") get all the files? @@ -532,7 +532,7 @@ protected files? Isn't this a bug in Perl? =over =item How can I hope to use regular expressions without creating illegible -and unmaintainable code? +and unmaintainable code? Comments Outside the Regexp, Comments Inside the Regexp, Different Delimiters @@ -551,7 +551,7 @@ case on the RHS? =item How can I match a locale-smart version of C</[a-zA-Z]/>? -=item How can I quote a variable to use in a regexp? +=item How can I quote a variable to use in a regexp? =item What is C</o> really for? @@ -580,7 +580,7 @@ file? =item What's wrong with using grep or map in a void context? -=item How can I match strings with multi-byte characters? +=item How can I match strings with multibyte characters? =back @@ -637,7 +637,7 @@ is in scope? =item Why doesn't "local($foo) = <FILE>;" work right? -=item How do I redefine a built-in function, operator, or method? +=item How do I redefine a builtin function, operator, or method? =item What's the difference between calling a function as &foo and foo()? @@ -714,7 +714,7 @@ does the error message "Protocol not supported" mean? =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 MSDOS)? +^Z on MS-DOS)? =item How can I convert my shell script to perl? @@ -823,29 +823,37 @@ file on another machine? =over -=item Compilation Option: Binary Compatibility With 5.003 +=item Compilation option: Binary compatibility with 5.003 + +=item $PERL5OPT environment variable + +=item More precise warnings =item Subroutine arguments created only when they're modified -=item Fixed Parsing of $$<digit>, &$<digit>, etc. +=item Simple functions' C<AUTOLOAD> not looked up as method + +=item Fixed parsing of $$<digit>, &$<digit>, etc. + +=item No resetting of $. on implicit close -=item No Resetting of $. on Implicit Close +=item C<wantarray> may return undef -=item Changes to Tainting Checks +=item Changes to tainting checks -=item New Opcode Module and Revised Safe Module +=item New Opcode module and revised Safe module -=item Embedding Improvements +=item Embedding improvements -=item Internal Change: FileHandle Class Based on IO::* Classes +=item Internal change: FileHandle class based on IO::* classes -=item Internal Change: PerlIO internal IO abstraction interface +=item Internal change: PerlIO abstraction interface -=item New and Changed Built-in Variables +=item New and changed builtin variables $^E, $^H, $^M -=item New and Changed Built-in Functions +=item New and changed builtin functions delete on slices, flock, printf and sprintf, keys as an lvalue, my() in Control Structures, unpack() and pack(), use VERSION, use Module VERSION @@ -853,36 +861,37 @@ LIST, prototype(FUNCTION), srand, $_ as Default, C<m//g> does not trigger a pos() reset on failure, C<m//x> ignores whitespace before ?*+{}, nested C<sub{}> closures work now, formats work right on changing lexicals -=item New Built-in Methods +=item New builtin methods isa(CLASS), can(METHOD), VERSION( [NEED] ) -=item TIEHANDLE Now Supported +=item TIEHANDLE now supported TIEHANDLE classname, LIST, PRINT this, LIST, READ this LIST, READLINE this, GETC this, DESTROY this -=item Malloc Enhancements +=item Malloc enhancements -DDEBUGGING_MSTATS, -DEMERGENCY_SBRK, -DPACK_MALLOC, -DTWO_POT_OPTIMIZE -=item Miscellaneous Efficiency Enhancements +=item Miscellaneous efficiency enhancements =back =item Pragmata -use blib, use blib 'dir', use locale, use ops, use vmsish +use autouse MODULE => qw(sub1 sub2 sub3), use blib, use blib 'dir', use +constant NAME => VALUE, use locale, use ops, use vmsish =item Modules =over -=item Installation Directories +=item Installation directories -=item Fcntl +=item Module information summary -=item Module Information Summary +=item Fcntl =item IO @@ -892,7 +901,7 @@ use blib, use blib 'dir', use locale, use ops, use vmsish =item Net::Ping -=item Overridden Built-ins +=item Object-oriented overrides for builtin operators =back @@ -919,20 +928,24 @@ L<perlsec> "my" variable %s masks earlier declaration in same scope, %s argument is not a HASH element or slice, Allocation too large: %lx, Allocation too -large, Attempt to free non-existent shared string, Attempt to use reference -as lvalue in substr, Unsupported function fork, Ill-formed logical name -|%s| in prime_env_iter, Can't use bareword ("%s") as %s ref while "strict -refs" in use, Constant subroutine %s redefined, Died, Integer overflow in -hex number, Integer overflow in octal number, Name "%s::%s" used only once: -possible typo, Null picture in formline, Offset outside string, Stub found -while resolving method `%s' overloading `%s' in package `%s', Cannot -resolve method `%s' overloading `%s' in package `s', Out of memory!, Out of -memory during request for %s, Possible attempt to put comments in qw() -list, Possible attempt to separate words with commas, Scalar value @%s{%s} -better written as $%s{%s}, untie attempted while %d inner references still -exist, Value of %s construct can be "0"; test with defined(), Variable "%s" -may be unavailable, Variable "%s" will not stay shared, Warning: -something's wrong, Got an error from DosAllocMem, Malformed PERLLIB_PREFIX, +large, Applying %s to %s will act on scalar(%s), Attempt to free +nonexistent shared string, Attempt to use reference as lvalue in substr, +Can't use bareword ("%s") as %s ref while "strict refs" in use, Cannot +resolve method `%s' overloading `%s' in package `%s', Constant subroutine +%s redefined, Constant subroutine %s undefined, Copy method did not return +a reference, Died, Exiting pseudo-block via %s, Illegal character %s +(carriage return), Illegal switch in PERL5OPT: %s, Integer overflow in hex +number, Integer overflow in octal number, Name "%s::%s" used only once: +possible typo, Null picture in formline, Offset outside string, Out of +memory!, Out of memory during request for %s, Possible attempt to put +comments in qw() list, Possible attempt to separate words with commas, +Scalar value @%s{%s} better written as $%s{%s}, Stub found while resolving +method `%s' overloading `%s' in package `%s', Too late for "B<-T>" option, +untie attempted while %d inner references still exist, Unrecognized +character %s, Unsupported function fork, Value of %s can be "0"; test with +defined(), Variable "%s" may be unavailable, Variable "%s" will not stay +shared, Warning: something's wrong, Ill-formed logical name |%s| in +prime_env_iter, Got an error from DosAllocMem, Malformed PERLLIB_PREFIX, PERL_SH_DIR too long, Process terminated by SIG%s =item BUGS @@ -1098,7 +1111,7 @@ i, m, s, x =item #! and quoting on non-Unix systems -OS/2, DOS, Win95/NT, Macintosh +OS/2, MS-DOS, Win95/NT, Macintosh =item Switches @@ -1113,8 +1126,8 @@ B<-T>, B<-u>, B<-U>, B<-v>, B<-V>, B<-V:>I<name>, B<-w>, B<-x> I<directory> =item ENVIRONMENT -HOME, LOGDIR, PATH, PERL5LIB, PERLLIB, PERL5DB, PERL_DEBUG_MSTATS, -PERL_DESTRUCT_LEVEL +HOME, LOGDIR, PATH, PERL5LIB, PERL5OPT, PERLLIB, PERL5DB, +PERL_DEBUG_MSTATS, PERL_DESTRUCT_LEVEL =head2 perlfunc - Perl builtin functions @@ -1179,9 +1192,9 @@ qx/STRING/, qw/STRING/, quotemeta EXPR, quotemeta, rand EXPR, rand, read FILEHANDLE,SCALAR,LENGTH,OFFSET, read FILEHANDLE,SCALAR,LENGTH, readdir DIRHANDLE, readlink EXPR, readlink, recv SOCKET,SCALAR,LEN,FLAGS, redo LABEL, redo, ref EXPR, ref, rename OLDNAME,NEWNAME, require EXPR, require, -reset EXPR, reset, return LIST, 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 +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 @@ -1713,7 +1726,7 @@ more elaborate constructs isa(CLASS), can(METHOD), VERSION( [NEED] ) -=item Destructors +=item Destructors =item WARNING @@ -1866,7 +1879,7 @@ command, m expr, m package =item Debugger input/output -Prompt, Multi-line commands, Stack backtrace, Listing, Frame listing +Prompt, Multiline commands, Stack backtrace, Listing, Frame listing =item Debugging compile-time statements @@ -2018,7 +2031,7 @@ Unclassified =item PREAMBLE -B<Use C from Perl?>, B<Use a UNIX program from Perl?>, B<Use Perl from +B<Use C from Perl?>, B<Use a Unix program from Perl?>, B<Use Perl from Perl?>, B<Use C from C?>, B<Use Perl from C?> =item ROADMAP @@ -2228,13 +2241,13 @@ B<PerlIO_get_base(f)>, B<PerlIO_get_bufsiz(f)> =item What is an "IV"? -=item Working with SV's +=item Working with SVs =item What's Really Stored in an SV? -=item Working with AV's +=item Working with AVs -=item Working with HV's +=item Working with HVs =item Hash API Extensions @@ -2248,7 +2261,7 @@ B<PerlIO_get_base(f)>, B<PerlIO_get_bufsiz(f)> =item Stashes and Globs -=item Double-Typed SV's +=item Double-Typed SVs =item Magic Variables @@ -2304,27 +2317,28 @@ AvFILL, av_clear, av_extend, av_fetch, av_len, av_make, av_pop, av_push, av_shift, av_store, av_undef, av_unshift, CLASS, Copy, croak, CvSTASH, DBsingle, DBsub, DBtrace, dMARK, dORIGMARK, dowarn, dSP, dXSARGS, dXSI32, dXSI32, ENTER, EXTEND, FREETMPS, G_ARRAY, G_DISCARD, G_EVAL, GIMME, -G_NOARGS, G_SCALAR, gv_fetchmeth, gv_fetchmethod, 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, MARK, mg_clear, mg_copy, -mg_find, mg_free, mg_get, mg_len, mg_magical, mg_set, Move, na, New, Newc, -Newz, newAV, newHV, newRV_inc, newRV_noinc, newSV, newSViv, newSVnv, -newSVpv, newSVrv, newSVsv, newXS, newXSproto, Nullav, Nullch, Nullcv, -Nullhv, Nullsv, ORIGMARK, perl_alloc, perl_call_argv, perl_call_method, -perl_call_pv, perl_call_sv, perl_construct, perl_destruct, perl_eval_sv, -perl_free, perl_get_av, perl_get_cv, perl_get_hv, perl_get_sv, perl_parse, -perl_require_pv, perl_run, POPi, POPl, POPp, POPn, POPs, PUSHMARK, PUSHi, -PUSHn, PUSHp, PUSHs, PUTBACK, Renew, Renewc, RETVAL, safefree, safemalloc, -saferealloc, savepv, savepvn, SAVETMPS, SP, SPAGAIN, ST, strEQ, strGE, -strGT, strLE, strLT, strNE, strnEQ, strnNE, sv_2mortal, sv_bless, sv_catpv, -sv_catpvn, sv_catsv, sv_cmp, sv_cmp, SvCUR, SvCUR_set, sv_dec, sv_dec, -SvEND, sv_eq, SvGROW, sv_grow, sv_inc, SvIOK, SvIOK_off, SvIOK_on, -SvIOK_only, SvIOK_only, SvIOKp, sv_isa, SvIV, sv_isobject, SvIVX, SvLEN, -sv_len, sv_len, sv_magic, sv_mortalcopy, SvOK, sv_newmortal, sv_no, SvNIOK, +GIMME_V, G_NOARGS, G_SCALAR, G_VOID, gv_fetchmeth, gv_fetchmethod, +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, MARK, mg_clear, mg_copy, mg_find, mg_free, mg_get, mg_len, +mg_magical, mg_set, Move, na, New, Newc, Newz, newAV, newHV, newRV_inc, +newRV_noinc, newSV, newSViv, newSVnv, newSVpv, newSVrv, newSVsv, newXS, +newXSproto, Nullav, Nullch, Nullcv, Nullhv, Nullsv, ORIGMARK, perl_alloc, +perl_call_argv, perl_call_method, perl_call_pv, perl_call_sv, +perl_construct, perl_destruct, perl_eval_sv, perl_free, perl_get_av, +perl_get_cv, perl_get_hv, perl_get_sv, perl_parse, perl_require_pv, +perl_run, POPi, POPl, POPp, POPn, POPs, PUSHMARK, PUSHi, PUSHn, PUSHp, +PUSHs, PUTBACK, Renew, Renewc, RETVAL, safefree, safemalloc, saferealloc, +savepv, savepvn, SAVETMPS, SP, SPAGAIN, ST, strEQ, strGE, strGT, strLE, +strLT, strNE, strnEQ, strnNE, sv_2mortal, sv_bless, sv_catpv, sv_catpvn, +sv_catsv, sv_cmp, sv_cmp, SvCUR, SvCUR_set, sv_dec, sv_dec, SvEND, sv_eq, +SvGROW, sv_grow, sv_inc, SvIOK, SvIOK_off, SvIOK_on, SvIOK_only, +SvIOK_only, SvIOKp, sv_isa, SvIV, sv_isobject, SvIVX, SvLEN, sv_len, +sv_len, sv_magic, sv_mortalcopy, SvOK, sv_newmortal, sv_no, SvNIOK, SvNIOK_off, SvNIOKp, SvNOK, SvNOK_off, SvNOK_on, SvNOK_only, SvNOK_only, SvNOKp, SvNV, SvNVX, SvPOK, SvPOK_off, SvPOK_on, SvPOK_only, SvPOK_only, SvPOKp, SvPV, SvPVX, SvREFCNT, SvREFCNT_dec, SvREFCNT_inc, SvROK, @@ -2355,6 +2369,8 @@ B<perl_call_sv>, B<perl_call_pv>, B<perl_call_method>, B<perl_call_argv> =over +=item G_VOID + =item G_SCALAR =item G_ARRAY @@ -2363,11 +2379,11 @@ B<perl_call_sv>, B<perl_call_pv>, B<perl_call_method>, B<perl_call_argv> =item G_NOARGS -=item G_EVAL +=item G_EVAL =item G_KEEPERR -=item Determining the Context +=item Determining the Context =back @@ -2399,7 +2415,7 @@ B<perl_call_sv>, B<perl_call_pv>, B<perl_call_method>, B<perl_call_argv> =item Using perl_call_method -=item Using GIMME +=item Using GIMME_V =item Using Perl to dispose of temporaries @@ -2445,6 +2461,22 @@ callback =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 @@ -2693,10 +2725,14 @@ new, debug =item Standard Exports -timeit(COUNT, CODE), timethis, timethese, timediff, timestr +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 @@ -2719,6 +2755,271 @@ timeit(COUNT, CODE), timethis, timethese, timediff, timestr =item AUTHOR +=head2 CGI - Simple Common Gateway Interface Class + +=item ABSTRACT + +=item INSTALLATION: + +=item DESCRIPTION + +=over + +=item CREATING A NEW QUERY OBJECT: + +=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 SAVING THE STATE OF THE FORM TO A FILE: + +=item CREATING A SELF-REFERENCING URL THAT PRESERVES STATE INFORMATION: + +=item COMPATIBILITY WITH CGI-LIB.PL + +=item CALLING CGI FUNCTIONS THAT TAKE MULTIPLE ARGUMENTS + +=item CREATING THE HTTP HEADER: + +=item GENERATING A REDIRECTION INSTRUCTION + +=item CREATING THE HTML HEADER: + +B<Parameters:>, 4, 5, 6.. + +=item ENDING THE HTML DOCUMENT: + +=back + +=item CREATING FORMS: + +=over + +=item CREATING AN ISINDEX TAG + +=item STARTING AND ENDING A FORM + +B<application/x-www-form-urlencoded>, B<multipart/form-data> + +=item CREATING A TEXT FIELD + +B<Parameters> + +=item CREATING A BIG TEXT FIELD + +=item CREATING A PASSWORD FIELD + +=item CREATING A FILE UPLOAD FIELD + +B<Parameters> + +=item CREATING A POPUP MENU + +=item CREATING A SCROLLING LIST + +B<Parameters:> + +=item CREATING A GROUP OF RELATED CHECKBOXES + +B<Parameters:> + +=item CREATING A STANDALONE CHECKBOX + +B<Parameters:> + +=item CREATING A RADIO BUTTON GROUP + +B<Parameters:> + +=item CREATING A SUBMIT BUTTON + +B<Parameters:> + +=item CREATING A RESET BUTTON + +=item CREATING A DEFAULT BUTTON + +=item CREATING A HIDDEN FIELD + +B<Parameters:> + +=item CREATING A CLICKABLE IMAGE BUTTON + +B<Parameters:>, 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 <Frameset> document, 2. Specify the destination for the +document in the HTTP header, 3. Specify the destination for the document in +the <FORM> tag + +=item DEBUGGING + +=over + +=item DUMPING OUT ALL THE NAME/VALUE PAIRS + +=back + +=item FETCHING ENVIRONMENT VARIABLES + +B<accept()>, B<raw_cookie()>, B<user_agent()>, B<path_info()>, +B<path_translated()>, B<remote_host()>, B<script_name()>Return the script +name as a partial URL, for self-refering +scripts, B<referer()>, B<auth_type ()>, B<server_name ()>, B<virtual_host +()>, B<server_software ()>, B<remote_user ()>, B<user_name ()>, +B<request_method()> + +=item CREATING HTML ELEMENTS: + +=over + +=item PROVIDING ARGUMENTS TO HTML SHORTCUTS + +=item Generating new HTML tags + +=back + +=item IMPORTING CGI METHOD CALLS INTO YOUR NAME SPACE + +B<cgi>, B<form>, B<html2>, B<html3>, B<netscape>, B<shortcuts>, +B<standard>, B<all> + +=item USING NPH SCRIPTS + +In the B<use> statementSimply add ":nph" to the list of symbols to be +imported into your script:, By calling the B<nph()> method:, By using +B<-nph> parameters in the B<header()> and B<redirect()> statements: + +=item AUTHOR INFORMATION + +=item CREDITS + +Matt Heffron (heffron@falstaff.css.beckman.com), James Taylor +(james.taylor@srs.gov), Scott Anguish <sanguish@digifix.com>, 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), ...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 + +=item SEE ALSO + +=item AUTHOR + +=head2 CGI::Carp, B<CGI::Carp> - 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 + +=item CHANGE LOG + +=item AUTHORS + +=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 + +-last_page, -type, -delay, -cookie, -target, -expires + +=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 @@ -4067,6 +4368,27 @@ Constants, Macros =item CREATION +=head2 Pod::Html, 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 diff --git a/pod/perltoot.pod b/pod/perltoot.pod index a8a77f1c68..c23591245a 100644 --- a/pod/perltoot.pod +++ b/pod/perltoot.pod @@ -311,7 +311,7 @@ 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 +(Well, unless you use the Alias module described below in L</"Data Members as Variables">.) 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 @@ -350,7 +350,7 @@ Some might argue that one should go at these this way: } But since these methods are all executing in the class itself, this -may not be critical. There are trade-offs to be made. Using direct +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 @@ -1091,7 +1091,7 @@ 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 built-in to your Perl +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: @@ -1417,7 +1417,7 @@ 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 +object so you wouldn't have to access that class data directly from an object method. =head2 Inherited Autoloaded Data Methods @@ -1624,7 +1624,7 @@ 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 built-in function. +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 @@ -1688,7 +1688,7 @@ update value fields in the hash. Convenient, eh? The need for the C<use vars> declaration is because what Alias does is play with package globals with the same name as the fields. To use -globals while C<use strict> is in effect, you have to pre-declare them. +globals while C<use strict> 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 @@ -1726,7 +1726,7 @@ 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 built-in and user-defined +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 @@ -1737,7 +1737,7 @@ notion, but not the former. =head1 SEE ALSO -The following man pages will doubtless provide more +The following manpages will doubtless provide more background for this one: L<perlmod>, L<perlref>, @@ -1755,7 +1755,7 @@ experiences have mandated its inclusion: Copyright 1996 Tom Christiansen. All Rights Reserved. This work derives in part from the second edition of I<Programming Perl>. -Although destined for release as a man page with the standard Perl +Although destined for release as a manpage with the standard Perl distribution, it is not public domain (nor is any of Perl and its docset: publishers beware). It's expected to someday make its way into a revision of the Camel Book. While it is copyright by me with all rights reserved, diff --git a/pod/perltrap.pod b/pod/perltrap.pod index fd91182d1e..fd41f2ef4d 100644 --- a/pod/perltrap.pod +++ b/pod/perltrap.pod @@ -20,8 +20,8 @@ The English module, loaded via use English; -allows you to refer to special variables (like $RS) as -though they were in B<awk>; see L<perlvar> for details. +allows you to refer to special variables (like C<$/>) with names (like +C<$RS>), as though they were in B<awk>; see L<perlvar> for details. =item * @@ -57,8 +57,8 @@ comparisons. =item * Reading an input line does not split it for you. You get to split it -yourself to an array. And the split() operator has different -arguments. +to an array yourself. And the split() operator has different +arguments than B<awk>'s. =item * @@ -157,7 +157,7 @@ You must use C<elsif> rather than C<else if>. =item * -The C<break> and C<continue> keywords from C become in +The C<break> and C<continue> keywords from C become in Perl C<last> and C<next>, respectively. Unlike in C, these do I<NOT> work within a C<do { } while> construct. @@ -230,18 +230,18 @@ Sharp shell programmers should take note of the following: =item * -The back-tick operator does variable interpolation without regard to +The backtick operator does variable interpolation without regard to the presence of single quotes in the command. =item * -The back-tick operator does no translation of the return value, unlike B<csh>. +The backtick operator does no translation of the return value, unlike B<csh>. =item * Shells (especially B<csh>) do several levels of substitution on each command line. Perl does substitution in only certain constructs -such as double quotes, back-ticks, angle brackets, and search patterns. +such as double quotes, backticks, angle brackets, and search patterns. =item * @@ -274,14 +274,14 @@ context than they do in a scalar one. See L<perldata> 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 +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 built-ins -are unary operators (like chop() and chdir()) +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<only> list operators, never unary ones.) See L<perlop>. @@ -290,7 +290,7 @@ unary ones.) See L<perlop>. 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. +you might expect to do not. =item * @@ -299,7 +299,7 @@ operation on that handle. The data read is assigned to $_ only if the file read is the sole condition in a while loop: while (<FH>) { } - while ($_ = <FH>) { }.. + while (defined($_ = <FH>)) { }.. <FH>; # data discarded! =item * @@ -312,14 +312,14 @@ these two constructs are quite different: =item * -The C<do {}> construct isn't a real loop that you can use +The C<do {}> construct isn't a real loop that you can use loop control on. =item * -Use C<my()> for local variables whenever you can get away with -it (but see L<perlform> for where you can't). -Using C<local()> actually gives a local value to a global +Use C<my()> for local variables whenever you can get away with +it (but see L<perlform> for where you can't). +Using C<local()> actually gives a local value to a global variable, which leaves you open to unforeseen side-effects of dynamic scoping. @@ -333,7 +333,7 @@ external name is still an alias for the original. =head2 Perl4 to Perl5 Traps -Practicing Perl4 Programmers should take note of the following +Practicing Perl4 Programmers should take note of the following Perl4-to-Perl5 specific traps. They're crudely ordered according to the following list: @@ -397,11 +397,11 @@ 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. +a bug from perl4. =over 4 -=item * Discontinuance +=item * Discontinuance Symbols starting with "_" are no longer forced into package main, except for C<$_> itself (and C<@_>, etc.). @@ -411,11 +411,11 @@ for C<$_> itself (and C<@_>, etc.). package main; print "\$_legacy is ",$_legacy,"\n"; - + # perl4 prints: $_legacy is 1 # perl5 prints: $_legacy is -=item * Deprecation +=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. @@ -433,11 +433,11 @@ whether this should be classed as a bug or not. $x = 10 ; print "x=${'x}\n" ; - + # perl4 prints: x=10 # perl5 prints: Can't find string terminator "'" anywhere before EOF -Also see precedence traps, for parsing C<$:>. +Also see precedence traps, for parsing C<$:>. =item * BugFix @@ -446,39 +446,39 @@ context (as the Camel says) rather than list context. sub sub1{return(0,2) } # return a 2-elem array sub sub2{ return(1,2,3)} # return a 3-elem array - @a1 = ("a","b","c","d","e"); + @a1 = ("a","b","c","d","e"); @a2 = splice(@a1,&sub1,&sub2); print join(' ',@a2),"\n"; - + # perl4 prints: a b - # perl5 prints: c d e + # perl5 prints: c d e -=item * Discontinuance +=item * Discontinuance You can't do a C<goto> into a block that is optimized away. Darn. goto marker1; - for(1){ + for(1){ marker1: print "Here I is!\n"; - } - + } + # perl4 prints: Here I is! # perl5 dumps core (SEGV) -=item * Discontinuance +=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. +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: Bare word found where operator expected + # perl5 errors: Bareword found where operator expected =item * Discontinuance @@ -490,7 +490,7 @@ The archaic while/if BLOCK BLOCK syntax is no longer supported. else { print "False!"; } - + # perl4 prints: True! # perl5 errors: syntax error at test.pl line 1, near "if {" @@ -500,11 +500,11 @@ 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 +=item * Discontinuance The meaning of C<foreach{}> has changed slightly when it is iterating over a list which is not an array. This used to assign the list to a @@ -518,12 +518,12 @@ values. $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 +explicitly to a temporary array and then iterate over that. For example, you might need to change foreach $var (grep(/ab/,@list)){ @@ -556,10 +556,10 @@ 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: @@ -574,7 +574,7 @@ number of elements in the resulting list. @x = ('existing'); print push(@x, 'first new', 'second new'); - + # perl4 prints: second new # perl5 prints: 3 @@ -600,7 +600,7 @@ See L<perldiag> for full details. Some error messages will be different. -=item * Discontinuance +=item * Discontinuance Some bugs may have been inadvertently removed. :-) @@ -618,7 +618,7 @@ Note the space between . and = $string . = "more string"; print $string; - + # perl4 prints: more string # perl5 prints: syntax error at - line 1, near ". =" @@ -629,7 +629,7 @@ Better parsing in perl 5 sub foo {} &foo print("hello, world\n"); - + # perl4 prints: hello, world # perl5 prints: syntax error @@ -639,7 +639,7 @@ Better parsing in perl 5 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 @@ -657,12 +657,12 @@ operands, or output from same. Formatted output and significant digits print 7.373504 - 0, "\n"; - printf "%20.18f\n", 7.373504 - 0; - + printf "%20.18f\n", 7.373504 - 0; + # Perl4 prints: 7.375039999999996141 7.37503999999999614 - + # Perl5 prints: 7.373504 7.37503999999999614 @@ -676,7 +676,7 @@ If in doubt: use Math::BigInt; -=item * Numerical +=item * Numerical Assignment of return values from numeric equality tests does not work in perl5 when the test evaluates to false (0). @@ -706,7 +706,7 @@ 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 @@ -715,13 +715,13 @@ Negative array subscripts now count from the end of the array. Setting C<$#array> lower now discards array elements, and makes them impossible to recover. - @a = (a,b,c,d,e); + @a = (a,b,c,d,e); print "Before: ",join('',@a); - $#a =1; + $#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 @@ -729,11 +729,11 @@ impossible to recover. Hashes get defined before use - local($s,@a,%h); + 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 @@ -746,17 +746,17 @@ variable is localized subsequent to the assignment *b = *a; local(@a); print @b,"\n"; - + # perl4 prints: This is Perl 4 # perl5 prints: - + # Another example - + *fred = *barney; # fred is aliased to barney @barney = (1, 2, 4); # @fred; print "@fred"; # should print "1, 2, 4" - + # perl4 prints: 1 2 4 # perl5 prints: In string, @fred now must be written as \@fred @@ -770,7 +770,7 @@ does to auto(magic)increment. print ++$x," : "; print -$x," : "; print ++$x,"\n"; - + # perl4 prints: aab : -0 : 1 # perl5 prints: aab : -aab : aac @@ -788,13 +788,13 @@ perl 4 lets you modify constants: $_[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. @@ -805,7 +805,7 @@ perl 4 lets you modify constants: The behavior is slightly different for: print "$x", defined $x - + # perl 4: 1 # perl 5: <no output, $x is not called into existence> @@ -823,7 +823,7 @@ that perl4 exhibits for only scalars. sub test { local( *theArgument ) = @_; local( %aNewLocal ); # perl 4 != 5.001l,m - $aNewLocal{"aKey"} = "this should never appear"; + $aNewLocal{"aKey"} = "this should never appear"; print "SUB: ", $theArgument{"aKey"}, "\n"; $aNewLocal{"aKey"} = "level $GlobalLevel"; # what should print $GlobalLevel++; @@ -831,14 +831,14 @@ that perl4 exhibits for only scalars. &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 @@ -862,19 +862,19 @@ context. This means you can interpolate list values now. @<<<<< @||||| @>>>>> @fmt; . - write; - + write; + # perl4 errors: Please use commas to separate fields in file # perl5 prints: foo bar baz =item * (scalar context) -The C<caller()> function now returns a false value in a scalar context -if there is no caller. This lets library files determine if they're +The C<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. caller() ? (print "You rang?\n") : (print "Got a 0\n"); - + # perl4 errors: There is no caller # perl5 prints: Got a 0 @@ -886,7 +886,7 @@ 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 @@ -898,15 +898,15 @@ 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<printf()> works fine, though: printf STDOUT (@z); - print "\n"; - + print "\n"; + # perl4 prints: foobar # perl5 prints: foobar @@ -941,7 +941,7 @@ These are now semantic errors because of precedence: 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 @@ -963,7 +963,7 @@ would be erroneously parsed as On the other hand, - $a += /foo/ ? 1 : 2; + $a += /foo/ ? 1 : 2; now works as a C programmer would expect. @@ -975,7 +975,7 @@ 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) @@ -985,16 +985,16 @@ perl4 gives the special variable, C<$:> precedence, where perl5 treats C<$::> as main C<package> $a = "x"; print "$::a"; - + # perl 4 prints: -:a # perl 5 prints: x =item * Precedence -concatenation precedence over filetest operator? +concatenation precedence over filetest operator? + + -e $foo .= "q" - -e $foo .= "q" - # perl4 prints: no output # perl5 prints: Can't modify -e in concatenation @@ -1021,14 +1021,14 @@ All types of RE traps. =item * Regular Expression C<s'$lhs'$rhs'> now does no interpolation on either side. It used to -interpolate C<$lhs> but not C<$rhs>. (And still does not match a literal +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 @@ -1043,7 +1043,7 @@ state of the searched string is lost) &doit("blah"); } sub doit{local($_) = shift; print "Got $_ "} - + # perl4 prints: blah blah blah # perl5 prints: infinite loop blah... @@ -1072,7 +1072,7 @@ the whole match, just like C<$&>. Perl5 does not. "abcdef" =~ /b.*e/; print "\$+ = $+\n"; - + # perl4 prints: bcde # perl5 prints: @@ -1083,7 +1083,7 @@ substitution now returns the null string if it fails $string = "test"; $value = ($string =~ s/foo//); print $value, "\n"; - + # perl4 prints: 0 # perl5 prints: @@ -1091,13 +1091,13 @@ Also see L<Numerical Traps> for another example of this new feature. =item * Regular Expression -C<s`lhs`rhs`> (using back-ticks) is now a normal substitution, with no -back-tick expansion +C<s`lhs`rhs`> (using backticks) is now a normal substitution, with no +backtick expansion $string = ""; $string =~ s`^`hostname`; print $string, "\n"; - + # perl4 prints: <the local hostname> # perl5 prints: hostname @@ -1106,7 +1106,7 @@ back-tick expansion 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" @@ -1114,12 +1114,12 @@ 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'; + $grpc = 'a'; $opt = 'r'; $_ = 'bar'; s/^([^$grpc]*$grpc[$opt]?)/foo/; print ; - + # perl4 prints: foo # perl5 prints: foobar @@ -1134,11 +1134,11 @@ repeatedly, like C</x/> or C<m!x!>. if( &match() ) { # m?x? matches more then once print "perl4\n"; - } else { + } else { # m?x? matches only once - print "perl5\n"; + print "perl5\n"; } - + # perl4 prints: perl4 # perl5 prints: perl5 @@ -1156,7 +1156,7 @@ found using the C<pos()> function--see L<perlfunc/pos>). print $1 while ($test =~ /(o)/g); # pos $test = 0; # to get old behavior } - + # perl4 prints: oooooo # perl5.004 prints: oo @@ -1181,7 +1181,7 @@ 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 @@ -1192,10 +1192,10 @@ Use B<-w> to catch this one reverse is no longer allowed as the name of a sort subroutine. sub reverse{ print "yup "; $a <=> $b } - print sort reverse a,b,c; - + print sort reverse a,b,c; + # perl4 prints: yup yup yup yup abc - # perl5 prints: abc + # perl5 prints: abc =item * warn() won't let you specify a filehandle. @@ -1205,7 +1205,7 @@ filehandle in perl4. With perl5 it does not. warn STDERR "Foo!"; # perl4 prints: Foo! - # perl5 prints: String found where operator expected + # perl5 prints: String found where operator expected =back @@ -1215,47 +1215,47 @@ filehandle in perl4. With perl5 it does not. =item * (SysV) -Under HPUX, and some other SysV OS's, 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 +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 @_... "; - } + print "Got @_... "; + } $SIG{'INT'} = 'gotit'; - + $| = 1; $pid = fork; if ($pid) { kill('INT', $pid); sleep(1); kill('INT', $pid); - } else { + } else { while (1) {sleep(10);} - } - + } + # perl4 (HPUX) prints: Got INT... # perl5 (HPUX) prints: Got INT... Got INT... =item * (SysV) -Under SysV OS's, C<seek()> on a file opened to append C<E<gt>E<gt>> now does -the right thing w.r.t. the fopen() man page. e.g., - When a file is opened +Under SysV OSes, C<seek()> on a file opened to append C<E<gt>E<gt>> 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 ; + $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 @@ -1274,8 +1274,8 @@ within certain expressions, statements, contexts, or whatever. @ now always interpolates an array in double-quotish strings. - print "To: someone@somewhere.com\n"; - + print "To: someone@somewhere.com\n"; + # perl4 prints: To:someone@somewhere.com # perl5 errors : In string, @somewhere now must be written as \@somewhere @@ -1286,7 +1286,7 @@ 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 @@ -1322,8 +1322,8 @@ works fine, however. =item * Interpolation -Creation of hashes on the fly with C<eval "EXPR"> now requires either both -C<$>'s to be protected in the specification of the hash name, or both curlies +Creation of hashes on the fly with C<eval "EXPR"> 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<eval{}> if possible. @@ -1366,13 +1366,13 @@ causes the following result: 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. +You also have to be careful about array references. print "$foo{" @@ -1385,7 +1385,7 @@ Similarly, watch out for: $foo = "array"; print "\$$foo{bar}\n"; - + # perl4 prints: $array{bar} # perl5 prints: $ @@ -1402,9 +1402,9 @@ C<qq()> string passed to C<eval> \$count++; } ); - + # perl4 runs this ok - # perl5 prints: Can't find string terminator ")" + # perl5 prints: Can't find string terminator ")" =back @@ -1463,7 +1463,7 @@ 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: @@ -1473,12 +1473,12 @@ And the do.pl file has the following single line: Running doit.pl gives the following: # perl 4 prints: 3 (aborts the subroutine early) - # perl 5 prints: 8 + # perl 5 prints: 8 Same behavior if you replace C<do> with C<require>. =back -As always, if any of these are ever officially declared as bugs, +As always, if any of these are ever officially declared as bugs, they'll be fixed and removed. diff --git a/pod/perlvar.pod b/pod/perlvar.pod index 1406858331..b569465d15 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -52,7 +52,7 @@ The default input and pattern-searching space. The following pairs are equivalent: while (<>) {...} # equivalent in only while! - while ($_ = <>) {...} + while (defined($_ = <>)) {...} /^Subject:/ $_ =~ /^Subject:/ @@ -63,7 +63,7 @@ equivalent: chop chop($_) -Here are the places where Perl will assume $_ even if you +Here are the places where Perl will assume $_ even if you don't use it: =over 3 @@ -83,16 +83,16 @@ Various list functions like print() and unlink(). The pattern matching operations C<m//>, C<s///>, and C<tr///> when used without an C<=~> operator. -=item * +=item * The default iterator variable in a C<foreach> loop if no other variable is supplied. -=item * +=item * The implicit iterator variable in the grep() and map() functions. -=item * +=item * The default place to put an input record when a C<E<lt>FHE<gt>> operation's result is tested by itself as the sole criterion of a C<while> @@ -108,7 +108,7 @@ test. Note that outside of a C<while> test, this will not happen. =item $E<lt>I<digit>E<gt> -Contains the sub-pattern from the corresponding set of parentheses in +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 \digit.) These variables are all read-only. @@ -162,7 +162,7 @@ This variable is read-only. =item $* -Set to 1 to do multi-line matching within a string, 0 to tell Perl +Set to 1 to do multiline 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 @@ -199,15 +199,15 @@ number.) The input record separator, newline by default. Works like B<awk>'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 multicharacter string to match a -multi-character delimiter. 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.) +null string. (Note: An empty line cannot contain any spaces or tabs.) +You may set it to a multicharacter string to match a multicharacter +delimiter, or to C<undef> 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 $/; $_ = <FH>; # whole file now here @@ -222,10 +222,10 @@ better for something :-) =item $| -If set to nonzero, forces a flush after every write or print on the +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). +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 @@ -279,7 +279,7 @@ is a space. (Mnemonic: obvious, I think.) =item $; -The subscript separator for multi-dimensional array emulation. If you +The subscript separator for multidimensional array emulation. If you refer to a hash element as $foo{$a,$b,$c} @@ -302,7 +302,7 @@ keys contain binary data there might not be any safe value for "C<$;>". semi-semicolon. Yeah, I know, it's pretty lame, but "C<$,>" is already taken for something more important.) -Consider using "real" multi-dimensional arrays. +Consider using "real" multidimensional arrays. =item $OFMT @@ -372,7 +372,7 @@ appended. (Mnemonic: points to top of page.) =item $: The current set of characters after which a string may be broken to -fill continuation fields (starting with ^) in a format. Default is +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.) @@ -399,7 +399,7 @@ L<perlfunc/formline()>. =item $? -The status returned by the last pipe close, back-tick (C<``>) command, +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<$? E<gt>E<gt> 8>), and @@ -459,7 +459,7 @@ 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__}> -below. +as described below. =item $PROCESS_ID @@ -531,7 +531,8 @@ multiple groups. =item $0 Contains the name of the file containing the Perl script being -executed. Assigning to "C<$0>" modifies the argument area that the ps(1) +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<sh> and B<ksh>.) @@ -552,24 +553,15 @@ discouraged. =item $] -The string printed out when you say C<perl -v>. -(This is currently I<BROKEN>). -It can be used to -determine at the beginning of a script whether the perl interpreter -executing the script is in the right range of versions. If used in a -numeric context, returns the version + patchlevel / 1000. Example: - - # see if getc is available - ($version,$patchlevel) = - $] =~ /(\d+\.\d+).*\nPatch level: (\d+)/; - print STDERR "(No filename completion available.)\n" - if $version * 1000 + $patchlevel < 2016; - -or, used numerically, +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; -(Mnemonic: Is this version of perl in the right bracket?) +See also the documentation of C<use VERSION> and C<require VERSION> +for a convenient way to fail if the Perl interpreter is too old. =item $DEBUGGING @@ -704,7 +696,7 @@ the Perl script. Here are some other examples: $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 +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<perlsub>. @@ -749,9 +741,9 @@ 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 -DEMERGENCY_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<INSTALL> file for information on how to enable this option. As a disincentive to casual use of this advanced feature, there is no L<English> long name for diff --git a/pod/perlxs.pod b/pod/perlxs.pod index ebead849dc..13ad669531 100644 --- a/pod/perlxs.pod +++ b/pod/perlxs.pod @@ -172,7 +172,7 @@ explicitly. If PPCODE: directive is not used, C<void> return value should be used only for subroutines which do not return a value, I<even if> CODE: -directive is used which sets ST(0) explicitly. +directive is used which sets ST(0) explicitly. Older versions of this document recommended to use C<void> return value in such cases. It was discovered that this could lead to @@ -289,7 +289,7 @@ its parameters. The Perl usage is given first. $status = rpcb_gettime( "localhost", $timep ); -The XSUB follows. +The XSUB follows. bool_t rpcb_gettime(host,timep) @@ -319,7 +319,7 @@ above, this keyword does not affect the way the compiler handles RETVAL. =head2 The NO_INIT Keyword The NO_INIT keyword is used to indicate that a function -parameter is being used as only an output value. The B<xsubpp> +parameter is being used only as an output value. The B<xsubpp> 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 @@ -328,7 +328,7 @@ 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 as only an output variable and does +This function uses the timep variable only as an output variable and does not care about its initial contents. bool_t @@ -694,7 +694,7 @@ To disable version checking: =head2 The PROTOTYPES: Keyword The PROTOTYPES: keyword corresponds to B<xsubpp>'s C<-prototypes> and -C<-noprototypes> options. This keyword overrides the command-line options. +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. diff --git a/pod/perlxstut.pod b/pod/perlxstut.pod index e31de334a8..cdd4344b78 100644 --- a/pod/perlxstut.pod +++ b/pod/perlxstut.pod @@ -55,7 +55,7 @@ to use the following line: =item * -This document assumes that the executable named "perl" is Perl version 5. +This document assumes that the executable named "perl" is Perl version 5. Some systems may have installed Perl version 5 as "perl5". =back @@ -145,7 +145,7 @@ And the Mytest.xs file should look something like this: #ifdef __cplusplus } #endif - + PROTOTYPES: DISABLE MODULE = Mytest PACKAGE = Mytest @@ -185,11 +185,11 @@ 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: @@ -222,7 +222,7 @@ 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 re-run make to rebuild our new shared library. +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. @@ -453,7 +453,7 @@ 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 -pre-defined C libraries. To begin with, we will build a small library of +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 @@ -475,7 +475,7 @@ Also create a file mylib.c that looks like this: #include <stdlib.h> #include "./mylib.h" - + double foo(a, b, c) int a; @@ -705,7 +705,7 @@ definition is placed. 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 man page format, +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. @@ -718,7 +718,7 @@ See L<perlpod> 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 +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. diff --git a/pod/pod2html.PL b/pod/pod2html.PL index 1c53f6c090..de36cd7fc9 100644 --- a/pod/pod2html.PL +++ b/pod/pod2html.PL @@ -32,655 +32,147 @@ $Config{startperl} # In the following, perl variables are not expanded during extraction. print OUT <<'!NO!SUBS!'; +=pod -# -# pod2html - convert pod format to html -# Version 1.21 -# usage: pod2html [podfiles] -# Will read the cwd and parse all files with .pod extension -# if no arguments are given on the command line. -# -# Many helps, suggestions, and fixes from the perl5 porters, and all over. -# Bill Middleton - wjm@metronet.com -# -# Please send patches/fixes/features to me -# - -require 'find.pl'; - -*RS = */; -*ERRNO = *!; - - -################################################################################ -# Invoke with various levels of debugging possible -################################################################################ -while ($ARGV[0] =~ /^-d(.*)/) { - shift; - $Debug{ lc($1 || shift) }++; -} - -# ck for podnames on command line -while ($ARGV[0]) { - push(@Pods,shift); -} - -################################################################################ -# CONFIGURE - change the following to suit your OS and taste -################################################################################ -# The beginning of the url for the anchors to the other sections. -# Edit $type to suit. It's configured for relative url's now. -# Other possibilities are: -# $type = '<A HREF="file://localhost/usr/local/htmldir/'; # file url -# $type = '<A HREF="http://www.bozo.com/perl/manual/html/' # server - -$type = '<A HREF="'; - -################################################################################ -# location of all podfiles unless on command line -# $installprivlib='HD:usr:local:lib:perl5'; # uncomment for Mac -# $installprivlib='C:\usr\local\lib\perl5'; # uncomment for DOS (I hope) -# $installprivlib='/usr/local/lib/perl5'; # Unix -$installprivlib="./"; # Standard perl pod directory for intallation - -################################################################################ -# Where to write out the html files -# $installhtmldir='HD:usr:local:lib:perl5:html'; # uncomment for Mac -# $installhtmldir='C:\usr\local\lib\perl5\html'; # uncomment for DOS (I hope) -$installhtmldir = './'; - -# test for validness - -if(!(-d $installhtmldir)){ - print "Installation directory $installhtmldir does not exist, using cwd\n"; - print "Hit ^C now to edit this script and configure installhtmldir\n"; - $installhtmldir = '.'; -} - -################################################################################ -# the html extension, change to htm for DOS - -$htmlext = "html"; - -################################################################################ -# arbitrary name for this group of pods - -$package = "perl"; - -################################################################################ -# look in these pods for links to things not found within the current pod -# be careful tho, namespace collisions cause stupid links - -@inclusions = qw[ perlfunc perlvar perlrun perlop ]; - -################################################################################ -# Directory path separator -# $sep= ":"; # uncomment for Mac -# $sep= "\"; # uncomment for DOS - -$sep= "/"; - -################################################################################ -# Create 8.3 html files if this equals 1 - -$DOSify=0; - -################################################################################ -# Create maximum 32 character html files if this equals 1 -$MACify=0; - -################################################################################ -# END CONFIGURE -# Beyond here be dragons. :-) -################################################################################ - -$A = {}; # The beginning of all things - -unless(@Pods){ - find($installprivlib); - splice(@Pods,$#Pods+1,0,@modpods);; -} - -@Pods or die "aak, expected pods"; -open(INDEX,">".$installhtmldir.$sep."index.".$htmlext) or - (die "cant open index.$htmlext"); -print INDEX "\n<HTML>\n<HEAD>\n<TITLE>Index of all pods for $package</TITLE></HEAD>\n<BODY>\n"; -print INDEX "<H1>Index of all pods for $package</H1>\n<hr><UL>\n"; -# loop twice through the pods, first to learn the links, then to produce html -for $count (0,1) { - print STDERR "Scanning pods...\n" unless $count; -loop1: - foreach $podfh ( @Pods ) { - $didindex = 0; - $refname = $podfh; - $refname =~ s/\Q$installprivlib${sep}\E?//; - $refname =~ s/${sep}/::/g; - $refname =~ s/\.p(m|od)$//; - $refname =~ s/^pod:://; - $savename = $refname; - $refname =~ s/::/_/g; - if($DOSify && !$count){ # shorten the name for DOS - (length($refname) > 8) and ( $refname = substr($refname,0,8)); - while(defined($DosNames{$refname})){ - @refname=split(//,$refname); - # allow 25 of em - ($refname[$#refname] eq "z") and ($refname[$#refname] = "a"); - $refname[$#refname]++; - $refname=join('',@refname); - $refname =~ s/\W/_/g; - } - $DosNames{$refname} = 1; - $Podnames{$savename} = $refname . ".$htmlext"; - } - elsif(!$DOSify and !$count){ - $Podnames{$savename} = $refname . ".$htmlext"; - } - $pod = $savename; - Debug("files", "opening 2 $podfh" ); - print "Creating $Podnames{$savename} from $podfh\n" if $count; - $RS = "\n="; # grok pods by item (Nonstandard but effecient) - open($podfh,"<".$podfh) || die "can't open $podfh: $ERRNO"; - @all = <$podfh>; - close($podfh); - $RS = "\n"; - ($all[0] =~ s/^=//) || pop(@all); - for ($i=0;$i <= $#all;$i++){ splice(@all,$i+1,1) unless - (($all[$i] =~ s/=$//) && ($all[$i+1] !~ /^cut/)) ; # whoa.. - } - $in_list = 0; - unless (grep(/NAME/,@all)){ - print STDERR "NAME header not found in $podfh, skipping\n"; - #delete($Podnames{$savename}); - next loop1; - } - if ($count) { - next unless length($Podnames{$savename}); - open(HTML,">".$installhtmldir.$sep.$Podnames{$savename}) or - (die "can't create $Podnames{$savename}: $ERRNO"); - print HTML "<HTML><HEAD>"; - print HTML "<TITLE>$refname</TITLE>\n</HEAD>\n<BODY>"; - } - - for ($i = 0; $i <= $#all; $i++) { # decide what to do with each chunk - $all[$i] =~ /^(\w+)\s*(.*)\n?([^\0]*)$/ ; - ($cmd, $title, $rest) = ($1,$2,$3); - if(length($cmd)){$cutting =0;} - next if $cutting; - if(($title =~ /NAME/) and ($didindex == 0) and $count){ - print INDEX "<LI><A HREF=\"$Podnames{$savename}\">$rest</A>\n"; - $didindex=1; - } - if ($cmd eq "item") { - if ($count ) { # producing html - do_list("over",$all[$i],\$in_list,\$depth) unless $depth; - do_item($title,$rest,$in_list); - } - else { - # scan item - scan_thing("item",$title,$pod); - } - } - elsif ($cmd =~ /^head([12])/) { - $num = $1; - if ($count) { # producing html - do_hdr($num,$title,$rest,$depth); - } - else { - # header scan - scan_thing($cmd,$title,$pod); # skip head1 - } - } - elsif ($cmd =~ /^over/) { - $count and $depth and do_list("over",$all[$i+1],\$in_list,\$depth); - } - elsif ($cmd =~ /^back/) { - if ($count) { # producing html - ($depth) or next; # just skip it - do_list("back",$all[$i+1],\$in_list,\$depth); - do_rest("$title$rest"); - } - } - elsif ($cmd =~ /^cut/) { - next; - } - elsif ($cmd =~ /^for/) { # experimental pragma html - if ($count) { # producing html - if ($title =~ s/^html//) { - $in_html =1; - do_rest("$title$rest"); - } - } - } - elsif ($cmd =~ /^begin/) { # experimental pragma html - if ($count) { # producing html - if ($title =~ s/^html//) { - print HTML $title,"\n",$rest; - } - elsif ($title =~ /^end/) { - next; - } - } - } - elsif ($Debug{"misc"}) { - warn("unrecognized header: $cmd"); - } - } - # close open lists without '=back' stmts - if ($count) { # producing html - while ($depth) { - do_list("back",$all[$i+1],\$in_list,\$depth); - } - print HTML "\n</BODY>\n</HTML>\n"; - } - } -} -print INDEX "\n</UL></BODY>\n</HTML>\n"; - -sub do_list{ # setup a list type, depending on some grok logic - my($which,$next_one,$list_type,$depth) = @_; - my($key); - if ($which eq "over") { - unless ($next_one =~ /^item\s+(.*)/) { - warn "Bad list, $1\n" if $Debug{"misc"}; - } - $key = $1; - - if ($key =~ /^1\.?/) { - $$list_type = "OL"; - } elsif ($key =~ /\*\s*$/) { - $$list_type = "UL"; - } elsif ($key =~ /\*?\s*\w/) { - $$list_type = "DL"; - } else { - warn "unknown list type for item $key" if $Debug{"misc"}; - } - - print HTML qq{\n}; - print HTML qq{<$$list_type>}; - $$depth++; - } - elsif ($which eq "back") { - print HTML qq{\n</$$list_type>\n}; - $$depth--; - } -} - -sub do_hdr{ # headers - my($num,$title,$rest,$depth) = @_; - my($savename,$restofname); - print HTML qq{<p><hr>\n} if $num == 1; - ($savename = $title) =~ s/^(\w+)([\s,]+.*)/$1/; - $restofname = $2; - (defined($Podnames{$savename})) ? ($savename = $savename) : ($savename = 0); - process_thing(\$title,"NAME"); - print HTML qq{\n<H$num> }; - if($savename){ - print HTML "<A HREF=\"$Podnames{$savename}\">$savename$restofname</A>"; - } - else{ - print HTML $title; - } - print HTML qq{</H$num>\n}; - do_rest($rest); -} - -sub do_item{ # list items - my($title,$rest,$list_type) = @_; - my $bullet_only; - $bullet_only = ($title eq '*' and $list_type eq 'UL') ? 1 : 0; - my($savename); - $savename = $title; - (defined($Podnames{$savename})) ? ($savename = $savename) : ($savename = 0); - process_thing(\$title,"NAME"); - if ($list_type eq "DL") { - print HTML qq{\n<DT>\n}; - if($savename){ - print HTML "<A HREF=\"$Podnames{$savename}\">$savename $rest</A>\n</DT>"; - } - - else{ - (print HTML qq{\n<STRONG>\n}) unless ($title =~ /STRONG/); - print HTML $title; - if($title !~ /STRONG/){ - print HTML "\n</STRONG></DT>\n"; - } else { - print HTML "</DT>\n"; - } - } - print HTML qq{<DD>\n}; - } - else { - print HTML qq{\n<LI>}; - unless ($bullet_only or $list_type eq "OL") { - if($savename){ - print HTML "<A HREF=\"$savename.$htmlext\">$savename</A>"; - } - else{ - print HTML $title,"\n"; - } - } - } - do_rest($rest); -} - -sub do_rest{ # the rest of the chunk handled here - my($rest) = @_; - my(@lines,$p,$q,$line,,@paras,$inpre); - @paras = split(/\n\n\n*/,$rest); - for ($p = 0; $p <= $#paras; $p++) { - $paras[$p] =~ s/^\n//mg; - @lines = split(/\n/,$paras[$p]); - if ($in_html) { # handle =for html paragraphs - print HTML $paras[0]; - $in_html = 0; - next; - } - elsif ($lines[0] =~ /^\s+\w*\t.*/) { # listing or unordered list - print HTML qq{<UL>}; - foreach $line (@lines) { - ($line =~ /^\s+(\w*)\t(.*)/) && (($key,$rem) = ($1,$2)); - print HTML defined($Podnames{$key}) - ? "<LI>$type$Podnames{$key}\">$key<\/A>\t$rem</LI>\n" - : "<LI>$line</LI>\n"; - } - print HTML qq{</UL>\n}; - } - elsif ($lines[0] =~ /^\s/) { # preformatted code - if ($paras[$p] =~/>>|<</) { - print HTML qq{\n<PRE>\n}; - $inpre=1; - } - else { # Still cant beat XMP. Yes, I know - print HTML qq{\n<XMP>\n}; # it's been obsoleted... suggestions? - $inpre = 0; - } - while (defined($paras[$p])) { - @lines = split(/\n/,$paras[$p]); - foreach $q (@lines) { # mind your p's and q's here :-) - if ($paras[$p] =~ />>|<</) { - if ($inpre) { - process_thing(\$q,"HTML"); - } - else { - print HTML qq{\n</XMP>\n}; - print HTML qq{<PRE>\n}; - $inpre=1; - process_thing(\$q,"HTML"); - } - } - 1 while $q =~ s/\t+/' 'x (length($&) * 8 - length($`) % 8)/e; - print HTML $q,"\n"; - } - last if $paras[$p+1] !~ /^\s/; - $p++; - } - print HTML ($inpre==1) ? (qq{\n</PRE>\n}) : (qq{\n</XMP>\n}); - } - else { # other text - @lines = split(/\n/,$paras[$p]); - foreach $line (@lines) { - process_thing(\$line,"HTML"); - $line =~ s/STRONG([^>])/STRONG>$1/; # lame attempt to fix strong - print HTML qq{$line\n}; - } - } - print HTML qq{<p>}; - } -} - -sub process_thing{ # process a chunk, order important - my($thing,$htype) = @_; - pre_escapes($thing); - find_refs($thing,$htype); - post_escapes($thing); -} - -sub scan_thing{ # scan a chunk for later references - my($cmd,$title,$pod) = @_; - $_ = $title; - s/\n$//; - s/E<(.*?)>/&$1;/g; - # remove any formatting information for the headers - s/[SFCBI]<(.*?)>/$1/g; - # the "don't format me" thing - s/Z<>//g; - if ($cmd eq "item") { - /^\*/ and return; # skip bullets - /^\d+\./ and return; # skip numbers - s/(-[a-z]).*/$1/i; - trim($_); - return if defined $A->{$pod}->{"Items"}->{$_}; - $A->{$pod}->{"Items"}->{$_} = gensym($pod, $_); - $A->{$pod}->{"Items"}->{(split(' ',$_))[0]}=$A->{$pod}->{"Items"}->{$_}; - Debug("items", "item $_"); - if (!/^-\w$/ && /([%\$\@\w]+)/ && $1 ne $_ - && !defined($A->{$pod}->{"Items"}->{$_}) && ($_ ne $1)) - { - $A->{$pod}->{"Items"}->{$1} = $A->{$pod}->{"Items"}->{$_}; - Debug("items", "item $1 REF TO $_"); - } - if ( m{^(tr|y|s|m|q[qwx])/.*[^/]} ) { - my $pf = $1 . '//'; - $pf .= "/" if $1 eq "tr" || $1 eq "y" || $1 eq "s"; - if ($pf ne $_) { - $A->{$pod}->{"Items"}->{$pf} = $A->{$pod}->{"Items"}->{$_}; - Debug("items", "item $pf REF TO $_"); - } - } - } - elsif ($cmd =~ /^head[12]/) { - return if defined($A->{$pod}->{"Headers"}->{$_}); - $A->{$pod}->{"Headers"}->{$_} = gensym($pod, $_); - Debug("headers", "header $_"); - } - else { - warn "unrecognized header: $cmd" if $Debug; - } -} - - -sub picrefs { - my($char, $bigkey, $lilkey,$htype) = @_; - my($key,$ref,$podname); - for $podname ($pod,@inclusions) { - for $ref ( "Items", "Headers" ) { - if (defined $A->{$podname}->{$ref}->{$bigkey}) { - $value = $A->{$podname}->{$ref}->{$key = $bigkey}; - Debug("subs", "bigkey is $bigkey, value is $value\n"); - } - elsif (defined $A->{$podname}->{$ref}->{$lilkey}) { - $value = $A->{$podname}->{$ref}->{$key = $lilkey}; - return "" if $lilkey eq ''; - Debug("subs", "lilkey is $lilkey, value is $value\n"); - } - } - if (length($key)) { - ($pod2, $num) = $value =~ /^(.*)_(\S+_\d+)$/; - if ($htype eq "NAME") { - return "\n<A NAME=\"".$value."\">\n$bigkey</A>\n" - } - else { - 1; # break here - return "\n$type$Podnames{$pod2}\#".$value."\">$bigkey<\/A>\n"; - } - } - } - if ($char =~ /[IF]/) { - return "<EM>$bigkey</EM>"; - } elsif ($char =~ /C/) { - return "<CODE>$bigkey</CODE>"; - } else { - if($bigkey =~ /STRONG/){ - return $bigkey; - } - else { - return "<STRONG>$bigkey</STRONG>"; - } - } -} - -sub find_refs { - my($thing,$htype) = @_; - my($orig) = $$thing; - # LREF: a manpage(3f) we don't know about - for ($$thing) { - #s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))>:the I<$1>$2 manpage:g; - s@(\S+?://\S*[^.,;!?\s])@noremap(qq{<A HREF="$1">$1</A>})@ge; - s,([a-z0-9_.-]+\@([a-z0-9_-]+\.)+([a-z0-9_-]+)),noremap(qq{<A HREF="mailto:$1">$1</A>}),gie; - s/L<([^>]*)>/lrefs($1,$htype)/ge; - s/([CIBF])<(\W*?(-?\w*).*?)>/picrefs($1, $2, $3, $htype)/ge; - s/(S)<([^\/]\W*?(-?\w*).*?)>/picrefs($1, $2, $3, $htype)/ge; - s/((\w+)\(\))/picrefs("I", $1, $2,$htype)/ge; - s/([\$\@%](?!&[gl]t)([\w:]+|\W\b))/varrefs($1,$htype)/ge; - } - if ($$thing eq $orig && $htype eq "NAME") { - $$thing = picrefs("I", $$thing, "", $htype); - } - -} - -sub lrefs { - my($page, $item) = split(m#/#, $_[0], 2); - my($htype) = $_[1]; - my($podname); - my($section) = $page =~ /\((.*)\)/; - my $selfref; - if ($page =~ /^[A-Z]/ && $item) { - $selfref++; - $item = "$page/$item"; - $page = $pod; - } elsif (!$item && $page =~ /[^a-z\-]/ && $page !~ /^\$.$/) { - $selfref++; - $item = $page; - $page = $pod; - } - $item =~ s/\(\)$//; - if (!$item) { - if (!defined $section && defined $Podnames{$page}) { - return "\n$type$Podnames{$page}\">\nthe <EM>$page</EM> manpage<\/A>\n"; - } else { - (warn "Bizarre entry $page/$item") if $Debug; - return "the <EM>$_[0]</EM> manpage\n"; - } - } - - if ($item =~ s/"(.*)"/$1/ || ($item =~ /[^\w\/\-]/ && $item !~ /^\$.$/)) { - $text = "<EM>$item</EM>"; - $ref = "Headers"; - } else { - $text = "<EM>$item</EM>"; - $ref = "Items"; - } - for $podname ($pod, @inclusions) { - undef $value; - if ($ref eq "Items") { - if (defined($value = $A->{$podname}->{$ref}->{$item})) { - ($pod2,$num) = split(/_/,$value,2); # break here - return (($pod eq $pod2) && ($htype eq "NAME")) - ? "\n<A NAME=\"".$value."\">\n$text</A>\n" - : "\n$type$Podnames{$pod2}\#".$value."\">$text<\/A>\n"; - } - } - elsif ($ref eq "Headers") { - if (defined($value = $A->{$podname}->{$ref}->{$item})) { - ($pod2,$num) = split(/_/,$value,2); # break here - return (($pod eq $pod2) && ($htype eq "NAME")) - ? "\n<A NAME=\"".$value."\">\n$text</A>\n" - : "\n$type$Podnames{$pod2}\#".$value."\">$text<\/A>\n"; - } - } - } - warn "No $ref reference for $item (@_)" if $Debug; - return $text; -} - -sub varrefs { - my ($var,$htype) = @_; - for $podname ($pod,@inclusions) { - if ($value = $A->{$podname}->{"Items"}->{$var}) { - ($pod2,$num) = split(/_/,$value,2); - Debug("vars", "way cool -- var ref on $var"); - return (($pod eq $pod2) && ($htype eq "NAME")) # INHERIT $_, $pod - ? "\n<A NAME=\"".$value."\">\n$var</A>\n" - : "\n$type$Podnames{$pod2}\#".$value."\">$var<\/A>\n"; - } - } - Debug( "vars", "bummer, $var not a var"); - if($var =~ /STRONG/){ - return $var; - } - else{ - return "<STRONG>$var</STRONG>"; - } -} - -sub gensym { - my ($podname, $key) = @_; - $key =~ s/\s.*//; - ($key = lc($key)) =~ tr/a-z/_/cs; - my $name = "${podname}_${key}_0"; - $name =~ s/__/_/g; - while ($sawsym{$name}++) { - $name =~ s/_?(\d+)$/'_' . ($1 + 1)/e; - } - return $name; -} - -sub pre_escapes { # twiddle these, and stay up late :-) - my($thing) = @_; - for ($$thing) { - s/([\200-\377])/noremap("&#".ord($1).";")/ge; - s/"(.*?)"/``$1''/gs; - s/&/noremap("&")/ge; - s/<</noremap("<<")/eg; - s/([^ESIBLCF])</$1\<\;/g; - s/E<(\d+)>/\&#$1\;/g; # embedded numeric special - s/E<([^\/][^<>]*)>/\&$1\;/g; # embedded special - } -} -sub noremap { # adding translator for hibit chars soon - my $hide = $_[0]; - $hide =~ tr/\000-\177/\200-\377/; - $hide; -} - - -sub post_escapes { - my($thing) = @_; - for ($$thing) { - s/([^GM])>>/$1\>\;\>\;/g; - s/([^D][^"MGA])>/$1\>\;/g; - tr/\200-\377/\000-\177/; - } -} - -sub Debug { - my $level = shift; - print STDERR @_,"\n" if $Debug{$level}; -} - -sub dumptable { - my $t = shift; - print STDERR "TABLE DUMP $t\n"; - foreach $k (sort keys %$t) { - printf STDERR "%-20s <%s>\n", $t->{$k}, $k; - } -} -sub trim { - for (@_) { - s/^\s+//; - s/\s\n?$//; - } -} -sub wanted { - my $name = $name; - if (-f $_) { - if ($name =~ /\.p(m|od)$/){ - push(@modpods, $name) if ($name =~ /\.p(m|od)$/); - } - } -} +=head1 NAME +pod2html - convert .pod files to .html files + +=head1 SYNOPSIS + + pod2html --help --htmlroot=<name> --infile=<name> --outfile=<name> + --podpath=<name>:...:<name> --podroot=<name> + --libpods=<name>:...:<name> --recurse --norecurse --verbose + --index --noindex --title=<name> + +=head1 DESCRIPTION + +Converts files from pod format (see L<perlpod>) 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, E<lt>tchrist@perl.comE<gt>. + +=head1 BUGS + +See L<Pod::Html> for a list of known bugs in the translator. + +=head1 SEE ALSO + +L<perlpod>, L<Pod::HTML> + +=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: $!"; @@ -40,9 +40,8 @@ static bool srand_called = FALSE; PP(pp_stub) { dSP; - if (GIMME != G_ARRAY) { + if (GIMME_V == G_SCALAR) XPUSHs(&sv_undef); - } RETURN; } @@ -81,15 +80,18 @@ PP(pp_padav) PP(pp_padhv) { dSP; dTARGET; + I32 gimme; + XPUSHs(TARG); if (op->op_private & OPpLVAL_INTRO) SAVECLEARSV(curpad[op->op_targ]); if (op->op_flags & OPf_REF) RETURN; - if (GIMME == G_ARRAY) { /* array wanted */ + gimme = GIMME_V; + if (gimme == G_ARRAY) { RETURNOP(do_kv(ARGS)); } - else { + else if (gimme == G_SCALAR) { SV* sv = sv_newmortal(); if (HvFILL((HV*)TARG)) { sprintf(buf, "%ld/%ld", @@ -99,8 +101,8 @@ PP(pp_padhv) else sv_setiv(sv, 0); SETs(sv); - RETURN; } + RETURN; } PP(pp_padany) @@ -550,9 +552,9 @@ PP(pp_undef) hv_undef((HV*)sv); break; case SVt_PVCV: - if (!CvANON((CV*)sv) && cv_const_sv((CV*)sv)) + if (cv_const_sv((CV*)sv)) warn("Constant subroutine %s undefined", - GvENAME(CvGV((CV*)sv))); + CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv))); /* FALL THROUGH */ case SVt_PVFM: cv_undef((CV*)sv); @@ -834,7 +836,7 @@ PP(pp_lt) dSP; tryAMAGICbinSET(lt,0); { dPOPnv; - SETs((TOPn < value) ? &sv_yes : &sv_no); + SETs(boolSV(TOPn < value)); RETURN; } } @@ -844,7 +846,7 @@ PP(pp_gt) dSP; tryAMAGICbinSET(gt,0); { dPOPnv; - SETs((TOPn > value) ? &sv_yes : &sv_no); + SETs(boolSV(TOPn > value)); RETURN; } } @@ -854,7 +856,7 @@ PP(pp_le) dSP; tryAMAGICbinSET(le,0); { dPOPnv; - SETs((TOPn <= value) ? &sv_yes : &sv_no); + SETs(boolSV(TOPn <= value)); RETURN; } } @@ -864,7 +866,7 @@ PP(pp_ge) dSP; tryAMAGICbinSET(ge,0); { dPOPnv; - SETs((TOPn >= value) ? &sv_yes : &sv_no); + SETs(boolSV(TOPn >= value)); RETURN; } } @@ -874,7 +876,7 @@ PP(pp_ne) dSP; tryAMAGICbinSET(ne,0); { dPOPnv; - SETs((TOPn != value) ? &sv_yes : &sv_no); + SETs(boolSV(TOPn != value)); RETURN; } } @@ -909,7 +911,7 @@ PP(pp_slt) int cmp = ((op->op_private & OPpLOCALE) ? sv_cmp_locale(left, right) : sv_cmp(left, right)); - SETs( cmp < 0 ? &sv_yes : &sv_no ); + SETs(boolSV(cmp < 0)); RETURN; } } @@ -922,7 +924,7 @@ PP(pp_sgt) int cmp = ((op->op_private & OPpLOCALE) ? sv_cmp_locale(left, right) : sv_cmp(left, right)); - SETs( cmp > 0 ? &sv_yes : &sv_no ); + SETs(boolSV(cmp > 0)); RETURN; } } @@ -935,7 +937,7 @@ PP(pp_sle) int cmp = ((op->op_private & OPpLOCALE) ? sv_cmp_locale(left, right) : sv_cmp(left, right)); - SETs( cmp <= 0 ? &sv_yes : &sv_no ); + SETs(boolSV(cmp <= 0)); RETURN; } } @@ -948,7 +950,7 @@ PP(pp_sge) int cmp = ((op->op_private & OPpLOCALE) ? sv_cmp_locale(left, right) : sv_cmp(left, right)); - SETs( cmp >= 0 ? &sv_yes : &sv_no ); + SETs(boolSV(cmp >= 0)); RETURN; } } @@ -958,7 +960,7 @@ PP(pp_seq) dSP; tryAMAGICbinSET(seq,0); { dPOPTOPssrl; - SETs( sv_eq(left, right) ? &sv_yes : &sv_no ); + SETs(boolSV(sv_eq(left, right))); RETURN; } } @@ -968,7 +970,7 @@ PP(pp_sne) dSP; tryAMAGICbinSET(sne,0); { dPOPTOPssrl; - SETs( !sv_eq(left, right) ? &sv_yes : &sv_no ); + SETs(boolSV(!sv_eq(left, right))); RETURN; } } @@ -1092,7 +1094,7 @@ PP(pp_not) #ifdef OVERLOAD dSP; tryAMAGICunSET(not); #endif /* OVERLOAD */ - *stack_sp = SvTRUE(*stack_sp) ? &sv_no : &sv_yes; + *stack_sp = boolSV(!SvTRUE(*stack_sp)); return NORMAL; } @@ -1199,7 +1201,7 @@ PP(pp_i_lt) dSP; tryAMAGICbinSET(lt,0); { dPOPTOPiirl; - SETs((left < right) ? &sv_yes : &sv_no); + SETs(boolSV(left < right)); RETURN; } } @@ -1209,7 +1211,7 @@ PP(pp_i_gt) dSP; tryAMAGICbinSET(gt,0); { dPOPTOPiirl; - SETs((left > right) ? &sv_yes : &sv_no); + SETs(boolSV(left > right)); RETURN; } } @@ -1219,7 +1221,7 @@ PP(pp_i_le) dSP; tryAMAGICbinSET(le,0); { dPOPTOPiirl; - SETs((left <= right) ? &sv_yes : &sv_no); + SETs(boolSV(left <= right)); RETURN; } } @@ -1229,7 +1231,7 @@ PP(pp_i_ge) dSP; tryAMAGICbinSET(ge,0); { dPOPTOPiirl; - SETs((left >= right) ? &sv_yes : &sv_no); + SETs(boolSV(left >= right)); RETURN; } } @@ -1239,7 +1241,7 @@ PP(pp_i_eq) dSP; tryAMAGICbinSET(eq,0); { dPOPTOPiirl; - SETs((left == right) ? &sv_yes : &sv_no); + SETs(boolSV(left == right)); RETURN; } } @@ -1249,7 +1251,7 @@ PP(pp_i_ne) dSP; tryAMAGICbinSET(ne,0); { dPOPTOPiirl; - SETs((left != right) ? &sv_yes : &sv_no); + SETs(boolSV(left != right)); RETURN; } } @@ -1363,28 +1365,50 @@ PP(pp_srand) static U32 seed() { + /* + * 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 + U32 u; #ifdef VMS # include <starlet.h> unsigned int when[2]; _ckvmssts(sys$gettim(when)); - u = when[0] ^ when[1]; + /* Please tell us: Which value is seconds and what is the other here? */ + u = (U32)SEED_C1 * when[0] + (U32)SEED_C2 * when[1]; #else # ifdef HAS_GETTIMEOFDAY struct timeval when; gettimeofday(&when,(struct timezone *) 0); - u = when.tv_sec ^ when.tv_usec; + u = (U32)SEED_C1 * when.tv_sec + (U32)SEED_C2 * when.tv_usec; # else Time_t when; (void)time(&when); - u = when; + u = (U32)SEED_C1 * when; # endif #endif -#ifndef PLAN9 /* XXX Plan9 assembler chokes on this; fix needed */ - /* What is a good hashing algorithm here? */ - u ^= ( ( 269 * (U32)getpid()) - ^ (26107 * (U32)&when) - ^ (73819 * (U32)stack_sp)); + u += SEED_C3 * (U32)getpid(); + u += SEED_C4 * (U32)(UV)stack_sp; +#ifndef PLAN9 /* XXX Plan9 assembler chokes on this; fix needed */ + u += SEED_C5 * (U32)(UV)&when; #endif return u; } @@ -1999,22 +2023,23 @@ PP(pp_each) dSP; dTARGET; HV *hash = (HV*)POPs; HE *entry; + I32 gimme = GIMME_V; PUTBACK; - entry = hv_iternext(hash); /* might clobber stack_sp */ + entry = hv_iternext(hash); /* might clobber stack_sp */ SPAGAIN; EXTEND(SP, 2); if (entry) { - PUSHs(hv_iterkeysv(entry)); /* won't clobber stack_sp */ - if (GIMME == G_ARRAY) { + PUSHs(hv_iterkeysv(entry)); /* won't clobber stack_sp */ + if (gimme == G_ARRAY) { PUTBACK; - sv_setsv(TARG, hv_iterval(hash, entry)); /* might clobber stack_sp */ + sv_setsv(TARG, hv_iterval(hash, entry)); /* might hit stack_sp */ SPAGAIN; PUSHs(TARG); } } - else if (GIMME == G_SCALAR) + else if (gimme == G_SCALAR) RETPUSHUNDEF; RETURN; @@ -2033,6 +2058,8 @@ PP(pp_keys) PP(pp_delete) { dSP; + I32 gimme = GIMME_V; + I32 discard = (gimme == G_VOID) ? G_DISCARD : 0; SV *sv; HV *hv; @@ -2042,11 +2069,12 @@ PP(pp_delete) if (SvTYPE(hv) != SVt_PVHV) DIE("Not a HASH reference"); while (++MARK <= SP) { - sv = hv_delete_ent(hv, *MARK, - (op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0), 0); + sv = hv_delete_ent(hv, *MARK, discard, 0); *MARK = sv ? sv : &sv_undef; } - if (GIMME != G_ARRAY) { + if (discard) + SP = ORIGMARK; + else if (gimme == G_SCALAR) { MARK = ORIGMARK; *++MARK = *SP; SP = MARK; @@ -2057,11 +2085,11 @@ PP(pp_delete) hv = (HV*)POPs; if (SvTYPE(hv) != SVt_PVHV) DIE("Not a HASH reference"); - sv = hv_delete_ent(hv, keysv, - (op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0), 0); + sv = hv_delete_ent(hv, keysv, discard, 0); if (!sv) sv = &sv_undef; - PUSHs(sv); + if (!discard) + PUSHs(sv); } RETURN; } @@ -2490,7 +2518,7 @@ PP(pp_reverse) if (SP - MARK > 1) do_join(TARG, &sv_no, MARK, SP); else - sv_setsv(TARG, *SP); + sv_setsv(TARG, (SP > MARK) ? *SP : GvSV(defgv)); up = SvPV_force(TARG, len); if (len > 1) { down = SvPVX(TARG) + len - 1; @@ -2543,6 +2571,7 @@ PP(pp_unpack) dSP; dPOPPOPssrl; SV **oldsp = sp; + I32 gimme = GIMME_V; SV *sv; STRLEN llen; STRLEN rlen; @@ -2576,7 +2605,7 @@ PP(pp_unpack) double cdouble; static char* bitcount = 0; - if (GIMME != G_ARRAY) { /* arrange to do first one only */ + 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 == '%') { @@ -3215,7 +3244,7 @@ PP(pp_unpack) checksum = 0; } } - if (sp == oldsp && GIMME != G_ARRAY) + if (sp == oldsp && gimme == G_SCALAR) PUSHs(&sv_undef); RETURN; } @@ -3781,7 +3810,7 @@ PP(pp_split) I32 realarray = 0; I32 base; AV *oldstack = curstack; - I32 gimme = GIMME; + I32 gimme = GIMME_V; I32 oldsave = savestack_ix; #ifdef DEBUGGING @@ -23,7 +23,7 @@ #define WORD_ALIGN sizeof(U16) #endif -#define DOCATCH(o) (mustcatch ? docatch(o) : (o)) +#define DOCATCH(o) ((CATCH_GET == TRUE) ? docatch(o) : (o)) static OP *docatch _((OP *o)); static OP *doeval _((int gimme)); @@ -50,10 +50,14 @@ PP(pp_wantarray) if (cxix < 0) RETPUSHUNDEF; - if (cxstack[cxix].blk_gimme == G_ARRAY) + switch (cxstack[cxix].blk_gimme) { + case G_ARRAY: RETPUSHYES; - else + case G_SCALAR: RETPUSHNO; + default: + RETPUSHUNDEF; + } } PP(pp_regcmaybe) @@ -462,7 +466,7 @@ PP(pp_grepstart) if (stack_base + *markstack_ptr == sp) { (void)POPMARK; - if (GIMME != G_ARRAY) + if (GIMME_V == G_SCALAR) XPUSHs(&sv_no); RETURNOP(op->op_next->op_next); } @@ -525,6 +529,7 @@ PP(pp_mapwhile) /* All done yet? */ if (markstack_ptr[-1] > *markstack_ptr) { I32 items; + I32 gimme = GIMME_V; (void)POPMARK; /* pop top */ LEAVE; /* exit outer scope */ @@ -532,12 +537,12 @@ PP(pp_mapwhile) items = --*markstack_ptr - markstack_ptr[-1]; (void)POPMARK; /* pop dst */ SP = stack_base + POPMARK; /* pop original mark */ - if (GIMME != G_ARRAY) { + if (gimme == G_SCALAR) { dTARGET; XPUSHi(items); - RETURN; } - SP += items; + else if (gimme == G_ARRAY) + SP += items; RETURN; } else { @@ -628,7 +633,7 @@ PP(pp_sort) AV *oldstack; CONTEXT *cx; SV** newsp; - bool oldmustcatch = mustcatch; + bool oldcatch = CATCH_GET; SAVETMPS; SAVESPTR(op); @@ -639,7 +644,7 @@ PP(pp_sort) AvREAL_off(sortstack); av_extend(sortstack, 32); } - mustcatch = TRUE; + CATCH_SET(TRUE); SWITCHSTACK(curstack, sortstack); if (sortstash != stash) { firstgv = gv_fetchpv("a", TRUE, SVt_PV); @@ -656,7 +661,7 @@ PP(pp_sort) POPBLOCK(cx,curpm); SWITCHSTACK(sortstack, oldstack); - mustcatch = oldmustcatch; + CATCH_SET(oldcatch); } LEAVE; } @@ -812,16 +817,29 @@ char *label; I32 dowantarray() { + I32 gimme = block_gimme(); + return (gimme == G_VOID) ? G_SCALAR : gimme; +} + +I32 +block_gimme() +{ I32 cxix; cxix = dopoptosub(cxstack_ix); if (cxix < 0) return G_SCALAR; - if (cxstack[cxix].blk_gimme == G_ARRAY) - return G_ARRAY; - else + 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); + } } static I32 @@ -1036,6 +1054,7 @@ PP(pp_caller) register I32 cxix = dopoptosub(cxstack_ix); register CONTEXT *cx; I32 dbcxix; + I32 gimme; SV *sv; I32 count = 0; @@ -1087,7 +1106,11 @@ PP(pp_caller) PUSHs(sv_2mortal(newSVpv("(eval)",0))); PUSHs(sv_2mortal(newSViv(0))); } - PUSHs(sv_2mortal(newSViv((I32)cx->blk_gimme))); + gimme = (I32)cx->blk_gimme; + if (gimme == G_VOID) + PUSHs(&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); @@ -1239,7 +1262,7 @@ PP(pp_enteriter) { dSP; dMARK; register CONTEXT *cx; - I32 gimme = GIMME; + I32 gimme = GIMME_V; SV **svp; ENTER; @@ -1271,7 +1294,7 @@ PP(pp_enterloop) { dSP; register CONTEXT *cx; - I32 gimme = GIMME; + I32 gimme = GIMME_V; ENTER; SAVETMPS; @@ -1297,15 +1320,13 @@ PP(pp_leaveloop) mark = newsp; POPLOOP1(cx); /* Delay POPLOOP2 until stack values are safe */ - if (gimme == G_SCALAR) { - if (op->op_private & OPpLEAVE_VOID) - ; - else { - if (mark < SP) - *++newsp = sv_mortalcopy(*SP); - else - *++newsp = &sv_undef; - } + if (gimme == G_VOID) + ; /* do nothing */ + else if (gimme == G_SCALAR) { + if (mark < SP) + *++newsp = sv_mortalcopy(*SP); + else + *++newsp = &sv_undef; } else { while (mark < SP) @@ -1362,6 +1383,7 @@ PP(pp_return) 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(incgv), name, strlen(name), G_DISCARD); DIE("%s did not return a true value", name); @@ -1378,7 +1400,7 @@ PP(pp_return) else *++newsp = &sv_undef; } - else { + else if (gimme == G_ARRAY) { while (++MARK <= SP) *++newsp = (popsub2 && SvTEMP(*MARK)) ? *MARK : sv_mortalcopy(*MARK); @@ -1450,7 +1472,7 @@ PP(pp_last) else *++newsp = &sv_undef; } - else { + else if (gimme == G_ARRAY) { while (++MARK <= SP) *++newsp = ((pop2 == CXt_SUB) && SvTEMP(*MARK)) ? *MARK : sv_mortalcopy(*MARK); @@ -1843,7 +1865,7 @@ PP(pp_goto) if (curstack == signalstack) { restartop = retop; - Siglongjmp(top_env, 3); + JMPENV_JUMP(3); } RETURNOP(retop); @@ -1943,28 +1965,25 @@ OP *o; int ret; int oldrunlevel = runlevel; OP *oldop = op; - Sigjmp_buf oldtop; + dJMPENV; op = o; - Copy(top_env, oldtop, 1, Sigjmp_buf); #ifdef DEBUGGING - assert(mustcatch == TRUE); + assert(CATCH_GET == TRUE); + DEBUG_l(deb("(Setting up local jumplevel, runlevel = %d)\n", runlevel+1)); #endif - mustcatch = FALSE; - switch ((ret = Sigsetjmp(top_env,1))) { + switch ((ret = JMPENV_PUSH)) { default: /* topmost level handles it */ - Copy(oldtop, top_env, 1, Sigjmp_buf); + JMPENV_POP; runlevel = oldrunlevel; - mustcatch = TRUE; op = oldop; - Siglongjmp(top_env, ret); + JMPENV_JUMP(ret); /* NOTREACHED */ case 3: if (!restartop) { PerlIO_printf(PerlIO_stderr(), "panic: restartop\n"); break; } - mustcatch = FALSE; op = restartop; restartop = 0; /* FALL THROUGH */ @@ -1972,9 +1991,8 @@ OP *o; runops(); break; } - Copy(oldtop, top_env, 1, Sigjmp_buf); + JMPENV_POP; runlevel = oldrunlevel; - mustcatch = TRUE; op = oldop; return Nullop; } @@ -2078,7 +2096,9 @@ int gimme; rs = SvREFCNT_inc(nrs); compiling.cop_line = 0; SAVEFREEOP(eval_root); - if (gimme & G_ARRAY) + if (gimme & G_VOID) + scalarvoid(eval_root); + else if (gimme & G_ARRAY) list(eval_root); else scalar(eval_root); @@ -2235,7 +2255,7 @@ PP(pp_entereval) dSP; register CONTEXT *cx; dPOPss; - I32 gimme = GIMME, was = sub_generation; + I32 gimme = GIMME_V, was = sub_generation; char tmpbuf[32], *safestr; STRLEN len; OP *ret; @@ -2296,23 +2316,20 @@ PP(pp_leaveeval) POPEVAL(cx); retop = pop_return(); - if (gimme == G_SCALAR) { - if (op->op_private & OPpLEAVE_VOID) - MARK = newsp; + 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 { - MARK = newsp + 1; - if (MARK <= SP) { - if (SvFLAGS(TOPs) & SVs_TEMP) - *MARK = TOPs; - else - *MARK = sv_mortalcopy(TOPs); - } - else { - MEXTEND(mark,0); - *MARK = &sv_undef; - } + MEXTEND(mark,0); + *MARK = &sv_undef; } - SP = MARK; } else { for (mark = newsp + 1; mark <= SP; mark++) @@ -2328,10 +2345,10 @@ PP(pp_leaveeval) CvDEPTH(compcv) = 0; if (optype == OP_REQUIRE && - !(gimme == G_SCALAR ? SvTRUE(*sp) : sp > newsp)) { - char *name = cx->blk_eval.old_name; - + !(gimme == G_SCALAR ? SvTRUE(*sp) : sp > newsp)) + { /* Unassume the success we assumed earlier. */ + char *name = cx->blk_eval.old_name; (void)hv_delete(GvHVn(incgv), name, strlen(name), G_DISCARD); retop = die("%s did not return a true value", name); } @@ -2349,7 +2366,7 @@ PP(pp_entertry) { dSP; register CONTEXT *cx; - I32 gimme = GIMME; + I32 gimme = GIMME_V; ENTER; SAVETMPS; @@ -2379,21 +2396,19 @@ PP(pp_leavetry) POPEVAL(cx); pop_return(); - if (gimme == G_SCALAR) { - if (op->op_private & OPpLEAVE_VOID) - MARK = newsp; + 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 { - 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 = &sv_undef; - } + MEXTEND(mark,0); + *MARK = &sv_undef; } SP = MARK; } @@ -160,8 +160,7 @@ PP(pp_sassign) } if (tainting && tainted && !SvTAINTED(left)) TAINT_NOT; - SvSetSV(right, left); - SvSETMAGIC(right); + SvSetMagicSV(right, left); SETs(right); RETURN; } @@ -221,7 +220,7 @@ PP(pp_padsv) if (op->op_private & OPpLVAL_INTRO) SAVECLEARSV(curpad[op->op_targ]); else if (op->op_private & OPpDEREF) - vivify_ref(curpad[op->op_targ], op->op_flags & OPpDEREF); + vivify_ref(curpad[op->op_targ], op->op_private & OPpDEREF); } RETURN; } @@ -237,7 +236,7 @@ PP(pp_eq) dSP; tryAMAGICbinSET(eq,0); { dPOPnv; - SETs((TOPn == value) ? &sv_yes : &sv_no); + SETs(boolSV(TOPn == value)); RETURN; } } @@ -590,6 +589,7 @@ PP(pp_aassign) register SV *sv; register AV *ary; + I32 gimme; HV *hash; I32 i; int magic; @@ -744,7 +744,16 @@ PP(pp_aassign) tainting |= (uid && (euid != uid || egid != gid)); } delaymagic = 0; - if (GIMME == G_ARRAY) { + + 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 @@ -752,15 +761,8 @@ PP(pp_aassign) lelem = firstlelem + (relem - firstrelem); while (relem <= SP) *relem++ = (lelem <= lastlelem) ? *lelem++ : &sv_undef; - RETURN; - } - else { - dTARGET; - SP = firstrelem; - - SETi(lastrelem - firstrelem + 1); - RETURN; } + RETURN; } PP(pp_match) @@ -976,6 +978,7 @@ do_readline() PerlIO *fp; register IO *io = GvIO(last_in_gv); register I32 type = op->op_type; + I32 gimme = GIMME_V; MAGIC *mg; if (SvMAGICAL(last_in_gv) && (mg = mg_find((SV*)last_in_gv, 'q'))) { @@ -983,11 +986,11 @@ do_readline() XPUSHs(mg->mg_obj); PUTBACK; ENTER; - perl_call_method("READLINE", GIMME); + perl_call_method("READLINE", gimme); LEAVE; SPAGAIN; - if (GIMME == G_SCALAR) - SvSetSV_nosteal(TARG, TOPs); + if (gimme == G_SCALAR) + SvSetMagicSV_nosteal(TARG, TOPs); RETURN; } fp = Nullfp; @@ -1134,17 +1137,13 @@ do_readline() if (!fp) { if (dowarn && io && !(IoFLAGS(io) & IOf_START)) warn("Read on closed filehandle <%s>", GvENAME(last_in_gv)); - if (GIMME == G_SCALAR) { + if (gimme == G_SCALAR) { (void)SvOK_off(TARG); PUSHTARG; } RETURN; } - if (GIMME == G_ARRAY) { - sv = sv_2mortal(NEWSV(57, 80)); - offset = 0; - } - else { + if (gimme == G_SCALAR) { sv = TARG; if (SvROK(sv)) sv_unref(sv); @@ -1157,6 +1156,10 @@ do_readline() else offset = 0; } + else { + sv = sv_2mortal(NEWSV(57, 80)); + offset = 0; + } for (;;) { if (!sv_gets(sv, fp, offset)) { PerlIO_clearerr(fp); @@ -1170,7 +1173,7 @@ do_readline() else if (type == OP_GLOB) { (void)do_close(last_in_gv, FALSE); } - if (GIMME == G_SCALAR) { + if (gimme == G_SCALAR) { (void)SvOK_off(TARG); PUSHTARG; } @@ -1203,7 +1206,7 @@ do_readline() continue; } } - if (GIMME == G_ARRAY) { + if (gimme == G_ARRAY) { if (SvLEN(sv) - SvCUR(sv) > 20) { SvLEN_set(sv, SvCUR(sv)+1); Renew(SvPVX(sv), SvLEN(sv), char); @@ -1211,7 +1214,7 @@ do_readline() sv = sv_2mortal(NEWSV(58, 80)); continue; } - else if (!tmplen && SvLEN(sv) - SvCUR(sv) > 80) { + 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); @@ -1227,19 +1230,14 @@ PP(pp_enter) { dSP; register CONTEXT *cx; - I32 gimme; - - /* - * We don't just use the GIMME macro here because it assumes there's - * already a context, which ain't necessarily so at initial startup. - */ + I32 gimme = OP_GIMME(op, -1); - if (op->op_flags & OPf_KNOW) - gimme = op->op_flags & OPf_LIST; - else if (cxstack_ix >= 0) - gimme = cxstack[cxstack_ix].blk_gimme; - else - gimme = G_SCALAR; + if (gimme == -1) { + if (cxstack_ix >= 0) + gimme = cxstack[cxstack_ix].blk_gimme; + else + gimme = G_SCALAR; + } ENTER; @@ -1306,31 +1304,30 @@ PP(pp_leave) POPBLOCK(cx,newpm); - if (op->op_flags & OPf_KNOW) - gimme = op->op_flags & OPf_LIST; - else if (cxstack_ix >= 0) - gimme = cxstack[cxstack_ix].blk_gimme; - else - gimme = G_SCALAR; + gimme = OP_GIMME(op, -1); + if (gimme == -1) { + if (cxstack_ix >= 0) + gimme = cxstack[cxstack_ix].blk_gimme; + else + gimme = G_SCALAR; + } - if (gimme == G_SCALAR) { - if (op->op_private & OPpLEAVE_VOID) - SP = newsp; + 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 { - 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 = &sv_undef; - } - SP = MARK; + MEXTEND(mark,0); + *MARK = &sv_undef; } + SP = MARK; } - else { + else if (gimme == G_ARRAY) { for (mark = newsp + 1; mark <= SP; mark++) if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP))) *mark = sv_mortalcopy(*mark); @@ -1657,18 +1654,19 @@ PP(pp_grepwhile) /* All done yet? */ if (stack_base + *markstack_ptr > sp) { I32 items; + I32 gimme = GIMME_V; LEAVE; /* exit outer scope */ (void)POPMARK; /* pop src */ items = --*markstack_ptr - markstack_ptr[-1]; (void)POPMARK; /* pop dst */ SP = stack_base + POPMARK; /* pop original mark */ - if (GIMME != G_ARRAY) { + if (gimme == G_SCALAR) { dTARGET; XPUSHi(items); - RETURN; } - SP += items; + else if (gimme == G_ARRAY) + SP += items; RETURN; } else { @@ -1708,7 +1706,7 @@ PP(pp_leavesub) } SP = MARK; } - else { + else if (gimme == G_ARRAY) { for (MARK = newsp + 1; MARK <= SP; MARK++) { if (!SvTEMP(*MARK)) *MARK = sv_mortalcopy(*MARK); @@ -1791,7 +1789,9 @@ PP(pp_entersub) goto retry; } /* should call AUTOLOAD now? */ - if ((autogv = gv_autoload(GvESTASH(gv), GvNAME(gv), GvNAMELEN(gv)))) { + if ((autogv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), + FALSE))) + { cv = GvCV(autogv); goto retry; } @@ -1801,7 +1801,7 @@ PP(pp_entersub) DIE("Undefined subroutine &%s called", SvPVX(subname)); } - gimme = GIMME; + gimme = GIMME_V; if ((op->op_private & OPpENTERSUB_DB) && GvCV(DBsub) && !CvNODEBUG(cv)) { SV *oldsv = sv; sv = GvSV(DBsub); @@ -30,13 +30,6 @@ # include <sys/resource.h> #endif -/* Put this after #includes because fork and vfork prototypes may - conflict. -*/ -#ifndef HAS_VFORK -# define vfork fork -#endif - #if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */ # include <sys/socket.h> # include <netdb.h> @@ -91,6 +84,18 @@ extern int h_errno; #include <sys/file.h> #endif +/* Put this after #includes because fork and vfork prototypes may conflict. */ +#ifndef HAS_VFORK +# define vfork fork +#endif + +/* Put this after #includes because <unistd.h> defines _XOPEN_VERSION. */ +#if _XOPEN_VERSION >= 4 +# define Sock_size_t Size_t +#else +# define Sock_size_t int +#endif + #if !defined(HAS_MKDIR) || !defined(HAS_RMDIR) static int dooneliner _((char *cmd, char *filename)); #endif @@ -155,10 +160,17 @@ PP(pp_backtick) dSP; dTARGET; PerlIO *fp; char *tmps = POPp; + I32 gimme = GIMME_V; + TAINT_PROPER("``"); fp = my_popen(tmps, "r"); if (fp) { - if (GIMME == G_SCALAR) { + if (gimme == G_VOID) { + while (PerlIO_read(fp, buf, sizeof buf) > 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*/ @@ -188,7 +200,7 @@ PP(pp_backtick) } else { STATUS_NATIVE_SET(-1); - if (GIMME == G_SCALAR) + if (gimme == G_SCALAR) RETPUSHUNDEF; } @@ -320,7 +332,7 @@ PP(pp_close) else gv = (GV*)POPs; EXTEND(SP, 1); - PUSHs( do_close(gv, TRUE) ? &sv_yes : &sv_no ); + PUSHs(boolSV(do_close(gv, TRUE))); RETURN; } @@ -463,7 +475,7 @@ PP(pp_tie) SV **mark = stack_base + ++*markstack_ptr; /* reuse in entersub */ I32 markoff = mark - stack_base - 1; char *methname; - bool oldmustcatch = mustcatch; + bool oldcatch = CATCH_GET; varsv = mark[0]; if (SvTYPE(varsv) == SVt_PVHV) @@ -483,8 +495,8 @@ PP(pp_tie) Zero(&myop, 1, BINOP); myop.op_last = (OP *) &myop; myop.op_next = Nullop; - myop.op_flags = OPf_KNOW|OPf_STACKED; - mustcatch = TRUE; + myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED; + CATCH_SET(TRUE); ENTER; SAVESPTR(op); @@ -499,7 +511,7 @@ PP(pp_tie) runops(); SPAGAIN; - mustcatch = oldmustcatch; + CATCH_SET(oldcatch); sv = TOPs; if (sv_isobject(sv)) { if (SvTYPE(varsv) == SVt_PVHV || SvTYPE(varsv) == SVt_PVAV) { @@ -576,7 +588,7 @@ PP(pp_dbmopen) GV *gv; BINOP myop; SV *sv; - bool oldmustcatch = mustcatch; + bool oldcatch = CATCH_GET; hv = (HV*)POPs; @@ -594,8 +606,8 @@ PP(pp_dbmopen) Zero(&myop, 1, BINOP); myop.op_last = (OP *) &myop; myop.op_next = Nullop; - myop.op_flags = OPf_KNOW|OPf_STACKED; - mustcatch = TRUE; + myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED; + CATCH_SET(TRUE); ENTER; SAVESPTR(op); @@ -638,7 +650,7 @@ PP(pp_dbmopen) SPAGAIN; } - mustcatch = oldmustcatch; + CATCH_SET(oldcatch); if (sv_isobject(TOPs)) sv_magic((SV*)hv, TOPs, 'P', Nullch, 0); LEAVE; @@ -843,15 +855,16 @@ PP(pp_getc) gv = argvgv; if (SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) { + I32 gimme = GIMME_V; PUSHMARK(SP); XPUSHs(mg->mg_obj); PUTBACK; ENTER; - perl_call_method("GETC", GIMME); + perl_call_method("GETC", gimme); LEAVE; SPAGAIN; - if (GIMME == G_SCALAR) - SvSetSV_nosteal(TARG, TOPs); + if (gimme == G_SCALAR) + SvSetMagicSV_nosteal(TARG, TOPs); RETURN; } if (!gv || do_eof(gv)) /* make sure we have fp with something */ @@ -875,7 +888,7 @@ GV *gv; OP *retop; { register CONTEXT *cx; - I32 gimme = GIMME; + I32 gimme = GIMME_V; AV* padlist = CvPADLIST(cv); SV** svp = AvARRAY(padlist); @@ -1334,7 +1347,7 @@ PP(pp_eof) gv = last_in_gv; else gv = last_in_gv = (GV*)POPs; - PUSHs(!gv || do_eof(gv) ? &sv_yes : &sv_no); + PUSHs(boolSV(!gv || do_eof(gv))); RETURN; } @@ -1359,7 +1372,7 @@ PP(pp_seek) long offset = POPl; gv = last_in_gv = (GV*)POPs; - PUSHs( do_seek(gv, offset, whence) ? &sv_yes : &sv_no ); + PUSHs(boolSV(do_seek(gv, offset, whence))); RETURN; } @@ -1950,6 +1963,7 @@ PP(pp_stat) { dSP; GV *tmpgv; + I32 gimme; I32 max = 13; if (op->op_flags & OPf_REF) { @@ -1991,17 +2005,15 @@ PP(pp_stat) } } - if (GIMME != G_ARRAY) { - EXTEND(SP, 1); - if (max) - RETPUSHYES; - else - RETPUSHUNDEF; + 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)statcache.st_dev))); PUSHs(sv_2mortal(newSViv((I32)statcache.st_ino))); PUSHs(sv_2mortal(newSViv((I32)statcache.st_mode))); @@ -29,6 +29,7 @@ void av_undef _((AV* ar)); void av_unshift _((AV* ar, I32 num)); OP* bind_match _((I32 type, OP* left, OP* pat)); OP* block_end _((I32 floor, OP* seq)); +I32 block_gimme _((void)); int block_start _((int full)); void boot_core_UNIVERSAL _((void)); void call_list _((I32 oldscope, AV* list)); @@ -126,7 +127,7 @@ GP* gp_ref _((GP* gp)); GV* gv_AVadd _((GV* gv)); GV* gv_HVadd _((GV* gv)); GV* gv_IOadd _((GV* gv)); -GV* gv_autoload _((HV* stash, char* name, STRLEN len)); +GV* gv_autoload4 _((HV* stash, char* name, STRLEN len, I32 method)); void gv_check _((HV* stash)); void gv_efullname _((SV* sv, GV* gv)); void gv_efullname3 _((SV* sv, GV* gv, char* prefix)); @@ -70,3 +70,43 @@ SSPUSHINT(SAVEt_STACK_POS); \ } 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; + +#define dJMPENV JMPENV cur_env +#define JMPENV_PUSH (cur_env.je_prev = top_env, \ + cur_env.je_ret = Sigsetjmp(cur_env.je_buf,1), \ + top_env = &cur_env, \ + cur_env.je_mustcatch = FALSE, \ + cur_env.je_ret) +#define JMPENV_POP (top_env = cur_env.je_prev) +#define JMPENV_JUMP(v) (top_env->je_prev ? Siglongjmp(top_env->je_buf, (v)) \ + : ((v) == 2) ? exit(STATUS_NATIVE_EXPORT) \ + : (PerlIO_printf(PerlIO_stderr(), "panic: top_env\n"), \ + exit(1))) + +#define CATCH_GET (top_env->je_mustcatch) +#define CATCH_SET(v) (top_env->je_mustcatch = (v)) + @@ -557,20 +557,36 @@ SV *newRV_noinc _((SV *)); #define SvSETMAGIC(x) if (SvSMAGICAL(x)) mg_set(x) -#define SvSetSV(dst,src) if ((dst) != (src)) sv_setsv(dst,src) - -#define SvSetSV_nosteal(dst,src) \ +#define SvSetSV_and(dst,src,finally) \ + if ((dst) != (src)) { \ + sv_setsv(dst, src); \ + finally; \ + } +#define SvSetSV_nosteal_and(dst,src,finally) \ if ((dst) != (src)) { \ U32 tMpF = SvFLAGS(src) & SVs_TEMP; \ SvTEMP_off(src); \ sv_setsv(dst, src); \ SvFLAGS(src) |= tMpF; \ + finally; \ } +#define SvSetSV(dst,src) \ + SvSetSV_and(dst,src,) +#define SvSetSV_nosteal(dst,src) \ + SvSetSV_nosteal_and(dst,src,) + +#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)==&sv_undef || (sv)==&sv_yes || (sv)==&sv_no) +#define boolSV(b) ((b) ? &sv_yes : &sv_no) + #define isGV(sv) (SvTYPE(sv) == SVt_PVGV) #ifndef DOSISH diff --git a/t/op/arith.t b/t/op/arith.t new file mode 100644 index 0000000000..43af807b8b --- /dev/null +++ b/t/op/arith.t @@ -0,0 +1,12 @@ +#!./perl + +print "1..4\n"; + +sub try ($$) { + print +($_[1] ? "ok" : "not ok"), " $_[0]\n"; +} + +try 1, 13 % 4 == 1; +try 2, -13 % 4 == 3; +try 3, 13 % -4 == -3; +try 4, -13 % -4 == -1; diff --git a/t/op/method.t b/t/op/method.t index bdbc8a9673..e957d825ff 100755 --- a/t/op/method.t +++ b/t/op/method.t @@ -67,8 +67,11 @@ sub C::e; sub Y::f; $counter = 0; -@X::ISA = 'Y'; @Y::ISA = 'B'; +*Y::AUTOLOAD = *B::AUTOLOAD; + +@X::ISA = 'Y'; +*X::AUTOLOAD = *Y::AUTOLOAD; sub B::AUTOLOAD { my $c = ++$counter; diff --git a/t/op/taint.t b/t/op/taint.t index 66e26d82c9..d0ba887948 100755 --- a/t/op/taint.t +++ b/t/op/taint.t @@ -79,7 +79,7 @@ print PROG 'print "@ARGV\n"', "\n"; close PROG; my $echo = "$Invoke_Perl $ECHO"; -print "1..98\n"; +print "1..112\n"; # First, let's make sure that Perl is checking the dangerous # environment variables. Maybe they aren't set yet, so we'll @@ -444,3 +444,23 @@ print "1..98\n"; test 97, tainted $$fooref; test 98, tainted $foo; } + +# Some tests involving assignment +{ + my $foo = $TAINT0; + my $bar = $foo; + test 99, all_tainted $foo, $bar; + test 100, tainted($foo = $bar); + test 101, tainted($bar = $bar); + test 102, tainted($bar += $bar); + test 103, tainted($bar -= $bar); + test 104, tainted($bar *= $bar); + test 105, tainted($bar++); + test 106, tainted($bar /= $bar); + test 107, tainted($bar += 0); + test 108, tainted($bar -= 2); + test 109, tainted($bar *= -1); + test 110, tainted($bar /= 1); + test 111, tainted($bar--); + test 112, $bar == 0; +} diff --git a/t/pragma/constant.t b/t/pragma/constant.t new file mode 100644 index 0000000000..fdd08b85eb --- /dev/null +++ b/t/pragma/constant.t @@ -0,0 +1,141 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; +} + +BEGIN {$^W |= 1} # Insist upon warnings +use vars qw{ @warnings }; +BEGIN { # ...and save 'em for later + $SIG{'__WARN__'} = sub { push @warnings, @_ } +} +END { print @warnings } + +######################### We start with some black magic to print on failure. + +BEGIN { $| = 1; print "1..39\n"; } +END {print "not ok 1\n" unless $loaded;} +use constant; +$loaded = 1; +#print "# Version: $constant::VERSION\n"; +print "ok 1\n"; + +######################### End of black magic. + +use strict; + +sub test ($$;$) { + my($num, $bool, $diag) = @_; + if ($bool) { + print "ok $num\n"; + return; + } + print "not ok $num\n"; + return unless defined $diag; + $diag =~ s/\Z\n?/\n/; # unchomp + print map "# $num : $_", split m/^/m, $diag; +} + +use constant PI => 4 * atan2 1, 1; + +test 2, substr(PI, 0, 7) eq '3.14159'; +test 3, defined PI; + +sub deg2rad { PI * $_[0] / 180 } + +my $ninety = deg2rad 90; + +test 4, $ninety > 1.5707; +test 5, $ninety < 1.5708; + +use constant UNDEF1 => undef; # the right way +use constant UNDEF2 => ; # the weird way +use constant 'UNDEF3' ; # the 'short' way +use constant EMPTY => ( ) ; # the right way for lists + +test 6, not defined UNDEF1; +test 7, not defined UNDEF2; +test 8, not defined UNDEF3; +my @undef = UNDEF1; +test 9, @undef == 1; +test 10, not defined $undef[0]; +@undef = UNDEF2; +test 11, @undef == 0; +@undef = UNDEF3; +test 12, @undef == 0; +@undef = EMPTY; +test 13, @undef == 0; + +use constant COUNTDOWN => scalar reverse 1, 2, 3, 4, 5; +use constant COUNTLIST => reverse 1, 2, 3, 4, 5; +use constant COUNTLAST => (COUNTLIST)[-1]; + +test 14, COUNTDOWN eq '54321'; +my @cl = COUNTLIST; +test 15, @cl == 5; +test 16, COUNTDOWN eq join '', @cl; +test 17, COUNTLAST == 1; +test 18, (COUNTLIST)[1] == 4; + +use constant ABC => 'ABC'; +test 19, "abc${\( ABC )}abc" eq "abcABCabc"; + +use constant DEF => 'D', "\x45", chr 70; +test 20, "d e f @{[ DEF ]} d e f" eq "d e f D E F d e f"; + +use constant SINGLE => "'"; +use constant DOUBLE => '"'; +use constant BACK => '\\'; +my $tt = BACK . SINGLE . DOUBLE ; +test 21, $tt eq q(\\'"); + +use constant MESS => q('"'\\"'"\\); +test 22, MESS eq q('"'\\"'"\\); +test 23, length(MESS) == 8; + +use constant TRAILING => '12 cats'; +{ + my $save_warn; + local $^W; + BEGIN { $save_warn = $^W; $^W = 0 } + test 24, TRAILING == 12; + BEGIN { $^W = $save_warn } +} +test 25, TRAILING eq '12 cats'; + +use constant LEADING => " \t\n1234"; +test 26, LEADING == 1234; +test 27, LEADING eq " \t\n1234"; + +use constant ZERO1 => 0; +use constant ZERO2 => 0.0; +use constant ZERO3 => '0.0'; +test 28, ZERO1 eq '0'; +test 29, ZERO2 eq '0'; +test 30, ZERO3 eq '0.0'; + +{ + package Other; + use constant PI => 3.141; +} + +test 31, (PI > 3.1415 and PI < 3.1416); +test 32, Other::PI == 3.141; + +use constant E2BIG => $! = 7; +test 33, E2BIG == 7; +# This is something like "Arg list too long", but the actual message +# text may vary, so we can't test much better than this. +test 34, length(E2BIG) > 6; +test 35, index(E2BIG, " ") > 0; + +test 36, @warnings == 0, join "\n", "unexpected warning", @warnings; +@warnings = (); # just in case +undef &PI; +test 37, @warnings && + ($warnings[0] =~ /Constant sub.* undefined/), + shift @warnings; + +test 38, @warnings == 0, "unexpected warning"; +test 39, $^W & 1, "Who disabled the warnings?"; @@ -1458,8 +1458,7 @@ yylex() retry: switch (*s) { default: - warn("Unrecognized character \\%03o ignored", *s++ & 255); - goto retry; + croak("Unrecognized character \\%03o", *s & 255); case 4: case 26: goto fake_eof; /* emulate EOF on ^D or ^Z */ @@ -1499,14 +1498,28 @@ yylex() if (gv) GvIMPORTED_AV_on(gv); if (minus_F) { - char tmpbuf1[50]; - if ( splitstr[0] == '/' || - splitstr[0] == '\'' || - splitstr[0] == '"' ) - sprintf( tmpbuf1, "@F=split(%s);", splitstr ); - else - sprintf( tmpbuf1, "@F=split('%s');", splitstr ); + char *tmpbuf1; + New(201, tmpbuf1, strlen(splitstr) * 2 + 20, char); + if (strchr("/'\"", *splitstr) + && strchr(splitstr + 1, *splitstr)) + sprintf(tmpbuf1, "@F=split(%s);", splitstr); + else { + char delim; + s = "'~#\200\1'"; /* surely one char is unused...*/ + while (s[1] && strchr(splitstr, *s)) s++; + delim = *s; + sprintf(tmpbuf1, "@F=split(%s%c", + "q" + (delim == '\''), delim); + d = tmpbuf1 + strlen(tmpbuf1); + for (s = splitstr; *s; ) { + if (*s == '\\') + *d++ = '\\'; + *d++ = *s++; + } + sprintf(d, "%c);", delim); + } sv_catpv(linestr,tmpbuf1); + Safefree(tmpbuf1); } else sv_catpv(linestr,"@F=split(' ');"); @@ -1704,7 +1717,9 @@ yylex() } goto retry; case '\r': - croak("Illegal character \\%03o (carriage return)", '\r'); + warn("Illegal character \\%03o (carriage return)", '\r'); + croak( + "(Maybe you didn't strip carriage returns after a network transfer?)\n"); case ' ': case '\t': case '\f': case 013: s++; goto retry; @@ -2504,7 +2519,7 @@ yylex() curcop->cop_line++; } else - no_op("Bare word",s); + no_op("Bareword",s); } /* Look for a subroutine with this name in current package. */ @@ -5174,7 +5189,9 @@ char *s; char *context = NULL; int contlen = -1; - if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 && + if (!yychar || (yychar == ';' && !rsfp)) + where = "at EOF"; + else if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 && oldoldbufptr != oldbufptr && oldbufptr != bufptr) { while (isSPACE(*oldoldbufptr)) oldoldbufptr++; @@ -5190,8 +5207,6 @@ char *s; } else if (yychar > 255) where = "next token ???"; - else if (!yychar || (yychar == ';' && !rsfp)) - where = "at EOF"; else if ((yychar & 127) == 127) { if (lex_state == LEX_NORMAL || (lex_state == LEX_KNOWNEXT && lex_defer == LEX_NORMAL)) diff --git a/universal.c b/universal.c index 03b907de0c..938538f2a6 100644 --- a/universal.c +++ b/universal.c @@ -120,8 +120,7 @@ XS(XS_UNIVERSAL_isa) sv = ST(0); name = (char *)SvPV(ST(1),na); - ST(0) = (sv_derived_from(sv, name) ? &sv_yes : &sv_no) ; - + ST(0) = boolSV(sv_derived_from(sv, name)); XSRETURN(1); } @@ -150,7 +150,7 @@ MEM_SIZE size; /* safe version of free */ -void +Free_t safefree(where) Malloc_t where; { @@ -1209,7 +1209,7 @@ die(pat, va_alist) restartop = die_where(message); if ((!restartop && was_in_eval) || oldrunlevel > 1) - Siglongjmp(top_env, 3); + JMPENV_JUMP(3); return restartop; } @@ -1264,7 +1264,7 @@ croak(pat, va_alist) } if (in_eval) { restartop = die_where(message); - Siglongjmp(top_env, 3); + JMPENV_JUMP(3); } PerlIO_puts(PerlIO_stderr(),message); (void)PerlIO_flush(PerlIO_stderr()); diff --git a/utils/perlbug.PL b/utils/perlbug.PL index 2b676a4ae5..9ac6fb4315 100644 --- a/utils/perlbug.PL +++ b/utils/perlbug.PL @@ -166,9 +166,14 @@ sub Query { paraprint <<EOF; This program provides an easy way to create a message reporting a bug in perl, and e-mail it to $address. It is *NOT* intended for -sending test messages or simply verifying that perl works. It is *ONLY* -a means of reporting verifiable problems with perl, and any solutions to -such problems, to the people who maintain perl. +sending test messages or simply verifying that perl works, *NOR* is it +intended for reporting bugs in third-party perl modules. It is *ONLY* +a means of reporting verifiable problems with the core perl distribution, +and any solutions to such problems, to the people who maintain perl. + +If you're just looking for help with perl, try posting to the Usenet +newsgroup comp.lang.perl.misc. If you're looking for help with using +perl with CGI, try posting to comp.infosystems.www.programming.cgi. EOF @@ -471,11 +476,10 @@ EOF --- Environment for perl $]: EOF - for my $env (qw(PATH LD_LIBRARY_PATH - PERL5LIB PERLLIB PERL5DB - LC_ALL LC_COLLATE LC_CTYPE LC_MONETARY LC_NUMERIC LC_TIME - LANG PERL_BADLANG - SHELL HOME LOGDIR)) { + for my $env (qw(PATH LD_LIBRARY_PATH), + sort grep { /^(?:PERL|LC_)/ } keys %ENV, + qw(LANG PERL_BADLANG + SHELL HOME LOGDIR)) { print OUT " $env", exists $ENV{$env} ? "=$ENV{$env}" : ' (unset)', "\n"; diff --git a/vms/config.vms b/vms/config.vms index a189724240..e7bb57a0f9 100644 --- a/vms/config.vms +++ b/vms/config.vms @@ -76,7 +76,7 @@ * when Perl is built. Please do not change it by hand; make * any changes to FndVers.Com instead. */ -#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00395" /**/ +#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00396" /**/ #define ARCHLIB ARCHLIB_EXP /*config-skip*/ /* ARCHNAME: diff --git a/vms/descrip.mms b/vms/descrip.mms index de8d07a090..7ebdde4c27 100644 --- a/vms/descrip.mms +++ b/vms/descrip.mms @@ -65,7 +65,7 @@ OBJVAL = $(MMS$TARGET_NAME)$(O) .endif # Updated by fndvers.com -- do not edit by hand -PERL_VERSION = 5_00395# +PERL_VERSION = 5_00396# ARCHDIR = [.lib.$(ARCH).$(PERL_VERSION)] @@ -4054,7 +4054,7 @@ candelete_fromperl(CV *cv) } } - ST(0) = cando_by_name(S_IDUSR,0,fsp) ? &sv_yes : &sv_no; + ST(0) = boolSV(cando_by_name(S_IDUSR,0,fsp)); XSRETURN(1); } @@ -4107,7 +4107,7 @@ rmscopy_fromperl(CV *cv) } date_flag = (items == 3) ? SvIV(ST(2)) : 0; - ST(0) = rmscopy(inp,outp,date_flag) ? &sv_yes : &sv_no; + ST(0) = boolSV(rmscopy(inp,outp,date_flag)); XSRETURN(1); } diff --git a/win32/Makefile b/win32/Makefile index 5dbfb3c92f..1136d15097 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -33,6 +33,7 @@ EXTUTILSDIR=$(LIBDIR)\extutils # # various targets PERLLIB=..\libperl.lib +PERLIMPLIB=..\perl.lib MINIPERL=..\miniperl.exe PERLDLL=..\perl.dll PERLEXE=..\perl.exe @@ -146,7 +147,7 @@ $(PERLEXE): $(MINIPERL) modules.lib $(PERLDLL) attrib -r ..\t\*.* copy test ..\t $(XCOPY) ..\*.h ..\lib\CORE\*.* - $(XCOPY) ..\perl.lib ..\lib\CORE + $(XCOPY) $(PERLIMPLIB) ..\lib\CORE $(XCOPY) $(PERLLIB) ..\lib\CORE $(XCOPY) *.h ..\lib\CORE $(XCOPY) /S include ..\lib\CORE @@ -240,15 +241,17 @@ utils: $(PERLEXE) cd ..\win32 distclean: - -del /f $(MINIPERL) $(PERLEXE) $(PERLDLL) $(GLOBEXE) \ - $(PERLLIB) modules.lib + -del /f $(MINIPERL) $(PERLEXE) $(PERLDLL) $(GLOBEXE) $(PERLLIB) \ + $(PERLIMPLIB) ..\miniperl.lib modules.lib -del /f *.def - -del /f $(SOCKET_DLL) $(IO_DLL) $(SDBM_FILE_DLL) \ - $(FCNTL_DLL) $(OPCODE_DLL) - -del /f $(SOCKET).c $(IO).c $(SDBM_FILE).c $(FCNTL).c \ - $(OPCODE).c $(DYNALOADER).c + -del /f $(SOCKET_DLL) $(IO_DLL) $(SDBM_FILE_DLL) $(FCNTL_DLL) \ + $(OPCODE_DLL) + -del /f $(SOCKET).c $(IO).c $(SDBM_FILE).c $(FCNTL).c $(OPCODE).c \ + $(DYNALOADER).c -del /f $(PODDIR)\*.html -del /f $(PODDIR)\*.bat + -rmdir /s /q ..\lib\auto + -rmdir /s /q ..\lib\CORE -rmdir /s /q release -rmdir /s /q debug diff --git a/win32/bin/PL2BAT.BAT b/win32/bin/PL2BAT.BAT deleted file mode 100644 index 462affa7d0..0000000000 --- a/win32/bin/PL2BAT.BAT +++ /dev/null @@ -1,40 +0,0 @@ -@rem = ' -@echo off -perl -S %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9 -goto endofperl -@rem '; - -$head = <<'--end--'; -@rem = '--*-Perl-*--'; -@rem = ' -@echo off -perl -S %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9 -goto endofperl -@rem '; ---end-- - -$tail = "__END__\n:endofperl\n"; - -if ( @ARGV ) { - LOOP: - foreach ( @ARGV ) { - open( FILE, $_ ); - @file = <FILE>; - if ( grep( /:endofperl/, @file ) ) { - warn "$_ has already been converted to a batch file!!\n"; - next LOOP; - } - close( FILE, $_ ); - s/\.pl//; - s/\.bat//; - open( FILE, ">$_.bat" ); - print FILE $head, @file, $tail; - close( FILE ); - } -} else { - @file = <STDIN>; - print $head, @file, $tail; -} - -__END__ -:endofperl diff --git a/win32/bin/pl2bat.bat b/win32/bin/pl2bat.bat new file mode 100644 index 0000000000..7f5f39aa95 --- /dev/null +++ b/win32/bin/pl2bat.bat @@ -0,0 +1,54 @@ +@rem = '--*-Perl-*-- +@echo off +perl -x -S %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9 +goto endofperl +@rem '; +#!perl -w +#line 8 +(my $head = <<'--end--') =~ s/^\t//gm; + @rem = '--*-Perl-*-- + @echo off + perl -x -S %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9 + goto endofperl + @rem '; +--end-- +my $headlines = 2 + ($head =~ tr/\n/\n/); +my $tail = "__END__\n:endofperl\n"; + +@ARGV = ('-') unless @ARGV; + +process(@ARGV); + +sub process { + LOOP: + foreach ( @_ ) { + my $myhead = $head; + my $linedone = 0; + my $linenum = $headlines; + my $line; + open( FILE, $_ ) or die "Can't open $_: $!"; + @file = <FILE>; + foreach $line ( @file ) { + $linenum++; + if ( $line =~ /^:endofperl/) { + warn "$_ has already been converted to a batch file!\n"; + next LOOP; + } + if ( not $linedone and $line =~ /^#!.*perl/ ) { + $line .= "#line $linenum\n"; + $linedone++; + } + } + close( FILE ); + s/\.pl$//; + $_ .= '.bat' unless /\.bat$/ or /^-$/; + open( FILE, ">$_" ) or die "Can't open $_: $!"; + $myhead =~ s/perl -x/perl/ unless $linedone; + print FILE $myhead; + print FILE "#line $headlines\n" unless $linedone; + print FILE @file, $tail; + close( FILE ); + } +} +__END__ +:endofperl diff --git a/win32/bin/search.bat b/win32/bin/search.bat index 0bb123759f..88e83e5040 100644 --- a/win32/bin/search.bat +++ b/win32/bin/search.bat @@ -653,7 +653,7 @@ sub read_rc print "reading RC file: $file\n" if $show; - while ($_ = ($use_default ? shift(@default) : <RC>)) { + while (defined($_ = ($use_default ? shift(@default) : <RC>))) { $ln = ++$line_num; ## note starting line num. $_ .= <RC>, $line_num++ while s/\\\n?$/\n/; ## allow continuations next if /^\s*(#.*)?$/; ## skip blank or comment-only lines. diff --git a/win32/makedef.pl b/win32/makedef.pl index dfd507a865..7a1ddb20be 100644 --- a/win32/makedef.pl +++ b/win32/makedef.pl @@ -208,12 +208,6 @@ perl_call_pv perl_call_method perl_call_sv perl_requirepv -win32_inet_addr -win32_gethostbyname -win32_inet_ntoa -win32_htons -win32_ntohs -win32_htonl win32_stat win32_errno win32_stderr @@ -258,3 +252,45 @@ win32_read win32_write win32_spawnvpe win32_spawnle +win32_htons +win32_ntohs +win32_htonl +win32_ntohl +win32_inet_addr +win32_inet_ntoa +win32_socket +win32_bind +win32_listen +win32_accept +win32_connect +win32_send +win32_sendto +win32_recv +win32_recvfrom +win32_shutdown +win32_ioctlsocket +win32_setsockopt +win32_getsockopt +win32_getpeername +win32_getsockname +win32_gethostname +win32_gethostbyname +win32_gethostbyaddr +win32_getprotobyname +win32_getprotobynumber +win32_getservbyname +win32_getservbyport +win32_select +win32_endhostent +win32_endnetent +win32_endprotoent +win32_endservent +win32_getnetent +win32_getnetbyname +win32_getnetbyaddr +win32_getprotoent +win32_getservent +win32_sethostent +win32_setnetent +win32_setprotoent +win32_setservent diff --git a/win32/modules.mak b/win32/modules.mak index 2c4b0bf591..81812ebdc9 100644 --- a/win32/modules.mak +++ b/win32/modules.mak @@ -59,9 +59,9 @@ CLEAN : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" # ADD BASE CPP /nologo /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c -# ADD CPP /nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "MSDOS" /YX /c +# ADD CPP /nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "PERLDLL" /YX /c CPP_PROJ=/nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "NDEBUG" /D\ - "WIN32" /D "_WINDOWS" /D "MSDOS" /Fp"$(INTDIR)/modules.pch" /YX /Fo"$(INTDIR)/"\ + "WIN32" /D "_WINDOWS" /D "PERLDLL" /Fp"$(INTDIR)/modules.pch" /YX /Fo"$(INTDIR)/"\ /c CPP_OBJS=.\Release/ CPP_SBRS=.\. @@ -108,9 +108,9 @@ CLEAN : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" # ADD BASE CPP /nologo /W3 /Z7 /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c -# ADD CPP /nologo /MTd /W3 /Z7 /Od /I ".\include" /I "." /I ".." /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "MSDOS" /YX /c +# ADD CPP /nologo /MTd /W3 /Z7 /Od /I ".\include" /I "." /I ".." /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "PERLDLL" /YX /c CPP_PROJ=/nologo /MTd /W3 /Z7 /Od /I ".\include" /I "." /I ".." /D "_DEBUG"\ - /D "WIN32" /D "_WINDOWS" /D "MSDOS" /Fp"$(INTDIR)/modules.pch" /YX\ + /D "WIN32" /D "_WINDOWS" /D "PERLDLL" /Fp"$(INTDIR)/modules.pch" /YX\ /Fo"$(INTDIR)/" /c CPP_OBJS=.\Debug/ CPP_SBRS=.\. diff --git a/win32/perl.mak b/win32/perl.mak index 558717c97d..6cc231d4d7 100644 --- a/win32/perl.mak +++ b/win32/perl.mak @@ -1,4 +1,4 @@ -# Microsoft Developer Studio Generated NMAKE File, Format Version 4.20 +# Microsoft Developer Studio Generated NMAKE File, Format Version 4.00 # ** DO NOT EDIT ** # TARGTYPE "Win32 (x86) Console Application" 0x0103 @@ -49,12 +49,13 @@ RSC=rc.exe OUTDIR=.\Release INTDIR=.\Release -ALL : "..\_perl.exe" +ALL : "$(OUTDIR)\_perl.exe" CLEAN : - -@erase "$(INTDIR)\perlmain.obj" - -@erase "$(INTDIR)\win32io.obj" -@erase "..\_perl.exe" + -@erase ".\Release\perlmain.obj" + -@erase ".\Release\win32io.obj" + -@erase ".\Release\perl.res" "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" @@ -64,15 +65,15 @@ CLEAN : CPP_PROJ=/nologo /MT /W3 /O2 /I "." /I ".\include" /I ".." /D "WIN32" /D\ "NDEBUG" /D "_CONSOLE" /Fp"$(INTDIR)/perl.pch" /YX /Fo"$(INTDIR)/" /c CPP_OBJS=.\Release/ -CPP_SBRS=.\. +CPP_SBRS= # ADD BASE RSC /l 0x409 /d "NDEBUG" # ADD RSC /l 0x409 /d "NDEBUG" +RSC_PROJ=/l 0x409 /fo"$(INTDIR)/perl.res" /d "NDEBUG" BSC32=bscmake.exe # ADD BASE BSC32 /nologo # ADD BSC32 /nologo BSC32_FLAGS=/nologo /o"$(OUTDIR)/perl.bsc" -BSC32_SBRS= \ - +BSC32_SBRS= LINK32=link.exe # ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:console /machine:I386 # ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib setargv.obj /nologo /subsystem:console /machine:I386 /out:"../_perl.exe" @@ -81,11 +82,12 @@ LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ /subsystem:console /incremental:no /pdb:"$(OUTDIR)/_perl.pdb" /machine:I386\ /out:"../_perl.exe" LINK32_OBJS= \ - "$(INTDIR)\perlmain.obj" \ - "$(INTDIR)\win32io.obj" \ + "$(INTDIR)/perlmain.obj" \ + "$(INTDIR)/win32io.obj" \ + "$(INTDIR)/perl.res" \ "..\perl.lib" -"..\_perl.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) +"$(OUTDIR)\_perl.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) $(LINK32) @<< $(LINK32_FLAGS) $(LINK32_OBJS) << @@ -105,35 +107,33 @@ LINK32_OBJS= \ OUTDIR=.\Debug INTDIR=.\Debug -ALL : "..\_perl.exe" +ALL : "$(OUTDIR)\_perl.exe" CLEAN : - -@erase "$(INTDIR)\perlmain.obj" - -@erase "$(INTDIR)\vc40.idb" - -@erase "$(INTDIR)\vc40.pdb" - -@erase "$(INTDIR)\win32io.obj" - -@erase "$(OUTDIR)\_perl.pdb" -@erase "..\_perl.exe" + -@erase ".\Debug\perlmain.obj" + -@erase ".\Debug\win32io.obj" + -@erase ".\Debug\perl.res" -@erase "..\_perl.ilk" + -@erase ".\Debug\_perl.pdb" "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" # ADD BASE CPP /nologo /W3 /Gm /Zi /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /YX /c -# ADD CPP /nologo /MTd /W3 /Gm /Zi /Od /I "." /I ".\include" /I ".." /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /YX /c -CPP_PROJ=/nologo /MTd /W3 /Gm /Zi /Od /I "." /I ".\include" /I ".." /D\ - "WIN32" /D "_DEBUG" /D "_CONSOLE" /Fp"$(INTDIR)/perl.pch" /YX /Fo"$(INTDIR)/"\ - /Fd"$(INTDIR)/" /c +# ADD CPP /nologo /MTd /W3 /Z7 /Od /I "." /I ".\include" /I ".." /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /YX /c +CPP_PROJ=/nologo /MTd /W3 /Z7 /Od /I "." /I ".\include" /I ".." /D "WIN32" /D\ + "_DEBUG" /D "_CONSOLE" /Fp"$(INTDIR)/perl.pch" /YX /Fo"$(INTDIR)/" /c CPP_OBJS=.\Debug/ -CPP_SBRS=.\. +CPP_SBRS= # ADD BASE RSC /l 0x409 /d "_DEBUG" # ADD RSC /l 0x409 /d "_DEBUG" +RSC_PROJ=/l 0x409 /fo"$(INTDIR)/perl.res" /d "_DEBUG" BSC32=bscmake.exe # ADD BASE BSC32 /nologo # ADD BSC32 /nologo BSC32_FLAGS=/nologo /o"$(OUTDIR)/perl.bsc" -BSC32_SBRS= \ - +BSC32_SBRS= LINK32=link.exe # ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:console /debug /machine:I386 # ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib setargv.obj /nologo /subsystem:console /debug /machine:I386 /out:"../_perl.exe" @@ -142,11 +142,12 @@ LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ /subsystem:console /incremental:yes /pdb:"$(OUTDIR)/_perl.pdb" /debug\ /machine:I386 /out:"../_perl.exe" LINK32_OBJS= \ - "$(INTDIR)\perlmain.obj" \ - "$(INTDIR)\win32io.obj" \ + "$(INTDIR)/perlmain.obj" \ + "$(INTDIR)/win32io.obj" \ + "$(INTDIR)/perl.res" \ "..\perl.lib" -"..\_perl.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) +"$(OUTDIR)\_perl.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) $(LINK32) @<< $(LINK32_FLAGS) $(LINK32_OBJS) << @@ -191,9 +192,20 @@ DEP_CPP_PERLM=\ ".\win32io.h"\ +!IF "$(CFG)" == "perl - Win32 Release" + + +"$(INTDIR)\perlmain.obj" : $(SOURCE) $(DEP_CPP_PERLM) "$(INTDIR)" + + +!ELSEIF "$(CFG)" == "perl - Win32 Debug" + + "$(INTDIR)\perlmain.obj" : $(SOURCE) $(DEP_CPP_PERLM) "$(INTDIR)" +!ENDIF + # End Source File ################################################################################ # Begin Source File @@ -215,14 +227,27 @@ DEP_CPP_WIN32=\ ".\include\sys/socket.h"\ ".\win32io.h"\ ".\win32iop.h"\ - {$(INCLUDE)}"\Sys\Stat.h"\ - {$(INCLUDE)}"\Sys\Types.h"\ + {$(INCLUDE)}"\sys\STAT.H"\ + {$(INCLUDE)}"\sys\TYPES.H"\ "$(INTDIR)\win32io.obj" : $(SOURCE) $(DEP_CPP_WIN32) "$(INTDIR)" # End Source File +################################################################################ +# Begin Source File + +SOURCE=.\perl.rc +DEP_RSC_PERL_=\ + ".\camel.ico"\ + + +"$(INTDIR)\perl.res" : $(SOURCE) $(DEP_RSC_PERL_) "$(INTDIR)" + $(RSC) $(RSC_PROJ) $(SOURCE) + + +# End Source File # End Target # End Project ################################################################################ diff --git a/win32/perl.rc b/win32/perl.rc new file mode 100644 index 0000000000..15eae7843f --- /dev/null +++ b/win32/perl.rc @@ -0,0 +1,76 @@ +//Microsoft Developer Studio generated resource script. +// +#include "resource.h" + +#define APSTUDIO_READONLY_SYMBOLS +///////////////////////////////////////////////////////////////////////////// +// +// Generated from the TEXTINCLUDE 2 resource. +// +#include "afxres.h" + +///////////////////////////////////////////////////////////////////////////// +#undef APSTUDIO_READONLY_SYMBOLS + +///////////////////////////////////////////////////////////////////////////// +// English (U.S.) resources + +#if !defined(AFX_RESOURCE_DLL) || defined(AFX_TARG_ENU) +#ifdef _WIN32 +LANGUAGE LANG_ENGLISH, SUBLANG_ENGLISH_US +#pragma code_page(1252) +#endif //_WIN32 + +///////////////////////////////////////////////////////////////////////////// +// +// Icon +// + +// Icon with lowest ID value placed first to ensure application icon +// remains consistent on all systems. + +// you must obtain the icon for yourself, it's not in the dist +#if 0 +camel ICON DISCARDABLE "camel.ico" +#endif + +#ifdef APSTUDIO_INVOKED +///////////////////////////////////////////////////////////////////////////// +// +// TEXTINCLUDE +// + +1 TEXTINCLUDE DISCARDABLE +BEGIN + "resource.h\0" +END + +2 TEXTINCLUDE DISCARDABLE +BEGIN + "#include ""afxres.h""\r\n" + "\0" +END + +3 TEXTINCLUDE DISCARDABLE +BEGIN + "\r\n" + "\0" +END + +#endif // APSTUDIO_INVOKED + +#endif // English (U.S.) resources +///////////////////////////////////////////////////////////////////////////// + + + +#ifndef APSTUDIO_INVOKED +///////////////////////////////////////////////////////////////////////////// +// +// Generated from the TEXTINCLUDE 3 resource. +// + + +///////////////////////////////////////////////////////////////////////////// +#endif // not APSTUDIO_INVOKED + diff --git a/win32/perldll.mak b/win32/perldll.mak index 5b589c853b..6d63c46c8b 100644 --- a/win32/perldll.mak +++ b/win32/perldll.mak @@ -123,10 +123,10 @@ LINK32_OBJS= \ # PROP Output_Dir "debug" # PROP Intermediate_Dir "debug" # PROP Target_Dir "" -OUTDIR=.\debug +OUTDIR=.\.. INTDIR=.\debug -ALL : "..\perl.dll" +ALL : "$(OUTDIR)\perl.dll" CLEAN : -@erase "$(INTDIR)\perllib.obj" @@ -182,7 +182,7 @@ LINK32_OBJS= \ "..\libperl.lib" \ ".\modules.lib" -"..\perl.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) +"$(OUTDIR)\perl.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) $(LINK32) @<< $(LINK32_FLAGS) $(LINK32_OBJS) << diff --git a/win32/win32io.c b/win32/win32io.c index 75832240c7..333b64a7ec 100644 --- a/win32/win32io.c +++ b/win32/win32io.c @@ -178,6 +178,9 @@ my_get_osfhandle( int filehandle ) return _get_osfhandle(filehandle); } +#ifdef PERLDLL +__declspec(dllexport) +#endif WIN32_IOSUBSYSTEM win32stdio = { 12345678L, /* begin of structure; */ dummy_errno, /* (*pfunc_errno)(void); */ |
