diff options
242 files changed, 17849 insertions, 6373 deletions
@@ -8,9 +8,744 @@ or in the .../src/5/0/unsupported directory for sub-version releases.) ----------------- -Version 5.003_94 ----------------- +--------------- + 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 <gisle@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> + M. J. T. Guy <mjtg@cus.cam.ac.uk> + Gurusamy Sarathy <gsar@engin.umich.edu> + Jarkko Hietaniemi <jhi@iki.fi> + Nick Ing-Simmons <nik@tiuk.ti.com> + Andreas Koenig <a.koenig@mind.de> + Doug MacEachern <dougm@opengroup.org> + 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_97a +------------------- + +This release gets a letter instead of a full subversion because I'm +planning on making 5.003_98 the second public beta. + + CORE LANGUAGE CHANGES + + Title: "Fix AUTOLOAD, or kill me" + From: Chip Salzenberg + Files: gv.c pp.c t/op/method.t + + CORE PORTABILITY + + Title: "Add support for Cygwin32 (GNU-Win32) -- very low impact" + From: John Cerney <j-cerney1@ti.com> + Msg-ID: <199704030821.JAA08762@pluto.tiuk.ti.com> + Date: Thu, 3 Apr 1997 09:21:17 +0100 + Files: MANIFEST README.cygwin32 cygwin32/cw32imp.h cygwin32/gcc2 + cygwin32/ld2 cygwin32/perlgcc cygwin32/perlld + ext/DynaLoader/dl_cygwin32.xs hints/cygwin32.sh perl.h + pp_sys.c + + Title: "Win32 update (six patches)" + From: Gurusamy Sarathy + Files: MANIFEST README.win32 dosish.h t/io/fs.t t/io/tell.t + t/lib/io_tell.t t/op/magic.t t/op/mkdir.t t/op/runlevel.t + t/op/stat.t t/op/taint.t win32/Makefile win32/VC-2.0/pod.mak + win32/makedef.pl win32/pod.mak win32/win32.c win32/win32.h + win32/win32io.c win32/win32io.h win32/win32iop.h + + Title: "AmigaOS update" + From: Norbert Pueschel + Msg-ID: <77724828@Armageddon.meb.uni-bonn.de> + Date: Thu, 03 Apr 1997 16:16:51 +0200 + Files: README.amiga hints/amigaos.sh + + OTHER CORE CHANGES + + Title: "Fix const-sub-related panic on C<sub foo { my $x; 0 } foo>" + From: Chip Salzenberg + Files: op.c + + Title: "Fix warning for useless C<1..2>" + From: Chip Salzenberg + Files: op.c + + Title: "Minor cleanups" + From: Gurusamy Sarathy + Msg-ID: <199704040056.TAA22253@aatma.engin.umich.edu> + Date: Thu, 03 Apr 1997 19:56:57 -0500 + Files: mg.c mg.h perl.c + + Title: "Eliminate unreliable warning with %SIG and strict refs" + From: Chip Salzenberg + Files: mg.c + + Title: "Fix impossible test in vivification" + From: Chip Salzenberg + Files: mg.c + + Title: "runlevel is I32, not int" + From: Roderick Schertler + Msg-ID: <2848.860109823@eeyore.ibcinc.com> + Date: Thu, 03 Apr 1997 18:23:43 -0500 + Files: pp_ctl.c util.c + + BUILD PROCESS + + Title: "Re: shared lib compilation problem with miniperl5.003_97" + From: Andy Dougherty + Msg-ID: <Pine.SOL.3.95q.970404124326.647K-100000@fractal.lafayette.ed + Date: Fri, 04 Apr 1997 13:02:23 -0500 (EST) + Files: Makefile.SH + + LIBRARY AND EXTENSIONS + + Title: "Math::Trig, based on (and from an author of) Math::Complex" + From: Chip Salzenberg + Files: MANIFEST lib/Math/Complex.pm lib/Math/Trig.pm + pod/perldelta.pod t/lib/complex.t t/lib/trig.t + + Title: "Update AutoLoader and docs; support C<use AutoLoader 'AUTOLOAD'>" + From: Chip Salzenberg and Tim Bunce + Files: lib/AutoLoader.pm + + Title: "CPAN & TRL-Gnu" + From: Achim Bohnet <ach@rosat.mpe-garching.mpg.de> + Msg-ID: <9704040809.AA26143@o09.rosat.mpe-garching.mpg.de> + Date: Fri, 04 Apr 1997 10:09:03 +0200 + Files: lib/CPAN.pm + + Title: "Limit @ISA to actual DBM in AnyDBM" + From: Chip Salzenberg + Files: lib/AnyDBM_File.pm + + Title: "Don't use $4 when it might be undef" + From: Chip Salzenberg + Files: lib/bigfloat.pl + + TESTS + + Title: "Make *dbm tests work with Win32" + From: Chip Salzenberg + Files: t/lib/anydbm.t t/lib/gdbm.t t/lib/ndbm.t t/lib/odbm.t + t/lib/sdbm.t + + UTILITIES + + (no changes) + + DOCUMENTATION + + Title: "Update INSTALL" + From: Andy Dougherty + Files: INSTALL + + Title: "Pod style" + From: Nathan Torkington <gnat@prometheus.frii.com> + Files: pod/perlcall.pod pod/perldata.pod pod/perldebug.pod + pod/perldiag.pod pod/perlform.pod pod/perlfunc.pod + pod/perlipc.pod pod/perllocale.pod pod/perlmod.pod + pod/perlop.pod pod/perlre.pod pod/perlrun.pod + pod/perlstyle.pod pod/perltoc.pod pod/perlvar.pod + + +------------------ + Version 5.003_97 +------------------ + + CORE LANGUAGE CHANGES + + Title: "Reenable but deprecate inherited AUTOLOAD for plain funcs" + From: Chip Salzenberg + Files: ext/DynaLoader/DynaLoader.pm gv.c lib/Text/ParseWords.pm + pod/perldelta.pod pod/perldiag.pod t/op/method.t + + CORE PORTABILITY + + Title: "Don't use setjmp() and longjmp() in complex exprs" + From: Chip Salzenberg + Files: perl.c pp_ctl.c scope.h + + Title: "Improve definition of Sock_size_t" + From: Chip Salzenberg + Files: doio.c pp_sys.c + + Title: "Don't use a completely empty macro parameter" + From: Chip Salzenberg + Files: sv.h + + Title: "Win32 update" + From: Gurusamy Sarathy + Msg-ID: <199704020608.BAA29538@aatma.engin.umich.edu> + Date: Wed, 02 Apr 1997 01:08:09 -0500 + Files: win32/VC-2.0/modules.mak win32/VC-2.0/perl.mak win32/VC- + 2.0/perldll.mak win32/perl.mak + + OTHER CORE CHANGES + + Title: "Introduce and use gv_fetchmethod_autoload()" + From: Chip Salzenberg + Files: global.sym gv.c pod/perlguts.pod proto.h universal.c + + Title: "Reduce memory footprint of literal strings" + From: ilya@math.ohio-state.edu (Ilya Zakharevich) + Msg-ID: <1997Apr1.113438.1913905@hmivax.humgen.upenn.edu> + Date: Tue, 01 Apr 1997 11:34:37 -0500 (EST) + Files: toke.c + + BUILD PROCESS + + Title: "Remove target before link() of perldiag.pod" + From: Chip Salzenberg + Files: installperl + + LIBRARY AND EXTENSIONS + + Title: "Refresh CPAN to 1.24" + From: Andreas Koenig + Files: lib/CPAN.pm lib/CPAN/FirstTime.pm + + Title: "Refresh ExtUtils::Manifest to 1.33" + From: Andreas Koenig + Files: lib/ExtUtils/Manifest.pm + + Title: "Update $VERSION of ExtUtils::Embed to reflect reality" + From: Chip Salzenberg + Files: lib/ExtUtils/Embed.pm + + Title: "Fix POSIX::raise()" + From: "Jens T. Berger Thielemann" <jensthi@ifi.uio.no> + Msg-ID: <Pine.SUN.3.91.970401153125.8053A-100000@holmenkollen.ifi.uio + Date: Tue, 1 Apr 1997 15:34:47 +0200 (MET DST) + Files: ext/POSIX/POSIX.pm + + Title: "Eliminate warnings in File::Basename" + From: Robin Barker <rmb1@cise.npl.co.uk> + Msg-ID: <11173.9704011111@tempest.cise.npl.co.uk> + Date: Tue, 1 Apr 97 12:11:43 BST + Files: lib/File/Basename.pm t/lib/basename.t + + Title: "Eliminate warning in CGI.pm" + From: Chip Salzenberg + Files: lib/CGI.pm + + Title: "Tweaks to constant.pm" + From: Tom Phoenix + Msg-ID: <Pine.GSO.3.96.970331205519.16684I-100000@kelly.teleport.com> + Date: Mon, 31 Mar 1997 21:10:14 -0800 (PST) + Files: lib/constant.pm + + Title: "Document eval vs. sub in Benchmark" + From: Hugo van der Sanden <hv@crypt.compulink.co.uk> + Msg-ID: <199704012231.XAA00225@crypt.compulink.co.uk> + Date: Tue, 01 Apr 1997 23:31:55 +0100 + Files: lib/Benchmark.pm + + TESTS + + (no changes) + + UTILITIES + + Title: "Improve heuristics for pod2man titles" + From: Roderick Schertler + Msg-ID: <pzn2ri9gto.fsf@eeyore.ibcinc.com> + Date: 01 Apr 1997 23:41:55 -0500 + Files: pod/pod2man.PL + + DOCUMENTATION + + Title: "Clean up some poddities, and make C<make html> work again" + From: Chip Salzenberg + Files: pod/Makefile pod/perldelta.pod pod/perldiag.pod + pod/perlfaq8.pod pod/perlfunc.pod pod/perlop.pod + pod/perltrap.pod + + Title: "Fix MM doc's use of "SUPER::"" + From: avera@hal.com (Jim Avera) + Msg-ID: <9704012235.AA07841@membrane.hal.com> + Date: Tue, 1 Apr 1997 14:35:26 -0800 (PST) + Files: lib/ExtUtils/MakeMaker.pm + + Title: "Eliminate pod warnings in libs" + From: Chip Salzenberg + Files: lib/CGI.pm lib/ExtUtils/Command.pm + + +------------------ + Version 5.003_96 +------------------ + + CORE LANGUAGE CHANGES + + Title: "Support $ENV{PERL5OPT}" + From: Chip Salzenberg + Files: perl.c pod/perldiag.pod pod/perldelta.pod pod/perlrun.pod + + Title: "Implement void context, in which C<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 + 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 + 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 + 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 + + Title: "Don't compile scalar mods of aggregates, like C<@a =~ s/a/b/>" + From: Chip Salzenberg + Files: op.c t/op/misc.t + + Title: "Automatically flush on C< $| = 1 >" + From: Chip Salzenberg + Files: mg.c + + Title: "Refine modulus ("%") per suggestion of Tim Goodwin" + From: Chip Salzenberg + Files: pp.c + + Title: "If C<perl -a>, do equivalent of C<use vars '@F'>" + From: Chip Salzenberg + Files: toke.c + + Title: "Warn about undef magic values just like non-magic" + From: Chip Salzenberg + Files: ext/Opcode/Safe.pm sv.c t/lib/db-btree.t t/lib/db-hash.t + t/lib/db-recno.t t/pragma/locale.t + + CORE PORTABILITY + + Title: "Remove redundant patch to hints/bsdos.sh" + From: Shigeya Suzuki <shigeya@foretune.co.jp> + Msg-ID: <19970322222244K.shigeya@foretune.co.jp> + Date: Sat, 22 Mar 1997 22:22:44 +0900 + Files: hints/bsdos.sh + + Title: "Another MachTen Patch" + From: Tom Phoenix + Msg-ID: <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 and Nick Ing-Simmons + Files: MANIFEST README.win32 doio.c dosish.h pp_sys.c + lib/ExtUtils/Command.pm t/comp/multiline.t t/op/magic.t + t/op/mkdir.t t/op/runlevel.t t/op/stat.t t/op/write.t + win32/Makefile win32/config.H win32/config.w32 win32/win32.c + win32/win32.h win32/win32aux.c win32/*.mak win32/VC-2.0/*.mak + + OTHER CORE CHANGES + + Title: "Fix botch with G_NOARGS; PUSHMARK *is* required" + From: Chip Salzenberg + Files: perl.c + + Title: "Improve 'prototype mismatch' warning" + From: Chip Salzenberg + Files: global.sym op.c pod/perldiag.pod proto.h sv.c t/comp/redef.t + + Title: "In perlio, fix vprintf() definition and define vfprintf()" + From: Chip Salzenberg + Files: perlio.c + + BUILD PROCESS + + (no changes) + + LIBRARY AND EXTENSIONS + + Title: "Fix C<require> in Getopt::Long to work with 5.003" + From: Chip Salzenberg + Files: lib/Getopt/Long.pm + + Title: "Extraneous blank lines from Pod::Text" + From: Russ Allbery <rra@stanford.edu> + Msg-ID: <qumend4qq08.fsf@cyclone.stanford.edu> + Date: 25 Mar 1997 01:28:55 -0800 + Files: lib/Pod/Text.pm + + Title: "Exporting UNIVERSAL::can" + From: "M.J.T. Guy" + Msg-ID: <E0w9DwX-0000Zr-00@taurus.cus.cam.ac.uk> + Date: Mon, 24 Mar 1997 17:54:01 +0000 + Files: lib/UNIVERSAL.pm + + Title: "Term::Readline patch for AmigaOS" + From: Norbert Pueschel + Msg-ID: <77724797@Armageddon.meb.uni-bonn.de> + Date: Sun, 23 Mar 1997 18:57:22 +0100 + Files: lib/Term/ReadLine.pm + + TESTS + + Title: "Reduce memory footprint of complex.t" + From: Dominic Dunlop <domo@slipper.ip.lu> + Msg-ID: <v03020902af5d8e03c5ab@[194.51.248.84]> + Date: Tue, 25 Mar 1997 15:39:26 +0100 + Files: t/lib/complex.t + + UTILITIES + + Title: "Improve pod2man diagnostic when NAME is invalid" + From: Chip Salzenberg + Files: pod/pod2man.PL + + DOCUMENTATION + + Title: "INSTALL-1.8 to INSTALL-1.9 updates" + From: Andy Dougherty + Msg-ID: <Pine.SOL.3.95q.970325135138.3374A-100000@fractal.lafayette.e + Date: Tue, 25 Mar 1997 13:52:53 -0500 (EST) + Files: INSTALL + + Title: "Document possible problems with -Mdiagnostics after upgrade" + From: Chip Salzenberg + Files: INSTALL + + Title: "Mention perldelta in INSTALL" + From: Chip Salzenberg + Files: INSTALL + + Title: "Describe pod format at top of INSTALL" + From: Chip Salzenberg + Files: INSTALL + + Title: "Document C</a *b/x> fix" + From: Chip Salzenberg + Files: pod/perldelta.pod + + Title: "pods for subroutine argument autovivication" + From: "M.J.T. Guy" + Msg-ID: <E0w9489-0005YT-00@ursa.cus.cam.ac.uk> + Date: Mon, 24 Mar 1997 07:25:21 +0000 + Files: pod/perldelta.pod pod/perlsub.pod + + Title: "Missing item in perldiag" + From: "M.J.T. Guy" + Msg-ID: <E0w8jVZ-0005va-00@ursa.cus.cam.ac.uk> + Date: Sun, 23 Mar 1997 09:24:09 +0000 + Files: pod/perldiag.pod + + Title: "Mention and discourage use of term 'soft reference'" + From: Chip Salzenberg + Files: pod/perlref.pod + + Title: "Pod problems & fixes" + From: Hallvard B Furuseth + Msg-ID: <199703242031.VAA14997@bombur2.uio.no> + Date: Mon, 24 Mar 1997 21:31:51 +0100 (MET) + Files: INSTALL lib/Term/Complete.pm lib/subs.pm pod/perlcall.pod + pod/perldata.pod pod/perldiag.pod pod/perlembed.pod + pod/perlguts.pod pod/perlmod.pod pod/perlop.pod + pod/perlpod.pod pod/pod2html.PL + + Title: "DB_File documentation fix" + From: Paul Marquess + Msg-ID: <9703240854.AA08401@claudius.bfsec.bt.co.uk> + Date: Mon, 24 Mar 97 08:54:16 GMT + Files: ext/DB_File/DB_File.pm + + Title: "FAQ update" + From: Nathan Torkington <gnat@prometheus.frii.com> + Files: pod/perlfaq*.pod + + +------------------ + Version 5.003_94 +------------------ CORE LANGUAGE CHANGES @@ -60,7 +795,7 @@ Version 5.003_94 CORE PORTABILITY Title: "Don't say 'static var = 1'" - From: Jarkko Hietaniemi <jhi@iki.fi> + From: Jarkko Hietaniemi Msg-ID: <199703091319.PAA24714@alpha.hut.fi> Date: Sun, 9 Mar 1997 15:19:57 +0200 (EET) Files: malloc.c @@ -72,33 +807,32 @@ Version 5.003_94 Files: hints/bsdos.sh Title: "More MachTen hints" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.95q.970316133852.27997A-100000@kelly.teleport.com Date: Sun, 16 Mar 1997 13:40:35 -0800 (PST) Files: hints/machten_2.sh Title: "HP/UX hint comments" - From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> + From: Andy Dougherty Msg-ID: <Pine.SOL.3.95q.970321153918.28770B-100000@fractal.lafayette. Date: Fri, 21 Mar 1997 15:43:07 -0500 (EST) Files: hints/hpux.sh Title: "VMS update" - From: bailey@hmivax.humgen.upenn.edu (Charles Bailey) + From: Charles Bailey Msg-ID: <1997Mar11.220056.1873182@hmivax.humgen.upenn.edu> Date: Tue, 11 Mar 1997 22:00:55 -0500 (EST) Files: lib/ExtUtils/MM_VMS.pm lib/Test/Harness.pm t/op/taint.t utils/perlbug.PL vms/descrip.mms Title: "vmsish.t and related patches" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Msg-ID: <01IGQW3IP1KK005VFB@hmivax.humgen.upenn.edu> Date: Fri, 21 Mar 1997 01:32:47 -0500 (EST) Files: MANIFEST perl.h vms/descrip.mms vms/ext/vmsish.t vms/vms.c Title: "Win32 update (four patches)" - From: Gurusamy Sarathy <gsar@engin.umich.edu> and - Nick Ing-Simmons <nik@tiuk.ti.com> + From: Gurusamy Sarathy and Nick Ing-Simmons Files: MANIFEST README.win32 lib/AutoSplit.pm lib/Cwd.pm lib/ExtUtils/Command.pm lib/ExtUtils/Install.pm lib/ExtUtils/MM_OS2.pm lib/ExtUtils/MM_Unix.pm @@ -144,14 +878,14 @@ Version 5.003_94 Files: ext/POSIX/POSIX.xs mg.c pp_ctl.c toke.c Title: "printf format corrections for -DDEBUGGING" - From: Roderick Schertler <roderick@argon.org> + From: Roderick Schertler Msg-ID: <26592.858793370@eeyore.ibcinc.com> Date: Wed, 19 Mar 1997 12:42:50 -0500 Files: doop.c malloc.c op.c pp_ctl.c regexec.c sv.c x2p/str.c x2p/util.c Title: "Warn about missing -DMULTIPLICITY if likely a problem" - From: Doug MacEachern <dougm@opengroup.org> + From: Doug MacEachern Msg-ID: <199703192345.SAA15070@postman.osf.org> Date: Wed, 19 Mar 1997 18:45:53 -0500 Files: perl.c @@ -177,7 +911,7 @@ Version 5.003_94 Files: installman installperl Title: "3_93 doesn't install pods" - From: Spider Boardman <spider@orb.nashua.nh.us> + From: Spider Boardman Msg-ID: <199703160721.CAA08339@Orb.Nashua.NH.US> Date: Sun, 16 Mar 1997 02:21:35 -0500 Files: installperl @@ -187,7 +921,7 @@ Version 5.003_94 Files: installperl Title: "Make hint files' warnings more visible" - From: Hallvard B Furuseth <h.b.furuseth@usit.uio.no> + From: Hallvard B Furuseth Msg-ID: <199703202218.XAA09041@bombur2.uio.no> Date: Thu, 20 Mar 1997 23:18:03 +0100 (MET) Files: hints/3b1.sh hints/apollo.sh hints/cxux.sh hints/dcosx.sh @@ -199,7 +933,7 @@ Version 5.003_94 LIBRARY AND EXTENSIONS Title: "New module: autouse.pm" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199703210034.TAA13469@monk.mps.ohio-state.edu> Date: Thu, 20 Mar 1997 19:34:30 -0500 (EST) Files: MANIFEST lib/autouse.pm @@ -209,13 +943,13 @@ Version 5.003_94 Files: lib/Math/Complex.pm t/lib/complex.t Title: "Refresh DB_File to 1.12" - From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + From: Paul Marquess Msg-ID: <9703121551.AA07435@claudius.bfsec.bt.co.uk> Date: Wed, 12 Mar 97 15:51:14 GMT Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs Title: "New subroutine Symbol::qualify_to_ref()" - From: Roderick Schertler <roderick@argon.org> + From: Roderick Schertler Msg-ID: <pzlo7ut03b.fsf@eeyore.ibcinc.com> Date: 11 Mar 1997 19:39:36 -0500 Files: lib/Symbol.pm @@ -229,7 +963,7 @@ Version 5.003_94 Files: lib/File/Path.pm Title: "Fix typo in -l*perl* pattern" - From: Doug MacEachern <dougm@opengroup.org> + From: Doug MacEachern Msg-ID: <199703110414.XAA12884@berlin.atlantic.net> Date: Mon, 10 Mar 1997 22:58:38 -0500 Files: lib/ExtUtils/Embed.pm @@ -240,7 +974,7 @@ Version 5.003_94 lib/Getopt/Long.pm Title: "Problems with SKIP in makemaker" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199703210413.XAA21601@monk.mps.ohio-state.edu> Date: Thu, 20 Mar 1997 23:13:31 -0500 (EST) Files: lib/ExtUtils/MM_Unix.pm @@ -250,7 +984,7 @@ Version 5.003_94 Files: lib/Exporter.pm Title: "fix for Exporter's $SIG{__WARN__} handler" - From: Roderick Schertler <roderick@argon.org> + From: Roderick Schertler Msg-ID: <2282.858296451@eeyore.ibcinc.com> Date: Thu, 13 Mar 1997 18:40:51 -0500 Files: lib/Exporter.pm @@ -260,7 +994,7 @@ Version 5.003_94 Files: lib/Carp.pm Title: "Re: NUL in die and other messages" - From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk> + From: "M.J.T. Guy" Msg-ID: <E0w815V-0005xs-00@ursa.cus.cam.ac.uk> Date: Fri, 21 Mar 1997 09:58:17 +0000 Files: lib/Carp.pm @@ -270,7 +1004,7 @@ Version 5.003_94 Files: lib/Pod/Functions.pm Title: "Fix typos in IO::Socket documentation" - From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk> + From: "M.J.T. Guy" Msg-ID: <E0w75po-0003yh-00@taurus.cus.cam.ac.uk> Date: Tue, 18 Mar 1997 20:50:16 +0000 Files: ext/IO/lib/IO/Socket.pm @@ -282,7 +1016,7 @@ Version 5.003_94 UTILITIES Title: "Re: bug in pod2man (5.00326): section=3 for .pm modules" - From: Roderick Schertler <roderick@argon.org> + From: Roderick Schertler Msg-ID: <pzn2sat1hg.fsf@eeyore.ibcinc.com> Date: 11 Mar 1997 19:09:31 -0500 Files: pod/pod2man.PL @@ -290,7 +1024,7 @@ Version 5.003_94 DOCUMENTATION Title: "perlfaq.pod" - From: Tom Christiansen <tchrist@jhereg.perl.com> + From: Tom Christiansen Msg-ID: <199703172301.QAA12566@jhereg.perl.com> Date: Mon, 17 Mar 1997 16:01:40 -0700 Files: MANIFEST pod/Makefile pod/buildtoc pod/perl.pod @@ -305,7 +1039,7 @@ Version 5.003_94 pod/perlsec.pod pod/perlvar.pod Title: "INSTALL: How to enable debugging" - From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> + From: Andy Dougherty Msg-ID: <Pine.SOL.3.95q.970321112326.1414A-100000@fractal.lafayette.e Date: Fri, 21 Mar 1997 11:25:32 -0500 (EST) Files: INSTALL @@ -315,7 +1049,7 @@ Version 5.003_94 Files: pod/perldelta.pod Title: "Re: Embedding success with _93 " - From: Doug MacEachern <dougm@opengroup.org> + From: Doug MacEachern Msg-ID: <199703112255.RAA22775@postman.osf.org> Date: Tue, 11 Mar 1997 17:55:05 -0500 Files: pod/perldelta.pod @@ -327,43 +1061,43 @@ Version 5.003_94 Files: pod/perlmod.pod Title: "Patch to document illegal characters" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.96.970314090558.15346J-100000@kelly.teleport.com> Date: Fri, 14 Mar 1997 09:08:10 -0800 (PST) Files: pod/perldiag.pod pod/perltrap.pod Title: "Document trap with //o and closures" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Msg-ID: <01IGCHWRNSEU00661G@hmivax.humgen.upenn.edu> Date: Mon, 10 Mar 1997 18:08:08 -0500 (EST) Files: pod/perltrap.pod Title: "Re: Inline PI function" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.95q.970310143125.22489V-100000@kelly.teleport.com Date: Mon, 10 Mar 1997 14:33:20 -0800 (PST) Files: pod/perlsub.pod Title: "Illegal character in input" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.95q.970310151512.22489a-100000@kelly.teleport.com Date: Mon, 10 Mar 1997 15:21:21 -0800 (PST) Files: pod/perldiag.pod Title: "Patch for docs Re: Lost backslash" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.96.970319071438.24834G-100000@kelly.teleport.com> Date: Wed, 19 Mar 1997 07:28:57 -0800 (PST) Files: pod/perlop.pod Title: "XSUB's doc fix" - From: Roderick Schertler <roderick@argon.org> + From: Roderick Schertler Msg-ID: <28804.858012126@eeyore.ibcinc.com> Date: Mon, 10 Mar 1997 11:42:06 -0500 Files: pod/perlcall.pod pod/perlguts.pod pod/perlxstut.pod Title: "Document return from do FILE" - From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk> + From: "M.J.T. Guy" Msg-ID: <E0w70DK-0001yJ-00@ursa.cus.cam.ac.uk> Date: Tue, 18 Mar 1997 14:50:10 +0000 Files: pod/perlfunc.pod @@ -388,7 +1122,7 @@ Version 5.003_94 Files: pod/*.pod Title: "clarify example in perlfunc" - From: Jarkko Hietaniemi <jhi@iki.fi> + From: Jarkko Hietaniemi Msg-ID: <199703201746.TAA25195@alpha.hut.fi> Date: Thu, 20 Mar 1997 19:46:01 +0200 (EET) Files: pod/perlfunc.pod @@ -398,9 +1132,9 @@ Version 5.003_94 Files: ext/DB_File/DB_File.pm ----------------- -Version 5.003_93 ----------------- +------------------ + Version 5.003_93 +------------------ Me, last time: "This release will be the public beta of 5.004, @@ -411,13 +1145,13 @@ Me, now: CORE LANGUAGE CHANGES Title: "Don't autovivify array and hash elements in sub parameters" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199703061912.OAA20606@aatma.engin.umich.edu> Date: Thu, 06 Mar 1997 14:12:09 -0500 Files: op.c pod/perldelta.pod pod/perlsub.pod pod/perltrap.pod Title: "Support READ and GETC for tied handles" - From: Doug MacEachern <dougm@opengroup.org> + From: Doug MacEachern Msg-ID: <199703090019.TAA32591@postman.osf.org> Date: Sat, 08 Mar 1997 19:19:38 -0500 Files: pod/perldelta.pod pod/perltie.pod pp_sys.c t/op/misc.t @@ -433,14 +1167,14 @@ Me, now: CORE PORTABILITY Title: "VMS update" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Msg-ID: <01IG8KN5R28M00661G@hmivax.humgen.upenn.edu> Date: Fri, 07 Mar 1997 22:49:46 -0500 (EST) Files: lib/ExtUtils/MM_VMS.pm vms/descrip.mms vms/gen_shrfls.pl vms/sockadapt.h Title: "AmigaOS hint patch" - From: "Norbert Pueschel" <pueschel@imsdd.meb.uni-bonn.de> + From: Norbert Pueschel Msg-ID: <77724767@Armageddon.meb.uni-bonn.de> Date: Sat, 08 Mar 1997 12:50:15 +0100 Files: hints/amigaos.sh @@ -456,7 +1190,7 @@ Me, now: Files: op.c perl.c proto.h Title: "perl -P path patch" - From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> + From: Andy Dougherty Msg-ID: <Pine.SOL.3.95q.970308120242.23766D-100000@fractal.lafayette. Date: Sat, 08 Mar 1997 12:45:08 -0500 (EST) Files: config_H config_h.SH perl.c plan9/config.plan9 t/comp/cpp.t @@ -471,13 +1205,13 @@ Me, now: Files: Configure Title: "Allow './Configure -Uoptimize'" - From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> + From: Andy Dougherty Msg-ID: <Pine.SOL.3.95q.970306110532.11070A-100000@fractal.lafayette. Date: Thu, 06 Mar 1997 11:15:47 -0500 (EST) Files: Configure Title: "Use 'test -f', not 'test -x'" - From: Spider Boardman <spider@web.zk3.dec.com> + From: Spider Boardman Msg-ID: <199703080053.TAA13943@web.zk3.dec.com> Date: Fri, 7 Mar 1997 19:53:00 -0500 Files: Configure @@ -491,19 +1225,19 @@ Me, now: LIBRARY AND EXTENSIONS Title: "Carp with multiple arguments" - From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk> + From: "M.J.T. Guy" Msg-ID: <E0w3STZ-0007RW-00@taurus.cus.cam.ac.uk> Date: Sat, 8 Mar 1997 20:12:17 +0000 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 @@ -529,7 +1263,7 @@ Me, now: DOCUMENTATION Title: "Consolidated INSTALL updates since _92" - From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> + From: Andy Dougherty Msg-ID: <Pine.SOL.3.95q.970308131806.23766F-100000@fractal.lafayette. Date: Sat, 08 Mar 1997 13:21:22 -0500 (EST) @@ -543,13 +1277,13 @@ Me, now: Files: pod/perlform.pod Title: "OS/2 doc update" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199703080537.AAA25157@monk.mps.ohio-state.edu> Date: Sat, 8 Mar 1997 00:37:30 -0500 (EST) Files: README.os2 Title: "PODs corrections" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199703080253.VAA24975@monk.mps.ohio-state.edu> Date: Fri, 7 Mar 1997 21:53:04 -0500 (EST) Files: ext/DB_File/DB_File.pm ext/Socket/Socket.pm @@ -562,9 +1296,9 @@ Me, now: pod/perlop.pod pod/perlsub.pod ----------------- -Version 5.003_92 ----------------- +------------------ + Version 5.003_92 +------------------ This release will be the public beta of 5.004, or my name isn't Larson T. Pettifogger. @@ -588,19 +1322,19 @@ Larson T. Pettifogger. Files: hints/hpux.sh Title: "Re: The continuing MachTen saga" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.95q.970305091611.3572E-100000@kelly.teleport.com> Date: Wed, 5 Mar 1997 09:47:22 -0800 (PST) Files: hints/machten_2.sh Title: "OS/2 patches" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199703060308.WAA22211@monk.mps.ohio-state.edu> Date: Wed, 5 Mar 1997 22:08:43 -0500 (EST) Files: hints/os2.sh lib/ExtUtils/MakeMaker.pm t/op/taint.t Title: "VMS patches" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Msg-ID: <01IG5SQE4A6U00661G@hmivax.humgen.upenn.edu> Date: Wed, 05 Mar 1997 23:10:24 -0500 (EST) Files: lib/ExtUtils/MM_VMS.pm lib/ExtUtils/Manifest.pm perlsdio.h @@ -642,7 +1376,7 @@ Larson T. Pettifogger. Files: op.c Title: "Eliminate format-string type warnings" - From: Hallvard B Furuseth <h.b.furuseth@usit.uio.no> + From: Hallvard B Furuseth Msg-ID: <199703030915.KAA11634@bombur2.uio.no> Date: Mon, 3 Mar 1997 10:15:11 +0100 (MET) Files: doio.c ext/POSIX/POSIX.xs gv.c hints/dec_osf.sh pp.c pp_ctl.c @@ -655,7 +1389,7 @@ Larson T. Pettifogger. BUILD PROCESS Title: "near-harmless bug in _91's Configure" - From: Roderick Schertler <roderick@argon.org> + From: Roderick Schertler Msg-ID: <pzg1yfuiza.fsf@eeyore.ibcinc.com> Date: 01 Mar 1997 21:26:49 -0500 Files: Configure @@ -667,7 +1401,7 @@ Larson T. Pettifogger. LIBRARY AND EXTENSIONS Title: "Newer ReadLine" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199703040634.BAA19919@monk.mps.ohio-state.edu> Date: Tue, 4 Mar 1997 01:34:28 -0500 (EST) Files: lib/Term/ReadLine.pm lib/perl5db.pl @@ -705,7 +1439,7 @@ Larson T. Pettifogger. Files: t/TEST Title: "Smarter t/op/taint.t" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.95q.970303103047.24000A-100000@kelly.teleport.com Date: Mon, 3 Mar 1997 10:31:54 -0800 (PST) Files: t/op/taint.t @@ -733,7 +1467,7 @@ Larson T. Pettifogger. DOCUMENTATION Title: "Add taint checks and srand to perldelta" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.95q.970302115355.23058D-100000@kelly.teleport.com Date: Sun, 2 Mar 1997 11:56:08 -0800 (PST) Files: pod/perldelta.pod @@ -743,26 +1477,25 @@ Larson T. Pettifogger. Files: pod/perldelta.pod Title: "Improve sample module header" - From: Tom Christiansen <tchrist@jhereg.perl.com>, - Graham Barr <gbarr@ti.com> + From: Tom Christiansen and Graham Barr Msg-ID: <199703011732.KAA14693@jhereg.perl.com> Date: Sat, 01 Mar 1997 10:32:31 -0700 Files: pod/perlmod.pod Title: "Clarify C<crypt> documentation" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.95q.970228131112.12357D-100000@kelly.teleport.com Date: Fri, 28 Feb 1997 13:18:25 -0800 (PST) Files: pod/perlfunc.pod Title: "Update list of CPAN sites" - From: Jarkko Hietaniemi <jhi@iki.fi> + From: Jarkko Hietaniemi Msg-ID: <199703021454.QAA07446@alpha.hut.fi> Date: Sun, 2 Mar 1997 16:54:22 +0200 (EET) Files: pod/perlmod.pod Title: "Enhance description of 'server error'" - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Msg-ID: <199702041903.VAA16070@alpha.hut.fi> Date: Tue, 4 Feb 1997 21:03:23 +0200 (EET) Files: pod/perldiag.pod @@ -772,16 +1505,16 @@ Larson T. Pettifogger. Files: pod/*.pod ----------------- -Version 5.003_91 ----------------- +------------------ + Version 5.003_91 +------------------ This is (should be? must be!) the public beta of 5.004. CORE LANGUAGE CHANGES Title: "Fix perl_call_*() when !G_EVAL" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199702250725.CAA09192@aatma.engin.umich.edu>, <199702251925.OAA15498@aatma.engin.umich.edu>, <199702252200.RAA16853@aatma.engin.umich.edu> @@ -798,7 +1531,7 @@ This is (should be? must be!) the public beta of 5.004. Files: pp_sys.c Title: "Don't taint magic hash keys unnecessarily" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Msg-ID: <01IFXL9TY74Y00661G@hmivax.humgen.upenn.edu> Date: Fri, 28 Feb 1997 02:11:26 -0500 (EST) Files: hv.c @@ -806,7 +1539,7 @@ This is (should be? must be!) the public beta of 5.004. CORE PORTABILITY Title: "VMS patches post _90" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Msg-ID: <01IFYDE5ZT7O005A53@hmivax.humgen.upenn.edu> Date: Fri, 28 Feb 1997 15:26:33 -0500 (EST) Files: doio.c mg.c perl.h pp_hot.c t/op/rand.t t/op/taint.t taint.c @@ -835,19 +1568,19 @@ This is (should be? must be!) the public beta of 5.004. Files: perl.c pp.c pp_sys.c toke.c util.c Title: "Clean up and document API for hashes" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199702251824.NAA14859@aatma.engin.umich.edu> Date: Tue, 25 Feb 1997 13:24:02 -0500 Files: hv.c hv.h pod/perldelta.pod pod/perlguts.pod Title: "pp_undef was not always freeing memory" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199702270653.BAA13949@monk.mps.ohio-state.edu> Date: Thu, 27 Feb 1997 01:53:51 -0500 (EST) Files: pp.c Title: "Fix SEGV when debugging with foreach() lvalue patch" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199702271924.OAA14557@monk.mps.ohio-state.edu> Date: Thu, 27 Feb 1997 14:24:36 -0500 (EST) Files: sv.c @@ -857,7 +1590,7 @@ This is (should be? must be!) the public beta of 5.004. Files: pp_hot.c Title: "Silence bogus typo warning on $DB::postponed" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199702271802.NAA12505@aatma.engin.umich.edu> Date: Thu, 27 Feb 1997 13:02:30 -0500 Files: op.c @@ -865,7 +1598,7 @@ This is (should be? must be!) the public beta of 5.004. BUILD PROCESS Title: "Sanity check linking with $libs" - From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> + From: Andy Dougherty Msg-ID: <Pine.SOL.3.95q.970225221634.2486A-100000@fractal.lafayette.edu> Date: Tue, 25 Feb 1997 14:13:45 -0500 (EST) Files: Configure @@ -879,7 +1612,7 @@ This is (should be? must be!) the public beta of 5.004. Files: Configure Title: "Update OS/2 Configure diff" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199702251906.OAA10608@monk.mps.ohio-state.edu> Date: Tue, 25 Feb 1997 14:06:23 -0500 (EST) Files: os2/diff.configure @@ -891,25 +1624,25 @@ This is (should be? must be!) the public beta of 5.004. Files: lib/perl5db.pl Title: "Make IPC::Open3 work without fork()" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199702251937.OAA10718@monk.mps.ohio-state.edu> Date: Tue, 25 Feb 1997 14:37:07 -0500 (EST) Files: lib/IPC/Open3.pm Title: "Follow up on elimination of $` $& $' in libraries" - From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk> + From: "M.J.T. Guy" Msg-ID: <E0w0Sqc-00046E-00@ursa.cus.cam.ac.uk> Date: Fri, 28 Feb 1997 13:59:42 +0000 Files: lib/Getopt/Long.pm lib/diagnostics.pm Title: "Don't warn on use of CCFLAGS" - From: Andreas Koenig <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 Title: "Allow explicit '-lperl' in link arguments" - From: Doug MacEachern <dougm@opengroup.org> + From: Doug MacEachern Msg-ID: <199702271625.LAA25402@postman.osf.org> Date: Thu, 27 Feb 1997 11:25:04 -0500 Files: lib/ExtUtils/Embed.pm @@ -917,13 +1650,13 @@ This is (should be? must be!) the public beta of 5.004. TESTS Title: "New test op/taint.t" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.95q.970225101328.18288M-100000@kelly.teleport.com Date: Tue, 25 Feb 1997 11:36:53 -0800 (PST) Files: MANIFEST t/op/taint.t Title: "Patch to t/op/rand.t" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.95q.970225181321.13796Q-100000@kelly.teleport.com Date: Tue, 25 Feb 1997 18:19:34 -0800 (PST) Files: t/op/rand.t @@ -941,7 +1674,7 @@ This is (should be? must be!) the public beta of 5.004. DOCUMENTATION Title: "Warn about intrusive sfio behavior" - From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> + From: Andy Dougherty Msg-ID: <Pine.SOL.3.95q.970228112136.24038G-100000@fractal.lafayette. Date: Fri, 28 Feb 1997 11:35:49 -0500 (EST) Files: INSTALL @@ -964,9 +1697,9 @@ This is (should be? must be!) the public beta of 5.004. pod/perltoc.pod ----------------- -Version 5.003_90 ----------------- +------------------ + Version 5.003_90 +------------------ At last, a mil[le]stone: The first beta of Perl 5.004. @@ -979,20 +1712,20 @@ At last, a mil[le]stone: The first beta of Perl 5.004. CORE PORTABILITY Title: "Ultrix hints" - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman Msg-ID: <199702220951.EAA08156@Orb.Nashua.NH.US> Date: Sat, 22 Feb 1997 04:51:48 -0500 Files: hints/ultrix_4.sh Title: "Digital UNIX and 3_28" - From: Jarkko Hietaniemi <jhi@iki.fi> + From: Jarkko Hietaniemi Msg-ID: <199702231427.QAA13807@alpha.hut.fi> Date: Sun, 23 Feb 1997 16:27:19 +0200 (EET) Files: Configure MANIFEST ext/NDBM_File/hints/dec_osf.pl ext/ODBM_File/hints/dec_osf.pl hints/dec_osf.sh Title: "AmigaOS patches to 5.003_28" - From: "Norbert Pueschel" <pueschel@imsdd.meb.uni-bonn.de> + From: Norbert Pueschel Msg-ID: <77724759@Armageddon.meb.uni-bonn.de> Date: Sat, 22 Feb 1997 18:08:02 +0100 Files: README.amiga hints/amigaos.sh t/io/fs.t t/lib/anydbm.t @@ -1019,7 +1752,7 @@ At last, a mil[le]stone: The first beta of Perl 5.004. BUILD PROCESS Title: "Re: ccdlflags don't quite work" - From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> + From: Andy Dougherty Msg-ID: <Pine.SOL.3.95q.970224160630.5700E-100000@fractal.lafayette.e Date: Mon, 24 Feb 1997 16:07:07 -0500 (EST) Files: Configure @@ -1029,13 +1762,13 @@ At last, a mil[le]stone: The first beta of Perl 5.004. Files: Configure Title: "'installperl -v' doesn't do enough" - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman Msg-ID: <199702241342.IAA25945@Orb.Nashua.NH.US> Date: Mon, 24 Feb 1997 08:42:59 -0500 Files: installperl Title: "installperl breaks running system (for a while)" - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman Msg-ID: <199702241412.JAA11829@Orb.Nashua.NH.US> Date: Mon, 24 Feb 1997 09:12:11 -0500 Files: installperl @@ -1043,23 +1776,23 @@ At last, a mil[le]stone: The first beta of Perl 5.004. LIBRARY AND EXTENSIONS Title: "Don't clobber $1 et al in debugger's DB::sub()" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Files: lib/perl5db.pl Title: "Fix fd leak in IO::Pipe" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <pzn2sv722y.fsf@eeyore.ibcinc.com> Date: 23 Feb 1997 14:29:57 -0500 Files: ext/IO/lib/IO/Pipe.pm Title: "Pod::Text fixes" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <350.856634588@eeyore.ibcinc.com> Date: Sat, 22 Feb 1997 13:03:08 -0500 Files: lib/Pod/Text.pm Title: "Trivial patch to make ExtUtils::Install more -w clean" - From: Tim Bunce <Tim.Bunce@ig.co.uk> + From: Tim Bunce Msg-ID: <9702241605.AA17436@toad.ig.co.uk> Date: Mon, 24 Feb 1997 16:05:17 +0000 Files: lib/ExtUtils/Install.pm @@ -1071,7 +1804,7 @@ At last, a mil[le]stone: The first beta of Perl 5.004. TESTS Title: "More thoroughly test rand() and srand()" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Files: t/op/rand.t Title: "Don't use <*> where readdir() will do" @@ -1087,19 +1820,19 @@ At last, a mil[le]stone: The first beta of Perl 5.004. UTILITIES Title: "Post-28 INSTALL updates" - From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> + From: Andy Dougherty Msg-ID: <Pine.SOL.3.95q.970224170713.5700H-100000@fractal.lafayette.e Date: Mon, 24 Feb 1997 17:09:09 -0500 (EST) Files: INSTALL Title: "Re: Hash key created by subroutine call? (fwd) " - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199702242229.RAA04395@aatma.engin.umich.edu> Date: Mon, 24 Feb 1997 17:29:30 -0500 Files: pod/perlsub.pod pod/perltrap.pod Title: "Add documentation and '-h' option to perlbug" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199702240854.DAA27128@aatma.engin.umich.edu> and <199702242009.PAA02849@aatma.engin.umich.edu> Date: Mon, 24 Feb 1997 @@ -1107,7 +1840,7 @@ At last, a mil[le]stone: The first beta of Perl 5.004. utils/perlbug.PL Title: "pumpkin-1.9.pod" - From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> + From: Andy Dougherty Msg-ID: <Pine.SOL.3.95q.970224155702.5700D-100000@fractal.lafayette.e Date: Mon, 24 Feb 1997 16:06:02 -0500 (EST) Files: Porting/pumpkin.pod @@ -1115,19 +1848,19 @@ At last, a mil[le]stone: The first beta of Perl 5.004. DOCUMENTATION Title: "Fix typo in 'Tolkien quotation typo' fix" - From: Jarkko Hietaniemi <jhi@hut.fi> + From: Jarkko Hietaniemi Files: Changes Title: "Document one-argument limitation with #! line" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.95q.970223182745.15989A-100000@kelly.teleport.com Date: Sun, 23 Feb 1997 18:41:02 -0800 (PST) Files: pod/perldiag.pod pod/perlsec.pod ----------------- -Version 5.003_28 ----------------- +------------------ + Version 5.003_28 +------------------ This release is beta candidate #6. If this isn't good enough to go beta, I'll eat a floppy disk. (Okay, it's a chocolate floppy, but still....) @@ -1151,7 +1884,7 @@ I'll eat a floppy disk. (Okay, it's a chocolate floppy, but still....) Files: run.c Title: "When overloading, don't throw away nomethod's value" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Files: gv.c Title: "Optimize keys() and values() in void context" @@ -1161,7 +1894,7 @@ I'll eat a floppy disk. (Okay, it's a chocolate floppy, but still....) CORE PORTABILITY Title: "New hints for Digital UNIX" - From: Jarkko Hietaniemi <jhi@iki.fi> + From: Jarkko Hietaniemi Files: hints/dec_osf.sh Title: "No version of AIX has working setre[ug]id()" @@ -1169,7 +1902,7 @@ I'll eat a floppy disk. (Okay, it's a chocolate floppy, but still....) Files: hints/aix.sh Title: "VMS patches post _27" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Msg-ID: <01IFMEMPN1IU0057E2@hmivax.humgen.upenn.edu> Date: Thu, 20 Feb 1997 01:58:46 -0500 (EST) Files: MANIFEST dosish.h hv.c lib/ExtUtils/MM_VMS.pm @@ -1179,7 +1912,7 @@ I'll eat a floppy disk. (Okay, it's a chocolate floppy, but still....) vms/vms.c vms/vmsish.h Title: "Re: OS/2 patch for _27" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199702210024.TAA03174@monk.mps.ohio-state.edu> Date: Thu, 20 Feb 1997 19:24:16 -0500 (EST) Files: INSTALL README.os2 lib/Test/Harness.pm os2/Changes @@ -1206,7 +1939,7 @@ I'll eat a floppy disk. (Okay, it's a chocolate floppy, but still....) Files: op.c Title: "Minor update to malloc.c" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199702210244.VAA03676@monk.mps.ohio-state.edu> Date: Thu, 20 Feb 1997 21:44:13 -0500 (EST) Files: malloc.c @@ -1222,13 +1955,13 @@ I'll eat a floppy disk. (Okay, it's a chocolate floppy, but still....) LIBRARY AND EXTENSIONS Title: "Debugger patch" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199702210737.CAA03951@monk.mps.ohio-state.edu> Date: Fri, 21 Feb 1997 02:37:59 -0500 (EST) Files: lib/perl5db.pl Title: "Avoid $` $& $' in libraries" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199702210207.VAA03560@monk.mps.ohio-state.edu> Date: Thu, 20 Feb 1997 21:07:30 -0500 (EST) Files: lib/Getopt/Long.pm lib/Pod/Text.pm lib/diagnostics.pm @@ -1271,7 +2004,7 @@ I'll eat a floppy disk. (Okay, it's a chocolate floppy, but still....) DOCUMENTATION Title: "INSTALL updates since _26" - From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> + From: Andy Dougherty Msg-ID: <Pine.SOL.3.95q.970218155815.2014F-100000@fractal.lafayette.e Date: Tue, 18 Feb 1997 16:00:08 -0500 (EST) Files: INSTALL @@ -1289,7 +2022,7 @@ I'll eat a floppy disk. (Okay, it's a chocolate floppy, but still....) Files: pod/perldelta.pod pod/perlop.pod Title: "Document C<$?> vs. $SIG{CHLD}" - From: Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de> + From: Ulrich Pfeifer Files: pod/perlvar.pod Title: "Add pumpkin.pod" @@ -1304,28 +2037,28 @@ I'll eat a floppy disk. (Okay, it's a chocolate floppy, but still....) pod/perltie.pod pod/perltoc.pod pod/perltrap.pod x2p/a2p.pod ----------------- -Version 5.003_27 ----------------- +------------------ + Version 5.003_27 +------------------ This release is beta candidate #5: Our last, best hope for a beta. CORE LANGUAGE CHANGES Title: "Better looks_like_number() function [sv.c]" - From: Gisle Aas <aas@bergen.sn.no> + From: Gisle Aas Msg-ID: <199702141708.SAA17546@bergen.sn.no> Date: Fri, 14 Feb 1997 18:08:52 +0100 Files: sv.c Title: "Remove redundant functions UNIVERSAL::{class,is_instance}" - From: Gisle Aas <aas@bergen.sn.no> + From: Gisle Aas Msg-ID: <hwwsbpeq2.fsf@bergen.sn.no> Date: 14 Feb 1997 15:52:21 +0000 Files: pod/perldelta.pod pod/perlobj.pod t/op/universal.t universal.c Title: "Allow C<setpgrp $$>" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <pzraigyshr.fsf@eeyore.ibcinc.com> Date: 16 Feb 1997 23:19:12 -0500 Files: pp_sys.c @@ -1345,7 +2078,7 @@ This release is beta candidate #5: Our last, best hope for a beta. CORE PORTABILITY Title: "Eliminate $^S; add C<use vmsish qw(status exit time)>" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Msg-ID: <01IFI9CFKL0S004R2V@hmivax.humgen.upenn.edu> Date: Mon, 17 Feb 1997 02:45:26 -0500 (EST) Files: MANIFEST gv.c lib/English.pm lib/ExtUtils/MM_VMS.pm @@ -1362,7 +2095,7 @@ This release is beta candidate #5: Our last, best hope for a beta. Files: hints/sco.sh unixish.h Title: "Digital UNIX hints" - From: Jarkko Hietaniemi <jhi@iki.fi> + From: Jarkko Hietaniemi Msg-ID: <199702151906.VAA22999@alpha.hut.fi> Date: Sat, 15 Feb 1997 21:06:33 +0200 (EET) Files: hints/dec_osf.sh @@ -1385,13 +2118,13 @@ This release is beta candidate #5: Our last, best hope for a beta. Files: perl.c Title: "Re: Fragile signals" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199702130644.BAA07572@monk.mps.ohio-state.edu> Date: Thu, 13 Feb 1997 01:44:39 -0500 (EST) Files: mg.c Title: "Make format strings correspond exactly to parameters" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <pz7mkc1h0g.fsf@eeyore.ibcinc.com> Date: 13 Feb 1997 17:24:31 -0500 Files: doio.c ext/DB_File/DB_File.xs ext/Opcode/Opcode.xs gv.c op.c @@ -1448,11 +2181,11 @@ This release is beta candidate #5: Our last, best hope for a beta. lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Mksymlists.pm Title: "Refresh CPAN.pm to 1.21" - From: Andreas Koenig <a.koenig@mind.de> + From: Andreas Koenig Files: lib/CPAN.pm lib/CPAN/FirstTime.pm lib/CPAN/Nox.pm Title: "Refresh Test::Harness to 1.15" - From: Andreas Koenig <a.koenig@mind.de> + From: Andreas Koenig Files: lib/Test/Harness.pm TESTS @@ -1464,7 +2197,7 @@ This release is beta candidate #5: Our last, best hope for a beta. UTILITIES Title: "pod2man: missing '-' in name section shouldn't be fatal" - From: Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de> + From: Ulrich Pfeifer Msg-ID: <yfmzpxcimsa.fsf@ls6.informatik.uni-dortmund.de> Date: 10 Feb 1997 18:38:45 +0100 Files: pod/pod2man.PL @@ -1472,7 +2205,7 @@ This release is beta candidate #5: Our last, best hope for a beta. DOCUMENTATION Title: "Update To-Do list" - From: Tim Bunce <Tim.Bunce@ig.co.uk> + From: Tim Bunce Msg-ID: <9702101900.AA25293@toad.ig.co.uk> Date: Mon, 10 Feb 1997 19:00:59 +0000 Files: Todo @@ -1482,9 +2215,9 @@ This release is beta candidate #5: Our last, best hope for a beta. Files: pod/perldiag.pod ----------------- -Version 5.003_26 ----------------- +------------------ + Version 5.003_26 +------------------ This release is beta candidate #4. "Once more, dear friends...." @@ -1505,7 +2238,7 @@ This release is beta candidate #4. "Once more, dear friends...." Files: mg.c perl.h pp_sys.c Title: "VMS patches post _25" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Msg-ID: <01IF48W3P39W0050BD@hmivax.humgen.upenn.edu> Date: Fri, 07 Feb 1997 01:56:12 -0500 (EST) Files: Porting/Glossary lib/ExtUtils/Liblist.pm @@ -1534,13 +2267,13 @@ This release is beta candidate #4. "Once more, dear friends...." Files: cop.h pp_ctl.c Title: "Regexp optimizations" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199702041102.GAA24805@monk.mps.ohio-state.edu> Date: Tue, 4 Feb 1997 06:02:10 -0500 (EST) Files: regcomp.c regexec.c Title: "Re: static buffer in not_a_number() [sv.c] might overflow" - From: Gisle Aas <aas@bergen.sn.no> + From: Gisle Aas Msg-ID: <hbu9uz1si.fsf@bergen.sn.no> Date: 09 Feb 1997 11:55:41 +0100 Files: sv.c @@ -1560,19 +2293,19 @@ This release is beta candidate #4. "Once more, dear friends...." BUILD PROCESS Title: "Fix usage message in configure.gnu" - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Files: configure.gnu LIBRARY AND EXTENSIONS Title: "DB_File 1.11 patch" - From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + From: Paul Marquess Msg-ID: <9702061553.AA18147@claudius.bfsec.bt.co.uk> Date: Thu, 6 Feb 97 15:53:34 GMT Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs Title: "Faster File::Compare" - From: Gisle Aas <aas@bergen.sn.no> + From: Gisle Aas Msg-ID: <199702051342.OAA02753@bergen.sn.no> Date: Wed, 5 Feb 1997 14:42:49 +0100 Files: lib/File/Compare.pm @@ -1588,7 +2321,7 @@ This release is beta candidate #4. "Once more, dear friends...." TESTS Title: "Fix closure.t for AmigaOS (again)" - From: "Norbert Pueschel" <pueschel@imsdd.meb.uni-bonn.de> + From: Norbert Pueschel Msg-ID: <77724742@Armageddon.meb.uni-bonn.de> Date: Wed, 05 Feb 1997 18:56:45 +0100 Files: t/op/closure.t @@ -1596,13 +2329,13 @@ This release is beta candidate #4. "Once more, dear friends...." UTILITIES Title: "perldoc -f <perlfunc>" - From: Gisle Aas <aas@bergen.sn.no> + From: Gisle Aas Msg-ID: <199702051127.MAA02090@bergen.sn.no> Date: Wed, 5 Feb 1997 12:27:36 +0100 Files: utils/perldoc.PL Title: "Fix pod2man's handling of quotes in =items" - From: Jarkko Hietaniemi <jhi@iki.fi> + From: Jarkko Hietaniemi Msg-ID: <199702042023.WAA13143@alpha.hut.fi> Date: Tue, 4 Feb 1997 22:23:34 +0200 (EET) Files: pod/pod2man.PL @@ -1620,9 +2353,9 @@ This release is beta candidate #4. "Once more, dear friends...." Files: pod/perltie.pod ----------------- -Version 5.003_25 ----------------- +------------------ + Version 5.003_25 +------------------ This release is beta candidate #3. Here's hoping... @@ -1645,7 +2378,7 @@ This release is beta candidate #3. Here's hoping... CORE PORTABILITY Title: "VMS patches for _24" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Msg-ID: <01IEUIFP5038004GQP@hmivax.humgen.upenn.edu> Date: Fri, 31 Jan 1997 02:34:37 -0500 (EST) Files: ext/DynaLoader/DynaLoader.pm ext/DynaLoader/dl_vms.xs @@ -1655,13 +2388,13 @@ This release is beta candidate #3. Here's hoping... vms/ext/filespec.t vms/vms.c vms/vmsish.h Title: "hints/dec_osf.sh: polishing the comments" - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Msg-ID: <199701301958.VAA08992@alpha.hut.fi> Date: Thu, 30 Jan 1997 21:58:10 +0200 (EET) Files: hints/dec_osf.sh Title: "amigaos.sh" - From: "Norbert Pueschel" <pueschel@imsdd.meb.uni-bonn.de> + From: Norbert Pueschel Msg-ID: <77724724@Armageddon.meb.uni-bonn.de> Date: Wed, 29 Jan 1997 11:39:49 +0100 Files: hints/amigaos.sh @@ -1681,7 +2414,7 @@ This release is beta candidate #3. Here's hoping... Files: pp_sys.c Title: "Fix /\G/g with patterns that match empty string" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Files: pp_hot.c Title: "Fix scalar leak in av_unshift" @@ -1709,11 +2442,11 @@ This release is beta candidate #3. Here's hoping... LIBRARY AND EXTENSIONS Title: "Refresh CPAN to 1.19" - From: Andreas Koenig <a.koenig@mind.de> + From: Andreas Koenig Files: lib/Bundle/CPAN.pm lib/CPAN.pm lib/CPAN/FirstTime.pm Title: "Debugger update" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199702030406.XAA23029@monk.mps.ohio-state.edu> Date: Sun, 2 Feb 1997 23:06:34 -0500 (EST) Files: lib/perl5db.pl @@ -1727,7 +2460,7 @@ This release is beta candidate #3. Here's hoping... Files: ext/POSIX/POSIX.xs Title: "Make IO::Handle::gets() an alias of getline" - From: Gisle Aas <aas@bergen.sn.no> + From: Gisle Aas Msg-ID: <199701301103.MAA11291@bergen.sn.no> Date: Thu, 30 Jan 1997 12:03:15 +0100 Files: ext/IO/lib/IO/Handle.pm lib/IO/Handle.pm @@ -1735,7 +2468,7 @@ This release is beta candidate #3. Here's hoping... TESTS Title: "More Amiga test patches" - From: "Norbert Pueschel" <pueschel@imsdd.meb.uni-bonn.de> + From: Norbert Pueschel Msg-ID: <77724725@Armageddon.meb.uni-bonn.de> Date: Wed, 29 Jan 1997 16:07:33 +0100 Files: README.amiga t/lib/safe2.t t/op/closure.t @@ -1771,7 +2504,7 @@ This release is beta candidate #3. Here's hoping... Files: pod/perldelta.pod Title: "perlfunc.pod tweaks" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <20526.854659255@eeyore.ibcinc.com> Date: Thu, 30 Jan 1997 16:20:55 -0500 Files: pod/perlfunc.pod @@ -1787,9 +2520,9 @@ This release is beta candidate #3. Here's hoping... Files: pod/perldiag.pod ----------------- -Version 5.003_24 ----------------- +------------------ + Version 5.003_24 +------------------ This release is the second candidate for a public beta test. It's, well, bunches better than _23. @@ -1797,19 +2530,19 @@ It's, well, bunches better than _23. CORE LANGUAGE CHANGES Title: "glob defaults to $_" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199701270809.DAA00934@aatma.engin.umich.edu> Date: Mon, 27 Jan 1997 03:09:13 -0500 Files: op.c opcode.pl pod/perlfunc.pod t/op/glob.t Title: "Re: an overloading bug " - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199701270007.TAA26525@aatma.engin.umich.edu> Date: Sun, 26 Jan 1997 19:07:45 -0500 Files: pod/perldiag.pod pod/perlfunc.pod pp_ctl.c Title: "Don't warn on C<$\ = undef>" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: mg.c CORE PORTABILITY @@ -1819,7 +2552,7 @@ It's, well, bunches better than _23. Files: MANIFEST win32/* Title: "Amiga files" - From: Norbert Pueschel <pueschel@imsdd.meb.uni-bonn.de> + From: Norbert Pueschel Msg-ID: <77724712@Armageddon.meb.uni-bonn.de> Date: Sun, 26 Jan 1997 17:42:15 +0100 Files: MANIFEST README.amiga hints/amigaos.sh @@ -1833,27 +2566,27 @@ It's, well, bunches better than _23. OTHER CORE CHANGES Title: "Prevent premature death of @_ during leavesub" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_hot.c t/op/misc.t Title: "Deref old stash when re-blessing" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: sv.c Title: "Don't abort when RCHECK and DEBUGGING" - From: Tim Bunce <Tim.Bunce@ig.co.uk> + From: Tim Bunce Msg-ID: <9701272339.AA16537@toad.ig.co.uk> Date: Mon, 27 Jan 1997 23:39:48 +0000 Files: malloc.c Title: "Fix overloading macro conflict with Digital 'cc -fast'" - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Msg-ID: <199701272216.AAA04557@alpha.hut.fi> Date: Tue, 28 Jan 1997 00:16:49 +0200 (EET) Files: perl.h Title: "global.sym: typo?" - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Msg-ID: <199701261937.VAA07556@alpha.hut.fi> Date: Sun, 26 Jan 1997 21:37:59 +0200 (EET) Files: global.sym @@ -1861,39 +2594,39 @@ It's, well, bunches better than _23. BUILD PROCESS Title: "Put all extensions' modules in $archlib" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: installperl Title: "Configure fixes: set $archlib, omit _NO_PROTO" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Configure Title: "Make configure{,.gnu} ignore --cache-file option" - From: Norbert Pueschel <pueschel@imsdd.meb.uni-bonn.de> + From: Norbert Pueschel Files: configure configure.gnu LIBRARY AND EXTENSIONS Title: "Version checking in XS bootstrap is optional" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: XSUB.h Title: "Update $VERSION of DynaLoader and POSIX" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: ext/DynaLoader/DynaLoader.pm ext/POSIX/POSIX.pm Title: "Refresh Text::Wrap to 97.011701" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: lib/Text/Wrap.pm Title: "Fcntl.xs: F_[GS]ETOWN were in wrong case branch" - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Msg-ID: <199701251510.RAA05142@alpha.hut.fi> Date: Sat, 25 Jan 1997 17:10:20 +0200 (EET) Files: ext/Fcntl/Fcntl.pm ext/Fcntl/Fcntl.xs Title: "Fix $Is_VMS typo in Test::Harness" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: lib/Test/Harness.pm Title: "Allow for really big keys in Tie::SubstrHash" @@ -1903,19 +2636,19 @@ It's, well, bunches better than _23. Files: lib/Tie/SubstrHash.pm Title: "Avoid newRV_noinc() in IO, for compiling with old Perls" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: ext/IO/IO.xs TESTS Title: "New test op/closure.t" - From: Tom Phoenix <rootbeer@teleport.com>, Ulrich Pfeifer + From: Tom Phoenix, Ulrich Pfeifer Files: MANIFEST t/op/closure.t UTILITIES Title: "xsubpp handing of void funcs breaks extensions using XST_m*()" - From: Tim Bunce <Tim.Bunce@ig.co.uk> + From: Tim Bunce Msg-ID: <9701271659.AA15137@toad.ig.co.uk> Date: Mon, 27 Jan 1997 16:59:06 +0000 Files: lib/ExtUtils/xsubpp @@ -1923,17 +2656,17 @@ It's, well, bunches better than _23. DOCUMENTATION Title: "perldelta Fcntl enhancement" - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Msg-ID: <199701251505.RAA22159@alpha.hut.fi> Date: Sat, 25 Jan 1997 17:05:34 +0200 (EET) Files: pod/perldelta.pod Title: "Updates to perldelta re: Fcntl, DB_File, Net::Ping" - From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + From: Paul Marquess Files: pod/perldelta.pod Title: "Document restrictions on gv_fetchmethod() and perl_call_sv()" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pod/perldelta.pod pod/perlguts.pod Title: "perldiag.pod: No comma allowed after %s" @@ -1943,7 +2676,7 @@ It's, well, bunches better than _23. Files: pod/perldiag.pod Title: "perlfunc.pod: localtime" - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Msg-ID: <199701251629.SAA08114@alpha.hut.fi> Date: Sat, 25 Jan 1997 18:29:37 +0200 (EET) Files: pod/perlfunc.pod @@ -1955,38 +2688,38 @@ It's, well, bunches better than _23. Files: pod/perlfunc.pod Title: "Updates to guts" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199701270034.TAA13177@monk.mps.ohio-state.edu> Date: Sun, 26 Jan 1997 19:34:18 -0500 (EST) Files: pod/perlguts.pod Title: "perltoot fixes" - From: Tom Christiansen <tchrist@mox.perl.com> + From: Tom Christiansen Msg-ID: <6807.854214205@jinete> Date: Sat, 25 Jan 1997 09:43:25 -0800 Files: pod/perltoot.pod Title: "5.003_23: small typo in perlsyn.pod" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199701270824.DAA01169@aatma.engin.umich.edu> Date: Mon, 27 Jan 1997 03:24:25 -0500 Files: pod/perlsyn.pod ----------------- -Version 5.003_23 ----------------- +------------------ + Version 5.003_23 +------------------ This release is our first candidate for a public beta test. CORE LANGUAGE CHANGES Title: "Disallow changing $_[0] in __DIE__ handlers" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pod/perlfunc.pod util.c Title: "Fix overloading with inheritance and AUTOLOAD" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199701202226.RAA05072@monk.mps.ohio-state.edu> Date: Mon, 20 Jan 1997 17:26:32 -0500 (EST) Files: gv.c lib/diagnostics.pm lib/overload.pm pod/perldebug.pod @@ -2000,21 +2733,21 @@ This release is our first candidate for a public beta test. Files: toke.c Title: "Revert $^X to old behavior (plus HP-UX bug fix)" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: hints/hpux.sh toke.c Title: "Protect against '0' in 'stmt while <HANDLE>'" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c Title: "Don't warn when closure uses var at file scope" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c CORE PORTABILITY Title: "VMS patches for _22" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Msg-ID: <01IEGBJ2TMYS003PCL@hmivax.humgen.upenn.edu> Date: Mon, 20 Jan 1997 22:50:21 -0500 (EST) Files: ext/POSIX/POSIX.xs lib/ExtUtils/MM_VMS.pm lib/ExtUtils/xsubpp @@ -2023,7 +2756,7 @@ This release is our first candidate for a public beta test. vms/Makefile vms/config.vms vms/descrip.mms vms/perly_c.vms Title: "Re: Perl 5.003_21: OS/2 patches" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199701170446.XAA28939@monk.mps.ohio-state.edu> Date: Thu, 16 Jan 1997 23:46:40 -0500 (EST) Files: os2/Changes os2/os2.c @@ -2033,7 +2766,7 @@ This release is our first candidate for a public beta test. Files: plan9/config.plan9 plan9/mkfile Title: "Bugfixes for AmigaOS" - From: "Norbert Pueschel" <pueschel@imsdd.meb.uni-bonn.de> + From: Norbert Pueschel Msg-ID: <77724691@Armageddon.meb.uni-bonn.de> Date: Wed, 22 Jan 1997 00:13:54 +0100 Files: hints/amigaos.sh lib/File/Basename.pm @@ -2045,7 +2778,7 @@ This release is our first candidate for a public beta test. Files: hints/dec_osf.sh Title: "on NeXT: gdbm problem fixed" - From: Andreas Koenig <k@anna.in-berlin.de> + From: Andreas Koenig Msg-ID: <199701210201.DAA17794@anna.in-berlin.de> Date: Tue, 21 Jan 1997 03:01:32 +0100 Files: hints/next_3.sh hints/next_3_0.sh @@ -2071,49 +2804,49 @@ This release is our first candidate for a public beta test. OTHER CORE CHANGES Title: "Make PERL5LIB and -I work like C<use lib>" - From: Tim Bunce <Tim.Bunce@ig.co.uk> + From: Tim Bunce Msg-ID: <9701231523.AA26613@toad.ig.co.uk> Date: Thu, 23 Jan 1997 15:23:27 +0000 Files: lib/lib.pm perl.c Title: "Fix /\G.a/" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: regcomp.c regcomp.h regexec.c regexp.h toke.c Title: "Extend stack in pp_undef (!)" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp.c Title: "Allow for sub to be redefined while executing" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: cop.h pp_hot.c t/op/misc.t Title: "Eliminate redundant flag CVf_FORMAT" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: cv.h op.c perl.c perly.c perly.y proto.h sv.c toke.c Title: "Generate IVs when possible in abs() and int()" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp.c Title: "Efficiency patchlet for pp_aassign()" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199701210305.WAA05451@monk.mps.ohio-state.edu> Date: Mon, 20 Jan 1997 22:05:39 -0500 (EST) Files: pp_hot.c Title: "When sorting, promote to PVNV only for built-in comparison" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_ctl.c Title: "Remove "suidperl security patch" message" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: perl.c BUILD PROCESS Title: "Make configure.gnu a copy of configure; make configure writea - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: MANIFEST configure.gnu Title: "Regen Configure with metaconfig: +ARCHNAME, -FILE_filbuf" @@ -2123,23 +2856,23 @@ This release is our first candidate for a public beta test. utils/perlbug.PL vms/config.vms vms/fndvers.com Title: "Compile with optimization when testing memory functions" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Configure Title: "Minor patch for Debian installation" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: installperl LIBRARY AND EXTENSIONS Title: "Debugger update" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199701190455.XAA02579@monk.mps.ohio-state.edu> Date: Sat, 18 Jan 1997 23:54:59 -0500 (EST) Files: lib/perl5db.pl Title: "DynaLoader enhancement: support RTLD_GLOBAL" - From: Nick Ing-Simmons <nik@tiuk.ti.com> + From: Nick Ing-Simmons Msg-ID: <199701240937.JAA11443@pluto.tiuk.ti.com> Date: Fri, 24 Jan 1997 09:37:18 GMT Files: ext/DynaLoader/DynaLoader.pm ext/DynaLoader/dl_aix.xs @@ -2154,21 +2887,21 @@ This release is our first candidate for a public beta test. Files: ext/Fcntl/Fcntl.pm ext/Fcntl/Fcntl.xs Title: "Refresh IO to 1.15 (plus DESTROY and new_tmpfile fixes)" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: ext/IO/lib/IO/File.pm ext/IO/lib/IO/Handle.pm ext/IO/lib/IO/Pipe.pm ext/IO/lib/IO/Seekable.pm ext/IO/lib/IO/Socket.pm t/lib/io_pipe.t Title: "Allow IO.xs to remain at 1.15 while $VERSION is 1.1501" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: XSUB.h ext/IO/Makefile.PL ext/IO/lib/IO/Handle.pm Title: "Refresh CPAN to 1.15" - From: Andreas Koenig <a.koenig@mind.de> + From: Andreas Koenig Files: lib/CPAN.pm lib/CPAN/FirstTime.pm Title: "Add E* and SA_* constants" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <23338.853986967@eeyore.ibcinc.com> Date: Wed, 22 Jan 1997 21:36:07 -0500 Files: ext/POSIX/POSIX.pm ext/POSIX/POSIX.pod ext/POSIX/POSIX.xs @@ -2182,18 +2915,18 @@ This release is our first candidate for a public beta test. Files: t/base/lex.t Title: "Fix tests of $^X and $0 to work with QNX" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: t/lib/io_pipe.t t/lib/open2.t t/lib/open3.t t/op/magic.t Title: "Patch tests for systems without fork()" - From: "Norbert Pueschel" <pueschel@imsdd.meb.uni-bonn.de> + From: Norbert Pueschel Msg-ID: <77724697@Armageddon.meb.uni-bonn.de> Date: Thu, 23 Jan 1997 23:51:28 +0100 Files: t/io/pipe.t t/lib/filehand.t t/lib/io_pipe.t t/lib/io_sock.t t/lib/open2.t t/lib/open3.t t/op/fork.t Title: "Test patches for OS/2" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199701170448.XAA28948@monk.mps.ohio-state.edu> Date: Thu, 16 Jan 1997 23:48:18 -0500 (EST) Files: os2/OS2/ExtAttr/t/os2_ea.t os2/OS2/PrfDB/t/os2_prfdb.t @@ -2209,11 +2942,11 @@ This release is our first candidate for a public beta test. UTILITIES Title: "Translate \200 to È in pod2html" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pod/pod2html.PL Title: "VMS patches: '.com' extension on scripts" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Msg-ID: <01IELNPDLYJM003E7J@hmivax.humgen.upenn.edu> Date: Fri, 24 Jan 1997 18:42:29 -0500 (EST) Files: pod/checkpods.PL pod/pod2html.PL pod/pod2latex.PL @@ -2231,56 +2964,56 @@ This release is our first candidate for a public beta test. DOCUMENTATION Title: "First cut at INSTALL edit" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: INSTALL Title: "Additional docs for __DIE__ and __WARN__" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Files: pod/perlfunc.pod pod/perlrun.pod pod/perlvar.pod Title: "Document #line directive" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199701240908.EAA23846@aatma.engin.umich.edu> Date: Fri, 24 Jan 1997 04:08:44 -0500 Files: pod/perlsyn.pod pod/perltoc.pod Title: "Perlguts version 30" - From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com> + From: Jeff Okamoto Msg-ID: <199701172117.AA116515863@hpcc123.corp.hp.com> Date: Fri, 17 Jan 1997 13:17:43 -0800 Files: pod/perlguts.pod Title: "delta for perldelta" - From: Tom Christiansen <tchrist@mox.perl.com> + From: Tom Christiansen Msg-ID: <804.854121463@jinete> Date: Fri, 24 Jan 1997 07:57:43 -0800 Files: pod/perlnews.pod pod/perltoc.pod Title: "Updates to perldelta" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199701211610.LAA06227@monk.mps.ohio-state.edu> Date: Mon, 20 Jan 1997 06:48:49 -0500 (EST) Files: pod/perlnews.pod pod/perltoc.pod Title: "perlnews.pod diff for the Fcntl" - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Msg-ID: <199701211600.SAA30117@alpha.hut.fi> Date: Tue, 21 Jan 1997 18:00:56 +0200 (EET) Files: pod/perlnews.pod Title: "Rename perlnews -> perldelta per Tom's request" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: MANIFEST pod/Makefile pod/buildtoc pod/perl.pod pod/perldelta.pod pod/perltoc.pod pod/roffitall Title: "Remove bad advice from perllocale.pod" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pod/perllocale.pod ----------------- -Version 5.003_22 ----------------- +------------------ + Version 5.003_22 +------------------ This release is primarily made up of bug fixes, the foremost among which repairs a showstopper memory corruption bug in formats. @@ -2288,43 +3021,43 @@ which repairs a showstopper memory corruption bug in formats. CORE LANGUAGE CHANGES Title: "Fix parsing of C< ${ xyz } >" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: toke.c Title: "Don't parse method calls in strings" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: toke.c Title: "Fix overly picky carping about leading '{' in regex" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: regcomp.c OTHER CORE CHANGES Title: "Fix memory corruption from formats" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c perl.c perly.c perly.c.diff perly.y proto.h sv.c toke.c BUILD PROCESS Title: "Fix '_mopop' typo" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Makefile.SH LIBRARY AND EXTENSIONS Title: "Gut IO::Handle::DESTROY" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: ext/IO/lib/IO/Handle.pm Title: "RiscOS is case-insensitive" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: lib/File/Basename.pm TESTS Title: "Fix thinko in db-recno.t" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: t/lib/db-recno.t UTILITIES @@ -2342,7 +3075,7 @@ which repairs a showstopper memory corruption bug in formats. Files: INSTALL pod/roffitall Title: "srand() doc update" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <24195.853379065@eeyore.ibcinc.com> Date: Wed, 15 Jan 1997 20:44:25 -0500 Files: pod/perlfunc.pod @@ -2354,9 +3087,9 @@ which repairs a showstopper memory corruption bug in formats. Files: configpm ----------------- -Version 5.003_21 ----------------- +------------------ + Version 5.003_21 +------------------ This release includes several important bug fixes, and a couple of minor but valuable language tweaks. Please read on for a list of the @@ -2365,27 +3098,27 @@ significant changes: CORE LANGUAGE CHANGES Title: "Fix overloading via inherited autoloaded functions" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199701131022.FAA22830@monk.mps.ohio-state.edu> Date: Mon, 13 Jan 1997 05:22:47 -0500 (EST) Files: gv.c lib/overload.pm pod/perldiag.pod t/pragma/overload.t Title: "Method call fixes: Don't cache in alias, don't skip undef" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: global.sym gv.c gv.h hv.c op.c pod/perlguts.pod pod/perltoc.pod pp.c pp_ctl.c pp_hot.c proto.h scope.c sv.c t/op/method.t Title: "Formats can be closures" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: cv.h op.c perly.c perly.c.diff perly.y pp_sys.c sv.h Title: "Quote 'foo' in C<$x{-foo}>" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: toke.c Title: "Forbid C< x->{y} > and C< x->[0] > under C<strict refs>" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c pod/perldiag.pod t/pragma/strict-refs Title: "Allow <=> to return undef when operands are not ordered" @@ -2393,19 +3126,19 @@ significant changes: Files: MANIFEST pp.c t/op/cmp.t Title: "Fail regex that starts with '{'" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: regcomp.c CORE PORTABILITY Title: "Re: Perl 5.003_20: OS/2 patches" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199701101102.GAA19051@monk.mps.ohio-state.edu> Date: Fri, 10 Jan 1997 06:02:16 -0500 (EST) Files: hints/os2.sh os2/Changes os2/os2.c os2/os2ish.h pp_sys.c Title: "VMS patches for _20" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Msg-ID: <01IE7MGK7ULQ003K5M@hmivax.humgen.upenn.edu> Date: Tue, 14 Jan 1997 17:34:43 -0500 (EST) Files: configpm dosish.h os2/os2ish.h plan9/plan9ish.h proto.h @@ -2427,21 +3160,21 @@ significant changes: Files: Configure hints/machten.sh Title: "Rename aux.sh to aux_3.sh for MS-LOSS" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: MANIFEST hints/aux_3.sh OTHER CORE CHANGES Title: "Fix C< eval { my $x; eval '$x' } >" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c t/op/misc.t Title: "Don't warn if eval '' uses outer func's lexicals" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c Title: "Avoid memory wastage in wait(); make pidstatus global" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: global.sym interp.sym perl.c perl.h pp_sys.c Title: "Forbid ++ and -- on readonly values" @@ -2451,39 +3184,39 @@ significant changes: Files: pp.c pp_hot.c Title: "Keep array from dying during foreach(@array)" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: cop.h pp_ctl.c Title: "Fix C< $a="simple"; split /($a)/o >" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp.c t/op/misc.t Title: "Fix infinite loop for undef function in @SIG{__WARN__,__DIE__}" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: util.c Title: "Fix for anon-lists with tied entries coredump" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199701100745.CAA13057@aatma.engin.umich.edu> Date: Fri, 10 Jan 1997 02:45:11 -0500 Files: pp.c Title: "Don't set SVf_PADBUSY on immortal SVs" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c Title: "Patch for Object subroutines" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199701080156.UAA15366@monk.mps.ohio-state.edu> Date: Tue, 7 Jan 1997 20:56:02 -0500 (EST) Files: cop.h Title: "Use an SVt_PVLV to hold stacked OP pointers when debugging" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp.c pp_hot.c Title: "Undo change that freed large pad vars" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: scope.c BUILD PROCESS @@ -2501,7 +3234,7 @@ significant changes: Files: Configure Title: "Make installperl quieter; only shared libraries need 0555" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: installperl TESTS @@ -2513,15 +3246,15 @@ significant changes: Files: t/TEST Title: "UNIVERSAL tests" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Files: MANIFEST t/op/universal.t Title: "Test deletion of array during foreach" - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Files: t/op/misc.t Title: "patch for db-recno.t" - From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + From: Paul Marquess Msg-ID: <9701121509.AA11147@claudius.bfsec.bt.co.uk> Date: Sun, 12 Jan 1997 15:09:33 +0000 (GMT) Files: t/lib/db-recno.t @@ -2529,7 +3262,7 @@ significant changes: LIBRARY AND EXTENSIONS Title: "Localize info about filesystems being case-forgiving" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: lib/File/Basename.pm pod/checkpods.PL pod/pod2html.PL pod/pod2latex.PL pod/pod2man.PL pod/pod2text.PL utils/c2ph.PL utils/h2ph.PL utils/h2xs.PL utils/perlbug.PL @@ -2545,39 +3278,39 @@ significant changes: Files: lib/Getopt/Long.pm Title: "Refresh DB_File to 1.10" - From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + From: Paul Marquess Msg-ID: <9701141247.AA21242@claudius.bfsec.bt.co.uk> Date: Tue, 14 Jan 97 12:47:40 GMT Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs Title: "Re: FileCache::cacheout clobbers $_" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <pz3ewb3189.fsf@eeyore.ibcinc.com> Date: 08 Jan 1997 23:45:58 -0500 Files: lib/FileCache.pm lib/cacheout.pl Title: "PATCH: AutoSplit" - From: Graham Barr <bodg@tiuk.ti.com> + From: Graham Barr Msg-ID: <9603111010.AA29935@tiuk.ti.com> Date: 11 Mar 1996 06:01:58 -0500 Files: lib/AutoSplit.pm Title: "Re: Uninitialized value in Carp.pm ? " - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199701141815.NAA07960@aatma.engin.umich.edu> Date: Tue, 14 Jan 1997 13:15:25 -0500 Files: lib/Carp.pm Title: "Avoid "uninitialized" warnings from POSIX::constant()" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: ext/POSIX/POSIX.pm Title: "Eliminate warning from C<use overload>" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: lib/overload.pm Title: "low priority patches" - From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + From: Paul Marquess Msg-ID: <9701081655.AA27349@claudius.bfsec.bt.co.uk> Date: Wed, 8 Jan 97 16:55:02 GMT Files: lib/Cwd.pm t/comp/redef.t t/lib/db-btree.t @@ -2585,13 +3318,13 @@ significant changes: UTILITIES Title: "Re: xsubpp and Tk ==> segfault" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199701080825.DAA15813@monk.mps.ohio-state.edu> Date: Wed, 8 Jan 1997 03:25:47 -0500 (EST) Files: lib/ExtUtils/xsubpp Title: "Re: MakeMaker and 'make uninstall'" - From: Andreas Koenig <k@anna.in-berlin.de> + From: Andreas Koenig Msg-ID: <199701101243.NAA26400@anna.in-berlin.de> Date: Fri, 10 Jan 1997 13:43:39 +0100 Files: lib/ExtUtils/MM_Unix.pm @@ -2603,13 +3336,13 @@ significant changes: Files: utils/perldoc.PL Title: "Yet another perldoc option" - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Msg-ID: <199610022200.AAA15334@furubotn.sn.no> Date: Thu, 3 Oct 1996 00:00:35 +0200 Files: utils/perldoc.PL Title: "Re: perldoc, temp files, async pagers" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <pzwwtoom8p.fsf@eeyore.ibcinc.com> Date: 07 Jan 1997 22:54:14 -0500 Files: utils/perldoc.PL @@ -2623,38 +3356,38 @@ significant changes: Files: MANIFEST pod/roffitall pod/rofftoc Title: "Re: documentation correction (i.e. patch) for perlsyn.pod" - From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk> + From: "M.J.T. Guy" Msg-ID: <E0vilLh-0000M6-00@ursa.cus.cam.ac.uk> Date: Fri, 10 Jan 1997 18:06:37 +0000 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 @@ -2668,11 +3401,11 @@ updates, and expanded tests. This is good stuff. "I love you, man!" CORE LANGUAGE CHANGES Title: "Rescind named closures" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Makefile.SH op.c perly.c perly.c.diff perly.y pp_hot.c Title: "Fix: empty @_ when calling empty-proto subs without parens" - From: Graham Barr <bodg@tiuk.ti.com> + From: Graham Barr Msg-ID: <32CE30F0.7E8425A5@tiuk.ti.com> Date: Sat, 04 Jan 1997 10:29:04 +0000 Files: perly.c perly.y @@ -2680,37 +3413,37 @@ updates, and expanded tests. This is good stuff. "I love you, man!" CORE PORTABILITY Title: "Fix $^X on systems that set it to Perl's basename" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: hints/hpux.sh toke.c Title: "Configure/perl5/Compartmented Mode Workstation (fwd)" - From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> + From: Andy Dougherty Msg-ID: <Pine.SOL.3.95.970106131505.1662C-100000@fractal.lafayette.ed Date: Mon, 06 Jan 1997 13:15:38 -0500 (EST) Files: Configure hints/dec_osf.sh Title: "Remove obsolete file "dl_os2.xs"." - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Files: MANIFEST OTHER CORE CHANGES Title: "Fix C< sub foo (&@); sub bar (&); foo {}, bar {}, bar {} >" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: perly.c perly.c.diff perly.y Title: "plug for safe/opcode leaks" - From: Doug MacEachern <dougm@osf.org> + From: Doug MacEachern Msg-ID: <199701072220.RAA02117@postman.osf.org> Date: Tue, 07 Jan 1997 17:20:46 -0500 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 @@ -2718,11 +3451,11 @@ updates, and expanded tests. This is good stuff. "I love you, man!" BUILD PROCESS Title: "Make Configure default to the first domain in /etc/resolv.conf" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Configure Title: "Start all helper scripts with $startsh" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Configure Title: "Support libperl.so under FreeBSD" @@ -2734,13 +3467,13 @@ updates, and expanded tests. This is good stuff. "I love you, man!" TESTS Title: "New test: comp/proto.t" - From: Graham Barr <bodg@tiuk.ti.com> + From: Graham Barr Msg-ID: <32D0C21F.3FB28D51@tiuk.ti.com> Date: Mon, 06 Jan 1997 09:13:03 +0000 Files: MANIFEST t/comp/proto.t Title: "More magic variable tests" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <7043.852565192@eeyore.ibcinc.com> Date: Mon, 06 Jan 1997 10:39:52 -0500 Files: t/harness t/op/magic.t @@ -2754,13 +3487,13 @@ updates, and expanded tests. This is good stuff. "I love you, man!" Files: lib/File/Basename.pm t/lib/basename.t Title: "sigaction() problems" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <12808.852583324@eeyore.ibcinc.com> Date: Mon, 06 Jan 1997 15:42:04 -0500 Files: ext/POSIX/POSIX.pm ext/POSIX/POSIX.pod Title: "Fix importation of FileHandle methods; fix POSIX docs" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: ext/POSIX/POSIX.pm ext/POSIX/POSIX.pod lib/FileHandle.pm Title: "Patch: make hints files warn about db-recno failures" @@ -2780,31 +3513,31 @@ updates, and expanded tests. This is good stuff. "I love you, man!" DOCUMENTATION Title: "tiny doc patches" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <23338.852394333@eeyore.ibcinc.com> Date: Sat, 04 Jan 1997 11:12:13 -0500 Files: pod/perlapio.pod pod/perlnews.pod pod/perltoc.pod Title: "doc patch for defined on perlfunc.pod" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <pz91686ek1.fsf@eeyore.ibcinc.com> Date: 04 Jan 1997 21:28:30 -0500 Files: pod/perlfunc.pod Title: "doc patch: perldsc" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <pzafqo6eo9.fsf@eeyore.ibcinc.com> Date: 04 Jan 1997 21:25:58 -0500 Files: pod/perldsc.pod pod/perltoc.pod Title: "Re: constant function inlining" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <pzk9pp1b95.fsf@eeyore.ibcinc.com> Date: 07 Jan 1997 15:27:50 -0500 Files: pod/perldiag.pod pod/perlsub.pod Title: "scalar caller doc fix" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <18245.852608060@eeyore.ibcinc.com> Date: Mon, 06 Jan 1997 22:34:20 -0500 Files: pod/perlfunc.pod @@ -2816,13 +3549,13 @@ updates, and expanded tests. This is good stuff. "I love you, man!" Files: pod/perlpod.pod Title: "Misc perlfunc updates" - From: Tom Christiansen <tchrist@mox.perl.com> + From: Tom Christiansen Files: pod/perlfunc.pod pod/perltoc.pod ----------------- -Version 5.003_19 ----------------- +------------------ + Version 5.003_19 +------------------ Lots of internal cleanup in this patch, especially plugged memory leaks when embedded Perl interpreters shut down and restart. The @@ -2836,22 +3569,22 @@ Here's a list of the more significant changes... CORE LANGUAGE CHANGES Title: "Make method cache invisible to user code" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: dump.c gv.c gv.h hv.c op.c perl.c pp_hot.c pp_sys.c sv.c toke.c Title: "Never parse "{m,s,y,tr,q{,q,w,x}}:{,:}" as package or label" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: toke.c CORE PORTABILITY Title: "Fix $^X under HP-UX" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: hints/hpux.sh toke.c Title: "New hints/hpux.sh" - From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com> + From: Jeff Okamoto Msg-ID: <199612312309.AA283393772@hpcc123.corp.hp.com> Date: Tue, 31 Dec 1996 15:09:32 -0800 Files: hints/hpux.sh @@ -2859,45 +3592,45 @@ Here's a list of the more significant changes... OTHER CORE CHANGES Title: "Fix segv when calling named closures" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_hot.c Title: "Finish rationalizing "undef value" warnings" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: doop.c pp.c sv.c t/op/assignwarn.t Title: "Arrange for all "_<file" entries to be in %main::" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: gv.c lib/perl5db.pl Title: "Introduce CVf_NODEBUG flag" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199701012042.PAA25994@aatma.engin.umich.edu> Date: Wed, 01 Jan 1997 15:42:05 -0500 Files: cv.h pp_hot.c Title: "Reword 'may be "0"' warning per Larry; fix its line number" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c pod/perldiag.pod Title: "5.003_18: perl_{con,des}truct fixes" - From: Doug MacEachern <dougm@osf.org> + From: Doug MacEachern Msg-ID: <199701032042.PAA06766@postman.osf.org> Date: Fri, 03 Jan 1997 15:42:04 -0500 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 @@ -2911,7 +3644,7 @@ Here's a list of the more significant changes... LIBRARY AND EXTENSIONS Title: "Make libs clean under '-w'" - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Files: lib/AutoSplit.pm lib/Devel/SelfStubber.pm lib/Env.pm lib/Math/Complex.pm lib/Pod/Functions.pm lib/Search/Dict.pm lib/SelfLoader.pm lib/Term/Complete.pm lib/chat2.pl @@ -2921,13 +3654,13 @@ Here's a list of the more significant changes... DOCUMENTATION Title: "Perlguts, version 28" - From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com> + From: Jeff Okamoto Msg-ID: <199701032110.AA102535846@hpcc123.corp.hp.com> Date: Fri, 3 Jan 1997 13:10:46 -0800 Files: pod/perlguts.pod Title: "Re: perldelta, take 3" - From: Tim Bunce <Tim.Bunce@ig.co.uk> + From: Tim Bunce Msg-ID: <9701031748.AA15335@toad.ig.co.uk> Date: Fri, 3 Jan 1997 17:48:46 +0000 Files: pod/perlnews.pod @@ -2938,93 +3671,93 @@ Here's a list of the more significant changes... pod/perlguts.pod Title: "expanded flock() docs" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <4481.852337871@eeyore.ibcinc.com> Date: Fri, 03 Jan 1997 19:31:11 -0500 Files: pod/perlfunc.pod Title: "Use Text::Wrap in buildtoc; run buildtoc" - From: Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de> + From: Ulrich Pfeifer Files: pod/buildtoc pod/perltoc.pod Title: "Remove obsolete perlovl.pod" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: MANIFEST plan9/mkfile pod/perlovl.pod vms/Makefile vms/descrip.mms ----------------- -Version 5.003_18 ----------------- +------------------ + Version 5.003_18 +------------------ Yet further down the road to 5.004.... CORE LANGUAGE CHANGES Title: "Inherited overloading" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199612291312.IAA02134@monk.mps.ohio-state.edu> Date: Sun, 29 Dec 1996 08:12:54 -0500 (EST) Files: gv.c lib/overload.pm perl.h sv.c sv.h t/op/overload.t Title: "Hide lexicals from C<use>d or C<require>d module (!)" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_ctl.c Title: "Closures at file scope must be anonymous" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c Title: "Warn on '{if,while} ($x = X)' where X is glob, readdir, or <FH>" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c pod/perldiag.pod Title: "Warn on 'undef $x; $x OP 1' where OP is *=, /=, %=, or **=" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp.c CORE PORTABILITY Title: "Ultrix setlocale() workaround" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: hints/ultrix_4.sh util.c OTHER CORE CHANGES Title: "Get rid of 'Leaked scalars'" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: cop.h gv.c op.c Title: "Don't forget $c in C<(($a,$b,$c)=(1,2))=(3,4,5)>" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_hot.c Title: "Fix core dump on perl_construct()/perl_destruct() loop" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: perl.c Title: "Add missing syms to global.sym; update magic doc" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: global.sym pod/perlguts.pod TESTS Title: "Expanded locale.t and misc.t" - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Files: t/lib/locale.t t/lib/misc.t Title: "Expanded my.t" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: t/lib/my.t Title: "test harness for C<use x.xxxx>" - From: Graham Barr <bodg@tiuk.ti.com> + From: Graham Barr Msg-ID: <32C76882.3F3C7999@tiuk.ti.com> Date: Mon, 30 Dec 1996 07:00:18 +0000 Files: MANIFEST t/op/use.t Title: "More tests" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.95.961229170736.15213M-100000@solaris.teleport.co Date: Sun, 29 Dec 1996 17:46:21 -0800 (PST) Files: t/op/each.t t/op/oct.t t/op/quotemeta.t t/op/rand.t @@ -3032,13 +3765,13 @@ Yet further down the road to 5.004.... LIBRARY AND EXTENSIONS Title: "Improving Config.pm" - From: Tom Phoenix <rootbeer@teleport.com> + From: Tom Phoenix Msg-ID: <Pine.GSO.3.95.961230091244.13467L-100000@solaris.teleport.co Date: Mon, 30 Dec 1996 09:24:16 -0800 (PST) Files: configpm Title: "File::Copy under OS/2" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199612280347.WAA00293@monk.mps.ohio-state.edu> Date: Fri, 27 Dec 1996 22:47:24 -0500 (EST) Files: lib/File/Copy.pm t/lib/filecopy.t @@ -3057,15 +3790,15 @@ Yet further down the road to 5.004.... pod/perlre.pod pod/perlsec.pod Title: "Re: perldiag.pod entry for "Scalar value @%s{%s} ..."" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <2043.852051019@eeyore.ibcinc.com> Date: Tue, 31 Dec 1996 11:50:19 -0500 Files: pod/perldiag.pod ----------------- -Version 5.003_17 ----------------- +------------------ + Version 5.003_17 +------------------ The rate of patches is slowing down.... I see 5.004 at the end of the tunnel! (Hey, what's that whistle?) @@ -3073,7 +3806,7 @@ tunnel! (Hey, what's that whistle?) CORE LANGUAGE CHANGES Title: "Support named closures" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: cv.h op.c perl.c pp.c pp_ctl.c pp_hot.c CORE PORTABILITY @@ -3089,7 +3822,7 @@ tunnel! (Hey, what's that whistle?) Files: hints/freebsd.sh Title: "Minor OS/2 fixes" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199612252105.QAA11890@monk.mps.ohio-state.edu> Date: Wed, 25 Dec 1996 16:05:42 -0500 (EST) Files: os2/os2ish.h pod/perlxstut.pod @@ -3097,11 +3830,11 @@ tunnel! (Hey, what's that whistle?) OTHER CORE CHANGES Title: "Fix {,un}tainting of $1 etc. when C<use locale>" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: mg.c sv.c Title: "Limit effects of "=pod" to a single file" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: toke.c TESTS @@ -3111,19 +3844,19 @@ tunnel! (Hey, what's that whistle?) Files: MANIFEST t/lib/locale.t t/op/method.t Title: "Test C< ()=() >" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: t/op/misc.t LIBRARY AND EXTENSIONS Title: "Refresh MakeMaker to 5.39" - From: Andreas Koenig <k@anna.in-berlin.de> + From: Andreas Koenig Files: lib/ExtUtils/Install.pm lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Mksymlists.pm Title: "Newer debugger" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199612261954.OAA12999@monk.mps.ohio-state.edu> Date: Thu, 26 Dec 1996 14:54:34 -0500 (EST) Files: lib/perl5db.pl @@ -3131,27 +3864,27 @@ tunnel! (Hey, what's that whistle?) DOCUMENTATION Title: "Perlguts, version 27" - From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com> + From: Jeff Okamoto Msg-ID: <199612250144.AA059528263@hpcc123.corp.hp.com> Date: Tue, 24 Dec 1996 17:44:23 -0800 Files: pod/perlguts.pod Title: "perlpod.pod patch for _16" - From: Kenneth Albanowski <kjahds@kjahds.com> + From: Kenneth Albanowski Msg-ID: <Pine.LNX.3.93.961224225906.337B-100000@kjahds.com> Date: Tue, 24 Dec 1996 23:00:10 -0500 (EST) Files: pod/perlpod.pod Title: "tiny perllocale.pod diff for _16" - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Msg-ID: <199612261306.PAA21161@alpha.hut.fi> Date: Thu, 26 Dec 1996 15:06:04 +0200 (EET) Files: pod/perllocale.pod ----------------- -Version 5.003_16 ----------------- +------------------ + Version 5.003_16 +------------------ This patch is all bug fixes, library updates, and documentation updates. We'll get to 5.004 RSN, I promise. :-) @@ -3159,7 +3892,7 @@ updates. We'll get to 5.004 RSN, I promise. :-) CORE LANGUAGE CHANGES Title: "Fix closures that are not in subroutines" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c CORE PORTABILITY @@ -3173,25 +3906,25 @@ updates. We'll get to 5.004 RSN, I promise. :-) OTHER CORE CHANGES Title: "Fix 'foreach(@ARGV) { while (<>) { push @p,$_ } }'" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: cop.h pp_hot.c scope.c Title: "Eliminate warnings from C< undef $x; $x OP= "foo" >" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: doop.c pp.c pp.h pp_hot.c Title: "Try again to improve method caching" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199612240113.UAA09487@monk.mps.ohio-state.edu> Date: Mon, 23 Dec 1996 20:13:56 -0500 (EST) Files: gv.c sv.c Title: "Be more careful about 'o' magic memory management" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: mg.c sv.c Title: "Fix bad pointer refs when localized object loses magic" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: scope.c LIBRARY AND EXTENSIONS @@ -3216,7 +3949,7 @@ updates. We'll get to 5.004 RSN, I promise. :-) BUILD PROCESS AND UTILITIES Title: "Don't recurse into subdirs twice on 'make realclean'" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Makefile.SH Title: "Use root EXTERN.h when compiling x2p/malloc.c." @@ -3230,17 +3963,17 @@ updates. We'll get to 5.004 RSN, I promise. :-) DOCUMENTATION Title: "Edit INSTALL to describe new binary compat setup" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: INSTALL Title: "Update to perllocale.pod" - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Files: pod/perllocale.pod ----------------- -Version 5.003_15 ----------------- +------------------ + Version 5.003_15 +------------------ As soon as I posted 5.003_14, I found a fatal error in it. :-( @@ -3248,72 +3981,72 @@ This release is strictly a bug fix -- it removes some function caching changes that were supposed to be improvements, but weren't. ----------------- -Version 5.003_14 ----------------- +------------------ + Version 5.003_14 +------------------ We seem to have achieved "release candidate" status. CORE LANGUAGE CHANGES Title: "Eliminate support for {if,unless,while,until} BLOCK BLOCK" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: perly.c perly.c.diff perly.y toke.c Title: "Taint $x after $x =~ s/pat/xyz/ if pat or xyz is tainted by locale" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: cop.h mg.c pp_ctl.c pp_hot.c Title: "Complete support for modifying undefined array members in foreach" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: global.sym mg.c perl.h pp.c pp_hot.c proto.h sv.c OTHER CORE CHANGES Title: "patch for regex bug: (x|x){n}" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199612210259.VAA10170@aatma.engin.umich.edu> Date: Fri, 20 Dec 1996 21:59:22 -0500 Files: regexec.c Title: "Bug in debugger with import manipulations" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199612231037.FAA08617@monk.mps.ohio-state.edu> Date: Mon, 23 Dec 1996 05:37:48 -0500 (EST) Files: pp_hot.c Title: "Import and dynamic methods" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199612230645.BAA08378@monk.mps.ohio-state.edu> Date: Mon, 23 Dec 1996 01:45:37 -0500 (EST) Files: gv.c hv.c sv.c Title: "malloc.c patch" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199612220748.CAA07164@monk.mps.ohio-state.edu> Date: Sun, 22 Dec 1996 02:48:58 -0500 (EST) Files: malloc.c Title: "sv_gets patch" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199612220824.DAA07235@monk.mps.ohio-state.edu> Date: Sun, 22 Dec 1996 03:24:04 -0500 (EST) Files: pp_hot.c Title: "pos $str patch" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199612220831.DAA07247@monk.mps.ohio-state.edu> Date: Sun, 22 Dec 1996 03:31:21 -0500 (EST) Files: mg.c pp_hot.c t/op/pat.t Title: "Prevent warnings when STDCHAR is unsigned" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: perlio.c perlio.h PORTABILITY Title: "Fix bugs in bincompat3 usage" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: perl.h perl_exp.SH Title: "Support shared libperl on SunOS" @@ -3321,7 +4054,7 @@ We seem to have achieved "release candidate" status. Files: Makefile.SH Title: "Configure on OS/2" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199612202325.SAA05505@monk.mps.ohio-state.edu> Date: Fri, 20 Dec 1996 18:25:30 -0500 (EST) Files: Configure @@ -3333,11 +4066,11 @@ We seem to have achieved "release candidate" status. Files: hints/isc.sh op.c pp_sys.c universal.c Title: "Use "proto" instead of "_" in sdbm.h" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: ext/SDBM_File/sdbm/sdbm.h Title: "VMS patches to 5.003_13" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Msg-ID: <01IDBYYFYPIS002ASE@hmivax.humgen.upenn.edu> Date: Mon, 23 Dec 1996 01:26:47 -0500 (EST) Files: deb.c ext/POSIX/POSIX.xs gv.c lib/File/Copy.pm mg.c perl.c @@ -3350,11 +4083,11 @@ We seem to have achieved "release candidate" status. UTILITIES, LIBRARY, AND EXTENSIONS Title: "Remove libnet" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: MANIFEST pod/perlmod.pod Title: "Refresh CPAN module to 1.08" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: lib/CPAN.pm lib/CPAN/FirstTime.pm Title: "Refresh ExtUtils::Manifest to version 1.28" @@ -3362,15 +4095,15 @@ We seem to have achieved "release candidate" status. Files: lib/ExtUtils/Manifest.pm Title: "Update IO->VERSION() to 1.1201 for CPAN's sake" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: ext/IO/lib/IO/Handle.pm lib/IO/Handle.pm Title: "Remodel File::Copy." - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: lib/File/Copy.pm Title: "dumb bug in User::pwent.pm" - From: Tom Christiansen <tchrist@mox.perl.com> + From: Tom Christiansen Msg-ID: <199612201145.EAA27860@mox.perl.com> Date: Fri, 20 Dec 1996 04:45:37 -0700 Files: lib/User/pwent.pm @@ -3378,7 +4111,7 @@ We seem to have achieved "release candidate" status. DOCUMENTATION Title: "Better support for =for" - From: Kenneth Albanowski <kjahds@kjahds.com> + From: Kenneth Albanowski Msg-ID: <Pine.LNX.3.93.961220163747.298T-100000@kjahds.com> Date: Fri, 20 Dec 1996 16:43:35 -0500 (EST) Files: lib/Pod/Text.pm pod/pod2latex.PL pod/pod2man.PL @@ -3390,26 +4123,26 @@ We seem to have achieved "release candidate" status. Files: pod/perllocale.pod Title: "Perlguts, version 26" - From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com> + From: Jeff Okamoto Msg-ID: <199612201943.AA048111018@hpcc123.corp.hp.com> Date: Fri, 20 Dec 1996 11:43:38 -0800 Files: pod/perlguts.pod Title: "Update pod/Makefile; s/perli18n/perllocale/" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: ext/POSIX/POSIX.pod lib/I18N/Collate.pm pod/Makefile pod/perl.pod pod/perlmod.pod pod/perlnews.pod pod/roffitall Title: "obstruct pod2man doc tweaks" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <3923.851106237@eeyore.ibcinc.com> Date: Fri, 20 Dec 1996 13:23:57 -0500 Files: lib/Class/Template.pm lib/Time/tm.pm ----------------- -Version 5.003_13 ----------------- +------------------ + Version 5.003_13 +------------------ The watchword here is "synchronization." There were a couple of show-stopper bugs in 5.003_12, so I'm issuing this patch to bring @@ -3418,33 +4151,33 @@ everyone up to a common working base. CORE LANGUAGE CHANGES Title: "Disallow labels named q, qq, qw, qx, s, y, and tr" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: toke.c Title: "Make evals' lexicals visible to nested evals" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_ctl.c OTHER CORE CHANGES Title: "Fix core dump bug with anoncode" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c Title: "Allow DESTROY to make refs to dying objects" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: sv.c PORTABILITY Title: "Add missing backslash in Configure" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Configure UTILITIES, LIBRARY, AND EXTENSIONS Title: "Include libnet-1.01 instead of old Net::FTP" - From: Graham Barr <Graham.Barr@tiuk.ti.com> + From: Graham Barr Files: MANIFEST lib/Net/Cmd.pm lib/Net/Domain.pm lib/Net/DummyInetd.pm lib/Net/FTP.pm lib/Net/NNTP.pm lib/Net/Netrc.pm lib/Net/POP3.pm lib/Net/SMTP.pm @@ -3456,7 +4189,7 @@ everyone up to a common working base. Files: lib/Net/FTP.pm Title: "Re: Open3.pm tries to close unopened file handle" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <pzloavmd9h.fsf@eeyore.ibcinc.com> Date: 18 Dec 1996 22:19:54 -0500 Files: MANIFEST lib/IPC/Open2.pm lib/IPC/Open3.pm lib/open2.pl @@ -3464,20 +4197,20 @@ everyone up to a common working base. t/lib/open3.t Title: "Long-standing problem in Socket module" - From: Spider Boardman <spider@orb.nashua.nh.us> + From: Spider Boardman Msg-ID: <199612190418.XAA07291@Orb.Nashua.NH.US> Date: Wed, 18 Dec 1996 23:18:14 -0500 Files: Configure Porting/Glossary config_H config_h.SH ext/Socket/Socket.pm ext/Socket/Socket.xs Title: "flock() constants" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <26669.850977437@eeyore.ibcinc.com> Date: Thu, 19 Dec 1996 01:37:17 -0500 Files: ext/Fcntl/Fcntl.pm ext/Fcntl/Fcntl.xs pod/perlfunc.pod Title: "Re: find2perl . -xdev BROKEN still" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <pzvi9yig3h.fsf@eeyore.ibcinc.com> Date: 19 Dec 1996 12:44:34 -0500 Files: lib/File/Find.pm lib/find.pl lib/finddepth.pl @@ -3485,21 +4218,21 @@ everyone up to a common working base. DOCUMENTATION Title: "small doc tweaks for _12" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <1826.851011557@eeyore.ibcinc.com> Date: Thu, 19 Dec 1996 11:05:57 -0500 Files: lib/UNIVERSAL.pm pod/perldiag.pod pod/perltie.pod Title: "Re: missing E<> POD directive in perlpod.pod" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <pzwwueimak.fsf@eeyore.ibcinc.com> Date: 19 Dec 1996 10:30:43 -0500 Files: pod/perlpod.pod pod/pod2html.PL ----------------- -Version 5.003_12 ----------------- +------------------ + Version 5.003_12 +------------------ This patch is huge. A multitude of bug fixes, new modules (especially CPAN and Net::FTP), a couple of new Configure variables, updated @@ -3509,109 +4242,109 @@ the more significant changes in 5.003_12: CORE LANGUAGE CHANGES Title: "Support C<delete @hash{@keys}>" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c op.h opcode.pl pod/perldiag.pod pod/perlfunc.pod pp.c t/op/delete.t Title: "Autovivify scalars" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: dump.c op.c op.h pp.c pp_hot.c Title: "Allow any word, including keyword, as label" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: toke.c OTHER CORE CHANGES Title: "Allow assignment to empty array values during foreach()" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: cop.h global.sym mg.c op.c perl.h pp_hot.c proto.h sv.c Title: "Fix nested closures" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c opcode.pl pp.c pp_ctl.c pp_hot.c Title: "Fix core dump on auto-vivification" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_hot.c Title: "Fix core dump on C<open $undef_var, "X">" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_sys.c Title: "Fix -T/-B on globs and globrefs" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_sys.c Title: "Fix memory management of $`, $&, and $'" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_hot.c regexec.c Title: "Fix paren matching during backtracking" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: regexec.c Title: "Fix memory leak and std{in,out,err} death in perl_{con,de}str - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: miniperlmain.c perl.c perl.h sv.c Title: "Discard garbage bytes at end of prototype()" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp.c Title: "Fix local($pack::{foo})" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: global.sym pp.c pp_hot.c proto.h scope.c Title: "Fix for AmigaOS - inplace operation" - From: "Norbert Pueschel" <pueschel@imsdd.meb.uni-bonn.de> + From: Norbert Pueschel Msg-ID: <77724601@Armageddon.meb.uni-bonn.de> Date: Sun, 08 Dec 1996 15:33:00 +0100 Files: doio.c Title: "Disable warn, die, and parse hooks _before_ global destruction - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: perl.c Title: "Re: Bug in formline " - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199612081958.OAA26025@aatma.engin.umich.edu> Date: Sun, 08 Dec 1996 14:58:32 -0500 Files: pp_ctl.c Title: "Fix C<@a = ($a,$b,$c,$d) = (1,2)>" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_hot.c Title: "Fix %ENV assignment when environment starts out empty" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: hv.c Title: "Properly support and document newRV{,_inc,_noinc}" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: global.sym pod/perlguts.pod sv.c sv.h Title: "Support SvREADONLY on arrays" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: av.c Title: "Allow lvalue pos inside recursive function" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c pp.c pp_ctl.c pp_hot.c PORTABILITY Title: "Eliminate PerlIO warnings when setting cnt to -1" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: perlio.c Title: "Make $privlib contents compatible with 5.003" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: INSTALL ext/Opcode/Safe.pm installperl lib/FileHandle.pm lib/Test/Harness.pm Title: "Support $bincompat3 config variable; update metaconfig units" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Configure MANIFEST compat3.sym config_h.SH embed.pl global.sym old_embed.pl old_global.sym old_perl_exp.SH perl_exp.SH @@ -3622,11 +4355,11 @@ the more significant changes in 5.003_12: Files: Configure config_H config_h.SH pp.c Title: "Make $startperl a relative path if people want portable scrip - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Configure Title: "Homogenize use of "eval exec" hack" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Porting/Glossary eg/README eg/nih eg/sysvipc/ipcmsg eg/sysvipc/ipcsem eg/sysvipc/ipcshm lib/diagnostics.pm makeaperl.SH pod/checkpods.PL pod/perlrun.pod @@ -3642,7 +4375,7 @@ the more significant changes in 5.003_12: Files: Configure MANIFEST hints/lynxos.sh t/op/stat.t Title: "In Linux hints, set suidsafe=no and dosuid=yes" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: hints/linux.sh Title: "5.003_11 on UnixWare 2.1.1 - Only one small UnixWare buglet" @@ -3652,17 +4385,17 @@ the more significant changes in 5.003_12: Files: hints/svr4.sh Title: "Re: db-recno.t failures with _11 on Freebsd 2.1-stable" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <pzohg0r5tr.fsf@eeyore.ibcinc.com> Date: 11 Dec 1996 18:58:56 -0500 Files: INSTALL hints/freebsd.sh Title: "OS/2 updates from Ilya" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Files: README.os2 os2/Changes os2/Makefile.SHs os2/os2.c os2/os2ish.h Title: "VMS patches to 5.003_11" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Msg-ID: <01ICTR32LCZG001A1D@hmivax.humgen.upenn.edu> Date: Mon, 09 Dec 1996 23:16:10 -0500 (EST) Files: MANIFEST regexec.c t/lib/filehand.t util.c vms/* @@ -3670,7 +4403,7 @@ the more significant changes in 5.003_12: TESTING Title: "recurse recurse recurse ..." - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Msg-ID: <199612092144.XAA29025@alpha.hut.fi> Date: Mon, 9 Dec 1996 23:44:27 +0200 (EET) Files: MANIFEST t/op/recurse.t @@ -3678,7 +4411,7 @@ the more significant changes in 5.003_12: UTILITIES, LIBRARY, AND EXTENSIONS Title: "Add CPAN and Net::FTP" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: MANIFEST lib/CPAN.pm lib/CPAN/FirstTime.pm lib/CPAN/Nox.pm lib/Net/FTP.pm lib/Net/Netrc.pm lib/Net/Socket.pm pod/perlmod.pod @@ -3690,47 +4423,47 @@ the more significant changes in 5.003_12: Files: lib/Text/Tabs.pm lib/Text/Wrap.pm Title: "Add File::Compare" - From: Nick Ing-Simmons <nik@tiuk.ti.com> + From: Nick Ing-Simmons Msg-ID: <199612161844.SAA02152@pluto> Date: Mon, 16 Dec 1996 18:44:59 GMT Files: MANIFEST lib/File/Compare.pm pod/perlmod.pod Title: "Add Tie::RefHash" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199612152358.SAA28665@aatma.engin.umich.edu> Date: Sun, 15 Dec 1996 18:58:08 -0500 Files: MANIFEST lib/Tie/RefHash.pm pod/perlmod.pod Title: "Put "splain" in utils." - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Makefile.SH installperl utils/Makefile utils/splain.PL Title: "Some h2ph fixes" - From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com> + From: Jeff Okamoto Msg-ID: <199612131934.AA289845652@hpcc123.corp.hp.com> Date: Fri, 13 Dec 1996 11:34:12 -0800 Files: utils/h2ph.PL Title: "xsubpp patch to add #line" - From: nick@ni-s.u-net.com (Nick Ing-Simmons) + From: Nick Ing-Simmons Msg-ID: <199612162153.VAA03590@ni-s.u-net.com> Date: Mon, 16 Dec 1996 21:53:56 GMT Files: lib/ExtUtils/xsubpp Title: "Re: Proposed addition to File::Copy: move" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Msg-ID: <01ICZBN0LRC8001A1D@hmivax.humgen.upenn.edu> Date: Sat, 14 Dec 1996 00:27:29 -0500 (EST) Files: lib/File/Copy.pm t/lib/filecopy.t Title: "DB_File 1.09 patch" - From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + From: Paul Marquess Msg-ID: <9612181037.AA10123@claudius.bfsec.bt.co.uk> Date: Wed, 18 Dec 96 10:37:58 GMT Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs Title: "Debugger update" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199612111038.FAA24363@monk.mps.ohio-state.edu> Date: Wed, 11 Dec 1996 05:38:28 -0500 (EST) Files: lib/perl5db.pl @@ -3743,13 +4476,13 @@ the more significant changes in 5.003_12: pod/perlnews.pod Title: "perltoot.pod" - From: Tom Christiansen <tchrist@mox.perl.com> + From: Tom Christiansen Msg-ID: <199612091444.HAA09947@toy.perl.com> Date: Mon, 09 Dec 1996 07:44:10 -0700 Files: MANIFEST pod/perltoot.pod Title: "Perlguts, version 25" - From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com> + From: Jeff Okamoto Msg-ID: <199612061940.AA055461228@hpcc123.corp.hp.com> Date: Fri, 6 Dec 96 11:40:27 PST Files: pod/perlguts.pod @@ -3767,14 +4500,14 @@ the more significant changes in 5.003_12: Files: pod/*.pod Title: "Misc doc updates" - From: Tom Christiansen <tchrist@mox.perl.com> + From: Tom Christiansen Msg-ID: <199612150156.SAA12506@mox.perl.com> Date: Sat, 14 Dec 1996 18:56:33 -0700 Files: pod/* ----------------- -Version 5.003_11 ----------------- +------------------ + Version 5.003_11 +------------------ This patch is (still) closing in on 5.004. Nothing dramatic, lots of value. @@ -3782,91 +4515,91 @@ value. CORE LANGUAGE CHANGES Title: "Fix precedence problems with subs as uniops or listops" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: perly.c perly.c.diff perly.h perly.y Title: "Don't reset $. on open()" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_sys.c Title: "Support *glob{IO} (eventually deprecate *glob{FILEHANDLE})" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pod/perlref.pod pp_hot.c sv.c Title: "Don't let expression context force return context" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c Title: "Properly convert "1E2" et al to IV/UV" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: doio.c sv.c Title: "Fix modulo operator in UV realm" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp.c Title: "Fix stat(_) after stat(HANDLE)" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_sys.c Title: "Fix: s/// and "$x =~ $y" under 'use locale'" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c toke.c OTHER CORE CHANGES Title: "Eliminate spurious warning when splicing undefs" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp.c sv.h Title: "Eliminate spurious warning from "x=" operator" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c Title: "Fix line numbers near control structures" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c perly.c perly.c.diff perly.y proto.h Title: "Don't let scalar unpack() underflow stack" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp.c Title: "Fix core dump from precedence bug in "@foo" warning" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: toke.c Title: "Move die() to utils.c; add varargs hack to croak()" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_ctl.c util.c Title: "Avoid memcmp() for magnitude test if it thinks char is signed" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Configure config_H config_h.SH doop.c ext/SDBM_File/sdbm/pair.c ext/SDBM_File/sdbm/sdbm.h handy.h hv.c perl.h pp_hot.c proto.h regexec.c sv.c toke.c util.c Title: "Less malloc in magic" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: mg.c Title: "Re: 5.003_09: PADTMP fix" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199611281150.GAA06884@monk.mps.ohio-state.edu> Date: Thu, 28 Nov 1996 06:50:58 -0500 (EST) Files: pod/perlguts.pod Title: "Fully paramaterize locales; disable all if NO_LOCALE" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: ext/POSIX/POSIX.xs op.c perl.h pp.c pp_sys.c sv.c util.c PORTABILITY AND TESTING Title: "Bitwise op fix for Alpha" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp.c Title: "hints/dgux.sh update" - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Msg-ID: <24178.849309616@eeyore.ibcinc.com> Date: Fri, 29 Nov 1996 18:20:16 -0500 Files: hints/dgux.sh @@ -3878,7 +4611,7 @@ value. Files: hints/hpux.sh Title: "VMS patches for 5.003_10" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Msg-ID: <01ICMALO8NMS001A1D@hmivax.humgen.upenn.edu> Date: Wed, 04 Dec 1996 16:40:12 -0500 (EST) Files: EXTERN.h INTERN.h old_perl_exp.SH perl.c perl.h perl_exp.SH @@ -3887,7 +4620,7 @@ value. vms/gen_shrfls.pl vms/genconfig.pl vms/vmsish.h Title: "_10+ under OS/2" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199612011107.GAA10805@monk.mps.ohio-state.edu> Date: Sun, 1 Dec 1996 06:07:19 -0500 (EST) Files: malloc.c os2/diff.configure @@ -3895,7 +4628,7 @@ value. LIBRARY AND EXTENSIONS Title: "{in,ob}structive pods" - From: Tom Christiansen <tchrist@mox.perl.com> + From: Tom Christiansen Msg-ID: <199611301652.JAA24201@toy.perl.com> Date: Sat, 30 Nov 1996 09:52:57 -0700 Files: MANIFEST lib/Class/Template.pm lib/File/stat.pm @@ -3904,44 +4637,44 @@ value. lib/Time/tm.pm lib/User/grent.pm lib/User/pwent.pm Title: "FileHandle that 'ISA' IO::File" - From: Nick Ing-Simmons <nik@tiuk.ti.com> + From: Nick Ing-Simmons Msg-ID: <199612021718.RAA04416@pluto> Date: Mon, 2 Dec 1996 17:18:02 GMT Files: MANIFEST lib/FileHandle.pm Title: "Make IO::File::import use its parameters" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: ext/IO/lib/IO/File.pm Title: "10+ debugger patch" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199612011137.GAA10864@monk.mps.ohio-state.edu> Date: Sun, 1 Dec 1996 06:37:31 -0500 (EST) Files: lib/perl5db.pl perl.c pod/perldebug.pod Title: "Don't call CORE::close in file handle DESTROY method" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: ext/IO/lib/IO/Handle.pm Title: "Re: Namespace cleanup: Does SDBM need binary compatibility?" - From: Hallvard B Furuseth <h.b.furuseth@usit.uio.no> + From: Hallvard B Furuseth Msg-ID: <199612031445.PAA19056@bombur2.uio.no> Date: Tue, 3 Dec 1996 15:45:27 +0100 (MET) Files: ext/SDBM_File/sdbm/pair.h ext/SDBM_File/sdbm/sdbm.3 Title: "DB_File 1.07" - From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + From: Paul Marquess Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs t/lib/db-btree.t t/lib/db-recno.t Title: "DB_File 1.08" - From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + From: Paul Marquess Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs ----------------- -Version 5.003_10 ----------------- +------------------ + Version 5.003_10 +------------------ This patch is closing in on 5.004. It contains lots of small and valuable changes, but nothing dramatic. @@ -3949,7 +4682,7 @@ valuable changes, but nothing dramatic. CORE LANGUAGE CHANGES Title: "Allow &{sub {...}} without warning" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: toke.c Title: "Make parens optional on [gs]ethost and [gs]et{pw,gr} functions @@ -3957,25 +4690,25 @@ valuable changes, but nothing dramatic. Files: toke.c Title: "Fix syntax error with "$x [0]" and "$x {y}" and "@x {y}"" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: toke.c OTHER CORE CHANGES Title: "Fix regex matching of chars with high bit set" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: regexec.c Title: "Hash key memory corruption fix and naming cleanup" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: hv.c hv.h perl.h Title: "Undo broken perf. patch (PADTMP stealing)" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: sv.c Title: "Make SV unstudied in sv_gets()" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: sv.c Title: "Better support for UVs" @@ -3985,51 +4718,51 @@ valuable changes, but nothing dramatic. Title: "Minor locale cleanups" (Accept "POSIX" locale as standard like "C". Reset locale to 'C' when testing strtod() in t/lib/posix.t.) - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: t/lib/posix.t util.c Title: "Always taint result of sprintf() on float" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: doop.c Title: "Fix spurious warning from bitwise string ops" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: doop.c Title: "Eliminate warning on {,sys}read(,$newvar,)" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: doop.c pp_sys.c Title: "Don't call fcntl(fileno(rsfp)) if !rsfp" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: perl.c Title: "Save message when calling __DIE__ hook" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_ctl.c Title: "Namespace cleanup" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: global.sym old_global.sym perl.h Title: "Modify perl_exp.SH; create old_perl_exp.SH; document old_*" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Configure INSTALL MANIFEST old_perl_exp.SH perl_exp.SH PORTABILITY Title: "Reliable signal patch" - From: Kenneth Albanowski <kjahds@kjahds.com> + From: Kenneth Albanowski Msg-ID: <Pine.LNX.3.93.961126053209.294J-100000@kjahds.com> Date: Tue, 26 Nov 1996 05:40:50 -0500 (EST) Files: global.sym mg.c old_global.sym perl.h pp_sys.c proto.h util.c Title: "Emulate missing flock() with either fcntl() or lockf()" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp_sys.c Title: "3_09: minor patches for OS/2" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199611270830.DAA04985@monk.mps.ohio-state.edu> Date: Wed, 27 Nov 1996 03:30:05 -0500 (EST) Files: doio.c global.sym malloc.c old_global.sym os2/Makefile.SHs @@ -4045,7 +4778,7 @@ valuable changes, but nothing dramatic. t/TEST toke.c util.c x2p/proto.h Title: "Re: updated patch on the sysread, syswrite for VMS" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Msg-ID: <01ICB648K2XG001A1D@hmivax.humgen.upenn.edu> Date: Tue, 26 Nov 1996 17:28:23 -0500 (EST) Files: t/op/sysio.t @@ -4053,37 +4786,37 @@ valuable changes, but nothing dramatic. LIBRARY AND EXTENSIONS Title: "Minor patch to debugger" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199611290533.AAA08053@monk.mps.ohio-state.edu> Date: Fri, 29 Nov 1996 00:33:49 -0500 (EST) Files: lib/perl5db.pl Title: "AutoLoader::AUTOLOAD optimization" - From: nick@ni-s.u-net.com (Nick Ing-Simmons) + From: Nick Ing-Simmons Msg-ID: <199611231954.TAA09921@ni-s.u-net.com> Date: Sat, 23 Nov 1996 19:54:52 GMT Files: lib/AutoLoader.pm Title: "Diagnostic cleanup" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: lib/diagnostics.pm pod/perldiag.pod DOCUMENTATION Title: "Improve documentation for sysread() and syswrite()" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pod/perlfunc.pod Title: "Document how to use $SIG{ALRM} and alarm()" - From: Roderick Schertler <roderick@ibcinc.com> + From: Roderick Schertler Msg-ID: <5898.849026569@eeyore.ibcinc.com> Date: Tue, 26 Nov 1996 11:42:49 -0500 Files: pod/perlfunc.pod ----------------- -Version 5.003_09 ----------------- +------------------ + Version 5.003_09 +------------------ This patch was a compendium of various fixes and enhancements from many people, including some serious improvement in lexical variable @@ -4093,17 +4826,17 @@ scoping and locale handling. Title: "Lexical locales" (make effectiveness of locales depend on C<use locale>) - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: too many to list Title: "Lexical scoping cleanup" (tighten scoping of lexical variables, somewhat on the new constructs and somewhat on the old) - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: many... but mostly perly.y and toke.c Title: "Re: memory corruption / security bug in sysread,syswrite + pa - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Msg-ID: <199611251946.VAA30459@alpha.hut.fi> Date: Mon, 25 Nov 1996 21:46:31 +0200 (EET) Files: MANIFEST pod/perldiag.pod pod/perlfunc.pod pp_sys.c @@ -4112,11 +4845,11 @@ scoping and locale handling. OTHER CORE CHANGES Title: "Configure fix for handling DynaLoader" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: Configure Title: "Properly prototype safe{malloc,calloc,realloc,free}." - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: proto.h Title: "UnixWare 2.1 fix for perl5.003_08 - cope with fp->_cnt < -1, @@ -4126,55 +4859,55 @@ scoping and locale handling. Files: sv.c Title: ""static" call to UNIVERSAL::can" - From: Nick.Ing-Simmons@tiuk.ti.com + From: Nick Ing-Simmons Msg-ID: <199611211547.PAA15878@pluto> Date: Thu, 21 Nov 1996 15:47:46 GMT Files: universal.c Title: "die -> croak" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199611212111.QAA17070@aatma.engin.umich.edu> Date: Thu, 21 Nov 1996 16:11:21 -0500 Files: pp_ctl.c Title: "Patch for embed.pl when !EMBED && !MULTIPLICITY" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: embed.pl Title: "Add new symbols to old_global.sym, too." - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: global.sym old_global.sym Title: "Cleanup of {,un}pack('w')." - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp.c Title: "Cleanups from Ilya." - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: gv.c malloc.c pod/perlguts.pod pp_ctl.c Title: "Fix for unpack('w') on 64-bit systems." - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp.c Title: "Re: LC_NUMERIC support is ready + performance" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199611260308.WAA02677@monk.mps.ohio-state.edu> Date: Mon, 25 Nov 1996 22:08:27 -0500 (EST) Files: sv.c Title: "Hash key sharing improvements from Ilya." - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: hv.c hv.h proto.h Title: "Mortal stack pre-allocation from Ilya." - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp.c pp.h pp_ctl.c pp_hot.c pp_sys.c PORTABILITY Title: "VMS patches post-5.003_08" - From: bailey@hmivax.humgen.upenn.edu (Charles Bailey) + From: Charles Bailey Msg-ID: <1996Nov22.181631.1603238@hmivax.humgen.upenn.edu> Date: Fri, 22 Nov 1996 18:16:31 -0500 (EST) Files: lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_VMS.pm @@ -4184,20 +4917,20 @@ scoping and locale handling. vms/vmsish.h Title: "5.003_08: OS/2-specific bugs/enhancements" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Msg-ID: <199611241147.GAA00490@monk.mps.ohio-state.edu> Date: Sun, 24 Nov 1996 06:47:25 -0500 (EST) Files: README.os2 hints/os2.sh os2/Changes os2/Makefile.SHs os2/OS2/PrfDB/PrfDB.pm os2/os2.c Title: "HP patches didn't make it into _08 (fwd)" - From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com> + From: Jeff Okamoto Msg-ID: <199611260215.AA100414526@hpcc123.corp.hp.com> Date: Mon, 25 Nov 96 18:15:26 PST Files: ext/DynaLoader/dl_hpux.xs Title: "Another HP "patch" that didn't make it (new hints file)" - From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com> + From: Jeff Okamoto Msg-ID: <199611252116.AA245766577@hpcc123.corp.hp.com> Date: Mon, 25 Nov 1996 13:16:17 -0800 Files: hints/hpux.sh @@ -4205,15 +4938,15 @@ scoping and locale handling. LIBRARY AND EXTENSIONS Title: "Elide spurious space in db-hash.t" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: t/lib/db-hash.t Title: "Update documentation and warning in I18N::Collate." - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: lib/I18N/Collate.pm Title: "Fix bitwise op test; clean up a couple of others" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: t/lib/bigintpm.t t/op/bop.t t/op/overload.t Title: "minimal timelocal.pl for _09" @@ -4223,11 +4956,11 @@ scoping and locale handling. Files: lib/Time/Local.pm Title: "Socket test improvement from Ilya." - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: t/lib/io_sock.t Title: "Re: blib" - From: nick@ni-s.u-net.com (Nick Ing-Simmons) + From: Nick Ing-Simmons Msg-ID: <199611230917.JAA00471@ni-s.u-net.com> Date: Sat, 23 Nov 1996 09:17:40 GMT Files: lib/blib.pm @@ -4235,19 +4968,19 @@ scoping and locale handling. DOCUMENTATION Title: "perldiag documentation patch." - From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + From: Paul Marquess Msg-ID: <9611201607.AA12729@claudius.bfsec.bt.co.uk> Date: Wed, 20 Nov 96 16:07:28 GMT Files: pod/perldiag.pod Title: "a missing perldiag entry" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Msg-ID: <199611212024.PAA15758@aatma.engin.umich.edu> Date: Thu, 21 Nov 1996 15:24:02 -0500 Files: pod/perldiag.pod Title: "perlfunc patch" - From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + From: Paul Marquess Msg-ID: <9611201404.AA12477@claudius.bfsec.bt.co.uk> Date: Wed, 20 Nov 96 14:04:08 GMT Files: pod/perlfunc.pod @@ -4259,19 +4992,19 @@ scoping and locale handling. Files: pod/perlpod.pod Title: "Update locale documentation." - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pod/perli18n.pod BUNDLED UTILITIES Title: "Fix type mismatches in x2p's safe{alloc,realloc,free}." - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: x2p/util.c ----------------- -Version 5.003_08 ----------------- +------------------ + Version 5.003_08 +------------------ This patch was a compendium of various fixes and enhancements from many people. Here are some of the more significant changes. @@ -4280,13 +5013,13 @@ many people. Here are some of the more significant changes. CORE LANGUAGE CHANGES Title: "Make C<no FOO> fail if C<unimport FOO> fails" - From: Tim Bunce <Tim.Bunce@ig.co.uk> + From: Tim Bunce Files: gv.c Title: "Bitwise op sign rationalization" (Make bitwise ops result in unsigned values, unless C<use integer> is in effect. Includes initial support for UVs.) - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c opcode.pl pod/perlop.pod pod/perltoc.pod pp.c pp.h pp_hot.c proto.h sv.c t/op/bop.t @@ -4297,78 +5030,78 @@ many people. Here are some of the more significant changes. structure. Also adds new construct "for my", which automatically declares the control variable "my" and limits its scope to the loop.) - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: op.c perly.c perly.c.diff perly.h perly.y proto.h toke.c Title: "Fix ++/-- after int conversion (e.g. 'printf "%d"')" (This patch makes Perl correctly ignore SvIVX() if either NOK or POK is true, since SvIVX() may be a truncated or overflowed version of the real value.) - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: pp.c pp_hot.c sv.c Title: "Make code match Camel II re: functions that use $_" - From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + From: Paul Marquess Files: opcode.pl Title: "Provide scalar context on left side of "->"" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: perly.c perly.y Title: "Quote bearword package/handle FOO in "funcname FOO => 'bar'"" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: toke.c OTHER CORE CHANGES Title: "Warn on overflow of octal and hex integers" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: proto.h toke.c util.c Title: "If -w active, warn for commas and hashes ('#') in qw()" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: toke.c Title: "Fixes for pack('w')" - From: Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de> + From: Ulrich Pfeifer Files: pp.c t/op/pack.t Title: "More complete output from sv_dump()" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Files: sv.c Title: "Major '..' and debugger patches" - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Files: lib/perl5db.pl op.c pp_ctl.c scope.c scope.h Title: "Fix for formline()" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Files: global.sym mg.c perl.h pod/perldiag.pod pp_ctl.c proto.h sv.c t/op/write.t Title: "Fix stack botch in untie and binmode" - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Files: pp_sys.c Title: "Complete EMBED, including symbols from interp.sym" (New define EMBEDMYMALLOC makes embedding total by avoiding "Mymalloc" etc.) - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: MANIFEST embed.pl ext/DynaLoader/dlutils.c ext/SDBM_File/sdbm/sdbm.h global.sym handy.h malloc.c perl.h pp_sys.c proto.h regexec.c toke.c util.c x2p/Makefile.SH x2p/a2p.h x2p/handy.h x2p/util.h Title: "Support old embedding for people who want it" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: MANIFEST Makefile.SH old_embed.pl old_global.sym PORTABILITY Title: "Miscellaneous VMS fixes" - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Files: lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_VMS.pm lib/Math/Complex.pm lib/Time/Local.pm lib/timelocal.pl perl.h perl_exp.SH proto.h t/TEST t/io/read.t @@ -4389,14 +5122,14 @@ many people. Here are some of the more significant changes. plan9/genconfig.pl plan9/mkfile plan9/setup.rc Title: "Patch to make Perl work under AmigaOS" - From: "Norbert Pueschel" <pueschel@imsdd.meb.uni-bonn.de> + From: Norbert Pueschel Files: MANIFEST hints/amigaos.sh installman lib/File/Basename.pm lib/File/Find.pm pod/pod2man.PL pp_sys.c util.c LIBRARY AND EXTENSIONS Title: "DB_File 1.05" - From: Paul Marquess (pmarquess@bfsec.bt.co.uk) + From: Paul Marquess Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs t/lib/db-hash.t Title: "Getopts::Std patch for hash support" @@ -4405,7 +5138,7 @@ many people. Here are some of the more significant changes. Title: "Kludge for bareword handles" (Add 'require IO::Handle' at beginning of FileHandle.pm) - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: ext/FileHandle/FileHandle.pm Title: "Re: strtod / strtol patch for POSIX module" @@ -4416,13 +5149,13 @@ many people. Here are some of the more significant changes. BUNDLED UTILITIES Title: "Fix a2p translation of '{print "a" "b" "c"}'" - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Files: x2p/a2p.c x2p/a2p.y ----------------- -Version 5.003_07 ----------------- +------------------ + Version 5.003_07 +------------------ This patch was primarily to fix bugs or include little things I missed in 5.003_06. 5.003_07 is intended to be stable enough to merit serious @@ -4516,14 +5249,14 @@ Index: MANIFEST Add mention of t/lib/io_taint.t Date: Wed, 9 Oct 1996 22:29:44 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich os2/Changes added. Index: Makefile.SH Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich All the executable targets are moved into the same chunk with shared library target, which is delegated to @@ -4589,14 +5322,14 @@ Index: ext/SDBM_File/sdbm/sdbm.h Index: gv.c Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Better error message for overload. Index: hints/os2.sh Date: Wed, 9 Oct 1996 22:29:44 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Some optimization (speedup in loading GNU utilities with some memory present - 32M should be quite enough). @@ -4611,14 +5344,14 @@ Index: hints/sco.sh Index: installperl Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Restore timestamps under OS/2 (needed for binary install). Index: lib/Cwd.pm Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Use builtin methods if present under OS/2 (maybe should be done outside of OS/2 too?). @@ -4626,28 +5359,28 @@ Index: lib/Cwd.pm Index: lib/ExtUtils/MM_Unix.pm Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Made `use strict'-clean even in parts shadowed by Autoloading. Index: lib/ExtUtils/typemap Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich `bool' entry added. Index: lib/ExtUtils/xsubpp Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Logic for processing RETVAL documented (at last!). Index: lib/File/Copy.pm Date: Thu, 10 Oct 1996 00:42:29 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Subject: Cleanup after new test Below are patches for File::Copy (copying to filehandles was just @@ -4656,7 +5389,7 @@ Index: lib/File/Copy.pm Index: lib/FindBin.pm Date: Fri, 20 Sep 1996 15:04:04 +0200 - From: Gisle Aas <aas@bergen.sn.no> + From: Gisle Aas Subject: Documentation patch to the FindBin module Index: lib/Getopt/Long.pm @@ -4678,7 +5411,7 @@ Index: lib/newgetopt.pl Index: makedepend.SH Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich weed out perl_exp.SH, config_h.SH (They have these funny names to avoid names like perl.exp.SH @@ -4687,7 +5420,7 @@ Index: makedepend.SH Index: mg.c Date: Thu, 10 Oct 1996 14:33:08 +0000 () - From: Chip Salzenberg <chip@atlantic.net> + From: Chip Salzenberg Subject: Re: Group fix for 5.003_06 The group problems recently experienced are due to a small error @@ -4696,20 +5429,20 @@ Index: mg.c Index: os2/Changes Date: Wed, 9 Oct 1996 22:29:44 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich sys/un.h is not very useful without Merlin toolkit. updates for fork()ing. Date: Wed, 9 Oct 1996 22:29:44 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich added. Index: os2/Makefile.SHs Date: Wed, 9 Oct 1996 22:29:44 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Convoluted process to create chimera executables added. aout_clean is done automatically on clean. @@ -4717,7 +5450,7 @@ Index: os2/Makefile.SHs Index: os2/OS2/ExtAttr/t/os2_ea.t Date: Wed, 9 Oct 1996 22:29:44 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Use `unlink' where appropriate. @@ -4728,7 +5461,7 @@ Index: os2/diff.configure Index: os2/os2.c Date: Wed, 9 Oct 1996 22:29:44 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich /bin/sh is translated to the configured value of location of sh.exe. popen() used even if we can fork (as we do now). @@ -4737,7 +5470,7 @@ Index: os2/os2.c Index: os2/os2ish.h Date: Wed, 9 Oct 1996 22:29:44 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich sys/un.h is not very useful without Merlin toolkit. updates for fork()ing. @@ -4749,7 +5482,7 @@ Index: patchlevel.h Index: perl.c Date: Wed, 9 Oct 1996 19:03:41 +0000 - From: Tim Bunce <Tim.Bunce@ig.co.uk> + From: Tim Bunce Subject: Infinte loop with perl_destruct_level and $SIG{__WARN__} I've just started using purify on a perl with DBD::Oracle linked in @@ -4760,7 +5493,7 @@ Index: perl.c of problems typified by this example and folowed by a core dump: Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Copywrite of OS/2 port now has \n\n. Now deletes -e file (again!) if compilation is interrupted. @@ -4834,7 +5567,7 @@ Index: plan9/versnum Index: pod/perldiag.pod Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich mention that malloc in berkeley DB is broken, and PERL_BADFREE. OS/2-specific messages added. @@ -4842,7 +5575,7 @@ Index: pod/perldiag.pod Index: pod/perlfunc.pod Date: 20 Sep 1996 13:17:14 +0200 - From: Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de> + From: Ulrich Pfeifer Subject: Re: Patch for ASN.1 compressed integer in pack/unpack Index: pod/perli18n.pod @@ -4852,7 +5585,7 @@ Index: pod/perli18n.pod Index: pod/perlop.pod Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Crossrefs corrected. @@ -4864,14 +5597,14 @@ Index: pod/perltrap.pod Index: pod/perlvar.pod Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich $^E under OS/2. Index: pp.c Date: 20 Sep 1996 13:17:14 +0200 - From: Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de> + From: Ulrich Pfeifer Subject: Re: Patch for ASN.1 compressed integer in pack/unpack Index: pp_sys.c @@ -4885,7 +5618,7 @@ Index: pp_sys.c Index: sv.c Date: Tue, 08 Oct 1996 23:54:47 -0400 - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: Re: Sorting lists of integers doesn't always work >> > print sort (4,1,2,3); @@ -4904,7 +5637,7 @@ Index: sv.c Index: t/lib/anydbm.t Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich File mode under OS/2 is not what you expect. However, this has nothing to do with databases, _and_ there is a test @@ -4916,7 +5649,7 @@ Index: t/lib/anydbm.t Index: t/lib/db-btree.t Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich File mode under OS/2 is not what you expect. However, this has nothing to do with databases, _and_ there is a test @@ -4928,7 +5661,7 @@ Index: t/lib/db-btree.t Index: t/lib/db-hash.t Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich File mode under OS/2 is not what you expect. However, this has nothing to do with databases, _and_ there is a test @@ -4940,7 +5673,7 @@ Index: t/lib/db-hash.t Index: t/lib/db-recno.t Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich File mode under OS/2 is not what you expect. However, this has nothing to do with databases, _and_ there is a test @@ -4952,7 +5685,7 @@ Index: t/lib/db-recno.t Index: t/lib/gdbm.t Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich File mode under OS/2 is not what you expect. However, this has nothing to do with databases, _and_ there is a test @@ -4964,7 +5697,7 @@ Index: t/lib/gdbm.t Index: t/lib/io_pipe.t Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Better error message on dying. @@ -4988,7 +5721,7 @@ Index: t/lib/io_taint.t Index: t/lib/ndbm.t Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich File mode under OS/2 is not what you expect. However, this has nothing to do with databases, _and_ there is a test @@ -5000,7 +5733,7 @@ Index: t/lib/ndbm.t Index: t/lib/odbm.t Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich File mode under OS/2 is not what you expect. However, this has nothing to do with databases, _and_ there is a test @@ -5012,7 +5745,7 @@ Index: t/lib/odbm.t Index: t/lib/sdbm.t Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich File mode under OS/2 is not what you expect. However, this has nothing to do with databases, _and_ there is a test @@ -5024,7 +5757,7 @@ Index: t/lib/sdbm.t Index: t/lib/socket.t Date: Thu, 10 Oct 1996 01:09:59 -0400 - From: Spider Boardman <spider@orb.nashua.nh.us> + From: Spider Boardman Subject: Re: 5.003_06 is available (results on ULTRIX) fix t/lib/socket.t to treat TCP like the stream protocol it is @@ -5033,19 +5766,19 @@ Index: t/lib/socket.t Index: t/op/pack.t Date: 20 Sep 1996 13:17:14 +0200 - From: Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de> + From: Ulrich Pfeifer Subject: Re: Patch for ASN.1 compressed integer in pack/unpack Index: t/op/sort.t Date: Wed, 09 Oct 1996 00:41:27 -0400 - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: more t/op/sort.t tests Index: util.c Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich uses my_syspopen, my_syspclose ifdef OS2. my_pclose is defined as my_syspclose ifdef OS2 and can FORK (as OS2 does). @@ -5071,9 +5804,10 @@ Index: x2p/cflags.SH pathname of the file being extracted. ----------------- -Version 5.003_06 ----------------- +------------------ + Version 5.003_06 +------------------ + This patch was primarily to fix bugs, improve the documentation, and work towards restoring binary compatibility with 5.003. The details are described below. A very brief summary is: @@ -5125,7 +5859,7 @@ Here are the specific file-by-file changes. # The full description is below. # Please execute the following commands before applying this patch. # (You can feed this patch to 'sh' to do so.) -# Andy Dougherty <doughera@lafcol.lafayette.edu> +# -- Andy Dougherty # We'll create some new tests, but patch won't automatically make them # executable. @@ -5161,12 +5895,6 @@ designed so you can examine each change with a command such as csplit may complain, since many csplit's have an arbitrary limit of 100 files. Still, you can manually split the file or roll your own.) -Patch and enjoy, - - Andy Dougherty doughera@lafcol.lafayette.edu - Dept. of Physics - Lafayette College, Easton PA 18042 - Index: Changes Updated for 5.003_06. @@ -5187,7 +5915,7 @@ Index: Configure Index: INSTALL Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -5197,7 +5925,7 @@ Index: INSTALL Index: MANIFEST Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -5205,13 +5933,13 @@ Index: MANIFEST out are applied. Date: Sat, 28 Sep 1996 15:11:06 +0200 - From: Andreas Koenig <k@anna.in-berlin.de> + From: Andreas Koenig Subject: Dale's posting as patch (Was: Perl 5.003_5 make fails on NS3.2 - CURED) Handle NeXT, POSIX, and setpgid in pp_sys.c and POSIX. Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -5242,13 +5970,13 @@ Index: configure Index: doio.c Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 Index: doop.c Date: Mon, 30 Sep 1996 01:13:28 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman Subject: Re: pre extending hash? - need speed The patch below (which is relative to perl5.001l) implements @@ -5370,7 +6098,7 @@ Index: ext/NDBM_File/hints/dynixptx.pl Index: ext/Opcode/Opcode.pm Date: Fri, 20 Sep 1996 12:59:21 +0200 - From: Gisle Aas <aas@bergen.sn.no> + From: Gisle Aas Subject: Re: Symbol.pm clobbers $_ at startup The same kind of problem seem to be present in Opcode.pm: @@ -5394,7 +6122,7 @@ Index: ext/Opcode/Safe.pm Index: ext/POSIX/POSIX.pod Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -5404,7 +6132,7 @@ Index: ext/POSIX/POSIX.pod Index: ext/POSIX/POSIX.xs Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -5415,7 +6143,7 @@ Index: ext/POSIX/POSIX.xs Index: ext/POSIX/hints/next_3.pl Date: Sat, 28 Sep 1996 15:11:06 +0200 - From: Andreas Koenig <k@anna.in-berlin.de> + From: Andreas Koenig Subject: Dale's posting as patch (Was: Perl 5.003_5 make fails on NS3.2 - CURED) Handle NeXT, POSIX, and setpgid in pp_sys.c and POSIX. @@ -5440,7 +6168,7 @@ Index: global.sym Provide new 3-arg forms gv_fullname3() and gv_efullname3(). Date: Mon, 30 Sep 1996 01:13:28 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman Subject: Re: pre extending hash? - need speed The patch below (which is relative to perl5.001l) implements @@ -5450,7 +6178,7 @@ Index: global.sym improved. Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -5465,7 +6193,7 @@ Index: gv.c Index: handy.h Date: Sat, 21 Sep 1996 21:33:15 -0400 (EDT) - From: Kenneth Albanowski <kjahds@kjahds.com> + From: Kenneth Albanowski Subject: Full LONG_MAX & co. patch over 5.003_05 This patch contains the changes I've collected for the various _MAX issues @@ -5485,7 +6213,7 @@ Index: hints/next_3.sh the optimizier. Date: Sat, 28 Sep 1996 15:11:06 +0200 - From: Andreas Koenig <k@anna.in-berlin.de> + From: Andreas Koenig Subject: Dale's posting as patch (Was: Perl 5.003_5 make fails on NS3.2 - CURED) Handle NeXT, POSIX, and setpgid in pp_sys.c and POSIX. @@ -5493,7 +6221,7 @@ Index: hints/next_3.sh Index: hv.c Date: Fri, 20 Sep 1996 15:38:57 -0400 - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: Re: "Attempt to free non-existent shared string"? (with patch) I found a subtle problem with the lazydelete mechanism (which is used @@ -5507,7 +6235,7 @@ Index: hv.c flag. Date: Mon, 30 Sep 1996 01:13:28 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman Subject: Re: pre extending hash? - need speed The patch below (which is relative to perl5.001l) implements @@ -5519,7 +6247,7 @@ Index: hv.c Index: hv.h Date: Fri, 20 Sep 1996 15:38:57 -0400 - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: Re: "Attempt to free non-existent shared string"? (with patch) I found a subtle problem with the lazydelete mechanism (which is used @@ -5553,21 +6281,21 @@ Index: installperl Index: lib/AutoLoader.pm Date: Mon Sep 9 09:29:44 1996 - From: Gisle Aas <aas@bergen.sn.no> + From: Gisle Aas Subject: Re: problem with 'die' and UserAgent > This is a patch to the AutoLoader.pm (from 5.003) that fixes the problem: This is a better patch (no need to test for /::DESTROY$/ twice): Date: Mon, 30 Sep 1996 00:54:37 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman The test and patches for AutoLoader were also non-functional, since the regexp context (curpm) was still being clobbered by the filename manipulations: Date: Sun, 06 Oct 1996 16:15:07 +0200 - From: Gisle Aas <aas@bergen.sn.no> + From: Gisle Aas Subject: Re: Can't locate auto/U/autosplit.ix It would IMHO be much better if the AutoLoader exported the AUTOLOAD() @@ -5580,7 +6308,7 @@ Index: lib/AutoLoader.pm Index: lib/Benchmark.pm Date: Sat, 28 Sep 1996 17:01:22 +0300 (EET DST) - From: Jarkko Hietaniemi <jhi@cc.hut.fi> + From: Jarkko Hietaniemi Subject: a really really tiny typo Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST) @@ -5665,7 +6393,7 @@ Index: lib/ExtUtils/MM_VMS.pm 5.003_05 pods, including the pods embedded in library modules. Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 Index: lib/ExtUtils/MakeMaker.pm @@ -5687,7 +6415,7 @@ Index: lib/ExtUtils/Manifest.pm 5.003_05 pods, including the pods embedded in library modules. Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 Index: lib/ExtUtils/Mksymlists.pm @@ -5706,24 +6434,24 @@ Index: lib/ExtUtils/xsubpp Index: lib/File/Basename.pm Date: Fri, 20 Sep 1996 14:11:05 +0200 - From: Gisle Aas <aas@bergen.sn.no> + From: Gisle Aas Subject: File::BaseName: "/" is legal path separator for MSDOS The File::BaseName module should allow "/" as path separator when fileparse_set_fstype("MSDOS") is in effect: Date: Fri, 20 Sep 1996 13:58:52 +0200 - From: Gisle Aas <aas@bergen.sn.no> + From: Gisle Aas Subject: File::Basename documentation patch Date: Mon, 30 Sep 1996 00:54:37 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman For t/lib/basename.t, though, the associated patch for File::Basename was also wrong: Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 Index: lib/File/Copy.pm @@ -5777,7 +6505,7 @@ Index: lib/Getopt/Long.pm Index: lib/I18N/Collate.pm Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -5805,7 +6533,7 @@ Index: lib/IPC/Open3.pm Index: lib/Math/BigInt.pm Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -5833,7 +6561,7 @@ Index: lib/Pod/Text.pm Index: lib/Search/Dict.pm Date: Sat, 21 Sep 1996 23:02:42 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: look() in Search::Dict should use lc() istead of tr/A-Z/a-z/ The Search::Dict look() function should use the lc() function instead @@ -5852,7 +6580,7 @@ Index: lib/SelfLoader.pm Index: lib/Symbol.pm Date: Fri, 20 Sep 1996 12:38:14 +0200 - From: Gisle Aas <aas@bergen.sn.no> + From: Gisle Aas Subject: Symbol.pm clobbers $_ at startup perl -le 'BEGIN {$_="foo";} use Symbol; print qualify($_)' @@ -5880,7 +6608,7 @@ Index: lib/Sys/Hostname.pm Index: lib/Term/Cap.pm Date: 23 Sep 1996 14:11:38 +0200 - From: Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de> + From: Ulrich Pfeifer Subject: Patch for Term::Cap 'use Term::Cap' produces a warning when diagnosics are active. The @@ -5917,13 +6645,13 @@ Index: lib/Test/Harness.pm 5.003_05 pods, including the pods embedded in library modules. Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 Index: lib/Text/Abbrev.pm Date: 23 Sep 1996 11:33:01 +0200 - From: Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de> + From: Ulrich Pfeifer Subject: Text::Abbrev (Re: More standard library test scripts) This patch merges the Text::Abbrev related patches/tests from Gisle @@ -5963,7 +6691,7 @@ Index: lib/UNIVERSAL.pm Index: lib/bigint.pl Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -5991,7 +6719,7 @@ Index: lib/overload.pm Index: lib/perl5db.pl Date: Mon, 30 Sep 1996 00:34:58 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Subject: Re: dereferencing a hash from the debugger won't work Index: lib/splain @@ -6029,14 +6757,14 @@ Index: mg.c Provide new 3-arg forms gv_fullname3() and gv_efullname3(). Date: Sun, 29 Sep 1996 22:18:19 -0400 (EDT) - From: Chip Salzenberg <salzench@nielsenmedia.com> + From: Chip Salzenberg Subject: 5.003_05: Fix numeric value of $! This patch undoes a bit of over-zealous integerization in mg.c, related to the numeric value of $!. Date: Mon, 30 Sep 1996 01:13:28 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman Subject: Re: pre extending hash? - need speed The patch below (which is relative to perl5.001l) implements @@ -6046,11 +6774,11 @@ Index: mg.c improved. Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 Date: Fri, 4 Oct 1996 12:38:31 -0400 (EDT) - From: Chip Salzenberg <salzench@nielsenmedia.com> + From: Chip Salzenberg Subject: 5.003_05: Fix numeric $! and $^E This patch undoes a bit of over-zealous integerization in mg.c, @@ -6065,7 +6793,7 @@ Index: op.c Provide new 3-arg forms gv_fullname3() and gv_efullname3(). Date: Mon, 30 Sep 1996 01:13:28 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman Subject: Re: pre extending hash? - need speed The patch below (which is relative to perl5.001l) implements @@ -6100,26 +6828,26 @@ Index: patchlevel.h Index: perl.c - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Subject: Re: -T flag and removal of `.' from @INC support C<perl -e'attached code'> Date: Tue, 01 Oct 1996 19:02:17 -0400 - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: Re: 2 core dumps (patch) Message-Id: <199610012302.TAA08395@aatma.engin.umich.edu> The problem is an uninitialized SV slot in errgv. Here's a patch. Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 Index: perl.h Date: Sat, 21 Sep 1996 21:33:15 -0400 (EDT) - From: Kenneth Albanowski <kjahds@kjahds.com> + From: Kenneth Albanowski Subject: Full LONG_MAX & co. patch over 5.003_05 This patch contains the changes I've collected for the various _MAX issues @@ -6130,7 +6858,7 @@ Index: perl.h ambiguous) and to explicitly cast all of the constants. Date: Mon, 30 Sep 1996 01:13:28 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman Subject: Re: pre extending hash? - need speed The patch below (which is relative to perl5.001l) implements @@ -6143,7 +6871,7 @@ Index: perl.h 5.003. Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -6169,13 +6897,13 @@ Index: perlsdio.h Undef Irix getc_unlocked and putc_unlocked #defines. Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 Index: pod/Makefile Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -6203,7 +6931,7 @@ Index: pod/perl.pod Changed Larry's address to larry@wall.org. Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -6273,7 +7001,7 @@ Index: pod/perldiag.pod 5.003_05 pods, including the pods embedded in library modules. Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 Index: pod/perldsc.pod @@ -6326,7 +7054,7 @@ Index: pod/perlguts.pod From: "Daniel S. Lewart" <lewart@vadds.cvm.uiuc.edu> Subject: POD spelling patches Date: Mon, 23 Sep 96 13:18:01 PDT - From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com> + From: Jeff Okamoto Subject: Re: perlguts API Listing patch Here's the lastest complete version for inclusion into _06 or .004. This @@ -6342,7 +7070,7 @@ Index: pod/perlguts.pod Index: pod/perli18n.pod Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -6385,7 +7113,7 @@ Index: pod/perlmod.pod 5.003_05 pods, including the pods embedded in library modules. Date: Wed, 02 Oct 1996 16:52:08 -0400 - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Subject: documentation for $? in END Document the behavior with $? WRT END subroutines. @@ -6409,7 +7137,7 @@ Index: pod/perlop.pod 5.003_05 pods, including the pods embedded in library modules. Date: Fri, 4 Oct 1996 10:36:19 -0400 (EDT) - From: Kenneth Albanowski <kjahds@kjahds.com> + From: Kenneth Albanowski Subject: Re: Suggestion for improving man page Add alternative names for various escape sequences. @@ -6441,7 +7169,7 @@ Index: pod/perlre.pod 5.003_05 pods, including the pods embedded in library modules. Date: Fri, 4 Oct 1996 10:36:19 -0400 (EDT) - From: Kenneth Albanowski <kjahds@kjahds.com> + From: Kenneth Albanowski Subject: Re: Suggestion for improving man page Add alternative names for various escape sequences. @@ -6536,7 +7264,7 @@ Index: pod/perltoc.pod Index: pod/perltrap.pod Date: Wed, 11 Sep 1996 13:26:18 -0400 - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: a perl425 trap Here's an addition that should be self-explanatory. @@ -6559,7 +7287,7 @@ Index: pod/perlvar.pod 5.003_05 pods, including the pods embedded in library modules. Date: Wed, 02 Oct 1996 16:52:08 -0400 - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Subject: documentation for $? in END Document the behavior with $? WRT END subroutines. @@ -6623,7 +7351,7 @@ Index: pp_ctl.c Provide new 3-arg forms gv_fullname3() and gv_efullname3(). Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -6688,7 +7416,7 @@ Index: pp_sys.c then closed and re-opened, retained the untaintedness. Date: Mon, 30 Sep 1996 00:54:37 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman First, with IO::untaint, the patches as posted resulted in a miniperl which couldn't open files, so the autosplitting of the @@ -6701,7 +7429,7 @@ Index: proto.h Provide new 3-arg forms gv_fullname3() and gv_efullname3(). Date: Mon, 30 Sep 1996 01:13:28 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman Subject: Re: pre extending hash? - need speed The patch below (which is relative to perl5.001l) implements @@ -6711,7 +7439,7 @@ Index: proto.h improved. Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -6729,7 +7457,7 @@ Index: sv.c Provide new 3-arg forms gv_fullname3() and gv_efullname3(). Date: Mon, 30 Sep 1996 01:13:28 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman Subject: Re: pre extending hash? - need speed The patch below (which is relative to perl5.001l) implements @@ -6739,7 +7467,7 @@ Index: sv.c improved. Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 I've added some DEBUG_Ps to sv.c which give a trace of the @@ -6750,7 +7478,7 @@ Index: sv.c already adds a profile of op usage to its advertised output.) Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -6778,7 +7506,7 @@ Index: sv.h * Add the "untaint" keyword. Date: Fri, 20 Sep 1996 15:38:57 -0400 - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: Re: "Attempt to free non-existent shared string"? (with patch) I found a subtle problem with the lazydelete mechanism (which is used @@ -6794,7 +7522,7 @@ Index: sv.h Index: t/base/term.t Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -6804,7 +7532,7 @@ Index: t/base/term.t Index: t/comp/package.t Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -6814,7 +7542,7 @@ Index: t/comp/package.t Index: t/lib/abbrev.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -6822,7 +7550,7 @@ Index: t/lib/abbrev.t out are applied. Date: 23 Sep 1996 11:33:01 +0200 - From: Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de> + From: Ulrich Pfeifer Subject: Text::Abbrev (Re: More standard library test scripts) This patch merges the Text::Abbrev related patches/tests from Gisle @@ -6831,7 +7559,7 @@ Index: t/lib/abbrev.t Index: t/lib/anydbm.t Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -6841,7 +7569,7 @@ Index: t/lib/anydbm.t Index: t/lib/autoloader.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -6849,7 +7577,7 @@ Index: t/lib/autoloader.t out are applied. Date: Mon, 30 Sep 1996 00:54:37 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman The test and patches for AutoLoader were also non-functional, since the regexp context (curpm) was still being clobbered by the @@ -6858,7 +7586,7 @@ Index: t/lib/autoloader.t Index: t/lib/basename.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -6866,12 +7594,12 @@ Index: t/lib/basename.t out are applied. Date: Mon, 30 Sep 1996 00:54:37 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman Fix the number of tests. Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 A different set of tests for File::Basename and friends. @@ -6879,7 +7607,7 @@ Index: t/lib/basename.t Index: t/lib/checktree.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -6898,7 +7626,7 @@ Index: t/lib/complex.t Index: t/lib/db-btree.t Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -6908,7 +7636,7 @@ Index: t/lib/db-btree.t Index: t/lib/db-hash.t Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -6918,7 +7646,7 @@ Index: t/lib/db-hash.t Index: t/lib/env.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -6928,7 +7656,7 @@ Index: t/lib/env.t Index: t/lib/fatal.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -6938,7 +7666,7 @@ Index: t/lib/fatal.t Index: t/lib/filecache.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -6948,7 +7676,7 @@ Index: t/lib/filecache.t Index: t/lib/filecopy.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -6958,7 +7686,7 @@ Index: t/lib/filecopy.t Index: t/lib/filefind.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -6968,7 +7696,7 @@ Index: t/lib/filefind.t Index: t/lib/filepath.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -6978,7 +7706,7 @@ Index: t/lib/filepath.t Index: t/lib/findbin.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -6988,7 +7716,7 @@ Index: t/lib/findbin.t Index: t/lib/gdbm.t Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -6998,7 +7726,7 @@ Index: t/lib/gdbm.t Index: t/lib/getopt.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -7008,7 +7736,7 @@ Index: t/lib/getopt.t Index: t/lib/hostname.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -7018,7 +7746,7 @@ Index: t/lib/hostname.t Index: t/lib/ndbm.t Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -7028,7 +7756,7 @@ Index: t/lib/ndbm.t Index: t/lib/odbm.t Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -7038,7 +7766,7 @@ Index: t/lib/odbm.t Index: t/lib/parsewords.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -7048,7 +7776,7 @@ Index: t/lib/parsewords.t Index: t/lib/sdbm.t Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -7058,7 +7786,7 @@ Index: t/lib/sdbm.t Index: t/lib/searchdict.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -7068,7 +7796,7 @@ Index: t/lib/searchdict.t Index: t/lib/selectsaver.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -7078,7 +7806,7 @@ Index: t/lib/selectsaver.t Index: t/lib/symbol.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -7086,7 +7814,7 @@ Index: t/lib/symbol.t out are applied. Date: Mon, 30 Sep 1996 00:54:37 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman The various new lib/*.t tests didn't all work. For some, it was only because the count of tests was wrong: @@ -7094,7 +7822,7 @@ Index: t/lib/symbol.t Index: t/lib/texttabs.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -7104,7 +7832,7 @@ Index: t/lib/texttabs.t Index: t/lib/textwrap.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -7114,7 +7842,7 @@ Index: t/lib/textwrap.t Index: t/lib/timelocal.t Date: Sun, 22 Sep 1996 00:59:56 +0200 - From: Gisle Aas <aas@aas.no> + From: Gisle Aas Subject: More standard library test scripts This is a collection of test scripts for the standard library modules. @@ -7124,7 +7852,7 @@ Index: t/lib/timelocal.t Index: t/op/each.t Date: Mon, 30 Sep 1996 01:13:28 -0400 - From: Spider Boardman <spider@Orb.Nashua.NH.US> + From: Spider Boardman Subject: Re: pre extending hash? - need speed The patch below (which is relative to perl5.001l) implements @@ -7134,7 +7862,7 @@ Index: t/op/each.t improved. Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -7144,7 +7872,7 @@ Index: t/op/each.t Index: t/op/glob.t Date: Tue, 01 Oct 1996 16:37:03 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: Re: glob test 1 failing...bad test or bug Under AIX 4.1.4, with LOCALE set en_GB (British english) glob test one @@ -7156,7 +7884,7 @@ Index: t/op/glob.t Index: t/op/magic.t Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -7164,7 +7892,7 @@ Index: t/op/magic.t Index: t/op/readdir.t Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -7174,7 +7902,7 @@ Index: t/op/readdir.t Index: t/op/sort.t Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -7184,7 +7912,7 @@ Index: t/op/sort.t Index: toke.c Date: Sat, 14 Sep 1996 17:08:16 -0400 - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: whitespace induced lexer errors (with patch) I finally got around to fixing skipspace() to not indiscriminately @@ -7192,7 +7920,7 @@ Index: toke.c expectation decisions in the lexer). Date: Sat, 14 Sep 1996 18:55:16 -0400 - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: perl lexer won't accept C<my($a,$b);$a<=>$b;> Date: Thu, 19 Sep 1996 11:58:22 -0400 @@ -7216,7 +7944,7 @@ Index: toke.c Index: util.c Date: Mon, 7 Oct 1996 22:03:00 +0300 - From: Jarkko Hietaniemi <jhi@alpha.hut.fi> + From: Jarkko Hietaniemi Subject: LC_COLLATE. Big patch to add, document, and test LC_COLLATE support. @@ -7272,7 +8000,7 @@ Index: utils/h2xs.PL Index: utils/perldoc.PL Date: Sun, 29 Sep 1996 22:00:09 -0400 (EDT) - From: Kenneth Albanowski <kjahds@kjahds.com> + From: Kenneth Albanowski Subject: perldoc patch Ilya has found that this change makes perldoc much more useful under OS/2. @@ -7280,31 +8008,31 @@ Index: utils/perldoc.PL Index: vms/config.vms Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 Index: vms/descrip.mms Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 Index: vms/genconfig.pl Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 Index: vms/perlvms.pod Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 Index: vms/vms.c Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT) - From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + From: Charles Bailey Subject: VMS patches to 5.003_05 Index: x2p/a2p.pod @@ -7324,9 +8052,10 @@ Index: x2p/s2p.PL This patch just changed the old s2p.man page into a pod page. I then embedded the pod into the s2p script. ----------------- -Version 5.003_05 ----------------- + +------------------ + Version 5.003_05 +------------------ This patch was primarily to fix bugs and to clean up some of the remaining issues from in 5.003_04. The details are described below. @@ -7379,7 +8108,7 @@ Here are the specific file-by-file changes. # The full description is below. # Please execute the following commands before applying this patch. # (You can feed this patch to 'sh' to do so.) -# Andy Dougherty <doughera@lafcol.lafayette.edu> +# -- Andy Dougherty # We'll create a new test, but patch won't automatically make it # executable. @@ -7402,12 +8131,6 @@ designed so you can examine each change with a command such as csplit -k perl5.003_05.pat '/^Index:/' '{99}' -Patch and enjoy, - - Andy Dougherty doughera@lafcol.lafayette.edu - Dept. of Physics - Lafayette College, Easton PA 18042 - Index: Changes Updated for 5.003_05. @@ -7477,7 +8200,7 @@ Index: av.h Subject: turbidity in av.[ch] Date: Sun, 10 Dec 1995 00:21:31 -0500 - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Some unclean code that I noticed today. @@ -7494,7 +8217,7 @@ Index: config_h.SH Index: emacs/cperl-mode.el - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Subject: Newer CPerl-mode Index: ext/DB_File/DB_File.pm @@ -7508,14 +8231,14 @@ Index: ext/DB_File/DB_File.xs Index: ext/Fcntl/Fcntl.pm Date: Thu, 5 Sep 1996 18:19:14 -0400 (EDT) - From: Chip Salzenberg <salzench@nielsenmedia.com> + From: Chip Salzenberg Subject: No AutoLoader for Fcntl Just like Socket, Fcntl doesn't need splitting and AutoLoading. Index: ext/FileHandle/FileHandle.pm - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Subject: FileHandle::DESTROY for fd 0 This fixes FileHandle::DESTROY when called on stdin. @@ -7536,7 +8259,7 @@ Index: ext/ODBM_File/hints/ultrix.pl Index: ext/Socket/Socket.pm Date: Thu, 5 Sep 1996 09:58:08 +0200 - From: Andreas Koenig <k@anna.in-berlin.de> + From: Andreas Koenig Subject: Patch to inhibit autosplit on Socket.pm This patch inhibits production and use of a completely useless @@ -7576,14 +8299,14 @@ Index: hints/sunos_4_1.sh Index: hv.c Date: Thu, 05 Sep 1996 00:25:28 -0400 - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: minor misc. cleanup This patch makes some minor cleanups to the sources. No change in functionality whatsoever. Date: Thu, 05 Sep 1996 02:52:21 -0400 - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: debugger problems--another patch (was Re: 5.003_04) @@ -7689,7 +8412,7 @@ Index: lib/open3.pl Index: lib/syslog.pl Date: Tue, 03 Sep 1996 20:33:54 -0400 - From: Roderick Schertler <roderick@gate.net> + From: Roderick Schertler Subject: syslog.pl `use Socket' lossage syslog.pl tries but fails to use @@ -7717,7 +8440,7 @@ Index: mg.c (lines near 584) Part of VMS changes. I don't know what this did. Date: Fri, 23 Aug 1996 17:20:22 -0400 (EDT) - From: Chip Salzenberg <salzench@nielsenmedia.com> + From: Chip Salzenberg Subject: Integerize mg.c; eliminate warning on C< local($)) > This patch converts magic variables ($!, $^E, etc.) to use integers @@ -7738,7 +8461,7 @@ Index: nostdio.h Index: op.c - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: Re: \ ( @array ) busted for lexical @array (once more) Index: patchlevel.h @@ -7802,7 +8525,7 @@ Index: pod/perlipc.pod Index: pod/perlref.pod - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: Re: \ ( @array ) busted for lexical @array (once more) Index: pod/perltie.pod @@ -7838,14 +8561,14 @@ Index: pod/perlvar.pod Index: pp.c Date: Fri, 23 Aug 1996 17:22:40 -0400 (EDT) - From: Chip Salzenberg <salzench@nielsenmedia.com> + From: Chip Salzenberg Subject: Minor integer speedups in mathematics This patch provides minor speedups by using integer math and SVt_IV values when performing bitwise operations and modulus. Date: Tue, 3 Sep 1996 17:49:22 -0400 (EDT) - From: Kenneth Albanowski <kjahds@kjahds.com> + From: Kenneth Albanowski Subject: Pack Patch (was Re: 5.002 - pack/unpack does not do "I" right) (double)auint cast added for call to sv_setnv(). @@ -7853,7 +8576,7 @@ Index: pp.c Index: pp_hot.c Date: Thu, 05 Sep 1996 00:25:28 -0400 - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: minor misc. cleanup This patch makes some minor cleanups to the sources. No change @@ -7883,7 +8606,7 @@ Index: sv.c Perl_debug_log instead. Date: Fri, 23 Aug 1996 17:26:42 -0400 (EDT) - From: Chip Salzenberg <salzench@nielsenmedia.com> + From: Chip Salzenberg Subject: Minor potential bug in AV creation I wasn't the one who originated this patch. But it looks like it @@ -7941,18 +8664,18 @@ Index: t/op/misc.t Index: t/op/pack.t Date: Tue, 3 Sep 1996 17:49:22 -0400 (EDT) - From: Kenneth Albanowski <kjahds@kjahds.com> + From: Kenneth Albanowski Subject: Pack Patch (was Re: 5.002 - pack/unpack does not do "I" right) Index: t/op/ref.t - From: Gurusamy Sarathy <gsar@engin.umich.edu> + From: Gurusamy Sarathy Subject: Re: \ ( @array ) busted for lexical @array (once more) Index: universal.c Date: Thu, 29 Aug 96 07:05:10 BST - From: Graham Barr <bodg@tiuk.ti.com> + From: Graham Barr Subject: Re: UNIVERSAL::class busted yes, but I also noticed that this does not check that the reference @@ -7971,7 +8694,7 @@ Index: util.c Index: utils/h2xs.PL Date: Fri, 6 Sep 1996 06:09:20 -0400 (EDT) - From: Ilya Zakharevich <ilya@math.ohio-state.edu> + From: Ilya Zakharevich Subject: updated h2xs Changes: @@ -8040,9 +8763,10 @@ Index: vms/vmsish.h VMS 5.003_05 Update. ----------------- -Version 5.003_04 ----------------- + +------------------ + Version 5.003_04 +------------------ This patch was primarily to fix bugs and to clean up some of the changes made in 5.003_03. The details are described below. @@ -8081,7 +8805,7 @@ Here are the specific file-by-file changes. # The full description is below. # Please execute the following commands before applying this patch. # (You can feed this patch to 'sh' to do so.) -# Andy Dougherty <doughera@lafcol.lafayette.edu> +# -- Andy Dougherty # Obsolete perl4 hint file. rm -f hints/dnix.sh @@ -8109,13 +8833,6 @@ designed so you can examine each change with a command such as csplit -k perl5.003_04.pat '/^Index:/' '{99}' -Patch and enjoy, - - Andy Dougherty doughera@lafcol.lafayette.edu - Dept. of Physics - Lafayette College, Easton PA 18042 - - Index: Changes Updated for 5.003_04. @@ -8176,8 +8893,7 @@ Index: config_h.SH The /*#define FOO /**/ is a perfectly legal un-nested comment, and I wish IBM would fix it's blasted compiler instead. In the meantime we'll take mercy on the poor AIX user and get rid of the screenfulls - of stupid warning messages. Thanks to Hallvard B Furuseth - <h.b.furuseth@usit.uio.no> for the fix. + of stupid warning messages. Thanks to Hallvard B Furuseth for the fix. Index: dump.c @@ -8480,7 +9196,7 @@ Index: sv.c reduce code size and improve maintainability by combining some common code in gv_fullname() and gv_efullname(). - From: Chip Salzenberg <salzench@nielsenmedia.com> + From: Chip Salzenberg Subject: Track SVs for destruction when -DPURIFY When checking for memory leaks, I compiled Perl with "-DPURIFY". @@ -8572,9 +9288,10 @@ Index: utils/perldoc.PL HP-UX nroff -man output. (col -x isn't portable -- SunOS doesn't support the -x option.) ----------------- -Version 5.003_03 ----------------- + +------------------ + Version 5.003_03 +------------------ Most of the changes in 5.003_03 are to make the build and installation process more robust. The details are described below. A very brief @@ -8609,7 +9326,7 @@ Here are the specific file-by-file changes. # The full description is below. # Please execute the following commands before applying this patch. # (You can feed this patch to 'sh' to do so.) -# Andy Dougherty <doughera@lafcol.lafayette.edu> +# -- Andy Dougherty # Absorbed into Changes5.002 rm -f Changes.Conf @@ -8648,12 +9365,6 @@ designed so you can examine each change with a command such as csplit -k perl5.003_03.pat '/^Index:/' '{99}' -Patch and enjoy, - - Andy Dougherty doughera@lafcol.lafayette.edu - Dept. of Physics - Lafayette College, Easton PA 18042 - Index: Changes Include 5.003_03 change notes. @@ -9189,9 +9900,11 @@ Index: x2p/str.c Use Configure's FILE_filbuf macro instead of a raw _filbuf. ----------------- -Version 5.003_02 ----------------- + +------------------ + Version 5.003_02 +------------------ + o Visible Changes to Core Functionality - Redefining constant subs, or changing sub's prototype now give warnings. - Fixes for ++/-- of values close to max/min size of an integer @@ -9231,9 +9944,10 @@ o Changes in OS-specific and Build-time Support - Applied OS/2 patches. - Typo patch for VMS. ----------------- -Version 5.003_01 ----------------- + +------------------ + Version 5.003_01 +------------------ Version 5.003_01 contains bugfixes and additions accumulated since version 5.002_01, since the patch to version 5.003 was deliberately @@ -23,10 +23,24 @@ # define EXTCONST globalref # define dEXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly #else -# define EXT extern -# define dEXT -# define EXTCONST extern const -# define dEXTCONST const +# if defined(_MSC_VER) && defined(_WIN32) +# ifdef PERLDLL +# define EXT __declspec(dllexport) +# define dEXT +# define EXTCONST __declspec(dllexport) const +# define dEXTCONST const +# else +# define EXT __declspec(dllimport) +# define dEXT +# define EXTCONST __declspec(dllimport) const +# define dEXTCONST const +# endif +# else +# define EXT extern +# define dEXT +# define EXTCONST extern const +# define dEXTCONST const +# endif #endif #undef INIT @@ -19,30 +19,41 @@ The basic steps to build and install perl5 on a Unix system are: Each of these is explained in further detail below. -For information on non-Unix systems, see the section on -L<"Porting information"> below. +For information on non-Unix systems, see L<"Porting information"> below. -=head1 DESCRIPTION +For information on what's new in this release, see the pod/perldelta.pod +file. For more detailed information about specific changes, see the +Changes file. -You should probably at least skim through this entire document before -proceeding. Special notes specific to this release are identified -by B<NOTE>. +=head1 DESCRIPTION This document is written in pod format as an easy way to indicate its structure. The pod format is described in pod/perlpod.pod, but you can -read it as is with any pager or editor. +read it as is with any pager or editor. Headings and items are marked +by lines beginning with '='. The other mark-up used is + + B<text> embolden text, used for switches, programs or commands + C<code> literal code + L<name> A link (cross reference) to name + +You should probably at least skim through this entire document before +proceeding. If you're building Perl on a non-Unix system, you should also read the README file specific to your operating system, since this may provide additional or different instructions for building Perl. +If there is a hint file for your system (in the hints/ directory) you +should also read that hint file for specific information for your +system. (Unixware users should use the svr4.sh hint file.) + =head1 Space Requirements -The complete perl5 source tree takes up about 7 MB of disk space. -The complete tree after completing C<make> takes roughly -15 MB, though the actual total is likely to be quite -system-dependent. The installation directories need something -on the order of 7 MB, though again that value is system-dependent. +The complete perl5 source tree takes up about 7 MB of disk space. The +complete tree after completing make takes roughly 15 MB, though the +actual total is likely to be quite system-dependent. The installation +directories need something on the order of 7 MB, though again that +value is system-dependent. =head1 Start with a Fresh Distribution @@ -54,7 +65,7 @@ with the command The results of a Configure run are stored in the config.sh file. If you are upgrading from a previous version of perl, or if you change systems or compilers or make other significant changes, or if you are -experiencing difficulties building perl, you should probably I<not> +experiencing difficulties building perl, you should probably not re-use your old config.sh. Simply remove it or rename it, e.g. mv config.sh config.sh.old @@ -70,8 +81,8 @@ Similarly, if you used a shared libperl.so (see below) with version numbers, you will probably want to adjust them as well. Also, be careful to check your architecture name. Some Linux systems -call themselves i486, while others use i586. If you pick up a -precompiled binary, it might not use the same name. +(such as Debian) use i386, while others may use i486 or i586. If you +pick up a precompiled binary, it might not use the same name. In short, if you wish to use your old config.sh, I recommend running Configure interactively rather than blindly accepting the defaults. @@ -80,11 +91,12 @@ Configure interactively rather than blindly accepting the defaults. Configure will figure out various things about your system. Some things Configure will figure out for itself, other things it will ask -you about. To accept the default, just press C<RETURN>. The default -is almost always ok. +you about. To accept the default, just press RETURN. The default +is almost always ok. At any Configure prompt, you can type &-d +and Configure will use the defaults from then on. After it runs, Configure will perform variable substitution on all the -F<*.SH> files and offer to run B<make depend>. +*.SH files and offer to run make depend. Configure supports a number of useful options. Run B<Configure -h> to get a listing. To compile with gcc, for example, you can run @@ -97,11 +109,6 @@ compiler) so that the hints files can set appropriate defaults. If you want to use your old config.sh but override some of the items with command line options, you need to use B<Configure -O>. -If you are willing to accept all the defaults, and you want terse -output, you can run - - sh Configure -des - By default, for most systems, perl will be installed in /usr/local/{bin, lib, man}. You can specify a different 'prefix' for the default installation directory, when Configure prompts you or by @@ -120,14 +127,23 @@ your system supports it. If you want to force perl to be compiled statically, you can either choose this when Configure prompts you or you can use the Configure command line option -Uusedl. +If you are willing to accept all the defaults, and you want terse +output, you can run + + sh Configure -des + +For my Solaris system, I usually use + + sh Configure -Dprefix=/opt/perl -Doptimize='-xpentium -xO4' -des + =head2 GNU-style configure -If you prefer the GNU-style B<configure> command line interface, you can -use the supplied B<configure> command, e.g. +If you prefer the GNU-style configure command line interface, you can +use the supplied configure command, e.g. CC=gcc ./configure -The B<configure> script emulates a few of the more common configure +The configure script emulates a few of the more common configure options. Try ./configure --help @@ -137,8 +153,8 @@ for a listing. Cross compiling is not supported. For systems that do not distinguish the files "Configure" and -"configure", Perl includes a copy of B<configure> named -B<configure.gnu>. +"configure", Perl includes a copy of configure named +configure.gnu. =head2 Extensions @@ -153,6 +169,10 @@ Configure command line. Similarly, the Opcode extension is always built by default, but you can skip it by setting the Configure variable useopcode=false either in a hint file for from the command line. +You can learn more about each of these extensions by consulting the +documentation in the individual .pm modules, located under the +ext/ subdirectory. + Even if you do not have dynamic loading, you must still build the DynaLoader extension; you should just build the stub dl_none.xs version. (Configure will suggest this as the default.) @@ -182,6 +202,11 @@ library. Of course, you may always run Configure interactively and select only the extensions you want. +Note: The DB_File module will only work with version 1.x of +Berkeley DB. Once Berkeley DB version 2 is released, DB_File will be +upgraded to work with it. Configure will automatically detect this +for you and refuse to try to build DB_File with version 2. + Finally, if you have dynamic loading (most modern Unix systems do) remember that these extensions do not increase the size of your perl executable, nor do they impact start-up time, so you probably might as @@ -193,15 +218,15 @@ Perl5 comes with interfaces to number of database extensions, including dbm, ndbm, gdbm, and Berkeley db. For each extension, if Configure can find the appropriate header files and libraries, it will automatically include that extension. The gdbm and db libraries -are B<not> included with perl. See the library documentation for +are not included with perl. See the library documentation for how to obtain the libraries. -I<Note:> If your database header (.h) files are not in a +Note: If your database header (.h) files are not in a directory normally searched by your C compiler, then you will need to -include the appropriate B<-I/your/directory> option when prompted by +include the appropriate -I/your/directory option when prompted by Configure. If your database library (.a) files are not in a directory normally searched by your C compiler and linker, then you will need to -include the appropriate B<-L/your/directory> option when prompted by +include the appropriate -L/your/directory option when prompted by Configure. See the examples below. =head2 Examples @@ -211,20 +236,20 @@ Configure. See the examples below. =item gdbm in /usr/local Suppose you have gdbm and want Configure to find it and build the -GDBM_File extension. This examples assumes you have F<gdbm.h> -installed in F</usr/local/include/gdbm.h> and F<libgdbm.a> installed in -F</usr/local/lib/libgdbm.a>. Configure should figure all the +GDBM_File extension. This examples assumes you have gdbm.h +installed in /usr/local/include/gdbm.h and libgdbm.a installed in +/usr/local/lib/libgdbm.a. Configure should figure all the necessary steps out automatically. Specifically, when Configure prompts you for flags for -your C compiler, you should include C<-I/usr/local/include>. +your C compiler, you should include -I/usr/local/include. When Configure prompts you for linker flags, you should include -C<-L/usr/local/lib>. +-L/usr/local/lib. If you are using dynamic loading, then when Configure prompts you for linker flags for dynamic loading, you should again include -C<-L/usr/local/lib>. +-L/usr/local/lib. Again, this should all happen automatically. If you want to accept the defaults for all the questions and have Configure print out only terse @@ -241,11 +266,11 @@ This should actually work if you have gdbm installed in any of Suppose you have gdbm installed in some place other than /usr/local/, but you still want Configure to find it. To be specific, assume you -have F</usr/you/include/gdbm.h> and F</usr/you/lib/libgdbm.a>. You -still have to add B<-I/usr/you/include> to cc flags, but you have to take -an extra step to help Configure find F<libgdbm.a>. Specifically, when +have /usr/you/include/gdbm.h and /usr/you/lib/libgdbm.a. You +still have to add -I/usr/you/include to cc flags, but you have to take +an extra step to help Configure find libgdbm.a. Specifically, when Configure prompts you for library directories, you have to add -F</usr/you/lib> to the list. +/usr/you/lib to the list. It is possible to specify this from the command line too (all on one line): @@ -254,13 +279,13 @@ line): -Dlocincpth="/usr/you/include" \ -Dloclibpth="/usr/you/lib" -C<locincpth> is a space-separated list of include directories to search. -Configure will automatically add the appropriate B<-I> directives. +locincpth is a space-separated list of include directories to search. +Configure will automatically add the appropriate -I directives. -C<loclibpth> is a space-separated list of library directories to search. -Configure will automatically add the appropriate B<-L> directives. If -you have some libraries under F</usr/local/> and others under -F</usr/you>, then you have to include both, namely +loclibpth is a space-separated list of library directories to search. +Configure will automatically add the appropriate -L directives. If +you have some libraries under /usr/local/ and others under +/usr/you, then you have to include both, namely sh Configure -des \ -Dlocincpth="/usr/you/include /usr/local/include" \ @@ -274,6 +299,11 @@ The installation directories can all be changed by answering the appropriate questions in Configure. For convenience, all the installation questions are near the beginning of Configure. +It is highly recommend that you running Configure interactively +to be sure it puts everything where you want it. At any point +during the Configure process, you can answer a question with +C<&-d> and Configure will use the defaults from then on. + By default, Configure uses the following directories for library files (archname is a string like sun4-sunos, determined by Configure) @@ -294,7 +324,17 @@ instead.) The module man pages are stuck in that strange spot so that they don't collide with other man pages stored in /usr/local/man/man3, and so that Perl's man pages don't hide system man pages. On some systems, B<man less> would end up calling up Perl's less.pm module man -page, rather than the B<less> program. +page, rather than the less program. (This location may change in a +future release of perl.) + +Note: Many users prefer to store the module man pages in +/usr/local/man/man3. You can do this from the command line with + + sh Configure -Dman3dir=/usr/local/man/man3 + +Some users also prefer to use a .3pm suffix. You can do that with + + sh Configure -Dman3ext=3pm If you specify a prefix that contains the string "perl", then the directory structure is simplified. For example, if you Configure with @@ -334,18 +374,18 @@ Configure distinguishes between the directory in which perl (and its associated files) should be installed and the directory in which it will eventually reside. For most sites, these two are the same; for sites that use AFS, this distinction is handled automatically. -However, sites that use software such as B<depot> to manage software +However, sites that use software such as depot to manage software packages may also wish to install perl into a different directory and use that management software to move perl to its final destination. This section describes how to do this. Someday, Configure may support an option -Dinstallprefix=/foo to simplify this. -Suppose you want to install perl under the F</tmp/perl5> directory. -You can edit F<config.sh> and change all the install* variables to -point to F</tmp/perl5> instead of F</usr/local/wherever>. You could +Suppose you want to install perl under the /tmp/perl5 directory. +You can edit config.sh and change all the install* variables to +point to /tmp/perl5 instead of /usr/local/wherever. You could also set them all from the Configure command line. Or, you can automate this process by placing the following lines in a file -F<config.over> B<before> you run Configure (replace /tmp/perl5 by a +config.over before you run Configure (replace /tmp/perl5 by a directory of your choice): installprefix=/tmp/perl5 @@ -411,20 +451,24 @@ automatically). You can turn off this namespace protection by adding Perl 5.003's namespace protection was incomplete, but this has been fixed in 5.004. However, some sites may need to maintain complete binary compatibility with Perl 5.003. If you are building -Perl for such a site, then when B<Configure> asks if you want binary +Perl for such a site, then when Configure asks if you want binary compatibility, answer "y". On the other hand, if you are embedding perl into another application and want the maximum namespace protection, then you probably ought to -answer "n" when B<Configure> asks if you want binary compatibility. +answer "n" when Configure asks if you want binary compatibility. The default answer of "y" to maintain binary compatibility is probably appropriate for almost everyone. +In a related issue, old extensions may possibly be affected by the changes +in the Perl language in the current release. Please see pod/perldelta for +a description of what's changed. + =head2 Selecting File IO mechanisms Previous versions of perl used the standard IO mechanisms as defined in -<stdio.h>. Versions 5.003_02 and later of perl allow alternate IO +stdio.h. Versions 5.003_02 and later of perl allow alternate IO mechanisms via a "PerlIO" abstraction, but the stdio mechanism is still the default and is the only supported mechanism. @@ -444,7 +488,7 @@ everywhere. =item 1. -AT&T's "sfio". This has superior performance to <stdio.h> in many +AT&T's "sfio". This has superior performance to stdio.h in many cases, and is extensible by the use of "discipline" modules. Sfio currently only builds on a subset of the UNIX platforms perl supports. Because the data structures are completely different from stdio, perl @@ -463,8 +507,8 @@ If you have already selected -Duseperlio, and if Configure detects that you have sfio, then sfio will be the default suggested by Configure. -I<Note:> On some systems, sfio's B<iffe> configuration script fails -to detect that you have an C<atexit> function (or equivalent). +Note: On some systems, sfio's iffe configuration script fails +to detect that you have an atexit function (or equivalent). Apparently, this is a problem at least for some versions of Linux and SunOS 4. @@ -609,19 +653,19 @@ or you can answer 'n' at the appropriate interactive Configure prompt. =head2 Malloc Performance Flags If you are using Perl's malloc, you may add one or -more of the following items to your C<cflags> config.sh variable +more of the following items to your cflags config.sh variable to change its behavior in potentially useful ways. You can find out -more about these flags by reading the F<malloc.c> source. +more about these flags by reading the malloc.c source. In a future version of perl, these might be enabled by default. =over 4 =item -DDEBUGGING_MSTATS -If C<DEBUGGING_MSTATS> is defined, you can extract malloc +If DEBUGGING_MSTATS is defined, you can extract malloc statistics from the Perl interpreter. The overhead this imposes is not large (perl just twiddles integers at malloc/free/sbrk time). When you -run perl with the environment variable C<PERL_DEBUG_MSTATS> set to +run perl with the environment variable PERL_DEBUG_MSTATS set to either 1 or 2, the interpreter will dump statistics to stderr at exit time and (with a value of 2) after compilation. If you install the Devel::Peek module you can get the statistics whenever you like by @@ -629,24 +673,24 @@ invoking its mstat() function. =item -DEMERGENCY_SBRK -If C<EMERGENCY_SBRK> is defined, running out of memory need not be a +If EMERGENCY_SBRK is defined, running out of memory need not be a fatal error: a memory pool can allocated by assigning to the special -variable C<$^M>. See L<perlvar> for more details. +variable $^M. See perlvar(1) for more details. =item -DPACK_MALLOC -If C<PACK_MALLOC> is defined, malloc.c uses a slightly different +If PACK_MALLOC is defined, malloc.c uses a slightly different algorithm for small allocations (up to 64 bytes long). Such small allocations are quite common in typical Perl scripts. -The expected memory savings (with 8-byte alignment in C<alignbytes>) is +The expected memory savings (with 8-byte alignment in $alignbytes) is about 20% for typical Perl usage. The expected slowdown due to the additional malloc overhead is in fractions of a percent. (It is hard to measure because of the effect of the saved memory on speed). =item -DTWO_POT_OPTIMIZE -If C<TWO_POT_OPTIMIZE> is defined, malloc.c uses a slightly different +If TWO_POT_OPTIMIZE is defined, malloc.c uses a slightly different algorithm for large allocations that are close to a power of two (starting with 16K). Such allocations are typical for big hashes and special-purpose scripts, especially image processing. If you will be @@ -662,16 +706,25 @@ negligible. =head2 Building a debugging perl You can run perl scripts under the perl debugger at any time with -B<perl -d>. If, however, you want to debug perl itself, +B<perl -d your_script>. If, however, you want to debug perl itself, you probably want to do sh Configure -Doptimize='-g' -This will do two things: First, it will force compilation to use -B<cc -g> so that you can use your system's debugger on the executable. -Second, it will add a C<-DDEBUGGING> to your ccflags variable in -F<config.sh> so that you can use B<perl -D> to access perl's internal -state. +This will do two independent things: First, it will force compilation +to use cc -g so that you can use your system's debugger on the +executable. (Note: Your system may actually require something like +cc -g2. Check you man pages for cc(1) and also any hint file for your +system.) Second, it will add -DDEBUGGING to your ccflags variable in +config.sh so that you can use B<perl -D> to access perl's internal +state. (Note: Configure will only add -DDEBUGGING by +default if you are not reusing your old config.sh. If you want to +reuse your old config.sh, then you can just edit it and change the +optimize and ccflags variables by hand and then propagate your changes +as shown in L<"Propagating your changes to config.sh"> below.) + +You can actually specify -g and -DDEBUGGING independently, but usually +it's convenient to have both. If you are using a shared libperl, see the warnings about multiple versions of perl under L<Building a shared libperl.so Perl library>. @@ -680,7 +733,7 @@ versions of perl under L<Building a shared libperl.so Perl library>. For most users, all of the Configure defaults are fine. However, you can change a number of factors in the way perl is built -by adding appropriate B<-D> directives to your ccflags variable in +by adding appropriate -D directives to your ccflags variable in config.sh. For example, you can replace the rand() and srand() functions in the @@ -689,9 +742,14 @@ following: sh Configure -Dccflags='-Drand=random -Dsrand=srandom' -or by adding C<-Drand=random> and C<-Dsrandom=srandom> to your ccflags -at the appropriate Configure prompt. (You may also have to adjust -Configure's guess for 'randbits' as well.) +or by adding -Drand=random and -Dsrand=srandom to your ccflags +at the appropriate Configure prompt. (Note: Although this worked for +me, it might not work for you if your system's header files give +different prototypes for rand() and random() or srand() and srandom().) + +You should also run Configure interactively to verify that a hint file +doesn't inadvertently override your ccflags setting. (Hints files +shouldn't do that, but some might.) =head2 What if it doesn't work? @@ -705,7 +763,7 @@ guesses. All the installation questions have been moved to the top, so you don't have to wait for them. Once you've handled them (and your C compiler and -flags) you can type C<&-d> at the next Configure prompt and Configure +flags) you can type &-d at the next Configure prompt and Configure will use the defaults from then on. If you find yourself trying obscure command line incantations and @@ -720,7 +778,7 @@ will offer to use that hint file. Several of the hint files contain additional important information. If you have any problems, it is a good idea to read the relevant hint -file for further information. See F<hints/solaris_2.sh> for an +file for further information. See hints/solaris_2.sh for an extensive example. =item *** WHOA THERE!!! *** @@ -752,25 +810,28 @@ Now, Configure will find your gdbm library and will issue a message: The previous value for $i_gdbm on this machine was "undef"! Keep the previous value? [y] -In this case, you do I<not> want to keep the previous value, so you +In this case, you do not want to keep the previous value, so you should answer 'n'. (You'll also have to manually add GDBM_File to the list of dynamic extensions to build.) =item Changing Compilers If you change compilers or make other significant changes, you should -probably I<not> re-use your old config.sh. Simply remove it or +probably not re-use your old config.sh. Simply remove it or rename it, e.g. mv config.sh config.sh.old. Then rerun Configure with the options you want to use. -This is a common source of problems. If you change from B<cc> to -B<gcc>, you should almost always remove your old config.sh. +This is a common source of problems. If you change from cc to +gcc, you should almost always remove your old config.sh. =item Propagating your changes to config.sh -If you make any changes to F<config.sh>, you should propagate -them to all the .SH files by running B<sh Configure -S>. You will -then have to rebuild by running +If you make any changes to config.sh, you should propagate +them to all the .SH files by running + + sh Configure -S + +You will then have to rebuild by running make depend make @@ -785,26 +846,29 @@ L<"Changing the installation directory"> for an example. =item config.h -Many of the system dependencies are contained in F<config.h>. -F<Configure> builds F<config.h> by running the F<config_h.SH> script. -The values for the variables are taken from F<config.sh>. +Many of the system dependencies are contained in config.h. +Configure builds config.h by running the config_h.SH script. +The values for the variables are taken from config.sh. -If there are any problems, you can edit F<config.h> directly. Beware, -though, that the next time you run B<Configure>, your changes will be +If there are any problems, you can edit config.h directly. Beware, +though, that the next time you run Configure, your changes will be lost. =item cflags If you have any additional changes to make to the C compiler command -line, they can be made in F<cflags.SH>. For instance, to turn off the -optimizer on F<toke.c>, find the line in the switch structure for -F<toke.c> and put the command C<optimize='-g'> before the C<;;>. You -can also edit F<cflags> directly, but beware that your changes will be -lost the next time you run B<Configure>. +line, they can be made in cflags.SH. For instance, to turn off the +optimizer on toke.c, find the line in the switch structure for +toke.c and put the command optimize='-g' before the ;; . You +can also edit cflags directly, but beware that your changes will be +lost the next time you run Configure. -To change the C flags for all the files, edit F<config.sh> -and change either C<$ccflags> or C<$optimize>, -and then re-run B<sh Configure -S ; make depend>. +To change the C flags for all the files, edit config.sh +and change either $ccflags or $optimize, +and then re-run + + sh Configure -S + make depend =item No sh @@ -816,12 +880,12 @@ mechanism. =item Porting information Specific information for the OS/2, Plan9, VMS and Win32 ports is in the -corresponding subdirectories. Additional information, including -a glossary of all those config.sh variables, is in the Porting +corresponding README files and subdirectories. Additional information, +including a glossary of all those config.sh variables, is in the Porting subdirectory. Ports for other systems may also be available. You should check out -L<"http://www.perl.com/CPAN/ports"> for current information on ports to +http://www.perl.com/CPAN/ports for current information on ports to various other operating systems. =back @@ -829,11 +893,11 @@ various other operating systems. =head1 make depend This will look for all the includes. -The output is stored in F<makefile>. The only difference between -F<Makefile> and F<makefile> is the dependencies at the bottom of -F<makefile>. If you have to make any changes, you should edit -F<makefile>, not F<Makefile> since the Unix B<make> command reads -F<makefile> first. (On non-Unix systems, the output may be stored in +The output is stored in makefile. The only difference between +Makefile and makefile is the dependencies at the bottom of +makefile. If you have to make any changes, you should edit +makefile, not Makefile since the Unix make command reads +makefile first. (On non-Unix systems, the output may be stored in a different file. Check the value of $firstmakefile in your config.sh if in doubt.) @@ -853,14 +917,14 @@ See L<"Reporting Problems"> below. =over 4 -=item * +=item hints If you used a hint file, try reading the comments in the hint file for further tips and information. -=item * +=item extensions -If you can successfully build F<miniperl>, but the process crashes +If you can successfully build miniperl, but the process crashes during the building of extensions, you should run make minitest @@ -874,7 +938,7 @@ unsetting them. I have some reports that some versions of IRIX hang while running B<./miniperl configpm> with locales other than the C locale. See the discussion under L<make test> below about locales. -=item * +=item malloc duplicates If you get duplicates upon linking for malloc et al, add -DHIDEMYMALLOC or -DEMBEDMYMALLOC to your ccflags variable in config.sh. @@ -889,7 +953,7 @@ forget to propagate your changes (see L<"Propagating your changes to config.sh"> below). See also the L<"vsprintf"> item below. -=item * +=item croak If you get error messages such as the following (the exact line numbers will vary in different versions of perl): @@ -905,11 +969,11 @@ previous L<"varargs"> item. If you have problems with dynamic loading using gcc on SunOS or Solaris, and you are using GNU as and GNU ld, you may need to add -B<-B/bin/> (for SunOS) or B<-B/usr/ccs/bin/> (for Solaris) to your +-B/bin/ (for SunOS) or -B/usr/ccs/bin/ (for Solaris) to your $ccflags, $ldflags, and $lddlflags so that the system's versions of as and ld are used. Alternatively, you can use the GCC_EXEC_PREFIX environment variable to ensure that Sun's as and ld are used. Consult -your gcc documentation for further information on the B<-B> option and +your gcc documentation for further information on the -B option and the GCC_EXEC_PREFIX variable. =item ld.so.1: ./perl: fatal: relocation error: @@ -918,7 +982,7 @@ If you get this message on SunOS or Solaris, and you're using gcc, it's probably the GNU as or GNU ld problem in the previous item L<"Solaris and SunOS dynamic loading">. -=item * +=item LD_LIBRARY_PATH If you run into dynamic loading problems, check your setting of the LD_LIBRARY_PATH environment variable. If you're creating a static @@ -947,7 +1011,7 @@ with sh Configure -Uusenm or by answering the nm extraction question interactively. -If you have previously run Configure, you should I<not> reuse your old +If you have previously run Configure, you should not reuse your old config.sh. =item vsprintf @@ -964,6 +1028,13 @@ If Configure guessed wrong, it is likely that Configure guessed wrong on a number of other common functions too. You are probably better off re-running Configure without using nm extraction (see previous item). +=item do_aspawn + +If you run into problems relating to do_aspawn or do_spawn, the +problem is probably that Configure failed to detect your system's +fork() function. Follow the procedure in the previous items +on L<"vsprintf"> and L<"nm extraction">. + =item Optimizer If you can't compile successfully, try turning off your compiler's @@ -978,9 +1049,9 @@ to something like then propagate your changes with B<sh Configure -S> and rebuild with B<make depend; make>. -=item * +=item CRIPPLED_CC -If you still can't compile successfully, try adding a C<-DCRIPPLED_CC> +If you still can't compile successfully, try adding a -DCRIPPLED_CC flag. (Just because you get no errors doesn't mean it compiled right!) This simplifies some complicated expressions for compilers that get indigestion easily. @@ -992,13 +1063,13 @@ other, or you need to undefine some feature that Configure thought was there but is defective or incomplete. Look through config.h for likely suspects. -=item * +=item toke.c -Some compilers will not compile or optimize the larger files without -some extra switches to use larger jump offsets or allocate larger -internal tables. You can customize the switches for each file in -F<cflags>. It's okay to insert rules for specific files into -F<makefile> since a default rule only takes effect in the absence of a +Some compilers will not compile or optimize the larger files (such as +toke.c) without some extra switches to use larger jump offsets or +allocate larger internal tables. You can customize the switches for +each file in cflags. It's okay to insert rules for specific files into +makefile since a default rule only takes effect in the absence of a specific rule. =item Missing dbmclose @@ -1037,7 +1108,7 @@ quite that tightly coordinated. This is a message from your shell telling you that the command 'ar' was not found. You need to check your PATH environment variable to make sure that it includes the directory with the 'ar' command. This -is a common problem on Solaris, where 'ar' is in the F</usr/ccs/bin> +is a common problem on Solaris, where 'ar' is in the /usr/ccs/bin directory. =item db-recno failure on tests 51, 53 and 55 @@ -1046,7 +1117,7 @@ Old versions of the DB library (including the DB library which comes with FreeBSD 2.1) had broken handling of recno databases with modified bval settings. Upgrade your DB library or OS. -=item * +=item Miscellaneous Some additional things that have been reported for either perl4 or perl5: @@ -1054,7 +1125,7 @@ Genix may need to use libc rather than libc_s, or #undef VARARGS. NCR Tower 32 (OS 2.01.01) may need -W2,-Sl,2000 and #undef MKDIR. -UTS may need one or more of -DCRIPPLED_CC, B<-K> or B<-g>, and undef LSTAT. +UTS may need one or more of -DCRIPPLED_CC, -K or -g, and undef LSTAT. If you get syntax errors on '(', try -DCRIPPLED_CC. @@ -1066,31 +1137,31 @@ Machines with half-implemented dbm routines will need to #undef I_ODBM This will run the regression tests on the perl you just made. If it doesn't say "All tests successful" then something went wrong. See the -file F<t/README> in the F<t> subdirectory. Note that you can't run the +file t/README in the t subdirectory. Note that you can't run the tests in background if this disables opening of /dev/tty. -If B<make test> bombs out, just B<cd> to the F<t> directory and run -F<./TEST> by hand to see if it makes any difference. If individual tests +If make test bombs out, just cd to the t directory and run ./TEST +by hand to see if it makes any difference. If individual tests bomb, you can run them by hand, e.g., ./perl op/groups.t Another way to get more detailed information about failed tests and -individual subtests is to B<cd> to the F<t> directory and run +individual subtests is to cd to the t directory and run ./perl harness -(this assumes that I<most> tests succeed, since F<harness> uses +(this assumes that most tests succeed, since harness uses complicated constructs). You can also read the individual tests to see if there are any helpful comments that apply to your system. -B<Note>: One possible reason for errors is that some external programs +Note: One possible reason for errors is that some external programs may be broken due to the combination of your environment and the way -C<make test> exercises them. For example, this may happen if you have -one or more of these environment variables set: C<LC_ALL LC_CTYPE -LC_COLLATE LANG>. In some versions of UNIX, the non-English locales +B<make test> exercises them. For example, this may happen if you have +one or more of these environment variables set: LC_ALL LC_CTYPE +LC_COLLATE LANG. In some versions of UNIX, the non-English locales are known to cause programs to exhibit mysterious errors. If you have any of the above environment variables set, please try @@ -1101,18 +1172,18 @@ If you have any of the above environment variables set, please try LC_ALL=C;export LC_ALL -for Bourne or Korn shell) from the command line and then retry C<make -test>. If the tests then succeed, you may have a broken program that +for Bourne or Korn shell) from the command line and then retry +make test. If the tests then succeed, you may have a broken program that is confusing the testing. Please run the troublesome test by hand as shown above and see whether you can locate the program. Look for -things like: C<exec, `backquoted command`, system, open("|...")> or -C<open("...|")>. All these mean that Perl is trying to run some +things like: exec, `backquoted command`, system, open("|...") or +open("...|"). All these mean that Perl is trying to run some external program. =head1 make install This will put perl into the public directory you specified to -B<Configure>; by default this is F</usr/local/bin>. It will also try +Configure; by default this is /usr/local/bin. It will also try to put the man pages in a reasonable place. It will not nroff the man pages, however. You may need to be root to run B<make install>. If you are not root, you must own the directories in question and you should @@ -1124,7 +1195,7 @@ anything, you can run ./perl installperl -n ./perl installman -n -B<make install> will install the following: +make install will install the following: perl, perl5.nnn where nnn is the current release number. This @@ -1179,26 +1250,30 @@ need to install the current version in a separate directory tree, since some of the architecture-independent library files have changed in incompatible ways. -The architecture-dependent files are stored in a version-specific -directory (such as F</usr/local/lib/perl5/sun4-sunos/5.004>) so that -they are still accessible. I<Note:> Perl 5.000 and 5.001 did not -put their architecture-dependent libraries in a version-specific -directory. They are simply in F</usr/local/lib/perl5/$archname>. If -you will not be using 5.000 or 5.001, you may safely remove those -files. - -The standard library files in F</usr/local/lib/perl5> -should be usable by all versions of perl5. +The old architecture-dependent files are stored in a version-specific +directory (such as /usr/local/lib/perl5/sun4-sunos/5.003) so that they +will still be accessible even after a later version is installed. +(Note: Perl 5.000 and 5.001 did not put their architecture-dependent +libraries in a version-specific directory. They are simply in +/usr/local/lib/perl5/$archname. If you will not be using 5.000 or +5.001, you may safely remove those files.) + +In general, the standard library files in /usr/local/lib/perl5 should +be usable by all versions of perl5. However, the diagnostics.pm module +uses the /usr/local/lib/perl5/pod/perldiag.pod documentation file, so +the C<use diagnostics;> pragma and the splain script will only identify +and explain any warnings or errors that the most recently-installed +version of perl can generate. Most extensions will probably not need to be recompiled to use with a newer version of perl. If you do run into problems, and you want to continue to use the old version of perl along with your extension, simply move those extension files to the appropriate version directory, such as -F</usr/local/lib/perl/archname/5.003>. Then Perl 5.003 will find your +/usr/local/lib/perl/archname/5.003. Then Perl 5.003 will find your files in the 5.003 directory, and newer versions of perl will find your newer extension in the site_perl directory. -Some users may prefer to keep all versions of perl in completely +Many users prefer to keep all versions of perl in completely separate directories. One convenient way to do this is by using a separate prefix for each version, such as @@ -1212,14 +1287,14 @@ scripts can still start with #!/usr/local/bin/perl. You can safely install perl5 even if you want to keep perl4 around. -By default, the perl5 libraries go into F</usr/local/lib/perl5/>, so -they don't override the perl4 libraries in F</usr/local/lib/perl/>. +By default, the perl5 libraries go into /usr/local/lib/perl5/, so +they don't override the perl4 libraries in /usr/local/lib/perl/. In your /usr/local/bin directory, you should have a binary named -F<perl4.036>. That will not be touched by the perl5 installation +perl4.036. That will not be touched by the perl5 installation process. Most perl4 scripts should run just fine under perl5. However, if you have any scripts that require perl4, you can replace -the C<#!> line at the top of them by C<#!/usr/local/bin/perl4.036> +the #! line at the top of them by #!/usr/local/bin/perl4.036 (or whatever the appropriate pathname is). See pod/perltrap.pod for possible problems running perl4 scripts under perl5. @@ -1227,14 +1302,14 @@ for possible problems running perl4 scripts under perl5. Some perl scripts need to be able to obtain information from the system header files. This command will convert the most commonly used -header files in F</usr/include> into files that can be easily interpreted +header files in /usr/include into files that can be easily interpreted by perl. These files will be placed in the architectural library directory -you specified to B<Configure>; by default this is -F</usr/local/lib/perl5/ARCH/VERSION>, where B<ARCH> is your architecture -(such as C<sun4-solaris>) and B<VERSION> is the version of perl you are -building (for example, C<5.004>). +you specified to Configure; by default this is +/usr/local/lib/perl5/ARCH/VERSION, where ARCH is your architecture +(such as sun4-solaris) and VERSION is the version of perl you are +building (for example, 5.004). -B<Note:> Due to differences in the C and perl languages, the +Note: Due to differences in the C and perl languages, the conversion of the header files is not perfect. You will probably have to hand-edit some of the converted files to get them to parse correctly. For example, h2ph breaks spectacularly on type casting and @@ -1264,12 +1339,12 @@ manual pages on your system doesn't help either, then you should send a message to either the comp.lang.perl.misc newsgroup or to perlbug@perl.com with an accurate description of your problem. -Please include the I<output> of the B<./myconfig> shell script +Please include the output of the ./myconfig shell script that comes with the distribution. Alternatively, you can use the -B<perlbug> program that comes with the perl distribution, +perlbug program that comes with the perl distribution, but you need to have perl compiled and installed before you can use it. -You might also find helpful information in the F<Porting> +You might also find helpful information in the Porting directory of the perl distribution. =head1 DOCUMENTATION @@ -1277,11 +1352,11 @@ directory of the perl distribution. Read the manual entries before running perl. The main documentation is in the pod/ subdirectory and should have been installed during the build process. Type B<man perl> to get started. Alternatively, you -can type B<perldoc perl> to use the supplied B<perldoc> script. This +can type B<perldoc perl> to use the supplied perldoc script. This is sometimes useful for finding things in the library modules. -Under UNIX, you can produce a documentation book in postscript form -along with its I<Table of Contents> by going to the pod/ subdirectory +Under UNIX, you can produce a documentation book in postscript form, +along with its table of contents, by going to the pod/ subdirectory and running (either): ./roffitall -groff # If you have GNU groff installed @@ -1297,9 +1372,10 @@ generate the documentation. =head1 AUTHOR -Andy Dougherty <doughera@lafcol.lafayette.edu>, borrowing I<very> heavily -from the original README by Larry Wall. +Andy Dougherty doughera@lafcol.lafayette.edu , borrowing very heavily +from the original README by Larry Wall, and also with lots of helpful +feedback from the perl5-porters@perl.org folks. =head1 LAST MODIFIED -$Id: INSTALL,v 1.8 1997/03/21 16:21:53 doughera Released $ +$Id: INSTALL,v 1.13 1997/04/03 18:29:14 doughera Released $ @@ -17,6 +17,7 @@ Porting/Glossary Glossary of config.sh variables Porting/pumpkin.pod Guidelines and hints for Perl maintainers README The Instructions README.amiga Notes about AmigaOS port +README.cygwin32 Notes about Cygwin32 port README.os2 Notes about OS/2 port README.plan9 Notes about Plan9 port README.qnx Notes about QNX port @@ -33,6 +34,11 @@ config_h.SH Produces config.h configpm Produces lib/Config.pm cop.h Control operator header cv.h Code value header +cygwin32/cw32imp.h Cygwin32 port +cygwin32/gcc2 Cygwin32 port +cygwin32/ld2 Cygwin32 port +cygwin32/perlgcc Cygwin32 port +cygwin32/perlld Cygwin32 port deb.c Debugging routines doio.c I/O operations doop.c Support code for various operations @@ -40,6 +46,24 @@ dosish.h Some defines for MS/DOSish machines dump.c Debugging output eg/ADB An adb wrapper to put in your crash dir eg/README Intro to example perl scripts +eg/cgi/RunMeFirst Setup script for CGI examples +eg/cgi/clickable_image.cgi CGI example +eg/cgi/cookie.cgi CGI example +eg/cgi/crash.cgi CGI example +eg/cgi/customize.cgi CGI example +eg/cgi/diff_upload.cgi CGI example +eg/cgi/file_upload.cgi CGI example +eg/cgi/frameset.cgi CGI example +eg/cgi/index.html Index page for CGI examples +eg/cgi/internal_links.cgi CGI example +eg/cgi/javascript.cgi CGI example +eg/cgi/monty.cgi CGI example +eg/cgi/multiple_forms.cgi CGI example +eg/cgi/nph-clock.cgi CGI example +eg/cgi/popup.cgi CGI example +eg/cgi/save_state.cgi CGI example +eg/cgi/tryit.cgi CGI example +eg/cgi/wilogo.gif.uu Small image for CGI examples eg/changes A program to list recently changed files eg/client A sample client eg/down A program to do things to subdirectories @@ -94,6 +118,7 @@ ext/DynaLoader/DynaLoader.pm Dynamic Loader perl module ext/DynaLoader/Makefile.PL Dynamic Loader makefile writer ext/DynaLoader/README Dynamic Loader notes and intro ext/DynaLoader/dl_aix.xs AIX implementation +ext/DynaLoader/dl_cygwin32.xs Cygwin32 implementation ext/DynaLoader/dl_dld.xs GNU dld style implementation ext/DynaLoader/dl_dlopen.xs BSD/SunOS4&5 dlopen() style implementation ext/DynaLoader/dl_hpux.xs HP-UX implementation @@ -213,6 +238,7 @@ hints/broken-db.msg Warning message for systems with broken DB library hints/bsdos.sh Hints for named architecture hints/convexos.sh Hints for named architecture hints/cxux.sh Hints for named architecture +hints/cygwin32.sh Hints for named architecture hints/dcosx.sh Hints for named architecture hints/dec_osf.sh Hints for named architecture hints/dgux.sh Hints for named architecture @@ -272,6 +298,7 @@ hints/utekv.sh Hints for named architecture hints/uts.sh Hints for named architecture hv.c Hash value code hv.h Hash value header +installhtml Perl script to install html files for pods installman Perl script to install man pages for pods installperl Perl script to do "make install" dirty work interp.sym Interpreter specific symbols to hide in a struct @@ -282,6 +309,12 @@ lib/AutoLoader.pm Autoloader base class lib/AutoSplit.pm Split up autoload functions lib/Benchmark.pm Measure execution time lib/Bundle/CPAN.pm The CPAN bundle +lib/CGI.pm Web server interface +lib/CGI/Apache.pm Web server interface +lib/CGI/Carp.pm Web server interface +lib/CGI/Fast.pm Web server interface +lib/CGI/Push.pm Web server interface +lib/CGI/Switch.pm Web server interface lib/CPAN.pm Interface to Comprehensive Perl Archive Network lib/CPAN/FirstTime.pm Utility for creating CPAN config files lib/CPAN/Nox.pm Runs CPAN while avoiding compiled extensions @@ -326,12 +359,14 @@ lib/IPC/Open3.pm Open a three-ended pipe! lib/Math/BigFloat.pm An arbitrary precision floating-point arithmetic package lib/Math/BigInt.pm An arbitrary precision integer arithmetic package lib/Math/Complex.pm A Complex package +lib/Math/Trig.pm A simple interface to complex trigonometry lib/Net/Ping.pm Hello, anybody home? lib/Net/hostent.pm By-name interface to Perl's built-in gethost* lib/Net/netent.pm By-name interface to Perl's built-in getnet* lib/Net/protoent.pm By-name interface to Perl's built-in getproto* lib/Net/servent.pm By-name interface to Perl's built-in getserv* lib/Pod/Functions.pm used by pod/splitpod +lib/Pod/Html.pm Convert POD data to HTML lib/Pod/Text.pm Convert POD data to formatted ASCII text lib/Search/Dict.pm Perform binary search on dictionaries lib/SelectSaver.pm Enforce proper select scoping @@ -368,9 +403,8 @@ lib/bigint.pl An arbitrary precision integer arithmetic package lib/bigrat.pl An arbitrary precision rational arithmetic package lib/blib.pm For "use blib" lib/cacheout.pl Manages output filehandles when you need too many -lib/chat2.inter A chat2 with interaction -lib/chat2.pl Randal's famous expect-ish routines lib/complete.pl A command completion subroutine +lib/constant.pm For "use constant" lib/ctime.pl A ctime workalike lib/diagnostics.pm Print verbose diagnostics lib/dotsh.pl Code to "dot" in a shell script @@ -651,7 +685,9 @@ t/lib/symbol.t See if Symbol works t/lib/texttabs.t See if Text::Tabs works t/lib/textwrap.t See if Text::Wrap works t/lib/timelocal.t See if Time::Local works +t/lib/trig.t See if Math::Trig works t/op/append.t See if . works +t/op/arith.t See if arithmetic works t/op/array.t See if array operations work t/op/assignwarn.t See if OP= operators warn correctly for undef targets t/op/auto.t See if autoincrement et all work @@ -716,6 +752,7 @@ t/op/universal.t See if UNIVERSAL class works t/op/unshift.t See if unshift works t/op/vec.t See if vectors work t/op/write.t See if write works +t/pragma/constant.t See if compile-time constants work t/pragma/locale.t See if locale support (i18n and l10n) works t/pragma/overload.t See if operator overloading works t/pragma/strict-refs Tests of "use strict 'refs'" for strict.t @@ -773,7 +810,6 @@ vms/vms.c VMS-specific C code for Perl core vms/vms_yfix.pl convert Unix perly.[ch] to VMS perly_[ch].vms vms/vmsish.h VMS-specific C header for Perl core vms/writemain.pl Generate perlmain.c from miniperlmain.c+extensions -win32/EXTERN.h Win32 port win32/Fcntl.mak Win32 port win32/IO.mak Win32 port win32/Makefile Win32 port @@ -781,6 +817,9 @@ win32/Opcode.mak Win32 port win32/SDBM_File.mak Win32 port win32/Socket.mak Win32 port win32/TEST Win32 port +win32/VC-2.0/Fcntl.mak Win32 port +win32/VC-2.0/IO.mak Win32 port +win32/VC-2.0/Opcode.mak Win32 port win32/VC-2.0/SDBM_File.mak Win32 port win32/VC-2.0/Socket.mak Win32 port win32/VC-2.0/libperl.mak Win32 port @@ -788,10 +827,11 @@ win32/VC-2.0/miniperl.mak Win32 port win32/VC-2.0/modules.mak Win32 port win32/VC-2.0/perl.mak Win32 port win32/VC-2.0/perldll.mak Win32 port -win32/VC-2.0/vc2.patch Win32 port +win32/VC-2.0/perlglob.mak Win32 port +win32/VC-2.0/pod.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 @@ -800,7 +840,6 @@ win32/config.H Win32 config header (suffix not ".h" for metaconfig) win32/config.w32 Win32 port win32/dl_win32.xs Win32 port win32/dosish.diff Win32 port -win32/dosish.h Win32 port win32/genxsdef.pl Win32 port win32/include/arpa/inet.h Win32 port win32/include/dirent.h Win32 port @@ -813,11 +852,12 @@ win32/makeperldef.pl Win32 port win32/miniperl.mak Win32 port win32/modules.mak Win32 port win32/perl.mak Win32 port +win32/perl.rc Win32 port win32/perldll.mak Win32 port win32/perlglob.c Win32 port win32/perlglob.mak Win32 port win32/perllib.c Win32 port -win32/perlmain.c Win32 port +win32/pod.mak Win32 port win32/runperl.c Win32 port win32/splittree.pl Win32 port win32/win32.c Win32 port diff --git a/Makefile.SH b/Makefile.SH index d0a16a5158..5beeca0d67 100755 --- a/Makefile.SH +++ b/Makefile.SH @@ -34,7 +34,7 @@ true) -compatibility_version 1 -current_version $(PATCHLEVEL) \ -prebind -seg1addr 0x27000000 -install_name $(SHRPDIR)/$@' ;; - sunos*|freebsd[23]*) + sunos*|freebsd[23]*|netbsd*) linklibperl="-lperl" ;; esac diff --git a/README.amiga b/README.amiga index e4d4071188..55167cb44d 100644 --- a/README.amiga +++ b/README.amiga @@ -56,8 +56,8 @@ You need the Unix emulation for AmigaOS, whose most important part is B<ixemul.library>. For a minimum setup, get the following archives from ftp://ftp.ninemoons.com/pub/ade/current or a mirror: -ixemul-45.1-bin.lha -ixemul-45.1-env-bin.lha +ixemul-46.0-bin.lha +ixemul-46.0-env-bin.lha pdksh-4.9-bin.lha ADE-misc-bin.lha diff --git a/README.cygwin32 b/README.cygwin32 new file mode 100644 index 0000000000..d7950f63d4 --- /dev/null +++ b/README.cygwin32 @@ -0,0 +1,59 @@ +The following assumes you have the GNU-Win32 package, version b17.1 or +later, installed and configured on your system. See +http://www.cygnus.com/misc/gnu-win32/ for details on the GNU-Win32 +project and the Cygwin32 API. + +1) Copy the contents of the cygwin32 directory to the Perl source + root directory. + +2) Modify the ld2 script by making the PERLPATH variable contain the + Perl source root directory. For example, if you extracted perl to + "/perl5.004", change the script so it contains the line: + + PERLPATH=/perl5.004 + +3) Copy the two scripts ld2 and gcc2 from the cygwin32 subdirectory to a + directory in your PATH environment variable. For example, copy to + /bin, assuming /bin is in your PATH. (These two scripts are 'wrapper' + scripts that encapsulate the multiple-pass dll building steps used by + GNU-Win32 ld/gcc.) + +4) Run the perl Configuration script as stated in the perl README file: + + sh Configure + + When confronted with this prompt: + + First time through, eh? I have some defaults handy for the + following systems: + . + . + . + Which of these apply, if any? + + Select "cygwin32". + + The defaults should be OK for everything, except for the specific + pathnames for the cygwin32 libs, include files, installation dirs, + etc. on your system; answer those questions appropriately. + + NOTE: On windows 95, the configuration script only stops every other + time for responses from the command line. In this case you can manually + copy hints/cygwin32.sh to config.sh, edit config.sh for your paths, and + run Configure non-interactively using sh Configure -d. + +5) Run "make" as stated in the perl README file. + +6) Run "make test". Some tests will fail, but you should get around a + 83% success rate. (Most failures seem to be due to Unixisms that don't + apply to win32.) + +7) Install. If you just run "perl installperl", it appears that perl + can't find itself when it forks because it changes to another directory + during the install process. You can get around this by invoking the + install script using a full pathname for perl, such as: + + /perl5.004/perl installperl + + This should complete the installation process. + diff --git a/README.win32 b/README.win32 index 36953ec0da..63763cd33d 100644 --- a/README.win32 +++ b/README.win32 @@ -4,21 +4,26 @@ specially designed to be readable as is. =head1 NAME -perlwin32 - Perl under WindowsNT [XXX and perhaps under Windows95] +perlwin32 - Perl under Win32 =head1 SYNOPSIS These are instructions for building Perl under WindowsNT (versions -3.51 or 4.0), using Visual C++. +3.51 or 4.0), using Visual C++ (versions 2.0 through 5.0). Currently, +this port may also build under Windows95, but you can expect problems +stemming from the unmentionable command shell that infests that +platform. Note this caveat is only about B<building> perl. Once +built, you should be able to B<use> it on either Win32 platform (modulo +the problems arising from the inferior command shell). =head1 DESCRIPTION -Before you start, you should glance through the README file found +Before you start, you should glance through the README file found in the top-level directory where the Perl distribution was extracted. Make sure you read and understand the terms under which this software is being distributed. -Make sure you read the L<BUGS AND CAVEATS> section below for the +Also make sure you read the L<BUGS AND CAVEATS> section below for the known limitations of this port. The INSTALL file in the perl top-level has much information that is @@ -37,7 +42,11 @@ port of Perl to Win32 platforms. The resulting Perl requires no additional software to run (other than what came with your operating system). Currently, this port is only capable of using Microsoft's Visual C++ compiler. The ultimate goal is to support the other major -compilers that can be used on the platforms. +compilers that can be used to build Win32 applications. + +This port currently supports MakeMaker (the set of modules that +is used to build extensions to perl). Therefore, you should be +able to build and install most extensions found in the CPAN sites. =head2 Setting Up @@ -47,7 +56,8 @@ compilers that can be used on the platforms. Use the default "cmd" shell that comes with NT. In particular, do *not* use the 4DOS/NT shell. The Makefile has commands that are not -compatible with that shell. +compatible with that shell. You are mostly on your own if you can +muster the temerity to attempt this with Windows95. =item * @@ -76,8 +86,8 @@ but it doesn't hurt to do so. The "win32" directory contains *.mak files for use with the NMAKE that comes with Visual C++ ver. 4.0 and above. If you wish to build perl -using Visual C++ versions between 2.0 and 4.0, do the following three -additional steps (these three steps are not required if you are +using Visual C++ versions between 2.0 and 4.0, do the following two +additional steps (these steps are not required if you are using Visual C++ versions 4.0 and above): =over 8 @@ -85,9 +95,7 @@ using Visual C++ versions 4.0 and above): =item 1. Overwrite the *.mak files in the win32 subdirectory with the versions -in the win32\VC-2.0 directory. (The only difference in those makefiles -is in how the $(INCLUDE) variable is handled--VC 2.0 NMAKE does not -grok a path list in $(INCLUDE)). +in the win32\VC-2.0 directory. =item 2. @@ -100,15 +108,6 @@ This must have only one directory (a list of directories will not work). VCVARS32.BAT may put multiple locations in there, which is why this step is required. -=item 3. - -Apply the patch found in win32\VC-2.0\vc2.patch, like so: - - cd win32 - patch -p2 -N < VC-2.0\vc2.patch - -You may have to edit win32\win32.c manually if you don't have GNU patch. - =back =item * @@ -139,33 +138,25 @@ PATH environment variable to C:\PERL\BIN (or D:\FOO\PERL\BIN). =head2 Testing Type "nmake test". This will run most of the tests from the -testsuite (many tests will be skipped, and some tests will fail). -Most failures are due to UNIXisms in the standard perl testsuite. +testsuite (many tests will be skipped, and a few tests may fail). -To get a more detailed breakdown of the tests that failed, say: +To get a more detailed breakdown of the tests that failed, +you may want to say: cd ..\t .\perl harness -This should produce a summary very similar to the following: +This should produce a summary of the failed tests. Currently, the +only known failure is lib\findbin.t: Failed Test Status Wstat Total Fail Failed List of failed ------------------------------------------------------------------------------ - io/fs.t 26 16 61.54% 1-5, 7-11, 16-18, 23-25 - io/tell.t 13 1 7.69% 10 - lib/anydbm.t 12 1 8.33% 2 lib/findbin.t 1 1 100.00% 1 - lib/sdbm.t 12 1 8.33% 2 - op/mkdir.t 7 2 28.57% 3, 7 - op/runlevel.t 8 1 12.50% 4 - op/stat.t 56 3 5.36% 3-4, 20 - op/taint.t 98 20 20.41% 1-6, 14, 16, 19-21, 24, 26, 35-3 - pragma/locale.t 98 40 40.82% 1, 13-14, 21-27, 33, 39, 45-53, - Failed 10/149 test scripts, 93.29% okay. 86/3506 subtests failed, 97.55% okay. + Failed 1/151 test scripts, 99.34% okay. 1/3902 subtests failed, 99.97% okay. + Check if any additional tests other than the ones shown here -failed. The standard testsuite will ultimately be modified so -that the testsuite avoids running irrelevant tests on Win32. +failed, and report them as described under L<BUGS AND CAVEATS>. =head1 BUGS AND CAVEATS @@ -173,12 +164,12 @@ This is still very much an experimental port, and should be considered alpha quality software. You can expect changes in virtually all of these areas: build process, installation structure, supported utilities/modules, and supported perl functionality. Specifically, -functionality that supports the Win32 environment may be ultimately +functionality that supports the Win32 environment may ultimately be supported as either core modules or extensions. -Many tests from the standard testsuite either fail or produce different -results under this port. Most of the problems fall under one of these -categories +If you have had prior exposure to Perl on Unix platforms, this port +may exhibit behavior different from what is documented. Most of the +differences fall under one of these categories. =over 8 @@ -191,9 +182,10 @@ platforms, and some fields may be completely bogus. =item * The following functions are currently unavailable: C<fork()>, C<exec()>, -C<dump()>, C<kill()>, C<chown()>, C<link()>, C<symlink()>, C<chroot()>, +C<dump()>, C<chown()>, C<link()>, C<symlink()>, C<chroot()>, C<setpgrp()>, C<getpgrp()>, C<setpriority()>, C<getpriority()>, -C<syscall()>, C<fcntl()>, C<flock()>. This list is possibly incomplete. +C<syscall()>, C<fcntl()>, C<flock()>. This list is possibly very +incomplete. =item * @@ -211,7 +203,10 @@ when used to call interactive commands, is ill-defined. =item * -C<$!> doesn't work reliably yet. +C<$?> ends up with the exitstatus of the subprocess (this is different +from Unix, where the exitstatus is actually given by "$? >> 8"). +Failure to spawn() the subprocess is indicated by setting $? to +"255<<8". This is subject to change. =item * @@ -269,7 +264,7 @@ at the time. Nick Ing-Simmons and Gurusamy Sarathy have made numerous and sundry hacks since then. -Last updated: 19 March 1997 +Last updated: 04 April 1997 =cut @@ -70,8 +70,8 @@ print CONFIG "\n", print CONFIG "my \$summary = <<'!END!';\n"; open(MYCONFIG,"<myconfig") || die "open myconfig failed: $!"; -1 while( ($_=<MYCONFIG>) !~ /^Summary of/); -do { print CONFIG $_ } until ($_ = <MYCONFIG>) =~ /^\s*$/; +1 while defined($_ = <MYCONFIG>) && !/^Summary of/; +do { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/; close(MYCONFIG); print CONFIG "\n!END!\n", <<'EOT'; @@ -265,9 +265,10 @@ struct context { /* "gimme" values */ #define G_SCALAR 0 #define G_ARRAY 1 +#define G_VOID 128 /* skip this bit when adding flags below */ /* extra flags for perl_call_* routines */ #define G_DISCARD 2 /* Call FREETMPS. */ #define G_EVAL 4 /* Assume eval {} around subroutine call. */ #define G_NOARGS 8 /* Don't construct a @_ array. */ -#define G_KEEPERR 16 /* Append errors to $@ rather than overwriting it */ +#define G_KEEPERR 16 /* Append errors to $@, don't overwrite it */ diff --git a/extLibInc.h b/cygwin32/cw32imp.h index 04bf5cad32..1fb11d3e03 100644 --- a/extLibInc.h +++ b/cygwin32/cw32imp.h @@ -1,10 +1,11 @@ -/* include file for building of extension libs using gnuwin32. - This file is included by the extension dlls when they are built. - Global vars defined in perl exe are referenced by the extension module - dll by using __imp_varName, where varName is the name of the global - variable in perl.exe. Gnuwin32 has no equivalent to MSVC's - __declspec(dllimport) keyword to define a imported global, so we have - to use this approach to access globals exported by perl.exe +/* include file for building of extension libs using GNU-Win32 toolkit, + which is based on the Cygnus Cygwin32 API. This file is included by + the extension dlls when they are built. Global vars defined in perl + exe are referenced by the extension module dll by using __imp_varName, + where varName is the name of the global variable in perl.exe. + GNU-Win32 has no equivalent to MSVC's __declspec(dllimport) keyword to + define a imported global, so we have to use this approach to access + globals exported by perl.exe. -jc 4/1/97 */ diff --git a/cygwin32/gcc2 b/cygwin32/gcc2 new file mode 100644 index 0000000000..3da705cdbf --- /dev/null +++ b/cygwin32/gcc2 @@ -0,0 +1,12 @@ +#!/bin/sh +# +# gcc wrapper for building dynamic lib version of perl +# if -buildperl found on command line, then all args passed to +# perlgcc, else pass all args to gcc. +# jc 3/24/97 +# + +case "$*" in +*-buildperl*) miniperl perlgcc "$@" ;; +*) gcc "$@" ;; +esac diff --git a/cygwin32/ld2 b/cygwin32/ld2 new file mode 100644 index 0000000000..9aec8798fe --- /dev/null +++ b/cygwin32/ld2 @@ -0,0 +1,9 @@ +#!/bin/sh +# +# ld wrapper for building dynamic lib version of perl; +# passes all args to ld. +# + +PERLPATH=/perl5.004 + +$PERLPATH/perl $PERLPATH/perlld "$@" diff --git a/perlgcc b/cygwin32/perlgcc index b34945d131..97d7d1a8a5 100644 --- a/perlgcc +++ b/cygwin32/perlgcc @@ -1,10 +1,12 @@ # -# Perl script be a wrapper around the gnu gcc. the exportable perl.exe is built, special -# processing is done -# This script is caled by the gcc2 shell script when the flag -buildperl is passed to gcc2 +# Perl script be a wrapper around the gnu gcc. the exportable perl.exe +# is built, special processing is done. +# This script is caled by the gcc2 shell script when the flag +# -buildperl is passed to gcc2 print "perlgcc: building exportable perl...\n"; + # get all libs: my @libobs; my @obs; @@ -73,11 +75,3 @@ print "$command\n"; system($command); print "perlgcc: Completed\n"; - - - - - - - - diff --git a/perlld b/cygwin32/perlld index 25acc24a4c..1622f2ffaf 100644 --- a/perlld +++ b/cygwin32/perlld @@ -1,10 +1,12 @@ # -# Perl script be a wrapper around the gnu ld. When a dll is specified to be built, special -# processing is done, else the standard ld is called. +# Perl script be a wrapper around the gnu ld. When a dll is specified to +# to be built, special processing is done, else the standard ld is called. # # Modified 3/14/97 to include the impure_ptr setup routine in init.cc # Modified to make dll in current directory then copy to another dir if -# a path name specified on the command name with the -o parm +# a path name specified on the command name with the -o parm. +# + my $args = join(" ",@ARGV); # get args my $arg; @@ -103,7 +105,7 @@ else{ # no special processing, just call ld system($command); } -# -------------------------------------------------------------------------------- +#--------------------------------------------------------------------------- sub writeInit{ open(OUTFILE,">$init.cc") or die("Can't open $init.cc\n"); @@ -175,7 +177,7 @@ close OUTFILE; } -# ------------------------------------------------------------------------------------------ +#--------------------------------------------------------------------------- sub writefixup{ open(OUTFILE,">$fixup.c") or die("Can't open $fixup.c\n"); @@ -188,19 +190,3 @@ print OUTFILE <<'EOF'; EOF close OUTFILE; } - - - - - - - - - - - - - - - - @@ -34,7 +34,11 @@ #endif #ifdef I_UTIME -#include <utime.h> +# ifdef WIN32 +# include <sys/utime.h> +# else +# include <utime.h> +# endif #endif #ifdef I_FCNTL #include <fcntl.h> @@ -62,6 +66,15 @@ # endif #endif +/* Put this after #includes because <unistd.h> defines _XOPEN_*. */ +#ifndef Sock_size_t +# if _XOPEN_VERSION >= 5 || defined(_XOPEN_SOURCE_EXTENDED) +# define Sock_size_t Size_t +# else +# define Sock_size_t int +# endif +#endif + bool do_open(gv,name,len,as_raw,rawmode,rawperm,supplied_fp) GV *gv; @@ -284,9 +297,10 @@ PerlIO *supplied_fp; !statbuf.st_mode #endif ) { - int buflen = sizeof tokenbuf; - if (getsockname(PerlIO_fileno(fp), (struct sockaddr *)tokenbuf, &buflen) >= 0 - || errno != ENOTSOCK) + Sock_size_t buflen = sizeof tokenbuf; + if (getsockname(PerlIO_fileno(fp), (struct sockaddr *)tokenbuf, + &buflen) >= 0 + || errno != ENOTSOCK) IoTYPE(io) = 's'; /* some OS's return 0 on fstat()ed socket */ /* but some return 0 for streams too, sigh */ } @@ -649,6 +649,7 @@ dARGS HV *hv = (HV*)POPs; register HE *entry; SV *tmpstr; + I32 gimme = GIMME_V; I32 dokeys = (op->op_type == OP_KEYS); I32 dovalues = (op->op_type == OP_VALUES); @@ -667,10 +668,10 @@ dARGS (void)hv_iterinit(hv); /* always reset iterator regardless */ - if (op->op_private & OPpLEAVE_VOID) + if (gimme == G_VOID) RETURN; - if (GIMME != G_ARRAY) { + if (gimme == G_SCALAR) { I32 i; dTARGET; @@ -3,20 +3,29 @@ #define SH_PATH "/bin/sh" #ifdef DJGPP -#define BIT_BUCKET "nul" -#define OP_BINARY O_BINARY +# define BIT_BUCKET "nul" +# define OP_BINARY O_BINARY void Perl_DJGPP_init(); -#define PERL_SYS_INIT(argcp, argvp) STMT_START { \ +# define PERL_SYS_INIT(argcp, argvp) STMT_START { \ Perl_DJGPP_init(); } STMT_END -#else -#define PERL_SYS_INIT(c,v) -#define BIT_BUCKET "\dev\nul" -#endif +#else /* DJGPP */ +# define PERL_SYS_INIT(c,v) +# ifdef WIN32 +# define BIT_BUCKET "nul" +# else +# define BIT_BUCKET "\\dev\\nul" /* "wanna be like, umm, Newlined, or somethin?" */ +# endif +#endif /* DJGPP */ #define PERL_SYS_TERM() #define dXSUB_SYS int dummy #define TMPPATH "plXXXXXX" +#ifdef WIN32 +#define HAS_UTIME +#define HAS_KILL +#endif + /* * 5.003_07 and earlier keyed on #ifdef MSDOS for determining if we were * running on DOS, *and* if we had to cope with 16 bit memory addressing @@ -75,6 +84,18 @@ void Perl_DJGPP_init(); */ #define fwrite1 fwrite -#define Stat(fname,bufptr) stat((fname),(bufptr)) #define Fstat(fd,bufptr) fstat((fd),(bufptr)) #define Fflush(fp) fflush(fp) + +#ifndef WIN32 +# define Stat(fname,bufptr) stat((fname),(bufptr)) +#else +# define Stat(fname,bufptr) win32_stat((fname),(bufptr)) +# define my_getenv(var) getenv(var) +/* + * the following are standard library calls (stdio in particular) + * that is being redirected to the perl DLL. This is needed for + * Dynaloading any modules that called stdio functions + */ +# include <win32iop.h> +#endif /* WIN32 */ @@ -131,14 +131,20 @@ register OP *op; #endif if (op->op_flags) { *buf = '\0'; - if (op->op_flags & OPf_KNOW) { - if (op->op_flags & OPf_LIST) - (void)strcat(buf,"LIST,"); - else - (void)strcat(buf,"SCALAR,"); - } - else + switch (op->op_flags & OPf_WANT) { + case OPf_WANT_VOID: + (void)strcat(buf,"VOID,"); + break; + case OPf_WANT_SCALAR: + (void)strcat(buf,"SCALAR,"); + break; + case OPf_WANT_LIST: + (void)strcat(buf,"LIST,"); + break; + default: (void)strcat(buf,"UNKNOWN,"); + break; + } if (op->op_flags & OPf_KIDS) (void)strcat(buf,"KIDS,"); if (op->op_flags & OPf_PARENS) diff --git a/eg/cgi/RunMeFirst b/eg/cgi/RunMeFirst new file mode 100755 index 0000000000..c96d79eb62 --- /dev/null +++ b/eg/cgi/RunMeFirst @@ -0,0 +1,29 @@ +#!/usr/local/bin/perl + +# Make a world-writeable directory for saving state. +$ww = 'WORLD_WRITABLE'; +unless (-w $ww) { + $u = umask 0; + mkdir $ww, 0777; + umask $u; +} + +# Decode the sample image. +for $bin (qw(wilogo.gif)) { + unless (open UU, "$bin.uu") { warn "Can't open $bin.uu: $!\n"; next } + unless (open BIN, "> $bin") { warn "Can't create $bin: $!\n"; next } + $_ = <UU>; + while (<UU>) { + chomp; + last if /^end/; + print BIN unpack "u", $_; + } + close BIN; + close UU; +} + +# Create symlinks from *.txt to *.cgi for documentation purposes. +foreach (<*.cgi>) { + ($target = $_) =~ s/cgi$/txt/; + symlink $_, $target unless -e $target; +} diff --git a/eg/cgi/clickable_image.cgi b/eg/cgi/clickable_image.cgi new file mode 100644 index 0000000000..81daf09690 --- /dev/null +++ b/eg/cgi/clickable_image.cgi @@ -0,0 +1,26 @@ +#!/usr/local/bin/perl + +use CGI; +$query = new CGI; +print $query->header; +print $query->start_html("A Clickable Image"); +print <<END; +<H1>A Clickable Image</H1> +</A> +END +print "Sorry, this isn't very exciting!\n"; + +print $query->startform; +print $query->image_button('picture',"./wilogo.gif"); +print "Give me a: ",$query->popup_menu('letter',['A','B','C','D','E','W']),"\n"; # +print "<P>Magnification: ",$query->radio_group('magnification',['1X','2X','4X','20X']),"\n"; +print "<HR>\n"; + +if ($query->param) { + print "<P>Magnification, <EM>",$query->param('magnification'),"</EM>\n"; + print "<P>Selected Letter, <EM>",$query->param('letter'),"</EM>\n"; + ($x,$y) = ($query->param('picture.x'),$query->param('picture.y')); + print "<P>Selected Position <EM>($x,$y)</EM>\n"; +} + +print $query->end_html; diff --git a/eg/cgi/cookie.cgi b/eg/cgi/cookie.cgi new file mode 100644 index 0000000000..98adda196e --- /dev/null +++ b/eg/cgi/cookie.cgi @@ -0,0 +1,88 @@ +#!/usr/local/bin/perl + +use CGI qw(:standard); + +@ANIMALS=sort qw/lion tiger bear pig porcupine ferret zebra gnu ostrich + emu moa goat weasel yak chicken sheep hyena dodo lounge-lizard + squirrel rat mouse hedgehog racoon baboon kangaroo hippopotamus + giraffe/; + +# Recover the previous animals from the magic cookie. +# The cookie has been formatted as an associative array +# mapping animal name to the number of animals. +%zoo = cookie('animals'); + +# Recover the new animal(s) from the parameter 'new_animal' +@new = param('new_animals'); + +# If the action is 'add', then add new animals to the zoo. Otherwise +# delete them. +foreach (@new) { + if (param('action') eq 'Add') { + $zoo{$_}++; + } elsif (param('action') eq 'Delete') { + $zoo{$_}-- if $zoo{$_}; + delete $zoo{$_} unless $zoo{$_}; + } +} + +# Add new animals to old, and put them in a cookie +$the_cookie = cookie(-name=>'animals', + -value=>\%zoo, + -expires=>'+1h'); + +# Print the header, incorporating the cookie and the expiration date... +print header(-cookie=>$the_cookie); + +# Now we're ready to create our HTML page. +print start_html('Animal crackers'); + +print <<EOF; +<h1>Animal Crackers</h1> +Choose the animals you want to add to the zoo, and click "add". +Come back to this page any time within the next hour and the list of +animals in the zoo will be resurrected. You can even quit Netscape +completely! +<p> +Try adding the same animal several times to the list. Does this +remind you vaguely of a shopping cart? +<p> +<em>This script only works with Netscape browsers</em> +<p> +<center> +<table border> +<tr><th>Add/Delete<th>Current Contents +EOF + ; + +print "<tr><td>",start_form; +print scrolling_list(-name=>'new_animals', + -values=>[@ANIMALS], + -multiple=>1, + -override=>1, + -size=>10),"<br>"; +print submit(-name=>'action',-value=>'Delete'), + submit(-name=>'action',-value=>'Add'); +print end_form; + +print "<td>"; +if (%zoo) { # make a table + print "<ul>\n"; + foreach (sort keys %zoo) { + print "<li>$zoo{$_} $_\n"; + } + print "</ul>\n"; +} else { + print "<strong>The zoo is empty.</strong>\n"; +} +print "</table></center>"; + +print <<EOF; +<hr> +<ADDRESS>Lincoln D. Stein</ADDRESS><BR> +<A HREF="./">More Examples</A> +EOF + ; +print end_html; + + diff --git a/eg/cgi/crash.cgi b/eg/cgi/crash.cgi new file mode 100644 index 0000000000..64f03c7b3d --- /dev/null +++ b/eg/cgi/crash.cgi @@ -0,0 +1,6 @@ +#!/usr/local/bin/perl + +use CGI::Carp qw(fatalsToBrowser); + +# This line invokes a fatal error message at compile time. +foo bar baz; diff --git a/eg/cgi/customize.cgi b/eg/cgi/customize.cgi new file mode 100644 index 0000000000..d932f4ba23 --- /dev/null +++ b/eg/cgi/customize.cgi @@ -0,0 +1,92 @@ +#!/usr/local/bin/perl + +use CGI qw(:standard :html3); + +# Some constants to use in our form. +@colors=qw/aqua black blue fuschia gray green lime maroon navy olive + purple red silver teal white yellow/; +@sizes=("<default>",1..7); + +# recover the "preferences" cookie. +%preferences = cookie('preferences'); + +# If the user wants to change the background color or her +# name, they will appear among our CGI parameters. +foreach ('text','background','name','size') { + $preferences{$_} = param($_) || $preferences{$_}; +} + +# Set some defaults +$preferences{'background'} = $preferences{'background'} || 'silver'; +$preferences{'text'} = $preferences{'text'} || 'black'; + +# Refresh the cookie so that it doesn't expire. This also +# makes any changes the user made permanent. +$the_cookie = cookie(-name=>'preferences', + -value=>\%preferences, + -expires=>'+30d'); +print header(-cookie=>$the_cookie); + +# Adjust the title to incorporate the user's name, if provided. +$title = $preferences{'name'} ? + "Welcome back, $preferences{name}!" : "Customizable Page"; + +# Create the HTML page. We use several of Netscape's +# extended tags to control the background color and the +# font size. It's safe to use Netscape features here because +# cookies don't work anywhere else anyway. +print start_html(-title=>$title, + -bgcolor=>$preferences{'background'}, + -text=>$preferences{'text'} + ); + +print basefont({SIZE=>$preferences{size}}) if $preferences{'size'} > 0; + +print h1($title),<<END; +You can change the appearance of this page by submitting +the fill-out form below. If you return to this page any time +within 30 days, your preferences will be restored. +END + ; + +# Create the form +print hr(), + start_form, + + "Your first name: ", + textfield(-name=>'name', + -default=>$preferences{'name'}, + -size=>30),br, + + table( + TR( + td("Preferred"), + td("Page color:"), + td(popup_menu(-name=>'background', + -values=>\@colors, + -default=>$preferences{'background'}) + ), + ), + TR( + td(''), + td("Text color:"), + td(popup_menu(-name=>'text', + -values=>\@colors, + -default=>$preferences{'text'}) + ) + ), + TR( + td(''), + td("Font size:"), + td(popup_menu(-name=>'size', + -values=>\@sizes, + -default=>$preferences{'size'}) + ) + ) + ), + + submit(-label=>'Set preferences'), + hr; + +print a({HREF=>"/"},'Go to the home page'); + diff --git a/eg/cgi/diff_upload.cgi b/eg/cgi/diff_upload.cgi new file mode 100644 index 0000000000..913f9ca179 --- /dev/null +++ b/eg/cgi/diff_upload.cgi @@ -0,0 +1,68 @@ +#!/usr/local/bin/perl + +$DIFF = "/usr/bin/diff"; +$PERL = "/usr/bin/perl"; + +use CGI qw(:standard); +use CGI::Carp; + +print header; +print start_html("File Diff Example"); +print "<strong>Version </strong>$CGI::VERSION<p>"; + +print <<EOF; +<H1>File Diff Example</H1> +Enter two files. When you press "submit" their diff will be +produced. +EOF + ; + +# Start a multipart form. +print start_multipart_form; +print "File #1:",filefield(-name=>'file1',-size=>45),"<BR>\n"; +print "File #2:",filefield(-name=>'file2',-size=>45),"<BR>\n"; +print "Diff type: ",radio_group(-name=>'type', + -value=>['context','normal']),"<br>\n"; +print reset,submit(-name=>'submit',-value=>'Do Diff'); +print endform; + +# Process the form if there is a file name entered +$file1 = param('file1'); +$file2 = param('file2'); + +$|=1; # for buffering +if ($file1 && $file2) { + $realfile1 = tmpFileName($file1); + $realfile2 = tmpFileName($file2); + print "<HR>\n"; + print "<H2>$file1 vs $file2</H2>\n"; + + print "<PRE>\n"; + $options = "-c" if param('type') eq 'context'; + system "$DIFF $options $realfile1 $realfile2 | $PERL -pe 's/>/>/g; s/</</g;'"; + close $file1; + close $file2; + print "</PRE>\n"; +} + +print <<EOF; +<HR> +<A HREF="../cgi_docs.html">CGI documentation</A> +<HR> +<ADDRESS> +<A HREF="/~lstein">Lincoln D. Stein</A> +</ADDRESS><BR> +Last modified 17 July 1996 +EOF + ; +print end_html; + +sub sanitize { + my $name = shift; + my($safe) = $name=~/([a-zA-Z0-9._~#,]+)/; + unless ($safe) { + print "<strong>$name is not a valid Unix filename -- sorry</strong>"; + exit 0; + } + return $safe; +} diff --git a/eg/cgi/file_upload.cgi b/eg/cgi/file_upload.cgi new file mode 100644 index 0000000000..1f9eaec332 --- /dev/null +++ b/eg/cgi/file_upload.cgi @@ -0,0 +1,63 @@ +#!/usr/local/bin/perl + +use CGI qw(:standard); +use CGI::Carp; + +print header(); +print start_html("File Upload Example"); +print strong("Version "),$CGI::VERSION,p; + +print h1("File Upload Example"), + 'This example demonstrates how to prompt the remote user to + select a remote file for uploading. ', + strong("This feature only works with Netscape 2.0 browsers."), + p, + 'Select the ',cite('browser'),' button to choose a text file + to upload. When you press the submit button, this script + will count the number of lines, words, and characters in + the file.'; + +@types = ('count lines','count words','count characters'); + +# Start a multipart form. +print start_multipart_form(), + "Enter the file to process:", + filefield('filename','',45), + br, + checkbox_group('count',\@types,\@types), + p, + reset,submit('submit','Process File'), + endform; + +# Process the form if there is a file name entered +if ($file = param('filename')) { + $tmpfile=tmpFileName($file); + print hr(), + h2($file), + h3($tmpfile); + my($lines,$words,$characters,@words) = (0,0,0,0); + while (<$file>) { + $lines++; + $words += @words=split(/\s+/); + $characters += length($_); + } + close $file; + grep($stats{$_}++,param('count')); + if (%stats) { + print strong("Lines: "),$lines,br if $stats{'count lines'}; + print strong("Words: "),$words,br if $stats{'count words'}; + print strong("Characters: "),$characters,br if $stats{'count characters'}; + } else { + print strong("No statistics selected."); + } +} + +print hr(), + a({href=>"../cgi_docs.html"},"CGI documentation"), + hr, + address( + a({href=>'/~lstein'},"Lincoln D. Stein")), + br, + 'Last modified July 17, 1996', + end_html; + diff --git a/eg/cgi/frameset.cgi b/eg/cgi/frameset.cgi new file mode 100644 index 0000000000..ff730268e9 --- /dev/null +++ b/eg/cgi/frameset.cgi @@ -0,0 +1,81 @@ +#!/usr/local/bin/perl + +use CGI; +$query = new CGI; +print $query->header; +$TITLE="Frameset Example"; + +# We use the path information to distinguish between calls +# to the script to: +# (1) create the frameset +# (2) create the query form +# (3) create the query response + +$path_info = $query->path_info; + +# If no path information is provided, then we create +# a side-by-side frame set +if (!$path_info) { + &print_frameset; + exit 0; +} + +# If we get here, then we either create the query form +# or we create the response. +&print_html_header; +&print_query if $path_info=~/query/; +&print_response if $path_info=~/response/; +&print_end; + + +# Create the frameset +sub print_frameset { + $script_name = $query->script_name; + print <<EOF; +<html><head><title>$TITLE</title></head> +<frameset cols="50,50"> +<frame src="$script_name/query" name="query"> +<frame src="$script_name/response" name="response"> +</frameset> +EOF + ; + exit 0; +} + +sub print_html_header { + print $query->start_html($TITLE); +} + +sub print_end { + print qq{<P><hr><A HREF="cgi_docs.html">Go to the documentation</A>}; + print $query->end_html; +} + +sub print_query { + $script_name = $query->script_name; + print "<H1>Frameset Query</H1>\n"; + print $query->startform(-action=>"$script_name/response",-TARGET=>"response"); + print "What's your name? ",$query->textfield('name'); + print "<P>What's the combination?<P>", + $query->checkbox_group(-name=>'words', + -values=>['eenie','meenie','minie','moe']); + + print "<P>What's your favorite color? ", + $query->popup_menu(-name=>'color', + -values=>['red','green','blue','chartreuse']), + "<P>"; + print $query->submit; + print $query->endform; +} + +sub print_response { + print "<H1>Frameset Result</H1>\n"; + unless ($query->param) { + print "<b>No query submitted yet.</b>"; + return; + } + print "Your name is <EM>",$query->param(name),"</EM>\n"; + print "<P>The keywords are: <EM>",join(", ",$query->param(words)),"</EM>\n"; + print "<P>Your favorite color is <EM>",$query->param(color),"</EM>\n"; +} + diff --git a/eg/cgi/index.html b/eg/cgi/index.html new file mode 100644 index 0000000000..9eafd5f108 --- /dev/null +++ b/eg/cgi/index.html @@ -0,0 +1,111 @@ +<HTML> <HEAD> +<TITLE>More Examples of Scripts Created with CGI.pm</TITLE> +</HEAD> + +<BODY> +<H1>More Examples of Scripts Created with CGI.pm</H1> + +<H2> Basic Non Sequitur Questionnaire</H2> +<UL> + <LI> <A HREF="tryit.cgi">Try the script</A> + <LI> <A HREF="tryit.txt">Look at its source code</A> +</UL> + +<H2> Advanced Non Sequitur Questionnaire</H2> +<UL> + <LI> <A HREF="monty.cgi">Try the script</A> + <LI> <A HREF="monty.txt">Look at its source code</A> +</UL> + +<H2> Save and restore the state of a form to a file</H2> +<UL> + <LI> <A HREF="save_state.cgi">Try the script</A> + <LI> <A HREF="save_state.txt">Look at its source code</A> +</UL> + +<H2> Read the coordinates from a clickable image map</H2> +<UL> + <LI> <A HREF="clickable_image.cgi">Try the script</A> + <LI> <A HREF="clickable_image.txt">Look at its source code</A> +</UL> + +<H2> Multiple independent forms on the same page</H2> +<UL> + <LI> <A HREF="multiple_forms.cgi">Try the script</A> + <LI> <A HREF="multiple_forms.txt">Look at its source code</A> +</UL> + +<H2> How to maintain state on a page with internal links</H2> +<UL> + <LI> <A HREF="internal_links.cgi">Try the script</A> + <LI> <A HREF="internal_links.txt">Look at its source code</A> +</UL> + +<h2>Echo fatal script errors to the browser</h2> +<ul> + <li><a href="crash.cgi">Try the script</a> + <li><a href="crash.txt">Look at its source code</a> +</ul> + +<EM>The Following Scripts only Work with Netscape 2.0 & Internet Explorer only!</EM> + +<H2> Prompt for a file to upload and process it</H2> +<UL> + <LI> <A HREF="file_upload.cgi">Try the script</A> + <LI> <A HREF="file_upload.txt">Look at its source code</A> +</UL> + +<h2> A Continuously-Updated Page using Server Push</h2> +<ul> + <li><a href="nph-clock.cgi">Try the script</a> + <li><a href="nph-clock.txt">Look at its source code</a> +</ul> + +<h2>Compute the "diff" between two uploaded files</h2> +<ul> + <li><a href="diff_upload.cgi">Try the script</a> + <li><a href="diff_upload.txt">Look at its source code</a> +</ul> + +<h2>Maintain state over a long period with a cookie</h2> +<ul> + <li><a href="cookie.cgi">Try the script</a> + <li><a href="cookie.txt">Look at its source code</a> +</ul> + +<h2>Permanently customize the appearance of a page</h2> +<ul> + <li><a href="customize.cgi">Try the script</a> + <li><a href="customize.txt">Look at its source code</a> +</ul> + +<h2> Popup the response in a new window</h2> +<ul> + <li><a href="popup.cgi">Try the script</a> + <li><a href="popup.txt">Look at its source code</a> +</ul> + +<h2> Side-by-side form and response using frames</h2> +<ul> + <li><a href="frameset.cgi">Try the script</a> + <li><a href="frameset.txt">Look at its source code</a> +</ul> + +<h2>Verify the Contents of a fill-out form with JavaScript</h2> +<ul> + <li><a href="javascript.cgi">Try the script</a> + <li><a href="javascript.txt">Look at its source code</a> +</ul> + +<HR> +<MENU> + <LI> <A HREF="../cgi_docs.html">CGI.pm documentation</A> + <LI> <A HREF="../CGI.pm.tar.gz">Download the CGI.pm distribution</A> +</MENU> +<HR> +<ADDRESS>Lincoln D. Stein, lstein@genome.wi.mit.edu<br> +<a href="/">Whitehead Institute/MIT Center for Genome Research</a></ADDRESS> +<!-- hhmts start --> +Last modified: Mon Dec 2 06:23:25 EST 1996 +<!-- hhmts end --> +</BODY> </HTML> diff --git a/eg/cgi/internal_links.cgi b/eg/cgi/internal_links.cgi new file mode 100644 index 0000000000..4806966842 --- /dev/null +++ b/eg/cgi/internal_links.cgi @@ -0,0 +1,33 @@ +#!/usr/local/bin/perl + +use CGI; +$query = new CGI; + +# We generate a regular HTML file containing a very long list +# and a popup menu that does nothing except to show that we +# don't lose the state information. +print $query->header; +print $query->start_html("Internal Links Example"); +print "<H1>Internal Links Example</H1>\n"; +print "Click <cite>Submit Query</cite> to create a state. Then scroll down and", + " click on any of the <cite>Jump to top</cite> links. This is not very exciting."; + +print "<A NAME=\"start\"></A>\n"; # an anchor point at the top + +# pick a default starting value; +$query->param('amenu','FOO1') unless $query->param('amenu'); + +print $query->startform; +print $query->popup_menu('amenu',[('FOO1'..'FOO9')]); +print $query->submit,$query->endform; + +# We create a long boring list for the purposes of illustration. +$myself = $query->self_url; +print "<OL>\n"; +for (1..100) { + print qq{<LI>List item #$_ <A HREF="$myself#start">Jump to top</A>\n}; +} +print "</OL>\n"; + +print $query->end_html; + diff --git a/eg/cgi/javascript.cgi b/eg/cgi/javascript.cgi new file mode 100644 index 0000000000..20496c0e80 --- /dev/null +++ b/eg/cgi/javascript.cgi @@ -0,0 +1,105 @@ +#!/usr/local/bin/perl + +# This script illustrates how to use JavaScript to validage fill-out +# forms. +use CGI qw(:standard); + +# Here's the javascript code that we include in the document. +$JSCRIPT=<<EOF; + // validate that the user is the right age. Return + // false to prevent the form from being submitted. + function validateForm() { + var today = new Date(); + var birthday = validateDate(document.form1.birthdate); + if (birthday == 0) { + document.form1.birthdate.focus() + document.form1.birthdate.select(); + return false; + } + var milliseconds = today.getTime()-birthday; + var years = milliseconds/(1000 * 60 * 60 * 24 * 365.25); + if ((years > 20) || (years < 5)) { + alert("You must be between the ages of 5 and 20 to submit this form"); + document.form1.birthdate.focus(); + document.form1.birthdate.select(); + return false; + } + // Since we've calculated the age in years already, + // we might as well send it up to our CGI script. + document.form1.age.value=Math.floor(years); + return true; + } + + // make sure that the contents of the supplied + // field contain a valid date. + function validateDate(element) { + var date = Date.parse(element.value); + if (0 == date) { + alert("Please enter date in format MMM DD, YY"); + element.focus(); + element.select(); + } + return date; + } + + // Compliments, compliments + function doPraise(element) { + if (element.checked) { + self.status=element.value + " is an excellent choice!"; + return true; + } else { + return false; + } + } + + function checkColor(element) { + var color = element.options[element.selectedIndex].text; + if (color == "blonde") { + if (confirm("Is it true that blondes have more fun?")) + alert("Darn. That leaves me out."); + } else + alert(color + " is a fine choice!"); + } +EOF + ; + +# here's where the execution begins +print header; +print start_html(-title=>'Personal Profile',-script=>$JSCRIPT); + +print h1("Big Brother Wants to Know All About You"), + strong("Note: "),"This page uses JavaScript and requires", + "Netscape 2.0 or higher to do anything special."; + +&print_prompt(); +print hr; +&print_response() if param; +print end_html; + +sub print_prompt { + print start_form(-name=>'form1', + -onSubmit=>"return validateForm()"),"\n"; + print "Birthdate (e.g. Jan 3, 1972): ", + textfield(-name=>'birthdate', + -onBlur=>"validateDate(this)"),"<p>\n"; + print "Sex: ",radio_group(-name=>'gender', + -value=>[qw/male female/], + -onClick=>"doPraise(this)"),"<p>\n"; + print "Hair color: ",popup_menu(-name=>'color', + -value=>[qw/brunette blonde red gray/], + -default=>'red', + -onChange=>"checkColor(this)"),"<p>\n"; + print hidden(-name=>'age',-value=>0); + print submit(); + print end_form; +} + +sub print_response { + import_names('Q'); + print h2("Your profile"), + "You are a ",b($Q::age)," year old ",b($Q::color,$Q::gender),".", + "You should be ashamed of yourself for lying so ", + "blatantly to big brother!", + hr; +} + diff --git a/eg/cgi/monty.cgi b/eg/cgi/monty.cgi new file mode 100644 index 0000000000..b7c0f6a8f6 --- /dev/null +++ b/eg/cgi/monty.cgi @@ -0,0 +1,83 @@ +#!/usr/local/bin/perl + +use CGI; + +$query = new CGI; + +print $query->header; +print $query->start_html("Example CGI.pm Form"); +print "<H1> Example CGI.pm Form</H1>\n"; +&print_prompt($query); +&do_work($query); +&print_tail; +print $query->end_html; + +sub print_prompt { + my($query) = @_; + + print $query->start_multipart_form; + print "<EM>What's your name?</EM><BR>"; + print $query->textfield('name'); + print $query->checkbox('Not my real name'); + + print "<P><EM>Where can you find English Sparrows?</EM><BR>"; + print $query->checkbox_group( + -name=>'Sparrow locations', + -values=>[England,France,Spain,Asia,Hoboken], + -linebreak=>'yes', + -defaults=>[England,Asia]); + + print "<P><EM>How far can they fly?</EM><BR>", + $query->radio_group( + -name=>'how far', + -values=>['10 ft','1 mile','10 miles','real far'], + -default=>'1 mile'); + + print "<P><EM>What's your favorite color?</EM> "; + print $query->popup_menu(-name=>'Color', + -values=>['black','brown','red','yellow'], + -default=>'red'); + + print $query->hidden('Reference','Monty Python and the Holy Grail'); + + print "<P><EM>What have you got there?</EM><BR>"; + print $query->scrolling_list( + -name=>'possessions', + -values=>['A Coconut','A Grail','An Icon', + 'A Sword','A Ticket'], + -size=>5, + -multiple=>'true'); + + print "<P><EM>Any parting comments?</EM><BR>"; + print $query->textarea(-name=>'Comments', + -rows=>10, + -columns=>50); + + print "<P>",$query->reset; + print $query->submit('Action','Shout'); + print $query->submit('Action','Scream'); + print $query->endform; + print "<HR>\n"; + } + +sub do_work { + my($query) = @_; + my(@values,$key); + + print "<H2>Here are the current settings in this form</H2>"; + + foreach $key ($query->param) { + print "<STRONG>$key</STRONG> -> "; + @values = $query->param($key); + print join(", ",@values),"<BR>\n"; + } +} + +sub print_tail { + print <<END; +<HR> +<ADDRESS>Lincoln D. Stein</ADDRESS><BR> +<A HREF="/">Home Page</A> +END + ; +} diff --git a/eg/cgi/multiple_forms.cgi b/eg/cgi/multiple_forms.cgi new file mode 100644 index 0000000000..b38bf93e96 --- /dev/null +++ b/eg/cgi/multiple_forms.cgi @@ -0,0 +1,54 @@ +#!/usr/local/bin/perl + +use CGI; + +$query = new CGI; +print $query->header; +print $query->start_html('Multiple Forms'); +print "<H1>Multiple Forms</H1>\n"; + +# Print the first form +print $query->startform; +$name = $query->remote_user || 'anonymous@' . $query->remote_host; + +print "What's your name? ",$query->textfield('name',$name,50); +print "<P>What's the combination?<P>", + $query->checkbox_group('words',['eenie','meenie','minie','moe']); +print "<P>What's your favorite color? ", + $query->popup_menu('color',['red','green','blue','chartreuse']), + "<P>"; +print $query->submit('form_1','Send Form 1'); +print $query->endform; + +# Print the second form +print "<HR>\n"; +print $query->startform; +print "Some radio buttons: ",$query->radio_group('radio buttons', + [qw{one two three four five}],'three'),"\n"; +print "<P>What's the password? ",$query->password_field('pass','secret'); +print $query->defaults,$query->submit('form_2','Send Form 2'),"\n"; +print $query->endform; + +print "<HR>\n"; + +$query->import_names('Q'); +if ($Q::form_1) { + print "<H2>Form 1 Submitted</H2>\n"; + print "Your name is <EM>$Q::name</EM>\n"; + print "<P>The combination is: <EM>{",join(",",@Q::words),"}</EM>\n"; + print "<P>Your favorite color is <EM>$Q::color</EM>\n"; +} elsif ($Q::form_2) { + print <<EOF; +<H2>Form 2 Submitted</H2> +<P>The value of the radio buttons is <EM>$Q::radio_buttons</EM> +<P>The secret password is <EM>$Q::pass</EM> +EOF + ; +} +print qq{<P><A HREF="./">Other examples</A>}; +print qq{<P><A HREF="../cgi_docs.html">Go to the documentation</A>}; + +print $query->end_html; + + + diff --git a/eg/cgi/nph-clock.cgi b/eg/cgi/nph-clock.cgi new file mode 100644 index 0000000000..55a2fbe545 --- /dev/null +++ b/eg/cgi/nph-clock.cgi @@ -0,0 +1,18 @@ +#!/usr/local/bin/perl -w + +use CGI::Push qw(:standard :html3); + +do_push(-next_page=>\&draw_time,-delay=>1); + +sub draw_time { + my $time = `/bin/date`; + return start_html('Tick Tock'), + div({-align=>CENTER}, + h1('Virtual Clock'), + h2($time) + ), + hr, + a({-href=>'index.html'},'More examples'), + end_html(); +} + diff --git a/eg/cgi/popup.cgi b/eg/cgi/popup.cgi new file mode 100644 index 0000000000..88cea1da9c --- /dev/null +++ b/eg/cgi/popup.cgi @@ -0,0 +1,32 @@ +#!/usr/local/bin/perl + +use CGI; +$query = new CGI; +print $query->header; +print $query->start_html('Popup Window'); + + +if (!$query->param) { + print "<H1>Ask your Question</H1>\n"; + print $query->startform(-target=>'_new'); + print "What's your name? ",$query->textfield('name'); + print "<P>What's the combination?<P>", + $query->checkbox_group(-name=>'words', + -values=>['eenie','meenie','minie','moe'], + -defaults=>['eenie','moe']); + + print "<P>What's your favorite color? ", + $query->popup_menu(-name=>'color', + -values=>['red','green','blue','chartreuse']), + "<P>"; + print $query->submit; + print $query->endform; + +} else { + print "<H1>And the Answer is...</H1>\n"; + print "Your name is <EM>",$query->param(name),"</EM>\n"; + print "<P>The keywords are: <EM>",join(", ",$query->param(words)),"</EM>\n"; + print "<P>Your favorite color is <EM>",$query->param(color),"</EM>\n"; +} +print qq{<P><A HREF="cgi_docs.html">Go to the documentation</A>}; +print $query->end_html; diff --git a/eg/cgi/save_state.cgi b/eg/cgi/save_state.cgi new file mode 100644 index 0000000000..be79051bd6 --- /dev/null +++ b/eg/cgi/save_state.cgi @@ -0,0 +1,67 @@ +#!/usr/local/bin/perl + +use CGI; +$query = new CGI; + +print $query->header; +print $query->start_html("Save and Restore Example"); +print "<H1>Save and Restore Example</H1>\n"; + +# Here's where we take action on the previous request +&save_parameters($query) if $query->param('action') eq 'SAVE'; +$query = &restore_parameters($query) if $query->param('action') eq 'RESTORE'; + +# Here's where we create the form +print $query->startform; +print "Popup 1: ",$query->popup_menu('popup1',[qw{red green purple magenta orange chartreuse brown}]),"\n"; +print "Popup 2: ",$query->popup_menu('popup2',[qw{lion tiger bear zebra potto wildebeest frog emu gazelle}]),"\n"; +print "<P>"; +$default_name = $query->remote_addr . '.sav'; +print "Save/restore state from file: ",$query->textfield('savefile',$default_name),"\n"; +print "<P>"; +print $query->submit('action','SAVE'),$query->submit('action','RESTORE'); +print "<P>",$query->defaults; +print $query->endform; + +# Here we print out a bit at the end +print $query->end_html; + +sub save_parameters { + local($query) = @_; + local($filename) = &clean_name($query->param('savefile')); + if (open(FILE,">$filename")) { + $query->save(FILE); + close FILE; + print "<STRONG>State has been saved to file $filename</STRONG>\n"; + print "<P>If you remember this name you can restore the state later.\n"; + } else { + print "<STRONG>Error:</STRONG> couldn't write to file $filename: $!\n"; + } +} + +sub restore_parameters { + local($query) = @_; + local($filename) = &clean_name($query->param('savefile')); + if (open(FILE,$filename)) { + $query = new CGI(FILE); # Throw out the old query, replace it with a new one + close FILE; + print "<STRONG>State has been restored from file $filename</STRONG>\n"; + } else { + print "<STRONG>Error:</STRONG> couldn't restore file $filename: $!\n"; + } + return $query; +} + + +# Very important subroutine -- get rid of all the naughty +# metacharacters from the file name. If there are, we +# complain bitterly and die. +sub clean_name { + local($name) = @_; + unless ($name=~/^[\w\._\-]+$/) { + print "<STRONG>$name has naughty characters. Only "; + print "alphanumerics are allowed. You can't use absolute names.</STRONG>"; + die "Attempt to use naughty characters"; + } + return "WORLD_WRITABLE/$name"; +} diff --git a/eg/cgi/tryit.cgi b/eg/cgi/tryit.cgi new file mode 100644 index 0000000000..155cd72a59 --- /dev/null +++ b/eg/cgi/tryit.cgi @@ -0,0 +1,35 @@ +#!/usr/local/bin/perl + +use CGI ':standard'; + +print header; +print start_html('A Simple Example'), + h1('A Simple Example'), + start_form, + "What's your name? ",textfield('name'), + p, + "What's the combination?", + p, + checkbox_group(-name=>'words', + -values=>['eenie','meenie','minie','moe'], + -defaults=>['eenie','minie']), + p, + "What's your favorite color? ", + popup_menu(-name=>'color', + -values=>['red','green','blue','chartreuse']), + p, + submit, + end_form, + hr; + +if (param()) { + print + "Your name is: ",em(param('name')), + p, + "The keywords are: ",em(join(", ",param('words'))), + p, + "Your favorite color is: ",em(param('color')), + hr; +} +print a({href=>'../cgi_docs.html'},'Go to the documentation'); + diff --git a/eg/cgi/wilogo.gif.uu b/eg/cgi/wilogo.gif.uu new file mode 100644 index 0000000000..a183bc02d5 --- /dev/null +++ b/eg/cgi/wilogo.gif.uu @@ -0,0 +1,14 @@ +begin 644 wilogo.gif +M1TE&.#=A7@!$`(```'X2F?___RP`````7@!$```"_D2.J<#MKF)ZU,A3,[OO +M(IUY']A%9"6AW$F)+#2]Y:BNLF6_\;WMH<?#I72^VP+D"@*)F&"O25KRDM&B +M[%C-7;4_J)*6'4ZE&O`W8"1OQ5UGPWRBIKDPM!MW9J]-[;LUKL;$5W.'YQ3( +M(O<&-^>F*(A55\BX%UEI^;<VB0BH1RFX2=<IELE4^*0'N?-I>OJ8N%(*Z^4G +M.OJJ>8HZ.(>;JRMD><E[!KQHB^3;:APL6Z8\RKPK/)O:*-WLW&7]*\UYR]J) +M?<P=1MR-_6VN76,WGAV^32W^3CZ_SCY3;W__C-R^CU^\%M#T!9PVL(ZZ&>X" +M%A1XSM]!A?T8/C0T$1XMJG\B&G+,"-&C/(VS0(842;`)M'S>_OE8F#"=2S#* +M8LHLAS'D1Y,42UGY9O,F-T:X@@JEE@D1RW>/D@8R.DZ-+*E0CQ:9JJ5JU!SQ +MR&BU2D.;E*4'ER0TNY%G2A/Y.G[=VG%81+5K_UG$21<A6;=YP9'5B++O7:@7 +M\]J5]]?DX7:)%<]5%=B/55>-GQW55;$8L\RW6J8-9>QM7<^A/SMZK!ESY$,+ +(KPA.EJ```#L` +` +end @@ -53,6 +53,7 @@ #define band_amg Perl_band_amg #define bind_match Perl_bind_match #define block_end Perl_block_end +#define block_gimme Perl_block_gimme #define block_start Perl_block_start #define bool__amg Perl_bool__amg #define bor_amg Perl_bor_amg @@ -124,6 +125,7 @@ #define cshname Perl_cshname #define curinterp Perl_curinterp #define curpad Perl_curpad +#define cv_ckproto Perl_cv_ckproto #define cv_clone Perl_cv_clone #define cv_const_sv Perl_cv_const_sv #define cv_undef Perl_cv_undef @@ -218,13 +220,14 @@ #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 gv_fetchfile Perl_gv_fetchfile #define gv_fetchmeth Perl_gv_fetchmeth #define gv_fetchmethod Perl_gv_fetchmethod +#define gv_fetchmethod_autoload Perl_gv_fetchmethod_autoload #define gv_fetchpv Perl_gv_fetchpv #define gv_fullname Perl_gv_fullname #define gv_fullname3 Perl_gv_fullname3 @@ -1256,7 +1259,6 @@ #define minus_n (curinterp->Iminus_n) #define minus_p (curinterp->Iminus_p) #define multiline (curinterp->Imultiline) -#define mustcatch (curinterp->Imustcatch) #define mystack_base (curinterp->Imystack_base) #define mystack_mark (curinterp->Imystack_mark) #define mystack_max (curinterp->Imystack_max) @@ -1297,6 +1299,7 @@ #define sortstack (curinterp->Isortstack) #define sortstash (curinterp->Isortstash) #define splitstr (curinterp->Isplitstr) +#define start_env (curinterp->Istart_env) #define statcache (curinterp->Istatcache) #define statgv (curinterp->Istatgv) #define statname (curinterp->Istatname) @@ -1409,7 +1412,6 @@ #define Iminus_n minus_n #define Iminus_p minus_p #define Imultiline multiline -#define Imustcatch mustcatch #define Imystack_base mystack_base #define Imystack_mark mystack_mark #define Imystack_max mystack_max @@ -1450,6 +1452,7 @@ #define Isortstack sortstack #define Isortstash sortstash #define Isplitstr splitstr +#define Istart_env start_env #define Istatcache statcache #define Istatgv statgv #define Istatname statname @@ -1571,7 +1574,6 @@ #define minus_n Perl_minus_n #define minus_p Perl_minus_p #define multiline Perl_multiline -#define mustcatch Perl_mustcatch #define mystack_base Perl_mystack_base #define mystack_mark Perl_mystack_mark #define mystack_max Perl_mystack_max @@ -1611,6 +1613,7 @@ #define sortstack Perl_sortstack #define sortstash Perl_sortstash #define splitstr Perl_splitstr +#define start_env Perl_start_env #define statcache Perl_statcache #define statgv Perl_statgv #define statname Perl_statname diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm index c2609a074b..3b6edd4fc7 100644 --- a/ext/DB_File/DB_File.pm +++ b/ext/DB_File/DB_File.pm @@ -499,7 +499,7 @@ See L<Changing the BTREE sort order> for an example of using the C<compare> template. If you are using the DB_RECNO interface and you intend making use of -C<bval>, you should check out L<The bval option>. +C<bval>, you should check out L<The 'bval' Option>. =head2 Default Parameters @@ -1148,7 +1148,7 @@ destroyed. undef $db ; untie %hash ; -See L<The untie gotcha> for more details. +See L<The untie() Gotcha> for more details. All the functions defined in L<dbopen> are available except for close() and dbopen() itself. The B<DB_File> method interface to the diff --git a/ext/DynaLoader/DynaLoader.pm b/ext/DynaLoader/DynaLoader.pm index 3cb06cc4db..84881448c7 100644 --- a/ext/DynaLoader/DynaLoader.pm +++ b/ext/DynaLoader/DynaLoader.pm @@ -12,17 +12,15 @@ package DynaLoader; # # Tim.Bunce@ig.co.uk, August 1994 -use vars qw($VERSION @ISA) ; +use vars qw($VERSION); + +$VERSION = "1.02"; require Carp; require Config; -require AutoLoader; - -@ISA=qw(AutoLoader); -$VERSION = "1.01" ; - -sub import { } # override import inherited from AutoLoader +require AutoLoader; +*AUTOLOAD = \&AutoLoader::AUTOLOAD; # enable debug/trace messages from DynaLoader perl code $dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug; diff --git a/ext/DynaLoader/dl_gnuwin32.xs b/ext/DynaLoader/dl_cygwin32.xs index 1d88114dc7..2b7563764e 100644 --- a/ext/DynaLoader/dl_gnuwin32.xs +++ b/ext/DynaLoader/dl_cygwin32.xs @@ -1,4 +1,4 @@ -/* dl_gnuwin32.xs +/* dl_cygwin32.xs * * Platform: Win32 (Windows NT/Windows 95) * Author: Wei-Yuen Tan (wyt@hip.com) @@ -8,7 +8,7 @@ * August 23rd 1995 - rewritten after losing everything when I * wiped off my NT partition (eek!) */ -/* Modified from the original dl_win32.xs to work with gnuwin32 +/* Modified from the original dl_win32.xs to work with cygwin32 -John Cerney 3/26/97 */ /* Porting notes: @@ -21,7 +21,7 @@ calls. #define WIN32_LEAN_AND_MEAN // Defines from windows needed for this function only. Can't include full -// gnuwin2 windows headers because of problems with CONTEXT redefinition +// Cygwin32 windows headers because of problems with CONTEXT redefinition // Removed logic to tell not dynamically load static modules. It is assumed that all // modules are dynamically built. This should be similar to the behavoir on sunOS. // Leaving in the logic would have required changes to the standard perlmain.c code @@ -95,7 +95,8 @@ dl_load_file(filename,flags=0) // setup the dll's impure_ptr: impure_setupptr = GetProcAddress(RETVAL, "impure_setup"); if( impure_setupptr == NULL){ - printf("Gnuwin32 Dynaloader Error, Could not load impure_setup symbol\n"); + printf( + "Cygwin32 dynaloader error: could not load impure_setup symbol\n"); RETVAL = NULL; } else{ diff --git a/ext/Opcode/Safe.pm b/ext/Opcode/Safe.pm index 22772796e2..c9d741647e 100644 --- a/ext/Opcode/Safe.pm +++ b/ext/Opcode/Safe.pm @@ -150,26 +150,27 @@ sub share_from { my $vars = shift; my $no_record = shift || 0; my $root = $obj->root(); - my ($var, $arg); croak("vars not an array ref") unless ref $vars eq 'ARRAY'; no strict 'refs'; # Check that 'from' package actually exists croak("Package \"$pkg\" does not exist") unless keys %{"$pkg\::"}; + my $arg; foreach $arg (@$vars) { # catch some $safe->share($var) errors: croak("'$arg' not a valid symbol table name") unless $arg =~ /^[\$\@%*&]?\w[\w:]*$/ or $arg =~ /^\$\W$/; - ($var = $arg) =~ s/^(\W)//; # get type char - # warn "share_from $pkg $1 $var"; - *{$root."::$var"} = ($1 eq '$') ? \${$pkg."::$var"} - : ($1 eq '@') ? \@{$pkg."::$var"} - : ($1 eq '%') ? \%{$pkg."::$var"} - : ($1 eq '*') ? *{$pkg."::$var"} - : ($1 eq '&') ? \&{$pkg."::$var"} - : (!$1) ? \&{$pkg."::$var"} - : croak(qq(Can't share "$1$var" of unknown type)); + my ($var, $type); + $type = $1 if ($var = $arg) =~ s/^(\W)//; + # warn "share_from $pkg $type $var"; + *{$root."::$var"} = (!$type) ? \&{$pkg."::$var"} + : ($type eq '&') ? \&{$pkg."::$var"} + : ($type eq '$') ? \${$pkg."::$var"} + : ($type eq '@') ? \@{$pkg."::$var"} + : ($type eq '%') ? \%{$pkg."::$var"} + : ($type eq '*') ? *{$pkg."::$var"} + : croak(qq(Can't share "$type$var" of unknown type)); } $obj->share_record($pkg, $vars) unless $no_record or !$vars; } diff --git a/ext/POSIX/POSIX.pm b/ext/POSIX/POSIX.pm index 6656443483..2885c0d84c 100644 --- a/ext/POSIX/POSIX.pm +++ b/ext/POSIX/POSIX.pm @@ -11,7 +11,7 @@ require Exporter; require DynaLoader; @ISA = qw(Exporter DynaLoader); -$VERSION = "1.01" ; +$VERSION = "1.02" ; %EXPORT_TAGS = ( @@ -386,7 +386,7 @@ sub kill { sub raise { usage "raise(sig)" if @_ != 1; - kill $$, $_[0]; # Is this good enough? + kill $_[0], $$; # Is this good enough? } sub offsetof { @@ -1,19 +0,0 @@ -#!/bin/sh - - -# gcc wrapper for building dynamic lib version of perl -# if -buildperl found on command line, then all args passed to -# perlgcc, else pass all args to gcc. -# jc 3/24/97 -# -results=`echo "$*" | grep "\-buildperl"` -# echo "results = <$results>" -#if ( "$results" .eq. ""); then -# if `sh -c echo '$*' | grep buildperl >/dev/null 2>&1`; then -case "$results" in - "") gcc $*;; - *) miniperl perlgcc $*;; -esac - - - diff --git a/global.sym b/global.sym index ddfe93130c..1524c035cc 100644 --- a/global.sym +++ b/global.sym @@ -45,7 +45,6 @@ cshlen cshname curinterp curpad -cv_const_sv dc debug dec_amg @@ -318,6 +317,7 @@ av_undef av_unshift bind_match block_end +block_gimme block_start boot_core_UNIVERSAL call_list @@ -363,7 +363,9 @@ ck_trunc convert cpytill croak +cv_ckproto cv_clone +cv_const_sv cv_undef cx_dump cxinc @@ -435,13 +437,14 @@ gp_ref gv_AVadd gv_HVadd gv_IOadd -gv_autoload +gv_autoload4 gv_check gv_efullname gv_efullname3 gv_fetchfile gv_fetchmeth gv_fetchmethod +gv_fetchmethod_autoload gv_fetchpv gv_fullname gv_fullname3 @@ -212,8 +212,16 @@ I32 level; if (gv = gv_fetchmeth(lastchance, name, len, (level >= 0) ? level + 1 : level - 1)) { gotcha: - /* Use topgv for cache only if it has no synonyms */ - if (topgv && GvREFCNT(topgv) == 1) { + /* + * Cache method in topgv if: + * 1. topgv has no synonyms (else inheritance crosses wires) + * 2. method isn't a stub (else AUTOLOAD fails spectacularly) + */ + if (topgv && + GvREFCNT(topgv) == 1 && + (cv = GvCV(gv)) && + (CvROOT(cv) || CvXSUB(cv))) + { if (cv = GvCV(topgv)) SvREFCNT_dec(cv); GvCV(topgv) = (CV*)SvREFCNT_inc(GvCV(gv)); @@ -232,6 +240,15 @@ gv_fetchmethod(stash, name) HV* stash; char* name; { + return gv_fetchmethod_autoload(stash, name, TRUE); +} + +GV * +gv_fetchmethod_autoload(stash, name, autoload) +HV* stash; +char* name; +I32 autoload; +{ register char *nend; char *nsplit = 0; GV* gv; @@ -263,18 +280,38 @@ char* name; if (!gv) { if (strEQ(name,"import")) gv = (GV*)&sv_yes; - else - gv = gv_autoload(stash, name, nend - name); + else if (autoload) + gv = gv_autoload4(stash, name, nend - name, TRUE); + } + else if (autoload) { + CV* cv = GvCV(gv); + if (!CvROOT(cv) && !CvXSUB(cv)) { + GV* stubgv; + GV* autogv; + + if (CvANON(cv)) + stubgv = gv; + else { + stubgv = CvGV(cv); + if (GvCV(stubgv) != cv) /* orphaned import */ + stubgv = gv; + } + autogv = gv_autoload4(GvSTASH(stubgv), + GvNAME(stubgv), GvNAMELEN(stubgv), TRUE); + if (autogv) + gv = autogv; + } } return gv; } GV* -gv_autoload(stash, name, len) +gv_autoload4(stash, name, len, method) HV* stash; char* name; STRLEN len; +I32 method; { static char autoload[] = "AUTOLOAD"; static STRLEN autolen = 8; @@ -286,11 +323,19 @@ STRLEN len; if (len == autolen && strnEQ(name, autoload, autolen)) return Nullgv; - if (!(gv = gv_fetchmeth(stash, autoload, autolen, 0))) + if (!(gv = gv_fetchmeth(stash, autoload, autolen, FALSE))) return Nullgv; cv = GvCV(gv); /* + * Inheriting AUTOLOAD for non-methods works ... for now. + */ + if (dowarn && !method && (GvCVGEN(gv) || GvSTASH(gv) != stash)) + warn( + "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated", + HvNAME(stash), (int)len, name); + + /* * Given &FOO::AUTOLOAD, set $FOO::AUTOLOAD to desired function name. * The subroutine's original name may not be "AUTOLOAD", so we don't * use that, but for lack of anything better we will use the sub's @@ -1029,11 +1074,10 @@ HV* stash; DEBUG_o( deb("Resolving method `%.256s' for overloaded `%s' in package `%.256s'\n", SvPV(GvSV(gv), na), cp, HvNAME(stash)) ); - if (SvPOK(GvSV(gv)) - && (ngv = gv_fetchmethod(stash, SvPVX(GvSV(gv))))) { - name = SvPVX(GvSV(gv)); - cv = GvCV(gv = ngv); - } else { + if (!SvPOK(GvSV(gv)) + || !(ngv = gv_fetchmethod_autoload(stash, SvPVX(GvSV(gv)), + FALSE))) + { /* Can be an import stub (created by `can'). */ if (GvCVGEN(gv)) { croak("Stub found while resolving method `%.256s' overloading `%s' in package `%.256s'", @@ -1044,9 +1088,8 @@ HV* stash; (SvPOK(GvSV(gv)) ? SvPVX(GvSV(gv)) : "???" ), cp, HvNAME(stash)); } - /* If the sub is only a stub then we may have a gv to AUTOLOAD */ - gv = (GV*)*hv_fetch(GvSTASH(gv), name, strlen(name), TRUE); - cv = GvCV(gv); + name = SvPVX(GvSV(gv)); + cv = GvCV(gv = ngv); } DEBUG_o( deb("Overloading `%s' in package `%.256s' via `%.256s::%.256s' \n", cp, HvNAME(stash), HvNAME(GvSTASH(CvGV(cv))), @@ -1282,14 +1325,14 @@ int flags; dSP; BINOP myop; SV* res; - bool oldmustcatch = mustcatch; + bool oldcatch = CATCH_GET; + CATCH_SET(TRUE); Zero(&myop, 1, BINOP); myop.op_last = (OP *) &myop; myop.op_next = Nullop; - myop.op_flags = OPf_KNOW|OPf_STACKED; + myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED; - mustcatch = TRUE; ENTER; SAVESPTR(op); op = (OP *) &myop; @@ -1301,7 +1344,7 @@ int flags; EXTEND(sp, notfound + 5); PUSHs(lr>0? right: left); PUSHs(lr>0? left: right); - PUSHs( assign ? &sv_undef : (lr>0? &sv_yes: &sv_no)); + PUSHs( assign ? &sv_undef : boolSV(lr>0) ); if (notfound) { PUSHs( sv_2mortal(newSVpv((char *)AMG_names[method + assignshift],0)) ); } @@ -1315,7 +1358,7 @@ int flags; res=POPs; PUTBACK; - mustcatch = oldmustcatch; + CATCH_SET(oldcatch); if (postpr) { int ans; @@ -1344,7 +1387,7 @@ int flags; case not_amg: ans=!SvOK(res); break; } - return ans? &sv_yes: &sv_no; + return boolSV(ans); } else if (method==copy_amg) { if (!SvROK(res)) { croak("Copy method did not return a reference"); diff --git a/hints/amigaos.sh b/hints/amigaos.sh index 4108c2ecb8..57c7b62aeb 100644 --- a/hints/amigaos.sh +++ b/hints/amigaos.sh @@ -17,10 +17,6 @@ d_fork='undef' d_vfork='define' groupstype='int' -# the following is needed to prevent pdksh from blowing up - -i_neterrno='undef' - # libs libpth="$prefix/lib /local/lib" diff --git a/hints/bsdos.sh b/hints/bsdos.sh index 773778382b..29a069102c 100644 --- a/hints/bsdos.sh +++ b/hints/bsdos.sh @@ -68,7 +68,7 @@ case "$osvers" in d_setrgid='undef' d_setruid='undef' ;; -2.1*|3.0*) +2.1*) # Use 2.1's shlicc2 for dynamic linking # Since cc -o is linking, use it for compiling too. # I'm not sure whether Configure is careful about diff --git a/perl5.003_94/hints/gnuwin32.sh b/hints/cygwin32.sh index abd0210273..5853499954 100644 --- a/perl5.003_94/hints/gnuwin32.sh +++ b/hints/cygwin32.sh @@ -1,5 +1,5 @@ #! /bin/sh -# gnuwin32.sh - hintsfile for building perl on Windows NT using the +# cygwin32.sh - hintsfile for building perl on Windows NT using the # Cygnus Win32 Development Kit. # See "http://www.cygnus.com/misc/gnu-win32/" to learn about the kit. # @@ -16,10 +16,10 @@ libs='-lcygwin -lm -lc -lkernel32' # dynamic lib stuff so='dll' #i_dlfcn='define' -dlsrc='dl_gnuwin32.xs' +dlsrc='dl_cygwin32.xs' usedl='y' -# flag to include the perl.exe export variable translation file extLibInc.h when -# building extension libs +# flag to include the perl.exe export variable translation file cw32imp.h +# when building extension libs cccdlflags='-DCYGWIN32 -DDLLIMPORT ' # flag that signals gcc2 to build exportable perl ccdlflags='-buildperl ' @@ -31,7 +31,7 @@ signal_t='int' useposix='false' rd_nodata='0' eagain='EAGAIN' -archname='gnuwin32' +archname='cygwin32' # installbin='/usr/local/bin' diff --git a/hints/dgux.sh b/hints/dgux.sh index d751e63a64..03b285dbd4 100644 --- a/hints/dgux.sh +++ b/hints/dgux.sh @@ -18,7 +18,7 @@ # your $LD_LIBRARY_PATH to include the source directory when you build, # test and install the software. # -# -Roderick Schertler <roderick@gate.net> +# -Roderick Schertler <roderick@argon.org> # Here are the things from some old DGUX hints files which are different diff --git a/hints/freebsd.sh b/hints/freebsd.sh index 4b7653a784..7ec8751f87 100644 --- a/hints/freebsd.sh +++ b/hints/freebsd.sh @@ -68,9 +68,11 @@ case "$osvers" in ;; # # 2.2 and above have phkmalloc(3). +# don't use -lmalloc (maybe there's an old one from 1.1.5.1 floating around) 2.2*) usevfork='true' usemymalloc='n' + libswanted=`echo $libswanted | sed 's/ malloc / /'` d_dosuid='define' d_setregid='define' d_setreuid='define' @@ -81,6 +83,7 @@ case "$osvers" in # Guesses at what will be needed after 2.2 *) usevfork='true' usemymalloc='n' + libswanted=`echo $libswanted | sed 's/ malloc / /'` ;; esac diff --git a/hints/gnuwin32.sh b/hints/gnuwin32.sh deleted file mode 100644 index abd0210273..0000000000 --- a/hints/gnuwin32.sh +++ /dev/null @@ -1,50 +0,0 @@ -#! /bin/sh -# gnuwin32.sh - hintsfile for building perl on Windows NT using the -# Cygnus Win32 Development Kit. -# See "http://www.cygnus.com/misc/gnu-win32/" to learn about the kit. -# -path_sep=\; -exe_ext='.exe' -firstmakefile='GNUmakefile' -if test -f $sh.exe; then sh=$sh.exe; fi -startsh="#!$sh" -cc='gcc2' -ld='ld2' -usrinc='/gnuwin32/H-i386-cygwin32/i386-cygwin32/include' -libpth='/gnuwin32/H-i386-cygwin32/i386-cygwin32/lib /gnuwin32/H-i386-cygwin32/lib' -libs='-lcygwin -lm -lc -lkernel32' -# dynamic lib stuff -so='dll' -#i_dlfcn='define' -dlsrc='dl_gnuwin32.xs' -usedl='y' -# flag to include the perl.exe export variable translation file extLibInc.h when -# building extension libs -cccdlflags='-DCYGWIN32 -DDLLIMPORT ' -# flag that signals gcc2 to build exportable perl -ccdlflags='-buildperl ' -lddlflags='-L../.. -L/gnuwin32/H-i386-cygwin32/i386-cygwin32/lib -lperlexp -lcygwin' -d_voidsig='undef' -extensions='Fcntl IO Opcode SDBM_File' -lns='cp' -signal_t='int' -useposix='false' -rd_nodata='0' -eagain='EAGAIN' -archname='gnuwin32' -# - -installbin='/usr/local/bin' -installman1dir='' -installman3dir='' -installprivlib='/usr/local/lib/perl5' -installscript='/usr/local/bin' - -installsitelib='/usr/local/lib/perl5/site_perl' -libc='/gnuwin32/H-i386-cygwin32/i386-cygwin32/lib/libc.a' - -perlpath='/usr/local/bin/perl' - -sitelib='/usr/local/lib/perl5/site_perl' -sitelibexp='/usr/local/lib/perl5/site_perl' -usrinc='/gnuwin32/H-i386-cygwin32/i386-cygwin32/include' diff --git a/hints/machten_2.sh b/hints/machten_2.sh index 3e12a6fa05..c406a37df7 100644 --- a/hints/machten_2.sh +++ b/hints/machten_2.sh @@ -21,6 +21,12 @@ # March 5, 1997 # # Locale, optimization, and malloc changes by Tom Phoenix Mar 15, 1997 +# +# groupstype change and note about t/lib/findbin.t by Tom, Mar 24, 1997 + +# MachTen's ability to have valid filepaths beginning with "//" may +# be causing lib/FindBin.pm to fail. I don't know how to fix it, but +# the reader is encouraged to do so! :-) -- Tom # There seem to be some hard-to-diagnose problems under MachTen's # malloc, so we'll use Perl's. If you have problems which Perl's @@ -40,7 +46,13 @@ esac # MachTen doesn't have secure setid scripts d_suidsafe='undef' -d_dosuid='define' +case "$d_dosuid" in +'') d_dosuid='define' ;; +esac + +# groupstype should be gid_t, as near as I can tell, but it only +# seems to work right when it's int. +groupstype='int' case "$optimize" in '') optimize='-O2' ;; @@ -79,4 +91,7 @@ Hmm...You had some extra variables I don't know about...I'll try to keep 'em. Read the File::Find documentation for more information. +It's possible that test t/lib/findbin.t will fail on some configurations +of MachTen. + EOM diff --git a/hints/titanos.sh b/hints/titanos.sh index 5147af09fd..cea99f82a3 100644 --- a/hints/titanos.sh +++ b/hints/titanos.sh @@ -1,6 +1,6 @@ # Hints file (perl 4.019) for Kubota Pacific's Titan 3000 Series Machines. # Created by: JT McDuffie (jt@kpc.com) 26 DEC 1991 -# p5ed by: Jarkko Hietaniemi <jhi@hut.fi> Aug 27 1994 +# p5ed by: Jarkko Hietaniemi <jhi@iki.fi> Aug 27 1994 # NOTE: You should run Configure with tcsh (yes, tcsh). # Comments by Andy Dougherty <doughera@lafcol.lafayette.edu> 28 Mar 1995 alignbytes="8" diff --git a/installhtml b/installhtml new file mode 100755 index 0000000000..a33dec3895 --- /dev/null +++ b/installhtml @@ -0,0 +1,560 @@ +#!/usr/bin/perl -w + +use Config; # for config options in the makefile +use Getopt::Long; # for command-line parsing +use Cwd; +use Pod::Html; + +umask 022; + +=head1 NAME + +installhtml - converts a collection of POD pages to HTML format. + +=head1 SYNOPSIS + + installhtml [--help] [--podpath=<name>:...:<name>] [--podroot=<name>] + [--htmldir=<name>] [--htmlroot=<name>] [--norecurse] [--recurse] + [--splithead=<name>,...,<name>] [--splititem=<name>,...,<name>] + [--libpods=<name>,...,<name>] [--verbose] + +=head1 DESCRIPTION + +I<installhtml> converts a collection of POD pages to a corresponding +collection of HTML pages. This is primarily used to convert the pod +pages found in the perl distribution. + +=head1 OPTIONS + +=over 4 + +=item B<--help> help + +Displays the usage. + +=item B<--podpath> POD search path + +The list of diretories to search for .pod and .pm files to be converted. +Default is `podroot/.'. + +=item B<--podroot> POD search path base directory + +The base directory to search for all .pod and .pm files to be converted. +Default is current directory. + +=item B<--htmldir> HTML destination directory + +The base directory which all HTML files will be written to. This should +be a path relative to the filesystem, not the resulting URL. + +=item B<--htmlroot> URL base directory + +The base directory which all resulting HTML files will be visible at in +a URL. The default is `/'. + +=item B<--recurse> recurse on subdirectories + +Whether or not to convert all .pm and .pod files found in subdirectories +too. Default is to not recurse. + +=item B<--splithead> POD files to split on =head directive + +Colon-seperated list of pod files to split by the =head directive. These +files should have names specified relative to podroot. + +=item B<--splititem> POD files to split on =item directive + +Colon-seperated list of all pod files to split by the =item directive. +I<installhtml> does not do the actual split, rather it invokes I<splitpod> +to do the dirty work. As with --splithead, these files should have names +specified relative to podroot. + +=item B<--libpods> library PODs for LE<lt>E<gt> links + +Colon-seperated list of "library" pod files. This is the same list that +will be passed to pod2html when any pod is converted. + +=item B<--verbose> verbose output + +Self-explanatory. + +=back + +=head1 EXAMPLE + +The following command-line is an example of the one we use to convert +perl documentation: + + ./installhtml --podpath=lib:ext:pod:vms \ + --podroot=/usr/src/perl \ + --htmldir=/perl/nmanual \ + --htmlroot=/perl/nmanual \ + --splithead=pod/perlipc.pod \ + --splititem=pod/perlfunc \ + --libpods=perlfunc:perlguts:perlvar:perlrun:perlop \ + --recurse \ + --verbose + +=head1 AUTHOR + +Chris Hall E<lt>hallc@cs.colorado.eduE<gt> + +=head1 TODO + +=cut + +$usage =<<END_OF_USAGE; +Usage: $0 --help --podpath=<name>:...:<name> --podroot=<name> + --htmldir=<name> --htmlroot=<name> --norecurse --recurse + --splithead=<name>,...,<name> --splititem=<name>,...,<name> + --libpods=<name>,...,<name> --verbose + + --help - this message + --podpath - colon-separated list of directories containing .pod and + .pm files to be converted (. by default). + --podroot - filesystem base directory from which all relative paths in + podpath stem (default is .). + --htmldir - directory to store resulting html files in relative + to the filesystem (\$podroot/html by default). + --htmlroot - http-server base directory from which all relative paths + in podpath stem (default is /). + --libpods - comma-separated list of files to search for =item pod + directives in as targets of C<> and implicit links (empty + by default). + --norecurse - don't recurse on those subdirectories listed in podpath. + (default behavior). + --recurse - recurse on those subdirectories listed in podpath + --splithead - comma-separated list of .pod or .pm files to split. will + split each file into several smaller files at every occurance + of a pod =head[1-6] directive. + --splititem - comma-separated list of .pod or .pm files to split using + splitpod. + --splitpod - where the program splitpod can be found (\$podroot/pod by + default). + --verbose - self-explanatory. + +END_OF_USAGE + +@libpods = (); +@podpath = ( "." ); # colon-separated list of directories containing .pod + # and .pm files to be converted. +$podroot = "."; # assume the pods we want are here +$htmldir = ""; # nothing for now... +$htmlroot = "/"; # default value +$recurse = 0; # default behavior +@splithead = (); # don't split any files by default +@splititem = (); # don't split any files by default +$splitpod = ""; # nothing for now. + +$verbose = 0; # whether or not to print debugging info + +$pod2html = "pod/pod2html"; + + +# parse the command-line +$result = GetOptions( qw( + help + podpath=s + podroot=s + htmldir=s + htmlroot=s + libpods=s + recurse! + splithead=s + splititem=s + splitpod=s + verbose +)); +usage("invalid parameters") unless $result; +parse_command_line(); + + +# set these variables to appropriate values if the user didn't specify +# values for them. +$htmldir = "$htmlroot/html" unless $htmldir; +$splitpod = "$podroot/pod" unless $splitpod; + + +# make sure that the destination directory exists +(mkdir($htmldir, 0755) || + die "$0: cannot make directory $htmldir: $!\n") if ! -d $htmldir; + + +# the following array will eventually contain files that are to be +# ignored in the conversion process. these are files that have been +# process by splititem or splithead and should not be converted as a +# result. +@ignore = (); + + +# split pods. its important to do this before convert ANY pods because +# it may effect some of the links +@splitdirs = (); # files in these directories won't get an index +split_on_head($podroot, $htmldir, \@splitdirs, \@ignore, @splithead); +split_on_item($podroot, \@splitdirs, \@ignore, @splititem); + + +# convert the pod pages found in @poddirs +#warn "converting files\n" if $verbose; +#warn "\@ignore\t= @ignore\n" if $verbose; +foreach $dir (@podpath) { + installdir($dir, $recurse, $podroot, \@splitdirs, \@ignore); +} + + +# now go through and create master indices for each pod we split +foreach $dir (@splititem) { + print "creating index $htmldir/$dir.html\n" if $verbose; + create_index("$htmldir/$dir.html", "$htmldir/$dir"); +} + +foreach $dir (@splithead) { + $dir .= ".pod" unless $dir =~ /(\.pod|\.pm)$/; + # let pod2html create the file + runpod2html($dir, 1); + + # now go through and truncate after the index + $dir =~ /^(.*?)(\.pod|\.pm)?$/sm; + $file = "$htmldir/$1"; + print "creating index $file.html\n" if $verbose; + + # read in everything until what would have been the first =head + # directive, patching the index as we go. + open(H, "<$file.html") || + die "$0: error opening $file.html for input: $!\n"; + $/ = ""; + @data = (); + while (<H>) { + last if /NAME=/; + s,HREF="#(.*)">,HREF="$file/$1.html">,g; + push @data, $_; + } + close(H); + + # now rewrite the file + open(H, ">$file.html") || + die "$0: error opening $file.html for output: $!\n"; + print H "@data\n"; + close(H); +} + +############################################################################## + + +sub usage { + warn "$0: @_\n" if @_; + die $usage; +} + + +sub parse_command_line { + usage() if defined $opt_help; + $opt_help = ""; # make -w shut up + + # list of directories + @podpath = split(":", $opt_podpath) if defined $opt_podpath; + + # lists of files + @splithead = split(",", $opt_splithead) if defined $opt_splithead; + @splititem = split(",", $opt_splititem) if defined $opt_splititem; + @libpods = split(",", $opt_libpods) if defined $opt_libpods; + + $htmldir = $opt_htmldir if defined $opt_htmldir; + $htmlroot = $opt_htmlroot if defined $opt_htmlroot; + $podroot = $opt_podroot if defined $opt_podroot; + $splitpod = $opt_splitpod if defined $opt_splitpod; + + $recurse = $opt_recurse if defined $opt_recurse; + $verbose = $opt_verbose if defined $opt_verbose; +} + + +sub create_index { + my($html, $dir) = @_; + my(@files, @filedata, @index, $file); + + # get the list of .html files in this directory + opendir(DIR, $dir) || + die "$0: error opening directory $dir for reading: $!\n"; + @files = sort(grep(/\.html$/, readdir(DIR))); + closedir(DIR); + + open(HTML, ">$html") || + die "$0: error opening $html for output: $!\n"; + + # for each .html file in the directory, extract the index + # embedded in the file and throw it into the big index. + print HTML "<DL COMPACT>\n"; + foreach $file (@files) { + $/ = ""; + + open(IN, "<$dir/$file") || + die "$0: error opening $dir/$file for input: $!\n"; + @filedata = <IN>; + close(IN); + + # pull out the NAME section + ($name) = grep(/NAME=/, @filedata); + $name =~ m,/H1>\s(\S+)\s[\s-]*(.*?)\s*$,sm; + print HTML qq(<A HREF="$dir/$file">); + print HTML "<DT>$1</A><DD>$2\n" if defined $1; +# print HTML qq(<A HREF="$dir/$file">$1</A><BR>\n") if defined $1; + + next; + + @index = grep(/<!-- INDEX BEGIN -->.*<!-- INDEX END -->/s, + @filedata); + for (@index) { + s/<!-- INDEX BEGIN -->(\s*<!--)(.*)(-->\s*)<!-- INDEX END -->/$2/s; + s,#,$dir/$file#,g; + # print HTML "$_\n"; + print HTML "$_\n<P><HR><P>\n"; + } + } + print HTML "</DL>\n"; + + close(HTML); +} + + +sub split_on_head { + my($podroot, $htmldir, $splitdirs, $ignore, @splithead) = @_; + my($pod, $dirname, $filename); + + # split the files specified in @splithead on =head[1-6] pod directives + print "splitting files by head.\n" if $verbose && $#splithead >= 0; + foreach $pod (@splithead) { + # figure out the directory name and filename + $pod =~ s,^([^/]*)$,/$1,; + $pod =~ m,(.*?)/(.*?)(\.pod)?$,; + $dirname = $1; + $filename = "$2.pod"; + + # since we are splitting this file it shouldn't be converted. + push(@$ignore, "$podroot/$dirname/$filename"); + + # split the pod + splitpod("$podroot/$dirname/$filename", "$podroot/$dirname", $htmldir, + $splitdirs); + } +} + + +sub split_on_item { + my($podroot, $splitdirs, $ignore, @splititem) = @_; + my($pwd, $dirname, $filename); + + print "splitting files by item.\n" if $verbose && $#splititem >= 0; + $pwd = getcwd(); + foreach $pod (@splititem) { + # figure out the directory to split into + $pod =~ s,^([^/]*)$,/$1,; + $pod =~ m,(.*?)/(.*?)(\.pod)?$,; + $dirname = "$1/$2"; + $filename = "$2.pod"; + + # since we are splitting this file it shouldn't be converted. + push(@$ignore, "$podroot/$dirname.pod"); + + # split the pod + push(@$splitdirs, "$podroot/$dirname"); + if (! -d "$podroot/$dirname") { + mkdir("$podroot/$dirname", 0755) || + die "$0: error creating directory $podroot/$dirname: $!\n"; + } + chdir("$podroot/$dirname") || + die "$0: error changing to directory $podroot/$dirname: $!\n"; + system("./splitpod", "../$filename"); + } + chdir($pwd); +} + + +# +# splitpod - splits a .pod file into several smaller .pod files +# where a new file is started each time a =head[1-6] pod directive +# is encountered in the input file. +# +sub splitpod { + my($pod, $poddir, $htmldir, $splitdirs) = @_; + my(@poddata, @filedata, @heads); + my($file, $i, $j, $prevsec, $section, $nextsec); + + print "splitting $pod\n" if $verbose; + + # read the file in paragraphs + $/ = ""; + open(SPLITIN, "<$pod") || + die "$0: error opening $pod for input: $!\n"; + @filedata = <SPLITIN>; + close(SPLITIN) || + die "$0: error closing $pod: $!\n"; + + # restore the file internally by =head[1-6] sections + @poddata = (); + for ($i = 0, $j = -1; $i <= $#filedata; $i++) { + $j++ if ($filedata[$i] =~ /^\s*=head[1-6]/); + if ($j >= 0) { + $poddata[$j] = "" unless defined $poddata[$j]; + $poddata[$j] .= "\n$filedata[$i]" if $j >= 0; + } + } + + # create list of =head[1-6] sections so that we can rewrite + # L<> links as necessary. + %heads = (); + foreach $i (0..$#poddata) { + $heads{htmlize($1)} = 1 if $poddata[$i] =~ /=head[1-6]\s+(.*)/; + } + + # create a directory of a similar name and store all the + # files in there + $pod =~ s,.*/(.*),$1,; # get the last part of the name + $dir = $pod; + $dir =~ s/\.pod//g; + push(@$splitdirs, "$poddir/$dir"); + mkdir("$poddir/$dir", 0755) || + die "$0: could not create directory $poddir/$dir: $!\n" + unless -d "$poddir/$dir"; + + $poddata[0] =~ /^\s*=head[1-6]\s+(.*)/; + $section = ""; + $nextsec = $1; + + # for each section of the file create a separate pod file + for ($i = 0; $i <= $#poddata; $i++) { + # determine the "prev" and "next" links + $prevsec = $section; + $section = $nextsec; + if ($i < $#poddata) { + $poddata[$i+1] =~ /^\s*=head[1-6]\s+(.*)/; + $nextsec = $1; + } else { + $nextsec = ""; + } + + # determine an appropriate filename (this must correspond with + # what pod2html will try and guess) + # $poddata[$i] =~ /^\s*=head[1-6]\s+(.*)/; + $file = "$dir/" . htmlize($section) . ".pod"; + + # create the new .pod file + print "\tcreating $poddir/$file\n" if $verbose; + open(SPLITOUT, ">$poddir/$file") || + die "$0: error opening $poddir/$file for output: $!\n"; + $poddata[$i] =~ s,L<([^<>]*)>, + defined $heads{htmlize($1)} ? "L<$dir/$1>" : "L<$1>" + ,ge; + print SPLITOUT $poddata[$i]."\n\n"; + print SPLITOUT "=over 4\n\n"; + print SPLITOUT "=item *\n\nBack to L<$dir/\"$prevsec\">\n\n" if $prevsec; + print SPLITOUT "=item *\n\nForward to L<$dir/\"$nextsec\">\n\n" if $nextsec; + print SPLITOUT "=item *\n\nUp to L<$dir>\n\n"; + print SPLITOUT "=back\n\n"; + close(SPLITOUT) || + die "$0: error closing $poddir/$file: $!\n"; + } +} + + +# +# installdir - takes care of converting the .pod and .pm files in the +# current directory to .html files and then installing those. +# +sub installdir { + my($dir, $recurse, $podroot, $splitdirs, $ignore) = @_; + my(@dirlist, @podlist, @pmlist, $doindex); + + @dirlist = (); # directories to recurse on + @podlist = (); # .pod files to install + @pmlist = (); # .pm files to install + + # should files in this directory get an index? + $doindex = (grep($_ eq "$podroot/$dir", @$splitdirs) ? 0 : 1); + + opendir(DIR, "$podroot/$dir") + || die "$0: error opening directory $podroot/$dir: $!\n"; + + # find the directories to recurse on + @dirlist = map { "$dir/$_" } + grep(-d "$podroot/$dir/$_" && !/^\.{1,2}/, readdir(DIR)) if $recurse; + rewinddir(DIR); + + # find all the .pod files within the directory + @podlist = map { /^(.*)\.pod$/; "$dir/$1" } + grep(! -d "$podroot/$dir/$_" && /\.pod$/, readdir(DIR)); + rewinddir(DIR); + + # find all the .pm files within the directory + @pmlist = map { /^(.*)\.pm$/; "$dir/$1" } + grep(! -d "$podroot/$dir/$_" && /\.pm$/, readdir(DIR)); + + closedir(DIR); + + # recurse on all subdirectories we kept track of + foreach $dir (@dirlist) { + installdir($dir, $recurse, $podroot, $splitdirs, $ignore); + } + + # install all the pods we found + foreach $pod (@podlist) { + # check if we should ignore it. + next if grep($_ eq "$podroot/$pod.pod", @$ignore); + + # check if a .pm files exists too + if (grep($_ eq "$pod.pm", @pmlist)) { + print "$0: Warning both `$podroot/$pod.pod' and " + . "`$podroot/$pod.pm' exist, using pod\n"; + push(@ignore, "$pod.pm"); + } + runpod2html("$pod.pod", $doindex); + } + + # install all the .pm files we found + foreach $pm (@pmlist) { + # check if we should ignore it. + next if grep($_ eq "$pm.pm", @ignore); + + runpod2html("$pm.pm", $doindex); + } +} + + +# +# runpod2html - invokes pod2html to convert a .pod or .pm file to a .html +# file. +# +sub runpod2html { + my($pod, $doindex) = @_; + my($html, $i, $dir, @dirs); + + $html = $pod; + $html =~ s/\.(pod|pm)$/.html/g; + + # make sure the destination directories exist + @dirs = split("/", $html); + $dir = "$htmldir/"; + for ($i = 0; $i < $#dirs; $i++) { + if (! -d "$dir$dirs[$i]") { + mkdir("$dir$dirs[$i]", 0755) || + die "$0: error creating directory $dir$dirs[$i]: $!\n"; + } + $dir .= "$dirs[$i]/"; + } + + # invoke pod2html + print "$podroot/$pod => $htmldir/$html\n" if $verbose; +#system("./pod2html", + Pod::Html'pod2html( + #Pod::Html'pod2html($pod2html, + "--htmlroot=$htmlroot", + "--podpath=".join(":", @podpath), + "--podroot=$podroot", "--netscape", + ($doindex ? "--index" : "--noindex"), + "--" . ($recurse ? "" : "no") . "recurse", + ($#libpods >= 0) ? "--libpods=" . join(":", @libpods) : "", + "--infile=$podroot/$pod", "--outfile=$htmldir/$html"); + die "$0: error running $pod2html: $!\n" if $?; +} + +sub htmlize { htmlify(0, @_) } diff --git a/installperl b/installperl index 764a6f917b..a654b268fe 100755 --- a/installperl +++ b/installperl @@ -11,7 +11,7 @@ use File::Compare; use File::Copy (); use File::Path (); use Config; -use subs qw(unlink rename link chmod); +use subs qw(unlink link chmod); # override the ones in the rest of the script sub mkpath { @@ -217,10 +217,35 @@ if (! $versiononly) { if (! $versiononly || !($installprivlib =~ m/\Q$]/)) { mkpath("${installprivlib}/pod", 1, 0777); + + # If Perl 5.003's perldiag.pod is there, rename it. + if (open POD, "${installprivlib}/pod/perldiag.pod") { + read POD, $_, 4000; + close POD; + # Some of Perl 5.003's diagnostic messages ended with periods. + if (/^=.*\.$/m) { + my ($from, $to) = ("${installprivlib}/pod/perldiag.pod", + "${installprivlib}/pod/perldiag-5.003.pod"); + print STDERR " rename $from $to"; + rename($from, $to) + or warn "Couldn't rename $from to $to: $!\n" + unless $nonono; + } + } + foreach $file (@pods) { # $file is a name like pod/perl.pod copy_if_diff($file, "${installprivlib}/${file}"); } + + # Link perldiag.pod into archlib + my ($from, $to) = ("${installprivlib}/pod/perldiag.pod", + "${installarchlib}/pod/perldiag.pod"); + if (compare($from, $to) || $nonono) { + mkpath("${installarchlib}/pod", 1, 0777); + unlink($to); + link($from, $to); + } } # Check to make sure there aren't other perls around in installer's @@ -307,7 +332,7 @@ sub safe_rename { if (-f $to and not unlink($to)) { my($i); for ($i = 1; $i < 50; $i++) { - last if CORE::rename($to, "$to.$i"); + last if rename($to, "$to.$i"); } warn("Cannot rename to `$to.$i': $!"), return 0 if $i >= 50; # Give up! diff --git a/interp.sym b/interp.sym index a82c2c4843..80ef5b59dd 100644 --- a/interp.sym +++ b/interp.sym @@ -85,7 +85,6 @@ minus_l minus_n minus_p multiline -mustcatch mystack_base mystack_mark mystack_max @@ -126,6 +125,7 @@ sortcop sortstack sortstash splitstr +start_env statcache statgv statname @@ -1,4 +0,0 @@ -#!/bin/sh -PERLPATH=/perl5.003_94 -# pass all args to the perl ld wrapper -$PERLPATH/perl $PERLPATH/perlld $* diff --git a/lib/AnyDBM_File.pm b/lib/AnyDBM_File.pm index e6a15033c3..aff3c7cdec 100644 --- a/lib/AnyDBM_File.pm +++ b/lib/AnyDBM_File.pm @@ -1,11 +1,14 @@ package AnyDBM_File; -use vars qw(@ISA); +use vars qw(@ISA); @ISA = qw(NDBM_File DB_File GDBM_File SDBM_File ODBM_File) unless @ISA; my $mod; for $mod (@ISA) { - return 1 if eval "require $mod" + if (eval "require $mod") { + @ISA = ($mod); # if we leave @ISA alone, warnings abound + return 1; + } } die "No DBM package was successfully found or installed"; @@ -15,7 +18,7 @@ die "No DBM package was successfully found or installed"; AnyDBM_File - provide framework for multiple DBMs -NDBM_File, ODBM_File, SDBM_File, GDBM_File - various DBM implementations +NDBM_File, DB_File, GDBM_File, SDBM_File, ODBM_File - various DBM implementations =head1 SYNOPSIS @@ -30,14 +33,8 @@ L<DB_File>), GDBM, SDBM (which is always there--it comes with Perl), and finally ODBM. This way old programs that used to use NDBM via dbmopen() can still do so, but new ones can reorder @ISA: - @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File); - -Note, however, that an explicit use overrides the specified order: - - use GDBM_File; - @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File); - -will only find GDBM_File. + BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File) } + use AnyDBM_File; Having multiple DBM implementations makes it trivial to copy database formats: diff --git a/lib/AutoLoader.pm b/lib/AutoLoader.pm index be6429e6e8..e2d71700d4 100644 --- a/lib/AutoLoader.pm +++ b/lib/AutoLoader.pm @@ -1,101 +1,13 @@ package AutoLoader; -use Carp; -$DB::sub = $DB::sub; # Avoid warning - -=head1 NAME - -AutoLoader - load functions only on demand - -=head1 SYNOPSIS - - package FOOBAR; - use Exporter; - use AutoLoader; - @ISA = qw(Exporter AutoLoader); - -=head1 DESCRIPTION - -This module tells its users that functions in the FOOBAR package are -to be autoloaded from F<auto/$AUTOLOAD.al>. See -L<perlsub/"Autoloading"> and L<AutoSplit>. -=head2 __END__ - -The module using the autoloader should have the special marker C<__END__> -prior to the actual subroutine declarations. All code that is before the -marker will be loaded and compiled when the module is used. At the marker, -perl will cease reading and parsing. See also the B<AutoSplit> module, a -utility that automatically splits a module into a collection of files for -autoloading. - -When a subroutine not yet in memory is called, the C<AUTOLOAD> function -attempts to locate it in a directory relative to the location of the module -file itself. As an example, assume F<POSIX.pm> is located in -F</usr/local/lib/perl5/POSIX.pm>. The autoloader will look for perl -subroutines for this package in F</usr/local/lib/perl5/auto/POSIX/*.al>. -The C<.al> file is named using the subroutine name, sans package. - -=head2 Loading Stubs - -The B<AutoLoader> module provide a special import() method that will -load the stubs (from F<autosplit.ix> file) of the calling module. -These stubs are needed to make inheritance work correctly for class -modules. - -Modules that inherit from B<AutoLoader> should always ensure that they -override the AutoLoader->import() method. If the module inherit from -B<Exporter> like shown in the I<synopis> section this is already taken -care of. For class methods an empty import() would do nicely: - - package MyClass; - use AutoLoader; # load stubs - @ISA=qw(AutoLoader); - sub import {} # hide AutoLoader::import - -You can also set up autoloading by importing the AUTOLOAD function -instead of inheriting from B<AutoLoader>: - - package MyClass; - use AutoLoader; # load stubs - *AUTOLOAD = \&AutoLoader::AUTOLOAD; - - -=head2 Package Lexicals - -Package lexicals declared with C<my> in the main block of a package using -the B<AutoLoader> will not be visible to auto-loaded functions, due to the -fact that the given scope ends at the C<__END__> marker. A module using such -variables as package globals will not work properly under the B<AutoLoader>. - -The C<vars> pragma (see L<perlmod/"vars">) may be used in such situations -as an alternative to explicitly qualifying all globals with the package -namespace. Variables pre-declared with this pragma will be visible to any -autoloaded routines (but will not be invisible outside the package, -unfortunately). - -=head2 AutoLoader vs. SelfLoader - -The B<AutoLoader> is a counterpart to the B<SelfLoader> module. Both delay -the loading of subroutines, but the B<SelfLoader> accomplishes the goal via -the C<__DATA__> marker rather than C<__END__>. While this avoids the use of -a hierarchy of disk files and the associated open/close for each routine -loaded, the B<SelfLoader> suffers a disadvantage in the one-time parsing of -the lines after C<__DATA__>, after which routines are cached. B<SelfLoader> -can also handle multiple packages in a file. - -B<AutoLoader> only reads code as it is requested, and in many cases should be -faster, but requires a machanism like B<AutoSplit> be used to create the -individual files. The B<ExtUtils::MakeMaker> will invoke B<AutoSplit> -automatically if the B<AutoLoader> is used in a module source file. - -=head1 CAVEAT - -On systems with restrictions on file name length, the file corresponding to a -subroutine may have a shorter name that the routine itself. This can lead to -conflicting file names. The I<AutoSplit> package warns of these potential -conflicts when used to split a module. +use Carp; +use vars qw(@EXPORT @EXPORT_OK); -=cut +BEGIN { + require Exporter; + @EXPORT = (); + @EXPORT_OK = qw(AUTOLOAD); +} AUTOLOAD { my $name; @@ -135,13 +47,20 @@ AUTOLOAD { } } $@ = $save; - $DB::sub = $AUTOLOAD; # Now debugger know where we are. goto &$AUTOLOAD; } - + sub import { - my ($callclass, $callfile, $callline,$path,$callpack) = caller(0); - ($callpack = $callclass) =~ s#::#/#; + my $pkg = shift; + my $callpkg = caller; + + # + # Export symbols, but not by accident of inheritance. + # + + Exporter::export $pkg, $callpkg, @_ if $pkg eq 'AutoLoader'; + + # # Try to find the autosplit index file. Eg., if the call package # is POSIX, then $INC{POSIX.pm} is something like # '/usr/local/lib/perl5/POSIX.pm', and the autosplit index file is in @@ -152,13 +71,16 @@ sub import { # $INC{POSIX.pm} is 'lib/POSIX.pm', and we want to require # 'auto/POSIX/autosplit.ix' (without the leading 'lib'). # - if (defined($path = $INC{$callpack . '.pm'})) { + + (my $calldir = $callpkg) =~ s#::#/#; + my $path = $INC{$calldir . '.pm'}; + if (defined($path)) { # Try absolute path name. - $path =~ s#^(.*)$callpack\.pm$#$1auto/$callpack/autosplit.ix#; + $path =~ s#^(.*)$calldir\.pm$#$1auto/$calldir/autosplit.ix#; eval { require $path; }; # If that failed, try relative path with normal @INC searching. if ($@) { - $path ="auto/$callpack/autosplit.ix"; + $path ="auto/$calldir/autosplit.ix"; eval { require $path; }; } carp $@ if ($@); @@ -166,3 +88,156 @@ sub import { } 1; + +__END__ + +=head1 NAME + +AutoLoader - load subroutines only on demand + +=head1 SYNOPSIS + + package Foo; + use AutoLoader 'AUTOLOAD'; # import the default AUTOLOAD subroutine + + package Bar; + use AutoLoader; # don't import AUTOLOAD, define our own + sub AUTOLOAD { + ... + $AutoLoader::AUTOLOAD = "..."; + goto &AutoLoader::AUTOLOAD; + } + +=head1 DESCRIPTION + +The B<AutoLoader> module works with the B<AutoSplit> module and the +C<__END__> token to defer the loading of some subroutines until they are +used rather than loading them all at once. + +To use B<AutoLoader>, the author of a module has to place the +definitions of subroutines to be autoloaded after an C<__END__> token. +(See L<perldata>.) The B<AutoSplit> module can then be run manually to +extract the definitions into individual files F<auto/funcname.al>. + +B<AutoLoader> implements an AUTOLOAD subroutine. When an undefined +subroutine in is called in a client module of B<AutoLoader>, +B<AutoLoader>'s AUTOLOAD subroutine attempts to locate the subroutine in a +file with a name related to the location of the file from which the +client module was read. As an example, if F<POSIX.pm> is located in +F</usr/local/lib/perl5/POSIX.pm>, B<AutoLoader> will look for perl +subroutines B<POSIX> in F</usr/local/lib/perl5/auto/POSIX/*.al>, where +the C<.al> file has the same name as the subroutine, sans package. If +such a file exists, AUTOLOAD will read and evaluate it, +thus (presumably) defining the needed subroutine. AUTOLOAD will then +C<goto> the newly defined subroutine. + +Once this process completes for a given funtion, it is defined, so +future calls to the subroutine will bypass the AUTOLOAD mechanism. + +=head2 Subroutine Stubs + +In order for object method lookup and/or prototype checking to operate +correctly even when methods have not yet been defined it is necessary to +"forward declare" each subroutine (as in C<sub NAME;>). See +L<perlsub/"SYNOPSIS">. Such forward declaration creates "subroutine +stubs", which are place holders with no code. + +The AutoSplit and B<AutoLoader> modules automate the creation of forward +declarations. The AutoSplit module creates an 'index' file containing +forward declarations of all the AutoSplit subroutines. When the +AutoLoader module is 'use'd it loads these declarations into its callers +package. + +Because of this mechanism it is important that B<AutoLoader> is always +C<use>d and not C<require>d. + +=head2 Using B<AutoLoader>'s AUTOLOAD Subroutine + +In order to use B<AutoLoader>'s AUTOLOAD subroutine you I<must> +explicitly import it: + + use AutoLoader 'AUTOLOAD'; + +=head2 Overriding B<AutoLoader>'s AUTOLOAD Subroutine + +Some modules, mainly extensions, provide their own AUTOLOAD subroutines. +They typically need to check for some special cases (such as constants) +and then fallback to B<AutoLoader>'s AUTOLOAD for the rest. + +Such modules should I<not> import B<AutoLoader>'s AUTOLOAD subroutine. +Instead, they should define their own AUTOLOAD subroutines along these +lines: + + use AutoLoader; + + sub AUTOLOAD { + my $constname; + ($constname = $AUTOLOAD) =~ s/.*:://; + my $val = constant($constname, @_ ? $_[0] : 0); + if ($! != 0) { + if ($! =~ /Invalid/) { + $AutoLoader::AUTOLOAD = $AUTOLOAD; + goto &AutoLoader::AUTOLOAD; + } + else { + croak "Your vendor has not defined constant $constname"; + } + } + eval "sub $AUTOLOAD { $val }"; + goto &$AUTOLOAD; + } + +If any module's own AUTOLOAD subroutine has no need to fallback to the +AutoLoader's AUTOLOAD subroutine (because it doesn't have any AutoSplit +subroutines), then that module should not use B<AutoLoader> at all. + +=head2 Package Lexicals + +Package lexicals declared with C<my> in the main block of a package +using B<AutoLoader> will not be visible to auto-loaded subroutines, due to +the fact that the given scope ends at the C<__END__> marker. A module +using such variables as package globals will not work properly under the +B<AutoLoader>. + +The C<vars> pragma (see L<perlmod/"vars">) may be used in such +situations as an alternative to explicitly qualifying all globals with +the package namespace. Variables pre-declared with this pragma will be +visible to any autoloaded routines (but will not be invisible outside +the package, unfortunately). + +=head2 B<AutoLoader> vs. B<SelfLoader> + +The B<AutoLoader> is similar in purpose to B<SelfLoader>: both delay the +loading of subroutines. + +B<SelfLoader> uses the C<__DATA__> marker rather than C<__END__>. +While this avoids the use of a hierarchy of disk files and the +associated open/close for each routine loaded, B<SelfLoader> suffers a +startup speed disadvantage in the one-time parsing of the lines after +C<__DATA__>, after which routines are cached. B<SelfLoader> can also +handle multiple packages in a file. + +B<AutoLoader> only reads code as it is requested, and in many cases +should be faster, but requires a machanism like B<AutoSplit> be used to +create the individual files. L<ExtUtils::MakeMaker> will invoke +B<AutoSplit> automatically if B<AutoLoader> is used in a module source +file. + +=head1 CAVEATS + +AutoLoaders prior to Perl 5.002 had a slightly different interface. Any +old modules which use B<AutoLoader> should be changed to the new calling +style. Typically this just means changing a require to a use, adding +the explicit C<'AUTOLOAD'> import if needed, and removing B<AutoLoader> +from C<@ISA>. + +On systems with restrictions on file name length, the file corresponding +to a subroutine may have a shorter name that the routine itself. This +can lead to conflicting file names. The I<AutoSplit> package warns of +these potential conflicts when used to split a module. + +=head1 SEE ALSO + +L<SelfLoader> - an autoloader that doesn't use external files. + +=cut diff --git a/lib/AutoSplit.pm b/lib/AutoSplit.pm index ab634b2330..03d76e66c3 100644 --- a/lib/AutoSplit.pm +++ b/lib/AutoSplit.pm @@ -39,7 +39,7 @@ last update of the hierarchy. The remaining three arguments to C<autosplit> govern other options to the autosplitter. If the third argument, I<$keep>, is false, then any pre-existing -C<.al> files in the autoload directory are removed if they are no longer +C<*.al> files in the autoload directory are removed if they are no longer part of the module (obsoleted functions). The fourth argument, I<$check>, instructs C<autosplit> to check the module currently being split to ensure that it does include a C<use> specification for the AutoLoader module, and diff --git a/lib/Benchmark.pm b/lib/Benchmark.pm index ee7cf74cc3..13acf869bc 100644 --- a/lib/Benchmark.pm +++ b/lib/Benchmark.pm @@ -14,11 +14,18 @@ timeit - run a chunk of code and see how long it goes timethis ($count, "code"); + # Use Perl code in strings... timethese($count, { 'Name1' => '...code1...', 'Name2' => '...code2...', }); + # ... or use subroutine references. + timethese($count, { + 'Name1' => sub { ...code1... }, + 'Name2' => sub { ...code2... }, + }); + $t = timeit($count, '...other code...') print "$count loops of other code took:",timestr($t),"\n"; @@ -46,37 +53,64 @@ Returns the current time. Example: Enables or disable debugging by setting the C<$Benchmark::Debug> flag: - debug Benchmark 1; + debug Benchmark 1; $t = timeit(10, ' 5 ** $Global '); - debug Benchmark 0; + debug Benchmark 0; =back =head2 Standard Exports -The following routines will be exported into your namespace +The following routines will be exported into your namespace if you use the Benchmark module: =over 10 =item timeit(COUNT, CODE) -Arguments: COUNT is the number of time to run the loop, and -the second is the code to run. CODE may be a string containing the code, -a reference to the function to run, or a reference to a hash containing -keys which are names and values which are more CODE specs. +Arguments: COUNT is the number of times to run the loop, and CODE is +the code to run. CODE may be either a code reference or a string to +be eval'd; either way it will be run in the caller's package. + +Returns: a Benchmark object. + +=item timethis ( COUNT, CODE, [ TITLE, [ STYLE ]] ) + +Time COUNT iterations of CODE. CODE may be a string to eval or a +code reference; either way the CODE will run in the caller's package. +Results will be printed to STDOUT as TITLE followed by the times. +TITLE defaults to "timethis COUNT" if none is provided. STYLE +determines the format of the output, as described for timestr() below. + +=item timethese ( COUNT, CODEHASHREF, [ STYLE ] ) -Side-effects: prints out noise to standard out. +The CODEHASHREF is a reference to a hash containing names as keys +and either a string to eval or a code reference for each value. +For each (KEY, VALUE) pair in the CODEHASHREF, this routine will +call -Returns: a Benchmark object. + timethis(COUNT, VALUE, KEY, STYLE) -=item timethis +=item timediff ( T1, T2 ) -=item timethese +Returns the difference between two Benchmark times as a Benchmark +object suitable for passing to timestr(). -=item timediff +=item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ]] ) -=item timestr +Returns a string that formats the times in the TIMEDIFF object in +the requested STYLE. TIMEDIFF is expected to be a Benchmark object +similar to that returned by timediff(). + +STYLE can be any of 'all', 'noc', 'nop' or 'auto'. 'all' shows each +of the 5 times available ('wallclock' time, user time, system time, +user time of children, and system time of children). 'noc' shows all +except the two children times. 'nop' shows only wallclock and the +two children times. 'auto' (the default) will act as 'all' unless +the children times are both zero, in which case it acts as 'noc'. + +FORMAT is the L<printf(3)>-style format specifier (without the +leading '%') to use to print the times. It defaults to '5.2f'. =back @@ -87,20 +121,31 @@ if you specifically ask that they be imported: =over 10 -clearcache +=item clearcache ( COUNT ) + +Clear the cached time for COUNT rounds of the null loop. + +=item clearallcache ( ) -clearallcache +Clear all cached times. -disablecache +=item disablecache ( ) -enablecache +Disable caching of timings for the null loop. This will force Benchmark +to recalculate these timings for each new piece of code timed. + +=item enablecache ( ) + +Enable caching of timings for the null loop. The time taken for COUNT +rounds of the null loop will be calculated only once for each +different COUNT used. =back =head1 NOTES The data is stored as a list of values from the time and times -functions: +functions: ($real, $user, $system, $children_user, $children_system) @@ -110,10 +155,6 @@ The timing is done using time(3) and times(3). Code is executed in the caller's package. -Enable debugging by: - - $Benchmark::debug = 1; - The time of the null loop (a loop with the same number of rounds but empty loop body) is subtracted from the time of the real loop. @@ -122,10 +163,10 @@ The null loop times are cached, the key being the number of rounds. The caching can be controlled using calls like these: - clearcache($key); + clearcache($key); clearallcache(); - disablecache(); + disablecache(); enablecache(); =head1 INHERITANCE @@ -135,12 +176,16 @@ for Exporter. =head1 CAVEATS +Comparing eval'd strings with code references will give you +inaccurate results: a code reference will show a slower +execution time than the equivalent eval'd string. + The real time timing is done using time(2) and the granularity is therefore only one second. Short tests may produce negative figures because perl -can appear to take longer to execute the empty loop -than a short test; try: +can appear to take longer to execute the empty loop +than a short test; try: timethis(100,'1'); @@ -148,99 +193,19 @@ The system time of the null loop might be slightly more than the system time of the loop with the actual code and therefore the difference might end up being E<lt> 0. -More documentation is needed :-( especially for styles and formats. - =head1 AUTHORS -Jarkko Hietaniemi E<lt>F<Jarkko.Hietaniemi@hut.fi>E<gt>, -Tim Bunce E<lt>F<Tim.Bunce@ig.co.uk>E<gt> +Jarkko Hietaniemi <F<jhi@iki.fi>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>> =head1 MODIFICATION HISTORY September 8th, 1994; by Tim Bunce. -=cut +March 28th, 1997; by Hugo van der Sanden: added support for code +references and the already documented 'debug' method; revamped +documentation. -# Purpose: benchmark running times of code. -# -# -# Usage - to time code snippets and print results: -# -# timethis($count, '...code...'); -# -# prints: -# timethis 100: 2 secs ( 0.23 usr 0.10 sys = 0.33 cpu) -# -# -# timethese($count, { -# Name1 => '...code1...', -# Name2 => '...code2...', -# ... }); -# prints: -# Benchmark: timing 100 iterations of Name1, Name2... -# Name1: 2 secs ( 0.50 usr 0.00 sys = 0.50 cpu) -# Name2: 1 secs ( 0.48 usr 0.00 sys = 0.48 cpu) -# -# The default display style will automatically add child process -# values if non-zero. -# -# -# Usage - to time sections of your own code: -# -# use Benchmark; -# $t0 = new Benchmark; -# ... your code here ... -# $t1 = new Benchmark; -# $td = &timediff($t1, $t0); -# print "the code took:",timestr($td),"\n"; -# -# $t = &timeit($count, '...other code...') -# print "$count loops of other code took:",timestr($t),"\n"; -# -# -# Data format: -# The data is stored as a list of values from the time and times -# functions: ($real, $user, $system, $children_user, $children_system) -# in seconds for the whole loop (not divided by the number of rounds). -# -# Internals: -# The timing is done using time(3) and times(3). -# -# Code is executed in the callers package -# -# Enable debugging by: $Benchmark::debug = 1; -# -# The time of the null loop (a loop with the same -# number of rounds but empty loop body) is substracted -# from the time of the real loop. -# -# The null loop times are cached, the key being the -# number of rounds. The caching can be controlled using -# &clearcache($key); &clearallcache; -# &disablecache; &enablecache; -# -# Caveats: -# -# The real time timing is done using time(2) and -# the granularity is therefore only one second. -# -# Short tests may produce negative figures because perl -# can appear to take longer to execute the empty loop -# than a short test: try timethis(100,'1'); -# -# The system time of the null loop might be slightly -# more than the system time of the loop with the actual -# code and therefore the difference might end up being < 0 -# -# More documentation is needed :-( -# Especially for styles and formats. -# -# Authors: Jarkko Hietaniemi <Jarkko.Hietaniemi@hut.fi> -# Tim Bunce <Tim.Bunce@ig.co.uk> -# -# -# Last updated: Sept 8th 94 by Tim Bunce -# +=cut use Carp; use Exporter; @@ -263,68 +228,69 @@ sub init { &clearallcache; } +sub debug { $debug = ($_[1] != 0); } + sub clearcache { delete $cache{$_[0]}; } sub clearallcache { %cache = (); } sub enablecache { $cache = 1; } sub disablecache { $cache = 0; } - # --- Functions to process the 'time' data type -sub new { my(@t)=(time, times); print "new=@t\n" if $debug; bless \@t; } +sub new { my @t = (time, times); print "new=@t\n" if $debug; bless \@t; } sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps ; } sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $cu+$cs ; } sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; } sub real { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r ; } -sub timediff{ +sub timediff { my($a, $b) = @_; - my(@r); - for($i=0; $i < @$a; ++$i){ + my @r; + for ($i=0; $i < @$a; ++$i) { push(@r, $a->[$i] - $b->[$i]); } bless \@r; } -sub timestr{ +sub timestr { my($tr, $style, $f) = @_; - my(@t) = @$tr; + my @t = @$tr; warn "bad time value" unless @t==5; my($r, $pu, $ps, $cu, $cs) = @t; my($pt, $ct, $t) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a); - $f = $defaultfmt unless $f; + $f = $defaultfmt unless defined $f; # format a time in the required style, other formats may be added here - $style = $defaultstyle unless $style; - $style = ($ct>0) ? 'all' : 'noc' if $style=~/^auto$/; - my($s) = "@t $style"; # default for unknown style + $style ||= $defaultstyle; + $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto'; + my $s = "@t $style"; # default for unknown style $s=sprintf("%2d secs (%$f usr %$f sys + %$f cusr %$f csys = %$f cpu)", - @t,$t) if $style =~ /^all$/; + @t,$t) if $style eq 'all'; $s=sprintf("%2d secs (%$f usr %$f sys = %$f cpu)", - $r,$pu,$ps,$pt) if $style =~ /^noc$/; + $r,$pu,$ps,$pt) if $style eq 'noc'; $s=sprintf("%2d secs (%$f cusr %$f csys = %$f cpu)", - $r,$cu,$cs,$ct) if $style =~ /^nop$/; + $r,$cu,$cs,$ct) if $style eq 'nop'; $s; } -sub timedebug{ + +sub timedebug { my($msg, $t) = @_; - print STDERR "$msg",timestr($t),"\n" if ($debug); + print STDERR "$msg",timestr($t),"\n" if $debug; } - # --- Functions implementing low-level support for timing loops sub runloop { my($n, $c) = @_; $n+=0; # force numeric now, so garbage won't creep into the eval - croak "negativ loopcount $n" if $n<0; - confess "Usage: runloop(number, string)" unless defined $c; + croak "negative loopcount $n" if $n<0; + confess "Usage: runloop(number, [string | coderef])" unless defined $c; my($t0, $t1, $td); # before, after, difference # find package of caller so we can execute code there - my ($curpack) = caller(0); - my ($i, $pack)= 0; + my($curpack) = caller(0); + my($i, $pack)= 0; while (($pack) = caller(++$i)) { last if $pack ne $curpack; } @@ -334,7 +300,7 @@ sub runloop { : "sub { package $pack; my(\$_i)=$n; while (\$_i--){$c;} }"; my $subref = eval $subcode; croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@; - print STDERR "runloop $n '$subcode'\n" if ($debug); + print STDERR "runloop $n '$subcode'\n" if $debug; $t0 = &new; &$subref; @@ -352,9 +318,9 @@ sub timeit { printf STDERR "timeit $n $code\n" if $debug; - if ($cache && exists $cache{$n}){ + if ($cache && exists $cache{$n}) { $wn = $cache{$n}; - }else{ + } else { $wn = &runloop($n, ''); $cache{$n} = $wn; } @@ -370,44 +336,38 @@ sub timeit { $wd; } - # --- Functions implementing high-level time-then-print utilities sub timethis{ my($n, $code, $title, $style) = @_; - my($t) = timeit($n, $code); - local($|) = 1; - $title = "timethis $n" unless $title; - $style = "" unless $style; + my $t = timeit($n, $code); + local $| = 1; + $title = "timethis $n" unless defined $title; + $style = "" unless defined $style; printf("%10s: ", $title); print timestr($t, $style),"\n"; + # A conservative warning to spot very silly tests. # Don't assume that your benchmark is ok simply because # you don't get this warning! print " (warning: too few iterations for a reliable count)\n" - if ( $n < $min_count + if $n < $min_count || ($t->real < 1 && $n < 1000) - || $t->cpu_a < $min_cpu); + || $t->cpu_a < $min_cpu; $t; } - sub timethese{ my($n, $alt, $style) = @_; die "usage: timethese(count, { 'Name1'=>'code1', ... }\n" unless ref $alt eq HASH; - my(@all); - my(@names) = sort keys %$alt; - $style = "" unless $style; + my @names = sort keys %$alt; + $style = "" unless defined $style; print "Benchmark: timing $n iterations of ",join(', ',@names),"...\n"; - foreach(@names){ - $t = timethis($n, $alt->{$_}, $_, $style); - push(@all, $t); - } - # we could produce a summary from @all here + + # we could save the results in an array and produce a summary here # sum, min, max, avg etc etc - @all; + map timethis($n, $alt->{$_}, $_, $style), @names; } - 1; diff --git a/lib/CGI.pm b/lib/CGI.pm new file mode 100644 index 0000000000..4651e138a3 --- /dev/null +++ b/lib/CGI.pm @@ -0,0 +1,4892 @@ +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.3201'; + +# 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 (defined($MOD_PERL = $ENV{'GATEWAY_INTERFACE'}) && + $MOD_PERL =~ /^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 SYNOPSIS + + use CGI; + # the rest is too complicated for a synopsis; keep reading + +=head1 ABSTRACT + +This perl library uses perl5 objects to make it easy to create +Web fill-out forms and parse their contents. This package +defines CGI objects, entities that contain the values of the +current query string and other state variables. +Using a CGI object's methods, you can examine keywords and parameters +passed to your script, and create forms whose initial values +are taken from the current query (thereby preserving state +information). + +The current version of CGI.pm is available at + + http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html + ftp://ftp-genome.wi.mit.edu/pub/software/WWW/ + +=head1 INSTALLATION: + +To install this package, just change to the directory in which this +file is found and type the following: + + perl Makefile.PL + make + make install + +This will copy CGI.pm to your perl library directory for use by all +perl scripts. You probably must be root to do this. Now you can +load the CGI routines in your Perl scripts with the line: + + use CGI; + +If you don't have sufficient privileges to install CGI.pm in the Perl +library directory, you can put CGI.pm into some convenient spot, such +as your home directory, or in cgi-bin itself and prefix all Perl +scripts that call it with something along the lines of the following +preamble: + + use lib '/home/davis/lib'; + use CGI; + +If you are using a version of perl earlier than 5.002 (such as NT perl), use +this instead: + + BEGIN { + unshift(@INC,'/home/davis/lib'); + } + use CGI; + +The CGI distribution also comes with a cute module called L<CGI::Carp>. +It redefines the die(), warn(), confess() and croak() error routines +so that they write nicely formatted error messages into the server's +error log (or to the output stream of your choice). This avoids long +hours of groping through the error and access logs, trying to figure +out which CGI script is generating error messages. If you choose, +you can even have fatal error messages echoed to the browser to avoid +the annoying and uninformative "Server Error" message. + +=head1 DESCRIPTION + +=head2 CREATING A NEW QUERY OBJECT: + + $query = new CGI; + +This will parse the input (from both POST and GET methods) and store +it into a perl5 object called $query. + +=head2 CREATING A NEW QUERY OBJECT FROM AN INPUT FILE + + $query = new CGI(INPUTFILE); + +If you provide a file handle to the new() method, it +will read parameters from the file (or STDIN, or whatever). The +file can be in any of the forms describing below under debugging +(i.e. a series of newline delimited TAG=VALUE pairs will work). +Conveniently, this type of file is created by the save() method +(see below). Multiple records can be saved and restored. + +Perl purists will be pleased to know that this syntax accepts +references to file handles, or even references to filehandle globs, +which is the "official" way to pass a filehandle: + + $query = new CGI(\*STDIN); + +You can also initialize the query object from an associative array +reference: + + $query = new CGI( {'dinosaur'=>'barney', + 'song'=>'I love you', + 'friends'=>[qw/Jessica George Nancy/]} + ); + +or from a properly formatted, URL-escaped query string: + + $query = new CGI('dinosaur=barney&color=purple'); + +To create an empty query, initialize it from an empty string or hash: + + $empty_query = new CGI(""); + -or- + $empty_query = new CGI({}); + +=head2 FETCHING A LIST OF KEYWORDS FROM THE QUERY: + + @keywords = $query->keywords + +If the script was invoked as the result of an <ISINDEX> search, the +parsed keywords can be obtained as an array using the keywords() method. + +=head2 FETCHING THE NAMES OF ALL THE PARAMETERS PASSED TO YOUR SCRIPT: + + @names = $query->param + +If the script was invoked with a parameter list +(e.g. "name1=value1&name2=value2&name3=value3"), the param() +method will return the parameter names as a list. If the +script was invoked as an <ISINDEX> script, there will be a +single parameter named 'keywords'. + +NOTE: As of version 1.5, the array of parameter names returned will +be in the same order as they were submitted by the browser. +Usually this order is the same as the order in which the +parameters are defined in the form (however, this isn't part +of the spec, and so isn't guaranteed). + +=head2 FETCHING THE VALUE OR VALUES OF A SINGLE NAMED PARAMETER: + + @values = $query->param('foo'); + + -or- + + $value = $query->param('foo'); + +Pass the param() method a single argument to fetch the value of the +named parameter. If the parameter is multivalued (e.g. from multiple +selections in a scrolling list), you can ask to receive an array. Otherwise +the method will return a single value. + +=head2 SETTING THE VALUE(S) OF A NAMED PARAMETER: + + $query->param('foo','an','array','of','values'); + +This sets the value for the named parameter 'foo' to an array of +values. This is one way to change the value of a field AFTER +the script has been invoked once before. (Another way is with +the -override parameter accepted by all methods that generate +form elements.) + +param() also recognizes a named parameter style of calling described +in more detail later: + + $query->param(-name=>'foo',-values=>['an','array','of','values']); + + -or- + + $query->param(-name=>'foo',-value=>'the value'); + +=head2 APPENDING ADDITIONAL VALUES TO A NAMED PARAMETER: + + $query->append(-name=>;'foo',-values=>['yet','more','values']); + +This adds a value or list of values to the named parameter. The +values are appended to the end of the parameter if it already exists. +Otherwise the parameter is created. Note that this method only +recognizes the named argument calling syntax. + +=head2 IMPORTING ALL PARAMETERS INTO A NAMESPACE: + + $query->import_names('R'); + +This creates a series of variables in the 'R' namespace. For example, +$R::foo, @R:foo. For keyword lists, a variable @R::keywords will appear. +If no namespace is given, this method will assume 'Q'. +WARNING: don't import anything into 'main'; this is a major security +risk!!!! + +In older versions, this method was called B<import()>. As of version 2.20, +this name has been removed completely to avoid conflict with the built-in +Perl module B<import> operator. + +=head2 DELETING A PARAMETER COMPLETELY: + + $query->delete('foo'); + +This completely clears a parameter. It sometimes useful for +resetting parameters that you don't want passed down between +script invocations. + +=head2 DELETING ALL PARAMETERS: + +$query->delete_all(); + +This clears the CGI object completely. It might be useful to ensure +that all the defaults are taken when you create a fill-out form. + +=head2 SAVING THE STATE OF THE FORM TO A FILE: + + $query->save(FILEHANDLE) + +This will write the current state of the form to the provided +filehandle. You can read it back in by providing a filehandle +to the new() method. Note that the filehandle can be a file, a pipe, +or whatever! + +The format of the saved file is: + + NAME1=VALUE1 + NAME1=VALUE1' + NAME2=VALUE2 + NAME3=VALUE3 + = + +Both name and value are URL escaped. Multi-valued CGI parameters are +represented as repeated names. A session record is delimited by a +single = symbol. You can write out multiple records and read them +back in with several calls to B<new>. You can do this across several +sessions by opening the file in append mode, allowing you to create +primitive guest books, or to keep a history of users' queries. Here's +a short example of creating multiple session records: + + use CGI; + + open (OUT,">>test.out") || die; + $records = 5; + foreach (0..$records) { + my $q = new CGI; + $q->param(-name=>'counter',-value=>$_); + $q->save(OUT); + } + close OUT; + + # reopen for reading + open (IN,"test.out") || die; + while (!eof(IN)) { + my $q = new CGI(IN); + print $q->param('counter'),"\n"; + } + +The file format used for save/restore is identical to that used by the +Whitehead Genome Center's data exchange format "Boulderio", and can be +manipulated and even databased using Boulderio utilities. See + + http://www.genome.wi.mit.edu/genome_software/other/boulder.html + +for further details. + +=head2 CREATING A SELF-REFERENCING URL THAT PRESERVES STATE INFORMATION: + + $myself = $query->self_url; + print "<A HREF=$myself>I'm talking to myself.</A>"; + +self_url() will return a URL, that, when selected, will reinvoke +this script with all its state information intact. This is most +useful when you want to jump around within the document using +internal anchors but you don't want to disrupt the current contents +of the form(s). Something like this will do the trick. + + $myself = $query->self_url; + print "<A HREF=$myself#table1>See table 1</A>"; + print "<A HREF=$myself#table2>See table 2</A>"; + print "<A HREF=$myself#yourself>See for yourself</A>"; + +If you don't want to get the whole query string, call +the method url() to return just the URL for the script: + + $myself = $query->url; + print "<A HREF=$myself>No query string in this baby!</A>\n"; + +You can also retrieve the unprocessed query string with query_string(): + + $the_string = $query->query_string; + +=head2 COMPATIBILITY WITH CGI-LIB.PL + +To make it easier to port existing programs that use cgi-lib.pl +the compatibility routine "ReadParse" is provided. Porting is +simple: + +OLD VERSION + require "cgi-lib.pl"; + &ReadParse; + print "The value of the antique is $in{antique}.\n"; + +NEW VERSION + use CGI; + CGI::ReadParse + print "The value of the antique is $in{antique}.\n"; + +CGI.pm's ReadParse() routine creates a tied variable named %in, +which can be accessed to obtain the query variables. Like +ReadParse, you can also provide your own variable. Infrequently +used features of ReadParse, such as the creation of @in and $in +variables, are not supported. + +Once you use ReadParse, you can retrieve the query object itself +this way: + + $q = $in{CGI}; + print $q->textfield(-name=>'wow', + -value=>'does this really work?'); + +This allows you to start using the more interesting features +of CGI.pm without rewriting your old scripts from scratch. + +=head2 CALLING CGI FUNCTIONS THAT TAKE MULTIPLE ARGUMENTS + +In versions of CGI.pm prior to 2.0, it could get difficult to remember +the proper order of arguments in CGI function calls that accepted five +or six different arguments. As of 2.0, there's a better way to pass +arguments to the various CGI functions. In this style, you pass a +series of name=>argument pairs, like this: + + $field = $query->radio_group(-name=>'OS', + -values=>[Unix,Windows,Macintosh], + -default=>'Unix'); + +The advantages of this style are that you don't have to remember the +exact order of the arguments, and if you leave out a parameter, in +most cases it will default to some reasonable value. If you provide +a parameter that the method doesn't recognize, it will usually do +something useful with it, such as incorporating it into the HTML form +tag. For example if Netscape decides next week to add a new +JUSTIFICATION parameter to the text field tags, you can start using +the feature without waiting for a new version of CGI.pm: + + $field = $query->textfield(-name=>'State', + -default=>'gaseous', + -justification=>'RIGHT'); + +This will result in an HTML tag that looks like this: + + <INPUT TYPE="textfield" NAME="State" VALUE="gaseous" + JUSTIFICATION="RIGHT"> + +Parameter names are case insensitive: you can use -name, or -Name or +-NAME. You don't have to use the hyphen if you don't want to. After +creating a CGI object, call the B<use_named_parameters()> method with +a nonzero value. This will tell CGI.pm that you intend to use named +parameters exclusively: + + $query = new CGI; + $query->use_named_parameters(1); + $field = $query->radio_group('name'=>'OS', + 'values'=>['Unix','Windows','Macintosh'], + 'default'=>'Unix'); + +Actually, CGI.pm only looks for a hyphen in the first parameter. So +you can leave it off subsequent parameters if you like. Something to +be wary of is the potential that a string constant like "values" will +collide with a keyword (and in fact it does!) While Perl usually +figures out when you're referring to a function and when you're +referring to a string, you probably should put quotation marks around +all string constants just to play it safe. + +=head2 CREATING THE HTTP HEADER: + + print $query->header; + + -or- + + print $query->header('image/gif'); + + -or- + + print $query->header('text/html','204 No response'); + + -or- + + print $query->header(-type=>'image/gif', + -nph=>1, + -status=>'402 Payment required', + -expires=>'+3d', + -cookie=>$cookie, + -Cost=>'$2.00'); + +header() returns the Content-type: header. You can provide your own +MIME type if you choose, otherwise it defaults to text/html. An +optional second parameter specifies the status code and a human-readable +message. For example, you can specify 204, "No response" to create a +script that tells the browser to do nothing at all. If you want to +add additional fields to the header, just tack them on to the end: + + print $query->header('text/html','200 OK','Content-Length: 3002'); + +The last example shows the named argument style for passing arguments +to the CGI methods using named parameters. Recognized parameters are +B<-type>, B<-status>, B<-expires>, and B<-cookie>. Any other +parameters will be stripped of their initial hyphens and turned into +header fields, allowing you to specify any HTTP header you desire. + +Most browsers will not cache the output from CGI scripts. Every time +the browser reloads the page, the script is invoked anew. You can +change this behavior with the B<-expires> parameter. When you specify +an absolute or relative expiration interval with this parameter, some +browsers and proxy servers will cache the script's output until the +indicated expiration date. The following forms are all valid for the +-expires field: + + +30s 30 seconds from now + +10m ten minutes from now + +1h one hour from now + -1d yesterday (i.e. "ASAP!") + now immediately + +3M in three months + +10y in ten years time + Thursday, 25-Apr-96 00:40:33 GMT at the indicated time & date + +(CGI::expires() is the static function call used internally that turns +relative time intervals into HTTP dates. You can call it directly if +you wish.) + +The B<-cookie> parameter generates a header that tells the browser to provide +a "magic cookie" during all subsequent transactions with your script. +Netscape cookies have a special format that includes interesting attributes +such as expiration time. Use the cookie() method to create and retrieve +session cookies. + +The B<-nph> parameter, if set to a true value, will issue the correct +headers to work with a NPH (no-parse-header) script. This is important +to use with certain servers, such as Microsoft Internet Explorer, which +expect all their scripts to be NPH. + +=head2 GENERATING A REDIRECTION INSTRUCTION + + print $query->redirect('http://somewhere.else/in/movie/land'); + +redirects the browser elsewhere. If you use redirection like this, +you should B<not> print out a header as well. As of version 2.0, we +produce both the unofficial Location: header and the official URI: +header. This should satisfy most servers and browsers. + +One hint I can offer is that relative links may not work correctly +when when you generate a redirection to another document on your site. +This is due to a well-intentioned optimization that some servers use. +The solution to this is to use the full URL (including the http: part) +of the document you are redirecting to. + +You can use named parameters: + + print $query->redirect(-uri=>'http://somewhere.else/in/movie/land', + -nph=>1); + +The B<-nph> parameter, if set to a true value, will issue the correct +headers to work with a NPH (no-parse-header) script. This is important +to use with certain servers, such as Microsoft Internet Explorer, which +expect all their scripts to be NPH. + + +=head2 CREATING THE HTML HEADER: + + print $query->start_html(-title=>'Secrets of the Pyramids', + -author=>'fred@capricorn.org', + -base=>'true', + -target=>'_blank', + -meta=>{'keywords'=>'pharaoh secret mummy', + 'copyright'=>'copyright 1996 King Tut'}, + -BGCOLOR=>'blue'); + + -or- + + print $query->start_html('Secrets of the Pyramids', + 'fred@capricorn.org','true', + 'BGCOLOR="blue"'); + +This will return a canned HTML header and the opening <BODY> tag. +All parameters are optional. In the named parameter form, recognized +parameters are -title, -author, -base, -xbase and -target (see below for the +explanation). Any additional parameters you provide, such as the +Netscape unofficial BGCOLOR attribute, are added to the <BODY> tag. + +The argument B<-xbase> allows you to provide an HREF for the <BASE> tag +different from the current location, as in + + -xbase=>"http://home.mcom.com/" + +All relative links will be interpreted relative to this tag. + +The argument B<-target> allows you to provide a default target frame +for all the links and fill-out forms on the page. See the Netscape +documentation on frames for details of how to manipulate this. + + -target=>"answer_window" + +All relative links will be interpreted relative to this tag. +You add arbitrary meta information to the header with the B<-meta> +argument. This argument expects a reference to an associative array +containing name/value pairs of meta information. These will be turned +into a series of header <META> tags that look something like this: + + <META NAME="keywords" CONTENT="pharaoh secret mummy"> + <META NAME="description" CONTENT="copyright 1996 King Tut"> + +There is no support for the HTTP-EQUIV type of <META> tag. This is +because you can modify the HTTP header directly with the B<header()> +method. + +JAVASCRIPTING: The B<-script>, B<-onLoad> and B<-onUnload> parameters +are used to add Netscape JavaScript calls to your pages. B<-script> +should point to a block of text containing JavaScript function +definitions. This block will be placed within a <SCRIPT> block inside +the HTML (not HTTP) header. The block is placed in the header in +order to give your page a fighting chance of having all its JavaScript +functions in place even if the user presses the stop button before the +page has loaded completely. CGI.pm attempts to format the script in +such a way that JavaScript-naive browsers will not choke on the code: +unfortunately there are some browsers, such as Chimera for Unix, that +get confused by it nevertheless. + +The B<-onLoad> and B<-onUnload> parameters point to fragments of JavaScript +code to execute when the page is respectively opened and closed by the +browser. Usually these parameters are calls to functions defined in the +B<-script> field: + + $query = new CGI; + print $query->header; + $JSCRIPT=<<END; + // Ask a silly question + function riddle_me_this() { + var r = prompt("What walks on four legs in the morning, " + + "two legs in the afternoon, " + + "and three legs in the evening?"); + response(r); + } + // Get a silly answer + function response(answer) { + if (answer == "man") + alert("Right you are!"); + else + alert("Wrong! Guess again."); + } + END + print $query->start_html(-title=>'The Riddle of the Sphinx', + -script=>$JSCRIPT); + +See + + http://home.netscape.com/eng/mozilla/2.0/handbook/javascript/ + +for more information about JavaScript. + +The old-style positional parameters are as follows: + +=over 4 + +=item B<Parameters:> + +=item 1. + +The title + +=item 2. + +The author's e-mail address (will create a <LINK REV="MADE"> tag if present + +=item 3. + +A 'true' flag if you want to include a <BASE> tag in the header. This +helps resolve relative addresses to absolute ones when the document is moved, +but makes the document hierarchy non-portable. Use with care! + +=item 4, 5, 6... + +Any other parameters you want to include in the <BODY> tag. This is a good +place to put Netscape extensions, such as colors and wallpaper patterns. + +=back + +=head2 ENDING THE HTML DOCUMENT: + + print $query->end_html + +This ends an HTML document by printing the </BODY></HTML> tags. + +=head1 CREATING FORMS: + +I<General note> The various form-creating methods all return strings +to the caller, containing the tag or tags that will create the requested +form element. You are responsible for actually printing out these strings. +It's set up this way so that you can place formatting tags +around the form elements. + +I<Another note> The default values that you specify for the forms are only +used the B<first> time the script is invoked (when there is no query +string). On subsequent invocations of the script (when there is a query +string), the former values are used even if they are blank. + +If you want to change the value of a field from its previous value, you have two +choices: + +(1) call the param() method to set it. + +(2) use the -override (alias -force) parameter (a new feature in version 2.15). +This forces the default value to be used, regardless of the previous value: + + print $query->textfield(-name=>'field_name', + -default=>'starting value', + -override=>1, + -size=>50, + -maxlength=>80); + +I<Yet another note> By default, the text and labels of form elements are +escaped according to HTML rules. This means that you can safely use +"<CLICK ME>" as the label for a button. However, it also interferes with +your ability to incorporate special HTML character sequences, such as Á, +into your fields. If you wish to turn off automatic escaping, call the +autoEscape() method with a false value immediately after creating the CGI object: + + $query = new CGI; + $query->autoEscape(undef); + + +=head2 CREATING AN ISINDEX TAG + + print $query->isindex(-action=>$action); + + -or- + + print $query->isindex($action); + +Prints out an <ISINDEX> tag. Not very exciting. The parameter +-action specifies the URL of the script to process the query. The +default is to process the query with the current script. + +=head2 STARTING AND ENDING A FORM + + print $query->startform(-method=>$method, + -action=>$action, + -encoding=>$encoding); + <... various form stuff ...> + print $query->endform; + + -or- + + print $query->startform($method,$action,$encoding); + <... various form stuff ...> + print $query->endform; + +startform() will return a <FORM> tag with the optional method, +action and form encoding that you specify. The defaults are: + + method: POST + action: this script + encoding: application/x-www-form-urlencoded + +endform() returns the closing </FORM> tag. + +Startform()'s encoding method tells the browser how to package the various +fields of the form before sending the form to the server. Two +values are possible: + +=over 4 + +=item B<application/x-www-form-urlencoded> + +This is the older type of encoding used by all browsers prior to +Netscape 2.0. It is compatible with many CGI scripts and is +suitable for short fields containing text data. For your +convenience, CGI.pm stores the name of this encoding +type in B<$CGI::URL_ENCODED>. + +=item B<multipart/form-data> + +This is the newer type of encoding introduced by Netscape 2.0. +It is suitable for forms that contain very large fields or that +are intended for transferring binary data. Most importantly, +it enables the "file upload" feature of Netscape 2.0 forms. For +your convenience, CGI.pm stores the name of this encoding type +in B<$CGI::MULTIPART> + +Forms that use this type of encoding are not easily interpreted +by CGI scripts unless they use CGI.pm or another library designed +to handle them. + +=back + +For compatibility, the startform() method uses the older form of +encoding by default. If you want to use the newer form of encoding +by default, you can call B<start_multipart_form()> instead of +B<startform()>. + +JAVASCRIPTING: The B<-name> and B<-onSubmit> parameters are provided +for use with JavaScript. The -name parameter gives the +form a name so that it can be identified and manipulated by +JavaScript functions. -onSubmit should point to a JavaScript +function that will be executed just before the form is submitted to your +server. You can use this opportunity to check the contents of the form +for consistency and completeness. If you find something wrong, you +can put up an alert box or maybe fix things up yourself. You can +abort the submission by returning false from this function. + +Usually the bulk of JavaScript functions are defined in a <SCRIPT> +block in the HTML header and -onSubmit points to one of these function +call. See start_html() for details. + +=head2 CREATING A TEXT FIELD + + print $query->textfield(-name=>'field_name', + -default=>'starting value', + -size=>50, + -maxlength=>80); + -or- + + print $query->textfield('field_name','starting value',50,80); + +textfield() will return a text input field. + +=over 4 + +=item B<Parameters> + +=item 1. + +The first parameter is the required name for the field (-name). + +=item 2. + +The optional second parameter is the default starting value for the field +contents (-default). + +=item 3. + +The optional third parameter is the size of the field in + characters (-size). + +=item 4. + +The optional fourth parameter is the maximum number of characters the + field will accept (-maxlength). + +=back + +As with all these methods, the field will be initialized with its +previous contents from earlier invocations of the script. +When the form is processed, the value of the text field can be +retrieved with: + + $value = $query->param('foo'); + +If you want to reset it from its initial value after the script has been +called once, you can do so like this: + + $query->param('foo',"I'm taking over this value!"); + +NEW AS OF VERSION 2.15: If you don't want the field to take on its previous +value, you can force its current value by using the -override (alias -force) +parameter: + + print $query->textfield(-name=>'field_name', + -default=>'starting value', + -override=>1, + -size=>50, + -maxlength=>80); + +JAVASCRIPTING: You can also provide B<-onChange>, B<-onFocus>, B<-onBlur> +and B<-onSelect> parameters to register JavaScript event handlers. +The onChange handler will be called whenever the user changes the +contents of the text field. You can do text validation if you like. +onFocus and onBlur are called respectively when the insertion point +moves into and out of the text field. onSelect is called when the +user changes the portion of the text that is selected. + +=head2 CREATING A BIG TEXT FIELD + + print $query->textarea(-name=>'foo', + -default=>'starting value', + -rows=>10, + -columns=>50); + + -or + + print $query->textarea('foo','starting value',10,50); + +textarea() is just like textfield, but it allows you to specify +rows and columns for a multiline text entry box. You can provide +a starting value for the field, which can be long and contain +multiple lines. + +JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur> +and B<-onSelect> parameters are recognized. See textfield(). + +=head2 CREATING A PASSWORD FIELD + + print $query->password_field(-name=>'secret', + -value=>'starting value', + -size=>50, + -maxlength=>80); + -or- + + print $query->password_field('secret','starting value',50,80); + +password_field() is identical to textfield(), except that its contents +will be starred out on the web page. + +JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur> +and B<-onSelect> parameters are recognized. See textfield(). + +=head2 CREATING A FILE UPLOAD FIELD + + print $query->filefield(-name=>'uploaded_file', + -default=>'starting value', + -size=>50, + -maxlength=>80); + -or- + + print $query->filefield('uploaded_file','starting value',50,80); + +filefield() will return a file upload field for Netscape 2.0 browsers. +In order to take full advantage of this I<you must use the new +multipart encoding scheme> for the form. You can do this either +by calling B<startform()> with an encoding type of B<$CGI::MULTIPART>, +or by calling the new method B<start_multipart_form()> instead of +vanilla B<startform()>. + +=over 4 + +=item B<Parameters> + +=item 1. + +The first parameter is the required name for the field (-name). + +=item 2. + +The optional second parameter is the starting value for the field contents +to be used as the default file name (-default). + +The beta2 version of Netscape 2.0 currently doesn't pay any attention +to this field, and so the starting value will always be blank. Worse, +the field loses its "sticky" behavior and forgets its previous +contents. The starting value field is called for in the HTML +specification, however, and possibly later versions of Netscape will +honor it. + +=item 3. + +The optional third parameter is the size of the field in +characters (-size). + +=item 4. + +The optional fourth parameter is the maximum number of characters the +field will accept (-maxlength). + +=back + +When the form is processed, you can retrieve the entered filename +by calling param(). + + $filename = $query->param('uploaded_file'); + +In Netscape Gold, the filename that gets returned is the full local filename +on the B<remote user's> machine. If the remote user is on a Unix +machine, the filename will follow Unix conventions: + + /path/to/the/file + +On an MS-DOS/Windows and OS/2 machines, the filename will follow DOS conventions: + + C:\PATH\TO\THE\FILE.MSW + +On a Macintosh machine, the filename will follow Mac conventions: + + HD 40:Desktop Folder:Sort Through:Reminders + +The filename returned is also a file handle. You can read the contents +of the file using standard Perl file reading calls: + + # Read a text file and print it out + while (<$filename>) { + print; + } + + # Copy a binary file to somewhere safe + open (OUTFILE,">>/usr/local/web/users/feedback"); + while ($bytesread=read($filename,$buffer,1024)) { + print OUTFILE $buffer; + } + +When a file is uploaded the browser usually sends along some +information along with it in the format of headers. The information +usually includes the MIME content type. Future browsers may send +other information as well (such as modification date and size). To +retrieve this information, call uploadInfo(). It returns a reference to +an associative array containing all the document headers. + + $filename = $query->param('uploaded_file'); + $type = $query->uploadInfo($filename)->{'Content-Type'}; + unless ($type eq 'text/html') { + die "HTML FILES ONLY!"; + } + +If you are using a machine that recognizes "text" and "binary" data +modes, be sure to understand when and how to use them (see the Camel book). +Otherwise you may find that binary files are corrupted during file uploads. + +JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur> +and B<-onSelect> parameters are recognized. See textfield() +for details. + +=head2 CREATING A POPUP MENU + + print $query->popup_menu('menu_name', + ['eenie','meenie','minie'], + 'meenie'); + + -or- + + %labels = ('eenie'=>'your first choice', + 'meenie'=>'your second choice', + 'minie'=>'your third choice'); + print $query->popup_menu('menu_name', + ['eenie','meenie','minie'], + 'meenie',\%labels); + + -or (named parameter style)- + + print $query->popup_menu(-name=>'menu_name', + -values=>['eenie','meenie','minie'], + -default=>'meenie', + -labels=>\%labels); + +popup_menu() creates a menu. + +=over 4 + +=item 1. + +The required first argument is the menu's name (-name). + +=item 2. + +The required second argument (-values) is an array B<reference> +containing the list of menu items in the menu. You can pass the +method an anonymous array, as shown in the example, or a reference to +a named array, such as "\@foo". + +=item 3. + +The optional third parameter (-default) is the name of the default +menu choice. If not specified, the first item will be the default. +The values of the previous choice will be maintained across queries. + +=item 4. + +The optional fourth parameter (-labels) is provided for people who +want to use different values for the user-visible label inside the +popup menu nd the value returned to your script. It's a pointer to an +associative array relating menu values to user-visible labels. If you +leave this parameter blank, the menu values will be displayed by +default. (You can also leave a label undefined if you want to). + +=back + +When the form is processed, the selected value of the popup menu can +be retrieved using: + + $popup_menu_value = $query->param('menu_name'); + +JAVASCRIPTING: popup_menu() recognizes the following event handlers: +B<-onChange>, B<-onFocus>, and B<-onBlur>. See the textfield() +section for details on when these handlers are called. + +=head2 CREATING A SCROLLING LIST + + print $query->scrolling_list('list_name', + ['eenie','meenie','minie','moe'], + ['eenie','moe'],5,'true'); + -or- + + print $query->scrolling_list('list_name', + ['eenie','meenie','minie','moe'], + ['eenie','moe'],5,'true', + \%labels); + + -or- + + print $query->scrolling_list(-name=>'list_name', + -values=>['eenie','meenie','minie','moe'], + -default=>['eenie','moe'], + -size=>5, + -multiple=>'true', + -labels=>\%labels); + +scrolling_list() creates a scrolling list. + +=over 4 + +=item B<Parameters:> + +=item 1. + +The first and second arguments are the list name (-name) and values +(-values). As in the popup menu, the second argument should be an +array reference. + +=item 2. + +The optional third argument (-default) can be either a reference to a +list containing the values to be selected by default, or can be a +single value to select. If this argument is missing or undefined, +then nothing is selected when the list first appears. In the named +parameter version, you can use the synonym "-defaults" for this +parameter. + +=item 3. + +The optional fourth argument is the size of the list (-size). + +=item 4. + +The optional fifth argument can be set to true to allow multiple +simultaneous selections (-multiple). Otherwise only one selection +will be allowed at a time. + +=item 5. + +The optional sixth argument is a pointer to an associative array +containing long user-visible labels for the list items (-labels). +If not provided, the values will be displayed. + +When this form is processed, all selected list items will be returned as +a list under the parameter name 'list_name'. The values of the +selected items can be retrieved with: + + @selected = $query->param('list_name'); + +=back + +JAVASCRIPTING: scrolling_list() recognizes the following event handlers: +B<-onChange>, B<-onFocus>, and B<-onBlur>. See textfield() for +the description of when these handlers are called. + +=head2 CREATING A GROUP OF RELATED CHECKBOXES + + print $query->checkbox_group(-name=>'group_name', + -values=>['eenie','meenie','minie','moe'], + -default=>['eenie','moe'], + -linebreak=>'true', + -labels=>\%labels); + + print $query->checkbox_group('group_name', + ['eenie','meenie','minie','moe'], + ['eenie','moe'],'true',\%labels); + + HTML3-COMPATIBLE BROWSERS ONLY: + + print $query->checkbox_group(-name=>'group_name', + -values=>['eenie','meenie','minie','moe'], + -rows=2,-columns=>2); + + +checkbox_group() creates a list of checkboxes that are related +by the same name. + +=over 4 + +=item B<Parameters:> + +=item 1. + +The first and second arguments are the checkbox name and values, +respectively (-name and -values). As in the popup menu, the second +argument should be an array reference. These values are used for the +user-readable labels printed next to the checkboxes as well as for the +values passed to your script in the query string. + +=item 2. + +The optional third argument (-default) can be either a reference to a +list containing the values to be checked by default, or can be a +single value to checked. If this argument is missing or undefined, +then nothing is selected when the list first appears. + +=item 3. + +The optional fourth argument (-linebreak) can be set to true to place +line breaks between the checkboxes so that they appear as a vertical +list. Otherwise, they will be strung together on a horizontal line. + +=item 4. + +The optional fifth argument is a pointer to an associative array +relating the checkbox values to the user-visible labels that will will +be printed next to them (-labels). If not provided, the values will +be used as the default. + +=item 5. + +B<HTML3-compatible browsers> (such as Netscape) can take advantage +of the optional +parameters B<-rows>, and B<-columns>. These parameters cause +checkbox_group() to return an HTML3 compatible table containing +the checkbox group formatted with the specified number of rows +and columns. You can provide just the -columns parameter if you +wish; checkbox_group will calculate the correct number of rows +for you. + +To include row and column headings in the returned table, you +can use the B<-rowheader> and B<-colheader> parameters. Both +of these accept a pointer to an array of headings to use. +The headings are just decorative. They don't reorganize the +interpretation of the checkboxes -- they're still a single named +unit. + +=back + +When the form is processed, all checked boxes will be returned as +a list under the parameter name 'group_name'. The values of the +"on" checkboxes can be retrieved with: + + @turned_on = $query->param('group_name'); + +The value returned by checkbox_group() is actually an array of button +elements. You can capture them and use them within tables, lists, +or in other creative ways: + + @h = $query->checkbox_group(-name=>'group_name',-values=>\@values); + &use_in_creative_way(@h); + +JAVASCRIPTING: checkbox_group() recognizes the B<-onClick> +parameter. This specifies a JavaScript code fragment or +function call to be executed every time the user clicks on +any of the buttons in the group. You can retrieve the identity +of the particular button clicked on using the "this" variable. + +=head2 CREATING A STANDALONE CHECKBOX + + print $query->checkbox(-name=>'checkbox_name', + -checked=>'checked', + -value=>'ON', + -label=>'CLICK ME'); + + -or- + + print $query->checkbox('checkbox_name','checked','ON','CLICK ME'); + +checkbox() is used to create an isolated checkbox that isn't logically +related to any others. + +=over 4 + +=item B<Parameters:> + +=item 1. + +The first parameter is the required name for the checkbox (-name). It +will also be used for the user-readable label printed next to the +checkbox. + +=item 2. + +The optional second parameter (-checked) specifies that the checkbox +is turned on by default. Synonyms are -selected and -on. + +=item 3. + +The optional third parameter (-value) specifies the value of the +checkbox when it is checked. If not provided, the word "on" is +assumed. + +=item 4. + +The optional fourth parameter (-label) is the user-readable label to +be attached to the checkbox. If not provided, the checkbox name is +used. + +=back + +The value of the checkbox can be retrieved using: + + $turned_on = $query->param('checkbox_name'); + +JAVASCRIPTING: checkbox() recognizes the B<-onClick> +parameter. See checkbox_group() for further details. + +=head2 CREATING A RADIO BUTTON GROUP + + print $query->radio_group(-name=>'group_name', + -values=>['eenie','meenie','minie'], + -default=>'meenie', + -linebreak=>'true', + -labels=>\%labels); + + -or- + + print $query->radio_group('group_name',['eenie','meenie','minie'], + 'meenie','true',\%labels); + + + HTML3-COMPATIBLE BROWSERS ONLY: + + print $query->radio_group(-name=>'group_name', + -values=>['eenie','meenie','minie','moe'], + -rows=2,-columns=>2); + +radio_group() creates a set of logically-related radio buttons +(turning one member of the group on turns the others off) + +=over 4 + +=item B<Parameters:> + +=item 1. + +The first argument is the name of the group and is required (-name). + +=item 2. + +The second argument (-values) is the list of values for the radio +buttons. The values and the labels that appear on the page are +identical. Pass an array I<reference> in the second argument, either +using an anonymous array, as shown, or by referencing a named array as +in "\@foo". + +=item 3. + +The optional third parameter (-default) is the name of the default +button to turn on. If not specified, the first item will be the +default. You can provide a nonexistent button name, such as "-" to +start up with no buttons selected. + +=item 4. + +The optional fourth parameter (-linebreak) can be set to 'true' to put +line breaks between the buttons, creating a vertical list. + +=item 5. + +The optional fifth parameter (-labels) is a pointer to an associative +array relating the radio button values to user-visible labels to be +used in the display. If not provided, the values themselves are +displayed. + +=item 6. + +B<HTML3-compatible browsers> (such as Netscape) can take advantage +of the optional +parameters B<-rows>, and B<-columns>. These parameters cause +radio_group() to return an HTML3 compatible table containing +the radio group formatted with the specified number of rows +and columns. You can provide just the -columns parameter if you +wish; radio_group will calculate the correct number of rows +for you. + +To include row and column headings in the returned table, you +can use the B<-rowheader> and B<-colheader> parameters. Both +of these accept a pointer to an array of headings to use. +The headings are just decorative. They don't reorganize the +interpetation of the radio buttons -- they're still a single named +unit. + +=back + +When the form is processed, the selected radio button can +be retrieved using: + + $which_radio_button = $query->param('group_name'); + +The value returned by radio_group() is actually an array of button +elements. You can capture them and use them within tables, lists, +or in other creative ways: + + @h = $query->radio_group(-name=>'group_name',-values=>\@values); + &use_in_creative_way(@h); + +=head2 CREATING A SUBMIT BUTTON + + print $query->submit(-name=>'button_name', + -value=>'value'); + + -or- + + print $query->submit('button_name','value'); + +submit() will create the query submission button. Every form +should have one of these. + +=over 4 + +=item B<Parameters:> + +=item 1. + +The first argument (-name) is optional. You can give the button a +name if you have several submission buttons in your form and you want +to distinguish between them. The name will also be used as the +user-visible label. Be aware that a few older browsers don't deal with this correctly and +B<never> send back a value from a button. + +=item 2. + +The second argument (-value) is also optional. This gives the button +a value that will be passed to your script in the query string. + +=back + +You can figure out which button was pressed by using different +values for each one: + + $which_one = $query->param('button_name'); + +JAVASCRIPTING: radio_group() recognizes the B<-onClick> +parameter. See checkbox_group() for further details. + +=head2 CREATING A RESET BUTTON + + print $query->reset + +reset() creates the "reset" button. Note that it restores the +form to its value from the last time the script was called, +NOT necessarily to the defaults. + +=head2 CREATING A DEFAULT BUTTON + + print $query->defaults('button_label') + +defaults() creates a button that, when invoked, will cause the +form to be completely reset to its defaults, wiping out all the +changes the user ever made. + +=head2 CREATING A HIDDEN FIELD + + print $query->hidden(-name=>'hidden_name', + -default=>['value1','value2'...]); + + -or- + + print $query->hidden('hidden_name','value1','value2'...); + +hidden() produces a text field that can't be seen by the user. It +is useful for passing state variable information from one invocation +of the script to the next. + +=over 4 + +=item B<Parameters:> + +=item 1. + +The first argument is required and specifies the name of this +field (-name). + +=item 2. + +The second argument is also required and specifies its value +(-default). In the named parameter style of calling, you can provide +a single value here or a reference to a whole list + +=back + +Fetch the value of a hidden field this way: + + $hidden_value = $query->param('hidden_name'); + +Note, that just like all the other form elements, the value of a +hidden field is "sticky". If you want to replace a hidden field with +some other values after the script has been called once you'll have to +do it manually: + + $query->param('hidden_name','new','values','here'); + +=head2 CREATING A CLICKABLE IMAGE BUTTON + + print $query->image_button(-name=>'button_name', + -src=>'/source/URL', + -align=>'MIDDLE'); + + -or- + + print $query->image_button('button_name','/source/URL','MIDDLE'); + +image_button() produces a clickable image. When it's clicked on the +position of the click is returned to your script as "button_name.x" +and "button_name.y", where "button_name" is the name you've assigned +to it. + +JAVASCRIPTING: image_button() recognizes the B<-onClick> +parameter. See checkbox_group() for further details. + +=over 4 + +=item B<Parameters:> + +=item 1. + +The first argument (-name) is required and specifies the name of this +field. + +=item 2. + +The second argument (-src) is also required and specifies the URL + +=item 3. +The third option (-align, optional) is an alignment type, and may be +TOP, BOTTOM or MIDDLE + +=back + +Fetch the value of the button this way: + $x = $query->param('button_name.x'); + $y = $query->param('button_name.y'); + +=head2 CREATING A JAVASCRIPT ACTION BUTTON + + print $query->button(-name=>'button_name', + -value=>'user visible label', + -onClick=>"do_something()"); + + -or- + + print $query->button('button_name',"do_something()"); + +button() produces a button that is compatible with Netscape 2.0's +JavaScript. When it's pressed the fragment of JavaScript code +pointed to by the B<-onClick> parameter will be executed. On +non-Netscape browsers this form element will probably not even +display. + +=head1 NETSCAPE COOKIES + +Netscape browsers versions 1.1 and higher support a so-called +"cookie" designed to help maintain state within a browser session. +CGI.pm has several methods that support cookies. + +A cookie is a name=value pair much like the named parameters in a CGI +query string. CGI scripts create one or more cookies and send +them to the browser in the HTTP header. The browser maintains a list +of cookies that belong to a particular Web server, and returns them +to the CGI script during subsequent interactions. + +In addition to the required name=value pair, each cookie has several +optional attributes: + +=over 4 + +=item 1. an expiration time + +This is a time/date string (in a special GMT format) that indicates +when a cookie expires. The cookie will be saved and returned to your +script until this expiration date is reached if the user exits +Netscape and restarts it. If an expiration date isn't specified, the cookie +will remain active until the user quits Netscape. + +=item 2. a domain + +This is a partial or complete domain name for which the cookie is +valid. The browser will return the cookie to any host that matches +the partial domain name. For example, if you specify a domain name +of ".capricorn.com", then Netscape will return the cookie to +Web servers running on any of the machines "www.capricorn.com", +"www2.capricorn.com", "feckless.capricorn.com", etc. Domain names +must contain at least two periods to prevent attempts to match +on top level domains like ".edu". If no domain is specified, then +the browser will only return the cookie to servers on the host the +cookie originated from. + +=item 3. a path + +If you provide a cookie path attribute, the browser will check it +against your script's URL before returning the cookie. For example, +if you specify the path "/cgi-bin", then the cookie will be returned +to each of the scripts "/cgi-bin/tally.pl", "/cgi-bin/order.pl", +and "/cgi-bin/customer_service/complain.pl", but not to the script +"/cgi-private/site_admin.pl". By default, path is set to "/", which +causes the cookie to be sent to any CGI script on your site. + +=item 4. a "secure" flag + +If the "secure" attribute is set, the cookie will only be sent to your +script if the CGI request is occurring on a secure channel, such as SSL. + +=back + +The interface to Netscape cookies is the B<cookie()> method: + + $cookie = $query->cookie(-name=>'sessionID', + -value=>'xyzzy', + -expires=>'+1h', + -path=>'/cgi-bin/database', + -domain=>'.capricorn.org', + -secure=>1); + print $query->header(-cookie=>$cookie); + +B<cookie()> creates a new cookie. Its parameters include: + +=over 4 + +=item B<-name> + +The name of the cookie (required). This can be any string at all. +Although Netscape limits its cookie names to non-whitespace +alphanumeric characters, CGI.pm removes this restriction by escaping +and unescaping cookies behind the scenes. + +=item B<-value> + +The value of the cookie. This can be any scalar value, +array reference, or even associative array reference. For example, +you can store an entire associative array into a cookie this way: + + $cookie=$query->cookie(-name=>'family information', + -value=>\%childrens_ages); + +=item B<-path> + +The optional partial path for which this cookie will be valid, as described +above. + +=item B<-domain> + +The optional partial domain for which this cookie will be valid, as described +above. + +=item B<-expires> + +The optional expiration date for this cookie. The format is as described +in the section on the B<header()> method: + + "+1h" one hour from now + +=item B<-secure> + +If set to true, this cookie will only be used within a secure +SSL session. + +=back + +The cookie created by cookie() must be incorporated into the HTTP +header within the string returned by the header() method: + + print $query->header(-cookie=>$my_cookie); + +To create multiple cookies, give header() an array reference: + + $cookie1 = $query->cookie(-name=>'riddle_name', + -value=>"The Sphynx's Question"); + $cookie2 = $query->cookie(-name=>'answers', + -value=>\%answers); + print $query->header(-cookie=>[$cookie1,$cookie2]); + +To retrieve a cookie, request it by name by calling cookie() +method without the B<-value> parameter: + + use CGI; + $query = new CGI; + %answers = $query->cookie(-name=>'answers'); + # $query->cookie('answers') will work too! + +The cookie and CGI namespaces are separate. If you have a parameter +named 'answers' and a cookie named 'answers', the values retrieved by +param() and cookie() are independent of each other. However, it's +simple to turn a CGI parameter into a cookie, and vice-versa: + + # turn a CGI parameter into a cookie + $c=$q->cookie(-name=>'answers',-value=>[$q->param('answers')]); + # vice-versa + $q->param(-name=>'answers',-value=>[$q->cookie('answers')]); + +See the B<cookie.cgi> example script for some ideas on how to use +cookies effectively. + +B<NOTE:> There appear to be some (undocumented) restrictions on +Netscape cookies. In Netscape 2.01, at least, I haven't been able to +set more than three cookies at a time. There may also be limits on +the length of cookies. If you need to store a lot of information, +it's probably better to create a unique session ID, store it in a +cookie, and use the session ID to locate an external file/database +saved on the server's side of the connection. + +=head1 WORKING WITH NETSCAPE FRAMES + +It's possible for CGI.pm scripts to write into several browser +panels and windows using Netscape's frame mechanism. +There are three techniques for defining new frames programmatically: + +=over 4 + +=item 1. Create a <Frameset> document + +After writing out the HTTP header, instead of creating a standard +HTML document using the start_html() call, create a <FRAMESET> +document that defines the frames on the page. Specify your script(s) +(with appropriate parameters) as the SRC for each of the frames. + +There is no specific support for creating <FRAMESET> sections +in CGI.pm, but the HTML is very simple to write. See the frame +documentation in Netscape's home pages for details + + http://home.netscape.com/assist/net_sites/frames.html + +=item 2. Specify the destination for the document in the HTTP header + +You may provide a B<-target> parameter to the header() method: + + print $q->header(-target=>'ResultsWindow'); + +This will tell Netscape to load the output of your script into the +frame named "ResultsWindow". If a frame of that name doesn't +already exist, Netscape will pop up a new window and load your +script's document into that. There are a number of magic names +that you can use for targets. See the frame documents on Netscape's +home pages for details. + +=item 3. Specify the destination for the document in the <FORM> tag + +You can specify the frame to load in the FORM tag itself. With +CGI.pm it looks like this: + + print $q->startform(-target=>'ResultsWindow'); + +When your script is reinvoked by the form, its output will be loaded +into the frame named "ResultsWindow". If one doesn't already exist +a new window will be created. + +=back + +The script "frameset.cgi" in the examples directory shows one way to +create pages in which the fill-out form and the response live in +side-by-side frames. + +=head1 DEBUGGING + +If you are running the script +from the command line or in the perl debugger, you can pass the script +a list of keywords or parameter=value pairs on the command line or +from standard input (you don't have to worry about tricking your +script into reading from environment variables). +You can pass keywords like this: + + your_script.pl keyword1 keyword2 keyword3 + +or this: + + your_script.pl keyword1+keyword2+keyword3 + +or this: + + your_script.pl name1=value1 name2=value2 + +or this: + + your_script.pl name1=value1&name2=value2 + +or even as newline-delimited parameters on standard input. + +When debugging, you can use quotes and backslashes to escape +characters in the familiar shell manner, letting you place +spaces and other funny characters in your parameter=value +pairs: + + your_script.pl "name1='I am a long value'" "name2=two\ words" + +=head2 DUMPING OUT ALL THE NAME/VALUE PAIRS + +The dump() method produces a string consisting of all the query's +name/value pairs formatted nicely as a nested list. This is useful +for debugging purposes: + + print $query->dump + + +Produces something that looks like: + + <UL> + <LI>name1 + <UL> + <LI>value1 + <LI>value2 + </UL> + <LI>name2 + <UL> + <LI>value1 + </UL> + </UL> + +You can pass a value of 'true' to dump() in order to get it to +print the results out as plain text, suitable for incorporating +into a <PRE> section. + +As a shortcut, as of version 1.56 you can interpolate the entire +CGI object into a string and it will be replaced with the +the a nice HTML dump shown above: + + $query=new CGI; + print "<H2>Current Values</H2> $query\n"; + +=head1 FETCHING ENVIRONMENT VARIABLES + +Some of the more useful environment variables can be fetched +through this interface. The methods are as follows: + +=over 4 + +=item B<accept()> + +Return a list of MIME types that the remote browser +accepts. If you give this method a single argument +corresponding to a MIME type, as in +$query->accept('text/html'), it will return a +floating point value corresponding to the browser's +preference for this type from 0.0 (don't want) to 1.0. +Glob types (e.g. text/*) in the browser's accept list +are handled correctly. + +=item B<raw_cookie()> + +Returns the HTTP_COOKIE variable, an HTTP extension +implemented by Netscape browsers version 1.1 +and higher. Cookies have a special format, and this +method call just returns the raw form (?cookie dough). +See cookie() for ways of setting and retrieving +cooked cookies. + +=item B<user_agent()> + +Returns the HTTP_USER_AGENT variable. If you give +this method a single argument, it will attempt to +pattern match on it, allowing you to do something +like $query->user_agent(netscape); + +=item B<path_info()> + +Returns additional path information from the script URL. +E.G. fetching /cgi-bin/your_script/additional/stuff will +result in $query->path_info() returning +"additional/stuff". + +NOTE: The Microsoft Internet Information Server +is broken with respect to additional path information. If +you use the Perl DLL library, the IIS server will attempt to +execute the additional path information as a Perl script. +If you use the ordinary file associations mapping, the +path information will be present in the environment, +but incorrect. The best thing to do is to avoid using additional +path information in CGI scripts destined for use with IIS. + +=item B<path_translated()> + +As per path_info() but returns the additional +path information translated into a physical path, e.g. +"/usr/local/etc/httpd/htdocs/additional/stuff". + +The Microsoft IIS is broken with respect to the translated +path as well. + +=item B<remote_host()> + +Returns either the remote host name or IP address. +if the former is unavailable. + +=item B<script_name()> +Return the script name as a partial URL, for self-refering +scripts. + +=item B<referer()> + +Return the URL of the page the browser was viewing +prior to fetching your script. Not available for all +browsers. + +=item B<auth_type ()> + +Return the authorization/verification method in use for this +script, if any. + +=item B<server_name ()> + +Returns the name of the server, usually the machine's host +name. + +=item B<virtual_host ()> + +When using virtual hosts, returns the name of the host that +the browser attempted to contact + +=item B<server_software ()> + +Returns the server software and version number. + +=item B<remote_user ()> + +Return the authorization/verification name used for user +verification, if this script is protected. + +=item B<user_name ()> + +Attempt to obtain the remote user's name, using a variety +of different techniques. This only works with older browsers +such as Mosaic. Netscape does not reliably report the user +name! + +=item B<request_method()> + +Returns the method used to access your script, usually +one of 'POST', 'GET' or 'HEAD'. + +=back + +=head1 CREATING HTML ELEMENTS: + +In addition to its shortcuts for creating form elements, CGI.pm +defines general HTML shortcut methods as well. HTML shortcuts are +named after a single HTML element and return a fragment of HTML text +that you can then print or manipulate as you like. + +This example shows how to use the HTML methods: + + $q = new CGI; + print $q->blockquote( + "Many years ago on the island of", + $q->a({href=>"http://crete.org/"},"Crete"), + "there lived a minotaur named", + $q->strong("Fred."), + ), + $q->hr; + +This results in the following HTML code (extra newlines have been +added for readability): + + <blockquote> + Many years ago on the island of + <a HREF="http://crete.org/">Crete</a> there lived + a minotaur named <strong>Fred.</strong> + </blockquote> + <hr> + +If you find the syntax for calling the HTML shortcuts awkward, you can +import them into your namespace and dispense with the object syntax +completely (see the next section for more details): + + use CGI shortcuts; # IMPORT HTML SHORTCUTS + print blockquote( + "Many years ago on the island of", + a({href=>"http://crete.org/"},"Crete"), + "there lived a minotaur named", + strong("Fred."), + ), + hr; + +=head2 PROVIDING ARGUMENTS TO HTML SHORTCUTS + +The HTML methods will accept zero, one or multiple arguments. If you +provide no arguments, you get a single tag: + + print hr; + # gives "<hr>" + +If you provide one or more string arguments, they are concatenated +together with spaces and placed between opening and closing tags: + + print h1("Chapter","1"); + # gives "<h1>Chapter 1</h1>" + +If the first argument is an associative array reference, then the keys +and values of the associative array become the HTML tag's attributes: + + print a({href=>'fred.html',target=>'_new'}, + "Open a new frame"); + # gives <a href="fred.html",target="_new">Open a new frame</a> + +You are free to use CGI.pm-style dashes in front of the attribute +names if you prefer: + + print img {-src=>'fred.gif',-align=>'LEFT'}; + # gives <img ALIGN="LEFT" SRC="fred.gif"> + +=head2 Generating new HTML tags + +Since no mere mortal can keep up with Netscape and Microsoft as they +battle it out for control of HTML, the code that generates HTML tags +is general and extensible. You can create new HTML tags freely just +by referring to them on the import line: + + use CGI shortcuts,winkin,blinkin,nod; + +Now, in addition to the standard CGI shortcuts, you've created HTML +tags named "winkin", "blinkin" and "nod". You can use them like this: + + print blinkin {color=>'blue',rate=>'fast'},"Yahoo!"; + # <blinkin COLOR="blue" RATE="fast">Yahoo!</blinkin> + +=head1 IMPORTING CGI METHOD CALLS INTO YOUR NAME SPACE + +As a convenience, you can import most of the CGI method calls directly +into your name space. The syntax for doing this is: + + use CGI <list of methods>; + +The listed methods will be imported into the current package; you can +call them directly without creating a CGI object first. This example +shows how to import the B<param()> and B<header()> +methods, and then use them directly: + + use CGI param,header; + print header('text/plain'); + $zipcode = param('zipcode'); + +You can import groups of methods by referring to a number of special +names: + +=over 4 + +=item B<cgi> + +Import all CGI-handling methods, such as B<param()>, B<path_info()> +and the like. + +=item B<form> + +Import all fill-out form generating methods, such as B<textfield()>. + +=item B<html2> + +Import all methods that generate HTML 2.0 standard elements. + +=item B<html3> + +Import all methods that generate HTML 3.0 proposed elements (such as +<table>, <super> and <sub>). + +=item B<netscape> + +Import all methods that generate Netscape-specific HTML extensions. + +=item B<shortcuts> + +Import all HTML-generating shortcuts (i.e. 'html2' + 'html3' + +'netscape')... + +=item B<standard> + +Import "standard" features, 'html2', 'form' and 'cgi'. + +=item B<all> + +Import all the available methods. For the full list, see the CGI.pm +code, where the variable %TAGS is defined. + +=back + +Note that in the interests of execution speed CGI.pm does B<not> use +the standard L<Exporter> syntax for specifying load symbols. This may +change in the future. + +If you import any of the state-maintaining CGI or form-generating +methods, a default CGI object will be created and initialized +automatically the first time you use any of the methods that require +one to be present. This includes B<param()>, B<textfield()>, +B<submit()> and the like. (If you need direct access to the CGI +object, you can find it in the global variable B<$CGI::Q>). By +importing CGI.pm methods, you can create visually elegant scripts: + + use CGI standard,html2; + print + header, + start_html('Simple Script'), + h1('Simple Script'), + start_form, + "What's your name? ",textfield('name'),p, + "What's the combination?", + checkbox_group(-name=>'words', + -values=>['eenie','meenie','minie','moe'], + -defaults=>['eenie','moe']),p, + "What's your favorite color?", + popup_menu(-name=>'color', + -values=>['red','green','blue','chartreuse']),p, + submit, + end_form, + hr,"\n"; + + if (param) { + print + "Your name is ",em(param('name')),p, + "The keywords are: ",em(join(", ",param('words'))),p, + "Your favorite color is ",em(param('color')),".\n"; + } + print end_html; + +=head1 USING NPH SCRIPTS + +NPH, or "no-parsed-header", scripts bypass the server completely by +sending the complete HTTP header directly to the browser. This has +slight performance benefits, but is of most use for taking advantage +of HTTP extensions that are not directly supported by your server, +such as server push and PICS headers. + +Servers use a variety of conventions for designating CGI scripts as +NPH. Many Unix servers look at the beginning of the script's name for +the prefix "nph-". The Macintosh WebSTAR server and Microsoft's +Internet Information Server, in contrast, try to decide whether a +program is an NPH script by examining the first line of script output. + + +CGI.pm supports NPH scripts with a special NPH mode. When in this +mode, CGI.pm will output the necessary extra header information when +the header() and redirect() methods are +called. + +The Microsoft Internet Information Server requires NPH mode. As of version +2.30, CGI.pm will automatically detect when the script is running under IIS +and put itself into this mode. You do not need to do this manually, although +it won't hurt anything if you do. + +There are a number of ways to put CGI.pm into NPH mode: + +=over 4 + +=item In the B<use> statement +Simply add ":nph" to the list of symbols to be imported into your script: + + use CGI qw(:standard :nph) + +=item By calling the B<nph()> method: + +Call B<nph()> with a non-zero parameter at any point after using CGI.pm in your program. + + CGI->nph(1) + +=item By using B<-nph> parameters in the B<header()> and B<redirect()> statements: + + print $q->header(-nph=>1); + +=back + +=head1 AUTHOR INFORMATION + +Copyright 1995,1996, Lincoln D. Stein. All rights reserved. It may +be used and modified freely, but I do request that this copyright +notice remain attached to the file. You may modify this module as you +wish, but if you redistribute a modified version, please attach a note +listing the modifications you have made. + +Address bug reports and comments to: +lstein@genome.wi.mit.edu + +=head1 CREDITS + +Thanks very much to: + +=over 4 + +=item Matt Heffron (heffron@falstaff.css.beckman.com) + +=item James Taylor (james.taylor@srs.gov) + +=item Scott Anguish <sanguish@digifix.com> + +=item Mike Jewell (mlj3u@virginia.edu) + +=item Timothy Shimmin (tes@kbs.citri.edu.au) + +=item Joergen Haegg (jh@axis.se) + +=item Laurent Delfosse (delfosse@csgrad1.cs.wvu.edu) + +=item Richard Resnick (applepi1@aol.com) + +=item Craig Bishop (csb@barwonwater.vic.gov.au) + +=item Tony Curtis (tc@vcpc.univie.ac.at) + +=item Tim Bunce (Tim.Bunce@ig.co.uk) + +=item Tom Christiansen (tchrist@convex.com) + +=item Andreas Koenig (k@franz.ww.TU-Berlin.DE) + +=item Tim MacKenzie (Tim.MacKenzie@fulcrum.com.au) + +=item Kevin B. Hendricks (kbhend@dogwood.tyler.wm.edu) + +=item Stephen Dahmen (joyfire@inxpress.net) + +=item Ed Jordan (ed@fidalgo.net) + +=item David Alan Pisoni (david@cnation.com) + +=item ...and many many more... + +for suggestions and bug fixes. + +=back + +=head1 A COMPLETE EXAMPLE OF A SIMPLE FORM-BASED SCRIPT + + + #!/usr/local/bin/perl + + use CGI; + + $query = new CGI; + + print $query->header; + print $query->start_html("Example CGI.pm Form"); + print "<H1> Example CGI.pm Form</H1>\n"; + &print_prompt($query); + &do_work($query); + &print_tail; + print $query->end_html; + + sub print_prompt { + my($query) = @_; + + print $query->startform; + print "<EM>What's your name?</EM><BR>"; + print $query->textfield('name'); + print $query->checkbox('Not my real name'); + + print "<P><EM>Where can you find English Sparrows?</EM><BR>"; + print $query->checkbox_group( + -name=>'Sparrow locations', + -values=>[England,France,Spain,Asia,Hoboken], + -linebreak=>'yes', + -defaults=>[England,Asia]); + + print "<P><EM>How far can they fly?</EM><BR>", + $query->radio_group( + -name=>'how far', + -values=>['10 ft','1 mile','10 miles','real far'], + -default=>'1 mile'); + + print "<P><EM>What's your favorite color?</EM> "; + print $query->popup_menu(-name=>'Color', + -values=>['black','brown','red','yellow'], + -default=>'red'); + + print $query->hidden('Reference','Monty Python and the Holy Grail'); + + print "<P><EM>What have you got there?</EM><BR>"; + print $query->scrolling_list( + -name=>'possessions', + -values=>['A Coconut','A Grail','An Icon', + 'A Sword','A Ticket'], + -size=>5, + -multiple=>'true'); + + print "<P><EM>Any parting comments?</EM><BR>"; + print $query->textarea(-name=>'Comments', + -rows=>10, + -columns=>50); + + print "<P>",$query->reset; + print $query->submit('Action','Shout'); + print $query->submit('Action','Scream'); + print $query->endform; + print "<HR>\n"; + } + + sub do_work { + my($query) = @_; + my(@values,$key); + + print "<H2>Here are the current settings in this form</H2>"; + + foreach $key ($query->param) { + print "<STRONG>$key</STRONG> -> "; + @values = $query->param($key); + print join(", ",@values),"<BR>\n"; + } + } + + sub print_tail { + print <<END; + <HR> + <ADDRESS>Lincoln D. Stein</ADDRESS><BR> + <A HREF="/">Home Page</A> + END + } + +=head1 BUGS + +This module has grown large and monolithic. Furthermore it's doing many +things, such as handling URLs, parsing CGI input, writing HTML, etc., that +are also done in the LWP modules. It should be discarded in favor of +the CGI::* modules, but somehow I continue to work on it. + +Note that the code is truly contorted in order to avoid spurious +warnings when programs are run with the B<-w> switch. + +=head1 SEE ALSO + +L<CGI::Carp>, L<URI::URL>, L<CGI::Request>, L<CGI::MiniSvr>, +L<CGI::Base>, L<CGI::Form>, L<CGI::Apache>, L<CGI::Switch>, +L<CGI::Push>, L<CGI::Fast> + +=cut + diff --git a/lib/CGI/Apache.pm b/lib/CGI/Apache.pm new file mode 100644 index 0000000000..6666f19b55 --- /dev/null +++ b/lib/CGI/Apache.pm @@ -0,0 +1,90 @@ +package CGI::Apache; +use Apache (); +use vars qw(@ISA $VERSION); +require CGI; +@ISA = qw(CGI); + +$VERSION = (qw$Revision: 1.00 $)[1]; +$CGI::DefaultClass = 'CGI::Apache'; +$CGI::Apache::AutoloadClass = 'CGI'; + +sub new { + my($class) = shift; + my($r) = Apache->request; + %ENV = $r->cgi_env unless defined $ENV{GATEWAY_INTERFACE}; #PerlSetupEnv On + my $self = $class->SUPER::new(@_); + $self->{'.req'} = $r; + $self; +} + +sub header { + my ($self,@rest) = CGI::self_or_default(@_); + my $r = $self->{'.req'}; + $r->basic_http_header; + return CGI::header($self,@rest); +} + +sub print { + my($self,@rest) = CGI::self_or_default(@_); + $self->{'.req'}->print(@rest); +} + +sub read_from_client { + my($self, $fh, $buff, $len, $offset) = @_; + my $r = $self->{'.req'} || Apache->request; + return $r->read($$buff, $len, $offset); +} + +sub new_MultipartBuffer { + my $self = shift; + my $new = CGI::Apache::MultipartBuffer->new($self, @_); + $new->{'.req'} = $self->{'.req'} || Apache->request; + return $new; +} + +package CGI::Apache::MultipartBuffer; +use vars qw(@ISA); +@ISA = qw(MultipartBuffer); + +$CGI::Apache::MultipartBuffer::AutoloadClass = 'MultipartBuffer'; +*CGI::Apache::MultipartBuffer::read_from_client = + \&CGI::Apache::read_from_client; + + +1; + +__END__ + +=head1 NAME + +CGI::Apache - Make things work with CGI.pm against Perl-Apache API + +=head1 SYNOPSIS + + require CGI::Apache; + + my $q = new Apache::CGI; + + $q->print($q->header); + + #do things just like you do with CGI.pm + +=head1 DESCRIPTION + +When using the Perl-Apache API, your applications are faster, but the +enviroment is different than CGI. +This module attempts to set-up that environment as best it can. + +=head1 NOTE + +This module used to be named Apache::CGI. Sorry for the confusion. + +=head1 SEE ALSO + +perl(1), Apache(3), CGI(3) + +=head1 AUTHOR + +Doug MacEachern E<lt>dougm@osf.orgE<gt>, hacked over by Andreas König E<lt>a.koenig@mind.deE<gt>, modified by Lincoln Stein <lt>lstein@genome.wi.mit.edu<gt> + +=cut diff --git a/lib/CGI/Carp.pm b/lib/CGI/Carp.pm new file mode 100644 index 0000000000..4cd79467fd --- /dev/null +++ b/lib/CGI/Carp.pm @@ -0,0 +1,242 @@ +package CGI::Carp; + +=head1 NAME + +B<CGI::Carp> - CGI routines for writing to the HTTPD (or other) error log + +=head1 SYNOPSIS + + use CGI::Carp; + + croak "We're outta here!"; + confess "It was my fault: $!"; + carp "It was your fault!"; + warn "I'm confused"; + die "I'm dying.\n"; + +=head1 DESCRIPTION + +CGI scripts have a nasty habit of leaving warning messages in the error +logs that are neither time stamped nor fully identified. Tracking down +the script that caused the error is a pain. This fixes that. Replace +the usual + + use Carp; + +with + + use CGI::Carp + +And the standard warn(), die (), croak(), confess() and carp() calls +will automagically be replaced with functions that write out nicely +time-stamped messages to the HTTP server error log. + +For example: + + [Fri Nov 17 21:40:43 1995] test.pl: I'm confused at test.pl line 3. + [Fri Nov 17 21:40:43 1995] test.pl: Got an error message: Permission denied. + [Fri Nov 17 21:40:43 1995] test.pl: I'm dying. + +=head1 REDIRECTING ERROR MESSAGES + +By default, error messages are sent to STDERR. Most HTTPD servers +direct STDERR to the server's error log. Some applications may wish +to keep private error logs, distinct from the server's error log, or +they may wish to direct error messages to STDOUT so that the browser +will receive them. + +The C<carpout()> function is provided for this purpose. Since +carpout() is not exported by default, you must import it explicitly by +saying + + use CGI::Carp qw(carpout); + +The carpout() function requires one argument, which should be a +reference to an open filehandle for writing errors. It should be +called in a C<BEGIN> block at the top of the CGI application so that +compiler errors will be caught. Example: + + BEGIN { + use CGI::Carp qw(carpout); + open(LOG, ">>/usr/local/cgi-logs/mycgi-log") or + die("Unable to open mycgi-log: $!\n"); + carpout(LOG); + } + +carpout() does not handle file locking on the log for you at this point. + +The real STDERR is not closed -- it is moved to SAVEERR. Some +servers, when dealing with CGI scripts, close their connection to the +browser when the script closes STDOUT and STDERR. SAVEERR is used to +prevent this from happening prematurely. + +You can pass filehandles to carpout() in a variety of ways. The "correct" +way according to Tom Christiansen is to pass a reference to a filehandle +GLOB: + + carpout(\*LOG); + +This looks weird to mere mortals however, so the following syntaxes are +accepted as well: + + carpout(LOG); + carpout(main::LOG); + carpout(main'LOG); + carpout(\LOG); + carpout(\'main::LOG'); + + ... and so on + +Use of carpout() is not great for performance, so it is recommended +for debugging purposes or for moderate-use applications. A future +version of this module may delay redirecting STDERR until one of the +CGI::Carp methods is called to prevent the performance hit. + +=head1 MAKING PERL ERRORS APPEAR IN THE BROWSER WINDOW + +If you want to send fatal (die, confess) errors to the browser, ask to +import the special "fatalsToBrowser" subroutine: + + use CGI::Carp qw(fatalsToBrowser); + die "Bad error here"; + +Fatal errors will now be echoed to the browser as well as to the log. CGI::Carp +arranges to send a minimal HTTP header to the browser so that even errors that +occur in the early compile phase will be seen. +Nonfatal errors will still be directed to the log file only (unless redirected +with carpout). + +=head1 CHANGE LOG + +1.05 carpout() added and minor corrections by Marc Hedlund + <hedlund@best.com> on 11/26/95. + +1.06 fatalsToBrowser() no longer aborts for fatal errors within + eval() statements. + +=head1 AUTHORS + +Lincoln D. Stein <lstein@genome.wi.mit.edu>. Feel free to redistribute +this under the Perl Artistic License. + + +=head1 SEE ALSO + +Carp, CGI::Base, CGI::BasePlus, CGI::Request, CGI::MiniSvr, CGI::Form, +CGI::Response + +=cut + +require 5.000; +use Exporter; +use Carp; + +@ISA = qw(Exporter); +@EXPORT = qw(confess croak carp); +@EXPORT_OK = qw(carpout fatalsToBrowser); + +$main::SIG{__WARN__}=\&CGI::Carp::warn; +$main::SIG{__DIE__}=\&CGI::Carp::die; +$CGI::Carp::VERSION = '1.06'; + +# fancy import routine detects and handles 'errorWrap' specially. +sub import { + my $pkg = shift; + my(%routines); + grep($routines{$_}++,@_); + $WRAP++ if $routines{'fatalsToBrowser'}; + my($oldlevel) = $Exporter::ExportLevel; + $Exporter::ExportLevel = 1; + Exporter::import($pkg,keys %routines); + $Exporter::ExportLevel = $oldlevel; +} + +# These are the originals +sub realwarn { warn(@_); } +sub realdie { die(@_); } + +sub id { + my $level = shift; + my($pack,$file,$line,$sub) = caller($level); + my($id) = $file=~m|([^/]+)$|; + return ($file,$line,$id); +} + +sub stamp { + my $time = scalar(localtime); + my $frame = 0; + my ($id,$pack,$file); + do { + $id = $file; + ($pack,$file) = caller($frame++); + } until !$file; + ($id) = $id=~m|([^/]+)$|; + return "[$time] $id: "; +} + +sub warn { + my $message = shift; + my($file,$line,$id) = id(1); + $message .= " at $file line $line.\n" unless $message=~/\n$/; + my $stamp = stamp; + $message=~s/^/$stamp/gm; + realwarn $message; +} + +sub die { + my $message = shift; + my $time = scalar(localtime); + my($file,$line,$id) = id(1); + return undef if $file=~/^\(eval/; + $message .= " at $file line $line.\n" unless $message=~/\n$/; + &fatalsToBrowser($message) if $WRAP; + my $stamp = stamp; + $message=~s/^/$stamp/gm; + realdie $message; +} + +# Avoid generating "subroutine redefined" warnings with the following +# hack: +{ + local $^W=0; + eval <<EOF; +sub confess { CGI::Carp::die Carp::longmess \@_; } +sub croak { CGI::Carp::die Carp::shortmess \@_; } +sub carp { CGI::Carp::warn Carp::shortmess \@_; } +EOF + ; +} + +# We have to be ready to accept a filehandle as a reference +# or a string. +sub carpout { + my($in) = @_; + $in = $$in if ref($in); # compatability with Marc's method; + my($no) = fileno($in); + unless (defined($no)) { + my($package) = caller; + my($handle) = $in=~/[':]/ ? $in : "$package\:\:$in"; + $no = fileno($handle); + } + die "Invalid filehandle $in\n" unless $no; + + open(SAVEERR, ">&STDERR"); + open(STDERR, ">&$no") or + ( print SAVEERR "Unable to redirect STDERR: $!\n" and exit(1) ); +} + +# headers +sub fatalsToBrowser { + my($msg) = @_; + $msg=~s/>/>/g; + $msg=~s/</</g; + print STDOUT "Content-type: text/html\n\n"; + print STDOUT <<END; +<H1>Software error:</H1> +<CODE>$msg</CODE> +<P> +Please send mail to this site's webmaster for help. +END +} + +1; diff --git a/lib/CGI/Fast.pm b/lib/CGI/Fast.pm new file mode 100644 index 0000000000..03b54072c9 --- /dev/null +++ b/lib/CGI/Fast.pm @@ -0,0 +1,173 @@ +package CGI::Fast; + +# See the bottom of this file for the POD documentation. Search for the +# string '=head'. + +# You can run this file through either pod2man or pod2html to produce pretty +# documentation in manual or html file format (these utilities are part of the +# Perl 5 distribution). + +# Copyright 1995,1996, Lincoln D. Stein. All rights reserved. +# It may be used and modified freely, but I do request that this copyright +# notice remain attached to the file. You may modify this module as you +# wish, but if you redistribute a modified version, please attach a note +# listing the modifications you have made. + +# The most recent version and complete docs are available at: +# http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html +# ftp://ftp-genome.wi.mit.edu/pub/software/WWW/ +$CGI::Fast::VERSION='1.00a'; + +use CGI; +use FCGI; +@ISA = ('CGI'); + +# workaround for known bug in libfcgi +while (($ignore) = each %ENV) { } + +# override the initialization behavior so that +# state is NOT maintained between invocations +sub save_request { + # no-op +} + +# New is slightly different in that it calls FCGI's +# accept() method. +sub new { + return undef unless FCGI::accept() >= 0; + my($self,@param) = @_; + return $CGI::Q = $self->SUPER::new(@param); +} + +1; + +=head1 NAME + +CGI::Fast - CGI Interface for Fast CGI + +=head1 SYNOPSIS + + use CGI::Fast qw(:standard); + $COUNTER = 0; + while (new CGI::Fast) { + print header; + print start_html("Fast CGI Rocks"); + print + h1("Fast CGI Rocks"), + "Invocation number ",b($COUNTER++), + " PID ",b($$),".", + hr; + print end_html; + } + +=head1 DESCRIPTION + +CGI::Fast is a subclass of the CGI object created by +CGI.pm. It is specialized to work well with the Open Market +FastCGI standard, which greatly speeds up CGI scripts by +turning them into persistently running server processes. Scripts +that perform time-consuming initialization processes, such as +loading large modules or opening persistent database connections, +will see large performance improvements. + +=head1 OTHER PIECES OF THE PUZZLE + +In order to use CGI::Fast you'll need a FastCGI-enabled Web +server. Open Market's server is FastCGI-savvy. There are also +freely redistributable FastCGI modules for NCSA httpd 1.5 and Apache. +FastCGI-enabling modules for Microsoft Internet Information Server and +Netscape Communications Server have been announced. + +In addition, you'll need a version of the Perl interpreter that has +been linked with the FastCGI I/O library. Precompiled binaries are +available for several platforms, including DEC Alpha, HP-UX and +SPARC/Solaris, or you can rebuild Perl from source with patches +provided in the FastCGI developer's kit. The FastCGI Perl interpreter +can be used in place of your normal Perl without ill consequences. + +You can find FastCGI modules for Apache and NCSA httpd, precompiled +Perl interpreters, and the FastCGI developer's kit all at URL: + + http://www.fastcgi.com/ + +=head1 WRITING FASTCGI PERL SCRIPTS + +FastCGI scripts are persistent: one or more copies of the script +are started up when the server initializes, and stay around until +the server exits or they die a natural death. After performing +whatever one-time initialization it needs, the script enters a +loop waiting for incoming connections, processing the request, and +waiting some more. + +A typical FastCGI script will look like this: + + #!/usr/local/bin/perl # must be a FastCGI version of perl! + use CGI::Fast; + &do_some_initialization(); + while ($q = new CGI::Fast) { + &process_request($q); + } + +Each time there's a new request, CGI::Fast returns a +CGI object to your loop. The rest of the time your script +waits in the call to new(). When the server requests that +your script be terminated, new() will return undef. You can +of course exit earlier if you choose. A new version of the +script will be respawned to take its place (this may be +necessary in order to avoid Perl memory leaks in long-running +scripts). + +CGI.pm's default CGI object mode also works. Just modify the loop +this way: + + while (new CGI::Fast) { + &process_request; + } + +Calls to header(), start_form(), etc. will all operate on the +current request. + +=head1 INSTALLING FASTCGI SCRIPTS + +See the FastCGI developer's kit documentation for full details. On +the Apache server, the following line must be added to srm.conf: + + AddType application/x-httpd-fcgi .fcgi + +FastCGI scripts must end in the extension .fcgi. For each script you +install, you must add something like the following to srm.conf: + + AppClass /usr/etc/httpd/fcgi-bin/file_upload.fcgi -processes 2 + +This instructs Apache to launch two copies of file_upload.fcgi at +startup time. + +=head1 USING FASTCGI SCRIPTS AS CGI SCRIPTS + +Any script that works correctly as a FastCGI script will also work +correctly when installed as a vanilla CGI script. However it will +not see any performance benefit. + +=head1 CAVEATS + +I haven't tested this very much. + +=head1 AUTHOR INFORMATION + +be used and modified freely, but I do request that this copyright +notice remain attached to the file. You may modify this module as you +wish, but if you redistribute a modified version, please attach a note +listing the modifications you have made. + +Address bug reports and comments to: +lstein@genome.wi.mit.edu + +=head1 BUGS + +This section intentionally left blank. + +=head1 SEE ALSO + +L<CGI::Carp>, L<CGI> + +=cut diff --git a/lib/CGI/Push.pm b/lib/CGI/Push.pm new file mode 100644 index 0000000000..11421a7f23 --- /dev/null +++ b/lib/CGI/Push.pm @@ -0,0 +1,239 @@ +package CGI::Push; + +# See the bottom of this file for the POD documentation. Search for the +# string '=head'. + +# You can run this file through either pod2man or pod2html to produce pretty +# documentation in manual or html file format (these utilities are part of the +# Perl 5 distribution). + +# Copyright 1995,1996, Lincoln D. Stein. All rights reserved. +# It may be used and modified freely, but I do request that this copyright +# notice remain attached to the file. You may modify this module as you +# wish, but if you redistribute a modified version, please attach a note +# listing the modifications you have made. + +# The most recent version and complete docs are available at: +# http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html +# ftp://ftp-genome.wi.mit.edu/pub/software/WWW/ + +$CGI::Push::VERSION='1.00'; +use CGI; +@ISA = ('CGI'); + +# add do_push() to exported tags +push(@{$CGI::EXPORT_TAGS{':standard'}},'do_push'); + +sub do_push { + my ($self,@p) = CGI::self_or_CGI(@_); + + # unbuffer output + $| = 1; + srand; + my ($random) = rand()*1E16; + my ($boundary) = "----------------------------------$random"; + + my (@header); + my ($type,$callback,$delay,$last_page,$cookie,$target,$expires,@other) = + $self->rearrange([TYPE,NEXT_PAGE,DELAY,LAST_PAGE,[COOKIE,COOKIES],TARGET,EXPIRES],@p); + $type = 'text/html' unless $type; + $callback = \&simple_counter unless $callback && ref($callback) eq 'CODE'; + $delay = 1 unless defined($delay); + + my(@o); + foreach (@other) { push(@o,split("=")); } + push(@o,'-Target'=>$target) if defined($target); + push(@o,'-Cookie'=>$cookie) if defined($cookie); + push(@o,'-Type'=>"multipart/x-mixed-replace; boundary=$boundary"); + push(@o,'-Server'=>"CGI.pm Push Module"); + push(@o,'-Status'=>'200 OK'); + push(@o,'-nph'=>1); + print $self->header(@o); + print "${boundary}$CGI::CRLF"; + + # now we enter a little loop + my @contents; + while (1) { + last unless (@contents = &$callback($self,++$COUNTER)) && defined($contents[0]); + print "Content-type: ${type}$CGI::CRLF$CGI::CRLF"; + print @contents,"$CGI::CRLF"; + print "${boundary}$CGI::CRLF"; + do_sleep($delay) if $delay; + } + print "Content-type: ${type}$CGI::CRLF$CGI::CRLF", + &$last_page($self,++$COUNTER), + "$CGI::CRLF${boundary}$CGI::CRLF" + if $last_page && ref($last_page) eq 'CODE'; +} + +sub simple_counter { + my ($self,$count) = @_; + return ( + CGI->start_html("CGI::Push Default Counter"), + CGI->h1("CGI::Push Default Counter"), + "This page has been updated ",CGI->strong($count)," times.", + CGI->hr(), + CGI->a({'-href'=>'http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html'},'CGI.pm home page'), + CGI->end_html + ); +} + +sub do_sleep { + my $delay = shift; + if ( ($delay >= 1) && ($delay!~/\./) ){ + sleep($delay); + } else { + select(undef,undef,undef,$delay); + } +} + +1; + +=head1 NAME + +CGI::Push - Simple Interface to Server Push + +=head1 SYNOPSIS + + use CGI::Push qw(:standard); + + do_push(-next_page=>\&next_page, + -last_page=>\&last_page, + -delay=>0.5); + + sub next_page { + my($q,$counter) = @_; + return undef if $counter >= 10; + return start_html('Test'), + h1('Visible'),"\n", + "This page has been called ", strong($counter)," times", + end_html(); + } + + sub last_page { + my($q,$counter) = @_; + return start_html('Done'), + h1('Finished'), + strong($counter),' iterations.', + end_html; + } + +=head1 DESCRIPTION + +CGI::Push is a subclass of the CGI object created by CGI.pm. It is +specialized for server push operations, which allow you to create +animated pages whose content changes at regular intervals. + +You provide CGI::Push with a pointer to a subroutine that will draw +one page. Every time your subroutine is called, it generates a new +page. The contents of the page will be transmitted to the browser +in such a way that it will replace what was there beforehand. The +technique will work with HTML pages as well as with graphics files, +allowing you to create animated GIFs. + +=head1 USING CGI::Push + +CGI::Push adds one new method to the standard CGI suite, do_push(). +When you call this method, you pass it a reference to a subroutine +that is responsible for drawing each new page, an interval delay, and +an optional subroutine for drawing the last page. Other optional +parameters include most of those recognized by the CGI header() +method. + +You may call do_push() in the object oriented manner or not, as you +prefer: + + use CGI::Push; + $q = new CGI::Push; + $q->do_push(-next_page=>\&draw_a_page); + + -or- + + use CGI::Push qw(:standard); + do_push(-next_page=>\&draw_a_page); + +Parameters are as follows: + +=over 4 + +=item -next_page + + do_push(-next_page=>\&my_draw_routine); + +This required parameter points to a reference to a subroutine responsible for +drawing each new page. The subroutine should expect two parameters +consisting of the CGI object and a counter indicating the number +of times the subroutine has been called. It should return the +contents of the page as an B<array> of one or more items to print. +It can return a false value (or an empty array) in order to abort the +redrawing loop and print out the final page (if any) + + sub my_draw_routine { + my($q,$counter) = @_; + return undef if $counter > 100; + return start_html('testing'), + h1('testing'), + "This page called $counter times"; + } + +=item -last_page + +This optional parameter points to a reference to the subroutine +responsible for drawing the last page of the series. It is called +after the -next_page routine returns a false value. The subroutine +itself should have exactly the same calling conventions as the +-next_page routine. + +=item -type + +This optional parameter indicates the content type of each page. It +defaults to "text/html". Currently, server push of heterogeneous +document types is not supported. + +=item -delay + +This indicates the delay, in seconds, between frames. Smaller delays +refresh the page faster. Fractional values are allowed. + +B<If not specified, -delay will default to 1 second> + +=item -cookie, -target, -expires + +These have the same meaning as the like-named parameters in +CGI::header(). + +=back + +=head1 INSTALLING CGI::Push SCRIPTS + +Server push scripts B<must> be installed as no-parsed-header (NPH) +scripts in order to work correctly. On Unix systems, this is most +often accomplished by prefixing the script's name with "nph-". +Recognition of NPH scripts happens automatically with WebSTAR and +Microsoft IIS. Users of other servers should see their documentation +for help. + +=head1 CAVEATS + +This is a new module. It hasn't been extensively tested. + +=head1 AUTHOR INFORMATION + +be used and modified freely, but I do request that this copyright +notice remain attached to the file. You may modify this module as you +wish, but if you redistribute a modified version, please attach a note +listing the modifications you have made. + +Address bug reports and comments to: +lstein@genome.wi.mit.edu + +=head1 BUGS + +This section intentionally left blank. + +=head1 SEE ALSO + +L<CGI::Carp>, L<CGI> + +=cut + diff --git a/lib/CGI/Switch.pm b/lib/CGI/Switch.pm new file mode 100644 index 0000000000..420fff7643 --- /dev/null +++ b/lib/CGI/Switch.pm @@ -0,0 +1,78 @@ +package CGI::Switch; +use Carp; +use strict; +use vars qw($VERSION @Pref); +$VERSION = '0.05'; +@Pref = qw(CGI::Apache CGI); #default + +sub import { + my($self,@arg) = @_; + @Pref = @arg if @arg; +} + +sub new { + shift; + my($file,$pack); + for $pack (@Pref) { + ($file = $pack) =~ s|::|/|g; + eval { require "$file.pm"; }; + if ($@) { +#XXX warn $@; + next; + } else { +#XXX warn "Going to try $pack\->new\n"; + my $obj; + eval {$obj = $pack->new(@_)}; + if ($@) { +#XXX warn $@; + } else { + return $obj; + } + } + } + Carp::croak "Couldn't load+construct any of @Pref\n"; +} + +# there's a trick in Lincoln's package that determines the calling +# package. The reason is to have a filehandle with the same name as +# the filename. To tell this trick that we are not the calling +# package we have to follow this dirty convention. It's a questionable +# trick imho, but for now I want to have something working +sub isaCGI { 1 } + +1; +__END__ + +=head1 NAME + +CGI::Switch - Try more than one constructors and return the first object available + +=head1 SYNOPSIS + + + use CGISwitch; + + -or- + + use CGI::Switch This, That, CGI::XA, Foo, Bar, CGI; + + my $q = new CGI::Switch; + +=head1 DESCRIPTION + +Per default the new() method tries to call new() in the three packages +Apache::CGI, CGI::XA, and CGI. It returns the first CGI object it +succeeds with. + +The import method allows you to set up the default order of the +modules to be tested. + +=head1 SEE ALSO + +perl(1), Apache(3), CGI(3), CGI::XA(3) + +=head1 AUTHOR + +Andreas König E<lt>a.koenig@mind.deE<gt> + +=cut diff --git a/lib/CPAN.pm b/lib/CPAN.pm index 08246f7246..32934a7054 100644 --- a/lib/CPAN.pm +++ b/lib/CPAN.pm @@ -1,11 +1,11 @@ package CPAN; use vars qw{$META $Signal $Cwd $End $Suppress_readline}; -$VERSION = '1.21'; +$VERSION = '1.2401'; -# $Id: CPAN.pm,v 1.127 1997/02/11 06:23:10 k Exp $ +# $Id: CPAN.pm,v 1.139 1997/03/31 22:43:23 k Exp $ -# my $version = substr q$Revision: 1.127 $, 10; # only used during development +# my $version = substr q$Revision: 1.139 $, 10; # only used during development use Carp (); use Config (); @@ -22,7 +22,9 @@ use Safe (); use Text::ParseWords (); use Text::Wrap; -$Cwd = Cwd::cwd(); +my $getcwd; +$getcwd = $CPAN::Config->{'getcwd'} || 'cwd'; +$Cwd = Cwd->$getcwd(); END { $End++; &cleanup; } @@ -127,7 +129,7 @@ sub checklock { qq{ kill $other\n}. qq{ rm $lockfile\n}; } elsif (-w $lockfile) { - my($ans)= + my($ans) = ExtUtils::MakeMaker::prompt (qq{Other job not responding. Shall I overwrite }. qq{the lockfile? (Y/N)},"y"); @@ -180,8 +182,7 @@ or $Signal = 1; }; $SIG{'__DIE__'} = \&cleanup; - print STDERR "Signal handler set.\n" - unless $CPAN::Config->{'inhibit_startup_message'}; + $self->debug("Signal handler set.") if $CPAN::DEBUG; } #-> sub CPAN::DESTROY ; @@ -193,7 +194,7 @@ sub DESTROY { sub exists { my($mgr,$class,$id) = @_; CPAN::Index->reload; - Carp::croak "exists called without class argument" unless $class; + ### Carp::croak "exists called without class argument" unless $class; $id ||= ""; exists $META->{$class}{$id}; } @@ -260,8 +261,9 @@ sub hasWAIT { #-> sub CPAN::instance ; sub instance { my($mgr,$class,$id) = @_; + ### CPAN::Index->reload; ### not faster: unless time - $CPAN::Index::last_time > 60; CPAN::Index->reload; - Carp::croak "instance called without class argument" unless $class; + ### Carp::croak "instance called without class argument" unless $class; $id ||= ""; $META->{$class}{$id} ||= $class->new(ID => $id ); } @@ -303,11 +305,13 @@ sub shell { no strict; $META->checklock(); - my $cwd = Cwd::cwd(); - # How should we determine if we have more than stub ReadLine enabled? + my $getcwd; + $getcwd = $CPAN::Config->{'getcwd'} || 'cwd'; + my $cwd = Cwd->$getcwd(); my $rl_avail = $Suppress_readline ? "suppressed" : - defined &Term::ReadLine::Perl::readline ? "enabled" : - "available (get Term::ReadKey and Term::ReadLine::Perl)"; + ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" : + "available (get Term::ReadKey and Term::ReadLine::Perl ". + "or get Term::ReadLine::Gnu)"; print qq{ cpan shell -- CPAN exploration and modules installation (v$CPAN::VERSION) @@ -317,7 +321,7 @@ Readline support $rl_avail while () { if ($Suppress_readline) { print $prompt; - last unless defined ($_ = <>); + last unless defined ($_ = <> ); chomp; } else { # if (defined($CPAN::ANDK) && $CPAN::DEBUG) { # !$CPAN::ANDK++;$CPAN::DEBUG=1024 @@ -398,14 +402,14 @@ sub cachesize { # } #-> sub CPAN::CacheMgr::clean_cache ; -sub clean_cache { - my $self = shift; - my $dir; - while ($self->{DU} > $self->{'MAX'} and $dir = shift @{$self->{FIFO}}) { - $self->force_clean_cache($dir); - } - $self->debug("leaving clean_cache with $self->{DU}") if $CPAN::DEBUG; -} +#=# sub clean_cache { +#=# my $self = shift; +#=# my $dir; +#=# while ($self->{DU} > $self->{'MAX'} and $dir = shift @{$self->{FIFO}}) { +#=# $self->force_clean_cache($dir); +#=# } +#=# $self->debug("leaving clean_cache with $self->{DU}") if $CPAN::DEBUG; +#=# } #-> sub CPAN::CacheMgr::dir ; sub dir { @@ -415,8 +419,11 @@ sub dir { #-> sub CPAN::CacheMgr::entries ; sub entries { my($self,$dir) = @_; + $self->debug("reading dir[$dir]") if $CPAN::DEBUG; $dir ||= $self->{ID}; - my($cwd) = Cwd::cwd(); + my $getcwd; + $getcwd = $CPAN::Config->{'getcwd'} || 'cwd'; + my($cwd) = Cwd->$getcwd(); chdir $dir or Carp::croak("Can't chdir to $dir: $!"); my $dh = DirHandle->new(".") or Carp::croak("Couldn't opendir $dir: $!"); my(@entries); @@ -431,22 +438,22 @@ sub entries { } } chdir $cwd or Carp::croak("Can't chdir to $cwd: $!"); - sort {-M $b <=> -M $a} @entries; + sort { -M $b <=> -M $a} @entries; } #-> sub CPAN::CacheMgr::disk_usage ; sub disk_usage { my($self,$dir) = @_; - if (! defined $dir or $dir eq "") { - $self->debug("Cannot determine disk usage for some reason") if $CPAN::DEBUG; - return; - } - return if defined $self->{SIZE}{$dir}; +# if (! defined $dir or $dir eq "") { +# $self->debug("Cannot determine disk usage for some reason") if $CPAN::DEBUG; +# return; +# } + return if $self->{SIZE}{$dir}; local($Du) = 0; find( sub { return if -l $_; - $Du += -s; + $Du += -s _; }, $dir ); @@ -455,14 +462,10 @@ sub disk_usage { $self->debug("measured $dir is $Du") if $CPAN::DEBUG; $self->{DU} += $Du/1024/1024; if ($self->{DU} > $self->{'MAX'} ) { - my($toremove) = $self->{FIFO}[0]; + my($toremove) = shift @{$self->{FIFO}}; printf "...Hold on a sec... cleaning from cache (%.1f>%.1f MB): $toremove\n", $self->{DU}, $self->{'MAX'}; - $self->clean_cache; - } else { - $self->debug("NOT have to clean the cache: $self->{DU} <= $self->{'MAX'}") - if $CPAN::DEBUG; - $self->debug($self->as_string) if $CPAN::DEBUG; + $self->force_clean_cache($toremove); } $self->{DU}; } @@ -480,6 +483,9 @@ sub force_clean_cache { #-> sub CPAN::CacheMgr::new ; sub new { my $class = shift; + my $time = time; + my($debug,$t2); + $debug = ""; my $self = { ID => $CPAN::Config->{'build_dir'}, MAX => $CPAN::Config->{'build_cache'}, @@ -492,9 +498,12 @@ sub new { my $e; for $e ($self->entries) { next if $e eq ".." || $e eq "."; - $self->debug("Have to check size $e") if $CPAN::DEBUG; $self->disk_usage($e); } + $t2 = time; + $debug .= "timing of CacheMgr->new: ".($t2 - $time); + $time = $t2; + CPAN->debug($debug) if $CPAN::DEBUG; $self; } @@ -620,7 +629,7 @@ EOF #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 ); #chmod $mode, $configpm; - $self->defaults; +###why was that so? $self->defaults; print "commit: wrote $configpm\n"; 1; } @@ -648,84 +657,88 @@ sub init { my $dot_cpan; #-> sub CPAN::Config::load ; sub load { - my($self) = @_; + my($self) = shift; + my(@miss); eval {require CPAN::Config;}; # We eval, because of some MakeMaker problems unshift @INC, $CPAN::META->catdir($ENV{HOME},".cpan") unless $dot_cpan++; eval {require CPAN::MyConfig;}; # where you can override system wide settings - unless ( $self->load_succeeded ) { - require CPAN::FirstTime; - my($configpm,$fh); - if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) { - $configpm = $INC{"CPAN/Config.pm"}; - } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) { - $configpm = $INC{"CPAN/MyConfig.pm"}; - } else { - my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"}); - my($configpmdir) = MM->catdir($path_to_cpan,"CPAN"); - my($configpmtest) = MM->catfile($configpmdir,"Config.pm"); - if (-d $configpmdir or File::Path::mkpath($configpmdir)) { - if (-w $configpmtest) { - $configpm = $configpmtest; - } elsif (-w $configpmdir) { -#_#_# following code dumped core on me with 5.003_11, a.k. - unlink "$configpmtest.bak" if -f "$configpmtest.bak"; - rename $configpmtest, "$configpmtest.bak" if -f $configpmtest; - my $fh = FileHandle->new; - if ($fh->open(">$configpmtest")) { - $fh->print("1;\n"); - $configpm = $configpmtest; - } else { - # Should never happen - Carp::confess("Cannot open >$configpmtest"); - } - } - } - unless ($configpm) { - $configpmdir = MM->catdir($ENV{HOME},".cpan","CPAN"); - File::Path::mkpath($configpmdir); - $configpmtest = MM->catfile($configpmdir,"MyConfig.pm"); - if (-w $configpmtest) { - $configpm = $configpmtest; - } elsif (-w $configpmdir) { -#_#_# following code dumped core on me with 5.003_11, a.k. - my $fh = FileHandle->new; - if ($fh->open(">$configpmtest")) { - $fh->print("1;\n"); - $configpm = $configpmtest; - } else { - # Should never happen - Carp::confess("Cannot open >$configpmtest"); - } - } else { - Carp::confess(qq{WARNING: CPAN.pm is unable to }. - qq{create a configuration file.}); - } - } - } - CPAN->debug(qq{Calling CPAN::FirstTime::init("$configpm")}) - if $CPAN::DEBUG; - print qq{ -Configuring CPAN.pm. + return unless @miss = $self->not_loaded; + require CPAN::FirstTime; + my($configpm,$fh,$redo); + $redo ||= ""; + if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) { + $configpm = $INC{"CPAN/Config.pm"}; + $redo++; + } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) { + $configpm = $INC{"CPAN/MyConfig.pm"}; + $redo++; + } else { + my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"}); + my($configpmdir) = MM->catdir($path_to_cpan,"CPAN"); + my($configpmtest) = MM->catfile($configpmdir,"Config.pm"); + if (-d $configpmdir or File::Path::mkpath($configpmdir)) { + if (-w $configpmtest) { + $configpm = $configpmtest; + } elsif (-w $configpmdir) { + #_#_# following code dumped core on me with 5.003_11, a.k. + unlink "$configpmtest.bak" if -f "$configpmtest.bak"; + rename $configpmtest, "$configpmtest.bak" if -f $configpmtest; + my $fh = FileHandle->new; + if ($fh->open(">$configpmtest")) { + $fh->print("1;\n"); + $configpm = $configpmtest; + } else { + # Should never happen + Carp::confess("Cannot open >$configpmtest"); + } + } + } + unless ($configpm) { + $configpmdir = MM->catdir($ENV{HOME},".cpan","CPAN"); + File::Path::mkpath($configpmdir); + $configpmtest = MM->catfile($configpmdir,"MyConfig.pm"); + if (-w $configpmtest) { + $configpm = $configpmtest; + } elsif (-w $configpmdir) { + #_#_# following code dumped core on me with 5.003_11, a.k. + my $fh = FileHandle->new; + if ($fh->open(">$configpmtest")) { + $fh->print("1;\n"); + $configpm = $configpmtest; + } else { + # Should never happen + Carp::confess("Cannot open >$configpmtest"); + } + } else { + Carp::confess(qq{WARNING: CPAN.pm is unable to }. + qq{create a configuration file.}); + } + } + } + local($") = ", "; + print qq{ +We have to reconfigure CPAN.pm due to following uninitialized parameters: + +@miss +} if $redo ; + print qq{ $configpm initialized. }; - CPAN::FirstTime::init($configpm); - } + sleep 2; + CPAN::FirstTime::init($configpm); } -#-> sub CPAN::Config::load_succeeded ; -sub load_succeeded { - my($miss) = 0; +#-> sub CPAN::Config::not_loaded ; +sub not_loaded { + my(@miss); for (qw( cpan_home keep_source_where build_dir build_cache index_expire gzip tar unzip make pager makepl_arg make_arg make_install_arg urllist inhibit_startup_message ftp_proxy http_proxy no_proxy )) { - unless (defined $CPAN::Config->{$_}){ - $miss++; - CPAN->debug("undefined configuration parameter $_") if $CPAN::DEBUG; - } + push @miss, $_ unless defined $CPAN::Config->{$_}; } - return !$miss; + return @miss; } #-> sub CPAN::Config::unload ; @@ -864,7 +877,7 @@ sub i { for $type (@type) { push @result, $self->expand($type,@args); } - my $result = @result==1 ? + my $result = @result == 1 ? $result[0]->as_string : join "", map {$_->as_glimpse} @result; $result ||= "No objects found of any type for argument @args\n"; @@ -1095,7 +1108,7 @@ sub _u_r_common { } } if ($what eq "r" && $version_zeroes) { - my $s = $version_zeroes>1 ? "s have" : " has"; + my $s = $version_zeroes > 1 ? "s have" : " has"; print qq{$version_zeroes installed module$s no version number to compare\n}; } @result; @@ -1200,7 +1213,7 @@ sub expand { push @m, $obj; } } - return @m; + return wantarray ? @m : $m[0]; } #-> sub CPAN::Shell::format_result ; @@ -1209,7 +1222,7 @@ sub format_result { my($type,@args) = @_; @args = '/./' unless @args; my(@result) = $self->expand($type,@args); - my $result = @result==1 ? + my $result = @result == 1 ? $result[0]->as_string : join "", map {$_->as_glimpse} @result; $result ||= "No objects of type $type found for argument @args\n"; @@ -1255,7 +1268,13 @@ sub rematein { $obj = $CPAN::META->instance('CPAN::Author',$s); print "Don't be silly, you can't $meth ", $obj->fullname, " ;-)\n"; } else { - print "Warning: Cannot $meth $s, don't know what it is\n"; + print qq{Warning: Cannot $meth $s, don\'t know what it is. +Try the command + + i /$s/ + +to find objects with similar identifiers. +}; } } } @@ -1320,6 +1339,7 @@ sub localize { $self->debug("file [$file] aslocal [$aslocal]") if $CPAN::DEBUG; return $aslocal if -f $aslocal && -r _ && ! $force; + rename $aslocal, "$aslocal.bak" if -f $aslocal; my($aslocal_dir) = File::Basename::dirname($aslocal); File::Path::mkpath($aslocal_dir); @@ -1425,7 +1445,7 @@ Trying with $funkyftp to get if (($wstatus = system($system)) == 0) { if ($want_compressed) { $system = "$CPAN::Config->{'gzip'} -dt $aslocal"; - if (system($system)==0) { + if (system($system) == 0) { rename $aslocal, "$aslocal.gz"; } else { $system = "$CPAN::Config->{'gzip'} $aslocal"; @@ -1434,7 +1454,7 @@ Trying with $funkyftp to get return "$aslocal.gz"; } else { $system = "$CPAN::Config->{'gzip'} -dt $aslocal"; - if (system($system)==0) { + if (system($system) == 0) { $system = "$CPAN::Config->{'gzip'} -d $aslocal"; system($system); } else { @@ -1458,7 +1478,7 @@ returned status $estatus (wstat $wstatus) my $timestamp = 0; my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime, $ctime,$blksize,$blocks) = stat($aslocal); - $timestamp = $mtime ||=0; + $timestamp = $mtime ||= 0; my($netrc) = CPAN::FTP::netrc->new; my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : ""; @@ -1575,9 +1595,80 @@ Subprocess "|$CPAN::Config->{'ftp'}$verbose -n" print Text::Wrap::wrap("","",$mess), "\n"; } print "Cannot fetch $file\n"; + if (-f "$aslocal.bak") { + rename "$aslocal.bak", $aslocal; + print "Trying to get away with old file:\n"; + print $self->ls($aslocal); + return $aslocal; + } return; } +# find2perl needs modularization, too, all the following is stolen +# from there +sub ls { + my($self,$name) = @_; + my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm, + $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name); + + my($perms,%user,%group); + my $pname = $name; + + if (defined $blocks) { + $blocks = int(($blocks + 1) / 2); + } + else { + $blocks = int(($sizemm + 1023) / 1024); + } + + if (-f _) { $perms = '-'; } + elsif (-d _) { $perms = 'd'; } + elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; } + elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; } + elsif (-p _) { $perms = 'p'; } + elsif (-S _) { $perms = 's'; } + else { $perms = 'l'; $pname .= ' -> ' . readlink($_); } + + my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx'); + my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); + my $tmpmode = $mode; + my $tmp = $rwx[$tmpmode & 7]; + $tmpmode >>= 3; + $tmp = $rwx[$tmpmode & 7] . $tmp; + $tmpmode >>= 3; + $tmp = $rwx[$tmpmode & 7] . $tmp; + substr($tmp,2,1) =~ tr/-x/Ss/ if -u _; + substr($tmp,5,1) =~ tr/-x/Ss/ if -g _; + substr($tmp,8,1) =~ tr/-x/Tt/ if -k _; + $perms .= $tmp; + + my $user = $user{$uid} || $uid; # too lazy to implement lookup + my $group = $group{$gid} || $gid; + + my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime); + my($timeyear); + my($moname) = $moname[$mon]; + if (-M _ > 365.25 / 2) { + $timeyear = $year + 1900; + } + else { + $timeyear = sprintf("%02d:%02d", $hour, $min); + } + + sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n", + $ino, + $blocks, + $perms, + $nlink, + $user, + $group, + $sizemm, + $moname, + $mday, + $timeyear, + $pname; +} + package CPAN::FTP::netrc; sub new { @@ -1704,8 +1795,8 @@ sub complete_reload { my(@words) = split " ", $line; CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG; my(@ok) = qw(cpan index); - return @ok if @words==1; - return grep /^\Q$word\E/, @ok if @words==2 && $word; + return @ok if @words == 1; + return grep /^\Q$word\E/, @ok if @words == 2 && $word; } #-> sub CPAN::Complete::complete_option ; @@ -1715,8 +1806,8 @@ sub complete_option { my(@words) = split " ", $line; CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG; my(@ok) = qw(conf debug); - return @ok if @words==1; - return grep /^\Q$word\E/, @ok if @words==2 && $word; + return @ok if @words == 1; + return grep /^\Q$word\E/, @ok if @words == 2 && $word; if (0) { } elsif ($words[1] eq 'index') { return (); @@ -1728,9 +1819,10 @@ sub complete_option { } package CPAN::Index; -use vars qw($last_time); +use vars qw($last_time $date_of_03); @CPAN::Index::ISA = qw(CPAN::Debug); $last_time ||= 0; +$date_of_03 ||= 0; #-> sub CPAN::Index::force_reload ; sub force_reload { @@ -1745,36 +1837,53 @@ sub reload { my $time = time; # XXX check if a newer one is available. (We currently read it from time to time) + for ($CPAN::Config->{index_expire}) { + $_ = 0.001 unless $_ > 0.001; + } return if $last_time + $CPAN::Config->{index_expire}*86400 > $time; + my($debug,$t2); $last_time = $time; $cl->read_authindex($cl->reload_x( "authors/01mailrc.txt.gz", "01mailrc.gz", $force)); + $t2 = time; + $debug = "timing reading 01[".($t2 - $time)."]"; + $time = $t2; return if $CPAN::Signal; # this is sometimes lengthy $cl->read_modpacks($cl->reload_x( "modules/02packages.details.txt.gz", "02packag.gz", $force)); + $t2 = time; + $debug .= "02[".($t2 - $time)."]"; + $time = $t2; return if $CPAN::Signal; # this is sometimes lengthy $cl->read_modlist($cl->reload_x( "modules/03modlist.data.gz", "03mlist.gz", $force)); + $t2 = time; + $debug .= "03[".($t2 - $time)."]"; + $time = $t2; + CPAN->debug($debug) if $CPAN::DEBUG; } #-> sub CPAN::Index::reload_x ; sub reload_x { my($cl,$wanted,$localname,$force) = @_; $force ||= 0; + CPAN::Config->load; # we should guarantee loading wherever we rely on Config XXX my $abs_wanted = CPAN->catfile($CPAN::Config->{'keep_source_where'},$localname); - if (-f $abs_wanted && + if ( + -f $abs_wanted && -M $abs_wanted < $CPAN::Config->{'index_expire'} && - !$force) { - my($s) = $CPAN::Config->{'index_expire'} != 1; + !$force + ) { + my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s"; $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }. - qq{day$s. I\'ll use that.\n}); + qq{day$s. I\'ll use that.}); return $abs_wanted; } else { $force ||= 1; @@ -1809,23 +1918,22 @@ sub read_modpacks { print "Going to read $index_target\n"; my $fh = FileHandle->new("$pipe|"); while (<$fh>) { - next if 1../^\s*$/; + last if /^\s*$/; + } + while (<$fh>) { chomp; my($mod,$version,$dist) = split; - $version =~ s/^\+//; +### $version =~ s/^\+//; # if it as a bundle, instatiate a bundle object - my($bundle); - if ($mod =~ /^Bundle::(.*)/) { - $bundle = $1; - } - + my($bundle,$id,$userid); + if ($mod eq 'CPAN') { - local($^W)=0; + local($^W)= 0; if ($version > $CPAN::VERSION){ print qq{ - Hey, you know what? There\'s a new CPAN.pm version (v$version) - available! I\'d suggest--provided you have time--you try + There\'s a new CPAN.pm version (v$version) available! + You might want to try install CPAN reload cpan without quitting the current session. It should be a seemless upgrade @@ -1835,12 +1943,13 @@ sub read_modpacks { print qq{\n}; } last if $CPAN::Signal; + } elsif ($mod =~ /^Bundle::(.*)/) { + $bundle = $1; } - my($id); if ($bundle){ $id = $CPAN::META->instance('CPAN::Bundle',$mod); - $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist); +### $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist); # This "next" makes us faster but if the job is running long, we ignore # rereads which is bad. So we have to be a bit slower again. # } elsif ($CPAN::META->exists('CPAN::Module',$mod)) { @@ -1848,12 +1957,19 @@ sub read_modpacks { } else { # instantiate a module object $id = $CPAN::META->instance('CPAN::Module',$mod); - $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist); +### $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist) +### if $id->cpan_version ne $version || $id->cpan_file ne $dist; # good speed in here } - # determine the author - my($userid) = $dist =~ /([^\/]+)/; - $id->set('CPAN_USERID' => $userid) if $userid =~ /\w/; + if ($id->cpan_file ne $dist){ + # determine the author + ($userid) = $dist =~ /([^\/]+)/; + $id->set( + 'CPAN_USERID' => $userid, + 'CPAN_VERSION' => $version, + 'CPAN_FILE' => $dist + ); + } # instantiate a distribution object unless ($CPAN::META->exists('CPAN::Distribution',$dist)) { @@ -1861,8 +1977,7 @@ sub read_modpacks { 'CPAN::Distribution' => $dist )->set( 'CPAN_USERID' => $userid - ) - if $userid =~ /\w/; + ); } return if $CPAN::Signal; @@ -1879,6 +1994,10 @@ sub read_modlist { my $fh = FileHandle->new("$pipe|"); my $eval; while (<$fh>) { + if (/^Date:\s+(.*)/){ + return if $date_of_03 eq $1; + ($date_of_03) = $1; + } last if /^\s*$/; } local($/) = undef; @@ -2022,14 +2141,14 @@ sub get { $self->debug("Changed directory to tmp") if $CPAN::DEBUG; if ($local_file =~ /z$/i){ $self->{archived} = "tar"; - if (system("$CPAN::Config->{gzip} --decompress --stdout $local_file | $CPAN::Config->{tar} xvf -")==0) { + if (system("$CPAN::Config->{gzip} --decompress --stdout $local_file | $CPAN::Config->{tar} xvf -")== 0) { $self->{unwrapped} = "YES"; } else { $self->{unwrapped} = "NO"; } } elsif ($local_file =~ /zip$/i) { $self->{archived} = "zip"; - if (system("$CPAN::Config->{unzip} $local_file")==0) { + if (system("$CPAN::Config->{unzip} $local_file") == 0) { $self->{unwrapped} = "YES"; } else { $self->{unwrapped} = "NO"; @@ -2121,10 +2240,12 @@ Please define it with "o conf shell <your shell>" my $dist = $self->id; my $dir = $self->dir or $self->get; $dir = $self->dir; - my $pwd = Cwd::cwd(); + my $getcwd; + $getcwd = $CPAN::Config->{'getcwd'} || 'cwd'; + my $pwd = Cwd->$getcwd(); chdir($dir); print qq{Working directory is $dir.\n}; - system($CPAN::Config->{'shell'})==0 or die "Subprocess shell error"; + system($CPAN::Config->{'shell'}) == 0 or die "Subprocess shell error"; chdir($pwd); } @@ -2195,7 +2316,7 @@ sub verifyMD5 { 'force>:-{' ); my $system = "$CPAN::Config->{gzip} --decompress $local_file"; - system($system)==0 or die "Could not uncompress $local_file"; + system($system) == 0 or die "Could not uncompress $local_file"; $local_file =~ s/\.gz$//; } $self->MD5_check_file($local_file,$basename); @@ -2206,7 +2327,7 @@ sub MD5_check_file { my($self,$lfile,$basename) = @_; my($cksum); my $fh = new FileHandle; - local($/)=undef; + local($/) = undef; if (open $fh, $lfile){ my $eval = <$fh>; close $fh; @@ -2289,7 +2410,10 @@ sub force { sub perl { my($self) = @_; my($perl) = MM->file_name_is_absolute($^X) ? $^X : ""; - $perl ||= "$CPAN::Cwd/$^X" if -x "$CPAN::Cwd/$^X"; + my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd'; + my $pwd = Cwd->$getcwd(); + my $candidate = $CPAN::META->catfile($pwd,$^X); + $perl ||= $candidate if MM->maybe_command($candidate); unless ($perl) { my ($component,$perl_name); DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") { @@ -2346,44 +2470,46 @@ sub make { # if $] > 5.00310; $system = "$perl $switch Makefile.PL $CPAN::Config->{makepl_arg}"; } - $SIG{ALRM} = sub { die "inactivity_timeout reached\n" }; - my($ret,$pid); - $@ = ""; - if ($CPAN::Config->{inactivity_timeout}) { - eval { - alarm $CPAN::Config->{inactivity_timeout}; - #$SIG{CHLD} = \&REAPER; - if (defined($pid=fork)) { - if ($pid) { #parent - wait; - } else { #child - exec $system; + { + local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" }; + my($ret,$pid); + $@ = ""; + if ($CPAN::Config->{inactivity_timeout}) { + eval { + alarm $CPAN::Config->{inactivity_timeout}; + local $SIG{CHLD} = sub { wait }; + if (defined($pid = fork)) { + if ($pid) { #parent + wait; + } else { #child + exec $system; + } + } else { + print "Cannot fork: $!"; + return; } - } else { - print "Cannot fork: $!"; + }; + alarm 0; + if ($@){ + kill 9, $pid; + waitpid $pid, 0; + print $@; + $self->{writemakefile} = "NO - $@"; + $@ = ""; return; } + } else { $ret = system($system); - }; - alarm 0; - } else { - $ret = system($system); - } - if ($@){ - kill 9, $pid; - waitpid $pid, 0; - print $@; - $self->{writemakefile} = "NO - $@"; - $@ = ""; - return; - } elsif ($ret != 0) { - $self->{writemakefile} = "NO"; - return; + if ($ret != 0) { + $self->{writemakefile} = "NO"; + return; + } + } } $self->{writemakefile} = "YES"; return if $CPAN::Signal; $system = join " ", $CPAN::Config->{'make'}, $CPAN::Config->{make_arg}; - if (system($system)==0) { + if (system($system) == 0) { print " $system -- OK\n"; $self->{'make'} = "YES"; } else { @@ -2414,7 +2540,7 @@ sub test { chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}"); $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG; my $system = join " ", $CPAN::Config->{'make'}, "test"; - if (system($system)==0) { + if (system($system) == 0) { print " $system -- OK\n"; $self->{'make_test'} = "YES"; } else { @@ -2435,7 +2561,7 @@ sub clean { chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}"); $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG; my $system = join " ", $CPAN::Config->{'make'}, "clean"; - if (system($system)==0) { + if (system($system) == 0) { print " $system -- OK\n"; $self->force; } else { @@ -2517,14 +2643,13 @@ sub contains { # Try to get at it in the cpan directory $self->debug("no parsefile") if $CPAN::DEBUG; my $dist = $CPAN::META->instance('CPAN::Distribution',$self->{'CPAN_FILE'}); - $self->debug($dist->as_string) if $CPAN::DEBUG; $dist->get; $self->debug($dist->as_string) if $CPAN::DEBUG; my($todir) = $CPAN::META->catdir($CPAN::Config->{'cpan_home'},"Bundle"); File::Path::mkpath($todir); my($me,$from,$to); ($me = $self->id) =~ s/.*://; - $from = $CPAN::META->catfile($dist->{'build_dir'},"$me.pm"); + $from = $self->find_bundle_file($dist->{'build_dir'},"$me.pm"); $to = $CPAN::META->catfile($todir,"$me.pm"); File::Copy::copy($from, $to) or Carp::confess("Couldn't copy $from to $to: $!"); $parsefile = $to; @@ -2550,6 +2675,33 @@ sub contains { @result; } +#-> sub CPAN::Bundle::find_bundle_file +sub find_bundle_file { + my($self,$where,$what) = @_; + my $bu = $CPAN::META->catfile($where,$what); + return $bu if -f $bu; + my $manifest = $CPAN::META->catfile($where,"MANIFEST"); + unless (-f $manifest) { + require ExtUtils::Manifest; + my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd'; + my $cwd = Cwd->$getcwd(); + chdir $where; + ExtUtils::Manifest::mkmanifest(); + chdir $cwd; + } + my $fh = FileHandle->new($manifest) or Carp::croak("Couldn't open $manifest: $!"); + local($/) = "\n"; + while (<$fh>) { + next if /^\s*\#/; + my($file) = /(\S+)/; + if ($file =~ m|Bundle/$what$|) { + $bu = $file; + return $CPAN::META->catfile($where,$bu); + } + } + Carp::croak("Could't find a Bundle file in $where"); +} + #-> sub CPAN::Bundle::inst_file ; sub inst_file { my($self) = @_; @@ -2582,6 +2734,13 @@ explicitly a file $s. } } +#sub CPAN::Bundle::xs_file +sub xs_file { + # If a bundle contains another that contains an xs_file we have + # here, we just don't bother I suppose + return 0; +} + #-> sub CPAN::Bundle::force ; sub force { shift->rematein('force',@_); } #-> sub CPAN::Bundle::get ; @@ -2634,7 +2793,7 @@ sub as_string { $sprintf2, 'CPAN_USERID', $userid, - $CPAN::META->instance(CPAN::Author,$userid)->fullname + CPAN::Shell->expand('Author',$userid)->fullname ) } push @m, sprintf $sprintf, 'CPAN_VERSION', $self->{CPAN_VERSION} if $self->{CPAN_VERSION}; @@ -2749,10 +2908,14 @@ sub install { if (defined $inst_file) { $have = $self->inst_version; } - if ($inst_file && $have >= $latest && not exists $self->{'force_update'}) { - print $self->id, " is up to date.\n"; - } else { - $doit = 1; + if (1){ # A block for scoping $^W, the if is just for the visual + # appeal + local($^W)=0; + if ($inst_file && $have >= $latest && not exists $self->{'force_update'}) { + print $self->id, " is up to date.\n"; + } else { + $doit = 1; + } } $self->rematein('install') if $doit; } @@ -2806,6 +2969,7 @@ sub inst_version { CPAN::Config->load unless defined $CPAN::No_Config_is_ok; 1; +__END__ =head1 NAME @@ -2981,13 +3145,80 @@ perl breaks binary compatibility. If one of the modules that CPAN uses is in turn depending on binary compatibility (so you cannot run CPAN commands), then you should try the CPAN::Nox module for recovery. +=head2 The 4 Classes: Authors, Bundles, Modules, Distributions + +Although it may be considered internal, the class hierarchie does +matter for both users and programmer. CPAN.pm deals with above +mentioned four classes, and all those classes share a set of +methods. It is a classical single polymorphism that is in effect. A +metaclass object registers all objects of all kinds and indexes them +with a string. The strings referencing objects have a separated +namespace (well, not completely separated): + + Namespace Class + + words containing a "/" (slash) Distribution + words starting with Bundle:: Bundle + everything else Module or Author + +Modules know their associated Distribution objects. They always refer +to the most recent official release. Developers may mark their +releases as unstable development versions (by inserting an underbar +into the visible version number), so not always is the default +distribution for a given module the really hottest and newest. If a +module Foo circulates on CPAN in both version 1.23 and 1.23_90, +CPAN.pm offers a convenient way to install version 1.23 by saying + + install Foo + +This would install the complete distribution file (say +BAR/Foo-1.23.tar.gz) with all accompanying material in there. But if +you would like to install version 1.23_90, you need to know where the +distribution file resides on CPAN relative to the authors/id/ +directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz, +so he would have say + + install BAR/Foo-1.23_90.tar.gz + +The first example will be driven by an object of the class +CPAN::Module, the second by an object of class Distribution. + =head2 ProgrammerE<39>s interface If you do not enter the shell, the available shell commands are both available as methods (C<CPAN::Shell-E<gt>install(...)>) and as -functions in the calling package (C<install(...)>). The -programmerE<39>s interface has beta status. Do not heavily rely on it, -changes may still be necessary. +functions in the calling package (C<install(...)>). + +There's currently only one class that has a stable interface, +CPAN::Shell. All commands that are available in the CPAN shell are +methods of the class CPAN::Shell. The commands that produce listings +of modules (C<r>, C<autobundle>, C<u>) return a list of the IDs of all +modules within the list. + +=over 2 + +=item expand($type,@things) + +The IDs of all objects available within a program are strings that can +be expanded to the corresponding real objects with the +C<CPAN::Shell-E<gt>expand()> method. Expand returns a list of +CPAN::Module objects according to the C<@things> arguments given. In +scalar context it only returns the first element of the list. + +=item Programming Examples + +This enables the programmer to do operations like these: + + # install everything that is outdated on my disk: + perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)' + + # install my favorite programs if necessary: + for $mod (qw(Net::FTP MD5 Data::Dumper)){ + my $obj = CPAN::Shell->expand('Module',$mod); + $obj->install; + } + +=back =head2 Cache Manager diff --git a/lib/CPAN/FirstTime.pm b/lib/CPAN/FirstTime.pm index c996a1cfbb..8ac180dc71 100644 --- a/lib/CPAN/FirstTime.pm +++ b/lib/CPAN/FirstTime.pm @@ -15,7 +15,7 @@ use ExtUtils::MakeMaker qw(prompt); use FileHandle (); use File::Path (); use vars qw($VERSION); -$VERSION = substr q$Revision: 1.16 $, 10; +$VERSION = substr q$Revision: 1.18 $, 10; =head1 NAME @@ -128,7 +128,7 @@ those. my(@path) = split($Config{path_sep},$ENV{PATH}); my $prog; - for $prog (qw/gzip tar unzip make lynx ftp/){ + for $prog (qw/gzip tar unzip make lynx ncftp ftp/){ my $path = $CPAN::Config->{$prog} || find_exe($prog,[@path]) || $prog; $ans = prompt("Where is your $prog program?",$path) || $path; $CPAN::Config->{$prog} = $ans; @@ -178,7 +178,8 @@ without caring about them. As sometimes the Makefile.PL contains question you\'re expected to answer, you can set a timer that will kill a 'perl Makefile.PL' process after the specified time in seconds. -If you set this value to 0, these processes will wait forever. +If you set this value to 0, these processes will wait forever. This is +the default and recommended setting. }; @@ -257,8 +258,9 @@ the \$CPAN::Config takes precedence. $CPAN::Config->{$_} = prompt("Your $_?",$default); } - # We don't ask that now, it will be noticed in time.... + # We don't ask that now, it will be noticed in time, won't it? $CPAN::Config->{'inhibit_startup_message'} = 0; + $CPAN::Config->{'getcwd'} = 'cwd'; print "\n\n"; CPAN::Config->commit($configpm); diff --git a/lib/ExtUtils/Command.pm b/lib/ExtUtils/Command.pm index 8c4fd7a916..bdf32d4218 100644 --- a/lib/ExtUtils/Command.pm +++ b/lib/ExtUtils/Command.pm @@ -1,6 +1,7 @@ package ExtUtils::Command; use strict; # use AutoLoader; +use Carp; use File::Copy; use File::Compare; use File::Basename; @@ -15,7 +16,7 @@ $VERSION = '1.00'; ExtUtils::Command - utilities to replace common UNIX commands in Makefiles etc. -=head1 SYNOPSYS +=head1 SYNOPSIS perl -MExtUtils::command -e cat files... > destination perl -MExtUtils::command -e mv source... destination @@ -35,14 +36,22 @@ Most commands are wrapers on generic modules File::Path and File::Basename. =over 4 +=cut + +sub expand_wildcards +{ + @ARGV = map(/[\*\?]/ ? glob($_) : $_,@ARGV); +} + =item cat -Concatenates all files menthion on command line to STDOUT. +Concatenates all files mentioned on command line to STDOUT. =cut sub cat () { + expand_wildcards(); print while (<>); } @@ -68,7 +77,7 @@ Removes directories - recursively (even if readonly) sub rm_rf { - rmtree([@ARGV],0,0); + rmtree([grep -e $_,expand_wildcards()],0,0); } =item rm_f files.... @@ -79,12 +88,13 @@ Removes files (even if readonly) sub rm_f { - foreach (@ARGV) + foreach (expand_wildcards()) { - next unless -e $_; - chmod(0777,$_); - next if (-f $_ and unlink($_)); - die "Cannot delete $_:$!"; + next unless -f $_; + next if unlink($_); + chmod(0777,$_); + next if unlink($_); + carp "Cannot delete $_:$!"; } } @@ -96,6 +106,7 @@ Makes files exist, with current timestamp sub touch { + expand_wildcards(); while (@ARGV) { my $file = shift(@ARGV); @@ -114,19 +125,12 @@ Multiple sources are allowed if destination is an existing directory. sub mv { my $dst = pop(@ARGV); - if (-d $dst) - { - while (@ARGV) - { - my $src = shift(@ARGV); - my $leaf = basename($src); - move($src,"$dst/$leaf"); # fixme - } - } - else + expand_wildcards(); + croak("Too many arguments") if (@ARGV > 1 && ! -d $dst); + while (@ARGV) { - my $src = shift(@ARGV); - move($src,$dst) || die "Cannot move $src $dst:$!"; + my $src = shift(@ARGV); + move($src,$dst); } } @@ -140,18 +144,12 @@ Multiple sources are allowed if destination is an existing directory. sub cp { my $dst = pop(@ARGV); - if (-d $dst) - { - while (@ARGV) - { - my $src = shift(@ARGV); - my $leaf = basename($src); - copy($src,"$dst/$leaf"); # fixme - } - } - else + expand_wildcards(); + croak("Too many arguments") if (@ARGV > 1 && ! -d $dst); + while (@ARGV) { - copy(shift,$dst); + my $src = shift(@ARGV); + copy($src,$dst); } } @@ -163,7 +161,8 @@ Sets UNIX like permissions 'mode' on all the files. sub chmod { - chmod(@ARGV) || die "Cannot chmod ".join(' ',@ARGV).":$!"; + my $mode = shift(@ARGV); + chmod($mode,expand_wildcards()) || die "Cannot chmod ".join(' ',$mode,@ARGV).":$!"; } =item mkpath directory... @@ -174,7 +173,7 @@ Creates directory, including any parent directories. sub mkpath { - File::Path::mkpath([@ARGV],1,0777); + File::Path::mkpath([expand_wildcards()],1,0777); } =item test_f file @@ -195,9 +194,6 @@ __END__ =head1 BUGS -eqtime does not work right on Win32 due to problems with utime() built-in -command. - Should probably be Auto/Self loaded. =head1 SEE ALSO diff --git a/lib/ExtUtils/Embed.pm b/lib/ExtUtils/Embed.pm index b6097f40ff..0db3ecfcc4 100644 --- a/lib/ExtUtils/Embed.pm +++ b/lib/ExtUtils/Embed.pm @@ -1,4 +1,4 @@ -# $Id: Embed.pm,v 1.22 1997/01/30 00:37:09 dougm Exp $ +# $Id: Embed.pm,v 1.2501 $ require 5.002; package ExtUtils::Embed; @@ -17,7 +17,7 @@ use vars qw(@ISA @EXPORT $VERSION ); use strict; -$VERSION = sprintf("%d.%02d", q$Revision: 1.2201 $ =~ /(\d+)\.(\d+)/); +$VERSION = sprintf("%d.%02d", q$Revision: 1.2501 $ =~ /(\d+)\.(\d+)/); #for the namespace change $Devel::embed::VERSION = "99.99"; @@ -114,8 +114,9 @@ sub xsi_body { my(@exts) = @_; my($pname,@retval,%seen); my($dl) = canon('/','DynaLoader'); + push(@retval, "\tchar *file = __FILE__;\n"); push(@retval, "\tdXSUB_SYS;\n") if $] > 5.002; - push(@retval, "\tchar *file = __FILE__;\n\n"); + push(@retval, "\n"); foreach $_ (@exts){ my($pname) = canon('/', $_); diff --git a/lib/ExtUtils/MakeMaker.pm b/lib/ExtUtils/MakeMaker.pm index eb49f3e55f..0898b751ef 100644 --- a/lib/ExtUtils/MakeMaker.pm +++ b/lib/ExtUtils/MakeMaker.pm @@ -1687,7 +1687,8 @@ either say: or you can edit the default by saying something like: sub MY::c_o { - my($inherited) = shift->SUPER::c_o(@_); + package MY; # so that "SUPER" works right + my $inherited = shift->SUPER::c_o(@_); $inherited =~ s/old text/new text/; $inherited; } diff --git a/lib/ExtUtils/Manifest.pm b/lib/ExtUtils/Manifest.pm index 5df98f4668..0959a2fd73 100644 --- a/lib/ExtUtils/Manifest.pm +++ b/lib/ExtUtils/Manifest.pm @@ -10,7 +10,7 @@ use strict; use vars qw($VERSION @ISA @EXPORT_OK $Is_VMS $Debug $Verbose $Quiet $MANIFEST $found); -$VERSION = '1.2801'; +$VERSION = substr(q$Revision: 1.33 $, 10); @ISA=('Exporter'); @EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', 'skipcheck', 'maniread', 'manicopy'); @@ -85,10 +85,10 @@ sub skipcheck { sub _manicheck { my($arg) = @_; my $read = maniread(); + my $found = manifind(); my $file; my(@missfile,@missentry); if ($arg & 1){ - my $found = manifind(); foreach $file (sort keys %$read){ warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug; unless ( exists $found->{$file} ) { @@ -100,7 +100,6 @@ sub _manicheck { if ($arg & 2){ $read ||= {}; my $matches = _maniskip(); - my $found = manifind(); my $skipwarn = $arg & 4; foreach $file (sort keys %$found){ if (&$matches($file)){ @@ -119,7 +118,7 @@ sub _manicheck { sub maniread { my ($mfile) = @_; - $mfile = $MANIFEST unless defined $mfile; + $mfile ||= $MANIFEST; my $read = {}; local *M; unless (open M, $mfile){ @@ -128,6 +127,7 @@ sub maniread { } while (<M>){ chomp; + next if /^#/; if ($Is_VMS) { my($file)= /^(\S+)/; next unless $file; @@ -151,12 +151,13 @@ sub _maniskip { my ($mfile) = @_; my $matches = sub {0}; my @skip ; - $mfile = "$MANIFEST.SKIP" unless defined $mfile; + $mfile ||= "$MANIFEST.SKIP"; local *M; return $matches unless -f $mfile; open M, $mfile or return $matches; while (<M>){ chomp; + next if /^#/; next if /^\s*$/; push @skip, $_; } @@ -174,7 +175,7 @@ sub _maniskip { sub manicopy { my($read,$target,$how)=@_; croak "manicopy() called without target argument" unless defined $target; - $how = 'cp' unless defined $how && $how; + $how ||= 'cp'; require File::Path; require File::Basename; my(%dirs,$file); @@ -194,7 +195,7 @@ sub manicopy { sub cp_if_diff { my($from, $to, $how)=@_; - -f $from || carp "$0: $from not found"; + -f $from or carp "$0: $from not found"; my($diff) = 0; local(*F,*T); open(F,$from) or croak "Can't read $from: $!\n"; @@ -209,11 +210,14 @@ sub cp_if_diff { if (-e $to) { unlink($to) or confess "unlink $to: $!"; } - STRICT_SWITCH: { - best($from,$to), last STRICT_SWITCH if $how eq 'best'; - cp($from,$to), last STRICT_SWITCH if $how eq 'cp'; - ln($from,$to), last STRICT_SWITCH if $how eq 'ln'; - } + STRICT_SWITCH: { + best($from,$to), last STRICT_SWITCH if $how eq 'best'; + cp($from,$to), last STRICT_SWITCH if $how eq 'cp'; + ln($from,$to), last STRICT_SWITCH if $how eq 'ln'; + croak("ExtUtils::Manifest::cp_if_diff " . + "called with illegal how argument [$how]. " . + "Legal values are 'best', 'cp', and 'ln'."); + } } } @@ -309,6 +313,8 @@ files found below the current directory. Maniread($file) reads a named C<MANIFEST> file (defaults to C<MANIFEST> in the current directory) and returns a HASH reference with files being the keys and comments being the values of the HASH. +Blank lines and lines which start with C<#> in the C<MANIFEST> file +are discarded. I<Manicopy($read,$target,$how)> copies the files that are the keys in the HASH I<%$read> to the named target directory. The HASH reference @@ -324,7 +330,9 @@ make a tree without any symbolic link. Best is the default. The file MANIFEST.SKIP may contain regular expressions of files that should be ignored by mkmanifest() and filecheck(). The regular -expressions should appear one on each line. A typical example: +expressions should appear one on each line. Blank lines and lines +which start with C<#> are skipped. Use C<\#> if you need a regular +expression to start with a sharp character. A typical example: \bRCS\b ^MANIFEST\. diff --git a/lib/ExtUtils/typemap b/lib/ExtUtils/typemap index c65b1cf35d..20cc96f0b5 100644 --- a/lib/ExtUtils/typemap +++ b/lib/ExtUtils/typemap @@ -203,7 +203,7 @@ T_SYSRET T_ENUM sv_setiv($arg, (IV)$var); T_BOOL - $arg = $var ? &sv_yes : &sv_no; + $arg = boolSV($var); T_U_INT sv_setiv($arg, (IV)$var); T_SHORT diff --git a/lib/File/Basename.pm b/lib/File/Basename.pm index 0442aed8c5..3ceb10e6c1 100644 --- a/lib/File/Basename.pm +++ b/lib/File/Basename.pm @@ -163,7 +163,7 @@ sub fileparse { } } if ($fstype =~ /^MSDOS/i) { - ($dirpath,$basename) = ($fullname =~ /^(.*[:\\\/])?(.*)/); + ($dirpath,$basename) = ($fullname =~ /^((?:.*[:\\\/])?)(.*)/); $dirpath .= '.\\' unless $dirpath =~ /[\\\/]$/; } elsif ($fstype =~ /^MacOS/i) { diff --git a/lib/Getopt/Long.pm b/lib/Getopt/Long.pm index 740b83fe54..d752b3be11 100644 --- a/lib/Getopt/Long.pm +++ b/lib/Getopt/Long.pm @@ -522,7 +522,7 @@ cause options parsing to fail. use strict; BEGIN { - require 5.00327; + require 5.003; use Exporter (); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); $VERSION = sprintf("%d.%02d", q$Revision: 2.9 $ =~ /(\d+)\.(\d+)/); diff --git a/lib/I18N/Collate.pm b/lib/I18N/Collate.pm index 343cb02205..6961dc2f1c 100644 --- a/lib/I18N/Collate.pm +++ b/lib/I18N/Collate.pm @@ -47,10 +47,10 @@ European character set. # I18N::Collate.pm # -# Author: Jarkko Hietaniemi <Jarkko.Hietaniemi@hut.fi> +# Author: Jarkko Hietaniemi <F<jhi@iki.fi>> # Helsinki University of Technology, Finland # -# Acks: Guy Decoux <decoux@moulon.inra.fr> understood +# Acks: Guy Decoux <F<decoux@moulon.inra.fr>> understood # overloading magic much deeper than I and told # how to cut the size of this code by more than half. # (my first version did overload all of lt gt eq le ge cmp) diff --git a/lib/Math/Complex.pm b/lib/Math/Complex.pm index 30194eb9a7..9000543438 100644 --- a/lib/Math/Complex.pm +++ b/lib/Math/Complex.pm @@ -5,26 +5,41 @@ # -- Jarkko Hietaniemi, March 1997 require Exporter; -package Math::Complex; @ISA = qw(Exporter); +package Math::Complex; use strict; -use vars qw(@EXPORT $package $display +use vars qw($VERSION @ISA + @EXPORT %EXPORT_TAGS + $package $display $pi $i $ilog10 $logn %logn); -@EXPORT = qw( - pi i Re Im arg - sqrt exp log ln - log10 logn cbrt root - tan - cosec csc sec cotan cot - asin acos atan - acosec acsc asec acotan acot - sinh cosh tanh - cosech csch sech cotanh coth - asinh acosh atanh - acosech acsch asech acotanh acoth - cplx cplxe +@ISA = qw(Exporter); + +$VERSION = 1.01; + +my @trig = qw( + pi + tan + csc cosec sec cot cotan + asin acos atan + acsc acosec asec acot acotan + sinh cosh tanh + csch cosech sech coth cotanh + asinh acosh atanh + acsch acosech asech acoth acotanh + ); + +@EXPORT = (qw( + i Re Im arg + sqrt exp log ln + log10 logn cbrt root + cplx cplxe + ), + @trig); + +%EXPORT_TAGS = ( + 'trig' => [@trig], ); use overload @@ -236,7 +251,7 @@ sub multiply { # Die on division by zero. # sub divbyzero { - warn $package . '::' . "$_[0]: Division by zero.\n"; + warn "$_[0]: Division by zero.\n"; warn "(Because in the definition of $_[0], $_[1] is 0)\n" if (defined $_[1]); my @up = caller(1); @@ -1002,6 +1017,7 @@ Math::Complex - complex numbers and associated mathematical functions =head1 SYNOPSIS use Math::Complex; + $z = Math::Complex->make(5, 6); $t = 4 - 3*i + $z; $j = cplxe(1, 2*pi/3); @@ -1195,32 +1211,32 @@ numbers: tan(z) = sin(z) / cos(z) - csc(z) = 1 / sin(z) - sec(z) = 1 / cos(z) + csc(z) = 1 / sin(z) + sec(z) = 1 / cos(z) cot(z) = 1 / tan(z) asin(z) = -i * log(i*z + sqrt(1-z*z)) acos(z) = -i * log(z + sqrt(z*z-1)) atan(z) = i/2 * log((i+z) / (i-z)) - acsc(z) = asin(1 / z) - asec(z) = acos(1 / z) + acsc(z) = asin(1 / z) + asec(z) = acos(1 / z) acot(z) = -i/2 * log((i+z) / (z-i)) sinh(z) = 1/2 (exp(z) - exp(-z)) cosh(z) = 1/2 (exp(z) + exp(-z)) tanh(z) = sinh(z) / cosh(z) = (exp(z) - exp(-z)) / (exp(z) + exp(-z)) - csch(z) = 1 / sinh(z) - sech(z) = 1 / cosh(z) + csch(z) = 1 / sinh(z) + sech(z) = 1 / cosh(z) coth(z) = 1 / tanh(z) asinh(z) = log(z + sqrt(z*z+1)) acosh(z) = log(z + sqrt(z*z-1)) atanh(z) = 1/2 * log((1+z) / (1-z)) - acsch(z) = asinh(1 / z) - asech(z) = acosh(1 / z) + acsch(z) = asinh(1 / z) + asech(z) = acosh(1 / z) acoth(z) = atanh(1 / z) = 1/2 * log((1+z) / (z-1)) I<log>, I<csc>, I<cot>, I<acsc>, I<acot>, I<csch>, I<coth>, @@ -1325,6 +1341,32 @@ Here are some examples: $k = exp(i * 2*pi/3); print "$j - $k = ", $j - $k, "\n"; +=head1 CAVEATS + +The division (/) and the following functions + + tan + sec + csc + cot + atan + acot + tanh + sech + csch + coth + atanh + asech + acsch + acoth + +cannot be computed for all arguments because that would mean dividing +by zero. These situations cause fatal runtime errors looking like this + + cot(0): Division by zero. + (Because in the definition of cot(0), sin(0) is 0) + Died at ... + =head1 BUGS Saying C<use Math::Complex;> exports many mathematical routines in the caller diff --git a/lib/Math/Trig.pm b/lib/Math/Trig.pm new file mode 100644 index 0000000000..7c3570c840 --- /dev/null +++ b/lib/Math/Trig.pm @@ -0,0 +1,242 @@ +# +# Trigonometric functions, mostly inherited from Math::Complex. +# -- Jarkko Hietaniemi, April 1997 +# + +require Exporter; +package Math::Trig; + +use strict; + +use Math::Complex qw(:trig); + +use vars qw($VERSION $PACKAGE + @ISA + @EXPORT + $pi2 $DR $RD $DG $GD $RG $GR); + +@ISA = qw(Exporter); + +$VERSION = 1.00; + +my @angcnv = qw(rad_to_deg rad_to_grad + deg_to_rad deg_to_grad + grad_to_rad grad_to_dec); + +@EXPORT = (@{$Math::Complex::EXPORT_TAGS{'trig'}}, + @angcnv); + +sub pi2 () { + $pi2 = 2 * pi unless ($pi2); + $pi2; +} + +sub DR () { + $DR = pi2/360 unless ($DR); + $DR; +} + +sub RD () { + $RD = 360/pi2 unless ($RD); + $RD; +} + +sub DG () { + $DG = 400/360 unless ($DG); + $DG; +} + +sub GD () { + $GD = 360/400 unless ($GD); + $GD; +} + +sub RG () { + $RG = 400/pi2 unless ($RG); + $RG; +} + +sub GR () { + $GR = pi2/400 unless ($GR); + $GR; +} + +# +# Truncating remainder. +# + +sub remt ($$) { + # Oh yes, POSIX::fmod() would be faster. Possibly. If it is available. + $_[0] - $_[1] * int($_[0] / $_[1]); +} + +# +# Angle conversions. +# + +sub rad_to_deg ($) { + remt(RD * $_[0], 360); +} + +sub deg_to_rad ($) { + remt(DR * $_[0], pi2); +} + +sub grad_to_deg ($) { + remt(GD * $_[0], 360); +} + +sub deg_to_grad ($) { + remt(DG * $_[0], 400); +} + +sub rad_to_grad ($) { + remt(RG * $_[0], 400); +} + +sub grad_to_rad ($) { + remt(GR * $_[0], pi2); +} + +=head1 NAME + +Math::Trig - trigonometric functions + +=head1 SYNOPSIS + + use Math::Trig; + + $x = tan(0.9); + $y = acos(3.7); + $z = asin(2.4); + + $halfpi = pi/2; + + $rad = deg_to_rad(120); + +=head1 DESCRIPTION + +C<Math::Trig> defines many trigonometric functions not defined by the +core Perl (which defines only the C<sin()> and C<cos()>. The constant +B<pi> is also defined as are a few convenience functions for angle +conversions. + +=head1 TRIGONOMETRIC FUNCTIONS + +The tangent + + tan + +The cofunctions of the sine, cosine, and tangent (cosec/csc and cotan/cot +are aliases) + + csc cosec sec cot cotan + +The arcus (also known as the inverse) functions of the sine, cosine, +and tangent + + asin acos atan + +The principal value of the arc tangent of y/x + + atan2(y, x) + +The arcus cofunctions of the sine, cosine, and tangent (acosec/acsc +and acotan/acot are aliases) + + acsc acosec asec acot acotan + +The hyperbolic sine, cosine, and tangent + + sinh cosh tanh + +The cofunctions of the hyperbolic sine, cosine, and tangent (cosech/csch +and cotanh/coth are aliases) + + csch cosech sech coth cotanh + +The arcus (also known as the inverse) functions of the hyperbolic +sine, cosine, and tangent + + asinh acosh atanh + +The arcus cofunctions of the hyperbolic sine, cosine, and tangent +(acsch/acosech and acoth/acotanh are aliases) + + acsch acosech asech acoth acotanh + +The trigonometric constant B<pi> is also defined. + + $pi2 = 2 * pi; + +=head2 SIMPLE ARGUMENTS, COMPLEX RESULTS + +Please note that some of the trigonometric functions can break out +from the B<real axis> into the B<complex plane>. For example +C<asin(2)> has no definition for plain real numbers but it has +definition for complex numbers. + +In Perl terms this means that supplying the usual Perl numbers (also +known as scalars, please see L<perldata>) as input for the +trigonometric functions might produce as output results that no more +are simple real numbers: instead they are complex numbers. + +The C<Math::Trig> handles this by using the C<Math::Complex> package +which knows how to handle complex numbers, please see L<Math::Complex> +for more information. In practice you need not to worry about getting +complex numbers as results because the C<Math::Complex> takes care of +details like for example how to display complex numbers. For example: + + print asin(2), "\n"; + +should produce something like this (take or leave few last decimals): + + 1.5707963267949-1.31695789692482i + +That is, a complex number with the real part of approximately E<1.571> +and the imaginary part of approximately E<-1.317>. + +=head1 ANGLE CONVERSIONS + +(Plane, 2-dimensional) angles may be converted with the following functions. + + $radians = deg_to_rad($degrees); + $radians = grad_to_rad($gradians); + + $degrees = rad_to_deg($radians); + $degrees = grad_to_deg($gradians); + + $gradians = deg_to_grad($degrees); + $gradians = rad_to_grad($radians); + +The full circle is 2 B<pi> radians or E<360> degrees or E<400> gradians. + +=head1 + +The following functions + + tan + sec + csc + cot + atan + acot + tanh + sech + csch + coth + atanh + asech + acsch + acoth + +cannot be computed for all arguments because that would mean dividing +by zero. These situations cause fatal runtime errors looking like this + + cot(0): Division by zero. + (Because in the definition of cot(0), sin(0) is 0) + Died at ... + +=cut + +# eof diff --git a/lib/Pod/Html.pm b/lib/Pod/Html.pm new file mode 100644 index 0000000000..a00d21057b --- /dev/null +++ b/lib/Pod/Html.pm @@ -0,0 +1,1472 @@ +package Pod::Html; + +use Pod::Functions; +use Getopt::Long; # package for handling command-line parameters +require Exporter; +@ISA = Exporter; +@EXPORT = qw(pod2html htmlify); +use Cwd; + +use Carp; + +use strict; + +=head1 NAME + +Pod::HTML - module to convert pod files to HTML + +=head1 SYNOPSIS + + use Pod::HTML; + pod2html([options]); + +=head1 DESCRIPTION + +Converts files from pod format (see L<perlpod>) to HTML format. It +can automatically generate indexes and cross-references, and it keeps +a cache of things it knows how to cross-reference. + +=head1 ARGUMENTS + +Pod::Html takes the following arguments: + +=over 4 + +=item help + + --help + +Displays the usage message. + +=item htmlroot + + --htmlroot=name + +Sets the base URL for the HTML files. When cross-references are made, +the HTML root is prepended to the URL. + +=item infile + + --infile=name + +Specify the pod file to convert. Input is taken from STDIN if no +infile is specified. + +=item outfile + + --outfile=name + +Specify the HTML file to create. Output goes to STDOUT if no outfile +is specified. + +=item podroot + + --podroot=name + +Specify the base directory for finding library pods. + +=item podpath + + --podpath=name:...:name + +Specify which subdirectories of the podroot contain pod files whose +HTML converted forms can be linked-to in cross-references. + +=item libpods + + --libpods=name:...:name + +List of page names (eg, "perlfunc") which contain linkable C<=item>s. + +=item netscape + + --netscape + +Use Netscape HTML directives when applicable. + +=item nonetscape + + --nonetscape + +Do not use Netscape HTML directives (default). + +=item index + + --index + +Generate an index at the top of the HTML file (default behaviour). + +=item noindex + + --noindex + +Do not generate an index at the top of the HTML file. + + +=item recurse + + --recurse + +Recurse into subdirectories specified in podpath (default behaviour). + +=item norecurse + + --norecurse + +Do not recurse into subdirectories specified in podpath. + +=item title + + --title=title + +Specify the title of the resulting HTML file. + +=item verbose + + --verbose + +Display progress messages. + +=back + +=head1 EXAMPLE + + pod2html("pod2html", + "--podpath=lib:ext:pod:vms", + "--podroot=/usr/src/perl", + "--htmlroot=/perl/nmanual", + "--libpods=perlfunc:perlguts:perlvar:perlrun:perlop", + "--recurse", + "--infile=foo.pod", + "--outfile=/perl/nmanual/foo.html"); + +=head1 AUTHOR + +Tom Christiansen, E<lt>tchrist@perl.comE<gt>. + +=head1 BUGS + +Has trouble with C<> etc in = commands. + +=head1 SEE ALSO + +L<perlpod> + +=head1 COPYRIGHT + +This program is distributed under the Artistic License. + +=cut + +my $dircache = "pod2html-dircache"; +my $itemcache = "pod2html-itemcache"; + +my @begin_stack = (); # begin/end stack + +my @libpods = (); # files to search for links from C<> directives +my $htmlroot = "/"; # http-server base directory from which all + # relative paths in $podpath stem. +my $htmlfile = ""; # write to stdout by default +my $podfile = ""; # read from stdin by default +my @podpath = (); # list of directories containing library pods. +my $podroot = "."; # filesystem base directory from which all + # relative paths in $podpath stem. +my $recurse = 1; # recurse on subdirectories in $podpath. +my $verbose = 0; # not verbose by default +my $doindex = 1; # non-zero if we should generate an index +my $listlevel = 0; # current list depth +my @listitem = (); # stack of HTML commands to use when a =item is + # encountered. the top of the stack is the + # current list. +my @listdata = (); # similar to @listitem, but for the text after + # an =item +my @listend = (); # similar to @listitem, but the text to use to + # end the list. +my $ignore = 1; # whether or not to format text. we don't + # format text until we hit our first pod + # directive. + +my %items_named = (); # for the multiples of the same item in perlfunc +my @items_seen = (); +my $netscape = 0; # whether or not to use netscape directives. +my $title; # title to give the pod(s) +my $top = 1; # true if we are at the top of the doc. used + # to prevent the first <HR> directive. +my $paragraph; # which paragraph we're processing (used + # for error messages) +my %pages = (); # associative array used to find the location + # of pages referenced by L<> links. +my %sections = (); # sections within this page +my %items = (); # associative array used to find the location + # of =item directives referenced by C<> links +sub init_globals { +$dircache = "pod2html-dircache"; +$itemcache = "pod2html-itemcache"; + +@begin_stack = (); # begin/end stack + +@libpods = (); # files to search for links from C<> directives +$htmlroot = "/"; # http-server base directory from which all + # relative paths in $podpath stem. +$htmlfile = ""; # write to stdout by default +$podfile = ""; # read from stdin by default +@podpath = (); # list of directories containing library pods. +$podroot = "."; # filesystem base directory from which all + # relative paths in $podpath stem. +$recurse = 1; # recurse on subdirectories in $podpath. +$verbose = 0; # not verbose by default +$doindex = 1; # non-zero if we should generate an index +$listlevel = 0; # current list depth +@listitem = (); # stack of HTML commands to use when a =item is + # encountered. the top of the stack is the + # current list. +@listdata = (); # similar to @listitem, but for the text after + # an =item +@listend = (); # similar to @listitem, but the text to use to + # end the list. +$ignore = 1; # whether or not to format text. we don't + # format text until we hit our first pod + # directive. + +@items_seen = (); +%items_named = (); +$netscape = 0; # whether or not to use netscape directives. +$title = ''; # title to give the pod(s) +$top = 1; # true if we are at the top of the doc. used + # to prevent the first <HR> directive. +$paragraph = ''; # which paragraph we're processing (used + # for error messages) +%pages = (); # associative array used to find the location + # of pages referenced by L<> links. +%sections = (); # sections within this page +%items = (); # associative array used to find the location + # of =item directives referenced by C<> links + +} + +sub pod2html { + local(@ARGV) = @_; + local($/); + local $_; + + init_globals(); + + # cache of %pages and %items from last time we ran pod2html + my $podpath = ''; + + #undef $opt_help if defined $opt_help; + + # parse the command-line parameters + parse_command_line(); + + # set some variables to their default values if necessary + local *POD; + unless (@ARGV && $ARGV[0]) { + $podfile = "-" unless $podfile; # stdin + open(POD, "<$podfile") + || die "$0: cannot open $podfile file for input: $!\n"; + } else { + $podfile = $ARGV[0]; # XXX: might be more filenames + *POD = *ARGV; + } + $htmlfile = "-" unless $htmlfile; # stdout + $htmlroot = "" if $htmlroot eq "/"; # so we don't get a // + + # read the pod a paragraph at a time + warn "Scanning for sections in input file(s)\n" if $verbose; + $/ = ""; + my @poddata = <POD>; + close(POD); + + # scan the pod for =head[1-6] directives and build an index + my $index = scan_headings(\%sections, @poddata); + + # open the output file + open(HTML, ">$htmlfile") + || die "$0: cannot open $htmlfile file for output: $!\n"; + + # put a title in the HTML file + $title = ''; + TITLE_SEARCH: { + for (my $i = 0; $i < @poddata; $i++) { + if ($poddata[$i] =~ /^=head1\s*NAME\b/m) { + for my $para ( @poddata[$i, $i+1] ) { + last TITLE_SEARCH if ($title) = $para =~ /(\S+\s+-+\s*.*)/s; + } + } + + } + } + unless ($title) { + $podfile =~ /^(.*)(\.[^.\/]+)?$/; + $title = ($podfile eq "-" ? 'No Title' : $1); + warn "found $title" if $verbose; + } + if ($title =~ /\.pm/) { + warn "$0: no title for $podfile"; + $title = $podfile; + } + print HTML <<END_OF_HEAD; + <HTML> + <HEAD> + <TITLE>$title</TITLE> + </HEAD> + + <BODY> + +END_OF_HEAD + + # load a cache of %pages and %items if possible. $tests will be + # non-zero if successful. + my $tests = 0; + if (-f $dircache && -f $itemcache) { + warn "scanning for item cache\n" if $verbose; + $tests = find_cache($dircache, $itemcache, $podpath, $podroot); + } + + # if we didn't succeed in loading the cache then we must (re)build + # %pages and %items. + if (!$tests) { + warn "scanning directories in pod-path\n" if $verbose; + scan_podpath($podroot, $recurse); + } + + # scan the pod for =item directives + scan_items("", \%items, @poddata); + + # put an index at the top of the file. note, if $doindex is 0 we + # still generate an index, but surround it with an html comment. + # that way some other program can extract it if desired. + $index =~ s/--+/-/g; + print HTML "<!-- INDEX BEGIN -->\n"; + print HTML "<!--\n" unless $doindex; + print HTML $index; + print HTML "-->\n" unless $doindex; + print HTML "<!-- INDEX END -->\n\n"; + print HTML "<HR>\n" if $doindex; + + # now convert this file + warn "Converting input file\n" if $verbose; + foreach my $i (0..$#poddata) { + $_ = $poddata[$i]; + $paragraph = $i+1; + if (/^(=.*)/s) { # is it a pod directive? + $ignore = 0; + $_ = $1; + if (/^=begin\s+(\S+)\s*(.*)/si) {# =begin + process_begin($1, $2); + } elsif (/^=end\s+(\S+)\s*(.*)/si) {# =end + process_end($1, $2); + } elsif (/^=cut/) { # =cut + process_cut(); + } elsif (/^=pod/) { # =pod + process_pod(); + } else { + next if @begin_stack && $begin_stack[-1] ne 'html'; + + if (/^=(head[1-6])\s+(.*)/s) { # =head[1-6] heading + process_head($1, $2); + } elsif (/^=item\s*(.*)/sm) { # =item text + process_item($1); + } elsif (/^=over\s*(.*)/) { # =over N + process_over(); + } elsif (/^=back/) { # =back + process_back(); + } elsif (/^=for\s+(\S+)\s+(.*)/si) {# =for + process_for($1,$2); + } else { + /^=(\S*)\s*/; + warn "$0: $podfile: unknown pod directive '$1' in " + . "paragraph $paragraph. ignoring.\n"; + } + } + $top = 0; + } + else { + next if $ignore; + next if @begin_stack && $begin_stack[-1] ne 'html'; + my $text = $_; + process_text(\$text, 1); + print HTML "$text\n<P>\n\n"; + } + } + + # finish off any pending directives + finish_list(); + print HTML <<END_OF_TAIL; + </BODY> + + </HTML> +END_OF_TAIL + + # close the html file + close(HTML); + + warn "Finished\n" if $verbose; +} + +############################################################################## + +my $usage; # see below +sub usage { + my $podfile = shift; + warn "$0: $podfile: @_\n" if @_; + die $usage; +} + +$usage =<<END_OF_USAGE; +Usage: $0 --help --htmlroot=<name> --infile=<name> --outfile=<name> + --podpath=<name>:...:<name> --podroot=<name> + --libpods=<name>:...:<name> --recurse --verbose --index + --netscape --norecurse --noindex + + --flush - flushes the item and directory caches. + --help - prints this message. + --htmlroot - http-server base directory from which all relative paths + in podpath stem (default is /). + --index - generate an index at the top of the resulting html + (default). + --infile - filename for the pod to convert (input taken from stdin + by default). + --libpods - colon-separated list of pages to search for =item pod + directives in as targets of C<> and implicit links (empty + by default). note, these are not filenames, but rather + page names like those that appear in L<> links. + --netscape - will use netscape html directives when applicable. + --nonetscape - will not use netscape directives (default). + --outfile - filename for the resulting html file (output sent to + stdout by default). + --podpath - colon-separated list of directories containing library + pods. empty by default. + --podroot - filesystem base directory from which all relative paths + in podpath stem (default is .). + --noindex - don't generate an index at the top of the resulting html. + --norecurse - don't recurse on those subdirectories listed in podpath. + --recurse - recurse on those subdirectories listed in podpath + (default behavior). + --title - title that will appear in resulting html file. + --verbose - self-explanatory + +END_OF_USAGE + +sub parse_command_line { + my ($opt_flush,$opt_help,$opt_htmlroot,$opt_index,$opt_infile,$opt_libpods,$opt_netscape,$opt_outfile,$opt_podpath,$opt_podroot,$opt_norecurse,$opt_recurse,$opt_title,$opt_verbose); + my $result = GetOptions( + 'flush' => \$opt_flush, + 'help' => \$opt_help, + 'htmlroot=s' => \$opt_htmlroot, + 'index!' => \$opt_index, + 'infile=s' => \$opt_infile, + 'libpods=s' => \$opt_libpods, + 'netscape!' => \$opt_netscape, + 'outfile=s' => \$opt_outfile, + 'podpath=s' => \$opt_podpath, + 'podroot=s' => \$opt_podroot, + 'norecurse' => \$opt_norecurse, + 'recurse!' => \$opt_recurse, + 'title=s' => \$opt_title, + 'verbose' => \$opt_verbose, + ); + usage("-", "invalid parameters") if not $result; + + usage("-") if defined $opt_help; # see if the user asked for help + $opt_help = ""; # just to make -w shut-up. + + $podfile = $opt_infile if defined $opt_infile; + $htmlfile = $opt_outfile if defined $opt_outfile; + + @podpath = split(":", $opt_podpath) if defined $opt_podpath; + @libpods = split(":", $opt_libpods) if defined $opt_libpods; + + warn "Flushing item and directory caches\n" + if $opt_verbose && defined $opt_flush; + unlink($dircache, $itemcache) if defined $opt_flush; + + $htmlroot = $opt_htmlroot if defined $opt_htmlroot; + $podroot = $opt_podroot if defined $opt_podroot; + + $doindex = $opt_index if defined $opt_index; + $recurse = $opt_recurse if defined $opt_recurse; + $title = $opt_title if defined $opt_title; + $verbose = defined $opt_verbose ? 1 : 0; + $netscape = $opt_netscape if defined $opt_netscape; +} + +# +# find_cache - tries to find if the caches stored in $dircache and $itemcache +# are valid caches of %pages and %items. if they are valid then it loads +# them and returns a non-zero value. +# +sub find_cache { + my($dircache, $itemcache, $podpath, $podroot) = @_; + my($tests); + local $_; + + $tests = 0; + + open(CACHE, "<$itemcache") || + die "$0: error opening $itemcache for reading: $!\n"; + $/ = "\n"; + + # is it the same podpath? + $_ = <CACHE>; + chomp($_); + $tests++ if (join(":", @podpath) eq $_); + + # is it the same podroot? + $_ = <CACHE>; + chomp($_); + $tests++ if ($podroot eq $_); + + # load the cache if its good + if ($tests != 2) { + close(CACHE); + + %items = (); + return 0; + } + + warn "loading item cache\n" if $verbose; + while (<CACHE>) { + /(.*?) (.*)$/; + $items{$1} = $2; + } + close(CACHE); + + warn "scanning for directory cache\n" if $verbose; + open(CACHE, "<$dircache") || + die "$0: error opening $dircache for reading: $!\n"; + $/ = "\n"; + $tests = 0; + + # is it the same podpath? + $_ = <CACHE>; + chomp($_); + $tests++ if (join(":", @podpath) eq $_); + + # is it the same podroot? + $_ = <CACHE>; + chomp($_); + $tests++ if ($podroot eq $_); + + # load the cache if its good + if ($tests != 2) { + close(CACHE); + + %pages = (); + %items = (); + return 0; + } + + warn "loading directory cache\n" if $verbose; + while (<CACHE>) { + /(.*?) (.*)$/; + $pages{$1} = $2; + } + + close(CACHE); + + return 1; +} + +# +# scan_podpath - scans the directories specified in @podpath for directories, +# .pod files, and .pm files. it also scans the pod files specified in +# @libpods for =item directives. +# +sub scan_podpath { + my($podroot, $recurse) = @_; + my($pwd, $dir); + my($libpod, $dirname, $pod, @files, @poddata); + + # scan each directory listed in @podpath + $pwd = getcwd(); + chdir($podroot) + || die "$0: error changing to directory $podroot: $!\n"; + foreach $dir (@podpath) { + scan_dir($dir, $recurse); + } + + # scan the pods listed in @libpods for =item directives + foreach $libpod (@libpods) { + # if the page isn't defined then we won't know where to find it + # on the system. + next unless defined $pages{$libpod} && $pages{$libpod}; + + # if there is a directory then use the .pod and .pm files within it. + if ($pages{$libpod} =~ /([^:]*[^(\.pod|\.pm)]):/) { + # find all the .pod and .pm files within the directory + $dirname = $1; + opendir(DIR, $dirname) || + die "$0: error opening directory $dirname: $!\n"; + @files = grep(/(\.pod|\.pm)$/ && ! -d $_, readdir(DIR)); + closedir(DIR); + + # scan each .pod and .pm file for =item directives + foreach $pod (@files) { + open(POD, "<$dirname/$pod") || + die "$0: error opening $dirname/$pod for input: $!\n"; + @poddata = <POD>; + close(POD); + + scan_items("$dirname/$pod", @poddata); + } + + # use the names of files as =item directives too. + foreach $pod (@files) { + $pod =~ /^(.*)(\.pod|\.pm)$/; + $items{$1} = "$dirname/$1.html" if $1; + } + } elsif ($pages{$libpod} =~ /([^:]*\.pod):/ || + $pages{$libpod} =~ /([^:]*\.pm):/) { + # scan the .pod or .pm file for =item directives + $pod = $1; + open(POD, "<$pod") || + die "$0: error opening $pod for input: $!\n"; + @poddata = <POD>; + close(POD); + + scan_items("$pod", @poddata); + } else { + warn "$0: shouldn't be here (line ".__LINE__."\n"; + } + } + @poddata = (); # clean-up a bit + + chdir($pwd) + || die "$0: error changing to directory $pwd: $!\n"; + + # cache the item list for later use + warn "caching items for later use\n" if $verbose; + open(CACHE, ">$itemcache") || + die "$0: error open $itemcache for writing: $!\n"; + + print CACHE join(":", @podpath) . "\n$podroot\n"; + foreach my $key (keys %items) { + print CACHE "$key $items{$key}\n"; + } + + close(CACHE); + + # cache the directory list for later use + warn "caching directories for later use\n" if $verbose; + open(CACHE, ">$dircache") || + die "$0: error open $dircache for writing: $!\n"; + + print CACHE join(":", @podpath) . "\n$podroot\n"; + foreach my $key (keys %pages) { + print CACHE "$key $pages{$key}\n"; + } + + close(CACHE); +} + +# +# scan_dir - scans the directory specified in $dir for subdirectories, .pod +# files, and .pm files. notes those that it finds. this information will +# be used later in order to figure out where the pages specified in L<> +# links are on the filesystem. +# +sub scan_dir { + my($dir, $recurse) = @_; + my($t, @subdirs, @pods, $pod, $dirname, @dirs); + local $_; + + @subdirs = (); + @pods = (); + + opendir(DIR, $dir) || + die "$0: error opening directory $dir: $!\n"; + while (defined($_ = readdir(DIR))) { + if (-d "$dir/$_" && $_ ne "." && $_ ne "..") { # directory + $pages{$_} = "" unless defined $pages{$_}; + $pages{$_} .= "$dir/$_:"; + push(@subdirs, $_); + } elsif (/\.pod$/) { # .pod + s/\.pod$//; + $pages{$_} = "" unless defined $pages{$_}; + $pages{$_} .= "$dir/$_.pod:"; + push(@pods, "$dir/$_.pod"); + } elsif (/\.pm$/) { # .pm + s/\.pm$//; + $pages{$_} = "" unless defined $pages{$_}; + $pages{$_} .= "$dir/$_.pm:"; + push(@pods, "$dir/$_.pm"); + } + } + closedir(DIR); + + # recurse on the subdirectories if necessary + if ($recurse) { + foreach my $subdir (@subdirs) { + scan_dir("$dir/$subdir", $recurse); + } + } +} + +# +# scan_headings - scan a pod file for head[1-6] tags, note the tags, and +# build an index. +# +sub scan_headings { + my($sections, @data) = @_; + my($tag, $which_head, $title, $listdepth, $index); + + $listdepth = 0; + $index = ""; + + # scan for =head directives, note their name, and build an index + # pointing to each of them. + foreach my $line (@data) { + if ($line =~ /^\s*=(head)([1-6])\s+(.*)/) { + ($tag,$which_head, $title) = ($1,$2,$3); + chomp($title); + $$sections{htmlify(0,$title)} = 1; + + if ($which_head > $listdepth) { + $index .= "\n" . ("\t" x $listdepth) . "<UL>\n"; + } elsif ($which_head < $listdepth) { + $listdepth--; + $index .= "\n" . ("\t" x $listdepth) . "</UL>\n"; + } + $listdepth = $which_head; + + $index .= "\n" . ("\t" x $listdepth) . "<LI>" . + "<A HREF=\"#" . htmlify(0,$title) . "\">$title</A>"; + } + } + + # finish off the lists + while ($listdepth--) { + $index .= "\n" . ("\t" x $listdepth) . "</UL>\n"; + } + + # get rid of bogus lists + $index =~ s,\t*<UL>\s*</UL>\n,,g; + + return $index; +} + +# +# scan_items - scans the pod specified by $pod for =item directives. we +# will use this information later on in resolving C<> links. +# +sub scan_items { + my($pod, @poddata) = @_; + my($i, $item); + local $_; + + $pod =~ s/\.pod$//; + $pod .= ".html" if $pod; + + foreach $i (0..$#poddata) { + $_ = $poddata[$i]; + + # remove any formatting instructions + s,[A-Z]<([^<>]*)>,$1,g; + + # figure out what kind of item it is and get the first word of + # it's name. + if (/^=item\s+(\w*)\s*.*$/s) { + if ($1 eq "*") { # bullet list + /\A=item\s+\*\s*(.*?)\s*\Z/s; + $item = $1; + } elsif ($1 =~ /^[0-9]+/) { # numbered list + /\A=item\s+[0-9]+\.?(.*?)\s*\Z/s; + $item = $1; + } else { +# /\A=item\s+(.*?)\s*\Z/s; + /\A=item\s+(\w*)/s; + $item = $1; + } + + $items{$item} = "$pod" if $item; + } + } +} + +# +# process_head - convert a pod head[1-6] tag and convert it to HTML format. +# +sub process_head { + my($tag, $heading) = @_; + my $firstword; + + # figure out the level of the =head + $tag =~ /head([1-6])/; + my $level = $1; + + # can't have a heading full of spaces and speechmarks and so on + $firstword = $heading; $firstword =~ s/\s*(\w+)\s.*/$1/; + + print HTML "<P>\n" unless $listlevel; + print HTML "<HR>\n" unless $listlevel || $top; + print HTML "<H$level>"; # unless $listlevel; + #print HTML "<H$level>" unless $listlevel; + my $convert = $heading; process_text(\$convert); + print HTML '<A NAME="' . htmlify(0,$heading) . "\">$convert</A>"; + print HTML "</H$level>"; # unless $listlevel; + print HTML "\n"; +} + +# +# process_item - convert a pod item tag and convert it to HTML format. +# +sub process_item { + my $text = $_[0]; + my($i, $quote, $name); + + my $need_preamble = 0; + my $this_entry; + + + # lots of documents start a list without doing an =over. this is + # bad! but, the proper thing to do seems to be to just assume + # they did do an =over. so warn them once and then continue. + warn "$0: $podfile: unexpected =item directive in paragraph $paragraph. ignoring.\n" + unless $listlevel; + process_over() unless $listlevel; + + return unless $listlevel; + + # remove formatting instructions from the text + 1 while $text =~ s/[A-Z]<([^<>]*)>/$1/g; + pre_escape(\$text); + + $need_preamble = $items_seen[$listlevel]++ == 0; + + # check if this is the first =item after an =over + $i = $listlevel - 1; + my $need_new = $listlevel >= @listitem; + + if ($text =~ /\A\*/) { # bullet + + if ($need_preamble) { + push(@listend, "</UL>"); + print HTML "<UL>\n"; + } + + print HTML "<LI><STRONG>"; + $text =~ /\A\*\s*(.*)\Z/s; + print HTML "<A NAME=\"item_" . htmlify(1,$1) . "\">" if $1 && !$items_named{$1}++; + $quote = 1; + #print HTML process_puretext($1, \$quote); + print HTML $1; + print HTML "</A>" if $1; + print HTML "</STRONG>"; + + } elsif ($text =~ /\A[0-9#]+/) { # numbered list + + if ($need_preamble) { + push(@listend, "</OL>"); + print HTML "<OL>\n"; + } + + print HTML "<LI><STRONG>"; + $text =~ /\A[0-9]+\.?(.*)\Z/s; + print HTML "<A NAME=\"item_" . htmlify(0,$1) . "\">" if $1; + $quote = 1; + #print HTML process_puretext($1, \$quote); + print HTML $1 if $1; + print HTML "</A>" if $1; + print HTML "</STRONG>"; + + } else { # all others + + if ($need_preamble) { + push(@listend, '</DL>'); + print HTML "<DL>\n"; + } + + print HTML "<DT><STRONG>"; + print HTML "<A NAME=\"item_" . htmlify(1,$text) . "\">" + if $text && !$items_named{($text =~ /(\S+)/)[0]}++; + # preceding craziness so that the duplicate leading bits in + # perlfunc work to find just the first one. otherwise + # open etc would have many names + $quote = 1; + #print HTML process_puretext($text, \$quote); + print HTML $text; + print HTML "</A>" if $text; + print HTML "</STRONG>"; + + print HTML '<DD>'; + } + + print HTML "\n"; +} + +# +# process_over - process a pod over tag and start a corresponding HTML +# list. +# +sub process_over { + # start a new list + $listlevel++; +} + +# +# process_back - process a pod back tag and convert it to HTML format. +# +sub process_back { + warn "$0: $podfile: unexpected =back directive in paragraph $paragraph. ignorning.\n" + unless $listlevel; + return unless $listlevel; + + # close off the list. note, I check to see if $listend[$listlevel] is + # defined because an =item directive may have never appeared and thus + # $listend[$listlevel] may have never been initialized. + $listlevel--; + print HTML $listend[$listlevel] if defined $listend[$listlevel]; + print HTML "\n"; + + # don't need the corresponding perl code anymore + pop(@listitem); + pop(@listdata); + pop(@listend); + + pop(@items_seen); +} + +# +# process_cut - process a pod cut tag, thus stop ignoring pod directives. +# +sub process_cut { + $ignore = 1; +} + +# +# process_pod - process a pod pod tag, thus ignore pod directives until we see a +# corresponding cut. +# +sub process_pod { + # no need to set $ignore to 0 cause the main loop did it +} + +# +# process_for - process a =for pod tag. if it's for html, split +# it out verbatim, otherwise ignore it. +# +sub process_for { + my($whom, $text) = @_; + if ( $whom =~ /^(pod2)?html$/i) { + print HTML $text; + } +} + +# +# process_begin - process a =begin pod tag. this pushes +# whom we're beginning on the begin stack. if there's a +# begin stack, we only print if it us. +# +sub process_begin { + my($whom, $text) = @_; + $whom = lc($whom); + push (@begin_stack, $whom); + if ( $whom =~ /^(pod2)?html$/) { + print HTML $text if $text; + } +} + +# +# process_end - process a =end pod tag. pop the +# begin stack. die if we're mismatched. +# +sub process_end { + my($whom, $text) = @_; + $whom = lc($whom); + if ($begin_stack[-1] ne $whom ) { + die "Unmatched begin/end at chunk $paragraph\n" + } + pop @begin_stack; +} + +# +# process_text - handles plaintext that appears in the input pod file. +# there may be pod commands embedded within the text so those must be +# converted to html commands. +# +sub process_text { + my($text, $escapeQuotes) = @_; + my($result, $rest, $s1, $s2, $s3, $s4, $match, $bf); + my($podcommand, $params, $tag, $quote); + + return if $ignore; + + $quote = 0; # status of double-quote conversion + $result = ""; + $rest = $$text; + + if ($rest =~ /^\s+/) { # preformatted text, no pod directives + $rest =~ s/\n+\Z//; + + $rest =~ s/&/&/g; + $rest =~ s/</</g; + $rest =~ s/>/>/g; + $rest =~ s/"/"/g; + + # try and create links for all occurrences of perl.* within + # the preformatted text. + $rest =~ s{ + (\s*)(perl\w+) + }{ + if (defined $pages{$2}) { # is a link + qq($1<A HREF="$htmlroot/$pages{$2}">$2</A>); + } else { + "$1$2"; + } + }xeg; + $rest =~ s/(<A HREF=)([^>:]*:)?([^>:]*)\.pod:([^>:]*:)?/$1$3.html/g; + + my $urls = '(' . join ('|', qw{ + http + telnet + mailto + news + gopher + file + wais + ftp + } ) + . ')'; + + my $ltrs = '\w'; + my $gunk = '/#~:.?+=&%@!\-'; + my $punc = '.:?\-'; + my $any = "${ltrs}${gunk}${punc}"; + + $rest =~ s{ + \b # start at word boundary + ( # begin $1 { + $urls : # need resource and a colon + [$any] +? # followed by on or more + # of any valid character, but + # be conservative and take only + # what you need to.... + ) # end $1 } + (?= # look-ahead non-consumptive assertion + [$punc]* # either 0 or more puntuation + [^$any] # followed by a non-url char + | # or else + $ # then end of the string + ) + }{<A HREF="$1">$1</A>}igox; + + $result = "<PRE>" # text should be as it is (verbatim) + . "$rest\n" + . "</PRE>\n"; + } else { # formatted text + # parse through the string, stopping each time we find a + # pod-escape. once the string has been throughly processed + # we can output it. + while ($rest) { + # check to see if there are any possible pod directives in + # the remaining part of the text. + if ($rest =~ m/[BCEIFLSZ]</) { + warn "\$rest\t= $rest\n" unless + $rest =~ /\A + ([^<]*?) + ([BCEIFLSZ]?) + < + (.*)\Z/xs; + + $s1 = $1; # pure text + $s2 = $2; # the type of pod-escape that follows + $s3 = '<'; # '<' + $s4 = $3; # the rest of the string + } else { + $s1 = $rest; + $s2 = ""; + $s3 = ""; + $s4 = ""; + } + + if ($s3 eq '<' && $s2) { # a pod-escape + $result .= ($escapeQuotes ? process_puretext($s1, \$quote) : $s1); + $podcommand = "$s2<"; + $rest = $s4; + + # find the matching '>' + $match = 1; + $bf = 0; + while ($match && !$bf) { + $bf = 1; + if ($rest =~ /\A([^<>]*[BCEIFLSZ]<)(.*)\Z/s) { + $bf = 0; + $match++; + $podcommand .= $1; + $rest = $2; + } elsif ($rest =~ /\A([^>]*>)(.*)\Z/s) { + $bf = 0; + $match--; + $podcommand .= $1; + $rest = $2; + } + } + + if ($match != 0) { + warn <<WARN; +$0: $podfile: cannot find matching > for $s2 in paragraph $paragraph. +WARN + $result .= substr $podcommand, 0, 2; + $rest = substr($podcommand, 2) . $rest; + next; + } + + # pull out the parameters to the pod-escape + $podcommand =~ /^([BCFEILSZ]?)<(.*)>$/s; + $tag = $1; + $params = $2; + + # process the text within the pod-escape so that any escapes + # which must occur do. + process_text(\$params, 0) unless $tag eq 'L'; + + $s1 = $params; + if (!$tag || $tag eq " ") { # <> : no tag + $s1 = "<$params>"; + } elsif ($tag eq "L") { # L<> : link + $s1 = process_L($params); + } elsif ($tag eq "I" || # I<> : italicize text + $tag eq "B" || # B<> : bold text + $tag eq "F") { # F<> : file specification + $s1 = process_BFI($tag, $params); + } elsif ($tag eq "C") { # C<> : literal code + $s1 = process_C($params, 1); + } elsif ($tag eq "E") { # E<> : escape + $s1 = process_E($params); + } elsif ($tag eq "Z") { # Z<> : zero-width character + $s1 = process_Z($params); + } elsif ($tag eq "S") { # S<> : non-breaking space + $s1 = process_S($params); + } elsif ($tag eq "X") { # S<> : non-breaking space + $s1 = process_X($params); + } else { + warn "$0: $podfile: unhandled tag '$tag' in paragraph $paragraph\n"; + } + + $result .= "$s1"; + } else { + # for pure text we must deal with implicit links and + # double-quotes among other things. + $result .= ($escapeQuotes ? process_puretext("$s1$s2$s3", \$quote) : "$s1$s2$s3"); + $rest = $s4; + } + } + } + $$text = $result; +} + +sub html_escape { + my $rest = $_[0]; + $rest =~ s/&/&/g; + $rest =~ s/</</g; + $rest =~ s/>/>/g; + $rest =~ s/"/"/g; + return $rest; +} + +# +# process_puretext - process pure text (without pod-escapes) converting +# double-quotes and handling implicit C<> links. +# +sub process_puretext { + my($text, $quote) = @_; + my(@words, $result, $rest, $lead, $trail); + + # convert double-quotes to single-quotes + $text =~ s/\A([^"]*)"/$1''/s if $$quote; + while ($text =~ s/\A([^"]*)["]([^"]*)["]/$1``$2''/sg) {} + + $$quote = ($text =~ m/"/ ? 1 : 0); + $text =~ s/\A([^"]*)"/$1``/s if $$quote; + + # keep track of leading and trailing white-space + $lead = ($text =~ /\A(\s*)/s ? $1 : ""); + $trail = ($text =~ /(\s*)\Z/s ? $1 : ""); + + # collapse all white space into a single space + $text =~ s/\s+/ /g; + @words = split(" ", $text); + + # process each word individually + foreach my $word (@words) { + # see if we can infer a link + if ($word =~ /^\w+\(/) { + # has parenthesis so should have been a C<> ref + $word = process_C($word); +# $word =~ /^[^()]*]\(/; +# if (defined $items{$1} && $items{$1}) { +# $word = "\n<CODE><A HREF=\"$htmlroot/$items{$1}#item_" +# . htmlify(0,$word) +# . "\">$word</A></CODE>"; +# } elsif (defined $items{$word} && $items{$word}) { +# $word = "\n<CODE><A HREF=\"$htmlroot/$items{$word}#item_" +# . htmlify(0,$word) +# . "\">$word</A></CODE>"; +# } else { +# $word = "\n<CODE><A HREF=\"#item_" +# . htmlify(0,$word) +# . "\">$word</A></CODE>"; +# } + } elsif ($word =~ /^[\$\@%&*]+\w+$/) { + # perl variables, should be a C<> ref + $word = process_C($word, 1); + } elsif ($word =~ m,^\w+://\w,) { + # looks like a URL + $word = qq(<A HREF="$word">$word</A>); + } elsif ($word =~ /[\w.-]+\@\w+\.\w/) { + # looks like an e-mail address + $word = qq(<A HREF="MAILTO:$word">$word</A>); + } elsif ($word !~ /[a-z]/ && $word =~ /[A-Z]/) { # all uppercase? + $word = html_escape($word) if $word =~ /[&<>]/; + $word = "\n<FONT SIZE=-1>$word</FONT>" if $netscape; + } else { + $word = html_escape($word) if $word =~ /[&<>]/; + } + } + + # build a new string based upon our conversion + $result = ""; + $rest = join(" ", @words); + while (length($rest) > 75) { + if ( $rest =~ m/^(.{0,75})\s(.*?)$/o || + $rest =~ m/^(\S*)\s(.*?)$/o) { + + $result .= "$1\n"; + $rest = $2; + } else { + $result .= "$rest\n"; + $rest = ""; + } + } + $result .= $rest if $rest; + + # restore the leading and trailing white-space + $result = "$lead$result$trail"; + + return $result; +} + +# +# pre_escape - convert & in text to $amp; +# +sub pre_escape { + my($str) = @_; + + $$str =~ s,&,&,g; +} + +# +# process_L - convert a pod L<> directive to a corresponding HTML link. +# most of the links made are inferred rather than known about directly +# (i.e it's not known whether the =head\d section exists in the target file, +# or whether a .pod file exists in the case of split files). however, the +# guessing usually works. +# +# Unlike the other directives, this should be called with an unprocessed +# string, else tags in the link won't be matched. +# +sub process_L { + my($str) = @_; + my($s1, $s2, $linktext, $page, $section, $link); # work strings + + $str =~ s/\n/ /g; # undo word-wrapped tags + $s1 = $str; + for ($s1) { + # a :: acts like a / + s,::,/,; + + # make sure sections start with a / + s,^",/",g; + s,^,/,g if (!m,/, && / /); + + # check if there's a section specified + if (m,^(.*?)/"?(.*?)"?$,) { # yes + ($page, $section) = ($1, $2); + } else { # no + ($page, $section) = ($str, ""); + } + + # check if we know that this is a section in this page + if (!defined $pages{$page} && defined $sections{$page}) { + $section = $page; + $page = ""; + } + } + + if ($page eq "") { + $link = "#" . htmlify(0,$section); + $linktext = $section; + } elsif (!defined $pages{$page}) { + warn "$0: $podfile: cannot resolve L<$str> in paragraph $paragraph: no such page '$page'\n"; + $link = ""; + $linktext = $page; + } else { + $linktext = ($section ? "$section" : "the $page manpage"); + $section = htmlify(0,$section) if $section ne ""; + + # if there is a directory by the name of the page, then assume that an + # appropriate section will exist in the subdirectory + if ($section ne "" && $pages{$page} =~ /([^:]*[^(\.pod|\.pm)]):/) { + $link = "$htmlroot/$1/$section.html"; + + # since there is no directory by the name of the page, the section will + # have to exist within a .html of the same name. thus, make sure there + # is a .pod or .pm that might become that .html + } else { + $section = "#$section"; + # check if there is a .pod with the page name + if ($pages{$page} =~ /([^:]*)\.pod:/) { + $link = "$htmlroot/$1.html$section"; + } elsif ($pages{$page} =~ /([^:]*)\.pm:/) { + $link = "$htmlroot/$1.html$section"; + } else { + warn "$0: $podfile: cannot resolve L$str in paragraph $paragraph: ". + "no .pod or .pm found\n"; + $link = ""; + $linktext = $section; + } + } + } + + process_text(\$linktext, 0); + if ($link) { + $s1 = "<A HREF=\"$link\">$linktext</A>"; + } else { + $s1 = "<EM>$linktext</EM>"; + } + return $s1; +} + +# +# process_BFI - process any of the B<>, F<>, or I<> pod-escapes and +# convert them to corresponding HTML directives. +# +sub process_BFI { + my($tag, $str) = @_; + my($s1); # work string + my(%repltext) = ( 'B' => 'STRONG', + 'F' => 'EM', + 'I' => 'EM'); + + # extract the modified text and convert to HTML + $s1 = "<$repltext{$tag}>$str</$repltext{$tag}>"; + return $s1; +} + +# +# process_C - process the C<> pod-escape. +# +sub process_C { + my($str, $doref) = @_; + my($s1, $s2); + + $s1 = $str; + $s1 =~ s/\([^()]*\)//g; # delete parentheses + $str = $s2 = $s1; + $s1 =~ s/\W//g; # delete bogus characters + + # if there was a pod file that we found earlier with an appropriate + # =item directive, then create a link to that page. + if ($doref && defined $items{$s1}) { + $s1 = ($items{$s1} ? + "<A HREF=\"$htmlroot/$items{$s1}#item_" . htmlify(0,$s2) . "\">$str</A>" : + "<A HREF=\"#item_" . htmlify(0,$s2) . "\">$str</A>"); + $s1 =~ s,(perl\w+/(\S+)\.html)#item_\2\b,$1,; + confess "s1 has space: $s1" if $s1 =~ /HREF="[^"]*\s[^"]*"/; + } else { + $s1 = "<CODE>$str</CODE>"; + # warn "$0: $podfile: cannot resolve C<$str> in paragraph $paragraph\n" if $verbose + } + + + return $s1; +} + +# +# process_E - process the E<> pod directive which seems to escape a character. +# +sub process_E { + my($str) = @_; + + for ($str) { + s,([^/].*),\&$1\;,g; + } + + return $str; +} + +# +# process_Z - process the Z<> pod directive which really just amounts to +# ignoring it. this allows someone to start a paragraph with an = +# +sub process_Z { + my($str) = @_; + + # there is no equivalent in HTML for this so just ignore it. + $str = ""; + return $str; +} + +# +# process_S - process the S<> pod directive which means to convert all +# spaces in the string to non-breaking spaces (in HTML-eze). +# +sub process_S { + my($str) = @_; + + # convert all spaces in the text to non-breaking spaces in HTML. + $str =~ s/ / /g; + return $str; +} + +# +# process_X - this is supposed to make an index entry. we'll just +# ignore it. +# +sub process_X { + return ''; +} + + +# +# finish_list - finish off any pending HTML lists. this should be called +# after the entire pod file has been read and converted. +# +sub finish_list { + while ($listlevel >= 0) { + print HTML "</DL>\n"; + $listlevel--; + } +} + +# +# htmlify - converts a pod section specification to a suitable section +# specification for HTML. if first arg is 1, only takes 1st word. +# +sub htmlify { + my($compact, $heading) = @_; + + if ($compact) { + $heading =~ /^(\w+)/; + $heading = $1; + } + + # $heading = lc($heading); + $heading =~ s/[^\w\s]/_/g; + $heading =~ s/(\s+)/ /g; + $heading =~ s/^\s*(.*?)\s*$/$1/s; + $heading =~ s/ /_/g; + $heading =~ s/\A(.{32}).*\Z/$1/s; + $heading =~ s/\s+\Z//; + $heading =~ s/_{2,}/_/g; + + return $heading; +} + +BEGIN { +} + +1; + diff --git a/lib/Pod/Text.pm b/lib/Pod/Text.pm index d40abbca94..bc3ccd6824 100644 --- a/lib/Pod/Text.pm +++ b/lib/Pod/Text.pm @@ -12,7 +12,7 @@ Pod::Text - convert POD data to formatted ASCII text Also: - pod2text < input.pod + pod2text [B<-a>] [B<->I<width>] < input.pod =head1 DESCRIPTION @@ -25,7 +25,9 @@ will be used to simulate bold and underlined text. A separate F<pod2text> program is included that is primarily a wrapper for Pod::Text. -The single function C<pod2text()> can take one or two arguments. The first +The single function C<pod2text()> can take the optional options B<-a> +for an alternative output format, then a B<->I<width> option with the +max terminal width, followed by one or two arguments. The first should be the name of a file to read the pod from, or "E<lt>&STDIN" to read from STDIN. A second argument, if provided, should be a filehandle glob where output should be sent. @@ -48,10 +50,12 @@ require Exporter; @EXPORT = qw(pod2text); use vars qw($VERSION); -$VERSION = "1.0202"; +$VERSION = "1.0203"; $termcap=0; +$opt_alt_format = 0; + #$use_format=1; $UNDL = "\x1b[4m"; @@ -60,8 +64,7 @@ $BOLD = "\x1b[1m"; $NORM = "\x1b[0m"; sub pod2text { -local($file,*OUTPUT) = @_; -*OUTPUT = *STDOUT if @_<2; +shift if $opt_alt_format = ($_[0] eq '-a'); if($termcap and !$setuptermcap) { $setuptermcap=1; @@ -79,6 +82,13 @@ $SCREEN = ($_[0] =~ /^-(\d+)/ && (shift, $1)) || (`stty -a 2>/dev/null` =~ /(\d+) columns/)[0] || 72; +@_ = ("<&STDIN") unless @_; +local($file,*OUTPUT) = @_; +*OUTPUT = *STDOUT if @_<2; + +local $: = $:; +$: = " \n" if $opt_alt_format; # Do not break ``-L/lib/'' into ``- L/lib/''. + $/ = ""; $FANCY = 0; @@ -112,7 +122,6 @@ POD_DIRECTIVE: while (<IN>) { }me; # Translate verbatim paragraph if (/^\s/) { - $needspace = 1; output($_); next; } @@ -143,7 +152,12 @@ sub prepare_for_output { $maxnest = 10; while ($maxnest-- && /[A-Z]</) { unless ($FANCY) { - s/C<(.*?)>/`$1'/sg; + if ($opt_alt_format) { + s/[BC]<(.*?)>/``$1''/sg; + s/F<(.*?)>/"$1"/sg; + } else { + s/C<(.*?)>/`$1'/sg; + } } else { s/C<(.*?)>/noremap("E<lchevron>${1}E<rchevron>")/sge; } @@ -216,8 +230,13 @@ sub prepare_for_output { } elsif ($Cmd eq 'head1') { makespace(); + if ($opt_alt_format) { + print OUTPUT "\n"; + s/^(.+?)[ \t]*$/==== $1 ====/; + } print OUTPUT; # print OUTPUT uc($_); + $needspace = $opt_alt_format; } elsif ($Cmd eq 'head2') { makespace(); @@ -225,7 +244,13 @@ sub prepare_for_output { #print ' ' x $DEF_INDENT, $_; # print "\xA7"; s/(\w)/\xA7 $1/ if $FANCY; - print OUTPUT ' ' x ($DEF_INDENT/2), $_, "\n"; + if ($opt_alt_format) { + s/^(.+?)[ \t]*$/== $1 ==/; + print OUTPUT "\n", $_; + } else { + print OUTPUT ' ' x ($DEF_INDENT/2), $_, "\n"; + } + $needspace = $opt_alt_format; } elsif ($Cmd eq 'over') { push(@indent,$indent); @@ -253,7 +278,7 @@ sub prepare_for_output { IP_output($paratag, $_); } else { local($indent) = $indent[$#index - 1] || $DEF_INDENT; - output($_); + output($_, 0); } } } @@ -347,7 +372,9 @@ sub IP_output { s/\s+/ /g; s/^ //; $str = "format OUTPUT = \n" - . (" " x ($tag_indent)) + . (($opt_alt_format && $tag_indent > 1) + ? ":" . " " x ($tag_indent - 1) + : " " x ($tag_indent)) . '@' . ('<' x ($indent - $tag_indent - 1)) . "^" . ("<" x ($cols - 1)) . "\n" . '$tag, $_' @@ -375,6 +402,7 @@ sub output { } else { s/^/' ' x $indent/gem; s/^\s+\n$/\n/gm; + s/^ /: /s if defined($reformat) && $opt_alt_format; print OUTPUT; } } diff --git a/lib/SelectSaver.pm b/lib/SelectSaver.pm index 4c764bedcf..5f569222fc 100644 --- a/lib/SelectSaver.pm +++ b/lib/SelectSaver.pm @@ -38,8 +38,10 @@ use Symbol; sub new { @_ >= 1 && @_ <= 2 or croak 'usage: new SelectSaver [FILEHANDLE]'; - my $fh = (@_ > 1) ? (select qualify($_[1], caller)) : select; - bless [$fh], $_[0]; + my $fh = select; + my $self = bless [$fh], $_[0]; + select qualify($_[1], caller) if @_ > 1; + $self; } sub DESTROY { diff --git a/lib/Sys/Syslog.pm b/lib/Sys/Syslog.pm index ee90127340..2da1d769d2 100644 --- a/lib/Sys/Syslog.pm +++ b/lib/Sys/Syslog.pm @@ -154,7 +154,7 @@ sub syslog { $whoami = $ident; - if (!$ident && $mask =~ /^(\S.*):\s?(.*)/) { + if (!$whoami && $mask =~ /^(\S.*?):\s?(.*)/) { $whoami = $1; $mask = $2; } diff --git a/lib/Term/Cap.pm b/lib/Term/Cap.pm index 5a73ecfc52..0b3b4aa4ad 100644 --- a/lib/Term/Cap.pm +++ b/lib/Term/Cap.pm @@ -185,13 +185,16 @@ sub Tgetent { ## public -- static method # This is eval'ed inside the while loop for each file $search = q{ - while ($_ = <TERMCAP>) { + while (<TERMCAP>) { next if /^\\t/ || /^#/; if ($_ =~ m/(^|\\|)${termpat}[:|]/o) { chomp; s/^[^:]*:// if $first++; $state = 0; - while ($_ =~ s/\\\\$//) { $_ .= <TERMCAP>; chomp; } + while ($_ =~ s/\\\\$//) { + defined(my $x = <TERMCAP>) or last; + $_ .= $x; chomp; + } last; } } diff --git a/lib/Term/Complete.pm b/lib/Term/Complete.pm index e3c290aa02..275aadeb65 100644 --- a/lib/Term/Complete.pm +++ b/lib/Term/Complete.pm @@ -29,6 +29,7 @@ The following command characters are defined: =over 4 =item E<lt>tabE<gt> + Attempts word completion. Cannot be changed. diff --git a/lib/Term/ReadLine.pm b/lib/Term/ReadLine.pm index 0c88a76e41..7b735eb424 100644 --- a/lib/Term/ReadLine.pm +++ b/lib/Term/ReadLine.pm @@ -152,7 +152,10 @@ sub findConsole { $console = "sys\$command"; } - if (defined $ENV{'OS2_SHELL'}) { # In OS/2 + if ($^O eq 'amigaos') { + $console = undef; + } + elsif ($^O eq 'os2') { if ($DB::emacs) { $console = undef; } else { diff --git a/lib/Text/ParseWords.pm b/lib/Text/ParseWords.pm index f2e1514972..bd95b4f204 100644 --- a/lib/Text/ParseWords.pm +++ b/lib/Text/ParseWords.pm @@ -1,11 +1,13 @@ package Text::ParseWords; require 5.000; -require Exporter; -require AutoLoader; use Carp; -@ISA = qw(Exporter AutoLoader); +require AutoLoader; +*AUTOLOAD = \&AutoLoader::AUTOLOAD; + +require Exporter; +@ISA = qw(Exporter); @EXPORT = qw(shellwords quotewords); @EXPORT_OK = qw(old_shellwords); diff --git a/lib/UNIVERSAL.pm b/lib/UNIVERSAL.pm index c0e7ebdee2..6d832c4bea 100644 --- a/lib/UNIVERSAL.pm +++ b/lib/UNIVERSAL.pm @@ -2,7 +2,7 @@ package UNIVERSAL; require Exporter; @ISA = qw(Exporter); -@EXPORT_OK = qw(isa); +@EXPORT_OK = qw(isa can); 1; __END__ @@ -58,7 +58,7 @@ C<UNIVERSAL> also optionally exports the following subroutines =over 4 -=item isa ( REF, TYPE ) +=item isa ( VAL, TYPE ) C<isa> returns I<true> if the first argument is a reference and either of the following statements is true. @@ -67,15 +67,22 @@ of the following statements is true. =item -C<REF> is a blessed reference and is blessed into package C<TYPE> +C<VAL> is a blessed reference and is blessed into package C<TYPE> or inherits from package C<TYPE> =item -C<REF> is a reference to a C<TYPE> of perl variable (er 'HASH') +C<VAL> is a reference to a C<TYPE> of perl variable (er 'HASH') =back +=item can ( VAL, METHOD ) + +If C<VAL> is a blessed reference which has a method called C<METHOD>, +C<can> returns a reference to the subroutine. If C<VAL> is not +a blessed reference, or if it does not have a method C<METHOD>, +I<undef> is returned. + =back =cut diff --git a/lib/autouse.pm b/lib/autouse.pm index e2ef580392..b3adc34549 100644 --- a/lib/autouse.pm +++ b/lib/autouse.pm @@ -3,7 +3,7 @@ package autouse; #use strict; # debugging only use 5.003_90; # ->can, for my $var -$autouse::VERSION = '0.03'; +$autouse::VERSION = '1.00'; my $DEBUG = $ENV{AUTOUSE_DEBUG}; diff --git a/lib/bigfloat.pl b/lib/bigfloat.pl index 9ad171f295..d687c784f1 100644 --- a/lib/bigfloat.pl +++ b/lib/bigfloat.pl @@ -41,8 +41,10 @@ $rnd_mode = 'even'; sub main'fnorm { #(string) return fnum_str local($_) = @_; s/\s+//g; # strip white space - if (/^([+-]?)(\d*)(\.(\d*))?([Ee]([+-]?\d+))?$/ && "$2$4" ne '') { - &norm(($1 ? "$1$2$4" : "+$2$4"),(($4 ne '') ? $6-length($4) : $6)); + if (/^([+-]?)(\d*)(\.(\d*))?([Ee]([+-]?\d+))?$/ + && ($2 ne '' || defined($4))) { + my $x = defined($4) ? $4 : ''; + &norm(($1 ? "$1$2$x" : "+$2$x"), (($x ne '') ? $6-length($x) : $6)); } else { 'NaN'; } diff --git a/lib/chat2.inter b/lib/chat2.inter deleted file mode 100644 index 6934f1cc28..0000000000 --- a/lib/chat2.inter +++ /dev/null @@ -1,495 +0,0 @@ -Article 20992 of comp.lang.perl: -Path: netlabs!news.cerf.net!mvb.saic.com!MathWorks.Com!europa.eng.gtefsd.com!howland.reston.ans.net!cs.utexas.edu!swrinde!ihnp4.ucsd.edu!ames!koriel!male.EBay.Sun.COM!jethro.Corp.Sun.COM!eric -From: eric.arnold@sun.com (Eric Arnold) -Newsgroups: comp.lang.perl -Subject: Re: Need a bidirectional filter for interactive Unix applications -Date: 15 Apr 94 21:24:03 GMT -Organization: Sun Microsystems -Lines: 478 -Sender: news@sun.com -Message-ID: <ERIC.94Apr15212403@sun.com> -References: <dgfCo9F2J.Jzw@netcom.com> <1994Apr15.110134.4581@chemabs.uucp> -NNTP-Posting-Host: animus.corp.sun.com -X-Newsreader: prn Ver 1.09 -In-reply-to: btf64@cas.org's message of Fri, 15 Apr 1994 11:01:34 GMT - -In article <1994Apr15.110134.4581@chemabs.uucp> - btf64@cas.org (Bernard T. French) writes: - ->In article <dgfCo9F2J.Jzw@netcom.com> dgf@netcom.com (David Feldman) writes: ->>I need to write a bidirectional filter that would (ideally) sit between a -.. ->>program's stdin & stdout to point to a pty pair known to perl. The perl app- ->>lication would talk to the user's crt/keyboard, translate (application-specific) ->>the input & output streams, and pass these as appropriate to/from the pty pair, -.. -> -> I'm afraid I can't offer you a perl solution, but err..... there is a ->Tcl solution. There is a Tcl extension called "expect" that is designed to - -There *is* an old, established Perl solution: "chat2.pl" which does -everything (well, basically) "expect" does but you get it in the -expressive Perl environment. "chat2.pl" is delivered with the Perl -source. - -Randal: "interact()" still hasn't made it into Perl5alpha8 -"chat2.pl", so I've included a version which does. - --Eric - - -## chat.pl: chat with a server -## V2.01.alpha.7 91/06/16 -## Randal L. Schwartz - -package chat; - -$sockaddr = 'S n a4 x8'; -chop($thishost = `hostname`); $thisaddr = (gethostbyname($thishost))[4]; -$thisproc = pack($sockaddr, 2, 0, $thisaddr); - -# *S = symbol for current I/O, gets assigned *chatsymbol.... -$next = "chatsymbol000000"; # next one -$nextpat = "^chatsymbol"; # patterns that match next++, ++, ++, ++ - - -## $handle = &chat'open_port("server.address",$port_number); -## opens a named or numbered TCP server - -sub open_port { ## public - local($server, $port) = @_; - - local($serveraddr,$serverproc); - - *S = ++$next; - if ($server =~ /^(\d+)+\.(\d+)\.(\d+)\.(\d+)$/) { - $serveraddr = pack('C4', $1, $2, $3, $4); - } else { - local(@x) = gethostbyname($server); - return undef unless @x; - $serveraddr = $x[4]; - } - $serverproc = pack($sockaddr, 2, $port, $serveraddr); - unless (socket(S, 2, 1, 6)) { - # XXX hardwired $AF_SOCKET, $SOCK_STREAM, 'tcp' - # but who the heck would change these anyway? (:-) - ($!) = ($!, close(S)); # close S while saving $! - return undef; - } - unless (bind(S, $thisproc)) { - ($!) = ($!, close(S)); # close S while saving $! - return undef; - } - unless (connect(S, $serverproc)) { - ($!) = ($!, close(S)); # close S while saving $! - return undef; - } - select((select(S), $| = 1)[0]); - $next; # return symbol for switcharound -} - -## ($host, $port, $handle) = &chat'open_listen([$port_number]); -## opens a TCP port on the current machine, ready to be listened to -## if $port_number is absent or zero, pick a default port number -## process must be uid 0 to listen to a low port number - -sub open_listen { ## public - - *S = ++$next; - local($thisport) = shift || 0; - local($thisproc_local) = pack($sockaddr, 2, $thisport, $thisaddr); - local(*NS) = "__" . time; - unless (socket(NS, 2, 1, 6)) { - # XXX hardwired $AF_SOCKET, $SOCK_STREAM, 'tcp' - # but who the heck would change these anyway? (:-) - ($!) = ($!, close(NS)); - return undef; - } - unless (bind(NS, $thisproc_local)) { - ($!) = ($!, close(NS)); - return undef; - } - unless (listen(NS, 1)) { - ($!) = ($!, close(NS)); - return undef; - } - select((select(NS), $| = 1)[0]); - local($family, $port, @myaddr) = - unpack("S n C C C C x8", getsockname(NS)); - $S{"needs_accept"} = *NS; # so expect will open it - (@myaddr, $port, $next); # returning this -} - -## $handle = &chat'open_proc("command","arg1","arg2",...); -## opens a /bin/sh on a pseudo-tty - -sub open_proc { ## public - local(@cmd) = @_; - - *S = ++$next; - local(*TTY) = "__TTY" . time; - local($pty,$tty,$pty_handle) = &_getpty(S,TTY); - - #local($pty,$tty,$pty_handle) = &getpty(S,TTY); - #$Tty = $tty; - - die "Cannot find a new pty" unless defined $pty; - local($pid) = fork; - die "Cannot fork: $!" unless defined $pid; - unless ($pid) { - close STDIN; close STDOUT; close STDERR; - #close($pty_handle); - setpgrp(0,$$); - if (open(DEVTTY, "/dev/tty")) { - ioctl(DEVTTY,0x20007471,0); # XXX s/b &TIOCNOTTY - close DEVTTY; - } - open(STDIN,"<&TTY"); - open(STDOUT,">&TTY"); - open(STDERR,">&STDOUT"); - die "Oops" unless fileno(STDERR) == 2; # sanity - close(S); - - exec @cmd; - die "Cannot exec @cmd: $!"; - } - close(TTY); - $PID{$next} = $pid; - $next; # return symbol for switcharound - -} - -# $S is the read-ahead buffer - -## $return = &chat'expect([$handle,] $timeout_time, -## $pat1, $body1, $pat2, $body2, ... ) -## $handle is from previous &chat'open_*(). -## $timeout_time is the time (either relative to the current time, or -## absolute, ala time(2)) at which a timeout event occurs. -## $pat1, $pat2, and so on are regexs which are matched against the input -## stream. If a match is found, the entire matched string is consumed, -## and the corresponding body eval string is evaled. -## -## Each pat is a regular-expression (probably enclosed in single-quotes -## in the invocation). ^ and $ will work, respecting the current value of $*. -## If pat is 'TIMEOUT', the body is executed if the timeout is exceeded. -## If pat is 'EOF', the body is executed if the process exits before -## the other patterns are seen. -## -## Pats are scanned in the order given, so later pats can contain -## general defaults that won't be examined unless the earlier pats -## have failed. -## -## The result of eval'ing body is returned as the result of -## the invocation. Recursive invocations are not thought -## through, and may work only accidentally. :-) -## -## undef is returned if either a timeout or an eof occurs and no -## corresponding body has been defined. -## I/O errors of any sort are treated as eof. - -$nextsubname = "expectloop000000"; # used for subroutines - -sub expect { ## public - if ($_[0] =~ /$nextpat/) { - *S = shift; - } - local($endtime) = shift; - - local($timeout,$eof) = (1,1); - local($caller) = caller; - local($rmask, $nfound, $timeleft, $thisbuf); - local($cases, $pattern, $action, $subname); - $endtime += time if $endtime < 600_000_000; - - if (defined $S{"needs_accept"}) { # is it a listen socket? - local(*NS) = $S{"needs_accept"}; - delete $S{"needs_accept"}; - $S{"needs_close"} = *NS; - unless(accept(S,NS)) { - ($!) = ($!, close(S), close(NS)); - return undef; - } - select((select(S), $| = 1)[0]); - } - - # now see whether we need to create a new sub: - - unless ($subname = $expect_subname{$caller,@_}) { - # nope. make a new one: - $expect_subname{$caller,@_} = $subname = $nextsubname++; - - $cases .= <<"EDQ"; # header is funny to make everything elsif's -sub $subname { - LOOP: { - if (0) { ; } -EDQ - while (@_) { - ($pattern,$action) = splice(@_,0,2); - if ($pattern =~ /^eof$/i) { - $cases .= <<"EDQ"; - elsif (\$eof) { - package $caller; - $action; - } -EDQ - $eof = 0; - } elsif ($pattern =~ /^timeout$/i) { - $cases .= <<"EDQ"; - elsif (\$timeout) { - package $caller; - $action; - } -EDQ - $timeout = 0; - } else { - $pattern =~ s#/#\\/#g; - $cases .= <<"EDQ"; - elsif (\$S =~ /$pattern/) { - \$S = \$'; - package $caller; - $action; - } -EDQ - } - } - $cases .= <<"EDQ" if $eof; - elsif (\$eof) { - undef; - } -EDQ - $cases .= <<"EDQ" if $timeout; - elsif (\$timeout) { - undef; - } -EDQ - $cases .= <<'ESQ'; - else { - $rmask = ""; - vec($rmask,fileno(S),1) = 1; - ($nfound, $rmask) = - select($rmask, undef, undef, $endtime - time); - if ($nfound) { - $nread = sysread(S, $thisbuf, 1024); - if ($nread > 0) { - $S .= $thisbuf; - } else { - $eof++, redo LOOP; # any error is also eof - } - } else { - $timeout++, redo LOOP; # timeout - } - redo LOOP; - } - } -} -ESQ - eval $cases; die "$cases:\n$@" if $@; - } - $eof = $timeout = 0; - do $subname(); -} - -## &chat'print([$handle,] @data) -## $handle is from previous &chat'open(). -## like print $handle @data - -sub print { ## public - if ($_[0] =~ /$nextpat/) { - *S = shift; - } - print S @_; -} - -## &chat'close([$handle,]) -## $handle is from previous &chat'open(). -## like close $handle - -sub close { ## public - local($pid); - if ($_[0] =~ /$nextpat/) { - $pid = $PID{$_[0]}; - *S = shift; - } else { - $pid = $PID{$next}; - } - close(S); - waitpid($pid,0); - if (defined $S{"needs_close"}) { # is it a listen socket? - local(*NS) = $S{"needs_close"}; - delete $S{"needs_close"}; - close(NS); - } -} - -## @ready_handles = &chat'select($timeout, @handles) -## select()'s the handles with a timeout value of $timeout seconds. -## Returns an array of handles that are ready for I/O. -## Both user handles and chat handles are supported (but beware of -## stdio's buffering for user handles). - -sub select { ## public - local($timeout) = shift; - local(@handles) = @_; - local(%handlename) = (); - local(%ready) = (); - local($caller) = caller; - local($rmask) = ""; - for (@handles) { - if (/$nextpat/o) { # one of ours... see if ready - local(*SYM) = $_; - if (length($SYM)) { - $timeout = 0; # we have a winner - $ready{$_}++; - } - $handlename{fileno($_)} = $_; - } else { - $handlename{fileno(/'/ ? $_ : "$caller\'$_")} = $_; - } - } - for (sort keys %handlename) { - vec($rmask, $_, 1) = 1; - } - select($rmask, undef, undef, $timeout); - for (sort keys %handlename) { - $ready{$handlename{$_}}++ if vec($rmask,$_,1); - } - sort keys %ready; -} - -# ($pty,$tty) = $chat'_getpty(PTY,TTY): -# internal procedure to get the next available pty. -# opens pty on handle PTY, and matching tty on handle TTY. -# returns undef if can't find a pty. - -sub _getpty { ## private - local($_PTY,$_TTY) = @_; - $_PTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e; - $_TTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e; - local($pty,$tty); - for $bank (112..127) { - next unless -e sprintf("/dev/pty%c0", $bank); - for $unit (48..57) { - $pty = sprintf("/dev/pty%c%c", $bank, $unit); - open($_PTY,"+>$pty") || next; - select((select($_PTY), $| = 1)[0]); - ($tty = $pty) =~ s/pty/tty/; - open($_TTY,"+>$tty") || next; - select((select($_TTY), $| = 1)[0]); - system "stty nl>$tty"; - return ($pty,$tty,$_PTY); - } - } - undef; -} - - -sub getpty { - local( $pty_handle, $tty_handle ) = @_; - -print "--------in getpty----------\n"; - $pty_handle =~ s/^([^']+)$/(caller)[$[]."'".$1/e; - $pty_handle =~ s/^([^']+)$/(caller)[$[]."'".$1/e; - - #$pty_handle = ++$next_handle; - chop( @ptys = `ls /dev/pty*` ); - - for $pty ( @ptys ) - { - open($pty_handle,"+>$pty") || next; - select((select($pty_handle), $| = 1)[0]); - ($tty = $pty) =~ s/pty/tty/; - - open($tty_handle,"+>$tty") || next; - select((select($tty_handle), $| = 1)[0]); - ($tty = $pty) =~ s/pty/tty/; - - return ($pty, $tty, $pty_handle ); - } - return undef; -} - - - -# from: Randal L. Schwartz - -# Usage: -# -# ($chathandle = &chat'open_proc("/bin/sh")) || die "cannot open shell"; -# system("stty cbreak raw -echo >/dev/tty\n"); -# &chat'interact($chathandle); -# &chat'close($chathandle); -# system("stty -cbreak -raw echo >/dev/tty\n"); - -sub interact -{ - local( $chathandle ) = @_; - - &chat'print($chathandle, "stty sane\n"); - select(STDOUT) ; $| = 1; # unbuffer STDOUT - - #print "tty=$Tty,whoami=",`whoami`,"\n"; - #&change_utmp( "", $Tty, "eric", "", time() ); - - { - @ready = &chat'select(30, STDIN,$chathandle); - print "after select, ready=",join(",",@ready),"\n"; - #(warn "[waiting]"), redo unless @ready; - if (grep($_ eq $chathandle, @ready)) { - print "checking $chathandle\n"; - last unless $text = &chat'expect($chathandle,0,'[\s\S]+','$&'); - print "$chathandle OK\n"; - print "got=($text)"; - #print $text; - } - if (grep($_ eq STDIN, @ready)) { - print "checking STDIN\n"; - last unless sysread(STDIN,$buf,1024) > 0; - print "STDIN OK\n"; - &chat'print($chathandle,$buf); - } - redo; - } - #&change_utmp( $Tty, "$Tty", "", "", 0 ); - print "leaving interact, \$!=$!\n"; -} - -## $handle = &chat'open_duphandle(handle); -## duplicates an input file handle to conform to chat format - -sub open_duphandle { ## public - *S = ++$next; - open(S,"<&$_[0]"); - $next; # return symbol for switcharound -} - -#Here is an example which uses this routine. -# -# # The following lines makes stdin unbuffered -# -# $BSD = -f '/vmunix'; -# -# if ($BSD) { -# system "stty cbreak </dev/tty >/dev/tty 2>&1"; -# } -# else { -# system "stty", '-icanon'; -# system "stty", 'eol', '^A'; -# } -# -# require 'mychat2.pl'; -# -# &chat'open_duphandle(STDIN); -# -# print -# &chat'expect(3, -# '[A-Z]', '" :-)"', -# '.', '" :-("', -# TIMEOUT, '"-o-"', -# EOF, '"\$\$"'), -# "\n"; - - -1; - - diff --git a/lib/chat2.pl b/lib/chat2.pl deleted file mode 100644 index 8320270175..0000000000 --- a/lib/chat2.pl +++ /dev/null @@ -1,368 +0,0 @@ -# chat.pl: chat with a server -# Based on: V2.01.alpha.7 91/06/16 -# Randal L. Schwartz (was <merlyn@stonehenge.com>) -# multihome additions by A.Macpherson@bnr.co.uk -# allow for /dev/pts based systems by Joe Doupnik <JRD@CC.USU.EDU> - -package chat; - -require 'sys/socket.ph'; - -if( defined( &main'PF_INET ) ){ - $pf_inet = &main'PF_INET; - $sock_stream = &main'SOCK_STREAM; - local($name, $aliases, $proto) = getprotobyname( 'tcp' ); - $tcp_proto = $proto; -} -else { - # XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp' - # but who the heck would change these anyway? (:-) - $pf_inet = 2; - $sock_stream = 1; - $tcp_proto = 6; -} - - -$sockaddr = 'S n a4 x8'; -chop($thishost = `hostname`); - -# *S = symbol for current I/O, gets assigned *chatsymbol.... -$next = "chatsymbol000000"; # next one -$nextpat = "^chatsymbol"; # patterns that match next++, ++, ++, ++ - - -## $handle = &chat'open_port("server.address",$port_number); -## opens a named or numbered TCP server - -sub open_port { ## public - local($server, $port) = @_; - - local($serveraddr,$serverproc); - - # We may be multi-homed, start with 0, fixup once connexion is made - $thisaddr = "\0\0\0\0" ; - $thisproc = pack($sockaddr, 2, 0, $thisaddr); - - *S = ++$next; - if ($server =~ /^(\d+)+\.(\d+)\.(\d+)\.(\d+)$/) { - $serveraddr = pack('C4', $1, $2, $3, $4); - } else { - local(@x) = gethostbyname($server); - return undef unless @x; - $serveraddr = $x[4]; - } - $serverproc = pack($sockaddr, 2, $port, $serveraddr); - unless (socket(S, $pf_inet, $sock_stream, $tcp_proto)) { - ($!) = ($!, close(S)); # close S while saving $! - return undef; - } - unless (bind(S, $thisproc)) { - ($!) = ($!, close(S)); # close S while saving $! - return undef; - } - unless (connect(S, $serverproc)) { - ($!) = ($!, close(S)); # close S while saving $! - return undef; - } -# We opened with the local address set to ANY, at this stage we know -# which interface we are using. This is critical if our machine is -# multi-homed, with IP forwarding off, so fix-up. - local($fam,$lport); - ($fam,$lport,$thisaddr) = unpack($sockaddr, getsockname(S)); - $thisproc = pack($sockaddr, 2, 0, $thisaddr); -# end of post-connect fixup - select((select(S), $| = 1)[0]); - $next; # return symbol for switcharound -} - -## ($host, $port, $handle) = &chat'open_listen([$port_number]); -## opens a TCP port on the current machine, ready to be listened to -## if $port_number is absent or zero, pick a default port number -## process must be uid 0 to listen to a low port number - -sub open_listen { ## public - - *S = ++$next; - local($thisport) = shift || 0; - local($thisproc_local) = pack($sockaddr, 2, $thisport, $thisaddr); - local(*NS) = "__" . time; - unless (socket(NS, $pf_inet, $sock_stream, $tcp_proto)) { - ($!) = ($!, close(NS)); - return undef; - } - unless (bind(NS, $thisproc_local)) { - ($!) = ($!, close(NS)); - return undef; - } - unless (listen(NS, 1)) { - ($!) = ($!, close(NS)); - return undef; - } - select((select(NS), $| = 1)[0]); - local($family, $port, @myaddr) = - unpack("S n C C C C x8", getsockname(NS)); - $S{"needs_accept"} = *NS; # so expect will open it - (@myaddr, $port, $next); # returning this -} - -## $handle = &chat'open_proc("command","arg1","arg2",...); -## opens a /bin/sh on a pseudo-tty - -sub open_proc { ## public - local(@cmd) = @_; - - *S = ++$next; - local(*TTY) = "__TTY" . time; - local($pty,$tty) = &_getpty(S,TTY); - die "Cannot find a new pty" unless defined $pty; - $pid = fork; - die "Cannot fork: $!" unless defined $pid; - unless ($pid) { - close STDIN; close STDOUT; close STDERR; - setpgrp(0,$$); - if (open(DEVTTY, "/dev/tty")) { - ioctl(DEVTTY,0x20007471,0); # XXX s/b &TIOCNOTTY - close DEVTTY; - } - open(STDIN,"<&TTY"); - open(STDOUT,">&TTY"); - open(STDERR,">&STDOUT"); - die "Oops" unless fileno(STDERR) == 2; # sanity - close(S); - exec @cmd; - die "Cannot exec @cmd: $!"; - } - close(TTY); - $next; # return symbol for switcharound -} - -# $S is the read-ahead buffer - -## $return = &chat'expect([$handle,] $timeout_time, -## $pat1, $body1, $pat2, $body2, ... ) -## $handle is from previous &chat'open_*(). -## $timeout_time is the time (either relative to the current time, or -## absolute, ala time(2)) at which a timeout event occurs. -## $pat1, $pat2, and so on are regexs which are matched against the input -## stream. If a match is found, the entire matched string is consumed, -## and the corresponding body eval string is evaled. -## -## Each pat is a regular-expression (probably enclosed in single-quotes -## in the invocation). ^ and $ will work, respecting the current value of $*. -## If pat is 'TIMEOUT', the body is executed if the timeout is exceeded. -## If pat is 'EOF', the body is executed if the process exits before -## the other patterns are seen. -## -## Pats are scanned in the order given, so later pats can contain -## general defaults that won't be examined unless the earlier pats -## have failed. -## -## The result of eval'ing body is returned as the result of -## the invocation. Recursive invocations are not thought -## through, and may work only accidentally. :-) -## -## undef is returned if either a timeout or an eof occurs and no -## corresponding body has been defined. -## I/O errors of any sort are treated as eof. - -$nextsubname = "expectloop000000"; # used for subroutines - -sub expect { ## public - if ($_[0] =~ /$nextpat/) { - *S = shift; - } - local($endtime) = shift; - - local($timeout,$eof) = (1,1); - local($caller) = caller; - local($rmask, $nfound, $timeleft, $thisbuf); - local($cases, $pattern, $action, $subname); - $endtime += time if $endtime < 600_000_000; - - if (defined $S{"needs_accept"}) { # is it a listen socket? - local(*NS) = $S{"needs_accept"}; - delete $S{"needs_accept"}; - $S{"needs_close"} = *NS; - unless(accept(S,NS)) { - ($!) = ($!, close(S), close(NS)); - return undef; - } - select((select(S), $| = 1)[0]); - } - - # now see whether we need to create a new sub: - - unless ($subname = $expect_subname{$caller,@_}) { - # nope. make a new one: - $expect_subname{$caller,@_} = $subname = $nextsubname++; - - $cases .= <<"EDQ"; # header is funny to make everything elsif's -sub $subname { - LOOP: { - if (0) { ; } -EDQ - while (@_) { - ($pattern,$action) = splice(@_,0,2); - if ($pattern =~ /^eof$/i) { - $cases .= <<"EDQ"; - elsif (\$eof) { - package $caller; - $action; - } -EDQ - $eof = 0; - } elsif ($pattern =~ /^timeout$/i) { - $cases .= <<"EDQ"; - elsif (\$timeout) { - package $caller; - $action; - } -EDQ - $timeout = 0; - } else { - $pattern =~ s#/#\\/#g; - $cases .= <<"EDQ"; - elsif (\$S =~ /$pattern/) { - \$S = \$'; - package $caller; - $action; - } -EDQ - } - } - $cases .= <<"EDQ" if $eof; - elsif (\$eof) { - undef; - } -EDQ - $cases .= <<"EDQ" if $timeout; - elsif (\$timeout) { - undef; - } -EDQ - $cases .= <<'ESQ'; - else { - $rmask = ""; - vec($rmask,fileno(S),1) = 1; - ($nfound, $rmask) = - select($rmask, undef, undef, $endtime - time); - if ($nfound) { - $nread = sysread(S, $thisbuf, 1024); - if ($nread > 0) { - $S .= $thisbuf; - } else { - $eof++, redo LOOP; # any error is also eof - } - } else { - $timeout++, redo LOOP; # timeout - } - redo LOOP; - } - } -} -ESQ - eval $cases; die "$cases:\n$@" if $@; - } - $eof = $timeout = 0; - &$subname(); -} - -## &chat'print([$handle,] @data) -## $handle is from previous &chat'open(). -## like print $handle @data - -sub print { ## public - if ($_[0] =~ /$nextpat/) { - *S = shift; - } - print S @_; - if( $chat'debug ){ - print STDERR "printed:"; - print STDERR @_; - } -} - -## &chat'close([$handle,]) -## $handle is from previous &chat'open(). -## like close $handle - -sub close { ## public - if ($_[0] =~ /$nextpat/) { - *S = shift; - } - close(S); - if (defined $S{"needs_close"}) { # is it a listen socket? - local(*NS) = $S{"needs_close"}; - delete $S{"needs_close"}; - close(NS); - } -} - -## @ready_handles = &chat'select($timeout, @handles) -## select()'s the handles with a timeout value of $timeout seconds. -## Returns an array of handles that are ready for I/O. -## Both user handles and chat handles are supported (but beware of -## stdio's buffering for user handles). - -sub select { ## public - local($timeout) = shift; - local(@handles) = @_; - local(%handlename) = (); - local(%ready) = (); - local($caller) = caller; - local($rmask) = ""; - for (@handles) { - if (/$nextpat/o) { # one of ours... see if ready - local(*SYM) = $_; - if (length($SYM)) { - $timeout = 0; # we have a winner - $ready{$_}++; - } - $handlename{fileno($_)} = $_; - } else { - $handlename{fileno(/'/ ? $_ : "$caller\'$_")} = $_; - } - } - for (sort keys %handlename) { - vec($rmask, $_, 1) = 1; - } - select($rmask, undef, undef, $timeout); - for (sort keys %handlename) { - $ready{$handlename{$_}}++ if vec($rmask,$_,1); - } - sort keys %ready; -} - -# ($pty,$tty) = $chat'_getpty(PTY,TTY): -# internal procedure to get the next available pty. -# opens pty on handle PTY, and matching tty on handle TTY. -# returns undef if can't find a pty. -# Modify "/dev/pty" to "/dev/pts" for Dell Unix v2.2 (aka SVR4.04). Joe Doupnik. - -sub _getpty { ## private - local($_PTY,$_TTY) = @_; - $_PTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e; - $_TTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e; - local($pty, $tty, $kind); - if( -e "/dev/pts000" ){ ## mods by Joe Doupnik Dec 1992 - $kind = "pts"; ## SVR4 Streams - } else { - $kind = "pty"; ## BSD Clist stuff - } - for $bank (112..127) { - next unless -e sprintf("/dev/$kind%c0", $bank); - for $unit (48..57) { - $pty = sprintf("/dev/$kind%c%c", $bank, $unit); - open($_PTY,"+>$pty") || next; - select((select($_PTY), $| = 1)[0]); - ($tty = $pty) =~ s/pty/tty/; - open($_TTY,"+>$tty") || next; - select((select($_TTY), $| = 1)[0]); - system "stty nl>$tty"; - return ($pty,$tty); - } - } - undef; -} - -1; diff --git a/lib/constant.pm b/lib/constant.pm new file mode 100644 index 0000000000..a0d4f9d5cd --- /dev/null +++ b/lib/constant.pm @@ -0,0 +1,163 @@ +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. +(These error numbers aren't totally portable, alas.) + + 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_96; + +#======================================================================= +# 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; diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm index 5e8e971f44..0bdf1be1fa 100644 --- a/lib/diagnostics.pm +++ b/lib/diagnostics.pm @@ -166,12 +166,16 @@ require 5.001; use Carp; use Config; +($privlib, $archlib) = @Config{qw(privlibexp archlibexp)}; if ($^O eq 'VMS') { - $PODFILE = VMS::Filespec::unixify($Config{privlibexp}).'/pod/perldiag.pod'; -} -else { - $PODFILE = $Config{privlibexp} . "/pod/perldiag.pod"; + require VMS::Filespec; + $privlib = VMS::Filespec::unixify($privlib); + $archlib = VMS::Filespec::unixify($archlib); } +@trypod = ("$archlib/pod/perldiag.pod", + "$privlib/pod/perldiag-$].pod", + "$privlib/pod/perldiag.pod"); +($PODFILE) = ((grep { -e } @trypod), $trypod[$#trypod])[0]; $DEBUG ||= 0; my $WHOAMI = ref bless []; # nobody's business, prolly not even mine @@ -188,7 +192,8 @@ CONFIG: { unless (caller) { $standalone++; require Getopt::Std; - Getopt::Std::getopts('pdvf:') || die "Usage: $0 [-v] [-p] [-f splainpod]"; + Getopt::Std::getopts('pdvf:') + or die "Usage: $0 [-v] [-p] [-f splainpod]"; $PODFILE = $opt_f if $opt_f; $DEBUG = 2 if $opt_d; $VERBOSE = $opt_v; diff --git a/lib/perl5db.pl b/lib/perl5db.pl index 5e2bd43ae6..9718fede67 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -2,7 +2,7 @@ package DB; # Debugger for Perl 5.00x; perl5db.pl patch level: -$VERSION = 0.9908; +$VERSION = 0.9909; $header = "perl5db.pl patch level $VERSION"; # Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich) @@ -411,7 +411,9 @@ sub DB { $evalarg = $action, &eval if $action; if ($single || $was_signal) { local $level = $level + 1; - map {$evalarg = $_, &eval} @$pre; + foreach $evalarg (@$pre) { + &eval; + } print $OUT $#stack . " levels deep in subroutine calls!\n" if $single & 4; $start = $line; @@ -1074,7 +1076,9 @@ sub DB { } } # CMD: $exiting = 1 unless defined $cmd; - map {$evalarg = $_; &eval} @$post; + foreach $evalarg (@$post) { + &eval; + } } # if ($single || $signal) ($@, $!, $,, $/, $\, $^W) = @saved; (); diff --git a/lib/subs.pm b/lib/subs.pm index aa4c7e751e..512bc9be9a 100644 --- a/lib/subs.pm +++ b/lib/subs.pm @@ -23,6 +23,7 @@ declarations with C<no vars> or C<no subs>. See L<perlmod/Pragmatic Modules> and L<strict/strict subs>. =cut + require 5.000; sub import { @@ -581,27 +581,20 @@ MAGIC* mg; { register char *s; char *ptr; - STRLEN len; + STRLEN len, klen; I32 i; s = SvPV(sv,len); - ptr = MgPV(mg); + ptr = MgPV(mg,klen); my_setenv(ptr, s); #ifdef DYNAMIC_ENV_FETCH /* We just undefd an environment var. Is a replacement */ /* waiting in the wings? */ if (!len) { - HE *envhe; - SV *keysv; - if (mg->mg_len == HEf_SVKEY) - keysv = (SV *)mg->mg_ptr; - else - keysv = newSVpv(mg->mg_ptr, mg->mg_len); - if ((envhe = hv_fetch_ent(GvHVn(envgv), keysv, FALSE, 0))) - s = SvPV(HeVAL(envhe), len); - if (mg->mg_len != HEf_SVKEY) - SvREFCNT_dec(keysv); + SV **valp; + if ((valp = hv_fetch(GvHVn(envgv), ptr, klen, FALSE))) + s = SvPV(*valp, len); } #endif @@ -611,7 +604,7 @@ MAGIC* mg; if (tainting) { MgTAINTEDDIR_off(mg); #ifdef VMS - if (s && strnEQ(ptr, "DCL$PATH", 8)) { + if (s && klen == 8 && strEQ(ptr, "DCL$PATH")) { char pathbuf[256], eltbuf[256], *cp, *elt = s; struct stat sbuf; int i = 0, j = 0; @@ -636,7 +629,7 @@ MAGIC* mg; } while (my_trnlnm(s, pathbuf, i++) && (elt = pathbuf)); } #endif /* VMS */ - if (s && strEQ(ptr,"PATH")) { + if (s && klen == 4 && strEQ(ptr,"PATH")) { char *strend = s + len; while (s < strend) { @@ -661,7 +654,7 @@ magic_clearenv(sv,mg) SV* sv; MAGIC* mg; { - my_setenv(MgPV(mg),Nullch); + my_setenv(MgPV(mg,na),Nullch); return 0; } @@ -672,7 +665,7 @@ MAGIC* mg; { I32 i; /* Are we fetching a signal entry? */ - i = whichsig(MgPV(mg)); + i = whichsig(MgPV(mg,na)); if (i) { if(psig_ptr[i]) sv_setsv(sv,psig_ptr[i]); @@ -697,7 +690,7 @@ MAGIC* mg; { I32 i; /* Are we clearing a signal entry? */ - i = whichsig(MgPV(mg)); + i = whichsig(MgPV(mg,na)); if (i) { if(psig_ptr[i]) { SvREFCNT_dec(psig_ptr[i]); @@ -720,7 +713,7 @@ MAGIC* mg; I32 i; SV** svp; - s = MgPV(mg); + s = MgPV(mg,na); if (*s == '_') { if (strEQ(s,"__DIE__")) svp = &diehook; @@ -771,8 +764,11 @@ MAGIC* mg; *svp = 0; } else { - if(hints & HINT_STRICT_REFS) - die(no_symref,s,"a subroutine"); + /* + * We should warn if HINT_STRICT_REFS, but without + * access to a known hint bit in a known OP, we can't + * tell whether HINT_STRICT_REFS is in force or not. + */ if (!strchr(s,':') && !strchr(s,'\'')) { sprintf(tokenbuf, "main::%s",s); sv_setpv(sv,tokenbuf); @@ -958,7 +954,7 @@ MAGIC* mg; gv = DBline; i = SvTRUE(sv); svp = av_fetch(GvAV(gv), - atoi(MgPV(mg)), FALSE); + atoi(MgPV(mg,na)), FALSE); if (svp && SvIOKp(*svp) && (o = (OP*)SvSTASH(*svp))) o->op_private = i; else @@ -1200,7 +1196,7 @@ SV* sv; } else { AV* av = (AV*)LvTARG(sv); - if (LvTARGLEN(sv) < 0 && (I32)LvTARGOFF(sv) > AvFILL(av)) + if ((I32)LvTARGLEN(sv) < 0 && (I32)LvTARGOFF(sv) > AvFILL(av)) LvTARG(sv) = Nullsv; /* array can't be extended */ else { SV** svp = av_fetch(av, LvTARGOFF(sv), TRUE); @@ -1374,9 +1370,18 @@ MAGIC* mg; IoPAGE(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); break; case '|': - IoFLAGS(GvIOp(defoutgv)) &= ~IOf_FLUSH; - if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) != 0) { - IoFLAGS(GvIOp(defoutgv)) |= IOf_FLUSH; + { + IO *io = GvIOp(defoutgv); + if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) == 0) + IoFLAGS(io) &= ~IOf_FLUSH; + else { + if (!(IoFLAGS(io) & IOf_FLUSH)) { + PerlIO *ofp = IoOFP(io); + if (ofp) + (void)PerlIO_flush(ofp); + IoFLAGS(io) |= IOf_FLUSH; + } + } } break; case '*': @@ -36,6 +36,6 @@ struct magic { #define MgTAINTEDDIR_on(mg) (mg->mg_flags |= MGf_TAINTEDDIR) #define MgTAINTEDDIR_off(mg) (mg->mg_flags &= ~MGf_TAINTEDDIR) -#define MgPV(mg) ((mg)->mg_len == HEf_SVKEY) ? \ - SvPV((SV*)((mg)->mg_ptr),na) : \ - (mg)->mg_ptr +#define MgPV(mg,lp) (((lp = (mg)->mg_len) == HEf_SVKEY) ? \ + SvPV((SV*)((mg)->mg_ptr),lp) : \ + (mg)->mg_ptr) @@ -39,6 +39,7 @@ static I32 list_assignment _((OP *op)); static OP *bad_type _((I32 n, char *t, char *name, OP *kid)); static OP *modkids _((OP *op, I32 type)); static OP *no_fh_allowed _((OP *op)); +static bool scalar_mod_type _((OP *op, I32 type)); static OP *scalarboolean _((OP *op)); static OP *too_few_arguments _((OP *op, char* name)); static OP *too_many_arguments _((OP *op, char* name)); @@ -219,7 +220,11 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix) if (CvANON(compcv) || SvTYPE(compcv) == SVt_PVFM) { /* "It's closures all the way down." */ CvCLONE_on(compcv); - if (cv != startcv) { + if (cv == startcv) { + if (CvANON(compcv)) + oldsv = Nullsv; /* no need to keep ref */ + } + else { CV *bcv; for (bcv = startcv; bcv && bcv != cv && !CvCLONE(bcv); @@ -293,6 +298,7 @@ pad_findmy(name) char *name; { I32 off; + I32 pendoff = 0; SV *sv; SV **svp = AvARRAY(comppad_name); U32 seq = cop_seqmax; @@ -301,18 +307,25 @@ char *name; for (off = AvFILL(comppad_name); off > 0; off--) { if ((sv = svp[off]) && sv != &sv_undef && - seq <= SvIVX(sv) && - seq > I_32(SvNVX(sv)) && + (!SvIVX(sv) || + (seq <= SvIVX(sv) && + seq > I_32(SvNVX(sv)))) && strEQ(SvPVX(sv), name)) { - return (PADOFFSET)off; + if (SvIVX(sv)) + return (PADOFFSET)off; + pendoff = off; /* this pending def. will override import */ } } /* See if it's in a nested scope */ off = pad_findlex(name, 0, seq, CvOUTSIDE(compcv), cxstack_ix); - if (off) + if (off) { + /* If there is a pending local definition, this new alias must die */ + if (pendoff) + SvIVX(AvARRAY(comppad_name)[off]) = seq; return off; + } return 0; } @@ -595,12 +608,11 @@ OP *op; OP *kid; /* assumes no premature commitment */ - if (!op || (op->op_flags & OPf_KNOW) || op->op_type == OP_RETURN - || error_count) + if (!op || (op->op_flags & OPf_WANT) || error_count + || op->op_type == OP_RETURN) return op; - op->op_flags &= ~OPf_LIST; - op->op_flags |= OPf_KNOW; + op->op_flags = (op->op_flags & ~OPf_WANT) | OPf_WANT_SCALAR; switch (op->op_type) { case OP_REPEAT: @@ -631,8 +643,16 @@ OP *op; break; case OP_LEAVE: case OP_LEAVETRY: - scalar(cLISTOP->op_first); - /* FALL THROUGH */ + kid = cLISTOP->op_first; + scalar(kid); + while (kid = kid->op_sibling) { + if (kid->op_sibling) + scalarvoid(kid); + else + scalar(kid); + } + curcop = &compiling; + break; case OP_SCOPE: case OP_LINESEQ: case OP_LIST: @@ -656,12 +676,12 @@ OP *op; char* useless = 0; SV* sv; - if (!op || error_count) - return op; - if (op->op_flags & OPf_LIST) + /* assumes no premature commitment */ + if (!op || (op->op_flags & OPf_WANT) == OPf_WANT_LIST || error_count + || op->op_type == OP_RETURN) return op; - op->op_flags |= OPf_KNOW; + op->op_flags = (op->op_flags & ~OPf_WANT) | OPf_WANT_VOID; switch (op->op_type) { default: @@ -791,37 +811,38 @@ OP *op; for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling) scalarvoid(kid); break; + case OP_NULL: if (op->op_targ == OP_NEXTSTATE || op->op_targ == OP_DBSTATE) curcop = ((COP*)op); /* for warning below */ if (op->op_flags & OPf_STACKED) break; + /* FALL THROUGH */ 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) scalarvoid(kid); 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_SPLIT: if ((kid = ((LISTOP*)op)->op_first) && kid->op_type == OP_PUSHRE) { if (!kPMOP->op_pmreplroot) 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); @@ -847,11 +868,11 @@ OP *op; OP *kid; /* assumes no premature commitment */ - if (!op || (op->op_flags & OPf_KNOW) || op->op_type == OP_RETURN - || error_count) + if (!op || (op->op_flags & OPf_WANT) || error_count + || op->op_type == OP_RETURN) return op; - op->op_flags |= (OPf_KNOW | OPf_LIST); + op->op_flags = (op->op_flags & ~OPf_WANT) | OPf_WANT_LIST; switch (op->op_type) { case OP_FLOP: @@ -879,8 +900,16 @@ OP *op; break; case OP_LEAVE: case OP_LEAVETRY: - list(cLISTOP->op_first); - /* FALL THROUGH */ + kid = cLISTOP->op_first; + list(kid); + while (kid = kid->op_sibling) { + if (kid->op_sibling) + scalarvoid(kid); + else + list(kid); + } + curcop = &compiling; + break; case OP_SCOPE: case OP_LINESEQ: for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) { @@ -1031,6 +1060,8 @@ I32 type; } /* FALL THROUGH */ case OP_RV2GV: + if (scalar_mod_type(op, type)) + goto nomod; ref(cUNOP->op_first, op->op_type); /* FALL THROUGH */ case OP_AASSIGN: @@ -1059,6 +1090,8 @@ I32 type; modcount = 10000; if (type == OP_REFGEN && op->op_flags & OPf_PARENS) return op; /* Treat \(@foo) like ordinary list. */ + if (scalar_mod_type(op, type)) + goto nomod; /* FALL THROUGH */ case OP_PADSV: modcount++; @@ -1126,6 +1159,52 @@ I32 type; return op; } +static bool +scalar_mod_type(op, type) +OP *op; +I32 type; +{ + switch (type) { + case OP_SASSIGN: + if (op->op_type == OP_RV2GV) + return FALSE; + /* FALL THROUGH */ + case OP_PREINC: + case OP_PREDEC: + case OP_POSTINC: + case OP_POSTDEC: + case OP_I_PREINC: + case OP_I_PREDEC: + case OP_I_POSTINC: + case OP_I_POSTDEC: + case OP_POW: + case OP_MULTIPLY: + case OP_DIVIDE: + case OP_MODULO: + case OP_REPEAT: + case OP_ADD: + case OP_SUBTRACT: + case OP_I_MULTIPLY: + case OP_I_DIVIDE: + case OP_I_MODULO: + case OP_I_ADD: + case OP_I_SUBTRACT: + case OP_LEFT_SHIFT: + case OP_RIGHT_SHIFT: + case OP_BIT_AND: + case OP_BIT_XOR: + case OP_BIT_OR: + case OP_CONCAT: + case OP_SUBST: + case OP_TRANS: + case OP_ANDASSIGN: /* may work later */ + case OP_ORASSIGN: /* may work later */ + return TRUE; + default: + return FALSE; + } +} + OP * refkids(op, type) OP *op; @@ -1572,7 +1651,7 @@ OP* op; if (!op || op->op_type != OP_LIST) op = newLISTOP(OP_LIST, 0, op, Nullop); else - op->op_flags &= ~(OPf_KNOW|OPf_LIST); + op->op_flags &= ~OPf_WANT; if (!(opargs[type] & OA_MARK)) null(cLISTOP->op_first); @@ -2339,7 +2418,7 @@ OP *right; tmpop->op_sibling = Nullop; /* don't free split */ right->op_next = tmpop->op_next; /* fix starting loc */ op_free(op); /* blow off assign */ - right->op_flags &= ~(OPf_KNOW|OPf_LIST); + right->op_flags &= ~OPf_WANT; /* "I don't know and I don't care." */ return right; } @@ -3051,27 +3130,69 @@ CV* proto; return cv_clone2(proto, CvOUTSIDE(proto)); } +void +cv_ckproto(cv, gv, p) +CV* cv; +GV* gv; +char* p; +{ + if ((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX(cv)))) { + char* buf; + SV* name = Nullsv; + + if (gv) + gv_efullname3(name = NEWSV(606, 40), gv, Nullch); + New(607, buf, ((name ? SvCUR(name) : 0) + + (SvPOK(cv) ? SvCUR(cv) : 0) + + (p ? strlen(p) : 0) + + 60), char); + strcpy(buf, "Prototype mismatch:"); + if (name) { + sprintf(buf + strlen(buf), " sub %s", SvPVX(name)); + SvREFCNT_dec(name); + } + if (SvPOK(cv)) + sprintf(buf + strlen(buf), " (%s)", SvPVX(cv)); + strcat(buf, " vs "); + sprintf(buf + strlen(buf), p ? "(%s)" : "none", p); + warn("%s", buf); + Safefree(buf); + } +} + SV * cv_const_sv(cv) -CV *cv; +CV* cv; { OP *o; - SV *sv = Nullsv; + SV *sv; - if(cv && SvPOK(cv) && !SvCUR(cv)) { - for (o = CvSTART(cv); o; o = o->op_next) { - OPCODE type = o->op_type; - - if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK) - continue; - if (type == OP_LEAVESUB || type == OP_RETURN) - break; - if (type != OP_CONST || sv) - return Nullsv; + if (!cv || !SvPOK(cv) || SvCUR(cv)) + return Nullsv; + sv = Nullsv; + for (o = CvSTART(cv); o; o = o->op_next) { + OPCODE type = o->op_type; + + if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK) + continue; + if (type == OP_LEAVESUB || type == OP_RETURN) + break; + if (sv) + return Nullsv; + if (type == OP_CONST) sv = ((SVOP*)o)->op_sv; + else if (type == OP_PADSV) { + AV* pad = (AV*)(AvARRAY(CvPADLIST(cv))[1]); + sv = pad ? AvARRAY(pad)[o->op_targ] : Nullsv; + if (!sv || (!SvREADONLY(sv) && SvREFCNT(sv) > 1)) + return Nullsv; } + else + return Nullsv; } + if (sv) + SvREADONLY_on(sv); return sv; } @@ -3084,21 +3205,19 @@ OP *block; { char *name = op ? SvPVx(cSVOP->op_sv, na) : Nullch; 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) SAVEFREEOP(op); + if (proto) + SAVEFREEOP(proto); + if (!name || GvCVGEN(gv)) cv = Nullcv; else if (cv = GvCV(gv)) { - /* prototype mismatch? */ - char *p = proto ? SvPVx(((SVOP*)proto)->op_sv, na) : Nullch; - if ((!proto != !SvPOK(cv)) || (p && strNE(p, SvPVX(cv)))) { - warn("Prototype mismatch: (%s) vs (%s)", - SvPOK(cv) ? SvPVX(cv) : "none", p ? p : "none"); - } + cv_ckproto(cv, gv, ps); /* already defined (or promised)? */ if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) { SV* const_sv; @@ -3142,11 +3261,8 @@ OP *block; CvFILEGV(cv) = curcop->cop_filegv; CvSTASH(cv) = curstash; - if (proto) { - char *p = SvPVx(((SVOP*)proto)->op_sv, na); - sv_setpv((SV*)cv, p); - op_free(proto); - } + if (ps) + sv_setpv((SV*)cv, ps); if (error_count) { op_free(block); @@ -3164,18 +3280,44 @@ OP *block; return cv; } - av = newAV(); /* Will be @_ */ - av_extend(av, 0); - av_store(comppad, 0, (SV*)av); - AvFLAGS(av) = AVf_REIFY; + if (AvFILL(comppad_name) < AvFILL(comppad)) + av_store(comppad_name, AvFILL(comppad), Nullsv); - for (ix = AvFILL(comppad); ix > 0; ix--) { - if (!SvPADMY(curpad[ix]) && !SvIMMORTAL(curpad[ix])) - SvPADTMP_on(curpad[ix]); + if (CvCLONE(cv)) { + SV **namep = AvARRAY(comppad_name); + for (ix = AvFILL(comppad); ix > 0; ix--) { + SV *namesv; + + if (SvIMMORTAL(curpad[ix])) + continue; + /* + * The only things that a clonable function needs in its + * pad are references to outer lexicals and anonymous subs. + * The rest are created anew during cloning. + */ + if (!((namesv = namep[ix]) != Nullsv && + namesv != &sv_undef && + (SvFAKE(namesv) || + *SvPVX(namesv) == '&'))) + { + SvREFCNT_dec(curpad[ix]); + curpad[ix] = Nullsv; + } + } } + else { + AV *av = newAV(); /* Will be @_ */ + av_extend(av, 0); + av_store(comppad, 0, (SV*)av); + AvFLAGS(av) = AVf_REIFY; - if (AvFILL(comppad_name) < AvFILL(comppad)) - av_store(comppad_name, AvFILL(comppad), Nullsv); + for (ix = AvFILL(comppad); ix > 0; ix--) { + if (SvIMMORTAL(curpad[ix])) + continue; + if (!SvPADMY(curpad[ix])) + SvPADTMP_on(curpad[ix]); + } + } CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block)); CvSTART(cv) = LINKLIST(CvROOT(cv)); @@ -4498,9 +4640,9 @@ register OP* o; o->op_seq = op_seqmax++; break; case OP_STUB: - if ((o->op_flags & (OPf_KNOW|OPf_LIST)) != (OPf_KNOW|OPf_LIST)) { + if ((o->op_flags & OPf_WANT) != OPf_WANT_LIST) { o->op_seq = op_seqmax++; - break; /* Scalar stub must produce undef. List stub is noop */ + break; /* Scalar stub must produce undef. List stub is noop */ } goto nothin; case OP_NULL: @@ -41,11 +41,20 @@ typedef U32 PADOFFSET; U8 op_flags; \ U8 op_private; -#define GIMME (op->op_flags & OPf_KNOW ? op->op_flags & OPf_LIST : dowantarray()) +#define OP_GIMME(op,dfl) \ + (((op)->op_flags & OPf_WANT) == OPf_WANT_VOID ? G_VOID : \ + ((op)->op_flags & OPf_WANT) == OPf_WANT_SCALAR ? G_SCALAR : \ + ((op)->op_flags & OPf_WANT) == OPf_WANT_LIST ? G_ARRAY : \ + dfl) + +#define GIMME_V OP_GIMME(op, block_gimme()) /* Public flags */ -#define OPf_LIST 1 /* Do operator in list context. */ -#define OPf_KNOW 2 /* Context is known. */ + +#define OPf_WANT 3 /* Mask for "want" bits: */ +#define OPf_WANT_VOID 1 /* Want nothing */ +#define OPf_WANT_SCALAR 2 /* Want single value */ +#define OPf_WANT_LIST 3 /* Want list of any length */ #define OPf_KIDS 4 /* There is a firstborn child. */ #define OPf_PARENS 8 /* This operator was parenthesized. */ /* (Or block needs explicit scope entry.) */ @@ -65,6 +74,12 @@ typedef U32 PADOFFSET; /* On OP_ENTERSUB || OP_NULL, saw a "do". */ /* On OP_(ENTER|LEAVE)EVAL, don't clear $@ */ +/* old names; don't use in new code, but don't break them, either */ +#define OPf_LIST 1 +#define OPf_KNOW 2 +#define GIMME \ + (op->op_flags & OPf_KNOW ? op->op_flags & OPf_LIST : dowantarray()) + /* Private for lvalues */ #define OPpLVAL_INTRO 128 /* Lvalue must be localized */ @@ -105,11 +120,8 @@ typedef U32 PADOFFSET; /* Private for OP_LIST */ #define OPpLIST_GUESSED 64 /* Guessed that pushmark was needed. */ -/* Private for OP_LEAVE, OP_DELETE, and friends(?) */ -#define OPpLEAVE_VOID 64 /* No need to copy out values. */ - /* Private for OP_DELETE */ -#define OPpSLICE 32 /* Operating on a list of keys */ +#define OPpSLICE 64 /* Operating on a list of keys */ /* Private for OP_SORT, OP_PRTF, OP_SPRINTF, string cmp'n, and case changers */ #define OPpLOCALE 64 /* Use locale */ @@ -850,7 +850,7 @@ XS(XS_Cwd_sys_chdir) bool RETVAL; RETVAL = sys_chdir(path); - ST(0) = RETVAL ? &sv_yes : &sv_no; + ST(0) = boolSV(RETVAL); if (SvREFCNT(ST(0))) sv_2mortal(ST(0)); } XSRETURN(1); @@ -866,7 +866,7 @@ XS(XS_Cwd_change_drive) bool RETVAL; RETVAL = change_drive(d); - ST(0) = RETVAL ? &sv_yes : &sv_no; + ST(0) = boolSV(RETVAL); if (SvREFCNT(ST(0))) sv_2mortal(ST(0)); } XSRETURN(1); @@ -882,7 +882,7 @@ XS(XS_Cwd_sys_is_absolute) bool RETVAL; RETVAL = sys_is_absolute(path); - ST(0) = RETVAL ? &sv_yes : &sv_no; + ST(0) = boolSV(RETVAL); if (SvREFCNT(ST(0))) sv_2mortal(ST(0)); } XSRETURN(1); @@ -898,7 +898,7 @@ XS(XS_Cwd_sys_is_rooted) bool RETVAL; RETVAL = sys_is_rooted(path); - ST(0) = RETVAL ? &sv_yes : &sv_no; + ST(0) = boolSV(RETVAL); if (SvREFCNT(ST(0))) sv_2mortal(ST(0)); } XSRETURN(1); @@ -914,7 +914,7 @@ XS(XS_Cwd_sys_is_relative) bool RETVAL; RETVAL = sys_is_relative(path); - ST(0) = RETVAL ? &sv_yes : &sv_no; + ST(0) = boolSV(RETVAL); if (SvREFCNT(ST(0))) sv_2mortal(ST(0)); } XSRETURN(1); @@ -1101,7 +1101,7 @@ XS(XS_Cwd_extLibpath_set) } RETVAL = extLibpath_set(s, type); - ST(0) = RETVAL ? &sv_yes : &sv_no; + ST(0) = boolSV(RETVAL); if (SvREFCNT(ST(0))) sv_2mortal(ST(0)); } XSRETURN(1); diff --git a/patchlevel.h b/patchlevel.h index f7cc9dda21..6cc0f69743 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1,5 +1,5 @@ #define PATCHLEVEL 3 -#define SUBVERSION 94 +#define SUBVERSION 97 /* local_patches -- list of locally applied less-than-subversion patches. @@ -38,6 +38,7 @@ */ static char *local_patches[] = { NULL + ,"Dev97A - First development patch to 5.003_97" ,NULL }; @@ -20,6 +20,10 @@ #include <unistd.h> #endif +#if !defined(STANDARD_C) && !defined(HAS_GETENV_PROTOTYPE) +char *getenv _((char *)); /* Usually in <stdlib.h> */ +#endif + dEXTCONST char rcsid[] = "perl.c\nPatch level: ###\n"; #ifdef IAMSUID @@ -140,6 +144,10 @@ register PerlInterpreter *sv_interp; init_ids(); + start_env.je_prev = NULL; + start_env.je_ret = -1; + start_env.je_mustcatch = TRUE; + top_env = &start_env; STATUS_ALL_SUCCESS; SET_NUMERIC_STANDARD(); @@ -432,9 +440,6 @@ PerlInterpreter *sv_interp; return; Safefree(sv_interp); } -#if !defined(STANDARD_C) && !defined(HAS_GETENV_PROTOTYPE) -char *getenv _((char *)); /* Usually in <stdlib.h> */ -#endif int perl_parse(sv_interp, xsinit, argc, argv, env) @@ -451,6 +456,8 @@ char **env; char *validarg = ""; I32 oldscope; AV* comppadlist; + dJMPENV; + int ret; #ifdef SETUID_SCRIPTS_ARE_SECURE_NOW #ifdef IAMSUID @@ -498,9 +505,9 @@ setuid perl scripts securely.\n"); time(&basetime); oldscope = scopestack_ix; - mustcatch = FALSE; - switch (Sigsetjmp(top_env,1)) { + JMPENV_PUSH(ret); + switch (ret) { case 1: STATUS_ALL_FAILURE; /* FALL THROUGH */ @@ -511,9 +518,10 @@ setuid perl scripts securely.\n"); curstash = defstash; if (endav) call_list(oldscope, endav); + JMPENV_POP; return STATUS_NATIVE_EXPORT; case 3: - mustcatch = FALSE; + JMPENV_POP; PerlIO_printf(PerlIO_stderr(), "panic: top_env\n"); return 1; } @@ -522,6 +530,7 @@ setuid perl scripts securely.\n"); sv = newSVpv("",0); /* first used for -I flags */ SAVEFREESV(sv); init_main_stash(); + for (argc--,argv++; argc > 0; argc--,argv++) { if (argv[0][0] != '-' || !argv[0][1]) break; @@ -619,13 +628,13 @@ setuid perl scripts securely.\n"); #else sv_catpv(Sv,"print \"\\nCharacteristics of this binary (from libperl): \\n\","); #endif -#if defined(DEBUGGING) || defined(NOEMBED) || defined(MULTIPLICITY) +#if defined(DEBUGGING) || defined(NO_EMBED) || defined(MULTIPLICITY) strcpy(buf,"\" Compile-time options:"); # ifdef DEBUGGING strcat(buf," DEBUGGING"); # endif -# ifdef NOEMBED - strcat(buf," NOEMBED"); +# ifdef NO_EMBED + strcat(buf," NO_EMBED"); # endif # ifdef MULTIPLICITY strcat(buf," MULTIPLICITY"); @@ -634,8 +643,8 @@ setuid perl scripts securely.\n"); sv_catpv(Sv,buf); #endif #if defined(LOCAL_PATCH_COUNT) - if (LOCAL_PATCH_COUNT > 0) - { int i; + if (LOCAL_PATCH_COUNT > 0) { + int i; sv_catpv(Sv,"print \" Locally applied patches:\\n\","); for (i = 1; i <= LOCAL_PATCH_COUNT; i++) { if (localpatches[i]) { @@ -645,17 +654,21 @@ setuid perl scripts securely.\n"); } } #endif - sprintf(buf,"\" Built under %s\\n\",",OSNAME); + sprintf(buf,"\" Built under %s\\n\"",OSNAME); sv_catpv(Sv,buf); #ifdef __DATE__ # ifdef __TIME__ - sprintf(buf,"\" Compiled at %s %s\\n\"",__DATE__,__TIME__); + sprintf(buf,",\" Compiled at %s %s\\n\"",__DATE__,__TIME__); # else - sprintf(buf,"\" Compiled on %s\\n\"",__DATE__); + sprintf(buf,",\" Compiled on %s\\n\"",__DATE__); # endif sv_catpv(Sv,buf); #endif - sv_catpv(Sv,"; $\"=\"\\n \"; print \" \\@INC:\\n @INC\\n\""); + sv_catpv(Sv, "; \ +$\"=\"\\n \"; \ +@env = map { \"$_=\\\"$ENV{$_}\\\"\" } sort grep {/^PERL/} keys %ENV; \ +print \" \\%ENV:\\n @env\\n\" if @env; \ +print \" \\@INC:\\n @INC\\n\";"); } else { Sv = newSVpv("config_vars(qw(",0); @@ -682,6 +695,24 @@ setuid perl scripts securely.\n"); } } switch_end: + + if (!tainting && (s = getenv("PERL5OPT"))) { + for (;;) { + while (isSPACE(*s)) + s++; + if (*s == '-') { + s++; + if (isSPACE(*s)) + continue; + } + if (!*s) + break; + if (!strchr("DIMUdmw", *s)) + croak("Illegal switch in PERL5OPT: -%c", *s); + s = moreswitches(s); + } + } + if (!scriptname) scriptname = argv[0]; if (e_fp) { @@ -784,6 +815,7 @@ setuid perl scripts securely.\n"); ENTER; restartop = 0; + JMPENV_POP; return 0; } @@ -792,13 +824,16 @@ perl_run(sv_interp) PerlInterpreter *sv_interp; { I32 oldscope; + dJMPENV; + int ret; if (!(curinterp = sv_interp)) return 255; oldscope = scopestack_ix; - switch (Sigsetjmp(top_env,1)) { + JMPENV_PUSH(ret); + switch (ret) { case 1: cxstack_ix = -1; /* start context stack again */ break; @@ -814,12 +849,13 @@ PerlInterpreter *sv_interp; if (getenv("PERL_DEBUG_MSTATS")) dump_mstats("after execution: "); #endif + JMPENV_POP; return STATUS_NATIVE_EXPORT; case 3: - mustcatch = FALSE; if (!restartop) { PerlIO_printf(PerlIO_stderr(), "panic: restartop\n"); FREETMPS; + JMPENV_POP; return 1; } if (curstack != mainstack) { @@ -858,6 +894,7 @@ PerlInterpreter *sv_interp; } my_exit(0); + /* NOTREACHED */ return 0; } @@ -968,10 +1005,11 @@ I32 flags; /* See G_* flags in cop.h */ SV** sp = stack_sp; I32 oldmark; I32 retval; - Sigjmp_buf oldtop; I32 oldscope; static CV *DBcv; - bool oldmustcatch = mustcatch; + bool oldcatch = CATCH_GET; + dJMPENV; + int ret; if (flags & G_DISCARD) { ENTER; @@ -979,15 +1017,12 @@ I32 flags; /* See G_* flags in cop.h */ } Zero(&myop, 1, LOGOP); - if (flags & G_NOARGS) { - PUSHMARK(sp); - } - else - myop.op_flags |= OPf_STACKED; myop.op_next = Nullop; - myop.op_flags |= OPf_KNOW; - if (flags & G_ARRAY) - myop.op_flags |= OPf_LIST; + if (!(flags & G_NOARGS)) + myop.op_flags |= OPf_STACKED; + myop.op_flags |= ((flags & G_VOID) ? OPf_WANT_VOID : + (flags & G_ARRAY) ? OPf_WANT_LIST : + OPf_WANT_SCALAR); SAVESPTR(op); op = (OP*)&myop; @@ -1005,14 +1040,12 @@ I32 flags; /* See G_* flags in cop.h */ op->op_private |= OPpENTERSUB_DB; if (flags & G_EVAL) { - Copy(top_env, oldtop, 1, Sigjmp_buf); - cLOGOP->op_other = op; markstack_ptr--; /* we're trying to emulate pp_entertry() here */ { register CONTEXT *cx; - I32 gimme = GIMME; + I32 gimme = GIMME_V; ENTER; SAVETMPS; @@ -1030,8 +1063,8 @@ I32 flags; /* See G_* flags in cop.h */ } markstack_ptr++; - restart: - switch (Sigsetjmp(top_env,1)) { + JMPENV_PUSH(ret); + switch (ret) { case 0: break; case 1: @@ -1041,17 +1074,16 @@ I32 flags; /* See G_* flags in cop.h */ /* my_exit() was called */ curstash = defstash; FREETMPS; - Copy(oldtop, top_env, 1, Sigjmp_buf); + JMPENV_POP; if (statusvalue) croak("Callback called exit"); my_exit_jump(); /* NOTREACHED */ case 3: - mustcatch = FALSE; if (restartop) { op = restartop; restartop = 0; - goto restart; + break; } stack_sp = stack_base + oldmark; if (flags & G_ARRAY) @@ -1064,7 +1096,7 @@ I32 flags; /* See G_* flags in cop.h */ } } else - mustcatch = TRUE; + CATCH_SET(TRUE); if (op == (OP*)&myop) op = pp_entersub(); @@ -1089,10 +1121,10 @@ I32 flags; /* See G_* flags in cop.h */ curpm = newpm; LEAVE; } - Copy(oldtop, top_env, 1, Sigjmp_buf); + JMPENV_POP; } else - mustcatch = oldmustcatch; + CATCH_SET(oldcatch); if (flags & G_DISCARD) { stack_sp = stack_base + oldmark; @@ -1114,8 +1146,9 @@ I32 flags; /* See G_* flags in cop.h */ SV** sp = stack_sp; I32 oldmark = sp - stack_base; I32 retval; - Sigjmp_buf oldtop; I32 oldscope; + dJMPENV; + int ret; if (flags & G_DISCARD) { ENTER; @@ -1133,16 +1166,14 @@ I32 flags; /* See G_* flags in cop.h */ myop.op_flags = OPf_STACKED; myop.op_next = Nullop; myop.op_type = OP_ENTEREVAL; - myop.op_flags |= OPf_KNOW; + myop.op_flags |= ((flags & G_VOID) ? OPf_WANT_VOID : + (flags & G_ARRAY) ? OPf_WANT_LIST : + OPf_WANT_SCALAR); if (flags & G_KEEPERR) myop.op_flags |= OPf_SPECIAL; - if (flags & G_ARRAY) - myop.op_flags |= OPf_LIST; - - Copy(top_env, oldtop, 1, Sigjmp_buf); -restart: - switch (Sigsetjmp(top_env,1)) { + JMPENV_PUSH(ret); + switch (ret) { case 0: break; case 1: @@ -1152,17 +1183,16 @@ restart: /* my_exit() was called */ curstash = defstash; FREETMPS; - Copy(oldtop, top_env, 1, Sigjmp_buf); + JMPENV_POP; if (statusvalue) croak("Callback called exit"); my_exit_jump(); /* NOTREACHED */ case 3: - mustcatch = FALSE; if (restartop) { op = restartop; restartop = 0; - goto restart; + break; } stack_sp = stack_base + oldmark; if (flags & G_ARRAY) @@ -1183,7 +1213,7 @@ restart: sv_setpv(GvSV(errgv),""); cleanup: - Copy(oldtop, top_env, 1, Sigjmp_buf); + JMPENV_POP; if (flags & G_DISCARD) { stack_sp = stack_base + oldmark; retval = 0; @@ -2248,7 +2278,7 @@ register char **env; HV *hv; GvMULTI_on(envgv); hv = GvHVn(envgv); - hv_clear(hv); + hv_magic(hv, envgv, 'E'); #ifndef VMS /* VMS doesn't have environ array */ /* Note that if the supplied env parameter is actually a copy of the global environ then it may now point to free'd memory @@ -2257,16 +2287,13 @@ register char **env; */ if (!env) env = environ; - if (env != environ) { + if (env != environ) environ[0] = Nullch; - hv_magic(hv, envgv, 'E'); - } for (; *env; env++) { if (!(s = strchr(*env,'='))) continue; *s++ = '\0'; sv = newSVpv(s--,0); - sv_magic(sv, sv, 'e', *env, s - *env); (void)hv_store(hv, *env, s - *env, sv, 0); *s = '='; } @@ -2274,7 +2301,6 @@ register char **env; #ifdef DYNAMIC_ENV_FETCH HvNAME(hv) = savepv(ENV_HV_NAME); #endif - hv_magic(hv, envgv, 'E'); } TAINT_NOT; if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV)) @@ -2445,25 +2471,25 @@ call_list(oldscope, list) I32 oldscope; AV* list; { - Sigjmp_buf oldtop; - STRLEN len; line_t oldline = curcop->cop_line; - - Copy(top_env, oldtop, 1, Sigjmp_buf); + STRLEN len; + dJMPENV; + int ret; while (AvFILL(list) >= 0) { CV *cv = (CV*)av_shift(list); SAVEFREESV(cv); - switch (Sigsetjmp(top_env,1)) { + JMPENV_PUSH(ret); + switch (ret) { 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) @@ -2487,7 +2513,7 @@ AV* list; if (endav) call_list(oldscope, endav); FREETMPS; - Copy(oldtop, top_env, 1, Sigjmp_buf); + JMPENV_POP; curcop = &compiling; curcop->cop_line = oldline; if (statusvalue) { @@ -2504,14 +2530,13 @@ AV* list; FREETMPS; break; } - Copy(oldtop, top_env, 1, Sigjmp_buf); + JMPENV_POP; curcop = &compiling; curcop->cop_line = oldline; - Siglongjmp(top_env, 3); + JMPENV_JUMP(3); } + JMPENV_POP; } - - Copy(oldtop, top_env, 1, Sigjmp_buf); } void @@ -2579,5 +2604,5 @@ my_exit_jump() LEAVE; } - Siglongjmp(top_env, 2); + JMPENV_JUMP(2); } @@ -260,12 +260,6 @@ #define MEM_SIZE Size_t -#if _XOPEN_VERSION >= 4 -# define Sock_size_t Size_t -#else -# define Sock_size_t int -#endif - #if defined(STANDARD_C) && defined(I_STDDEF) # include <stddef.h> # define STRUCT_OFFSET(s,m) offsetof(s,m) @@ -989,18 +983,19 @@ union any { void (*any_dptr) _((void*)); }; +/* Work around some cygwin32 problems with importing global symbols */ +#if defined(CYGWIN32) && defined(DLLIMPORT) +# include "cw32imp.h" +#endif + #include "regexp.h" #include "sv.h" #include "util.h" #include "form.h" #include "gv.h" #include "cv.h" -#include "op.h" -/* Work Around some problems with importing globals from dlls for cygwin32 */ -#if defined(CYGWIN32) && defined(DLLIMPORT) -# include "extLibInc.h" -#endif #include "opcode.h" +#include "op.h" #include "cop.h" #include "av.h" #include "hv.h" @@ -1847,9 +1842,9 @@ IEXT line_t Icopline IINIT(NOLINE); IEXT CONTEXT * Icxstack; IEXT I32 Icxstack_ix IINIT(-1); IEXT I32 Icxstack_max IINIT(128); -IEXT Sigjmp_buf Itop_env; +IEXT JMPENV Istart_env; /* empty startup sigjmp() environment */ +IEXT JMPENV * Itop_env; /* ptr. to current sigjmp() environment */ IEXT I32 Irunlevel; -IEXT bool Imustcatch; /* doeval() must be caught locally */ /* stack stuff */ IEXT AV * Icurstack; /* THE STACK */ diff --git a/perl5.003_94/ext/DynaLoader/dl_gnuwin32.xs b/perl5.003_94/ext/DynaLoader/dl_gnuwin32.xs deleted file mode 100644 index 1d88114dc7..0000000000 --- a/perl5.003_94/ext/DynaLoader/dl_gnuwin32.xs +++ /dev/null @@ -1,152 +0,0 @@ -/* dl_gnuwin32.xs - * - * Platform: Win32 (Windows NT/Windows 95) - * Author: Wei-Yuen Tan (wyt@hip.com) - * Created: A warm day in June, 1995 - * - * Modified: - * August 23rd 1995 - rewritten after losing everything when I - * wiped off my NT partition (eek!) - */ -/* Modified from the original dl_win32.xs to work with gnuwin32 - -John Cerney 3/26/97 -*/ -/* Porting notes: - -I merely took Paul's dl_dlopen.xs, took out extraneous stuff and -replaced the appropriate SunOS calls with the corresponding Win32 -calls. - -*/ - -#define WIN32_LEAN_AND_MEAN -// Defines from windows needed for this function only. Can't include full -// gnuwin2 windows headers because of problems with CONTEXT redefinition -// Removed logic to tell not dynamically load static modules. It is assumed that all -// modules are dynamically built. This should be similar to the behavoir on sunOS. -// Leaving in the logic would have required changes to the standard perlmain.c code -// -// // Includes call a dll function to initialize it's impure_ptr. -#include <stdio.h> -void (*impure_setupptr)(struct _reent *); // pointer to the impure_setup routine - -//#include <windows.h> -#define LOAD_WITH_ALTERED_SEARCH_PATH (8) -typedef void *HANDLE; -typedef HANDLE HINSTANCE; -#define STDCALL __attribute__ ((stdcall)) -typedef int STDCALL (*FARPROC)(); - -HINSTANCE -STDCALL -LoadLibraryExA( - char* lpLibFileName, - HANDLE hFile, - unsigned int dwFlags - ); -unsigned int -STDCALL -GetLastError( - void - ); -FARPROC -STDCALL -GetProcAddress( - HINSTANCE hModule, - char* lpProcName - ); - -#include <string.h> - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#include "dlutils.c" /* SaveError() etc */ - -static void -dl_private_init() -{ - (void)dl_generic_private_init(); -} - - -MODULE = DynaLoader PACKAGE = DynaLoader - -BOOT: - (void)dl_private_init(); - -void * -dl_load_file(filename,flags=0) - char * filename - int flags - PREINIT: - CODE: - DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename)); - - RETVAL = (void*) LoadLibraryExA(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ; - - DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL)); - ST(0) = sv_newmortal() ; - if (RETVAL == NULL){ - SaveError("%d",GetLastError()) ; - } - else{ - // setup the dll's impure_ptr: - impure_setupptr = GetProcAddress(RETVAL, "impure_setup"); - if( impure_setupptr == NULL){ - printf("Gnuwin32 Dynaloader Error, Could not load impure_setup symbol\n"); - RETVAL = NULL; - } - else{ - // setup the DLLs impure_ptr: - (*impure_setupptr)(_impure_ptr); - sv_setiv( ST(0), (IV)RETVAL); - } - } - - - -void * -dl_find_symbol(libhandle, symbolname) - void * libhandle - char * symbolname - CODE: - DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n", - libhandle, symbolname)); - RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname); - DLDEBUG(2,fprintf(stderr," symbolref = %x\n", RETVAL)); - ST(0) = sv_newmortal() ; - if (RETVAL == NULL) - SaveError("%d",GetLastError()) ; - else - sv_setiv( ST(0), (IV)RETVAL); - - -void -dl_undef_symbols() - PPCODE: - - - -# These functions should not need changing on any platform: - -void -dl_install_xsub(perl_name, symref, filename="$Package") - char * perl_name - void * symref - char * filename - CODE: - DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n", - perl_name, symref)); - ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename))); - - -char * -dl_error() - CODE: - RETVAL = LastError ; - OUTPUT: - RETVAL - -# end. diff --git a/perl5.003_94/extLibInc.h b/perl5.003_94/extLibInc.h deleted file mode 100644 index 04bf5cad32..0000000000 --- a/perl5.003_94/extLibInc.h +++ /dev/null @@ -1,355 +0,0 @@ -/* include file for building of extension libs using gnuwin32. - This file is included by the extension dlls when they are built. - Global vars defined in perl exe are referenced by the extension module - dll by using __imp_varName, where varName is the name of the global - variable in perl.exe. Gnuwin32 has no equivalent to MSVC's - __declspec(dllimport) keyword to define a imported global, so we have - to use this approach to access globals exported by perl.exe - -jc 4/1/97 -*/ - -#define impure_setupptr (*__imp_impure_setupptr) -#define Perl_reall_srchlen (*__imp_Perl_reall_srchlen) -#define Perl_yychar (*__imp_Perl_yychar) -#define Perl_yycheck (*__imp_Perl_yycheck) -#define Perl_yydebug (*__imp_Perl_yydebug) -#define Perl_yydefred (*__imp_Perl_yydefred) -#define Perl_yydgoto (*__imp_Perl_yydgoto) -#define Perl_yyerrflag (*__imp_Perl_yyerrflag) -#define Perl_yygindex (*__imp_Perl_yygindex) -#define Perl_yylen (*__imp_Perl_yylen) -#define Perl_yylhs (*__imp_Perl_yylhs) -#define Perl_yylval (*__imp_Perl_yylval) -#define Perl_yynerrs (*__imp_Perl_yynerrs) -#define Perl_yyrindex (*__imp_Perl_yyrindex) -#define Perl_yysindex (*__imp_Perl_yysindex) -#define Perl_yytable (*__imp_Perl_yytable) -#define Perl_yyval (*__imp_Perl_yyval) -#define Perl_regarglen (*__imp_Perl_regarglen) -#define Perl_regdummy (*__imp_Perl_regdummy) -#define Perl_regkind (*__imp_Perl_regkind) -#define Perl_simple (*__imp_Perl_simple) -#define Perl_varies (*__imp_Perl_varies) -#define Perl_watchaddr (*__imp_Perl_watchaddr) -#define Perl_watchok (*__imp_Perl_watchok) -#define Argv (*__imp_Argv) -#define Cmd (*__imp_Cmd) -#define DBgv (*__imp_DBgv) -#define DBline (*__imp_DBline) -#define DBsignal (*__imp_DBsignal) -#define DBsingle (*__imp_DBsingle) -#define DBsub (*__imp_DBsub) -#define DBtrace (*__imp_DBtrace) -#define Error (*__imp_Error) -#define Perl_AMG_names (*__imp_Perl_AMG_names) -#define Perl_No (*__imp_Perl_No) -#define Perl_Sv (*__imp_Perl_Sv) -#define Perl_Xpv (*__imp_Perl_Xpv) -#define Perl_Yes (*__imp_Perl_Yes) -#define Perl_amagic_generation (*__imp_Perl_amagic_generation) -#define Perl_an (*__imp_Perl_an) -#define Perl_buf (*__imp_Perl_buf) -#define Perl_bufend (*__imp_Perl_bufend) -#define Perl_bufptr (*__imp_Perl_bufptr) -#define Perl_check (*__imp_Perl_check) -#define Perl_collation_ix (*__imp_Perl_collation_ix) -#define Perl_collation_name (*__imp_Perl_collation_name) -#define Perl_collation_standard (*__imp_Perl_collation_standard) -#define Perl_collxfrm_base (*__imp_Perl_collxfrm_base) -#define Perl_collxfrm_mult (*__imp_Perl_collxfrm_mult) -#define Perl_compcv (*__imp_Perl_compcv) -#define Perl_compiling (*__imp_Perl_compiling) -#define Perl_comppad (*__imp_Perl_comppad) -#define Perl_comppad_name (*__imp_Perl_comppad_name) -#define Perl_comppad_name_fill (*__imp_Perl_comppad_name_fill) -#define Perl_cop_seqmax (*__imp_Perl_cop_seqmax) -#define Perl_curcop (*__imp_Perl_curcop) -#define Perl_curcopdb (*__imp_Perl_curcopdb) -#define Perl_curinterp (*__imp_Perl_curinterp) -#define Perl_curpad (*__imp_Perl_curpad) -#define Perl_dc (*__imp_Perl_dc) -#define Perl_di (*__imp_Perl_di) -#define Perl_ds (*__imp_Perl_ds) -#define Perl_egid (*__imp_Perl_egid) -#define Perl_envgv (*__imp_Perl_envgv) -#define Perl_error_count (*__imp_Perl_error_count) -#define Perl_euid (*__imp_Perl_euid) -#define Perl_evalseq (*__imp_Perl_evalseq) -#define Perl_expect (*__imp_Perl_expect) -#define Perl_fold_locale (*__imp_Perl_fold_locale) -#define Perl_gid (*__imp_Perl_gid) -#define Perl_he_root (*__imp_Perl_he_root) -#define Perl_hexdigit (*__imp_Perl_hexdigit) -#define Perl_hints (*__imp_Perl_hints) -#define Perl_in_my (*__imp_Perl_in_my) -#define Perl_last_lop (*__imp_Perl_last_lop) -#define Perl_last_lop_op (*__imp_Perl_last_lop_op) -#define Perl_last_uni (*__imp_Perl_last_uni) -#define Perl_lex_brackets (*__imp_Perl_lex_brackets) -#define Perl_lex_brackstack (*__imp_Perl_lex_brackstack) -#define Perl_lex_casemods (*__imp_Perl_lex_casemods) -#define Perl_lex_casestack (*__imp_Perl_lex_casestack) -#define Perl_lex_defer (*__imp_Perl_lex_defer) -#define Perl_lex_dojoin (*__imp_Perl_lex_dojoin) -#define Perl_lex_expect (*__imp_Perl_lex_expect) -#define Perl_lex_fakebrack (*__imp_Perl_lex_fakebrack) -#define Perl_lex_formbrack (*__imp_Perl_lex_formbrack) -#define Perl_lex_inpat (*__imp_Perl_lex_inpat) -#define Perl_lex_inwhat (*__imp_Perl_lex_inwhat) -#define Perl_lex_op (*__imp_Perl_lex_op) -#define Perl_lex_repl (*__imp_Perl_lex_repl) -#define Perl_lex_starts (*__imp_Perl_lex_starts) -#define Perl_lex_state (*__imp_Perl_lex_state) -#define Perl_lex_stuff (*__imp_Perl_lex_stuff) -#define Perl_linestr (*__imp_Perl_linestr) -#define Perl_markstack (*__imp_Perl_markstack) -#define Perl_markstack_max (*__imp_Perl_markstack_max) -#define Perl_markstack_ptr (*__imp_Perl_markstack_ptr) -#define Perl_max_intro_pending (*__imp_Perl_max_intro_pending) -#define Perl_maxo (*__imp_Perl_maxo) -#define Perl_min_intro_pending (*__imp_Perl_min_intro_pending) -#define Perl_multi_close (*__imp_Perl_multi_close) -#define Perl_multi_end (*__imp_Perl_multi_end) -#define Perl_multi_open (*__imp_Perl_multi_open) -#define Perl_multi_start (*__imp_Perl_multi_start) -#define Perl_na (*__imp_Perl_na) -#define Perl_nexttoke (*__imp_Perl_nexttoke) -#define Perl_nexttype (*__imp_Perl_nexttype) -#define Perl_nextval (*__imp_Perl_nextval) -#define Perl_nomemok (*__imp_Perl_nomemok) -#define Perl_numeric_local (*__imp_Perl_numeric_local) -#define Perl_numeric_name (*__imp_Perl_numeric_name) -#define Perl_numeric_standard (*__imp_Perl_numeric_standard) -#define Perl_oldbufptr (*__imp_Perl_oldbufptr) -#define Perl_oldoldbufptr (*__imp_Perl_oldoldbufptr) -#define Perl_op (*__imp_Perl_op) -#define Perl_op_desc (*__imp_Perl_op_desc) -#define Perl_op_name (*__imp_Perl_op_name) -#define Perl_op_seqmax (*__imp_Perl_op_seqmax) -#define Perl_opargs (*__imp_Perl_opargs) -#define Perl_origalen (*__imp_Perl_origalen) -#define Perl_origenviron (*__imp_Perl_origenviron) -#define Perl_osname (*__imp_Perl_osname) -#define Perl_padix (*__imp_Perl_padix) -#define Perl_patleave (*__imp_Perl_patleave) -#define Perl_pidstatus (*__imp_Perl_pidstatus) -#define Perl_ppaddr (*__imp_Perl_ppaddr) -#define Perl_profiledata (*__imp_Perl_profiledata) -#define Perl_psig_name (*__imp_Perl_psig_name) -#define Perl_psig_ptr (*__imp_Perl_psig_ptr) -#define Perl_regbol (*__imp_Perl_regbol) -#define Perl_regcode (*__imp_Perl_regcode) -#define Perl_regendp (*__imp_Perl_regendp) -#define Perl_regeol (*__imp_Perl_regeol) -#define Perl_reginput (*__imp_Perl_reginput) -#define Perl_reglastparen (*__imp_Perl_reglastparen) -#define Perl_regnaughty (*__imp_Perl_regnaughty) -#define Perl_regnpar (*__imp_Perl_regnpar) -#define Perl_regparse (*__imp_Perl_regparse) -#define Perl_regprecomp (*__imp_Perl_regprecomp) -#define Perl_regprev (*__imp_Perl_regprev) -#define Perl_regsawback (*__imp_Perl_regsawback) -#define Perl_regsize (*__imp_Perl_regsize) -#define Perl_regstartp (*__imp_Perl_regstartp) -#define Perl_regtill (*__imp_Perl_regtill) -#define Perl_regxend (*__imp_Perl_regxend) -#define Perl_retstack (*__imp_Perl_retstack) -#define Perl_retstack_ix (*__imp_Perl_retstack_ix) -#define Perl_retstack_max (*__imp_Perl_retstack_max) -#define Perl_rsfp (*__imp_Perl_rsfp) -#define Perl_rsfp_filters (*__imp_Perl_rsfp_filters) -#define Perl_savestack (*__imp_Perl_savestack) -#define Perl_savestack_ix (*__imp_Perl_savestack_ix) -#define Perl_savestack_max (*__imp_Perl_savestack_max) -#define Perl_scopestack (*__imp_Perl_scopestack) -#define Perl_scopestack_ix (*__imp_Perl_scopestack_ix) -#define Perl_scopestack_max (*__imp_Perl_scopestack_max) -#define Perl_scrgv (*__imp_Perl_scrgv) -#define Perl_sh_path (*__imp_Perl_sh_path) -#define Perl_sig_name (*__imp_Perl_sig_name) -#define Perl_sig_num (*__imp_Perl_sig_num) -#define Perl_siggv (*__imp_Perl_siggv) -#define Perl_stack_base (*__imp_Perl_stack_base) -#define Perl_stack_max (*__imp_Perl_stack_max) -#define Perl_stack_sp (*__imp_Perl_stack_sp) -#define Perl_statbuf (*__imp_Perl_statbuf) -#define Perl_sub_generation (*__imp_Perl_sub_generation) -#define Perl_subline (*__imp_Perl_subline) -#define Perl_subname (*__imp_Perl_subname) -#define Perl_sv_no (*__imp_Perl_sv_no) -#define Perl_sv_undef (*__imp_Perl_sv_undef) -#define Perl_sv_yes (*__imp_Perl_sv_yes) -#define Perl_tainting (*__imp_Perl_tainting) -#define Perl_thisexpr (*__imp_Perl_thisexpr) -#define Perl_timesbuf (*__imp_Perl_timesbuf) -#define Perl_tokenbuf (*__imp_Perl_tokenbuf) -#define Perl_uid (*__imp_Perl_uid) -#define Perl_vert (*__imp_Perl_vert) -#define Perl_vtbl_amagic (*__imp_Perl_vtbl_amagic) -#define Perl_vtbl_amagicelem (*__imp_Perl_vtbl_amagicelem) -#define Perl_vtbl_arylen (*__imp_Perl_vtbl_arylen) -#define Perl_vtbl_bm (*__imp_Perl_vtbl_bm) -#define Perl_vtbl_collxfrm (*__imp_Perl_vtbl_collxfrm) -#define Perl_vtbl_dbline (*__imp_Perl_vtbl_dbline) -#define Perl_vtbl_env (*__imp_Perl_vtbl_env) -#define Perl_vtbl_envelem (*__imp_Perl_vtbl_envelem) -#define Perl_vtbl_fm (*__imp_Perl_vtbl_fm) -#define Perl_vtbl_glob (*__imp_Perl_vtbl_glob) -#define Perl_vtbl_isa (*__imp_Perl_vtbl_isa) -#define Perl_vtbl_isaelem (*__imp_Perl_vtbl_isaelem) -#define Perl_vtbl_itervar (*__imp_Perl_vtbl_itervar) -#define Perl_vtbl_mglob (*__imp_Perl_vtbl_mglob) -#define Perl_vtbl_nkeys (*__imp_Perl_vtbl_nkeys) -#define Perl_vtbl_pack (*__imp_Perl_vtbl_pack) -#define Perl_vtbl_packelem (*__imp_Perl_vtbl_packelem) -#define Perl_vtbl_pos (*__imp_Perl_vtbl_pos) -#define Perl_vtbl_sig (*__imp_Perl_vtbl_sig) -#define Perl_vtbl_sigelem (*__imp_Perl_vtbl_sigelem) -#define Perl_vtbl_substr (*__imp_Perl_vtbl_substr) -#define Perl_vtbl_sv (*__imp_Perl_vtbl_sv) -#define Perl_vtbl_taint (*__imp_Perl_vtbl_taint) -#define Perl_vtbl_uvar (*__imp_Perl_vtbl_uvar) -#define Perl_vtbl_vec (*__imp_Perl_vtbl_vec) -#define Perl_xiv_arenaroot (*__imp_Perl_xiv_arenaroot) -#define Perl_xiv_root (*__imp_Perl_xiv_root) -#define Perl_xnv_root (*__imp_Perl_xnv_root) -#define Perl_xpv_root (*__imp_Perl_xpv_root) -#define Perl_xrv_root (*__imp_Perl_xrv_root) -#define ampergv (*__imp_ampergv) -#define argvgv (*__imp_argvgv) -#define argvoutgv (*__imp_argvoutgv) -#define basetime (*__imp_basetime) -#define beginav (*__imp_beginav) -#define bodytarget (*__imp_bodytarget) -#define cddir (*__imp_cddir) -#define chopset (*__imp_chopset) -#define comppad_name_floor (*__imp_comppad_name_floor) -#define copline (*__imp_copline) -#define curpm (*__imp_curpm) -#define curstack (*__imp_curstack) -#define curstash (*__imp_curstash) -#define curstname (*__imp_curstname) -#define cxstack (*__imp_cxstack) -#define cxstack_ix (*__imp_cxstack_ix) -#define cxstack_max (*__imp_cxstack_max) -#define dbargs (*__imp_dbargs) -#define debdelim (*__imp_debdelim) -#define debname (*__imp_debname) -#define debstash (*__imp_debstash) -#define debug (*__imp_debug) -#define defgv (*__imp_defgv) -#define defoutgv (*__imp_defoutgv) -#define defstash (*__imp_defstash) -#define delaymagic (*__imp_delaymagic) -#define diehook (*__imp_diehook) -#define dirty (*__imp_dirty) -#define dlevel (*__imp_dlevel) -#define dlmax (*__imp_dlmax) -#define do_undump (*__imp_do_undump) -#define doextract (*__imp_doextract) -#define doswitches (*__imp_doswitches) -#define dowarn (*__imp_dowarn) -#define dumplvl (*__imp_dumplvl) -#define e_fp (*__imp_e_fp) -#define e_tmpname (*__imp_e_tmpname) -#define endav (*__imp_endav) -#define errgv (*__imp_errgv) -#define eval_root (*__imp_eval_root) -#define eval_start (*__imp_eval_start) -#define fdpid (*__imp_fdpid) -#define filemode (*__imp_filemode) -#define firstgv (*__imp_firstgv) -#define forkprocess (*__imp_forkprocess) -#define formfeed (*__imp_formfeed) -#define formtarget (*__imp_formtarget) -#define gensym (*__imp_gensym) -#define in_eval (*__imp_in_eval) -#define incgv (*__imp_incgv) -#define inplace (*__imp_inplace) -#define last_in_gv (*__imp_last_in_gv) -#define lastfd (*__imp_lastfd) -#define lastscream (*__imp_lastscream) -#define lastsize (*__imp_lastsize) -#define lastspbase (*__imp_lastspbase) -#define laststatval (*__imp_laststatval) -#define laststype (*__imp_laststype) -#define leftgv (*__imp_leftgv) -#define lineary (*__imp_lineary) -#define localizing (*__imp_localizing) -#define localpatches (*__imp_localpatches) -#define main_cv (*__imp_main_cv) -#define main_root (*__imp_main_root) -#define main_start (*__imp_main_start) -#define mainstack (*__imp_mainstack) -#define maxscream (*__imp_maxscream) -#define maxsysfd (*__imp_maxsysfd) -#define minus_F (*__imp_minus_F) -#define minus_a (*__imp_minus_a) -#define minus_c (*__imp_minus_c) -#define minus_l (*__imp_minus_l) -#define minus_n (*__imp_minus_n) -#define minus_p (*__imp_minus_p) -#define multiline (*__imp_multiline) -#define mystack_base (*__imp_mystack_base) -#define mystack_max (*__imp_mystack_max) -#define mystack_sp (*__imp_mystack_sp) -#define mystrk (*__imp_mystrk) -#define nice_chunk (*__imp_nice_chunk) -#define nice_chunk_size (*__imp_nice_chunk_size) -#define nrs (*__imp_nrs) -#define ofmt (*__imp_ofmt) -#define ofs (*__imp_ofs) -#define ofslen (*__imp_ofslen) -#define oldlastpm (*__imp_oldlastpm) -#define oldname (*__imp_oldname) -#define op_mask (*__imp_op_mask) -#define origargc (*__imp_origargc) -#define origargv (*__imp_origargv) -#define origfilename (*__imp_origfilename) -#define ors (*__imp_ors) -#define orslen (*__imp_orslen) -#define pad_reset_pending (*__imp_pad_reset_pending) -#define padix_floor (*__imp_padix_floor) -#define parsehook (*__imp_parsehook) -#define patchlevel (*__imp_patchlevel) -#define perl_destruct_level (*__imp_perl_destruct_level) -#define perldb (*__imp_perldb) -#define preambleav (*__imp_preambleav) -#define preambled (*__imp_preambled) -#define preprocess (*__imp_preprocess) -#define regflags (*__imp_regflags) -#define restartop (*__imp_restartop) -#define rightgv (*__imp_rightgv) -#define rs (*__imp_rs) -#define runlevel (*__imp_runlevel) -#define sawampersand (*__imp_sawampersand) -#define sawstudy (*__imp_sawstudy) -#define sawvec (*__imp_sawvec) -#define screamfirst (*__imp_screamfirst) -#define screamnext (*__imp_screamnext) -#define secondgv (*__imp_secondgv) -#define signalstack (*__imp_signalstack) -#define sortcop (*__imp_sortcop) -#define sortstack (*__imp_sortstack) -#define sortstash (*__imp_sortstash) -#define splitstr (*__imp_splitstr) -#define statcache (*__imp_statcache) -#define statgv (*__imp_statgv) -#define statname (*__imp_statname) -#define statusvalue (*__imp_statusvalue) -#define stdingv (*__imp_stdingv) -#define strchop (*__imp_strchop) -#define strtab (*__imp_strtab) -#define sv_arenaroot (*__imp_sv_arenaroot) -#define sv_count (*__imp_sv_count) -#define sv_objcount (*__imp_sv_objcount) -#define sv_root (*__imp_sv_root) -#define tainted (*__imp_tainted) -#define tmps_floor (*__imp_tmps_floor) -#define tmps_ix (*__imp_tmps_ix) -#define tmps_max (*__imp_tmps_max) -#define tmps_stack (*__imp_tmps_stack) -#define top_env (*__imp_top_env) -#define toptarget (*__imp_toptarget) -#define unsafe (*__imp_unsafe) -#define warnhook (*__imp_warnhook) diff --git a/perl5.003_94/gcc2 b/perl5.003_94/gcc2 deleted file mode 100644 index f01da9ec34..0000000000 --- a/perl5.003_94/gcc2 +++ /dev/null @@ -1,19 +0,0 @@ -#!/bin/sh - - -# gcc wrapper for building dynamic lib version of perl -# if -buildperl found on command line, then all args passed to -# perlgcc, else pass all args to gcc. -# jc 3/24/97 -# -results=`echo "$*" | grep "\-buildperl"` -# echo "results = <$results>" -#if ( "$results" .eq. ""); then -# if `sh -c echo '$*' | grep buildperl >/dev/null 2>&1`; then -case "$results" in - "") gcc $*;; - *) miniperl perlgcc $*;; -esac - - - diff --git a/perl5.003_94/ld2 b/perl5.003_94/ld2 deleted file mode 100644 index 65f10b46c3..0000000000 --- a/perl5.003_94/ld2 +++ /dev/null @@ -1,4 +0,0 @@ -#!/bin/sh -PERLPATH=/perl5.003_94 -# pass all args to the perl ld wrapper -$PERLPATH/perl $PERLPATH/perlld $* @@ -585,7 +585,15 @@ Fpos_t *pos; #if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF) int -vprintf(fd, pat, args) +vprintf(pat, args) +char *pat, *args; +{ + _doprnt(pat, args, stdout); + return 0; /* wrong, but perl doesn't use the return value */ +} + +int +vfprintf(fd, pat, args) FILE *fd; char *pat, *args; { @@ -8,7 +8,7 @@ $/ = "\n\n"; # set paragraph mode $SHlinesep = "\n"; -while ($SHcmd = <>) { +while (defined($SHcmd = <>)) { $/ = $SHlinesep; eval $SHcmd; print $@ || "\n"; $SHlinesep = $/; $/ = ''; diff --git a/plan9/buildinfo b/plan9/buildinfo index 49489adae9..ea502c0781 100644 --- a/plan9/buildinfo +++ b/plan9/buildinfo @@ -1 +1 @@ -p9pvers = 5.003_94 +p9pvers = 5.003_97 diff --git a/pod/Makefile b/pod/Makefile index 0ec08f992a..273786489c 100644 --- a/pod/Makefile +++ b/pod/Makefile @@ -1,6 +1,13 @@ CONVERTERS = pod2html pod2latex pod2man pod2text checkpods +HTMLROOT = / # Change this to fix cross-references in HTML +POD2HTML = pod2html \ + --htmlroot=$(HTMLROOT) \ + --podroot=.. --podpath=pod:lib:ext:vms \ + --libpods=perlfunc:perlguts:perlvar:perlrun:perlop + all: $(CONVERTERS) man + PERL = ../miniperl POD = \ @@ -141,8 +148,8 @@ HTML = \ perlfaq6.html \ perlfaq7.html \ perlfaq8.html \ - perlfaq9.html \ - perltoc.html + perlfaq9.html +# not perltoc.html TEX = \ perl.tex \ @@ -191,19 +198,18 @@ TEX = \ perlfaq9.tex \ perltoc.tex -man: pod2man $(MAN) +man: pod2man $(MAN) -# pod2html normally runs on all the pods at once in order to build up -# cross-references. -html: pod2html - $(PERL) -I../lib pod2html $(POD) +html: pod2html $(HTML) tex: pod2latex $(TEX) toc: $(PERL) -I../lib buildtoc >perltoc.pod -.SUFFIXES: .pm .pod .man +.SUFFIXES: .pm .pod + +.SUFFIXES: .man .pm.man: pod2man $(PERL) -I../lib pod2man $*.pm >$*.man @@ -211,24 +217,25 @@ toc: .pod.man: pod2man $(PERL) -I../lib pod2man $*.pod >$*.man -.SUFFIXES: .mp .pod .html +.SUFFIXES: .html .pm.html: pod2html - $(PERL) -I../lib pod2html $*.pod + $(PERL) -I../lib $(POD2HTML) --infile=$*.pm --outfile=$*.html .pod.html: pod2html - $(PERL) -I../lib pod2html $*.pod - -.SUFFIXES: .pm .pod .tex + $(PERL) -I../lib $(POD2HTML) --infile=$*.pod --outfile=$*.html -.pod.tex: pod2latex - $(PERL) -I../lib pod2latex $*.pod +.SUFFIXES: .tex .pm.tex: pod2latex + $(PERL) -I../lib pod2latex $*.pm + +.pod.tex: pod2latex $(PERL) -I../lib pod2latex $*.pod clean: rm -f $(MAN) $(HTML) $(TEX) + rm -f pod2html-*cache rm -f *.aux *.log realclean: clean diff --git a/pod/perl.pod b/pod/perl.pod index 2c1dde2039..fc4158257b 100644 --- a/pod/perl.pod +++ b/pod/perl.pod @@ -34,7 +34,7 @@ of sections: perlform Perl formats perllocale Perl locale support - perlref Perl references + perlref Perl references perldsc Perl data structures intro perllol Perl data structures: lists of lists perltoot Perl OO tutorial @@ -52,27 +52,38 @@ of sections: perlpod Perl plain old documentation perlbook Perl book information - perlembed Perl how to embed perl in your C or C++ app + perlembed Perl ways to embed perl in your C or C++ application perlapio Perl internal IO abstraction interface perlxs Perl XS application programming interface perlxstut Perl XS tutorial - perlguts Perl internal functions for those doing extensions + perlguts Perl internal functions for those doing extensions perlcall Perl calling conventions from C (If you're intending to read these straight through for the first time, the suggested order will tend to reduce the number of forward references.) -Additional documentation for Perl modules is available in the -F</usr/local/man/> directory. Some of this is distributed standard with -Perl, but you'll also find third-party modules there. You should be able -to view this with your man(1) program by including the proper directories -in the appropriate start-up files. To find out where these are, type: +By default, all of the above manpages are installed in the +F</usr/local/man/> directory. + +Extensive additional documentation for Perl modules is available. The +default configuration for perl will place this additional documentation +in the F</usr/local/lib/perl5/man> directory (or else in the F<man> +subdirectory of the Perl library directory). Some of this additional +documentation is distributed standard with Perl, but you'll also find +documentation for third-party modules there. + +You should be able to view Perl's documentation with your man(1) +program by including the proper directories in the appropriate start-up +files, or in the MANPATH environment variable. To find out where the +configuration has installed the manpages, type: perl -V:man.dir -If the directories were F</usr/local/man/man1> and F</usr/local/man/man3>, -you would need to add only F</usr/local/man> to your MANPATH. If -they are different, you'll have to add both stems. +If the directories have a common stem, such as F</usr/local/man/man1> +and F</usr/local/man/man3>, you need only to add that stem +(F</usr/local/man>) to your man(1) configuration files or your MANPATH +environment variable. If they do not share a stem, you'll have to add +both stems. If that doesn't work for some reason, you can still use the supplied F<perldoc> script to view module information. You might @@ -142,7 +153,7 @@ will continue to work unchanged. Perl variables may now be declared within a lexical scope, like "auto" variables in C. Not only is this more efficient, but it contributes -to better privacy for "programming in the large". Anonymous +to better privacy for "programming in the large". Anonymous subroutines exhibit deep binding of lexical variables (closures). =item * Arbitrarily nested data structures @@ -200,7 +211,7 @@ semantics for undefined subroutine calls. It's not for just autoloading. =item * Regular expression enhancements -You can now specify non-greedy quantifiers. You can now do grouping +You can now specify nongreedy quantifiers. You can now do grouping without creating a backreference. You can now write regular expressions with embedded whitespace and comments for readability. A consistent extensibility mechanism has been added that is upwardly compatible with @@ -215,7 +226,7 @@ code. See F<http://www.perl.com/CPAN> for a site near you. =item * Compilability While not yet in full production mode, a working perl-to-C compiler -does exist. It can generate portable bytecode, simple C, or +does exist. It can generate portable byte code, simple C, or optimized C code. =back diff --git a/pod/perlapio.pod b/pod/perlapio.pod index 2a2a99fc60..d88e44509c 100644 --- a/pod/perlapio.pod +++ b/pod/perlapio.pod @@ -7,16 +7,16 @@ perlapio - perl's IO abstraction interface. PerlIO *PerlIO_stdin(void); PerlIO *PerlIO_stdout(void); PerlIO *PerlIO_stderr(void); - + PerlIO *PerlIO_open(const char *,const char *); int PerlIO_close(PerlIO *); int PerlIO_stdoutf(const char *,...) int PerlIO_puts(PerlIO *,const char *); int PerlIO_putc(PerlIO *,int); - int PerlIO_write(PerlIO *,const void *,size_t); + int PerlIO_write(PerlIO *,const void *,size_t); int PerlIO_printf(PerlIO *, const char *,...); - int PerlIO_vprintf(PerlIO *, const char *, va_list); + int PerlIO_vprintf(PerlIO *, const char *, va_list); int PerlIO_flush(PerlIO *); int PerlIO_eof(PerlIO *); @@ -25,7 +25,7 @@ perlapio - perl's IO abstraction interface. int PerlIO_getc(PerlIO *); int PerlIO_ungetc(PerlIO *,int); - int PerlIO_read(PerlIO *,void *,size_t); + int PerlIO_read(PerlIO *,void *,size_t); int PerlIO_fileno(PerlIO *); PerlIO *PerlIO_fdopen(int, const char *); @@ -34,30 +34,30 @@ perlapio - perl's IO abstraction interface. FILE *PerlIO_findFILE(PerlIO *); void PerlIO_releaseFILE(PerlIO *,FILE *); - void PerlIO_setlinebuf(PerlIO *); + void PerlIO_setlinebuf(PerlIO *); long PerlIO_tell(PerlIO *); int PerlIO_seek(PerlIO *,off_t,int); - int PerlIO_getpos(PerlIO *,Fpos_t *) - int PerlIO_setpos(PerlIO *,Fpos_t *) + int PerlIO_getpos(PerlIO *,Fpos_t *) + int PerlIO_setpos(PerlIO *,Fpos_t *) void PerlIO_rewind(PerlIO *); - - int PerlIO_has_base(PerlIO *); - int PerlIO_has_cntptr(PerlIO *); - int PerlIO_fast_gets(PerlIO *); - int PerlIO_canset_cnt(PerlIO *); - - char *PerlIO_get_ptr(PerlIO *); - int PerlIO_get_cnt(PerlIO *); - void PerlIO_set_cnt(PerlIO *,int); - void PerlIO_set_ptrcnt(PerlIO *,char *,int); - char *PerlIO_get_base(PerlIO *); - int PerlIO_get_bufsiz(PerlIO *); + + int PerlIO_has_base(PerlIO *); + int PerlIO_has_cntptr(PerlIO *); + int PerlIO_fast_gets(PerlIO *); + int PerlIO_canset_cnt(PerlIO *); + + char *PerlIO_get_ptr(PerlIO *); + int PerlIO_get_cnt(PerlIO *); + void PerlIO_set_cnt(PerlIO *,int); + void PerlIO_set_ptrcnt(PerlIO *,char *,int); + char *PerlIO_get_base(PerlIO *); + int PerlIO_get_bufsiz(PerlIO *); =head1 DESCRIPTION Perl's source code should use the above functions instead of those -defined in ANSI C's I<stdio.h>, I<perlio.h> will the C<#define> them to +defined in ANSI C's I<stdio.h>, I<perlio.h> will the C<#define> them to the I/O mechanism selected at Configure time. The functions are modeled on those in I<stdio.h>, but parameter order @@ -67,15 +67,15 @@ has been "tidied up a little". =item B<PerlIO *> -This takes the place of FILE *. Unlike FILE * it should be treated as +This takes the place of FILE *. Unlike FILE * it should be treated as opaque (it is probably safe to assume it is a pointer to something). =item B<PerlIO_stdin()>, B<PerlIO_stdout()>, B<PerlIO_stderr()> Use these rather than C<stdin>, C<stdout>, C<stderr>. They are written to look like "function calls" rather than variables because this makes -it easier to I<make them> function calls if platform cannot export data -to loaded modules, or if (say) different "threads" might have different +it easier to I<make them> function calls if platform cannot export data +to loaded modules, or if (say) different "threads" might have different values. =item B<PerlIO_open(path, mode)>, B<PerlIO_fdopen(fd,mode)> @@ -93,7 +93,7 @@ so it is (currently) legal to use C<printf(fmt,...)> in perl sources. =item B<PerlIO_read(f,buf,count)>, B<PerlIO_write(f,buf,count)> -These correspond to fread() and fwrite(). Note that arguments +These correspond to fread() and fwrite(). Note that arguments are different, there is only one "count" and order has "file" first. @@ -101,7 +101,7 @@ are different, there is only one "count" and order has =item B<PerlIO_puts(s,f)>, B<PerlIO_putc(c,f)> -These correspond to fputs() and fputc(). +These correspond to fputs() and fputc(). Note that arguments have been revised to have "file" first. =item B<PerlIO_ungetc(c,f)> @@ -123,8 +123,8 @@ This corresponds to ferror(). =item B<PerlIO_fileno(f)> -This corresponds to fileno(), note that on some platforms, -the meaning of "fileno" may not match UNIX. +This corresponds to fileno(), note that on some platforms, +the meaning of "fileno" may not match Unix. =item B<PerlIO_clearerr(f)> @@ -145,7 +145,7 @@ This corresponds to fseek(). =item B<PerlIO_getpos(f,p)>, B<PerlIO_setpos(f,p)> -These correspond to fgetpos() and fsetpos(). If platform does not +These correspond to fgetpos() and fsetpos(). If platform does not have the stdio calls then they are implemented in terms of PerlIO_tell() and PerlIO_seek(). @@ -159,14 +159,14 @@ in terms of PerlIO_seek() at some point. This corresponds to tmpfile(), i.e., returns an anonymous PerlIO which will automatically be deleted when closed. -=back +=back =head2 Co-existence with stdio There is outline support for co-existence of PerlIO with stdio. -Obviously if PerlIO is implemented in terms of stdio there is +Obviously if PerlIO is implemented in terms of stdio there is no problem. However if perlio is implemented on top of (say) sfio -then mechanisms must exist to create a FILE * which can be passed +then mechanisms must exist to create a FILE * which can be passed to library code which is going to use stdio calls. =over 4 @@ -179,12 +179,12 @@ May need additional arguments, interface under review. =item B<PerlIO_exportFILE(f,flags)> Given an PerlIO * return a 'native' FILE * suitable for -passing to code expecting to be compiled and linked with +passing to code expecting to be compiled and linked with ANSI C I<stdio.h>. The fact that such a FILE * has been 'exported' is recorded, -and may affect future PerlIO operations on the original -PerlIO *. +and may affect future PerlIO operations on the original +PerlIO *. =item B<PerlIO_findFILE(f)> @@ -195,7 +195,7 @@ Place holder until interface is fully defined. Calling PerlIO_releaseFILE informs PerlIO that all use of FILE * is complete. It is removed from list of 'exported' -FILE *s, and associated PerlIO * should revert to original +FILE *s, and associated PerlIO * should revert to original behaviour. =item B<PerlIO_setlinebuf(f)> @@ -230,21 +230,21 @@ Return count of readable bytes in the buffer. =item B<PerlIO_canset_cnt(f)> -Implementation can adjust its idea of number of +Implementation can adjust its idea of number of bytes in the buffer. =item B<PerlIO_fast_gets(f)> -Implementation has all the interfaces required to +Implementation has all the interfaces required to allow perl's fast code to handle <FILE> mechanism. - PerlIO_fast_gets(f) = PerlIO_has_cntptr(f) && \ + PerlIO_fast_gets(f) = PerlIO_has_cntptr(f) && \ PerlIO_canset_cnt(f) && \ `Can set pointer into buffer' =item B<PerlIO_set_ptrcnt(f,p,c)> -Set pointer into buffer, and a count of bytes still in the +Set pointer into buffer, and a count of bytes still in the buffer. Should be used only to set pointer to within range implied by previous calls to C<PerlIO_get_ptr> and C<PerlIO_get_cnt>. @@ -255,7 +255,7 @@ Obscure - set count of bytes in the buffer. Deprecated. Currently used in only doio.c to force count < -1 to -1. Perhaps should be PerlIO_set_empty or similar. This call may actually do nothing if "count" is deduced from pointer -and a "limit". +and a "limit". =item B<PerlIO_has_base(f)> @@ -271,4 +271,4 @@ Return I<start> of buffer. Return I<total size> of buffer. -=back +=back diff --git a/pod/perlbot.pod b/pod/perlbot.pod index 30d00558b4..bc4e4da1f7 100644 --- a/pod/perlbot.pod +++ b/pod/perlbot.pod @@ -265,7 +265,7 @@ This example demonstrates an interface for the SDBM class. This creates a $ref->FETCH(@_); } sub STORE { - my $self = shift; + my $self = shift; if (defined $_[0]){ my $ref = $self->{'dbm'}; $ref->STORE(@_); @@ -420,7 +420,7 @@ method where that data is located. sub enter { my $self = shift; - + # Don't try to guess if we should use %Bar::fizzle # or %Foo::fizzle. The object already knows which # we should use, so just ask it. diff --git a/pod/perlcall.pod b/pod/perlcall.pod index 1ff71fc581..0bfd142cb3 100644 --- a/pod/perlcall.pod +++ b/pod/perlcall.pod @@ -126,6 +126,31 @@ which can consist of any combination of the symbols defined below, OR'ed together. +=head2 G_VOID + +Calls the Perl subroutine in a void context. + +This flag has 2 effects: + +=over 5 + +=item 1. + +It indicates to the subroutine being called that it is executing in +a void context (if it executes I<wantarray> the result will be the +undefined value). + +=item 2. + +It ensures that nothing is actually returned from the subroutine. + +=back + +The value returned by the I<perl_call_*> function indicates how many +items have been returned by the Perl subroutine - in this case it will +be 0. + + =head2 G_SCALAR Calls the Perl subroutine in a scalar context. This is the default @@ -140,7 +165,6 @@ This flag has 2 effects: It indicates to the subroutine being called that it is executing in a scalar context (if it executes I<wantarray> the result will be false). - =item 2. It ensures that only a scalar is actually returned from the subroutine. @@ -164,7 +188,7 @@ accessible from the stack - think of the case where only one value is returned as being a list with only one element. Any other items that were returned will not exist by the time control returns from the I<perl_call_*> function. The section I<Returning a list in a scalar -context> shows an example of this behaviour. +context> shows an example of this behavior. =head2 G_ARRAY @@ -251,7 +275,7 @@ What has happened is that C<fred> accesses the C<@_> array which belongs to C<joe>. -=head2 G_EVAL +=head2 G_EVAL It is possible for the Perl subroutine you are calling to terminate abnormally, e.g., by calling I<die> explicitly or by not actually @@ -293,7 +317,7 @@ from the stack. =back -See I<Using G_EVAL> for details of using G_EVAL. +See I<Using G_EVAL> for details on using G_EVAL. =head2 G_KEEPERR @@ -326,14 +350,17 @@ The G_KEEPERR flag was introduced in Perl version 5.002. See I<Using G_KEEPERR> for an example of a situation that warrants the use of this flag. -=head2 Determining the Context +=head2 Determining the Context As mentioned above, you can determine the context of the currently -executing subroutine in Perl with I<wantarray>. The equivalent test can -be made in C by using the C<GIMME> macro. This will return C<G_SCALAR> -if you have been called in a scalar context and C<G_ARRAY> if in an -array context. An example of using the C<GIMME> macro is shown in -section I<Using GIMME>. +executing subroutine in Perl with I<wantarray>. The equivalent test +can be made in C by using the C<GIMME_V> macro, which returns +C<G_ARRAY> if you have been called in an array context, C<G_SCALAR> if +in a a scalar context, or C<G_VOID> if in a void context (i.e. the +return value will not be used). An older version of this macro is +called C<GIMME>; in a void context it returns C<G_SCALAR> instead of +C<G_VOID>. An example of using the C<GIMME_V> macro is shown in +section I<Using GIMME_V>. =head1 KNOWN PROBLEMS @@ -368,7 +395,7 @@ For example, say you want to call this Perl sub sub fred { eval { die "Fatal Error" ; } - print "Trapped error: $@\n" + print "Trapped error: $@\n" if $@ ; } @@ -388,8 +415,8 @@ When C<Call_fred> is executed it will print As control never returns to C<Call_fred>, the C<"back in Call_fred"> string will not get printed. -To work around this problem, you can either upgrade to Perl 5.002 (or -later), or use the G_EVAL flag with I<perl_call_*> as shown below +To work around this problem, you can either upgrade to Perl 5.002 or +higher, or use the G_EVAL flag with I<perl_call_*> as shown below void Call_fred() @@ -565,7 +592,7 @@ Next, we come to XPUSHs. This is where the parameters actually get pushed onto the stack. In this case we are pushing a string and an integer. -See the L<perlguts/"XSUBs and the Argument Stack"> for details +See L<perlguts/"XSUBs and the Argument Stack"> for details on how the XPUSH macros work. =item 6. @@ -626,7 +653,7 @@ Points to note this time are =over 5 -=item 1. +=item 1. The only flag specified this time was G_SCALAR. That means the C<@_> array will be created and that the value returned by I<Adder> will @@ -654,7 +681,7 @@ temporaries we create. This means that the temporaries we get rid of will be limited to those which were created after these calls. The C<FREETMPS>/C<LEAVE> pair will get rid of any values returned by -the Perl subroutine, plus it will also dump the mortal SV's we have +the Perl subroutine, plus it will also dump the mortal SVs we have created. Having C<ENTER>/C<SAVETMPS> at the beginning of the code makes sure that no other mortals are destroyed. @@ -672,7 +699,7 @@ allocated to the Perl stack has been reallocated whilst in the I<perl_call_pv> call. If you are making use of the Perl stack pointer in your code you must -always refresh the your local copy using SPAGAIN whenever you make use +always refresh the local copy using SPAGAIN whenever you make use of the I<perl_call_*> functions or any other Perl internal function. =item 4. @@ -834,7 +861,7 @@ then the output will be Value 1 = 3 In this case the main point to note is that only the last item in the -list returned from the subroutine, I<Adder> actually made it back to +list is returned from the subroutine, I<AddSubtract> actually made it back to I<call_AddSubScalar>. @@ -977,7 +1004,7 @@ I<Subtract>. =item 2. -The code +The code if (SvTRUE(GvSV(errgv))) { @@ -1012,7 +1039,7 @@ version of the call_Subtract example above inside a destructor: package Foo; sub new { bless {}, $_[0] } - sub Subtract { + sub Subtract { my($a,$b) = @_; die "death can be fatal" if $a < $b ; $a - $b; @@ -1063,7 +1090,7 @@ Here is a snippet of XSUB which defines I<CallSubPV>. PUSHMARK(sp) ; perl_call_pv(name, G_DISCARD|G_NOARGS) ; -That is fine as far as it goes. The thing is, the Perl subroutine +That is fine as far as it goes. The thing is, the Perl subroutine can be specified as only a string. For Perl 4 this was adequate, but Perl 5 allows references to subroutines and anonymous subroutines. This is where I<perl_call_sv> is useful. @@ -1121,22 +1148,22 @@ particularly true for these cases CallSavedSub1() ; By the time each of the C<SaveSub1> statements above have been executed, -the SV*'s which corresponded to the parameters will no longer exist. +the SV*s which corresponded to the parameters will no longer exist. Expect an error message from Perl of the form Can't use an undefined value as a subroutine reference at ... for each of the C<CallSavedSub1> lines. -Similarly, with this code +Similarly, with this code $ref = \&fred ; SaveSub1($ref) ; $ref = 47 ; CallSavedSub1() ; -you can expect one of these messages (which you actually get is dependent on -the version of Perl you are using) +you can expect one of these messages (which you actually get is dependent on +the version of Perl you are using) Not a CODE reference at ... Undefined subroutine &main::47 called ... @@ -1159,7 +1186,7 @@ A similar but more subtle problem is illustrated with this code CallSavedSub1() ; This time whenever C<CallSavedSub1> get called it will execute the Perl -subroutine C<joe> (assuming it exists) rather than C<fred> as was +subroutine C<joe> (assuming it exists) rather than C<fred> as was originally requested in the call to C<SaveSub1>. To get around these problems it is necessary to take a full copy of the @@ -1260,7 +1287,7 @@ single element of the array. Here is an all Perl example of using it. will print 1: green - This is Class Mine version 1.0 + This is Class Mine version 1.0 Calling a Perl method from C is fairly straightforward. The following things are required @@ -1320,26 +1347,31 @@ The only thing to note is that in both the static and virtual methods, the method name is not passed via the stack - it is used as the first parameter to I<perl_call_method>. -=head2 Using GIMME +=head2 Using GIMME_V -Here is a trivial XSUB which prints the context in which it is +Here is a trivial XSUB which prints the context in which it is currently executing. void PrintContext() CODE: - if (GIMME == G_SCALAR) + I32 gimme = GIMME_V; + if (gimme == G_VOID) + printf ("Context is Void\n") ; + else if (gimme == G_SCALAR) printf ("Context is Scalar\n") ; else printf ("Context is Array\n") ; and here is some Perl to test it + PrintContext ; $a = PrintContext ; @a = PrintContext ; The output from that will be + Context is Void Context is Scalar Context is Array @@ -1418,26 +1450,26 @@ will be more like this perl --> XSUB --> event handler ... - event handler --> perl_call --> perl + event handler --> perl_call --> perl | - event handler <-- perl_call --<--+ + event handler <-- perl_call <----+ ... - event handler --> perl_call --> perl + event handler --> perl_call --> perl | - event handler <-- perl_call --<--+ + event handler <-- perl_call <----+ ... - event handler --> perl_call --> perl + event handler --> perl_call --> perl | - event handler <-- perl_call --<--+ + event handler <-- perl_call <----+ In this case the flow of control can consist of only the repeated sequence event handler --> perl_call --> perl -for the practically the complete duration of the program. This means -that control may I<never> drop back to the surrounding scope in Perl at -the extreme left. +for practically the complete duration of the program. This means that +control may I<never> drop back to the surrounding scope in Perl at the +extreme left. So what is the big problem? Well, if you are expecting Perl to tidy up those temporaries for you, you might be in for a long wait. For Perl @@ -1553,7 +1585,7 @@ This may expect the C I<ProcessRead> function of this form int fh ; char * buffer ; { - ... + ... } To provide a Perl interface to this library we need to be able to map @@ -1646,7 +1678,7 @@ the C<buffer> parameter like this Without the file handle there is no straightforward way to map from the C callback to the Perl subroutine. -In this case a possible way around this problem is to pre-define a +In this case a possible way around this problem is to predefine a series of C functions to act as the interface to Perl, thus #define MAX_CB 3 @@ -1774,7 +1806,7 @@ example. Secondly, there is a hard-wired limit (in this case 3) to the number of callbacks that can exist simultaneously. The only way to increase the limit is by modifying the code to add more functions and then -re-compiling. None the less, as long as the number of functions is +recompiling. None the less, as long as the number of functions is chosen with some care, it is still a workable solution and in some cases is the only one available. @@ -1878,7 +1910,7 @@ sets the stack up so that we can use the C<ST> macro. Unlike the original coding of this example, the returned values are not accessed in reverse order. So C<ST(0)> refers to the -first value returned by the Perl subroutine and C<ST(count-1)> +first value returned by the Perl subroutine and C<ST(count-1)> refers to the last. =back diff --git a/pod/perldata.pod b/pod/perldata.pod index f0837b3854..0dbb92afa5 100644 --- a/pod/perldata.pod +++ b/pod/perldata.pod @@ -145,12 +145,12 @@ type "filehandle", or anything else. Perl is a contextually polymorphic language whose scalars can be strings, numbers, or references (which includes objects). While strings and numbers are considered pretty much the same thing for nearly all purposes, references are strongly-typed -uncastable pointers with built-in reference-counting and destructor +uncastable pointers with builtin reference-counting and destructor invocation. A scalar value is interpreted as TRUE in the Boolean sense if it is not the null string or the number 0 (or its string equivalent, "0"). The -Boolean context is just a special kind of scalar context. +Boolean context is just a special kind of scalar context. There are actually two varieties of null scalars: defined and undefined. Undefined null scalars are returned when there is no real @@ -160,14 +160,14 @@ array. An undefined null scalar may become defined the first time you use it as if it were defined, but prior to that you can use the defined() operator to determine whether the value is defined or not. -To find out whether a given string is a valid non-zero number, it's usually +To find out whether a given string is a valid nonzero number, it's usually enough to test it against both numeric 0 and also lexical "0" (although this will cause B<-w> noises). That's because strings that aren't numbers count as 0, just as they do in B<awk>: if ($str == 0 && $str ne "0") { warn "That doesn't look like a number"; - } + } That's usually preferable because otherwise you won't treat IEEE notations like C<NaN> or C<Infinity> properly. At other times you might prefer to @@ -176,9 +176,9 @@ for details on regular expressions. warn "has nondigits" if /\D/; warn "not a whole number" unless /^\d+$/; - warn "not an integer" unless /^[+-]?\d+$/ - warn "not a decimal number" unless /^[+-]?\d+\.?\d*$/ - warn "not a C float" + warn "not an integer" unless /^[+-]?\d+$/ + warn "not a decimal number" unless /^[+-]?\d+\.?\d*$/ + warn "not a C float" unless /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/; The length of an array is a scalar value. You may find the length of @@ -190,7 +190,7 @@ intervening values. Lengthening an array that was previously shortened I<NO LONGER> recovers the values that were in those elements. (It used to in Perl 4, but we had to break this to make sure destructors were called when expected.) You can also gain some measure of efficiency by -preextending an array that is going to get big. (You can also extend +pre-extending an array that is going to get big. (You can also extend an array by assigning to an element that is off the end of the array.) You can truncate an array down to nothing by assigning the null list () to it. The following are equivalent: @@ -310,7 +310,7 @@ say then any bareword that would NOT be interpreted as a subroutine call produces a compile-time error instead. The restriction lasts to the -end of the enclosing block. An inner block may countermand this +end of the enclosing block. An inner block may countermand this by saying C<no strict 'subs'>. Array variables are interpolated into double-quoted strings by joining all @@ -342,11 +342,11 @@ quoted, the type of quotes you use determines the treatment of the text, just as in regular quoting. An unquoted identifier works like double quotes. There must be no space between the C<E<lt>E<lt>> and the identifier. (If you put a space it will be treated as a null -identifier, which is valid, and matches the first blank line.) The +identifier, which is valid, and matches the first empty line.) The terminating string must appear by itself (unquoted and with no surrounding whitespace) on the terminating line. - print <<EOF; + print <<EOF; The price is $Price. EOF @@ -369,11 +369,11 @@ surrounding whitespace) on the terminating line. Here's a line or two. THIS - and here another. + and here's another. THAT -Just don't forget that you have to put a semicolon on the end -to finish the statement, as Perl doesn't know you're not going to +Just don't forget that you have to put a semicolon on the end +to finish the statement, as Perl doesn't know you're not going to try to do this: print <<ABC @@ -401,12 +401,12 @@ assigns the entire list value to array foo, but assigns the value of variable bar to variable foo. Note that the value of an actual array in a scalar context is the length of the array; the -following assigns to $foo the value 3: +following assigns the value 3 to $foo: @foo = ('cc', '-E', $bar); $foo = @foo; # $foo gets 3 -You may have an optional comma before the closing parenthesis of an +You may have an optional comma before the closing parenthesis of a list literal, so that you can say: @foo = ( @@ -434,7 +434,7 @@ interpolating an array with no elements is the same as if no array had been interpolated at that point. A list value may also be subscripted like a normal array. You must -put the list in parentheses to avoid ambiguity. Examples: +put the list in parentheses to avoid ambiguity. For example: # Stat returns list value. $time = (stat($file))[8]; @@ -514,7 +514,7 @@ or for initializing hash references to be used as records: or for using call-by-named-parameter to complicated functions: - $field = $query->radio_group( + $field = $query->radio_group( name => 'group_name', values => ['eenie','meenie','minie'], default => 'meenie', @@ -530,7 +530,7 @@ of how to arrange for an output ordering. Perl uses an internal type called a I<typeglob> to hold an entire symbol table entry. The type prefix of a typeglob is a C<*>, because -it represents all types. This used to be the preferred way to +it represents all types. This used to be the preferred way to pass arrays and hashes by reference into a function, but now that we have real references, this is seldom needed. It also used to be the preferred way to pass filehandles into a function, but now diff --git a/pod/perldebug.pod b/pod/perldebug.pod index 61263b6664..86a3216161 100644 --- a/pod/perldebug.pod +++ b/pod/perldebug.pod @@ -13,7 +13,7 @@ Perl source debugger. This works like an interactive Perl environment, prompting for debugger commands that let you examine source code, set breakpoints, get stack backtraces, change the values of variables, etc. This is so convenient that you often fire up -the debugger all by itself just to test out Perl constructs +the debugger all by itself just to test out Perl constructs interactively to see what they do. For example: perl -d -e 42 @@ -23,7 +23,7 @@ typical compiled environment. Instead, the B<-d> flag tells the compiler to insert source information into the parse trees it's about to hand off to the interpreter. That means your code must first compile correctly for the debugger to work on it. Then when the interpreter starts up, it -pre-loads a Perl library file containing the debugger itself. +preloads a Perl library file containing the debugger itself. The program will halt I<right before> the first run-time executable statement (but see below regarding compile-time statements) and ask you @@ -47,7 +47,7 @@ The debugger understands the following commands: =item h [command] -Prints out a help message. +Prints out a help message. If you supply another debugger command as an argument to the C<h> command, it prints out the description for just that command. The special @@ -73,7 +73,7 @@ where STDOUT may be redirected to. =item x expr -Evaluates its expression in list context and dumps out the result +Evaluates its expression in list context and dumps out the result in a pretty-printed fashion. Nested data structures are printed out recursively, unlike the C<print> function. @@ -308,7 +308,7 @@ Run Tk while prompting (with ReadLine). Level of verbosity. By default the debugger is in a sane verbose mode, thus it will print backtraces on all the warnings and die-messages which are going to be printed out, and will print a message when -interesting uncaught signals arrive. +interesting uncaught signals arrive. To disable this behaviour, set these values to 0. If C<dieLevel> is 2, then the messages which will be caught by surrounding C<eval> are also @@ -328,11 +328,11 @@ C<|visual_perl_db>), then a short, "emacs like" message is used. If 0, allows I<stepping off> the end of the script. -=item C<PrintRet> +=item C<PrintRet> affects printing of return value after C<r> command. -=item C<frame> +=item C<frame> affects printing messages on entry and exit from subroutines. If C<frame & 2> is false, messages are printed on entry only. (Printing @@ -383,7 +383,7 @@ can enable either double-quotish dump, or single-quotish by setting it to C<"> or C<'>. By default, characters with high bit set are printed I<as is>. -=item C<UsageOnly> +=item C<UsageOnly> I<very> rudimentally per-package memory usage dump. Calculates total size of strings in variables in the package. @@ -429,7 +429,7 @@ ReadLine applications. =item C<NonStop> -If set, debugger goes into non-interactive mode until interrupted, or +If set, debugger goes into noninteractive mode until interrupted, or programmatically by setting $DB::signal or $DB::single. =back @@ -449,7 +449,7 @@ Other examples may include $ PERLDB_OPTS="N f A L=listing" perl -d myprogram -- runs script non-interactively, printing info on each entry into a +- runs script noninteractively, printing info on each entry into a subroutine and each executed line into the file F<listing>. (If you interrupt it, you would better reset C<LineInfo> to something "interactive"!) @@ -539,7 +539,7 @@ your history across this, but internal settings and command line options may be lost. Currently the following setting are preserved: history, breakpoints, -actions, debugger C<O>ptions, and the following command-line +actions, debugger C<O>ptions, and the following command line options: B<-w>, B<-I>, and B<-e>. =item |dbcmd @@ -593,14 +593,14 @@ or even DB<<17>> where that number is the command number, which you'd use to access with -the built-in B<csh>-like history mechanism, e.g., C<!17> would repeat +the builtin B<csh>-like history mechanism, e.g., C<!17> would repeat command number 17. The number of angle brackets indicates the depth of the debugger. You could get more than one set of brackets, for example, if you'd already at a breakpoint and then printed out the result of a function call that itself also has a breakpoint, or you step into an expression via C<s/n/t expression> command. -=item Multi-line commands +=item Multiline commands If you want to enter a multi-line command, such as a subroutine definition with several statements, or a format, you may escape the @@ -667,7 +667,7 @@ next executed line is marked by C<==E<gt>>. When C<frame> option is set, debugger would print entered (and optionally exited) subroutines in different styles. -What follows is the start of the listing of +What follows is the start of the listing of env "PERLDB_OPTS=f=1 N" perl -d -V @@ -795,7 +795,7 @@ is printed with proper indentation. If you have any compile-time executable statements (code within a BEGIN block or a C<use> statement), these will C<NOT> be stopped by debugger, although C<require>s will (and compile-time statements can be traced -with C<AutoTrace> option set in C<PERLDB_OPTS>). From your own Perl +with C<AutoTrace> option set in C<PERLDB_OPTS>). From your own Perl code, however, you can transfer control back to the debugger using the following statement, which is harmless if the debugger is not running: @@ -859,7 +859,7 @@ the Term::ReadKey and Term::ReadLine modules from CPAN, you will have full editing capabilities much like GNU I<readline>(3) provides. Look for these in the F<modules/by-module/Term> directory on CPAN. -A rudimentary command-line completion is also available. +A rudimentary command line completion is also available. Unfortunately, the names of lexical variables are not available for completion. @@ -901,7 +901,7 @@ in that profile. When you call the B<caller> function (see L<perlfunc/caller>) from the package DB, Perl sets the array @DB::args to contain the arguments the -corresponding stack frame was called with. +corresponding stack frame was called with. If perl is run with B<-d> option, the following additional features are enabled: @@ -1007,9 +1007,9 @@ statement, and would wait for your C<CR> to continue. The following debugger is quite functional: - { - package DB; - sub DB {} + { + package DB; + sub DB {} sub sub {print ++$i, " $sub\n"; &$sub} } @@ -1020,7 +1020,7 @@ package C<DB>. =head2 Debugger Internals At the start, the debugger reads your rc file (F<./.perldb> or -F<~/.perldb> under UNIX), which can set important options. This file may +F<~/.perldb> under Unix), which can set important options. This file may define a subroutine C<&afterinit> to be executed after the debugger is initialized. @@ -1042,7 +1042,7 @@ C<context> (C<$> or C<@>), C<sub> (subroutine name, or info about eval), C<args> (C<undef> or a reference to an array), C<file>, and C<line>. -The function C<DB::print_trace(FH, skip[, count[, short]])> prints +The function C<DB::print_trace(FH, skip[, count[, short]])> prints formatted info about caller frames. The last two functions may be convenient as arguments to C<E<lt>>, C<E<lt>E<lt>> commands. diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 958bee38ed..0d3dd84ab0 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -18,7 +18,7 @@ QNX, and AmigaOS. Most importantly, many bugs were fixed. See the F<Changes> file in the distribution for details. -=head2 Compilation Option: Binary Compatibility With 5.003 +=head2 Compilation option: Binary compatibility with 5.003 There is a new Configure question that asks if you want to maintain binary compatibility with Perl 5.003. If you choose binary @@ -27,19 +27,64 @@ might have symbol conflicts if you embed Perl in another application, just as in the 5.003 release. By default, binary compatibility is preserved at the expense of symbol table pollution. -=head2 No Autovivification of Subroutine Parameters +=head2 $PERL5OPT environment variable -In Perl versions 5.002 and 5.003, array and hash elements used as -subroutine parameters were "autovivified"; that is, they were brought -into existence if they did not already exist. For example, calling -C<func($h{foo})> would create C<$h{foo}> if it did not already exist, -causing C<exists $h{foo}> to become true and C<keys %h> to return -C<('foo')>. +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]>. -Perl 5.004 returns to the pre-5.002 behavior of I<not> autovivifying -array and hash elements used as subroutine parameters. +=head2 More precise warnings -=head2 Fixed Parsing of $$<digit>, &$<digit>, etc. +If you removed the B<-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 Deprecated: Inherited C<AUTOLOAD> for non-methods + +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 +(e.g. C<Foo->bar()> or C<$obj->bar()>). + +Perl 5.005 will use method lookup only for methods' C<AUTOLOAD>s. +However, there is a significant base of existing code that may be using +the old behavior. So, as an interim step, Perl 5.004 issues an optional +warning when a non-method uses an inherited C<AUTOLOAD>. + +The simple rule is: Inheritance will not work when autoloading +non-methods. The simple fix for old code is: In any module that used to +depend on inheriting C<AUTOLOAD> for non-methods from a base class named +C<BaseClass>, execute C<*AUTOLOAD = \&BaseClass::AUTOLOAD> during startup. + +=head2 Subroutine arguments created only when they're modified + +In Perl 5.004, nonexistent array and hash elements used as subroutine +parameters are brought into existence only if they are actually +assigned to (via C<@_>). + +Earlier versions of Perl vary in their handling of such arguments. +Perl versions 5.002 and 5.003 always brought them into existence. +Perl versions 5.000, 5.001, and 5.002 brought them into existence only +if they were not the first argument (which was almost certainly a +bug). Earlier versions of Perl never brought them into existence. + +For example, given this code: + + undef @a; undef %a; + sub show { print $_[0] }; + sub change { $_[0]++ }; + show($a[2]); + change($a{b}); + +After this code executes in Perl 5.004, $a{b} exists but $a[2] does +not. In Perl 5.002 and 5.003, both $a{b} and $a[2] would have existed +(but $a[2]'s value would have been undefined). + +=head2 Fixed parsing of $$<digit>, &$<digit>, etc. A bug in previous versions of Perl 5.0 prevented proper parsing of numeric special variables as symbolic references. That bug has been @@ -47,14 +92,22 @@ fixed. As a result, the string "$$0" is no longer equivalent to C<$$."0">, but rather to C<${$0}>. To get the old behavior, change "$$" followed by a digit to "${$}". -=head2 No Resetting of $. on Implicit Close +=head2 No resetting of $. on implicit close The documentation for Perl 5.0 has always stated that C<$.> is I<not> -reset when an already-open file handle is re-opened with no intervening -call to C<close>. Due to a bug, perl versions 5.000 through 5.0003 +reset when an already-open file handle is reopened with no intervening +call to C<close>. Due to a bug, perl versions 5.000 through 5.003 I<did> reset C<$.> under that circumstance; Perl 5.004 does not. -=head2 Changes to Tainting Checks +=head2 C<wantarray> may return undef + +The C<wantarray> operator returns true if a subroutine is expected to +return a list, and false otherwise. In Perl 5.004, C<wantarray> can +also return the undefined value if a subroutine's return value will +not be used at all, which allows subroutines to avoid a time-consuming +calculation of a return value if it isn't going to be used. + +=head2 Changes to tainting checks A bug in previous versions may have failed to detect some insecure conditions when taint checks are turned on. (Taint checks are used @@ -64,14 +117,14 @@ previously-working script to now fail -- which should be construed as a blessing, since that indicates a potentially-serious security hole was just plugged. -=head2 New Opcode Module and Revised Safe Module +=head2 New Opcode module and revised Safe module A new Opcode module supports the creation, manipulation and application of opcode masks. The revised Safe module has a new API and is implemented using the new Opcode module. Please read the new Opcode and Safe documentation. -=head2 Embedding Improvements +=head2 Embedding improvements In older versions of Perl it was not possible to create more than one Perl interpreter instance inside a single process without leaking like a @@ -80,7 +133,7 @@ fixed. However, you still must take care when embedding Perl in a C program. See the updated perlembed manpage for tips on how to manage your interpreters. -=head2 Internal Change: FileHandle Class Based on IO::* Classes +=head2 Internal change: FileHandle class based on IO::* classes File handles are now stored internally as type IO::Handle. The FileHandle module is still supported for backwards compatibility, but @@ -91,13 +144,13 @@ require, that you use the IO::* modules in new code. In harmony with this change, C<*GLOB{FILEHANDLE}> is now a backward-compatible synonym for C<*STDOUT{IO}>. -=head2 Internal Change: PerlIO internal IO abstraction interface +=head2 Internal change: PerlIO abstraction interface It is now possible to build Perl with AT&T's sfio IO package instead of stdio. See L<perlapio> for more details, and the F<INSTALL> file for how to use it. -=head2 New and Changed Built-in Variables +=head2 New and changed builtin variables =over @@ -130,7 +183,7 @@ there is no C<use English> long name for this variable. =back -=head2 New and Changed Built-in Functions +=head2 New and changed builtin functions =over @@ -213,7 +266,7 @@ number instead of a module name. If the version of the Perl interpreter is less than VERSION, then an error message is printed and Perl exits immediately. Because C<use> occurs at compile time, this check happens immediately during the compilation process, unlike C<require VERSION>, -which waits until run-time for the check. This is often useful if you +which waits until runtime for the check. This is often useful if you need to check the current Perl version before C<use>ing library modules which have changed in incompatible ways from older versions of Perl. (We try not to do this more than we have to.) @@ -223,7 +276,7 @@ which have changed in incompatible ways from older versions of Perl. If the VERSION argument is present between Module and LIST, then the C<use> will call the VERSION method in class Module with the given version as an argument. The default VERSION method, inherited from -the Universal class, croaks if the given version is larger than the +the UNIVERSAL class, croaks if the given version is larger than the value of the variable $Module::VERSION. (Note that there is not a comma after VERSION!) @@ -267,6 +320,13 @@ string in some way. This change makes it practical to chain C<m//g> matches together in conjunction with ordinary matches using the C<\G> zero-width assertion. See L<perlop> and L<perlre>. +=item C<m//x> ignores whitespace before ?*+{} + +The C<m//x> construct has always been intended to ignore all unescaped +whitespace. However, before Perl 5.004, whitespace had the effect of +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 Prior to the 5.004 release, nested anonymous functions didn't work @@ -290,7 +350,7 @@ before, and is fine now: =back -=head2 New Built-in Methods +=head2 New builtin methods The C<UNIVERSAL> package automatically contains the following methods that are inherited by all other classes: @@ -340,7 +400,7 @@ You do not need to C<use UNIVERSAL> in order to make these methods available to your program. This is necessary only if you wish to have C<isa> available as a plain subroutine in the current package. -=head2 TIEHANDLE Now Supported +=head2 TIEHANDLE now supported See L<perltie> for other kinds of tie()s. @@ -409,7 +469,7 @@ possibly for cleaning up. =back -=head2 Malloc Enhancements +=head2 Malloc enhancements Four new compilation flags are recognized by malloc.c. (They have no effect if perl is compiled with system malloc().) @@ -468,7 +528,7 @@ negligible. =back -=head2 Miscellaneous Efficiency Enhancements +=head2 Miscellaneous efficiency enhancements Functions that have an empty prototype and that do nothing but return a fixed value are now inlined (e.g. C<sub PI () { 3.14159 }>). @@ -479,10 +539,16 @@ same hash, the hash keys never have to be reallocated. =head1 Pragmata -Four new pragmatic modules exist: +Six new pragmatic modules exist: =over +=item use autouse MODULE => qw(sub1 sub2 sub3) + +Defers C<require MODULE> until someone calls one of the specified +subroutines (which must be exported by MODULE). This pragma should be +used with caution, and only when necessary. + =item use blib =item use blib 'dir' @@ -494,10 +560,15 @@ parent directories. Intended for use on command line with B<-M> option as a way of testing arbitrary scripts against an uninstalled version of a package. +=item use constant NAME => VALUE + +Provides a convenient interface for creating compile-time constants, +See L<perlsub/"Constant Functions">. + =item use locale Tells the compiler to enable (or disable) the use of POSIX locales for -built-in operations. +builtin operations. When C<use locale> is in effect, the current LC_CTYPE locale is used for regular expressions and case mapping; LC_COLLATE for string @@ -529,7 +600,7 @@ relative to the local time zone, in the VMS tradition. =head1 Modules -=head2 Installation Directories +=head2 Installation directories The I<installperl> script now places the Perl source files for extensions in the architecture-specific library directory, which is @@ -539,31 +610,7 @@ library directory unchanged from a previous version, without running the risk of binary incompatibility between extensions' Perl source and shared libraries. -=head2 Fcntl - -New constants in the existing Fcntl modules are now supported, -provided that your operating system happens to support them: - - F_GETOWN F_SETOWN - O_ASYNC O_DEFER O_DSYNC O_FSYNC O_SYNC - O_EXLOCK O_SHLOCK - -These constants are intended for use with the Perl operators sysopen() -and fcntl() and the basic database modules like SDBM_File. For the -exact meaning of these and other Fcntl constants please refer to your -operating system's documentation for fcntl() and open(). - -In addition, the Fcntl module now provides these constants for use -with the Perl operator flock(): - - LOCK_SH LOCK_EX LOCK_NB LOCK_UN - -These constants are defined in all environments (because where there is -no flock() system call, Perl emulates it). However, for historical -reasons, these constants are not exported unless they are explicitly -requested with the ":flock" tag (e.g. C<use Fcntl ':flock'>). - -=head2 Module Information Summary +=head2 Module information summary Brand new modules, arranged by topic rather than strictly alphabetically: @@ -603,6 +650,30 @@ alphabetically: UNIVERSAL.pm Base class for *ALL* classes +=head2 Fcntl + +New constants in the existing Fcntl modules are now supported, +provided that your operating system happens to support them: + + F_GETOWN F_SETOWN + O_ASYNC O_DEFER O_DSYNC O_FSYNC O_SYNC + O_EXLOCK O_SHLOCK + +These constants are intended for use with the Perl operators sysopen() +and fcntl() and the basic database modules like SDBM_File. For the +exact meaning of these and other Fcntl constants please refer to your +operating system's documentation for fcntl() and open(). + +In addition, the Fcntl module now provides these constants for use +with the Perl operator flock(): + + LOCK_SH LOCK_EX LOCK_NB LOCK_UN + +These constants are defined in all environments (because where there is +no flock() system call, Perl emulates it). However, for historical +reasons, these constants are not exported unless they are explicitly +requested with the ":flock" tag (e.g. C<use Fcntl ':flock'>). + =head2 IO The IO module provides a simple mechanism to load all of the IO modules at one @@ -632,6 +703,11 @@ And these functions are now exported: sinh cosh tanh cotanh asinh acosh atanh acotanh cplx cplxe +=head2 Math::Trig + +This module provides a simpler interface to parts of Math::Complex for +those who need trigonometric functions only for real numbers. + =head2 DB_File There have been quite a few changes made to DB_File. Here are a few of @@ -678,9 +754,9 @@ changes. Everything after DB_File 1.01 has been added since 5.003. Major rewrite - support added for both udp echo and real icmp pings. -=head2 Overridden Built-ins +=head2 Object-oriented overrides for builtin operators -Many of the Perl built-ins returning lists now have +Many of the Perl builtins returning lists now have object-oriented overrides. These are: File::stat @@ -749,7 +825,7 @@ on the first call). Internal handling of hash keys has changed. The old hashtable API is still fully supported, and will likely remain so. The additions to the API allow passing keys as C<SV*>s, so that C<tied> hashes can be given -real scalars as keys rather than plain strings (non-tied hashes still +real scalars as keys rather than plain strings (nontied hashes still can only use strings as keys). New extensions must use the new hash access functions and macros if they wish to use C<SV*> keys. These additions also make it feasible to manipulate C<HE*>s (hash entries), @@ -803,7 +879,7 @@ increasing order of desperation): (S) A severe warning (mandatory). (F) A fatal error (trappable). (P) An internal error you should never see (trappable). - (X) A very fatal error (non-trappable). + (X) A very fatal error (nontrappable). (A) An alien error message (not generated by Perl). =over @@ -830,13 +906,22 @@ or a hash slice, such as =item Allocation too large: %lx -(X) You can't allocate more than 64K on an MSDOS machine. +(X) You can't allocate more than 64K on an MS-DOS machine. =item Allocation too large (F) You can't allocate more than 2^31+"small amount" bytes. -=item Attempt to free non-existent shared string +=item Applying %s to %s will act on scalar(%s) + +(W) The pattern match (//), substitution (s///), and translation (tr///) +operators work on scalar values. If you apply one of them to an array +or a hash, it will convert the array or hash to a scalar value -- the +length of an array, or the population info of a hash -- and then work on +that scalar value. This is probably not what you meant to do. See +L<perlfunc/grep> and L<perlfunc/map> for alternatives. + +=item Attempt to free nonexistent shared string (P) Perl maintains a reference counted internal table of strings to optimize the storage and access of hash keys and other strings. This @@ -849,39 +934,54 @@ that can no longer be found in the table. as an lvalue, which is pretty strange. Perhaps you forgot to dereference it first. See L<perlfunc/substr>. -=item Unsupported function fork - -(F) Your version of executable does not support forking. - -Note that under some systems, like OS/2, there may be different flavors of -Perl executables, some of which may support fork, some not. Try changing -the name you call Perl by to C<perl_>, C<perl__>, and so on. - -=item Ill-formed logical name |%s| in prime_env_iter - -(W) A warning peculiar to VMS. A logical name was encountered when preparing -to iterate over %ENV which violates the syntactic rules governing logical -names. Since it cannot be translated normally, it is skipped, and will not -appear in %ENV. This may be a benign occurrence, as some software packages -might directly modify logical name tables and introduce non-standard names, -or it may indicate that a logical name table has been corrupted. - =item Can't use bareword ("%s") as %s ref while "strict refs" in use (F) Only hard references are allowed by "strict refs". Symbolic references are disallowed. See L<perlref>. +=item Cannot resolve method `%s' overloading `%s' in package `%s' + +(P) Internal error trying to resolve overloading specified by a method +name (as opposed to a subroutine reference). + =item Constant subroutine %s redefined (S) You redefined a subroutine which had previously been eligible for inlining. See L<perlsub/"Constant Functions"> for commentary and workarounds. +=item Constant subroutine %s undefined + +(S) You undefined a subroutine which had previously been eligible for +inlining. See L<perlsub/"Constant Functions"> for commentary and +workarounds. + +=item Copy method did not return a reference + +(F) The method which overloads "=" is buggy. See L<overload/Copy Constructor>. + =item Died (F) You passed die() an empty string (the equivalent of C<die "">) or you called it with no args and both C<$@> and C<$_> were empty. +=item Exiting pseudo-block via %s + +(W) You are exiting a rather special block construct (like a sort block or +subroutine) by unconventional means, such as a goto, or a loop control +statement. See L<perlfunc/sort>. + +=item Illegal character %s (carriage return) + +(F) A carriage return character was found in the input. This is an +error, and not a warning, because carriage return characters can break +multi-line strings, including here documents (e.g., C<print E<lt>E<lt>EOF;>). + +=item Illegal switch in PERL5OPT: %s + +(X) The PERL5OPT environment variable may only be used to set the +following switches: B<-[DIMUdmw]>. + =item Integer overflow in hex number (S) The literal hex number you have specified is too big for your @@ -914,17 +1014,6 @@ pointing outside the buffer. This is difficult to imagine. The sole exception to this is that C<sysread()>ing past the buffer will extend the buffer and zero pad the new area. -=item Stub found while resolving method `%s' overloading `%s' in package `%s' - -(P) Overloading resolution over @ISA tree may be broken by importing stubs. -Stubs should never be implicitely created, but explicit calls to C<can> -may break this. - -=item Cannot resolve method `%s' overloading `%s' in package `s' - -(P) Internal error trying to resolve overloading specified by a method -name (as opposed to a subroutine reference). - =item Out of memory! (X|F) The malloc() function returned 0, indicating there was insufficient @@ -998,18 +1087,46 @@ assigning to it and when evaluating its argument, while C<@foo{&bar}> behaves like a list when you assign to it, and provides a list context to its subscript, which can do weird things if you're expecting only one subscript. +=item Stub found while resolving method `%s' overloading `%s' in package `%s' + +(P) Overloading resolution over @ISA tree may be broken by importing stubs. +Stubs should never be implicitely created, but explicit calls to C<can> +may break this. + +=item Too late for "B<-T>" option + +(X) The #! line (or local equivalent) in a Perl script contains the +B<-T> option, but Perl was not invoked with B<-T> in its argument +list. This is an error because, by the time Perl discovers a B<-T> in +a script, it's too late to properly taint everything from the +environment. So Perl gives up. + =item untie attempted while %d inner references still exist (W) A copy of the object returned from C<tie> (or C<tied>) was still valid when C<untie> was called. -=item Value of %s construct can be "0"; test with defined() +=item Unrecognized character %s + +(F) The Perl parser has no idea what to do with the specified character +in your Perl script (or eval). Perhaps you tried to run a compressed +script, a binary program, or a directory as a Perl program. -(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. +=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), 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 @@ -1052,7 +1169,7 @@ will I<never> share the given variable. This problem can usually be solved by making the inner subroutine anonymous, using the C<sub {}> syntax. When inner anonymous subs that reference variables in outer subroutines are called or referenced, -they are automatically re-bound to the current values of such +they are automatically rebound to the current values of such variables. =item Warning: something's wrong @@ -1060,6 +1177,15 @@ variables. (W) You passed warn() an empty string (the equivalent of C<warn "">) or you called it with no args and C<$_> was empty. +=item Ill-formed logical name |%s| in prime_env_iter + +(W) A warning peculiar to VMS. A logical name was encountered when preparing +to iterate over %ENV which violates the syntactic rules governing logical +names. Since it cannot be translated normally, it is skipped, and will not +appear in %ENV. This may be a benign occurrence, as some software packages +might directly modify logical name tables and introduce nonstandard names, +or it may indicate that a logical name table has been corrupted. + =item Got an error from DosAllocMem (P) An error peculiar to OS/2. Most probably you're using an obsolete @@ -1067,7 +1193,7 @@ version of Perl, and this should not happen anyway. =item Malformed PERLLIB_PREFIX -(F) An error peculiar to OS/2. PERLLIB_PREFIX should be of the form +(F) An error peculiar to OS/2. PERLLIB_PREFIX should be of the form prefix1;prefix2 @@ -1075,21 +1201,23 @@ or prefix1 prefix2 -with non-empty 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">. +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 +"PERLLIB_PREFIX" in F<README.os2>. =item PERL_SH_DIR too long (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">. +C<sh>-shell in. See "PERL_SH_DIR" in F<README.os2>. =item Process terminated by SIG%s (W) This is a standard message issued by OS/2 applications, while *nix -applications die in silence. It is considered a feature of the OS/2 -port. One can easily disable this by appropriate sighandlers, see -L<perlipc/"Signals">. See L<perlos2/"Process terminated by SIGTERM/SIGINT">. +applications die in silence. It is considered a feature of the OS/2 +port. One can easily disable this by appropriate sighandlers, see +L<perlipc/"Signals">. See also "Process terminated by SIGTERM/SIGINT" +in F<README.os2>. =back diff --git a/pod/perldiag.pod b/pod/perldiag.pod index e0a23b0162..89c8a2ac5c 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -12,7 +12,7 @@ desperation): (S) A severe warning (mandatory). (F) A fatal error (trappable). (P) An internal error you should never see (trappable). - (X) A very fatal error (non-trappable). + (X) A very fatal error (nontrappable). (A) An alien error message (not generated by Perl). Optional warnings are enabled by using the B<-w> switch. Warnings may @@ -174,7 +174,7 @@ the return value of your socket() call? See L<perlfunc/accept>. =item Allocation too large: %lx -(X) You can't allocate more than 64K on an MSDOS machine. +(X) You can't allocate more than 64K on an MS-DOS machine. =item Allocation too large @@ -237,7 +237,7 @@ know which context to supply to the right side. be garbage collected on exit. An SV was discovered to be outside any of those arenas. -=item Attempt to free non-existent shared string +=item Attempt to free nonexistent shared string (P) Perl maintains a reference counted internal table of strings to optimize the storage and access of hash keys and other strings. This @@ -334,6 +334,12 @@ wasn't a symbol table entry. of Perl. Check the #! line, or manually feed your script into Perl yourself. +=item Bareword "%s" not allowed while "strict subs" in use + +(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 predeclare a subroutine? + =item BEGIN failed--compilation aborted (F) An untrapped exception was raised while executing a BEGIN subroutine. @@ -383,7 +389,7 @@ will be considered a block that loops once. See L<perlfunc/last>. there isn't a current block. Note that an "if" or "else" block doesn't count as a "loopish" block, as doesn't a block given to sort(). You can usually double the curlies to get the same effect though, because the inner -curlies will be considered a block that loops once. See L<perlfunc/last>. +curlies will be considered a block that loops once. See L<perlfunc/next>. =item Can't "redo" outside a block @@ -391,7 +397,7 @@ curlies will be considered a block that loops once. See L<perlfunc/last>. there isn't a current block. Note that an "if" or "else" block doesn't count as a "loopish" block, as doesn't a block given to sort(). You can usually double the curlies to get the same effect though, because the inner -curlies will be considered a block that loops once. See L<perlfunc/last>. +curlies will be considered a block that loops once. See L<perlfunc/redo>. =item Can't bless non-reference value @@ -400,7 +406,7 @@ encapsulation of objects. See L<perlobj>. =item Can't break at that line -(S) A warning intended for while running within the debugger, indicating +(S) A warning intended to only be printed while running within the debugger, indicating the line number specified wasn't the location of a statement that could be stopped at. @@ -412,7 +418,7 @@ in it, let alone methods. See L<perlobj>. =item Can't call method "%s" on unblessed reference -(F) A method call must know what package it's supposed to run in. It +(F) A method call must know in what package it's supposed to run. It ordinarily finds this out from the object reference you supply, but you didn't supply an object reference in this case. A reference isn't an object reference until it has been blessed. See L<perlobj>. @@ -472,10 +478,10 @@ They must have ordinary identifiers as names. (S) The creation of the new file failed for the indicated reason. -=item Can't do in-place edit without backup +=item Can't do inplace edit without backup -(F) You're on a system such as MSDOS that gets confused if you try reading -from a deleted (but still opened) file. You have to say B<-i>C<.bak>, or some +(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. =item Can't do inplace edit: %s E<gt> 14 characters @@ -557,14 +563,6 @@ levels, the following is missing its final parenthesis: (F) A fatal error occurred while trying to fork while opening a pipeline. -=item Unsupported function fork - -(F) Your version of executable does not support forking. - -Note that under some systems, like OS/2, there may be different flavors of -Perl executables, some of which may support fork, some not. Try changing -the name you call Perl by to C<perl_>, C<perl__>, and so on. - =item Can't get filespec - stale stat buffer? (S) A warning peculiar to VMS. This arises because of the difference between @@ -615,10 +613,10 @@ package name. =item Can't locate %s in @INC -(F) You said to do (or require, or use) a file that couldn't be found -in any of the libraries mentioned in @INC. Perhaps you need to set -the PERL5LIB environment variable to say where the extra library is, -or maybe the script needs to add the library name to @INC. Or maybe +(F) You said to do (or require, or use) a file that couldn't be found in +in any of the libraries mentioned in @INC. Perhaps you need to set the +PERL5LIB or PERL5OPT environment variable to say where the extra library +is, or maybe the script needs to add the library name to @INC. Or maybe you just misspelled the name of the file. See L<perlfunc/require>. =item Can't locate object method "%s" via package "%s" @@ -642,7 +640,7 @@ a B<-e> switch. Maybe your /tmp partition is full, or clobbered. (F) You aren't allowed to assign to the item indicated, or otherwise try to change it, such as with an auto-increment. -=item Can't modify non-existent substring +=item Can't modify nonexistent substring (P) The internal routine that does assignment to a substr() was handed a NULL. @@ -654,7 +652,7 @@ buffer. =item Can't open %s: %s -(S) An in-place edit couldn't open the original file for the indicated reason. +(S) An inplace edit couldn't open the original file for the indicated reason. Usually this is because you don't have read permission for the file. =item Can't open bidirectional pipe @@ -793,7 +791,7 @@ are disallowed. See L<perlref>. =item Can't use an undefined value as %s reference (F) A value used as either a hard reference or a symbolic reference must -be a defined value. This helps to de-lurk some insidious errors. +be a defined value. This helps to delurk some insidious errors. =item Can't use global %s in "my" @@ -900,7 +898,7 @@ On the other hand, maybe you just meant %hash and got carried away. (F) You passed die() an empty string (the equivalent of C<die "">) or you called it with no args and both C<$@> and C<$_> were empty. -=item Do you need to pre-declare %s? +=item Do you need to predeclare %s? (S) This is an educated guess made in conjunction with the message "%s found where operator expected". It often means a subroutine or module @@ -1100,18 +1098,18 @@ is now heavily deprecated. to iterate over %ENV which violates the syntactic rules governing logical names. Because it cannot be translated normally, it is skipped, and will not appear in %ENV. This may be a benign occurrence, as some software packages -might directly modify logical name tables and introduce non-standard names, +might directly modify logical name tables and introduce nonstandard names, or it may indicate that a logical name table has been corrupted. =item Illegal character %s (carriage return) (F) A carriage return character was found in the input. This is an error, and not a warning, because carriage return characters can break -here documents (e.g., C<print E<lt>E<lt>EOF;>). - -Under UNIX, this error is usually caused by executing Perl code -- +multi-line strings, including here documents (e.g., C<print E<lt>E<lt>EOF;>). + +Under Unix, this error is usually caused by executing Perl code -- either the main program, a module, or an eval'd string -- that was -transferred over a network connection from a non-UNIX system without +transferred over a network connection from a non-Unix system without properly converting the text file format. Under systems that use something other than '\n' to delimit lines of @@ -1141,6 +1139,11 @@ don't take to this kindly. (W) You may have tried to use an 8 or 9 in a octal number. Interpretation of the octal number stopped before the 8 or 9. +=item Illegal switch in PERL5OPT: %s + +(X) The PERL5OPT environment variable may only be used to set the +following switches: B<-[DIMUdmw]>. + =item In string, @%s now must be written as \@%s (F) It used to be that Perl would try to guess whether you wanted an @@ -1295,13 +1298,13 @@ catches that. But an easy way to do the same thing is: Another way is to assign to a substr() that's off the end of the string. -=item Modification of non-creatable array value attempted, subscript %d +=item Modification of noncreatable array value attempted, subscript %d (F) You tried to make an array value spring into existence, and the subscript was probably negative, even counting from end of the array backwards. -=item Modification of non-creatable hash value attempted, subscript "%s" +=item Modification of noncreatable hash value attempted, subscript "%s" (F) You tried to make a hash value spring into existence, and it couldn't be created for some peculiar reason. @@ -1376,7 +1379,7 @@ this error was triggered? =item No command into which to pipe on command line (F) An error peculiar to VMS. Perl handles its own command line redirection, -and found a '|' at the end of the command line, so it doesn't know whither you +and found a '|' at the end of the command line, so it doesn't know where you want to pipe the output from this command. =item No DB::DB routine defined @@ -1416,7 +1419,7 @@ from which to read data for stdin. (F) An error peculiar to VMS. Perl handles its own command line redirection, and found a lone 'E<gt>' at the end of the command line, so it doesn't know -whither you wanted to redirect stdout. +where you wanted to redirect stdout. =item No output file after E<gt> or E<gt>E<gt> on command line @@ -1590,7 +1593,7 @@ but realloc() wouldn't give it more memory, virtual or otherwise. =item Out of memory! (X|F) The malloc() function returned 0, indicating there was insufficient -remaining memory (or virtual memory) to satisfy the request. +remaining memory (or virtual memory) to satisfy the request. The request was judged to be small, so the possibility to trap it depends on the way perl was compiled. By default it is not trappable. @@ -1793,7 +1796,7 @@ used.) You probably wrote something like this: - @list = qw( + @list = qw( a # a comment b # another comment ); @@ -1801,8 +1804,8 @@ You probably wrote something like this: when you should have written this: @list = qw( - a - b + a + b ); If you really want comments, build your list the @@ -1820,7 +1823,7 @@ aren't needed to separate the items. (You may have used different delimiters than the parentheses shown here; braces are also frequently used.) -You probably wrote something like this: +You probably wrote something like this: qw! a, b, c !; @@ -1863,16 +1866,16 @@ Check your logic flow. =item Probable precedence problem on %s -(W) The compiler found a bare word where it expected a conditional, +(W) The compiler found a bareword where it expected a conditional, which often indicates that an || or && was parsed as part of the last argument of the previous construct, for example: open FOO || die; -=item Prototype mismatch: (%s) vs (%s) +=item Prototype mismatch: %s vs %s -(S) The subroutine being defined had a pre-declared (forward) declaration -with a different function prototype. +(S) The subroutine being declared or defined had previously been declared +or defined with a different function prototype. =item Read on closed filehandle E<lt>%sE<gt> @@ -1881,7 +1884,7 @@ Check your logic flow. =item Reallocation too large: %lx -(F) You can't allocate more than 64K on an MSDOS machine. +(F) You can't allocate more than 64K on an MS-DOS machine. =item Recompile perl with B<-D>DEBUGGING to use B<-D> switch @@ -1959,8 +1962,8 @@ L<perlref>. =item Script is not setuid/setgid in suidperl -(F) Oddly, the suidperl program was invoked on a script with its setuid -or setgid bit not set. This doesn't make much sense. +(F) Oddly, the suidperl program was invoked on a script without a setuid +or setgid bit set. This doesn't make much sense. =item Search pattern not terminated @@ -1970,7 +1973,7 @@ construct. Remember that bracketing delimiters count nesting level. =item seek() on unopened file (W) You tried to use the seek() function on a filehandle that was either -never opened or has been closed since. +never opened or has since been closed. =item select not implemented @@ -2096,7 +2099,7 @@ See L<perlfunc/split>. =item Stat on unopened file E<lt>%sE<gt> (W) You tried to use the stat() function (or an equivalent file test) -on a filehandle that was either never opened or has been closed since. +on a filehandle that was either never opened or has since been closed. =item Statement unlikely to be reached @@ -2189,7 +2192,7 @@ Check your logic flow. =item tell() on unopened file (W) You tried to use the tell() function on a filehandle that was either -never opened or has been closed since. +never opened or has since been closed. =item Test on unopened file E<lt>%sE<gt> @@ -2388,14 +2391,15 @@ See L<perlre>. =item Unquoted string "%s" may clash with future reserved word -(W) You used a bare word that might someday be claimed as a reserved word. +(W) You used a bareword that might someday be claimed as a reserved word. It's best to put such a word in quotes, or capitalize it somehow, or insert an underbar into it. You might also declare it as a subroutine. -=item Unrecognized character \%03o ignored +=item Unrecognized character %s -(S) A garbage character was found in the input, and ignored, in case it's -a weird control character on an EBCDIC machine, or some such. +(F) The Perl parser has no idea what to do with the specified character +in your Perl script (or eval). Perhaps you tried to run a compressed +script, a binary program, or a directory as a Perl program. =item Unrecognized signal name "%s" @@ -2412,12 +2416,20 @@ supplying the bad switch on your behalf.) (W) A file operation was attempted on a filename, and that operation failed, PROBABLY because the filename contained a newline, PROBABLY -because you forgot to chop() or chomp() it off. See L<perlfunc/chop>. +because you forgot to chop() or chomp() it off. See L<perlfunc/chomp>. =item Unsupported directory function "%s" called (F) Your machine doesn't support opendir() and readdir(). +=item Unsupported function fork + +(F) Your version of executable does not support forking. + +Note that under some systems, like OS/2, there may be different flavors of +Perl executables, some of which may support fork, some not. Try changing +the name you call Perl by to C<perl_>, C<perl__>, and so on. + =item Unsupported function %s (F) This machines doesn't implement the indicated function, apparently. @@ -2452,16 +2464,10 @@ action-at-a-distance effects of C<$*>. (F) You attempted to use a feature of printf that is accessible from only C. This usually means there's a better way to do it in Perl. -=item Use of %s is deprecated - -(D) The construct indicated is no longer recommended for use, generally -because there's a better way to do it, and also because the old way has -bad side effects. - =item Use of bare E<lt>E<lt> to mean E<lt>E<lt>"" is deprecated (D) You are now encouraged to use the explicitly quoted form if you -wish to use a blank line as the terminator of the here-document. +wish to use an empty line as the terminator of the here-document. =item Use of implicit split to @_ is deprecated @@ -2469,6 +2475,30 @@ wish to use a blank line as the terminator of the here-document. subroutine's argument list, so it's better if you assign the results of a split() explicitly to an array (or list). +=item Use of inherited AUTOLOAD for non-method %s() is deprecated + +As an (ahem) accidental feature, C<AUTOLOAD> subroutines are looked up +as methods (using the C<@ISA> hierarchy) even when the subroutines to be +autoloaded were called as plain functions (e.g. C<Foo::bar()>), not as +methods (e.g. C<Foo->bar()> or C<$obj->bar()>). + +This bug will be rectified in Perl 5.005, which will use method lookup +only for methods' C<AUTOLOAD>s. However, there is a significant base +of existing code that may be using the old behavior. So, as an +interim step, Perl 5.004 issues an optional warning when non-methods +use inherited C<AUTOLOAD>s. + +The simple rule is: Inheritance will not work when autoloading +non-methods. The simple fix for old code is: In any module that used to +depend on inheriting C<AUTOLOAD> for non-methods from a base class named +C<BaseClass>, execute C<*AUTOLOAD = \&BaseClass::AUTOLOAD> during startup. + +=item Use of %s is deprecated + +(D) The construct indicated is no longer recommended for use, generally +because there's a better way to do it, and also because the old way has +bad side effects. + =item Use of uninitialized value (W) An undefined value was used as if it were already defined. It was @@ -2568,7 +2598,7 @@ will I<never> share the given variable. This problem can usually be solved by making the inner subroutine anonymous, using the C<sub {}> syntax. When inner anonymous subs that reference variables in outer subroutines are called or referenced, -they are automatically re-bound to the current values of such +they are automatically rebound to the current values of such variables. =item Variable syntax @@ -2691,7 +2721,7 @@ version of Perl, and this should not happen anyway. =item Malformed PERLLIB_PREFIX -(F) An error peculiar to OS/2. PERLLIB_PREFIX should be of the form +(F) An error peculiar to OS/2. PERLLIB_PREFIX should be of the form prefix1;prefix2 @@ -2699,21 +2729,23 @@ or prefix1 prefix2 -with non-empty 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">. +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 +"PERLLIB_PREFIX" in F<README.os2>. =item PERL_SH_DIR too long -(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">. +(F) An error peculiar to OS/2. PERL_SH_DIR is the directory to find the +C<sh>-shell in. See "PERL_SH_DIR" in F<README.os2>. =item Process terminated by SIG%s (W) This is a standard message issued by OS/2 applications, while *nix -applications die in silence. It is considered a feature of the OS/2 -port. One can easily disable this by appropriate sighandlers, see -L<perlipc/"Signals">. See L<perlos2/"Process terminated by SIGTERM/SIGINT">. +applications die in silence. It is considered a feature of the OS/2 +port. One can easily disable this by appropriate sighandlers, see +L<perlipc/"Signals">. See also "Process terminated by SIGTERM/SIGINT" +in F<README.os2>. =back diff --git a/pod/perldsc.pod b/pod/perldsc.pod index 61c45b970c..e2b82df796 100644 --- a/pod/perldsc.pod +++ b/pod/perldsc.pod @@ -134,7 +134,7 @@ might do well to consider being a tad more explicit about it, like this: for $i (1..10) { @list = somefunc($i); - $counts[$i] = scalar @list; + $counts[$i] = scalar @list; } Here's the case of taking a reference to the same memory location @@ -328,7 +328,7 @@ There's also a lowercase B<x> command which is nearly the same. =head1 CODE EXAMPLES -Presented with little comment (these will get their own man pages someday) +Presented with little comment (these will get their own manpages someday) here are short code examples illustrating access of various types of data structures. @@ -457,7 +457,7 @@ types of data structures. } # print the whole thing sorted by number of members and name - foreach $family ( sort { + foreach $family ( sort { @{$HoL{$b}} <=> @{$HoL{$a}} || $a cmp $b diff --git a/pod/perlembed.pod b/pod/perlembed.pod index 4b88754f72..9111be1253 100644 --- a/pod/perlembed.pod +++ b/pod/perlembed.pod @@ -14,7 +14,7 @@ Do you want to: Read L<perlcall> and L<perlxs>. -=item B<Use a UNIX program from Perl?> +=item B<Use a Unix program from Perl?> Read about back-quotes and about C<system> and C<exec> in L<perlfunc>. @@ -96,29 +96,29 @@ Execute this statement for a hint about where to find CORE: perl -MConfig -e 'print $Config{archlib}' -Here's how you'd compile the example in the next section, +Here's how you'd compile the example in the next section, L<Adding a Perl interpreter to your C program>, on my Linux box: - % gcc -O2 -Dbool=char -DHAS_BOOL -I/usr/local/include + % gcc -O2 -Dbool=char -DHAS_BOOL -I/usr/local/include -I/usr/local/lib/perl5/i586-linux/5.003/CORE - -L/usr/local/lib/perl5/i586-linux/5.003/CORE + -L/usr/local/lib/perl5/i586-linux/5.003/CORE -o interp interp.c -lperl -lm -(That's all one line.) On my DEC Alpha running 5.00305, the incantation +(That's all one line.) On my DEC Alpha running 5.003_05, the incantation is a bit different: - % cc -O2 -Olimit 2900 -DSTANDARD_C -I/usr/local/include - -I/usr/local/lib/perl5/alpha-dec_osf/5.00305/CORE - -L/usr/local/lib/perl5/alpha-dec_osf/5.00305/CORE -L/usr/local/lib + % cc -O2 -Olimit 2900 -DSTANDARD_C -I/usr/local/include + -I/usr/local/lib/perl5/alpha-dec_osf/5.00305/CORE + -L/usr/local/lib/perl5/alpha-dec_osf/5.00305/CORE -L/usr/local/lib -D__LANGUAGE_C__ -D_NO_PROTO -o interp interp.c -lperl -lm How can you figure out what to add? Assuming your Perl is post-5.001, execute a C<perl -V> command and pay special attention to the "cc" and -"ccflags" information. +"ccflags" information. -You'll have to choose the appropriate compiler (I<cc>, I<gcc>, et al.) for +You'll have to choose the appropriate compiler (I<cc>, I<gcc>, et al.) for your machine: C<perl -MConfig -e 'print $Config{cc}'> will tell you what -to use. +to use. You'll also have to choose the appropriate library directory (I</usr/local/lib/...>) for your machine. If your compiler complains @@ -132,7 +132,7 @@ Perhaps those printed by perl -MConfig -e 'print $Config{libs}' -Provided your perl binary was properly configured and installed the +Provided your perl binary was properly configured and installed the B<ExtUtils::Embed> module will determine all of this information for you: @@ -145,14 +145,14 @@ this documentation came from your Perl distribution, then you're running 5.004 or better and you already have it.) The B<ExtUtils::Embed> kit on CPAN also contains all source code for -the examples in this document, tests, additional examples and other +the examples in this document, tests, additional examples and other information you may find useful. =head2 Adding a Perl interpreter to your C program In a sense, perl (the C program) is a good example of embedding Perl (the language), so I'll demonstrate embedding with I<miniperlmain.c>, -from the source distribution. Here's a bastardized, non-portable +from the source distribution. Here's a bastardized, nonportable version of I<miniperlmain.c> containing the essentials of embedding: #include <EXTERN.h> /* from the Perl distribution */ @@ -200,7 +200,7 @@ calling I<perl_run()>. =head2 Calling a Perl subroutine from your C program To call individual Perl subroutines, you can use any of the B<perl_call_*> -functions documented in the L<perlcall> man page. +functions documented in the L<perlcall> manpage. In this example we'll use I<perl_call_argv>. That's shown below, in a program I'll call I<showtime.c>. @@ -493,7 +493,7 @@ which produces the output (again, long lines have been wrapped here) match: with substitute: s/[aeiou]//gi...139 substitutions made. - Now text is: Whn h s t cnvnnc str nd th bll cms t sm mnt lk 76 cnts, + Now text is: Whn h s t cnvnnc str nd th bll cms t sm mnt lk 76 cnts, Mynrd s wr tht thr s smthng h *shld* d, smthng tht wll nbl hm t gt bck qrtr, bt h hs n d *wht*. H fmbls thrgh hs rd sqzy chngprs nd gvs th by thr xtr pnns wth hs dllr, hpng tht h mght lck nt th crrct mnt. Th by gvs @@ -519,7 +519,7 @@ described in L<perlcall>. Once you've understood those, embedding Perl in C is easy. -Because C has no built-in function for integer exponentiation, let's +Because C has no builtin function for integer exponentiation, let's make Perl's ** operator available to it (this is less useful than it sounds, because Perl implements ** with C's I<pow()> function). First I'll create a stub exponentiation function in I<power.pl>: @@ -592,7 +592,7 @@ When developing interactive and/or potentially long-running applications, it's a good idea to maintain a persistent interpreter rather than allocating and constructing a new interpreter multiple times. The major reason is speed: since Perl will only be loaded into -memory once. +memory once. However, you have to be more cautious with namespace and variable scoping when using a persistent interpreter. In previous examples @@ -627,47 +627,47 @@ itself after a certain number of requests, to ensure that memory consumption is minimized. You'll also want to scope your variables with L<perlfunc/my> whenever possible. - + package Embed::Persistent; #persistent.pl - + use strict; use vars '%Cache'; - + sub valid_package_name { my($string) = @_; $string =~ s/([^A-Za-z0-9\/])/sprintf("_%2x",unpack("C",$1))/eg; # second pass only for words starting with a digit $string =~ s|/(\d)|sprintf("/_%2x",unpack("C",$1))|eg; - + # Dress it up as a real package name $string =~ s|/|::|g; return "Embed" . $string; } - + #borrowed from Safe.pm sub delete_package { my $pkg = shift; my ($stem, $leaf); - + no strict 'refs'; $pkg = "main::$pkg\::"; # expand to full symbol table name ($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/; - + my $stem_symtab = *{$stem}{HASH}; - + delete $stem_symtab->{$leaf}; } - + sub eval_file { my($filename, $delete) = @_; my $package = valid_package_name($filename); my $mtime = -M $filename; if(defined $Cache{$package}{mtime} && - $Cache{$package}{mtime} <= $mtime) + $Cache{$package}{mtime} <= $mtime) { - # we have compiled this subroutine already, + # we have compiled this subroutine already, # it has not been updated on disk, nothing left to do print STDERR "already compiled $package->handler\n"; } @@ -677,7 +677,7 @@ with L<perlfunc/my> whenever possible. local($/) = undef; my $sub = <FH>; close FH; - + #wrap the code into a subroutine inside our unique package my $eval = qq{package $package; sub handler { $sub; }}; { @@ -686,35 +686,35 @@ with L<perlfunc/my> whenever possible. eval $eval; } die $@ if $@; - + #cache it unless we're cleaning out each time $Cache{$package}{mtime} = $mtime unless $delete; } - + eval {$package->handler;}; die $@ if $@; - + delete_package($package) if $delete; - + #take a look if you want #print Devel::Symdump->rnew($package)->as_string, $/; } - + 1; - + __END__ /* persistent.c */ - #include <EXTERN.h> - #include <perl.h> - + #include <EXTERN.h> + #include <perl.h> + /* 1 = clean out filename's symbol table after each request, 0 = don't */ #ifndef DO_CLEAN #define DO_CLEAN 0 #endif - + static PerlInterpreter *perl = NULL; - + int main(int argc, char **argv, char **env) { @@ -722,41 +722,40 @@ with L<perlfunc/my> whenever possible. char *args[] = { "", DO_CLEAN, NULL }; char filename [1024]; int exitstatus = 0; - + if((perl = perl_alloc()) == NULL) { fprintf(stderr, "no memory!"); exit(1); } - perl_construct(perl); - + perl_construct(perl); + exitstatus = perl_parse(perl, NULL, 2, embedding, NULL); - - if(!exitstatus) { + + if(!exitstatus) { exitstatus = perl_run(perl); - + while(printf("Enter file name: ") && gets(filename)) { - + /* call the subroutine, passing it the filename as an argument */ args[0] = filename; - perl_call_argv("Embed::Persistent::eval_file", + perl_call_argv("Embed::Persistent::eval_file", G_DISCARD | G_EVAL, args); - + /* check $@ */ - if(SvTRUE(GvSV(errgv))) + if(SvTRUE(GvSV(errgv))) fprintf(stderr, "eval error: %s\n", SvPV(GvSV(errgv),na)); } } - + perl_destruct_level = 0; - perl_destruct(perl); - perl_free(perl); + perl_destruct(perl); + perl_free(perl); exit(exitstatus); } - Now compile: - % cc -o persistent persistent.c `perl -MExtUtils::Embed -e ccopts -e ldopts` + % cc -o persistent persistent.c `perl -MExtUtils::Embed -e ccopts -e ldopts` Here's a example script file: @@ -782,7 +781,7 @@ Now run: Some rare applications will need to create more than one interpreter during a session. Such an application might sporadically decide to -release any resources associated with the interpreter. +release any resources associated with the interpreter. The program must take care to ensure that this takes place I<before> the next interpreter is constructed. By default, the global variable @@ -791,22 +790,22 @@ needed when a program has only one interpreter. Setting C<perl_destruct_level> to C<1> makes everything squeaky clean: - perl_destruct_level = 1; + perl_destruct_level = 1; while(1) { ... /* reset global variables here with perl_destruct_level = 1 */ - perl_construct(my_perl); + perl_construct(my_perl); ... /* clean and reset _everything_ during perl_destruct */ - perl_destruct(my_perl); - perl_free(my_perl); + perl_destruct(my_perl); + perl_free(my_perl); ... /* let's go do it again! */ } -When I<perl_destruct()> is called, the interpreter's syntax parse tree -and symbol tables are cleaned up, and global variables are reset. +When I<perl_destruct()> is called, the interpreter's syntax parse tree +and symbol tables are cleaned up, and global variables are reset. Now suppose we have more than one interpreter instance running at the same time. This is feasible, but only if you used the @@ -826,9 +825,9 @@ Let's give it a try: int main(int argc, char **argv, char **env) { - PerlInterpreter + PerlInterpreter *one_perl = perl_alloc(), - *two_perl = perl_alloc(); + *two_perl = perl_alloc(); char *one_args[] = { "one_perl", SAY_HELLO }; char *two_args[] = { "two_perl", SAY_HELLO }; diff --git a/pod/perlfaq.pod b/pod/perlfaq.pod index 8db316c24b..99aeae953d 100644 --- a/pod/perlfaq.pod +++ b/pod/perlfaq.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq - frequently asked questions about Perl ($Date: 1997/03/17 22:17:56 $) +perlfaq - frequently asked questions about Perl ($Date: 1997/03/25 18:20:48 $) =head1 DESCRIPTION @@ -91,7 +91,7 @@ Perl Porters. Copyright (c) 1997 Tom Christiansen and Nathan Torkington. All rights reserved. -=head2 Non-commercial Reproduction +=head2 Noncommercial Reproduction Permission is granted to distribute this document, in part or in full, via electronic means or printed copy providing that (1) that all credits @@ -124,6 +124,23 @@ in respect of this information or its use. =over 4 +=item 25/March/97 + +Added more info to the binary distribution section of L<perlfaq2>. +Added Net::Telnet to L<perlfaq6>. Fixed typos in L<perlfaq8>. Added +mail sending example to L<perlfaq9>. Added Merlyn's columns to +L<perlfaq2>. + +=item 18/March/97 + +Added the DATE to the NAME section, indicating which sections have +changed. + +Mentioned SIGPIPE and L<perlipc> in the forking open answer in +L<perlfaq8>. + +Fixed description of a regular expression in L<perlfaq4>. + =item 17/March/97 Version Various typos fixed throughout. diff --git a/pod/perlfaq1.pod b/pod/perlfaq1.pod index 2510a4b1f1..5d45c819c5 100644 --- a/pod/perlfaq1.pod +++ b/pod/perlfaq1.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq1 - General Questions About Perl ($Revision: 1.10 $) +perlfaq1 - General Questions About Perl ($Revision: 1.11 $, $Date: 1997/03/19 17:23:09 $) =head1 DESCRIPTION @@ -168,7 +168,7 @@ notice that perl is not itself written in Perl. The new native-code compiler for Perl may reduce the limitations given in the previous statement to some degree, but understand that Perl remains fundamentally a dynamically typed language, and not a -statically typed one. You certainly won't be chastized if you don't +statically typed one. You certainly won't be chastised if you don't trust nuclear-plant or brain-surgery monitoring code to it. And Larry will sleep easier, too -- Wall Street programs not withstanding. :-) @@ -193,7 +193,7 @@ programs, however, are usually neither strictly compiled nor strictly interpreted. They can be compiled to a bytecode form (something of a Perl virtual machine) or to completely different languages, like C or assembly language. You can't tell just by looking whether the source is destined -for a pure interpreter, a parse-tree interpreter, a byte-code interpreter, +for a pure interpreter, a parse-tree interpreter, a byte code interpreter, or a native-code compiler, so it's hard to give a definitive answer here. =head2 What is a JAPH? diff --git a/pod/perlfaq2.pod b/pod/perlfaq2.pod index b4c3e9f1dc..95d542d566 100644 --- a/pod/perlfaq2.pod +++ b/pod/perlfaq2.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.13 $) +perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.15 $, $Date: 1997/03/25 18:15:48 $) =head1 DESCRIPTION @@ -39,6 +39,21 @@ grab a binary version of gcc from the net and use that to compile perl with. CPAN only has binaries for systems that are terribly hard to get free compilers for, not for Unix systems. +Your first stop should be http://www.perl.com/CPAN/ports to see what +information is already available. A simple installation guide for +MS-DOS is available at http://www.cs.ruu.nl/~piet/perl5dos.html , and +similarly for Windows 3.1 at http://www.cs.ruu.nl/~piet/perlwin3.html +. + +=head2 I don't have a C compiler on my system. How can I compile perl? + +Since you don't have a C compiler, you're doomed and your vendor +should be sacrificed to the Sun gods. But that doesn't help you. + +What you need to do is get a binary version of gcc for your system +first. Consult the Usenet FAQs for your operating system for +information on where to get such a binary version. + =head2 I copied the Perl binary from one machine to another, but scripts don't work. That's probably because you forgot libraries, or library paths differ. @@ -47,7 +62,7 @@ eventually live on, and then type C<make install>. Most other approaches are doomed to failure. One simple way to check that things are in the right place is to print out -the hard-coded @INC which perl is looking for. +the hardcoded @INC which perl is looking for. perl -e 'print join("\n",@INC)' @@ -55,10 +70,13 @@ If this command lists any paths which don't exist on your system, then you may need to move the appropriate libraries to these locations, or create symlinks, aliases, or shortcuts appropriately. +You might also want to check out L<perlfaq8/"How do I keep my own +module/library directory?">. + =head2 I grabbed the sources and tried to compile but gdbm/dynamic loading/malloc/linking/... failed. How do I make it work? Read the F<INSTALL> file, which is part of the source distribution. -It describes in detail how to cope with most idiosyncracies that the +It describes in detail how to cope with most idiosyncrasies that the Configure script can't work around for any given system or architecture. @@ -66,7 +84,7 @@ architecture. CPAN stands for Comprehensive Perl Archive Network, a huge archive replicated on dozens of machines all over the world. CPAN contains -source code, non-native ports, documentation, scripts, and many +source code, nonnative ports, documentation, scripts, and many third-party modules and extensions, designed for everything from commercial database interfaces to keyboard/screen control to web walking and CGI scripts. The master machine for CPAN is @@ -173,7 +191,7 @@ before you buy! What follows is a list of the books that the FAQ authors found personally useful. Your mileage may (but, we hope, probably won't) vary. -If you're already a hard-core systems programmer, then the Camel Book +If you're already a hardcore systems programmer, then the Camel Book just might suffice for you to learn Perl from. But if you're not, check out the "Llama Book". It currently doesn't cover perl5, but the 2nd edition is nearly done and should be out by summer 97: @@ -222,15 +240,18 @@ It is published (on paper, not online) quarterly by Jon Orwant (orwant@tpj.com), editor. Subscription information is at http://tpj.com or via email to subscriptions@tpj.com. -Beyond this, two other magazines that frequently carry high-quality articles -on Perl are Web Techniques (see http://www.webtechniques.com/) and -Unix Review (http://www.unixreview.com/). +Beyond this, two other magazines that frequently carry high-quality +articles on Perl are Web Techniques (see +http://www.webtechniques.com/) and Unix Review +(http://www.unixreview.com/). Randal Schwartz's Web Technique's +columns are available on the web at +http://www.stonehenge.com/merlyn/WebTechniques/ . =head2 Perl on the Net: FTP and WWW Access To get the best (and possibly cheapest) performance, pick a site from the list below and use it to grab the complete list of mirror sites. ->From there you can find the quickest site for you. Remember, the +From there you can find the quickest site for you. Remember, the following list is I<not> the complete list of CPAN mirrors. http://www.perl.com/CPAN (redirects to another mirror) @@ -258,7 +279,7 @@ There is a mailing list for discussing Macintosh Perl. Contact "mac-perl-request@iis.ee.ethz.ch". Also see Matthias Neeracher's (the creator and maintainer of MacPerl) -webpage at http://www.iis.ee.ethz.ch/~neeri/macintosh/perl.html for +web page at http://www.iis.ee.ethz.ch/~neeri/macintosh/perl.html for many links to interesting MacPerl sites, and the applications/MPW tools, precompiled. @@ -384,19 +405,19 @@ If you are reporting a bug in the perl interpreter or the modules shipped with perl, use the perlbug program in the perl distribution or email your report to perlbug@perl.com. -If you are posting a bug with a non-standard port (see the answer to +If you are posting a bug with a nonstandard port (see the answer to "What platforms is Perl available for?"), a binary distribution, or a -non-standard module (such as Tk, CGI, etc), then please see the +nonstandard module (such as Tk, CGI, etc), then please see the documentation that came with it to determine the correct place to post bugs. -Read the perlbug man page (perl5.004 or later) for more information. +Read the perlbug manpage (perl5.004 or later) for more information. =head2 What is perl.com? perl.org? The Perl Institute? perl.org is the official vehicle for The Perl Institute. The motto of TPI is "helping people help Perl help people" (or something like -that). It's a non-profit organization supporting development, +that). It's a nonprofit organization supporting development, documentation, and dissemination of perl. Current directors of TPI include Larry Wall, Tom Christiansen, and Randal Schwartz, whom you may have heard of somewhere else around here. @@ -404,8 +425,8 @@ may have heard of somewhere else around here. The perl.com domain is Tom Christiansen's domain. He created it as a public service long before perl.org came about. It's the original PBS of the Perl world, a clearinghouse for information about all things -Perlian, accepting no paid advertisements, glossy gifs, or (gasp!) -java applets on its pages. +Perlian, accepting no paid advertisements, glossy GIFs, or (gasp!) +Java applets on its pages. =head2 How do I learn about object-oriented Perl programming? diff --git a/pod/perlfaq3.pod b/pod/perlfaq3.pod index 121743ddbf..af7e53b8fe 100644 --- a/pod/perlfaq3.pod +++ b/pod/perlfaq3.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq3 - Programming Tools ($Revision: 1.19 $) +perlfaq3 - Programming Tools ($Revision: 1.20 $, $Date: 1997/03/19 17:23:43 $) =head1 DESCRIPTION @@ -11,7 +11,7 @@ and programming support. Have you looked at CPAN (see L<perlfaq2>)? The chances are that someone has already written a module that can solve your problem. -Have you read the appropriate man pages? Here's a brief index: +Have you read the appropriate manpages? Here's a brief index: Objects perlref, perlmod, perlobj, perltie Data Structures perlref, perllol, perldsc @@ -22,12 +22,12 @@ Have you read the appropriate man pages? Here's a brief index: Various http://www.perl.com/CPAN/doc/FMTEYEWTK/index.html (not a man-page but still useful) -L<perltoc> provides a crude table of contents for the perl man page set. +L<perltoc> provides a crude table of contents for the perl manpage set. =head2 How can I use Perl interactively? The typical approach uses the Perl debugger, described in the -perldebug(1) man page, on an "empty" program, like this: +perldebug(1) manpage, on an "empty" program, like this: perl -de 42 @@ -200,7 +200,7 @@ structure. If you're working with specialist data structures less memory than equivalent Perl modules. Another thing to try is learning whether your Perl was compiled with -the system malloc or with Perl's built-in malloc. Whichever one it +the system malloc or with Perl's builtin malloc. Whichever one it is, try using the other one and see whether this makes a difference. Information about malloc is in the F<INSTALL> file in the source distribution. You can find out whether you are using perl's malloc by @@ -235,7 +235,7 @@ use in other parts of your program. (NB: my() variables also execute about 10% faster than globals.) A global variable, of course, never goes out of scope, so you can't get its space automatically reclaimed, although undef()ing and/or delete()ing it will achieve the same effect. -In general, memory allocation and de-allocation isn't something you can +In general, memory allocation and deallocation isn't something you can or should be worrying about much in Perl, but even this capability (preallocation of data types) is in the works. @@ -244,15 +244,15 @@ or should be worrying about much in Perl, but even this capability Beyond the normal measures described to make general Perl programs faster or smaller, a CGI program has additional issues. It may be run several times per second. Given that each time it runs it will need -to be re-compiled and will often allocate a megabyte or more of system +to be recompiled and will often allocate a megabyte or more of system memory, this can be a killer. Compiling into C B<isn't going to help -you> because the process start-up overhead is where the bottleneck is. +you> because the process startup overhead is where the bottleneck is. There are at least two popular ways to avoid this overhead. One solution involves running the Apache HTTP server (available from http://www.apache.org/) with either of the mod_perl or mod_fastcgi plugin modules. With mod_perl and the Apache::* modules (from CPAN), -httpd will run with an embedded Perl interpreter which pre-compiles +httpd will run with an embedded Perl interpreter which precompiles your script and then executes it within the same address space without forking. The Apache extension also gives Perl access to the internal server API, so modules written in Perl can do just about anything a @@ -286,8 +286,8 @@ instead of fixing them, is little security indeed. You can try using encryption via source filters (Filter::* from CPAN). But crackers might be able to decrypt it. You can try using the -byte-code compiler and interpreter described below, but crackers might -be able to de-compile it. You can try using the native-code compiler +byte code compiler and interpreter described below, but crackers might +be able to decompile it. You can try using the native-code compiler described below, but crackers might be able to disassemble it. These pose varying degrees of difficulty to people wanting to get at your code, but none can definitively conceal it (this is true of every @@ -301,12 +301,12 @@ Your access to it does not give you permission to use it blah blah blah." We are not lawyers, of course, so you should see a lawyer if you want to be sure your licence's wording will stand up in court. -=head2 How can I compile my Perl program into byte-code or C? +=head2 How can I compile my Perl program into byte code or C? Malcolm Beattie has written a multifunction backend compiler, available from CPAN, that can do both these things. It is as of Feb-1997 in late alpha release, which means it's fun to play with if -you're a programmer but not really for people looking for turn-key +you're a programmer but not really for people looking for turnkey solutions. I<Please> understand that merely compiling into C does not in and of @@ -334,14 +334,14 @@ you link your main perl binary with this, it will make it miniscule. For example, on one author's system, /usr/bin/perl is only 11k in size! -=head2 How can I get '#!perl' to work on [MSDOS,NT,...]? +=head2 How can I get '#!perl' to work on [MS-DOS,Windows NT,...]? For OS/2 just use extproc perl -S -your_switches as the first line in C<*.cmd> file (C<-S> due to a bug in cmd.exe's -`extproc' handling). For DOS one should first invent a corresponding +`extproc' handling). For MS-DOS one should first invent a corresponding batch file, and codify it in C<ALTERNATIVE_SHEBANG> (see the F<INSTALL> file in the source distribution for more information). @@ -385,7 +385,7 @@ Yes. Read L<perlrun> for more information. Some examples follow. Ok, the last one was actually an obfuscated perl entry. :-) -=head2 Why don't perl one-liners work on my DOS/Mac/VMS system? +=head2 Why don't perl one-liners work on my MS-DOS/Macintosh/VMS system? The problem is usually that the command interpreters on those systems have rather different ideas about quoting than the Unix shells under @@ -398,10 +398,10 @@ For example: # Unix perl -e 'print "Hello world\n"' - # DOS, etc. + # MS-DOS, etc. perl -e "print \"Hello world\n\"" - # Mac + # Macintosh print "Hello world\n" (then Run "Myscript" or Shift-Command-R) @@ -409,15 +409,15 @@ For example: perl -e "print ""Hello world\n""" The problem is that none of this is reliable: it depends on the command -interpreter. Under Unix, the first two often work. Under DOS, it's +interpreter. Under Unix, the first two often work. Under MS-DOS, it's entirely possible neither works. If 4DOS was the command shell, I'd probably have better luck like this: perl -e "print <Ctrl-x>"Hello world\n<Ctrl-x>"" -Under the Mac, it depends which environment you are using. The MacPerl +Under the Macintosh, it depends which environment you are using. The MacPerl shell, or MPW, is much like Unix shells in its support for several -quoting variants, except that it makes free use of the Mac's non-ASCII +quoting variants, except that it makes free use of the Macintosh's non-ASCII characters as control characters. I'm afraid that there is no general solution to all of this. It is a @@ -470,7 +470,7 @@ my C program, what am I doing wrong? Download the ExtUtils::Embed kit from CPAN and run `make test'. If the tests pass, read the pods again and again and again. If they -fail, see L<perlbug> and send a bugreport with the output of +fail, see L<perlbug> and send a bug report with the output of C<make test TEST_VERBOSE=1> along with C<perl -V>. =head2 When I tried to run my script, I got this message. What does it diff --git a/pod/perlfaq4.pod b/pod/perlfaq4.pod index 1c1edfa467..d3a7e8ccb9 100644 --- a/pod/perlfaq4.pod +++ b/pod/perlfaq4.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq4 - Data Manipulation ($Revision: 1.15 $) +perlfaq4 - Data Manipulation ($Revision: 1.17 $, $Date: 1997/03/25 18:16:24 $) =head1 DESCRIPTION @@ -254,7 +254,7 @@ Although those with a regexp kind of thought process will likely prefer You have to keep track. For example, let's say you want to change the fifth occurrence of "whoever" or "whomever" -into "whosoever", case insensitively. +into "whosoever" or "whomsoever", case insensitively. $count = 0; s{((whom?)ever)}{ @@ -271,7 +271,7 @@ C<tr///> function like so: $string = "ThisXlineXhasXsomeXx'sXinXit": $count = ($string =~ tr/X//); - print "There are $count X charcters in the string"; + print "There are $count X characters in the string"; This is fine if you are just looking for a single character. However, if you are trying to count multiple character substrings within a @@ -286,12 +286,15 @@ integers: =head2 How do I capitalize all the words on one line? To make the first letter of each word upper case: + $line =~ s/\b(\w)/\U$1/g; To make the whole line upper case: + $line = uc($line); To force each word to be lower case, with the first letter upper case: + $line =~ s/(\w+)/\u\L$1/g; =head2 How can I split a [character] delimited string except when inside @@ -770,7 +773,7 @@ find one of the associated keys. This may or may not worry you. If you mean how many keys, then all you have to do is take the scalar sense of the keys() function: - $num_keys = scalar keys %hash; + $num_keys = scalar keys %hash; In void context it just resets the iterator, which is faster for tied hashes. @@ -897,7 +900,7 @@ they end up doing is not what they do with ordinary hashes. Using C<keys %hash> in a scalar context returns the number of keys in the hash I<and> resets the iterator associated with the hash. You may need to do this if you use C<last> to exit a loop early so that when you -re-enter it, the hash iterator has been reset. +reenter it, the hash iterator has been reset. =head2 How can I get the unique keys from two hashes? @@ -952,7 +955,7 @@ Normally, merely accessing a key's value for a nonexistent key does I<not> cause that key to be forever there. This is different than awk's behavior. -=head2 How can I make the Perl equivalent of a C structure/C++ class/hash +=head2 How can I make the Perl equivalent of a C structure/C++ class/hash or array of hashes or arrays? Use references (documented in L<perlref>). Examples of complex data @@ -980,7 +983,7 @@ versus "binary" files. See L<perlfunc/"binmode">. If you're concerned about 8-bit ASCII data, then see L<perllocale>. -If you want to deal with multi-byte characters, however, there are +If you want to deal with multibyte characters, however, there are some gotchas. See the section on Regular Expressions. =head2 How do I determine whether a scalar is a number/whole/integer/float? @@ -991,7 +994,7 @@ Assuming that you don't care about IEEE notations like "NaN" or warn "has nondigits" if /\D/; warn "not a whole number" unless /^\d+$/; warn "not an integer" unless /^-?\d+$/; # reject +3 - warn "not an integer" unless /^[+-]?\d+$/; + warn "not an integer" unless /^[+-]?\d+$/; warn "not a decimal number" unless /^-?\d+\.?\d*$/; # rejects .2 warn "not a decimal number" unless /^-?(?:\d+(?:\.\d*)?|\.\d+)$/; warn "not a C float" diff --git a/pod/perlfaq5.pod b/pod/perlfaq5.pod index c36576ff7f..47c6dead22 100644 --- a/pod/perlfaq5.pod +++ b/pod/perlfaq5.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq5 - Files and Formats ($Revision: 1.19 $) +perlfaq5 - Files and Formats ($Revision: 1.20 $, $Date: 1997/03/19 17:24:51 $) =head1 DESCRIPTION @@ -106,7 +106,7 @@ the changes you want, then copy that over the original. rename($new, $old) or die "can't rename $new to $old: $!"; Perl can do this sort of thing for you automatically with the C<-i> -command-line switch or the closely-related C<$^I> variable (see +command line switch or the closely-related C<$^I> variable (see L<perlrun> for more details). Note that C<-i> may require a suffix on some non-Unix systems; see the platform-specific documentation that came with your port. @@ -138,7 +138,7 @@ the last line of a file without making a copy or reading the whole file into memory: open (FH, "+< $file"); - while ( <FH> ) { $addr = tell(FH) unless eof(FH) } + while ( <FH> ) { $addr = tell(FH) unless eof(FH) } truncate(FH, $addr); Error checking is left as an exercise for the reader. @@ -233,7 +233,7 @@ one of its more specific derived classes. =head2 How can I set up a footer format to be used with write()? -There's no built-in way to do this, but L<perlform> has a couple of +There's no builtin way to do this, but L<perlform> has a couple of techniques to make it possible for the intrepid hacker. =head2 How can I write() into a string? @@ -358,7 +358,7 @@ permissions, timestamps, inode info, etc. =head2 How can I lock a file? -Perl's built-in flock() function (see L<perlfunc> for details) will call +Perl's builtin flock() function (see L<perlfunc> for details) will call flock(2) if that exists, fcntl(2) if it doesn't (on perl version 5.004 and later), and lockf(3) if neither of the two previous system calls exists. On some systems, it may even use a different form of native locking. @@ -409,10 +409,10 @@ over NFS, so this won't work (at least, not every time) over the net. Various schemes involving involving link() have been suggested, but these tend to involve busy-wait, which is also subdesirable. -=head2 I still don't get locking. I just want to increment the number +=head2 I still don't get locking. I just want to increment the number in the file. How can I do this? -Didn't anyone ever tell you web-page hit counters were useless? +Didn't anyone ever tell you web page hit counters were useless? Anyway, this is what to do: @@ -426,7 +426,7 @@ Anyway, this is what to do: # DO NOT UNLOCK THIS UNTIL YOU CLOSE close FH or die "can't close numfile: $!"; -Here's a much better web-page hit counter: +Here's a much better web page hit counter: $hits = int( (time() - 850_000_000) / rand(1_000) ); @@ -455,14 +455,14 @@ like this: Locking and error checking are left as an exercise for the reader. Don't forget them, or you'll be quite sorry. -Don't forget to set binmode() under DOS-like platforms when operating +Don't forget to set binmode() under MS-DOS-like platforms when operating on files that have anything other than straight text in them. See the docs on open() and on binmode() for more details. =head2 How do I get a file's timestamp in perl? If you want to retrieve the time at which the file was last read, -written, or had its meta-data (owner, etc) changed, you use the B<-M>, +written, or had its metadata (owner, etc) changed, you use the B<-M>, B<-A>, or B<-C> filetest operations as documented in L<perlfunc>. These retrieve the age of the file (measured against the start-time of your program) in days as a floating point number. To retrieve the "raw" @@ -602,7 +602,7 @@ The Term::ReadKey module from CPAN may be easier to use: printf "\nYou said %s, char number %03d\n", $key, ord $key; -For DOS systems, Dan Carson <dbc@tc.fluke.COM> reports the following: +For MS-DOS systems, Dan Carson <dbc@tc.fluke.COM> reports the following: To put the PC in "raw" mode, use ioctl with some magic numbers gleaned from msdos.c (Perl source file) and Ralf Brown's interrupt list (comes @@ -737,17 +737,17 @@ to, you may be able to do this: $rc = syscall(&SYS_close, $fd + 0); # must force numeric die "can't sysclose $fd: $!" unless $rc == -1; -=head2 Why can't I use "C:\temp\foo" in DOS paths? What doesn't `C:\temp\foo.exe` work? +=head2 Why can't I use "C:\temp\foo" in MS-DOS paths? What doesn't `C:\temp\foo.exe` work? Whoops! You just put a tab and a formfeed into that filename! Remember that within double quoted strings ("like\this"), the backslash is an escape character. The full list of these is in L<perlop/Quote and Quote-like Operators>. Unsurprisingly, you don't have a file called "c:(tab)emp(formfeed)oo" or -"c:(tab)emp(formfeed)oo.exe" on your DOS filesystem. +"c:(tab)emp(formfeed)oo.exe" on your MS-DOS filesystem. Either single-quote your strings, or (preferably) use forward slashes. -Since all DOS and Windows versions since something like MS-DOS 2.0 or so +Since all MS-DOS and Windows versions since something like MS-DOS 2.0 or so have treated C</> and C<\> the same in a path, you might as well use the one that doesn't clash with Perl -- or the POSIX shell, ANSI C and C++, awk, Tcl, Java, or Python, just to mention a few. @@ -755,7 +755,7 @@ awk, Tcl, Java, or Python, just to mention a few. =head2 Why doesn't glob("*.*") get all the files? Because even on non-Unix ports, Perl's glob function follows standard -Unix globbing semantics. You'll need C<glob("*")> to get all (non-hidden) +Unix globbing semantics. You'll need C<glob("*")> to get all (nonhidden) files. =head2 Why does Perl let me delete read-only files? Why does C<-i> clobber protected files? Isn't this a bug in Perl? diff --git a/pod/perlfaq6.pod b/pod/perlfaq6.pod index 589d89e495..1cec15c669 100644 --- a/pod/perlfaq6.pod +++ b/pod/perlfaq6.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq6 - Regexps ($Revision: 1.14 $) +perlfaq6 - Regexps ($Revision: 1.16 $, $Date: 1997/03/25 18:16:56 $) =head1 DESCRIPTION @@ -11,7 +11,7 @@ with regular expressions, but those answers are found elsewhere in this document (in the section on Data and the Networking one on networking, to be precise). -=head2 How can I hope to use regular expressions without creating illegible and unmaintainable code? +=head2 How can I hope to use regular expressions without creating illegible and unmaintainable code? Three techniques can make regular expressions maintainable and understandable. @@ -96,8 +96,8 @@ record read in. while ( <> ) { while ( /\b(\w\S+)(\s+\1)+\b/gi ) { print "Duplicate $1 at paragraph $.\n"; - } - } + } + } Here's code that finds sentences that begin with "From " (which would be mangled by many mailers): @@ -138,11 +138,31 @@ on matching balanced text. $/ must be a string, not a regular expression. Awk has to be better for something. :-) -Actually, you could do this if you don't mind reading the whole file into +Actually, you could do this if you don't mind reading the whole file into undef $/; @records = split /your_pattern/, <FH>; +The Net::Telnet module (available from CPAN) has the capability to +wait for a pattern in the input stream, or timeout if it doesn't +appear within a certain time. + + ## Create a file with three lines. + open FH, ">file"; + print FH "The first line\nThe second line\nThe third line\n"; + close FH; + + ## Get a read/write filehandle to it. + $fh = new FileHandle "+<file"; + + ## Attach it to a "stream" object. + use Net::Telnet; + $file = new Net::Telnet (-fhopen => $fh); + + ## Search for the second line and print out the third. + $file->waitfor('/second line\n/'); + print $file->getline; + =head2 How do I substitute case insensitively on the LHS, but preserving case on the RHS? It depends on what you mean by "preserving case". The following @@ -197,10 +217,10 @@ See L<perllocale>. =head2 How can I match a locale-smart version of C</[a-zA-Z]/>? One alphabetic character would be C</[^\W\d_]/>, no matter what locale -you're in. Non-alphabetics would be C</[\W\d_]/> (assuming you don't +you're in. Non-alphabetics would be C</[\W\d_]/> (assuming you don't consider an underscore a letter). -=head2 How can I quote a variable to use in a regexp? +=head2 How can I quote a variable to use in a regexp? The Perl parser will expand $variable and @variable references in regular expressions unless the delimiter is a single quote. Remember, @@ -220,7 +240,7 @@ Without the \Q, the regexp would also spuriously match "di". =head2 What is C</o> really for? -Using a variable in a regular expression match forces a re-evaluation +Using a variable in a regular expression match forces a reevaluation (and perhaps recompilation) each time through. The C</o> modifier locks in the regexp the first time it's used. This always happens in a constant regular expression, and in fact, the pattern was compiled @@ -305,13 +325,13 @@ playing hot potato. Use the split function: while (<>) { - foreach $word ( split ) { + foreach $word ( split ) { # do something with $word here - } - } + } + } -Note that this isn't really a word in the English sense; it's just -chunks of consecutive non-whitespace characters. +Note that this isn't really a word in the English sense; it's just +chunks of consecutive non-whitespace characters. To work with only alphanumeric sequences, you might consider @@ -324,25 +344,25 @@ To work with only alphanumeric sequences, you might consider =head2 How can I print out a word-frequency or line-frequency summary? To do this, you have to parse out each word in the input stream. We'll -pretend that by word you mean chunk of alphabetics, hyphens, or -apostrophes, rather than the non-whitespace chunk idea of a word given +pretend that by word you mean chunk of alphabetics, hyphens, or +apostrophes, rather than the non-whitespace chunk idea of a word given in the previous question: while (<>) { while ( /(\b[^\W_\d][\w'-]+\b)/g ) { # misses "`sheep'" $seen{$1}++; - } - } + } + } while ( ($word, $count) = each %seen ) { print "$count $word\n"; - } + } If you wanted to do the same thing for lines, you wouldn't need a regular expression: - while (<>) { + while (<>) { $seen{$_}++; - } + } while ( ($line, $count) = each %seen ) { print "$count $line"; } @@ -475,7 +495,7 @@ Of course, that could have been written as while (<>) { chomp; PARSER: { - if ( /\G( \d+\b )/gx { + if ( /\G( \d+\b )/gx { print "number: $1\n"; redo PARSER; } @@ -500,7 +520,7 @@ But then you lose the vertical alignment of the regular expressions. While it's true that Perl's regular expressions resemble the DFAs (deterministic finite automata) of the egrep(1) program, they are in -fact implemented as NFAs (non-deterministic finite automata) to allow +fact implemented as NFAs (nondeterministic finite automata) to allow backtracking and backreferencing. And they aren't POSIX-style either, because those guarantee worst-case behavior for all cases. (It seems that some people prefer guarantees of consistency, even when what's @@ -518,7 +538,7 @@ side-effects, and side-effects can be mystifying. There's no void grep() that's not better written as a C<for> (well, C<foreach>, technically) loop. -=head2 How can I match strings with multi-byte characters? +=head2 How can I match strings with multibyte characters? This is hard, and there's no good way. Perl does not directly support wide characters. It pretends that a byte and a character are @@ -542,7 +562,7 @@ This is a big problem. Here are a few ways, all painful, to deal with it: - $martian =~ s/([A-Z][A-Z])/ $1 /g; # Make sure adjacent ``maritan'' bytes + $martian =~ s/([A-Z][A-Z])/ $1 /g; # Make sure adjacent ``martian'' bytes # are no longer adjacent. print "found GX!\n" if $martian =~ /GX/; @@ -558,7 +578,7 @@ Or like this: Or like this: while ($martian =~ m/\G([A-Z][A-Z]|.)/gs) { # \G probably unneeded - print "found GX!\n", last if $1 eq 'GX'; + print "found GX!\n", last if $1 eq 'GX'; } Or like this: @@ -566,11 +586,11 @@ Or like this: die "sorry, Perl doesn't (yet) have Martian support )-:\n"; In addition, a sample program which converts half-width to full-width -katakana (in Shift-JIS or EUC encoding) is available from CPAN as +katakana (in Shift-JIS or EUC encoding) is available from CPAN as =for Tom make it so -There are many double- (and multi-) byte encodings commonly used these +There are many double (and multi) byte encodings commonly used these days. Some versions of these have 1-, 2-, 3-, and 4-byte characters, all mixed. diff --git a/pod/perlfaq7.pod b/pod/perlfaq7.pod index 14bfc678fc..c272c91e31 100644 --- a/pod/perlfaq7.pod +++ b/pod/perlfaq7.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq7 - Perl Language Issues ($Revision: 1.15 $) +perlfaq7 - Perl Language Issues ($Revision: 1.16 $, $Date: 1997/03/19 17:25:23 $) =head1 DESCRIPTION @@ -169,7 +169,7 @@ own module. Make sure to change the names appropriately. # if using RCS/CVS, this next line may be preferred, # but beware two-digit versions. - $VERSION = do{my@r=q$Revision: 1.15 $=~/\d+/g;sprintf '%d.'.'%02d'x$#r,@r}; + $VERSION = do{my@r=q$Revision: 1.16 $=~/\d+/g;sprintf '%d.'.'%02d'x$#r,@r}; @ISA = qw(Exporter); @EXPORT = qw(&func1 &func2 &func3); @@ -532,7 +532,7 @@ issue is the same here: my($foo) = <FILE>; # WRONG my $foo = <FILE>; # right -=head2 How do I redefine a built-in function, operator, or method? +=head2 How do I redefine a builtin function, operator, or method? Why do you want to do that? :-) @@ -576,7 +576,7 @@ how best to do this, so he left it out, even though it's been on the wish list since perl1. Here's a simple example of a switch based on pattern matching. We'll -do a multi-way conditional based on the type of reference stored in +do a multiway conditional based on the type of reference stored in $whatchamacallit: SWITCH: diff --git a/pod/perlfaq8.pod b/pod/perlfaq8.pod index 6ad5c15750..fba9a249aa 100644 --- a/pod/perlfaq8.pod +++ b/pod/perlfaq8.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq8 - System Interaction ($Revision: 1.15 $) +perlfaq8 - System Interaction ($Revision: 1.17 $, $Date: 1997/03/25 18:17:12 $) =head1 DESCRIPTION @@ -10,7 +10,7 @@ control over the user-interface (keyboard, screen and pointing devices), and most anything else not related to data manipulation. Read the FAQs and documentation specific to the port of perl to your -operating system (eg, L<perlvms>, L<perlplan9>, ...). These should +operating system (eg, L<perlvms>, F<REAMDE.os2>, ...). These should contain more detailed information on the vagaries of your perl. =head2 How do I find out which operating system I'm running under? @@ -104,7 +104,7 @@ give the numeric values you want directly, using octal ("\015"), hex Even though with normal text files, a "\n" will do the trick, there is still no unified scheme for terminating a line that is portable -between Unix, DOS/Win, and Macintosh, except to terminate I<ALL> line +between Unix, MS-DOS/Windows, and Macintosh, except to terminate I<ALL> line ends with "\015\012", and strip what you don't need from the output. This applies especially to socket I/O and autoflushing, discussed next. @@ -208,7 +208,7 @@ You don't actually "trap" a control character. Instead, that character generates a signal, which you then trap. Signals are documented in L<perlipc/"Signals"> and chapter 6 of the Camel. -Be warned that very few C libraries are re-entrant. Therefore, if you +Be warned that very few C libraries are reentrant. Therefore, if you attempt to print() in a handler that got invoked during another stdio operation your internal structures will likely be in an inconsistent state, and your program will dump core. You can @@ -230,7 +230,7 @@ For example: However, because syscalls restart by default, you'll find that if you're in a "slow" call, such as E<lt>FHE<gt>, read(), connect(), or wait(), that the only way to terminate them is by "longjumping" out; -that is, by raising an exception. See the time-out handler for a +that is, by raising an exception. See the timeout handler for a blocking flock() in L<perlipc/"Signals"> or chapter 6 of the Camel. =head2 How do I modify the shadow password file on a Unix system? @@ -267,7 +267,7 @@ http://www.perl.com/CPAN/doc/misc/ancient/tutorial/eg/itimers.pl . =head2 How can I measure time under a second? In general, you may not be able to. The Time::HiRes module (available -from CPAN) provides this functionality for some systems. +from CPAN) provides this functionality for some systems. In general, you may not be able to. But if you system supports both the syscall() function in Perl as well as a system call like gettimeofday(2), @@ -311,7 +311,7 @@ END blocks you should also use Perl's exception-handling mechanism is its eval() operator. You can use eval() as setjmp and die() as longjmp. For details of this, see -the section on signals, especially the time-out handler for a blocking +the section on signals, especially the timeout handler for a blocking flock() in L<perlipc/"Signals"> and chapter 6 of the Camel. If exception handling is all you're interested in, try the @@ -352,7 +352,7 @@ Simple files like F<errno.h>, F<syscall.h>, and F<socket.h> were fine, but the hard ones like F<ioctl.h> nearly always need to hand-edited. Here's how to install the *.ph files: - 1. become super-user + 1. become superuser 2. cd /usr/include 3. h2ph *.h */*.h @@ -379,6 +379,17 @@ easy-to-use approach that internally uses pipe(), fork(), and exec() to do the job. Make sure you read the deadlock warnings in its documentation, though (see L<IPC::Open2>). +=head2 Why can't I get the output of a command with system()? + +You're confusing the purpose of system() and backticks (''). system() +runs a command and returns exit status information (as a 16 bit value +-- the low 8 bits are the signal the process died from, if any, and +the high 8 bits are the actual exit value). Backticks ('') run a +command and return what it sent to STDOUT. + + $status = system("mail-users"); + $output = `ls`; + =head2 How can I capture STDERR from an external command? There are three basic ways of running external commands: @@ -437,7 +448,9 @@ process ID of the child. The child exec()s the command to be piped to/from. The parent can't know whether the exec() was successful or not - all it can return is whether the fork() succeeded or not. To find out if the command succeeded, you have to catch SIGCHLD and -wait() to get the exit status. +wait() to get the exit status. You should also catch SIGPIPE if +you're writing to the child -- you may not have found out the exec() +failed by the time you write. This is documented in L<perlipc>. On systems that follow the spawn() paradigm, open() I<might> do what you expect - unless perl uses a shell to start your command. In this @@ -500,7 +513,7 @@ You have to do this: Just as with system(), no shell escapes happen when you exec() a list. -=head2 Why can't my script read from STDIN after I gave it EOF (^D on Unix, ^Z on MSDOS)? +=head2 Why can't my script read from STDIN after I gave it EOF (^D on Unix, ^Z on MS-DOS)? Because some stdio's set error and eof flags that need clearing. The POSIX module defines clearerr() that you can use. That is the @@ -539,7 +552,7 @@ Things that are awkward to do in the shell are easy to do in Perl, and this very awkwardness is what would make a shell->perl converter nigh-on impossible to write. By rewriting it, you'll think about what you're really trying to do, and hopefully will escape the shell's -pipeline datastream paradigm, which while convenient for some matters, +pipeline data stream paradigm, which while convenient for some matters, causes many inefficiencies. =head2 Can I use perl to run a telnet or ftp session? diff --git a/pod/perlfaq9.pod b/pod/perlfaq9.pod index e62dac4bd3..9e6355f816 100644 --- a/pod/perlfaq9.pod +++ b/pod/perlfaq9.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq9 - Networking ($Revision: 1.13 $) +perlfaq9 - Networking ($Revision: 1.15 $, $Date: 1997/03/25 18:17:20 $) =head1 DESCRIPTION @@ -51,7 +51,7 @@ http://www.perl.com/CPAN/authors/Tom_Christiansen/scripts/striphtml.gz =head2 How do I extract URLs? -A quick but imperfect approach is +A quick but imperfect approach is #!/usr/bin/perl -n00 # qxurl - tchrist@perl.com @@ -127,7 +127,7 @@ server, or perhaps check some of the other FAQs referenced above. The HTTPD::UserAdmin and HTTPD::GroupAdmin modules provide a consistent OO interface to these files, regardless of how they're -stored. Databases may be text, dbm, Berkley DB or any database with a +stored. Databases may be text, dbm, Berkeley DB or any database with a DBI compatible driver. HTTPD::UserAdmin supports files used by the `Basic' and `Digest' authentication schemes. Here's an example: @@ -224,11 +224,28 @@ Again, the best way is often just to ask the user. =head2 How do I send/read mail? Sending mail: the Mail::Mailer module from CPAN (part of the MailTools -package) is UNIX-centric, while Mail::Internet uses Net::SMTP which is -not UNIX-centric. Reading mail: use the Mail::Folder module from CPAN +package) is Unix-centric, while Mail::Internet uses Net::SMTP which is +not Unix-centric. Reading mail: use the Mail::Folder module from CPAN (part of the MailFolder package) or the Mail::Internet module from CPAN (also part of the MailTools package). + # sending mail + use Mail::Internet; + use Mail::Header; + # say which mail host to use + $ENV{SMTPHOSTS} = 'mail.frii.com'; + # create headers + $header = new Mail::Header; + $header->add('From', 'gnat@frii.com'); + $header->add('Subject', 'Testing'); + $header->add('To', 'gnat@frii.com'); + # create body + $body = 'This is a test, ignore'; + # create mail object + $mail = new Mail::Internet(undef, Header => $header, Body => \[$body]); + # send it + $mail->smtpsend or die; + =head2 How do I find out my hostname/domainname/IP address? A lot of code has historically cavalierly called the C<`hostname`> diff --git a/pod/perlform.pod b/pod/perlform.pod index 4e55e02800..7e540b8ff6 100644 --- a/pod/perlform.pod +++ b/pod/perlform.pod @@ -5,20 +5,20 @@ perlform - Perl formats =head1 DESCRIPTION Perl has a mechanism to help you generate simple reports and charts. To -facilitate this, Perl helps you code up your output page -close to how it will look when it's printed. It can keep -track of things like how many lines on a page, what page you're on, when to -print page headers, etc. Keywords are borrowed from FORTRAN: -format() to declare and write() to execute; see their entries in -L<perlfunc>. Fortunately, the layout is much more legible, more like -BASIC's PRINT USING statement. Think of it as a poor man's nroff(1). - -Formats, like packages and subroutines, are declared rather than executed, -so they may occur at any point in your program. (Usually it's best to -keep them all together though.) They have their own namespace apart from -all the other "types" in Perl. This means that if you have a function -named "Foo", it is not the same thing as having a format named "Foo". -However, the default name for the format associated with a given +facilitate this, Perl helps you code up your output page close to how it +will look when it's printed. It can keep track of things like how many +lines are on a page, what page you're on, when to print page headers, +etc. Keywords are borrowed from FORTRAN: format() to declare and write() +to execute; see their entries in L<perlfunc>. Fortunately, the layout is +much more legible, more like BASIC's PRINT USING statement. Think of it +as a poor man's nroff(1). + +Formats, like packages and subroutines, are declared rather than +executed, so they may occur at any point in your program. (Usually it's +best to keep them all together though.) They have their own namespace +apart from all the other "types" in Perl. This means that if you have a +function named "Foo", it is not the same thing as having a format named +"Foo". However, the default name for the format associated with a given filehandle is the same as the name of the filehandle. Thus, the default format for STDOUT is name "STDOUT", and the default format for filehandle TEMP is name "TEMP". They just look the same. They aren't. @@ -30,7 +30,7 @@ Output record formats are declared as follows: . If name is omitted, format "STDOUT" is defined. FORMLIST consists of -a sequence of lines, each of which may be of one of three types: +a sequence of lines, each of which may be one of three types: =over 4 @@ -64,7 +64,7 @@ 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. +nontruncated values; it should appear by itself on a line. The values are specified on the following line in the same order as the picture fields. The expressions providing the values should be @@ -105,7 +105,7 @@ first, the line will be repeated until all the fields on the line are exhausted. (If you use a field of the at variety, the expression you supply had better not give the same value every time forever!) -Top-of-form processing is by default handled by a format with the +Top-of-form processing is by default handled by a format with the same name as the current filehandle with "_TOP" concatenated to it. It's triggered at the top of each page. See L<perlfunc/write>. @@ -169,7 +169,7 @@ the first) is stored in C<$^L> (C<$FORMAT_FORMFEED>). These variables are set on a per-filehandle basis, so you'll need to select() into a different one to affect them: - select((select(OUTF), + select((select(OUTF), $~ = "My_Other_Format", $^ = "My_Top_Format" )[0]); @@ -205,25 +205,25 @@ Much better! =head1 NOTES -Because the values line may contain arbitrary expressions (for at fields, +Because the values line may contain arbitrary expressions (for at fields, not caret fields), you can farm out more sophisticated processing to other functions, like sprintf() or one of your own. For example: - format Ident = + format Ident = @<<<<<<<<<<<<<<< &commify($n) . To get a real at or caret into the field, do this: - format Ident = + format Ident = I have an @ here. "@" . To center a whole line of text, do something like this: - format Ident = + format Ident = @||||||||||||||||||||||||||||||||||||||||||||||| "Some text line" . @@ -240,12 +240,12 @@ on the current number of columns, and then eval() it: . '$entry' . "\n"; . ".\n"; print $format if $Debugging; - eval $format; + eval $format; die $@ if $@; Which would generate a format looking something like this: - format STDOUT = + format STDOUT = ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< $entry ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~ @@ -254,7 +254,7 @@ Which would generate a format looking something like this: Here's a little program that's somewhat like fmt(1): - format = + format = ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~ $_ @@ -264,7 +264,7 @@ Here's a little program that's somewhat like fmt(1): while (<>) { s/\s*\n\s*/ /g; write; - } + } =head2 Footers @@ -277,10 +277,10 @@ Here's one strategy: If you have a fixed-size footer, you can get footers by checking $FORMAT_LINES_LEFT before each write() and print the footer yourself if necessary. -Here's another strategy; open a pipe to yourself, using C<open(MESELF, "|-")> -(see L<perlfunc/open()>) and always write() to MESELF instead of -STDOUT. Have your child process massage its STDIN to rearrange -headers and footers however you like. Not very convenient, but doable. +Here's another strategy: Open a pipe to yourself, using C<open(MYSELF, "|-")> +(see L<perlfunc/open()>) and always write() to MYSELF instead of STDOUT. +Have your child process massage its STDIN to rearrange headers and footers +however you like. Not very convenient, but doable. =head2 Accessing Formatting Internals @@ -305,7 +305,7 @@ is to printf(), do this: $^A = ""; formline($format,@_); return $^A; - } + } $string = swrite(<<'END', 1, 2, 3); Check me out diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index c4de4a39ae..84a794adb2 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -48,7 +48,7 @@ example, the third line above produces: Useless use of integer addition in void context at - line 1. For functions that can be used in either a scalar or list context, -non-abortive failure is generally indicated in a scalar context by +nonabortive failure is generally indicated in a scalar context by returning the undefined value, and in a list context by returning the null list. @@ -126,7 +126,7 @@ stat, symlink, umask, unlink, utime caller, continue, die, do, dump, eval, exit, goto, last, next, redo, return, sub, wantarray -=item Keywords related to scoping +=item Keywords related to scoping caller, import, local, my, package, use @@ -225,7 +225,7 @@ operator may be any of: -e File exists. -z File has zero size. - -s File has non-zero size (returns size). + -s File has nonzero size (returns size). -f File is a plain file. -d File is a directory. @@ -275,7 +275,7 @@ are found, it's a C<-B> file, otherwise it's a C<-T> file. Also, any file containing null in the first block is considered a binary file. If C<-T> or C<-B> is used on a filehandle, the current stdio buffer is examined rather than the first block. Both C<-T> and C<-B> return TRUE on a null -file, or a file at EOF when testing a filehandle. Because you have to +file, or a file at EOF when testing a filehandle. Because you have to read a file to do the C<-T> test, on most occasions you want to use a C<-f> against the file first, as in C<next unless -f $file && -T $file>. @@ -300,7 +300,7 @@ symbolic link, not the real file.) Example: =item abs VALUE -=item abs +=item abs Returns the absolute value of its argument. If VALUE is omitted, uses $_. @@ -313,7 +313,7 @@ See example in L<perlipc/"Sockets: Client/Server Communication">. =item alarm SECONDS -=item alarm +=item alarm Arranges to have a SIGALRM delivered to this process after the specified number of seconds have elapsed. If SECONDS is not specified, @@ -326,8 +326,8 @@ starting a new one. The returned value is the amount of time remaining on the previous timer. For delays of finer granularity than one second, you may use Perl's -syscall() interface to access setitimer(2) if your system supports it, -or else see L</select()> below. It is not advised to intermix alarm() +syscall() interface to access setitimer(2) if your system supports it, +or else see L</select()>. It is usually a mistake to intermix alarm() and sleep() calls. If you want to use alarm() to time out a system call you need to use an @@ -370,9 +370,9 @@ L<perlipc/"Sockets: Client/Server Communication">. Arranges for the file to be read or written in "binary" mode in operating systems that distinguish between binary and text files. Files that are not in binary mode have CR LF sequences translated to LF on input and LF -translated to CR LF on output. Binmode has no effect under Unix; in DOS +translated to CR LF on output. Binmode has no effect under Unix; in MS-DOS and similarly archaic systems, it may be imperative--otherwise your -DOS-damaged C library may mangle your file. The key distinction between +MS-DOS-damaged C library may mangle your file. The key distinction between systems that need binmode and those that don't is their text file formats. Systems like Unix and Plan9 that delimit lines with a single character, and that encode that character in C as '\n', do not need @@ -406,21 +406,21 @@ With EXPR, it returns some extra information that the debugger uses to print a stack trace. The value of EXPR indicates how many call frames to go back before the current one. - ($package, $filename, $line, $subroutine, + ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require) = caller($i); Here $subroutine may be C<"(eval)"> if the frame is not a subroutine -call, but C<L<eval>>. In such a case additional elements $evaltext and -$is_require are set: $is_require is true if the frame is created by -C<L<require>> or C<L<use>> statement, $evaltext contains the text of -C<L<eval EXPR>> statement. In particular, for C<L<eval BLOCK>> -statement $filename is C<"(eval)">, but $evaltext is undefined. (Note -also that C<L<use>> statement creates a C<L<require>> frame inside -an C<L<eval EXPR>>) frame. +call, but an C<eval>. In such a case additional elements $evaltext and +$is_require are set: $is_require is true if the frame is created by a +C<require> or C<use> statement, $evaltext contains the text of the +C<eval EXPR> statement. In particular, for a C<eval BLOCK> statement, +$filename is C<"(eval)">, but $evaltext is undefined. (Note also that +each C<use> statement creates a C<require> frame inside an C<eval EXPR>) +frame. Furthermore, when called from within the DB package, caller returns more detailed information: it sets the list variable @DB::args to be the -arguments with which that subroutine was invoked. +arguments with which the subroutine was invoked. =item chdir EXPR @@ -434,7 +434,7 @@ Changes the permissions of a list of files. The first element of the list must be the numerical mode, which should probably be an octal number, and which definitely should I<not> a string of octal digits: C<0644> is okay, C<'0644'> is not. Returns the number of files -successfully changed. See also L<oct>, if all you have is a string. +successfully changed. See also L</oct>, if all you have is a string. $cnt = chmod 0755, 'foo', 'bar'; chmod 0755, @executables; @@ -509,7 +509,7 @@ Returns the number of files successfully changed. $cnt = chown $uid, $gid, 'foo', 'bar'; chown $uid, $gid, @filenames; -Here's an example that looks up non-numeric uids in the passwd file: +Here's an example that looks up nonnumeric uids in the passwd file: print "User: "; chop($user = <STDIN>); @@ -522,23 +522,23 @@ Here's an example that looks up non-numeric uids in the passwd file: @ary = <${pattern}>; # expand filenames chown $uid, $gid, @ary; -On most systems, you are not allowed to change the ownership of the +On most systems, you are not allowed to change the ownership of the file unless you're the superuser, although you should be able to change the group to any of your secondary groups. On insecure systems, these restrictions may be relaxed, but this is not a portable assumption. =item chr NUMBER -=item chr +=item chr Returns the character represented by that NUMBER in the character set. -For example, C<chr(65)> is "A" in ASCII. For the reverse, use L<ord>. +For example, C<chr(65)> is "A" in ASCII. For the reverse, use L</ord>. If NUMBER is omitted, uses $_. =item chroot FILENAME -=item chroot +=item chroot This function works as the system call by the same name: it makes the named directory the new root directory for all further pathnames that @@ -627,9 +627,9 @@ their own password: die "Sorry...\n"; } else { print "ok\n"; - } + } -Of course, typing in your own password to whomever asks you +Of course, typing in your own password to whomever asks you for it is unwise. =item dbmclose HASH @@ -675,7 +675,7 @@ rich implementation. =item defined EXPR -=item defined +=item defined Returns a Boolean value telling whether EXPR has a value other than the undefined value C<undef>. If EXPR is not present, C<$_> will be @@ -697,7 +697,7 @@ is not guaranteed to produce intuitive results, and should probably be avoided. When used on a hash element, it tells you whether the value is defined, -not whether the key exists in the hash. Use L<exists> for the latter +not whether the key exists in the hash. Use L</exists> for the latter purpose. Examples: @@ -738,10 +738,10 @@ them as not defined anymore, but you shoudln't do that unless you don't plan to use them again, because it saves time when you load them up again to have memory already ready to be filled. -This counter-intuitive behaviour of defined() on aggregates may be +This counterintuitive behaviour of defined() on aggregates may be changed, fixed, or broken in a future release of Perl. -See also L<undef>, L<exists>, L<ref>. +See also L</undef>, L</exists>, L</ref>. =item delete EXPR @@ -773,7 +773,7 @@ hash element lookup or hash slice: Outside of an eval(), prints the value of LIST to C<STDERR> and exits with the current value of C<$!> (errno). If C<$!> is 0, exits with the value of -C<($? E<gt>E<gt> 8)> (back-tick `command` status). If C<($? E<gt>E<gt> 8)> +C<($? E<gt>E<gt> 8)> (backtick `command` status). If C<($? E<gt>E<gt> 8)> is 0, exits with 255. Inside an eval(), the error message is stuffed into C<$@>, and the eval() is terminated with the undefined value; this makes die() the way to raise an exception. @@ -781,7 +781,7 @@ die() the way to raise an exception. Equivalent examples: die "Can't cd to spool: $!\n" unless chdir '/usr/spool/news'; - chdir '/usr/spool/news' or die "Can't cd to spool: $!\n" + chdir '/usr/spool/news' or die "Can't cd to spool: $!\n" If the value of EXPR does not end in a newline, the current script line number and input line number (if any) are also printed, and a newline @@ -832,7 +832,7 @@ except that it's more efficient, more concise, keeps track of the current filename for error messages, and searches all the B<-I> libraries if the file isn't in the current directory (see also the @INC array in L<perlvar/Predefined Names>). It's the same, however, in that it does -re-parse the file every time you call it, so you probably don't want to +reparse the file every time you call it, so you probably don't want to do this inside a loop. Note that inclusion of library modules is better done with the @@ -938,7 +938,7 @@ I<EACH> file in a while (E<lt>E<gt>) loop. Examples: } Practical hint: you almost never need to use C<eof> in Perl, because the -input operators return undef when they run out of data. +input operators return undef when they run out of data. =item eval EXPR @@ -971,7 +971,7 @@ form to trap run-time errors without incurring the penalty of recompiling each time. The error, if any, is still returned in C<$@>. Examples: - # make divide-by-zero non-fatal + # make divide-by-zero nonfatal eval { $answer = $a / $b; }; warn $@ if $@; # same thing, but less efficient @@ -1001,7 +1001,7 @@ die() again, which has the effect of changing their error messages: print $@ if $@; # prints "bar barfs here" } -With an eval(), you should be especially careful to remember what's +With an eval(), you should be especially careful to remember what's being looked at when: eval $x; # CASE 1 @@ -1020,7 +1020,7 @@ and 4 likewise behave in the same way: they run the code '$x', which does nothing but return the value of C<$x>. (Case 4 is preferred for purely visual reasons, but it also has the advantage of compiling at compile-time instead of at run-time.) Case 5 is a place where -normally you I<WOULD> like to use double quotes, except that in that +normally you I<WOULD> like to use double quotes, except that in this particular situation, you can just use symbolic references instead, as in case 6. @@ -1047,7 +1047,7 @@ If you don't really want to execute the first argument, but want to lie to the program you are executing about its own name, you can specify the program you actually want to run as an "indirect object" (without a comma) in front of the LIST. (This always forces interpretation of the -LIST as a multi-valued list, even if there is only a single scalar in +LIST as a multivalued list, even if there is only a single scalar in the list.) Example: $shell = '/bin/csh'; @@ -1085,7 +1085,7 @@ are called before exit.) Example: exit 0 if $ans =~ /^[Xx]/; See also die(). If EXPR is omitted, exits with 0 status. The only -univerally portable values for EXPR are 0 for success and 1 for error; +universally portable values for EXPR are 0 for success and 1 for error; all other values are subject to unpredictable interpretation depending on the environment in which the Perl program is running. @@ -1095,9 +1095,9 @@ which can be trapped by an eval(). =item exp EXPR -=item exp +=item exp -Returns I<e> (the natural logarithm base) to the power of EXPR. +Returns I<e> (the natural logarithm base) to the power of EXPR. If EXPR is omitted, gives C<exp($_)>. =item fcntl FILEHANDLE,FUNCTION,SCALAR @@ -1190,7 +1190,7 @@ zombies: $SIG{CHLD} = sub { wait }; -There's also the double-fork trick (error checking on +There's also the double-fork trick (error checking on fork() returns omitted); unless ($pid = fork) { @@ -1218,7 +1218,7 @@ you're done. You should reopen those to /dev/null if it's any issue. Declare a picture format with use by the write() function. For example: - format Something = + format Something = Test: @<<<<<<<< @||||| @>>>>> $str, $%, '$' . int($num) . @@ -1263,7 +1263,7 @@ single-characters, however. For that, try something more like: system "stty cbreak </dev/tty >/dev/tty 2>&1"; } else { - system "stty", '-icanon', 'eol', "\001"; + system "stty", '-icanon', 'eol', "\001"; } $key = getc(STDIN); @@ -1276,18 +1276,18 @@ single-characters, however. For that, try something more like: } print "\n"; -Determination of whether $BSD_STYLE should be set -is left as an exercise to the reader. +Determination of whether $BSD_STYLE should be set +is left as an exercise to the reader. The POSIX::getattr() function can do this more portably on systems alleging POSIX compliance. See also the C<Term::ReadKey> module from your nearest CPAN site; -details on CPAN can be found on L<perlmod/CPAN>. +details on CPAN can be found on L<perlmod/CPAN>. =item getlogin Returns the current login from F</etc/utmp>, if any. If null, use -getpwuid(). +getpwuid(). $login = getlogin || getpwuid($<) || "Kilroy"; @@ -1446,26 +1446,26 @@ L<perlop/"I/O Operators">. =item gmtime EXPR Converts a time as returned by the time function to a 9-element array -with the time localized for the standard Greenwich time zone. +with the time localized for the standard Greenwich time zone. Typically used as follows: - + # 0 1 2 3 4 5 6 7 8 ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time); All array elements are numeric, and come straight out of a struct tm. In particular this means that $mon has the range 0..11 and $wday has -the range 0..6. Also, $year is the number of years since 1900, I<not> -simply the last two digits of the year. +the range 0..6 with sunday as day 0. Also, $year is the number of +years since 1900, I<not> simply the last two digits of the year. If EXPR is omitted, does C<gmtime(time())>. -In a scalar context, prints out the ctime(3) value: +In a scalar context, returns the ctime(3) value: $now_string = gmtime; # e.g., "Thu Oct 13 04:54:34 1994" -Also see the F<timegm.pl> library, and the strftime(3) function available -via the POSIX module. +Also see the timegm() function provided by the Time::Local module, +and the strftime(3) function available via the POSIX module. =item goto LABEL @@ -1501,7 +1501,7 @@ will be able to tell that this routine was called first. =item grep EXPR,LIST -This is similar in spirit to, but not the same as, L<grep(1)> +This is similar in spirit to, but not the same as, grep(1) and its relatives. In particular, it is not limited to using regular expressions. @@ -1526,21 +1526,21 @@ actually modifies the element in the original list. =item hex EXPR -=item hex +=item hex -Interprets EXPR as a hex string and returns the corresponding +Interprets EXPR as a hex string and returns the corresponding value. (To convert strings that might start with either 0 or 0x -see L<oct>.) If EXPR is omitted, uses $_. +see L</oct>.) If EXPR is omitted, uses $_. print hex '0xAf'; # prints '175' print hex 'aF'; # same =item import -There is no built-in import() function. It is merely an ordinary +There is no builtin import() function. It is merely an ordinary method (subroutine) defined (or inherited) by modules that wish to export names to another module. The use() function calls the import() method -for the package used. See also L</use>, L<perlmod>, and L<Exporter>. +for the package used. See also L</use()>, L<perlmod>, and L<Exporter>. =item index STR,SUBSTR,POSITION @@ -1554,7 +1554,7 @@ one less than the base, ordinarily -1. =item int EXPR -=item int +=item int Returns the integer portion of EXPR. If EXPR is omitted, uses $_. @@ -1568,7 +1568,7 @@ first to get the correct function definitions. If F<ioctl.ph> doesn't exist or doesn't have the correct definitions you'll have to roll your own, based on your C header files such as F<E<lt>sys/ioctl.hE<gt>>. (There is a Perl script called B<h2ph> that comes with the Perl kit which -may help you in this, but it's non-trivial.) SCALAR will be read and/or +may help you in this, but it's nontrivial.) SCALAR will be read and/or written depending on the FUNCTION--a pointer to the string value of SCALAR will be passed as the third argument of the actual ioctl call. (If SCALAR has no string value but does have a numeric value, that value will be @@ -1605,7 +1605,7 @@ system: =item join EXPR,LIST -Joins the separate strings of LIST or ARRAY into a single string with +Joins the separate strings of LIST into a single string with fields separated by the value of EXPR, and returns the string. Example: @@ -1635,7 +1635,7 @@ or how about sorted by key: print $key, '=', $ENV{$key}, "\n"; } -To sort an array by value, you'll need to use a C<sort{}> function. +To sort an array by value, you'll need to use a C<sort> function. Here's a descending numeric sort of a hash by its values: foreach $key (sort { $hash{$b} <=> $hash{$a} } keys %hash)) { @@ -1658,8 +1658,8 @@ as trying has no effect). =item kill LIST -Sends a signal to a list of processes. The first element of -the list must be the signal to send. Returns the number of +Sends a signal to a list of processes. The first element of +the list must be the signal to send. Returns the number of processes successfully signaled. $cnt = kill 1, $child1, $child2; @@ -1687,17 +1687,17 @@ C<continue> block, if any, is not executed: =item lc EXPR -=item lc +=item lc Returns an lowercased version of EXPR. This is the internal function -implementing the \L escape in double-quoted strings. +implementing the \L escape in double-quoted strings. Respects current LC_CTYPE locale if C<use locale> in force. See L<perllocale>. If EXPR is omitted, uses $_. =item lcfirst EXPR -=item lcfirst +=item lcfirst Returns the value of EXPR with the first character lowercased. This is the internal function implementing the \l escape in double-quoted strings. @@ -1707,7 +1707,7 @@ If EXPR is omitted, uses $_. =item length EXPR -=item length +=item length Returns the length in characters of the value of EXPR. If EXPR is omitted, returns length of $_. @@ -1739,24 +1739,27 @@ Converts a time as returned by the time function to a 9-element array with the time analyzed for the local time zone. Typically used as follows: + # 0 1 2 3 4 5 6 7 8 ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); All array elements are numeric, and come straight out of a struct tm. In particular this means that $mon has the range 0..11 and $wday has -the range 0..6 and $year is year-1900, that is, $year is 123 in year -2023. If EXPR is omitted, uses the current time ("localtime(time)"). +the range 0..6 with sunday as day 0. Also, $year is the number of +years since 1900, that is, $year is 123 in year 2023. + +If EXPR is omitted, uses the current time (C<localtime(time)>). In a scalar context, returns the ctime(3) value: $now_string = localtime; # e.g., "Thu Oct 13 04:54:34 1994" -Also see the Time::Local module, and the strftime(3) function available -via the POSIX module. +Also see the Time::Local module, and the strftime(3) and mktime(3) +function available via the POSIX module. =item log EXPR -=item log +=item log Returns logarithm (base I<e>) of EXPR. If EXPR is omitted, returns log of $_. @@ -1765,7 +1768,7 @@ of $_. =item lstat EXPR -=item lstat +=item lstat Does the same thing as the stat() function, but stats a symbolic link instead of the file the symbolic link points to. If symbolic links are @@ -1862,7 +1865,7 @@ See the "use" function, which "no" is the opposite of. =item oct EXPR -=item oct +=item oct Interprets EXPR as an octal string and returns the corresponding value. (If EXPR happens to start off with 0x, interprets it as @@ -1907,9 +1910,9 @@ L<IPC::Open2>, L<IPC::Open3>, and L<perlipc/"Bidirectional Communication"> for alternatives.) Opening '-' opens STDIN and opening 'E<gt>-' opens STDOUT. Open returns -non-zero upon success, the undefined value otherwise. If the open +nonzero upon success, the undefined value otherwise. If the open involved a pipe, the return value happens to be the pid of the -subprocess. +subprocess. If you're unfortunate enough to be running Perl on a system that distinguishes between text files and binary files (modern operating @@ -2006,7 +2009,7 @@ In the child process the filehandle isn't opened--i/o happens from/to the new STDOUT or STDIN. Typically this is used like the normal piped open when you want to exercise more control over just how the pipe command gets executed, such as when you are running setuid, and -don't want to have to scan shell commands for metacharacters. +don't want to have to scan shell commands for metacharacters. The following pairs are more or less equivalent: open(FOO, "|tr '[a-z]' '[A-Z]'"); @@ -2072,10 +2075,10 @@ DIRHANDLEs have their own namespace separate from FILEHANDLEs. =item ord EXPR -=item ord +=item ord Returns the numeric ascii value of the first character of EXPR. If -EXPR is omitted, uses $_. For the reverse, see L<chr>. +EXPR is omitted, uses $_. For the reverse, see L</chr>. =item pack TEMPLATE,LIST @@ -2206,7 +2209,7 @@ for examples of such things. =item pop ARRAY -=item pop +=item pop Pops and returns the last value of the array, shortening the array by 1. Has a similar effect to @@ -2220,7 +2223,7 @@ like shift(). =item pos SCALAR -=item pos +=item pos Returns the offset of where the last C<m//g> search left off for the variable is in question ($_ is used when the variable is not specified). May be @@ -2300,7 +2303,7 @@ Generalized quotes. See L<perlop>. =item quotemeta EXPR -=item quotemeta +=item quotemeta Returns the value of EXPR with all non-alphanumeric characters backslashed. (That is, all characters not matching @@ -2316,7 +2319,7 @@ If EXPR is omitted, uses $_. =item rand Returns a random fractional number between 0 and the value of EXPR. -(EXPR should be positive.) If EXPR is omitted, returns a value between +(EXPR should be positive.) If EXPR is omitted, returns a value between 0 and 1. Automatically calls srand() unless srand() has already been called. See also srand(). @@ -2353,7 +2356,7 @@ chdir() there, it would have been testing the wrong file. =item readlink EXPR -=item readlink +=item readlink Returns the value of a symbolic link, if symbolic links are implemented. If not, gives a fatal error. If there is some system @@ -2367,7 +2370,7 @@ data into variable SCALAR from the specified SOCKET filehandle. Actually does a C recvfrom(), so that it can returns the address of the sender. Returns the undefined value if there's an error. SCALAR will be grown or shrunk to the length actually read. Takes the same flags -as the system call of the same name. +as the system call of the same name. See L<perlipc/"UDP: Message Passing"> for examples. =item redo LABEL @@ -2399,7 +2402,7 @@ themselves about what was just input: =item ref EXPR -=item ref +=item ref Returns a TRUE value if EXPR is a reference, FALSE otherwise. If EXPR is not specified, $_ will be used. The value returned depends on the @@ -2413,15 +2416,15 @@ Builtin types include: CODE GLOB -If the referenced object has been blessed into a package, then that package +If the referenced object has been blessed into a package, then that package name is returned instead. You can think of ref() as a typeof() operator. if (ref($r) eq "HASH") { print "r is a reference to a hash.\n"; - } + } if (!ref ($r) { print "r is not a reference at all.\n"; - } + } See also L<perlref>. @@ -2470,12 +2473,12 @@ end such a file with "1;" unless you're sure it'll return TRUE otherwise. But it's better just to put the "C<1;>", in case you add more statements. -If EXPR is a bare word, the require assumes a "F<.pm>" extension and +If EXPR is a bareword, the require assumes a "F<.pm>" extension and replaces "F<::>" with "F</>" in the filename for you, -to make it easy to load standard modules. This form of loading of +to make it easy to load standard modules. This form of loading of modules does not risk altering your namespace. -For a yet-more-powerful import facility, see L</use> and +For a yet-more-powerful import facility, see L</use> and L<perlmod>. =item reset EXPR @@ -2500,9 +2503,17 @@ ARGV and ENV arrays. Resets only package variables--lexical variables are unaffected, but they clean themselves up on scope exit anyway, so you'll probably want to use them instead. See L</my>. -=item return LIST +=item return EXPR + +=item return + +Returns from a subroutine, eval(), or do FILE with the value of the +given EXPR. Evaluation of EXPR may be in a list, scalar, or void +context, depending on how the return value will be used, and the context +may vary from one execution to the next (see wantarray()). If no EXPR +is given, returns an empty list in a list context, an undefined value in +a scalar context, or nothing in a void context. -Returns from a subroutine, eval(), or do FILE with the value specified. (Note that in the absence of a return, a subroutine, eval, or do FILE will automatically return the value of the last expression evaluated.) @@ -2541,7 +2552,7 @@ last occurrence at or before that position. =item rmdir FILENAME -=item rmdir +=item rmdir Deletes the directory specified by FILENAME if it is empty. If it succeeds it returns 1, otherwise it returns 0 and sets C<$!> (errno). If @@ -2554,11 +2565,11 @@ The substitution operator. See L<perlop>. =item scalar EXPR Forces EXPR to be interpreted in a scalar context and returns the value -of EXPR. +of EXPR. @counts = ( scalar @a, scalar @b, scalar @c ); -There is no equivalent operator to force an expression to +There is no equivalent operator to force an expression to be interpolated in a list context because it's in practice never needed. If you really wanted to do so, however, you could use the construction C<@{[ (some expression) ]}>, but usually a simple @@ -2571,7 +2582,7 @@ call of stdio. FILEHANDLE may be an expression whose value gives the name of the filehandle. The values for WHENCE are 0 to set the file pointer to POSITION, 1 to set the it to current plus POSITION, and 2 to set it to EOF plus offset. You may use the values SEEK_SET, SEEK_CUR, and SEEK_END for -this from POSIX module. Returns 1 upon success, 0 otherwise. +this from the POSIX module. Returns 1 upon success, 0 otherwise. On some systems you have to do a seek whenever you switch between reading and writing. Amongst other things, this may have the effect of calling @@ -2661,7 +2672,7 @@ The usual idiom is: ($nfound,$timeleft) = select($rout=$rin, $wout=$win, $eout=$ein, $timeout); -or to block until something becomes ready just do this +or to block until something becomes ready just do this $nfound = select($rout=$rin, $wout=$win, $eout=$ein, undef); @@ -2781,12 +2792,12 @@ has the same interpretation as in the system call of the same name. =item sin EXPR -=item sin +=item sin Returns the sine of EXPR (expressed in radians). If EXPR is omitted, returns sine of $_. -For the inverse sine operation, you may use the POSIX::sin() +For the inverse sine operation, you may use the POSIX::asin() function, or use this relation: sub asin { atan2($_[0], sqrt(1 - $_[0] * $_[0])) } @@ -2805,8 +2816,8 @@ you requested, depending on how it counts seconds. Most modern systems always sleep the full amount. For delays of finer granularity than one second, you may use Perl's -syscall() interface to access setitimer(2) if your system supports it, -or else see L</select()> below. +syscall() interface to access setitimer(2) if your system supports it, +or else see L</select()> below. See also the POSIX module's sigpause() function. @@ -2862,7 +2873,7 @@ Examples: @articles = sort {$a cmp $b} @files; # now case-insensitively - @articles = sort { uc($a) cmp uc($b)} @files; + @articles = sort {uc($a) cmp uc($b)} @files; # same thing in reversed order @articles = sort {$b cmp $a} @files; @@ -2893,8 +2904,8 @@ Examples: print sort @george, 'to', @harry; # prints AbelAxedCainPunishedcatchaseddoggonetoxyz - # inefficiently sort by descending numeric compare using - # the first integer after the first = sign, or the + # inefficiently sort by descending numeric compare using + # the first integer after the first = sign, or the # whole record case-insensitively otherwise @new = sort { @@ -2907,10 +2918,10 @@ Examples: # we'll build auxiliary indices instead # for speed @nums = @caps = (); - for (@old) { + for (@old) { push @nums, /=(\d+)/; push @caps, uc($_); - } + } @new = @old[ sort { $nums[$b] <=> $nums[$a] @@ -3031,7 +3042,7 @@ produces the list value (1, '-', 10, ',', 20) -If you had the entire header of a normal Unix email message in $header, +If you had the entire header of a normal Unix email message in $header, you could split it up into fields and their values this way: $header =~ s/\n\s+/ /g; # fix continuation lines @@ -3053,12 +3064,12 @@ Example: open(passwd, '/etc/passwd'); while (<passwd>) { - ($login, $passwd, $uid, $gid, $gcos, + ($login, $passwd, $uid, $gid, $gcos, $home, $shell) = split(/:/); ... } -(Note that $shell above will still have a newline on it. See L</chop>, +(Note that $shell above will still have a newline on it. See L</chop>, L</chomp>, and L</join>.) =item sprintf FORMAT, LIST @@ -3075,7 +3086,7 @@ dump core when fed ludicrous arguments. =item sqrt EXPR -=item sqrt +=item sqrt Return the square root of EXPR. If EXPR is omitted, returns square root of $_. @@ -3113,11 +3124,11 @@ function is to "seed" the rand() function so that rand() can produce a different sequence each time you run your program. Just do it once at the top of your program, or you I<won't> get random numbers out of rand()! -Frequently called programs (like CGI scripts) that simply use +Frequently called programs (like CGI scripts) that simply use time ^ $$ -for a seed can fall prey to the mathematical property that +for a seed can fall prey to the mathematical property that a^b == (a+1)^(b+1) @@ -3127,7 +3138,7 @@ one-third of the time. So don't do that. =item stat EXPR -=item stat +=item stat Returns a 13-element array giving the status info for a file, either the file opened via FILEHANDLE, or named by EXPR. If EXPR is omitted, it @@ -3139,22 +3150,22 @@ follows: $atime,$mtime,$ctime,$blksize,$blocks) = stat($filename); -Not all fields are supported on all filesystem types. Here are the +Not all fields are supported on all filesystem types. Here are the meaning of the fields: - dev device number of filesystem - ino inode number - mode file mode (type and permissions) - nlink number of (hard) links to the file - uid numeric user ID of file's owner - gid numeric group ID of file's owner - rdev the device identifier (special files only) - size total size of file, in bytes - atime last access time since the epoch - mtime last modify time since the epoch - ctime inode change time (NOT creation time!) since the epoch - blksize preferred block size for file system I/O - blocks actual number of blocks allocated + 0 dev device number of filesystem + 1 ino inode number + 2 mode file mode (type and permissions) + 3 nlink number of (hard) links to the file + 4 uid numeric user ID of file's owner + 5 gid numeric group ID of file's owner + 6 rdev the device identifier (special files only) + 7 size total size of file, in bytes + 8 atime last access time since the epoch + 9 mtime last modify time since the epoch + 10 ctime inode change time (NOT creation time!) since the epoch + 11 blksize preferred block size for file system I/O + 12 blocks actual number of blocks allocated (The epoch was at 00:00 January 1, 1970 GMT.) @@ -3176,11 +3187,11 @@ Takes extra time to study SCALAR (C<$_> if unspecified) in anticipation of doing many pattern matches on the string before it is next modified. This may or may not save time, depending on the nature and number of patterns you are searching on, and on the distribution of character -frequencies in the string to be searched--you probably want to compare +frequencies in the string to be searched -- you probably want to compare run times with and without it to see which runs faster. Those loops which scan for many short constant strings (including the constant parts of more complex patterns) will benefit most. You may have only -one study active at a time--if you study a different scalar the first +one study active at a time -- if you study a different scalar the first is "unstudied". (The way study works is this: a linked list of every character in the string to be searched is made, so we know, for example, where all the 'k' characters are. From each search string, @@ -3264,7 +3275,7 @@ Returns 1 for success, 0 otherwise. On systems that don't support symbolic links, produces a fatal error at run time. To check for that, use eval: - $symlink_exists = (eval 'symlink("","");', $@ eq ''); + $symlink_exists = (eval {symlink("","")};, $@ eq ''); =item syscall LIST @@ -3334,41 +3345,41 @@ first, and the parent process waits for the child process to complete. Note that argument processing varies depending on the number of arguments. The return value is the exit status of the program as returned by the wait() call. To get the actual exit value divide by -256. See also L</exec>. This is I<NOT> what you want to use to capture -the output from a command, for that you should use merely back-ticks or +256. See also L</exec>. This is I<NOT> what you want to use to capture +the output from a command, for that you should use merely backticks or qx//, as described in L<perlop/"`STRING`">. -Because system() and back-ticks block SIGINT and SIGQUIT, killing the +Because system() and backticks block SIGINT and SIGQUIT, killing the program they're running doesn't actually interrupt your program. @args = ("command", "arg1", "arg2"); - system(@args) == 0 - or die "system @args failed: $?" + system(@args) == 0 + or die "system @args failed: $?" Here's a more elaborate example of analysing the return value from -system() on a UNIX system to check for all possibilities, including for -signals and coredumps. +system() on a Unix system to check for all possibilities, including for +signals and core dumps. $rc = 0xffff & system @args; printf "system(%s) returned %#04x: ", "@args", $rc; if ($rc == 0) { print "ran with normal exit\n"; - } + } elsif ($rc == 0xff00) { print "command failed: $!\n"; - } + } elsif ($rc > 0x80) { $rc >>= 8; print "ran with non-zero exit status $rc\n"; - } + } else { print "ran with "; if ($rc & 0x80) { $rc &= ~0x80; - print "coredump from "; - } + print "core dump from "; + } print "signal $rc\n" - } + } $ok = ($rc != 0); =item syswrite FILEHANDLE,SCALAR,LENGTH,OFFSET @@ -3384,7 +3395,7 @@ is available will be written. An OFFSET may be specified to write the data from some part of the string other than the beginning. A negative OFFSET specifies writing -from that many bytes counting backwards from the end of the string. +that many bytes counting backwards from the end of the string. =item tell FILEHANDLE @@ -3448,7 +3459,7 @@ A class implementing a scalar should have the following methods: TIESCALAR classname, LIST DESTROY this - FETCH this, + FETCH this, STORE this, value Unlike dbmopen(), the tie() function will not use or require a module @@ -3478,7 +3489,7 @@ seconds, for this process and the children of this process. =item tr/// -The translation operator. See L<perlop>. +The translation operator. Same as y///. See L<perlop>. =item truncate FILEHANDLE,LENGTH @@ -3490,7 +3501,7 @@ on your system. =item uc EXPR -=item uc +=item uc Returns an uppercased version of EXPR. This is the internal function implementing the \U escape in double-quoted strings. @@ -3500,7 +3511,7 @@ If EXPR is omitted, uses $_. =item ucfirst EXPR -=item ucfirst +=item ucfirst Returns the value of EXPR with the first character uppercased. This is the internal function implementing the \u escape in double-quoted strings. @@ -3515,14 +3526,14 @@ If EXPR is omitted, uses $_. Sets the umask for the process to EXPR and returns the previous value. If EXPR is omitted, merely returns the current umask. Remember that a umask is a number, usually given in octal; it is I<not> a string of octal -digits. See also L<oct>, if all you have is a string. +digits. See also L</oct>, if all you have is a string. =item undef EXPR =item undef -Undefines the value of EXPR, which must be an lvalue. Use on only a -scalar value, an entire array or hash, or a subroutine name (using +Undefines the value of EXPR, which must be an lvalue. Use only on a +scalar value, an entire array, an entire hash, or a subroutine name (using "&"). (Using undef() will probably not do what you expect on most predefined variables or DBM list values, so don't do that.) Always returns the undefined value. You can omit the EXPR, in which case @@ -3535,13 +3546,13 @@ pass as a parameter. Examples: undef @ary; undef %hash; undef &mysub; - return (wantarray ? () : undef) if $they_blew_it; + return (wantarray ? (undef, $errmsg) : undef) if $they_blew_it; select undef, undef, undef, 0.25; ($a, $b, undef, $c) = &foo; # Ignore third value returned =item unlink LIST -=item unlink +=item unlink Deletes a list of files. Returns the number of files successfully deleted. @@ -3618,7 +3629,7 @@ package. It is exactly equivalent to BEGIN { require Module; import Module LIST; } -except that Module I<must> be a bare word. +except that Module I<must> be a bareword. If the first argument to C<use> is a number, it is treated as a version number instead of a module name. If the version of the Perl interpreter @@ -3746,9 +3757,12 @@ not been harvested by the Perl script yet.) Returns TRUE if the context of the currently executing subroutine is looking for a list value. Returns FALSE if the context is looking -for a scalar. +for a scalar. Returns the undefined value if the context is looking +for no value (void context). - return wantarray ? () : undef; + return unless defined wantarray; # don't bother doing more + my @a = complex_calculation(); + return wantarray ? @a : "@a"; =item warn LIST @@ -3793,7 +3807,7 @@ examples. Writes a formatted record (possibly multi-line) to the specified file, using the format associated with that file. By default the format for -a file is the one having the same name is the filehandle, but the +a file is the one having the same name as the filehandle, but the format for the current output channel (see the select() function) may be set explicitly by assigning the name of the format to the C<$~> variable. @@ -3817,6 +3831,6 @@ Note that write is I<NOT> the opposite of read. Unfortunately. =item y/// -The translation operator. See L<perlop>. +The translation operator. Same as tr///. See L<perlop>. =back diff --git a/pod/perlguts.pod b/pod/perlguts.pod index 866cafb2fc..382c6c2e00 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -28,7 +28,7 @@ guaranteed to be large enough to hold a pointer (as well as an integer). Perl also uses two special typedefs, I32 and I16, which will always be at least 32-bits and 16-bits long, respectively. -=head2 Working with SV's +=head2 Working with SVs An SV can be created and loaded with one command. There are four types of values that can be loaded: an integer value (IV), a double (NV), a string, @@ -56,7 +56,7 @@ argument to C<newSVpv>. Be warned, though, that Perl will determine the string's length by using C<strlen>, which depends on the string terminating with a NUL character. -All SV's that will contain strings should, but need not, be terminated +All SVs that will contain strings should, but need not, be terminated with a NUL character. If it is not NUL-terminated there is a risk of core dumps and corruptions from code which passes the string to C functions or system calls which expect a NUL-terminated string. @@ -77,7 +77,7 @@ In the C<SvPV> macro, the length of the string returned is placed into the variable C<len> (this is a macro, so you do I<not> use C<&len>). If you do not care what the length of the data is, use the global variable C<na>. Remember, however, that Perl allows arbitrary strings of data that may both contain -NUL's and might not be terminated by a NUL. +NULs and might not be terminated by a NUL. If you want to know if the scalar value is TRUE, you can use: @@ -162,7 +162,7 @@ bus error, or just weird results. Change the zero to C<&sv_undef> in the first line and all will be well. To free an SV that you've created, call C<SvREFCNT_dec(SV*)>. Normally this -call is not necessary (see the section on L<Reference Counts and Mortality>). +call is not necessary (see L<Reference Counts and Mortality>). =head2 What's Really Stored in an SV? @@ -184,21 +184,21 @@ stored in your SV. The "p" stands for private. In general, though, it's best to use the C<Sv*V> macros. -=head2 Working with AV's +=head2 Working with AVs There are two ways to create and load an AV. The first method creates an empty AV: AV* newAV(); -The second method both creates the AV and initially populates it with SV's: +The second method both creates the AV and initially populates it with SVs: AV* av_make(I32 num, SV **ptr); The second argument points to an array containing C<num> C<SV*>'s. Once the -AV has been created, the SV's can be destroyed, if so desired. +AV has been created, the SVs can be destroyed, if so desired. -Once the AV has been created, the following operations are possible on AV's: +Once the AV has been created, the following operations are possible on AVs: void av_push(AV*, SV*); SV* av_pop(AV*); @@ -242,13 +242,13 @@ by using the following: This returns NULL if the variable does not exist. -=head2 Working with HV's +=head2 Working with HVs To create an HV, you use the following routine: HV* newHV(); -Once the HV has been created, the following operations are possible on HV's: +Once the HV has been created, the following operations are possible on HVs: SV** hv_store(HV*, char* key, U32 klen, SV* val, U32 hash); SV** hv_fetch(HV*, char* key, U32 klen, I32 lval); @@ -256,7 +256,7 @@ Once the HV has been created, the following operations are possible on HV's: The C<klen> parameter is the length of the key being passed in (Note that you cannot pass 0 in as a value of C<klen> to tell Perl to measure the length of the key). The C<val> argument contains the SV pointer to the -scalar being stored, and C<hash> is the pre-computed hash value (zero if +scalar being stored, and C<hash> is the precomputed hash value (zero if you want C<hv_store> to calculate it for you). The C<lval> parameter indicates whether this fetch is actually a part of a store operation, in which case a new undefined value will be added to the HV with the supplied @@ -422,7 +422,7 @@ A reference can be blessed into a package with the following function: SV* sv_bless(SV* sv, HV* stash); The C<sv> argument must be a reference. The C<stash> argument specifies -which class the reference will belong to. See the section on +which class the reference will belong to. See L<Stashes and Globs> for information on converting class names into stashes. /* Still under construction */ @@ -468,7 +468,7 @@ There are additional macros whose values may be bitwise OR'ed with the C<TRUE> argument to enable certain extra features. Those bits are: GV_ADDMULTI Marks the variable as multiply defined, thus preventing the - "Indentifier <varname> used only once: possible typo" warning. + "Name <varname> used only once: possible typo" warning. GV_ADDWARN Issues the warning "Had to create <varname> unexpectedly" if the variable did not exist before the function was called. @@ -477,8 +477,8 @@ package. =head2 Reference Counts and Mortality -Perl uses an reference count-driven garbage collection mechanism. SV's, -AV's, or HV's (xV for short in the following) start their life with a +Perl uses an reference count-driven garbage collection mechanism. SVs, +AVs, or HVs (xV for short in the following) start their life with a reference count of 1. If the reference count of an xV ever drops to 0, then it will be destroyed and its memory made available for reuse. @@ -514,11 +514,11 @@ the reference count of the SV will go to zero and it will be destroyed, stopping any memory leak. There are some convenience functions available that can help with the -destruction of xV's. These functions introduce the concept of "mortality". +destruction of xVs. These functions introduce the concept of "mortality". An xV that is mortal has had its reference count marked to be decremented, but not actually decremented, until "a short time later". Generally the term "short time later" means a single Perl statement, such as a call to -an XSUB function. The actual determinant for when mortal xV's have their +an XSUB function. The actual determinant for when mortal xVs have their reference count decremented depends on two macros, SAVETMPS and FREETMPS. See L<perlcall> and L<perlxs> for more details on these macros. @@ -540,7 +540,7 @@ The first call creates a mortal SV, the second converts an existing SV to a mortal SV (and thus defers a call to C<SvREFCNT_dec>), and the third creates a mortal copy of an existing SV. -The mortal routines are not just for SV's -- AV's and HV's can be +The mortal routines are not just for SVs -- AVs and HVs can be made mortal by passing their address (type-casted to C<SV*>) to the C<sv_2mortal> or C<sv_mortalcopy> routines. @@ -601,7 +601,7 @@ as any other SV. For more information on references and blessings, consult L<perlref>. -=head2 Double-Typed SV's +=head2 Double-Typed SVs Scalar variables normally contain only one type of value, an integer, double, pointer, or reference. Perl will automatically convert the @@ -679,9 +679,9 @@ entry of the same type of magic is deleted. Note that this can be overridden, and multiple instances of the same type of magic can be associated with an SV. -The C<name> and C<namlem> arguments are used to associate a string with -the magic, typically the name of a variable. C<namlem> is stored in the -C<mg_len> field and if C<name> is non-null and C<namlem> >= 0 a malloc'd +The C<name> and C<namlen> arguments are used to associate a string with +the magic, typically the name of a variable. C<namlen> is stored in the +C<mg_len> field and if C<name> is non-null and C<namlen> >= 0 a malloc'd copy of the name is stored in C<mg_ptr> field. The sv_magic function uses C<how> to determine which, if any, predefined @@ -800,7 +800,7 @@ at the top of the private data area and check that. This routine returns a pointer to the C<MAGIC> structure stored in the SV. If the SV does not have that magical feature, C<NULL> is returned. Also, -if the SV is not of type SVt_PVMG, Perl may core-dump. +if the SV is not of type SVt_PVMG, Perl may core dump. int mg_copy(SV* sv, SV* nsv, char* key, STRLEN klen); @@ -836,7 +836,7 @@ where C<sp> is the stack pointer, and C<num> is the number of elements the stack should be extended by. Now that there is room on the stack, values can be pushed on it using the -macros to push IV's, doubles, strings, and SV pointers respectively: +macros to push IVs, doubles, strings, and SV pointers respectively: PUSHi(IV) PUSHn(double) @@ -979,20 +979,20 @@ others, which use it via C<(X)PUSH[pni]>. =head2 Scratchpads -The question remains on when the SV's which are I<target>s for opcodes +The question remains on when the SVs which are I<target>s for opcodes are created. The answer is that they are created when the current unit -- a subroutine or a file (for opcodes for statements outside of subroutines) -- is compiled. During this time a special anonymous Perl array is created, which is called a scratchpad for the current unit. -A scratchpad keeps SV's which are lexicals for the current unit and are +A scratchpad keeps SVs which are lexicals for the current unit and are targets for opcodes. One can deduce that an SV lives on a scratchpad by looking on its flags: lexicals have C<SVs_PADMY> set, and I<target>s have C<SVs_PADTMP> set. -The correspondence between OP's and I<target>s is not 1-to-1. Different -OP's in the compile tree of the unit can use the same target, if this +The correspondence between OPs and I<target>s is not 1-to-1. Different +OPs in the compile tree of the unit can use the same target, if this would not conflict with the expected life of the temporary. =head2 Scratchpads and recursion @@ -1343,7 +1343,7 @@ L<perlcall>. =item G_ARRAY -Used to indicate array context. See C<GIMME> and L<perlcall>. +Used to indicate array context. See C<GIMME_V>, C<GIMME> and L<perlcall>. =item G_DISCARD @@ -1356,8 +1356,14 @@ Used to force a Perl C<eval> wrapper around a callback. See L<perlcall>. =item GIMME -The XSUB-writer's equivalent to Perl's C<wantarray>. Returns C<G_SCALAR> or -C<G_ARRAY> for scalar or array context. +A backward-compatible version of C<GIMME_V> which can only return +C<G_SCALAR> or C<G_ARRAY>; in a void context, it returns C<G_SCALAR>. + +=item GIMME_V + +The XSUB-writer's equivalent to Perl's C<wantarray>. Returns +C<G_VOID>, C<G_SCALAR> or C<G_ARRAY> for void, scalar or array +context, respectively. =item G_NOARGS @@ -1365,7 +1371,11 @@ Indicates that no arguments are being sent to a callback. See L<perlcall>. =item G_SCALAR -Used to indicate scalar context. See C<GIMME> and L<perlcall>. +Used to indicate scalar context. See C<GIMME_V>, C<GIMME>, and L<perlcall>. + +=item G_VOID + +Used to indicate void context. See C<GIMME_V> and L<perlcall>. =item gv_fetchmeth @@ -1390,24 +1400,34 @@ method's CV, which can be obtained from the GV with the C<GvCV> macro. =item gv_fetchmethod +=item gv_fetchmethod_autoload + Returns the glob which contains the subroutine to call to invoke the -method on the C<stash>. In fact in the presense of autoloading this may -be the glob for "AUTOLOAD". In this case the corresponing variable +method on the C<stash>. In fact in the presense of autoloading this may +be the glob for "AUTOLOAD". In this case the corresponding variable $AUTOLOAD is already setup. -Note that if you want to keep this glob for a long time, you need to -check for it being "AUTOLOAD", since at the later time the call +The third parameter of C<gv_fetchmethod_autoload> determines whether AUTOLOAD +lookup is performed if the given method is not present: non-zero means +yes, look for AUTOLOAD; zero means no, don't look for AUTOLOAD. Calling +C<gv_fetchmethod> is equivalent to calling C<gv_fetchmethod_autoload> with a +non-zero C<autoload> parameter. + +These functions grant C<"SUPER"> token as a prefix of the method name. + +Note that if you want to keep the returned glob for a long time, you +need to check for it being "AUTOLOAD", since at the later time the call may load a different subroutine due to $AUTOLOAD changing its value. Use the glob created via a side effect to do this. -This function grants C<"SUPER"> token as a prefix of the method name. - -Has the same side-effects and as C<gv_fetchmeth> with C<level==0>. -C<name> should be writable if contains C<':'> or C<'\''>. +These functions have the same side-effects and as C<gv_fetchmeth> with +C<level==0>. C<name> should be writable if contains C<':'> or C<'\''>. The warning against passing the GV returned by C<gv_fetchmeth> to -C<perl_call_sv> apply equally to C<gv_fetchmethod>. +C<perl_call_sv> apply equally to these functions. GV* gv_fetchmethod _((HV* stash, char* name)); + GV* gv_fetchmethod_autoload _((HV* stash, char* name, + I32 autoload)); =item gv_stashpv @@ -1526,7 +1546,7 @@ returned. Deletes a key/value pair in the hash. The value SV is removed from the hash and returned to the caller. The C<flags> value will normally be zero; if set -to G_DISCARD then null will be returned. C<hash> can be a valid pre-computed +to G_DISCARD then null will be returned. C<hash> can be a valid precomputed hash value, or 0 to ask for it to be computed. SV* hv_delete_ent _((HV* tb, SV* key, I32 flags, U32 hash)); @@ -1541,7 +1561,7 @@ C<klen> is the length of the key. =item hv_exists_ent Returns a boolean indicating whether the specified hash key exists. C<hash> -can be a valid pre-computed hash value, or 0 to ask for it to be computed. +can be a valid precomputed hash value, or 0 to ask for it to be computed. bool hv_exists_ent _((HV* tb, SV* key, U32 hash)); @@ -1557,7 +1577,7 @@ dereferencing it to a C<SV*>. =item hv_fetch_ent Returns the hash entry which corresponds to the specified key in the hash. -C<hash> must be a valid pre-computed hash number for the given C<key>, or +C<hash> must be a valid precomputed hash number for the given C<key>, or 0 if you want the function to compute it. IF C<lval> is set then the fetch will be part of a store. Make sure the return value is non-null before accessing it. The return value when C<tb> is a tied hash @@ -1587,7 +1607,7 @@ C<hv_iterinit>. char* hv_iterkey _((HE* entry, I32* retlen)); =item hv_iterkeysv - + Returns the key as an C<SV*> from the current position of the hash iterator. The return value will always be a mortal copy of the key. Also see C<hv_iterinit>. @@ -1629,7 +1649,7 @@ Returns the package name of a stash. See C<SvSTASH>, C<CvSTASH>. =item hv_store Stores an SV in a hash. The hash key is specified as C<key> and C<klen> is -the length of the key. The C<hash> parameter is the pre-computed hash +the length of the key. The C<hash> parameter is the precomputed hash value; if it is zero then Perl will compute it. The return value will be null if the operation failed, otherwise it can be dereferenced to get the original C<SV*>. @@ -1639,7 +1659,7 @@ original C<SV*>. =item hv_store_ent Stores C<val> in a hash. The hash key is specified as C<key>. The C<hash> -parameter is the pre-computed hash value; if it is zero then Perl will +parameter is the precomputed hash value; if it is zero then Perl will compute it. The return value is the new hash entry so created. It will be null if the operation failed or if the entry was stored in a tied hash. Otherwise the contents of the return value can be accessed using the @@ -2118,7 +2138,7 @@ C<SPAGAIN>. =item SPAGAIN -Re-fetch the stack pointer. Used after a callback. See L<perlcall>. +Refetch the stack pointer. Used after a callback. See L<perlcall>. SPAGAIN; @@ -2910,4 +2930,4 @@ API Listing by Dean Roehrich <F<roehrich@cray.com>>. =head1 DATE -Version 31.3: 1997/3/14 +Version 31.5: 1997/4/1 diff --git a/pod/perlipc.pod b/pod/perlipc.pod index ab4a912bc6..86dda59137 100644 --- a/pod/perlipc.pod +++ b/pod/perlipc.pod @@ -16,13 +16,13 @@ with an argument which is the name of the signal that triggered it. A signal may be generated intentionally from a particular keyboard sequence like control-C or control-Z, sent to you from another process, or triggered automatically by the kernel when special events transpire, like -a child process exiting, your process running out of stack space, or +a child process exiting, your process running out of stack space, or hitting file size limit. For example, to trap an interrupt signal, set up a handler like this. Notice how all we do is set a global variable and then raise an exception. That's because on most systems libraries are not -re-entrant, so calling any print() functions (or even anything that needs to +reentrant, so calling any print() functions (or even anything that needs to malloc(3) more memory) could in theory trigger a memory fault and subsequent core dump. @@ -30,7 +30,7 @@ and subsequent core dump. my $signame = shift; $shucks++; die "Somebody sent me a SIG$signame"; - } + } $SIG{INT} = 'catch_zap'; # could fail in modules $SIG{INT} = \&catch_zap; # best strategy @@ -45,14 +45,14 @@ indexed by name to get the number: $signo{$name} = $i; $signame[$i] = $name; $i++; - } + } So to check whether signal 17 and SIGALRM were the same, do just this: print "signal #17 = $signame[17]\n"; - if ($signo{ALRM}) { + if ($signo{ALRM}) { print "SIGALRM is $signo{ALRM}\n"; - } + } You may also choose to assign the strings C<'IGNORE'> or C<'DEFAULT'> as the handler, in which case Perl will try to discard the signal or do the @@ -65,10 +65,10 @@ values are "inherited" by functions called from within that block.) sub precious { local $SIG{INT} = 'IGNORE'; &more_functions; - } + } sub more_functions { # interrupts still ignored, for now... - } + } Sending a signal to a negative process ID means that you send the signal to the entire Unix process-group. This code send a hang-up signal to all @@ -83,11 +83,11 @@ itself: Another interesting signal to send is signal number zero. This doesn't actually affect another process, but instead checks whether it's alive -or has changed its UID. +or has changed its UID. unless (kill 0 => $kid_pid) { warn "something wicked happened to $kid_pid"; - } + } You might also want to employ anonymous functions for simple signal handlers: @@ -95,18 +95,18 @@ handlers: $SIG{INT} = sub { die "\nOutta here!\n" }; But that will be problematic for the more complicated handlers that need -to re-install themselves. Because Perl's signal mechanism is currently +to reinstall themselves. Because Perl's signal mechanism is currently based on the signal(3) function from the C library, you may sometimes be so misfortunate as to run on systems where that function is "broken", that is, it behaves in the old unreliable SysV way rather than the newer, more reasonable BSD and POSIX fashion. So you'll see defensive people writing signal handlers like this: - sub REAPER { + sub REAPER { $waitedpid = wait; # loathe sysV: it makes us not only reinstate # the handler, but place it after the wait - $SIG{CHLD} = \&REAPER; + $SIG{CHLD} = \&REAPER; } $SIG{CHLD} = \&REAPER; # now do something that forks... @@ -114,11 +114,11 @@ signal handlers like this: or even the more elaborate: use POSIX ":sys_wait_h"; - sub REAPER { + sub REAPER { my $child; while ($child = waitpid(-1,WNOHANG)) { $Kid_Status{$child} = $?; - } + } $SIG{CHLD} = \&REAPER; # still loathe sysV } $SIG{CHLD} = \&REAPER; @@ -134,11 +134,11 @@ using longjmp() or throw() in other languages. Here's an example: - eval { + eval { local $SIG{ALRM} = sub { die "alarm clock restart" }; - alarm 10; + alarm 10; flock(FH, 2); # blocking write lock - alarm 0; + alarm 0; }; if ($@ and $@ !~ /alarm clock restart/) { die } @@ -151,7 +151,7 @@ examples in it. A named pipe (often referred to as a FIFO) is an old Unix IPC mechanism for processes communicating on the same machine. It works -just like a regular, connected anonymous pipes, except that the +just like a regular, connected anonymous pipes, except that the processes rendezvous using a filename and don't have to be related. To create a named pipe, use the Unix command mknod(1) or on some @@ -160,16 +160,16 @@ systems, mkfifo(1). These may not be in your normal path. # system return val is backwards, so && not || # $ENV{PATH} .= ":/etc:/usr/etc"; - if ( system('mknod', $path, 'p') + if ( system('mknod', $path, 'p') && system('mkfifo', $path) ) { die "mk{nod,fifo} $path failed; - } + } A fifo is convenient when you want to connect a process to an unrelated one. When you open a fifo, the program will block until there's something -on the other end. +on the other end. For example, let's say you'd like to have your F<.signature> file be a named pipe that has a Perl program on the other end. Now every time any @@ -185,9 +185,9 @@ to find out whether anyone (or anything) has accidentally removed our fifo. while (1) { unless (-p $FIFO) { unlink $FIFO; - system('mknod', $FIFO, 'p') + system('mknod', $FIFO, 'p') && die "can't mknod $FIFO: $!"; - } + } # next line blocks until there's a reader open (FIFO, "> $FIFO") || die "can't write $FIFO: $!"; @@ -204,7 +204,7 @@ communication by either appending or prepending a pipe symbol to the second argument to open(). Here's how to start something up in a child process you intend to write to: - open(SPOOLER, "| cat -v | lpr -h 2>/dev/null") + open(SPOOLER, "| cat -v | lpr -h 2>/dev/null") || die "can't fork: $!"; local $SIG{PIPE} = sub { die "spooler pipe broke" }; print SPOOLER "stuff\n"; @@ -217,7 +217,7 @@ And here's how to start up a child process you intend to read from: while (<STATUS>) { next if /^(tcp|udp)/; print; - } + } close STATUS || die "bad netstat: $! $?"; If one can be sure that a particular program is a Perl script that is @@ -231,7 +231,7 @@ read from the file F<f1>, the process F<cmd1>, standard input (F<tmpfile> in this case), the F<f2> file, the F<cmd2> command, and finally the F<f3> file. Pretty nifty, eh? -You might notice that you could use back-ticks for much the +You might notice that you could use backticks for much the same effect as opening a pipe for reading: print grep { !/^(tcp|udp)/ } `netstat -an 2>&1`; @@ -325,13 +325,13 @@ you opened whatever your kid writes to his STDOUT. use English; my $sleep_count = 0; - do { + do { $pid = open(KID_TO_WRITE, "|-"); unless (defined $pid) { warn "cannot fork: $!"; die "bailing out" if $sleep_count++ > 6; sleep 10; - } + } } until defined $pid; if ($pid) { # parent @@ -339,21 +339,21 @@ you opened whatever your kid writes to his STDOUT. close(KID_TO_WRITE) || warn "kid exited $?"; } else { # child ($EUID, $EGID) = ($UID, $GID); # suid progs only - open (FILE, "> /safe/file") + open (FILE, "> /safe/file") || die "can't open /safe/file: $!"; while (<STDIN>) { print FILE; # child's STDIN is parent's KID - } + } exit; # don't forget this - } + } Another common use for this construct is when you need to execute something without the shell's interference. With system(), it's -straightforward, but you can't use a pipe open or back-ticks safely. +straightforward, but you can't use a pipe open or backticks safely. That's because there's no way to stop the shell from getting its hands on your arguments. Instead, use lower-level control to call exec() directly. -Here's a safe back-tick or pipe open for read: +Here's a safe backtick or pipe open for read: # add error processing as above $pid = open(KID_TO_READ, "-|"); @@ -361,7 +361,7 @@ Here's a safe back-tick or pipe open for read: if ($pid) { # parent while (<KID_TO_READ>) { # do something interesting - } + } close(KID_TO_READ) || warn "kid exited $?"; } else { # child @@ -369,7 +369,7 @@ Here's a safe back-tick or pipe open for read: exec($program, @options, @args) || die "can't exec program: $!"; # NOTREACHED - } + } And here's a safe pipe open for writing: @@ -381,7 +381,7 @@ And here's a safe pipe open for writing: if ($pid) { # parent for (@data) { print KID_TO_WRITE; - } + } close(KID_TO_WRITE) || warn "kid exited $?"; } else { # child @@ -389,11 +389,11 @@ And here's a safe pipe open for writing: exec($program, @options, @args) || die "can't exec program: $!"; # NOTREACHED - } + } Note that these operations are full Unix forks, which means they may not be correctly implemented on alien systems. Additionally, these are not true -multi-threading. If you'd like to learn more about threading, see the +multithreading. If you'd like to learn more about threading, see the F<modules> file mentioned below in the SEE ALSO section. =head2 Bidirectional Communication @@ -404,7 +404,7 @@ doesn't actually work: open(PROG_FOR_READING_AND_WRITING, "| some program |") -and if you forget to use the B<-w> flag, then you'll miss out +and if you forget to use the B<-w> flag, then you'll miss out entirely on the diagnostic message: Can't do bidirectional pipe at -e line 1. @@ -435,13 +435,13 @@ The problem with this is that Unix buffering is really going to ruin your day. Even though your C<Writer> filehandle is auto-flushed, and the process on the other end will get your data in a timely manner, you can't usually do anything to force it to give it back to you -in a similarly quick fashion. In this case, we could, because we +in a similarly quick fashion. In this case, we could, because we gave I<cat> a B<-u> flag to make it unbuffered. But very few Unix commands are designed to operate over pipes, so this seldom works -unless you yourself wrote the program on the other end of the +unless you yourself wrote the program on the other end of the double-ended pipe. -A solution to this is the non-standard F<Comm.pl> library. It uses +A solution to this is the nonstandard F<Comm.pl> library. It uses pseudo-ttys to make your program behave more reasonably: require 'Comm.pl'; @@ -452,8 +452,8 @@ pseudo-ttys to make your program behave more reasonably: } This way you don't have to have control over the source code of the -program you're using. The F<Comm> library also has expect() -and interact() functions. Find the library (and we hope its +program you're using. The F<Comm> library also has expect() +and interact() functions. Find the library (and we hope its successor F<IPC::Chat>) at your nearest CPAN archive as detailed in the SEE ALSO section below. @@ -483,7 +483,7 @@ If you're not writing a server/client for an existing protocol like NNTP or SMTP, you should give some thought to how your server will know when the client has finished talking, and vice-versa. Most protocols are based on one-line messages and responses (so one party -knows the other has finished when a "\n" is received) or multiline +knows the other has finished when a "\n" is received) or multi-line messages and responses that end with a period on an empty line ("\n.\n" terminates a message/response). @@ -510,16 +510,16 @@ Here's a sample TCP client using Internet-domain sockets: $proto = getprotobyname('tcp'); socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; connect(SOCK, $paddr) || die "connect: $!"; - while ($line = <SOCK>) { + while (defined($line = <SOCK>)) { print $line; - } + } close (SOCK) || die "close: $!"; exit; And here's a corresponding server to go along with it. We'll leave the address as INADDR_ANY so that the kernel can choose -the appropriate interface on multi-homed hosts. If you want sit +the appropriate interface on multihomed hosts. If you want sit on a particular interface (like the external side of a gateway or firewall machine), you should fill this in with your real address instead. @@ -531,14 +531,14 @@ instead. use Socket; use Carp; - sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" } + sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" } my $port = shift || 2345; my $proto = getprotobyname('tcp'); $port = $1 if $port =~ /(\d+)/; # untaint port number socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; - setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, + setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) || die "setsockopt: $!"; bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!"; listen(Server,SOMAXCONN) || die "listen: $!"; @@ -553,16 +553,16 @@ instead. my($port,$iaddr) = sockaddr_in($paddr); my $name = gethostbyaddr($iaddr,AF_INET); - logmsg "connection from $name [", - inet_ntoa($iaddr), "] + logmsg "connection from $name [", + inet_ntoa($iaddr), "] at port $port"; - print Client "Hello there, $name, it's now ", + print Client "Hello there, $name, it's now ", scalar localtime, "\n"; - } + } -And here's a multi-threaded version. It's multi-threaded in that -like most typical servers, it spawns (forks) a slave server to +And here's a multithreaded version. It's multithreaded in that +like most typical servers, it spawns (forks) a slave server to handle the client request so that the master server can quickly go back to service a new client. @@ -574,14 +574,14 @@ go back to service a new client. use Carp; sub spawn; # forward declaration - sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" } + sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" } my $port = shift || 2345; my $proto = getprotobyname('tcp'); $port = $1 if $port =~ /(\d+)/; # untaint port number - + socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; - setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, + setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) || die "setsockopt: $!"; bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!"; listen(Server,SOMAXCONN) || die "listen: $!"; @@ -591,7 +591,7 @@ go back to service a new client. my $waitedpid = 0; my $paddr; - sub REAPER { + sub REAPER { $waitedpid = wait; $SIG{CHLD} = \&REAPER; # loathe sysV logmsg "reaped $waitedpid" . ($? ? " with exit $?" : ''); @@ -599,30 +599,30 @@ go back to service a new client. $SIG{CHLD} = \&REAPER; - for ( $waitedpid = 0; - ($paddr = accept(Client,Server)) || $waitedpid; - $waitedpid = 0, close Client) + for ( $waitedpid = 0; + ($paddr = accept(Client,Server)) || $waitedpid; + $waitedpid = 0, close Client) { next if $waitedpid and not $paddr; my($port,$iaddr) = sockaddr_in($paddr); my $name = gethostbyaddr($iaddr,AF_INET); - logmsg "connection from $name [", - inet_ntoa($iaddr), "] + logmsg "connection from $name [", + inet_ntoa($iaddr), "] at port $port"; - spawn sub { + spawn sub { print "Hello there, $name, it's now ", scalar localtime, "\n"; - exec '/usr/games/fortune' + exec '/usr/games/fortune' or confess "can't exec fortune: $!"; }; - } + } sub spawn { my $coderef = shift; - unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') { + unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') { confess "usage: spawn CODEREF"; } @@ -640,7 +640,7 @@ go back to service a new client. open(STDOUT, ">&Client") || die "can't dup client to stdout"; ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr"; exit &$coderef(); - } + } This server takes the trouble to clone off a child version via fork() for each incoming request. That way it can handle many requests at once, @@ -666,11 +666,11 @@ differ from the system on which it's being run: use Socket; my $SECS_of_70_YEARS = 2208988800; - sub ctime { scalar localtime(shift) } + sub ctime { scalar localtime(shift) } - my $iaddr = gethostbyname('localhost'); - my $proto = getprotobyname('tcp'); - my $port = getservbyname('time', 'tcp'); + my $iaddr = gethostbyname('localhost'); + my $proto = getprotobyname('tcp'); + my $port = getservbyname('time', 'tcp'); my $paddr = sockaddr_in(0, $iaddr); my($host); @@ -695,7 +695,7 @@ differ from the system on which it's being run: That's fine for Internet-domain clients and servers, but what about local communications? While you can use the same setup, sometimes you don't want to. Unix-domain sockets are local to the current host, and are often -used internally to implement pipes. Unlike Internet domain sockets, UNIX +used internally to implement pipes. Unlike Internet domain sockets, Unix domain sockets can show up in the file system with an ls(1) listing. $ ls -l /dev/log @@ -705,7 +705,7 @@ You can test for these with Perl's B<-S> file test: unless ( -S '/dev/log' ) { die "something's wicked with the print system"; - } + } Here's a sample Unix-domain client: @@ -718,12 +718,12 @@ Here's a sample Unix-domain client: $rendezvous = shift || '/tmp/catsock'; socket(SOCK, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!"; connect(SOCK, sockaddr_un($rendezvous)) || die "connect: $!"; - while ($line = <SOCK>) { + while (defined($line = <SOCK>)) { print $line; - } + } exit; -And here's a corresponding server. +And here's a corresponding server. #!/usr/bin/perl -Tw require 5.002; @@ -746,17 +746,17 @@ And here's a corresponding server. $SIG{CHLD} = \&REAPER; - for ( $waitedpid = 0; - accept(Client,Server) || $waitedpid; - $waitedpid = 0, close Client) + for ( $waitedpid = 0; + accept(Client,Server) || $waitedpid; + $waitedpid = 0, close Client) { next if $waitedpid; logmsg "connection on $NAME"; - spawn sub { + spawn sub { print "Hello there, it's now ", scalar localtime, "\n"; exec '/usr/games/fortune' or die "can't exec fortune: $!"; }; - } + } As you see, it's remarkably similar to the Internet domain TCP server, so much so, in fact, that we've omitted several duplicate functions--spawn(), @@ -799,8 +799,8 @@ with TCP, you'd have to use a different socket handle for each host. use Socket; use Sys::Hostname; - my ( $count, $hisiaddr, $hispaddr, $histime, - $host, $iaddr, $paddr, $port, $proto, + my ( $count, $hisiaddr, $hispaddr, $histime, + $host, $iaddr, $paddr, $port, $proto, $rin, $rout, $rtime, $SECS_of_70_YEARS); $SECS_of_70_YEARS = 2208988800; @@ -847,7 +847,7 @@ several processes. That's because Perl would reallocate your string when you weren't wanting it to. -Here's a small example showing shared memory usage. +Here's a small example showing shared memory usage. $IPC_PRIVATE = 0; $IPC_RMID = 0; @@ -925,7 +925,7 @@ C<require "sys/ipc.ph">. Better yet, perhaps someone should create an C<IPC::SysV> module the way we have the C<Socket> module for normal client-server communications. -(... time passes) +(... time passes) Voila! Check out the IPC::SysV modules written by Jack Shirazi. You can find them at a CPAN store near you. @@ -961,8 +961,8 @@ signals and to stick with simple TCP and UDP socket operations; e.g., don't try to pass open file descriptors over a local UDP datagram socket if you want your code to stand a chance of being portable. -Because few vendors provide C libraries that are safely -re-entrant, the prudent programmer will do little else within +Because few vendors provide C libraries that are safely +reentrant, the prudent programmer will do little else within a handler beyond die() to raise an exception and longjmp(3) out. =head1 AUTHOR diff --git a/pod/perllocale.pod b/pod/perllocale.pod index 31ab40a58d..e1bf5f070d 100644 --- a/pod/perllocale.pod +++ b/pod/perllocale.pod @@ -182,7 +182,7 @@ As the example shows, if the second argument is an empty string, the category's locale is returned to the default specified by the corresponding environment variables. Generally, this results in a return to the default which was in force when Perl started up: changes -to the environment made by the application after start-up may or may not +to the environment made by the application after startup may or may not be noticed, depending on the implementation of your system's C library. If the second argument does not correspond to a valid locale, the locale @@ -584,13 +584,13 @@ True/false results are never tainted. Three examples illustrate locale-dependent tainting. The first program, which ignores its locale, won't run: a value taken -directly from the command-line may not be used to name an output file +directly from the command line may not be used to name an output file when taint checks are enabled. #/usr/local/bin/perl -T # Run with taint checking - # Command-line sanity check omitted... + # Command line sanity check omitted... $tainted_output_file = shift; open(F, ">$tainted_output_file") @@ -598,7 +598,7 @@ when taint checks are enabled. The program can be made to run by "laundering" the tainted value through a regular expression: the second example - which still ignores locale -information - runs, creating the file named on its command-line +information - runs, creating the file named on its command line if it can. #/usr/local/bin/perl -T @@ -632,7 +632,7 @@ of a match involving C<\w> when C<use locale> is in effect. =item PERL_BADLANG A string that can suppress Perl's warning about failed locale settings -at start-up. Failure can occur if the locale support in the operating +at startup. Failure can occur if the locale support in the operating system is lacking (broken) is some way - or if you mistyped the name of a locale when you set up your environment. If this environment variable is absent, or has a value which does not evaluate to integer zero - that diff --git a/pod/perllol.pod b/pod/perllol.pod index f15b24384e..ac36364ae0 100644 --- a/pod/perllol.pod +++ b/pod/perllol.pod @@ -16,7 +16,7 @@ old array @LoL that you can get at with two subscripts, like C<$LoL[3][2]>. Her a declaration of the array: # assign to our array a list of list references - @LoL = ( + @LoL = ( [ "fred", "barney" ], [ "george", "jane", "elroy" ], [ "homer", "marge", "bart" ], @@ -39,10 +39,10 @@ but rather just a reference to it, you could do something more like this: print $ref_to_LoL->[2][2]; -Notice that the outer bracket type has changed, and so our access syntax +Notice that the outer bracket type has changed, and so our access syntax has also changed. That's because unlike C, in perl you can't freely -interchange arrays and references thereto. $ref_to_LoL is a reference to an -array, whereas @LoL is an array proper. Likewise, C<$LoL[2]> is not an +interchange arrays and references thereto. $ref_to_LoL is a reference to an +array, whereas @LoL is an array proper. Likewise, C<$LoL[2]> is not an array, but an array ref. So how come you can write these: $LoL[2][2] @@ -72,7 +72,7 @@ each line is a row and each word an element. If you're trying to develop an while (<>) { @tmp = split; push @LoL, [ @tmp ]; - } + } You might also have loaded that from a function: @@ -81,7 +81,7 @@ You might also have loaded that from a function: } Or you might have had a temporary variable sitting around with the -list in it. +list in it. for $i ( 1 .. 10 ) { @tmp = somefunc($i); @@ -93,8 +93,8 @@ constructor. That's because this will be very wrong: $LoL[$i] = @tmp; -You see, assigning a named list like that to a scalar just counts the -number of elements in @tmp, which probably isn't what you want. +You see, assigning a named list like that to a scalar just counts the +number of elements in @tmp, which probably isn't what you want. If you are running under C<use strict>, you'll have to add some declarations to make it happy: @@ -104,13 +104,13 @@ declarations to make it happy: while (<>) { @tmp = split; push @LoL, [ @tmp ]; - } + } Of course, you don't need the temporary array to have a name at all: while (<>) { push @LoL, [ split ]; - } + } You also don't have to use push(). You could just make a direct assignment if you knew where you wanted to put it: @@ -119,30 +119,30 @@ if you knew where you wanted to put it: for $i ( 0 .. 10 ) { $line = <>; $LoL[$i] = [ split ' ', $line ]; - } + } or even just my (@LoL, $i); for $i ( 0 .. 10 ) { $LoL[$i] = [ split ' ', <> ]; - } + } You should in general be leery of using potential list functions -in a scalar context without explicitly stating such. +in a scalar context without explicitly stating such. This would be clearer to the casual reader: my (@LoL, $i); for $i ( 0 .. 10 ) { $LoL[$i] = [ split ' ', scalar(<>) ]; - } + } If you wanted to have a $ref_to_LoL variable as a reference to an array, you'd have to do something like this: while (<>) { push @$ref_to_LoL, [ split ]; - } + } Actually, if you were using strict, you'd have to declare not only $ref_to_LoL as you had to declare @LoL, but you'd I<also> having to @@ -152,7 +152,7 @@ perl version 5.001m that's been fixed for the 5.002 release.) my $ref_to_LoL = []; while (<>) { push @$ref_to_LoL, [ split ]; - } + } Ok, now you can add new rows. What about adding new columns? If you're dealing with just matrices, it's often easiest to use simple assignment: @@ -165,9 +165,9 @@ dealing with just matrices, it's often easiest to use simple assignment: for $x ( 3, 7, 9 ) { $LoL[$x][20] += func2($x); - } + } -It doesn't matter whether those elements are already +It doesn't matter whether those elements are already there or not: it'll gladly create them for you, setting intervening elements to C<undef> as need be. @@ -186,7 +186,7 @@ to push() must be a real array, not just a reference to such. =head1 Access and Printing -Now it's time to print your data structure out. How +Now it's time to print your data structure out. How are you going to do that? Well, if you want only one of the elements, it's trivial: @@ -198,10 +198,10 @@ say print @LoL; # WRONG because you'll get just references listed, and perl will never -automatically dereference things for you. Instead, you have to +automatically dereference things for you. Instead, you have to roll yourself a loop or two. This prints the whole structure, using the shell-style for() construct to loop across the outer -set of subscripts. +set of subscripts. for $aref ( @LoL ) { print "\t [ @$aref ],\n"; @@ -221,7 +221,7 @@ or maybe even this. Notice the inner loop. } } -As you can see, it's getting a bit complicated. That's why +As you can see, it's getting a bit complicated. That's why sometimes is easier to take a temporary on your way through: for $i ( 0 .. $#LoL ) { @@ -254,10 +254,10 @@ Here's how to do one operation using a loop. We'll assume an @LoL variable as before. @part = (); - $x = 4; + $x = 4; for ($y = 7; $y < 13; $y++) { push @part, $LoL[$x][$y]; - } + } That same loop could be replaced with a slice operation: @@ -273,9 +273,9 @@ $x run from 4..8 and $y run from 7 to 12? Hmm... here's the simple way: for ($starty = $y = 7; $x <= 12; $y++) { $newLoL[$x - $startx][$y - $starty] = $LoL[$x][$y]; } - } + } -We can reduce some of the looping through slices +We can reduce some of the looping through slices for ($x = 4; $x <= 8; $x++) { push @newLoL, [ @{ $LoL[$x] } [ 7..12 ] ]; @@ -293,13 +293,13 @@ If I were you, I'd put that in a function: @newLoL = splice_2D( \@LoL, 4 => 8, 7 => 12 ); sub splice_2D { my $lrr = shift; # ref to list of list refs! - my ($x_lo, $x_hi, + my ($x_lo, $x_hi, $y_lo, $y_hi) = @_; - return map { - [ @{ $lrr->[$_] } [ $y_lo .. $y_hi ] ] + return map { + [ @{ $lrr->[$_] } [ $y_lo .. $y_hi ] ] } $x_lo .. $x_hi; - } + } =head1 SEE ALSO diff --git a/pod/perlmod.pod b/pod/perlmod.pod index 2f1ae5b20e..0b384ab35c 100644 --- a/pod/perlmod.pod +++ b/pod/perlmod.pod @@ -41,7 +41,7 @@ package's symbol table. All other symbols are kept in package C<main>, including all of the punctuation variables like $_. In addition, the identifiers STDIN, STDOUT, STDERR, ARGV, ARGVOUT, ENV, INC, and SIG are forced to be in package C<main>, even when used for other purposes than -their built-in one. Note also that, if you have a package called C<m>, +their builtin one. Note also that, if you have a package called C<m>, C<s>, or C<y>, then you can't use the qualified form of an identifier because it will be interpreted instead as a pattern match, a substitution, or a translation. @@ -77,8 +77,8 @@ use the C<*name> typeglob notation. In fact, the following have the same effect, though the first is more efficient because it does the symbol table lookups at compile time: - local(*main::foo) = *main::bar; local($main::{'foo'}) = - $main::{'bar'}; + local(*main::foo) = *main::bar; + local($main::{'foo'}) = $main::{'bar'}; You can use this to print out all the variables in a package, for instance. Here is F<dumpvar.pl> from the Perl library: @@ -328,7 +328,7 @@ the rest of the current file. This will not work if you use C<require> instead of C<use>. With require you can get into this problem: require Cwd; # make Cwd:: accessible - $here = Cwd::getcwd(); + $here = Cwd::getcwd(); use Cwd; # import names from Cwd:: $here = getcwd(); @@ -381,7 +381,7 @@ F<.pl> files will all eventually be converted into standard modules, and the F<.ph> files made by B<h2ph> will probably end up as extension modules made by B<h2xs>. (Some F<.ph> values may already be available through the POSIX module.) The B<pl2pm> file in the distribution may help in your -conversion, but it's just a mechanical process and therefore far from +conversion, but it's just a mechanical process and therefore far from bulletproof. =head2 Pragmatic Modules @@ -398,7 +398,7 @@ which lasts until the end of that BLOCK. Unlike the pragmas that effect the C<$^H> hints variable, the C<use vars> and C<use subs> declarations are not BLOCK-scoped. They allow -you to pre-declare a variables or subroutines within a particular +you to predeclare a variables or subroutines within a particular I<file> rather than just a block. Such declarations are effective for the entire file for which they were declared. You cannot rescind them with C<no vars> or C<no subs>. @@ -430,7 +430,7 @@ manipulate @INC at compile time =item locale -use or ignore current locale for built-in operations (see L<perllocale>) +use or ignore current locale for builtin operations (see L<perllocale>) =item ops @@ -450,7 +450,7 @@ restrict unsafe constructs =item subs -pre-declare sub names +predeclare sub names =item vmsish @@ -458,7 +458,7 @@ adopt certain VMS-specific behaviors =item vars -pre-declare global variable names +predeclare global variable names =back @@ -556,7 +556,7 @@ determine libraries to use and how to use them =item ExtUtils::MM_OS2 -methods to override UN*X behaviour in ExtUtils::MakeMaker +methods to override Unix behaviour in ExtUtils::MakeMaker =item ExtUtils::MM_Unix @@ -564,7 +564,7 @@ methods used by ExtUtils::MakeMaker =item ExtUtils::MM_VMS -methods to override UN*X behaviour in ExtUtils::MakeMaker +methods to override Unix behaviour in ExtUtils::MakeMaker =item ExtUtils::MakeMaker @@ -616,7 +616,7 @@ create or remove a series of directories =item File::stat -by-name interface to Perl's built-in stat() functions +by-name interface to Perl's builtin stat() functions =item FileCache @@ -704,19 +704,19 @@ Hello, anybody home? =item Net::hostent -by-name interface to Perl's built-in gethost*() functions +by-name interface to Perl's builtin gethost*() functions =item Net::netent -by-name interface to Perl's built-in getnet*() functions +by-name interface to Perl's builtin getnet*() functions =item Net::protoent -by-name interface to Perl's built-in getproto*() functions +by-name interface to Perl's builtin getproto*() functions =item Net::servent -by-name interface to Perl's built-in getserv*() functions +by-name interface to Perl's builtin getserv*() functions =item Opcode @@ -768,7 +768,7 @@ try every conceivable way to get hostname =item Sys::Syslog -interface to the UNIX syslog(3) calls +interface to the Unix syslog(3) calls =item Term::Cap @@ -800,7 +800,7 @@ implementation of the Soundex Algorithm as described by Knuth =item Text::Tabs -expand and unexpand tabs per the unix expand(1) and unexpand(1) +expand and unexpand tabs per the Unix expand(1) and unexpand(1) =item Text::Wrap @@ -828,11 +828,11 @@ efficiently compute time from local and GMT time =item Time::gmtime -by-name interface to Perl's built-in gmtime() function +by-name interface to Perl's builtin gmtime() function =item Time::localtime -by-name interface to Perl's built-in localtime() function +by-name interface to Perl's builtin localtime() function =item Time::tm @@ -844,11 +844,11 @@ base class for ALL classes (blessed references) =item User::grent -by-name interface to Perl's built-in getgr*() functions +by-name interface to Perl's builtin getgr*() functions =item User::pwent -by-name interface to Perl's built-in getpw*() functions +by-name interface to Perl's builtin getpw*() functions =back @@ -862,7 +862,8 @@ your system man(1) command. If that fails, try the I<perldoc> program. =head2 Extension Modules -Extension modules are written in C (or a mix of Perl and C) and get +Extension modules are written in C (or a mix of Perl and C) and may be +statically linked or in general are dynamically loaded into Perl if and when you need them. Supported extension modules include the Socket, Fcntl, and POSIX modules. @@ -1105,7 +1106,7 @@ Inherit methods from other modules if appropriate. Avoid class name tests like: C<die "Invalid" unless ref $ref eq 'FOO'>. Generally you can delete the "C<eq 'FOO'>" part with no harm at all. -Let the objects look after themselves! Generally, avoid hardwired +Let the objects look after themselves! Generally, avoid hard-wired class names as far as possible. Avoid C<$r-E<gt>Class::func()> where using C<@ISA=qw(... Class ...)> and @@ -1213,7 +1214,7 @@ standards for naming modules and the interface to methods in those modules. To be portable each component of a module name should be limited to -11 characters. If it might be used on DOS then try to ensure each is +11 characters. If it might be used on MS-DOS then try to ensure each is unique in the first 8 characters. Nested modules make this easier. =item Have you got it right? @@ -1279,8 +1280,8 @@ How you choose to license your work is a personal decision. The general mechanism is to assert your Copyright and then make a declaration of how others may copy/use/modify your work. -Perl, for example, is supplied with two types of license: The GNU -GPL and The Artistic License (see the files README, Copying, and +Perl, for example, is supplied with two types of licence: The GNU +GPL and The Artistic Licence (see the files README, Copying, and Artistic). Larry has good reasons for NOT just using the GNU GPL. My personal recommendation, out of respect for Larry, Perl, and the @@ -1428,6 +1429,6 @@ the application could invoked as: perl -e 'use Module::Name; method(@ARGV)' ... or - perl -mModule::Name ... (in perl5.002) + perl -mModule::Name ... (in perl5.002 or higher) =back diff --git a/pod/perlobj.pod b/pod/perlobj.pod index 07a71dc203..765b7ffab7 100644 --- a/pod/perlobj.pod +++ b/pod/perlobj.pod @@ -9,7 +9,7 @@ See L<perlref> for that. Second, if you still find the following reference work too complicated, a tutorial on object-oriented programming in Perl can be found in L<perltoot>. -If you're still with us, then +If you're still with us, then here are three very simple definitions that you should find reassuring. =over 4 @@ -44,11 +44,11 @@ constructor: package Critter; sub new { bless {} } -The C<{}> constructs a reference to an anonymous hash containing no +The C<{}> constructs a reference to an anonymous hash containing no key/value pairs. The bless() takes that reference and tells the object it references that it's now a Critter, and returns the reference. This is for convenience, because the referenced object itself knows that -it has been blessed, and its reference to it could have been returned +it has been blessed, and the reference to it could have been returned directly, like this: sub new { @@ -82,7 +82,7 @@ so that your constructors may be inherited: Or if you expect people to call not just C<CLASS-E<gt>new()> but also C<$obj-E<gt>new()>, then use something like this. The initialize() -method used will be of whatever $class we blessed the +method used will be of whatever $class we blessed the object into: sub new { @@ -102,7 +102,7 @@ be accessed only through the class's methods. A constructor may re-bless a referenced object currently belonging to another class, but then the new class is responsible for all cleanup later. The previous blessing is forgotten, as an object may belong -to only one class at a time. (Although of course it's free to +to only one class at a time. (Although of course it's free to inherit methods from many classes.) A clarification: Perl objects are blessed. References are not. Objects @@ -115,7 +115,7 @@ the following example: bless $a, BLAH; print "\$b is a ", ref($b), "\n"; -This reports $b as being a BLAH, so obviously bless() +This reports $b as being a BLAH, so obviously bless() operated on the object and not on the reference. =head2 A Class is Simply a Package @@ -130,7 +130,7 @@ package. This is how Perl implements inheritance. Each element of the @ISA array is just the name of another package that happens to be a class package. The classes are searched (depth first) for missing methods in the order that they occur in @ISA. The classes accessible -through @ISA are known as base classes of the current class. +through @ISA are known as base classes of the current class. If a missing method is found in one of the base classes, it is cached in the current class for efficiency. Changing @ISA or defining new @@ -159,7 +159,7 @@ Unlike say C++, Perl doesn't provide any special syntax for method definition. (It does provide a little syntax for method invocation though. More on that later.) A method expects its first argument to be the object or package it is being invoked on. There are just two -types of methods, which we'll call class and instance. +types of methods, which we'll call class and instance. (Sometimes you'll hear these called static and virtual, in honor of the two C++ method types they most closely resemble.) @@ -324,7 +324,7 @@ You do not need to C<use UNIVERSAL> in order to make these methods available to your program. This is necessary only if you wish to have C<isa> available as a plain subroutine in the current package. -=head2 Destructors +=head2 Destructors When the last reference to an object goes away, the object is automatically destroyed. (This may even be after you exit, if you've @@ -345,14 +345,14 @@ automatically when the current object is freed. An indirect object is limited to a name, a scalar variable, or a block, because it would have to do too much lookahead otherwise, just like any other postfix dereference in the language. The left side of -E<gt> is not so -limited, because it's an infix operator, not a postfix operator. +limited, because it's an infix operator, not a postfix operator. -That means that below, A and B are equivalent to each other, and C and D -are equivalent, but AB and CD are different: +That means that in the following, A and B are equivalent to each other, and +C and D are equivalent, but A/B and C/D are different: - A: method $obref->{"fieldname"} + A: method $obref->{"fieldname"} B: (method $obref)->{"fieldname"} - C: $obref->{"fieldname"}->method() + C: $obref->{"fieldname"}->method() D: method {$obref->{"fieldname"}} =head2 Summary @@ -372,12 +372,12 @@ probably won't matter. A more serious concern is that unreachable memory with a non-zero reference count will not normally get freed. Therefore, this is a bad -idea: +idea: { my $a; $a = \$a; - } + } Even thought $a I<should> go away, it can't. When building recursive data structures, you'll have to break the self-reference yourself explicitly @@ -391,7 +391,7 @@ node such as one might use in a sophisticated tree structure: $node->{LEFT} = $node->{RIGHT} = $node; $node->{DATA} = [ @_ ]; return bless $node => $class; - } + } If you create nodes like that, they (currently) won't go away unless you break their self reference yourself. (In other words, this is not to be @@ -403,10 +403,10 @@ When an interpreter thread finally shuts down (usually when your program exits), then a rather costly but complete mark-and-sweep style of garbage collection is performed, and everything allocated by that thread gets destroyed. This is essential to support Perl as an embedded or a -multi-threadable language. For example, this program demonstrates Perl's +multithreadable language. For example, this program demonstrates Perl's two-phased garbage collection: - #!/usr/bin/perl + #!/usr/bin/perl package Subtle; sub new { @@ -414,12 +414,12 @@ two-phased garbage collection: $test = \$test; warn "CREATING " . \$test; return bless \$test; - } + } sub DESTROY { my $self = shift; warn "DESTROYING $self"; - } + } package main; @@ -429,7 +429,7 @@ two-phased garbage collection: my $b = Subtle->new; $$a = 0; # break selfref warn "leaving block"; - } + } warn "just exited block"; warn "time to die..."; @@ -447,7 +447,7 @@ When run as F</tmp/test>, the following output is produced: DESTROYING Subtle=SCALAR(0x8e57c) during global destruction. Notice that "global destruction" bit there? That's the thread -garbage collector reaching the unreachable. +garbage collector reaching the unreachable. Objects are always destructed, even when regular refs aren't and in fact are destructed in a separate pass before ordinary refs just to try to @@ -462,8 +462,8 @@ at a future date. =head1 SEE ALSO -A kinder, gentler tutorial on object-oriented programming in Perl can +A kinder, gentler tutorial on object-oriented programming in Perl can be found in L<perltoot>. -You should also check out L<perlbot> for other object tricks, traps, and tips, +You should also check out L<perlbot> for other object tricks, traps, and tips, as well as L<perlmod> for some style guides on constructing both modules and classes. diff --git a/pod/perlop.pod b/pod/perlop.pod index c4a342be7b..45dafaa187 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -8,7 +8,7 @@ Perl operators have the following associativity and precedence, listed from highest precedence to lowest. Note that all operators borrowed from C keep the same precedence relationship with each other, even where C's precedence is slightly screwy. (This makes learning -Perl easier for C folks.) With very few exceptions, these all +Perl easier for C folks.) With very few exceptions, these all operate on scalar values only, not array values. left terms and list operators (leftward) @@ -16,7 +16,7 @@ operate on scalar values only, not array values. nonassoc ++ -- right ** right ! ~ \ and unary + and - - left =~ !~ + left =~ !~ left * / % x left + - . left << >> @@ -42,7 +42,7 @@ In the following sections, these operators are covered in precedence order. =head2 Terms and List Operators (Leftward) -Any TERM is of highest precedence of Perl. These includes variables, +A TERM has the highest precedence in Perl. They includes variables, quote and quote-like operators, any expression in parentheses, and any function whose arguments are parenthesized. Actually, there aren't really functions in this sense, just list operators and unary @@ -56,7 +56,7 @@ just like a normal function call. In the absence of parentheses, the precedence of list operators such as C<print>, C<sort>, or C<chmod> is either very high or very low depending on -whether you look at the left side of operator or the right side of it. +whether you are looking at the left side or the right side of the operator. For example, in @ary = (1, 3, sort 4, 2); @@ -81,11 +81,11 @@ Also note that print ($foo & 255) + 1, "\n"; -probably doesn't do what you expect at first glance. See +probably doesn't do what you expect at first glance. See L<Named Unary Operators> for more discussion of this. Also parsed as terms are the C<do {}> and C<eval {}> constructs, as -well as subroutine and method calls, and the anonymous +well as subroutine and method calls, and the anonymous constructors C<[]> and C<{}>. See also L<Quote and Quote-like Operators> toward the end of this section, @@ -110,7 +110,7 @@ See L<perlobj>. increment or decrement the variable before returning the value, and if placed after, increment or decrement the variable after returning the value. -The auto-increment operator has a little extra built-in magic to it. If +The auto-increment operator has a little extra builtin magic to it. If you increment a variable that is numeric, or that has ever been used in a numeric context, you get a normal increment. If, however, the variable has been used in only string contexts since it was set, and @@ -179,7 +179,12 @@ Binary "*" multiplies two numbers. Binary "/" divides two numbers. -Binary "%" computes the modulus of the two numbers. +Binary "%" computes the modulus of two numbers. Given integer +operands C<$a> and C<$b>: If C<$b> is positive, then C<$a % $b> is +C<$a> minus the largest multiple of C<$b> that is not greater than +C<$a>. If C<$b> is negative, then C<$a % $b> is C<$a> minus the +smallest multiple of C<$b> that is not less than C<$a> (i.e. the +result will be less than or equal to zero). Binary "x" is the repetition operator. In a scalar context, it returns a string consisting of the left operand repeated the number of @@ -347,12 +352,12 @@ operators depending on the context. In a list context, it returns an array of values counting (by ones) from the left value to the right value. This is useful for writing C<for (1..10)> loops and for doing slice operations on arrays. Be aware that under the current implementation, -a temporary array is created, so you'll burn a lot of memory if you +a temporary array is created, so you'll burn a lot of memory if you write something like this: for (1 .. 1_000_000) { # code - } + } In a scalar context, ".." returns a boolean value. The operator is bistable, like a flip-flop, and emulates the line-range (comma) operator @@ -416,11 +421,11 @@ like an if-then-else. If the argument before the ? is true, the argument before the : is returned, otherwise the argument after the : is returned. For example: - printf "I have %d dog%s.\n", $n, + printf "I have %d dog%s.\n", $n, ($n == 1) ? '' : "s"; Scalar or list context propagates downward into the 2nd -or 3rd argument, whichever is selected. +or 3rd argument, whichever is selected. $a = $ok ? $b : $c; # get a scalar @a = $ok ? @b : @c; # get an array @@ -446,8 +451,8 @@ is equivalent to $a = $a + 2; although without duplicating any side effects that dereferencing the lvalue -might trigger, such as from tie(). Other assignment operators work similarly. -The following are recognized: +might trigger, such as from tie(). Other assignment operators work similarly. +The following are recognized: **= += *= &= <<= &&= -= /= |= >>= ||= @@ -533,12 +538,12 @@ Address-of operator. (But see the "\" operator for taking a reference.) =item unary * -Dereference-address operator. (Perl's prefix dereferencing +Dereference-address operator. (Perl's prefix dereferencing operators are typed: $, @, %, and &.) =item (TYPE) -Type casting operator. +Type casting operator. =back @@ -550,7 +555,7 @@ pattern matching capabilities. Perl provides customary quote characters for these behaviors, but also provides a way for you to choose your quote character for any of them. In the following table, a C<{}> represents any pair of delimiters you choose. Non-bracketing delimiters use -the same character fore and aft, but the 4 sorts of brackets +the same character fore and aft, but the 4 sorts of brackets (round, angle, square, curly) will all nest. Customary Generic Meaning Interpolates @@ -706,7 +711,7 @@ beginning. Examples: # scalar context $/ = ""; $* = 1; # $* deprecated in modern perls - while ($paragraph = <>) { + while (defined($paragraph = <>)) { while ($paragraph =~ /[a-z]['")]*[.!?]+['")]*\s/g) { $sentences++; } @@ -741,10 +746,10 @@ combine several regexps like this to process a string part-by-part, doing different actions depending on which regexp matched. The next regexp would step in at the place the previous one left off. - $_ = <<'EOL'; + $_ = <<'EOL'; $url = new URI::URL "http://www/"; die if $url eq "xXx"; -EOL - LOOP: + EOL + LOOP: { print(" digits"), redo LOOP if /\G\d+\b[,.;]?\s*/g; print(" lowercase"), redo LOOP if /\G[a-z]+\b[,.;]?\s*/g; @@ -798,7 +803,7 @@ with $/ or $INPUT_RECORD_SEPARATOR). $today = qx{ date }; -See L<I/O Operators> for more discussion. +See L<"I/O Operators"> for more discussion. =item qw/STRING/ @@ -847,7 +852,7 @@ Options are: Any non-alphanumeric, non-whitespace delimiter may replace the slashes. If single quotes are used, no interpretation is done on the replacement string (the C</e> modifier overrides this, however). Unlike -Perl 4, Perl 5 treats back-ticks as normal delimiters; the replacement +Perl 4, Perl 5 treats backticks as normal delimiters; the replacement text is not evaluated as a command. If the PATTERN is delimited by bracketing quotes, the REPLACEMENT has its own pair of quotes, which may or may not be bracketing quotes, e.g., @@ -892,7 +897,7 @@ Examples: s/([^ ]*) *([^ ]*)/$2 $1/; # reverse 1st two fields -Note the use of $ instead of \ in the last example. Unlike +Note the use of $ instead of \ in the last example. Unlike B<sed>, we use the \E<lt>I<digit>E<gt> form in only the left hand side. Anywhere else it's $E<lt>I<digit>E<gt>. @@ -915,12 +920,12 @@ Translates all occurrences of the characters found in the search list with the corresponding character in the replacement list. It returns the number of characters replaced or deleted. If no string is specified via the =~ or !~ operator, the $_ string is translated. (The -string specified with =~ must be a scalar variable, an array element, -or an assignment to one of those, i.e., an lvalue.) For B<sed> devotees, -C<y> is provided as a synonym for C<tr>. If the SEARCHLIST is -delimited by bracketing quotes, the REPLACEMENTLIST has its own pair of -quotes, which may or may not be bracketing quotes, e.g., C<tr[A-Z][a-z]> -or C<tr(+-*/)/ABCD/>. +string specified with =~ must be a scalar variable, an array element, a +hash element, or an assignment to one of those, i.e., an lvalue.) +For B<sed> devotees, C<y> is provided as a synonym for C<tr>. If the +SEARCHLIST is delimited by bracketing quotes, the REPLACEMENTLIST has +its own pair of quotes, which may or may not be bracketing quotes, +e.g., C<tr[A-Z][a-z]> or C<tr(+-*/)/ABCD/>. Options: @@ -983,8 +988,8 @@ an eval(): =head2 I/O Operators -There are several I/O operators you should know about. -A string is enclosed by back-ticks (grave accents) first undergoes +There are several I/O operators you should know about. +A string is enclosed by backticks (grave accents) first undergoes variable substitution just like a double quoted string. It is then interpreted as a command, and the output of that command is the value of the pseudo-literal, like in a shell. In a scalar context, a single @@ -997,8 +1002,8 @@ of C<$?>). Unlike in B<csh>, no translation is done on the return data--newlines remain newlines. Unlike in any of the shells, single quotes do not hide variable names in the command from interpretation. To pass a $ through to the shell you need to hide it with a backslash. -The generalized form of back-ticks is C<qx//>. (Because back-ticks -always undergo shell expansion as well, see L<perlsec> for +The generalized form of backticks is C<qx//>. (Because backticks +always undergo shell expansion as well, see L<perlsec> for security concerns.) Evaluating a filehandle in angle brackets yields the next line from @@ -1063,7 +1068,7 @@ continue as if the input were one big happy file. (But see example under eof() for how to reset line numbers on each file.) If you want to set @ARGV to your own list of files, go right ahead. If -you want to pass switches into your script, you can use one of the +you want to pass switches into your script, you can use one of the Getopts modules or put a loop on the front like this: while ($_ = $ARGV[0], /^-/) { @@ -1120,7 +1125,7 @@ machine.) Of course, the shortest way to do the above is: Because globbing invokes a shell, it's often faster to call readdir() yourself and do your own grep() on the filenames. Furthermore, due to its current -implementation of using a shell, the glob() routine may get "Arg list too +implementation of using a shell, the glob() routine may get "Arg list too long" errors (unless you've installed tcsh(1L) as F</bin/csh>). A glob evaluates its (embedded) argument only when it is starting a new @@ -1138,7 +1143,7 @@ than $file = <blurch*>; because the latter will alternate between returning a filename and -returning FALSE. +returning FALSE. It you're trying to do variable interpolation, it's definitely better to use the glob() function, because the older notation can cause people @@ -1159,14 +1164,14 @@ compile time. You can say 'Now is the time for all' . "\n" . 'good men to come to.' -and this all reduces to one string internally. Likewise, if +and this all reduces to one string internally. Likewise, if you say foreach $file (@filenames) { if (-s $file > 5 + 100 * 2**16) { ... } - } + } -the compiler will pre-compute the number that +the compiler will precompute the number that expression represents so that the interpreter won't have to. @@ -1180,7 +1185,7 @@ floating point. But by saying you may tell the compiler that it's okay to use integer operations from here to the end of the enclosing BLOCK. An inner BLOCK may -countermand this by saying +countermand this by saying no integer; diff --git a/pod/perlpod.pod b/pod/perlpod.pod index ce092214b8..1dfb3ac3d4 100644 --- a/pod/perlpod.pod +++ b/pod/perlpod.pod @@ -54,7 +54,7 @@ items consistent: either use "=item *" for all of them, to produce bullets, or use "=item 1.", "=item 2.", etc., to produce numbered lists, or use "=item foo", "=item bar", etc., i.e., things that looks nothing like bullets or numbers. If you start with bullets or numbers, stick with them, as many -formatters use the first "=item" type to decide how to format the list. +formatters use the first "=item" type to decide how to format the list. For, begin, and end let you include sections that are not interpreted as pod text, but passed directly to particular formatters. A formatter @@ -63,12 +63,12 @@ completely ignored. The directive "=for" specifies that the entire next paragraph is in the format indicated by the first word after "=for", like this: - =for html <br> + =for html <br> <p> This is a raw HTML paragraph </p> The paired commands "=begin" and "=end" work very similarly to "=for", but instead of only accepting a single paragraph, all text from "=begin" to a -paragraph with a matching "=end" are treated as a particular format. +paragraph with a matching "=end" are treated as a particular format. Here are some examples of how to use these: @@ -95,7 +95,7 @@ treat some of these as synonyms.) And don't forget, when using any command, that the command lasts up until the end of the B<paragraph>, not the line. Hence in the examples below, you -can see the blank lines after each command to end its paragraph. +can see the empty lines after each command to end its paragraph. Some examples of lists include: @@ -132,7 +132,7 @@ here and in commands: I<text> italicize text, used for emphasis or variables B<text> embolden text, used for switches and programs S<text> text contains non-breaking spaces - C<code> literal code + C<code> literal code L<name> A link (cross reference) to name L<name> manual page L<name/ident> item in manual page @@ -188,7 +188,7 @@ documentation with a "=head1" command at the beginning, and end it with a "=cut" command. Perl will ignore the pod text. See any of the supplied library modules for examples. If you're going to put your pods at the end of the file, and you're using an __END__ or __DATA__ -cut mark, make sure to put a blank line there before the first pod +cut mark, make sure to put an empty line there before the first pod directive. __END__ @@ -198,7 +198,7 @@ directive. modern - I am a modern module -If you had not had that blank line there, then the translators wouldn't +If you had not had that empty line there, then the translators wouldn't have seen it. =head1 Common Pod Pitfalls @@ -208,7 +208,7 @@ have seen it. =item * Pod translators usually will require paragraphs to be separated by -completely empty lines. If you have an apparently blank line with +completely empty lines. If you have an apparently empty line with some spaces on it, this can cause odd formatting. =item * @@ -222,7 +222,7 @@ sensibly. =item * The script F<pod/checkpods.PL> in the Perl source distribution -provides skeletal checking for lines that look blank but aren't +provides skeletal checking for lines that look empty but aren't B<only>, but is there as a placeholder until someone writes Pod::Checker. The best way to check your pod is to pass it through one or more translators and proofread the result, or print out the diff --git a/pod/perlre.pod b/pod/perlre.pod index 74a8bd9fd5..f881a3bcc7 100644 --- a/pod/perlre.pod +++ b/pod/perlre.pod @@ -23,18 +23,18 @@ Do case-insensitive pattern matching. If C<use locale> is in effect, the case map is taken from the current locale. See L<perllocale>. -=item m +=item m Treat string as multiple lines. That is, change "^" and "$" from matching at only the very start or end of the string to the start or end of any line anywhere within the string, -=item s +=item s Treat string as single line. That is, change "." to match any character whatsoever, even a newline, which it normally would not match. -=item x +=item x Extend your pattern's legibility by permitting whitespace and comments. @@ -49,7 +49,7 @@ The C</x> modifier itself needs a little more explanation. It tells the regular expression parser to ignore whitespace that is neither backslashed nor within a character class. You can use this to break up your regular expression into (slightly) more readable parts. The C<#> -character is also treated as a meta-character introducing a comment, +character is also treated as a metacharacter introducing a comment, just as in ordinary Perl code. This also means that if you want real whitespace or C<#> characters in the pattern that you'll have to either escape them or encode them using octal or hex escapes. Taken together, @@ -67,7 +67,7 @@ See L<Version 8 Regular Expressions> for details. In particular the following metacharacters have their standard I<egrep>-ish meanings: - \ Quote the next meta-character + \ Quote the next metacharacter ^ Match the beginning of the line . Match any character (except newline) $ Match the end of the line (or before newline at the end) @@ -106,13 +106,11 @@ as a regular character.) The "*" modifier is equivalent to C<{0,}>, the "+" modifier to C<{1,}>, and the "?" modifier to C<{0,1}>. n and m are limited to integral values less than 65536. -By default, a quantified sub-pattern is "greedy", that is, it will match as -many times as possible without causing the rest of the pattern not to match. -The standard quantifiers are all "greedy", in that they match as many -occurrences as possible (given a particular starting location) without -causing the pattern to fail. If you want it to match the minimum number -of times possible, follow the quantifier with a "?" after any of them. -Note that the meanings don't change, just the "gravity": +By default, a quantified subpattern is "greedy", that is, it will match as +many times as possible (given a particular starting location) while still +allowing the rest of the pattern to match. If you want it to match the +minimum number of times possible, follow the quantifier with a "?". Note +that the meanings don't change, just the "greediness": *? Match 0 or more times +? Match 1 or more times @@ -176,7 +174,7 @@ just like "^" and "$" except that they won't match multiple times when the C</m> modifier is used, while "^" and "$" will match at every internal line boundary. To match the actual end of the string, not ignoring newline, you can use C<\Z(?!\n)>. The C<\G> assertion can be used to mix global -matches (using C<m//g>) and non-global ones, as described in +matches (using C<m//g>) and non-global ones, as described in L<perlop/"Regexp Quote-Like Operators">. It is also useful when writing C<lex>-like scanners, when you have several regexps which you want to match against consequent substrings of your @@ -230,14 +228,14 @@ You will note that all backslashed metacharacters in Perl are alphanumeric, such as C<\b>, C<\w>, C<\n>. Unlike some other regular expression languages, there are no backslashed symbols that aren't alphanumeric. So anything that looks like \\, \(, \), \E<lt>, \E<gt>, \{, or \} is always -interpreted as a literal character, not a meta-character. This makes it +interpreted as a literal character, not a metacharacter. This makes it simple to quote a string that you want to use for a pattern but that you are afraid might contain metacharacters. Quote simply all the non-alphanumeric characters: $pattern =~ s/(\W)/\\$1/g; -You can also use the built-in quotemeta() function to do this. +You can also use the builtin quotemeta() function to do this. An even easier way to quote metacharacters right in the match operator is to say @@ -420,7 +418,7 @@ definition might succeed against a particular string. And if there are multiple ways it might succeed, you need to understand backtracking to know which variety of success you will achieve. When using lookahead assertions and negations, this can all get even -tricker. Imagine you'd like to find a sequence of non-digits not +tricker. Imagine you'd like to find a sequence of non-digits not followed by "123". You might try to write that as $_ = "ABC123"; @@ -454,14 +452,14 @@ backtracking, whereas test 1 will not. What's happening is that you've asked "Is it true that at the start of $x, following 0 or more non-digits, you have something that's not 123?" If the pattern matcher had let C<\D*> expand to "ABC", this would have caused the whole pattern to -fail. +fail. The search engine will initially match C<\D*> with "ABC". Then it will try to match C<(?!123> with "123" which, of course, fails. But because a quantifier (C<\D*>) has been used in the regular expression, the search engine can backtrack and retry the match differently -in the hope of matching the complete regular expression. +in the hope of matching the complete regular expression. -Well now, +Well now, the pattern really, I<really> wants to succeed, so it uses the standard regexp back-off-and-retry and lets C<\D*> expand to just "AB" this time. Now there's indeed something following "AB" that is not @@ -503,7 +501,7 @@ it would take literally forever--or until you ran out of stack space. In case you're not familiar with the "regular" Version 8 regexp routines, here are the pattern-matching rules not described above. -Any single character matches itself, unless it is a I<meta-character> +Any single character matches itself, unless it is a I<metacharacter> with a special meaning described here or above. You can cause characters which normally function as metacharacters to be interpreted literally by prefixing them with a "\" (e.g., "\." matches a ".", not any @@ -518,13 +516,13 @@ in the list. Within a list, the "-" character is used to specify a range, so that C<a-z> represents all the characters between "a" and "z", inclusive. -Characters may be specified using a meta-character syntax much like that +Characters may be specified using a metacharacter syntax much like that used in C: "\n" matches a newline, "\t" a tab, "\r" a carriage return, "\f" a form feed, etc. More generally, \I<nnn>, where I<nnn> is a string of octal digits, matches the character whose ASCII value is I<nnn>. Similarly, \xI<nn>, where I<nn> are hexadecimal digits, matches the character whose ASCII value is I<nn>. The expression \cI<x> matches the -ASCII character control-I<x>. Finally, the "." meta-character matches any +ASCII character control-I<x>. Finally, the "." metacharacter matches any character except "\n" (unless you use C</s>). You can specify a series of alternatives for a pattern using "|" to @@ -539,14 +537,14 @@ start and end. Note however that "|" is interpreted as a literal with square brackets, so if you write C<[fee|fie|foe]> you're really only matching C<[feio|]>. -Within a pattern, you may designate sub-patterns for later reference by +Within a pattern, you may designate subpatterns for later reference by enclosing them in parentheses, and you may refer back to the I<n>th -sub-pattern later in the pattern using the meta-character \I<n>. -Sub-patterns are numbered based on the left to right order of their +subpattern later in the pattern using the metacharacter \I<n>. +Subpatterns are numbered based on the left to right order of their opening parenthesis. Note that a backreference matches whatever -actually matched the sub-pattern in the string being examined, not the -rules for that sub-pattern. Therefore, C<(0|0x)\d*\s\1\d*> will -match "0x1234 0x4321",but not "0x1234 01234", because sub-pattern 1 +actually matched the subpattern in the string being examined, not the +rules for that subpattern. Therefore, C<(0|0x)\d*\s\1\d*> will +match "0x1234 0x4321",but not "0x1234 01234", because subpattern 1 actually matched "0x", even though the rule C<0|0x> could potentially match the leading 0 in the second number. diff --git a/pod/perlref.pod b/pod/perlref.pod index 7b522eee4d..cf793652f7 100644 --- a/pod/perlref.pod +++ b/pod/perlref.pod @@ -14,36 +14,41 @@ contain scalars, you can now easily build arrays of arrays, arrays of hashes, hashes of arrays, arrays of hashes of functions, and so on. Hard references are smart--they keep track of reference counts for you, -automatically freeing the thing referred to when its reference count -goes to zero. (Note: The reference counts for values in self-referential -or cyclic data structures may not go to zero without a little help; see +automatically freeing the thing referred to when its reference count goes +to zero. (Note: The reference counts for values in self-referential or +cyclic data structures may not go to zero without a little help; see L<perlobj/"Two-Phased Garbage Collection"> for a detailed explanation. -If that thing happens to be an object, the object is -destructed. See L<perlobj> for more about objects. (In a sense, -everything in Perl is an object, but we usually reserve the word for -references to objects that have been officially "blessed" into a class package.) - - -A symbolic reference contains the name of a variable, just as a -symbolic link in the filesystem contains merely the name of a file. -The C<*glob> notation is a kind of symbolic reference. Hard references -are more like hard links in the file system: merely another way -at getting at the same underlying object, irrespective of its name. - -"Hard" references are easy to use in Perl. There is just one -overriding principle: Perl does no implicit referencing or -dereferencing. When a scalar is holding a reference, it always behaves -as a scalar. It doesn't magically start being an array or a hash -unless you tell it so explicitly by dereferencing it. - -References can be constructed several ways. +If that thing happens to be an object, the object is destructed. See +L<perlobj> for more about objects. (In a sense, everything in Perl is an +object, but we usually reserve the word for references to objects that +have been officially "blessed" into a class package.) + +Symbolic references are names of variables or other objects, just as a +symbolic link in a Unix filesystem contains merely the name of a file. +The C<*glob> notation is a kind of symbolic reference. (Symbolic +references are sometimes called "soft references", but please don't call +them that; references are confusing enough without useless synonyms.) + +In contrast, hard references are more like hard links in a Unix file +system: They are used to access an underlying object without concern for +what its (other) name is. When the word "reference" is used without an +adjective, like in the following paragraph, it usually is talking about a +hard reference. + +References are easy to use in Perl. There is just one overriding +principle: Perl does no implicit referencing or dereferencing. When a +scalar is holding a reference, it always behaves as a simple scalar. It +doesn't magically start being an array or hash or subroutine; you have to +tell it explicitly to do so, by dereferencing it. + +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 @@ -58,7 +63,7 @@ reference that the backslash returned. Here are some examples: It isn't possible to create a true reference to an IO handle (filehandle or dirhandle) using the backslash operator. See the explanation of the *foo{THING} syntax below. (However, you're apt to find Perl code -out there using globrefs as though they were IO handles, which is +out there using globrefs as though they were IO handles, which is grandfathered into continued functioning.) =item 2. @@ -69,7 +74,7 @@ brackets: $arrayref = [1, 2, ['a', 'b', 'c']]; Here we've constructed a reference to an anonymous array of three elements -whose final element is itself reference to another anonymous array of three +whose final element is itself a reference to another anonymous array of three elements. (The multidimensional syntax described later can be used to access this. For example, after the above, C<$arrayref-E<gt>[2][1]> would have the value "b".) @@ -78,10 +83,10 @@ Note that taking a reference to an enumerated list is not the same as using square brackets--instead it's the same as creating a list of references! - @list = (\$a, \@b, \%c); + @list = (\$a, \@b, \%c); @list = \($a, @b, %c); # same thing! -As a special case, C<\(@foo)> returns a list of references to the contents +As a special case, C<\(@foo)> returns a list of references to the contents of C<@foo>, not a reference to C<@foo> itself. Likewise for C<%foo>. =item 3. @@ -138,8 +143,8 @@ context even when it's called outside of the context. In human terms, it's a funny way of passing arguments to a subroutine when you define it as well as when you call it. It's useful for setting up little bits of code to run later, such as callbacks. You can even -do object-oriented stuff with it, though Perl provides a different -mechanism to do that already--see L<perlobj>. +do object-oriented stuff with it, though Perl already provides a different +mechanism to do that--see L<perlobj>. You can also think of closure as a way to write a subroutine template without using eval. (In fact, in version 5.000, eval was the I<only> way to get @@ -293,7 +298,7 @@ Admittedly, it's a little silly to use the curlies in this case, but the BLOCK can contain any arbitrary expression, in particular, subscripted expressions: - &{ $dispatch{$index} }(1,2,3); # call correct routine + &{ $dispatch{$index} }(1,2,3); # call correct routine Because of being able to omit the curlies for the simple case of C<$$x>, people often make the mistake of viewing the dereferencing symbols as @@ -411,7 +416,7 @@ that, you can say use strict 'refs'; and then only hard references will be allowed for the rest of the enclosing -block. An inner block may countermand that with +block. An inner block may countermand that with no strict 'refs'; @@ -424,7 +429,7 @@ invisible to this mechanism. For example: { my $value = 20; print $$ref; - } + } This will still print 10, not 20. Remember that local() affects package variables, which are all "global" to the package. @@ -490,7 +495,7 @@ converted into a string: $x{ \$a } = $a; -If you try to dereference the key, it won't do a hard dereference, and +If you try to dereference the key, it won't do a hard dereference, and you won't accomplish what you're attempting. You might want to do something more like diff --git a/pod/perlrun.pod b/pod/perlrun.pod index a2e0764c7b..33beee7cc7 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -44,7 +44,7 @@ beginning, unless you've specified a B<-x> switch, in which case it scans for the first line starting with #! and containing the word "perl", and starts there instead. This is useful for running a script embedded in a larger message. (In this case you would indicate the end -of the script using the __END__ token.) +of the script using the C<__END__> token.) The #! line is always examined for switches as the line is being parsed. Thus, if you're on a machine that allows only one argument @@ -81,7 +81,7 @@ dispatch the program to the correct interpreter for them. After locating your script, Perl compiles the entire script to an internal form. If there are any compilation errors, execution of the script is not attempted. (This is unlike the typical shell script, -which might run partway through before finding a syntax error.) +which might run part-way through before finding a syntax error.) If the script is syntactically correct, it is executed. If the script runs off the end without hitting an exit() or die() operator, an implicit @@ -102,7 +102,7 @@ Put as the first line in C<*.cmd> file (C<-S> due to a bug in cmd.exe's `extproc' handling). -=item DOS +=item MS-DOS Create a batch file to run your script, and codify it in C<ALTERNATIVE_SHEBANG> (see the F<dosish.h> file in the source @@ -113,7 +113,7 @@ distribution for more information). The Win95/NT installation, when using the Activeware port of Perl, will modify the Registry to associate the .pl extension with the perl interpreter. If you install another port of Perl, including the one -in the win32 directory of the Perl distribution, then you'll have to +in the Win32 directory of the Perl distribution, then you'll have to modify the Registry yourself. =item Macintosh @@ -138,10 +138,10 @@ For example: # Unix perl -e 'print "Hello world\n"' - # DOS, etc. + # MS-DOS, etc. perl -e "print \"Hello world\n\"" - # Mac + # Macintosh print "Hello world\n" (then Run "Myscript" or Shift-Command-R) @@ -149,7 +149,7 @@ For example: perl -e "print ""Hello world\n""" The problem is that none of this is reliable: it depends on the command -tirely possible neither works. If 4DOS was the command shell, this would +and it is entirely possible neither works. If 4DOS was the command shell, this would probably work better: perl -e "print <Ctrl-x>"Hello world\n<Ctrl-x>"" @@ -158,9 +158,9 @@ CMD.EXE in Windows NT slipped a lot of standard Unix functionality in when nobody was looking, but just try to find documentation for its quoting rules. -Under the Mac, it depends which environment you are using. The MacPerl +Under the Macintosh, it depends which environment you are using. The MacPerl shell, or MPW, is much like Unix shells in its support for several -quoting variants, except that it makes free use of the Mac's non-ASCII +quoting variants, except that it makes free use of the Macintosh's non-ASCII characters as control characters. There is no general solution to all of this. It's just a mess. @@ -211,7 +211,7 @@ An alternate delimiter may be specified using B<-F>. causes Perl to check the syntax of the script and then exit without executing it. Actually, it I<will> execute C<BEGIN>, C<END>, and C<use> blocks, -because these are considered as occurring outside the execution of +because these are considered as occurring outside the execution of your program. =item B<-d> @@ -254,11 +254,11 @@ equivalent to B<-Dtls>): =item B<-e> I<commandline> -may be used to enter one line of script. +may be used to enter one line of script. If B<-e> is given, Perl -will not look for a script filename in the argument list. +will not look for a script filename in the argument list. Multiple B<-e> commands may -be given to build up a multi-line script. +be given to build up a multi-line script. Make sure to use semicolons where you would in a normal program. =item B<-F>I<pattern> @@ -309,8 +309,8 @@ know when the filename has changed. It does, however, use ARGVOUT for the selected filehandle. Note that STDOUT is restored as the default output filehandle after the loop. -You can use C<eof> without parenthesis to locate the end of each input file, -in case you want to append to each file, or reset line numbering (see +You can use C<eof> without parenthesis to locate the end of each input file, +in case you want to append to each file, or reset line numbering (see example in L<perlfunc/eof>). =item B<-I>I<directory> @@ -358,7 +358,7 @@ e.g., C<-M'module qw(foo bar)'>. If the first character after the C<-M> or C<-m> is a dash (C<->) then the 'use' is replaced with 'no'. -A little built-in syntactic sugar means you can also say +A little builtin syntactic sugar means you can also say C<-mmodule=foo,bar> or C<-Mmodule=foo,bar> as a shortcut for C<-M'module qw(foo bar)'>. This avoids the need to use quotes when importing symbols. The actual code generated by C<-Mmodule=foo,bar> is @@ -547,6 +547,14 @@ instead say use lib "/my/directory"; +=item PERL5OPT + +Command-line options (switches). Switches in this variable are taken +as if they were on every Perl command line. Only the B<-[DIMUdmw]> +switches are allowed. When running taint checks (because the script +was running setuid or setgid, or the B<-T> switch was used), this +variable is ignored. + =item PERLLIB A colon-separated list of directories in which to look for Perl library diff --git a/pod/perlsec.pod b/pod/perlsec.pod index 0d72cf0ca6..e21f97f21f 100644 --- a/pod/perlsec.pod +++ b/pod/perlsec.pod @@ -6,10 +6,10 @@ perlsec - Perl security Perl is designed to make it easy to program securely even when running with extra privileges, like setuid or setgid programs. Unlike most -command-line shells, which are based on multiple substitution passes on +command line shells, which are based on multiple substitution passes on each line of the script, Perl uses a more conventional evaluation scheme with fewer hidden snags. Additionally, because the language has more -built-in functionality, it can rely less upon external (and possibly +builtin functionality, it can rely less upon external (and possibly untrustworthy) programs to accomplish its purposes. Perl automatically enables a set of special security checks, called I<taint @@ -29,7 +29,7 @@ and it is these checks especially that contribute to making a setuid Perl program more secure than the corresponding C program. You may not use data derived from outside your program to affect something -else outside your program--at least, not by accident. All command-line +else outside your program--at least, not by accident. All command line arguments, environment variables, locale information (see L<perllocale>), and file input are marked as "tainted". Tainted data may not be used directly or indirectly in any command that invokes a sub-shell, nor in any @@ -57,7 +57,7 @@ For example: $path = $ENV{'PATH'}; # $path now tainted - $ENV{'PATH'} = '/bin:/usr/bin'; + $ENV{'PATH'} = '/bin:/usr/bin'; $ENV{'IFS'} = '' if $ENV{'IFS'} ne ''; $path = $ENV{'PATH'}; # $path now NOT tainted @@ -82,7 +82,7 @@ For example: If you try to do something insecure, you will get a fatal error saying something like "Insecure dependency" or "Insecure PATH". Note that you can still write an insecure B<system> or B<exec>, but only by explicitly -doing something like the last example above. +doing something like the last example above. =head2 Laundering and Detecting Tainted Data @@ -91,9 +91,9 @@ trigger an "Insecure dependency" message, you can use the following I<is_tainted()> function. sub is_tainted { - return ! eval { - join('',@_), kill 0; - 1; + return ! eval { + join('',@_), kill 0; + 1; }; } @@ -106,7 +106,7 @@ same expression, the whole expression is considered tainted. But testing for taintedness gets you only so far. Sometimes you have just to clear your data's taintedness. The only way to bypass the tainting -mechanism is by referencing sub-patterns from a regular expression match. +mechanism is by referencing subpatterns from a regular expression match. Perl presumes that if you reference a substring using $1, $2, etc., that you knew what you were doing when you wrote the pattern. That means using a bit of thought--don't just blindly untaint anything, or you defeat the @@ -119,7 +119,7 @@ Here's a test to make sure that the data contains nothing but "word" characters (alphabetics, numerics, and underscores), a hyphen, an at sign, or a dot. - if ($data =~ /^([-\@\w.]+)$/) { + if ($data =~ /^([-\@\w.]+)$/) { $data = $1; # $data now untainted } else { die "Bad data in $data"; # log this somewhere @@ -146,12 +146,12 @@ block. See L<perllocale/SECURITY> for further discussion and examples. When you make a script executable, in order to make it usable as a command, the system will pass switches to perl from the script's #! -line. Perl checks that any command-line switches given to a setuid +line. Perl checks that any command line switches given to a setuid (or setgid) script actually match the ones set on the #! line. Some -UNIX and UNIX-like environments impose a one-switch limit on the #! +Unix and Unix-like environments impose a one-switch limit on the #! line, so you may need to use something like C<-wU> instead of C<-w -U> -under such systems. (This issue should arise only in UNIX or -UNIX-like environments that support #! and setuid or setgid scripts.) +under such systems. (This issue should arise only in Unix or +Unix-like environments that support #! and setuid or setgid scripts.) =head2 Cleaning Up Your Path @@ -164,7 +164,7 @@ it's generated because you never set your PATH environment variable, or you didn't set it to something that was safe. Because Perl can't guarantee that the executable in question isn't itself going to turn around and execute some other program that is dependent on your PATH, it -makes sure you set the PATH. +makes sure you set the PATH. It's also possible to get into trouble with other operations that don't care whether they use tainted values. Make judicious use of the file @@ -177,8 +177,8 @@ prevent stupid mistakes, not to remove the need for thought. Perl does not call the shell to expand wild cards when you pass B<system> and B<exec> explicit parameter lists instead of strings with possible shell wildcards in them. Unfortunately, the B<open>, B<glob>, and -back-tick functions provide no such alternate calling convention, so more -subterfuge will be required. +backtick functions provide no such alternate calling convention, so more +subterfuge will be required. Perl provides a reasonably safe way to open a file or pipe from a setuid or setgid program: just create a child process with reduced privilege who @@ -193,13 +193,13 @@ parent. Because the file or pipe was opened in the child while running under less privilege than the parent, it's not apt to be tricked into doing something it shouldn't. -Here's a way to do back-ticks reasonably safely. Notice how the B<exec> is +Here's a way to do backticks reasonably safely. Notice how the B<exec> is not called with a string that the shell could expand. This is by far the best way to call something that might be subjected to shell escapes: just never call the shell at all. By the time we get to the B<exec>, tainting is turned off, however, so be careful what you call and what you pass it. - use English; + use English; die unless defined $pid = open(KID, "-|"); if ($pid) { # parent while (<KID>) { @@ -247,7 +247,7 @@ Alternately, it can simply ignore the setuid bit on scripts. If the latter is true, Perl can emulate the setuid and setgid mechanism when it notices the otherwise useless setuid/gid bits on Perl scripts. It does this via a special executable called B<suidperl> that is automatically -invoked for you if it's needed. +invoked for you if it's needed. However, if the kernel setuid script feature isn't disabled, Perl will complain loudly that your setuid script is insecure. You'll need to @@ -258,14 +258,14 @@ kernel bug that plagues setuid scripts. Here's a simple wrapper, written in C: #define REAL_PATH "/path/to/script" - main(ac, av) + main(ac, av) char **av; { execv(REAL_PATH, av); - } + } -Compile this wrapper into a binary executable and then make I<it> rather -than your script setuid or setgid. +Compile this wrapper into a binary executable and then make I<it> rather +than your script setuid or setgid. See the program B<wrapsuid> in the F<eg> directory of your Perl distribution for a convenient way to do this automatically for all your @@ -308,7 +308,7 @@ instead of fixing them, is little security indeed. You can try using encryption via source filters (Filter::* from CPAN). But crackers might be able to decrypt it. You can try using the -byte-code compiler and interpreter described below, but crackers might +byte code compiler and interpreter described below, but crackers might be able to de-compile it. You can try using the native-code compiler described below, but crackers might be able to disassemble it. These pose varying degrees of difficulty to people wanting to get at your diff --git a/pod/perlstyle.pod b/pod/perlstyle.pod index 734b9ad032..bfc94a9eaa 100644 --- a/pod/perlstyle.pod +++ b/pod/perlstyle.pod @@ -6,7 +6,7 @@ perlstyle - Perl style guide Each programmer will, of course, have his or her own preferences in regards to formatting, but there are some general guidelines that will -make your programs easier to read, understand, and maintain. +make your programs easier to read, understand, and maintain. The most important thing is to run your programs under the B<-w> flag at all times. You may turn it off explicitly for particular @@ -154,13 +154,13 @@ the middle. Just "outdent" it a little to make it more visible: =item * Don't be afraid to use loop labels--they're there to enhance -readability as well as to allow multi-level loop breaks. See the +readability as well as to allow multilevel loop breaks. See the previous example. =item * Avoid using grep() (or map()) or `backticks` in a void context, that is, -when you just throw away their return values. Those functions all +when you just throw away their return values. Those functions all have return values, so use them. Otherwise use a foreach() loop or the system() function instead. @@ -178,7 +178,7 @@ determined by the B<Configure> program when Perl was installed. Choose mnemonic identifiers. If you can't remember what mnemonic means, you've got a problem. -=item * +=item * While short identifiers like $gotit are probably ok, use underscores to separate words. It is generally easier to read $var_names_like_this than @@ -190,19 +190,19 @@ reserves lowercase module names for "pragma" modules like C<integer> and C<strict>. Other modules should begin with a capital letter and use mixed case, but probably without underscores due to limitations in primitive file systems' representations of module names as files that must fit into a -few sparse bites. +few sparse bytes. =item * -You may find it helpful to use letter case to indicate the scope -or nature of a variable. For example: +You may find it helpful to use letter case to indicate the scope +or nature of a variable. For example: - $ALL_CAPS_HERE constants only (beware clashes with perl vars!) - $Some_Caps_Here package-wide global/static - $no_caps_here function scope my() or local() variables + $ALL_CAPS_HERE constants only (beware clashes with perl vars!) + $Some_Caps_Here package-wide global/static + $no_caps_here function scope my() or local() variables -Function and method names seem to work best as all lowercase. -E.g., $obj-E<gt>as_string(). +Function and method names seem to work best as all lowercase. +E.g., $obj-E<gt>as_string(). You can use a leading underscore to indicate that a variable or function should not be used outside the package that defined it. @@ -227,12 +227,12 @@ Use here documents instead of repeated print() statements. =item * Line up corresponding things vertically, especially if it'd be too long -to fit on one line anyway. +to fit on one line anyway. - $IDX = $ST_MTIME; - $IDX = $ST_ATIME if $opt_u; - $IDX = $ST_CTIME if $opt_c; - $IDX = $ST_SIZE if $opt_s; + $IDX = $ST_MTIME; + $IDX = $ST_ATIME if $opt_u; + $IDX = $ST_CTIME if $opt_c; + $IDX = $ST_SIZE if $opt_s; mkdir $tmpdir, 0700 or die "can't mkdir $tmpdir: $!"; chdir($tmpdir) or die "can't chdir $tmpdir: $!"; diff --git a/pod/perlsub.pod b/pod/perlsub.pod index f2a5b8ff0f..602e5c0dda 100644 --- a/pod/perlsub.pod +++ b/pod/perlsub.pod @@ -23,7 +23,7 @@ To import subroutines: To call subroutines: NAME(LIST); # & is optional with parentheses. - NAME LIST; # Parentheses optional if pre-declared/imported. + NAME LIST; # Parentheses optional if predeclared/imported. &NAME; # Passes current @_ to subroutine. =head1 DESCRIPTION @@ -47,13 +47,25 @@ there's really no difference from the language's perspective.) Any arguments passed to the routine come in as the array @_. Thus if you called a function with two arguments, those would be stored in C<$_[0]> -and C<$_[1]>. The array @_ is a local array, but its values are implicit -references (predating L<perlref>) to the actual scalar parameters. 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. +and C<$_[1]>. The array @_ is a local array, but its elements are +aliases for the actual scalar parameters. In particular, if an element +C<$_[0]> is updated, the corresponding argument is updated (or an error +occurs if it is not updatable). If an argument is an array or hash +element which did not exist when the function was called, that element is +created only when (and if) it is modified or if a reference to it is +taken. (Some earlier versions of Perl created the element whether or not +it was assigned to.) Note that assigning to the whole array @_ removes +the aliasing, and does not update any arguments. + +The return value of the subroutine is the value of the last expression +evaluated. Alternatively, a return statement may be used exit the +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 @@ -81,7 +93,7 @@ Example: sub get_line { $thisline = $lookahead; # GLOBAL VARIABLES!! - LINE: while ($lookahead = <STDIN>) { + LINE: while (defined($lookahead = <STDIN>)) { if ($lookahead =~ /^[ \t]/) { $thisline .= $lookahead; } @@ -110,8 +122,8 @@ do in-place modifications of @_ and change its caller's values. upcase_in($v1, $v2); # this changes $v1 and $v2 sub upcase_in { - for (@_) { tr/a-z/A-Z/ } - } + for (@_) { tr/a-z/A-Z/ } + } You aren't allowed to modify constants in this way, of course. If an argument were actually literal and you tried to change it, you'd take a @@ -119,17 +131,17 @@ argument were actually literal and you tried to change it, you'd take a upcase_in("frederick"); -It would be much safer if the upcase_in() function +It would be much safer if the upcase_in() function were written to return a copy of its parameters instead of changing them in place: ($v3, $v4) = upcase($v1, $v2); # this doesn't sub upcase { + return unless defined wantarray; # void context, do nothing my @parms = @_; - for (@parms) { tr/a-z/A-Z/ } - # wantarray checks if we were called in list context + for (@parms) { tr/a-z/A-Z/ } return wantarray ? @parms : $parms[0]; - } + } Notice how this (unprototyped) function doesn't care whether it was passed real scalars or arrays. Perl will see everything as one big long flat @_ @@ -151,7 +163,7 @@ made @b an empty list. See L</"Pass by Reference"> for alternatives. A subroutine may be called using the "&" prefix. The "&" is optional in modern Perls, and so are the parentheses if the subroutine has been -pre-declared. (Note, however, that the "&" is I<NOT> optional when +predeclared. (Note, however, that the "&" is I<NOT> optional when you're just naming the subroutine, such as when it's used as an argument to defined() or undef(). Nor is it optional when you want to do an indirect subroutine call with a subroutine name or reference @@ -171,7 +183,7 @@ new users may wish to avoid. &foo(); # the same &foo; # foo() get current args, like foo(@_) !! - foo; # like foo() IFF sub foo pre-declared, else "foo" + foo; # like foo() IFF sub foo predeclared, else "foo" Not only does the "&" form make the argument list optional, but it also disables any prototype checking on the arguments you do provide. This @@ -218,7 +230,7 @@ this is used to name the parameters to a subroutine. Examples: my $arg = shift; # name doesn't matter $arg **= 1/3; return $arg; - } + } The "my" is simply a modifier on something you might assign to. So when you do assign to the variables in its argument list, the "my" doesn't @@ -245,7 +257,7 @@ the current statement. Thus, my $x = $x; -can be used to initialize the new $x with the value of the old $x, and +can be used to initialize the new $x with the value of the old $x, and the expression my $x = 123 and $x == 123 @@ -256,7 +268,7 @@ Lexical scopes of control structures are not bounded precisely by the braces that delimit their controlled blocks; control expressions are part of the scope, too. Thus in the loop - while (my $line = <>) { + while (defined(my $line = <>)) { $line = lc $line; } continue { print $line; @@ -359,28 +371,28 @@ just enclose the whole function in an extra block, and put the static variable outside the function but in the block. { - my $secret_val = 0; + my $secret_val = 0; sub gimme_another { return ++$secret_val; - } - } + } + } # $secret_val now becomes unreachable by the outside # world, but retains its value between calls to gimme_another -If this function is being sourced in from a separate file +If this function is being sourced in from a separate file via C<require> or C<use>, then this is probably just fine. If it's -all in the main program, you'll need to arrange for the my() +all in the main program, you'll need to arrange for the my() to be executed early, either by putting the whole block above -your pain program, or more likely, placing merely a BEGIN +your pain program, or more likely, placing merely a BEGIN sub around it to make sure it gets executed before your program starts to run: sub BEGIN { - my $secret_val = 0; + my $secret_val = 0; sub gimme_another { return ++$secret_val; - } - } + } + } See L<perlrun> about the BEGIN function. @@ -404,7 +416,7 @@ Synopsis: local *merlyn = *randal; # now $merlyn is really $randal, plus # @merlyn is really @randal, etc local *merlyn = 'randal'; # SAME THING: promote 'randal' to *randal - local *merlyn = \$randal; # just alias $merlyn, not @merlyn etc + local *merlyn = \$randal; # just alias $merlyn, not @merlyn etc A local() modifies its listed variables to be local to the enclosing block, (or subroutine, C<eval{}>, or C<do>) and I<any called from @@ -425,9 +437,9 @@ subroutine. Examples: for $i ( 0 .. 9 ) { $digits{$i} = $i; - } + } # assume this function uses global %digits hash - parse_num(); + parse_num(); # now temporarily add to %digits hash if ($base12) { @@ -517,29 +529,29 @@ list of all their former last elements: my @retlist = (); foreach $aref ( @_ ) { push @retlist, pop @$aref; - } + } return @retlist; - } + } -Here's how you might write a function that returns a +Here's how you might write a function that returns a list of keys occurring in all the hashes passed to it: - @common = inter( \%foo, \%bar, \%joe ); + @common = inter( \%foo, \%bar, \%joe ); sub inter { my ($k, $href, %seen); # locals foreach $href (@_) { while ( $k = each %$href ) { $seen{$k}++; - } - } + } + } return grep { $seen{$_} == @_ } keys %seen; - } + } So far, we're using just the normal list return mechanism. -What happens if you want to pass or return a hash? Well, -if you're using only one of them, or you don't mind them +What happens if you want to pass or return a hash? Well, +if you're using only one of them, or you don't mind them concatenating, then the normal calling convention is ok, although -a little expensive. +a little expensive. Where people get into trouble is here: @@ -564,8 +576,8 @@ in order of how many elements they have in them: return ($cref, $dref); } else { return ($dref, $cref); - } - } + } + } It turns out that you can actually do this also: @@ -577,8 +589,8 @@ It turns out that you can actually do this also: return (\@c, \@d); } else { return (\@d, \@c); - } - } + } + } Here we're using the typeglobs to do symbol table aliasing. It's a tad subtle, though, and also won't work if you're using my() @@ -609,7 +621,7 @@ If you're planning on generating new filehandles, you could do this: my $name = shift; local *FH; return open (FH, $path) ? *FH : undef; - } + } Although that will actually produce a small memory leak. See the bottom of L<perlfunc/open()> for a somewhat cleaner way using the IO::Handle @@ -736,7 +748,7 @@ if you decide that a function should take just one parameter, like this: sub func ($) { my $n = shift; print "you gave me $n\n"; - } + } and someone has been calling it with an array or expression returning a list: @@ -752,15 +764,17 @@ in @foo. And the split() gets called in a scalar context and starts scribbling on your @_ parameter list. This is all very powerful, of course, and should be used only in moderation -to make the world a better place. +to make the world a better place. =head2 Constant Functions Functions with a prototype of C<()> are potential candidates for -inlining. If the result after optimization and constant folding is a -constant then it will be used in place of new-style calls to the -function. Old-style calls (that is, calls made using C<&>) are not -affected. +inlining. If the result after optimization and constant folding is +either a constant or a lexically-scoped scalar which has no other +references, then it will be used in place of function calls made +without C<&> or C<do>. Calls made using C<&> or C<do> are never +inlined. (See constant.pm for an easy way to declare most +constants.) All of the following functions would be inlined. @@ -773,8 +787,8 @@ All of the following functions would be inlined. sub FLAG_FOO () { 1 << 8 } sub FLAG_BAR () { 1 << 9 } sub FLAG_MASK () { FLAG_FOO | FLAG_BAR } - - sub OPT_BAZ () { 1 } + + sub OPT_BAZ () { not (0x1B58 & FLAG_MASK) } sub BAZ_VAL () { if (OPT_BAZ) { return 23; @@ -784,6 +798,13 @@ All of the following functions would be inlined. } } + sub N () { int(BAZ_VAL) / 3 } + BEGIN { + my $prod = 1; + for (1..N) { $prod *= $_ } + sub N_FACTORIAL () { $prod } + } + If you redefine a subroutine which was eligible for inlining you'll get a mandatory warning. (You can use this warning to tell whether or not a particular subroutine is considered constant.) The warning is @@ -794,9 +815,8 @@ ensure that it isn't inlined, either by dropping the C<()> prototype (which changes the calling semantics, so beware) or by thwarting the inlining mechanism in some other way, such as - my $dummy; sub not_inlined () { - $dummy || 23 + 23 if $]; } =head2 Overriding Builtin Functions @@ -808,7 +828,7 @@ on a non-Unix system. Overriding may be done only by importing the name from a module--ordinary predeclaration isn't good enough. However, the -C<subs> pragma (compiler directive) lets you, in effect, pre-declare subs +C<subs> pragma (compiler directive) lets you, in effect, predeclare subs via the import syntax, and these names may then override the builtin ones: use subs 'chdir', 'chroot', 'chmod', 'chown'; @@ -856,12 +876,12 @@ should just call system() with those arguments. All you'd do is this: my $program = $AUTOLOAD; $program =~ s/.*:://; system($program, @_); - } + } date(); who('am', 'i'); ls('-l'); -In fact, if you pre-declare the functions you want to call that way, you don't +In fact, if you predeclare the functions you want to call that way, you don't even need the parentheses: use subs qw(date who ls); @@ -881,6 +901,6 @@ functions to perl code in L<perlxs>. =head1 SEE ALSO See L<perlref> for more on references. See L<perlxs> if you'd -like to learn about calling C subroutines from perl. See -L<perlmod> to learn about bundling up your functions in +like to learn about calling C subroutines from perl. See +L<perlmod> to learn about bundling up your functions in separate files. diff --git a/pod/perlsyn.pod b/pod/perlsyn.pod index 77dcc597a9..9c3f6617bd 100644 --- a/pod/perlsyn.pod +++ b/pod/perlsyn.pod @@ -32,20 +32,23 @@ that. A declaration can be put anywhere a statement can, but has no effect on the execution of the primary sequence of statements--declarations all take effect at compile time. Typically all the declarations are put at -the beginning or the end of the script. However, if you're using +the beginning or the end of the script. However, if you're using lexically-scoped private variables created with my(), you'll have to make sure your format or subroutine definition is within the same block scope as the my if you expect to be able to access those private variables. Declaring a subroutine allows a subroutine name to be used as if it were a list operator from that point forward in the program. You can declare a -subroutine (prototyped to take one scalar parameter) without defining it by saying just: +subroutine without defining it by saying C<sub name>, thus: - sub myname ($); + sub myname; $me = myname $0 or die "can't get myname"; -Note that it functions as a list operator though, not as a unary -operator, so be careful to use C<or> instead of C<||> there. +Note that it functions as a list operator, not as a unary operator; so +be careful to use C<or> instead of C<||> in this case. However, if +you were to declare the subroutine as C<sub myname ($)>, then +C<myname> would functonion as a unary operator, so either C<or> or +C<||> would work. Subroutines declarations can also be loaded up with the C<require> statement or both loaded and imported into your namespace with a C<use> statement. @@ -65,7 +68,7 @@ semicolon, unless it is the final statement in a block, in which case the semicolon is optional. (A semicolon is still encouraged there if the block takes up more than one line, because you may eventually add another line.) Note that there are some operators like C<eval {}> and C<do {}> that look -like compound statements, but aren't (they're just TERMs in an expression), +like compound statements, but aren't (they're just TERMs in an expression), and thus need an explicit termination if used as the last item in a statement. Any simple statement may optionally be followed by a I<SINGLE> modifier, @@ -178,25 +181,26 @@ want to skip ahead and get the next record. while (<>) { chomp; - if (s/\\$//) { - $_ .= <>; + if (s/\\$//) { + $_ .= <>; redo unless eof(); } # now process $_ - } + } which is Perl short-hand for the more explicitly written version: - LINE: while ($line = <ARGV>) { + LINE: while (defined($line = <ARGV>)) { chomp($line); - if ($line =~ s/\\$//) { - $line .= <ARGV>; + if ($line =~ s/\\$//) { + $line .= <ARGV>; redo LINE unless eof(); # not eof(ARGV)! } # now process $line - } + } -Or here's a simpleminded Pascal comment stripper (warning: assumes no { or } in strings). +Or here's a simpleminded Pascal comment stripper (warning: assumes no +{ or } in strings). LINE: while (<STDIN>) { while (s|({.*}.*){.*}|$1 |) {} @@ -246,15 +250,15 @@ for variables declared with C<my> in the initialization expression.) Besides the normal array index looping, C<for> can lend itself to many other interesting applications. Here's one that avoids the -problem you get into if you explicitly test for end-of-file on -an interactive file descriptor causing your program to appear to +problem you get into if you explicitly test for end-of-file on +an interactive file descriptor causing your program to appear to hang. $on_a_tty = -t STDIN && -t STDOUT; sub prompt { print "yes? " if $on_a_tty } for ( prompt(); <STDIN>; prompt() ) { # do something - } + } =head2 Foreach Loops @@ -309,12 +313,12 @@ Here's how a C programmer might code up a particular algorithm in Perl: Whereas here's how a Perl programmer more comfortable with the idiom might do it: - OUTER: foreach my $wid (@ary1) { + OUTER: foreach my $wid (@ary1) { INNER: foreach my $jet (@ary2) { next OUTER if $wid > $jet; $wid += $jet; - } - } + } + } See how much easier this is? It's cleaner, safer, and faster. It's cleaner because it's less noisy. It's safer because if code gets added @@ -370,19 +374,19 @@ or or formatted so it stands out more as a "proper" switch statement: SWITCH: { - /^abc/ && do { - $abc = 1; - last SWITCH; + /^abc/ && do { + $abc = 1; + last SWITCH; }; - /^def/ && do { - $def = 1; - last SWITCH; + /^def/ && do { + $def = 1; + last SWITCH; }; - /^xyz/ && do { - $xyz = 1; - last SWITCH; + /^xyz/ && do { + $xyz = 1; + last SWITCH; }; $nothing = 1; } @@ -416,14 +420,14 @@ a temporary assignment to $_ for convenient matching: /Anywhere/ && do { push @flags, '-h'; last; }; /In Rulings/ && do { last; }; die "unknown value for form variable where: `$where'"; - } + } Another interesting approach to a switch statement is arrange for a C<do> block to return the proper value: $amode = do { - if ($flag & O_RDONLY) { "r" } - elsif ($flag & O_WRONLY) { ($flag & O_APPEND) ? "a" : "w" } + if ($flag & O_RDONLY) { "r" } + elsif ($flag & O_WRONLY) { ($flag & O_APPEND) ? "a" : "w" } elsif ($flag & O_RDWR) { if ($flag & O_CREAT) { "w+" } else { ($flag & O_APPEND) ? "a+" : "r+" } @@ -475,14 +479,14 @@ encounters a line that begins with an equal sign and a word, like this Then that text and all remaining text up through and including a line beginning with C<=cut> will be ignored. The format of the intervening -text is described in L<perlpod>. +text is described in L<perlpod>. This allows you to intermix your source code and your documentation text freely, as in =item snazzle($) - The snazzle() function will behave in the most spectacular + The snazzle() function will behave in the most spectacular form that you can possibly imagine, not even excepting cybernetic pyrotechnics. @@ -491,11 +495,11 @@ and your documentation text freely, as in sub snazzle($) { my $thingie = shift; ......... - } + } -Note that pod translators should look at only paragraphs beginning +Note that pod translators should look at only paragraphs beginning with a pod directive (it makes parsing easier), whereas the compiler -actually knows to look for pod escapes even in the middle of a +actually knows to look for pod escapes even in the middle of a paragraph. This means that the following secret stuff will be ignored by both the compiler and the translators. @@ -532,18 +536,18 @@ shell: die 'foo'; __END__ foo at bzzzt line 201. - + % perl # line 200 "bzzzt" eval qq[\n#line 2001 ""\ndie 'foo']; print $@; __END__ foo at - line 2001. - + % perl eval qq[\n#line 200 "foo bar"\ndie 'foo']; print $@; __END__ foo at foo bar line 200. - + % perl # line 345 "goop" eval "\n#line " . __LINE__ . ' "' . __FILE__ ."\"\ndie 'foo'"; diff --git a/pod/perltie.pod b/pod/perltie.pod index 8dc7c17c14..847340d182 100644 --- a/pod/perltie.pod +++ b/pod/perltie.pod @@ -60,10 +60,10 @@ And now whenever either of those variables is accessed, its current system priority is retrieved and returned. If those variables are set, then the process's priority is changed! -We'll use Jarkko Hietaniemi <F<Jarkko.Hietaniemi@hut.fi>>'s -BSD::Resource class (not included) to access the PRIO_PROCESS, PRIO_MIN, -and PRIO_MAX constants from your system, as well as the getpriority() and -setpriority() system calls. Here's the preamble of the class. +We'll use Jarkko Hietaniemi <F<jhi@iki.fi>>'s BSD::Resource class (not +included) to access the PRIO_PROCESS, PRIO_MIN, and PRIO_MAX constants +from your system, as well as the getpriority() and setpriority() system +calls. Here's the preamble of the class. package Nice; use Carp; diff --git a/pod/perltoc.pod b/pod/perltoc.pod index 4e412bd7b8..467f02c31d 100644 --- a/pod/perltoc.pod +++ b/pod/perltoc.pod @@ -38,8 +38,8 @@ expression enhancements, Innumerable Unbundled Modules, Compilability =item NOTES -=head2 perlfaq - frequently asked questions about Perl ($Date: 1997/03/17 -22:17:56 $) +=head2 perlfaq - frequently asked questions about Perl ($Date: 1997/03/25 +18:20:48 $) =item DESCRIPTION @@ -66,7 +66,7 @@ authors =over -=item Non-commercial Reproduction +=item Noncommercial Reproduction =item Commercial Reproduction @@ -76,9 +76,10 @@ authors =item Changes -17/March/97 Version, Initial Release: 11/March/97 +25/March/97, 18/March/97, 17/March/97 Version, Initial Release: 11/March/97 -=head2 perlfaq1 - General Questions About Perl ($Revision: 1.10 $) +=head2 perlfaq1 - General Questions About Perl ($Revision: 1.11 $, $Date: +1997/03/19 17:23:09 $) =item DESCRIPTION @@ -118,7 +119,8 @@ Scheme, or Tcl? =item AUTHOR AND COPYRIGHT -=head2 perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.13 $) +=head2 perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.15 $, +$Date: 1997/03/25 18:15:48 $) =item DESCRIPTION @@ -128,6 +130,8 @@ Scheme, or Tcl? =item How can I get a binary version of Perl? +=item I don't have a C compiler on my system. How can I compile perl? + =item I copied the Perl binary from one machine to another, but scripts don't work. @@ -171,7 +175,8 @@ MacPerl, Perl5-Porters, NTPerl, Perl-Packrats =item AUTHOR AND COPYRIGHT -=head2 perlfaq3 - Programming Tools ($Revision: 1.19 $) +=head2 perlfaq3 - Programming Tools ($Revision: 1.20 $, $Date: 1997/03/19 +17:23:43 $) =item DESCRIPTION @@ -219,13 +224,13 @@ MacPerl, Perl5-Porters, NTPerl, Perl-Packrats =item How can I hide the source for my Perl program? -=item How can I compile my Perl program into byte-code or C? +=item How can I compile my Perl program into byte code or C? -=item How can I get '#!perl' to work on [MSDOS,NT,...]? +=item How can I get '#!perl' to work on [MS-DOS,Windows NT,...]? =item Can I write useful perl programs on the command line? -=item Why don't perl one-liners work on my DOS/Mac/VMS system? +=item Why don't perl one-liners work on my MS-DOS/Macintosh/VMS system? =item Where can I learn about CGI or Web programming in Perl? @@ -245,7 +250,8 @@ mean? =item AUTHOR AND COPYRIGHT -=head2 perlfaq4 - Data Manipulation ($Revision: 1.15 $) +=head2 perlfaq4 - Data Manipulation ($Revision: 1.17 $, $Date: 1997/03/25 +18:16:24 $) =item DESCRIPTION @@ -408,7 +414,7 @@ it? =item Why does passing a subroutine an undefined element in a hash create it? -=item How can I make the Perl equivalent of a C structure/C++ class/hash +=item How can I make the Perl equivalent of a C structure/C++ class/hash or array of hashes or arrays? =item How can I use a reference as a hash key? @@ -435,7 +441,8 @@ or array of hashes or arrays? =item AUTHOR AND COPYRIGHT -=head2 perlfaq5 - Files and Formats ($Revision: 1.19 $) +=head2 perlfaq5 - Files and Formats ($Revision: 1.20 $, $Date: 1997/03/19 +17:24:51 $) =item DESCRIPTION @@ -477,7 +484,7 @@ filehandles between subroutines? How do I make an array of filehandles? =item What can't I just open(FH, ">file.lock")? -=item I still don't get locking. I just want to increment the number +=item I still don't get locking. I just want to increment the number in the file. How can I do this? =item How do I randomly update a binary file? @@ -504,7 +511,7 @@ in the file. How can I do this? =item How do I close a file descriptor by number? -=item Why can't I use "C:\temp\foo" in DOS paths? What doesn't +=item Why can't I use "C:\temp\foo" in MS-DOS paths? What doesn't `C:\temp\foo.exe` work? =item Why doesn't glob("*.*") get all the files? @@ -518,14 +525,14 @@ protected files? Isn't this a bug in Perl? =item AUTHOR AND COPYRIGHT -=head2 perlfaq6 - Regexps ($Revision: 1.14 $) +=head2 perlfaq6 - Regexps ($Revision: 1.16 $, $Date: 1997/03/25 18:16:56 $) =item DESCRIPTION =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 @@ -544,7 +551,7 @@ case on the RHS? =item How can I match a locale-smart version of C</[a-zA-Z]/>? -=item How can I quote a variable to use in a regexp? +=item How can I quote a variable to use in a regexp? =item What is C</o> really for? @@ -573,13 +580,14 @@ file? =item What's wrong with using grep or map in a void context? -=item How can I match strings with multi-byte characters? +=item How can I match strings with multibyte characters? =back =item AUTHOR AND COPYRIGHT -=head2 perlfaq7 - Perl Language Issues ($Revision: 1.15 $) +=head2 perlfaq7 - Perl Language Issues ($Revision: 1.16 $, $Date: +1997/03/19 17:25:23 $) =item DESCRIPTION @@ -629,7 +637,7 @@ is in scope? =item Why doesn't "local($foo) = <FILE>;" work right? -=item How do I redefine a built-in function, operator, or method? +=item How do I redefine a builtin function, operator, or method? =item What's the difference between calling a function as &foo and foo()? @@ -645,7 +653,8 @@ is in scope? =item AUTHOR AND COPYRIGHT -=head2 perlfaq8 - System Interaction ($Revision: 1.15 $) +=head2 perlfaq8 - System Interaction ($Revision: 1.17 $, $Date: 1997/03/25 +18:17:12 $) =item DESCRIPTION @@ -694,6 +703,8 @@ does the error message "Protocol not supported" mean? =item How can I open a pipe both to and from a command? +=item Why can't I get the output of a command with system()? + =item How can I capture STDERR from an external command? =item Why doesn't open() return an error when a pipe open fails? @@ -703,7 +714,7 @@ does the error message "Protocol not supported" mean? =item How can I call backticks without shell processing? =item Why can't my script read from STDIN after I gave it EOF (^D on Unix, -^Z on MSDOS)? +^Z on MS-DOS)? =item How can I convert my shell script to perl? @@ -749,7 +760,8 @@ complete? =item AUTHOR AND COPYRIGHT -=head2 perlfaq9 - Networking ($Revision: 1.13 $) +=head2 perlfaq9 - Networking ($Revision: 1.15 $, $Date: 1997/03/25 18:17:20 +$) =item DESCRIPTION @@ -811,76 +823,87 @@ file on another machine? =over -=item Compilation Option: Binary Compatibility With 5.003 +=item Compilation option: Binary compatibility with 5.003 + +=item $PERL5OPT environment variable + +=item More precise warnings -=item No Autovivification of Subroutine Parameters +=item Deprecated: Inherited C<AUTOLOAD> for non-methods -=item Fixed Parsing of $$<digit>, &$<digit>, etc. +=item Subroutine arguments created only when they're modified -=item No Resetting of $. on Implicit Close +=item Fixed parsing of $$<digit>, &$<digit>, etc. -=item Changes to Tainting Checks +=item No resetting of $. on implicit close -=item New Opcode Module and Revised Safe Module +=item C<wantarray> may return undef -=item Embedding Improvements +=item Changes to tainting checks -=item Internal Change: FileHandle Class Based on IO::* Classes +=item New Opcode module and revised Safe module -=item Internal Change: PerlIO internal IO abstraction interface +=item Embedding improvements -=item New and Changed Built-in Variables +=item Internal change: FileHandle class based on IO::* classes + +=item Internal change: PerlIO abstraction interface + +=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 LIST, prototype(FUNCTION), srand, $_ as Default, C<m//g> does not trigger a -pos() reset on failure, nested C<sub{}> closures work now, formats work -right on changing lexicals +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 Math::Complex +=item Math::Trig + =item DB_File =item Net::Ping -=item Overridden Built-ins +=item Object-oriented overrides for builtin operators =back @@ -907,20 +930,24 @@ L<perlsec> "my" variable %s masks earlier declaration in same scope, %s argument is not a HASH element or slice, Allocation too large: %lx, Allocation too -large, Attempt to free non-existent shared string, Attempt to use reference -as lvalue in substr, Unsupported function fork, Ill-formed logical name -|%s| in prime_env_iter, Can't use bareword ("%s") as %s ref while "strict -refs" in use, Constant subroutine %s redefined, Died, Integer overflow in -hex number, Integer overflow in octal number, Name "%s::%s" used only once: -possible typo, Null picture in formline, Offset outside string, Stub found -while resolving method `%s' overloading `%s' in package `%s', Cannot -resolve method `%s' overloading `%s' in package `s', Out of memory!, Out of -memory during request for %s, Possible attempt to put comments in qw() -list, Possible attempt to separate words with commas, Scalar value @%s{%s} -better written as $%s{%s}, untie attempted while %d inner references still -exist, Value of %s construct can be "0"; test with defined(), Variable "%s" -may be unavailable, Variable "%s" will not stay shared, Warning: -something's wrong, Got an error from DosAllocMem, Malformed PERLLIB_PREFIX, +large, Applying %s to %s will act on scalar(%s), Attempt to free +nonexistent shared string, Attempt to use reference as lvalue in substr, +Can't use bareword ("%s") as %s ref while "strict refs" in use, Cannot +resolve method `%s' overloading `%s' in package `%s', Constant subroutine +%s redefined, Constant subroutine %s undefined, Copy method did not return +a reference, Died, Exiting pseudo-block via %s, Illegal character %s +(carriage return), Illegal switch in PERL5OPT: %s, Integer overflow in hex +number, Integer overflow in octal number, Name "%s::%s" used only once: +possible typo, Null picture in formline, Offset outside string, Out of +memory!, Out of memory during request for %s, Possible attempt to put +comments in qw() list, Possible attempt to separate words with commas, +Scalar value @%s{%s} better written as $%s{%s}, Stub found while resolving +method `%s' overloading `%s' in package `%s', Too late for "B<-T>" option, +untie attempted while %d inner references still exist, Unrecognized +character %s, Unsupported function fork, Value of %s can be "0"; test with +defined(), Variable "%s" may be unavailable, Variable "%s" will not stay +shared, Warning: something's wrong, Ill-formed logical name |%s| in +prime_env_iter, Got an error from DosAllocMem, Malformed PERLLIB_PREFIX, PERL_SH_DIR too long, Process terminated by SIG%s =item BUGS @@ -1086,7 +1113,7 @@ i, m, s, x =item #! and quoting on non-Unix systems -OS/2, DOS, Win95/NT, Macintosh +OS/2, MS-DOS, Win95/NT, Macintosh =item Switches @@ -1101,8 +1128,8 @@ B<-T>, B<-u>, B<-U>, B<-v>, B<-V>, B<-V:>I<name>, B<-w>, B<-x> I<directory> =item ENVIRONMENT -HOME, LOGDIR, PATH, PERL5LIB, PERLLIB, PERL5DB, PERL_DEBUG_MSTATS, -PERL_DESTRUCT_LEVEL +HOME, LOGDIR, PATH, PERL5LIB, PERL5OPT, PERLLIB, PERL5DB, +PERL_DEBUG_MSTATS, PERL_DESTRUCT_LEVEL =head2 perlfunc - Perl builtin functions @@ -1167,9 +1194,9 @@ qx/STRING/, qw/STRING/, quotemeta EXPR, quotemeta, rand EXPR, rand, read FILEHANDLE,SCALAR,LENGTH,OFFSET, read FILEHANDLE,SCALAR,LENGTH, readdir DIRHANDLE, readlink EXPR, readlink, recv SOCKET,SCALAR,LEN,FLAGS, redo LABEL, redo, ref EXPR, ref, rename OLDNAME,NEWNAME, require EXPR, require, -reset EXPR, reset, return LIST, reverse LIST, rewinddir DIRHANDLE, rindex -STR,SUBSTR,POSITION, rindex STR,SUBSTR, rmdir FILENAME, rmdir, s///, scalar -EXPR, seek FILEHANDLE,POSITION,WHENCE, seekdir DIRHANDLE,POS, select +reset EXPR, reset, return EXPR, return, reverse LIST, rewinddir DIRHANDLE, +rindex STR,SUBSTR,POSITION, rindex STR,SUBSTR, rmdir FILENAME, rmdir, s///, +scalar EXPR, seek FILEHANDLE,POSITION,WHENCE, seekdir DIRHANDLE,POS, select FILEHANDLE, select, select RBITS,WBITS,EBITS,TIMEOUT, semctl ID,SEMNUM,CMD,ARG, semget KEY,NSEMS,FLAGS, semop KEY,OPSTRING, send SOCKET,MSG,FLAGS,TO, send SOCKET,MSG,FLAGS, setpgrp PID,PGRP, setpriority @@ -1701,7 +1728,7 @@ more elaborate constructs isa(CLASS), can(METHOD), VERSION( [NEED] ) -=item Destructors +=item Destructors =item WARNING @@ -1854,7 +1881,7 @@ command, m expr, m package =item Debugger input/output -Prompt, Multi-line commands, Stack backtrace, Listing, Frame listing +Prompt, Multiline commands, Stack backtrace, Listing, Frame listing =item Debugging compile-time statements @@ -2006,7 +2033,7 @@ Unclassified =item PREAMBLE -B<Use C from Perl?>, B<Use a UNIX program from Perl?>, B<Use Perl from +B<Use C from Perl?>, B<Use a Unix program from Perl?>, B<Use Perl from Perl?>, B<Use C from C?>, B<Use Perl from C?> =item ROADMAP @@ -2216,13 +2243,13 @@ B<PerlIO_get_base(f)>, B<PerlIO_get_bufsiz(f)> =item What is an "IV"? -=item Working with SV's +=item Working with SVs =item What's Really Stored in an SV? -=item Working with AV's +=item Working with AVs -=item Working with HV's +=item Working with HVs =item Hash API Extensions @@ -2236,7 +2263,7 @@ B<PerlIO_get_base(f)>, B<PerlIO_get_bufsiz(f)> =item Stashes and Globs -=item Double-Typed SV's +=item Double-Typed SVs =item Magic Variables @@ -2292,42 +2319,39 @@ AvFILL, av_clear, av_extend, av_fetch, av_len, av_make, av_pop, av_push, av_shift, av_store, av_undef, av_unshift, CLASS, Copy, croak, CvSTASH, DBsingle, DBsub, DBtrace, dMARK, dORIGMARK, dowarn, dSP, dXSARGS, dXSI32, dXSI32, ENTER, EXTEND, FREETMPS, G_ARRAY, G_DISCARD, G_EVAL, GIMME, -G_NOARGS, G_SCALAR, gv_fetchmeth, gv_fetchmethod, gv_stashpv, gv_stashsv, -GvSV, HEf_SVKEY, HeHASH, HeKEY, HeKLEN, HePV, HeSVKEY, HeSVKEY_force, -HeSVKEY_set, HeVAL, hv_clear, hv_delayfree_ent, hv_delete, hv_delete_ent, -hv_exists, hv_exists_ent, hv_fetch, hv_fetch_ent, hv_free_ent, hv_iterinit, -hv_iterkey, hv_iterkeysv -Returns the key as an C<SV*> from the current position of the hash -iterator. The return value will always be a mortal copy of the -key. Also see C<hv_iterinit>, 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, SvROK_off, SvROK_on, SvRV, -sv_setiv, sv_setnv, sv_setpv, sv_setpvn, sv_setref_iv, sv_setref_nv, -sv_setref_pv, sv_setref_pvn, sv_setsv, SvSTASH, SVt_IV, SVt_PV, SVt_PVAV, -SVt_PVCV, SVt_PVHV, SVt_PVMG, SVt_NV, SvTRUE, SvTYPE, svtype, SvUPGRADE, -sv_upgrade, sv_undef, sv_unref, sv_usepvn, sv_yes, THIS, toLOWER, toUPPER, -warn, XPUSHi, XPUSHn, XPUSHp, XPUSHs, XS, XSRETURN, XSRETURN_EMPTY, -XSRETURN_IV, XSRETURN_NO, XSRETURN_NV, XSRETURN_PV, XSRETURN_UNDEF, -XSRETURN_YES, XST_mIV, XST_mNV, XST_mNO, XST_mPV, XST_mUNDEF, XST_mYES, -XS_VERSION, XS_VERSION_BOOTCHECK, Zero +GIMME_V, G_NOARGS, G_SCALAR, G_VOID, gv_fetchmeth, gv_fetchmethod, +gv_fetchmethod_autoload, 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, +SvROK_off, SvROK_on, SvRV, sv_setiv, sv_setnv, sv_setpv, sv_setpvn, +sv_setref_iv, sv_setref_nv, sv_setref_pv, sv_setref_pvn, sv_setsv, SvSTASH, +SVt_IV, SVt_PV, SVt_PVAV, SVt_PVCV, SVt_PVHV, SVt_PVMG, SVt_NV, SvTRUE, +SvTYPE, svtype, SvUPGRADE, sv_upgrade, sv_undef, sv_unref, sv_usepvn, +sv_yes, THIS, toLOWER, toUPPER, warn, XPUSHi, XPUSHn, XPUSHp, XPUSHs, XS, +XSRETURN, XSRETURN_EMPTY, XSRETURN_IV, XSRETURN_NO, XSRETURN_NV, +XSRETURN_PV, XSRETURN_UNDEF, XSRETURN_YES, XST_mIV, XST_mNV, XST_mNO, +XST_mPV, XST_mUNDEF, XST_mYES, XS_VERSION, XS_VERSION_BOOTCHECK, Zero =item EDITOR @@ -2347,6 +2371,8 @@ B<perl_call_sv>, B<perl_call_pv>, B<perl_call_method>, B<perl_call_argv> =over +=item G_VOID + =item G_SCALAR =item G_ARRAY @@ -2355,11 +2381,11 @@ B<perl_call_sv>, B<perl_call_pv>, B<perl_call_method>, B<perl_call_argv> =item G_NOARGS -=item G_EVAL +=item G_EVAL =item G_KEEPERR -=item Determining the Context +=item Determining the Context =back @@ -2391,7 +2417,7 @@ B<perl_call_sv>, B<perl_call_pv>, B<perl_call_method>, B<perl_call_argv> =item Using perl_call_method -=item Using GIMME +=item Using GIMME_V =item Using Perl to dispose of temporaries @@ -2437,6 +2463,22 @@ callback =item AUTHOR +=head2 constant - Perl pragma to declare constants + +=item SYNOPSIS + +=item DESCRIPTION + +=item NOTES + +=item TECHNICAL NOTE + +=item BUGS + +=item AUTHOR + +=item COPYRIGHT + =head2 diagnostics - Perl compiler pragma to force verbose warning diagnostics @@ -2641,7 +2683,7 @@ C<strict refs>, C<strict vars>, C<strict subs> =item SEE ALSO -=head2 AutoLoader - load functions only on demand +=head2 AutoLoader - load subroutines only on demand =item SYNOPSIS @@ -2649,17 +2691,21 @@ C<strict refs>, C<strict vars>, C<strict subs> =over -=item __END__ +=item Subroutine Stubs -=item Loading Stubs +=item Using B<AutoLoader>'s AUTOLOAD Subroutine + +=item Overriding B<AutoLoader>'s AUTOLOAD Subroutine =item Package Lexicals -=item AutoLoader vs. SelfLoader +=item B<AutoLoader> vs. B<SelfLoader> =back -=item CAVEAT +=item CAVEATS + +=item SEE ALSO =head2 AutoSplit - split a package for autoloading @@ -2685,10 +2731,14 @@ new, debug =item Standard Exports -timeit(COUNT, CODE), timethis, timethese, timediff, timestr +timeit(COUNT, CODE), timethis ( COUNT, CODE, [ TITLE, [ STYLE ]] ), +timethese ( COUNT, CODEHASHREF, [ STYLE ] ), timediff ( T1, T2 ), timestr ( +TIMEDIFF, [ STYLE, [ FORMAT ]] ) =item Optional Exports +clearcache ( COUNT ), clearallcache ( ), disablecache ( ), enablecache ( ) + =back =item NOTES @@ -2711,6 +2761,273 @@ timeit(COUNT, CODE), timethis, timethese, timediff, timestr =item AUTHOR +=head2 CGI - Simple Common Gateway Interface Class + +=item SYNOPSIS + +=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 @@ -2731,8 +3048,12 @@ distribution =item recompile +=item The 4 Classes: Authors, Bundles, Modules, Distributions + =item ProgrammerE<39>s interface +expand($type,@things), Programming Examples + =item Cache Manager =item Bundles @@ -2981,7 +3302,7 @@ variables =head2 ExtUtils::Command - utilities to replace common UNIX commands in Makefiles etc. -=item SYNOPSYS +=item SYNOPSIS =item DESCRIPTION @@ -3772,10 +4093,28 @@ functions =item USAGE +=item CAVEATS + =item BUGS =item AUTHORS +=head2 Math::Trig - trigonometric functions + +=item SYNOPSIS + +=item DESCRIPTION + +=item TRIGONOMETRIC FUNCTIONS + +=over + +=item SIMPLE ARGUMENTS, COMPLEX RESULTS + +=back + +=item ANGLE CONVERSIONS + =head2 NDBM_File - Tied access to ndbm files =item SYNOPSIS @@ -4059,6 +4398,27 @@ Constants, Macros =item CREATION +=head2 Pod::Html, Pod::HTML - module to convert pod files to HTML + +=item SYNOPSIS + +=item DESCRIPTION + +=item ARGUMENTS + +help, htmlroot, infile, outfile, podroot, podpath, libpods, netscape, +nonetscape, index, noindex, recurse, norecurse, title, verbose + +=item EXAMPLE + +=item AUTHOR + +=item BUGS + +=item SEE ALSO + +=item COPYRIGHT + =head2 Pod::Text - convert POD data to formatted ASCII text =item SYNOPSIS @@ -4207,8 +4567,7 @@ setlogmask $mask_priority, closelog =item DESCRIPTION -E<lt>tabE<gt>Attempts word completion. -Cannot be changed, ^D, ^U, E<lt>delE<gt>, E<lt>bsE<gt> +E<lt>tabE<gt>, ^D, ^U, E<lt>delE<gt>, E<lt>bsE<gt> =item DIAGNOSTICS @@ -4401,7 +4760,8 @@ function =item DESCRIPTION -isa ( TYPE ), can ( METHOD ), VERSION ( [ REQUIRE ] ), isa ( REF, TYPE ) +isa ( TYPE ), can ( METHOD ), VERSION ( [ REQUIRE ] ), isa ( VAL, TYPE ), +can ( VAL, METHOD ) =head2 User::grent - by-name interface to Perl's built-in getgr*() functions diff --git a/pod/perltoot.pod b/pod/perltoot.pod index a8a77f1c68..c23591245a 100644 --- a/pod/perltoot.pod +++ b/pod/perltoot.pod @@ -311,7 +311,7 @@ be made through methods. Perl doesn't impose restrictions on who gets to use which methods. The public-versus-private distinction is by convention, not syntax. -(Well, unless you use the Alias module described below in +(Well, unless you use the Alias module described below in L</"Data Members as Variables">.) Occasionally you'll see method names beginning or ending with an underscore or two. This marking is a convention indicating that the methods are private to that class alone and sometimes to its @@ -350,7 +350,7 @@ Some might argue that one should go at these this way: } But since these methods are all executing in the class itself, this -may not be critical. There are trade-offs to be made. Using direct +may not be critical. There are tradeoffs to be made. Using direct hash access is faster (about an order of magnitude faster, in fact), and it's more convenient when you want to interpolate in strings. But using methods (the external interface) internally shields not just the users of @@ -1091,7 +1091,7 @@ In version 5.003, there were no predefined methods there, but you could put whatever you felt like into it. However, as of version 5.004 (or some subversive releases, like 5.003_08), -UNIVERSAL has some methods in it already. These are built-in to your Perl +UNIVERSAL has some methods in it already. These are builtin to your Perl binary, so they don't take any extra time to load. Predefined methods include isa(), can(), and VERSION(). isa() tells you whether an object or class "is" another one without having to traverse the hierarchy yourself: @@ -1417,7 +1417,7 @@ is modify %fields. No new functions need be written. I could have avoided the C<_permitted> field entirely, but I wanted to demonstrate how to store a reference to class data on the -object so you wouldn't have to access that class data +object so you wouldn't have to access that class data directly from an object method. =head2 Inherited Autoloaded Data Methods @@ -1624,7 +1624,7 @@ functions in the 5.004 release of Perl in File::stat, Net::hostent, Net::netent, Net::protoent, Net::servent, Time::gmtime, Time::localtime, User::grent, and User::pwent. These modules have a final component that's all lowercase, by convention reserved for compiler pragmas, -because they affect the compilation and change a built-in function. +because they affect the compilation and change a builtin function. They also have the type names that a C programmer would most expect. =head2 Data Members as Variables @@ -1688,7 +1688,7 @@ update value fields in the hash. Convenient, eh? The need for the C<use vars> declaration is because what Alias does is play with package globals with the same name as the fields. To use -globals while C<use strict> is in effect, you have to pre-declare them. +globals while C<use strict> is in effect, you have to predeclare them. These package variables are localized to the block enclosing the attr() call just as if you'd used a local() on them. However, that means that they're still considered global variables with temporary values, just @@ -1726,7 +1726,7 @@ object (one expecting a reference), or vice versa. Z<>From the C++ perspective, all methods in Perl are virtual. This, by the way, is why they are never checked for function -prototypes in the argument list as regular built-in and user-defined +prototypes in the argument list as regular builtin and user-defined functions can be. Because a class is itself something of an object, Perl's classes can be @@ -1737,7 +1737,7 @@ notion, but not the former. =head1 SEE ALSO -The following man pages will doubtless provide more +The following manpages will doubtless provide more background for this one: L<perlmod>, L<perlref>, @@ -1755,7 +1755,7 @@ experiences have mandated its inclusion: Copyright 1996 Tom Christiansen. All Rights Reserved. This work derives in part from the second edition of I<Programming Perl>. -Although destined for release as a man page with the standard Perl +Although destined for release as a manpage with the standard Perl distribution, it is not public domain (nor is any of Perl and its docset: publishers beware). It's expected to someday make its way into a revision of the Camel Book. While it is copyright by me with all rights reserved, diff --git a/pod/perltrap.pod b/pod/perltrap.pod index fd91182d1e..d5aeafc3f2 100644 --- a/pod/perltrap.pod +++ b/pod/perltrap.pod @@ -20,8 +20,8 @@ The English module, loaded via use English; -allows you to refer to special variables (like $RS) as -though they were in B<awk>; see L<perlvar> for details. +allows you to refer to special variables (like C<$/>) with names (like +C<$RS>), as though they were in B<awk>; see L<perlvar> for details. =item * @@ -57,8 +57,8 @@ comparisons. =item * Reading an input line does not split it for you. You get to split it -yourself to an array. And the split() operator has different -arguments. +to an array yourself. And the split() operator has different +arguments than B<awk>'s. =item * @@ -157,7 +157,7 @@ You must use C<elsif> rather than C<else if>. =item * -The C<break> and C<continue> keywords from C become in +The C<break> and C<continue> keywords from C become in Perl C<last> and C<next>, respectively. Unlike in C, these do I<NOT> work within a C<do { } while> construct. @@ -230,18 +230,18 @@ Sharp shell programmers should take note of the following: =item * -The back-tick operator does variable interpolation without regard to +The backtick operator does variable interpolation without regard to the presence of single quotes in the command. =item * -The back-tick operator does no translation of the return value, unlike B<csh>. +The backtick operator does no translation of the return value, unlike B<csh>. =item * Shells (especially B<csh>) do several levels of substitution on each command line. Perl does substitution in only certain constructs -such as double quotes, back-ticks, angle brackets, and search patterns. +such as double quotes, backticks, angle brackets, and search patterns. =item * @@ -274,14 +274,14 @@ context than they do in a scalar one. See L<perldata> for details. =item * Avoid barewords if you can, especially all lowercase ones. -You can't tell by just looking at it whether a bareword is -a function or a string. By using quotes on strings and +You can't tell by just looking at it whether a bareword is +a function or a string. By using quotes on strings and parentheses on function calls, you won't ever get them confused. =item * -You cannot discern from mere inspection which built-ins -are unary operators (like chop() and chdir()) +You cannot discern from mere inspection which builtins +are unary operators (like chop() and chdir()) and which are list operators (like print() and unlink()). (User-defined subroutines can be B<only> list operators, never unary ones.) See L<perlop>. @@ -290,7 +290,7 @@ unary ones.) See L<perlop>. People have a hard time remembering that some functions default to $_, or @ARGV, or whatever, but that others which -you might expect to do not. +you might expect to do not. =item * @@ -299,7 +299,7 @@ operation on that handle. The data read is assigned to $_ only if the file read is the sole condition in a while loop: while (<FH>) { } - while ($_ = <FH>) { }.. + while (defined($_ = <FH>)) { }.. <FH>; # data discarded! =item * @@ -312,14 +312,14 @@ these two constructs are quite different: =item * -The C<do {}> construct isn't a real loop that you can use +The C<do {}> construct isn't a real loop that you can use loop control on. =item * -Use C<my()> for local variables whenever you can get away with -it (but see L<perlform> for where you can't). -Using C<local()> actually gives a local value to a global +Use C<my()> for local variables whenever you can get away with +it (but see L<perlform> for where you can't). +Using C<local()> actually gives a local value to a global variable, which leaves you open to unforeseen side-effects of dynamic scoping. @@ -333,7 +333,7 @@ external name is still an alias for the original. =head2 Perl4 to Perl5 Traps -Practicing Perl4 Programmers should take note of the following +Practicing Perl4 Programmers should take note of the following Perl4-to-Perl5 specific traps. They're crudely ordered according to the following list: @@ -397,11 +397,11 @@ Also note that at least some of these can be caught with B<-w>. =head2 Discontinuance, Deprecation, and BugFix traps Anything that has been discontinued, deprecated, or fixed as -a bug from perl4. +a bug from perl4. =over 4 -=item * Discontinuance +=item * Discontinuance Symbols starting with "_" are no longer forced into package main, except for C<$_> itself (and C<@_>, etc.). @@ -411,11 +411,11 @@ for C<$_> itself (and C<@_>, etc.). package main; print "\$_legacy is ",$_legacy,"\n"; - + # perl4 prints: $_legacy is 1 # perl5 prints: $_legacy is -=item * Deprecation +=item * Deprecation Double-colon is now a valid package separator in a variable name. Thus these behave differently in perl4 vs. perl5, because the packages don't exist. @@ -433,11 +433,11 @@ whether this should be classed as a bug or not. $x = 10 ; print "x=${'x}\n" ; - + # perl4 prints: x=10 # perl5 prints: Can't find string terminator "'" anywhere before EOF -Also see precedence traps, for parsing C<$:>. +Also see precedence traps, for parsing C<$:>. =item * BugFix @@ -446,39 +446,39 @@ context (as the Camel says) rather than list context. sub sub1{return(0,2) } # return a 2-elem array sub sub2{ return(1,2,3)} # return a 3-elem array - @a1 = ("a","b","c","d","e"); + @a1 = ("a","b","c","d","e"); @a2 = splice(@a1,&sub1,&sub2); print join(' ',@a2),"\n"; - + # perl4 prints: a b - # perl5 prints: c d e + # perl5 prints: c d e -=item * Discontinuance +=item * Discontinuance You can't do a C<goto> into a block that is optimized away. Darn. goto marker1; - for(1){ + for(1){ marker1: print "Here I is!\n"; - } - + } + # perl4 prints: Here I is! # perl5 dumps core (SEGV) -=item * Discontinuance +=item * Discontinuance It is no longer syntactically legal to use whitespace as the name of a variable, or as a delimiter for any kind of quote construct. -Double darn. +Double darn. $a = ("foo bar"); $b = q baz ; print "a is $a, b is $b\n"; - + # perl4 prints: a is foo bar, b is baz - # perl5 errors: Bare word found where operator expected + # perl5 errors: Bareword found where operator expected =item * Discontinuance @@ -490,7 +490,7 @@ The archaic while/if BLOCK BLOCK syntax is no longer supported. else { print "False!"; } - + # perl4 prints: True! # perl5 errors: syntax error at test.pl line 1, near "if {" @@ -500,11 +500,11 @@ The C<**> operator now binds more tightly than unary minus. It was documented to work this way before, but didn't. print -4**2,"\n"; - + # perl4 prints: 16 # perl5 prints: -16 -=item * Discontinuance +=item * Discontinuance The meaning of C<foreach{}> has changed slightly when it is iterating over a list which is not an array. This used to assign the list to a @@ -518,12 +518,12 @@ values. $var = 1; } print (join(':',@list)); - + # perl4 prints: ab:abc:bcd:def # perl5 prints: 1:1:bcd:def To retain Perl4 semantics you need to assign your list -explicitly to a temporary array and then iterate over that. For +explicitly to a temporary array and then iterate over that. For example, you might need to change foreach $var (grep(/ab/,@list)){ @@ -556,10 +556,10 @@ would silently accept an B<-e> switch without a following arg. Both of these behaviors have been fixed. perl -e'print "attached to -e"' 'print "separate arg"' - + # perl4 prints: separate arg # perl5 prints: attached to -e - + perl -e # perl4 prints: @@ -574,7 +574,7 @@ number of elements in the resulting list. @x = ('existing'); print push(@x, 'first new', 'second new'); - + # perl4 prints: second new # perl5 prints: 3 @@ -600,7 +600,7 @@ See L<perldiag> for full details. Some error messages will be different. -=item * Discontinuance +=item * Discontinuance Some bugs may have been inadvertently removed. :-) @@ -618,7 +618,7 @@ Note the space between . and = $string . = "more string"; print $string; - + # perl4 prints: more string # perl5 prints: syntax error at - line 1, near ". =" @@ -629,7 +629,7 @@ Better parsing in perl 5 sub foo {} &foo print("hello, world\n"); - + # perl4 prints: hello, world # perl5 prints: syntax error @@ -639,7 +639,7 @@ Better parsing in perl 5 print ($foo == 1) ? "is one\n" : "is zero\n"; - + # perl4 prints: is zero # perl5 warns: "Useless use of a constant in void context" if using -w @@ -657,12 +657,12 @@ operands, or output from same. Formatted output and significant digits print 7.373504 - 0, "\n"; - printf "%20.18f\n", 7.373504 - 0; - + printf "%20.18f\n", 7.373504 - 0; + # Perl4 prints: 7.375039999999996141 7.37503999999999614 - + # Perl5 prints: 7.373504 7.37503999999999614 @@ -676,7 +676,7 @@ If in doubt: use Math::BigInt; -=item * Numerical +=item * Numerical Assignment of return values from numeric equality tests does not work in perl5 when the test evaluates to false (0). @@ -688,8 +688,8 @@ Logical tests now return an null, instead of 0 # perl4 prints: 0 # perl5 prints: -Also see the L<General Regular Expression Traps using s///, etc.> -tests for another example of this new feature... +Also see L<"General Regular Expression Traps using s///, etc."> +for another example of this new feature... =back @@ -706,7 +706,7 @@ Negative array subscripts now count from the end of the array. @a = (1, 2, 3, 4, 5); print "The third element of the array is $a[3] also expressed as $a[-2] \n"; - + # perl4 prints: The third element of the array is 4 also expressed as # perl5 prints: The third element of the array is 4 also expressed as 4 @@ -715,13 +715,13 @@ Negative array subscripts now count from the end of the array. Setting C<$#array> lower now discards array elements, and makes them impossible to recover. - @a = (a,b,c,d,e); + @a = (a,b,c,d,e); print "Before: ",join('',@a); - $#a =1; + $#a =1; print ", After: ",join('',@a); $#a =3; print ", Recovered: ",join('',@a),"\n"; - + # perl4 prints: Before: abcde, After: ab, Recovered: abcd # perl5 prints: Before: abcde, After: ab, Recovered: ab @@ -729,11 +729,11 @@ impossible to recover. Hashes get defined before use - local($s,@a,%h); + local($s,@a,%h); die "scalar \$s defined" if defined($s); die "array \@a defined" if defined(@a); die "hash \%h defined" if defined(%h); - + # perl4 prints: # perl5 dies: hash %h defined @@ -746,17 +746,17 @@ variable is localized subsequent to the assignment *b = *a; local(@a); print @b,"\n"; - + # perl4 prints: This is Perl 4 # perl5 prints: - + # Another example - + *fred = *barney; # fred is aliased to barney @barney = (1, 2, 4); # @fred; print "@fred"; # should print "1, 2, 4" - + # perl4 prints: 1 2 4 # perl5 prints: In string, @fred now must be written as \@fred @@ -770,7 +770,7 @@ does to auto(magic)increment. print ++$x," : "; print -$x," : "; print ++$x,"\n"; - + # perl4 prints: aab : -0 : 1 # perl5 prints: aab : -aab : aac @@ -788,13 +788,13 @@ perl 4 lets you modify constants: $_[0] = "m"; print " after: $_[0]\n"; } - + # perl4: # before: x after: m # before: a after: m # before: m after: m # before: m after: m - + # Perl5: # before: x after: m # Modification of a read-only value attempted at foo.pl line 12. @@ -805,7 +805,7 @@ perl 4 lets you modify constants: The behavior is slightly different for: print "$x", defined $x - + # perl 4: 1 # perl 5: <no output, $x is not called into existence> @@ -823,7 +823,7 @@ that perl4 exhibits for only scalars. sub test { local( *theArgument ) = @_; local( %aNewLocal ); # perl 4 != 5.001l,m - $aNewLocal{"aKey"} = "this should never appear"; + $aNewLocal{"aKey"} = "this should never appear"; print "SUB: ", $theArgument{"aKey"}, "\n"; $aNewLocal{"aKey"} = "level $GlobalLevel"; # what should print $GlobalLevel++; @@ -831,14 +831,14 @@ that perl4 exhibits for only scalars. &test( *aNewLocal ); } } - + # Perl4: # MAIN:global value # SUB: global value # SUB: level 0 # SUB: level 1 # SUB: level 2 - + # Perl5: # MAIN:global value # SUB: global value @@ -862,19 +862,19 @@ context. This means you can interpolate list values now. @<<<<< @||||| @>>>>> @fmt; . - write; - + write; + # perl4 errors: Please use commas to separate fields in file # perl5 prints: foo bar baz =item * (scalar context) -The C<caller()> function now returns a false value in a scalar context -if there is no caller. This lets library files determine if they're +The C<caller()> function now returns a false value in a scalar context +if there is no caller. This lets library files determine if they're being required. caller() ? (print "You rang?\n") : (print "Got a 0\n"); - + # perl4 errors: There is no caller # perl5 prints: Got a 0 @@ -886,7 +886,7 @@ scalar context to its arguments. @y= ('a','b','c'); $x = (1, 2, @y); print "x = $x\n"; - + # Perl4 prints: x = c # Thinks list context interpolates list # Perl5 prints: x = 3 # Knows scalar uses length of list @@ -898,15 +898,15 @@ This test could be added to t/op/sprintf.t @z = ('%s%s', 'foo', 'bar'); $x = sprintf(@z); if ($x eq 'foobar') {print "ok 2\n";} else {print "not ok 2 '$x'\n";} - + # perl4 prints: ok 2 # perl5 prints: not ok 2 C<printf()> works fine, though: printf STDOUT (@z); - print "\n"; - + print "\n"; + # perl4 prints: foobar # perl5 prints: foobar @@ -941,7 +941,7 @@ These are now semantic errors because of precedence: print "n is $n, "; $m = keys %map + 2; # number of items in hash plus 2 print "m is $m\n"; - + # perl4 prints: n is 3, m is 6 # perl5 errors and fails to compile @@ -963,7 +963,7 @@ would be erroneously parsed as On the other hand, - $a += /foo/ ? 1 : 2; + $a += /foo/ ? 1 : 2; now works as a C programmer would expect. @@ -975,7 +975,7 @@ is now incorrect. You need parentheses around the filehandle. Otherwise, perl5 leaves the statement as its default precedence: open(FOO || die); - + # perl4 opens or dies # perl5 errors: Precedence problem: open FOO should be open(FOO) @@ -985,16 +985,16 @@ perl4 gives the special variable, C<$:> precedence, where perl5 treats C<$::> as main C<package> $a = "x"; print "$::a"; - + # perl 4 prints: -:a # perl 5 prints: x =item * Precedence -concatenation precedence over filetest operator? +concatenation precedence over filetest operator? + + -e $foo .= "q" - -e $foo .= "q" - # perl4 prints: no output # perl5 prints: Can't modify -e in concatenation @@ -1021,14 +1021,14 @@ All types of RE traps. =item * Regular Expression C<s'$lhs'$rhs'> now does no interpolation on either side. It used to -interpolate C<$lhs> but not C<$rhs>. (And still does not match a literal +interpolate C<$lhs> but not C<$rhs>. (And still does not match a literal '$' in string) $a=1;$b=2; $string = '1 2 $a $b'; $string =~ s'$a'$b'; print $string,"\n"; - + # perl4 prints: $b 2 $a $b # perl5 prints: 1 2 $a $b @@ -1043,7 +1043,7 @@ state of the searched string is lost) &doit("blah"); } sub doit{local($_) = shift; print "Got $_ "} - + # perl4 prints: blah blah blah # perl5 prints: infinite loop blah... @@ -1072,7 +1072,7 @@ the whole match, just like C<$&>. Perl5 does not. "abcdef" =~ /b.*e/; print "\$+ = $+\n"; - + # perl4 prints: bcde # perl5 prints: @@ -1083,7 +1083,7 @@ substitution now returns the null string if it fails $string = "test"; $value = ($string =~ s/foo//); print $value, "\n"; - + # perl4 prints: 0 # perl5 prints: @@ -1091,13 +1091,13 @@ Also see L<Numerical Traps> for another example of this new feature. =item * Regular Expression -C<s`lhs`rhs`> (using back-ticks) is now a normal substitution, with no -back-tick expansion +C<s`lhs`rhs`> (using backticks) is now a normal substitution, with no +backtick expansion $string = ""; $string =~ s`^`hostname`; print $string, "\n"; - + # perl4 prints: <the local hostname> # perl5 prints: hostname @@ -1106,7 +1106,7 @@ back-tick expansion Stricter parsing of variables used in regular expressions s/^([^$grpc]*$grpc[$opt$plus$rep]?)//o; - + # perl4: compiles w/o error # perl5: with Scalar found where operator expected ..., near "$opt$plus" @@ -1114,12 +1114,12 @@ an added component of this example, apparently from the same script, is the actual value of the s'd string after the substitution. C<[$opt]> is a character class in perl4 and an array subscript in perl5 - $grpc = 'a'; + $grpc = 'a'; $opt = 'r'; $_ = 'bar'; s/^([^$grpc]*$grpc[$opt]?)/foo/; print ; - + # perl4 prints: foo # perl5 prints: foobar @@ -1134,11 +1134,11 @@ repeatedly, like C</x/> or C<m!x!>. if( &match() ) { # m?x? matches more then once print "perl4\n"; - } else { + } else { # m?x? matches only once - print "perl5\n"; + print "perl5\n"; } - + # perl4 prints: perl4 # perl5 prints: perl5 @@ -1156,7 +1156,7 @@ found using the C<pos()> function--see L<perlfunc/pos>). print $1 while ($test =~ /(o)/g); # pos $test = 0; # to get old behavior } - + # perl4 prints: oooooo # perl5.004 prints: oo @@ -1181,7 +1181,7 @@ calls if a subroutine by that name is defined before the compiler sees them. sub SeeYa { warn"Hasta la vista, baby!" } $SIG{'TERM'} = SeeYa; print "SIGTERM is now $SIG{'TERM'}\n"; - + # perl4 prints: SIGTERM is main'SeeYa # perl5 prints: SIGTERM is now main::1 @@ -1192,10 +1192,10 @@ Use B<-w> to catch this one reverse is no longer allowed as the name of a sort subroutine. sub reverse{ print "yup "; $a <=> $b } - print sort reverse a,b,c; - + print sort reverse a,b,c; + # perl4 prints: yup yup yup yup abc - # perl5 prints: abc + # perl5 prints: abc =item * warn() won't let you specify a filehandle. @@ -1205,7 +1205,7 @@ filehandle in perl4. With perl5 it does not. warn STDERR "Foo!"; # perl4 prints: Foo! - # perl5 prints: String found where operator expected + # perl5 prints: String found where operator expected =back @@ -1215,47 +1215,47 @@ filehandle in perl4. With perl5 it does not. =item * (SysV) -Under HPUX, and some other SysV OS's, one had to reset any signal handler, -within the signal handler function, each time a signal was handled with -perl4. With perl5, the reset is now done correctly. Any code relying +Under HPUX, and some other SysV OSes, one had to reset any signal handler, +within the signal handler function, each time a signal was handled with +perl4. With perl5, the reset is now done correctly. Any code relying on the handler _not_ being reset will have to be reworked. Since version 5.002, Perl uses sigaction() under SysV. sub gotit { - print "Got @_... "; - } + print "Got @_... "; + } $SIG{'INT'} = 'gotit'; - + $| = 1; $pid = fork; if ($pid) { kill('INT', $pid); sleep(1); kill('INT', $pid); - } else { + } else { while (1) {sleep(10);} - } - + } + # perl4 (HPUX) prints: Got INT... # perl5 (HPUX) prints: Got INT... Got INT... =item * (SysV) -Under SysV OS's, C<seek()> on a file opened to append C<E<gt>E<gt>> now does -the right thing w.r.t. the fopen() man page. e.g., - When a file is opened +Under SysV OSes, C<seek()> on a file opened to append C<E<gt>E<gt>> now does +the right thing w.r.t. the fopen() manpage. e.g., - When a file is opened for append, it is impossible to overwrite information already in the file. open(TEST,">>seek.test"); - $start = tell TEST ; + $start = tell TEST ; foreach(1 .. 9){ print TEST "$_ "; } $end = tell TEST ; seek(TEST,$start,0); print TEST "18 characters here"; - + # perl4 (solaris) seek.test has: 18 characters here # perl5 (solaris) seek.test has: 1 2 3 4 5 6 7 8 9 18 characters here @@ -1274,8 +1274,8 @@ within certain expressions, statements, contexts, or whatever. @ now always interpolates an array in double-quotish strings. - print "To: someone@somewhere.com\n"; - + print "To: someone@somewhere.com\n"; + # perl4 prints: To:someone@somewhere.com # perl5 errors : In string, @somewhere now must be written as \@somewhere @@ -1286,7 +1286,7 @@ Double-quoted strings may no longer end with an unescaped $ or @. $foo = "foo$"; $bar = "bar@"; print "foo is $foo, bar is $bar\n"; - + # perl4 prints: foo is foo$, bar is bar@ # perl5 errors: Final $ should be \$ or $name @@ -1322,8 +1322,8 @@ works fine, however. =item * Interpolation -Creation of hashes on the fly with C<eval "EXPR"> now requires either both -C<$>'s to be protected in the specification of the hash name, or both curlies +Creation of hashes on the fly with C<eval "EXPR"> now requires either both +C<$>'s to be protected in the specification of the hash name, or both curlies to be protected. If both curlies are protected, the result will be compatible with perl4 and perl5. This is a very common practice, and should be changed to use the block form of C<eval{}> if possible. @@ -1366,13 +1366,13 @@ causes the following result: perl4 programs which unconsciously rely on the bugs in earlier perl versions. perl -e '$bar=q/not/; print "This is $foo{$bar} perl5"' - + # perl4 prints: This is not perl5 # perl5 prints: This is perl5 =item * Interpolation -You also have to be careful about array references. +You also have to be careful about array references. print "$foo{" @@ -1385,7 +1385,7 @@ Similarly, watch out for: $foo = "array"; print "\$$foo{bar}\n"; - + # perl4 prints: $array{bar} # perl5 prints: $ @@ -1402,9 +1402,9 @@ C<qq()> string passed to C<eval> \$count++; } ); - + # perl4 runs this ok - # perl5 prints: Can't find string terminator ")" + # perl5 prints: Can't find string terminator ")" =back @@ -1463,7 +1463,7 @@ If the file doit.pl has: sub foo { $rc = do "./do.pl"; return 8; - } + } print &foo, "\n"; And the do.pl file has the following single line: @@ -1473,12 +1473,12 @@ And the do.pl file has the following single line: Running doit.pl gives the following: # perl 4 prints: 3 (aborts the subroutine early) - # perl 5 prints: 8 + # perl 5 prints: 8 Same behavior if you replace C<do> with C<require>. =back -As always, if any of these are ever officially declared as bugs, +As always, if any of these are ever officially declared as bugs, they'll be fixed and removed. diff --git a/pod/perlvar.pod b/pod/perlvar.pod index 1406858331..00b97bad1e 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -52,7 +52,7 @@ The default input and pattern-searching space. The following pairs are equivalent: while (<>) {...} # equivalent in only while! - while ($_ = <>) {...} + while (defined($_ = <>)) {...} /^Subject:/ $_ =~ /^Subject:/ @@ -63,7 +63,7 @@ equivalent: chop chop($_) -Here are the places where Perl will assume $_ even if you +Here are the places where Perl will assume $_ even if you don't use it: =over 3 @@ -83,16 +83,16 @@ Various list functions like print() and unlink(). The pattern matching operations C<m//>, C<s///>, and C<tr///> when used without an C<=~> operator. -=item * +=item * The default iterator variable in a C<foreach> loop if no other variable is supplied. -=item * +=item * The implicit iterator variable in the grep() and map() functions. -=item * +=item * The default place to put an input record when a C<E<lt>FHE<gt>> operation's result is tested by itself as the sole criterion of a C<while> @@ -108,7 +108,7 @@ test. Note that outside of a C<while> test, this will not happen. =item $E<lt>I<digit>E<gt> -Contains the sub-pattern from the corresponding set of parentheses in +Contains the subpattern from the corresponding set of parentheses in the last pattern matched, not counting patterns matched in nested blocks that have been exited already. (Mnemonic: like \digit.) These variables are all read-only. @@ -199,15 +199,15 @@ number.) The input record separator, newline by default. Works like B<awk>'s RS variable, including treating empty lines as delimiters if set to the -null string. (Note: An empty line cannot contain any spaces or -tabs.) You may set it to a multicharacter string to match a -multi-character delimiter. Note that setting it to C<"\n\n"> means -something slightly different than setting it to C<"">, if the file -contains consecutive empty lines. Setting it to C<""> will treat two -or more consecutive empty lines as a single empty line. Setting it to -C<"\n\n"> will blindly assume that the next input character belongs to -the next paragraph, even if it's a newline. (Mnemonic: / is used to -delimit line boundaries when quoting poetry.) +null string. (Note: An empty line cannot contain any spaces or tabs.) +You may set it to a multi-character string to match a multi-character +delimiter, or to C<undef> to read to end of file. Note that setting it +to C<"\n\n"> means something slightly different than setting it to +C<"">, if the file contains consecutive empty lines. Setting it to +C<""> will treat two or more consecutive empty lines as a single empty +line. Setting it to C<"\n\n"> will blindly assume that the next input +character belongs to the next paragraph, even if it's a newline. +(Mnemonic: / is used to delimit line boundaries when quoting poetry.) undef $/; $_ = <FH>; # whole file now here @@ -222,10 +222,10 @@ better for something :-) =item $| -If set to nonzero, forces a flush after every write or print on the +If set to nonzero, forces a flush right away and after every write or print on the currently selected output channel. Default is 0 (regardless of whether the channel is actually buffered by the system or not; C<$|> tells you -only whether you've asked Perl explicitly to flush after each write). +only whether you've asked Perl explicitly to flush after each write). Note that STDOUT will typically be line buffered if output is to the terminal and block buffered otherwise. Setting this variable is useful primarily when you are outputting to a pipe, such as when you are running @@ -279,7 +279,7 @@ is a space. (Mnemonic: obvious, I think.) =item $; -The subscript separator for multi-dimensional array emulation. If you +The subscript separator for multidimensional array emulation. If you refer to a hash element as $foo{$a,$b,$c} @@ -302,7 +302,7 @@ keys contain binary data there might not be any safe value for "C<$;>". semi-semicolon. Yeah, I know, it's pretty lame, but "C<$,>" is already taken for something more important.) -Consider using "real" multi-dimensional arrays. +Consider using "real" multidimensional arrays. =item $OFMT @@ -372,7 +372,7 @@ appended. (Mnemonic: points to top of page.) =item $: The current set of characters after which a string may be broken to -fill continuation fields (starting with ^) in a format. Default is +fill continuation fields (starting with ^) in a format. Default is S<" \n-">, to break on whitespace or hyphens. (Mnemonic: a "colon" in poetry is a part of a line.) @@ -399,7 +399,7 @@ L<perlfunc/formline()>. =item $? -The status returned by the last pipe close, back-tick (C<``>) command, +The status returned by the last pipe close, backtick (C<``>) command, or system() operator. Note that this is the status word returned by the wait() system call (or else is made up to look like it). Thus, the exit value of the subprocess is actually (C<$? E<gt>E<gt> 8>), and @@ -459,7 +459,7 @@ the syntax error "at"?) Note that warning messages are not collected in this variable. You can, however, set up a routine to process warnings by setting C<$SIG{__WARN__}> -below. +as described below. =item $PROCESS_ID @@ -531,7 +531,8 @@ multiple groups. =item $0 Contains the name of the file containing the Perl script being -executed. Assigning to "C<$0>" modifies the argument area that the ps(1) +executed. On some operating systems +assigning to "C<$0>" modifies the argument area that the ps(1) program sees. This is more useful as a way of indicating the current program state than it is for hiding the program you're running. (Mnemonic: same as B<sh> and B<ksh>.) @@ -552,24 +553,15 @@ discouraged. =item $] -The string printed out when you say C<perl -v>. -(This is currently I<BROKEN>). -It can be used to -determine at the beginning of a script whether the perl interpreter -executing the script is in the right range of versions. If used in a -numeric context, returns the version + patchlevel / 1000. Example: - - # see if getc is available - ($version,$patchlevel) = - $] =~ /(\d+\.\d+).*\nPatch level: (\d+)/; - print STDERR "(No filename completion available.)\n" - if $version * 1000 + $patchlevel < 2016; - -or, used numerically, +The version + patchlevel / 1000 of the Perl interpreter. This variable +can be used to determine whether the Perl interpreter executing a +script is in the right range of versions. (Mnemonic: Is this version +of perl in the right bracket?) Example: warn "No checksumming!\n" if $] < 3.019; -(Mnemonic: Is this version of perl in the right bracket?) +See also the documentation of C<use VERSION> and C<require VERSION> +for a convenient way to fail if the Perl interpreter is too old. =item $DEBUGGING @@ -704,7 +696,7 @@ the Perl script. Here are some other examples: $SIG{"PIPE"} = Plumber(); # oops, what did Plumber() return?? The one marked scary is problematic because it's a bareword, which means -sometimes it's a string representing the function, and sometimes it's +sometimes it's a string representing the function, and sometimes it's going to call the subroutine call right then and there! Best to be sure and quote it or take a reference to it. *Plumber works too. See L<perlsub>. @@ -749,9 +741,9 @@ By default, running out of memory it is not trappable. However, if compiled for this, Perl may use the contents of C<$^M> as an emergency pool after die()ing with this message. Suppose that your Perl were compiled with -DEMERGENCY_SBRK and used Perl's malloc. Then - + $^M = 'a' x (1<<16); - + would allocate a 64K buffer for use when in emergency. See the F<INSTALL> file for information on how to enable this option. As a disincentive to casual use of this advanced feature, there is no L<English> long name for diff --git a/pod/perlxs.pod b/pod/perlxs.pod index ebead849dc..13ad669531 100644 --- a/pod/perlxs.pod +++ b/pod/perlxs.pod @@ -172,7 +172,7 @@ explicitly. If PPCODE: directive is not used, C<void> return value should be used only for subroutines which do not return a value, I<even if> CODE: -directive is used which sets ST(0) explicitly. +directive is used which sets ST(0) explicitly. Older versions of this document recommended to use C<void> return value in such cases. It was discovered that this could lead to @@ -289,7 +289,7 @@ its parameters. The Perl usage is given first. $status = rpcb_gettime( "localhost", $timep ); -The XSUB follows. +The XSUB follows. bool_t rpcb_gettime(host,timep) @@ -319,7 +319,7 @@ above, this keyword does not affect the way the compiler handles RETVAL. =head2 The NO_INIT Keyword The NO_INIT keyword is used to indicate that a function -parameter is being used as only an output value. The B<xsubpp> +parameter is being used only as an output value. The B<xsubpp> compiler will normally generate code to read the values of all function parameters from the argument stack and assign them to C variables upon entry to the function. NO_INIT @@ -328,7 +328,7 @@ output rather than for input and that they will be handled before the function terminates. The following example shows a variation of the rpcb_gettime() function. -This function uses the timep variable as only an output variable and does +This function uses the timep variable only as an output variable and does not care about its initial contents. bool_t @@ -694,7 +694,7 @@ To disable version checking: =head2 The PROTOTYPES: Keyword The PROTOTYPES: keyword corresponds to B<xsubpp>'s C<-prototypes> and -C<-noprototypes> options. This keyword overrides the command-line options. +C<-noprototypes> options. This keyword overrides the command line options. Prototypes are enabled by default. When prototypes are enabled XSUBs will be given Perl prototypes. This keyword may be used multiple times in an XS module to enable and disable prototypes for different parts of the module. diff --git a/pod/perlxstut.pod b/pod/perlxstut.pod index e31de334a8..cdd4344b78 100644 --- a/pod/perlxstut.pod +++ b/pod/perlxstut.pod @@ -55,7 +55,7 @@ to use the following line: =item * -This document assumes that the executable named "perl" is Perl version 5. +This document assumes that the executable named "perl" is Perl version 5. Some systems may have installed Perl version 5 as "perl5". =back @@ -145,7 +145,7 @@ And the Mytest.xs file should look something like this: #ifdef __cplusplus } #endif - + PROTOTYPES: DISABLE MODULE = Mytest PACKAGE = Mytest @@ -185,11 +185,11 @@ example only, we'll create a special test script. Create a file called hello that looks like this: #! /opt/perl5/bin/perl - + use ExtUtils::testlib; - + use Mytest; - + Mytest::hello(); Now we run the script and we should see the following output: @@ -222,7 +222,7 @@ the four lines starting at the "CODE:" line to not be indented. However, for readability purposes, it is suggested that you indent them 8 spaces (or one normal tab stop). -Now re-run make to rebuild our new shared library. +Now rerun make to rebuild our new shared library. Now perform the same steps as before, generating a Makefile from the Makefile.PL file, and running make. @@ -453,7 +453,7 @@ this behavior is tolerated. The next example will show how to do this. =head2 EXAMPLE 4 In this example, we'll now begin to write XSUBs that will interact with -pre-defined C libraries. To begin with, we will build a small library of +predefined C libraries. To begin with, we will build a small library of our own, then let h2xs write our .pm and .xs files for us. Create a new directory called Mytest2 at the same level as the directory @@ -475,7 +475,7 @@ Also create a file mylib.c that looks like this: #include <stdlib.h> #include "./mylib.h" - + double foo(a, b, c) int a; @@ -705,7 +705,7 @@ definition is placed. There is absolutely no excuse for not documenting your extension. Documentation belongs in the .pm file. This file will be fed to pod2man, -and the embedded documentation will be converted to the man page format, +and the embedded documentation will be converted to the manpage format, then placed in the blib directory. It will be copied to Perl's man page directory when the extension is installed. @@ -718,7 +718,7 @@ See L<perlpod> for more information about the pod format. =head2 INSTALLING YOUR EXTENSION Once your extension is complete and passes all its tests, installing it -is quite simple: you simply run "make install". You will either need +is quite simple: you simply run "make install". You will either need to have write permission into the directories where Perl is installed, or ask your system administrator to run the make for you. diff --git a/pod/pod2html.PL b/pod/pod2html.PL index 8dafea5d09..de36cd7fc9 100644 --- a/pod/pod2html.PL +++ b/pod/pod2html.PL @@ -32,655 +32,147 @@ $Config{startperl} # In the following, perl variables are not expanded during extraction. print OUT <<'!NO!SUBS!'; +=pod -# -# pod2html - convert pod format to html -# Version 1.21 -# usage: pod2html [podfiles] -# Will read the cwd and parse all files with .pod extension -# if no arguments are given on the command line. -# -# Many helps, suggestions, and fixes from the perl5 porters, and all over. -# Bill Middleton - wjm@metronet.com -# -# Please send patches/fixes/features to me -# - -require 'find.pl'; - -*RS = */; -*ERRNO = *!; - - -################################################################################ -# Invoke with various levels of debugging possible -################################################################################ -while ($ARGV[0] =~ /^-d(.*)/) { - shift; - $Debug{ lc($1 || shift) }++; -} - -# ck for podnames on command line -while ($ARGV[0]) { - push(@Pods,shift); -} - -################################################################################ -# CONFIGURE - change the following to suit your OS and taste -################################################################################ -# The beginning of the url for the anchors to the other sections. -# Edit $type to suit. It's configured for relative url's now. -# Other possibilities are: -# $type = '<A HREF="file://localhost/usr/local/htmldir/'; # file url -# $type = '<A HREF="http://www.bozo.com/perl/manual/html/' # server - -$type = '<A HREF="'; - -################################################################################ -# location of all podfiles unless on command line -# $installprivlib='HD:usr:local:lib:perl5'; # uncomment for Mac -# $installprivlib='C:\usr\local\lib\perl5'; # uncomment for DOS (I hope) -# $installprivlib='/usr/local/lib/perl5'; # Unix -$installprivlib="./"; # Standard perl pod directory for intallation - -################################################################################ -# Where to write out the html files -# $installhtmldir='HD:usr:local:lib:perl5:html'; # uncomment for Mac -# $installhtmldir='C:\usr\local\lib\perl5\html'; # uncomment for DOS (I hope) -$installhtmldir = './'; - -# test for validness - -if(!(-d $installhtmldir)){ - print "Installation directory $installhtmldir does not exist, using cwd\n"; - print "Hit ^C now to edit this script and configure installhtmldir\n"; - $installhtmldir = '.'; -} - -################################################################################ -# the html extension, change to htm for DOS - -$htmlext = "html"; - -################################################################################ -# arbitrary name for this group of pods - -$package = "perl"; - -################################################################################ -# look in these pods for links to things not found within the current pod -# be careful tho, namespace collisions cause stupid links - -@inclusions = qw[ perlfunc perlvar perlrun perlop ]; - -################################################################################ -# Directory path separator -# $sep= ":"; # uncomment for Mac -# $sep= "\"; # uncomment for DOS - -$sep= "/"; - -################################################################################ -# Create 8.3 html files if this equals 1 - -$DOSify=0; - -################################################################################ -# Create maximum 32 character html files if this equals 1 -$MACify=0; - -################################################################################ -# END CONFIGURE -# Beyond here be dragons. :-) -################################################################################ - -$A = {}; # The beginning of all things - -unless(@Pods){ - find($installprivlib); - splice(@Pods,$#Pods+1,0,@modpods);; -} - -@Pods or die "aak, expected pods"; -open(INDEX,">".$installhtmldir.$sep."index.".$htmlext) or - (die "cant open index.$htmlext"); -print INDEX "\n<HTML>\n<HEAD>\n<TITLE>Index of all pods for $package</TITLE></HEAD>\n<BODY>\n"; -print INDEX "<H1>Index of all pods for $package</H1>\n<hr><UL>\n"; -# loop twice through the pods, first to learn the links, then to produce html -for $count (0,1) { - print STDERR "Scanning pods...\n" unless $count; -loop1: - foreach $podfh ( @Pods ) { - $didindex = 0; - $refname = $podfh; - $refname =~ s/\Q$installprivlib${sep}\E?//; - $refname =~ s/${sep}/::/g; - $refname =~ s/\.p(m|od)$//; - $refname =~ s/^pod:://; - $savename = $refname; - $refname =~ s/::/_/g; - if($DOSify && !$count){ # shorten the name for DOS - (length($refname) > 8) and ( $refname = substr($refname,0,8)); - while(defined($DosNames{$refname})){ - @refname=split(//,$refname); - # allow 25 of em - ($refname[$#refname] eq "z") and ($refname[$#refname] = "a"); - $refname[$#refname]++; - $refname=join('',@refname); - $refname =~ s/\W/_/g; - } - $DosNames{$refname} = 1; - $Podnames{$savename} = $refname . ".$htmlext"; - } - elsif(!$DOSify and !$count){ - $Podnames{$savename} = $refname . ".$htmlext"; - } - $pod = $savename; - Debug("files", "opening 2 $podfh" ); - print "Creating $Podnames{$savename} from $podfh\n" if $count; - $RS = "\n="; # grok pods by item (Nonstandard but effecient) - open($podfh,"<".$podfh) || die "can't open $podfh: $ERRNO"; - @all = <$podfh>; - close($podfh); - $RS = "\n"; - ($all[0] =~ s/^=//) || pop(@all); - for ($i=0;$i <= $#all;$i++){ splice(@all,$i+1,1) unless - (($all[$i] =~ s/=$//) && ($all[$i+1] !~ /^cut/)) ; # whoa.. - } - $in_list = 0; - unless (grep(/NAME/,@all)){ - print STDERR "NAME header not found in $podfh, skipping\n"; - #delete($Podnames{$savename}); - next loop1; - } - if ($count) { - next unless length($Podnames{$savename}); - open(HTML,">".$installhtmldir.$sep.$Podnames{$savename}) or - (die "can't create $Podnames{$savename}: $ERRNO"); - print HTML "<HTML><HEAD>"; - print HTML "<TITLE>$refname</TITLE>\n</HEAD>\n<BODY>"; - } - - for ($i = 0; $i <= $#all; $i++) { # decide what to do with each chunk - $all[$i] =~ /^(\w+)\s*(.*)\n?([^\0]*)$/ ; - ($cmd, $title, $rest) = ($1,$2,$3); - if(length($cmd)){$cutting =0;} - next if $cutting; - if(($title =~ /NAME/) and ($didindex == 0) and $count){ - print INDEX "<LI><A HREF=\"$Podnames{$savename}\">$rest</A>\n"; - $didindex=1; - } - if ($cmd eq "item") { - if ($count ) { # producing html - do_list("over",$all[$i],\$in_list,\$depth) unless $depth; - do_item($title,$rest,$in_list); - } - else { - # scan item - scan_thing("item",$title,$pod); - } - } - elsif ($cmd =~ /^head([12])/) { - $num = $1; - if ($count) { # producing html - do_hdr($num,$title,$rest,$depth); - } - else { - # header scan - scan_thing($cmd,$title,$pod); # skip head1 - } - } - elsif ($cmd =~ /^over/) { - $count and $depth and do_list("over",$all[$i+1],\$in_list,\$depth); - } - elsif ($cmd =~ /^back/) { - if ($count) { # producing html - ($depth) or next; # just skip it - do_list("back",$all[$i+1],\$in_list,\$depth); - do_rest("$title$rest"); - } - } - elsif ($cmd =~ /^cut/) { - next; - } - elsif ($cmd =~ /^for/) { # experimental pragma html - if ($count) { # producing html - if ($title =~ s/^html//) { - $in_html =1; - do_rest("$title$rest"); - } - } - } - elsif ($cmd =~ /^begin/) { # experimental pragma html - if ($count) { # producing html - if ($title =~ s/^html//) { - print HTML $title,"\n",$rest; - } - elsif ($title =~ /^end/) { - next; - } - } - } - elsif ($Debug{"misc"}) { - warn("unrecognized header: $cmd"); - } - } - # close open lists without '=back' stmts - if ($count) { # producing html - while ($depth) { - do_list("back",$all[$i+1],\$in_list,\$depth); - } - print HTML "\n</BODY>\n</HTML>\n"; - } - } -} -print INDEX "\n</UL></BODY>\n</HTML>\n"; - -sub do_list{ # setup a list type, depending on some grok logic - my($which,$next_one,$list_type,$depth) = @_; - my($key); - if ($which eq "over") { - unless ($next_one =~ /^item\s+(.*)/) { - warn "Bad list, $1\n" if $Debug{"misc"}; - } - $key = $1; - - if ($key =~ /^1\.?/) { - $$list_type = "OL"; - } elsif ($key =~ /\*\s*$/) { - $$list_type = "UL"; - } elsif ($key =~ /\*?\s*\w/) { - $$list_type = "DL"; - } else { - warn "unknown list type for item $key" if $Debug{"misc"}; - } - - print HTML qq{\n}; - print HTML qq{<$$list_type>}; - $$depth++; - } - elsif ($which eq "back") { - print HTML qq{\n</$$list_type>\n}; - $$depth--; - } -} - -sub do_hdr{ # headers - my($num,$title,$rest,$depth) = @_; - my($savename,$restofname); - print HTML qq{<p><hr>\n} if $num == 1; - ($savename = $title) =~ s/^(\w+)([\s,]+.*)/$1/; - $restofname = $2; - (defined($Podnames{$savename})) ? ($savename = $savename) : ($savename = 0); - process_thing(\$title,"NAME"); - print HTML qq{\n<H$num> }; - if($savename){ - print HTML "<A HREF=\"$Podnames{$savename}\">$savename$restofname</A>"; - } - else{ - print HTML $title; - } - print HTML qq{</H$num>\n}; - do_rest($rest); -} - -sub do_item{ # list items - my($title,$rest,$list_type) = @_; - my $bullet_only; - $bullet_only = ($title eq '*' and $list_type eq 'UL') ? 1 : 0; - my($savename); - $savename = $title; - (defined($Podnames{$savename})) ? ($savename = $savename) : ($savename = 0); - process_thing(\$title,"NAME"); - if ($list_type eq "DL") { - print HTML qq{\n<DT>\n}; - if($savename){ - print HTML "<A HREF=\"$Podnames{$savename}\">$savename $rest</A>\n</DT>"; - } - - else{ - (print HTML qq{\n<STRONG>\n}) unless ($title =~ /STRONG/); - print HTML $title; - if($title !~ /STRONG/){ - print HTML "\n</STRONG></DT>\n"; - } else { - print HTML "</DT>\n"; - } - } - print HTML qq{<DD>\n}; - } - else { - print HTML qq{\n<LI>}; - unless ($bullet_only or $list_type eq "OL") { - if($savename){ - print HTML "<A HREF=\"$savename.$htmlext\">$savename</A>"; - } - else{ - print HTML $title,"\n"; - } - } - } - do_rest($rest); -} - -sub do_rest{ # the rest of the chunk handled here - my($rest) = @_; - my(@lines,$p,$q,$line,,@paras,$inpre); - @paras = split(/\n\n\n*/,$rest); - for ($p = 0; $p <= $#paras; $p++) { - $paras[$p] =~ s/^\n//mg; - @lines = split(/\n/,$paras[$p]); - if ($in_html) { # handle =for html paragraphs - print HTML $paras[0]; - $in_html = 0; - next; - } - elsif ($lines[0] =~ /^\s+\w*\t.*/) { # listing or unordered list - print HTML qq{<UL>}; - foreach $line (@lines) { - ($line =~ /^\s+(\w*)\t(.*)/) && (($key,$rem) = ($1,$2)); - print HTML defined($Podnames{$key}) - ? "<LI>$type$Podnames{$key}\">$key<\/A>\t$rem</LI>\n" - : "<LI>$line</LI>\n"; - } - print HTML qq{</UL>\n}; - } - elsif ($lines[0] =~ /^\s/) { # preformatted code - if ($paras[$p] =~/>>|<</) { - print HTML qq{\n<PRE>\n}; - $inpre=1; - } - else { # Still cant beat XMP. Yes, I know - print HTML qq{\n<XMP>\n}; # it's been obsoleted... suggestions? - $inpre = 0; - } - while (defined($paras[$p])) { - @lines = split(/\n/,$paras[$p]); - foreach $q (@lines) { # mind your p's and q's here :-) - if ($paras[$p] =~ />>|<</) { - if ($inpre) { - process_thing(\$q,"HTML"); - } - else { - print HTML qq{\n</XMP>\n}; - print HTML qq{<PRE>\n}; - $inpre=1; - process_thing(\$q,"HTML"); - } - } - 1 while $q =~ s/\t+/' 'x (length($&) * 8 - length($`) % 8)/e; - print HTML $q,"\n"; - } - last if $paras[$p+1] !~ /^\s/; - $p++; - } - print HTML ($inpre==1) ? (qq{\n</PRE>\n}) : (qq{\n</XMP>\n}); - } - else { # other text - @lines = split(/\n/,$paras[$p]); - foreach $line (@lines) { - process_thing(\$line,"HTML"); - $line =~ s/STRONG([^>])/STRONG>$1/; # lame attempt to fix strong - print HTML qq{$line\n}; - } - } - print HTML qq{<p>}; - } -} - -sub process_thing{ # process a chunk, order important - my($thing,$htype) = @_; - pre_escapes($thing); - find_refs($thing,$htype); - post_escapes($thing); -} - -sub scan_thing{ # scan a chunk for later references - my($cmd,$title,$pod) = @_; - $_ = $title; - s/\n$//; - s/E<(.*?)>/&$1;/g; - # remove any formatting information for the headers - s/[SFCBI]<(.*?)>/$1/g; - # the "don't format me" thing - s/Z<>//g; - if ($cmd eq "item") { - /^\*/ and return; # skip bullets - /^\d+\./ and return; # skip numbers - s/(-[a-z]).*/$1/i; - trim($_); - return if defined $A->{$pod}->{"Items"}->{$_}; - $A->{$pod}->{"Items"}->{$_} = gensym($pod, $_); - $A->{$pod}->{"Items"}->{(split(' ',$_))[0]}=$A->{$pod}->{"Items"}->{$_}; - Debug("items", "item $_"); - if (!/^-\w$/ && /([%\$\@\w]+)/ && $1 ne $_ - && !defined($A->{$pod}->{"Items"}->{$_}) && ($_ ne $1)) - { - $A->{$pod}->{"Items"}->{$1} = $A->{$pod}->{"Items"}->{$_}; - Debug("items", "item $1 REF TO $_"); - } - if ( m{^(tr|y|s|m|q[qwx])/.*[^/]} ) { - my $pf = $1 . '//'; - $pf .= "/" if $1 eq "tr" || $1 eq "y" || $1 eq "s"; - if ($pf ne $_) { - $A->{$pod}->{"Items"}->{$pf} = $A->{$pod}->{"Items"}->{$_}; - Debug("items", "item $pf REF TO $_"); - } - } - } - elsif ($cmd =~ /^head[12]/) { - return if defined($A->{$pod}->{"Headers"}->{$_}); - $A->{$pod}->{"Headers"}->{$_} = gensym($pod, $_); - Debug("headers", "header $_"); - } - else { - warn "unrecognized header: $cmd" if $Debug; - } -} - - -sub picrefs { - my($char, $bigkey, $lilkey,$htype) = @_; - my($key,$ref,$podname); - for $podname ($pod,@inclusions) { - for $ref ( "Items", "Headers" ) { - if (defined $A->{$podname}->{$ref}->{$bigkey}) { - $value = $A->{$podname}->{$ref}->{$key = $bigkey}; - Debug("subs", "bigkey is $bigkey, value is $value\n"); - } - elsif (defined $A->{$podname}->{$ref}->{$lilkey}) { - $value = $A->{$podname}->{$ref}->{$key = $lilkey}; - return "" if $lilkey eq ''; - Debug("subs", "lilkey is $lilkey, value is $value\n"); - } - } - if (length($key)) { - ($pod2, $num) = $value =~ /^(.*)_(\S+_\d+)$/; - if ($htype eq "NAME") { - return "\n<A NAME=\"".$value."\">\n$bigkey</A>\n" - } - else { - 1; # break here - return "\n$type$Podnames{$pod2}\#".$value."\">$bigkey<\/A>\n"; - } - } - } - if ($char =~ /[IF]/) { - return "<EM>$bigkey</EM>"; - } elsif ($char =~ /C/) { - return "<CODE>$bigkey</CODE>"; - } else { - if($bigkey =~ /STRONG/){ - return $bigkey; - } - else { - return "<STRONG>$bigkey</STRONG>"; - } - } -} - -sub find_refs { - my($thing,$htype) = @_; - my($orig) = $$thing; - # LREF: a manpage(3f) we don't know about - for ($$thing) { - #s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))>:the I<$1>$2 manpage:g; - s@(\S+?://\S*[^.,;!?\s])@noremap(qq{<A HREF="$1">$1</A>})@ge; - s,([a-z0-9_.-]+\@([a-z0-9_-]+\.)+([a-z0-9_-]+)),noremap(qq{<A HREF="MAILTO:$1">$1</A>}),gie; - s/L<([^>]*)>/lrefs($1,$htype)/ge; - s/([CIBF])<(\W*?(-?\w*).*?)>/picrefs($1, $2, $3, $htype)/ge; - s/(S)<([^\/]\W*?(-?\w*).*?)>/picrefs($1, $2, $3, $htype)/ge; - s/((\w+)\(\))/picrefs("I", $1, $2,$htype)/ge; - s/([\$\@%](?!&[gl]t)([\w:]+|\W\b))/varrefs($1,$htype)/ge; - } - if ($$thing eq $orig && $htype eq "NAME") { - $$thing = picrefs("I", $$thing, "", $htype); - } - -} - -sub lrefs { - my($page, $item) = split(m#/#, $_[0], 2); - my($htype) = $_[1]; - my($podname); - my($section) = $page =~ /\((.*)\)/; - my $selfref; - if ($page =~ /^[A-Z]/ && $item) { - $selfref++; - $item = "$page/$item"; - $page = $pod; - } elsif (!$item && $page =~ /[^a-z\-]/ && $page !~ /^\$.$/) { - $selfref++; - $item = $page; - $page = $pod; - } - $item =~ s/\(\)$//; - if (!$item) { - if (!defined $section && defined $Podnames{$page}) { - return "\n$type$Podnames{$page}\">\nthe <EM>$page</EM> manpage<\/A>\n"; - } else { - (warn "Bizarre entry $page/$item") if $Debug; - return "the <EM>$_[0]</EM> manpage\n"; - } - } - - if ($item =~ s/"(.*)"/$1/ || ($item =~ /[^\w\/\-]/ && $item !~ /^\$.$/)) { - $text = "<EM>$item</EM>"; - $ref = "Headers"; - } else { - $text = "<EM>$item</EM>"; - $ref = "Items"; - } - for $podname ($pod, @inclusions) { - undef $value; - if ($ref eq "Items") { - if (defined($value = $A->{$podname}->{$ref}->{$item})) { - ($pod2,$num) = split(/_/,$value,2); # break here - return (($pod eq $pod2) && ($htype eq "NAME")) - ? "\n<A NAME=\"".$value."\">\n$text</A>\n" - : "\n$type$Podnames{$pod2}\#".$value."\">$text<\/A>\n"; - } - } - elsif ($ref eq "Headers") { - if (defined($value = $A->{$podname}->{$ref}->{$item})) { - ($pod2,$num) = split(/_/,$value,2); # break here - return (($pod eq $pod2) && ($htype eq "NAME")) - ? "\n<A NAME=\"".$value."\">\n$text</A>\n" - : "\n$type$Podnames{$pod2}\#".$value."\">$text<\/A>\n"; - } - } - } - warn "No $ref reference for $item (@_)" if $Debug; - return $text; -} - -sub varrefs { - my ($var,$htype) = @_; - for $podname ($pod,@inclusions) { - if ($value = $A->{$podname}->{"Items"}->{$var}) { - ($pod2,$num) = split(/_/,$value,2); - Debug("vars", "way cool -- var ref on $var"); - return (($pod eq $pod2) && ($htype eq "NAME")) # INHERIT $_, $pod - ? "\n<A NAME=\"".$value."\">\n$var</A>\n" - : "\n$type$Podnames{$pod2}\#".$value."\">$var<\/A>\n"; - } - } - Debug( "vars", "bummer, $var not a var"); - if($var =~ /STRONG/){ - return $var; - } - else{ - return "<STRONG>$var</STRONG>"; - } -} - -sub gensym { - my ($podname, $key) = @_; - $key =~ s/\s.*//; - ($key = lc($key)) =~ tr/a-z/_/cs; - my $name = "${podname}_${key}_0"; - $name =~ s/__/_/g; - while ($sawsym{$name}++) { - $name =~ s/_?(\d+)$/'_' . ($1 + 1)/e; - } - return $name; -} - -sub pre_escapes { # twiddle these, and stay up late :-) - my($thing) = @_; - for ($$thing) { - s/([\200-\377])/noremap("&#".ord($1).";")/ge; - s/"(.*?)"/``$1''/gs; - s/&/noremap("&")/ge; - s/<</noremap("<<")/eg; - s/([^ESIBLCF])</$1\<\;/g; - s/E<(\d+)>/\&#$1\;/g; # embedded numeric special - s/E<([^\/][^<>]*)>/\&$1\;/g; # embedded special - } -} -sub noremap { # adding translator for hibit chars soon - my $hide = $_[0]; - $hide =~ tr/\000-\177/\200-\377/; - $hide; -} - - -sub post_escapes { - my($thing) = @_; - for ($$thing) { - s/([^GM])>>/$1\>\;\>\;/g; - s/([^D][^"MGA])>/$1\>\;/g; - tr/\200-\377/\000-\177/; - } -} - -sub Debug { - my $level = shift; - print STDERR @_,"\n" if $Debug{$level}; -} - -sub dumptable { - my $t = shift; - print STDERR "TABLE DUMP $t\n"; - foreach $k (sort keys %$t) { - printf STDERR "%-20s <%s>\n", $t->{$k}, $k; - } -} -sub trim { - for (@_) { - s/^\s+//; - s/\s\n?$//; - } -} -sub wanted { - my $name = $name; - if (-f $_) { - if ($name =~ /\.p(m|od)$/){ - push(@modpods, $name) if ($name =~ /\.p(m|od)$/); - } - } -} +=head1 NAME +pod2html - convert .pod files to .html files + +=head1 SYNOPSIS + + pod2html --help --htmlroot=<name> --infile=<name> --outfile=<name> + --podpath=<name>:...:<name> --podroot=<name> + --libpods=<name>:...:<name> --recurse --norecurse --verbose + --index --noindex --title=<name> + +=head1 DESCRIPTION + +Converts files from pod format (see L<perlpod>) to HTML format. + +=head1 ARGUMENTS + +pod2html takes the following arguments: + +=over 4 + +=item help + + --help + +Displays the usage message. + +=item htmlroot + + --htmlroot=name + +Sets the base URL for the HTML files. When cross-references are made, +the HTML root is prepended to the URL. + +=item infile + + --infile=name + +Specify the pod file to convert. Input is taken from STDIN if no +infile is specified. + +=item outfile + + --outfile=name + +Specify the HTML file to create. Output goes to STDOUT if no outfile +is specified. + +=item podroot + + --podroot=name + +Specify the base directory for finding library pods. + +=item podpath + + --podpath=name:...:name + +Specify which subdirectories of the podroot contain pod files whose +HTML converted forms can be linked-to in cross-references. + +=item libpods + + --libpods=name:...:name + +List of page names (eg, "perlfunc") which contain linkable C<=item>s. + +=item netscape + + --netscape + +Use Netscape HTML directives when applicable. + +=item nonetscape + + --nonetscape + +Do not use Netscape HTML directives (default). + +=item index + + --index + +Generate an index at the top of the HTML file (default behaviour). + +=item noindex + + --noindex + +Do not generate an index at the top of the HTML file. + + +=item recurse + + --recurse + +Recurse into subdirectories specified in podpath (default behaviour). + +=item norecurse + + --norecurse + +Do not recurse into subdirectories specified in podpath. + +=item title + + --title=title + +Specify the title of the resulting HTML file. + +=item verbose + + --verbose + +Display progress messages. + +=back + +=head1 AUTHOR + +Tom Christiansen, E<lt>tchrist@perl.comE<gt>. + +=head1 BUGS + +See L<Pod::Html> for a list of known bugs in the translator. + +=head1 SEE ALSO + +L<perlpod>, L<Pod::HTML> + +=head1 COPYRIGHT + +This program is distributed under the Artistic License. + +=cut + +use Pod::Html; + +pod2html @ARGV; !NO!SUBS! close OUT or die "Can't close $file: $!"; diff --git a/pod/pod2man.PL b/pod/pod2man.PL index 88ce73f126..cd14ce2866 100644 --- a/pod/pod2man.PL +++ b/pod/pod2man.PL @@ -404,7 +404,22 @@ if ($section =~ /^1/) { $name = uc File::Basename::basename($name); } $name =~ s/\.(pod|p[lm])$//i; -$name =~ s(/)(::)g; # translate Getopt/Long to Getopt::Long, etc. + +# Lose everything up to the first of +# */lib/*perl* standard or site_perl module +# */*perl*/lib from -D prefix=/opt/perl +# */*perl*/ random module hierarchy +# which works. +$name =~ s-//+-/-g; +if ($name =~ s-^.*?/lib/[^/]*perl[^/]*/--i + or $name =~ s-^.*?/[^/]*perl[^/]*/lib/--i + or $name =~ s-^.*?/[^/]*perl[^/]*/--i) { + # Lose ^arch/version/. + $name =~ s-^[^/]+/\d+\.\d+/--; +} + +# Translate Getopt/Long to Getopt::Long, etc. +$name =~ s(/)(::)g; if ($name ne 'something') { FCHECK: { @@ -416,9 +431,16 @@ if ($name ne 'something') { unless (/\s*-+\s+/) { $oops++; warn "$0: Improper man page - no dash in NAME header in paragraph $. of $ARGV[0]\n" - } else { - %namedesc = split /\s+-+\s+/; - } + } else { + my @n = split /\s+-+\s+/; + if (@n != 2) { + $oops++; + warn "$0: Improper man page - malformed NAME header in paragraph $. of $ARGV[0]\n" + } + else { + %namedesc = @n; + } + } last FCHECK; } next if /^=cut\b/; # DB_File and Net::Ping have =cut before NAME @@ -40,9 +40,8 @@ static bool srand_called = FALSE; PP(pp_stub) { dSP; - if (GIMME != G_ARRAY) { + if (GIMME_V == G_SCALAR) XPUSHs(&sv_undef); - } RETURN; } @@ -81,15 +80,18 @@ PP(pp_padav) PP(pp_padhv) { dSP; dTARGET; + I32 gimme; + XPUSHs(TARG); if (op->op_private & OPpLVAL_INTRO) SAVECLEARSV(curpad[op->op_targ]); if (op->op_flags & OPf_REF) RETURN; - if (GIMME == G_ARRAY) { /* array wanted */ + gimme = GIMME_V; + if (gimme == G_ARRAY) { RETURNOP(do_kv(ARGS)); } - else { + else if (gimme == G_SCALAR) { SV* sv = sv_newmortal(); if (HvFILL((HV*)TARG)) { sprintf(buf, "%ld/%ld", @@ -99,8 +101,8 @@ PP(pp_padhv) else sv_setiv(sv, 0); SETs(sv); - RETURN; } + RETURN; } PP(pp_padany) @@ -550,12 +552,14 @@ PP(pp_undef) hv_undef((HV*)sv); break; case SVt_PVCV: - if (!CvANON((CV*)sv) && cv_const_sv((CV*)sv)) + if (cv_const_sv((CV*)sv)) warn("Constant subroutine %s undefined", - GvENAME(CvGV((CV*)sv))); + CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv))); /* FALL THROUGH */ case SVt_PVFM: - cv_undef((CV*)sv); + { GV* gv = (GV*)SvREFCNT_inc(CvGV((CV*)sv)); + cv_undef((CV*)sv); + CvGV((CV*)sv) = gv; } /* let user-undef'd sub keep its identity */ break; case SVt_PVGV: if (SvFAKE(sv)) @@ -688,34 +692,43 @@ PP(pp_modulo) { UV left; UV right; - bool negate; + bool left_neg; + bool right_neg; UV ans; if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) { IV i = SvIVX(POPs); - right = (i < 0) ? -i : i; + right = (right_neg = (i < 0)) ? -i : i; } else { double n = POPn; - right = U_V((n < 0) ? -n : n); + right = U_V((right_neg = (n < 0)) ? -n : n); } if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) { IV i = SvIVX(POPs); - left = (negate = (i < 0)) ? -i : i; + left = (left_neg = (i < 0)) ? -i : i; } else { double n = POPn; - left = U_V((negate = (n < 0)) ? -n : n); + left = U_V((left_neg = (n < 0)) ? -n : n); } if (!right) DIE("Illegal modulus zero"); ans = left % right; - if (negate && ans) + if ((left_neg != right_neg) && ans) ans = right - ans; - PUSHu(ans); + if (right_neg) { + if (ans <= -(UV)IV_MAX) + sv_setiv(TARG, (IV) -ans); + else + sv_setnv(TARG, -(double)ans); + } + else + sv_setuv(TARG, ans); + PUSHTARG; RETURN; } } @@ -825,7 +838,7 @@ PP(pp_lt) dSP; tryAMAGICbinSET(lt,0); { dPOPnv; - SETs((TOPn < value) ? &sv_yes : &sv_no); + SETs(boolSV(TOPn < value)); RETURN; } } @@ -835,7 +848,7 @@ PP(pp_gt) dSP; tryAMAGICbinSET(gt,0); { dPOPnv; - SETs((TOPn > value) ? &sv_yes : &sv_no); + SETs(boolSV(TOPn > value)); RETURN; } } @@ -845,7 +858,7 @@ PP(pp_le) dSP; tryAMAGICbinSET(le,0); { dPOPnv; - SETs((TOPn <= value) ? &sv_yes : &sv_no); + SETs(boolSV(TOPn <= value)); RETURN; } } @@ -855,7 +868,7 @@ PP(pp_ge) dSP; tryAMAGICbinSET(ge,0); { dPOPnv; - SETs((TOPn >= value) ? &sv_yes : &sv_no); + SETs(boolSV(TOPn >= value)); RETURN; } } @@ -865,7 +878,7 @@ PP(pp_ne) dSP; tryAMAGICbinSET(ne,0); { dPOPnv; - SETs((TOPn != value) ? &sv_yes : &sv_no); + SETs(boolSV(TOPn != value)); RETURN; } } @@ -900,7 +913,7 @@ PP(pp_slt) int cmp = ((op->op_private & OPpLOCALE) ? sv_cmp_locale(left, right) : sv_cmp(left, right)); - SETs( cmp < 0 ? &sv_yes : &sv_no ); + SETs(boolSV(cmp < 0)); RETURN; } } @@ -913,7 +926,7 @@ PP(pp_sgt) int cmp = ((op->op_private & OPpLOCALE) ? sv_cmp_locale(left, right) : sv_cmp(left, right)); - SETs( cmp > 0 ? &sv_yes : &sv_no ); + SETs(boolSV(cmp > 0)); RETURN; } } @@ -926,7 +939,7 @@ PP(pp_sle) int cmp = ((op->op_private & OPpLOCALE) ? sv_cmp_locale(left, right) : sv_cmp(left, right)); - SETs( cmp <= 0 ? &sv_yes : &sv_no ); + SETs(boolSV(cmp <= 0)); RETURN; } } @@ -939,7 +952,7 @@ PP(pp_sge) int cmp = ((op->op_private & OPpLOCALE) ? sv_cmp_locale(left, right) : sv_cmp(left, right)); - SETs( cmp >= 0 ? &sv_yes : &sv_no ); + SETs(boolSV(cmp >= 0)); RETURN; } } @@ -949,7 +962,7 @@ PP(pp_seq) dSP; tryAMAGICbinSET(seq,0); { dPOPTOPssrl; - SETs( sv_eq(left, right) ? &sv_yes : &sv_no ); + SETs(boolSV(sv_eq(left, right))); RETURN; } } @@ -959,7 +972,7 @@ PP(pp_sne) dSP; tryAMAGICbinSET(sne,0); { dPOPTOPssrl; - SETs( !sv_eq(left, right) ? &sv_yes : &sv_no ); + SETs(boolSV(!sv_eq(left, right))); RETURN; } } @@ -1083,7 +1096,7 @@ PP(pp_not) #ifdef OVERLOAD dSP; tryAMAGICunSET(not); #endif /* OVERLOAD */ - *stack_sp = SvTRUE(*stack_sp) ? &sv_no : &sv_yes; + *stack_sp = boolSV(!SvTRUE(*stack_sp)); return NORMAL; } @@ -1190,7 +1203,7 @@ PP(pp_i_lt) dSP; tryAMAGICbinSET(lt,0); { dPOPTOPiirl; - SETs((left < right) ? &sv_yes : &sv_no); + SETs(boolSV(left < right)); RETURN; } } @@ -1200,7 +1213,7 @@ PP(pp_i_gt) dSP; tryAMAGICbinSET(gt,0); { dPOPTOPiirl; - SETs((left > right) ? &sv_yes : &sv_no); + SETs(boolSV(left > right)); RETURN; } } @@ -1210,7 +1223,7 @@ PP(pp_i_le) dSP; tryAMAGICbinSET(le,0); { dPOPTOPiirl; - SETs((left <= right) ? &sv_yes : &sv_no); + SETs(boolSV(left <= right)); RETURN; } } @@ -1220,7 +1233,7 @@ PP(pp_i_ge) dSP; tryAMAGICbinSET(ge,0); { dPOPTOPiirl; - SETs((left >= right) ? &sv_yes : &sv_no); + SETs(boolSV(left >= right)); RETURN; } } @@ -1230,7 +1243,7 @@ PP(pp_i_eq) dSP; tryAMAGICbinSET(eq,0); { dPOPTOPiirl; - SETs((left == right) ? &sv_yes : &sv_no); + SETs(boolSV(left == right)); RETURN; } } @@ -1240,7 +1253,7 @@ PP(pp_i_ne) dSP; tryAMAGICbinSET(ne,0); { dPOPTOPiirl; - SETs((left != right) ? &sv_yes : &sv_no); + SETs(boolSV(left != right)); RETURN; } } @@ -1354,28 +1367,50 @@ PP(pp_srand) static U32 seed() { + /* + * This is really just a quick hack which grabs various garbage + * values. It really should be a real hash algorithm which + * spreads the effect of every input bit onto every output bit, + * if someone who knows about such tings would bother to write it. + * Might be a good idea to add that function to CORE as well. + * No numbers below come from careful analysis or anyting here, + * except they are primes and SEED_C1 > 1E6 to get a full-width + * value from (tv_sec * SEED_C1 + tv_usec). The multipliers should + * probably be bigger too. + */ +#if RANDBITS > 16 +# define SEED_C1 1000003 +#define SEED_C4 73819 +#else +# define SEED_C1 25747 +#define SEED_C4 20639 +#endif +#define SEED_C2 3 +#define SEED_C3 269 +#define SEED_C5 26107 + U32 u; #ifdef VMS # include <starlet.h> unsigned int when[2]; _ckvmssts(sys$gettim(when)); - u = when[0] ^ when[1]; + /* Please tell us: Which value is seconds and what is the other here? */ + u = (U32)SEED_C1 * when[0] + (U32)SEED_C2 * when[1]; #else # ifdef HAS_GETTIMEOFDAY struct timeval when; gettimeofday(&when,(struct timezone *) 0); - u = when.tv_sec ^ when.tv_usec; + u = (U32)SEED_C1 * when.tv_sec + (U32)SEED_C2 * when.tv_usec; # else Time_t when; (void)time(&when); - u = when; + u = (U32)SEED_C1 * when; # endif #endif -#ifndef PLAN9 /* XXX Plan9 assembler chokes on this; fix needed */ - /* What is a good hashing algorithm here? */ - u ^= ( ( 269 * (U32)getpid()) - ^ (26107 * (U32)&when) - ^ (73819 * (U32)stack_sp)); + u += SEED_C3 * (U32)getpid(); + u += SEED_C4 * (U32)(UV)stack_sp; +#ifndef PLAN9 /* XXX Plan9 assembler chokes on this; fix needed */ + u += SEED_C5 * (U32)(UV)&when; #endif return u; } @@ -1990,22 +2025,23 @@ PP(pp_each) dSP; dTARGET; HV *hash = (HV*)POPs; HE *entry; + I32 gimme = GIMME_V; PUTBACK; - entry = hv_iternext(hash); /* might clobber stack_sp */ + entry = hv_iternext(hash); /* might clobber stack_sp */ SPAGAIN; EXTEND(SP, 2); if (entry) { - PUSHs(hv_iterkeysv(entry)); /* won't clobber stack_sp */ - if (GIMME == G_ARRAY) { + PUSHs(hv_iterkeysv(entry)); /* won't clobber stack_sp */ + if (gimme == G_ARRAY) { PUTBACK; - sv_setsv(TARG, hv_iterval(hash, entry)); /* might clobber stack_sp */ + sv_setsv(TARG, hv_iterval(hash, entry)); /* might hit stack_sp */ SPAGAIN; PUSHs(TARG); } } - else if (GIMME == G_SCALAR) + else if (gimme == G_SCALAR) RETPUSHUNDEF; RETURN; @@ -2024,6 +2060,8 @@ PP(pp_keys) PP(pp_delete) { dSP; + I32 gimme = GIMME_V; + I32 discard = (gimme == G_VOID) ? G_DISCARD : 0; SV *sv; HV *hv; @@ -2033,11 +2071,12 @@ PP(pp_delete) if (SvTYPE(hv) != SVt_PVHV) DIE("Not a HASH reference"); while (++MARK <= SP) { - sv = hv_delete_ent(hv, *MARK, - (op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0), 0); + sv = hv_delete_ent(hv, *MARK, discard, 0); *MARK = sv ? sv : &sv_undef; } - if (GIMME != G_ARRAY) { + if (discard) + SP = ORIGMARK; + else if (gimme == G_SCALAR) { MARK = ORIGMARK; *++MARK = *SP; SP = MARK; @@ -2048,11 +2087,11 @@ PP(pp_delete) hv = (HV*)POPs; if (SvTYPE(hv) != SVt_PVHV) DIE("Not a HASH reference"); - sv = hv_delete_ent(hv, keysv, - (op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0), 0); + sv = hv_delete_ent(hv, keysv, discard, 0); if (!sv) sv = &sv_undef; - PUSHs(sv); + if (!discard) + PUSHs(sv); } RETURN; } @@ -2481,7 +2520,7 @@ PP(pp_reverse) if (SP - MARK > 1) do_join(TARG, &sv_no, MARK, SP); else - sv_setsv(TARG, *SP); + sv_setsv(TARG, (SP > MARK) ? *SP : GvSV(defgv)); up = SvPV_force(TARG, len); if (len > 1) { down = SvPVX(TARG) + len - 1; @@ -2534,6 +2573,7 @@ PP(pp_unpack) dSP; dPOPPOPssrl; SV **oldsp = sp; + I32 gimme = GIMME_V; SV *sv; STRLEN llen; STRLEN rlen; @@ -2567,7 +2607,7 @@ PP(pp_unpack) double cdouble; static char* bitcount = 0; - if (GIMME != G_ARRAY) { /* arrange to do first one only */ + if (gimme != G_ARRAY) { /* arrange to do first one only */ /*SUPPRESS 530*/ for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ; if (strchr("aAbBhHP", *patend) || *pat == '%') { @@ -3206,7 +3246,7 @@ PP(pp_unpack) checksum = 0; } } - if (sp == oldsp && GIMME != G_ARRAY) + if (sp == oldsp && gimme == G_SCALAR) PUSHs(&sv_undef); RETURN; } @@ -3772,7 +3812,7 @@ PP(pp_split) I32 realarray = 0; I32 base; AV *oldstack = curstack; - I32 gimme = GIMME; + I32 gimme = GIMME_V; I32 oldsave = savestack_ix; #ifdef DEBUGGING @@ -23,7 +23,7 @@ #define WORD_ALIGN sizeof(U16) #endif -#define DOCATCH(o) (mustcatch ? docatch(o) : (o)) +#define DOCATCH(o) ((CATCH_GET == TRUE) ? docatch(o) : (o)) static OP *docatch _((OP *o)); static OP *doeval _((int gimme)); @@ -50,10 +50,14 @@ PP(pp_wantarray) if (cxix < 0) RETPUSHUNDEF; - if (cxstack[cxix].blk_gimme == G_ARRAY) + switch (cxstack[cxix].blk_gimme) { + case G_ARRAY: RETPUSHYES; - else + case G_SCALAR: RETPUSHNO; + default: + RETPUSHUNDEF; + } } PP(pp_regcmaybe) @@ -462,7 +466,7 @@ PP(pp_grepstart) if (stack_base + *markstack_ptr == sp) { (void)POPMARK; - if (GIMME != G_ARRAY) + if (GIMME_V == G_SCALAR) XPUSHs(&sv_no); RETURNOP(op->op_next->op_next); } @@ -525,6 +529,7 @@ PP(pp_mapwhile) /* All done yet? */ if (markstack_ptr[-1] > *markstack_ptr) { I32 items; + I32 gimme = GIMME_V; (void)POPMARK; /* pop top */ LEAVE; /* exit outer scope */ @@ -532,12 +537,12 @@ PP(pp_mapwhile) items = --*markstack_ptr - markstack_ptr[-1]; (void)POPMARK; /* pop dst */ SP = stack_base + POPMARK; /* pop original mark */ - if (GIMME != G_ARRAY) { + if (gimme == G_SCALAR) { dTARGET; XPUSHi(items); - RETURN; } - SP += items; + else if (gimme == G_ARRAY) + SP += items; RETURN; } else { @@ -628,7 +633,7 @@ PP(pp_sort) AV *oldstack; CONTEXT *cx; SV** newsp; - bool oldmustcatch = mustcatch; + bool oldcatch = CATCH_GET; SAVETMPS; SAVESPTR(op); @@ -639,7 +644,7 @@ PP(pp_sort) AvREAL_off(sortstack); av_extend(sortstack, 32); } - mustcatch = TRUE; + CATCH_SET(TRUE); SWITCHSTACK(curstack, sortstack); if (sortstash != stash) { firstgv = gv_fetchpv("a", TRUE, SVt_PV); @@ -656,7 +661,7 @@ PP(pp_sort) POPBLOCK(cx,curpm); SWITCHSTACK(sortstack, oldstack); - mustcatch = oldmustcatch; + CATCH_SET(oldcatch); } LEAVE; } @@ -812,16 +817,29 @@ char *label; I32 dowantarray() { + I32 gimme = block_gimme(); + return (gimme == G_VOID) ? G_SCALAR : gimme; +} + +I32 +block_gimme() +{ I32 cxix; cxix = dopoptosub(cxstack_ix); if (cxix < 0) return G_SCALAR; - if (cxstack[cxix].blk_gimme == G_ARRAY) - return G_ARRAY; - else + switch (cxstack[cxix].blk_gimme) { + case G_VOID: + return G_VOID; + case G_SCALAR: return G_SCALAR; + case G_ARRAY: + return G_ARRAY; + default: + croak("panic: bad gimme: %d\n", cxstack[cxix].blk_gimme); + } } static I32 @@ -1036,6 +1054,7 @@ PP(pp_caller) register I32 cxix = dopoptosub(cxstack_ix); register CONTEXT *cx; I32 dbcxix; + I32 gimme; SV *sv; I32 count = 0; @@ -1087,7 +1106,11 @@ PP(pp_caller) PUSHs(sv_2mortal(newSVpv("(eval)",0))); PUSHs(sv_2mortal(newSViv(0))); } - PUSHs(sv_2mortal(newSViv((I32)cx->blk_gimme))); + gimme = (I32)cx->blk_gimme; + if (gimme == G_VOID) + PUSHs(&sv_undef); + else + PUSHs(sv_2mortal(newSViv(gimme & G_ARRAY))); if (cx->cx_type == CXt_EVAL) { if (cx->blk_eval.old_op_type == OP_ENTEREVAL) { PUSHs(cx->blk_eval.cur_text); @@ -1239,7 +1262,7 @@ PP(pp_enteriter) { dSP; dMARK; register CONTEXT *cx; - I32 gimme = GIMME; + I32 gimme = GIMME_V; SV **svp; ENTER; @@ -1271,7 +1294,7 @@ PP(pp_enterloop) { dSP; register CONTEXT *cx; - I32 gimme = GIMME; + I32 gimme = GIMME_V; ENTER; SAVETMPS; @@ -1297,15 +1320,13 @@ PP(pp_leaveloop) mark = newsp; POPLOOP1(cx); /* Delay POPLOOP2 until stack values are safe */ - if (gimme == G_SCALAR) { - if (op->op_private & OPpLEAVE_VOID) - ; - else { - if (mark < SP) - *++newsp = sv_mortalcopy(*SP); - else - *++newsp = &sv_undef; - } + if (gimme == G_VOID) + ; /* do nothing */ + else if (gimme == G_SCALAR) { + if (mark < SP) + *++newsp = sv_mortalcopy(*SP); + else + *++newsp = &sv_undef; } else { while (mark < SP) @@ -1362,6 +1383,7 @@ PP(pp_return) if (optype == OP_REQUIRE && (MARK == SP || (gimme == G_SCALAR && !SvTRUE(*SP))) ) { + /* Unassume the success we assumed earlier. */ char *name = cx->blk_eval.old_name; (void)hv_delete(GvHVn(incgv), name, strlen(name), G_DISCARD); DIE("%s did not return a true value", name); @@ -1378,7 +1400,7 @@ PP(pp_return) else *++newsp = &sv_undef; } - else { + else if (gimme == G_ARRAY) { while (++MARK <= SP) *++newsp = (popsub2 && SvTEMP(*MARK)) ? *MARK : sv_mortalcopy(*MARK); @@ -1450,7 +1472,7 @@ PP(pp_last) else *++newsp = &sv_undef; } - else { + else if (gimme == G_ARRAY) { while (++MARK <= SP) *++newsp = ((pop2 == CXt_SUB) && SvTEMP(*MARK)) ? *MARK : sv_mortalcopy(*MARK); @@ -1843,7 +1865,7 @@ PP(pp_goto) if (curstack == signalstack) { restartop = retop; - Siglongjmp(top_env, 3); + JMPENV_JUMP(3); } RETURNOP(retop); @@ -1941,30 +1963,28 @@ docatch(o) OP *o; { int ret; - int oldrunlevel = runlevel; + I32 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 = %ld)\n", (long)runlevel+1)); #endif - mustcatch = FALSE; - switch ((ret = Sigsetjmp(top_env,1))) { + JMPENV_PUSH(ret); + switch (ret) { default: /* topmost level handles it */ - Copy(oldtop, top_env, 1, Sigjmp_buf); + JMPENV_POP; runlevel = oldrunlevel; - mustcatch = TRUE; op = oldop; - Siglongjmp(top_env, ret); + JMPENV_JUMP(ret); /* NOTREACHED */ case 3: if (!restartop) { PerlIO_printf(PerlIO_stderr(), "panic: restartop\n"); break; } - mustcatch = FALSE; op = restartop; restartop = 0; /* FALL THROUGH */ @@ -1972,9 +1992,8 @@ OP *o; runops(); break; } - Copy(oldtop, top_env, 1, Sigjmp_buf); + JMPENV_POP; runlevel = oldrunlevel; - mustcatch = TRUE; op = oldop; return Nullop; } @@ -2078,7 +2097,9 @@ int gimme; rs = SvREFCNT_inc(nrs); compiling.cop_line = 0; SAVEFREEOP(eval_root); - if (gimme & G_ARRAY) + if (gimme & G_VOID) + scalarvoid(eval_root); + else if (gimme & G_ARRAY) list(eval_root); else scalar(eval_root); @@ -2235,7 +2256,7 @@ PP(pp_entereval) dSP; register CONTEXT *cx; dPOPss; - I32 gimme = GIMME, was = sub_generation; + I32 gimme = GIMME_V, was = sub_generation; char tmpbuf[32], *safestr; STRLEN len; OP *ret; @@ -2296,23 +2317,20 @@ PP(pp_leaveeval) POPEVAL(cx); retop = pop_return(); - if (gimme == G_SCALAR) { - if (op->op_private & OPpLEAVE_VOID) - MARK = newsp; + if (gimme == G_VOID) + MARK = newsp; + else if (gimme == G_SCALAR) { + MARK = newsp + 1; + if (MARK <= SP) { + if (SvFLAGS(TOPs) & SVs_TEMP) + *MARK = TOPs; + else + *MARK = sv_mortalcopy(TOPs); + } else { - MARK = newsp + 1; - if (MARK <= SP) { - if (SvFLAGS(TOPs) & SVs_TEMP) - *MARK = TOPs; - else - *MARK = sv_mortalcopy(TOPs); - } - else { - MEXTEND(mark,0); - *MARK = &sv_undef; - } + MEXTEND(mark,0); + *MARK = &sv_undef; } - SP = MARK; } else { for (mark = newsp + 1; mark <= SP; mark++) @@ -2328,10 +2346,10 @@ PP(pp_leaveeval) CvDEPTH(compcv) = 0; if (optype == OP_REQUIRE && - !(gimme == G_SCALAR ? SvTRUE(*sp) : sp > newsp)) { - char *name = cx->blk_eval.old_name; - + !(gimme == G_SCALAR ? SvTRUE(*sp) : sp > newsp)) + { /* Unassume the success we assumed earlier. */ + char *name = cx->blk_eval.old_name; (void)hv_delete(GvHVn(incgv), name, strlen(name), G_DISCARD); retop = die("%s did not return a true value", name); } @@ -2349,7 +2367,7 @@ PP(pp_entertry) { dSP; register CONTEXT *cx; - I32 gimme = GIMME; + I32 gimme = GIMME_V; ENTER; SAVETMPS; @@ -2379,21 +2397,19 @@ PP(pp_leavetry) POPEVAL(cx); pop_return(); - if (gimme == G_SCALAR) { - if (op->op_private & OPpLEAVE_VOID) - MARK = newsp; + if (gimme == G_VOID) + SP = newsp; + else if (gimme == G_SCALAR) { + MARK = newsp + 1; + if (MARK <= SP) { + if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP)) + *MARK = TOPs; + else + *MARK = sv_mortalcopy(TOPs); + } else { - MARK = newsp + 1; - if (MARK <= SP) { - if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP)) - *MARK = TOPs; - else - *MARK = sv_mortalcopy(TOPs); - } - else { - MEXTEND(mark,0); - *MARK = &sv_undef; - } + MEXTEND(mark,0); + *MARK = &sv_undef; } SP = MARK; } @@ -160,8 +160,7 @@ PP(pp_sassign) } if (tainting && tainted && !SvTAINTED(left)) TAINT_NOT; - SvSetSV(right, left); - SvSETMAGIC(right); + SvSetMagicSV(right, left); SETs(right); RETURN; } @@ -221,7 +220,7 @@ PP(pp_padsv) if (op->op_private & OPpLVAL_INTRO) SAVECLEARSV(curpad[op->op_targ]); else if (op->op_private & OPpDEREF) - vivify_ref(curpad[op->op_targ], op->op_flags & OPpDEREF); + vivify_ref(curpad[op->op_targ], op->op_private & OPpDEREF); } RETURN; } @@ -237,7 +236,7 @@ PP(pp_eq) dSP; tryAMAGICbinSET(eq,0); { dPOPnv; - SETs((TOPn == value) ? &sv_yes : &sv_no); + SETs(boolSV(TOPn == value)); RETURN; } } @@ -590,6 +589,7 @@ PP(pp_aassign) register SV *sv; register AV *ary; + I32 gimme; HV *hash; I32 i; int magic; @@ -744,7 +744,16 @@ PP(pp_aassign) tainting |= (uid && (euid != uid || egid != gid)); } delaymagic = 0; - if (GIMME == G_ARRAY) { + + gimme = GIMME_V; + if (gimme == G_VOID) + SP = firstrelem - 1; + else if (gimme == G_SCALAR) { + dTARGET; + SP = firstrelem; + SETi(lastrelem - firstrelem + 1); + } + else { if (ary || hash) SP = lastrelem; else @@ -752,15 +761,8 @@ PP(pp_aassign) lelem = firstlelem + (relem - firstrelem); while (relem <= SP) *relem++ = (lelem <= lastlelem) ? *lelem++ : &sv_undef; - RETURN; - } - else { - dTARGET; - SP = firstrelem; - - SETi(lastrelem - firstrelem + 1); - RETURN; } + RETURN; } PP(pp_match) @@ -976,6 +978,7 @@ do_readline() PerlIO *fp; register IO *io = GvIO(last_in_gv); register I32 type = op->op_type; + I32 gimme = GIMME_V; MAGIC *mg; if (SvMAGICAL(last_in_gv) && (mg = mg_find((SV*)last_in_gv, 'q'))) { @@ -983,11 +986,11 @@ do_readline() XPUSHs(mg->mg_obj); PUTBACK; ENTER; - perl_call_method("READLINE", GIMME); + perl_call_method("READLINE", gimme); LEAVE; SPAGAIN; - if (GIMME == G_SCALAR) - SvSetSV_nosteal(TARG, TOPs); + if (gimme == G_SCALAR) + SvSetMagicSV_nosteal(TARG, TOPs); RETURN; } fp = Nullfp; @@ -1134,17 +1137,13 @@ do_readline() if (!fp) { if (dowarn && io && !(IoFLAGS(io) & IOf_START)) warn("Read on closed filehandle <%s>", GvENAME(last_in_gv)); - if (GIMME == G_SCALAR) { + if (gimme == G_SCALAR) { (void)SvOK_off(TARG); PUSHTARG; } RETURN; } - if (GIMME == G_ARRAY) { - sv = sv_2mortal(NEWSV(57, 80)); - offset = 0; - } - else { + if (gimme == G_SCALAR) { sv = TARG; if (SvROK(sv)) sv_unref(sv); @@ -1157,6 +1156,10 @@ do_readline() else offset = 0; } + else { + sv = sv_2mortal(NEWSV(57, 80)); + offset = 0; + } for (;;) { if (!sv_gets(sv, fp, offset)) { PerlIO_clearerr(fp); @@ -1170,7 +1173,7 @@ do_readline() else if (type == OP_GLOB) { (void)do_close(last_in_gv, FALSE); } - if (GIMME == G_SCALAR) { + if (gimme == G_SCALAR) { (void)SvOK_off(TARG); PUSHTARG; } @@ -1203,7 +1206,7 @@ do_readline() continue; } } - if (GIMME == G_ARRAY) { + if (gimme == G_ARRAY) { if (SvLEN(sv) - SvCUR(sv) > 20) { SvLEN_set(sv, SvCUR(sv)+1); Renew(SvPVX(sv), SvLEN(sv), char); @@ -1211,7 +1214,7 @@ do_readline() sv = sv_2mortal(NEWSV(58, 80)); continue; } - else if (!tmplen && SvLEN(sv) - SvCUR(sv) > 80) { + else if (gimme == G_SCALAR && !tmplen && SvLEN(sv) - SvCUR(sv) > 80) { /* try to reclaim a bit of scalar space (only on 1st alloc) */ if (SvCUR(sv) < 60) SvLEN_set(sv, 80); @@ -1227,19 +1230,14 @@ PP(pp_enter) { dSP; register CONTEXT *cx; - I32 gimme; - - /* - * We don't just use the GIMME macro here because it assumes there's - * already a context, which ain't necessarily so at initial startup. - */ + I32 gimme = OP_GIMME(op, -1); - if (op->op_flags & OPf_KNOW) - gimme = op->op_flags & OPf_LIST; - else if (cxstack_ix >= 0) - gimme = cxstack[cxstack_ix].blk_gimme; - else - gimme = G_SCALAR; + if (gimme == -1) { + if (cxstack_ix >= 0) + gimme = cxstack[cxstack_ix].blk_gimme; + else + gimme = G_SCALAR; + } ENTER; @@ -1306,31 +1304,30 @@ PP(pp_leave) POPBLOCK(cx,newpm); - if (op->op_flags & OPf_KNOW) - gimme = op->op_flags & OPf_LIST; - else if (cxstack_ix >= 0) - gimme = cxstack[cxstack_ix].blk_gimme; - else - gimme = G_SCALAR; + gimme = OP_GIMME(op, -1); + if (gimme == -1) { + if (cxstack_ix >= 0) + gimme = cxstack[cxstack_ix].blk_gimme; + else + gimme = G_SCALAR; + } - if (gimme == G_SCALAR) { - if (op->op_private & OPpLEAVE_VOID) - SP = newsp; + if (gimme == G_VOID) + SP = newsp; + else if (gimme == G_SCALAR) { + MARK = newsp + 1; + if (MARK <= SP) + if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP)) + *MARK = TOPs; + else + *MARK = sv_mortalcopy(TOPs); else { - MARK = newsp + 1; - if (MARK <= SP) - if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP)) - *MARK = TOPs; - else - *MARK = sv_mortalcopy(TOPs); - else { - MEXTEND(mark,0); - *MARK = &sv_undef; - } - SP = MARK; + MEXTEND(mark,0); + *MARK = &sv_undef; } + SP = MARK; } - else { + else if (gimme == G_ARRAY) { for (mark = newsp + 1; mark <= SP; mark++) if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP))) *mark = sv_mortalcopy(*mark); @@ -1657,18 +1654,19 @@ PP(pp_grepwhile) /* All done yet? */ if (stack_base + *markstack_ptr > sp) { I32 items; + I32 gimme = GIMME_V; LEAVE; /* exit outer scope */ (void)POPMARK; /* pop src */ items = --*markstack_ptr - markstack_ptr[-1]; (void)POPMARK; /* pop dst */ SP = stack_base + POPMARK; /* pop original mark */ - if (GIMME != G_ARRAY) { + if (gimme == G_SCALAR) { dTARGET; XPUSHi(items); - RETURN; } - SP += items; + else if (gimme == G_ARRAY) + SP += items; RETURN; } else { @@ -1708,7 +1706,7 @@ PP(pp_leavesub) } SP = MARK; } - else { + else if (gimme == G_ARRAY) { for (MARK = newsp + 1; MARK <= SP; MARK++) { if (!SvTEMP(*MARK)) *MARK = sv_mortalcopy(*MARK); @@ -1791,7 +1789,9 @@ PP(pp_entersub) goto retry; } /* should call AUTOLOAD now? */ - if ((autogv = gv_autoload(GvESTASH(gv), GvNAME(gv), GvNAMELEN(gv)))) { + if ((autogv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), + FALSE))) + { cv = GvCV(autogv); goto retry; } @@ -1801,7 +1801,7 @@ PP(pp_entersub) DIE("Undefined subroutine &%s called", SvPVX(subname)); } - gimme = GIMME; + gimme = GIMME_V; if ((op->op_private & OPpENTERSUB_DB) && GvCV(DBsub) && !CvNODEBUG(cv)) { SV *oldsv = sv; sv = GvSV(DBsub); @@ -30,13 +30,6 @@ # include <sys/resource.h> #endif -/* Put this after #includes because fork and vfork prototypes may - conflict. -*/ -#ifndef HAS_VFORK -# define vfork fork -#endif - #if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */ # include <sys/socket.h> # include <netdb.h> @@ -78,7 +71,11 @@ extern int h_errno; #endif #ifdef I_UTIME -#include <utime.h> +# ifdef WIN32 +# include <sys/utime.h> +# else +# include <utime.h> +# endif #endif #ifdef I_FCNTL #include <fcntl.h> @@ -87,6 +84,20 @@ extern int h_errno; #include <sys/file.h> #endif +/* Put this after #includes because fork and vfork prototypes may conflict. */ +#ifndef HAS_VFORK +# define vfork fork +#endif + +/* Put this after #includes because <unistd.h> defines _XOPEN_*. */ +#ifndef Sock_size_t +# if _XOPEN_VERSION >= 5 || defined(_XOPEN_SOURCE_EXTENDED) +# define Sock_size_t Size_t +# else +# define Sock_size_t int +# endif +#endif + #if !defined(HAS_MKDIR) || !defined(HAS_RMDIR) static int dooneliner _((char *cmd, char *filename)); #endif @@ -151,10 +162,17 @@ PP(pp_backtick) dSP; dTARGET; PerlIO *fp; char *tmps = POPp; + I32 gimme = GIMME_V; + TAINT_PROPER("``"); fp = my_popen(tmps, "r"); if (fp) { - if (GIMME == G_SCALAR) { + if (gimme == G_VOID) { + while (PerlIO_read(fp, buf, sizeof buf) > 0) + /*SUPPRESS 530*/ + ; + } + else if (gimme == G_SCALAR) { sv_setpv(TARG, ""); /* note that this preserves previous buffer */ while (sv_gets(TARG, fp, SvCUR(TARG)) != Nullch) /*SUPPRESS 530*/ @@ -184,7 +202,7 @@ PP(pp_backtick) } else { STATUS_NATIVE_SET(-1); - if (GIMME == G_SCALAR) + if (gimme == G_SCALAR) RETPUSHUNDEF; } @@ -316,7 +334,7 @@ PP(pp_close) else gv = (GV*)POPs; EXTEND(SP, 1); - PUSHs( do_close(gv, TRUE) ? &sv_yes : &sv_no ); + PUSHs(boolSV(do_close(gv, TRUE))); RETURN; } @@ -459,7 +477,7 @@ PP(pp_tie) SV **mark = stack_base + ++*markstack_ptr; /* reuse in entersub */ I32 markoff = mark - stack_base - 1; char *methname; - bool oldmustcatch = mustcatch; + bool oldcatch = CATCH_GET; varsv = mark[0]; if (SvTYPE(varsv) == SVt_PVHV) @@ -479,8 +497,8 @@ PP(pp_tie) Zero(&myop, 1, BINOP); myop.op_last = (OP *) &myop; myop.op_next = Nullop; - myop.op_flags = OPf_KNOW|OPf_STACKED; - mustcatch = TRUE; + myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED; + CATCH_SET(TRUE); ENTER; SAVESPTR(op); @@ -495,7 +513,7 @@ PP(pp_tie) runops(); SPAGAIN; - mustcatch = oldmustcatch; + CATCH_SET(oldcatch); sv = TOPs; if (sv_isobject(sv)) { if (SvTYPE(varsv) == SVt_PVHV || SvTYPE(varsv) == SVt_PVAV) { @@ -572,7 +590,7 @@ PP(pp_dbmopen) GV *gv; BINOP myop; SV *sv; - bool oldmustcatch = mustcatch; + bool oldcatch = CATCH_GET; hv = (HV*)POPs; @@ -590,8 +608,8 @@ PP(pp_dbmopen) Zero(&myop, 1, BINOP); myop.op_last = (OP *) &myop; myop.op_next = Nullop; - myop.op_flags = OPf_KNOW|OPf_STACKED; - mustcatch = TRUE; + myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED; + CATCH_SET(TRUE); ENTER; SAVESPTR(op); @@ -634,7 +652,7 @@ PP(pp_dbmopen) SPAGAIN; } - mustcatch = oldmustcatch; + CATCH_SET(oldcatch); if (sv_isobject(TOPs)) sv_magic((SV*)hv, TOPs, 'P', Nullch, 0); LEAVE; @@ -839,15 +857,16 @@ PP(pp_getc) gv = argvgv; if (SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) { + I32 gimme = GIMME_V; PUSHMARK(SP); XPUSHs(mg->mg_obj); PUTBACK; ENTER; - perl_call_method("GETC", GIMME); + perl_call_method("GETC", gimme); LEAVE; SPAGAIN; - if (GIMME == G_SCALAR) - SvSetSV_nosteal(TARG, TOPs); + if (gimme == G_SCALAR) + SvSetMagicSV_nosteal(TARG, TOPs); RETURN; } if (!gv || do_eof(gv)) /* make sure we have fp with something */ @@ -871,7 +890,7 @@ GV *gv; OP *retop; { register CONTEXT *cx; - I32 gimme = GIMME; + I32 gimme = GIMME_V; AV* padlist = CvPADLIST(cv); SV** svp = AvARRAY(padlist); @@ -1330,7 +1349,7 @@ PP(pp_eof) gv = last_in_gv; else gv = last_in_gv = (GV*)POPs; - PUSHs(!gv || do_eof(gv) ? &sv_yes : &sv_no); + PUSHs(boolSV(!gv || do_eof(gv))); RETURN; } @@ -1355,7 +1374,7 @@ PP(pp_seek) long offset = POPl; gv = last_in_gv = (GV*)POPs; - PUSHs( do_seek(gv, offset, whence) ? &sv_yes : &sv_no ); + PUSHs(boolSV(do_seek(gv, offset, whence))); RETURN; } @@ -1946,6 +1965,7 @@ PP(pp_stat) { dSP; GV *tmpgv; + I32 gimme; I32 max = 13; if (op->op_flags & OPf_REF) { @@ -1987,17 +2007,15 @@ PP(pp_stat) } } - if (GIMME != G_ARRAY) { - EXTEND(SP, 1); - if (max) - RETPUSHYES; - else - RETPUSHUNDEF; + gimme = GIMME_V; + if (gimme != G_ARRAY) { + if (gimme != G_VOID) + XPUSHs(boolSV(max)); + RETURN; } if (max) { EXTEND(SP, max); EXTEND_MORTAL(max); - PUSHs(sv_2mortal(newSViv((I32)statcache.st_dev))); PUSHs(sv_2mortal(newSViv((I32)statcache.st_ino))); PUSHs(sv_2mortal(newSViv((I32)statcache.st_mode))); @@ -3973,8 +3991,7 @@ PP(pp_gpwent) PP(pp_spwent) { dSP; - /* CYGWIN32 is missing setpwent(), (but has the others!) */ -#if 0 +#if defined(HAS_PASSWD) && !defined(CYGWIN32) setpwent(); RETPUSHYES; #else @@ -29,6 +29,7 @@ void av_undef _((AV* ar)); void av_unshift _((AV* ar, I32 num)); OP* bind_match _((I32 type, OP* left, OP* pat)); OP* block_end _((I32 floor, OP* seq)); +I32 block_gimme _((void)); int block_start _((int full)); void boot_core_UNIVERSAL _((void)); void call_list _((I32 oldscope, AV* list)); @@ -45,9 +46,10 @@ OP* convert _((I32 optype, I32 flags, OP* op)); char* cpytill _((char* to, char* from, char* fromend, int delim, I32* retlen)); void croak _((const char* pat,...)) __attribute__((format(printf,1,2),noreturn)); +void cv_ckproto _((CV* cv, GV* gv, char* p)); CV* cv_clone _((CV* proto)); -void cv_undef _((CV* cv)); SV* cv_const_sv _((CV* cv)); +void cv_undef _((CV* cv)); #ifdef DEBUGGING void cx_dump _((CONTEXT* cs)); #endif @@ -125,13 +127,14 @@ GP* gp_ref _((GP* gp)); GV* gv_AVadd _((GV* gv)); GV* gv_HVadd _((GV* gv)); GV* gv_IOadd _((GV* gv)); -GV* gv_autoload _((HV* stash, char* name, STRLEN len)); +GV* gv_autoload4 _((HV* stash, char* name, STRLEN len, I32 method)); void gv_check _((HV* stash)); void gv_efullname _((SV* sv, GV* gv)); void gv_efullname3 _((SV* sv, GV* gv, char* prefix)); GV* gv_fetchfile _((char* name)); GV* gv_fetchmeth _((HV* stash, char* name, STRLEN len, I32 level)); GV* gv_fetchmethod _((HV* stash, char* name)); +GV* gv_fetchmethod_autoload _((HV* stash, char* name, I32 autoload)); GV* gv_fetchpv _((char* name, I32 add, I32 sv_type)); void gv_fullname _((SV* sv, GV* gv)); void gv_fullname3 _((SV* sv, GV* gv, char* prefix)); @@ -697,6 +697,10 @@ I32 *flagp; *flagp = flags; return(ret); } + + if (!(flags&HASWIDTH) && op != '?') + FAIL("regexp *+ operand could be empty"); + nextchar(); *flagp = (op != '+') ? (WORST|SPSTART) : (WORST|HASWIDTH); @@ -70,3 +70,52 @@ 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(v) \ + STMT_START { \ + 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; \ + (v) = cur_env.je_ret; \ + } STMT_END +#define JMPENV_POP \ + STMT_START { top_env = cur_env.je_prev; } STMT_END +#define JMPENV_JUMP(v) \ + STMT_START { \ + if (top_env->je_prev) \ + Siglongjmp(top_env->je_buf, (v)); \ + if ((v) == 2) \ + exit(STATUS_NATIVE_EXPORT); \ + PerlIO_printf(PerlIO_stderr(), "panic: top_env\n"); \ + exit(1); \ + } STMT_END + +#define CATCH_GET (top_env->je_mustcatch) +#define CATCH_SET(v) (top_env->je_mustcatch = (v)) + @@ -1261,8 +1261,11 @@ register SV *sv; } if (SvPOKp(sv) && SvLEN(sv)) return asIV(sv); - if (!SvROK(sv)) + if (!SvROK(sv)) { + if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) + warn(warn_uninit); return 0; + } } if (SvTHINKFIRST(sv)) { if (SvROK(sv)) { @@ -1333,8 +1336,11 @@ register SV *sv; return U_V(SvNVX(sv)); if (SvPOKp(sv) && SvLEN(sv)) return asUV(sv); - if (!SvROK(sv)) + if (!SvROK(sv)) { + if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) + warn(warn_uninit); return 0; + } } if (SvTHINKFIRST(sv)) { if (SvROK(sv)) { @@ -1404,6 +1410,8 @@ register SV *sv; if (SvIOKp(sv)) return (double)SvIVX(sv); if (!SvROK(sv)) { + if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) + warn(warn_uninit); return 0; } } @@ -1605,6 +1613,8 @@ STRLEN *lp; goto tokensave; } if (!SvROK(sv)) { + if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) + warn(warn_uninit); *lp = 0; return ""; } @@ -1985,13 +1995,8 @@ register SV *sstr; warn("Subroutine %s redefined", GvENAME((GV*)dstr)); } - if (SvPOK(cv) != SvPOK(sref) - || (SvPOK(cv) - && strNE(SvPVX(cv), SvPVX(sref)))) { - warn("Prototype mismatch: (%s) vs (%s)", - SvPOK(cv) ? SvPVX(cv) : "none", - SvPOK(sref) ? SvPVX(sref) : "none"); - } + cv_ckproto(cv, (GV*)dstr, + SvPOK(sref) ? SvPVX(sref) : Nullch); } GvCV(dstr) = (CV*)sref; GvCVGEN(dstr) = 0; /* Switch off cacheness. */ @@ -557,20 +557,36 @@ SV *newRV_noinc _((SV *)); #define SvSETMAGIC(x) if (SvSMAGICAL(x)) mg_set(x) -#define SvSetSV(dst,src) if ((dst) != (src)) sv_setsv(dst,src) - -#define SvSetSV_nosteal(dst,src) \ +#define SvSetSV_and(dst,src,finally) \ + if ((dst) != (src)) { \ + sv_setsv(dst, src); \ + finally; \ + } +#define SvSetSV_nosteal_and(dst,src,finally) \ if ((dst) != (src)) { \ U32 tMpF = SvFLAGS(src) & SVs_TEMP; \ SvTEMP_off(src); \ sv_setsv(dst, src); \ SvFLAGS(src) |= tMpF; \ + finally; \ } +#define SvSetSV(dst,src) \ + SvSetSV_and(dst,src,/*nothing*/;) +#define SvSetSV_nosteal(dst,src) \ + SvSetSV_nosteal_and(dst,src,/*nothing*/;) + +#define SvSetMagicSV(dst,src) \ + SvSetSV_and(dst,src,SvSETMAGIC(dst)) +#define SvSetMagicSV_nosteal(dst,src) \ + SvSetSV_nosteal_and(dst,src,SvSETMAGIC(dst)) + #define SvPEEK(sv) sv_peek(sv) #define SvIMMORTAL(sv) ((sv)==&sv_undef || (sv)==&sv_yes || (sv)==&sv_no) +#define boolSV(b) ((b) ? &sv_yes : &sv_no) + #define isGV(sv) (SvTYPE(sv) == SVt_PVGV) #ifndef DOSISH diff --git a/t/comp/multiline.t b/t/comp/multiline.t index 0e022e9992..fc1eedc8d2 100755 --- a/t/comp/multiline.t +++ b/t/comp/multiline.t @@ -32,7 +32,7 @@ if ($z eq $y) {print "ok 2\n";} else {print "not ok 2\n";} if ($count == 3) {print "ok 3\n";} else {print "not ok 3\n";} -$_ = `cat Comp.try`; +$_ = ($^O eq 'MSWin32') ? `type Comp.try` : `cat Comp.try`; if (/.*\n.*\n.*\n$/) {print "ok 4\n";} else {print "not ok 4\n";} diff --git a/t/comp/redef.t b/t/comp/redef.t index ad28bfd5e2..07e978bb86 100755 --- a/t/comp/redef.t +++ b/t/comp/redef.t @@ -13,6 +13,8 @@ sub ok ($$) { print "1..18\n"; +my $NEWPROTO = 'Prototype mismatch:'; + sub sub0 { 1 } sub sub0 { 2 } @@ -21,19 +23,19 @@ ok 1, $warn =~ s/Subroutine sub0 redefined[^\n]+\n//s; sub sub1 { 1 } sub sub1 () { 2 } -ok 2, $warn =~ s/Prototype mismatch: \Q(none) vs ()\E[^\n]+\n//s; +ok 2, $warn =~ s/$NEWPROTO \Qsub main::sub1 vs ()\E[^\n]+\n//s; ok 3, $warn =~ s/Subroutine sub1 redefined[^\n]+\n//s; sub sub2 { 1 } sub sub2 ($) { 2 } -ok 4, $warn =~ s/Prototype mismatch: \Q(none) vs ($)\E[^\n]+\n//s; +ok 4, $warn =~ s/$NEWPROTO \Qsub main::sub2 vs ($)\E[^\n]+\n//s; ok 5, $warn =~ s/Subroutine sub2 redefined[^\n]+\n//s; sub sub3 () { 1 } sub sub3 { 2 } -ok 6, $warn =~ s/Prototype mismatch: \Q() vs (none)\E[^\n]+\n//s; +ok 6, $warn =~ s/$NEWPROTO \Qsub main::sub3 () vs none\E[^\n]+\n//s; ok 7, $warn =~ s/Constant subroutine sub3 redefined[^\n]+\n//s; sub sub4 () { 1 } @@ -44,19 +46,19 @@ ok 8, $warn =~ s/Constant subroutine sub4 redefined[^\n]+\n//s; sub sub5 () { 1 } sub sub5 ($) { 2 } -ok 9, $warn =~ s/Prototype mismatch: \Q() vs ($)\E[^\n]+\n//s; +ok 9, $warn =~ s/$NEWPROTO \Qsub main::sub5 () vs ($)\E[^\n]+\n//s; ok 10, $warn =~ s/Constant subroutine sub5 redefined[^\n]+\n//s; sub sub6 ($) { 1 } sub sub6 { 2 } -ok 11, $warn =~ s/Prototype mismatch: \Q($) vs (none)\E[^\n]+\n//s; +ok 11, $warn =~ s/$NEWPROTO \Qsub main::sub6 ($) vs none\E[^\n]+\n//s; ok 12, $warn =~ s/Subroutine sub6 redefined[^\n]+\n//s; sub sub7 ($) { 1 } sub sub7 () { 2 } -ok 13, $warn =~ s/Prototype mismatch: \Q($) vs ()\E[^\n]+\n//s; +ok 13, $warn =~ s/$NEWPROTO \Qsub main::sub7 ($) vs ()\E[^\n]+\n//s; ok 14, $warn =~ s/Subroutine sub7 redefined[^\n]+\n//s; sub sub8 ($) { 1 } @@ -67,7 +69,7 @@ ok 15, $warn =~ s/Subroutine sub8 redefined[^\n]+\n//s; sub sub9 ($@) { 1 } sub sub9 ($) { 2 } -ok 16, $warn =~ s/Prototype mismatch: \(\$\Q@) vs ($)\E[^\n]+\n//s; +ok 16, $warn =~ s/$NEWPROTO sub main::sub9 \(\$\Q@) vs ($)\E[^\n]+\n//s; ok 17, $warn =~ s/Subroutine sub9 redefined[^\n]+\n//s; ok 18, $_ eq ''; @@ -9,6 +9,9 @@ BEGIN { use Config; +# avoid win32 (for now) +do { print "1..0\n"; exit(0); } if $^O eq 'MSWin32'; + print "1..26\n"; $wd = (($^O eq 'MSWin32') ? `cd` : `pwd`); diff --git a/t/io/tell.t b/t/io/tell.t index 5badafeacb..83904e88bb 100755 --- a/t/io/tell.t +++ b/t/io/tell.t @@ -7,7 +7,7 @@ print "1..13\n"; $TST = 'tst'; open($TST, '../Configure') || (die "Can't open ../Configure"); - +binmode $TST if $^O eq 'MSWin32'; if (eof(tst)) { print "not ok 1\n"; } else { print "ok 1\n"; } $firstline = <$TST>; diff --git a/t/lib/anydbm.t b/t/lib/anydbm.t index eeec2caca9..6ddbf25e2d 100755 --- a/t/lib/anydbm.t +++ b/t/lib/anydbm.t @@ -22,10 +22,14 @@ $Dfile = "Op.dbmx.pag"; if (! -e $Dfile) { ($Dfile) = <Op.dbmx*>; } -($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, - $blksize,$blocks) = stat($Dfile); -print (($mode & 0777) == ($^O eq 'os2' ? 0666 : 0640) || $^O eq 'amigaos' - ? "ok 2\n" : "not ok 2\n"); +if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32') { + print "ok 2\n"; +} +else { + ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, + $blksize,$blocks) = stat($Dfile); + print (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n"); +} while (($key,$value) = each(%h)) { $i++; } diff --git a/t/lib/basename.t b/t/lib/basename.t index 0f8a117e4c..860b3379b4 100755 --- a/t/lib/basename.t +++ b/t/lib/basename.t @@ -51,6 +51,7 @@ print +(dirname('arma:[virumque]cano.trojae') eq 'arma:[virumque]' ? print +(dirname('arma:<virumque>cano.trojae') eq 'arma:<virumque>' ? '' : 'not '),"ok 12\n"; print +(dirname('arma:virumque.cano') eq 'arma:' ? '' : 'not '),"ok 13\n"; +$ENV{DEFAULT} = '' unless exists $ENV{DEFAULT}; print +(dirname('virumque.cano') eq $ENV{DEFAULT} ? '' : 'not '),"ok 14\n"; print +(dirname('arma/') eq '.' ? '' : 'not '),"ok 15\n"; diff --git a/t/lib/complex.t b/t/lib/complex.t index 5dcac6c6ce..46114fbf5b 100755 --- a/t/lib/complex.t +++ b/t/lib/complex.t @@ -2,19 +2,21 @@ # $RCSfile$ # -# Regression tests for the new Math::Complex pacakge -# -- Raphael Manfredi, Septemeber 1996 -# -- Jarkko Hietaniemi Manfredi, March 1997 +# Regression tests for the Math::Complex pacakge +# -- Raphael Manfredi, September 1996 +# -- Jarkko Hietaniemi, March 1997 + BEGIN { chdir 't' if -d 't'; @INC = '../lib'; } + use Math::Complex; $test = 0; $| = 1; -$script = ''; -my $eps = 1e-4; # for example root() is quite bad +@script = (); +my $eps = 1e-11; while (<DATA>) { s/^\s+//; @@ -48,7 +50,7 @@ while (<DATA>) { } print "1..$test\n"; -eval $script; +eval join '', @script; die $@ if $@; sub test { @@ -57,13 +59,13 @@ sub test { my $i; for ($i = 0; $i < @args; $i++) { $val = value($args[$i]); - $script .= "\$z$i = $val;\n"; + push @script, "\$z$i = $val;\n"; } if (defined $z) { $args = "'$op'"; # Really the value $try = "abs(\$z0 - \$z1) <= $eps ? \$z1 : \$z0"; - $script .= "\$res = $try; "; - $script .= "check($test, $args[0], \$res, \$z$#args, $args);\n"; + push @script, "\$res = $try; "; + push @script, "check($test, $args[0], \$res, \$z$#args, $args);\n"; } else { my ($try, $args); if (@args == 2) { @@ -73,8 +75,8 @@ sub test { $try = ($op =~ /^\w/) ? "$op(\$z0, \$z1)" : "\$z0 $op \$z1"; $args = "'$args[0]', '$args[1]'"; } - $script .= "\$res = $try; "; - $script .= "check($test, '$try', \$res, \$z$#args, $args);\n"; + push @script, "\$res = $try; "; + push @script, "check($test, '$try', \$res, \$z$#args, $args);\n"; } } @@ -88,8 +90,8 @@ sub set { for ($i = 0; $i < @set; $i++) { push(@{$valref}, $set[$i]); my $val = value($set[$i]); - $script .= "\$s$i = $val;\n"; - push(@{$setref}, "\$s$i"); + push @script, "\$s$i = $val;\n"; + push @{$setref}, "\$s$i"; } } diff --git a/t/lib/db-btree.t b/t/lib/db-btree.t index 10f585304a..897548585b 100755 --- a/t/lib/db-btree.t +++ b/t/lib/db-btree.t @@ -46,17 +46,14 @@ umask(0); # Check the interface to BTREEINFO my $dbh = new DB_File::BTREEINFO ; -ok(1, $dbh->{flags} == 0) ; -ok(2, $dbh->{cachesize} == 0) ; -ok(3, $dbh->{psize} == 0) ; -ok(4, $dbh->{lorder} == 0) ; -ok(5, $dbh->{minkeypage} == 0) ; -ok(6, $dbh->{maxkeypage} == 0) ; -{ - local $^W = 0 ; - ok(7, $dbh->{compare} == undef) ; - ok(8, $dbh->{prefix} == undef) ; -} +ok(1, ! defined $dbh->{flags}) ; +ok(2, ! defined $dbh->{cachesize}) ; +ok(3, ! defined $dbh->{psize}) ; +ok(4, ! defined $dbh->{lorder}) ; +ok(5, ! defined $dbh->{minkeypage}) ; +ok(6, ! defined $dbh->{maxkeypage}) ; +ok(7, ! defined $dbh->{compare}) ; +ok(8, ! defined $dbh->{prefix}) ; $dbh->{flags} = 3000 ; ok(9, $dbh->{flags} == 3000) ; diff --git a/t/lib/db-hash.t b/t/lib/db-hash.t index 9ebd060e0a..9765e2ed86 100755 --- a/t/lib/db-hash.t +++ b/t/lib/db-hash.t @@ -32,14 +32,12 @@ umask(0); my $dbh = new DB_File::HASHINFO ; -ok(1, $dbh->{bsize} == 0) ; -ok(2, $dbh->{ffactor} == 0) ; -ok(3, $dbh->{nelem} == 0) ; -ok(4, $dbh->{cachesize} == 0) ; -$^W = 0 ; -ok(5, $dbh->{hash} == undef) ; -$^W = 1 ; -ok(6, $dbh->{lorder} == 0) ; +ok(1, ! defined $dbh->{bsize}) ; +ok(2, ! defined $dbh->{ffactor}) ; +ok(3, ! defined $dbh->{nelem}) ; +ok(4, ! defined $dbh->{cachesize}) ; +ok(5, ! defined $dbh->{hash}) ; +ok(6, ! defined $dbh->{lorder}) ; $dbh->{bsize} = 3000 ; ok(7, $dbh->{bsize} == 3000 ); diff --git a/t/lib/db-recno.t b/t/lib/db-recno.t index b5b4f9404d..5df5af1808 100755 --- a/t/lib/db-recno.t +++ b/t/lib/db-recno.t @@ -51,13 +51,13 @@ umask(0); # Check the interface to RECNOINFO my $dbh = new DB_File::RECNOINFO ; -ok(1, $dbh->{bval} == 0 ) ; -ok(2, $dbh->{cachesize} == 0) ; -ok(3, $dbh->{psize} == 0) ; -ok(4, $dbh->{flags} == 0) ; -ok(5, $dbh->{lorder} == 0); -ok(6, $dbh->{reclen} == 0); -ok(7, $dbh->{bfname} eq ""); +ok(1, ! defined $dbh->{bval}) ; +ok(2, ! defined $dbh->{cachesize}) ; +ok(3, ! defined $dbh->{psize}) ; +ok(4, ! defined $dbh->{flags}) ; +ok(5, ! defined $dbh->{lorder}) ; +ok(6, ! defined $dbh->{reclen}) ; +ok(7, ! defined $dbh->{bfname}) ; $dbh->{bval} = 3000 ; ok(8, $dbh->{bval} == 3000 ); diff --git a/t/lib/gdbm.t b/t/lib/gdbm.t index 6a2d5fa54e..a0f081fa1e 100755 --- a/t/lib/gdbm.t +++ b/t/lib/gdbm.t @@ -24,10 +24,14 @@ $Dfile = "Op.dbmx.pag"; if (! -e $Dfile) { ($Dfile) = <Op.dbmx*>; } -($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, - $blksize,$blocks) = stat($Dfile); -print (($mode & 0777) == ($^O eq 'os2' ? 0666 : 0640) || $^O eq 'amigaos' - ? "ok 2\n" : "not ok 2\n"); +if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32') { + print "ok 2\n"; +} +else { + ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, + $blksize,$blocks) = stat($Dfile); + print (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n"); +} while (($key,$value) = each(%h)) { $i++; } diff --git a/t/lib/io_tell.t b/t/lib/io_tell.t index f45d21e095..d8ebae24fd 100755 --- a/t/lib/io_tell.t +++ b/t/lib/io_tell.t @@ -27,7 +27,7 @@ print "1..13\n"; use IO::File; $tst = IO::File->new("$tell_file","r") || die("Can't open $tell_file"); - +binmode $tst if $^O eq 'MSWin32'; if ($tst->eof) { print "not ok 1\n"; } else { print "ok 1\n"; } $firstline = <$tst>; diff --git a/t/lib/ndbm.t b/t/lib/ndbm.t index 48f64fef09..b10d7c26d4 100755 --- a/t/lib/ndbm.t +++ b/t/lib/ndbm.t @@ -27,10 +27,14 @@ $Dfile = "Op.dbmx.pag"; if (! -e $Dfile) { ($Dfile) = <Op.dbmx*>; } -($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, - $blksize,$blocks) = stat($Dfile); -print (($mode & 0777) == ($^O eq 'os2' ? 0666 : 0640) || $^O eq 'amigaos' - ? "ok 2\n" : "not ok 2\n"); +if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32') { + print "ok 2\n"; +} +else { + ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, + $blksize,$blocks) = stat($Dfile); + print (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n"); +} while (($key,$value) = each(%h)) { $i++; } diff --git a/t/lib/odbm.t b/t/lib/odbm.t index e83d0f979c..06ba844029 100755 --- a/t/lib/odbm.t +++ b/t/lib/odbm.t @@ -27,10 +27,14 @@ $Dfile = "Op.dbmx.pag"; if (! -e $Dfile) { ($Dfile) = <Op.dbmx*>; } -($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, - $blksize,$blocks) = stat($Dfile); -print (($mode & 0777) == ($^O eq 'os2' ? 0666 : 0640) || $^O eq 'amigaos' - ? "ok 2\n" : "not ok 2\n"); +if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32') { + print "ok 2\n"; +} +else { + ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, + $blksize,$blocks) = stat($Dfile); + print (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n"); +} while (($key,$value) = each(%h)) { $i++; } diff --git a/t/lib/sdbm.t b/t/lib/sdbm.t index b8e02ec3c6..9928847b94 100755 --- a/t/lib/sdbm.t +++ b/t/lib/sdbm.t @@ -20,16 +20,21 @@ print "1..12\n"; unlink <Op.dbmx*>; umask(0); -print (tie(%h,SDBM_File,'Op.dbmx', O_RDWR|O_CREAT, 0640) ? "ok 1\n" : "not ok 1\n"); +print (tie(%h,SDBM_File,'Op.dbmx', O_RDWR|O_CREAT, 0640) + ? "ok 1\n" : "not ok 1\n"); $Dfile = "Op.dbmx.pag"; if (! -e $Dfile) { ($Dfile) = <Op.dbmx*>; } -($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, - $blksize,$blocks) = stat($Dfile); -print (($mode & 0777) == ($^O eq 'os2' ? 0666 : 0640) || $^O eq 'amigaos' - ? "ok 2\n" : "not ok 2\n"); +if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32') { + print "ok 2\n"; +} +else { + ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, + $blksize,$blocks) = stat($Dfile); + print (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n"); +} while (($key,$value) = each(%h)) { $i++; } diff --git a/t/lib/trig.t b/t/lib/trig.t new file mode 100755 index 0000000000..57746fdcd4 --- /dev/null +++ b/t/lib/trig.t @@ -0,0 +1,54 @@ +#!./perl + +# +# Regression tests for the Math::Trig package +# +# The tests are quite modest as the Math::Complex tests exercise +# these quite vigorously. +# +# -- Jarkko Hietaniemi, April 1997 + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} + +use Math::Trig; + +use strict; + +use vars qw($x $y $z); + +my $eps = 1e-11; + +sub near ($$;$) { + abs($_[0] - $_[1]) < (defined $_[2] ? $_[2] : $eps); +} + +print "1..6\n"; + +$x = 0.9; +print 'not ' unless (near(tan($x), sin($x) / cos($x))); +print "ok 1\n"; + +print 'not ' unless (near(sinh(2), 3.62686040784702)); +print "ok 2\n"; + +print 'not ' unless (near(acsch(0.1), 2.99822295029797)); +print "ok 3\n"; + +$x = asin(2); +print 'not ' unless (ref $x eq 'Math::Complex'); +print "ok 4\n"; + +# avoid using Math::Complex here +$x =~ /^([^-]+)(-[^i]+)i$/; +($y, $z) = ($1, $2); +print 'not ' unless (near($y, 1.5707963267949) and + near($z, -1.31695789692482)); +print "ok 5\n"; + +print 'not ' unless (near(deg_to_rad(90), pi/2)); +print "ok 6\n"; + +# eof diff --git a/t/op/arith.t b/t/op/arith.t new file mode 100755 index 0000000000..43af807b8b --- /dev/null +++ b/t/op/arith.t @@ -0,0 +1,12 @@ +#!./perl + +print "1..4\n"; + +sub try ($$) { + print +($_[1] ? "ok" : "not ok"), " $_[0]\n"; +} + +try 1, 13 % 4 == 1; +try 2, -13 % 4 == 3; +try 3, 13 % -4 == -3; +try 4, -13 % -4 == -1; diff --git a/t/op/magic.t b/t/op/magic.t index fa19716c14..c2be2e5e68 100755 --- a/t/op/magic.t +++ b/t/op/magic.t @@ -25,7 +25,7 @@ $PERL = ($Is_MSWin32 ? '.\perl' : './perl'); print "1..28\n"; eval '$ENV{"foo"} = "hi there";'; # check that ENV is inited inside eval -if ($Is_MSWin32) { ok 1, `set foo` eq "foo=hi there\n"; } +if ($Is_MSWin32) { ok 1, `cmd /x /c set foo` eq "foo=hi there\n"; } else { ok 1, `echo \$foo` eq "hi there\n"; } unlink 'ajslkdfpqjsjfk'; @@ -94,9 +94,9 @@ ok 13, (keys %h)[0] eq "foo\034bar", (keys %h)[0]; } # $?, $@, $$ -system "$PERL -e 'exit(0)'"; +system qq[$PERL -e "exit(0)"]; ok 15, $? == 0, $?; -system "$PERL -e 'exit(1)'"; +system qq[$PERL -e "exit(1)"]; ok 16, $? != 0, $?; eval { die "foo\n" }; diff --git a/t/op/method.t b/t/op/method.t index bdbc8a9673..21d7c8f397 100755 --- a/t/op/method.t +++ b/t/op/method.t @@ -64,6 +64,7 @@ test (eval { A->x } || "nope", "nope"); eval <<'EOF'; sub C::e; +BEGIN { *B::e = \&C::e } # Shouldn't prevent AUTOLOAD in original pkg sub Y::f; $counter = 0; @@ -73,14 +74,16 @@ $counter = 0; sub B::AUTOLOAD { my $c = ++$counter; my $method = $B::AUTOLOAD; - *$B::AUTOLOAD = sub { "B: In $method, $c" }; - goto &$B::AUTOLOAD; + my $msg = "B: In $method, $c"; + eval "sub $method { \$msg }"; + goto &$method; } sub C::AUTOLOAD { my $c = ++$counter; my $method = $C::AUTOLOAD; - *$C::AUTOLOAD = sub { "C: In $method, $c" }; - goto &$C::AUTOLOAD; + my $msg = "C: In $method, $c"; + eval "sub $method { \$msg }"; + goto &$method; } EOF diff --git a/t/op/misc.t b/t/op/misc.t index 02d32bd5c5..1a5afe544a 100755 --- a/t/op/misc.t +++ b/t/op/misc.t @@ -95,7 +95,8 @@ EXPECT ######## %@x=0; EXPECT -Can't coerce HASH to string in repeat at - line 1. +Can't modify hash deref in repeat at - line 1, near "0;" +Execution of - aborted due to compilation errors. ######## $_="foo"; printf(STDOUT "%s\n", $_); diff --git a/t/op/mkdir.t b/t/op/mkdir.t index 7db5ec91e4..5a6dfe5f5c 100755 --- a/t/op/mkdir.t +++ b/t/op/mkdir.t @@ -4,7 +4,7 @@ print "1..7\n"; -`rm -rf blurfl`; +$^O eq 'MSWin32' ? `del /s /q blurfl 2>&1` : `rm -rf blurfl`; print (mkdir('blurfl',0777) ? "ok 1\n" : "not ok 1\n"); print (mkdir('blurfl',0777) ? "not ok 2\n" : "ok 2\n"); diff --git a/t/op/runlevel.t b/t/op/runlevel.t index 2fc2174596..2be2eec019 100755 --- a/t/op/runlevel.t +++ b/t/op/runlevel.t @@ -17,6 +17,7 @@ chdir 't' if -d 't'; @INC = "../lib"; $Is_VMS = $^O eq 'VMS'; +$Is_MSWin32 = $^O eq 'MSWin32'; $ENV{PERL5LIB} = "../lib" unless $Is_VMS; $|=1; @@ -40,7 +41,9 @@ for (@prgs){ close TEST; my $results = $Is_VMS ? `MCR $^X "-I[-.lib]" $switch $tmpfile` : - `sh -c './perl $switch $tmpfile' 2>&1`; + $Is_MSWin32 ? + `.\\perl -I../lib $switch $tmpfile 2>&1` : + `sh -c './perl $switch $tmpfile' 2>&1`; my $status = $?; $results =~ s/\n+$//; # allow expected output to be written as if $prog is on STDIN @@ -255,7 +258,7 @@ package main; open FH, ">&STDOUT"; tie *FH, TEST; print FH "OK\n"; -print "DONE\n"; +print STDERR "DONE\n"; EXPECT PRINT CALLED DONE diff --git a/t/op/stat.t b/t/op/stat.t index d7271522c2..84c5283ce5 100755 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -27,44 +27,49 @@ $junk = `ls Op.stat.tmp` unless $Is_MSWin32; ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, $blksize,$blocks) = stat(FOO); if ($nlink == 1) {print "ok 1\n";} else {print "not ok 1\n";} -if ($mtime && $mtime == $ctime) {print "ok 2\n";} else {print "not ok 2\n";} +if ($Is_MSWin32 || ($mtime && $mtime == $ctime)) {print "ok 2\n";} +else {print "# |$mtime| vs |$ctime|\nnot ok 2\n";} print FOO "Now is the time for all good men to come to.\n"; close(FOO); sleep 2; -`rm -f Op.stat.tmp2; ln Op.stat.tmp Op.stat.tmp2; chmod 644 Op.stat.tmp`; +if ($Is_MSWin32) { unlink "Op.stat.tmp2" } +else { + `rm -f Op.stat.tmp2;ln Op.stat.tmp Op.stat.tmp2; chmod 644 Op.stat.tmp`; +} ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, $blksize,$blocks) = stat('Op.stat.tmp'); -if ($Config{dont_use_nlink} || $nlink == 2) - {print "ok 3\n";} else {print "not ok 3\n";} +if ($Is_MSWin32 || $Config{dont_use_nlink} || $nlink == 2) + {print "ok 3\n";} else {print "# \$nlink is |$nlink|\nnot ok 3\n";} -if (($mtime && $mtime != $ctime) || $cwd =~ m#/afs/# || $^O eq 'amigaos') { +if ($Is_MSWin32 || ($mtime && $mtime != $ctime) || $cwd =~ m#/afs/# || $^O eq 'amigaos') { print "ok 4\n"; } else { print "not ok 4\n"; - print '#4 If test op/stat.t fails test 4, check if you are on a tmpfs'; - print '#4 of some sort. Building in /tmp sometimes has this problem.'; + print "#4 If test op/stat.t fails test 4, check if you are on a tmpfs\n"; + print "#4 of some sort. Building in /tmp sometimes has this problem.\n"; } print "#4 :$mtime: != :$ctime:\n"; -`rm -f Op.stat.tmp`; -`touch Op.stat.tmp`; +unlink "Op.stat.tmp"; +if ($Is_MSWin32) { open F, '>Op.stat.tmp' and close F } +else { `touch Op.stat.tmp` } if (-z 'Op.stat.tmp') {print "ok 5\n";} else {print "not ok 5\n";} if (! -s 'Op.stat.tmp') {print "ok 6\n";} else {print "not ok 6\n";} -`echo hi >Op.stat.tmp`; +$Is_MSWin32 ? `cmd /c echo hi > Op.stat.tmp` : `echo hi >Op.stat.tmp`; if (! -z 'Op.stat.tmp') {print "ok 7\n";} else {print "not ok 7\n";} if (-s 'Op.stat.tmp') {print "ok 8\n";} else {print "not ok 8\n";} unlink 'Op.stat.tmp'; $olduid = $>; # can't test -r if uid == 0 -`echo hi >Op.stat.tmp`; +$Is_MSWin32 ? `cmd /c echo hi > Op.stat.tmp` : `echo hi >Op.stat.tmp`; chmod 0,'Op.stat.tmp'; eval '$> = 1;'; # so switch uid (may not be implemented) if (!$> || ! -r 'Op.stat.tmp') {print "ok 9\n";} else {print "not ok 9\n";} @@ -80,7 +85,7 @@ foreach ((12,13,14,15,16,17)) { chmod 0700,'Op.stat.tmp'; if (-r 'Op.stat.tmp') {print "ok 18\n";} else {print "not ok 18\n";} if (-w 'Op.stat.tmp') {print "ok 19\n";} else {print "not ok 19\n";} -if (-x 'Op.stat.tmp') {print "ok 20\n";} else {print "not ok 20\n";} +if ($Is_MSWin32 or -x 'Op.stat.tmp') {print "ok 20\n";} else {print "not ok 20\n";} if (-f 'Op.stat.tmp') {print "ok 21\n";} else {print "not ok 21\n";} if (! -d 'Op.stat.tmp') {print "ok 22\n";} else {print "not ok 22\n";} @@ -98,7 +103,7 @@ else { if (-o 'Op.stat.tmp') {print "ok 26\n";} else {print "not ok 26\n";} if (-e 'Op.stat.tmp') {print "ok 27\n";} else {print "not ok 27\n";} -`rm -f Op.stat.tmp Op.stat.tmp2`; +unlink 'Op.stat.tmp', 'Op.stat.tmp2'; if (! -e 'Op.stat.tmp') {print "ok 28\n";} else {print "not ok 28\n";} if ($Is_MSWin32) @@ -169,7 +174,7 @@ else { } if (! -t tty) {print "ok 38\n";} else {print "not ok 38\n";} open(null,"/dev/null"); -if (! -t null || -e '/xenix' || -e '/MachTen') +if (! -t null || -e '/xenix' || -e '/MachTen' || $Is_MSWin32) {print "ok 39\n";} else {print "not ok 39\n";} close(null); if (-t) {print "ok 40\n";} else {print "not ok 40\n";} diff --git a/t/op/taint.t b/t/op/taint.t index 66e26d82c9..81d698ae8b 100755 --- a/t/op/taint.t +++ b/t/op/taint.t @@ -72,14 +72,14 @@ sub test ($$;$) { } # We need an external program to call. -my $ECHO = "./echo$$"; +my $ECHO = ($Is_MSWin32 ? ".\\echo$$" : "./echo$$"); END { unlink $ECHO } open PROG, "> $ECHO" or die "Can't create $ECHO: $!"; print PROG 'print "@ARGV\n"', "\n"; close PROG; my $echo = "$Invoke_Perl $ECHO"; -print "1..98\n"; +print "1..112\n"; # First, let's make sure that Perl is checking the dangerous # environment variables. Maybe they aren't set yet, so we'll @@ -87,18 +87,23 @@ print "1..98\n"; { $ENV{'DCL$PATH'} = '' if $Is_VMS; - $ENV{PATH} = $TAINT; - $ENV{IFS} = " \t\n"; - test 1, eval { `$echo 1` } eq ''; - test 2, $@ =~ /^Insecure \$ENV{PATH}/, $@; - - $ENV{PATH} = ''; - $ENV{IFS} = $TAINT; - test 3, eval { `$echo 1` } eq ''; - test 4, $@ =~ /^Insecure \$ENV{IFS}/, $@; + if ($Is_MSWin32) { + print "# PATH/IFS tainting tests skipped\n"; + for (1..4) { print "ok $_\n" } + } + else { + $ENV{PATH} = $TAINT; + $ENV{IFS} = " \t\n"; + test 1, eval { `$echo 1` } eq ''; + test 2, $@ =~ /^Insecure \$ENV{PATH}/, $@; + $ENV{PATH} = ''; + $ENV{IFS} = $TAINT; + test 3, eval { `$echo 1` } eq ''; + test 4, $@ =~ /^Insecure \$ENV{IFS}/, $@; + } my $tmp; - if ($^O eq 'os2' || $^O eq 'amigaos') { + if ($^O eq 'os2' || $^O eq 'amigaos' || $Is_MSWin32) { print "# all directories are writeable\n"; } else { @@ -444,3 +449,23 @@ print "1..98\n"; test 97, tainted $$fooref; test 98, tainted $foo; } + +# Some tests involving assignment +{ + my $foo = $TAINT0; + my $bar = $foo; + test 99, all_tainted $foo, $bar; + test 100, tainted($foo = $bar); + test 101, tainted($bar = $bar); + test 102, tainted($bar += $bar); + test 103, tainted($bar -= $bar); + test 104, tainted($bar *= $bar); + test 105, tainted($bar++); + test 106, tainted($bar /= $bar); + test 107, tainted($bar += 0); + test 108, tainted($bar -= 2); + test 109, tainted($bar *= -1); + test 110, tainted($bar /= 1); + test 111, tainted($bar--); + test 112, $bar == 0; +} diff --git a/t/op/write.t b/t/op/write.t index 46ec8130b9..705fa7977b 100755 --- a/t/op/write.t +++ b/t/op/write.t @@ -4,6 +4,8 @@ print "1..5\n"; +my $CAT = ($^O eq 'MSWin32') ? 'type' : 'cat'; + format OUT = the quick brown @<< $fox @@ -42,7 +44,7 @@ the course of huma... now is the time for all good men to come to\n"; -if (`cat Op_write.tmp` eq $right) +if (`$CAT Op_write.tmp` eq $right) { print "ok 1\n"; unlink 'Op_write.tmp'; } else { print "not ok 1\n"; } @@ -84,7 +86,7 @@ becomes necessary now is the time for all good men to come to\n"; -if (`cat Op_write.tmp` eq $right) +if (`$CAT Op_write.tmp` eq $right) { print "ok 2\n"; unlink 'Op_write.tmp'; } else { print "not ok 2\n"; } @@ -128,7 +130,7 @@ becomes necessary now is the time for all good men to come to\n"; -if (`cat Op_write.tmp` eq $right) +if (`$CAT Op_write.tmp` eq $right) { print "ok 3\n"; unlink 'Op_write.tmp'; } else { print "not ok 3\n"; } diff --git a/t/pragma/constant.t b/t/pragma/constant.t new file mode 100755 index 0000000000..fdd08b85eb --- /dev/null +++ b/t/pragma/constant.t @@ -0,0 +1,141 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; +} + +BEGIN {$^W |= 1} # Insist upon warnings +use vars qw{ @warnings }; +BEGIN { # ...and save 'em for later + $SIG{'__WARN__'} = sub { push @warnings, @_ } +} +END { print @warnings } + +######################### We start with some black magic to print on failure. + +BEGIN { $| = 1; print "1..39\n"; } +END {print "not ok 1\n" unless $loaded;} +use constant; +$loaded = 1; +#print "# Version: $constant::VERSION\n"; +print "ok 1\n"; + +######################### End of black magic. + +use strict; + +sub test ($$;$) { + my($num, $bool, $diag) = @_; + if ($bool) { + print "ok $num\n"; + return; + } + print "not ok $num\n"; + return unless defined $diag; + $diag =~ s/\Z\n?/\n/; # unchomp + print map "# $num : $_", split m/^/m, $diag; +} + +use constant PI => 4 * atan2 1, 1; + +test 2, substr(PI, 0, 7) eq '3.14159'; +test 3, defined PI; + +sub deg2rad { PI * $_[0] / 180 } + +my $ninety = deg2rad 90; + +test 4, $ninety > 1.5707; +test 5, $ninety < 1.5708; + +use constant UNDEF1 => undef; # the right way +use constant UNDEF2 => ; # the weird way +use constant 'UNDEF3' ; # the 'short' way +use constant EMPTY => ( ) ; # the right way for lists + +test 6, not defined UNDEF1; +test 7, not defined UNDEF2; +test 8, not defined UNDEF3; +my @undef = UNDEF1; +test 9, @undef == 1; +test 10, not defined $undef[0]; +@undef = UNDEF2; +test 11, @undef == 0; +@undef = UNDEF3; +test 12, @undef == 0; +@undef = EMPTY; +test 13, @undef == 0; + +use constant COUNTDOWN => scalar reverse 1, 2, 3, 4, 5; +use constant COUNTLIST => reverse 1, 2, 3, 4, 5; +use constant COUNTLAST => (COUNTLIST)[-1]; + +test 14, COUNTDOWN eq '54321'; +my @cl = COUNTLIST; +test 15, @cl == 5; +test 16, COUNTDOWN eq join '', @cl; +test 17, COUNTLAST == 1; +test 18, (COUNTLIST)[1] == 4; + +use constant ABC => 'ABC'; +test 19, "abc${\( ABC )}abc" eq "abcABCabc"; + +use constant DEF => 'D', "\x45", chr 70; +test 20, "d e f @{[ DEF ]} d e f" eq "d e f D E F d e f"; + +use constant SINGLE => "'"; +use constant DOUBLE => '"'; +use constant BACK => '\\'; +my $tt = BACK . SINGLE . DOUBLE ; +test 21, $tt eq q(\\'"); + +use constant MESS => q('"'\\"'"\\); +test 22, MESS eq q('"'\\"'"\\); +test 23, length(MESS) == 8; + +use constant TRAILING => '12 cats'; +{ + my $save_warn; + local $^W; + BEGIN { $save_warn = $^W; $^W = 0 } + test 24, TRAILING == 12; + BEGIN { $^W = $save_warn } +} +test 25, TRAILING eq '12 cats'; + +use constant LEADING => " \t\n1234"; +test 26, LEADING == 1234; +test 27, LEADING eq " \t\n1234"; + +use constant ZERO1 => 0; +use constant ZERO2 => 0.0; +use constant ZERO3 => '0.0'; +test 28, ZERO1 eq '0'; +test 29, ZERO2 eq '0'; +test 30, ZERO3 eq '0.0'; + +{ + package Other; + use constant PI => 3.141; +} + +test 31, (PI > 3.1415 and PI < 3.1416); +test 32, Other::PI == 3.141; + +use constant E2BIG => $! = 7; +test 33, E2BIG == 7; +# This is something like "Arg list too long", but the actual message +# text may vary, so we can't test much better than this. +test 34, length(E2BIG) > 6; +test 35, index(E2BIG, " ") > 0; + +test 36, @warnings == 0, join "\n", "unexpected warning", @warnings; +@warnings = (); # just in case +undef &PI; +test 37, @warnings && + ($warnings[0] =~ /Constant sub.* undefined/), + shift @warnings; + +test 38, @warnings == 0, "unexpected warning"; +test 39, $^W & 1, "Who disabled the warnings?"; diff --git a/t/pragma/locale.t b/t/pragma/locale.t index 05891fad77..d4b73b8f91 100755 --- a/t/pragma/locale.t +++ b/t/pragma/locale.t @@ -40,6 +40,7 @@ sub ok { # even the default locale will taint under 'use locale'. sub is_tainted { # hello, camel two. + local $^W; # no warnings 'undef' my $dummy; not eval { $dummy = join("", @_), kill 0; 1 } } @@ -622,7 +622,11 @@ sublex_start() return THING; } if (op_type == OP_CONST || op_type == OP_READLINE) { - yylval.opval = (OP*)newSVOP(op_type, 0, q(lex_stuff)); + SV *sv = q(lex_stuff); + STRLEN len; + char *p = SvPV(sv, len); + yylval.opval = (OP*)newSVOP(op_type, 0, newSVpv(p, len)); + SvREFCNT_dec(sv); lex_stuff = Nullsv; return THING; } @@ -1458,8 +1462,7 @@ yylex() retry: switch (*s) { default: - warn("Unrecognized character \\%03o ignored", *s++ & 255); - goto retry; + croak("Unrecognized character \\%03o", *s & 255); case 4: case 26: goto fake_eof; /* emulate EOF on ^D or ^Z */ @@ -1494,16 +1497,33 @@ yylex() sv_catpv(linestr, "LINE: while (<>) {"); if (minus_l) sv_catpv(linestr,"chomp;"); - if (minus_a){ - 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 ); - sv_catpv(linestr,tmpbuf1); + if (minus_a) { + GV* gv = gv_fetchpv("::F", TRUE, SVt_PVAV); + if (gv) + GvIMPORTED_AV_on(gv); + if (minus_F) { + 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(' ');"); @@ -1701,7 +1721,9 @@ yylex() } goto retry; case '\r': - croak("Illegal character \\%03o (carriage return)", '\r'); + warn("Illegal character \\%03o (carriage return)", '\r'); + croak( + "(Maybe you didn't strip carriage returns after a network transfer?)\n"); case ' ': case '\t': case '\f': case 013: s++; goto retry; @@ -2501,7 +2523,7 @@ yylex() curcop->cop_line++; } else - no_op("Bare word",s); + no_op("Bareword",s); } /* Look for a subroutine with this name in current package. */ @@ -5171,7 +5193,9 @@ char *s; char *context = NULL; int contlen = -1; - if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 && + if (!yychar || (yychar == ';' && !rsfp)) + where = "at EOF"; + else if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 && oldoldbufptr != oldbufptr && oldbufptr != bufptr) { while (isSPACE(*oldoldbufptr)) oldoldbufptr++; @@ -5187,8 +5211,6 @@ char *s; } else if (yychar > 255) where = "next token ???"; - else if (!yychar || (yychar == ';' && !rsfp)) - where = "at EOF"; else if ((yychar & 127) == 127) { if (lex_state == LEX_NORMAL || (lex_state == LEX_KNOWNEXT && lex_defer == LEX_NORMAL)) diff --git a/universal.c b/universal.c index 03b907de0c..b082da67ff 100644 --- a/universal.c +++ b/universal.c @@ -120,8 +120,7 @@ XS(XS_UNIVERSAL_isa) sv = ST(0); name = (char *)SvPV(ST(1),na); - ST(0) = (sv_derived_from(sv, name) ? &sv_yes : &sv_no) ; - + ST(0) = boolSV(sv_derived_from(sv, name)); XSRETURN(1); } @@ -132,8 +131,6 @@ XS(XS_UNIVERSAL_can) SV *sv; char *name; SV *rv; - GV *gv; - CV *cvp; HV *pkg = NULL; if (items != 2) @@ -153,16 +150,9 @@ XS(XS_UNIVERSAL_can) } if (pkg) { - gv = gv_fetchmethod(pkg, name); - - if(gv && GvCV(gv)) { - /* If the sub is only a stub then we may have a gv to AUTOLOAD */ - GV **gvp = (GV**)hv_fetch(GvSTASH(gv), name, strlen(name), TRUE); - if(gvp && (cvp = GvCV(*gvp))) { - rv = sv_newmortal(); - sv_setsv(rv, newRV((SV*)cvp)); - } - } + GV *gv = gv_fetchmethod_autoload(pkg, name, FALSE); + if (gv && isGV(gv)) + rv = sv_2mortal(newRV((SV*)GvCV(gv))); } ST(0) = rv; @@ -114,4 +114,4 @@ #define BIT_BUCKET "/dev/null" -#define dXSUB_SYS int dummy +#define dXSUB_SYS @@ -150,7 +150,7 @@ MEM_SIZE size; /* safe version of free */ -void +Free_t safefree(where) Malloc_t where; { @@ -1159,7 +1159,7 @@ die(pat, va_alist) { va_list args; char *message; - int oldrunlevel = runlevel; + I32 oldrunlevel = runlevel; int was_in_eval = in_eval; HV *stash; GV *gv; @@ -1209,7 +1209,7 @@ die(pat, va_alist) restartop = die_where(message); if ((!restartop && was_in_eval) || oldrunlevel > 1) - Siglongjmp(top_env, 3); + JMPENV_JUMP(3); return restartop; } @@ -1264,7 +1264,7 @@ croak(pat, va_alist) } if (in_eval) { restartop = die_where(message); - Siglongjmp(top_env, 3); + JMPENV_JUMP(3); } PerlIO_puts(PerlIO_stderr(),message); (void)PerlIO_flush(PerlIO_stderr()); diff --git a/utils/perlbug.PL b/utils/perlbug.PL index 2b676a4ae5..9ac6fb4315 100644 --- a/utils/perlbug.PL +++ b/utils/perlbug.PL @@ -166,9 +166,14 @@ sub Query { paraprint <<EOF; This program provides an easy way to create a message reporting a bug in perl, and e-mail it to $address. It is *NOT* intended for -sending test messages or simply verifying that perl works. It is *ONLY* -a means of reporting verifiable problems with perl, and any solutions to -such problems, to the people who maintain perl. +sending test messages or simply verifying that perl works, *NOR* is it +intended for reporting bugs in third-party perl modules. It is *ONLY* +a means of reporting verifiable problems with the core perl distribution, +and any solutions to such problems, to the people who maintain perl. + +If you're just looking for help with perl, try posting to the Usenet +newsgroup comp.lang.perl.misc. If you're looking for help with using +perl with CGI, try posting to comp.infosystems.www.programming.cgi. EOF @@ -471,11 +476,10 @@ EOF --- Environment for perl $]: EOF - for my $env (qw(PATH LD_LIBRARY_PATH - PERL5LIB PERLLIB PERL5DB - LC_ALL LC_COLLATE LC_CTYPE LC_MONETARY LC_NUMERIC LC_TIME - LANG PERL_BADLANG - SHELL HOME LOGDIR)) { + for my $env (qw(PATH LD_LIBRARY_PATH), + sort grep { /^(?:PERL|LC_)/ } keys %ENV, + qw(LANG PERL_BADLANG + SHELL HOME LOGDIR)) { print OUT " $env", exists $ENV{$env} ? "=$ENV{$env}" : ' (unset)', "\n"; diff --git a/vms/config.vms b/vms/config.vms index 5a362c9d50..c60239618d 100644 --- a/vms/config.vms +++ b/vms/config.vms @@ -76,7 +76,7 @@ * when Perl is built. Please do not change it by hand; make * any changes to FndVers.Com instead. */ -#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00394" /**/ +#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00397" /**/ #define ARCHLIB ARCHLIB_EXP /*config-skip*/ /* ARCHNAME: diff --git a/vms/descrip.mms b/vms/descrip.mms index 06c523eb48..db33be3e00 100644 --- a/vms/descrip.mms +++ b/vms/descrip.mms @@ -65,7 +65,7 @@ OBJVAL = $(MMS$TARGET_NAME)$(O) .endif # Updated by fndvers.com -- do not edit by hand -PERL_VERSION = 5_00394# +PERL_VERSION = 5_00397# ARCHDIR = [.lib.$(ARCH).$(PERL_VERSION)] @@ -4054,7 +4054,7 @@ candelete_fromperl(CV *cv) } } - ST(0) = cando_by_name(S_IDUSR,0,fsp) ? &sv_yes : &sv_no; + ST(0) = boolSV(cando_by_name(S_IDUSR,0,fsp)); XSRETURN(1); } @@ -4107,7 +4107,7 @@ rmscopy_fromperl(CV *cv) } date_flag = (items == 3) ? SvIV(ST(2)) : 0; - ST(0) = rmscopy(inp,outp,date_flag) ? &sv_yes : &sv_no; + ST(0) = boolSV(rmscopy(inp,outp,date_flag)); XSRETURN(1); } diff --git a/win32/EXTERN.h b/win32/EXTERN.h deleted file mode 100644 index 3ce63772a4..0000000000 --- a/win32/EXTERN.h +++ /dev/null @@ -1,47 +0,0 @@ -/* EXTERN.h - * - * Copyright (c) 1991-1997, Larry Wall - * - * You may distribute under the terms of either the GNU General Public - * License or the Artistic License, as specified in the README file. - * - */ - -/* - * EXT designates a global var which is defined in perl.h - * dEXT designates a global var which is defined in another - * file, so we can't count on finding it in perl.h - * (this practice should be avoided). - */ -#undef EXT -#undef dEXT -#undef EXTCONST -#undef dEXTCONST -#if defined(VMS) && !defined(__GNUC__) -# define EXT globalref -# define dEXT globaldef {"$GLOBAL_RW_VARS"} noshare -# define EXTCONST globalref -# define dEXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly -#elif 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 - -#undef INIT -#define INIT(x) - -#undef DOINIT diff --git a/win32/Makefile b/win32/Makefile index 05c2c48b36..3da20e77aa 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -33,6 +33,7 @@ EXTUTILSDIR=$(LIBDIR)\extutils # # various targets PERLLIB=..\libperl.lib +PERLIMPLIB=..\perl.lib MINIPERL=..\miniperl.exe PERLDLL=..\perl.dll PERLEXE=..\perl.exe @@ -40,7 +41,7 @@ GLOBEXE=..\perlglob.exe PL2BAT=bin\PL2BAT.BAT MAKE=nmake /nologo -XCOPY=xcopy /d /f /r +XCOPY=xcopy /i /d /f /r NULL= # @@ -117,9 +118,6 @@ $(GLOBEXE): $(MAKE) -f perlglob.mak CFG="perlglob - Win32 Release" $(PERLLIB): $(CORE_C) - attrib -r ..\*.h - copy dosish.h .. - copy EXTERN.h .. $(MAKE) -f libperl.mak CFG="libperl - Win32 $(CFG)" $(MINIPERL): $(PERLLIB) @@ -136,8 +134,6 @@ $(PERLDLL): $(MINIPERL) $(PERLLIB) $(MAKE) -A -f perldll.mak CFG="perldll - Win32 $(CFG)" $(PERLEXE): $(MINIPERL) modules.lib $(PERLDLL) - attrib -r perlmain.c - attrib -r perl.def # $(MINIPERL) makemain.pl $(STATICLINKMODUES) > perlmain.c # $(MINIPERL) makeperldef.pl $(STATICLINKMODUES) > perl.def $(MINIPERL) makeperldef.pl $(NULL) > perl.def @@ -151,7 +147,7 @@ $(PERLEXE): $(MINIPERL) modules.lib $(PERLDLL) attrib -r ..\t\*.* copy test ..\t $(XCOPY) ..\*.h ..\lib\CORE\*.* - $(XCOPY) ..\perl.lib ..\lib\CORE + $(XCOPY) $(PERLIMPLIB) ..\lib\CORE $(XCOPY) $(PERLLIB) ..\lib\CORE $(XCOPY) *.h ..\lib\CORE $(XCOPY) /S include ..\lib\CORE @@ -224,37 +220,40 @@ $(OPCODE_DLL): $(OPCODE).c $(PERLDLL) $(MAKE) -f $(*B).mak CFG="$(*B) - Win32 $(CFG)" doc: $(PERLEXE) - $(PERLEXE) $(POD2HTML).PL - $(PERLEXE) $(POD2MAN).PL - $(PERLEXE) $(POD2LATEX).PL - $(PERLEXE) $(POD2TEXT).PL - $(PERLEXE) $(PL2BAT) $(POD2HTML) - $(PERLEXE) $(PL2BAT) $(POD2MAN) - $(PERLEXE) $(PL2BAT) $(POD2LATEX) - $(PERLEXE) $(PL2BAT) $(POD2TEXT) cd $(PODDIR) - $(PERLEXE) pod2html.bat *.pod + nmake -f ../win32/pod.mak cd ..\win32 +utils: $(PERLEXE) + cd ..\utils + nmake PERL=$(MINIPERL) + $(PERLEXE) ..\win32\$(PL2BAT) h2ph splain perlbug pl2pm c2ph \ + h2xs perldoc pstruct + $(XCOPY) *.bat ..\win32\bin\*.* + 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 -install : ALL doc +install : ALL doc utils if not exist $(INST_TOP) mkdir $(INST_TOP) echo I $(INST_TOP) L $(LIBDIR) $(XCOPY) $(PERLEXE) $(INST_BIN)\*.* $(XCOPY) $(GLOBEXE) $(INST_BIN)\*.* $(XCOPY) $(PERLDLL) $(INST_BIN)\*.* + $(XCOPY) bin\*.* $(INST_BIN)\*.* $(XCOPY) /e ..\lib $(INST_LIB)\*.* $(XCOPY) ..\pod\*.bat $(INST_BIN)\*.* $(XCOPY) ..\pod\*.pod $(INST_POD)\*.* diff --git a/win32/SDBM_File.mak b/win32/SDBM_File.mak index 379ba26e2e..95f59c0570 100644 --- a/win32/SDBM_File.mak +++ b/win32/SDBM_File.mak @@ -211,7 +211,7 @@ LINK32_OBJS= \ SOURCE=..\ext\SDBM_File\SDBM_File.c DEP_CPP_SDBM_=\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\..\perl.h"\ ".\..\XSUB.h"\ ".\..\ext\SDBM_File\sdbm\sdbm.h"\ diff --git a/win32/Socket.mak b/win32/Socket.mak index fd26c99049..6bd318a3f8 100644 --- a/win32/Socket.mak +++ b/win32/Socket.mak @@ -116,7 +116,7 @@ ALL : "$(OUTDIR)\Socket.dll" CLEAN : -@erase ".\debug\vc40.pdb" -@erase ".\debug\vc40.idb" - -@erase ".\debug\Socket.dll" + -@erase "..\lib\auto\Socket\Socket.dll" -@erase ".\debug\Socket.obj" -@erase ".\debug\Socket.ilk" -@erase ".\debug\Socket.lib" @@ -148,8 +148,8 @@ LINK32=link.exe # ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:windows /dll /debug /machine:I386 LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo\ - /subsystem:windows /dll /incremental:yes /pdb:"$(OUTDIR)/Socket.pdb" /debug\ - /machine:I386 /def:".\Socket.def" /out:"$(OUTDIR)/Socket.dll"\ + /subsystem:windows /dll /incremental:no /pdb:"$(OUTDIR)/Socket.pdb" /debug\ + /machine:I386 /def:".\Socket.def" /out:"..\lib\auto\Socket\Socket.dll"\ /implib:"$(OUTDIR)/Socket.lib" DEF_FILE= \ ".\Socket.def" @@ -199,7 +199,7 @@ LINK32_OBJS= \ SOURCE=..\ext\Socket\Socket.c DEP_CPP_SOCKE=\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\..\perl.h"\ ".\..\XSUB.h"\ {$(INCLUDE)}"\sys\Types.h"\ diff --git a/win32/VC-2.0/Fcntl.mak b/win32/VC-2.0/Fcntl.mak new file mode 100644 index 0000000000..40bebb701a --- /dev/null +++ b/win32/VC-2.0/Fcntl.mak @@ -0,0 +1,247 @@ +# Microsoft Developer Studio Generated NMAKE File, Format Version 4.00 +# ** DO NOT EDIT ** + +# TARGTYPE "Win32 (x86) Dynamic-Link Library" 0x0102 + +!IF "$(CFG)" == "" +CFG=Fcntl - Win32 Debug +!MESSAGE No configuration specified. Defaulting to Fcntl - Win32 Debug. +!ENDIF + +!IF "$(CFG)" != "Fcntl - Win32 Release" && "$(CFG)" != "Fcntl - Win32 Debug" +!MESSAGE Invalid configuration "$(CFG)" specified. +!MESSAGE You can specify a configuration when running NMAKE on this makefile +!MESSAGE by defining the macro CFG on the command line. For example: +!MESSAGE +!MESSAGE NMAKE /f "Fcntl.mak" CFG="Fcntl - Win32 Debug" +!MESSAGE +!MESSAGE Possible choices for configuration are: +!MESSAGE +!MESSAGE "Fcntl - Win32 Release" (based on "Win32 (x86) Dynamic-Link Library") +!MESSAGE "Fcntl - Win32 Debug" (based on "Win32 (x86) Dynamic-Link Library") +!MESSAGE +!ERROR An invalid configuration is specified. +!ENDIF + +!IF "$(OS)" == "Windows_NT" +NULL= +!ELSE +NULL=nul +!ENDIF +################################################################################ +# Begin Project +CPP=cl.exe +RSC=rc.exe +MTL=mktyplib.exe + +!IF "$(CFG)" == "Fcntl - Win32 Release" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 0 +# PROP BASE Output_Dir "Fcntl___" +# PROP BASE Intermediate_Dir "Fcntl___" +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 0 +# PROP Output_Dir "Release" +# PROP Intermediate_Dir "Release" +# PROP Target_Dir "" +OUTDIR=.\Release +INTDIR=.\Release + +ALL : "$(OUTDIR)\Fcntl.dll" + +CLEAN : + -@erase "..\lib\auto\Fcntl\Fcntl.dll" + -@erase ".\Release\Fcntl.obj" + -@erase ".\Release\Fcntl.lib" + -@erase ".\Release\Fcntl.exp" + +"$(OUTDIR)" : + if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" + +# ADD BASE CPP /nologo /MT /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c +CPP_PROJ=/nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "WIN32" /D\ + "NDEBUG" /D "_WINDOWS" /Fp"$(INTDIR)/Fcntl.pch" /YX /Fo"$(INTDIR)/" /c +CPP_OBJS=.\Release/ +CPP_SBRS= +# ADD BASE MTL /nologo /D "NDEBUG" /win32 +# ADD MTL /nologo /D "NDEBUG" /win32 +MTL_PROJ=/nologo /D "NDEBUG" /win32 +# ADD BASE RSC /l 0x409 /d "NDEBUG" +# ADD RSC /l 0x409 /d "NDEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +BSC32_FLAGS=/nologo /o"$(OUTDIR)/Fcntl.bsc" +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:windows /dll /machine:I386 +# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:windows /dll /pdb:none /machine:I386 /out:"../lib/auto/Fcntl/Fcntl.dll" +LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ + advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo\ + /subsystem:windows /dll /pdb:none /machine:I386 /def:".\Fcntl.def"\ + /out:"../lib/auto/Fcntl/Fcntl.dll" /implib:"$(OUTDIR)/Fcntl.lib" +DEF_FILE= \ + ".\Fcntl.def" +LINK32_OBJS= \ + ".\Release\Fcntl.obj" \ + "..\perl.lib" + +"$(OUTDIR)\Fcntl.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) + $(LINK32) @<< + $(LINK32_FLAGS) $(LINK32_OBJS) +<< + +!ELSEIF "$(CFG)" == "Fcntl - Win32 Debug" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 1 +# PROP BASE Output_Dir "Fcntl__0" +# PROP BASE Intermediate_Dir "Fcntl__0" +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 1 +# PROP Output_Dir "Debug" +# PROP Intermediate_Dir "Debug" +# PROP Target_Dir "" +OUTDIR=.\Debug +INTDIR=.\Debug + +ALL : "$(OUTDIR)\Fcntl.dll" + +CLEAN : + -@erase "..\lib\auto\Fcntl\Fcntl.dll" + -@erase ".\Debug\Fcntl.obj" + -@erase ".\Debug\vc40.pdb" + -@erase ".\Debug\vc40.idb" + -@erase ".\Debug\Fcntl.lib" + -@erase ".\Debug\Fcntl.exp" + -@erase ".\Debug\Fcntl.pdb" + +"$(OUTDIR)" : + if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" + +# ADD BASE CPP /nologo /MT /W3 /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MT /W3 /Zi /Od /I ".\include" /I "." /I ".." /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c +CPP_PROJ=/nologo /MT /W3 /Zi /Od /I ".\include" /I "." /I ".." /D\ + "WIN32" /D "_DEBUG" /D "_WINDOWS" /Fp"$(INTDIR)/Fcntl.pch" /YX /Fo"$(INTDIR)/"\ + /Fd"$(INTDIR)/" /c +CPP_OBJS=.\Debug/ +CPP_SBRS= +# ADD BASE MTL /nologo /D "_DEBUG" /win32 +# ADD MTL /nologo /D "_DEBUG" /win32 +MTL_PROJ=/nologo /D "_DEBUG" /win32 +# ADD BASE RSC /l 0x409 /d "_DEBUG" +# ADD RSC /l 0x409 /d "_DEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +BSC32_FLAGS=/nologo /o"$(OUTDIR)/Fcntl.bsc" +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:windows /dll /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 /nologo /subsystem:windows /dll /incremental:no /debug /machine:I386 /out:"../lib/auto/Fcntl/Fcntl.dll" +LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ + advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo\ + /subsystem:windows /dll /incremental:no /pdb:"$(OUTDIR)/Fcntl.pdb" /debug\ + /machine:I386 /def:".\Fcntl.def" /out:"../lib/auto/Fcntl/Fcntl.dll"\ + /implib:"$(OUTDIR)/Fcntl.lib" +DEF_FILE= \ + ".\Fcntl.def" +LINK32_OBJS= \ + ".\Debug\Fcntl.obj" \ + "..\perl.lib" + +"$(OUTDIR)\Fcntl.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) + $(LINK32) @<< + $(LINK32_FLAGS) $(LINK32_OBJS) +<< + +!ENDIF + +.c{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.cpp{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.cxx{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.c{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +.cpp{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +.cxx{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +################################################################################ +# Begin Target + +# Name "Fcntl - Win32 Release" +# Name "Fcntl - Win32 Debug" + +!IF "$(CFG)" == "Fcntl - Win32 Release" + +!ELSEIF "$(CFG)" == "Fcntl - Win32 Debug" + +!ENDIF + +################################################################################ +# Begin Source File + +SOURCE=..\ext\Fcntl\Fcntl.c +NODEP_CPP_FCNTL=\ + "..\ext\Fcntl\EXTERN.h"\ + "..\ext\Fcntl\perl.h"\ + "..\ext\Fcntl\XSUB.h"\ + + +!IF "$(CFG)" == "Fcntl - Win32 Release" + + +"$(INTDIR)\Fcntl.obj" : $(SOURCE) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "Fcntl - Win32 Debug" + + +"$(INTDIR)\Fcntl.obj" : $(SOURCE) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=.\Fcntl.def + +!IF "$(CFG)" == "Fcntl - Win32 Release" + +!ELSEIF "$(CFG)" == "Fcntl - Win32 Debug" + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\perl.lib + +!IF "$(CFG)" == "Fcntl - Win32 Release" + +!ELSEIF "$(CFG)" == "Fcntl - Win32 Debug" + +!ENDIF + +# End Source File +# End Target +# End Project +################################################################################ diff --git a/win32/VC-2.0/IO.mak b/win32/VC-2.0/IO.mak new file mode 100644 index 0000000000..2b71bc6fb1 --- /dev/null +++ b/win32/VC-2.0/IO.mak @@ -0,0 +1,245 @@ +# Microsoft Developer Studio Generated NMAKE File, Format Version 4.00 +# ** DO NOT EDIT ** + +# TARGTYPE "Win32 (x86) Dynamic-Link Library" 0x0102 + +!IF "$(CFG)" == "" +CFG=IO - Win32 Debug +!MESSAGE No configuration specified. Defaulting to IO - Win32 Debug. +!ENDIF + +!IF "$(CFG)" != "IO - Win32 Release" && "$(CFG)" != "IO - Win32 Debug" +!MESSAGE Invalid configuration "$(CFG)" specified. +!MESSAGE You can specify a configuration when running NMAKE on this makefile +!MESSAGE by defining the macro CFG on the command line. For example: +!MESSAGE +!MESSAGE NMAKE /f "IO.mak" CFG="IO - Win32 Debug" +!MESSAGE +!MESSAGE Possible choices for configuration are: +!MESSAGE +!MESSAGE "IO - Win32 Release" (based on "Win32 (x86) Dynamic-Link Library") +!MESSAGE "IO - Win32 Debug" (based on "Win32 (x86) Dynamic-Link Library") +!MESSAGE +!ERROR An invalid configuration is specified. +!ENDIF + +!IF "$(OS)" == "Windows_NT" +NULL= +!ELSE +NULL=nul +!ENDIF +################################################################################ +# Begin Project +CPP=cl.exe +RSC=rc.exe +MTL=mktyplib.exe + +!IF "$(CFG)" == "IO - Win32 Release" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 0 +# PROP BASE Output_Dir "IO___Win" +# PROP BASE Intermediate_Dir "IO___Win" +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 0 +# PROP Output_Dir "Release" +# PROP Intermediate_Dir "Release" +# PROP Target_Dir "" +OUTDIR=.\Release +INTDIR=.\Release + +ALL : "$(OUTDIR)\IO.dll" + +CLEAN : + -@erase "..\lib\auto\IO\IO.dll" + -@erase ".\Release\IO.obj" + -@erase ".\Release\IO.lib" + -@erase ".\Release\IO.exp" + +"$(OUTDIR)" : + if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" + +# ADD BASE CPP /nologo /MT /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c +CPP_PROJ=/nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "WIN32" /D\ + "NDEBUG" /D "_WINDOWS" /Fp"$(INTDIR)/IO.pch" /YX /Fo"$(INTDIR)/" /c +CPP_OBJS=.\Release/ +CPP_SBRS= +# ADD BASE MTL /nologo /D "NDEBUG" /win32 +# ADD MTL /nologo /D "NDEBUG" /win32 +MTL_PROJ=/nologo /D "NDEBUG" /win32 +# ADD BASE RSC /l 0x409 /d "NDEBUG" +# ADD RSC /l 0x409 /d "NDEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +BSC32_FLAGS=/nologo /o"$(OUTDIR)/IO.bsc" +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:windows /dll /machine:I386 +# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:windows /dll /pdb:none /machine:I386 /out:"..\lib\auto\IO\IO.dll" +LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ + advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo\ + /subsystem:windows /dll /pdb:none /machine:I386 /def:".\IO.def"\ + /out:"..\lib\auto\IO\IO.dll" /implib:"$(OUTDIR)/IO.lib" +DEF_FILE= \ + ".\IO.def" +LINK32_OBJS= \ + ".\Release\IO.obj" \ + "..\perl.lib" + +"$(OUTDIR)\IO.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) + $(LINK32) @<< + $(LINK32_FLAGS) $(LINK32_OBJS) +<< + +!ELSEIF "$(CFG)" == "IO - Win32 Debug" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 1 +# PROP BASE Output_Dir "Debug" +# PROP BASE Intermediate_Dir "Debug" +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 1 +# PROP Output_Dir "Debug" +# PROP Intermediate_Dir "Debug" +# PROP Target_Dir "" +OUTDIR=.\Debug +INTDIR=.\Debug + +ALL : "$(OUTDIR)\IO.dll" + +CLEAN : + -@erase ".\Debug\IO.lib" + -@erase ".\Debug\IO.obj" + -@erase ".\Debug\IO.exp" + -@erase ".\Debug\vc40.pdb" + -@erase ".\Debug\vc40.idb" + -@erase "..\lib\auto\IO\IO.dll" + +"$(OUTDIR)" : + if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" + +# ADD BASE CPP /nologo /MT /W3 /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MT /W3 /Zi /Od /I ".\include" /I "." /I ".." /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c +CPP_PROJ=/nologo /MT /W3 /Zi /Od /I ".\include" /I "." /I ".." /D\ + "WIN32" /D "_DEBUG" /D "_WINDOWS" /Fp"$(INTDIR)/IO.pch" /YX /Fo"$(INTDIR)/"\ + /Fd"$(INTDIR)/" /c +CPP_OBJS=.\Debug/ +CPP_SBRS= +# ADD BASE MTL /nologo /D "_DEBUG" /win32 +# ADD MTL /nologo /D "_DEBUG" /win32 +MTL_PROJ=/nologo /D "_DEBUG" /win32 +# ADD BASE RSC /l 0x409 /d "_DEBUG" +# ADD RSC /l 0x409 /d "_DEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +BSC32_FLAGS=/nologo /o"$(OUTDIR)/IO.bsc" +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:windows /dll /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 /nologo /subsystem:windows /dll /pdb:none /debug /machine:I386 /out:"..\lib\auto\IO\IO.dll" +LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ + advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo\ + /subsystem:windows /dll /pdb:none /debug /machine:I386 /def:".\IO.def"\ + /out:"..\lib\auto\IO\IO.dll" /implib:"$(OUTDIR)/IO.lib" +DEF_FILE= \ + ".\IO.def" +LINK32_OBJS= \ + ".\Debug\IO.obj" \ + "..\perl.lib" + +"$(OUTDIR)\IO.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) + $(LINK32) @<< + $(LINK32_FLAGS) $(LINK32_OBJS) +<< + +!ENDIF + +.c{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.cpp{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.cxx{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.c{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +.cpp{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +.cxx{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +################################################################################ +# Begin Target + +# Name "IO - Win32 Release" +# Name "IO - Win32 Debug" + +!IF "$(CFG)" == "IO - Win32 Release" + +!ELSEIF "$(CFG)" == "IO - Win32 Debug" + +!ENDIF + +################################################################################ +# Begin Source File + +SOURCE=..\ext\Io\IO.c +NODEP_CPP_IO_C0=\ + "..\ext\Io\EXTERN.h"\ + "..\ext\Io\perl.h"\ + "..\ext\Io\XSUB.h"\ + + +!IF "$(CFG)" == "IO - Win32 Release" + + +"$(INTDIR)\IO.obj" : $(SOURCE) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "IO - Win32 Debug" + + +"$(INTDIR)\IO.obj" : $(SOURCE) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=.\IO.def + +!IF "$(CFG)" == "IO - Win32 Release" + +!ELSEIF "$(CFG)" == "IO - Win32 Debug" + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\perl.lib + +!IF "$(CFG)" == "IO - Win32 Release" + +!ELSEIF "$(CFG)" == "IO - Win32 Debug" + +!ENDIF + +# End Source File +# End Target +# End Project +################################################################################ diff --git a/win32/VC-2.0/Opcode.mak b/win32/VC-2.0/Opcode.mak new file mode 100644 index 0000000000..8ec2812e6b --- /dev/null +++ b/win32/VC-2.0/Opcode.mak @@ -0,0 +1,247 @@ +# Microsoft Developer Studio Generated NMAKE File, Format Version 4.00 +# ** DO NOT EDIT ** + +# TARGTYPE "Win32 (x86) Dynamic-Link Library" 0x0102 + +!IF "$(CFG)" == "" +CFG=Opcode - Win32 Debug +!MESSAGE No configuration specified. Defaulting to Opcode - Win32 Debug. +!ENDIF + +!IF "$(CFG)" != "Opcode - Win32 Release" && "$(CFG)" != "Opcode - Win32 Debug" +!MESSAGE Invalid configuration "$(CFG)" specified. +!MESSAGE You can specify a configuration when running NMAKE on this makefile +!MESSAGE by defining the macro CFG on the command line. For example: +!MESSAGE +!MESSAGE NMAKE /f "Opcode.mak" CFG="Opcode - Win32 Debug" +!MESSAGE +!MESSAGE Possible choices for configuration are: +!MESSAGE +!MESSAGE "Opcode - Win32 Release" (based on "Win32 (x86) Dynamic-Link Library") +!MESSAGE "Opcode - Win32 Debug" (based on "Win32 (x86) Dynamic-Link Library") +!MESSAGE +!ERROR An invalid configuration is specified. +!ENDIF + +!IF "$(OS)" == "Windows_NT" +NULL= +!ELSE +NULL=nul +!ENDIF +################################################################################ +# Begin Project +CPP=cl.exe +RSC=rc.exe +MTL=mktyplib.exe + +!IF "$(CFG)" == "Opcode - Win32 Release" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 0 +# PROP BASE Output_Dir "Opcode__" +# PROP BASE Intermediate_Dir "Opcode__" +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 0 +# PROP Output_Dir "Release" +# PROP Intermediate_Dir "Release" +# PROP Target_Dir "" +OUTDIR=.\Release +INTDIR=.\Release + +ALL : "$(OUTDIR)\Opcode.dll" + +CLEAN : + -@erase "..\lib\auto\Opcode\Opcode.dll" + -@erase ".\Release\Opcode.obj" + -@erase ".\Release\Opcode.lib" + -@erase ".\Release\Opcode.exp" + +"$(OUTDIR)" : + if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" + +# ADD BASE CPP /nologo /MT /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c +CPP_PROJ=/nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "WIN32" /D\ + "NDEBUG" /D "_WINDOWS" /Fp"$(INTDIR)/Opcode.pch" /YX /Fo"$(INTDIR)/" /c +CPP_OBJS=.\Release/ +CPP_SBRS= +# ADD BASE MTL /nologo /D "NDEBUG" /win32 +# ADD MTL /nologo /D "NDEBUG" /win32 +MTL_PROJ=/nologo /D "NDEBUG" /win32 +# ADD BASE RSC /l 0x409 /d "NDEBUG" +# ADD RSC /l 0x409 /d "NDEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +BSC32_FLAGS=/nologo /o"$(OUTDIR)/Opcode.bsc" +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:windows /dll /machine:I386 +# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:windows /dll /pdb:none /machine:I386 /out:"../lib/auto/Opcode/Opcode.dll" +LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ + advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo\ + /subsystem:windows /dll /pdb:none /machine:I386 /def:".\Opcode.def"\ + /out:"../lib/auto/Opcode/Opcode.dll" /implib:"$(OUTDIR)/Opcode.lib" +DEF_FILE= \ + ".\Opcode.def" +LINK32_OBJS= \ + ".\Release\Opcode.obj" \ + "..\perl.lib" + +"$(OUTDIR)\Opcode.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) + $(LINK32) @<< + $(LINK32_FLAGS) $(LINK32_OBJS) +<< + +!ELSEIF "$(CFG)" == "Opcode - Win32 Debug" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 1 +# PROP BASE Output_Dir "Opcode_0" +# PROP BASE Intermediate_Dir "Opcode_0" +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 1 +# PROP Output_Dir "Debug" +# PROP Intermediate_Dir "Debug" +# PROP Target_Dir "" +OUTDIR=.\Debug +INTDIR=.\Debug + +ALL : "$(OUTDIR)\Opcode.dll" + +CLEAN : + -@erase "..\lib\auto\Opcode\Opcode.dll" + -@erase ".\Debug\Opcode.obj" + -@erase ".\Debug\vc40.pdb" + -@erase ".\Debug\vc40.idb" + -@erase ".\Debug\Opcode.lib" + -@erase ".\Debug\Opcode.exp" + -@erase ".\Debug\Opcode.pdb" + +"$(OUTDIR)" : + if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" + +# ADD BASE CPP /nologo /MT /W3 /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MT /W3 /Zi /Od /I ".\include" /I "." /I ".." /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c +CPP_PROJ=/nologo /MT /W3 /Zi /Od /I ".\include" /I "." /I ".." /D\ + "WIN32" /D "_DEBUG" /D "_WINDOWS" /Fp"$(INTDIR)/Opcode.pch" /YX /Fo"$(INTDIR)/"\ + /Fd"$(INTDIR)/" /c +CPP_OBJS=.\Debug/ +CPP_SBRS= +# ADD BASE MTL /nologo /D "_DEBUG" /win32 +# ADD MTL /nologo /D "_DEBUG" /win32 +MTL_PROJ=/nologo /D "_DEBUG" /win32 +# ADD BASE RSC /l 0x409 /d "_DEBUG" +# ADD RSC /l 0x409 /d "_DEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +BSC32_FLAGS=/nologo /o"$(OUTDIR)/Opcode.bsc" +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:windows /dll /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 /nologo /subsystem:windows /dll /incremental:no /debug /machine:I386 /out:"../lib/auto/Opcode/Opcode.dll" +LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ + advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo\ + /subsystem:windows /dll /incremental:no /pdb:"$(OUTDIR)/Opcode.pdb" /debug\ + /machine:I386 /def:".\Opcode.def" /out:"../lib/auto/Opcode/Opcode.dll"\ + /implib:"$(OUTDIR)/Opcode.lib" +DEF_FILE= \ + ".\Opcode.def" +LINK32_OBJS= \ + ".\Debug\Opcode.obj" \ + "..\perl.lib" + +"$(OUTDIR)\Opcode.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) + $(LINK32) @<< + $(LINK32_FLAGS) $(LINK32_OBJS) +<< + +!ENDIF + +.c{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.cpp{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.cxx{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.c{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +.cpp{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +.cxx{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +################################################################################ +# Begin Target + +# Name "Opcode - Win32 Release" +# Name "Opcode - Win32 Debug" + +!IF "$(CFG)" == "Opcode - Win32 Release" + +!ELSEIF "$(CFG)" == "Opcode - Win32 Debug" + +!ENDIF + +################################################################################ +# Begin Source File + +SOURCE=.\Opcode.def + +!IF "$(CFG)" == "Opcode - Win32 Release" + +!ELSEIF "$(CFG)" == "Opcode - Win32 Debug" + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\ext\Opcode\Opcode.c +NODEP_CPP_OPCOD=\ + "..\ext\Opcode\EXTERN.h"\ + "..\ext\Opcode\perl.h"\ + "..\ext\Opcode\XSUB.h"\ + + +!IF "$(CFG)" == "Opcode - Win32 Release" + + +"$(INTDIR)\Opcode.obj" : $(SOURCE) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "Opcode - Win32 Debug" + + +"$(INTDIR)\Opcode.obj" : $(SOURCE) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\perl.lib + +!IF "$(CFG)" == "Opcode - Win32 Release" + +!ELSEIF "$(CFG)" == "Opcode - Win32 Debug" + +!ENDIF + +# End Source File +# End Target +# End Project +################################################################################ diff --git a/win32/VC-2.0/SDBM_File.mak b/win32/VC-2.0/SDBM_File.mak index 6ebaa15f2f..0eb689727c 100644 --- a/win32/VC-2.0/SDBM_File.mak +++ b/win32/VC-2.0/SDBM_File.mak @@ -136,9 +136,9 @@ CLEAN : "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" -# ADD BASE CPP /nologo /MTd /W3 /Gm /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /c -# ADD CPP /nologo /MTd /W3 /Gm /Zi /Od /I ".\include" /I "." /I ".." /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "MSDOS" /c -CPP_PROJ=/nologo /MTd /W3 /Gm /Zi /Od /I ".\include" /I "." /I ".." /D\ +# ADD BASE CPP /nologo /MT /W3 /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /c +# ADD CPP /nologo /MT /W3 /Zi /Od /I ".\include" /I "." /I ".." /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "MSDOS" /c +CPP_PROJ=/nologo /MT /W3 /Zi /Od /I ".\include" /I "." /I ".." /D\ "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "MSDOS" \ /Fo"$(INTDIR)/" /Fd"$(INTDIR)/" /c CPP_OBJS=.\Debug/ @@ -211,7 +211,7 @@ LINK32_OBJS= \ SOURCE=..\ext\SDBM_File\SDBM_File.c DEP_CPP_SDBM_=\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\..\perl.h"\ ".\..\XSUB.h"\ ".\..\ext\SDBM_File\sdbm\sdbm.h"\ diff --git a/win32/VC-2.0/Socket.mak b/win32/VC-2.0/Socket.mak index 69a774c279..f7475e2a05 100644 --- a/win32/VC-2.0/Socket.mak +++ b/win32/VC-2.0/Socket.mak @@ -116,7 +116,7 @@ ALL : "$(OUTDIR)\Socket.dll" CLEAN : -@erase ".\debug\vc40.pdb" -@erase ".\debug\vc40.idb" - -@erase ".\debug\Socket.dll" + -@erase "..\lib\auto\Socket\Socket.dll" -@erase ".\debug\Socket.obj" -@erase ".\debug\Socket.ilk" -@erase ".\debug\Socket.lib" @@ -126,9 +126,9 @@ CLEAN : "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" -# ADD BASE CPP /nologo /MTd /W3 /Gm /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c -# ADD CPP /nologo /MTd /W3 /Gm /Zi /Od /I ".\include" /I "." /I ".." /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c -CPP_PROJ=/nologo /MTd /W3 /Gm /Zi /Od /I ".\include" /I "." /I ".." /D\ +# ADD BASE CPP /nologo /MT /W3 /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MT /W3 /Zi /Od /I ".\include" /I "." /I ".." /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c +CPP_PROJ=/nologo /MT /W3 /Zi /Od /I ".\include" /I "." /I ".." /D\ "WIN32" /D "_DEBUG" /D "_WINDOWS" /Fp"$(INTDIR)/Socket.pch" /YX /Fo"$(INTDIR)/"\ /Fd"$(INTDIR)/" /c CPP_OBJS=.\debug/ @@ -148,8 +148,8 @@ LINK32=link.exe # ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:windows /dll /debug /machine:I386 LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo\ - /subsystem:windows /dll /incremental:yes /pdb:"$(OUTDIR)/Socket.pdb" /debug\ - /machine:I386 /def:".\Socket.def" /out:"$(OUTDIR)/Socket.dll"\ + /subsystem:windows /dll /incremental:no /pdb:"$(OUTDIR)/Socket.pdb" /debug\ + /machine:I386 /def:".\Socket.def" /out:"..\lib\auto\Socket\Socket.dll"\ /implib:"$(OUTDIR)/Socket.lib" DEF_FILE= \ ".\Socket.def" @@ -199,7 +199,7 @@ LINK32_OBJS= \ SOURCE=..\ext\Socket\Socket.c DEP_CPP_SOCKE=\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\..\perl.h"\ ".\..\XSUB.h"\ "$(INCLUDE)\sys\Types.h"\ diff --git a/win32/VC-2.0/libperl.mak b/win32/VC-2.0/libperl.mak index ab94be02e4..97d31c4f5d 100644 --- a/win32/VC-2.0/libperl.mak +++ b/win32/VC-2.0/libperl.mak @@ -189,9 +189,9 @@ CLEAN : if not exist "$(INTDIR)/$(NULL)" mkdir "$(INTDIR)" # 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 "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c -CPP_PROJ=/nologo /MTd /W3 /Z7 /Od /I ".\include" /I ".." /I "." /D "WIN32"\ - /D "_DEBUG" /D "_WINDOWS" /Fp"$(INTDIR)/libperl.pch" /YX /Fo"$(INTDIR)/" /c +# ADD CPP /nologo /MT /W3 /Z7 /Od /I ".\include" /I ".." /I "." /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c +CPP_PROJ=/nologo /MT /W3 /Z7 /Od /I ".\include" /I ".." /I "." /D "WIN32"\ +/D "PERLDLL" /D "_DEBUG" /D "_WINDOWS" /Fp"$(INTDIR)/libperl.pch" /YX /Fo"$(INTDIR)/" /c CPP_OBJS=.\Debug/ CPP_SBRS=.\. BSC32=bscmake.exe diff --git a/win32/VC-2.0/miniperl.mak b/win32/VC-2.0/miniperl.mak index 3fce97fde1..241a0eaf2b 100644 --- a/win32/VC-2.0/miniperl.mak +++ b/win32/VC-2.0/miniperl.mak @@ -131,9 +131,9 @@ CLEAN : "$(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 "_DEBUG" /D "WIN32" /D "_CONSOLE" /D "PERLDLL" /YX /c -CPP_PROJ=/nologo /MTd /W3 /Gm /Zi /Od /I "." /I ".\include" /I ".." /D\ +# ADD BASE CPP /nologo /W3 /Zi /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /YX /c +# ADD CPP /nologo /MT /W3 /Zi /Od /I "." /I ".\include" /I ".." /D "_DEBUG" /D "WIN32" /D "_CONSOLE" /D "PERLDLL" /YX /c +CPP_PROJ=/nologo /MT /W3 /Zi /Od /I "." /I ".\include" /I ".." /D\ "_DEBUG" /D "WIN32" /D "_CONSOLE" /D "PERLDLL" /Fp"$(INTDIR)/miniperl.pch" /YX\ /Fo"$(INTDIR)/" /Fd"$(INTDIR)/" /c CPP_OBJS=.\Debug/ @@ -293,7 +293,7 @@ DEP_CPP_WIN32=\ ".\..\unixish.h"\ ".\..\util.h"\ ".\config.h"\ - ".\EXTERN.h"\ + ".\..\EXTERN.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ ".\include\sys/socket.h"\ @@ -343,7 +343,7 @@ DEP_CPP_WIN32S=\ ".\..\unixish.h"\ ".\..\util.h"\ ".\config.h"\ - ".\EXTERN.h"\ + ".\..\EXTERN.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ ".\include\sys/socket.h"\ diff --git a/win32/VC-2.0/modules.mak b/win32/VC-2.0/modules.mak index 198ca3120f..2039986d51 100644 --- a/win32/VC-2.0/modules.mak +++ b/win32/VC-2.0/modules.mak @@ -59,9 +59,9 @@ CLEAN : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" # ADD BASE CPP /nologo /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c -# ADD CPP /nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "MSDOS" /YX /c +# ADD CPP /nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "PERLDLL" /YX /c CPP_PROJ=/nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "NDEBUG" /D\ - "WIN32" /D "_WINDOWS" /D "MSDOS" /Fp"$(INTDIR)/modules.pch" /YX /Fo"$(INTDIR)/"\ + "WIN32" /D "_WINDOWS" /D "PERLDLL" /Fp"$(INTDIR)/modules.pch" /YX /Fo"$(INTDIR)/"\ /c CPP_OBJS=.\Release/ CPP_SBRS=.\. @@ -108,9 +108,9 @@ CLEAN : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" # ADD BASE CPP /nologo /W3 /Z7 /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c -# ADD CPP /nologo /MTd /W3 /Z7 /Od /I ".\include" /I "." /I ".." /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "MSDOS" /YX /c -CPP_PROJ=/nologo /MTd /W3 /Z7 /Od /I ".\include" /I "." /I ".." /D "_DEBUG"\ - /D "WIN32" /D "_WINDOWS" /D "MSDOS" /Fp"$(INTDIR)/modules.pch" /YX\ +# ADD CPP /nologo /MT /W3 /Z7 /Od /I ".\include" /I "." /I ".." /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "PERLDLL" /YX /c +CPP_PROJ=/nologo /MT /W3 /Z7 /Od /I ".\include" /I "." /I ".." /D "_DEBUG"\ + /D "WIN32" /D "_WINDOWS" /D "PERLDLL" /Fp"$(INTDIR)/modules.pch" /YX\ /Fo"$(INTDIR)/" /c CPP_OBJS=.\Debug/ CPP_SBRS=.\. @@ -201,7 +201,7 @@ DEP_CPP_DYNAL=\ "..\XSUB.h"\ ".\..\ext\DynaLoader\dlutils.c"\ ".\config.h"\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ ".\include\sys/socket.h"\ @@ -250,7 +250,7 @@ DEP_CPP_DYNAL=\ "..\XSUB.h"\ ".\..\ext\DynaLoader\dlutils.c"\ ".\config.h"\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ ".\include\sys/socket.h"\ @@ -308,7 +308,7 @@ DEP_CPP_FCNTL=\ "..\util.h"\ "..\XSUB.h"\ ".\config.h"\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ ".\include\sys/socket.h"\ @@ -356,7 +356,7 @@ DEP_CPP_FCNTL=\ "..\util.h"\ "..\XSUB.h"\ ".\config.h"\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ ".\include\sys/socket.h"\ @@ -414,7 +414,7 @@ DEP_CPP_IO_C4=\ "..\util.h"\ "..\XSUB.h"\ ".\config.h"\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ ".\include\sys/socket.h"\ @@ -462,7 +462,7 @@ DEP_CPP_IO_C4=\ "..\util.h"\ "..\XSUB.h"\ ".\config.h"\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ ".\include\sys/socket.h"\ @@ -520,7 +520,7 @@ DEP_CPP_OPCOD=\ "..\util.h"\ "..\XSUB.h"\ ".\config.h"\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ ".\include\sys/socket.h"\ @@ -568,7 +568,7 @@ DEP_CPP_OPCOD=\ "..\util.h"\ "..\XSUB.h"\ ".\config.h"\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ ".\include\sys/socket.h"\ @@ -624,7 +624,7 @@ DEP_CPP_SDBM_=\ "..\XSUB.h"\ ".\..\ext\SDBM_File\sdbm\sdbm.h"\ ".\config.h"\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ ".\include\sys/socket.h"\ @@ -675,7 +675,7 @@ DEP_CPP_SOCKE=\ "..\util.h"\ "..\XSUB.h"\ ".\config.h"\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\include\arpa/inet.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ diff --git a/win32/VC-2.0/perl.mak b/win32/VC-2.0/perl.mak index bee99fda0e..48602f330d 100644 --- a/win32/VC-2.0/perl.mak +++ b/win32/VC-2.0/perl.mak @@ -1,4 +1,4 @@ -# Microsoft Developer Studio Generated NMAKE File, Format Version 4.20 +# Microsoft Developer Studio Generated NMAKE File, Format Version 4.00 # ** DO NOT EDIT ** # TARGTYPE "Win32 (x86) Console Application" 0x0103 @@ -49,12 +49,13 @@ RSC=rc.exe OUTDIR=.\Release INTDIR=.\Release -ALL : "..\_perl.exe" +ALL : "$(OUTDIR)\_perl.exe" CLEAN : - -@erase "$(INTDIR)\perlmain.obj" - -@erase "$(INTDIR)\win32io.obj" -@erase "..\_perl.exe" + -@erase ".\Release\perlmain.obj" + -@erase ".\Release\win32io.obj" + -@erase ".\Release\perl.res" "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" @@ -64,15 +65,15 @@ CLEAN : CPP_PROJ=/nologo /MT /W3 /O2 /I "." /I ".\include" /I ".." /D "WIN32" /D\ "NDEBUG" /D "_CONSOLE" /Fp"$(INTDIR)/perl.pch" /YX /Fo"$(INTDIR)/" /c CPP_OBJS=.\Release/ -CPP_SBRS=.\. +CPP_SBRS= # ADD BASE RSC /l 0x409 /d "NDEBUG" # ADD RSC /l 0x409 /d "NDEBUG" +RSC_PROJ=/l 0x409 /fo"$(INTDIR)/perl.res" /d "NDEBUG" BSC32=bscmake.exe # ADD BASE BSC32 /nologo # ADD BSC32 /nologo BSC32_FLAGS=/nologo /o"$(OUTDIR)/perl.bsc" -BSC32_SBRS= \ - +BSC32_SBRS= LINK32=link.exe # ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:console /machine:I386 # ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib setargv.obj /nologo /subsystem:console /machine:I386 /out:"../_perl.exe" @@ -81,11 +82,11 @@ LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ /subsystem:console /incremental:no /pdb:"$(OUTDIR)/_perl.pdb" /machine:I386\ /out:"../_perl.exe" LINK32_OBJS= \ - "$(INTDIR)\perlmain.obj" \ - "$(INTDIR)\win32io.obj" \ + "$(INTDIR)/perlmain.obj" \ + "$(INTDIR)/win32io.obj" \ "..\perl.lib" -"..\_perl.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) +"$(OUTDIR)\_perl.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) $(LINK32) @<< $(LINK32_FLAGS) $(LINK32_OBJS) << @@ -105,35 +106,33 @@ LINK32_OBJS= \ OUTDIR=.\Debug INTDIR=.\Debug -ALL : "..\_perl.exe" +ALL : "$(OUTDIR)\_perl.exe" CLEAN : - -@erase "$(INTDIR)\perlmain.obj" - -@erase "$(INTDIR)\vc40.idb" - -@erase "$(INTDIR)\vc40.pdb" - -@erase "$(INTDIR)\win32io.obj" - -@erase "$(OUTDIR)\_perl.pdb" -@erase "..\_perl.exe" + -@erase ".\Debug\perlmain.obj" + -@erase ".\Debug\win32io.obj" + -@erase ".\Debug\perl.res" -@erase "..\_perl.ilk" + -@erase ".\Debug\_perl.pdb" "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" -# ADD BASE CPP /nologo /W3 /Gm /Zi /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /YX /c -# ADD CPP /nologo /MTd /W3 /Gm /Zi /Od /I "." /I ".\include" /I ".." /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /YX /c -CPP_PROJ=/nologo /MTd /W3 /Gm /Zi /Od /I "." /I ".\include" /I ".." /D\ - "WIN32" /D "_DEBUG" /D "_CONSOLE" /Fp"$(INTDIR)/perl.pch" /YX /Fo"$(INTDIR)/"\ - /Fd"$(INTDIR)/" /c +# ADD BASE CPP /nologo /W3 /Zi /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /YX /c +# ADD CPP /nologo /MT /W3 /Z7 /Od /I "." /I ".\include" /I ".." /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /YX /c +CPP_PROJ=/nologo /MT /W3 /Z7 /Od /I "." /I ".\include" /I ".." /D "WIN32" /D\ + "_DEBUG" /D "_CONSOLE" /Fp"$(INTDIR)/perl.pch" /YX /Fo"$(INTDIR)/" /c CPP_OBJS=.\Debug/ -CPP_SBRS=.\. +CPP_SBRS= # ADD BASE RSC /l 0x409 /d "_DEBUG" # ADD RSC /l 0x409 /d "_DEBUG" +RSC_PROJ=/l 0x409 /fo"$(INTDIR)/perl.res" /d "_DEBUG" BSC32=bscmake.exe # ADD BASE BSC32 /nologo # ADD BSC32 /nologo BSC32_FLAGS=/nologo /o"$(OUTDIR)/perl.bsc" -BSC32_SBRS= \ - +BSC32_SBRS= LINK32=link.exe # ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:console /debug /machine:I386 # ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib setargv.obj /nologo /subsystem:console /debug /machine:I386 /out:"../_perl.exe" @@ -142,11 +141,11 @@ LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ /subsystem:console /incremental:yes /pdb:"$(OUTDIR)/_perl.pdb" /debug\ /machine:I386 /out:"../_perl.exe" LINK32_OBJS= \ - "$(INTDIR)\perlmain.obj" \ - "$(INTDIR)\win32io.obj" \ + "$(INTDIR)/perlmain.obj" \ + "$(INTDIR)/win32io.obj" \ "..\perl.lib" -"..\_perl.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) +"$(OUTDIR)\_perl.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) $(LINK32) @<< $(LINK32_FLAGS) $(LINK32_OBJS) << @@ -191,9 +190,20 @@ DEP_CPP_PERLM=\ ".\win32io.h"\ +!IF "$(CFG)" == "perl - Win32 Release" + + "$(INTDIR)\perlmain.obj" : $(SOURCE) $(DEP_CPP_PERLM) "$(INTDIR)" +!ELSEIF "$(CFG)" == "perl - Win32 Debug" + + +"$(INTDIR)\perlmain.obj" : $(SOURCE) $(DEP_CPP_PERLM) "$(INTDIR)" + + +!ENDIF + # End Source File ################################################################################ # Begin Source File @@ -215,8 +225,8 @@ DEP_CPP_WIN32=\ ".\include\sys/socket.h"\ ".\win32io.h"\ ".\win32iop.h"\ - "$(INCLUDE)\Sys\Stat.h"\ - "$(INCLUDE)\Sys\Types.h"\ + "$(INCLUDE)\sys\STAT.H"\ + "$(INCLUDE)\sys\TYPES.H"\ "$(INTDIR)\win32io.obj" : $(SOURCE) $(DEP_CPP_WIN32) "$(INTDIR)" diff --git a/win32/VC-2.0/perldll.mak b/win32/VC-2.0/perldll.mak index ab9460e2c8..2daf219bca 100644 --- a/win32/VC-2.0/perldll.mak +++ b/win32/VC-2.0/perldll.mak @@ -123,10 +123,10 @@ LINK32_OBJS= \ # PROP Output_Dir "debug" # PROP Intermediate_Dir "debug" # PROP Target_Dir "" -OUTDIR=.\debug +OUTDIR=.\.. INTDIR=.\debug -ALL : "..\perl.dll" +ALL : "$(OUTDIR)\perl.dll" CLEAN : -@erase "$(INTDIR)\perllib.obj" @@ -145,9 +145,9 @@ CLEAN : "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" -# ADD BASE CPP /nologo /MTd /W3 /Gm /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c -# ADD CPP /nologo /MTd /W3 /Gm /Zi /Od /I "." /I ".\include" /I ".." /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "PERLDLL" /YX /c -CPP_PROJ=/nologo /MTd /W3 /Gm /Zi /Od /I "." /I ".\include" /I ".." /D\ +# ADD BASE CPP /nologo /MT /W3 /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MT /W3 /Zi /Od /I "." /I ".\include" /I ".." /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "PERLDLL" /YX /c +CPP_PROJ=/nologo /MT /W3 /Zi /Od /I "." /I ".\include" /I ".." /D\ "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "PERLDLL" /Fp"$(INTDIR)/perldll.pch" /YX\ /Fo"$(INTDIR)/" /Fd"$(INTDIR)/" /c CPP_OBJS=.\debug/ @@ -182,7 +182,7 @@ LINK32_OBJS= \ "..\libperl.lib" \ ".\modules.lib" -"..\perl.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) +"$(OUTDIR)\perl.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) $(LINK32) @<< $(LINK32_FLAGS) $(LINK32_OBJS) << @@ -251,7 +251,7 @@ DEP_CPP_PERLL=\ "..\unixish.h"\ "..\util.h"\ ".\config.h"\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ ".\include\sys/socket.h"\ @@ -326,7 +326,7 @@ DEP_CPP_WIN32=\ "..\unixish.h"\ "..\util.h"\ ".\config.h"\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ ".\include\sys/socket.h"\ @@ -360,7 +360,7 @@ DEP_CPP_WIN32_=\ "..\perlsdio.h"\ "..\perlsfio.h"\ ".\config.h"\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ ".\include\sys/socket.h"\ @@ -376,7 +376,7 @@ DEP_CPP_WIN32_=\ DEP_CPP_WIN32_=\ "..\perl.h"\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ "$(INCLUDE)\sys\stat.h"\ "$(INCLUDE)\sys\types.h"\ diff --git a/win32/VC-2.0/perlglob.mak b/win32/VC-2.0/perlglob.mak new file mode 100644 index 0000000000..f11a8a52b2 --- /dev/null +++ b/win32/VC-2.0/perlglob.mak @@ -0,0 +1,201 @@ +# Microsoft Developer Studio Generated NMAKE File, Format Version 4.00 +# ** DO NOT EDIT ** + +# TARGTYPE "Win32 (x86) Console Application" 0x0103 + +!IF "$(CFG)" == "" +CFG=perlglob - Win32 Debug +!MESSAGE No configuration specified. Defaulting to perlglob - Win32 Debug. +!ENDIF + +!IF "$(CFG)" != "perlglob - Win32 Release" && "$(CFG)" !=\ + "perlglob - Win32 Debug" +!MESSAGE Invalid configuration "$(CFG)" specified. +!MESSAGE You can specify a configuration when running NMAKE on this makefile +!MESSAGE by defining the macro CFG on the command line. For example: +!MESSAGE +!MESSAGE NMAKE /f "perlglob.mak" CFG="perlglob - Win32 Debug" +!MESSAGE +!MESSAGE Possible choices for configuration are: +!MESSAGE +!MESSAGE "perlglob - Win32 Release" (based on\ + "Win32 (x86) Console Application") +!MESSAGE "perlglob - Win32 Debug" (based on "Win32 (x86) Console Application") +!MESSAGE +!ERROR An invalid configuration is specified. +!ENDIF + +!IF "$(OS)" == "Windows_NT" +NULL= +!ELSE +NULL=nul +!ENDIF +################################################################################ +# Begin Project +# PROP Target_Last_Scanned "perlglob - Win32 Debug" +CPP=cl.exe +RSC=rc.exe + +!IF "$(CFG)" == "perlglob - Win32 Release" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 0 +# PROP BASE Output_Dir "perlglob" +# PROP BASE Intermediate_Dir "perlglob" +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 0 +# PROP Output_Dir "release" +# PROP Intermediate_Dir "release" +# PROP Target_Dir "" +OUTDIR=.\release +INTDIR=.\release + +ALL : "$(OUTDIR)\perlglob.exe" + +CLEAN : + -@erase "..\perlglob.exe" + -@erase ".\release\perlglob.obj" + +"$(OUTDIR)" : + if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" + +# ADD BASE CPP /nologo /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /YX /c +# ADD CPP /nologo /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /YX /c +CPP_PROJ=/nologo /ML /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE"\ + /Fp"$(INTDIR)/perlglob.pch" /YX /Fo"$(INTDIR)/" /c +CPP_OBJS=.\release/ +CPP_SBRS= +# ADD BASE RSC /l 0x409 /d "NDEBUG" +# ADD RSC /l 0x409 /d "NDEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +BSC32_FLAGS=/nologo /o"$(OUTDIR)/perlglob.bsc" +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:"../perlglob.exe" +LINK32_FLAGS=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 /incremental:no /pdb:"$(OUTDIR)/perlglob.pdb" /machine:I386\ + /out:"../perlglob.exe" +LINK32_OBJS= \ + "$(INTDIR)/perlglob.obj" + +"$(OUTDIR)\perlglob.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) + $(LINK32) @<< + $(LINK32_FLAGS) $(LINK32_OBJS) +<< + +!ELSEIF "$(CFG)" == "perlglob - Win32 Debug" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 1 +# PROP BASE Output_Dir "perlglo0" +# PROP BASE Intermediate_Dir "perlglo0" +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 1 +# PROP Output_Dir "debug" +# PROP Intermediate_Dir "debug" +# PROP Target_Dir "" +OUTDIR=.\debug +INTDIR=.\debug + +ALL : "$(OUTDIR)\perlglob.exe" + +CLEAN : + -@erase "..\perlglob.exe" + -@erase ".\debug\perlglob.obj" + -@erase "..\perlglob.ilk" + -@erase ".\debug\perlglob.pdb" + -@erase ".\debug\vc40.pdb" + -@erase ".\debug\vc40.idb" + +"$(OUTDIR)" : + if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" + +# ADD BASE CPP /nologo /W3 /Zi /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /YX /c +# ADD CPP /nologo /W3 /Zi /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /YX /c +CPP_PROJ=/nologo /MLd /W3 /Zi /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE"\ + /Fp"$(INTDIR)/perlglob.pch" /YX /Fo"$(INTDIR)/" /Fd"$(INTDIR)/" /c +CPP_OBJS=.\debug/ +CPP_SBRS= +# ADD BASE RSC /l 0x409 /d "_DEBUG" +# ADD RSC /l 0x409 /d "_DEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +BSC32_FLAGS=/nologo /o"$(OUTDIR)/perlglob.bsc" +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:"..\perlglob.exe" +LINK32_FLAGS=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 /incremental:yes /pdb:"$(OUTDIR)/perlglob.pdb" /debug\ + /machine:I386 /out:"..\perlglob.exe" +LINK32_OBJS= \ + "$(INTDIR)/perlglob.obj" + +"$(OUTDIR)\perlglob.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) + $(LINK32) @<< + $(LINK32_FLAGS) $(LINK32_OBJS) +<< + +!ENDIF + +.c{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.cpp{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.cxx{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.c{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +.cpp{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +.cxx{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +################################################################################ +# Begin Target + +# Name "perlglob - Win32 Release" +# Name "perlglob - Win32 Debug" + +!IF "$(CFG)" == "perlglob - Win32 Release" + +!ELSEIF "$(CFG)" == "perlglob - Win32 Debug" + +!ENDIF + +################################################################################ +# Begin Source File + +SOURCE=.\perlglob.c + +!IF "$(CFG)" == "perlglob - Win32 Release" + + +"$(INTDIR)\perlglob.obj" : $(SOURCE) "$(INTDIR)" + + +!ELSEIF "$(CFG)" == "perlglob - Win32 Debug" + + +"$(INTDIR)\perlglob.obj" : $(SOURCE) "$(INTDIR)" + + +!ENDIF + +# End Source File +# End Target +# End Project +################################################################################ diff --git a/win32/VC-2.0/pod.mak b/win32/VC-2.0/pod.mak new file mode 100644 index 0000000000..538cfa3737 --- /dev/null +++ b/win32/VC-2.0/pod.mak @@ -0,0 +1,272 @@ +CONVERTERS = pod2html pod2latex pod2man pod2text checkpods + +HTMLROOT = / # Change this to fix cross-references in HTML +POD2HTML = pod2html \ + --htmlroot=$(HTMLROOT) \ + --podroot=.. --podpath=pod:lib:ext:vms \ + --libpods=perlfunc:perlguts:perlvar:perlrun:perlop + +all: $(CONVERTERS) html + +PERL = ..\miniperl.exe +PL2BAT = ..\win32\bin\pl2bat.bat + +POD = \ + perl.pod \ + perldelta.pod \ + perldata.pod \ + perlsyn.pod \ + perlop.pod \ + perlre.pod \ + perlrun.pod \ + perlfunc.pod \ + perlvar.pod \ + perlsub.pod \ + perlmod.pod \ + perlform.pod \ + perllocale.pod \ + perlref.pod \ + perldsc.pod \ + perllol.pod \ + perltoot.pod \ + perlobj.pod \ + perltie.pod \ + perlbot.pod \ + perlipc.pod \ + perldebug.pod \ + perldiag.pod \ + perlsec.pod \ + perltrap.pod \ + perlstyle.pod \ + perlpod.pod \ + perlbook.pod \ + perlembed.pod \ + perlapio.pod \ + perlxs.pod \ + perlxstut.pod \ + perlguts.pod \ + perlcall.pod \ + perlfaq.pod \ + perlfaq1.pod \ + perlfaq2.pod \ + perlfaq3.pod \ + perlfaq4.pod \ + perlfaq5.pod \ + perlfaq6.pod \ + perlfaq7.pod \ + perlfaq8.pod \ + perlfaq9.pod \ + perltoc.pod + +MAN = \ + perl.man \ + perldelta.man \ + perldata.man \ + perlsyn.man \ + perlop.man \ + perlre.man \ + perlrun.man \ + perlfunc.man \ + perlvar.man \ + perlsub.man \ + perlmod.man \ + perlform.man \ + perllocale.man \ + perlref.man \ + perldsc.man \ + perllol.man \ + perltoot.man \ + perlobj.man \ + perltie.man \ + perlbot.man \ + perlipc.man \ + perldebug.man \ + perldiag.man \ + perlsec.man \ + perltrap.man \ + perlstyle.man \ + perlpod.man \ + perlbook.man \ + perlembed.man \ + perlapio.man \ + perlxs.man \ + perlxstut.man \ + perlguts.man \ + perlcall.man \ + perlfaq.man \ + perlfaq1.man \ + perlfaq2.man \ + perlfaq3.man \ + perlfaq4.man \ + perlfaq5.man \ + perlfaq6.man \ + perlfaq7.man \ + perlfaq8.man \ + perlfaq9.man \ + perltoc.man + +HTML = \ + perl.html \ + perldelta.html \ + perldata.html \ + perlsyn.html \ + perlop.html \ + perlre.html \ + perlrun.html \ + perlfunc.html \ + perlvar.html \ + perlsub.html \ + perlmod.html \ + perlform.html \ + perllocale.html \ + perlref.html \ + perldsc.html \ + perllol.html \ + perltoot.html \ + perlobj.html \ + perltie.html \ + perlbot.html \ + perlipc.html \ + perldebug.html \ + perldiag.html \ + perlsec.html \ + perltrap.html \ + perlstyle.html \ + perlpod.html \ + perlbook.html \ + perlembed.html \ + perlapio.html \ + perlxs.html \ + perlxstut.html \ + perlguts.html \ + perlcall.html \ + perlfaq.html \ + perlfaq1.html \ + perlfaq2.html \ + perlfaq3.html \ + perlfaq4.html \ + perlfaq5.html \ + perlfaq6.html \ + perlfaq7.html \ + perlfaq8.html \ + perlfaq9.html +# not perltoc.html + +TEX = \ + perl.tex \ + perldelta.tex \ + perldata.tex \ + perlsyn.tex \ + perlop.tex \ + perlre.tex \ + perlrun.tex \ + perlfunc.tex \ + perlvar.tex \ + perlsub.tex \ + perlmod.tex \ + perlform.tex \ + perllocale.tex \ + perlref.tex \ + perldsc.tex \ + perllol.tex \ + perltoot.tex \ + perlobj.tex \ + perltie.tex \ + perlbot.tex \ + perlipc.tex \ + perldebug.tex \ + perldiag.tex \ + perlsec.tex \ + perltrap.tex \ + perlstyle.tex \ + perlpod.tex \ + perlbook.tex \ + perlembed.tex \ + perlapio.tex \ + perlxs.tex \ + perlxstut.tex \ + perlguts.tex \ + perlcall.tex \ + perlfaq.tex \ + perlfaq1.tex \ + perlfaq2.tex \ + perlfaq3.tex \ + perlfaq4.tex \ + perlfaq5.tex \ + perlfaq6.tex \ + perlfaq7.tex \ + perlfaq8.tex \ + perlfaq9.tex \ + perltoc.tex + +man: pod2man $(MAN) + +html: pod2html $(HTML) + +tex: pod2latex $(TEX) + +toc: + $(PERL) -I..\lib buildtoc >perltoc.pod + +.SUFFIXES: .pm .pod + +.SUFFIXES: .man + +.pm.man: + $(PERL) -I..\lib pod2man $*.pm >$*.man + +.pod.man: + $(PERL) -I..\lib pod2man $*.pod >$*.man + +.SUFFIXES: .html + +.pm.html: + $(PERL) -I..\lib $(POD2HTML) --infile=$*.pm --outfile=$*.html + +.pod.html: + $(PERL) -I..\lib $(POD2HTML) --infile=$*.pod --outfile=$*.html + +.SUFFIXES: .tex + +.pm.tex: + $(PERL) -I..\lib pod2latex $*.pm + +.pod.tex: + $(PERL) -I..\lib pod2latex $*.pod + +clean: + del /f $(MAN) $(HTML) $(TEX) + del /f pod2html-*cache + del /f *.aux *.log + +realclean: clean + del /f $(CONVERTERS) + +distclean: realclean + +check: checkpods + @echo "checking..."; \ + $(PERL) -I..\lib checkpods $(POD) + +# Dependencies. +pod2latex: pod2latex.PL ..\lib\Config.pm + $(PERL) -I..\lib pod2latex.PL + $(PERL) $(PL2BAT) pod2latex + +pod2html: pod2html.PL ..\lib\Config.pm + $(PERL) -I..\lib pod2html.PL + $(PERL) $(PL2BAT) pod2html + +pod2man: pod2man.PL ..\lib\Config.pm + $(PERL) -I..\lib pod2man.PL + $(PERL) $(PL2BAT) pod2man + +pod2text: pod2text.PL ..\lib\Config.pm + $(PERL) -I..\lib pod2text.PL + $(PERL) $(PL2BAT) pod2text + +checkpods: checkpods.PL ..\lib\Config.pm + $(PERL) -I..\lib checkpods.PL + $(PERL) $(PL2BAT) checkpods + + diff --git a/win32/VC-2.0/vc2.patch b/win32/VC-2.0/vc2.patch deleted file mode 100644 index ea7031b3c8..0000000000 --- a/win32/VC-2.0/vc2.patch +++ /dev/null @@ -1,16 +0,0 @@ -You will need this patch to win32.c when compiling with VC++ ver. 2.0. - - -diff -ur /y/src/perl5.003_93/win32/win32.c perl5.003_93-w32/win32/win32.c ---- /y/src/perl5.003_93/win32/win32.c Fri Jan 31 21:38:10 1997 -+++ perl5.003_93-w32/win32/win32.c Tue Mar 11 01:51:08 1997 -@@ -41,7 +41,8 @@ - char szPerlLibRoot[MAX_PATH+1]; - HANDLE PerlDllHandle = INVALID_HANDLE_VALUE; - --#define IsWin95() (Win32System == VER_PLATFORM_WIN32_WINDOWS) -+/* #define IsWin95() (Win32System == VER_PLATFORM_WIN32_WINDOWS) */ -+#define IsWin95() (0) - #define IsWinNT() (Win32System == VER_PLATFORM_WIN32_NT) - - void * diff --git a/win32/bin/PL2BAT.BAT b/win32/bin/PL2BAT.BAT deleted file mode 100644 index 462affa7d0..0000000000 --- a/win32/bin/PL2BAT.BAT +++ /dev/null @@ -1,40 +0,0 @@ -@rem = ' -@echo off -perl -S %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9 -goto endofperl -@rem '; - -$head = <<'--end--'; -@rem = '--*-Perl-*--'; -@rem = ' -@echo off -perl -S %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9 -goto endofperl -@rem '; ---end-- - -$tail = "__END__\n:endofperl\n"; - -if ( @ARGV ) { - LOOP: - foreach ( @ARGV ) { - open( FILE, $_ ); - @file = <FILE>; - if ( grep( /:endofperl/, @file ) ) { - warn "$_ has already been converted to a batch file!!\n"; - next LOOP; - } - close( FILE, $_ ); - s/\.pl//; - s/\.bat//; - open( FILE, ">$_.bat" ); - print FILE $head, @file, $tail; - close( FILE ); - } -} else { - @file = <STDIN>; - print $head, @file, $tail; -} - -__END__ -:endofperl diff --git a/win32/bin/pl2bat.bat b/win32/bin/pl2bat.bat new file mode 100644 index 0000000000..7f5f39aa95 --- /dev/null +++ b/win32/bin/pl2bat.bat @@ -0,0 +1,54 @@ +@rem = '--*-Perl-*-- +@echo off +perl -x -S %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9 +goto endofperl +@rem '; +#!perl -w +#line 8 +(my $head = <<'--end--') =~ s/^\t//gm; + @rem = '--*-Perl-*-- + @echo off + perl -x -S %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9 + goto endofperl + @rem '; +--end-- +my $headlines = 2 + ($head =~ tr/\n/\n/); +my $tail = "__END__\n:endofperl\n"; + +@ARGV = ('-') unless @ARGV; + +process(@ARGV); + +sub process { + LOOP: + foreach ( @_ ) { + my $myhead = $head; + my $linedone = 0; + my $linenum = $headlines; + my $line; + open( FILE, $_ ) or die "Can't open $_: $!"; + @file = <FILE>; + foreach $line ( @file ) { + $linenum++; + if ( $line =~ /^:endofperl/) { + warn "$_ has already been converted to a batch file!\n"; + next LOOP; + } + if ( not $linedone and $line =~ /^#!.*perl/ ) { + $line .= "#line $linenum\n"; + $linedone++; + } + } + close( FILE ); + s/\.pl$//; + $_ .= '.bat' unless /\.bat$/ or /^-$/; + open( FILE, ">$_" ) or die "Can't open $_: $!"; + $myhead =~ s/perl -x/perl/ unless $linedone; + print FILE $myhead; + print FILE "#line $headlines\n" unless $linedone; + print FILE @file, $tail; + close( FILE ); + } +} +__END__ +:endofperl diff --git a/win32/bin/search.bat b/win32/bin/search.bat index 0bb123759f..88e83e5040 100644 --- a/win32/bin/search.bat +++ b/win32/bin/search.bat @@ -653,7 +653,7 @@ sub read_rc print "reading RC file: $file\n" if $show; - while ($_ = ($use_default ? shift(@default) : <RC>)) { + while (defined($_ = ($use_default ? shift(@default) : <RC>))) { $ln = ++$line_num; ## note starting line num. $_ .= <RC>, $line_num++ while s/\\\n?$/\n/; ## allow continuations next if /^\s*(#.*)?$/; ## skip blank or comment-only lines. diff --git a/win32/config.H b/win32/config.H index f71ddc8151..420afcccac 100644 --- a/win32/config.H +++ b/win32/config.H @@ -1241,7 +1241,7 @@ * This symbol, if defined, indicates to the C program that it should * include <utime.h>. */ -/*#define I_UTIME /**/ +#define I_UTIME /**/ /* I_STDARG: * This symbol, if defined, indicates that <stdarg.h> exists and should diff --git a/win32/config.w32 b/win32/config.w32 index 116762202e..e8a1c03af8 100644 --- a/win32/config.w32 +++ b/win32/config.w32 @@ -342,7 +342,7 @@ i_termio='undef' i_termios='undef' i_time='define' i_unistd='undef' -i_utime='undef' +i_utime='define' i_values='undef' i_varargs='undef' i_varhdr='varargs.h' diff --git a/win32/dosish.h b/win32/dosish.h deleted file mode 100644 index 8e423fa8fa..0000000000 --- a/win32/dosish.h +++ /dev/null @@ -1,89 +0,0 @@ -#define ABORT() abort(); - -#define SH_PATH "/bin/sh" - -#ifdef DJGPP -#define BIT_BUCKET "nul" -#define OP_BINARY O_BINARY -void Perl_DJGPP_init(); -#define PERL_SYS_INIT(argcp, argvp) STMT_START { \ - Perl_DJGPP_init(); } STMT_END -#else -#define PERL_SYS_INIT(c,v) -#define BIT_BUCKET "nul" -#endif - -#define PERL_SYS_TERM() -#define dXSUB_SYS int dummy -#define TMPPATH "plXXXXXX" - -/* - * 5.003_07 and earlier keyed on #ifdef MSDOS for determining if we were - * running on DOS, *and* if we had to cope with 16 bit memory addressing - * constraints, *and* we need to have memory allocated as unsigned long. - * - * with the advent of *real* compilers for DOS, they are not locked together. - * MSDOS means "I am running on MSDOS". HAS_64K_LIMIT means "I have - * 16 bit memory addressing constraints". - * - * if you need the last, try #DEFINE MEM_SIZE unsigned long. - */ -#ifdef MSDOS - #ifndef DJGPP - #define HAS_64K_LIMIT - #endif -#endif - -/* USEMYBINMODE - * This symbol, if defined, indicates that the program should - * use the routine my_binmode(FILE *fp, char iotype) to insure - * that a file is in "binary" mode -- that is, that no translation - * of bytes occurs on read or write operations. - */ -#undef USEMYBINMODE - -/* USE_STAT_RDEV: - * This symbol is defined if this system has a stat structure declaring - * st_rdev - */ -#define USE_STAT_RDEV /**/ - -/* ACME_MESS: - * This symbol, if defined, indicates that error messages should be - * should be generated in a format that allows the use of the Acme - * GUI/editor's autofind feature. - */ -#undef ACME_MESS /**/ - -/* ALTERNATE_SHEBANG: - * This symbol, if defined, contains a "magic" string which may be used - * as the first line of a Perl program designed to be executed directly - * by name, instead of the standard Unix #!. If ALTERNATE_SHEBANG - * begins with a character other then #, then Perl will only treat - * it as a command line if if finds the string "perl" in the first - * word; otherwise it's treated as the first line of code in the script. - * (IOW, Perl won't hand off to another interpreter via an alternate - * shebang sequence that might be legal Perl code.) - */ -/* #define ALTERNATE_SHEBANG "#!" / **/ - -/* - * fwrite1() should be a routine with the same calling sequence as fwrite(), - * but which outputs all of the bytes requested as a single stream (unlike - * fwrite() itself, which on some systems outputs several distinct records - * if the number_of_items parameter is >1). - */ -#define fwrite1 fwrite - -#define Stat(fname,bufptr) win32_stat((fname),(bufptr)) -#define Fstat(fd,bufptr) fstat((fd),(bufptr)) -#define Fflush(fp) fflush(fp) - -#define my_getenv(var) getenv(var) -/* - * the following are standard library calls (stdio in particular) - * that is being redirected to the perl DLL. This is needed for - * Dynaloading any modules that called stdio functions - */ - -#include <win32iop.h> diff --git a/win32/libperl.mak b/win32/libperl.mak index 3fe30ffa8d..f25b2c4a66 100644 --- a/win32/libperl.mak +++ b/win32/libperl.mak @@ -191,7 +191,7 @@ CLEAN : # 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 "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c CPP_PROJ=/nologo /MTd /W3 /Z7 /Od /I ".\include" /I ".." /I "." /D "WIN32"\ - /D "_DEBUG" /D "_WINDOWS" /Fp"$(INTDIR)/libperl.pch" /YX /Fo"$(INTDIR)/" /c +/D "PERLDLL" /D "_DEBUG" /D "_WINDOWS" /Fp"$(INTDIR)/libperl.pch" /YX /Fo"$(INTDIR)/" /c CPP_OBJS=.\Debug/ CPP_SBRS=.\. BSC32=bscmake.exe diff --git a/win32/makedef.pl b/win32/makedef.pl index dfd507a865..0d510aedcd 100644 --- a/win32/makedef.pl +++ b/win32/makedef.pl @@ -208,12 +208,6 @@ perl_call_pv perl_call_method perl_call_sv perl_requirepv -win32_inet_addr -win32_gethostbyname -win32_inet_ntoa -win32_htons -win32_ntohs -win32_htonl win32_stat win32_errno win32_stderr @@ -258,3 +252,48 @@ win32_read win32_write win32_spawnvpe win32_spawnle +win32_mkdir +win32_rmdir +win32_chdir +win32_htons +win32_ntohs +win32_htonl +win32_ntohl +win32_inet_addr +win32_inet_ntoa +win32_socket +win32_bind +win32_listen +win32_accept +win32_connect +win32_send +win32_sendto +win32_recv +win32_recvfrom +win32_shutdown +win32_ioctlsocket +win32_setsockopt +win32_getsockopt +win32_getpeername +win32_getsockname +win32_gethostname +win32_gethostbyname +win32_gethostbyaddr +win32_getprotobyname +win32_getprotobynumber +win32_getservbyname +win32_getservbyport +win32_select +win32_endhostent +win32_endnetent +win32_endprotoent +win32_endservent +win32_getnetent +win32_getnetbyname +win32_getnetbyaddr +win32_getprotoent +win32_getservent +win32_sethostent +win32_setnetent +win32_setprotoent +win32_setservent diff --git a/win32/miniperl.mak b/win32/miniperl.mak index 9e6e2a4a15..55fcb5a8af 100644 --- a/win32/miniperl.mak +++ b/win32/miniperl.mak @@ -293,7 +293,7 @@ DEP_CPP_WIN32=\ ".\..\unixish.h"\ ".\..\util.h"\ ".\config.h"\ - ".\EXTERN.h"\ + ".\..\EXTERN.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ ".\include\sys/socket.h"\ @@ -343,7 +343,7 @@ DEP_CPP_WIN32S=\ ".\..\unixish.h"\ ".\..\util.h"\ ".\config.h"\ - ".\EXTERN.h"\ + ".\..\EXTERN.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ ".\include\sys/socket.h"\ diff --git a/win32/modules.mak b/win32/modules.mak index 8c0a546ec2..81812ebdc9 100644 --- a/win32/modules.mak +++ b/win32/modules.mak @@ -59,9 +59,9 @@ CLEAN : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" # ADD BASE CPP /nologo /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c -# ADD CPP /nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "MSDOS" /YX /c +# ADD CPP /nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "PERLDLL" /YX /c CPP_PROJ=/nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "NDEBUG" /D\ - "WIN32" /D "_WINDOWS" /D "MSDOS" /Fp"$(INTDIR)/modules.pch" /YX /Fo"$(INTDIR)/"\ + "WIN32" /D "_WINDOWS" /D "PERLDLL" /Fp"$(INTDIR)/modules.pch" /YX /Fo"$(INTDIR)/"\ /c CPP_OBJS=.\Release/ CPP_SBRS=.\. @@ -108,9 +108,9 @@ CLEAN : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" # ADD BASE CPP /nologo /W3 /Z7 /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c -# ADD CPP /nologo /MTd /W3 /Z7 /Od /I ".\include" /I "." /I ".." /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "MSDOS" /YX /c +# ADD CPP /nologo /MTd /W3 /Z7 /Od /I ".\include" /I "." /I ".." /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "PERLDLL" /YX /c CPP_PROJ=/nologo /MTd /W3 /Z7 /Od /I ".\include" /I "." /I ".." /D "_DEBUG"\ - /D "WIN32" /D "_WINDOWS" /D "MSDOS" /Fp"$(INTDIR)/modules.pch" /YX\ + /D "WIN32" /D "_WINDOWS" /D "PERLDLL" /Fp"$(INTDIR)/modules.pch" /YX\ /Fo"$(INTDIR)/" /c CPP_OBJS=.\Debug/ CPP_SBRS=.\. @@ -201,7 +201,7 @@ DEP_CPP_DYNAL=\ "..\XSUB.h"\ ".\..\ext\DynaLoader\dlutils.c"\ ".\config.h"\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ ".\include\sys/socket.h"\ @@ -250,7 +250,7 @@ DEP_CPP_DYNAL=\ "..\XSUB.h"\ ".\..\ext\DynaLoader\dlutils.c"\ ".\config.h"\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ ".\include\sys/socket.h"\ @@ -308,7 +308,7 @@ DEP_CPP_FCNTL=\ "..\util.h"\ "..\XSUB.h"\ ".\config.h"\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ ".\include\sys/socket.h"\ @@ -356,7 +356,7 @@ DEP_CPP_FCNTL=\ "..\util.h"\ "..\XSUB.h"\ ".\config.h"\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ ".\include\sys/socket.h"\ @@ -414,7 +414,7 @@ DEP_CPP_IO_C4=\ "..\util.h"\ "..\XSUB.h"\ ".\config.h"\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ ".\include\sys/socket.h"\ @@ -462,7 +462,7 @@ DEP_CPP_IO_C4=\ "..\util.h"\ "..\XSUB.h"\ ".\config.h"\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ ".\include\sys/socket.h"\ @@ -520,7 +520,7 @@ DEP_CPP_OPCOD=\ "..\util.h"\ "..\XSUB.h"\ ".\config.h"\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ ".\include\sys/socket.h"\ @@ -568,7 +568,7 @@ DEP_CPP_OPCOD=\ "..\util.h"\ "..\XSUB.h"\ ".\config.h"\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ ".\include\sys/socket.h"\ @@ -624,7 +624,7 @@ DEP_CPP_SDBM_=\ "..\XSUB.h"\ ".\..\ext\SDBM_File\sdbm\sdbm.h"\ ".\config.h"\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ ".\include\sys/socket.h"\ @@ -675,7 +675,7 @@ DEP_CPP_SOCKE=\ "..\util.h"\ "..\XSUB.h"\ ".\config.h"\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\include\arpa/inet.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ diff --git a/win32/perl.mak b/win32/perl.mak index 558717c97d..55c2689397 100644 --- a/win32/perl.mak +++ b/win32/perl.mak @@ -1,4 +1,4 @@ -# Microsoft Developer Studio Generated NMAKE File, Format Version 4.20 +# Microsoft Developer Studio Generated NMAKE File, Format Version 4.00 # ** DO NOT EDIT ** # TARGTYPE "Win32 (x86) Console Application" 0x0103 @@ -49,12 +49,13 @@ RSC=rc.exe OUTDIR=.\Release INTDIR=.\Release -ALL : "..\_perl.exe" +ALL : "$(OUTDIR)\_perl.exe" CLEAN : - -@erase "$(INTDIR)\perlmain.obj" - -@erase "$(INTDIR)\win32io.obj" -@erase "..\_perl.exe" + -@erase ".\Release\perlmain.obj" + -@erase ".\Release\win32io.obj" + -@erase ".\Release\perl.res" "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" @@ -64,15 +65,15 @@ CLEAN : CPP_PROJ=/nologo /MT /W3 /O2 /I "." /I ".\include" /I ".." /D "WIN32" /D\ "NDEBUG" /D "_CONSOLE" /Fp"$(INTDIR)/perl.pch" /YX /Fo"$(INTDIR)/" /c CPP_OBJS=.\Release/ -CPP_SBRS=.\. +CPP_SBRS= # ADD BASE RSC /l 0x409 /d "NDEBUG" # ADD RSC /l 0x409 /d "NDEBUG" +RSC_PROJ=/l 0x409 /fo"$(INTDIR)/perl.res" /d "NDEBUG" BSC32=bscmake.exe # ADD BASE BSC32 /nologo # ADD BSC32 /nologo BSC32_FLAGS=/nologo /o"$(OUTDIR)/perl.bsc" -BSC32_SBRS= \ - +BSC32_SBRS= LINK32=link.exe # ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:console /machine:I386 # ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib setargv.obj /nologo /subsystem:console /machine:I386 /out:"../_perl.exe" @@ -81,11 +82,11 @@ LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ /subsystem:console /incremental:no /pdb:"$(OUTDIR)/_perl.pdb" /machine:I386\ /out:"../_perl.exe" LINK32_OBJS= \ - "$(INTDIR)\perlmain.obj" \ - "$(INTDIR)\win32io.obj" \ + "$(INTDIR)/perlmain.obj" \ + "$(INTDIR)/win32io.obj" \ "..\perl.lib" -"..\_perl.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) +"$(OUTDIR)\_perl.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) $(LINK32) @<< $(LINK32_FLAGS) $(LINK32_OBJS) << @@ -105,35 +106,33 @@ LINK32_OBJS= \ OUTDIR=.\Debug INTDIR=.\Debug -ALL : "..\_perl.exe" +ALL : "$(OUTDIR)\_perl.exe" CLEAN : - -@erase "$(INTDIR)\perlmain.obj" - -@erase "$(INTDIR)\vc40.idb" - -@erase "$(INTDIR)\vc40.pdb" - -@erase "$(INTDIR)\win32io.obj" - -@erase "$(OUTDIR)\_perl.pdb" -@erase "..\_perl.exe" + -@erase ".\Debug\perlmain.obj" + -@erase ".\Debug\win32io.obj" + -@erase ".\Debug\perl.res" -@erase "..\_perl.ilk" + -@erase ".\Debug\_perl.pdb" "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" # ADD BASE CPP /nologo /W3 /Gm /Zi /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /YX /c -# ADD CPP /nologo /MTd /W3 /Gm /Zi /Od /I "." /I ".\include" /I ".." /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /YX /c -CPP_PROJ=/nologo /MTd /W3 /Gm /Zi /Od /I "." /I ".\include" /I ".." /D\ - "WIN32" /D "_DEBUG" /D "_CONSOLE" /Fp"$(INTDIR)/perl.pch" /YX /Fo"$(INTDIR)/"\ - /Fd"$(INTDIR)/" /c +# ADD CPP /nologo /MTd /W3 /Z7 /Od /I "." /I ".\include" /I ".." /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /YX /c +CPP_PROJ=/nologo /MTd /W3 /Z7 /Od /I "." /I ".\include" /I ".." /D "WIN32" /D\ + "_DEBUG" /D "_CONSOLE" /Fp"$(INTDIR)/perl.pch" /YX /Fo"$(INTDIR)/" /c CPP_OBJS=.\Debug/ -CPP_SBRS=.\. +CPP_SBRS= # ADD BASE RSC /l 0x409 /d "_DEBUG" # ADD RSC /l 0x409 /d "_DEBUG" +RSC_PROJ=/l 0x409 /fo"$(INTDIR)/perl.res" /d "_DEBUG" BSC32=bscmake.exe # ADD BASE BSC32 /nologo # ADD BSC32 /nologo BSC32_FLAGS=/nologo /o"$(OUTDIR)/perl.bsc" -BSC32_SBRS= \ - +BSC32_SBRS= LINK32=link.exe # ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:console /debug /machine:I386 # ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib setargv.obj /nologo /subsystem:console /debug /machine:I386 /out:"../_perl.exe" @@ -142,11 +141,11 @@ LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ /subsystem:console /incremental:yes /pdb:"$(OUTDIR)/_perl.pdb" /debug\ /machine:I386 /out:"../_perl.exe" LINK32_OBJS= \ - "$(INTDIR)\perlmain.obj" \ - "$(INTDIR)\win32io.obj" \ + "$(INTDIR)/perlmain.obj" \ + "$(INTDIR)/win32io.obj" \ "..\perl.lib" -"..\_perl.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) +"$(OUTDIR)\_perl.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) $(LINK32) @<< $(LINK32_FLAGS) $(LINK32_OBJS) << @@ -191,9 +190,20 @@ DEP_CPP_PERLM=\ ".\win32io.h"\ +!IF "$(CFG)" == "perl - Win32 Release" + + "$(INTDIR)\perlmain.obj" : $(SOURCE) $(DEP_CPP_PERLM) "$(INTDIR)" +!ELSEIF "$(CFG)" == "perl - Win32 Debug" + + +"$(INTDIR)\perlmain.obj" : $(SOURCE) $(DEP_CPP_PERLM) "$(INTDIR)" + + +!ENDIF + # End Source File ################################################################################ # Begin Source File @@ -215,8 +225,8 @@ DEP_CPP_WIN32=\ ".\include\sys/socket.h"\ ".\win32io.h"\ ".\win32iop.h"\ - {$(INCLUDE)}"\Sys\Stat.h"\ - {$(INCLUDE)}"\Sys\Types.h"\ + {$(INCLUDE)}"\sys\STAT.H"\ + {$(INCLUDE)}"\sys\TYPES.H"\ "$(INTDIR)\win32io.obj" : $(SOURCE) $(DEP_CPP_WIN32) "$(INTDIR)" diff --git a/win32/perl.rc b/win32/perl.rc new file mode 100644 index 0000000000..15eae7843f --- /dev/null +++ b/win32/perl.rc @@ -0,0 +1,76 @@ +//Microsoft Developer Studio generated resource script. +// +#include "resource.h" + +#define APSTUDIO_READONLY_SYMBOLS +///////////////////////////////////////////////////////////////////////////// +// +// Generated from the TEXTINCLUDE 2 resource. +// +#include "afxres.h" + +///////////////////////////////////////////////////////////////////////////// +#undef APSTUDIO_READONLY_SYMBOLS + +///////////////////////////////////////////////////////////////////////////// +// English (U.S.) resources + +#if !defined(AFX_RESOURCE_DLL) || defined(AFX_TARG_ENU) +#ifdef _WIN32 +LANGUAGE LANG_ENGLISH, SUBLANG_ENGLISH_US +#pragma code_page(1252) +#endif //_WIN32 + +///////////////////////////////////////////////////////////////////////////// +// +// Icon +// + +// Icon with lowest ID value placed first to ensure application icon +// remains consistent on all systems. + +// you must obtain the icon for yourself, it's not in the dist +#if 0 +camel ICON DISCARDABLE "camel.ico" +#endif + +#ifdef APSTUDIO_INVOKED +///////////////////////////////////////////////////////////////////////////// +// +// TEXTINCLUDE +// + +1 TEXTINCLUDE DISCARDABLE +BEGIN + "resource.h\0" +END + +2 TEXTINCLUDE DISCARDABLE +BEGIN + "#include ""afxres.h""\r\n" + "\0" +END + +3 TEXTINCLUDE DISCARDABLE +BEGIN + "\r\n" + "\0" +END + +#endif // APSTUDIO_INVOKED + +#endif // English (U.S.) resources +///////////////////////////////////////////////////////////////////////////// + + + +#ifndef APSTUDIO_INVOKED +///////////////////////////////////////////////////////////////////////////// +// +// Generated from the TEXTINCLUDE 3 resource. +// + + +///////////////////////////////////////////////////////////////////////////// +#endif // not APSTUDIO_INVOKED + diff --git a/win32/perldll.mak b/win32/perldll.mak index eb308771a3..6d63c46c8b 100644 --- a/win32/perldll.mak +++ b/win32/perldll.mak @@ -123,10 +123,10 @@ LINK32_OBJS= \ # PROP Output_Dir "debug" # PROP Intermediate_Dir "debug" # PROP Target_Dir "" -OUTDIR=.\debug +OUTDIR=.\.. INTDIR=.\debug -ALL : "..\perl.dll" +ALL : "$(OUTDIR)\perl.dll" CLEAN : -@erase "$(INTDIR)\perllib.obj" @@ -182,7 +182,7 @@ LINK32_OBJS= \ "..\libperl.lib" \ ".\modules.lib" -"..\perl.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) +"$(OUTDIR)\perl.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) $(LINK32) @<< $(LINK32_FLAGS) $(LINK32_OBJS) << @@ -251,7 +251,7 @@ DEP_CPP_PERLL=\ "..\unixish.h"\ "..\util.h"\ ".\config.h"\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ ".\include\sys/socket.h"\ @@ -326,7 +326,7 @@ DEP_CPP_WIN32=\ "..\unixish.h"\ "..\util.h"\ ".\config.h"\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ ".\include\sys/socket.h"\ @@ -360,7 +360,7 @@ DEP_CPP_WIN32_=\ "..\perlsdio.h"\ "..\perlsfio.h"\ ".\config.h"\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ ".\include\dirent.h"\ ".\include\netdb.h"\ ".\include\sys/socket.h"\ @@ -376,7 +376,7 @@ DEP_CPP_WIN32_=\ DEP_CPP_WIN32_=\ "..\perl.h"\ - ".\EXTERN.h"\ + "..\EXTERN.h"\ {$(INCLUDE)}"\sys\stat.h"\ {$(INCLUDE)}"\sys\types.h"\ diff --git a/win32/perlmain.c b/win32/perlmain.c deleted file mode 100644 index 507b3831f5..0000000000 --- a/win32/perlmain.c +++ /dev/null @@ -1,10 +0,0 @@ -#include <stdio.h> -#include <win32io.h> - -extern WIN32_IOSUBSYSTEM win32stdio; -extern int RunPerl(int argc, char **argv, char **env, void *iosubsystem); - -main(int argc, char **argv, char **env) -{ - return (RunPerl(argc, argv, env, &win32stdio)); -} diff --git a/win32/pod.mak b/win32/pod.mak new file mode 100644 index 0000000000..538cfa3737 --- /dev/null +++ b/win32/pod.mak @@ -0,0 +1,272 @@ +CONVERTERS = pod2html pod2latex pod2man pod2text checkpods + +HTMLROOT = / # Change this to fix cross-references in HTML +POD2HTML = pod2html \ + --htmlroot=$(HTMLROOT) \ + --podroot=.. --podpath=pod:lib:ext:vms \ + --libpods=perlfunc:perlguts:perlvar:perlrun:perlop + +all: $(CONVERTERS) html + +PERL = ..\miniperl.exe +PL2BAT = ..\win32\bin\pl2bat.bat + +POD = \ + perl.pod \ + perldelta.pod \ + perldata.pod \ + perlsyn.pod \ + perlop.pod \ + perlre.pod \ + perlrun.pod \ + perlfunc.pod \ + perlvar.pod \ + perlsub.pod \ + perlmod.pod \ + perlform.pod \ + perllocale.pod \ + perlref.pod \ + perldsc.pod \ + perllol.pod \ + perltoot.pod \ + perlobj.pod \ + perltie.pod \ + perlbot.pod \ + perlipc.pod \ + perldebug.pod \ + perldiag.pod \ + perlsec.pod \ + perltrap.pod \ + perlstyle.pod \ + perlpod.pod \ + perlbook.pod \ + perlembed.pod \ + perlapio.pod \ + perlxs.pod \ + perlxstut.pod \ + perlguts.pod \ + perlcall.pod \ + perlfaq.pod \ + perlfaq1.pod \ + perlfaq2.pod \ + perlfaq3.pod \ + perlfaq4.pod \ + perlfaq5.pod \ + perlfaq6.pod \ + perlfaq7.pod \ + perlfaq8.pod \ + perlfaq9.pod \ + perltoc.pod + +MAN = \ + perl.man \ + perldelta.man \ + perldata.man \ + perlsyn.man \ + perlop.man \ + perlre.man \ + perlrun.man \ + perlfunc.man \ + perlvar.man \ + perlsub.man \ + perlmod.man \ + perlform.man \ + perllocale.man \ + perlref.man \ + perldsc.man \ + perllol.man \ + perltoot.man \ + perlobj.man \ + perltie.man \ + perlbot.man \ + perlipc.man \ + perldebug.man \ + perldiag.man \ + perlsec.man \ + perltrap.man \ + perlstyle.man \ + perlpod.man \ + perlbook.man \ + perlembed.man \ + perlapio.man \ + perlxs.man \ + perlxstut.man \ + perlguts.man \ + perlcall.man \ + perlfaq.man \ + perlfaq1.man \ + perlfaq2.man \ + perlfaq3.man \ + perlfaq4.man \ + perlfaq5.man \ + perlfaq6.man \ + perlfaq7.man \ + perlfaq8.man \ + perlfaq9.man \ + perltoc.man + +HTML = \ + perl.html \ + perldelta.html \ + perldata.html \ + perlsyn.html \ + perlop.html \ + perlre.html \ + perlrun.html \ + perlfunc.html \ + perlvar.html \ + perlsub.html \ + perlmod.html \ + perlform.html \ + perllocale.html \ + perlref.html \ + perldsc.html \ + perllol.html \ + perltoot.html \ + perlobj.html \ + perltie.html \ + perlbot.html \ + perlipc.html \ + perldebug.html \ + perldiag.html \ + perlsec.html \ + perltrap.html \ + perlstyle.html \ + perlpod.html \ + perlbook.html \ + perlembed.html \ + perlapio.html \ + perlxs.html \ + perlxstut.html \ + perlguts.html \ + perlcall.html \ + perlfaq.html \ + perlfaq1.html \ + perlfaq2.html \ + perlfaq3.html \ + perlfaq4.html \ + perlfaq5.html \ + perlfaq6.html \ + perlfaq7.html \ + perlfaq8.html \ + perlfaq9.html +# not perltoc.html + +TEX = \ + perl.tex \ + perldelta.tex \ + perldata.tex \ + perlsyn.tex \ + perlop.tex \ + perlre.tex \ + perlrun.tex \ + perlfunc.tex \ + perlvar.tex \ + perlsub.tex \ + perlmod.tex \ + perlform.tex \ + perllocale.tex \ + perlref.tex \ + perldsc.tex \ + perllol.tex \ + perltoot.tex \ + perlobj.tex \ + perltie.tex \ + perlbot.tex \ + perlipc.tex \ + perldebug.tex \ + perldiag.tex \ + perlsec.tex \ + perltrap.tex \ + perlstyle.tex \ + perlpod.tex \ + perlbook.tex \ + perlembed.tex \ + perlapio.tex \ + perlxs.tex \ + perlxstut.tex \ + perlguts.tex \ + perlcall.tex \ + perlfaq.tex \ + perlfaq1.tex \ + perlfaq2.tex \ + perlfaq3.tex \ + perlfaq4.tex \ + perlfaq5.tex \ + perlfaq6.tex \ + perlfaq7.tex \ + perlfaq8.tex \ + perlfaq9.tex \ + perltoc.tex + +man: pod2man $(MAN) + +html: pod2html $(HTML) + +tex: pod2latex $(TEX) + +toc: + $(PERL) -I..\lib buildtoc >perltoc.pod + +.SUFFIXES: .pm .pod + +.SUFFIXES: .man + +.pm.man: + $(PERL) -I..\lib pod2man $*.pm >$*.man + +.pod.man: + $(PERL) -I..\lib pod2man $*.pod >$*.man + +.SUFFIXES: .html + +.pm.html: + $(PERL) -I..\lib $(POD2HTML) --infile=$*.pm --outfile=$*.html + +.pod.html: + $(PERL) -I..\lib $(POD2HTML) --infile=$*.pod --outfile=$*.html + +.SUFFIXES: .tex + +.pm.tex: + $(PERL) -I..\lib pod2latex $*.pm + +.pod.tex: + $(PERL) -I..\lib pod2latex $*.pod + +clean: + del /f $(MAN) $(HTML) $(TEX) + del /f pod2html-*cache + del /f *.aux *.log + +realclean: clean + del /f $(CONVERTERS) + +distclean: realclean + +check: checkpods + @echo "checking..."; \ + $(PERL) -I..\lib checkpods $(POD) + +# Dependencies. +pod2latex: pod2latex.PL ..\lib\Config.pm + $(PERL) -I..\lib pod2latex.PL + $(PERL) $(PL2BAT) pod2latex + +pod2html: pod2html.PL ..\lib\Config.pm + $(PERL) -I..\lib pod2html.PL + $(PERL) $(PL2BAT) pod2html + +pod2man: pod2man.PL ..\lib\Config.pm + $(PERL) -I..\lib pod2man.PL + $(PERL) $(PL2BAT) pod2man + +pod2text: pod2text.PL ..\lib\Config.pm + $(PERL) -I..\lib pod2text.PL + $(PERL) $(PL2BAT) pod2text + +checkpods: checkpods.PL ..\lib\Config.pm + $(PERL) -I..\lib checkpods.PL + $(PERL) $(PL2BAT) checkpods + + diff --git a/win32/win32.c b/win32/win32.c index 2e025ce152..7bb003d169 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -41,8 +41,15 @@ char szShellPath[MAX_PATH+1]; char szPerlLibRoot[MAX_PATH+1]; HANDLE PerlDllHandle = INVALID_HANDLE_VALUE; -#define IsWin95() (Win32System == VER_PLATFORM_WIN32_WINDOWS) -#define IsWinNT() (Win32System == VER_PLATFORM_WIN32_NT) +int +IsWin95(void) { + return (Win32System == VER_PLATFORM_WIN32_WINDOWS); +} + +int +IsWinNT(void) { + return (Win32System == VER_PLATFORM_WIN32_NT); +} void * SetIOSubSystem(void *p) @@ -338,18 +345,19 @@ do_aspawn(void* really, void** mark, void** arglast) SV *sv = (SV*)really; SV** pSv = (SV**)mark; - New(1110, argv, (arglast - mark) + 3, char*); + New(1110, argv, (arglast - mark) + 4, char*); if(sv != Nullsv) { cmd = SvPV(sv, length); } else { - cmd = GetShell(); + argv[index++] = cmd = GetShell(); + argv[index++] = "/x"; /* always enable command extensions */ argv[index++] = "/c"; } - while(pSv <= (SV**)arglast) { - sv = *pSv++; + while(++pSv <= (SV**)arglast) { + sv = *pSv; strPtr = SvPV(sv, length); if(strPtr != NULL && *strPtr != '\0') argv[index++] = strPtr; @@ -361,8 +369,12 @@ do_aspawn(void* really, void** mark, void** arglast) Safefree(argv); - /* set statusvalue the perl variable $? */ - return (statusvalue = status*256); + if (status < 0) { + if (dowarn) + warn("Can't spawn \"%s\": %s", cmd, strerror(errno)); + status = 255 << 8; + } + return (status); } int @@ -410,11 +422,16 @@ do_spawn(char *cmd) status = win32_spawnle(P_WAIT, shell, shell, + "/x", "/c", cmd, (char*)0, environ); } - - /* set statusvalue the perl variable $? */ - return (statusvalue = status*256); + if (status < 0) { + if (dowarn) + warn("Can't spawn \"%s\": %s", needToTry ? shell : argv[0], + strerror(errno)); + status = 255 << 8; + } + return (status); } @@ -1025,6 +1042,21 @@ win32_write(int fd, const char *buf, unsigned int cnt) } DllExport int +win32_mkdir(const char *dir, int mode) +{ + return pIOSubSystem->pfnmkdir(dir); /* just ignore mode */ +} +DllExport int +win32_rmdir(const char *dir) +{ + return pIOSubSystem->pfnrmdir(dir); +} +DllExport int +win32_chdir(const char *dir) +{ + return pIOSubSystem->pfnchdir(dir); +} +DllExport int win32_spawnvpe(int mode, const char *cmdname, const char *const *argv, const char *const *envp) { @@ -1039,8 +1071,9 @@ win32_spawnle(int mode, const char *cmdname, const char *arglist,...) argp = &arglist; while (*argp++) ; + envp = (const char* const*)*argp; - return pIOSubSystem->pfnspawnvpe(mode, cmdname, &arglist, argp); + return pIOSubSystem->pfnspawnvpe(mode, cmdname, &arglist, envp); } int diff --git a/win32/win32.h b/win32/win32.h index 0a18645d9c..31dfde05f2 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -52,15 +52,6 @@ extern FILE *myfdopen(int, char *); #define OP_BINARY _O_BINARY /* Mistake in in pp_sys.c. */ -#undef mkdir -#define mkdir(nm, md) _mkdir(nm) /* For UNIX compatibility. */ - -#undef chdir -#define chdir(nm) _chdir(nm) - -#undef rmdir -#define rmdir(nm) _rmdir(nm) - #undef pipe #define pipe(fd) win32_pipe((fd), 512, _O_BINARY) /* the pipe call is a bit different */ @@ -105,4 +96,11 @@ typedef char * caddr_t; /* In malloc.c (core address). */ #pragma warning(disable: 4018 4035 4101 4102 4244 4245 4761) +int IsWin95(void); +int IsWinNT(void); + +#ifndef VER_PLATFORM_WIN32_WINDOWS /* VC-2.0 headers dont have this */ +#define VER_PLATFORM_WIN32_WINDOWS 1 +#endif + #endif /* _INC_WIN32_PERL5 */ diff --git a/win32/win32aux.c b/win32/win32aux.c index 526b6999c9..1af2c7abd2 100644 --- a/win32/win32aux.c +++ b/win32/win32aux.c @@ -16,6 +16,7 @@ extern "C" { #include <assert.h> #include <errno.h> +#include "win32.h" #include "win32iop.h" struct servent* @@ -24,7 +25,7 @@ win32_savecopyservent(struct servent*d, struct servent*s, const char *proto) d->s_name = s->s_name; d->s_aliases = s->s_aliases; d->s_port = s->s_port; - if (s->s_proto && strlen(s->s_proto)) + if (!IsWin95() && s->s_proto && strlen(s->s_proto)) d->s_proto = s->s_proto; else if (proto && strlen(proto)) d->s_proto = (char *)proto; diff --git a/win32/win32io.c b/win32/win32io.c index 75832240c7..b4f58242cf 100644 --- a/win32/win32io.c +++ b/win32/win32io.c @@ -16,7 +16,7 @@ extern "C" { #include <assert.h> #include <errno.h> #include <process.h> - +#include <direct.h> #include "win32iop.h" /* @@ -178,6 +178,9 @@ my_get_osfhandle( int filehandle ) return _get_osfhandle(filehandle); } +#ifdef PERLDLL +__declspec(dllexport) +#endif WIN32_IOSUBSYSTEM win32stdio = { 12345678L, /* begin of structure; */ dummy_errno, /* (*pfunc_errno)(void); */ @@ -228,6 +231,9 @@ WIN32_IOSUBSYSTEM win32stdio = { my_open_osfhandle, my_get_osfhandle, spawnvpe, + _mkdir, + _rmdir, + _chdir, 87654321L, /* end of structure */ }; diff --git a/win32/win32io.h b/win32/win32io.h index 3ebc70aab5..f73eea1322 100644 --- a/win32/win32io.h +++ b/win32/win32io.h @@ -51,6 +51,9 @@ int (*pfnopenmode)(int mode); int (*pfn_open_osfhandle)(long handle, int flags); long (*pfn_get_osfhandle)(int fd); int (*pfnspawnvpe)(int mode, const char *cmdname, const char *const *argv, const char *const *envp); +int (*pfnmkdir)(const char *path); +int (*pfnrmdir)(const char *path); +int (*pfnchdir)(const char *path); int signature_end; } WIN32_IOSUBSYSTEM; diff --git a/win32/win32iop.h b/win32/win32iop.h index c0d1d57255..d699e03ab6 100644 --- a/win32/win32iop.h +++ b/win32/win32iop.h @@ -58,6 +58,9 @@ EXT int win32_write(int fd, const void *buf, unsigned int cnt); EXT int win32_spawnvpe(int mode, const char *cmdname, const char *const *argv, const char *const *envp); EXT int win32_spawnle(int mode, const char *cmdname, const char *,...); +EXT int win32_mkdir(const char *dir, int mode); +EXT int win32_rmdir(const char *dir); +EXT int win32_chdir(const char *dir); /* * these two are win32 specific but still io related @@ -129,6 +132,9 @@ void * SetIOSubSystem(void *piosubsystem); #define _get_osfhandle stolen_get_osfhandle #define spawnvpe win32_spawnvpe #define spawnle win32_spawnle +#define mkdir win32_mkdir +#define rmdir win32_rmdir +#define chdir win32_chdir #endif /* WIN32IO_IS_STDIO */ #endif /* WIN32IOP_H */ diff --git a/writemain.SH b/writemain.SH index f07c682faf..c428383085 100755 --- a/writemain.SH +++ b/writemain.SH @@ -70,11 +70,12 @@ cat << 'EOP' static void xs_init() { - dXSUB_SYS; EOP if test X"$args" != "X" ; then echo " char *file = __FILE__;" + echo " dXSUB_SYS;" + ai='' for ext in $args ; do |
