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
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
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
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
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
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
Files: pod/perlfaq*.pod
-----------------
-Version 5.003_94
-----------------
+------------------
+ Version 5.003_94
+------------------
CORE LANGUAGE CHANGES
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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,
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
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
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
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
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
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)
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
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.
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
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
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
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
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
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
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
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>
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
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
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
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
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
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
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
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
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
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
pod/perltoc.pod
-----------------
-Version 5.003_90
-----------------
+------------------
+ Version 5.003_90
+------------------
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
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
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
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
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"
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
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
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....)
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"
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()"
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
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
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
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
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
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"
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
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
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
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
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
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
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
Files: pod/perldiag.pod
-----------------
-Version 5.003_26
-----------------
+------------------
+ Version 5.003_26
+------------------
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
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
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
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
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
Files: pod/perltie.pod
-----------------
-Version 5.003_25
-----------------
+------------------
+ Version 5.003_25
+------------------
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
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
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"
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
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
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
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
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.
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
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
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
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"
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
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"
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
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
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
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
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
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
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"
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
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
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
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
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.
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
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
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
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"
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
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"
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
Files: Configure
Title: "Make installperl quieter; only shared libraries need 0555"
- From: Chip Salzenberg <chip@atlantic.net>
+ From: Chip Salzenberg
Files: installperl
TESTS
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
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
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
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
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
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
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
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"
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
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"
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
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"
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
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
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
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"
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
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
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
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
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
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?)
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
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
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
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
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. :-)
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
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
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."
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. :-(
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"
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
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
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"
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
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
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
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
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
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
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
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
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
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"
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/*
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
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
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
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
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.
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
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
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
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
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.
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
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"
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
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
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
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
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,
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
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
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"
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
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
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.
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
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
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"
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"
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
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
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).
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?).
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
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
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
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
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.
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.
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).
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.
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
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.
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.
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
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.
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
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);
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
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
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
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
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
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.
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
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
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
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
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).
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:
# 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.
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.
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.
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.
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.
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
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:
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.
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.
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.
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
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.
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
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.
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
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
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
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()
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)
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
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
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
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.
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.
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
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($_)'
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
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
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.
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
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
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,
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
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
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
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.
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.
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.
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
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
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.
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.
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.
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.
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.
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.
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.
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
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
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.
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
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
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.
* 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
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.
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.
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.
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
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.
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.
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
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.
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.
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.
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.
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.
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.
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.
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.
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.
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.
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.
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.
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.
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.
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.
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.
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.
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.
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.
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.
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.
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.
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:
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.
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.
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.
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
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.
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
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.
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.
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.
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
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
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.
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.
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
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.
# 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.
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.
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.
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
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.
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
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)
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
(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
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
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
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().
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
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
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
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:
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.
# 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
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.
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
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".
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
# 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
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.
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
- 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
# 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
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
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
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
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
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
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
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
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
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
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';
/* "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 */
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);
(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;
#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)
--- /dev/null
+#!/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;
+}
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
+
+
--- /dev/null
+#!/usr/local/bin/perl
+
+use CGI::Carp qw(fatalsToBrowser);
+
+# This line invokes a fatal error message at compile time.
+foo bar baz;
--- /dev/null
+#!/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');
+
--- /dev/null
+#!/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;
+}
--- /dev/null
+#!/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;
+
--- /dev/null
+#!/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";
+}
+
--- /dev/null
+<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>
--- /dev/null
+#!/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;
+
--- /dev/null
+#!/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;
+}
+
--- /dev/null
+#!/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
+ ;
+}
--- /dev/null
+#!/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;
+
+
+
--- /dev/null
+#!/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();
+}
+
--- /dev/null
+#!/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;
--- /dev/null
+#!/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";
+}
--- /dev/null
+#!/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');
+
--- /dev/null
+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
#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
#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
#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)
#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)
#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
#define Isortstack sortstack
#define Isortstash sortstash
#define Isplitstr splitstr
+#define Istart_env start_env
#define Istatcache statcache
#define Istatgv statgv
#define Istatname statname
#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
#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
av_unshift
bind_match
block_end
+block_gimme
block_start
boot_core_UNIVERSAL
call_list
gv_AVadd
gv_HVadd
gv_IOadd
-gv_autoload
+gv_autoload4
gv_check
gv_efullname
gv_efullname3
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;
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.
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;
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)) );
}
res=POPs;
PUTBACK;
- mustcatch = oldmustcatch;
+ CATCH_SET(oldcatch);
if (postpr) {
int ans;
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");
# 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
--- /dev/null
+#!/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, @_) }
minus_n
minus_p
multiline
-mustcatch
mystack_base
mystack_mark
mystack_max
sortstack
sortstash
splitstr
+start_env
statcache
statgv
statname
--- /dev/null
+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
+
--- /dev/null
+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
--- /dev/null
+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;
--- /dev/null
+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
--- /dev/null
+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
+
--- /dev/null
+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
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
--- /dev/null
+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;
+
# 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;
}
}
@EXPORT = qw(shellwords quotewords);
@EXPORT_OK = qw(old_shellwords);
+*AUTOLOAD = *AutoLoader::AUTOLOAD;
+
=head1 NAME
Text::ParseWords - parse text into an array of tokens
+++ /dev/null
-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;
-
-
+++ /dev/null
-# chat.pl: chat with a server
-# Based on: V2.01.alpha.7 91/06/16
-# Randal L. Schwartz (was <merlyn@stonehenge.com>)
-# multihome additions by A.Macpherson@bnr.co.uk
-# allow for /dev/pts based systems by Joe Doupnik <JRD@CC.USU.EDU>
-
-package chat;
-
-require 'sys/socket.ph';
-
-if( defined( &main'PF_INET ) ){
- $pf_inet = &main'PF_INET;
- $sock_stream = &main'SOCK_STREAM;
- local($name, $aliases, $proto) = getprotobyname( 'tcp' );
- $tcp_proto = $proto;
-}
-else {
- # XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp'
- # but who the heck would change these anyway? (:-)
- $pf_inet = 2;
- $sock_stream = 1;
- $tcp_proto = 6;
-}
-
-
-$sockaddr = 'S n a4 x8';
-chop($thishost = `hostname`);
-
-# *S = symbol for current I/O, gets assigned *chatsymbol....
-$next = "chatsymbol000000"; # next one
-$nextpat = "^chatsymbol"; # patterns that match next++, ++, ++, ++
-
-
-## $handle = &chat'open_port("server.address",$port_number);
-## opens a named or numbered TCP server
-
-sub open_port { ## public
- local($server, $port) = @_;
-
- local($serveraddr,$serverproc);
-
- # We may be multi-homed, start with 0, fixup once connexion is made
- $thisaddr = "\0\0\0\0" ;
- $thisproc = pack($sockaddr, 2, 0, $thisaddr);
-
- *S = ++$next;
- if ($server =~ /^(\d+)+\.(\d+)\.(\d+)\.(\d+)$/) {
- $serveraddr = pack('C4', $1, $2, $3, $4);
- } else {
- local(@x) = gethostbyname($server);
- return undef unless @x;
- $serveraddr = $x[4];
- }
- $serverproc = pack($sockaddr, 2, $port, $serveraddr);
- unless (socket(S, $pf_inet, $sock_stream, $tcp_proto)) {
- ($!) = ($!, close(S)); # close S while saving $!
- return undef;
- }
- unless (bind(S, $thisproc)) {
- ($!) = ($!, close(S)); # close S while saving $!
- return undef;
- }
- unless (connect(S, $serverproc)) {
- ($!) = ($!, close(S)); # close S while saving $!
- return undef;
- }
-# We opened with the local address set to ANY, at this stage we know
-# which interface we are using. This is critical if our machine is
-# multi-homed, with IP forwarding off, so fix-up.
- local($fam,$lport);
- ($fam,$lport,$thisaddr) = unpack($sockaddr, getsockname(S));
- $thisproc = pack($sockaddr, 2, 0, $thisaddr);
-# end of post-connect fixup
- select((select(S), $| = 1)[0]);
- $next; # return symbol for switcharound
-}
-
-## ($host, $port, $handle) = &chat'open_listen([$port_number]);
-## opens a TCP port on the current machine, ready to be listened to
-## if $port_number is absent or zero, pick a default port number
-## process must be uid 0 to listen to a low port number
-
-sub open_listen { ## public
-
- *S = ++$next;
- local($thisport) = shift || 0;
- local($thisproc_local) = pack($sockaddr, 2, $thisport, $thisaddr);
- local(*NS) = "__" . time;
- unless (socket(NS, $pf_inet, $sock_stream, $tcp_proto)) {
- ($!) = ($!, close(NS));
- return undef;
- }
- unless (bind(NS, $thisproc_local)) {
- ($!) = ($!, close(NS));
- return undef;
- }
- unless (listen(NS, 1)) {
- ($!) = ($!, close(NS));
- return undef;
- }
- select((select(NS), $| = 1)[0]);
- local($family, $port, @myaddr) =
- unpack("S n C C C C x8", getsockname(NS));
- $S{"needs_accept"} = *NS; # so expect will open it
- (@myaddr, $port, $next); # returning this
-}
-
-## $handle = &chat'open_proc("command","arg1","arg2",...);
-## opens a /bin/sh on a pseudo-tty
-
-sub open_proc { ## public
- local(@cmd) = @_;
-
- *S = ++$next;
- local(*TTY) = "__TTY" . time;
- local($pty,$tty) = &_getpty(S,TTY);
- die "Cannot find a new pty" unless defined $pty;
- $pid = fork;
- die "Cannot fork: $!" unless defined $pid;
- unless ($pid) {
- close STDIN; close STDOUT; close STDERR;
- setpgrp(0,$$);
- if (open(DEVTTY, "/dev/tty")) {
- ioctl(DEVTTY,0x20007471,0); # XXX s/b &TIOCNOTTY
- close DEVTTY;
- }
- open(STDIN,"<&TTY");
- open(STDOUT,">&TTY");
- open(STDERR,">&STDOUT");
- die "Oops" unless fileno(STDERR) == 2; # sanity
- close(S);
- exec @cmd;
- die "Cannot exec @cmd: $!";
- }
- close(TTY);
- $next; # return symbol for switcharound
-}
-
-# $S is the read-ahead buffer
-
-## $return = &chat'expect([$handle,] $timeout_time,
-## $pat1, $body1, $pat2, $body2, ... )
-## $handle is from previous &chat'open_*().
-## $timeout_time is the time (either relative to the current time, or
-## absolute, ala time(2)) at which a timeout event occurs.
-## $pat1, $pat2, and so on are regexs which are matched against the input
-## stream. If a match is found, the entire matched string is consumed,
-## and the corresponding body eval string is evaled.
-##
-## Each pat is a regular-expression (probably enclosed in single-quotes
-## in the invocation). ^ and $ will work, respecting the current value of $*.
-## If pat is 'TIMEOUT', the body is executed if the timeout is exceeded.
-## If pat is 'EOF', the body is executed if the process exits before
-## the other patterns are seen.
-##
-## Pats are scanned in the order given, so later pats can contain
-## general defaults that won't be examined unless the earlier pats
-## have failed.
-##
-## The result of eval'ing body is returned as the result of
-## the invocation. Recursive invocations are not thought
-## through, and may work only accidentally. :-)
-##
-## undef is returned if either a timeout or an eof occurs and no
-## corresponding body has been defined.
-## I/O errors of any sort are treated as eof.
-
-$nextsubname = "expectloop000000"; # used for subroutines
-
-sub expect { ## public
- if ($_[0] =~ /$nextpat/) {
- *S = shift;
- }
- local($endtime) = shift;
-
- local($timeout,$eof) = (1,1);
- local($caller) = caller;
- local($rmask, $nfound, $timeleft, $thisbuf);
- local($cases, $pattern, $action, $subname);
- $endtime += time if $endtime < 600_000_000;
-
- if (defined $S{"needs_accept"}) { # is it a listen socket?
- local(*NS) = $S{"needs_accept"};
- delete $S{"needs_accept"};
- $S{"needs_close"} = *NS;
- unless(accept(S,NS)) {
- ($!) = ($!, close(S), close(NS));
- return undef;
- }
- select((select(S), $| = 1)[0]);
- }
-
- # now see whether we need to create a new sub:
-
- unless ($subname = $expect_subname{$caller,@_}) {
- # nope. make a new one:
- $expect_subname{$caller,@_} = $subname = $nextsubname++;
-
- $cases .= <<"EDQ"; # header is funny to make everything elsif's
-sub $subname {
- LOOP: {
- if (0) { ; }
-EDQ
- while (@_) {
- ($pattern,$action) = splice(@_,0,2);
- if ($pattern =~ /^eof$/i) {
- $cases .= <<"EDQ";
- elsif (\$eof) {
- package $caller;
- $action;
- }
-EDQ
- $eof = 0;
- } elsif ($pattern =~ /^timeout$/i) {
- $cases .= <<"EDQ";
- elsif (\$timeout) {
- package $caller;
- $action;
- }
-EDQ
- $timeout = 0;
- } else {
- $pattern =~ s#/#\\/#g;
- $cases .= <<"EDQ";
- elsif (\$S =~ /$pattern/) {
- \$S = \$';
- package $caller;
- $action;
- }
-EDQ
- }
- }
- $cases .= <<"EDQ" if $eof;
- elsif (\$eof) {
- undef;
- }
-EDQ
- $cases .= <<"EDQ" if $timeout;
- elsif (\$timeout) {
- undef;
- }
-EDQ
- $cases .= <<'ESQ';
- else {
- $rmask = "";
- vec($rmask,fileno(S),1) = 1;
- ($nfound, $rmask) =
- select($rmask, undef, undef, $endtime - time);
- if ($nfound) {
- $nread = sysread(S, $thisbuf, 1024);
- if ($nread > 0) {
- $S .= $thisbuf;
- } else {
- $eof++, redo LOOP; # any error is also eof
- }
- } else {
- $timeout++, redo LOOP; # timeout
- }
- redo LOOP;
- }
- }
-}
-ESQ
- eval $cases; die "$cases:\n$@" if $@;
- }
- $eof = $timeout = 0;
- &$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;
--- /dev/null
+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;
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);
char *name;
{
I32 off;
+ I32 pendoff = 0;
SV *sv;
SV **svp = AvARRAY(comppad_name);
U32 seq = cop_seqmax;
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;
}
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:
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:
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:
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)
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);
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:
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) {
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);
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;
}
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;
}
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)
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));
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:
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.) */
/* 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 */
/* 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 */
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);
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);
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);
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);
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);
}
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);
#define PATCHLEVEL 3
-#define SUBVERSION 95
+#define SUBVERSION 96
/*
local_patches -- list of locally applied less-than-subversion patches.
#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
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();
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)
char *validarg = "";
I32 oldscope;
AV* comppadlist;
+ dJMPENV;
#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
#ifdef IAMSUID
time(&basetime);
oldscope = scopestack_ix;
- mustcatch = FALSE;
- switch (Sigsetjmp(top_env,1)) {
+ switch (JMPENV_PUSH) {
case 1:
STATUS_ALL_FAILURE;
/* FALL THROUGH */
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;
}
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;
#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");
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]) {
}
}
#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);
}
}
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) {
ENTER;
restartop = 0;
+ JMPENV_POP;
return 0;
}
perl_run(sv_interp)
PerlInterpreter *sv_interp;
{
+ dJMPENV;
I32 oldscope;
if (!(curinterp = sv_interp))
oldscope = scopestack_ix;
- switch (Sigsetjmp(top_env,1)) {
+ switch (JMPENV_PUSH) {
case 1:
cxstack_ix = -1; /* start context stack again */
break;
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) {
}
my_exit(0);
+ /* NOTREACHED */
return 0;
}
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;
}
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;
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;
}
markstack_ptr++;
- restart:
- switch (Sigsetjmp(top_env,1)) {
+ switch (JMPENV_PUSH) {
case 0:
break;
case 1:
/* 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)
}
}
else
- mustcatch = TRUE;
+ CATCH_SET(TRUE);
if (op == (OP*)&myop)
op = pp_entersub();
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;
SV** sp = stack_sp;
I32 oldmark = sp - stack_base;
I32 retval;
- Sigjmp_buf oldtop;
I32 oldscope;
+ dJMPENV;
if (flags & G_DISCARD) {
ENTER;
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:
/* 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)
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;
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)
if (endav)
call_list(oldscope, endav);
FREETMPS;
- Copy(oldtop, top_env, 1, Sigjmp_buf);
+ JMPENV_POP;
curcop = &compiling;
curcop->cop_line = oldline;
if (statusvalue) {
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
LEAVE;
}
- Siglongjmp(top_env, 2);
+ JMPENV_JUMP(2);
}
#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)
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 */
$/ = "\n\n"; # set paragraph mode
$SHlinesep = "\n";
-while ($SHcmd = <>) {
+while (defined($SHcmd = <>)) {
$/ = $SHlinesep;
eval $SHcmd; print $@ || "\n";
$SHlinesep = $/; $/ = '';
-p9pvers = 5.003_95
+p9pvers = 5.003_96
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 *);
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 *);
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
=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)>
=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.
=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)>
=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)>
=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().
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
=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)>
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)>
=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>.
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)>
Return I<total size> of buffer.
-=back
+=back
$ref->FETCH(@_);
}
sub STORE {
- my $self = shift;
+ my $self = shift;
if (defined $_[0]){
my $ref = $self->{'dbm'};
$ref->STORE(@_);
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.
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
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.
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
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
=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
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
sub fred
{
eval { die "Fatal Error" ; }
- print "Trapped error: $@\n"
+ print "Trapped error: $@\n"
if $@ ;
}
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.
=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
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.
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.
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>.
=item 2.
-The code
+The code
if (SvTRUE(GvSV(errgv)))
{
package Foo;
sub new { bless {}, $_[0] }
- sub Subtract {
+ sub Subtract {
my($a,$b) = @_;
die "death can be fatal" if $a < $b ;
$a - $b;
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.
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 ...
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
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
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
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
int fh ;
char * buffer ;
{
- ...
+ ...
}
To provide a Perl interface to this library we need to be able to map
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
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.
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.
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
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
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
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
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
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
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
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 = (
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];
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',
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
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
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
=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
=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.
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
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
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.
=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
$ 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"!)
=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
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
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:
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
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:
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.
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:
The following debugger is quite functional:
- {
- package DB;
- sub DB {}
+ {
+ package DB;
+ sub DB {}
sub sub {print ++$i, " $sub\n"; &$sub}
}
=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.
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.
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
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
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
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
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
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
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
=back
-=head2 New and Changed Built-in Functions
+=head2 New and changed builtin functions
=over
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.)
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
=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:
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.
=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().)
=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 }>).
=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'
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
=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
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:
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
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
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),
(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
=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
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
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
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
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
(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
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">.
(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
=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
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
(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
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
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
=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.
=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>.
(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.
(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
=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"
(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.
=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
=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"
(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
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
(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
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.
=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
(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
=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.
You probably wrote something like this:
- @list = qw(
+ @list = qw(
a # a comment
b # another comment
);
when you should have written this:
@list = qw(
- a
- b
+ a
+ b
);
If you really want comments, build your list the
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 !;
=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:
=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
=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
=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
=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
=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>
=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"
(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.
=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<$*>.
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
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
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
=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.
}
# print the whole thing sorted by number of members and name
- foreach $family ( sort {
+ foreach $family ( sort {
@{$HoL{$b}} <=> @{$HoL{$a}}
||
$a cmp $b
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>.
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
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:
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 */
=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>.
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
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>:
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
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";
}
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; }};
{
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)
{
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:
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
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
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 };
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
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. :-)
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?
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)'
=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.
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
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:
"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.
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.
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?
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
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
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
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.
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
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
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
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).
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
# 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)
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
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
$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
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?
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
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?
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"
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.
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.
=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?
=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.
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:
# 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) );
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"
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
$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.
=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?
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.
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):
$/ 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>;
=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,
=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
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
=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";
}
while (<>) {
chomp;
PARSER: {
- if ( /\G( \d+\b )/gx {
+ if ( /\G( \d+\b )/gx {
print "number: $1\n";
redo PARSER;
}
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
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
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:
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.
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? :-)
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:
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.
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
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?
=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),
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
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
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
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?
=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
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:
=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).
=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.
.
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
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
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
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>.
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]);
=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"
.
. '$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
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
Here's a little program that's somewhat like fmt(1):
- format =
+ format =
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
$_
while (<>) {
s/\s*\n\s*/ /g;
write;
- }
+ }
=head2 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
$^A = "";
formline($format,@_);
return $^A;
- }
+ }
$string = swrite(<<'END', 1, 2, 3);
Check me out
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.
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
-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.
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>.
=item abs VALUE
-=item abs
+=item abs
Returns the absolute value of its argument.
If VALUE is omitted, uses $_.
=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,
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
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
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
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
$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>);
@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>.
=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
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
=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
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>.
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.
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
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
}
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
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
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
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.
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';
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.
=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
$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) {
Declare a picture format with use by the write() function. For
example:
- format Something =
+ format Something =
Test: @<<<<<<<< @||||| @>>>>>
$str, $%, '$' . int($num)
.
system "stty cbreak </dev/tty >/dev/tty 2>&1";
}
else {
- system "stty", '-icanon', 'eol', "\001";
+ system "stty", '-icanon', 'eol', "\001";
}
$key = getc(STDIN);
}
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";
=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
=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.
=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 $_.
=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
=item int EXPR
-=item int
+=item int
Returns the integer portion of EXPR. If EXPR is omitted, uses $_.
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
=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:
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)) {
=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;
=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.
=item length EXPR
-=item length
+=item length
Returns the length in characters of the value of EXPR. If EXPR is
omitted, returns length of $_.
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 $_.
=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
=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
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
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]'");
=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>.
=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
=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
=item quotemeta EXPR
-=item quotemeta
+=item quotemeta
Returns the value of EXPR with all non-alphanumeric
characters backslashed. (That is, all characters not matching
=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().
=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
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
=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
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>.
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
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.)
=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
=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
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
($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);
=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])) }
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.
@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;
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 {
# 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]
(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
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
=item sqrt EXPR
-=item sqrt
+=item sqrt
Return the square root of EXPR. If EXPR is omitted, returns square
root of $_.
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)
=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
$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.)
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,
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
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
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
TIESCALAR classname, LIST
DESTROY this
- FETCH this,
+ FETCH this,
STORE this, value
Unlike dbmopen(), the tie() function will not use or require a module
=item tr///
-The translation operator. See L<perlop>.
+The translation operator. Same as y///. See L<perlop>.
=item truncate FILEHANDLE,LENGTH
=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.
=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.
=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
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.
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
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
=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.
=item y///
-The translation operator. See L<perlop>.
+The translation operator. Same as tr///. See L<perlop>.
=back
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,
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.
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:
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*);
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);
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
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.
=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.
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.
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.
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
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
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);
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)
=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
=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
=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
=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
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));
=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));
=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
=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*>.
=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
=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;
=head1 DATE
-Version 31.3: 1997/3/14
+Version 31.4: 1997/3/30
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.
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
$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
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
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:
$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...
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;
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 }
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
# 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
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: $!";
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";
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
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`;
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
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, "-|");
if ($pid) { # parent
while (<KID_TO_READ>) {
# do something interesting
- }
+ }
close(KID_TO_READ) || warn "kid exited $?";
} else { # child
exec($program, @options, @args)
|| die "can't exec program: $!";
# NOTREACHED
- }
+ }
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
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
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.
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';
}
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.
$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.
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: $!";
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.
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: $!";
my $waitedpid = 0;
my $paddr;
- sub REAPER {
+ sub REAPER {
$waitedpid = wait;
$SIG{CHLD} = \&REAPER; # loathe sysV
logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
$SIG{CHLD} = \&REAPER;
- for ( $waitedpid = 0;
- ($paddr = accept(Client,Server)) || $waitedpid;
- $waitedpid = 0, close Client)
+ 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";
}
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,
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);
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
unless ( -S '/dev/log' ) {
die "something's wicked with the print system";
- }
+ }
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;
$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(),
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;
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;
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.
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
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
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
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")
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
=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
a declaration of the array:
# assign to our array a list of list references
- @LoL = (
+ @LoL = (
[ "fred", "barney" ],
[ "george", "jane", "elroy" ],
[ "homer", "marge", "bart" ],
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]
while (<>) {
@tmp = split;
push @LoL, [ @tmp ];
- }
+ }
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);
$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:
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:
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
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:
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.
=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:
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";
}
}
-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 ) {
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:
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 ] ];
@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
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.
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:
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();
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
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>.
=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
=item subs
-pre-declare sub names
+predeclare sub names
=item vmsish
=item vars
-pre-declare global variable names
+predeclare global variable names
=back
=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
=item ExtUtils::MM_VMS
-methods to override UN*X behaviour in ExtUtils::MakeMaker
+methods to override Unix behaviour in ExtUtils::MakeMaker
=item ExtUtils::MakeMaker
=item File::stat
-by-name interface to Perl's built-in stat() functions
+by-name interface to Perl's builtin stat() functions
=item FileCache
=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
=item Sys::Syslog
-interface to the UNIX syslog(3) calls
+interface to the Unix syslog(3) calls
=item Term::Cap
=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
=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
=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
=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.
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?
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
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
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 {
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 {
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
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
@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
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.)
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
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
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
$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
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 {
$test = \$test;
warn "CREATING " . \$test;
return bless \$test;
- }
+ }
sub DESTROY {
my $self = shift;
warn "DESTROYING $self";
- }
+ }
package main;
my $b = Subtle->new;
$$a = 0; # break selfref
warn "leaving block";
- }
+ }
warn "just exited block";
warn "time to die...";
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
=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.
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)
nonassoc ++ --
right **
right ! ~ \ and unary + and -
- left =~ !~
+ left =~ !~
left * / % x
left + - .
left << >>
=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
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);
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,
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
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
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
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
$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:
**= += *= &= <<= &&=
-= /= |= >>= ||=
=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
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
# scalar context
$/ = ""; $* = 1; # $* deprecated in modern perls
- while ($paragraph = <>) {
+ while (defined($paragraph = <>)) {
while ($paragraph =~ /[a-z]['")]*[.!?]+['")]*\s/g) {
$sentences++;
}
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).
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.,
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>.
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:
=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
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
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], /^-/) {
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
$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
'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.
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;
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
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:
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
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.
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,
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)
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
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
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
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
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";
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
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
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
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.
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
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
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.
$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".)
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.
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
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
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';
{
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.
$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
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
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
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
# 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)
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>""
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.
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>
=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>
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>
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
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
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
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
$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
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
I<is_tainted()> function.
sub is_tainted {
- return ! eval {
- join('',@_), kill 0;
- 1;
+ return ! eval {
+ join('',@_), kill 0;
+ 1;
};
}
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
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
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
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
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
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>) {
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
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
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
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
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
=item *
-Space before the opening curly of a multi-line BLOCK.
+Space before the opening curly of a multiline BLOCK.
=item *
=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.
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
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.
=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: $!";
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
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
sub get_line {
$thisline = $lookahead; # GLOBAL VARIABLES!!
- LINE: while ($lookahead = <STDIN>) {
+ LINE: while (defined($lookahead = <STDIN>)) {
if ($lookahead =~ /^[ \t]/) {
$thisline .= $lookahead;
}
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
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 @_
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
&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
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
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
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;
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.
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
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) {
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:
return ($cref, $dref);
} else {
return ($dref, $cref);
- }
- }
+ }
+ }
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()
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
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:
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.
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;
}
}
+ 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
(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
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';
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);
=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.
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.
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,
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 |) {}
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
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
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;
}
/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+" }
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.
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.
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'";
=over
-=item Non-commercial Reproduction
+=item Noncommercial Reproduction
=item Commercial Reproduction
=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?
=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?
=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?
=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?
=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
=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?
=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
=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()?
=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?
=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
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
=item Net::Ping
-=item Overridden Built-ins
+=item Object-oriented overrides for builtin operators
=back
"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
=item #! and quoting on non-Unix systems
-OS/2, DOS, Win95/NT, Macintosh
+OS/2, MS-DOS, Win95/NT, Macintosh
=item Switches
=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
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
isa(CLASS), can(METHOD), VERSION( [NEED] )
-=item Destructors
+=item Destructors
=item WARNING
=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
=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
=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
=item Stashes and Globs
-=item Double-Typed SV's
+=item Double-Typed SVs
=item Magic Variables
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,
=over
+=item G_VOID
+
=item G_SCALAR
=item G_ARRAY
=item G_NOARGS
-=item G_EVAL
+=item G_EVAL
=item G_KEEPERR
-=item Determining the Context
+=item Determining the Context
=back
=item Using perl_call_method
-=item Using GIMME
+=item Using GIMME_V
=item Using Perl to dispose of temporaries
=item AUTHOR
+=head2 constant - Perl pragma to declare constants
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item NOTES
+
+=item TECHNICAL NOTE
+
+=item BUGS
+
+=item AUTHOR
+
+=item COPYRIGHT
+
=head2 diagnostics - Perl compiler pragma to force verbose warning
diagnostics
=item 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
=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
=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
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
}
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
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:
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
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
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
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
=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>,
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,
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 *
=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 *
=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.
=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 *
=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>.
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 *
file read is the sole condition in a while loop:
while (<FH>) { }
- while ($_ = <FH>) { }..
+ while (defined($_ = <FH>)) { }..
<FH>; # data discarded!
=item *
=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.
=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:
=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.).
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.
$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
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
else {
print "False!";
}
-
+
# perl4 prints: True!
# perl5 errors: syntax error at test.pl line 1, near "if {"
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
$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)){
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:
@x = ('existing');
print push(@x, 'first new', 'second new');
-
+
# perl4 prints: second new
# perl5 prints: 3
Some error messages will be different.
-=item * Discontinuance
+=item * Discontinuance
Some bugs may have been inadvertently removed. :-)
$string . = "more string";
print $string;
-
+
# perl4 prints: more string
# perl5 prints: syntax error at - line 1, near ". ="
sub foo {}
&foo
print("hello, world\n");
-
+
# perl4 prints: hello, world
# perl5 prints: syntax error
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
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
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).
@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
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
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
*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
print ++$x," : ";
print -$x," : ";
print ++$x,"\n";
-
+
# perl4 prints: aab : -0 : 1
# perl5 prints: aab : -aab : aac
$_[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.
The behavior is slightly different for:
print "$x", defined $x
-
+
# perl 4: 1
# perl 5: <no output, $x is not called into existence>
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++;
&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
@<<<<< @||||| @>>>>>
@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
@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
@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
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
On the other hand,
- $a += /foo/ ? 1 : 2;
+ $a += /foo/ ? 1 : 2;
now works as a C programmer would expect.
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)
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
=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
&doit("blah");
}
sub doit{local($_) = shift; print "Got $_ "}
-
+
# perl4 prints: blah blah blah
# perl5 prints: infinite loop blah...
"abcdef" =~ /b.*e/;
print "\$+ = $+\n";
-
+
# perl4 prints: bcde
# perl5 prints:
$string = "test";
$value = ($string =~ s/foo//);
print $value, "\n";
-
+
# perl4 prints: 0
# perl5 prints:
=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
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"
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
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
print $1 while ($test =~ /(o)/g);
# pos $test = 0; # to get old behavior
}
-
+
# perl4 prints: oooooo
# perl5.004 prints: oo
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
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.
warn STDERR "Foo!";
# perl4 prints: Foo!
- # perl5 prints: String found where operator expected
+ # perl5 prints: String found where operator expected
=back
=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
@ 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
$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
=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.
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{"
$foo = "array";
print "\$$foo{bar}\n";
-
+
# perl4 prints: $array{bar}
# perl5 prints: $
\$count++;
}
);
-
+
# perl4 runs this ok
- # perl5 prints: Can't find string terminator ")"
+ # perl5 prints: Can't find string terminator ")"
=back
sub foo {
$rc = do "./do.pl";
return 8;
- }
+ }
print &foo, "\n";
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.
equivalent:
while (<>) {...} # equivalent in only while!
- while ($_ = <>) {...}
+ while (defined($_ = <>)) {...}
/^Subject:/
$_ =~ /^Subject:/
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
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>
=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.
=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
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
=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
=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}
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
=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.)
=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
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
=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>.)
=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
$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>.
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
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
$status = rpcb_gettime( "localhost", $timep );
-The XSUB follows.
+The XSUB follows.
bool_t
rpcb_gettime(host,timep)
=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
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
=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.
=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
#ifdef __cplusplus
}
#endif
-
+
PROTOTYPES: DISABLE
MODULE = Mytest PACKAGE = Mytest
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:
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.
=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
#include <stdlib.h>
#include "./mylib.h"
-
+
double
foo(a, b, c)
int a;
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.
=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.
# 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: $!";
PP(pp_stub)
{
dSP;
- if (GIMME != G_ARRAY) {
+ if (GIMME_V == G_SCALAR)
XPUSHs(&sv_undef);
- }
RETURN;
}
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",
else
sv_setiv(sv, 0);
SETs(sv);
- RETURN;
}
+ RETURN;
}
PP(pp_padany)
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);
dSP; tryAMAGICbinSET(lt,0);
{
dPOPnv;
- SETs((TOPn < value) ? &sv_yes : &sv_no);
+ SETs(boolSV(TOPn < value));
RETURN;
}
}
dSP; tryAMAGICbinSET(gt,0);
{
dPOPnv;
- SETs((TOPn > value) ? &sv_yes : &sv_no);
+ SETs(boolSV(TOPn > value));
RETURN;
}
}
dSP; tryAMAGICbinSET(le,0);
{
dPOPnv;
- SETs((TOPn <= value) ? &sv_yes : &sv_no);
+ SETs(boolSV(TOPn <= value));
RETURN;
}
}
dSP; tryAMAGICbinSET(ge,0);
{
dPOPnv;
- SETs((TOPn >= value) ? &sv_yes : &sv_no);
+ SETs(boolSV(TOPn >= value));
RETURN;
}
}
dSP; tryAMAGICbinSET(ne,0);
{
dPOPnv;
- SETs((TOPn != value) ? &sv_yes : &sv_no);
+ SETs(boolSV(TOPn != value));
RETURN;
}
}
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;
}
}
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;
}
}
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;
}
}
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;
}
}
dSP; tryAMAGICbinSET(seq,0);
{
dPOPTOPssrl;
- SETs( sv_eq(left, right) ? &sv_yes : &sv_no );
+ SETs(boolSV(sv_eq(left, right)));
RETURN;
}
}
dSP; tryAMAGICbinSET(sne,0);
{
dPOPTOPssrl;
- SETs( !sv_eq(left, right) ? &sv_yes : &sv_no );
+ SETs(boolSV(!sv_eq(left, right)));
RETURN;
}
}
#ifdef OVERLOAD
dSP; tryAMAGICunSET(not);
#endif /* OVERLOAD */
- *stack_sp = SvTRUE(*stack_sp) ? &sv_no : &sv_yes;
+ *stack_sp = boolSV(!SvTRUE(*stack_sp));
return NORMAL;
}
dSP; tryAMAGICbinSET(lt,0);
{
dPOPTOPiirl;
- SETs((left < right) ? &sv_yes : &sv_no);
+ SETs(boolSV(left < right));
RETURN;
}
}
dSP; tryAMAGICbinSET(gt,0);
{
dPOPTOPiirl;
- SETs((left > right) ? &sv_yes : &sv_no);
+ SETs(boolSV(left > right));
RETURN;
}
}
dSP; tryAMAGICbinSET(le,0);
{
dPOPTOPiirl;
- SETs((left <= right) ? &sv_yes : &sv_no);
+ SETs(boolSV(left <= right));
RETURN;
}
}
dSP; tryAMAGICbinSET(ge,0);
{
dPOPTOPiirl;
- SETs((left >= right) ? &sv_yes : &sv_no);
+ SETs(boolSV(left >= right));
RETURN;
}
}
dSP; tryAMAGICbinSET(eq,0);
{
dPOPTOPiirl;
- SETs((left == right) ? &sv_yes : &sv_no);
+ SETs(boolSV(left == right));
RETURN;
}
}
dSP; tryAMAGICbinSET(ne,0);
{
dPOPTOPiirl;
- SETs((left != right) ? &sv_yes : &sv_no);
+ SETs(boolSV(left != right));
RETURN;
}
}
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;
}
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;
PP(pp_delete)
{
dSP;
+ I32 gimme = GIMME_V;
+ I32 discard = (gimme == G_VOID) ? G_DISCARD : 0;
SV *sv;
HV *hv;
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;
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;
}
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;
dSP;
dPOPPOPssrl;
SV **oldsp = sp;
+ I32 gimme = GIMME_V;
SV *sv;
STRLEN llen;
STRLEN rlen;
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 == '%') {
checksum = 0;
}
}
- if (sp == oldsp && GIMME != G_ARRAY)
+ if (sp == oldsp && gimme == G_SCALAR)
PUSHs(&sv_undef);
RETURN;
}
I32 realarray = 0;
I32 base;
AV *oldstack = curstack;
- I32 gimme = GIMME;
+ I32 gimme = GIMME_V;
I32 oldsave = savestack_ix;
#ifdef DEBUGGING
#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));
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)
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);
}
/* All done yet? */
if (markstack_ptr[-1] > *markstack_ptr) {
I32 items;
+ I32 gimme = GIMME_V;
(void)POPMARK; /* pop top */
LEAVE; /* exit outer scope */
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 {
AV *oldstack;
CONTEXT *cx;
SV** newsp;
- bool oldmustcatch = mustcatch;
+ bool oldcatch = CATCH_GET;
SAVETMPS;
SAVESPTR(op);
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);
POPBLOCK(cx,curpm);
SWITCHSTACK(sortstack, oldstack);
- mustcatch = oldmustcatch;
+ CATCH_SET(oldcatch);
}
LEAVE;
}
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
register I32 cxix = dopoptosub(cxstack_ix);
register CONTEXT *cx;
I32 dbcxix;
+ I32 gimme;
SV *sv;
I32 count = 0;
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);
{
dSP; dMARK;
register CONTEXT *cx;
- I32 gimme = GIMME;
+ I32 gimme = GIMME_V;
SV **svp;
ENTER;
{
dSP;
register CONTEXT *cx;
- I32 gimme = GIMME;
+ I32 gimme = GIMME_V;
ENTER;
SAVETMPS;
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)
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);
else
*++newsp = &sv_undef;
}
- else {
+ else if (gimme == G_ARRAY) {
while (++MARK <= SP)
*++newsp = (popsub2 && SvTEMP(*MARK))
? *MARK : sv_mortalcopy(*MARK);
else
*++newsp = &sv_undef;
}
- else {
+ else if (gimme == G_ARRAY) {
while (++MARK <= SP)
*++newsp = ((pop2 == CXt_SUB) && SvTEMP(*MARK))
? *MARK : sv_mortalcopy(*MARK);
if (curstack == signalstack) {
restartop = retop;
- Siglongjmp(top_env, 3);
+ JMPENV_JUMP(3);
}
RETURNOP(retop);
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 */
runops();
break;
}
- Copy(oldtop, top_env, 1, Sigjmp_buf);
+ JMPENV_POP;
runlevel = oldrunlevel;
- mustcatch = TRUE;
op = oldop;
return Nullop;
}
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);
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;
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++)
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);
}
{
dSP;
register CONTEXT *cx;
- I32 gimme = GIMME;
+ I32 gimme = GIMME_V;
ENTER;
SAVETMPS;
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;
}
}
if (tainting && tainted && !SvTAINTED(left))
TAINT_NOT;
- SvSetSV(right, left);
- SvSETMAGIC(right);
+ SvSetMagicSV(right, left);
SETs(right);
RETURN;
}
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;
}
dSP; tryAMAGICbinSET(eq,0);
{
dPOPnv;
- SETs((TOPn == value) ? &sv_yes : &sv_no);
+ SETs(boolSV(TOPn == value));
RETURN;
}
}
register SV *sv;
register AV *ary;
+ I32 gimme;
HV *hash;
I32 i;
int magic;
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
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)
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'))) {
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;
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);
else
offset = 0;
}
+ else {
+ sv = sv_2mortal(NEWSV(57, 80));
+ offset = 0;
+ }
for (;;) {
if (!sv_gets(sv, fp, offset)) {
PerlIO_clearerr(fp);
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;
}
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);
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);
{
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;
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);
/* 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 {
}
SP = MARK;
}
- else {
+ else if (gimme == G_ARRAY) {
for (MARK = newsp + 1; MARK <= SP; MARK++) {
if (!SvTEMP(*MARK))
*MARK = sv_mortalcopy(*MARK);
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;
}
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);
# 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>
#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
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*/
}
else {
STATUS_NATIVE_SET(-1);
- if (GIMME == G_SCALAR)
+ if (gimme == G_SCALAR)
RETPUSHUNDEF;
}
else
gv = (GV*)POPs;
EXTEND(SP, 1);
- PUSHs( do_close(gv, TRUE) ? &sv_yes : &sv_no );
+ PUSHs(boolSV(do_close(gv, TRUE)));
RETURN;
}
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)
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);
runops();
SPAGAIN;
- mustcatch = oldmustcatch;
+ CATCH_SET(oldcatch);
sv = TOPs;
if (sv_isobject(sv)) {
if (SvTYPE(varsv) == SVt_PVHV || SvTYPE(varsv) == SVt_PVAV) {
GV *gv;
BINOP myop;
SV *sv;
- bool oldmustcatch = mustcatch;
+ bool oldcatch = CATCH_GET;
hv = (HV*)POPs;
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);
SPAGAIN;
}
- mustcatch = oldmustcatch;
+ CATCH_SET(oldcatch);
if (sv_isobject(TOPs))
sv_magic((SV*)hv, TOPs, 'P', Nullch, 0);
LEAVE;
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 */
OP *retop;
{
register CONTEXT *cx;
- I32 gimme = GIMME;
+ I32 gimme = GIMME_V;
AV* padlist = CvPADLIST(cv);
SV** svp = AvARRAY(padlist);
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;
}
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;
}
{
dSP;
GV *tmpgv;
+ I32 gimme;
I32 max = 13;
if (op->op_flags & OPf_REF) {
}
}
- 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)));
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));
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));
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))
+
#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
--- /dev/null
+#!./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;
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;
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
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;
+}
--- /dev/null
+#!./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?";
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 */
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(' ');");
}
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;
curcop->cop_line++;
}
else
- no_op("Bare word",s);
+ no_op("Bareword",s);
}
/* Look for a subroutine with this name in current package. */
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++;
}
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))
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);
}
/* safe version of free */
-void
+Free_t
safefree(where)
Malloc_t where;
{
restartop = die_where(message);
if ((!restartop && was_in_eval) || oldrunlevel > 1)
- Siglongjmp(top_env, 3);
+ JMPENV_JUMP(3);
return restartop;
}
}
if (in_eval) {
restartop = die_where(message);
- Siglongjmp(top_env, 3);
+ JMPENV_JUMP(3);
}
PerlIO_puts(PerlIO_stderr(),message);
(void)PerlIO_flush(PerlIO_stderr());
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
---
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";
* 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:
.endif
# Updated by fndvers.com -- do not edit by hand
-PERL_VERSION = 5_00395#
+PERL_VERSION = 5_00396#
ARCHDIR = [.lib.$(ARCH).$(PERL_VERSION)]
}
}
- 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);
}
}
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);
}
#
# various targets
PERLLIB=..\libperl.lib
+PERLIMPLIB=..\perl.lib
MINIPERL=..\miniperl.exe
PERLDLL=..\perl.dll
PERLEXE=..\perl.exe
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
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
+++ /dev/null
-@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
--- /dev/null
+@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
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.
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
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
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=.\.
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=.\.
-# 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
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)"
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"
/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)
<<
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"
/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)
<<
".\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
".\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
################################################################################
--- /dev/null
+//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
+
# 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"
"..\libperl.lib" \
".\modules.lib"
-"..\perl.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
+"$(OUTDIR)\perl.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
$(LINK32) @<<
$(LINK32_FLAGS) $(LINK32_OBJS)
<<
return _get_osfhandle(filehandle);
}
+#ifdef PERLDLL
+__declspec(dllexport)
+#endif
WIN32_IOSUBSYSTEM win32stdio = {
12345678L, /* begin of structure; */
dummy_errno, /* (*pfunc_errno)(void); */
projects / p5sagit/p5-mst-13.2.git / commitdiff
