diff options
| author | Perl 5 Porters <perl5-porters@africa.nicoh.com> | 1996-12-19 16:44:00 +1200 |
|---|---|---|
| committer | Chip Salzenberg <chip@atlantic.net> | 1996-12-19 16:44:00 +1200 |
| commit | 5f05dabc4054964aa3b10f44f8468547f051cdf8 (patch) | |
| tree | 7bcc2c7b6d5cf44e7f0111bac2240ca979d9c804 | |
| parent | 6a3992aa749356d657a4c0e14be8c2f4c2f4f999 (diff) | |
| download | perl-5f05dabc4054964aa3b10f44f8468547f051cdf8.tar.gz | |
[inseparable changes from patch from perl5.003_11 to perl5.003_12]
CORE LANGUAGE CHANGES
Subject: Support C<delete @hash{@keys}>
From: Chip Salzenberg <chip@atlantic.net>
Files: op.c op.h opcode.pl pod/perldiag.pod pod/perlfunc.pod pp.c t/op/delete.t
Subject: Autovivify scalars
From: Chip Salzenberg <chip@atlantic.net>
Files: dump.c op.c op.h pp.c pp_hot.c
DOCUMENTATION
Subject: Update pods: perldelta -> perlnews, perli18n -> perllocale
From: Tom Christiansen <tchrist@perl.com>
Files: MANIFEST pod/perl.pod pod/perldelta.pod pod/perli18n.pod pod/perlnews.pod
Subject: perltoot.pod
Date: Mon, 09 Dec 1996 07:44:10 -0700
From: Tom Christiansen <tchrist@mox.perl.com>
Files: MANIFEST pod/perltoot.pod
Msg-ID: <199612091444.HAA09947@toy.perl.com>
(applied based on p5p patch as commit 32e22efaa9ec59b73a208b6c532a0b435e2c6462)
Subject: Perlguts, version 25
Date: Fri, 6 Dec 96 11:40:27 PST
From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com>
Files: pod/perlguts.pod
private-msgid: <199612061940.AA055461228@hpcc123.corp.hp.com>
Subject: pod patches for English errors
Date: Mon, 09 Dec 1996 13:33:11 -0800
From: Steve Kelem <steve.kelem@xilinx.com>
Files: pod/*.pod
Msg-ID: <24616.850167191@castor>
(applied based on p5p patch as commit 0135f10892ed8a21c4dbd1fca21fbcc365df99dd)
Subject: Misc doc updates
Date: Sat, 14 Dec 1996 18:56:33 -0700
From: Tom Christiansen <tchrist@mox.perl.com>
Files: pod/*
Subject: Re: perldelta.pod
Here are some diffs to the _11 pods. I forgot to add perldelta to
perl.pod though.
And *PLEASE* fix the Artistic License so it no longer has the bogus
"whomever" misdeclined in the nominative case:
under the copyright of this Package, but belong to whomever generated
them, and may be sold commercially, and may be aggregated with this
It should obviously be "whoever".
p5p-msgid: <199612150156.SAA12506@mox.perl.com>
OTHER CORE CHANGES
Subject: Allow assignment to empty array values during foreach()
From: Chip Salzenberg <chip@atlantic.net>
Files: cop.h global.sym mg.c op.c perl.h pp_hot.c proto.h sv.c
Subject: Fix nested closures
From: Chip Salzenberg <chip@atlantic.net>
Files: op.c opcode.pl pp.c pp_ctl.c pp_hot.c
Subject: Fix core dump on auto-vivification
From: Chip Salzenberg <chip@atlantic.net>
Files: pp_hot.c
Subject: Fix core dump on C<open $undef_var, "X">
From: Chip Salzenberg <chip@atlantic.net>
Files: pp_sys.c
Subject: Fix -T/-B on globs and globrefs
From: Chip Salzenberg <chip@atlantic.net>
Files: pp_sys.c
Subject: Fix memory management of $`, $&, and $'
From: Chip Salzenberg <chip@atlantic.net>
Files: pp_hot.c regexec.c
Subject: Fix paren matching during backtracking
From: Chip Salzenberg <chip@atlantic.net>
Files: regexec.c
Subject: Fix memory leak and std{in,out,err} death in perl_{con,de}str
From: Chip Salzenberg <chip@atlantic.net>
Files: miniperlmain.c perl.c perl.h sv.c
Subject: Discard garbage bytes at end of prototype()
From: Chip Salzenberg <chip@atlantic.net>
Files: pp.c
Subject: Fix local($pack::{foo})
From: Chip Salzenberg <chip@atlantic.net>
Files: global.sym pp.c pp_hot.c proto.h scope.c
Subject: Disable warn, die, and parse hooks _before_ global destruction
From: Chip Salzenberg <chip@atlantic.net>
Files: perl.c
Subject: Re: Bug in formline
Date: Sun, 08 Dec 1996 14:58:32 -0500
From: Gurusamy Sarathy <gsar@engin.umich.edu>
Files: pp_ctl.c
Msg-ID: <199612081958.OAA26025@aatma.engin.umich.edu>
(applied based on p5p patch as commit b386bda18108ba86d0b76ebe2d8745eafa80f39e)
Subject: Fix C<@a = ($a,$b,$c,$d) = (1,2)>
From: Chip Salzenberg <chip@atlantic.net>
Files: pp_hot.c
Subject: Properly support and document newRV{,_inc,_noinc}
From: Chip Salzenberg <chip@atlantic.net>
Files: global.sym pod/perlguts.pod sv.c sv.h
Subject: Allow lvalue pos inside recursive function
From: Chip Salzenberg <chip@atlantic.net>
Files: op.c pp.c pp_ctl.c pp_hot.c
PORTABILITY
Subject: Make $privlib contents compatible with 5.003
From: Chip Salzenberg <chip@atlantic.net>
Files: INSTALL ext/Opcode/Safe.pm installperl lib/FileHandle.pm lib/Test/Harness.pm
Subject: Support $bincompat3 config variable; update metaconfig units
From: Chip Salzenberg <chip@atlantic.net>
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
Subject: Look for gettimeofday() in Configure
Date: Wed, 11 Dec 1996 15:49:57 +0100
From: John Hughes <john@AtlanTech.COM>
Files: Configure config_H config_h.SH pp.c
Subject: perl5.003_11, Should base use of gettimeofday on HAS_GETTIMEOFDAY, not I_SYS_TIME
I've been installing perl5.003_11 on a SCO system that has the TCP/IP runtime
installed but not the TCP/IP development system.
Unfortunately the <sys/time.h> include file is included in the TCP/IP runtime
while libsocket.a is in the development system.
This means that pp.c decides to use "gettimeofday" because <sys/time.h> is
present but I can't link the perl that gets compiled.
So, here's a patch to base the use of "gettimeofday" on "HAS_GETTIMEOFDAY"
instead of "I_SYS_TIME". I also took the liberty of removing the special
case for plan9 (I assume plan9 has <sys/time.h> but no gettimeofday. Am I
right?).
p5p-msgid: <01BBE77A.F6F37F80@malvinas.AtlanTech.COM>
Subject: Make $startperl a relative path if people want portable scrip
From: Chip Salzenberg <chip@atlantic.net>
Files: Configure
Subject: Homogenize use of "eval exec" hack
From: Chip Salzenberg <chip@atlantic.net>
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 pod/pod2html.PL pod/pod2latex.PL pod/pod2man.PL pod/pod2text.PL utils/c2ph.PL utils/h2ph.PL utils/h2xs.PL utils/perlbug.PL utils/perldoc.PL utils/pl2pm.PL x2p/a2py.c x2p/find2perl.PL x2p/s2p.PL
Subject: LynxOS support
Date: Thu, 12 Dec 1996 09:25:00 PST
From: Greg Seibert <seibert@Lynx.COM>
Files: Configure MANIFEST hints/lynxos.sh t/op/stat.t
Msg-ID: <m0vYEsY-0000IZC@kzinti.lynx.com>
(applied based on p5p patch as commit 6693373533b15e559fd8f0f1877e5e6ec15483cc)
Subject: Re: db-recno.t failures with _11 on Freebsd 2.1-stable
Date: 11 Dec 1996 18:58:56 -0500
From: Roderick Schertler <roderick@gate.net>
Files: INSTALL hints/freebsd.sh
Msg-ID: <pzohg0r5tr.fsf@eeyore.ibcinc.com>
(applied based on p5p patch as commit 10e40321ee752c58e3407b204c74c8049894cb51)
Subject: VMS patches to 5.003_11
Date: Mon, 09 Dec 1996 23:16:10 -0500 (EST)
From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>
Files: MANIFEST regexec.c t/lib/filehand.t util.c vms/*
private-msgid: <01ICTR32LCZG001A1D@hmivax.humgen.upenn.edu>
TESTING
Subject: recurse recurse recurse ...
Date: Mon, 9 Dec 1996 23:44:27 +0200 (EET)
From: Jarkko Hietaniemi <jhi@cc.hut.fi>
Files: MANIFEST t/op/recurse.t
private-msgid: <199612092144.XAA29025@alpha.hut.fi>
UTILITIES, LIBRARY, AND EXTENSIONS
Subject: Add CPAN and Net::FTP
From: Chip Salzenberg <chip@atlantic.net>
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
Subject: Add File::Compare
Date: Mon, 16 Dec 1996 18:44:59 GMT
From: Nick Ing-Simmons <nik@tiuk.ti.com>
Files: MANIFEST lib/File/Compare.pm pod/perlmod.pod
Msg-ID: <199612161844.SAA02152@pluto>
(applied based on p5p patch as commit ec971c5c328aca84fb827f69f2cc1dc3be81f830)
Subject: Add Tie::RefHash
Date: Sun, 15 Dec 1996 18:58:08 -0500
From: Gurusamy Sarathy <gsar@engin.umich.edu>
Files: MANIFEST lib/Tie/RefHash.pm pod/perlmod.pod
Msg-ID: <199612152358.SAA28665@aatma.engin.umich.edu>
(applied based on p5p patch as commit 9a079709134ebbf4c935cc8752fdb564e5c82b94)
Subject: Put "splain" in utils.
From: Chip Salzenberg <chip@atlantic.net>
Files: Makefile.SH installperl utils/Makefile utils/splain.PL
Subject: Some h2ph fixes
Date: Fri, 13 Dec 1996 11:34:12 -0800
From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com>
Files: utils/h2ph.PL
Here is a message regarding changes to h2ph that should probably be folded
into the 5.004 release.
p5p-msgid: <199612131934.AA289845652@hpcc123.corp.hp.com>
134 files changed, 14526 insertions, 5159 deletions
@@ -97,7 +97,7 @@ interpreter is so embedded. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall -under the copyright of this Package, but belong to whomever generated +under the copyright of this Package, but belong to whoever generated them, and may be sold commercially, and may be aggregated with this Package. If such scripts or library files are aggregated with this Package via the so-called "undump" or "unexec" methods of producing a @@ -8,6 +8,281 @@ or in the .../src/5/0/unsupported directory for sub-version releases.) ---------------- +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 +docs... it's a long list. And speaking of lists, here's a list of +the more significant changes in 5.003_12: + + CORE LANGUAGE CHANGES + + Title: "Support C<delete @hash{@keys}>" + From: Chip Salzenberg <chip@atlantic.net> + 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> + 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> + Files: toke.c + + OTHER CORE CHANGES + + Title: "Allow assignment to empty array values during foreach()" + From: Chip Salzenberg <chip@atlantic.net> + 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> + 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> + Files: pp_hot.c + + Title: "Fix core dump on C<open $undef_var, "X">" + From: Chip Salzenberg <chip@atlantic.net> + Files: pp_sys.c + + Title: "Fix -T/-B on globs and globrefs" + From: Chip Salzenberg <chip@atlantic.net> + Files: pp_sys.c + + Title: "Fix memory management of $`, $&, and $'" + From: Chip Salzenberg <chip@atlantic.net> + Files: pp_hot.c regexec.c + + Title: "Fix paren matching during backtracking" + From: Chip Salzenberg <chip@atlantic.net> + Files: regexec.c + + Title: "Fix memory leak and std{in,out,err} death in perl_{con,de}str + From: Chip Salzenberg <chip@atlantic.net> + Files: miniperlmain.c perl.c perl.h sv.c + + Title: "Discard garbage bytes at end of prototype()" + From: Chip Salzenberg <chip@atlantic.net> + Files: pp.c + + Title: "Fix local($pack::{foo})" + From: Chip Salzenberg <chip@atlantic.net> + 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> + 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> + Files: perl.c + + Title: "Re: Bug in formline " + From: Gurusamy Sarathy <gsar@engin.umich.edu> + 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> + Files: pp_hot.c + + Title: "Fix %ENV assignment when environment starts out empty" + From: Chip Salzenberg <chip@atlantic.net> + Files: hv.c + + Title: "Properly support and document newRV{,_inc,_noinc}" + From: Chip Salzenberg <chip@atlantic.net> + Files: global.sym pod/perlguts.pod sv.c sv.h + + Title: "Support SvREADONLY on arrays" + From: Chip Salzenberg <chip@atlantic.net> + Files: av.c + + Title: "Allow lvalue pos inside recursive function" + From: Chip Salzenberg <chip@atlantic.net> + 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> + Files: perlio.c + + Title: "Make $privlib contents compatible with 5.003" + From: Chip Salzenberg <chip@atlantic.net> + 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> + 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 + + Title: "Look for gettimeofday() in Configure" + From: John Hughes <john@AtlanTech.COM> + Msg-ID: <01BBE77A.F6F37F80@malvinas.AtlanTech.COM> + Date: Wed, 11 Dec 1996 15:49:57 +0100 + 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> + Files: Configure + + Title: "Homogenize use of "eval exec" hack" + From: Chip Salzenberg <chip@atlantic.net> + 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 + pod/pod2html.PL pod/pod2latex.PL pod/pod2man.PL + pod/pod2text.PL utils/c2ph.PL utils/h2ph.PL utils/h2xs.PL + utils/perlbug.PL utils/perldoc.PL utils/pl2pm.PL x2p/a2py.c + x2p/find2perl.PL x2p/s2p.PL + + Title: "LynxOS support" + From: seibert@Lynx.COM (Greg Seibert) + Msg-ID: <m0vYEsY-0000IZC@kzinti.lynx.com> + Date: Thu, 12 Dec 1996 09:25:00 PST + 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> + Files: hints/linux.sh + + Title: "5.003_11 on UnixWare 2.1.1 - Only one small UnixWare buglet" + From: aburlison@cix.compulink.co.uk (Alan Burlison) + Msg-ID: <memo.453720@cix.compulink.co.uk> + Date: Wed, 11 Dec 96 18:34 GMT0 + Files: hints/svr4.sh + + Title: "Re: db-recno.t failures with _11 on Freebsd 2.1-stable" + From: Roderick Schertler <roderick@gate.net> + 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> + 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> + Msg-ID: <01ICTR32LCZG001A1D@hmivax.humgen.upenn.edu> + Date: Mon, 09 Dec 1996 23:16:10 -0500 (EST) + Files: MANIFEST regexec.c t/lib/filehand.t util.c vms/* + + TESTING + + Title: "recurse recurse recurse ..." + From: Jarkko Hietaniemi <jhi@cc.hut.fi> + Msg-ID: <199612092144.XAA29025@alpha.hut.fi> + Date: Mon, 9 Dec 1996 23:44:27 +0200 (EET) + Files: MANIFEST t/op/recurse.t + + UTILITIES, LIBRARY, AND EXTENSIONS + + Title: "Add CPAN and Net::FTP" + From: Chip Salzenberg <chip@atlantic.net> + 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 + + Title: "Please update Text::Wrap and Text::Tabs" + From: David Muir Sharnoff <muir@idiom.com> + Msg-ID: <199612180659.WAA24957@idiom.com> + Date: Tue, 17 Dec 1996 22:59:59 -0800 (PST) + Files: lib/Text/Tabs.pm lib/Text/Wrap.pm + + Title: "Add File::Compare" + From: Nick Ing-Simmons <nik@tiuk.ti.com> + 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> + 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> + Files: Makefile.SH installperl utils/Makefile utils/splain.PL + + Title: "Some h2ph fixes" + From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com> + 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) + 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> + 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) + 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> + Msg-ID: <199612111038.FAA24363@monk.mps.ohio-state.edu> + Date: Wed, 11 Dec 1996 05:38:28 -0500 (EST) + Files: lib/perl5db.pl + + DOCUMENTATION + + Title: "Update pods: perldelta -> perlnews, perli18n -> perllocale" + From: Tom Christiansen and Dominic Dunlop + Files: MANIFEST pod/perl.pod pod/perldelta.pod pod/perli18n.pod + pod/perlnews.pod + + Title: "perltoot.pod" + From: Tom Christiansen <tchrist@mox.perl.com> + 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> + Msg-ID: <199612061940.AA055461228@hpcc123.corp.hp.com> + Date: Fri, 6 Dec 96 11:40:27 PST + Files: pod/perlguts.pod + + Title: "pod/perlipc.pod patch" + From: d-lewart@uiuc.edu (Daniel S. Lewart) + Msg-ID: <199612090910.CAA20906@mox.perl.com> + Date: Mon, 9 Dec 96 3:10:02 CST + Files: pod/perlipc.pod + + Title: "pod patches for English errors" + From: Steve Kelem <steve.kelem@xilinx.com> + Msg-ID: <24616.850167191@castor> + Date: Mon, 09 Dec 1996 13:33:11 -0800 + Files: pod/*.pod + + Title: "Misc doc updates" + From: Tom Christiansen <tchrist@mox.perl.com> + Msg-ID: <199612150156.SAA12506@mox.perl.com> + Date: Sat, 14 Dec 1996 18:56:33 -0700 + Files: pod/* + +---------------- Version 5.003_11 ---------------- @@ -20,7 +20,7 @@ # $Id: Head.U,v 3.0.1.8 1995/07/25 13:40:02 ram Exp $ # -# Generated on Thu Oct 10 15:08:34 EDT 1996 [metaconfig 3.0 PL60] +# Generated on Tue Dec 17 14:33:33 EST 1996 [metaconfig 3.0 PL60] cat >/tmp/c1$$ <<EOF ARGGGHHHH!!!!! @@ -227,6 +227,8 @@ baserev='' bin='' binexp='' installbin='' +bincompat3='' +d_bincompat3='' byteorder='' cc='' gccversion='' @@ -284,6 +286,8 @@ d_flexfnam='' d_flock='' d_fork='' d_fsetpos='' +d_ftime='' +d_gettimeod='' d_Gconvert='' d_getgrps='' d_gethent='' @@ -773,7 +777,7 @@ case "$sh" in '') cat <<EOM >&2 $me: Fatal Error: I can't find a Bourne Shell anywhere. Usually it's in /bin/sh. How did you even get this far? -Please contact me (Andy Dougherty) at doughera@lafcol.lafayette.edu and +Please contact me (Chip Salzenberg) at chip@atlantic.net and we'll try to straigten this all out. EOM exit 1 @@ -849,11 +853,11 @@ cat >>extract <<'EOS' CONFIG=true echo "Doing variable substitutions on .SH files..." if test -f MANIFEST; then - shlist=`awk '!/^old_/ {print $1}' <MANIFEST | grep '\.SH$'` + shlist=`awk '{print $1}' <MANIFEST | grep '\.SH'` : Pick up possible extension manifests. for dir in ext/* ; do if test -f $dir/MANIFEST; then - xxx=`awk '!/^old_/ {print $1}' < $dir/MANIFEST | + xxx=`awk '{print $1}' < $dir/MANIFEST | sed -n "/\.SH$/ s@^@$dir/@p"` shlist="$shlist $xxx" fi @@ -861,7 +865,7 @@ if test -f MANIFEST; then set x $shlist else echo "(Looking for .SH files under the current directory.)" - set x `find . -name "*.SH" -print | grep -v '/old_'` + set x `find . -name "*.SH" -print` fi shift case $# in @@ -1141,7 +1145,7 @@ THIS PACKAGE SEEMS TO BE INCOMPLETE. You have the option of continuing the configuration process, despite the distinct possibility that your kit is damaged, by typing 'y'es. If you do, don't blame me if something goes wrong. I advise you to type 'n'o -and contact the author (doughera@lafcol.lafayette.edu). +and contact the author (chip@atlantic.net). EOM echo $n "Continue? [n] $c" >&4 @@ -1341,7 +1345,7 @@ Much effort has been expended to ensure that this shell script will run on any Unix system. If despite that it blows up on yours, your best bet is to edit Configure and run it again. If you can't run Configure for some reason, you'll have to generate a config.sh file by hand. Whatever problems you -have, let me (doughera@lafcol.lafayette.edu) know how I blew it. +have, let me (chip@atlantic.net) know how I blew it. This installation script affects things in two ways: @@ -1631,13 +1635,14 @@ EOM cd hints; ls -C *.sh | $sed 's/\.sh/ /g' >&4 dflt='' : Half the following guesses are probably wrong... If you have better - : tests or hints, please send them to doughera@lafcol.lafayette.edu + : tests or hints, please send them to chip@atlantic.net : The metaconfig authors would also appreciate a copy... $test -f /irix && osname=irix $test -f /xenix && osname=sco_xenix $test -f /dynix && osname=dynix $test -f /dnix && osname=dnix - $test -f /unicos && osname=unicos && osvers=`$uname -r` + $test -f /lynx.os && osname=lynxos + $test -f /unicos && osname=unicos && osvers=`$uname -r` $test -f /bin/mips && /bin/mips && osname=mips $test -d /NextApps && set X `hostinfo | grep 'NeXT Mach.*:' | \ $sed -e 's/://' -e 's/\./_/'` && osname=next && osvers=$4 @@ -1781,7 +1786,7 @@ EOM $2) case "$osname" in *isc*) ;; *freebsd*) ;; - svr*) + svr*) : svr4.x or possibly later case "svr$3" in ${osname}*) @@ -2020,7 +2025,8 @@ if xxx=`./loc arch blurfl $pth`; $test -f "$xxx"; then tarch=`arch`"-$osname" elif xxx=`./loc uname blurfl $pth`; $test -f "$xxx" ; then if uname -m > tmparch 2>&1 ; then - tarch=`$sed -e 's/ /_/g' -e 's/_*$//' -e 's/$/'"-$osname/" tmparch` + tarch=`$sed -e 's/ *$//' -e 's/ /_/g' + -e 's/$/'"-$osname/" tmparch` else tarch="$osname" fi @@ -2418,7 +2424,7 @@ else fi : set the base revision -baserev=5.0 +baserev=5 : get the patchlevel echo " " @@ -2430,7 +2436,12 @@ else patchlevel=0 subversion=0 fi -$echo $n "(You have $package $baserev patchlevel $patchlevel" $c +$echo $n "(You have $package" $c +case "$package" in +"*$baserev") ;; +*) $echo $n " $baserev" $c ;; +esac +$echo $n " patchlevel $patchlevel" $c test 0 -eq "$subversion" || $echo $n " subversion $subversion" $c echo ".)" @@ -2523,6 +2534,33 @@ $undef$define) . ./whoa; eval "$var=\$tu";; *) eval "$var=$val";; esac' +$cat <<EOM + +Perl 5.004 can be compiled for binary compatibility with 5.003. +If you decide to do so, you will be able to continue using any +extensions that were compiled for Perl 5.003. However, binary +compatibility forces Perl to expose some of its internal symbols +in the same way that 5.003 did. So you may have symbol conflicts +if you embed a binary-compatible Perl in other programs. + +EOM +case "$d_bincompat3" in +"$undef") dflt=n ;; +*) dflt=y ;; +esac +rp='Binary compatibility with Perl 5.003?' +. ./myread +case "$ans" in +y*) val="$define" ;; +*) val="$undef" ;; +esac +set d_bincompat3 +eval $setvar +case "$d_bincompat3" in +"$define") bincompat3=y ;; +*) bincompat3=n ;; +esac + : make some quick guesses about what we are up against echo " " $echo $n "Hmm... $c" @@ -3219,6 +3257,25 @@ none) libpth=' ';; *) libpth="$ans";; esac +: Define several unixisms. Hints files or command line options +: can be used to override them. +case "$ar" in +'') ar='ar';; +esac +case "$lib_ext" in +'') lib_ext='.a';; +esac +case "$obj_ext" in +'') obj_ext='.o';; +esac +case "$path_sep" in +'') path_sep=':';; +esac +: Which makefile gets called first. This is used by make depend. +case "$firstmakefile" in +'') firstmakefile='makefile';; +esac + : compute shared library extension case "$so" in '') @@ -3241,11 +3298,6 @@ rp='What is the file extension used for shared libraries?' . ./myread so="$ans" -: If no lib_ext yet, assume '.a'. -case "$lib_ext" in -'') lib_ext='.a';; -esac - : Looking for optional libraries echo " " echo "Checking for optional libraries..." >&4 @@ -3270,25 +3322,25 @@ for thislib in $libswanted; do *"-l$thislib "*);; *) dflt="$dflt -l$thislib";; esac - elif xxx=`./loc lib$thislib${lib_ext} X $libpth`; $test -f "$xxx"; then + elif xxx=`./loc lib$thislib$lib_ext X $libpth`; $test -f "$xxx"; then echo "Found -l$thislib." case " $dflt " in *"-l$thislib "*);; *) dflt="$dflt -l$thislib";; esac - elif xxx=`./loc $thislib${lib_ext} X $libpth`; $test -f "$xxx"; then + elif xxx=`./loc $thislib$lib_ext X $libpth`; $test -f "$xxx"; then echo "Found -l$thislib." case " $dflt " in *"-l$thislib "*);; *) dflt="$dflt -l$thislib";; esac - elif xxx=`./loc lib${thislib}_s${lib_ext} X $libpth`; $test -f "$xxx"; then + elif xxx=`./loc lib${thislib}_s$lib_ext X $libpth`; $test -f "$xxx"; then echo "Found -l${thislib}_s." case " $dflt " in *"-l$thislib "*);; *) dflt="$dflt -l${thislib}_s";; esac - elif xxx=`./loc Slib$thislib${lib_ext} X $xlibpth`; $test -f "$xxx"; then + elif xxx=`./loc Slib$thislib$lib_ext X $xlibpth`; $test -f "$xxx"; then echo "Found -l$thislib." case " $dflt " in *"-l$thislib "*);; @@ -3546,7 +3598,6 @@ if ./osf1; then else set signal.h LANGUAGE_C; eval $inctest fi -set signal.h NO_PROTOTYPE; eval $inctest set signal.h _NO_PROTO; eval $inctest case "$hint" in @@ -3839,7 +3890,7 @@ echo " " case "$libc" in '') libc=unknown case "$libs" in - *-lc_s*) libc=`./loc libc_s${lib_ext} $libc $libpth` + *-lc_s*) libc=`./loc libc_s$lib_ext $libc $libpth` esac ;; esac @@ -3857,15 +3908,13 @@ case "$libs" in : elif try=`./loc lib$thislib.$so X $libpth`; $test -f "$try"; then : - elif try=`./loc lib$thislib${lib_ext} X $libpth`; $test -f "$try"; then - : - elif try=`./loc $thislib${lib_ext} X $libpth`; $test -f "$try"; then + elif try=`./loc lib$thislib$lib_ext X $libpth`; $test -f "$try"; then : elif try=`./loc lib$thislib X $libpth`; $test -f "$try"; then : elif try=`./loc $thislib X $libpth`; $test -f "$try"; then : - elif try=`./loc Slib$thislib${lib_ext} X $xlibpth`; $test -f "$try"; then + elif try=`./loc Slib$thislib$lib_ext X $xlibpth`; $test -f "$try"; then : else try='' @@ -3896,7 +3945,7 @@ unknown) eval set \$$# done $test -r $1 || set /usr/ccs/lib/libc.$so - $test -r $1 || set /lib/libsys_s.a + $test -r $1 || set /lib/libsys_s$lib_ext ;; *) set blurfl @@ -3915,25 +3964,25 @@ elif $test -r /lib/libc && $test -r /lib/clib; then fi elif $test -r "$libc" || (test -h "$libc") >/dev/null 2>&1; then echo "Your C library seems to be in $libc, as you said before." -elif $test -r $incpath/usr/lib/libc${lib_ext}; then - libc=$incpath/usr/lib/libc${lib_ext}; +elif $test -r $incpath/usr/lib/libc$lib_ext; then + libc=$incpath/usr/lib/libc$lib_ext; echo "Your C library seems to be in $libc. That's fine." -elif $test -r /lib/libc${lib_ext}; then - libc=/lib/libc${lib_ext}; +elif $test -r /lib/libc$lib_ext; then + libc=/lib/libc$lib_ext; echo "Your C library seems to be in $libc. You're normal." else - if tans=`./loc libc${lib_ext} blurfl/dyick $libpth`; $test -r "$tans"; then + if tans=`./loc libc$lib_ext blurfl/dyick $libpth`; $test -r "$tans"; then : elif tans=`./loc libc blurfl/dyick $libpth`; $test -r "$tans"; then libnames="$libnames "`./loc clib blurfl/dyick $libpth` elif tans=`./loc clib blurfl/dyick $libpth`; $test -r "$tans"; then : - elif tans=`./loc Slibc${lib_ext} blurfl/dyick $xlibpth`; $test -r "$tans"; then + elif tans=`./loc Slibc$lib_ext blurfl/dyick $xlibpth`; $test -r "$tans"; then : - elif tans=`./loc Mlibc${lib_ext} blurfl/dyick $xlibpth`; $test -r "$tans"; then + elif tans=`./loc Mlibc$lib_ext blurfl/dyick $xlibpth`; $test -r "$tans"; then : else - tans=`./loc Llibc${lib_ext} blurfl/dyick $xlibpth` + tans=`./loc Llibc$lib_ext blurfl/dyick $xlibpth` fi if $test -r "$tans"; then echo "Your C library seems to be in $tans, of all places." @@ -4087,22 +4136,6 @@ fi esac $rm -f libnames libpath -: Define several unixisms. Hints files or command line options -: can be used to override them. -case "$ar" in -'') ar='ar';; -esac -case "$obj_ext" in -'') obj_ext='.o';; -esac -case "$path_sep" in -'') path_sep=':';; -esac -: Which makefile gets called first. This is used by make depend. -case "$firstmakefile" in -'') firstmakefile='makefile';; -esac - : determine filename position in cpp output echo " " echo "Computing filename position in cpp output for #include directives..." >&4 @@ -4608,7 +4641,7 @@ case "$shrpdir" in *) $cat >&4 <<EOM WARNING: Use of the shrpdir variable for the installation location of the shared $libperl is not supported. It was never documented and -will not work in this version. Let me (doughera@lafcol.lafayette.edu) +will not work in this version. Let me (chip@atlantic.net) know of any problems this may cause. EOM @@ -5216,6 +5249,63 @@ rp='Perl administrator e-mail address' . ./myread perladmin="$ans" +: figure out how to guarantee perl startup +case "$startperl" in +'') + case "$sharpbang" in + *!) + $cat <<EOH + +I can use the #! construct to start perl on your system. This will +make startup of perl scripts faster, but may cause problems if you +want to share those scripts and perl is not in a standard place +($binexp/perl) on all your platforms. The alternative is to force +a shell by starting the script with a single ':' character. + +EOH + dflt="$binexp/perl" + rp='What shall I put after the #! to start up perl ("none" to not use #!)?' + . ./myread + case "$ans" in + none) startperl=": # use perl";; + *) startperl="#!$ans";; + esac + ;; + *) startperl=": # use perl" + ;; + esac + ;; +esac +echo "I'll use $startperl to start perl scripts." + +: figure best path for perl in scripts +case "$perlpath" in +'') + perlpath="$binexp/perl" + case "$startperl" in + *!*) ;; + *) + $cat <<EOH + +I will use the "eval 'exec'" idiom to start Perl on your system. +I can use the full path of your Perl binary for this purpose, but +doing so may cause problems if you want to share those scripts and +Perl is not always in a standard place ($binexp/perl). + +EOH + dflt="$binexp/perl" + rp="What path shall I use in \"eval 'exec'\"?" + . ./myread + perlpath="$ans" + ;; + esac + ;; +esac +case "$startperl" in +*!*) ;; +*) echo "I'll use $perlpath in \"eval 'exec'\"" ;; +esac + : determine where public executable scripts go set scriptdir scriptdir eval $prefixit @@ -5269,40 +5359,6 @@ else installscript="$scriptdirexp" fi -: determine perl absolute location -case "$perlpath" in -'') perlpath=$binexp/perl ;; -esac - -: figure out how to guarantee perl startup -case "$startperl" in -'') - case "$sharpbang" in - *!) - $cat <<EOH - -I can use the #! construct to start perl on your system. This will -make startup of perl scripts faster, but may cause problems if you -want to share those scripts and perl is not in a standard place -($perlpath) on all your platforms. The alternative is to force -a shell by starting the script with a single ':' character. - -EOH - dflt=$perlpath - rp='What shall I put after the #! to start up perl ("none" to not use #!)?' - . ./myread - case "$ans" in - none) startperl=": # use perl";; - *) startperl="#!$ans";; - esac - ;; - *) startperl=": # use perl" - ;; - esac - ;; -esac -echo "I'll use $startperl to start perl scripts." - cat <<EOM Previous version of $package used the standard IO mechanisms as defined in @@ -5911,19 +5967,19 @@ if set crypt val -f d_crypt; eval $csym; $val; then val="$define" cryptlib='' else - cryptlib=`./loc Slibcrypt${lib_ext} "" $xlibpth` + cryptlib=`./loc Slibcrypt$lib_ext "" $xlibpth` if $test -z "$cryptlib"; then - cryptlib=`./loc Mlibcrypt${lib_ext} "" $xlibpth` + cryptlib=`./loc Mlibcrypt$lib_ext "" $xlibpth` else cryptlib=-lcrypt fi if $test -z "$cryptlib"; then - cryptlib=`./loc Llibcrypt${lib_ext} "" $xlibpth` + cryptlib=`./loc Llibcrypt$lib_ext "" $xlibpth` else cryptlib=-lcrypt fi if $test -z "$cryptlib"; then - cryptlib=`./loc libcrypt${lib_ext} "" $libpth` + cryptlib=`./loc libcrypt$lib_ext "" $libpth` else cryptlib=-lcrypt fi @@ -6126,23 +6182,23 @@ main() #endif handle = dlopen("./dyna.$dlext", mode) ; if (handle == NULL) { - printf ("1\n") ; - fflush (stdout) ; - exit(0); + printf ("1\n") ; + fflush (stdout) ; + exit(0); } symbol = dlsym(handle, "fred") ; if (symbol == NULL) { - /* try putting a leading underscore */ - symbol = dlsym(handle, "_fred") ; - if (symbol == NULL) { - printf ("2\n") ; - fflush (stdout) ; - exit(0); - } - printf ("3\n") ; + /* try putting a leading underscore */ + symbol = dlsym(handle, "_fred") ; + if (symbol == NULL) { + printf ("2\n") ; + fflush (stdout) ; + exit(0); + } + printf ("3\n") ; } else - printf ("4\n") ; + printf ("4\n") ; fflush (stdout) ; exit(0); } @@ -6460,6 +6516,25 @@ eval $inlibc set getpriority d_getprior eval $inlibc +: see if gettimeofday or ftime exists +set gettimeofday d_gettimeod +eval $inlibc +case "$d_gettimeod" in +"$undef") + set ftime d_ftime + eval $inlibc + ;; +*) + val="$undef"; set d_ftime; eval $setvar + ;; +esac +case "$d_gettimeod$d_ftime" in +"$undef$undef") + echo " " + echo 'No ftime() nor gettimeofday() -- timing may be less accurate.' >&4 + ;; +esac + : see if this is a netinet/in.h or sys/in.h system set netinet/in.h i_niin sys/in.h i_sysin eval $inhdr @@ -7048,7 +7123,7 @@ val="$undef" case "$d_memcmp" in "$define") echo " " - echo "Checking to see if memcmp() can compare relative magnitude..." >&4 + echo "Checking to see if your memcmp() can compare relative magnitude..." >&4 $cat >foo.c <<EOCP #$i_memory I_MEMORY #$i_stdlib I_STDLIB @@ -7390,10 +7465,10 @@ else : we will have to assume that it supports the 4.2 BSD interface d_oldsock="$undef" else - echo "You don't have Berkeley networking in libc${lib_ext}..." >&4 - if test -f /usr/lib/libnet${lib_ext}; then - ( (nm $nm_opt /usr/lib/libnet${lib_ext} | eval $nm_extract) || \ - ar t /usr/lib/libnet${lib_ext}) 2>/dev/null >> libc.list + echo "You don't have Berkeley networking in libc$lib_ext..." >&4 + if test -f /usr/lib/libnet$lib_ext; then + ( (nm $nm_opt /usr/lib/libnet$lib_ext | eval $nm_extract) || \ + ar t /usr/lib/libnet$lib_ext) 2>/dev/null >> libc.list if $contains socket libc.list >/dev/null 2>&1; then echo "...but the Wollongong group seems to have hacked it in." >&4 socketlib="-lnet" @@ -7406,7 +7481,7 @@ else d_oldsock="$define" fi else - echo "or even in libnet${lib_ext}, which is peculiar." >&4 + echo "or even in libnet$lib_ext, which is peculiar." >&4 d_socket="$undef" d_oldsock="$undef" fi @@ -8480,14 +8555,14 @@ EOP $cc $ccflags -c bar1.c >/dev/null 2>&1 $cc $ccflags -c bar2.c >/dev/null 2>&1 $cc $ccflags -c foo.c >/dev/null 2>&1 -ar rc bar${lib_ext} bar2.o bar1.o >/dev/null 2>&1 -if $cc $ccflags $ldflags -o foobar foo.o bar${lib_ext} $libs > /dev/null 2>&1 && +ar rc bar$lib_ext bar2.o bar1.o >/dev/null 2>&1 +if $cc $ccflags $ldflags -o foobar foo.o bar$lib_ext $libs > /dev/null 2>&1 && ./foobar >/dev/null 2>&1; then echo "ar appears to generate random libraries itself." orderlib=false ranlib=":" -elif ar ts bar${lib_ext} >/dev/null 2>&1 && - $cc $ccflags $ldflags -o foobar foo.o bar${lib_ext} $libs > /dev/null 2>&1 && +elif ar ts bar$lib_ext >/dev/null 2>&1 && + $cc $ccflags $ldflags -o foobar foo.o bar$lib_ext $libs > /dev/null 2>&1 && ./foobar >/dev/null 2>&1; then echo "a table of contents needs to be added with 'ar ts'." orderlib=false @@ -8960,7 +9035,7 @@ main() } EOM echo " " -if $cc $ccflags $ldflags -o ssize ssize.c > /dev/null 2>&1 && +if $cc $ccflags $ldflags -o ssize ssize.c $libs > /dev/null 2>&1 && ./ssize > /dev/null 2>&1 ; then ssizetype=`./ssize` echo "I'll be using $ssizetype for functions returning a byte count." >&4 @@ -9530,23 +9605,22 @@ known_extensions='' : some additional extensions into the source tree and expect them : to be built. for xxx in * ; do - case "$xxx" in - DynaLoader) ;; - *) - if $test -f $xxx/$xxx.xs; then - known_extensions="$known_extensions $xxx" - else - if $test -d $xxx; then - cd $xxx - for yyy in * ; do - if $test -f $yyy/$yyy.xs; then - known_extensions="$known_extensions $xxx/$yyy" - fi - done - cd .. - fi - fi ;; - esac + case "$xxx" in + DynaLoader) ;; + *) if $test -f $xxx/$xxx.xs; then + known_extensions="$known_extensions $xxx" + else + if $test -d $xxx; then + cd $xxx + for yyy in * ; do + if $test -f $yyy/$yyy.xs; then + known_extensions="$known_extensions $xxx/$yyy" + fi + done + cd .. + fi + fi ;; + esac done set X $known_extensions shift @@ -9759,6 +9833,7 @@ awk='$awk' baserev='$baserev' bash='$bash' bin='$bin' +bincompat3='$bincompat3' binexp='$binexp' bison='$bison' byacc='$byacc' @@ -9798,6 +9873,7 @@ d_archlib='$d_archlib' d_attribut='$d_attribut' d_bcmp='$d_bcmp' d_bcopy='$d_bcopy' +d_bincompat3='$d_bincompat3' d_bsd='$d_bsd' d_bsdgetpgrp='$d_bsdgetpgrp' d_bsdpgrp='$d_bsdpgrp' @@ -9836,6 +9912,7 @@ d_flock='$d_flock' d_fork='$d_fork' d_fpathconf='$d_fpathconf' d_fsetpos='$d_fsetpos' +d_ftime='$d_ftime' d_getgrps='$d_getgrps' d_gethent='$d_gethent' d_gethname='$d_gethname' @@ -9845,6 +9922,7 @@ d_getpgrp2='$d_getpgrp2' d_getpgrp='$d_getpgrp' d_getppid='$d_getppid' d_getprior='$d_getprior' +d_gettimeod='$d_gettimeod' d_gnulibc='$d_gnulibc' d_htonl='$d_htonl' d_index='$d_index' @@ -125,12 +125,12 @@ you can use the Configure command line option -Uusedl. By default, Configure will offer to build every extension which appears to be supported. For example, Configure will offer to build GDBM_File only if it is able to find the gdbm library. (See examples below.) -DynaLoader, Fcntl, FileHandle and IO are always built by default. -Configure does not contain code to test for POSIX compliance, so POSIX -is always built by default as well. If you wish to skip POSIX, you can -set the Configure variable useposix=false either in a hint file or from -the Configure command line. Similarly, the Opcode extension is always -built by default, but you can skip it by setting the Configure variable +DynaLoader, Fcntl, and IO are always built by default. Configure does +not contain code to test for POSIX compliance, so POSIX is always built +by default as well. If you wish to skip POSIX, you can set the +Configure variable useposix=false either in a hint file or from the +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. Even if you do not have dynamic loading, you must still build the @@ -143,7 +143,6 @@ to turn off each extension: DB_File i_db DynaLoader (Must always be included as a static extension) Fcntl (Always included by default) - FileHandle (Always included by default) GDBM_File i_gdbm IO (Always included by default) NDBM_File i_ndbm @@ -885,6 +884,11 @@ If you get syntax errors on '(', try -DCRIPPLED_CC. Machines with half-implemented dbm routines will need to #undef I_ODBM +db-recno failure on tests 51, 53 and 55: 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. + =back =head1 make test @@ -4,8 +4,8 @@ Changes5.000 Differences from perl4. Changes5.001 Differences from 5.000. Changes5.002 Differences from 5.001. Changes5.003 Differences from 5.002. -configure Crude emulation of GNU configure Configure Portability tool +configure Crude emulation of GNU configure Copying The GNU General Public License EXTERN.h Included before foreign .h files INSTALL Detailed installation instructions. @@ -23,6 +23,7 @@ XSUB.h Include file for extension subroutines av.c Array value code av.h Array value header cflags.SH A script that emits C compilation flags per file +compat3.sym List of symbols for binary-compatibility with 5.003 config_H Sample config.h config_h.SH Produces config.h configpm Produces lib/Config.pm @@ -225,6 +226,7 @@ hints/irix_6_2.sh Hints for named architecture hints/isc.sh Hints for named architecture hints/isc_2.sh Hints for named architecture hints/linux.sh Hints for named architecture +hints/lynxos.sh Hints for named architecture hints/machten.sh Hints for named architecture hints/machten_2.sh Hints for named architecture hints/mips.sh Hints for named architecture @@ -269,6 +271,9 @@ lib/AnyDBM_File.pm Perl module to emulate dbmopen lib/AutoLoader.pm Autoloader base class lib/AutoSplit.pm A module to split up autoload functions lib/Benchmark.pm A module to time pieces of code and such +lib/CPAN.pm Interface to Comprehensive Perl Archive Network +lib/CPAN/FirstTime.pm Utility for creating CPAN config files +lib/CPAN/Nox.pm Runs CPAN while avoiding compiled extensions lib/Carp.pm Error message base class lib/Class/Template.pm Structure/member template builder; makes nested types lib/Cwd.pm Various cwd routines (getcwd, fastcwd, chdir) @@ -293,6 +298,7 @@ lib/ExtUtils/xsubpp External subroutine preprocessor lib/Fatal.pm Make do-or-die equivalents of functions lib/File/Basename.pm A module to emulate the basename program lib/File/CheckTree.pm Perl module supporting wholesale file mode validation +lib/File/Compare.pm Emulation of cmp command lib/File/Copy.pm Emulation of cp command lib/File/Find.pm Routines to do a find lib/File/Path.pm A module to do things like `mkdir -p' and `rm -r' @@ -308,7 +314,10 @@ 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/Net/FTP.pm File Transfer Protocol client +lib/Net/Netrc.pm Parser for ".netrc" file a la Berkeley UNIX lib/Net/Ping.pm Ping methods +lib/Net/Socket.pm Support class for Net::FTP lib/Net/hostent.pm Object-oriented wrapper around CORE::gethost* lib/Net/netent.pm Object-oriented wrapper around CORE::getnet* lib/Net/protoent.pm Object-oriented wrapper around CORE::getproto* @@ -332,6 +341,7 @@ lib/Text/Soundex.pm Perl module to implement Soundex lib/Text/Tabs.pm Do expand and unexpand lib/Text/Wrap.pm Paragraph formatter lib/Tie/Hash.pm Base class for tied hashes +lib/Tie/RefHash.pm Base class for tied hashes with references as keys lib/Tie/Scalar.pm Base class for tied scalars lib/Tie/SubstrHash.pm Compact hash for known key, value and table size lib/Time/Local.pm Reverse translation of localtime, gmtime @@ -379,7 +389,6 @@ lib/perl5db.pl Perl debugging routines lib/pwd.pl Routines to keep track of PWD environment variable lib/shellwords.pl Perl library to split into words with shell quoting lib/sigtrap.pm For trapping an abort and giving traceback -lib/splain Standalone program to print verbose diagnostics. lib/stat.pl Perl library supporting stat function lib/strict.pm For "use strict" lib/subs.pm Declare overriding subs @@ -400,9 +409,6 @@ miniperlmain.c Basic perl w/o dynamic loading or extensions mv-if-diff Script to mv a file if it changed myconfig Prints summary of the current configuration nostdio.h Cause compile error on stdio calls -old_embed.pl Produces embed.h using old_global.sym -old_global.sym Old list of symbols to hide when embedded -old_perl_exp.SH Creates old list of exported symbols for AIX. op.c Opcode syntax tree code op.h Opcode syntax tree header opcode.h Automatically generated opcode header @@ -494,10 +500,11 @@ pod/perlembed.pod Embedding info pod/perlform.pod Format info pod/perlfunc.pod Function info pod/perlguts.pod Internals info -pod/perli18n.pod I18N info pod/perlipc.pod IPC info -pod/perllol.pod How to use lists of lists. +pod/perllocale.pod Locale support info +pod/perllol.pod How to use lists of lists pod/perlmod.pod Module info +pod/perlnews.pod News of changes since last version pod/perlobj.pod Object info pod/perlop.pod Operator info pod/perlovl.pod Overloading info @@ -511,6 +518,7 @@ pod/perlsub.pod Subroutine info pod/perlsyn.pod Syntax info pod/perltie.pod Tieing an object class into a simple variable pod/perltoc.pod Table of Contents info +pod/perltoot.pod Tom's object-oriented tutorial pod/perltrap.pod Trap info pod/perlvar.pod Variable info pod/perlxs.pod XS api info @@ -655,9 +663,10 @@ t/op/push.t See if push and pop work t/op/quotemeta.t See if quotemeta works t/op/rand.t See if rand works t/op/range.t See if .. works -t/op/re_tests Input file for op.regexp +t/op/re_tests Regular expressions for regexp.t t/op/read.t See if read() works t/op/readdir.t See if readdir() works +t/op/recurse.t See if deep recursion works t/op/ref.t See if refs and objects work t/op/regexp.t See if regular expressions work t/op/repeat.t See if x operator works @@ -676,7 +685,6 @@ t/op/undef.t See if undef 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/re_tests Regular expressions for regexp.t taint.c Tainting code toke.c The tokener universal.c The default UNIVERSAL package methods @@ -690,9 +698,15 @@ utils/h2xs.PL Program to make .xs files from C header files utils/perlbug.PL A simple tool to submit a bug report utils/perldoc.PL A simple tool to find & display perl's documentation utils/pl2pm.PL A pl to pm translator +utils/splain.PL Stand-alone version of diagnostics.pm vms/Makefile VMS port vms/config.vms default config.h for VMS vms/descrip.mms MM[SK] description file for build +vms/ext/DCLsym/0README.txt ReadMe file for VMS::DCLsym +vms/ext/DCLsym/DCLsym.pm Perl access to CLI symbols +vms/ext/DCLsym/DCLsym.xs Perl access to CLI symbols +vms/ext/DCLsym/Makefile.PL MakeMaker driver for VMS::DCLsym +vms/ext/DCLsym/test.pl regression tests for VMS::DCLsym vms/ext/Filespec.pm VMS-Unix file syntax interconversion vms/ext/Stdio/0README.txt ReadMe file for VMS::Stdio vms/ext/Stdio/Makefile.PL MakeMaker driver for VMS::Stdio diff --git a/Makefile.SH b/Makefile.SH index 81d65892f5..db3b776c01 100755 --- a/Makefile.SH +++ b/Makefile.SH @@ -243,7 +243,7 @@ $(LIBPERL): $& perl$(OBJ_EXT) $(obj) case "$useshrplib" in true) $spitshell >>Makefile <<'!NO!SUBS!' - $(LD) $(LDDLFLAGS) -o $@ perl$(OBJ_EXT) $(obj) + $(LD) $(LDDLFLAGS) -o $@ perl$(OBJ_EXT) $(obj) $(libs) !NO!SUBS! ;; *) diff --git a/Porting/Glossary b/Porting/Glossary index 4cd0099c93..da02084b31 100644 --- a/Porting/Glossary +++ b/Porting/Glossary @@ -1318,7 +1318,7 @@ startperl (startperl.U): script to make sure (hopefully) that it runs with perl and not some shell. Of course, that leading line must be followed by the classical perl idiom: - eval 'exec perl -S $0 "$@"' + eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' if $running_under_some_shell; to guarantee perl startup should the shell execute the script. Note that this magic incatation is not understood by csh. diff --git a/compat3.sym b/compat3.sym new file mode 100644 index 0000000000..db53dd67be --- /dev/null +++ b/compat3.sym @@ -0,0 +1,46 @@ +# Global symbols that should handled differently when Perl 5.004 is +# compiled for binary compatibility with version 5.003. + +# Variables from "interp.sym" that _should_ be hidden. + +curcop +curcopdb +envgv +siggv +tainting + +# Variables from "global.sym" that should _not_ be hidden. + +Error +block_type +comppad_name_floor +debug +nice_chunk +nice_chunk_size +no_myglob +no_symref +no_wrongref +pad_reset_pending +padix_floor +regflags +warn_uninit + +# Functions from "global.sym" that should _not_ be hidden. + +SvIV +SvNV +SvTRUE +SvUV +boot_core_UNIVERSAL +do_undump +safecalloc +safefree +safemalloc +saferealloc +safexcalloc +safexfree +safexmalloc +safexrealloc +save_iv +sv_pvn +yydestruct @@ -255,6 +255,17 @@ */ #define HAS_FSETPOS /**/ +/* HAS_GETTIMEOFDAY: + * This symbol, if defined, indicates that the gettimeofday() system + * call is available for a sub-second accuracy clock. Usually, the file + * <sys/resource.h> needs to be included (see I_SYS_RESOURCE). + * The type "Timeval" should be used to refer to "struct timeval". + */ +/*#define HAS_GETTIMEOFDAY / **/ +#ifdef HAS_GETTIMEOFDAY +#define Timeval struct timeval /* Structure used by gettimeofday() */ +#endif + /* HAS_GETGROUPS: * This symbol, if defined, indicates that the getgroups() routine is * available to get the list of process groups. If unavailable, multiple @@ -537,10 +548,9 @@ /*#define HAS_SAFE_MEMCPY / **/ /* HAS_SANE_MEMCMP: - * This symbol, if defined, indicates that the memcmp() routine is - * available to compare memory blocks for relative magnitude. If this - * symbol is not defined, and if HAS_MEMCMP is defined, then memcmp() - * may be used only to compare memory blocks for equality. + * This symbol, if defined, indicates that the memcmp routine is available + * and can be used to compare relative magnitudes of chars with their high + * bits set. If it is not defined, roll your own version. */ /*#define HAS_SANE_MEMCMP / **/ @@ -1362,6 +1372,12 @@ #define ARCHLIB "/opt/perl/lib/i86pc-solaris/5.00305" /**/ #define ARCHLIB_EXP "/opt/perl/lib/i86pc-solaris/5.00305" /**/ +/* BINCOMPAT3: + * This symbol, if defined, indicates that Perl 5.004 should be + * binary-compatible with Perl 5.003. + */ +#define BINCOMPAT3 /**/ + /* BYTEORDER: * This symbol holds the hexadecimal constant defined in byteorder, * i.e. 0x1234 or 0x4321, etc... diff --git a/config_h.SH b/config_h.SH index d2ff19c18a..dd73771d2c 100755 --- a/config_h.SH +++ b/config_h.SH @@ -269,6 +269,17 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_fsetpos HAS_FSETPOS /**/ +/* HAS_GETTIMEOFDAY: + * This symbol, if defined, indicates that the gettimeofday() system + * call is available for a sub-second accuracy clock. Usually, the file + * <sys/resource.h> needs to be included (see I_SYS_RESOURCE). + * The type "Timeval" should be used to refer to "struct timeval". + */ +#$d_gettimeod HAS_GETTIMEOFDAY /**/ +#ifdef HAS_GETTIMEOFDAY +#define Timeval struct timeval /* Structure used by gettimeofday() */ +#endif + /* HAS_GETGROUPS: * This symbol, if defined, indicates that the getgroups() routine is * available to get the list of process groups. If unavailable, multiple @@ -551,10 +562,9 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_safemcpy HAS_SAFE_MEMCPY /**/ /* HAS_SANE_MEMCMP: - * This symbol, if defined, indicates that the memcmp() routine is - * available to compare memory blocks for relative magnitude. If this - * symbol is not defined, and if HAS_MEMCMP is defined, then memcmp() - * may be used only to compare memory blocks for equality. + * This symbol, if defined, indicates that the memcmp routine is available + * and can be used to compare relative magnitudes of chars with their high + * bits set. If it is not defined, roll your own version. */ #$d_sanemcmp HAS_SANE_MEMCMP /**/ @@ -810,19 +820,19 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- /* HAS_STRTOD: * This symbol, if defined, indicates that the strtod routine is - * available to translate strings to doubles. + * available to provide better numeric string conversion than atof(). */ #$d_strtod HAS_STRTOD /**/ /* HAS_STRTOL: - * This symbol, if defined, indicates that the strtol routine is - * available to translate strings to integers. + * This symbol, if defined, indicates that the strtol routine is available + * to provide better numeric string conversion than atoi() and friends. */ #$d_strtol HAS_STRTOL /**/ /* HAS_STRTOUL: * This symbol, if defined, indicates that the strtoul routine is - * available to translate strings to integers. + * available to provide conversion of strings to unsigned long. */ #$d_strtoul HAS_STRTOUL /**/ @@ -1376,6 +1386,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_archlib ARCHLIB "$archlib" /**/ #$d_archlib ARCHLIB_EXP "$archlibexp" /**/ +/* BINCOMPAT3: + * This symbol, if defined, indicates that Perl 5.004 should be + * binary-compatible with Perl 5.003. + */ +#$d_bincompat3 BINCOMPAT3 /**/ + /* BYTEORDER: * This symbol holds the hexadecimal constant defined in byteorder, * i.e. 0x1234 or 0x4321, etc... @@ -93,6 +93,7 @@ struct block_loop { OP * last_op; SV ** itervar; SV * itersave; + SV * iterlval; AV * iterary; I32 iterix; }; @@ -103,12 +104,14 @@ struct block_loop { cx->blk_loop.redo_op = cLOOP->op_redoop; \ cx->blk_loop.next_op = cLOOP->op_nextop; \ cx->blk_loop.last_op = cLOOP->op_lastop; \ + cx->blk_loop.iterlval = Nullsv; \ cx->blk_loop.itervar = ivar; \ if (ivar) \ cx->blk_loop.itersave = *cx->blk_loop.itervar; #define POPLOOP(cx) \ - newsp = stack_base + cx->blk_loop.resetsp; + newsp = stack_base + cx->blk_loop.resetsp; \ + SvREFCNT_dec(cx->blk_loop.iterlval) /* context common to subroutines, evals and loops */ struct block { @@ -189,10 +189,17 @@ register OP *op; (void)strcat(buf,"AMPER,"); if (op->op_private & OPpENTERSUB_DB) (void)strcat(buf,"DB,"); - if (op->op_private & OPpDEREF_AV) - (void)strcat(buf,"AV,"); - if (op->op_private & OPpDEREF_HV) - (void)strcat(buf,"HV,"); + switch (op->op_private & OPpDEREF) { + case OPpDEREF_SV: + (void)strcat(buf, "SV,"); + break; + case OPpDEREF_AV: + (void)strcat(buf, "AV,"); + break; + case OPpDEREF_HV: + (void)strcat(buf, "HV,"); + break; + } if (op->op_private & HINT_STRICT_REFS) (void)strcat(buf,"STRICT_REFS,"); } @@ -13,7 +13,7 @@ of a system to check on and report various kinds of anomalies. If you machine doesn't support #!, the first thing you'll want to do is replace the #! with a couple of lines that look like this: - eval "exec /usr/bin/perl -S $0 $*" + eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' if $running_under_some_shell; being sure to include any flags that were on the #! line. A supplied script @@ -1,4 +1,4 @@ -eval "exec /usr/bin/perl -Spi.bak $0 $*" +eval 'exec /usr/bin/perl -Spi.bak $0 ${1+"$@"}' if $running_under_some_shell; # $RCSfile: nih,v $$Revision: 4.1 $$Date: 92/08/07 17:20:27 $ @@ -6,5 +6,6 @@ eval "exec /usr/bin/perl -Spi.bak $0 $*" # This script makes #! scripts directly executable on machines that don't # support #!. It edits in place any scripts mentioned on the command line. -s|^#!(.*)|#!$1\neval "exec $1 -S \$0 \$*"\n\tif \$running_under_some_shell;| +s[^#!(.*)] + [#!$1\neval 'exec $1 -S \$0 \${1+"\$@"}'\n\tif \$running_under_some_shell;] if $. == 1; diff --git a/eg/sysvipc/ipcmsg b/eg/sysvipc/ipcmsg index 317e027ea7..646d8b6aed 100644 --- a/eg/sysvipc/ipcmsg +++ b/eg/sysvipc/ipcmsg @@ -1,6 +1,6 @@ #!/usr/bin/perl eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' - if 0; + if $running_under_some_shell; require 'sys/ipc.ph'; require 'sys/msg.ph'; diff --git a/eg/sysvipc/ipcsem b/eg/sysvipc/ipcsem index d72a2dd77c..4d871b901a 100644 --- a/eg/sysvipc/ipcsem +++ b/eg/sysvipc/ipcsem @@ -1,6 +1,6 @@ #!/usr/bin/perl eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' - if 0; + if $running_under_some_shell; require 'sys/ipc.ph'; require 'sys/msg.ph'; diff --git a/eg/sysvipc/ipcshm b/eg/sysvipc/ipcshm index d40e46b945..ecc1ba4366 100644 --- a/eg/sysvipc/ipcshm +++ b/eg/sysvipc/ipcshm @@ -1,6 +1,6 @@ #!/usr/bin/perl eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' - if 0; + if $running_under_some_shell; require 'sys/ipc.ph'; require 'sys/shm.ph'; diff --git a/emacs/cperl-mode.el b/emacs/cperl-mode.el index ba4a863be5..6fa07ad29a 100644 --- a/emacs/cperl-mode.el +++ b/emacs/cperl-mode.el @@ -32,7 +32,7 @@ ;;; Corrections made by Ilya Zakharevich ilya@math.mps.ohio-state.edu ;;; XEmacs changes by Peter Arius arius@informatik.uni-erlangen.de -;; $Id: cperl-mode.el,v 1.29 1996/11/18 23:10:26 ilya Exp ilya $ +;; $Id: cperl-mode.el,v 1.31+ 1996/12/09 08:03:14 ilya Exp ilya $ ;;; To use this mode put the following into your .emacs file: @@ -46,6 +46,10 @@ ;;; in your .emacs file. (Emacs rulers do not consider it politically ;;; correct to make whistles enabled by default.) +;;; DO NOT FORGET to read micro-docs. (available from `Perl' menu). <<<<<< +;;; or as help on variables `cperl-tips', `cperl-problems', <<<<<< +;;; `cperl-non-problems'. <<<<<< + ;;; Additional useful commands to put into your .emacs file: ;; (setq auto-mode-alist @@ -328,6 +332,28 @@ ;;; Minor updates to `cperl-short-docs'. ;;; Will not consider <<= as start of here-doc. +;;;; After 1.29 +;;; Added an extra advice to look into Micro-docs. ;-). +;;; Enclosing of region when you press a closing parenth is regulated by +;;; `cperl-electric-parens-string'. +;;; Minor updates to `cperl-short-docs'. +;;; `initialize-new-tags-table' called only if present (Does this help +;;; with generation of tags under XEmacs?). +;;; When creating/updating tag files, new info is written at the old place, +;;; or at the end (is this a wanted behaviour? I need this in perl build directory). + +;;;; After 1.30 +;;; All the keywords from keywords.pl included (maybe with dummy explanation). +;;; No auto-help inside strings, comment, here-docs, formats, and pods. +;;; Shrinkwrapping of info, regulated by `cperl-max-help-size'. +;;; Info on variables as well. +;;; Recognision of HERE-DOCS improved yet more. +;;; Autonewline works on `}' without warnings. +;;; Autohelp works again on $_[0]. + +;;;; After 1.31 +;;; perl-descr.el found its author - hi, Johan! + (defvar cperl-extra-newline-before-brace nil "*Non-nil means that if, elsif, while, until, else, for, foreach and do constructs look like: @@ -388,7 +414,7 @@ Can be overwritten by `cperl-hairy' if nil.") "*Non-nil (and non-null) means { after $ in CPerl buffers should be preceeded by ` '. Can be overwritten by `cperl-hairy' if nil.") -(defvar cperl-electric-parens-string "({[<" +(defvar cperl-electric-parens-string "({[]})<" "*String of parentheses that should be electric in CPerl.") (defvar cperl-electric-parens nil @@ -455,6 +481,12 @@ You can always make lookup from menu or using \\[cperl-find-pods-heres].") "*Not-nil means add backreferences to generated `imenu's. May require patched `imenu' and `imenu-go'.") +(defvar cperl-max-help-size 66 + "*Non-nil means shrink-wrapping of info-buffer allowed up to these percents.") + +(defvar cperl-shrink-wrap-info-frame t + "*Non-nil means shrink-wrapping of info-buffer-frame allowed.") + (defvar cperl-info-page "perl" "Name of the info page containing perl docs. Older version of this page was called `perl5', newer `perl'.") @@ -548,6 +580,10 @@ will not break indentation, but 1 if ( s#//#/# ); will. +By similar reasons + s\"abc\"def\"; +will confuse CPerl a lot. + If you still get wrong indentation in situation that you think the code should be able to parse, try: @@ -1194,10 +1230,10 @@ char is \"{\", insert extra newline before only if (if cperl-auto-newline (progn (cperl-indent-line) (newline) t) nil))) (progn - (if cperl-auto-newline - (setq insertpos (point))) (insert last-command-char) (cperl-indent-line) + (if cperl-auto-newline + (setq insertpos (1- (point)))) (if (and cperl-auto-newline (null only-before)) (progn (newline) @@ -1282,6 +1318,9 @@ If not, or if we are not at the end of marking range, would self-insert." (interactive "P") (let ((beg (save-excursion (beginning-of-line) (point))) (other-end (if (and cperl-electric-parens-mark + (cperl-val 'cperl-electric-parens) + (memq last-command-char + (append cperl-electric-parens-string nil)) (cperl-mark-active) (< (mark) (point))) (mark) @@ -2137,9 +2176,20 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', "\\(\\`\n?\\|\n\n\\)=" "\\|" ;; One extra () before this: - "<<\\(\\([\"'`]\\)\\([^\"'`\n]*\\)\\3\\|\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)[^=]\\)" ; [^=] to avoid <<=. + "<<" + "\\(" + ;; First variant "BLAH" or just ``. + "\\([\"'`]\\)" + "\\([^\"'`\n]*\\)" + "\\3" + "\\|" + ;; Second variant: Identifier or empty + "\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" + ;; Check that we do not have <<= or << 30 or << $blah. + "\\([^= \t$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" + "\\)" "\\|" - ;; 1+5 extra () before this: + ;; 1+6 extra () before this: "^[ \t]*format[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$"))) (unwind-protect (progn @@ -2240,12 +2290,12 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (t (message "End of here-document `%s' not found." tag))))) ;; format (t - ;; 1+5=6 extra () before this: + ;; 1+6=7 extra () before this: ;; "^[ \t]*format[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$"))) (setq b (point) - name (if (match-beginning 7) ; 6 + 1 - (buffer-substring (match-beginning 7) ; 6 + 1 - (match-end 7)) ; 6 + 1 + name (if (match-beginning 8) ; 7 + 1 + (buffer-substring (match-beginning 8) ; 7 + 1 + (match-end 8)) ; 7 + 1 "")) (setq argument nil) (if cperl-pod-here-fontify @@ -3295,34 +3345,52 @@ Available styles are GNU, K&R, BSD and Whitesmith." (let ((perl-dbg-flags "-wc")) (mode-compile))) -(defun cperl-info-buffer () - ;; Returns buffer with documentation. Creates if missing - (let ((info (get-buffer "*info-perl*"))) +(defun cperl-info-buffer (type) + ;; Returns buffer with documentation. Creates if missing. + ;; If TYPE, this vars buffer. + ;; Special care is taken to not stomp over an existing info buffer + (let* ((bname (if type "*info-perl-var*" "*info-perl*")) + (info (get-buffer bname)) + (oldbuf (get-buffer "*info*"))) (if info info (save-window-excursion ;; Get Info running (require 'info) + (cond (oldbuf + (set-buffer oldbuf) + (rename-buffer "*info-perl-tmp*"))) (save-window-excursion (info)) - (Info-find-node cperl-info-page "perlfunc") + (Info-find-node cperl-info-page (if type "perlvar" "perlfunc")) (set-buffer "*info*") - (rename-buffer "*info-perl*") + (rename-buffer bname) + (cond (oldbuf + (set-buffer "*info-perl-tmp*") + (rename-buffer "*info*") + (set-buffer bname))) + (make-variable-buffer-local 'window-min-height) + (setq window-min-height 2) (current-buffer))))) (defun cperl-word-at-point (&optional p) ;; Returns the word at point or at P. (save-excursion (if p (goto-char p)) - (require 'etags) - (funcall (or (and (boundp 'find-tag-default-function) - find-tag-default-function) - (get major-mode 'find-tag-default-function) - ;; XEmacs 19.12 has `find-tag-default-hook'; it is - ;; automatically used within `find-tag-default': - 'find-tag-default)))) + (or (cperl-word-at-point-hard) + (progn + (require 'etags) + (funcall (or (and (boundp 'find-tag-default-function) + find-tag-default-function) + (get major-mode 'find-tag-default-function) + ;; XEmacs 19.12 has `find-tag-default-hook'; it is + ;; automatically used within `find-tag-default': + 'find-tag-default)))))) (defun cperl-info-on-command (command) - "Shows documentation for Perl command in other window." + "Shows documentation for Perl command in other window. +If perl-info buffer is shown in some frame, uses this frame. +Customized by setting variables `cperl-shrink-wrap-info-frame', +`cperl-max-help-size'." (interactive (let* ((default (cperl-word-at-point)) (read (read-string @@ -3334,21 +3402,72 @@ Available styles are GNU, K&R, BSD and Whitesmith." (let ((buffer (current-buffer)) (cmd-desc (concat "^" (regexp-quote command) "[^a-zA-Z_0-9]")) ; "tr///" - pos) + pos isvar height iniheight frheight buf win fr1 fr2 iniwin not-loner + max-height char-height buf-list) (if (string-match "^-[a-zA-Z]$" command) (setq cmd-desc "^-X[ \t\n]")) - (set-buffer (cperl-info-buffer)) + (setq isvar (string-match "^[$@%]" command) + buf (cperl-info-buffer isvar) + iniwin (selected-window) + fr1 (window-frame iniwin)) + (set-buffer buf) (beginning-of-buffer) - (re-search-forward "^-X[ \t\n]") - (forward-line -1) + (or isvar + (progn (re-search-forward "^-X[ \t\n]") + (forward-line -1))) (if (re-search-forward cmd-desc nil t) (progn - (setq pos (progn (beginning-of-line) - (point))) - (pop-to-buffer (cperl-info-buffer)) + ;; Go back to beginning of the group (ex, for qq) + (if (re-search-backward "^[ \t\n\f]") + (forward-line 1)) + (beginning-of-line) + ;; Get some of + (setq pos (point) + buf-list (list buf "*info-perl-var*" "*info-perl*")) + (while (and (not win) buf-list) + (setq win (get-buffer-window (car buf-list) t)) + (setq buf-list (cdr buf-list))) + (or (not win) + (eq (window-buffer win) buf) + (set-window-buffer win buf)) + (and win (setq fr2 (window-frame win))) + (if (or (not fr2) (eq fr1 fr2)) + (pop-to-buffer buf) + (special-display-popup-frame buf) ; Make it visible + (select-window win)) + (goto-char pos) ; Needed (?!). + ;; Resize + (setq iniheight (window-height) + frheight (frame-height) + not-loner (< iniheight (1- frheight))) ; Are not alone + (cond ((if not-loner cperl-max-help-size + cperl-shrink-wrap-info-frame) + (setq height + (+ 2 + (count-lines + pos + (save-excursion + (if (re-search-forward + "^[ \t][^\n]*\n+\\([^ \t\n\f]\\|\\'\\)" nil t) + (match-beginning 0) (point-max))))) + max-height + (if not-loner + (/ (* (- frheight 3) cperl-max-help-size) 100) + (setq char-height (frame-char-height)) + ;; Non-functioning under OS/2: + (if (eq char-height 1) (setq char-height 18)) + ;; Title, menubar, + 2 for slack + (- (/ (x-display-pixel-height) char-height) 4) + )) + (if (> height max-height) (setq height max-height)) + ;;(message "was %s doing %s" iniheight height) + (if not-loner + (enlarge-window (- height iniheight)) + (set-frame-height (window-frame win) (1+ height))))) (set-window-start (selected-window) pos)) (message "No entry for %s found." command)) - (pop-to-buffer buffer))) + ;;(pop-to-buffer buffer) + (select-window iniwin))) (defun cperl-info-on-current-command () "Shows documentation for Perl command at point in other window." @@ -3373,7 +3492,7 @@ Available styles are GNU, K&R, BSD and Whitesmith." imenu-extract-index-name-function (index-item (save-restriction (save-window-excursion - (set-buffer (cperl-info-buffer)) + (set-buffer (cperl-info-buffer nil)) (setq imenu-create-index-function 'imenu-default-create-index-function imenu-prev-index-position-function @@ -3660,7 +3779,7 @@ in subdirectories too." ) (t (setq xs (string-match "\\.xs$" file)) - (cond ((eq erase 'ignore) nil) + (cond ((eq erase 'ignore) (goto-char (point-max))) (erase (erase-buffer)) (t (goto-char 1) @@ -3671,12 +3790,13 @@ in subdirectories too." (progn (forward-char 1) (search-forward "\f\n" nil 'toend) - (point))) - (goto-char 1))))) + (point)))) + (goto-char (point-max))))) (insert (cperl-find-tags file xs)))) (if inbuffer nil ; Delegate to the caller (save-buffer 0) ; No backup - (initialize-new-tags-table))))) + (if (fboundp 'initialize-new-tags-table) ; Do we need something special in XEmacs? + (initialize-new-tags-table)))))) (defvar cperl-tags-hier-regexp-list "^\\(\\(package\\)\\>\\|sub\\>[^\n]+::\\|[a-zA-Z_][a-zA-Z_0-9:]*(\C-?[^\n]+::\\|[ \t]*BOOT:\C-?[^\n]+::\\)") @@ -3971,11 +4091,12 @@ Currently it is tuned to C and Perl syntax." ;;(concat "\\(" (mapconcat 'identity - '("[$@%*&][0-9a-zA-Z_:]+" ; Usual variable + '("[$@%*&][0-9a-zA-Z_:]+\\([ \t]*[[{]\\)?" ; Usual variable "[$@]\\^[a-zA-Z]" ; Special variable "[$@][^ \n\t]" ; Special variable "-[a-zA-Z]" ; File test "\\\\[a-zA-Z0]" ; Special chars + "^=[a-z][a-zA-Z0-9_]*" ; Pod sections "[-!&*+,-./<=>?\\\\^|~]+" ; Operator "[a-zA-Z_0-9:]+" ; symbol or number "x=" @@ -3989,6 +4110,58 @@ Currently it is tuned to C and Perl syntax." "Matches places in the buffer we can find help for.") (defvar cperl-message-on-help-error t) +(defvar cperl-help-from-timer nil) + +(defun cperl-word-at-point-hard () + ;; Does not save-excursion + ;; Get to the something meaningful + (or (eobp) (eolp) (forward-char 1)) + (re-search-backward "[-a-zA-Z0-9_:!&*+,-./<=>?\\\\^|~$%@]" + (save-excursion (beginning-of-line) (point)) + 'to-beg) + ;; (cond + ;; ((or (eobp) (looking-at "[][ \t\n{}();,]")) ; Not at a symbol + ;; (skip-chars-backward " \n\t\r({[]});,") + ;; (or (bobp) (backward-char 1)))) + ;; Try to backtrace + (cond + ((looking-at "[a-zA-Z0-9_:]") ; symbol + (skip-chars-backward "[a-zA-Z0-9_:]") + (cond + ((and (eq (preceding-char) ?^) ; $^I + (eq (char-after (- (point) 2)) ?\$)) + (forward-char -2)) + ((memq (preceding-char) (append "*$@%&\\" nil)) ; *glob + (forward-char -1)) + ((and (eq (preceding-char) ?\=) + (eq (current-column) 1)) + (forward-char -1))) ; =head1 + (if (and (eq (preceding-char) ?\<) + (looking-at "\\$?[a-zA-Z0-9_:]+>")) ; <FH> + (forward-char -1))) + ((and (looking-at "=") (eq (preceding-char) ?x)) ; x= + (forward-char -1)) + ((and (looking-at "\\^") (eq (preceding-char) ?\$)) ; $^I + (forward-char -1)) + ((looking-at "[-!&*+,-./<=>?\\\\^|~]") + (skip-chars-backward "[-!&*+,-./<=>?\\\\^|~]") + (cond + ((and (eq (preceding-char) ?\$) + (not (eq (char-after (- (point) 2)) ?\$))) ; $- + (forward-char -1)) + ((and (eq (following-char) ?\>) + (string-match "[a-zA-Z0-9_]" (char-to-string (preceding-char))) + (save-excursion + (forward-sexp -1) + (and (eq (preceding-char) ?\<) + (looking-at "\\$?[a-zA-Z0-9_:]+>")))) ; <FH> + (search-backward "<")))) + ((and (eq (following-char) ?\$) + (eq (preceding-char) ?\<) + (looking-at "\\$?[a-zA-Z0-9_:]+>")) ; <$fh> + (forward-char -1))) + (if (looking-at cperl-have-help-regexp) + (buffer-substring (match-beginning 0) (match-end 0)))) (defun cperl-get-help () "Get one-line docs on the symbol at the point. @@ -3996,56 +4169,19 @@ The data for these docs is a little bit obsolete and may be in fact longer than a line. Your contribution to update/shorten it is appreciated." (interactive) (save-excursion - ;; Get to the something meaningful - (or (eobp) (eolp) (forward-char 1)) - (re-search-backward "[-a-zA-Z0-9_:!&*+,-./<=>?\\\\^|~$%@]" - (save-excursion (beginning-of-line) (point)) - 'to-beg) - ;; (cond - ;; ((or (eobp) (looking-at "[][ \t\n{}();,]")) ; Not at a symbol - ;; (skip-chars-backward " \n\t\r({[]});,") - ;; (or (bobp) (backward-char 1)))) - ;; Try to backtrace - (cond - ((looking-at "[a-zA-Z0-9_:]") ; symbol - (skip-chars-backward "[a-zA-Z0-9_:]") - (cond - ((and (eq (preceding-char) ?^) ; $^I - (eq (char-after (- (point) 2)) ?\$)) - (forward-char -2)) - ((memq (preceding-char) (append "*$@%&\\" nil)) ; *glob - (forward-char -1))) - (if (and (eq (preceding-char) ?\<) - (looking-at "\\$?[a-zA-Z0-9_:]+>")) ; <FH> - (forward-char -1))) - ((and (looking-at "=") (eq (preceding-char) ?x)) ; x= - (forward-char -1)) - ((and (looking-at "\\^") (eq (preceding-char) ?\$)) ; $^I - (forward-char -1)) - ((looking-at "[-!&*+,-./<=>?\\\\^|~]") - (skip-chars-backward "[-!&*+,-./<=>?\\\\^|~]") - (cond - ((and (eq (preceding-char) ?\$) - (not (eq (char-after (- (point) 2)) ?\$))) ; $- - (forward-char -1)) - ((and (eq (following-char) ?\>) - (string-match "[a-zA-Z0-9_]" (char-to-string (preceding-char))) - (save-excursion - (forward-sexp -1) - (and (eq (preceding-char) ?\<) - (looking-at "\\$?[a-zA-Z0-9_:]+>")))) ; <FH> - (search-backward "<")))) - ((and (eq (following-char) ?\$) - (eq (preceding-char) ?\<) - (looking-at "\\$?[a-zA-Z0-9_:]+>")) ; <$fh> - (forward-char -1))) - ;;(or (eobp) (forward-char 1)) - (if (looking-at cperl-have-help-regexp) - (cperl-describe-perl-symbol - (buffer-substring (match-beginning 0) (match-end 0))) - (if cperl-message-on-help-error - (message "Nothing found for %s..." - (buffer-substring (point) (+ 5 (point)))))))) + (let ((word (cperl-word-at-point-hard))) + (if word + (if (and cperl-help-from-timer ; Bail out if not in mainland + (not (string-match "^#!\\|\\\\\\|^=" word)) ; Show help even in comments/strings. + (or (memq (get-text-property (point) 'face) + '(font-lock-comment-face font-lock-string-face)) + (memq (get-text-property (point) 'syntax-type) + '(pod here-doc format)))) + nil + (cperl-describe-perl-symbol word)) + (if cperl-message-on-help-error + (message "Nothing found for %s..." + (buffer-substring (point) (+ 5 (point))))))))) ;;; Stolen from perl-descr.el by Johan Vromans: @@ -4054,46 +4190,27 @@ than a line. Your contribution to update/shorten it is appreciated." (defun cperl-describe-perl-symbol (val) "Display the documentation of symbol at point, a Perl operator." - ;; We suppose that the current position is at the start of the symbol - ;; when we convert $_[5] to @_ - (let (;;(fn (perl-symbol-at-point)) - (enable-recursive-minibuffers t) - ;;val + (let ((enable-recursive-minibuffers t) args-file regexp) - ;; (interactive - ;; (let ((fn (perl-symbol-at-point)) - ;; (enable-recursive-minibuffers t) - ;; val args-file regexp) - ;; (setq val (read-from-minibuffer - ;; (if fn - ;; (format "Symbol (default %s): " fn) - ;; "Symbol: "))) - ;; (if (string= val "") - ;; (setq val fn)) (cond ((string-match "^[&*][a-zA-Z_]" val) (setq val (concat (substring val 0 1) "NAME"))) - ((looking-at "[$@][a-zA-Z_:0-9]+\\([[{]\\)") - (if (= ?\[ (char-after (match-beginning 1))) - (setq val (concat "@" (substring val 1))) - (setq val (concat "%" (substring val 1))))) - ((and (string= val "x") (looking-at "x=")) + ((string-match "^[$@]\\([a-zA-Z_:0-9]+\\)[ \t]*\\[" val) + (setq val (concat "@" (substring val 1 (match-end 1))))) + ((string-match "^[$@]\\([a-zA-Z_:0-9]+\\)[ \t]*{" val) + (setq val (concat "%" (substring val 1 (match-end 1))))) + ((and (string= val "x") (string-match "^x=" val)) (setq val "x=")) ((string-match "^\\$[\C-a-\C-z]" val) (setq val (concat "$^" (char-to-string (+ ?A -1 (aref val 1)))))) - ((and (string= "<" val) (looking-at "<\\$?[a-zA-Z0-9_:]+>")) + ((string-match "^CORE::" val) + (setq val "CORE::")) + ((string-match "^SUPER::" val) + (setq val "SUPER::")) + ((and (string= "<" val) (string-match "^<\\$?[a-zA-Z0-9_:]+>" val)) (setq val "<NAME>"))) -;;; (if (string-match "^[&*][a-zA-Z_]" val) -;;; (setq val (concat (substring val 0 1) "NAME")) -;;; (if (looking-at "[$@][a-zA-Z_:0-9]+\\([[{]\\)") -;;; (if (= ?\[ (char-after (match-beginning 1))) -;;; (setq val (concat "@" (substring val 1))) -;;; (setq val (concat "%" (substring val 1)))) -;;; (if (and (string= val "x") (looking-at "x=")) -;;; (setq val "x=") -;;; (if (looking-at "[$@][a-zA-Z_:0-9]") -;;; )))) - (setq regexp (concat "^" "\\([^a-zA-Z0-9_:]+[ \t]\\)?" + (setq regexp (concat "^" + "\\([^a-zA-Z0-9_:]+[ \t]+\\)?" (regexp-quote val) "\\([ \t([/]\\|$\\)")) @@ -4114,14 +4231,15 @@ than a line. Your contribution to update/shorten it is appreciated." (message "No definition for %s" val))))))) (defvar cperl-short-docs "Ignore my value" + ;; Perl4 version was written by Johan Vromans (jvromans@squirrel.nl) "# based on '@(#)@ perl-descr.el 1.9 - describe-perl-symbol' [Perl 5] -! Logical negation. -!= Numeric inequality. -!~ Search pattern, substitution, or translation (negated). +! ... Logical negation. +... != ... Numeric inequality. +... !~ ... Search pattern, substitution, or translation (negated). $! In numeric context: errno. In a string context: error string. $\" The separator which joins elements of arrays interpolated in strings. $# The output format for printed numbers. Initial value is %.20g. -$$ The process number of the perl running this script. Altered (in the child process) by fork(). +$$ Process number of this script. Changes in the fork()ed child process. $% The current page number of the currently selected output channel. The following variables are always local to the current block: @@ -4147,9 +4265,9 @@ $, The output field separator for the print operator. $- The number of lines left on the page. $. The current input line number of the last filehandle that was read. $/ The input record separator, newline by default. -$0 The name of the file containing the perl script being executed. May be set -$: The set of characters after which a string may be broken to fill continuation fields (starting with ^) in a format. -$; The subscript separator for multi-dimensional array emulation. Default is \"\\034\". +$0 Name of the file containing the perl script being executed. May be set. +$: String may be broken after these characters to fill ^-lines in a format. +$; Subscript separator for multi-dim array emulation. Default \"\\034\". $< The real uid of this process. $= The page length of the current output channel. Default is 60 lines. $> The effective uid of this process. @@ -4173,28 +4291,28 @@ $^T The time the script was started. Used by -A/-M/-C file tests. $^W True if warnings are requested (perl -w flag). $^X The name under which perl was invoked (argv[0] in C-speech). $_ The default input and pattern-searching space. -$| Flag for auto-flush after write/print on the currently selected output channel. Default is 0. +$| Auto-flush after write/print on the current output channel? Default 0. $~ The name of the current report format. -% Modulo division. -%= Modulo division assignment. +... % ... Modulo division. +... %= ... Modulo division assignment. %ENV Contains the current environment. %INC List of files that have been require-d or do-ne. %SIG Used to set signal handlers for various signals. -& Bitwise and. -&& Logical and. -&&= Logical and assignment. -&= Bitwise and assignment. -* Multiplication. -** Exponentiation. -*NAME Refers to all objects represented by NAME. *NAM1 = *NAM2 makes NAM1 a reference to NAM2. +... & ... Bitwise and. +... && ... Logical and. +... &&= ... Logical and assignment. +... &= ... Bitwise and assignment. +... * ... Multiplication. +... ** ... Exponentiation. +*NAME Glob: all objects refered by NAME. *NAM1 = *NAM2 aliases NAM1 to NAM2. &NAME(arg0, ...) Subroutine call. Arguments go to @_. -+ Addition. -++ Auto-increment (magical on strings). -+= Addition assignment. +... + ... Addition. +EXPR Makes EXPR into scalar context. +++ Auto-increment (magical on strings). ++EXPR EXPR++ +... += ... Addition assignment. , Comma operator. -- Subtraction. --- Auto-decrement. --= Subtraction assignment. +... - ... Subtraction. +-- Auto-decrement (NOT magical on strings). --EXPR EXPR-- +... -= ... Subtraction assignment. -A Access time in days since script started. -B File is a non-text (binary) file. -C Inode change time in days since script started. @@ -4225,54 +4343,54 @@ $~ The name of the current report format. . Concatenate strings. .. Alternation, also range operator. .= Concatenate assignment strings -/ Division. /PATTERN/ioxsmg Pattern match -/= Division assignment. +... / ... Division. /PATTERN/ioxsmg Pattern match +... /= ... Division assignment. /PATTERN/ioxsmg Pattern match. -< Numeric less than. <pattern> Glob. See <NAME>, <> as well. +... < ... Numeric less than. <pattern> Glob. See <NAME>, <> as well. <NAME> Reads line from filehandle NAME. NAME must be bareword/dollar-bareword. <pattern> Glob. (Unless pattern is bareword/dollar-bareword - see <NAME>) <> Reads line from union of files in @ARGV (= command line) and STDIN. -<< Bitwise shift left. << start of HERE-DOCUMENT. -<= Numeric less than or equal to. -<=> Numeric compare. -= Assignment. -== Numeric equality. -=~ Search pattern, substitution, or translation -> Numeric greater than. ->= Numeric greater than or equal to. ->> Bitwise shift right. ->>= Bitwise shift right assignment. -? : Alternation (if-then-else) operator. ?PAT? Backwards pattern match. -?PATTERN? Backwards pattern match. +... << ... Bitwise shift left. << start of HERE-DOCUMENT. +... <= ... Numeric less than or equal to. +... <=> ... Numeric compare. +... = ... Assignment. +... == ... Numeric equality. +... =~ ... Search pattern, substitution, or translation +... > ... Numeric greater than. +... >= ... Numeric greater than or equal to. +... >> ... Bitwise shift right. +... >>= ... Bitwise shift right assignment. +... ? ... : ... Condition=if-then-else operator. ?PAT? One-time pattern match. +?PATTERN? One-time pattern match. @ARGV Command line arguments (not including the command name - see $0). @INC List of places to look for perl scripts during do/include/use. @_ Parameter array for subroutines. Also used by split unless in array context. \\ Creates a reference to whatever follows, like \$var. \\0 Octal char, e.g. \\033. \\E Case modification terminator. See \\Q, \\L, and \\U. -\\L Lowercase until \\E . -\\U Upcase until \\E . -\\Q Quote metacharacters until \\E . +\\L Lowercase until \\E . See also \l, lc. +\\U Upcase until \\E . See also \u, uc. +\\Q Quote metacharacters until \\E . See also quotemeta. \\a Alarm character (octal 007). \\b Backspace character (octal 010). \\c Control character, e.g. \\c[ . \\e Escape character (octal 033). \\f Formfeed character (octal 014). -\\l Lowercase of next character. See also \\L and \\u, +\\l Lowercase the next character. See also \\L and \\u, lcfirst, \\n Newline character (octal 012). \\r Return character (octal 015). \\t Tab character (octal 011). -\\u Upcase of next character. See also \\U and \\l, +\\u Upcase the next character. See also \\U and \\l, ucfirst, \\x Hex character, e.g. \\x1b. -^ Bitwise exclusive or. -__END__ End of program source. -__DATA__ End of program source. +^ ... Bitwise exclusive or. +__END__ Ends program source. +__DATA__ Ends program source. __FILE__ Current (source) filename. __LINE__ Current line in current source. ARGV Default multi-file input filehandle. <ARGV> is a synonym for <>. ARGVOUT Output filehandle with -i flag. -BEGIN { block } Immediately executed (during compilation) piece of code. -END { block } Pseudo-subroutine executed after the script finishes. +BEGIN { ... } Immediately executed (during compilation) piece of code. +END { ... } Pseudo-subroutine executed after the script finishes. DATA Input filehandle for what follows after __END__ or __DATA__. accept(NEWSOCKET,GENERICSOCKET) alarm(SECONDS) @@ -4287,20 +4405,20 @@ chown(LIST) chroot(FILENAME) close(FILEHANDLE) closedir(DIRHANDLE) -cmp String compare. +... cmp ... String compare. connect(SOCKET,NAME) continue of { block } continue { block }. Is executed after `next' or at end. cos(EXPR) crypt(PLAINTEXT,SALT) -dbmclose(ASSOC_ARRAY) -dbmopen(ASSOC,DBNAME,MODE) +dbmclose(%HASH) +dbmopen(%HASH,DBNAME,MODE) defined(EXPR) -delete($ASSOC{KEY}) +delete($HASH{KEY}) die(LIST) do { ... }|SUBR while|until EXPR executes at least once do(EXPR|SUBR([LIST])) dump LABEL -each(ASSOC_ARRAY) +each(%HASH) endgrent endhostent endnetent @@ -4308,7 +4426,7 @@ endprotoent endpwent endservent eof[([FILEHANDLE])] -eq String equality. +... eq ... String equality. eval(EXPR) or eval { BLOCK } exec(LIST) exit(EXPR) @@ -4319,7 +4437,7 @@ flock(FILEHANDLE,OPERATION) for (EXPR;EXPR;EXPR) { ... } foreach [VAR] (@ARRAY) { ... } fork -ge String greater than or equal. +... ge ... String greater than or equal. getc[(FILEHANDLE)] getgrent getgrgid(GID) @@ -4349,17 +4467,17 @@ getsockopt(SOCKET,LEVEL,OPTNAME) gmtime(EXPR) goto LABEL grep(EXPR,LIST) -gt String greater than. +... gt ... String greater than. hex(EXPR) if (EXPR) { ... } [ elsif (EXPR) { ... } ... ] [ else { ... } ] or EXPR if EXPR index(STR,SUBSTR[,OFFSET]) int(EXPR) ioctl(FILEHANDLE,FUNCTION,SCALAR) join(EXPR,LIST) -keys(ASSOC_ARRAY) +keys(%HASH) kill(LIST) last [LABEL] -le String less than or equal. +... le ... String less than or equal. length(EXPR) link(OLDFILE,NEWFILE) listen(SOCKET,QUEUESIZE) @@ -4367,7 +4485,7 @@ local(LIST) localtime(EXPR) log(EXPR) lstat(EXPR|FILEHANDLE|VAR) -lt String less than. +... lt ... String less than. m/PATTERN/iogsmx mkdir(FILENAME,MODE) msgctl(ID,CMD,ARG) @@ -4375,14 +4493,14 @@ msgget(KEY,FLAGS) msgrcv(ID,VAR,SIZE,TYPE.FLAGS) msgsnd(ID,MSG,FLAGS) my VAR or my (VAR1,...) Introduces a lexical variable ($VAR, @ARR, or %HASH). -ne String inequality. +... ne ... String inequality. next [LABEL] oct(EXPR) open(FILEHANDLE[,EXPR]) opendir(DIRHANDLE,EXPR) ord(EXPR) pack(TEMPLATE,LIST) -package Introduces package context. +package NAME Introduces package context. pipe(READHANDLE,WRITEHANDLE) pop(ARRAY) print [FILEHANDLE] [(LIST)] @@ -4441,7 +4559,7 @@ sqrt(EXPR) srand(EXPR) stat(EXPR|FILEHANDLE|VAR) study[(SCALAR)] -sub [NAME [(format)]] { BODY } or sub [NAME [(format)]]; +sub [NAME [(format)]] { BODY } sub NAME [(format)]; sub [(format)] {...} substr(EXPR,OFFSET[,LEN]) symlink(OLDFILE,NEWFILE) syscall(LIST) @@ -4460,23 +4578,73 @@ unless (EXPR) { ... } [ else { ... } ] or EXPR unless EXPR unlink(LIST) unpack(TEMPLATE,EXPR) unshift(ARRAY,LIST) -until (EXPR) { ... } or EXPR until EXPR +until (EXPR) { ... } EXPR until EXPR utime(LIST) -values(ASSOC_ARRAY) +values(%HASH) vec(EXPR,OFFSET,BITS) wait waitpid(PID,FLAGS) wantarray warn(LIST) -while (EXPR) { ... } or EXPR while EXPR +while (EXPR) { ... } EXPR while EXPR write[(EXPR|FILEHANDLE)] -x Repeat string or array. -x= Repetition assignment. +... x ... Repeat string or array. +x= ... Repetition assignment. y/SEARCHLIST/REPLACEMENTLIST/ -| Bitwise or. -|| Logical or. -~ Unary bitwise complement. +... | ... Bitwise or. +... || ... Logical or. +~ ... Unary bitwise complement. #! OS interpreter indicator. If contains `perl', used for options, and -x. +AUTOLOAD {...} Shorthand for `sub AUTOLOAD {...}'. +CORE:: Prefix to access builtin function if imported sub obscures it. +SUPER:: Prefix to lookup for a method in @ISA classes. +DESTROY Shorthand for `sub DESTROY {...}'. +... EQ ... Obsolete synonym of `eq'. +... GE ... Obsolete synonym of `ge'. +... GT ... Obsolete synonym of `gt'. +... LE ... Obsolete synonym of `le'. +... LT ... Obsolete synonym of `lt'. +... NE ... Obsolete synonym of `ne'. +abs [ EXPR ] absolute value +... and ... Low-precedence synonym for &&. +bless REFERENCE [, PACKAGE] Makes reference into an object of a package. +chomp Docs missing +chr Docs missing +else Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}. +elsif Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}. +exists $HASH{KEY} True if the key exists. +format Docs missing +formline Docs missing +glob EXPR Synonym of <EXPR>. +lc [ EXPR ] Returns lowercased EXPR. +lcfirst [ EXPR ] Returns EXPR with lower-cased first letter. +map Docs missing +no PACKAGE [SYMBOL1, ...] Partial reverse for `use'. Runs `unimport' method. +... not ... Low-precedence synonym for ! - negation. +... or ... Low-precedence synonym for ||. +pos STRING Set/Get end-position of the last match over this string, see \\G. +quotemeta [ EXPR ] Quote metacharacters. +qw Docs missing +readline FH Synonym of <FH>. +readpipe CMD Synonym of `CMD`. +ref [ EXPR ] Type of EXPR when dereferenced. +sysopen Docs missing +tie Docs missing +tied Docs missing +uc [ EXPR ] Returns upcased EXPR. +ucfirst [ EXPR ] Returns EXPR with upcased first letter. +untie Docs missing +use PACKAGE [SYMBOL1, ...] Compile-time `require' with consequent `import'. +... xor ... Low-precedence synonym for exclusive or. +prototype \&SUB Returns prototype of the function given a reference. +=head1 Top-level heading. +=head2 Second-level heading. +=head3 Third-level heading (is there such?). +=over [ NUMBER ] Start list. +=item [ TITLE ] Start new item in the list. +=back End list. +=cut Switch from POD to Perl. +=pod Switch from Perl to POD. ") (defun cperl-switch-to-doc-buffer () @@ -4522,7 +4690,7 @@ y/SEARCHLIST/REPLACEMENTLIST/ (defun cperl-get-help-defer () (if (not (eq major-mode 'perl-mode)) nil - (let ((cperl-message-on-help-error nil)) + (let ((cperl-message-on-help-error nil) (cperl-help-from-timer t)) (cperl-get-help) (setq cperl-help-shown t)))) (cperl-lazy-install))) @@ -1,6 +1,6 @@ /* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! - This file is built by embed.pl from global.sym and interp.sym. - Any changes made here will be lost + This file is built by embed.pl from global.sym, interp.sym, + and compat3.sym. Any changes made here will be lost! */ /* (Doing namespace management portably in C is really gross.) */ @@ -15,1603 +15,1615 @@ # define EMBED 1 #endif +/* Hide global symbols? */ + #ifdef EMBED -/* globals we need to hide from the world */ -#define AMG_names Perl_AMG_names -#define Error Perl_Error -#define He Perl_He -#define No Perl_No -#define Sv Perl_Sv -#define Xpv Perl_Xpv -#define Yes Perl_Yes -#define abs_amg Perl_abs_amg -#define add_amg Perl_add_amg -#define add_ass_amg Perl_add_ass_amg -#define additem Perl_additem +#define AMG_names Perl_AMG_names +#define Gv_AMupdate Perl_Gv_AMupdate +#define No Perl_No +#define Sv Perl_Sv +#define Xpv Perl_Xpv +#define Yes Perl_Yes +#define abs_amg Perl_abs_amg +#define add_amg Perl_add_amg +#define add_ass_amg Perl_add_ass_amg +#define additem Perl_additem +#define amagic_call Perl_amagic_call #define amagic_generation Perl_amagic_generation -#define an Perl_an -#define atan2_amg Perl_atan2_amg -#define band_amg Perl_band_amg -#define block_type Perl_block_type -#define bool__amg Perl_bool__amg -#define bor_amg Perl_bor_amg -#define buf Perl_buf -#define bufend Perl_bufend -#define bufptr Perl_bufptr -#define bxor_amg Perl_bxor_amg -#define check Perl_check -#define collation_ix Perl_collation_ix -#define collation_name Perl_collation_name +#define an Perl_an +#define append_elem Perl_append_elem +#define append_list Perl_append_list +#define apply Perl_apply +#define assertref Perl_assertref +#define atan2_amg Perl_atan2_amg +#define av_clear Perl_av_clear +#define av_extend Perl_av_extend +#define av_fake Perl_av_fake +#define av_fetch Perl_av_fetch +#define av_fill Perl_av_fill +#define av_len Perl_av_len +#define av_make Perl_av_make +#define av_pop Perl_av_pop +#define av_push Perl_av_push +#define av_shift Perl_av_shift +#define av_store Perl_av_store +#define av_undef Perl_av_undef +#define av_unshift Perl_av_unshift +#define band_amg Perl_band_amg +#define bind_match Perl_bind_match +#define block_end Perl_block_end +#define block_start Perl_block_start +#define bool__amg Perl_bool__amg +#define bor_amg Perl_bor_amg +#define buf Perl_buf +#define bufend Perl_bufend +#define bufptr Perl_bufptr +#define bxor_amg Perl_bxor_amg +#define calllist Perl_calllist +#define cando Perl_cando +#define cast_ulong Perl_cast_ulong +#define check Perl_check +#define check_uni Perl_check_uni +#define checkcomma Perl_checkcomma +#define ck_aelem Perl_ck_aelem +#define ck_bitop Perl_ck_bitop +#define ck_concat Perl_ck_concat +#define ck_delete Perl_ck_delete +#define ck_eof Perl_ck_eof +#define ck_eval Perl_ck_eval +#define ck_exec Perl_ck_exec +#define ck_ftst Perl_ck_ftst +#define ck_fun Perl_ck_fun +#define ck_fun_locale Perl_ck_fun_locale +#define ck_glob Perl_ck_glob +#define ck_grep Perl_ck_grep +#define ck_gvconst Perl_ck_gvconst +#define ck_index Perl_ck_index +#define ck_lengthconst Perl_ck_lengthconst +#define ck_lfun Perl_ck_lfun +#define ck_listiob Perl_ck_listiob +#define ck_match Perl_ck_match +#define ck_null Perl_ck_null +#define ck_repeat Perl_ck_repeat +#define ck_require Perl_ck_require +#define ck_retarget Perl_ck_retarget +#define ck_rfun Perl_ck_rfun +#define ck_rvconst Perl_ck_rvconst +#define ck_scmp Perl_ck_scmp +#define ck_select Perl_ck_select +#define ck_shift Perl_ck_shift +#define ck_sort Perl_ck_sort +#define ck_spair Perl_ck_spair +#define ck_split Perl_ck_split +#define ck_subr Perl_ck_subr +#define ck_svconst Perl_ck_svconst +#define ck_trunc Perl_ck_trunc +#define collation_ix Perl_collation_ix +#define collation_name Perl_collation_name #define collation_standard Perl_collation_standard -#define collxfrm_base Perl_collxfrm_base -#define collxfrm_mult Perl_collxfrm_mult -#define compcv Perl_compcv -#define compiling Perl_compiling -#define compl_amg Perl_compl_amg -#define comppad Perl_comppad -#define comppad_name Perl_comppad_name +#define collxfrm_base Perl_collxfrm_base +#define collxfrm_mult Perl_collxfrm_mult +#define compcv Perl_compcv +#define compiling Perl_compiling +#define compl_amg Perl_compl_amg +#define comppad Perl_comppad +#define comppad_name Perl_comppad_name #define comppad_name_fill Perl_comppad_name_fill -#define comppad_name_floor Perl_comppad_name_floor -#define concat_amg Perl_concat_amg -#define concat_ass_amg Perl_concat_ass_amg -#define cop_seqmax Perl_cop_seqmax -#define cos_amg Perl_cos_amg -#define cryptseen Perl_cryptseen -#define cshlen Perl_cshlen -#define cshname Perl_cshname -#define curinterp Perl_curinterp -#define curpad Perl_curpad -#define cv_const_sv Perl_cv_const_sv -#define dc Perl_dc -#define debug Perl_debug -#define dec_amg Perl_dec_amg -#define di Perl_di -#define div_amg Perl_div_amg -#define div_ass_amg Perl_div_ass_amg -#define do_undump Perl_do_undump -#define ds Perl_ds -#define egid Perl_egid -#define eq_amg Perl_eq_amg -#define error_count Perl_error_count -#define euid Perl_euid -#define evalseq Perl_evalseq -#define exp_amg Perl_exp_amg -#define expect Perl_expect -#define expectterm Perl_expectterm -#define fallback_amg Perl_fallback_amg -#define filter_add Perl_filter_add -#define filter_del Perl_filter_del -#define filter_read Perl_filter_read -#define fold Perl_fold -#define fold_locale Perl_fold_locale -#define freq Perl_freq -#define ge_amg Perl_ge_amg -#define gid Perl_gid -#define gt_amg Perl_gt_amg -#define hexdigit Perl_hexdigit -#define hints Perl_hints -#define in_my Perl_in_my -#define inc_amg Perl_inc_amg -#define io_close Perl_io_close -#define know_next Perl_know_next -#define last_lop Perl_last_lop -#define last_lop_op Perl_last_lop_op -#define last_uni Perl_last_uni -#define le_amg Perl_le_amg -#define lex_brackets Perl_lex_brackets -#define lex_brackstack Perl_lex_brackstack -#define lex_casemods Perl_lex_casemods -#define lex_casestack Perl_lex_casestack -#define lex_defer Perl_lex_defer -#define lex_dojoin Perl_lex_dojoin -#define lex_expect Perl_lex_expect -#define lex_fakebrack Perl_lex_fakebrack -#define lex_formbrack Perl_lex_formbrack -#define lex_inpat Perl_lex_inpat -#define lex_inwhat Perl_lex_inwhat -#define lex_op Perl_lex_op -#define lex_repl Perl_lex_repl -#define lex_starts Perl_lex_starts -#define lex_state Perl_lex_state -#define lex_stuff Perl_lex_stuff -#define linestr Perl_linestr -#define log_amg Perl_log_amg -#define lshift_amg Perl_lshift_amg -#define lshift_ass_amg Perl_lshift_ass_amg -#define lt_amg Perl_lt_amg -#define markstack Perl_markstack -#define markstack_max Perl_markstack_max -#define markstack_ptr Perl_markstack_ptr -#define max_intro_pending Perl_max_intro_pending -#define maxo Perl_maxo -#define min_intro_pending Perl_min_intro_pending -#define mod_amg Perl_mod_amg -#define mod_ass_amg Perl_mod_ass_amg -#define mult_amg Perl_mult_amg -#define mult_ass_amg Perl_mult_ass_amg -#define multi_close Perl_multi_close -#define multi_end Perl_multi_end -#define multi_open Perl_multi_open -#define multi_start Perl_multi_start -#define na Perl_na -#define ncmp_amg Perl_ncmp_amg -#define ne_amg Perl_ne_amg -#define neg_amg Perl_neg_amg -#define nexttoke Perl_nexttoke -#define nexttype Perl_nexttype -#define nexttype Perl_nexttype -#define nextval Perl_nextval -#define nextval Perl_nextval -#define nice_chunk Perl_nice_chunk -#define nice_chunk_size Perl_nice_chunk_size -#define no_aelem Perl_no_aelem -#define no_dir_func Perl_no_dir_func -#define no_func Perl_no_func -#define no_helem Perl_no_helem -#define no_mem Perl_no_mem -#define no_modify Perl_no_modify -#define no_myglob Perl_no_myglob -#define no_security Perl_no_security -#define no_sock_func Perl_no_sock_func -#define no_symref Perl_no_symref -#define no_usym Perl_no_usym -#define no_wrongref Perl_no_wrongref -#define nointrp Perl_nointrp -#define nomem Perl_nomem -#define nomemok Perl_nomemok -#define nomethod_amg Perl_nomethod_amg -#define not_amg Perl_not_amg -#define numeric_local Perl_numeric_local -#define numeric_name Perl_numeric_name -#define numeric_standard Perl_numeric_standard -#define numer_amg Perl_numer_amg -#define oldbufptr Perl_oldbufptr -#define oldoldbufptr Perl_oldoldbufptr -#define op Perl_op -#define op_desc Perl_op_desc -#define op_name Perl_op_name -#define op_seqmax Perl_op_seqmax -#define opargs Perl_opargs -#define origalen Perl_origalen -#define origenviron Perl_origenviron -#define osname Perl_osname -#define pad_reset_pending Perl_pad_reset_pending -#define padix Perl_padix -#define padix_floor Perl_padix_floor -#define patleave Perl_patleave -#define pow_amg Perl_pow_amg -#define pow_ass_amg Perl_pow_ass_amg -#define ppaddr Perl_ppaddr -#define profiledata Perl_profiledata -#define provide_ref Perl_provide_ref -#define psig_name Perl_psig_name -#define psig_ptr Perl_psig_ptr -#define qrt_amg Perl_qrt_amg -#define rcsid Perl_rcsid -#define reall_srchlen Perl_reall_srchlen -#define regarglen Perl_regarglen -#define regbol Perl_regbol -#define regcode Perl_regcode -#define regdummy Perl_regdummy -#define regendp Perl_regendp -#define regeol Perl_regeol -#define regflags Perl_regflags -#define reginput Perl_reginput -#define regkind Perl_regkind -#define reglastparen Perl_reglastparen -#define regmyendp Perl_regmyendp -#define regmyp_size Perl_regmyp_size -#define regmystartp Perl_regmystartp -#define regnarrate Perl_regnarrate -#define regnaughty Perl_regnaughty -#define regnpar Perl_regnpar -#define regparse Perl_regparse -#define regprecomp Perl_regprecomp -#define regprev Perl_regprev -#define regsawback Perl_regsawback -#define regsize Perl_regsize -#define regstartp Perl_regstartp -#define regtill Perl_regtill -#define regxend Perl_regxend -#define repeat_amg Perl_repeat_amg -#define repeat_ass_amg Perl_repeat_ass_amg -#define retstack Perl_retstack -#define retstack_ix Perl_retstack_ix -#define retstack_max Perl_retstack_max -#define rsfp Perl_rsfp -#define rsfp_filters Perl_rsfp_filters -#define rshift_amg Perl_rshift_amg -#define rshift_ass_amg Perl_rshift_ass_amg -#define save_iv Perl_save_iv -#define save_pptr Perl_save_pptr -#define savestack Perl_savestack -#define savestack_ix Perl_savestack_ix -#define savestack_max Perl_savestack_max -#define saw_return Perl_saw_return -#define scmp_amg Perl_scmp_amg -#define scopestack Perl_scopestack -#define scopestack_ix Perl_scopestack_ix -#define scopestack_max Perl_scopestack_max -#define scrgv Perl_scrgv -#define seq_amg Perl_seq_amg -#define sge_amg Perl_sge_amg -#define sgt_amg Perl_sgt_amg -#define sh_path Perl_sh_path -#define sig_name Perl_sig_name -#define sig_num Perl_sig_num -#define sighandler Perl_sighandler -#define simple Perl_simple -#define sin_amg Perl_sin_amg -#define sle_amg Perl_sle_amg -#define slt_amg Perl_slt_amg -#define sne_amg Perl_sne_amg -#define stack_base Perl_stack_base -#define stack_max Perl_stack_max -#define stack_sp Perl_stack_sp -#define statbuf Perl_statbuf -#define string_amg Perl_string_amg -#define sub_generation Perl_sub_generation -#define subline Perl_subline -#define subname Perl_subname -#define subtr_amg Perl_subtr_amg -#define subtr_ass_amg Perl_subtr_ass_amg -#define sv_no Perl_sv_no -#define sv_undef Perl_sv_undef -#define sv_yes Perl_sv_yes -#define thisexpr Perl_thisexpr -#define timesbuf Perl_timesbuf -#define tokenbuf Perl_tokenbuf -#define uid Perl_uid -#define varies Perl_varies -#define vert Perl_vert -#define vtbl_amagic Perl_vtbl_amagic -#define vtbl_amagicelem Perl_vtbl_amagicelem -#define vtbl_arylen Perl_vtbl_arylen -#define vtbl_bm Perl_vtbl_bm -#define vtbl_collxfrm Perl_vtbl_collxfrm -#define vtbl_dbline Perl_vtbl_dbline -#define vtbl_env Perl_vtbl_env -#define vtbl_envelem Perl_vtbl_envelem -#define vtbl_fm Perl_vtbl_fm -#define vtbl_glob Perl_vtbl_glob -#define vtbl_isa Perl_vtbl_isa -#define vtbl_isaelem Perl_vtbl_isaelem -#define vtbl_mglob Perl_vtbl_mglob -#define vtbl_nkeys Perl_vtbl_nkeys -#define vtbl_pack Perl_vtbl_pack -#define vtbl_packelem Perl_vtbl_packelem -#define vtbl_pos Perl_vtbl_pos -#define vtbl_sig Perl_vtbl_sig -#define vtbl_sigelem Perl_vtbl_sigelem -#define vtbl_substr Perl_vtbl_substr -#define vtbl_sv Perl_vtbl_sv -#define vtbl_taint Perl_vtbl_taint -#define vtbl_uvar Perl_vtbl_uvar -#define vtbl_vec Perl_vtbl_vec -#define warn_nl Perl_warn_nl -#define warn_nosemi Perl_warn_nosemi -#define warn_reserved Perl_warn_reserved -#define warn_uninit Perl_warn_uninit -#define watchaddr Perl_watchaddr -#define watchok Perl_watchok -#define yychar Perl_yychar -#define yycheck Perl_yycheck -#define yydebug Perl_yydebug -#define yydefred Perl_yydefred -#define yydgoto Perl_yydgoto -#define yyerrflag Perl_yyerrflag -#define yygindex Perl_yygindex -#define yylen Perl_yylen -#define yylhs Perl_yylhs -#define yylval Perl_yylval -#define yyname Perl_yyname -#define yynerrs Perl_yynerrs -#define yyrindex Perl_yyrindex -#define yyrule Perl_yyrule -#define yysindex Perl_yysindex -#define yytable Perl_yytable -#define yyval Perl_yyval -#define Gv_AMupdate Perl_Gv_AMupdate -#define SvTRUE Perl_SvTRUE -#define SvIV Perl_SvIV -#define SvUV Perl_SvUV -#define SvNV Perl_SvNV -#define amagic_call Perl_amagic_call -#define append_elem Perl_append_elem -#define append_list Perl_append_list -#define apply Perl_apply -#define assertref Perl_assertref -#define av_clear Perl_av_clear -#define av_extend Perl_av_extend -#define av_fake Perl_av_fake -#define av_fetch Perl_av_fetch -#define av_fill Perl_av_fill -#define av_len Perl_av_len -#define av_make Perl_av_make -#define av_pop Perl_av_pop -#define av_push Perl_av_push -#define av_shift Perl_av_shift -#define av_store Perl_av_store -#define av_undef Perl_av_undef -#define av_unshift Perl_av_unshift -#define bind_match Perl_bind_match -#define block_end Perl_block_end -#define block_start Perl_block_start -#define boot_core_UNIVERSAL Perl_boot_core_UNIVERSAL -#define calllist Perl_calllist -#define cando Perl_cando -#define cast_ulong Perl_cast_ulong -#define check_uni Perl_check_uni -#define checkcomma Perl_checkcomma -#define ck_aelem Perl_ck_aelem -#define ck_bitop Perl_ck_bitop -#define ck_concat Perl_ck_concat -#define ck_delete Perl_ck_delete -#define ck_eof Perl_ck_eof -#define ck_eval Perl_ck_eval -#define ck_exec Perl_ck_exec -#define ck_ftst Perl_ck_ftst -#define ck_fun Perl_ck_fun -#define ck_fun_locale Perl_ck_fun_locale -#define ck_glob Perl_ck_glob -#define ck_grep Perl_ck_grep -#define ck_gvconst Perl_ck_gvconst -#define ck_index Perl_ck_index -#define ck_lengthconst Perl_ck_lengthconst -#define ck_lfun Perl_ck_lfun -#define ck_listiob Perl_ck_listiob -#define ck_match Perl_ck_match -#define ck_null Perl_ck_null -#define ck_repeat Perl_ck_repeat -#define ck_require Perl_ck_require -#define ck_retarget Perl_ck_retarget -#define ck_rfun Perl_ck_rfun -#define ck_rvconst Perl_ck_rvconst -#define ck_scmp Perl_ck_scmp -#define ck_select Perl_ck_select -#define ck_shift Perl_ck_shift -#define ck_sort Perl_ck_sort -#define ck_spair Perl_ck_spair -#define ck_split Perl_ck_split -#define ck_subr Perl_ck_subr -#define ck_svconst Perl_ck_svconst -#define ck_trunc Perl_ck_trunc -#define convert Perl_convert -#define cpytill Perl_cpytill -#define croak Perl_croak -#define cv_clone Perl_cv_clone -#define cv_undef Perl_cv_undef -#define cx_dump Perl_cx_dump -#define cxinc Perl_cxinc -#define deb Perl_deb -#define deb_growlevel Perl_deb_growlevel -#define debop Perl_debop -#define debprofdump Perl_debprofdump -#define debstack Perl_debstack -#define debstackptrs Perl_debstackptrs -#define deprecate Perl_deprecate -#define die Perl_die -#define die_where Perl_die_where -#define do_aexec Perl_do_aexec -#define do_chomp Perl_do_chomp -#define do_chop Perl_do_chop -#define do_close Perl_do_close -#define do_eof Perl_do_eof -#define do_exec Perl_do_exec -#define do_execfree Perl_do_execfree -#define do_ipcctl Perl_do_ipcctl -#define do_ipcget Perl_do_ipcget -#define do_join Perl_do_join -#define do_kv Perl_do_kv -#define do_msgrcv Perl_do_msgrcv -#define do_msgsnd Perl_do_msgsnd -#define do_open Perl_do_open -#define do_pipe Perl_do_pipe -#define do_print Perl_do_print -#define do_readline Perl_do_readline -#define do_seek Perl_do_seek -#define do_semop Perl_do_semop -#define do_shmio Perl_do_shmio -#define do_sprintf Perl_do_sprintf -#define do_tell Perl_do_tell -#define do_trans Perl_do_trans -#define do_vecset Perl_do_vecset -#define do_vop Perl_do_vop -#define doeval Perl_doeval -#define dofindlabel Perl_dofindlabel -#define dopoptoeval Perl_dopoptoeval -#define dounwind Perl_dounwind -#define dowantarray Perl_dowantarray -#define dump_all Perl_dump_all -#define dump_eval Perl_dump_eval -#define dump_fds Perl_dump_fds -#define dump_form Perl_dump_form -#define dump_gv Perl_dump_gv -#define dump_mstats Perl_dump_mstats -#define dump_op Perl_dump_op -#define dump_packsubs Perl_dump_packsubs -#define dump_pm Perl_dump_pm -#define dump_sub Perl_dump_sub -#define fbm_compile Perl_fbm_compile -#define fbm_instr Perl_fbm_instr -#define fetch_gv Perl_fetch_gv -#define fetch_io Perl_fetch_io -#define filter_add Perl_filter_add -#define filter_del Perl_filter_del -#define filter_read Perl_filter_read -#define fold_constants Perl_fold_constants -#define force_ident Perl_force_ident -#define force_list Perl_force_list -#define force_next Perl_force_next -#define force_word Perl_force_word -#define free_tmps Perl_free_tmps +#define concat_amg Perl_concat_amg +#define concat_ass_amg Perl_concat_ass_amg +#define convert Perl_convert +#define cop_seqmax Perl_cop_seqmax +#define cos_amg Perl_cos_amg +#define cpytill Perl_cpytill +#define croak Perl_croak +#define cryptseen Perl_cryptseen +#define cshlen Perl_cshlen +#define cshname Perl_cshname +#define curinterp Perl_curinterp +#define curpad Perl_curpad +#define cv_clone Perl_cv_clone +#define cv_const_sv Perl_cv_const_sv +#define cv_undef Perl_cv_undef +#define cx_dump Perl_cx_dump +#define cxinc Perl_cxinc +#define dc Perl_dc +#define deb Perl_deb +#define deb_growlevel Perl_deb_growlevel +#define debop Perl_debop +#define debprofdump Perl_debprofdump +#define debstack Perl_debstack +#define debstackptrs Perl_debstackptrs +#define dec_amg Perl_dec_amg +#define deprecate Perl_deprecate +#define di Perl_di +#define die Perl_die +#define die_where Perl_die_where +#define div_amg Perl_div_amg +#define div_ass_amg Perl_div_ass_amg +#define do_aexec Perl_do_aexec +#define do_chomp Perl_do_chomp +#define do_chop Perl_do_chop +#define do_close Perl_do_close +#define do_eof Perl_do_eof +#define do_exec Perl_do_exec +#define do_execfree Perl_do_execfree +#define do_ipcctl Perl_do_ipcctl +#define do_ipcget Perl_do_ipcget +#define do_join Perl_do_join +#define do_kv Perl_do_kv +#define do_msgrcv Perl_do_msgrcv +#define do_msgsnd Perl_do_msgsnd +#define do_open Perl_do_open +#define do_pipe Perl_do_pipe +#define do_print Perl_do_print +#define do_readline Perl_do_readline +#define do_seek Perl_do_seek +#define do_semop Perl_do_semop +#define do_shmio Perl_do_shmio +#define do_sprintf Perl_do_sprintf +#define do_tell Perl_do_tell +#define do_trans Perl_do_trans +#define do_vecset Perl_do_vecset +#define do_vop Perl_do_vop +#define doeval Perl_doeval +#define dofindlabel Perl_dofindlabel +#define dopoptoeval Perl_dopoptoeval +#define dounwind Perl_dounwind +#define dowantarray Perl_dowantarray +#define ds Perl_ds +#define dump_all Perl_dump_all +#define dump_eval Perl_dump_eval +#define dump_fds Perl_dump_fds +#define dump_form Perl_dump_form +#define dump_gv Perl_dump_gv +#define dump_mstats Perl_dump_mstats +#define dump_op Perl_dump_op +#define dump_packsubs Perl_dump_packsubs +#define dump_pm Perl_dump_pm +#define dump_sub Perl_dump_sub +#define egid Perl_egid +#define eq_amg Perl_eq_amg +#define error_count Perl_error_count +#define euid Perl_euid +#define evalseq Perl_evalseq +#define exp_amg Perl_exp_amg +#define expect Perl_expect +#define expectterm Perl_expectterm +#define fallback_amg Perl_fallback_amg +#define fbm_compile Perl_fbm_compile +#define fbm_instr Perl_fbm_instr +#define fetch_gv Perl_fetch_gv +#define fetch_io Perl_fetch_io +#define filter_add Perl_filter_add +#define filter_del Perl_filter_del +#define filter_read Perl_filter_read +#define fold Perl_fold +#define fold_constants Perl_fold_constants +#define fold_locale Perl_fold_locale +#define force_ident Perl_force_ident +#define force_list Perl_force_list +#define force_next Perl_force_next +#define force_word Perl_force_word +#define free_tmps Perl_free_tmps +#define freq Perl_freq +#define ge_amg Perl_ge_amg #define gen_constant_list Perl_gen_constant_list -#define gp_free Perl_gp_free -#define gp_ref Perl_gp_ref -#define gv_AVadd Perl_gv_AVadd -#define gv_HVadd Perl_gv_HVadd -#define gv_IOadd Perl_gv_IOadd -#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_fetchpv Perl_gv_fetchpv -#define gv_fullname Perl_gv_fullname -#define gv_fullname3 Perl_gv_fullname3 -#define gv_init Perl_gv_init -#define gv_stashpv Perl_gv_stashpv -#define gv_stashpvn Perl_gv_stashpvn -#define gv_stashsv Perl_gv_stashsv -#define he_delayfree Perl_he_delayfree -#define he_free Perl_he_free -#define he_root Perl_he_root -#define hoistmust Perl_hoistmust -#define hv_clear Perl_hv_clear -#define hv_delete Perl_hv_delete -#define hv_delete_ent Perl_hv_delete_ent -#define hv_exists Perl_hv_exists -#define hv_exists_ent Perl_hv_exists_ent -#define hv_fetch Perl_hv_fetch -#define hv_fetch_ent Perl_hv_fetch_ent -#define hv_iterinit Perl_hv_iterinit -#define hv_iterkey Perl_hv_iterkey -#define hv_iterkeysv Perl_hv_iterkeysv -#define hv_iternext Perl_hv_iternext -#define hv_iternextsv Perl_hv_iternextsv -#define hv_iterval Perl_hv_iterval -#define hv_ksplit Perl_hv_ksplit -#define hv_magic Perl_hv_magic -#define hv_stashpv Perl_hv_stashpv -#define hv_store Perl_hv_store -#define hv_store_ent Perl_hv_store_ent -#define hv_undef Perl_hv_undef -#define ibcmp Perl_ibcmp -#define ibcmp_locale Perl_ibcmp_locale -#define ingroup Perl_ingroup -#define instr Perl_instr -#define intro_my Perl_intro_my -#define intuit_more Perl_intuit_more -#define invert Perl_invert -#define jmaybe Perl_jmaybe -#define keyword Perl_keyword -#define leave_scope Perl_leave_scope -#define lex_end Perl_lex_end -#define lex_start Perl_lex_start -#define linklist Perl_linklist -#define list Perl_list -#define listkids Perl_listkids -#define localize Perl_localize +#define gid Perl_gid +#define gp_free Perl_gp_free +#define gp_ref Perl_gp_ref +#define gt_amg Perl_gt_amg +#define gv_AVadd Perl_gv_AVadd +#define gv_HVadd Perl_gv_HVadd +#define gv_IOadd Perl_gv_IOadd +#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_fetchpv Perl_gv_fetchpv +#define gv_fullname Perl_gv_fullname +#define gv_fullname3 Perl_gv_fullname3 +#define gv_init Perl_gv_init +#define gv_stashpv Perl_gv_stashpv +#define gv_stashpvn Perl_gv_stashpvn +#define gv_stashsv Perl_gv_stashsv +#define he_delayfree Perl_he_delayfree +#define he_free Perl_he_free +#define he_root Perl_he_root +#define hexdigit Perl_hexdigit +#define hints Perl_hints +#define hoistmust Perl_hoistmust +#define hv_clear Perl_hv_clear +#define hv_delete Perl_hv_delete +#define hv_delete_ent Perl_hv_delete_ent +#define hv_exists Perl_hv_exists +#define hv_exists_ent Perl_hv_exists_ent +#define hv_fetch Perl_hv_fetch +#define hv_fetch_ent Perl_hv_fetch_ent +#define hv_iterinit Perl_hv_iterinit +#define hv_iterkey Perl_hv_iterkey +#define hv_iterkeysv Perl_hv_iterkeysv +#define hv_iternext Perl_hv_iternext +#define hv_iternextsv Perl_hv_iternextsv +#define hv_iterval Perl_hv_iterval +#define hv_ksplit Perl_hv_ksplit +#define hv_magic Perl_hv_magic +#define hv_stashpv Perl_hv_stashpv +#define hv_store Perl_hv_store +#define hv_store_ent Perl_hv_store_ent +#define hv_undef Perl_hv_undef +#define ibcmp Perl_ibcmp +#define ibcmp_locale Perl_ibcmp_locale +#define in_my Perl_in_my +#define inc_amg Perl_inc_amg +#define ingroup Perl_ingroup +#define instr Perl_instr +#define intro_my Perl_intro_my +#define intuit_more Perl_intuit_more +#define invert Perl_invert +#define io_close Perl_io_close +#define jmaybe Perl_jmaybe +#define keyword Perl_keyword +#define know_next Perl_know_next +#define last_lop Perl_last_lop +#define last_lop_op Perl_last_lop_op +#define last_uni Perl_last_uni +#define le_amg Perl_le_amg +#define leave_scope Perl_leave_scope +#define lex_brackets Perl_lex_brackets +#define lex_brackstack Perl_lex_brackstack +#define lex_casemods Perl_lex_casemods +#define lex_casestack Perl_lex_casestack +#define lex_defer Perl_lex_defer +#define lex_dojoin Perl_lex_dojoin +#define lex_end Perl_lex_end +#define lex_expect Perl_lex_expect +#define lex_fakebrack Perl_lex_fakebrack +#define lex_formbrack Perl_lex_formbrack +#define lex_inpat Perl_lex_inpat +#define lex_inwhat Perl_lex_inwhat +#define lex_op Perl_lex_op +#define lex_repl Perl_lex_repl +#define lex_start Perl_lex_start +#define lex_starts Perl_lex_starts +#define lex_state Perl_lex_state +#define lex_stuff Perl_lex_stuff +#define linestr Perl_linestr +#define linklist Perl_linklist +#define list Perl_list +#define listkids Perl_listkids +#define localize Perl_localize +#define log_amg Perl_log_amg #define looks_like_number Perl_looks_like_number -#define magic_clearenv Perl_magic_clearenv -#define magic_clearpack Perl_magic_clearpack -#define magic_clearsig Perl_magic_clearsig +#define lshift_amg Perl_lshift_amg +#define lshift_ass_amg Perl_lshift_ass_amg +#define lt_amg Perl_lt_amg +#define magic_clearenv Perl_magic_clearenv +#define magic_clearpack Perl_magic_clearpack +#define magic_clearsig Perl_magic_clearsig #define magic_existspack Perl_magic_existspack -#define magic_get Perl_magic_get -#define magic_getarylen Perl_magic_getarylen -#define magic_getglob Perl_magic_getglob -#define magic_getpack Perl_magic_getpack -#define magic_getpos Perl_magic_getpos -#define magic_getsig Perl_magic_getsig -#define magic_gettaint Perl_magic_gettaint -#define magic_getuvar Perl_magic_getuvar -#define magic_len Perl_magic_len -#define magic_nextpack Perl_magic_nextpack -#define magic_set Perl_magic_set -#define magic_setamagic Perl_magic_setamagic -#define magic_setarylen Perl_magic_setarylen -#define magic_setbm Perl_magic_setbm +#define magic_freevivary Perl_magic_freevivary +#define magic_get Perl_magic_get +#define magic_getarylen Perl_magic_getarylen +#define magic_getglob Perl_magic_getglob +#define magic_getpack Perl_magic_getpack +#define magic_getpos Perl_magic_getpos +#define magic_getsig Perl_magic_getsig +#define magic_gettaint Perl_magic_gettaint +#define magic_getuvar Perl_magic_getuvar +#define magic_len Perl_magic_len +#define magic_nextpack Perl_magic_nextpack +#define magic_set Perl_magic_set +#define magic_setamagic Perl_magic_setamagic +#define magic_setarylen Perl_magic_setarylen +#define magic_setbm Perl_magic_setbm #define magic_setcollxfrm Perl_magic_setcollxfrm -#define magic_setdbline Perl_magic_setdbline -#define magic_setenv Perl_magic_setenv -#define magic_setfm Perl_magic_setfm -#define magic_setglob Perl_magic_setglob -#define magic_setisa Perl_magic_setisa -#define magic_setmglob Perl_magic_setmglob -#define magic_setnkeys Perl_magic_setnkeys -#define magic_setpack Perl_magic_setpack -#define magic_setpos Perl_magic_setpos -#define magic_setsig Perl_magic_setsig -#define magic_setsubstr Perl_magic_setsubstr -#define magic_settaint Perl_magic_settaint -#define magic_setuvar Perl_magic_setuvar -#define magic_setvec Perl_magic_setvec -#define magic_wipepack Perl_magic_wipepack -#define magicname Perl_magicname -#define markstack_grow Perl_markstack_grow -#define mem_collxfrm Perl_mem_collxfrm -#define mess Perl_mess -#define mg_clear Perl_mg_clear -#define mg_copy Perl_mg_copy -#define mg_find Perl_mg_find -#define mg_free Perl_mg_free -#define mg_get Perl_mg_get -#define mg_len Perl_mg_len -#define mg_magical Perl_mg_magical -#define mg_set Perl_mg_set -#define mod Perl_mod -#define modkids Perl_modkids -#define moreswitches Perl_moreswitches -#define mstats Perl_mstats -#define my Perl_my -#define my_bcopy Perl_my_bcopy -#define my_bzero Perl_my_bzero -#define my_chsize Perl_my_chsize -#define my_exit Perl_my_exit -#define my_htonl Perl_my_htonl -#define my_lstat Perl_my_lstat -#define my_memcmp Perl_my_memcmp -#define my_ntohl Perl_my_ntohl -#define my_pclose Perl_my_pclose -#define my_popen Perl_my_popen -#define my_setenv Perl_my_setenv -#define my_stat Perl_my_stat -#define my_swap Perl_my_swap -#define my_unexec Perl_my_unexec -#define newANONHASH Perl_newANONHASH -#define newANONLIST Perl_newANONLIST -#define newANONSUB Perl_newANONSUB -#define newASSIGNOP Perl_newASSIGNOP -#define newAV Perl_newAV -#define newAVREF Perl_newAVREF -#define newBINOP Perl_newBINOP -#define newCONDOP Perl_newCONDOP -#define newCVREF Perl_newCVREF -#define newFORM Perl_newFORM -#define newFOROP Perl_newFOROP -#define newGVOP Perl_newGVOP -#define newGVREF Perl_newGVREF -#define newGVgen Perl_newGVgen -#define newHV Perl_newHV -#define newHVREF Perl_newHVREF -#define newIO Perl_newIO -#define newLISTOP Perl_newLISTOP -#define newLOGOP Perl_newLOGOP -#define newLOOPEX Perl_newLOOPEX -#define newLOOPOP Perl_newLOOPOP -#define newNULLLIST Perl_newNULLLIST -#define newOP Perl_newOP -#define newPMOP Perl_newPMOP -#define newPROG Perl_newPROG -#define newPVOP Perl_newPVOP -#define newRANGE Perl_newRANGE -#define newRV Perl_newRV -#define newSLICEOP Perl_newSLICEOP -#define newSTATEOP Perl_newSTATEOP -#define newSUB Perl_newSUB -#define newSV Perl_newSV -#define newSVOP Perl_newSVOP -#define newSVREF Perl_newSVREF -#define newSViv Perl_newSViv -#define newSVnv Perl_newSVnv -#define newSVpv Perl_newSVpv -#define newSVrv Perl_newSVrv -#define newSVsv Perl_newSVsv -#define newUNOP Perl_newUNOP -#define newWHILEOP Perl_newWHILEOP -#define newXS Perl_newXS -#define newXSUB Perl_newXSUB -#define nextargv Perl_nextargv -#define ninstr Perl_ninstr -#define no_fh_allowed Perl_no_fh_allowed -#define no_op Perl_no_op -#define oopsAV Perl_oopsAV -#define oopsCV Perl_oopsCV -#define oopsHV Perl_oopsHV -#define op_free Perl_op_free -#define package Perl_package -#define pad_alloc Perl_pad_alloc -#define pad_allocmy Perl_pad_allocmy -#define pad_findmy Perl_pad_findmy -#define pad_free Perl_pad_free -#define pad_leavemy Perl_pad_leavemy -#define pad_reset Perl_pad_reset -#define pad_sv Perl_pad_sv -#define pad_swipe Perl_pad_swipe -#define peep Perl_peep -#define pidgone Perl_pidgone -#define pmflag Perl_pmflag -#define pmruntime Perl_pmruntime -#define pmtrans Perl_pmtrans -#define pop_return Perl_pop_return -#define pop_scope Perl_pop_scope -#define pp_aassign Perl_pp_aassign -#define pp_abs Perl_pp_abs -#define pp_accept Perl_pp_accept -#define pp_add Perl_pp_add -#define pp_aelem Perl_pp_aelem -#define pp_aelemfast Perl_pp_aelemfast -#define pp_alarm Perl_pp_alarm -#define pp_and Perl_pp_and -#define pp_andassign Perl_pp_andassign -#define pp_anoncode Perl_pp_anoncode -#define pp_anonhash Perl_pp_anonhash -#define pp_anonlist Perl_pp_anonlist -#define pp_aslice Perl_pp_aslice -#define pp_atan2 Perl_pp_atan2 -#define pp_av2arylen Perl_pp_av2arylen -#define pp_backtick Perl_pp_backtick -#define pp_bind Perl_pp_bind -#define pp_binmode Perl_pp_binmode -#define pp_bit_and Perl_pp_bit_and -#define pp_bit_or Perl_pp_bit_or -#define pp_bit_xor Perl_pp_bit_xor -#define pp_bless Perl_pp_bless -#define pp_caller Perl_pp_caller -#define pp_chdir Perl_pp_chdir -#define pp_chmod Perl_pp_chmod -#define pp_chomp Perl_pp_chomp -#define pp_chop Perl_pp_chop -#define pp_chown Perl_pp_chown -#define pp_chr Perl_pp_chr -#define pp_chroot Perl_pp_chroot -#define pp_close Perl_pp_close -#define pp_closedir Perl_pp_closedir -#define pp_complement Perl_pp_complement -#define pp_concat Perl_pp_concat -#define pp_cond_expr Perl_pp_cond_expr -#define pp_connect Perl_pp_connect -#define pp_const Perl_pp_const -#define pp_cos Perl_pp_cos -#define pp_crypt Perl_pp_crypt -#define pp_cswitch Perl_pp_cswitch -#define pp_dbmclose Perl_pp_dbmclose -#define pp_dbmopen Perl_pp_dbmopen -#define pp_dbstate Perl_pp_dbstate -#define pp_defined Perl_pp_defined -#define pp_delete Perl_pp_delete -#define pp_die Perl_pp_die -#define pp_divide Perl_pp_divide -#define pp_dofile Perl_pp_dofile -#define pp_dump Perl_pp_dump -#define pp_each Perl_pp_each -#define pp_egrent Perl_pp_egrent -#define pp_ehostent Perl_pp_ehostent -#define pp_enetent Perl_pp_enetent -#define pp_enter Perl_pp_enter -#define pp_entereval Perl_pp_entereval -#define pp_enteriter Perl_pp_enteriter -#define pp_enterloop Perl_pp_enterloop -#define pp_entersub Perl_pp_entersub -#define pp_entersubr Perl_pp_entersubr -#define pp_entertry Perl_pp_entertry -#define pp_enterwrite Perl_pp_enterwrite -#define pp_eof Perl_pp_eof -#define pp_eprotoent Perl_pp_eprotoent -#define pp_epwent Perl_pp_epwent -#define pp_eq Perl_pp_eq -#define pp_eservent Perl_pp_eservent -#define pp_evalonce Perl_pp_evalonce -#define pp_exec Perl_pp_exec -#define pp_exists Perl_pp_exists -#define pp_exit Perl_pp_exit -#define pp_exp Perl_pp_exp -#define pp_fcntl Perl_pp_fcntl -#define pp_fileno Perl_pp_fileno -#define pp_flip Perl_pp_flip -#define pp_flock Perl_pp_flock -#define pp_flop Perl_pp_flop -#define pp_fork Perl_pp_fork -#define pp_formline Perl_pp_formline -#define pp_ftatime Perl_pp_ftatime -#define pp_ftbinary Perl_pp_ftbinary -#define pp_ftblk Perl_pp_ftblk -#define pp_ftchr Perl_pp_ftchr -#define pp_ftctime Perl_pp_ftctime -#define pp_ftdir Perl_pp_ftdir -#define pp_fteexec Perl_pp_fteexec -#define pp_fteowned Perl_pp_fteowned -#define pp_fteread Perl_pp_fteread -#define pp_ftewrite Perl_pp_ftewrite -#define pp_ftfile Perl_pp_ftfile -#define pp_ftis Perl_pp_ftis -#define pp_ftlink Perl_pp_ftlink -#define pp_ftmtime Perl_pp_ftmtime -#define pp_ftpipe Perl_pp_ftpipe -#define pp_ftrexec Perl_pp_ftrexec -#define pp_ftrowned Perl_pp_ftrowned -#define pp_ftrread Perl_pp_ftrread -#define pp_ftrwrite Perl_pp_ftrwrite -#define pp_ftsgid Perl_pp_ftsgid -#define pp_ftsize Perl_pp_ftsize -#define pp_ftsock Perl_pp_ftsock -#define pp_ftsuid Perl_pp_ftsuid -#define pp_ftsvtx Perl_pp_ftsvtx -#define pp_fttext Perl_pp_fttext -#define pp_fttty Perl_pp_fttty -#define pp_ftzero Perl_pp_ftzero -#define pp_ge Perl_pp_ge -#define pp_gelem Perl_pp_gelem -#define pp_getc Perl_pp_getc -#define pp_getlogin Perl_pp_getlogin -#define pp_getpeername Perl_pp_getpeername -#define pp_getpgrp Perl_pp_getpgrp -#define pp_getppid Perl_pp_getppid -#define pp_getpriority Perl_pp_getpriority -#define pp_getsockname Perl_pp_getsockname -#define pp_ggrent Perl_pp_ggrent -#define pp_ggrgid Perl_pp_ggrgid -#define pp_ggrnam Perl_pp_ggrnam -#define pp_ghbyaddr Perl_pp_ghbyaddr -#define pp_ghbyname Perl_pp_ghbyname -#define pp_ghostent Perl_pp_ghostent -#define pp_glob Perl_pp_glob -#define pp_gmtime Perl_pp_gmtime -#define pp_gnbyaddr Perl_pp_gnbyaddr -#define pp_gnbyname Perl_pp_gnbyname -#define pp_gnetent Perl_pp_gnetent -#define pp_goto Perl_pp_goto -#define pp_gpbyname Perl_pp_gpbyname -#define pp_gpbynumber Perl_pp_gpbynumber -#define pp_gprotoent Perl_pp_gprotoent -#define pp_gpwent Perl_pp_gpwent -#define pp_gpwnam Perl_pp_gpwnam -#define pp_gpwuid Perl_pp_gpwuid -#define pp_grepstart Perl_pp_grepstart -#define pp_grepwhile Perl_pp_grepwhile -#define pp_gsbyname Perl_pp_gsbyname -#define pp_gsbyport Perl_pp_gsbyport -#define pp_gservent Perl_pp_gservent -#define pp_gsockopt Perl_pp_gsockopt -#define pp_gt Perl_pp_gt -#define pp_gv Perl_pp_gv -#define pp_gvsv Perl_pp_gvsv -#define pp_helem Perl_pp_helem -#define pp_hex Perl_pp_hex -#define pp_hslice Perl_pp_hslice -#define pp_i_add Perl_pp_i_add -#define pp_i_divide Perl_pp_i_divide -#define pp_i_eq Perl_pp_i_eq -#define pp_i_ge Perl_pp_i_ge -#define pp_i_gt Perl_pp_i_gt -#define pp_i_le Perl_pp_i_le -#define pp_i_lt Perl_pp_i_lt -#define pp_i_modulo Perl_pp_i_modulo -#define pp_i_multiply Perl_pp_i_multiply -#define pp_i_ncmp Perl_pp_i_ncmp -#define pp_i_ne Perl_pp_i_ne -#define pp_i_negate Perl_pp_i_negate -#define pp_i_subtract Perl_pp_i_subtract -#define pp_index Perl_pp_index -#define pp_indread Perl_pp_indread -#define pp_int Perl_pp_int -#define pp_interp Perl_pp_interp -#define pp_ioctl Perl_pp_ioctl -#define pp_iter Perl_pp_iter -#define pp_join Perl_pp_join -#define pp_keys Perl_pp_keys -#define pp_kill Perl_pp_kill -#define pp_last Perl_pp_last -#define pp_lc Perl_pp_lc -#define pp_lcfirst Perl_pp_lcfirst -#define pp_le Perl_pp_le -#define pp_leave Perl_pp_leave -#define pp_leaveeval Perl_pp_leaveeval -#define pp_leaveloop Perl_pp_leaveloop -#define pp_leavesub Perl_pp_leavesub -#define pp_leavetry Perl_pp_leavetry -#define pp_leavewrite Perl_pp_leavewrite -#define pp_left_shift Perl_pp_left_shift -#define pp_length Perl_pp_length -#define pp_lineseq Perl_pp_lineseq -#define pp_link Perl_pp_link -#define pp_list Perl_pp_list -#define pp_listen Perl_pp_listen -#define pp_localtime Perl_pp_localtime -#define pp_log Perl_pp_log -#define pp_lslice Perl_pp_lslice -#define pp_lstat Perl_pp_lstat -#define pp_lt Perl_pp_lt -#define pp_map Perl_pp_map -#define pp_mapstart Perl_pp_mapstart -#define pp_mapwhile Perl_pp_mapwhile -#define pp_match Perl_pp_match -#define pp_method Perl_pp_method -#define pp_mkdir Perl_pp_mkdir -#define pp_modulo Perl_pp_modulo -#define pp_msgctl Perl_pp_msgctl -#define pp_msgget Perl_pp_msgget -#define pp_msgrcv Perl_pp_msgrcv -#define pp_msgsnd Perl_pp_msgsnd -#define pp_multiply Perl_pp_multiply -#define pp_ncmp Perl_pp_ncmp -#define pp_ne Perl_pp_ne -#define pp_negate Perl_pp_negate -#define pp_next Perl_pp_next -#define pp_nextstate Perl_pp_nextstate -#define pp_not Perl_pp_not -#define pp_nswitch Perl_pp_nswitch -#define pp_null Perl_pp_null -#define pp_oct Perl_pp_oct -#define pp_open Perl_pp_open -#define pp_open_dir Perl_pp_open_dir -#define pp_or Perl_pp_or -#define pp_orassign Perl_pp_orassign -#define pp_ord Perl_pp_ord -#define pp_pack Perl_pp_pack -#define pp_padany Perl_pp_padany -#define pp_padav Perl_pp_padav -#define pp_padhv Perl_pp_padhv -#define pp_padsv Perl_pp_padsv -#define pp_pipe_op Perl_pp_pipe_op -#define pp_pop Perl_pp_pop -#define pp_pos Perl_pp_pos -#define pp_postdec Perl_pp_postdec -#define pp_postinc Perl_pp_postinc -#define pp_pow Perl_pp_pow -#define pp_predec Perl_pp_predec -#define pp_preinc Perl_pp_preinc -#define pp_print Perl_pp_print -#define pp_prototype Perl_pp_prototype -#define pp_prtf Perl_pp_prtf -#define pp_push Perl_pp_push -#define pp_pushmark Perl_pp_pushmark -#define pp_pushre Perl_pp_pushre -#define pp_quotemeta Perl_pp_quotemeta -#define pp_rand Perl_pp_rand -#define pp_range Perl_pp_range -#define pp_rcatline Perl_pp_rcatline -#define pp_read Perl_pp_read -#define pp_readdir Perl_pp_readdir -#define pp_readline Perl_pp_readline -#define pp_readlink Perl_pp_readlink -#define pp_recv Perl_pp_recv -#define pp_redo Perl_pp_redo -#define pp_ref Perl_pp_ref -#define pp_refgen Perl_pp_refgen -#define pp_regcmaybe Perl_pp_regcmaybe -#define pp_regcomp Perl_pp_regcomp -#define pp_rename Perl_pp_rename -#define pp_repeat Perl_pp_repeat -#define pp_require Perl_pp_require -#define pp_reset Perl_pp_reset -#define pp_return Perl_pp_return -#define pp_reverse Perl_pp_reverse -#define pp_rewinddir Perl_pp_rewinddir -#define pp_right_shift Perl_pp_right_shift -#define pp_rindex Perl_pp_rindex -#define pp_rmdir Perl_pp_rmdir -#define pp_rv2av Perl_pp_rv2av -#define pp_rv2cv Perl_pp_rv2cv -#define pp_rv2gv Perl_pp_rv2gv -#define pp_rv2hv Perl_pp_rv2hv -#define pp_rv2sv Perl_pp_rv2sv -#define pp_sassign Perl_pp_sassign -#define pp_scalar Perl_pp_scalar -#define pp_schomp Perl_pp_schomp -#define pp_schop Perl_pp_schop -#define pp_scmp Perl_pp_scmp -#define pp_scope Perl_pp_scope -#define pp_seek Perl_pp_seek -#define pp_seekdir Perl_pp_seekdir -#define pp_select Perl_pp_select -#define pp_semctl Perl_pp_semctl -#define pp_semget Perl_pp_semget -#define pp_semop Perl_pp_semop -#define pp_send Perl_pp_send -#define pp_seq Perl_pp_seq -#define pp_setpgrp Perl_pp_setpgrp -#define pp_setpriority Perl_pp_setpriority -#define pp_sge Perl_pp_sge -#define pp_sgrent Perl_pp_sgrent -#define pp_sgt Perl_pp_sgt -#define pp_shift Perl_pp_shift -#define pp_shmctl Perl_pp_shmctl -#define pp_shmget Perl_pp_shmget -#define pp_shmread Perl_pp_shmread -#define pp_shmwrite Perl_pp_shmwrite -#define pp_shostent Perl_pp_shostent -#define pp_shutdown Perl_pp_shutdown -#define pp_sin Perl_pp_sin -#define pp_sle Perl_pp_sle -#define pp_sleep Perl_pp_sleep -#define pp_slt Perl_pp_slt -#define pp_sne Perl_pp_sne -#define pp_snetent Perl_pp_snetent -#define pp_socket Perl_pp_socket -#define pp_sockpair Perl_pp_sockpair -#define pp_sort Perl_pp_sort -#define pp_splice Perl_pp_splice -#define pp_split Perl_pp_split -#define pp_sprintf Perl_pp_sprintf -#define pp_sprotoent Perl_pp_sprotoent -#define pp_spwent Perl_pp_spwent -#define pp_sqrt Perl_pp_sqrt -#define pp_srand Perl_pp_srand -#define pp_srefgen Perl_pp_srefgen -#define pp_sselect Perl_pp_sselect -#define pp_sservent Perl_pp_sservent -#define pp_ssockopt Perl_pp_ssockopt -#define pp_stat Perl_pp_stat -#define pp_stringify Perl_pp_stringify -#define pp_stub Perl_pp_stub -#define pp_study Perl_pp_study -#define pp_subst Perl_pp_subst -#define pp_substcont Perl_pp_substcont -#define pp_substr Perl_pp_substr -#define pp_subtract Perl_pp_subtract -#define pp_symlink Perl_pp_symlink -#define pp_syscall Perl_pp_syscall -#define pp_sysopen Perl_pp_sysopen -#define pp_sysread Perl_pp_sysread -#define pp_system Perl_pp_system -#define pp_syswrite Perl_pp_syswrite -#define pp_tell Perl_pp_tell -#define pp_telldir Perl_pp_telldir -#define pp_tie Perl_pp_tie -#define pp_tied Perl_pp_tied -#define pp_time Perl_pp_time -#define pp_tms Perl_pp_tms -#define pp_trans Perl_pp_trans -#define pp_truncate Perl_pp_truncate -#define pp_uc Perl_pp_uc -#define pp_ucfirst Perl_pp_ucfirst -#define pp_umask Perl_pp_umask -#define pp_undef Perl_pp_undef -#define pp_unlink Perl_pp_unlink -#define pp_unpack Perl_pp_unpack -#define pp_unshift Perl_pp_unshift -#define pp_unstack Perl_pp_unstack -#define pp_untie Perl_pp_untie -#define pp_utime Perl_pp_utime -#define pp_values Perl_pp_values -#define pp_vec Perl_pp_vec -#define pp_wait Perl_pp_wait -#define pp_waitpid Perl_pp_waitpid -#define pp_wantarray Perl_pp_wantarray -#define pp_warn Perl_pp_warn -#define pp_xor Perl_pp_xor -#define pregcomp Perl_pregcomp -#define pregexec Perl_pregexec -#define pregfree Perl_pregfree -#define prepend_elem Perl_prepend_elem -#define push_return Perl_push_return -#define push_scope Perl_push_scope -#define q Perl_q -#define ref Perl_ref -#define refkids Perl_refkids -#define regdump Perl_regdump -#define regnext Perl_regnext -#define regprop Perl_regprop -#define repeatcpy Perl_repeatcpy -#define rninstr Perl_rninstr -#define rsignal Perl_rsignal -#define rsignal_save Perl_rsignal_save -#define rsignal_state Perl_rsignal_state -#define rsignal_restore Perl_rsignal_restore -#define runops Perl_runops -#define safecalloc Perl_safecalloc -#define safemalloc Perl_safemalloc -#define safefree Perl_safefree -#define saferealloc Perl_saferealloc -#define safexcalloc Perl_safexcalloc -#define safexmalloc Perl_safexmalloc -#define safexfree Perl_safexfree -#define safexrealloc Perl_safexrealloc -#define same_dirent Perl_same_dirent -#define save_I16 Perl_save_I16 -#define save_I32 Perl_save_I32 -#define save_aptr Perl_save_aptr -#define save_ary Perl_save_ary -#define save_clearsv Perl_save_clearsv -#define save_delete Perl_save_delete -#define save_destructor Perl_save_destructor -#define save_freeop Perl_save_freeop -#define save_freepv Perl_save_freepv -#define save_freesv Perl_save_freesv -#define save_hash Perl_save_hash -#define save_hptr Perl_save_hptr -#define save_int Perl_save_int -#define save_item Perl_save_item -#define save_list Perl_save_list -#define save_long Perl_save_long -#define save_nogv Perl_save_nogv -#define save_pptr Perl_save_pptr -#define save_scalar Perl_save_scalar -#define save_sptr Perl_save_sptr -#define save_svref Perl_save_svref -#define savepv Perl_savepv -#define savepvn Perl_savepvn -#define savestack_grow Perl_savestack_grow -#define sawparens Perl_sawparens -#define scalar Perl_scalar -#define scalarkids Perl_scalarkids -#define scalarseq Perl_scalarseq -#define scalarvoid Perl_scalarvoid -#define scan_const Perl_scan_const -#define scan_formline Perl_scan_formline -#define scan_heredoc Perl_scan_heredoc -#define scan_hex Perl_scan_hex -#define scan_ident Perl_scan_ident +#define magic_setdbline Perl_magic_setdbline +#define magic_setenv Perl_magic_setenv +#define magic_setfm Perl_magic_setfm +#define magic_setglob Perl_magic_setglob +#define magic_setisa Perl_magic_setisa +#define magic_setmglob Perl_magic_setmglob +#define magic_setnkeys Perl_magic_setnkeys +#define magic_setpack Perl_magic_setpack +#define magic_setpos Perl_magic_setpos +#define magic_setsig Perl_magic_setsig +#define magic_setsubstr Perl_magic_setsubstr +#define magic_settaint Perl_magic_settaint +#define magic_setuvar Perl_magic_setuvar +#define magic_setvec Perl_magic_setvec +#define magic_setvivary Perl_magic_setvivary +#define magic_wipepack Perl_magic_wipepack +#define magicname Perl_magicname +#define markstack Perl_markstack +#define markstack_grow Perl_markstack_grow +#define markstack_max Perl_markstack_max +#define markstack_ptr Perl_markstack_ptr +#define max_intro_pending Perl_max_intro_pending +#define maxo Perl_maxo +#define mem_collxfrm Perl_mem_collxfrm +#define mess Perl_mess +#define mg_clear Perl_mg_clear +#define mg_copy Perl_mg_copy +#define mg_find Perl_mg_find +#define mg_free Perl_mg_free +#define mg_get Perl_mg_get +#define mg_len Perl_mg_len +#define mg_magical Perl_mg_magical +#define mg_set Perl_mg_set +#define min_intro_pending Perl_min_intro_pending +#define mod Perl_mod +#define mod_amg Perl_mod_amg +#define mod_ass_amg Perl_mod_ass_amg +#define modkids Perl_modkids +#define moreswitches Perl_moreswitches +#define mstats Perl_mstats +#define mult_amg Perl_mult_amg +#define mult_ass_amg Perl_mult_ass_amg +#define multi_close Perl_multi_close +#define multi_end Perl_multi_end +#define multi_open Perl_multi_open +#define multi_start Perl_multi_start +#define my Perl_my +#define my_bcopy Perl_my_bcopy +#define my_bzero Perl_my_bzero +#define my_chsize Perl_my_chsize +#define my_exit Perl_my_exit +#define my_htonl Perl_my_htonl +#define my_lstat Perl_my_lstat +#define my_memcmp Perl_my_memcmp +#define my_ntohl Perl_my_ntohl +#define my_pclose Perl_my_pclose +#define my_popen Perl_my_popen +#define my_setenv Perl_my_setenv +#define my_stat Perl_my_stat +#define my_swap Perl_my_swap +#define my_unexec Perl_my_unexec +#define na Perl_na +#define ncmp_amg Perl_ncmp_amg +#define ne_amg Perl_ne_amg +#define neg_amg Perl_neg_amg +#define newANONHASH Perl_newANONHASH +#define newANONLIST Perl_newANONLIST +#define newANONSUB Perl_newANONSUB +#define newASSIGNOP Perl_newASSIGNOP +#define newAV Perl_newAV +#define newAVREF Perl_newAVREF +#define newBINOP Perl_newBINOP +#define newCONDOP Perl_newCONDOP +#define newCVREF Perl_newCVREF +#define newFORM Perl_newFORM +#define newFOROP Perl_newFOROP +#define newGVOP Perl_newGVOP +#define newGVREF Perl_newGVREF +#define newGVgen Perl_newGVgen +#define newHV Perl_newHV +#define newHVREF Perl_newHVREF +#define newIO Perl_newIO +#define newLISTOP Perl_newLISTOP +#define newLOGOP Perl_newLOGOP +#define newLOOPEX Perl_newLOOPEX +#define newLOOPOP Perl_newLOOPOP +#define newNULLLIST Perl_newNULLLIST +#define newOP Perl_newOP +#define newPMOP Perl_newPMOP +#define newPROG Perl_newPROG +#define newPVOP Perl_newPVOP +#define newRANGE Perl_newRANGE +#define newRV Perl_newRV +#define newSLICEOP Perl_newSLICEOP +#define newSTATEOP Perl_newSTATEOP +#define newSUB Perl_newSUB +#define newSV Perl_newSV +#define newSVOP Perl_newSVOP +#define newSVREF Perl_newSVREF +#define newSViv Perl_newSViv +#define newSVnv Perl_newSVnv +#define newSVpv Perl_newSVpv +#define newSVrv Perl_newSVrv +#define newSVsv Perl_newSVsv +#define newUNOP Perl_newUNOP +#define newWHILEOP Perl_newWHILEOP +#define newXS Perl_newXS +#define newXSUB Perl_newXSUB +#define nextargv Perl_nextargv +#define nexttoke Perl_nexttoke +#define nexttype Perl_nexttype +#define nextval Perl_nextval +#define ninstr Perl_ninstr +#define no_aelem Perl_no_aelem +#define no_dir_func Perl_no_dir_func +#define no_fh_allowed Perl_no_fh_allowed +#define no_func Perl_no_func +#define no_helem Perl_no_helem +#define no_mem Perl_no_mem +#define no_modify Perl_no_modify +#define no_op Perl_no_op +#define no_security Perl_no_security +#define no_sock_func Perl_no_sock_func +#define no_usym Perl_no_usym +#define nointrp Perl_nointrp +#define nomem Perl_nomem +#define nomemok Perl_nomemok +#define nomethod_amg Perl_nomethod_amg +#define not_amg Perl_not_amg +#define numer_amg Perl_numer_amg +#define numeric_local Perl_numeric_local +#define numeric_name Perl_numeric_name +#define numeric_standard Perl_numeric_standard +#define oldbufptr Perl_oldbufptr +#define oldoldbufptr Perl_oldoldbufptr +#define oopsAV Perl_oopsAV +#define oopsCV Perl_oopsCV +#define oopsHV Perl_oopsHV +#define op Perl_op +#define op_desc Perl_op_desc +#define op_free Perl_op_free +#define op_name Perl_op_name +#define op_seqmax Perl_op_seqmax +#define opargs Perl_opargs +#define origalen Perl_origalen +#define origenviron Perl_origenviron +#define osname Perl_osname +#define package Perl_package +#define pad_alloc Perl_pad_alloc +#define pad_allocmy Perl_pad_allocmy +#define pad_findmy Perl_pad_findmy +#define pad_free Perl_pad_free +#define pad_leavemy Perl_pad_leavemy +#define pad_reset Perl_pad_reset +#define pad_sv Perl_pad_sv +#define pad_swipe Perl_pad_swipe +#define padix Perl_padix +#define patleave Perl_patleave +#define peep Perl_peep +#define pidgone Perl_pidgone +#define pmflag Perl_pmflag +#define pmruntime Perl_pmruntime +#define pmtrans Perl_pmtrans +#define pop_return Perl_pop_return +#define pop_scope Perl_pop_scope +#define pow_amg Perl_pow_amg +#define pow_ass_amg Perl_pow_ass_amg +#define pp_aassign Perl_pp_aassign +#define pp_abs Perl_pp_abs +#define pp_accept Perl_pp_accept +#define pp_add Perl_pp_add +#define pp_aelem Perl_pp_aelem +#define pp_aelemfast Perl_pp_aelemfast +#define pp_alarm Perl_pp_alarm +#define pp_and Perl_pp_and +#define pp_andassign Perl_pp_andassign +#define pp_anoncode Perl_pp_anoncode +#define pp_anonhash Perl_pp_anonhash +#define pp_anonlist Perl_pp_anonlist +#define pp_aslice Perl_pp_aslice +#define pp_atan2 Perl_pp_atan2 +#define pp_av2arylen Perl_pp_av2arylen +#define pp_backtick Perl_pp_backtick +#define pp_bind Perl_pp_bind +#define pp_binmode Perl_pp_binmode +#define pp_bit_and Perl_pp_bit_and +#define pp_bit_or Perl_pp_bit_or +#define pp_bit_xor Perl_pp_bit_xor +#define pp_bless Perl_pp_bless +#define pp_caller Perl_pp_caller +#define pp_chdir Perl_pp_chdir +#define pp_chmod Perl_pp_chmod +#define pp_chomp Perl_pp_chomp +#define pp_chop Perl_pp_chop +#define pp_chown Perl_pp_chown +#define pp_chr Perl_pp_chr +#define pp_chroot Perl_pp_chroot +#define pp_close Perl_pp_close +#define pp_closedir Perl_pp_closedir +#define pp_complement Perl_pp_complement +#define pp_concat Perl_pp_concat +#define pp_cond_expr Perl_pp_cond_expr +#define pp_connect Perl_pp_connect +#define pp_const Perl_pp_const +#define pp_cos Perl_pp_cos +#define pp_crypt Perl_pp_crypt +#define pp_cswitch Perl_pp_cswitch +#define pp_dbmclose Perl_pp_dbmclose +#define pp_dbmopen Perl_pp_dbmopen +#define pp_dbstate Perl_pp_dbstate +#define pp_defined Perl_pp_defined +#define pp_delete Perl_pp_delete +#define pp_die Perl_pp_die +#define pp_divide Perl_pp_divide +#define pp_dofile Perl_pp_dofile +#define pp_dump Perl_pp_dump +#define pp_each Perl_pp_each +#define pp_egrent Perl_pp_egrent +#define pp_ehostent Perl_pp_ehostent +#define pp_enetent Perl_pp_enetent +#define pp_enter Perl_pp_enter +#define pp_entereval Perl_pp_entereval +#define pp_enteriter Perl_pp_enteriter +#define pp_enterloop Perl_pp_enterloop +#define pp_entersub Perl_pp_entersub +#define pp_entersubr Perl_pp_entersubr +#define pp_entertry Perl_pp_entertry +#define pp_enterwrite Perl_pp_enterwrite +#define pp_eof Perl_pp_eof +#define pp_eprotoent Perl_pp_eprotoent +#define pp_epwent Perl_pp_epwent +#define pp_eq Perl_pp_eq +#define pp_eservent Perl_pp_eservent +#define pp_evalonce Perl_pp_evalonce +#define pp_exec Perl_pp_exec +#define pp_exists Perl_pp_exists +#define pp_exit Perl_pp_exit +#define pp_exp Perl_pp_exp +#define pp_fcntl Perl_pp_fcntl +#define pp_fileno Perl_pp_fileno +#define pp_flip Perl_pp_flip +#define pp_flock Perl_pp_flock +#define pp_flop Perl_pp_flop +#define pp_fork Perl_pp_fork +#define pp_formline Perl_pp_formline +#define pp_ftatime Perl_pp_ftatime +#define pp_ftbinary Perl_pp_ftbinary +#define pp_ftblk Perl_pp_ftblk +#define pp_ftchr Perl_pp_ftchr +#define pp_ftctime Perl_pp_ftctime +#define pp_ftdir Perl_pp_ftdir +#define pp_fteexec Perl_pp_fteexec +#define pp_fteowned Perl_pp_fteowned +#define pp_fteread Perl_pp_fteread +#define pp_ftewrite Perl_pp_ftewrite +#define pp_ftfile Perl_pp_ftfile +#define pp_ftis Perl_pp_ftis +#define pp_ftlink Perl_pp_ftlink +#define pp_ftmtime Perl_pp_ftmtime +#define pp_ftpipe Perl_pp_ftpipe +#define pp_ftrexec Perl_pp_ftrexec +#define pp_ftrowned Perl_pp_ftrowned +#define pp_ftrread Perl_pp_ftrread +#define pp_ftrwrite Perl_pp_ftrwrite +#define pp_ftsgid Perl_pp_ftsgid +#define pp_ftsize Perl_pp_ftsize +#define pp_ftsock Perl_pp_ftsock +#define pp_ftsuid Perl_pp_ftsuid +#define pp_ftsvtx Perl_pp_ftsvtx +#define pp_fttext Perl_pp_fttext +#define pp_fttty Perl_pp_fttty +#define pp_ftzero Perl_pp_ftzero +#define pp_ge Perl_pp_ge +#define pp_gelem Perl_pp_gelem +#define pp_getc Perl_pp_getc +#define pp_getlogin Perl_pp_getlogin +#define pp_getpeername Perl_pp_getpeername +#define pp_getpgrp Perl_pp_getpgrp +#define pp_getppid Perl_pp_getppid +#define pp_getpriority Perl_pp_getpriority +#define pp_getsockname Perl_pp_getsockname +#define pp_ggrent Perl_pp_ggrent +#define pp_ggrgid Perl_pp_ggrgid +#define pp_ggrnam Perl_pp_ggrnam +#define pp_ghbyaddr Perl_pp_ghbyaddr +#define pp_ghbyname Perl_pp_ghbyname +#define pp_ghostent Perl_pp_ghostent +#define pp_glob Perl_pp_glob +#define pp_gmtime Perl_pp_gmtime +#define pp_gnbyaddr Perl_pp_gnbyaddr +#define pp_gnbyname Perl_pp_gnbyname +#define pp_gnetent Perl_pp_gnetent +#define pp_goto Perl_pp_goto +#define pp_gpbyname Perl_pp_gpbyname +#define pp_gpbynumber Perl_pp_gpbynumber +#define pp_gprotoent Perl_pp_gprotoent +#define pp_gpwent Perl_pp_gpwent +#define pp_gpwnam Perl_pp_gpwnam +#define pp_gpwuid Perl_pp_gpwuid +#define pp_grepstart Perl_pp_grepstart +#define pp_grepwhile Perl_pp_grepwhile +#define pp_gsbyname Perl_pp_gsbyname +#define pp_gsbyport Perl_pp_gsbyport +#define pp_gservent Perl_pp_gservent +#define pp_gsockopt Perl_pp_gsockopt +#define pp_gt Perl_pp_gt +#define pp_gv Perl_pp_gv +#define pp_gvsv Perl_pp_gvsv +#define pp_helem Perl_pp_helem +#define pp_hex Perl_pp_hex +#define pp_hslice Perl_pp_hslice +#define pp_i_add Perl_pp_i_add +#define pp_i_divide Perl_pp_i_divide +#define pp_i_eq Perl_pp_i_eq +#define pp_i_ge Perl_pp_i_ge +#define pp_i_gt Perl_pp_i_gt +#define pp_i_le Perl_pp_i_le +#define pp_i_lt Perl_pp_i_lt +#define pp_i_modulo Perl_pp_i_modulo +#define pp_i_multiply Perl_pp_i_multiply +#define pp_i_ncmp Perl_pp_i_ncmp +#define pp_i_ne Perl_pp_i_ne +#define pp_i_negate Perl_pp_i_negate +#define pp_i_subtract Perl_pp_i_subtract +#define pp_index Perl_pp_index +#define pp_indread Perl_pp_indread +#define pp_int Perl_pp_int +#define pp_interp Perl_pp_interp +#define pp_ioctl Perl_pp_ioctl +#define pp_iter Perl_pp_iter +#define pp_join Perl_pp_join +#define pp_keys Perl_pp_keys +#define pp_kill Perl_pp_kill +#define pp_last Perl_pp_last +#define pp_lc Perl_pp_lc +#define pp_lcfirst Perl_pp_lcfirst +#define pp_le Perl_pp_le +#define pp_leave Perl_pp_leave +#define pp_leaveeval Perl_pp_leaveeval +#define pp_leaveloop Perl_pp_leaveloop +#define pp_leavesub Perl_pp_leavesub +#define pp_leavetry Perl_pp_leavetry +#define pp_leavewrite Perl_pp_leavewrite +#define pp_left_shift Perl_pp_left_shift +#define pp_length Perl_pp_length +#define pp_lineseq Perl_pp_lineseq +#define pp_link Perl_pp_link +#define pp_list Perl_pp_list +#define pp_listen Perl_pp_listen +#define pp_localtime Perl_pp_localtime +#define pp_log Perl_pp_log +#define pp_lslice Perl_pp_lslice +#define pp_lstat Perl_pp_lstat +#define pp_lt Perl_pp_lt +#define pp_map Perl_pp_map +#define pp_mapstart Perl_pp_mapstart +#define pp_mapwhile Perl_pp_mapwhile +#define pp_match Perl_pp_match +#define pp_method Perl_pp_method +#define pp_mkdir Perl_pp_mkdir +#define pp_modulo Perl_pp_modulo +#define pp_msgctl Perl_pp_msgctl +#define pp_msgget Perl_pp_msgget +#define pp_msgrcv Perl_pp_msgrcv +#define pp_msgsnd Perl_pp_msgsnd +#define pp_multiply Perl_pp_multiply +#define pp_ncmp Perl_pp_ncmp +#define pp_ne Perl_pp_ne +#define pp_negate Perl_pp_negate +#define pp_next Perl_pp_next +#define pp_nextstate Perl_pp_nextstate +#define pp_not Perl_pp_not +#define pp_nswitch Perl_pp_nswitch +#define pp_null Perl_pp_null +#define pp_oct Perl_pp_oct +#define pp_open Perl_pp_open +#define pp_open_dir Perl_pp_open_dir +#define pp_or Perl_pp_or +#define pp_orassign Perl_pp_orassign +#define pp_ord Perl_pp_ord +#define pp_pack Perl_pp_pack +#define pp_padany Perl_pp_padany +#define pp_padav Perl_pp_padav +#define pp_padhv Perl_pp_padhv +#define pp_padsv Perl_pp_padsv +#define pp_pipe_op Perl_pp_pipe_op +#define pp_pop Perl_pp_pop +#define pp_pos Perl_pp_pos +#define pp_postdec Perl_pp_postdec +#define pp_postinc Perl_pp_postinc +#define pp_pow Perl_pp_pow +#define pp_predec Perl_pp_predec +#define pp_preinc Perl_pp_preinc +#define pp_print Perl_pp_print +#define pp_prototype Perl_pp_prototype +#define pp_prtf Perl_pp_prtf +#define pp_push Perl_pp_push +#define pp_pushmark Perl_pp_pushmark +#define pp_pushre Perl_pp_pushre +#define pp_quotemeta Perl_pp_quotemeta +#define pp_rand Perl_pp_rand +#define pp_range Perl_pp_range +#define pp_rcatline Perl_pp_rcatline +#define pp_read Perl_pp_read +#define pp_readdir Perl_pp_readdir +#define pp_readline Perl_pp_readline +#define pp_readlink Perl_pp_readlink +#define pp_recv Perl_pp_recv +#define pp_redo Perl_pp_redo +#define pp_ref Perl_pp_ref +#define pp_refgen Perl_pp_refgen +#define pp_regcmaybe Perl_pp_regcmaybe +#define pp_regcomp Perl_pp_regcomp +#define pp_rename Perl_pp_rename +#define pp_repeat Perl_pp_repeat +#define pp_require Perl_pp_require +#define pp_reset Perl_pp_reset +#define pp_return Perl_pp_return +#define pp_reverse Perl_pp_reverse +#define pp_rewinddir Perl_pp_rewinddir +#define pp_right_shift Perl_pp_right_shift +#define pp_rindex Perl_pp_rindex +#define pp_rmdir Perl_pp_rmdir +#define pp_rv2av Perl_pp_rv2av +#define pp_rv2cv Perl_pp_rv2cv +#define pp_rv2gv Perl_pp_rv2gv +#define pp_rv2hv Perl_pp_rv2hv +#define pp_rv2sv Perl_pp_rv2sv +#define pp_sassign Perl_pp_sassign +#define pp_scalar Perl_pp_scalar +#define pp_schomp Perl_pp_schomp +#define pp_schop Perl_pp_schop +#define pp_scmp Perl_pp_scmp +#define pp_scope Perl_pp_scope +#define pp_seek Perl_pp_seek +#define pp_seekdir Perl_pp_seekdir +#define pp_select Perl_pp_select +#define pp_semctl Perl_pp_semctl +#define pp_semget Perl_pp_semget +#define pp_semop Perl_pp_semop +#define pp_send Perl_pp_send +#define pp_seq Perl_pp_seq +#define pp_setpgrp Perl_pp_setpgrp +#define pp_setpriority Perl_pp_setpriority +#define pp_sge Perl_pp_sge +#define pp_sgrent Perl_pp_sgrent +#define pp_sgt Perl_pp_sgt +#define pp_shift Perl_pp_shift +#define pp_shmctl Perl_pp_shmctl +#define pp_shmget Perl_pp_shmget +#define pp_shmread Perl_pp_shmread +#define pp_shmwrite Perl_pp_shmwrite +#define pp_shostent Perl_pp_shostent +#define pp_shutdown Perl_pp_shutdown +#define pp_sin Perl_pp_sin +#define pp_sle Perl_pp_sle +#define pp_sleep Perl_pp_sleep +#define pp_slt Perl_pp_slt +#define pp_sne Perl_pp_sne +#define pp_snetent Perl_pp_snetent +#define pp_socket Perl_pp_socket +#define pp_sockpair Perl_pp_sockpair +#define pp_sort Perl_pp_sort +#define pp_splice Perl_pp_splice +#define pp_split Perl_pp_split +#define pp_sprintf Perl_pp_sprintf +#define pp_sprotoent Perl_pp_sprotoent +#define pp_spwent Perl_pp_spwent +#define pp_sqrt Perl_pp_sqrt +#define pp_srand Perl_pp_srand +#define pp_srefgen Perl_pp_srefgen +#define pp_sselect Perl_pp_sselect +#define pp_sservent Perl_pp_sservent +#define pp_ssockopt Perl_pp_ssockopt +#define pp_stat Perl_pp_stat +#define pp_stringify Perl_pp_stringify +#define pp_stub Perl_pp_stub +#define pp_study Perl_pp_study +#define pp_subst Perl_pp_subst +#define pp_substcont Perl_pp_substcont +#define pp_substr Perl_pp_substr +#define pp_subtract Perl_pp_subtract +#define pp_symlink Perl_pp_symlink +#define pp_syscall Perl_pp_syscall +#define pp_sysopen Perl_pp_sysopen +#define pp_sysread Perl_pp_sysread +#define pp_system Perl_pp_system +#define pp_syswrite Perl_pp_syswrite +#define pp_tell Perl_pp_tell +#define pp_telldir Perl_pp_telldir +#define pp_tie Perl_pp_tie +#define pp_tied Perl_pp_tied +#define pp_time Perl_pp_time +#define pp_tms Perl_pp_tms +#define pp_trans Perl_pp_trans +#define pp_truncate Perl_pp_truncate +#define pp_uc Perl_pp_uc +#define pp_ucfirst Perl_pp_ucfirst +#define pp_umask Perl_pp_umask +#define pp_undef Perl_pp_undef +#define pp_unlink Perl_pp_unlink +#define pp_unpack Perl_pp_unpack +#define pp_unshift Perl_pp_unshift +#define pp_unstack Perl_pp_unstack +#define pp_untie Perl_pp_untie +#define pp_utime Perl_pp_utime +#define pp_values Perl_pp_values +#define pp_vec Perl_pp_vec +#define pp_wait Perl_pp_wait +#define pp_waitpid Perl_pp_waitpid +#define pp_wantarray Perl_pp_wantarray +#define pp_warn Perl_pp_warn +#define pp_xor Perl_pp_xor +#define ppaddr Perl_ppaddr +#define pregcomp Perl_pregcomp +#define pregexec Perl_pregexec +#define pregfree Perl_pregfree +#define prepend_elem Perl_prepend_elem +#define profiledata Perl_profiledata +#define provide_ref Perl_provide_ref +#define psig_name Perl_psig_name +#define psig_ptr Perl_psig_ptr +#define push_return Perl_push_return +#define push_scope Perl_push_scope +#define q Perl_q +#define qrt_amg Perl_qrt_amg +#define rcsid Perl_rcsid +#define reall_srchlen Perl_reall_srchlen +#define ref Perl_ref +#define refkids Perl_refkids +#define regarglen Perl_regarglen +#define regbol Perl_regbol +#define regcode Perl_regcode +#define regdummy Perl_regdummy +#define regdump Perl_regdump +#define regendp Perl_regendp +#define regeol Perl_regeol +#define reginput Perl_reginput +#define regkind Perl_regkind +#define reglastparen Perl_reglastparen +#define regmyendp Perl_regmyendp +#define regmyp_size Perl_regmyp_size +#define regmystartp Perl_regmystartp +#define regnarrate Perl_regnarrate +#define regnaughty Perl_regnaughty +#define regnext Perl_regnext +#define regnpar Perl_regnpar +#define regparse Perl_regparse +#define regprecomp Perl_regprecomp +#define regprev Perl_regprev +#define regprop Perl_regprop +#define regsawback Perl_regsawback +#define regsize Perl_regsize +#define regstartp Perl_regstartp +#define regtill Perl_regtill +#define regxend Perl_regxend +#define repeat_amg Perl_repeat_amg +#define repeat_ass_amg Perl_repeat_ass_amg +#define repeatcpy Perl_repeatcpy +#define retstack Perl_retstack +#define retstack_ix Perl_retstack_ix +#define retstack_max Perl_retstack_max +#define rninstr Perl_rninstr +#define rsfp Perl_rsfp +#define rsfp_filters Perl_rsfp_filters +#define rshift_amg Perl_rshift_amg +#define rshift_ass_amg Perl_rshift_ass_amg +#define rsignal Perl_rsignal +#define rsignal_restore Perl_rsignal_restore +#define rsignal_save Perl_rsignal_save +#define rsignal_state Perl_rsignal_state +#define runops Perl_runops +#define same_dirent Perl_same_dirent +#define save_I16 Perl_save_I16 +#define save_I32 Perl_save_I32 +#define save_aptr Perl_save_aptr +#define save_ary Perl_save_ary +#define save_clearsv Perl_save_clearsv +#define save_delete Perl_save_delete +#define save_destructor Perl_save_destructor +#define save_freeop Perl_save_freeop +#define save_freepv Perl_save_freepv +#define save_freesv Perl_save_freesv +#define save_gp Perl_save_gp +#define save_hash Perl_save_hash +#define save_hptr Perl_save_hptr +#define save_int Perl_save_int +#define save_item Perl_save_item +#define save_list Perl_save_list +#define save_long Perl_save_long +#define save_nogv Perl_save_nogv +#define save_pptr Perl_save_pptr +#define save_scalar Perl_save_scalar +#define save_sptr Perl_save_sptr +#define save_svref Perl_save_svref +#define savepv Perl_savepv +#define savepvn Perl_savepvn +#define savestack Perl_savestack +#define savestack_grow Perl_savestack_grow +#define savestack_ix Perl_savestack_ix +#define savestack_max Perl_savestack_max +#define saw_return Perl_saw_return +#define sawparens Perl_sawparens +#define scalar Perl_scalar +#define scalarkids Perl_scalarkids +#define scalarseq Perl_scalarseq +#define scalarvoid Perl_scalarvoid +#define scan_const Perl_scan_const +#define scan_formline Perl_scan_formline +#define scan_heredoc Perl_scan_heredoc +#define scan_hex Perl_scan_hex +#define scan_ident Perl_scan_ident #define scan_inputsymbol Perl_scan_inputsymbol -#define scan_num Perl_scan_num -#define scan_oct Perl_scan_oct -#define scan_pat Perl_scan_pat -#define scan_prefix Perl_scan_prefix -#define scan_str Perl_scan_str -#define scan_subst Perl_scan_subst -#define scan_trans Perl_scan_trans -#define scan_word Perl_scan_word -#define scope Perl_scope -#define screaminstr Perl_screaminstr -#define setdefout Perl_setdefout -#define setenv_getix Perl_setenv_getix -#define share_hek Perl_share_hek -#define sharepvn Perl_sharepvn -#define sighandler Perl_sighandler -#define skipspace Perl_skipspace -#define stack_grow Perl_stack_grow -#define start_subparse Perl_start_subparse -#define sublex_done Perl_sublex_done -#define sublex_start Perl_sublex_start -#define sv_2bool Perl_sv_2bool -#define sv_2cv Perl_sv_2cv -#define sv_2io Perl_sv_2io -#define sv_2iv Perl_sv_2iv -#define sv_2mortal Perl_sv_2mortal -#define sv_2nv Perl_sv_2nv -#define sv_2pv Perl_sv_2pv -#define sv_2uv Perl_sv_2uv -#define sv_add_arena Perl_sv_add_arena -#define sv_backoff Perl_sv_backoff -#define sv_bless Perl_sv_bless -#define sv_catpv Perl_sv_catpv -#define sv_catpvn Perl_sv_catpvn -#define sv_catsv Perl_sv_catsv -#define sv_chop Perl_sv_chop -#define sv_clean_all Perl_sv_clean_all -#define sv_clean_objs Perl_sv_clean_objs -#define sv_clear Perl_sv_clear -#define sv_cmp Perl_sv_cmp -#define sv_cmp_locale Perl_sv_cmp_locale -#define sv_collxfrm Perl_sv_collxfrm -#define sv_dec Perl_sv_dec -#define sv_derived_from Perl_sv_derived_from -#define sv_dump Perl_sv_dump -#define sv_eq Perl_sv_eq -#define sv_free Perl_sv_free -#define sv_free_arenas Perl_sv_free_arenas -#define sv_gets Perl_sv_gets -#define sv_grow Perl_sv_grow -#define sv_inc Perl_sv_inc -#define sv_insert Perl_sv_insert -#define sv_isa Perl_sv_isa -#define sv_isobject Perl_sv_isobject -#define sv_len Perl_sv_len -#define sv_magic Perl_sv_magic -#define sv_mortalcopy Perl_sv_mortalcopy -#define sv_newmortal Perl_sv_newmortal -#define sv_newref Perl_sv_newref -#define sv_peek Perl_sv_peek -#define sv_pvn Perl_sv_pvn -#define sv_pvn_force Perl_sv_pvn_force -#define sv_ref Perl_sv_ref -#define sv_reftype Perl_sv_reftype -#define sv_replace Perl_sv_replace -#define sv_report_used Perl_sv_report_used -#define sv_reset Perl_sv_reset -#define sv_setiv Perl_sv_setiv -#define sv_setnv Perl_sv_setnv -#define sv_setptrobj Perl_sv_setptrobj -#define sv_setpv Perl_sv_setpv -#define sv_setpvn Perl_sv_setpvn -#define sv_setref_iv Perl_sv_setref_iv -#define sv_setref_nv Perl_sv_setref_nv -#define sv_setref_pv Perl_sv_setref_pv -#define sv_setref_pvn Perl_sv_setref_pvn -#define sv_setsv Perl_sv_setsv -#define sv_setuv Perl_sv_setuv -#define sv_taint Perl_sv_taint -#define sv_tainted Perl_sv_tainted -#define sv_unmagic Perl_sv_unmagic -#define sv_unref Perl_sv_unref -#define sv_untaint Perl_sv_untaint -#define sv_upgrade Perl_sv_upgrade -#define sv_usepvn Perl_sv_usepvn -#define taint_env Perl_taint_env -#define taint_proper Perl_taint_proper +#define scan_num Perl_scan_num +#define scan_oct Perl_scan_oct +#define scan_pat Perl_scan_pat +#define scan_prefix Perl_scan_prefix +#define scan_str Perl_scan_str +#define scan_subst Perl_scan_subst +#define scan_trans Perl_scan_trans +#define scan_word Perl_scan_word +#define scmp_amg Perl_scmp_amg +#define scope Perl_scope +#define scopestack Perl_scopestack +#define scopestack_ix Perl_scopestack_ix +#define scopestack_max Perl_scopestack_max +#define screaminstr Perl_screaminstr +#define scrgv Perl_scrgv +#define seq_amg Perl_seq_amg +#define setdefout Perl_setdefout +#define setenv_getix Perl_setenv_getix +#define sge_amg Perl_sge_amg +#define sgt_amg Perl_sgt_amg +#define sh_path Perl_sh_path +#define share_hek Perl_share_hek +#define sharepvn Perl_sharepvn +#define sig_name Perl_sig_name +#define sig_num Perl_sig_num +#define sighandler Perl_sighandler +#define simple Perl_simple +#define sin_amg Perl_sin_amg +#define skipspace Perl_skipspace +#define sle_amg Perl_sle_amg +#define slt_amg Perl_slt_amg +#define sne_amg Perl_sne_amg +#define stack_base Perl_stack_base +#define stack_grow Perl_stack_grow +#define stack_max Perl_stack_max +#define stack_sp Perl_stack_sp +#define start_subparse Perl_start_subparse +#define statbuf Perl_statbuf +#define string_amg Perl_string_amg +#define sub_generation Perl_sub_generation +#define sublex_done Perl_sublex_done +#define sublex_start Perl_sublex_start +#define subline Perl_subline +#define subname Perl_subname +#define subtr_amg Perl_subtr_amg +#define subtr_ass_amg Perl_subtr_ass_amg +#define sv_2bool Perl_sv_2bool +#define sv_2cv Perl_sv_2cv +#define sv_2io Perl_sv_2io +#define sv_2iv Perl_sv_2iv +#define sv_2mortal Perl_sv_2mortal +#define sv_2nv Perl_sv_2nv +#define sv_2pv Perl_sv_2pv +#define sv_2uv Perl_sv_2uv +#define sv_add_arena Perl_sv_add_arena +#define sv_backoff Perl_sv_backoff +#define sv_bless Perl_sv_bless +#define sv_catpv Perl_sv_catpv +#define sv_catpvn Perl_sv_catpvn +#define sv_catsv Perl_sv_catsv +#define sv_chop Perl_sv_chop +#define sv_clean_all Perl_sv_clean_all +#define sv_clean_objs Perl_sv_clean_objs +#define sv_clear Perl_sv_clear +#define sv_cmp Perl_sv_cmp +#define sv_cmp_locale Perl_sv_cmp_locale +#define sv_collxfrm Perl_sv_collxfrm +#define sv_dec Perl_sv_dec +#define sv_derived_from Perl_sv_derived_from +#define sv_dump Perl_sv_dump +#define sv_eq Perl_sv_eq +#define sv_free Perl_sv_free +#define sv_free_arenas Perl_sv_free_arenas +#define sv_gets Perl_sv_gets +#define sv_grow Perl_sv_grow +#define sv_inc Perl_sv_inc +#define sv_insert Perl_sv_insert +#define sv_isa Perl_sv_isa +#define sv_isobject Perl_sv_isobject +#define sv_len Perl_sv_len +#define sv_magic Perl_sv_magic +#define sv_mortalcopy Perl_sv_mortalcopy +#define sv_newmortal Perl_sv_newmortal +#define sv_newref Perl_sv_newref +#define sv_no Perl_sv_no +#define sv_peek Perl_sv_peek +#define sv_pvn_force Perl_sv_pvn_force +#define sv_ref Perl_sv_ref +#define sv_reftype Perl_sv_reftype +#define sv_replace Perl_sv_replace +#define sv_report_used Perl_sv_report_used +#define sv_reset Perl_sv_reset +#define sv_setiv Perl_sv_setiv +#define sv_setnv Perl_sv_setnv +#define sv_setptrobj Perl_sv_setptrobj +#define sv_setpv Perl_sv_setpv +#define sv_setpvn Perl_sv_setpvn +#define sv_setref_iv Perl_sv_setref_iv +#define sv_setref_nv Perl_sv_setref_nv +#define sv_setref_pv Perl_sv_setref_pv +#define sv_setref_pvn Perl_sv_setref_pvn +#define sv_setsv Perl_sv_setsv +#define sv_setuv Perl_sv_setuv +#define sv_taint Perl_sv_taint +#define sv_tainted Perl_sv_tainted +#define sv_undef Perl_sv_undef +#define sv_unmagic Perl_sv_unmagic +#define sv_unref Perl_sv_unref +#define sv_untaint Perl_sv_untaint +#define sv_upgrade Perl_sv_upgrade +#define sv_usepvn Perl_sv_usepvn +#define sv_yes Perl_sv_yes +#define taint_env Perl_taint_env +#define taint_proper Perl_taint_proper +#define thisexpr Perl_thisexpr +#define timesbuf Perl_timesbuf +#define tokenbuf Perl_tokenbuf #define too_few_arguments Perl_too_few_arguments #define too_many_arguments Perl_too_many_arguments -#define unlnk Perl_unlnk -#define unshare_hek Perl_unshare_hek -#define unsharepvn Perl_unsharepvn -#define utilize Perl_utilize -#define wait4pid Perl_wait4pid -#define warn Perl_warn -#define watch Perl_watch -#define whichsig Perl_whichsig -#define xiv_arenaroot Perl_xiv_arenaroot -#define xiv_root Perl_xiv_root -#define xnv_root Perl_xnv_root -#define xpv_root Perl_xpv_root -#define xrv_root Perl_xrv_root -#define yyerror Perl_yyerror -#define yydestruct Perl_yydestruct -#define yylex Perl_yylex -#define yyparse Perl_yyparse -#define yywarn Perl_yywarn +#define uid Perl_uid +#define unlnk Perl_unlnk +#define unshare_hek Perl_unshare_hek +#define unsharepvn Perl_unsharepvn +#define utilize Perl_utilize +#define varies Perl_varies +#define vert Perl_vert +#define vtbl_amagic Perl_vtbl_amagic +#define vtbl_amagicelem Perl_vtbl_amagicelem +#define vtbl_arylen Perl_vtbl_arylen +#define vtbl_bm Perl_vtbl_bm +#define vtbl_collxfrm Perl_vtbl_collxfrm +#define vtbl_dbline Perl_vtbl_dbline +#define vtbl_env Perl_vtbl_env +#define vtbl_envelem Perl_vtbl_envelem +#define vtbl_fm Perl_vtbl_fm +#define vtbl_glob Perl_vtbl_glob +#define vtbl_isa Perl_vtbl_isa +#define vtbl_isaelem Perl_vtbl_isaelem +#define vtbl_mglob Perl_vtbl_mglob +#define vtbl_nkeys Perl_vtbl_nkeys +#define vtbl_pack Perl_vtbl_pack +#define vtbl_packelem Perl_vtbl_packelem +#define vtbl_pos Perl_vtbl_pos +#define vtbl_sig Perl_vtbl_sig +#define vtbl_sigelem Perl_vtbl_sigelem +#define vtbl_substr Perl_vtbl_substr +#define vtbl_sv Perl_vtbl_sv +#define vtbl_taint Perl_vtbl_taint +#define vtbl_uvar Perl_vtbl_uvar +#define vtbl_vec Perl_vtbl_vec +#define wait4pid Perl_wait4pid +#define warn Perl_warn +#define warn_nl Perl_warn_nl +#define warn_nosemi Perl_warn_nosemi +#define warn_reserved Perl_warn_reserved +#define watch Perl_watch +#define watchaddr Perl_watchaddr +#define watchok Perl_watchok +#define whichsig Perl_whichsig +#define xiv_arenaroot Perl_xiv_arenaroot +#define xiv_root Perl_xiv_root +#define xnv_root Perl_xnv_root +#define xpv_root Perl_xpv_root +#define xrv_root Perl_xrv_root +#define yychar Perl_yychar +#define yycheck Perl_yycheck +#define yydebug Perl_yydebug +#define yydefred Perl_yydefred +#define yydgoto Perl_yydgoto +#define yyerrflag Perl_yyerrflag +#define yyerror Perl_yyerror +#define yygindex Perl_yygindex +#define yylen Perl_yylen +#define yylex Perl_yylex +#define yylhs Perl_yylhs +#define yylval Perl_yylval +#define yyname Perl_yyname +#define yynerrs Perl_yynerrs +#define yyparse Perl_yyparse +#define yyrindex Perl_yyrindex +#define yyrule Perl_yyrule +#define yysindex Perl_yysindex +#define yytable Perl_yytable +#define yyval Perl_yyval +#define yywarn Perl_yywarn + +/* Hide global symbols that 5.003 revealed? */ + +#ifndef BINCOMPAT3 + +#define Error Perl_Error +#define SvIV Perl_SvIV +#define SvNV Perl_SvNV +#define SvTRUE Perl_SvTRUE +#define SvUV Perl_SvUV +#define block_type Perl_block_type +#define boot_core_UNIVERSAL Perl_boot_core_UNIVERSAL +#define comppad_name_floor Perl_comppad_name_floor +#define debug Perl_debug +#define do_undump Perl_do_undump +#define nice_chunk Perl_nice_chunk +#define nice_chunk_size Perl_nice_chunk_size +#define no_myglob Perl_no_myglob +#define no_symref Perl_no_symref +#define no_wrongref Perl_no_wrongref +#define pad_reset_pending Perl_pad_reset_pending +#define padix_floor Perl_padix_floor +#define regflags Perl_regflags +#define safecalloc Perl_safecalloc +#define safefree Perl_safefree +#define safemalloc Perl_safemalloc +#define saferealloc Perl_saferealloc +#define safexcalloc Perl_safexcalloc +#define safexfree Perl_safexfree +#define safexmalloc Perl_safexmalloc +#define safexrealloc Perl_safexrealloc +#define save_iv Perl_save_iv +#define sv_pvn Perl_sv_pvn +#define warn_uninit Perl_warn_uninit +#define yydestruct Perl_yydestruct + +#endif /* !BINCOMPAT3 */ #endif /* EMBED */ -/* Put interpreter specific symbols into a struct? */ +/* Put interpreter-specific symbols into a struct? */ #ifdef MULTIPLICITY -#define Argv (curinterp->IArgv) -#define Cmd (curinterp->ICmd) -#define DBgv (curinterp->IDBgv) -#define DBline (curinterp->IDBline) -#define DBsignal (curinterp->IDBsignal) -#define DBsingle (curinterp->IDBsingle) -#define DBsub (curinterp->IDBsub) -#define DBtrace (curinterp->IDBtrace) -#define allgvs (curinterp->Iallgvs) -#define ampergv (curinterp->Iampergv) -#define argvgv (curinterp->Iargvgv) -#define argvoutgv (curinterp->Iargvoutgv) -#define basetime (curinterp->Ibasetime) -#define beginav (curinterp->Ibeginav) -#define bodytarget (curinterp->Ibodytarget) -#define cddir (curinterp->Icddir) -#define chopset (curinterp->Ichopset) -#define copline (curinterp->Icopline) -#define curblock (curinterp->Icurblock) -#define curcop (curinterp->Icurcop) -#define curcopdb (curinterp->Icurcopdb) -#define curcsv (curinterp->Icurcsv) -#define curpm (curinterp->Icurpm) -#define curstack (curinterp->Icurstack) -#define curstash (curinterp->Icurstash) -#define curstname (curinterp->Icurstname) -#define cxstack (curinterp->Icxstack) -#define cxstack_ix (curinterp->Icxstack_ix) -#define cxstack_max (curinterp->Icxstack_max) -#define dbargs (curinterp->Idbargs) -#define debdelim (curinterp->Idebdelim) -#define debname (curinterp->Idebname) -#define debstash (curinterp->Idebstash) -#define defgv (curinterp->Idefgv) -#define defoutgv (curinterp->Idefoutgv) -#define defstash (curinterp->Idefstash) -#define delaymagic (curinterp->Idelaymagic) -#define diehook (curinterp->Idiehook) -#define dirty (curinterp->Idirty) -#define dlevel (curinterp->Idlevel) -#define dlmax (curinterp->Idlmax) -#define doextract (curinterp->Idoextract) -#define doswitches (curinterp->Idoswitches) -#define dowarn (curinterp->Idowarn) -#define dumplvl (curinterp->Idumplvl) -#define e_fp (curinterp->Ie_fp) -#define e_tmpname (curinterp->Ie_tmpname) -#define endav (curinterp->Iendav) -#define envgv (curinterp->Ienvgv) -#define errgv (curinterp->Ierrgv) -#define eval_root (curinterp->Ieval_root) -#define eval_start (curinterp->Ieval_start) -#define fdpid (curinterp->Ifdpid) -#define filemode (curinterp->Ifilemode) -#define firstgv (curinterp->Ifirstgv) -#define forkprocess (curinterp->Iforkprocess) -#define formfeed (curinterp->Iformfeed) -#define formtarget (curinterp->Iformtarget) -#define gensym (curinterp->Igensym) -#define in_eval (curinterp->Iin_eval) -#define incgv (curinterp->Iincgv) -#define inplace (curinterp->Iinplace) -#define last_in_gv (curinterp->Ilast_in_gv) -#define lastfd (curinterp->Ilastfd) -#define lastretstr (curinterp->Ilastretstr) -#define lastscream (curinterp->Ilastscream) -#define lastsize (curinterp->Ilastsize) -#define lastspbase (curinterp->Ilastspbase) -#define laststatval (curinterp->Ilaststatval) -#define laststype (curinterp->Ilaststype) -#define leftgv (curinterp->Ileftgv) -#define lineary (curinterp->Ilineary) -#define localizing (curinterp->Ilocalizing) -#define localpatches (curinterp->Ilocalpatches) -#define main_cv (curinterp->Imain_cv) -#define main_root (curinterp->Imain_root) -#define main_start (curinterp->Imain_start) -#define mainstack (curinterp->Imainstack) -#define maxscream (curinterp->Imaxscream) -#define maxsysfd (curinterp->Imaxsysfd) -#define minus_F (curinterp->Iminus_F) -#define minus_a (curinterp->Iminus_a) -#define minus_c (curinterp->Iminus_c) -#define minus_l (curinterp->Iminus_l) -#define minus_n (curinterp->Iminus_n) -#define minus_p (curinterp->Iminus_p) -#define multiline (curinterp->Imultiline) -#define mystack_base (curinterp->Imystack_base) -#define mystack_mark (curinterp->Imystack_mark) -#define mystack_max (curinterp->Imystack_max) -#define mystack_sp (curinterp->Imystack_sp) -#define mystrk (curinterp->Imystrk) -#define nrs (curinterp->Inrs) -#define ofmt (curinterp->Iofmt) -#define ofs (curinterp->Iofs) -#define ofslen (curinterp->Iofslen) -#define oldlastpm (curinterp->Ioldlastpm) -#define oldname (curinterp->Ioldname) -#define op_mask (curinterp->Iop_mask) -#define origargc (curinterp->Iorigargc) -#define origargv (curinterp->Iorigargv) -#define origfilename (curinterp->Iorigfilename) -#define ors (curinterp->Iors) -#define orslen (curinterp->Iorslen) -#define parsehook (curinterp->Iparsehook) -#define patchlevel (curinterp->Ipatchlevel) -#define perldb (curinterp->Iperldb) +#define Argv (curinterp->IArgv) +#define Cmd (curinterp->ICmd) +#define DBgv (curinterp->IDBgv) +#define DBline (curinterp->IDBline) +#define DBsignal (curinterp->IDBsignal) +#define DBsingle (curinterp->IDBsingle) +#define DBsub (curinterp->IDBsub) +#define DBtrace (curinterp->IDBtrace) +#define allgvs (curinterp->Iallgvs) +#define ampergv (curinterp->Iampergv) +#define argvgv (curinterp->Iargvgv) +#define argvoutgv (curinterp->Iargvoutgv) +#define basetime (curinterp->Ibasetime) +#define beginav (curinterp->Ibeginav) +#define bodytarget (curinterp->Ibodytarget) +#define cddir (curinterp->Icddir) +#define chopset (curinterp->Ichopset) +#define copline (curinterp->Icopline) +#define curblock (curinterp->Icurblock) +#define curcop (curinterp->Icurcop) +#define curcopdb (curinterp->Icurcopdb) +#define curcsv (curinterp->Icurcsv) +#define curpm (curinterp->Icurpm) +#define curstack (curinterp->Icurstack) +#define curstash (curinterp->Icurstash) +#define curstname (curinterp->Icurstname) +#define cxstack (curinterp->Icxstack) +#define cxstack_ix (curinterp->Icxstack_ix) +#define cxstack_max (curinterp->Icxstack_max) +#define dbargs (curinterp->Idbargs) +#define debdelim (curinterp->Idebdelim) +#define debname (curinterp->Idebname) +#define debstash (curinterp->Idebstash) +#define defgv (curinterp->Idefgv) +#define defoutgv (curinterp->Idefoutgv) +#define defstash (curinterp->Idefstash) +#define delaymagic (curinterp->Idelaymagic) +#define diehook (curinterp->Idiehook) +#define dirty (curinterp->Idirty) +#define dlevel (curinterp->Idlevel) +#define dlmax (curinterp->Idlmax) +#define doextract (curinterp->Idoextract) +#define doswitches (curinterp->Idoswitches) +#define dowarn (curinterp->Idowarn) +#define dumplvl (curinterp->Idumplvl) +#define e_fp (curinterp->Ie_fp) +#define e_tmpname (curinterp->Ie_tmpname) +#define endav (curinterp->Iendav) +#define envgv (curinterp->Ienvgv) +#define errgv (curinterp->Ierrgv) +#define eval_root (curinterp->Ieval_root) +#define eval_start (curinterp->Ieval_start) +#define fdpid (curinterp->Ifdpid) +#define filemode (curinterp->Ifilemode) +#define firstgv (curinterp->Ifirstgv) +#define forkprocess (curinterp->Iforkprocess) +#define formfeed (curinterp->Iformfeed) +#define formtarget (curinterp->Iformtarget) +#define gensym (curinterp->Igensym) +#define in_eval (curinterp->Iin_eval) +#define incgv (curinterp->Iincgv) +#define inplace (curinterp->Iinplace) +#define last_in_gv (curinterp->Ilast_in_gv) +#define lastfd (curinterp->Ilastfd) +#define lastretstr (curinterp->Ilastretstr) +#define lastscream (curinterp->Ilastscream) +#define lastsize (curinterp->Ilastsize) +#define lastspbase (curinterp->Ilastspbase) +#define laststatval (curinterp->Ilaststatval) +#define laststype (curinterp->Ilaststype) +#define leftgv (curinterp->Ileftgv) +#define lineary (curinterp->Ilineary) +#define localizing (curinterp->Ilocalizing) +#define localpatches (curinterp->Ilocalpatches) +#define main_cv (curinterp->Imain_cv) +#define main_root (curinterp->Imain_root) +#define main_start (curinterp->Imain_start) +#define mainstack (curinterp->Imainstack) +#define maxscream (curinterp->Imaxscream) +#define maxsysfd (curinterp->Imaxsysfd) +#define minus_F (curinterp->Iminus_F) +#define minus_a (curinterp->Iminus_a) +#define minus_c (curinterp->Iminus_c) +#define minus_l (curinterp->Iminus_l) +#define minus_n (curinterp->Iminus_n) +#define minus_p (curinterp->Iminus_p) +#define multiline (curinterp->Imultiline) +#define mystack_base (curinterp->Imystack_base) +#define mystack_mark (curinterp->Imystack_mark) +#define mystack_max (curinterp->Imystack_max) +#define mystack_sp (curinterp->Imystack_sp) +#define mystrk (curinterp->Imystrk) +#define nrs (curinterp->Inrs) +#define ofmt (curinterp->Iofmt) +#define ofs (curinterp->Iofs) +#define ofslen (curinterp->Iofslen) +#define oldlastpm (curinterp->Ioldlastpm) +#define oldname (curinterp->Ioldname) +#define op_mask (curinterp->Iop_mask) +#define origargc (curinterp->Iorigargc) +#define origargv (curinterp->Iorigargv) +#define origfilename (curinterp->Iorigfilename) +#define ors (curinterp->Iors) +#define orslen (curinterp->Iorslen) +#define parsehook (curinterp->Iparsehook) +#define patchlevel (curinterp->Ipatchlevel) #define perl_destruct_level (curinterp->Iperl_destruct_level) -#define pidstatus (curinterp->Ipidstatus) -#define preambled (curinterp->Ipreambled) -#define preambleav (curinterp->Ipreambleav) -#define preprocess (curinterp->Ipreprocess) -#define restartop (curinterp->Irestartop) -#define rightgv (curinterp->Irightgv) -#define rs (curinterp->Irs) -#define runlevel (curinterp->Irunlevel) -#define sawampersand (curinterp->Isawampersand) -#define sawstudy (curinterp->Isawstudy) -#define sawvec (curinterp->Isawvec) -#define screamfirst (curinterp->Iscreamfirst) -#define screamnext (curinterp->Iscreamnext) -#define secondgv (curinterp->Isecondgv) -#define siggv (curinterp->Isiggv) -#define signalstack (curinterp->Isignalstack) -#define sortcop (curinterp->Isortcop) -#define sortstack (curinterp->Isortstack) -#define sortstash (curinterp->Isortstash) -#define splitstr (curinterp->Isplitstr) -#define statcache (curinterp->Istatcache) -#define statgv (curinterp->Istatgv) -#define statname (curinterp->Istatname) -#define statusvalue (curinterp->Istatusvalue) -#define stdingv (curinterp->Istdingv) -#define strchop (curinterp->Istrchop) -#define strtab (curinterp->Istrtab) -#define sv_count (curinterp->Isv_count) -#define sv_objcount (curinterp->Isv_objcount) -#define sv_root (curinterp->Isv_root) -#define sv_arenaroot (curinterp->Isv_arenaroot) -#define tainted (curinterp->Itainted) -#define tainting (curinterp->Itainting) -#define tmps_floor (curinterp->Itmps_floor) -#define tmps_ix (curinterp->Itmps_ix) -#define tmps_max (curinterp->Itmps_max) -#define tmps_stack (curinterp->Itmps_stack) -#define top_env (curinterp->Itop_env) -#define toptarget (curinterp->Itoptarget) -#define unsafe (curinterp->Iunsafe) -#define warnhook (curinterp->Iwarnhook) +#define perldb (curinterp->Iperldb) +#define pidstatus (curinterp->Ipidstatus) +#define preambleav (curinterp->Ipreambleav) +#define preambled (curinterp->Ipreambled) +#define preprocess (curinterp->Ipreprocess) +#define restartop (curinterp->Irestartop) +#define rightgv (curinterp->Irightgv) +#define rs (curinterp->Irs) +#define runlevel (curinterp->Irunlevel) +#define sawampersand (curinterp->Isawampersand) +#define sawstudy (curinterp->Isawstudy) +#define sawvec (curinterp->Isawvec) +#define screamfirst (curinterp->Iscreamfirst) +#define screamnext (curinterp->Iscreamnext) +#define secondgv (curinterp->Isecondgv) +#define siggv (curinterp->Isiggv) +#define signalstack (curinterp->Isignalstack) +#define sortcop (curinterp->Isortcop) +#define sortstack (curinterp->Isortstack) +#define sortstash (curinterp->Isortstash) +#define splitstr (curinterp->Isplitstr) +#define statcache (curinterp->Istatcache) +#define statgv (curinterp->Istatgv) +#define statname (curinterp->Istatname) +#define statusvalue (curinterp->Istatusvalue) +#define stdingv (curinterp->Istdingv) +#define strchop (curinterp->Istrchop) +#define strtab (curinterp->Istrtab) +#define sv_arenaroot (curinterp->Isv_arenaroot) +#define sv_count (curinterp->Isv_count) +#define sv_objcount (curinterp->Isv_objcount) +#define sv_root (curinterp->Isv_root) +#define tainted (curinterp->Itainted) +#define tainting (curinterp->Itainting) +#define tmps_floor (curinterp->Itmps_floor) +#define tmps_ix (curinterp->Itmps_ix) +#define tmps_max (curinterp->Itmps_max) +#define tmps_stack (curinterp->Itmps_stack) +#define top_env (curinterp->Itop_env) +#define toptarget (curinterp->Itoptarget) +#define unsafe (curinterp->Iunsafe) +#define warnhook (curinterp->Iwarnhook) -#else /* not multiple, so translate interpreter symbols the other way... */ +#else /* !MULTIPLICITY */ -#define IArgv Argv -#define ICmd Cmd -#define IDBgv DBgv -#define IDBline DBline -#define IDBsignal DBsignal -#define IDBsingle DBsingle -#define IDBsub DBsub -#define IDBtrace DBtrace -#define Iallgvs allgvs -#define Iampergv ampergv -#define Iargvgv argvgv -#define Iargvoutgv argvoutgv -#define Ibasetime basetime -#define Ibeginav beginav -#define Ibodytarget bodytarget -#define Icddir cddir -#define Ichopset chopset -#define Icopline copline -#define Icurblock curblock -#define Icurcop curcop -#define Icurcopdb curcopdb -#define Icurcsv curcsv -#define Icurpm curpm -#define Icurstack curstack -#define Icurstash curstash -#define Icurstname curstname -#define Icxstack cxstack -#define Icxstack_ix cxstack_ix -#define Icxstack_max cxstack_max -#define Idbargs dbargs -#define Idebdelim debdelim -#define Idebname debname -#define Idebstash debstash -#define Idefgv defgv -#define Idefoutgv defoutgv -#define Idefstash defstash -#define Idelaymagic delaymagic -#define Idiehook diehook -#define Idirty dirty -#define Idlevel dlevel -#define Idlmax dlmax -#define Idoextract doextract -#define Idoswitches doswitches -#define Idowarn dowarn -#define Idumplvl dumplvl -#define Ie_fp e_fp -#define Ie_tmpname e_tmpname -#define Iendav endav -#define Ienvgv envgv -#define Ierrgv errgv -#define Ieval_root eval_root -#define Ieval_start eval_start -#define Ifdpid fdpid -#define Ifilemode filemode -#define Ifirstgv firstgv -#define Iforkprocess forkprocess -#define Iformfeed formfeed -#define Iformtarget formtarget -#define Igensym gensym -#define Iin_eval in_eval -#define Iincgv incgv -#define Iinplace inplace -#define Ilast_in_gv last_in_gv -#define Ilastfd lastfd -#define Ilastretstr lastretstr -#define Ilastscream lastscream -#define Ilastsize lastsize -#define Ilastspbase lastspbase -#define Ilaststatval laststatval -#define Ilaststype laststype -#define Ileftgv leftgv -#define Ilineary lineary -#define Ilocalizing localizing -#define Ilocalpatches localpatches -#define Imain_cv main_cv -#define Imain_root main_root -#define Imain_start main_start -#define Imainstack mainstack -#define Imaxscream maxscream -#define Imaxsysfd maxsysfd -#define Iminus_F minus_F -#define Iminus_a minus_a -#define Iminus_c minus_c -#define Iminus_l minus_l -#define Iminus_n minus_n -#define Iminus_p minus_p -#define Imultiline multiline -#define Imystack_base mystack_base -#define Imystack_mark mystack_mark -#define Imystack_max mystack_max -#define Imystack_sp mystack_sp -#define Imystrk mystrk -#define Inrs nrs -#define Iofmt ofmt -#define Iofs ofs -#define Iofslen ofslen -#define Ioldlastpm oldlastpm -#define Ioldname oldname -#define Iop_mask op_mask -#define Iorigargc origargc -#define Iorigargv origargv -#define Iorigfilename origfilename -#define Iors ors -#define Iorslen orslen -#define Iparsehook parsehook -#define Ipatchlevel patchlevel -#define Iperldb perldb +#define IArgv Argv +#define ICmd Cmd +#define IDBgv DBgv +#define IDBline DBline +#define IDBsignal DBsignal +#define IDBsingle DBsingle +#define IDBsub DBsub +#define IDBtrace DBtrace +#define Iallgvs allgvs +#define Iampergv ampergv +#define Iargvgv argvgv +#define Iargvoutgv argvoutgv +#define Ibasetime basetime +#define Ibeginav beginav +#define Ibodytarget bodytarget +#define Icddir cddir +#define Ichopset chopset +#define Icopline copline +#define Icurblock curblock +#define Icurcop curcop +#define Icurcopdb curcopdb +#define Icurcsv curcsv +#define Icurpm curpm +#define Icurstack curstack +#define Icurstash curstash +#define Icurstname curstname +#define Icxstack cxstack +#define Icxstack_ix cxstack_ix +#define Icxstack_max cxstack_max +#define Idbargs dbargs +#define Idebdelim debdelim +#define Idebname debname +#define Idebstash debstash +#define Idefgv defgv +#define Idefoutgv defoutgv +#define Idefstash defstash +#define Idelaymagic delaymagic +#define Idiehook diehook +#define Idirty dirty +#define Idlevel dlevel +#define Idlmax dlmax +#define Idoextract doextract +#define Idoswitches doswitches +#define Idowarn dowarn +#define Idumplvl dumplvl +#define Ie_fp e_fp +#define Ie_tmpname e_tmpname +#define Iendav endav +#define Ienvgv envgv +#define Ierrgv errgv +#define Ieval_root eval_root +#define Ieval_start eval_start +#define Ifdpid fdpid +#define Ifilemode filemode +#define Ifirstgv firstgv +#define Iforkprocess forkprocess +#define Iformfeed formfeed +#define Iformtarget formtarget +#define Igensym gensym +#define Iin_eval in_eval +#define Iincgv incgv +#define Iinplace inplace +#define Ilast_in_gv last_in_gv +#define Ilastfd lastfd +#define Ilastretstr lastretstr +#define Ilastscream lastscream +#define Ilastsize lastsize +#define Ilastspbase lastspbase +#define Ilaststatval laststatval +#define Ilaststype laststype +#define Ileftgv leftgv +#define Ilineary lineary +#define Ilocalizing localizing +#define Ilocalpatches localpatches +#define Imain_cv main_cv +#define Imain_root main_root +#define Imain_start main_start +#define Imainstack mainstack +#define Imaxscream maxscream +#define Imaxsysfd maxsysfd +#define Iminus_F minus_F +#define Iminus_a minus_a +#define Iminus_c minus_c +#define Iminus_l minus_l +#define Iminus_n minus_n +#define Iminus_p minus_p +#define Imultiline multiline +#define Imystack_base mystack_base +#define Imystack_mark mystack_mark +#define Imystack_max mystack_max +#define Imystack_sp mystack_sp +#define Imystrk mystrk +#define Inrs nrs +#define Iofmt ofmt +#define Iofs ofs +#define Iofslen ofslen +#define Ioldlastpm oldlastpm +#define Ioldname oldname +#define Iop_mask op_mask +#define Iorigargc origargc +#define Iorigargv origargv +#define Iorigfilename origfilename +#define Iors ors +#define Iorslen orslen +#define Iparsehook parsehook +#define Ipatchlevel patchlevel #define Iperl_destruct_level perl_destruct_level -#define Ipidstatus pidstatus -#define Ipreambled preambled -#define Ipreambleav preambleav -#define Ipreprocess preprocess -#define Irestartop restartop -#define Irightgv rightgv -#define Irs rs -#define Irunlevel runlevel -#define Isawampersand sawampersand -#define Isawstudy sawstudy -#define Isawvec sawvec -#define Iscreamfirst screamfirst -#define Iscreamnext screamnext -#define Isecondgv secondgv -#define Isiggv siggv -#define Isignalstack signalstack -#define Isortcop sortcop -#define Isortstack sortstack -#define Isortstash sortstash -#define Isplitstr splitstr -#define Istatcache statcache -#define Istatgv statgv -#define Istatname statname -#define Istatusvalue statusvalue -#define Istdingv stdingv -#define Istrchop strchop -#define Istrtab strtab -#define Isv_count sv_count -#define Isv_objcount sv_objcount -#define Isv_root sv_root -#define Isv_arenaroot sv_arenaroot -#define Itainted tainted -#define Itainting tainting -#define Itmps_floor tmps_floor -#define Itmps_ix tmps_ix -#define Itmps_max tmps_max -#define Itmps_stack tmps_stack -#define Itop_env top_env -#define Itoptarget toptarget -#define Iunsafe unsafe -#define Iwarnhook warnhook +#define Iperldb perldb +#define Ipidstatus pidstatus +#define Ipreambleav preambleav +#define Ipreambled preambled +#define Ipreprocess preprocess +#define Irestartop restartop +#define Irightgv rightgv +#define Irs rs +#define Irunlevel runlevel +#define Isawampersand sawampersand +#define Isawstudy sawstudy +#define Isawvec sawvec +#define Iscreamfirst screamfirst +#define Iscreamnext screamnext +#define Isecondgv secondgv +#define Isiggv siggv +#define Isignalstack signalstack +#define Isortcop sortcop +#define Isortstack sortstack +#define Isortstash sortstash +#define Isplitstr splitstr +#define Istatcache statcache +#define Istatgv statgv +#define Istatname statname +#define Istatusvalue statusvalue +#define Istdingv stdingv +#define Istrchop strchop +#define Istrtab strtab +#define Isv_arenaroot sv_arenaroot +#define Isv_count sv_count +#define Isv_objcount sv_objcount +#define Isv_root sv_root +#define Itainted tainted +#define Itainting tainting +#define Itmps_floor tmps_floor +#define Itmps_ix tmps_ix +#define Itmps_max tmps_max +#define Itmps_stack tmps_stack +#define Itop_env top_env +#define Itoptarget toptarget +#define Iunsafe unsafe +#define Iwarnhook warnhook + +/* Hide interpreter-specific symbols? */ #ifdef EMBED -#define Argv Perl_Argv -#define Cmd Perl_Cmd -#define DBgv Perl_DBgv -#define DBline Perl_DBline -#define DBsignal Perl_DBsignal -#define DBsingle Perl_DBsingle -#define DBsub Perl_DBsub -#define DBtrace Perl_DBtrace -#define allgvs Perl_allgvs -#define ampergv Perl_ampergv -#define argvgv Perl_argvgv -#define argvoutgv Perl_argvoutgv -#define basetime Perl_basetime -#define beginav Perl_beginav -#define bodytarget Perl_bodytarget -#define cddir Perl_cddir -#define chopset Perl_chopset -#define copline Perl_copline -#define curblock Perl_curblock -#define curcop Perl_curcop -#define curcopdb Perl_curcopdb -#define curcsv Perl_curcsv -#define curpm Perl_curpm -#define curstack Perl_curstack -#define curstash Perl_curstash -#define curstname Perl_curstname -#define cxstack Perl_cxstack -#define cxstack_ix Perl_cxstack_ix -#define cxstack_max Perl_cxstack_max -#define dbargs Perl_dbargs -#define debdelim Perl_debdelim -#define debname Perl_debname -#define debstash Perl_debstash -#define defgv Perl_defgv -#define defoutgv Perl_defoutgv -#define defstash Perl_defstash -#define delaymagic Perl_delaymagic -#define diehook Perl_diehook -#define dirty Perl_dirty -#define dlevel Perl_dlevel -#define dlmax Perl_dlmax -#define doextract Perl_doextract -#define doswitches Perl_doswitches -#define dowarn Perl_dowarn -#define dumplvl Perl_dumplvl -#define e_fp Perl_e_fp -#define e_tmpname Perl_e_tmpname -#define endav Perl_endav -#define envgv Perl_envgv -#define errgv Perl_errgv -#define eval_root Perl_eval_root -#define eval_start Perl_eval_start -#define fdpid Perl_fdpid -#define filemode Perl_filemode -#define firstgv Perl_firstgv -#define forkprocess Perl_forkprocess -#define formfeed Perl_formfeed -#define formtarget Perl_formtarget -#define gensym Perl_gensym -#define in_eval Perl_in_eval -#define incgv Perl_incgv -#define inplace Perl_inplace -#define last_in_gv Perl_last_in_gv -#define lastfd Perl_lastfd -#define lastretstr Perl_lastretstr -#define lastscream Perl_lastscream -#define lastsize Perl_lastsize -#define lastspbase Perl_lastspbase -#define laststatval Perl_laststatval -#define laststype Perl_laststype -#define leftgv Perl_leftgv -#define lineary Perl_lineary -#define localizing Perl_localizing -#define localpatches Perl_localpatches -#define main_cv Perl_main_cv -#define main_root Perl_main_root -#define main_start Perl_main_start -#define mainstack Perl_mainstack -#define maxscream Perl_maxscream -#define maxsysfd Perl_maxsysfd -#define minus_F Perl_minus_F -#define minus_a Perl_minus_a -#define minus_c Perl_minus_c -#define minus_l Perl_minus_l -#define minus_n Perl_minus_n -#define minus_p Perl_minus_p -#define multiline Perl_multiline -#define mystack_base Perl_mystack_base -#define mystack_mark Perl_mystack_mark -#define mystack_max Perl_mystack_max -#define mystack_sp Perl_mystack_sp -#define mystrk Perl_mystrk -#define nrs Perl_nrs -#define ofmt Perl_ofmt -#define ofs Perl_ofs -#define ofslen Perl_ofslen -#define oldlastpm Perl_oldlastpm -#define oldname Perl_oldname -#define op_mask Perl_op_mask -#define origargc Perl_origargc -#define origargv Perl_origargv -#define origfilename Perl_origfilename -#define ors Perl_ors -#define orslen Perl_orslen -#define parsehook Perl_parsehook -#define patchlevel Perl_patchlevel -#define perldb Perl_perldb +#define curcop Perl_curcop +#define curcopdb Perl_curcopdb +#define envgv Perl_envgv +#define siggv Perl_siggv +#define tainting Perl_tainting + +/* Hide interpreter symbols that 5.003 revealed? */ + +#ifndef BINCOMPAT3 + +#define Argv Perl_Argv +#define Cmd Perl_Cmd +#define DBgv Perl_DBgv +#define DBline Perl_DBline +#define DBsignal Perl_DBsignal +#define DBsingle Perl_DBsingle +#define DBsub Perl_DBsub +#define DBtrace Perl_DBtrace +#define allgvs Perl_allgvs +#define ampergv Perl_ampergv +#define argvgv Perl_argvgv +#define argvoutgv Perl_argvoutgv +#define basetime Perl_basetime +#define beginav Perl_beginav +#define bodytarget Perl_bodytarget +#define cddir Perl_cddir +#define chopset Perl_chopset +#define copline Perl_copline +#define curblock Perl_curblock +#define curcsv Perl_curcsv +#define curpm Perl_curpm +#define curstack Perl_curstack +#define curstash Perl_curstash +#define curstname Perl_curstname +#define cxstack Perl_cxstack +#define cxstack_ix Perl_cxstack_ix +#define cxstack_max Perl_cxstack_max +#define dbargs Perl_dbargs +#define debdelim Perl_debdelim +#define debname Perl_debname +#define debstash Perl_debstash +#define defgv Perl_defgv +#define defoutgv Perl_defoutgv +#define defstash Perl_defstash +#define delaymagic Perl_delaymagic +#define diehook Perl_diehook +#define dirty Perl_dirty +#define dlevel Perl_dlevel +#define dlmax Perl_dlmax +#define doextract Perl_doextract +#define doswitches Perl_doswitches +#define dowarn Perl_dowarn +#define dumplvl Perl_dumplvl +#define e_fp Perl_e_fp +#define e_tmpname Perl_e_tmpname +#define endav Perl_endav +#define errgv Perl_errgv +#define eval_root Perl_eval_root +#define eval_start Perl_eval_start +#define fdpid Perl_fdpid +#define filemode Perl_filemode +#define firstgv Perl_firstgv +#define forkprocess Perl_forkprocess +#define formfeed Perl_formfeed +#define formtarget Perl_formtarget +#define gensym Perl_gensym +#define in_eval Perl_in_eval +#define incgv Perl_incgv +#define inplace Perl_inplace +#define last_in_gv Perl_last_in_gv +#define lastfd Perl_lastfd +#define lastretstr Perl_lastretstr +#define lastscream Perl_lastscream +#define lastsize Perl_lastsize +#define lastspbase Perl_lastspbase +#define laststatval Perl_laststatval +#define laststype Perl_laststype +#define leftgv Perl_leftgv +#define lineary Perl_lineary +#define localizing Perl_localizing +#define localpatches Perl_localpatches +#define main_cv Perl_main_cv +#define main_root Perl_main_root +#define main_start Perl_main_start +#define mainstack Perl_mainstack +#define maxscream Perl_maxscream +#define maxsysfd Perl_maxsysfd +#define minus_F Perl_minus_F +#define minus_a Perl_minus_a +#define minus_c Perl_minus_c +#define minus_l Perl_minus_l +#define minus_n Perl_minus_n +#define minus_p Perl_minus_p +#define multiline Perl_multiline +#define mystack_base Perl_mystack_base +#define mystack_mark Perl_mystack_mark +#define mystack_max Perl_mystack_max +#define mystack_sp Perl_mystack_sp +#define mystrk Perl_mystrk +#define nrs Perl_nrs +#define ofmt Perl_ofmt +#define ofs Perl_ofs +#define ofslen Perl_ofslen +#define oldlastpm Perl_oldlastpm +#define oldname Perl_oldname +#define op_mask Perl_op_mask +#define origargc Perl_origargc +#define origargv Perl_origargv +#define origfilename Perl_origfilename +#define ors Perl_ors +#define orslen Perl_orslen +#define parsehook Perl_parsehook +#define patchlevel Perl_patchlevel #define perl_destruct_level Perl_perl_destruct_level -#define pidstatus Perl_pidstatus -#define preambled Perl_preambled -#define preambleav Perl_preambleav -#define preprocess Perl_preprocess -#define restartop Perl_restartop -#define rightgv Perl_rightgv -#define rs Perl_rs -#define runlevel Perl_runlevel -#define sawampersand Perl_sawampersand -#define sawstudy Perl_sawstudy -#define sawvec Perl_sawvec -#define screamfirst Perl_screamfirst -#define screamnext Perl_screamnext -#define secondgv Perl_secondgv -#define siggv Perl_siggv -#define signalstack Perl_signalstack -#define sortcop Perl_sortcop -#define sortstack Perl_sortstack -#define sortstash Perl_sortstash -#define splitstr Perl_splitstr -#define statcache Perl_statcache -#define statgv Perl_statgv -#define statname Perl_statname -#define statusvalue Perl_statusvalue -#define stdingv Perl_stdingv -#define strchop Perl_strchop -#define strtab Perl_strtab -#define sv_count Perl_sv_count -#define sv_objcount Perl_sv_objcount -#define sv_root Perl_sv_root -#define sv_arenaroot Perl_sv_arenaroot -#define tainted Perl_tainted -#define tainting Perl_tainting -#define tmps_floor Perl_tmps_floor -#define tmps_ix Perl_tmps_ix -#define tmps_max Perl_tmps_max -#define tmps_stack Perl_tmps_stack -#define top_env Perl_top_env -#define toptarget Perl_toptarget -#define unsafe Perl_unsafe -#define warnhook Perl_warnhook +#define perldb Perl_perldb +#define pidstatus Perl_pidstatus +#define preambleav Perl_preambleav +#define preambled Perl_preambled +#define preprocess Perl_preprocess +#define restartop Perl_restartop +#define rightgv Perl_rightgv +#define rs Perl_rs +#define runlevel Perl_runlevel +#define sawampersand Perl_sawampersand +#define sawstudy Perl_sawstudy +#define sawvec Perl_sawvec +#define screamfirst Perl_screamfirst +#define screamnext Perl_screamnext +#define secondgv Perl_secondgv +#define signalstack Perl_signalstack +#define sortcop Perl_sortcop +#define sortstack Perl_sortstack +#define sortstash Perl_sortstash +#define splitstr Perl_splitstr +#define statcache Perl_statcache +#define statgv Perl_statgv +#define statname Perl_statname +#define statusvalue Perl_statusvalue +#define stdingv Perl_stdingv +#define strchop Perl_strchop +#define strtab Perl_strtab +#define sv_arenaroot Perl_sv_arenaroot +#define sv_count Perl_sv_count +#define sv_objcount Perl_sv_objcount +#define sv_root Perl_sv_root +#define tainted Perl_tainted +#define tmps_floor Perl_tmps_floor +#define tmps_ix Perl_tmps_ix +#define tmps_max Perl_tmps_max +#define tmps_stack Perl_tmps_stack +#define top_env Perl_top_env +#define toptarget Perl_toptarget +#define unsafe Perl_unsafe +#define warnhook Perl_warnhook + +#endif /* !BINCOMPAT3 */ #endif /* EMBED */ @@ -1,12 +1,52 @@ -#!/usr/bin/perl +#!/usr/bin/perl -w -unlink "embed.h"; -open(EM, ">embed.h") || die "Can't create embed.h: $!\n"; +require 5.003; + +sub readsyms (\%$) { + my ($syms, $file) = @_; + %$syms = (); + local (*FILE, $_); + open(FILE, "< $file") + or die "embed.pl: Can't open $file: $!\n"; + while (<FILE>) { + s/[ \t]*#.*//; # Delete comments. + if (/^\s*(\S+)\s*$/) { + $$syms{$1} = 1; + } + } + close(FILE); +} + +readsyms %global, 'global.sym'; +readsyms %interp, 'interp.sym'; +readsyms %compat3, 'compat3.sym'; + +sub hide ($$) { + my ($from, $to) = @_; + my $t = int(length($from) / 8); + "#define $from" . "\t" x ($t < 3 ? 3 - $t : 1) . "$to\n"; +} +sub embed ($) { + my ($sym) = @_; + hide($sym, "Perl_$sym"); +} +sub multon ($) { + my ($sym) = @_; + hide($sym, "(curinterp->I$sym)"); +} +sub multoff ($) { + my ($sym) = @_; + hide("I$sym", $sym); +} + +unlink 'embed.h'; +open(EM, '> embed.h') + or die "Can't create embed.h: $!\n"; print EM <<'END'; /* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! - This file is built by embed.pl from global.sym and interp.sym. - Any changes made here will be lost + This file is built by embed.pl from global.sym, interp.sym, + and compat3.sym. Any changes made here will be lost! */ /* (Doing namespace management portably in C is really gross.) */ @@ -21,78 +61,82 @@ print EM <<'END'; # define EMBED 1 #endif +/* Hide global symbols? */ + #ifdef EMBED -/* globals we need to hide from the world */ END -open(GL, "<global.sym") || die "Can't open global.sym: $!\n"; - -while(<GL>) { - s/[ \t]*#.*//; # Delete comments. - next unless /\S/; - s/^\s*(\S+).*$/#define $1\t\tPerl_$1/; - $global{$1} = 1; - s/(................\t)\t/$1/; - print EM $_; +for $sym (sort keys %global) { + print EM embed($sym) unless $compat3{$sym}; } -close(GL) || warn "Can't close global.sym: $!\n"; +print EM <<'END'; + +/* Hide global symbols that 5.003 revealed? */ + +#ifndef BINCOMPAT3 + +END + +for $sym (sort keys %global) { + print EM embed($sym) if $compat3{$sym}; +} print EM <<'END'; +#endif /* !BINCOMPAT3 */ + #endif /* EMBED */ -/* Put interpreter specific symbols into a struct? */ +/* Put interpreter-specific symbols into a struct? */ #ifdef MULTIPLICITY END -open(INT, "<interp.sym") || die "Can't open interp.sym: $!\n"; -while (<INT>) { - s/[ \t]*#.*//; # Delete comments. - next unless /\S/; - s/^\s*(\S+).*$/#define $1\t\t(curinterp->I$1)/; - s/(................\t)\t/$1/; - print EM $_; +for $sym (sort keys %interp) { + print EM multon($sym); } -close(INT) || warn "Can't close interp.sym: $!\n"; print EM <<'END'; -#else /* not multiple, so translate interpreter symbols the other way... */ +#else /* !MULTIPLICITY */ END -open(INT, "<interp.sym") || die "Can't open interp.sym: $!\n"; -while (<INT>) { - s/[ \t]*#.*//; # Delete comments. - next unless /\S/; - s/^\s*(\S+).*$/#define I$1\t\t$1/; - s/(................\t)\t/$1/; - print EM $_; +for $sym (sort keys %interp) { + print EM multoff($sym); } -close(INT) || warn "Can't close interp.sym: $!\n"; print EM <<'END'; +/* Hide interpreter-specific symbols? */ + #ifdef EMBED END -open(INT, "<interp.sym") || die "Can't open interp.sym: $!\n"; -while (<INT>) { - s/[ \t]*#.*//; # Delete comments. - next unless /\S/; - s/^\s*(\S+).*$/#define $1\t\tPerl_$1/; - s/(................\t)\t/$1/; - print EM $_; +for $sym (sort keys %interp) { + print EM embed($sym) if $compat3{$sym}; } -close(INT) || warn "Can't close interp.sym: $!\n"; print EM <<'END'; +/* Hide interpreter symbols that 5.003 revealed? */ + +#ifndef BINCOMPAT3 + +END + +for $sym (sort keys %interp) { + print EM embed($sym) unless $compat3{$sym}; +} + +print EM <<'END'; + +#endif /* !BINCOMPAT3 */ + #endif /* EMBED */ #endif /* MULTIPLICITY */ diff --git a/ext/IO/lib/IO/Handle.pm b/ext/IO/lib/IO/Handle.pm index 2e20cfdb66..925b20806d 100644 --- a/ext/IO/lib/IO/Handle.pm +++ b/ext/IO/lib/IO/Handle.pm @@ -408,7 +408,7 @@ sub write { sub syswrite { @_ == 3 || @_ == 4 or croak '$fh->syswrite(BUF, LEN [, OFFSET])'; - sysread($_[0], $_[1], $_[2], $_[3] || 0); + syswrite($_[0], $_[1], $_[2], $_[3] || 0); } sub stat { diff --git a/ext/Opcode/Safe.pm b/ext/Opcode/Safe.pm index 6007b97311..22772796e2 100644 --- a/ext/Opcode/Safe.pm +++ b/ext/Opcode/Safe.pm @@ -1,14 +1,13 @@ package Safe; -require 5.002; - +use 5.003_11; use strict; -use Carp; - use vars qw($VERSION); $VERSION = "2.06"; +use Carp; + use Opcode 1.01, qw( opset opset_to_ops opmask_add empty_opset full_opset invert_opset verify_opset diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index e5f9b2f947..70527cd51d 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -2665,6 +2665,7 @@ localeconv() #ifdef HAS_LOCALECONV struct lconv *lcbuf; RETVAL = newHV(); + SET_NUMERIC_LOCAL(); if (lcbuf = localeconv()) { /* the strings */ if (lcbuf->decimal_point && *lcbuf->decimal_point) diff --git a/global.sym b/global.sym index 729aa18bc4..3e9f9de234 100644 --- a/global.sym +++ b/global.sym @@ -4,7 +4,6 @@ AMG_names Error -He No Sv Xpv @@ -64,9 +63,6 @@ exp_amg expect expectterm fallback_amg -filter_add -filter_del -filter_read fold fold_locale freq @@ -124,8 +120,6 @@ ne_amg neg_amg nexttoke nexttype -nexttype -nextval nextval nice_chunk nice_chunk_size @@ -207,8 +201,6 @@ rsfp rsfp_filters rshift_amg rshift_ass_amg -save_iv -save_pptr savestack savestack_ix savestack_max @@ -224,7 +216,6 @@ sgt_amg sh_path sig_name sig_num -sighandler simple sin_amg sle_amg @@ -496,6 +487,7 @@ magic_clearenv magic_clearpack magic_clearsig magic_existspack +magic_freevivary magic_get magic_getarylen magic_getglob @@ -525,6 +517,7 @@ magic_setsubstr magic_settaint magic_setuvar magic_setvec +magic_setvivary magic_wipepack magicname markstack_grow @@ -1008,10 +1001,12 @@ save_destructor save_freeop save_freepv save_freesv +save_gp save_hash save_hptr save_int save_item +save_iv save_list save_long save_nogv diff --git a/hints/freebsd.sh b/hints/freebsd.sh index e8bee396a3..f1ab871831 100644 --- a/hints/freebsd.sh +++ b/hints/freebsd.sh @@ -63,6 +63,16 @@ case "$osvers" in d_setreuid='define' d_setegid='undef' d_seteuid='undef' + cat <<EOF + +Unless you've upgraded your DB library manually you will see failures in +db-recno tests 51, 53 and 55. The behavior these tests are checking is +broken in the DB library which is included with the OS. You can ignore +the errors if you're never going to use the broken functionality (recno +databases with a modified bval), otherwise you'll have to upgrade your +DB library or OS. + +EOF ;; # # 2.2 and above have phkmalloc(3). diff --git a/hints/lynxos.sh b/hints/lynxos.sh new file mode 100644 index 0000000000..5f8991bc45 --- /dev/null +++ b/hints/lynxos.sh @@ -0,0 +1,12 @@ +# +# LynxOS hints +# +# These hints were submitted by: +# Greg Seibert +# seibert@Lynx.COM +# + +cc='gcc' +ccflags='-D_filbuf=_fillbuf' +so='none' +usemymalloc='n' diff --git a/installperl b/installperl index f4e68959ad..ddbe5956e8 100755 --- a/installperl +++ b/installperl @@ -1,6 +1,7 @@ #!./perl BEGIN { @INC=('./lib', '../lib') } use File::Find; +use File::Compare; use File::Path (); use Config; use subs qw(unlink rename link chmod); @@ -23,7 +24,7 @@ while (@ARGV) { umask 022; @scripts = qw( utils/c2ph utils/h2ph utils/h2xs - utils/perlbug utils/perldoc utils/pl2pm + utils/perlbug utils/perldoc utils/pl2pm utils/splain x2p/s2p x2p/find2perl pod/pod2man pod/pod2html pod/pod2latex pod/pod2text); @@ -343,8 +344,11 @@ sub installlib { $name = "$dir/$name" if $dir ne ''; + # ignore Chip-style patch backups. + return if grep(/^P\d+$/, split(m{/+}, $name)); + my $installlib = $installprivlib; - if ((substr($dir, 0, 4) eq 'auto') || ($name eq 'Config.pm')) { + if ($dir =~ /^auto/ || $name =~ /^(Config|FileHandle|Safe)\.pm$/) { $installlib = $installarchlib; return unless $do_installarchlib; } else { @@ -360,8 +364,7 @@ sub installlib { #This might not work because $archname might have changed. &unlink("$installarchlib/$name"); } - system "cmp", "-s", $_, "$installlib/$name"; - if ($? || $nonono) { + if (compare($_, "$installlib/$name") || $nonono) { &unlink("$installlib/$name"); mkpath("$installlib/$dir", 1, 0777); cp_if_diff($_, "$installlib/$name"); @@ -390,8 +393,7 @@ sub installlib { sub cp_if_diff { my($from,$to)=@_; -f $from || die "$0: $from not found"; - system "cmp", "-s", $from, $to; - if ($? || $nonono) { + if (compare($from, $to) || $nonono) { my ($atime, $mtime); unlink($to); # In case we don't have write permissions. if ($nonono) { diff --git a/lib/CPAN.pm b/lib/CPAN.pm new file mode 100644 index 0000000000..c755aa1ac0 --- /dev/null +++ b/lib/CPAN.pm @@ -0,0 +1,2350 @@ +package CPAN; +use vars qw{$META $Signal $Cwd $End $Suppress_readline}; + +$VERSION = '1.02'; + +# $Id: CPAN.pm,v 1.77 1996/12/11 01:26:43 k Exp $ + +# my $version = substr q$Revision: 1.77 $, 10; # only used during development + +BEGIN {require 5.003;} +require UNIVERSAL if $] == 5.003; + +use Carp (); +use Config (); +use Cwd (); +use DirHandle; +use Exporter (); +use ExtUtils::MakeMaker (); +use File::Basename (); +use File::Find; +use File::Path (); +use IO::File (); +use Safe (); + +$Cwd = Cwd::cwd(); + +END { $End++; &cleanup; } + +%CPAN::DEBUG = qw( + CPAN 1 + Index 2 + InfoObj 4 + Author 8 + Distribution 16 + Bundle 32 + Module 64 + CacheMgr 128 + Complete 256 + FTP 512 + Shell 1024 + Eval 2048 + Config 4096 + ); + +$CPAN::DEBUG ||= 0; + +package CPAN; +use vars qw($VERSION @ISA @EXPORT $AUTOLOAD $DEBUG $META); +use strict qw(vars); + +@ISA = qw(CPAN::Debug Exporter MY); # the MY class from MakeMaker, gives us catfile and catdir + +$META ||= new CPAN; # In case we reeval ourselves we need a || + +CPAN::Config->load; + +@EXPORT = qw(autobundle bundle expand force install make recompile shell test clean); + +sub autobundle; +sub bundle; +sub bundles; +sub expand; +sub force; +sub install; +sub make; +sub shell; +sub clean; +sub test; + +sub AUTOLOAD { + my($l) = $AUTOLOAD; + $l =~ s/.*:://; + my(%EXPORT); + @EXPORT{@EXPORT} = ''; + if (exists $EXPORT{$l}){ + CPAN::Shell->$l(@_); + } else { + warn "CPAN doesn't know how to autoload $AUTOLOAD :-( +Nothing Done. +"; + CPAN::Shell->h; + } +} + +sub all { + my($mgr,$class) = @_; + CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG; + CPAN::Index->reload; + values %{ $META->{$class} }; +} + +# Called by shell, not in batch mode. Not clean XXX +sub checklock { + my($self) = @_; + my $lockfile = CPAN->catfile($CPAN::Config->{cpan_home},".lock"); + if (-f $lockfile && -M _ > 0) { + my $fh = IO::File->new($lockfile); + my $other = <$fh>; + $fh->close; + if (defined $other && $other) { + chomp $other; + return if $$==$other; # should never happen + print qq{There seems to be running another CPAN process ($other). Trying to contact...\n}; + if (kill 0, $other) { + Carp::croak qq{Other job is running.\n}. + qq{You may want to kill it and delete the lockfile, maybe. On UNIX try:\n}. + qq{ kill $other\n}. + qq{ rm $lockfile\n}; + } elsif (-w $lockfile) { + my($ans)= + ExtUtils::MakeMaker::prompt + (qq{Other job not responding. Shall I overwrite the lockfile? (Y/N)},"y"); + print("Ok, bye\n"), exit unless $ans =~ /^y/i; + } else { + Carp::croak( + qq{Lockfile $lockfile not writeable by you. Cannot proceed.\n}. + qq{ On UNIX try:\n}. + qq{ rm $lockfile\n}. + qq{ and then rerun us.\n} + ); + } + } + } + File::Path::mkpath($CPAN::Config->{cpan_home}); + my $fh; + unless ($fh = IO::File->new(">$lockfile")) { + if ($! =~ /Permission/) { + my $incc = $INC{'CPAN/Config.pm'}; + my $myincc = MY->catfile($ENV{HOME},'.cpan','CPAN','MyConfig.pm'); + print qq{ + +Your configuration suggests that CPAN.pm should use a working +directory of + $CPAN::Config->{cpan_home} +Unfortunately we could not create the lock file + $lockfile +due to permission problems. + +Please make sure that the configuration variable + \$CPAN::Config->{cpan_home} +points to a directory where you can write a .lock file. You can set +this variable in either + $incc +or + $myincc + +}; + } + Carp::croak "Could not open >$lockfile: $!"; + } + print $fh $$, "\n"; + $self->{LOCK} = $lockfile; + $fh->close; + $SIG{'TERM'} = sub { &cleanup; die "Got SIGTERM, leaving"; }; + $SIG{'INT'} = sub { &cleanup, die "Got a second SIGINT" if $Signal; $Signal = 1; }; + $SIG{'__DIE__'} = \&cleanup; + print STDERR "Signal handler set.\n" unless $CPAN::Config->{'inhibit_startup_message'}; +} + +sub DESTROY { + &cleanup; # need an eval? +} + +sub exists { + my($mgr,$class,$id) = @_; + CPAN::Index->reload; + Carp::croak "exists called without class argument" unless $class; + $id ||= ""; + exists $META->{$class}{$id}; +} + +sub hasFTP { + my($self,$arg) = @_; + if (defined $arg) { + return $self->{'hasFTP'} = $arg; + } elsif (not defined $self->{'hasFTP'}) { + eval {require Net::FTP;}; + $self->{'hasFTP'} = $@ ? 0 : 1; + } + return $self->{'hasFTP'}; +} + +sub hasLWP { + my($self,$arg) = @_; + if (defined $arg) { + return $self->{'hasLWP'} = $arg; + } elsif (not defined $self->{'hasLWP'}) { + eval {require LWP;}; + $LWP::VERSION ||= 0; + $self->{'hasLWP'} = $LWP::VERSION >= 4.98; + } + return $self->{'hasLWP'}; +} + +sub hasMD5 { + my($self,$arg) = @_; + if (defined $arg) { + $self->{'hasMD5'} = $arg; + } elsif (not defined $self->{'hasMD5'}) { + eval {require MD5;}; + if ($@) { + print "MD5 security checks disabled because MD5 not installed. Please consider installing MD5\n"; + $self->{'hasMD5'} = 0; + } else { + $self->{'hasMD5'}++; + } + } + return $self->{'hasMD5'}; +} + +sub instance { + my($mgr,$class,$id) = @_; + CPAN::Index->reload; + Carp::croak "instance called without class argument" unless $class; + $id ||= ""; + $META->{$class}{$id} ||= $class->new(ID => $id ); +} + +sub new { + bless {}, shift; +} + +sub cleanup { + local $SIG{__DIE__} = ''; + my $i = 0; my $ineval = 0; my $sub; + while ((undef,undef,undef,$sub) = caller(++$i)) { + $ineval = 1, last if $sub eq '(eval)'; + } + return if $ineval && !$End; + return unless defined $META->{'LOCK'}; + return unless -f $META->{'LOCK'}; + unlink $META->{'LOCK'}; + print STDERR "Lockfile removed.\n"; +# my $mess = Carp::longmess(@_); +# die @_; +} + +sub shell { + $Suppress_readline ||= ! -t STDIN; + + my $prompt = "cpan> "; + local($^W) = 1; + my $term; + unless ($Suppress_readline) { + require Term::ReadLine; + import Term::ReadLine; + $term = new Term::ReadLine 'CPAN Monitor'; + $readline::rl_completion_function = + $readline::rl_completion_function = 'CPAN::Complete::complete'; + } + + no strict; + $META->checklock(); + my $cwd = Cwd::cwd(); + # How should we determine if we have more than stub ReadLine enabled? + my $rl_avail = $Suppress_readline ? "suppressed" : + defined &Term::ReadLine::Perl::readline ? "enabled" : + "available (get Term::ReadKey and Term::ReadLine::Perl)"; + + print qq{ +cpan shell -- CPAN exploration and modules installation (v$CPAN::VERSION) +Readline support $rl_avail + +} unless $CPAN::Config->{'inhibit_startup_message'} ; + while () { + if ($Suppress_readline) { + print $prompt; + last unless defined (chomp($_ = <>)); + } else { + last unless defined ($_ = $term->readline($prompt)); + } + s/^\s//; + next if /^$/; + $_ = 'h' if $_ eq '?'; + if (/^\!/) { + s/^\!//; + my($eval) = $_; + package CPAN::Eval; + use vars qw($import_done); + CPAN->import(':DEFAULT') unless $import_done++; + CPAN->debug("eval[$eval]") if $CPAN::DEBUG; + eval($eval); + warn $@ if $@; + } elsif (/^q(?:uit)?$/i) { + last; + } elsif (/./) { + my @line = split; + my $command = shift @line; + eval { CPAN::Shell->$command(@line) }; + warn $@ if $@; + } + } continue { + &cleanup, die if $Signal; + chdir $cwd; + print "\n"; + } +} + +package CPAN::Shell; +use vars qw(@ISA $AUTOLOAD); +@ISA = qw(CPAN::Debug); + +# private function ro re-eval this module (handy during development) +sub AUTOLOAD { + warn "CPAN::Shell doesn't know how to autoload $AUTOLOAD :-( +Nothing Done. +"; + CPAN::Shell->h; +} + +sub h { + my($class,$about) = @_; + if (defined $about) { + print "Detailed help not yet implemented\n"; + } else { + print q{ +command arguments description +a string authors +b or display bundles +d /regex/ info distributions +m or about modules +i none anything of above + +r as reinstall recommendations +u above uninstalled distributions +See manpage for autobundle() and recompile() + +make modules, make +test dists, bundles, make test (implies make) +install "r" or "u" make install (implies test) +clean make clean + +reload index|cpan load most recent indices/CPAN.pm +h or ? display this menu +o various set and query options +! perl-code eval a perl command +q quit the shell subroutine +}; + } +} + +sub a { print shift->format_result('Author',@_);} +sub b { + my($self,@which) = @_; + my($bdir) = $CPAN::META->catdir($CPAN::Config->{'cpan_home'},"Bundle"); + my($dh) = DirHandle->new($bdir); # may fail! + my($entry); + for $entry ($dh->read) { + next if -d $CPAN::META->catdir($bdir,$entry); + next unless $entry =~ s/\.pm$//; + $CPAN::META->instance('CPAN::Bundle',"Bundle::$entry"); + } + print $self->format_result('Bundle',@which); +} +sub d { print shift->format_result('Distribution',@_);} +sub m { print shift->format_result('Module',@_);} + +sub i { + my($self) = shift; + my(@args) = @_; + my(@type,$type,@m); + @type = qw/Author Bundle Distribution Module/; + @args = '/./' unless @args; + my(@result); + for $type (@type) { + push @result, $self->expand($type,@args); + } + my $result = @result==1 ? $result[0]->as_string : join "", map {$_->as_glimpse} @result; + $result ||= "No objects found of any type for argument @args\n"; + print $result; +} + +sub o { + my($self,$o_type,@o_what) = @_; + $o_type ||= ""; + CPAN->debug("o_type[$o_type] o_what[@o_what]\n"); + if ($o_type eq 'conf') { + shift @o_what if @o_what && $o_what[0] eq 'help'; + if (!@o_what) { + my($k,$v); + print "CPAN::Config options:\n"; + for $k (sort keys %CPAN::Config::can) { + $v = $CPAN::Config::can{$k}; + printf " %-18s %s\n", $k, $v; + } + print "\n"; + for $k (sort keys %$CPAN::Config) { + $v = $CPAN::Config->{$k}; + if (ref $v) { + printf " %-18s\n", $k; + print map {"\t$_\n"} @{$v}; + } else { + printf " %-18s %s\n", $k, $v; + } + } + print "\n"; + } elsif (!CPAN::Config->edit(@o_what)) { + print qq[Type 'o conf' to view configuration edit options\n\n]; + } + } elsif ($o_type eq 'debug') { + my(%valid); + @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i; + if (@o_what) { + while (@o_what) { + my($what) = shift @o_what; + if ( exists $CPAN::DEBUG{$what} ) { + $CPAN::DEBUG |= $CPAN::DEBUG{$what}; + } elsif ($what =~ /^\d/) { + $CPAN::DEBUG = $what; + } elsif (lc $what eq 'all') { + my($max) = 0; + for (values %CPAN::DEBUG) { + $max += $_; + } + $CPAN::DEBUG = $max; + } else { + for (keys %CPAN::DEBUG) { + next unless lc($_) eq lc($what); + $CPAN::DEBUG |= $CPAN::DEBUG{$_}; + } + print "unknown argument $what\n"; + } + } + } else { + print "Valid options for debug are ".join(", ",sort(keys %CPAN::DEBUG), 'all'). + " or a number. Completion works on the options. Case is ignored.\n\n"; + } + if ($CPAN::DEBUG) { + print "Options set for debugging:\n"; + my($k,$v); + for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) { + $v = $CPAN::DEBUG{$k}; + printf " %-14s(%s)\n", $k, $v if $v & $CPAN::DEBUG; + } + } else { + print "Debugging turned off completely.\n"; + } + } else { + print qq{ +Known options: + conf set or get configuration variables + debug set or get debugging options +}; + } +} + +sub reload { + if ($_[1] =~ /cpan/i) { + CPAN->debug("reloading the whole CPAN.pm") if $CPAN::DEBUG; + my $fh = IO::File->new($INC{'CPAN.pm'}); + local $/; + undef $/; + eval <$fh>; + warn $@ if $@; + } elsif ($_[1] =~ /index/) { + CPAN::Index->force_reload; + } +} + +sub _binary_extensions { + my($self) = shift @_; + my(@result,$module,%seen,%need,$headerdone); + for $module ($self->expand('Module','/./')) { + my $file = $module->cpan_file; + next if $file eq "N/A"; + next if $file =~ /^Contact Author/; + next if $file =~ /perl5[._-]\d{3}(?:[\d_]+)?\.tar[._-]gz$/; + next unless $module->xs_file; + push @result, $module; + } +# print join " | ", @result; +# print "\n"; + return @result; +} + +sub recompile { + my($self) = shift @_; + my($module,@module,$cpan_file,%dist); + @module = $self->_binary_extensions(); + for $module (@module){ # we force now and compile later, so we don't do it twice + $cpan_file = $module->cpan_file; + my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file); + $pack->force; + $dist{$cpan_file}++; + } + for $cpan_file (sort keys %dist) { + print " CPAN: Recompiling $cpan_file\n\n"; + my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file); + $pack->install; + $CPAN::Signal = 0; # it's tempting to reset Signal, so we can + # stop a package from recompiling, + # e.g. IO-1.12 when we have perl5.003_10 + } +} + +sub _u_r_common { + my($self) = shift @_; + my($what) = shift @_; + CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG; + Carp::croak "Usage: \$obj->_u_r_common($what)" unless defined $what; + Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless $what =~ /^[aru]$/; + my(@args) = @_; + @args = '/./' unless @args; + my(@result,$module,%seen,%need,$headerdone,$version_zeroes); + $version_zeroes = 0; + my $sprintf = "%-25s %9s %9s %s\n"; + for $module ($self->expand('Module',@args)) { + my $file = $module->cpan_file; + next unless defined $file; # ?? + my($latest) = $module->cpan_version || 0; + my($inst_file) = $module->inst_file; + my($have); + if ($inst_file){ + if ($what eq "a") { + $have = $module->inst_version; + } elsif ($what eq "r") { + $have = $module->inst_version; + local($^W) = 0; + $version_zeroes++ unless $have; + next if $have >= $latest; + } elsif ($what eq "u") { + next; + } + } else { + if ($what eq "a") { + next; + } elsif ($what eq "r") { + next; + } elsif ($what eq "u") { + $have = "-"; + } + } + $seen{$file} ||= 0; + if ($what eq "a") { + push @result, sprintf "%s %s\n", $module->id, $have; + } elsif ($what eq "r") { + push @result, $module->id; + next if $seen{$file}++; + } elsif ($what eq "u") { + push @result, $module->id; + next if $seen{$file}++; + next if $file =~ /^Contact/; + } + unless ($headerdone++){ + print "\n"; + printf $sprintf, "Package namespace", "installed", "latest", "in CPAN file"; + } + $latest = substr($latest,0,8) if length($latest) > 8; + $have = substr($have,0,8) if length($have) > 8; + printf $sprintf, $module->id, $have, $latest, $file; + $need{$module->id}++; + return if $CPAN::Signal; # this is sometimes lengthy + } + unless (%need) { + if ($what eq "u") { + print "No modules found for @args\n"; + } elsif ($what eq "r") { + print "All modules are up to date for @args\n"; + } + } + if ($what eq "r" && $version_zeroes) { + my $s = $version_zeroes>1 ? "s have" : " has"; + print qq{$version_zeroes installed module$s no version number to compare\n}; + } + @result; +} + +sub r { + shift->_u_r_common("r",@_); +} + +sub u { + shift->_u_r_common("u",@_); +} + +sub autobundle { + my($self) = shift; + my(@bundle) = $self->_u_r_common("a",@_); + my($todir) = $CPAN::META->catdir($CPAN::Config->{'cpan_home'},"Bundle"); + File::Path::mkpath($todir); + unless (-d $todir) { + print "Couldn't mkdir $todir for some reason\n"; + return; + } + my($y,$m,$d) = (localtime)[5,4,3]; + $y+=1900; + $m++; + my($c) = 0; + my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c; + my($to) = $CPAN::META->catfile($todir,"$me.pm"); + while (-f $to) { + $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c; + $to = $CPAN::META->catfile($todir,"$me.pm"); + } + my($fh) = IO::File->new(">$to") or Carp::croak "Can't open >$to: $!"; + $fh->print( + "package Bundle::$me;\n\n", + "\$VERSION = '0.01';\n\n", + "1;\n\n", + "__END__\n\n", + "=head1 NAME\n\n", + "Bundle::$me - Snapshot of installation on ", + $Config::Config{'myhostname'}, + " on ", + scalar(localtime), + "\n\n=head1 SYNOPSIS\n\n", + "perl -MCPAN -e 'install Bundle::$me'\n\n", + "=head1 CONTENTS\n\n", + join("\n", @bundle), + "\n\n=head1 CONFIGURATION\n\n", + Config->myconfig, + "\n\n=head1 AUTHOR\n\n", + "This Bundle has been generated automatically by the autobundle routine in CPAN.pm.\n", + ); + $fh->close; + print "\nWrote bundle file + $to\n\n"; +} + +sub bundle { + shift; + my(@bundles) = @_; + my $bundle; + my @pack = (); + foreach $bundle (@bundles) { + my $pack = $bundle; + $pack =~ s/^(Bundle::)?(.*)/Bundle::$2/; + push @pack, $CPAN::META->instance('CPAN::Bundle',$pack)->contains; + } + @pack; +} + +sub bundles { + my($self) = @_; + CPAN->debug("self[$self]") if $CPAN::DEBUG; + sort grep $_->id() =~ /^Bundle::/, $CPAN::META->all('CPAN::Bundle'); +} + +sub expand { + shift; + my($type,@args) = @_; + my($arg,@m); + for $arg (@args) { + my $regex; + if ($arg =~ m|^/(.*)/$|) { + $regex = $1; + } + my $class = "CPAN::$type"; + my $obj; + if (defined $regex) { + for $obj ( sort {$a->id cmp $b->id} $CPAN::META->all($class)) { + push @m, $obj if $obj->id =~ /$regex/i or $obj->can('name') && $obj->name =~ /$regex/i; + } + } else { + my($xarg) = $arg; + if ( $type eq 'Bundle' ) { + $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/; + } + if ($CPAN::META->exists($class,$xarg)) { + $obj = $CPAN::META->instance($class,$xarg); + } elsif ($obj = $CPAN::META->exists($class,$arg)) { + $obj = $CPAN::META->instance($class,$arg); + } else { + next; + } + push @m, $obj; + } + } + return @m; +} + +sub format_result { + my($self) = shift; + my($type,@args) = @_; + @args = '/./' unless @args; + my(@result) = $self->expand($type,@args); + my $result = @result==1 ? $result[0]->as_string : join "", map {$_->as_glimpse} @result; + $result ||= "No objects of type $type found for argument @args\n"; + $result; +} + +sub rematein { + shift; + my($meth,@some) = @_; + my $pragma = ""; + if ($meth eq 'force') { + $pragma = $meth; + $meth = shift @some; + } + CPAN->debug("pragma[$pragma]meth[$meth] some[@some]") if $CPAN::DEBUG; + my($s,@s); + foreach $s (@some) { + my $obj; + if (ref $s) { + $obj = $s; + } elsif ($s =~ m|/|) { # looks like a file + $obj = $CPAN::META->instance('CPAN::Distribution',$s); + } elsif ($s =~ m|^Bundle::|) { + $obj = $CPAN::META->instance('CPAN::Bundle',$s); + } else { + $obj = $CPAN::META->instance('CPAN::Module',$s) if $CPAN::META->exists('CPAN::Module',$s); + } + if (ref $obj) { + CPAN->debug(qq{pragma[$pragma] meth[$meth] obj[$obj] as_string\[}.$obj->as_string.qq{\]}) if $CPAN::DEBUG; + $obj->$pragma() if $pragma && $obj->can($pragma); + $obj->$meth(); + } else { + print "Warning: Cannot $meth $s, don't know what it is\n"; + } + } +} + +sub force { shift->rematein('force',@_); } +sub readme { shift->rematein('readme',@_); } +sub make { shift->rematein('make',@_); } +sub clean { shift->rematein('clean',@_); } +sub test { shift->rematein('test',@_); } +sub install { shift->rematein('install',@_); } + +package CPAN::FTP; +use vars qw($Ua @ISA); +@ISA = qw(CPAN::Debug); + +sub ftp_get { + my($class,$host,$dir,$file,$target) = @_; + $class->debug( + qq[Going to fetch file [$file] from dir [$dir] + on host [$host] as local [$target]\n] + ) if $CPAN::DEBUG; + my $ftp = Net::FTP->new($host); + $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG; + $class->debug(qq[Going to ->login("anonymous","$Config::Config{'cf_email'}")\n]); + unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){ + warn "Couldn't login on $host"; + return; + } + # print qq[Going to ->cwd("$dir")\n]; + unless ( $ftp->cwd($dir) ){ + warn "Couldn't cwd $dir"; + return; + } + $ftp->binary; + print qq[Going to ->get("$file","$target")\n] if $CPAN::DEBUG; + unless ( $ftp->get($file,$target) ){ + warn "Couldn't fetch $file from $host"; + return; + } + $ftp->quit; +} + +sub localize { + my($self,$file,$aslocal,$force) = @_; + $force ||= 0; + Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])" unless defined $aslocal; + $self->debug("file [$file] aslocal [$aslocal]") if $CPAN::DEBUG; + + return $aslocal if -f $aslocal && -r _ && ! $force; + + my($aslocal_dir) = File::Basename::dirname($aslocal); + File::Path::mkpath($aslocal_dir); + print STDERR qq{Warning: You are not allowed to write into directory "$aslocal_dir". + I\'ll continue, but if you face any problems, they may be due + to insufficient permissions.\n} unless -w $aslocal_dir; + + # Inheritance is not easier to manage than a few if/else branches + if ($CPAN::META->hasLWP) { + require LWP::UserAgent; + unless ($Ua) { + $Ua = new LWP::UserAgent; + $Ua->proxy('ftp', $ENV{'ftp_proxy'}) if defined $ENV{'ftp_proxy'}; + $Ua->proxy('http', $ENV{'http_proxy'}) if defined $ENV{'http_proxy'}; + $Ua->no_proxy($ENV{'no_proxy'}) if defined $ENV{'no_proxy'}; + } + } + + # Try the list of urls for each single object. We keep a record + # where we did get a file from + for (0..$#{$CPAN::Config->{urllist}}) { + my $url = $CPAN::Config->{urllist}[$_]; + $url .= "/" unless substr($url,-1) eq "/"; + $url .= $file; + $self->debug("localizing[$url]") if $CPAN::DEBUG; + if ($url =~ /^file:/) { + my $l; + if ($CPAN::META->hasLWP) { + require URI::URL; + my $u = new URI::URL $url; + $l = $u->path; + } else { # works only on Unix + ($l = $url) =~ s/^file://; + } + return $l if -f $l && -r _; + } + + if ($CPAN::META->hasLWP) { + print "Fetching $url\n"; + my $res = $Ua->mirror($url, $aslocal); + if ($res->is_success) { + return $aslocal; + } + } elsif ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) { + unless ($CPAN::META->hasFTP) { + warn "Can't access URL $url without module Net::FTP"; + next; + } + my($host,$dir,$getfile) = ($1,$2,$3); + $dir =~ s|/+|/|g; + print "Going to fetch file [$getfile] from dir [$dir] on host [$host] as local [$aslocal]\n"; + + #### This was the bug where I contacted Graham and got so strange error messages + #### ftp_get($host,$dir,$getfile,$aslocal) && return $aslocal; + CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal) && return $aslocal; + } + } + Carp::croak("Cannot fetch $file from anywhere"); +} + +package CPAN::Complete; +use vars qw(@ISA); +@ISA = qw(CPAN::Debug); + +sub complete { + my($word,$line,$pos) = @_; + $word ||= ""; + $line ||= ""; + $pos ||= 0; + CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG; + $line =~ s/^\s*//; + my @return; + if ($pos == 0) { + @return = grep(/^$word/, sort qw(! a b d h i m o q r u autobundle clean make test install reload)); + } elsif ( $line !~ /^[\!abdhimorut]/ ) { + @return = (); + } elsif ($line =~ /^a\s/) { + @return = completex('CPAN::Author',$word); + } elsif ($line =~ /^b\s/) { + @return = completex('CPAN::Bundle',$word); + } elsif ($line =~ /^d\s/) { + @return = completex('CPAN::Distribution',$word); + } elsif ($line =~ /^([mru]\s|(make|clean|test|install)\s)/ ) { + @return = (completex('CPAN::Module',$word),completex('CPAN::Bundle',$word)); + } elsif ($line =~ /^i\s/) { + @return = complete_any($word); + } elsif ($line =~ /^reload\s/) { + @return = complete_reload($word,$line,$pos); + } elsif ($line =~ /^o\s/) { + @return = complete_option($word,$line,$pos); + } else { + @return = (); + } + return @return; +} + +sub completex { + my($class, $word) = @_; + grep /^\Q$word\E/, map { $_->id } $CPAN::META->all($class); +} + +sub complete_any { + my($word) = shift; + return ( + completex('CPAN::Author',$word), + completex('CPAN::Bundle',$word), + completex('CPAN::Distribution',$word), + completex('CPAN::Module',$word), + ); +} + +sub complete_reload { + my($word,$line,$pos) = @_; + $word ||= ""; + 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; +} + +sub complete_option { + my($word,$line,$pos) = @_; + $word ||= ""; + 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; + if (0) { + } elsif ($words[1] eq 'index') { + return (); + } elsif ($words[1] eq 'conf') { + return CPAN::Config::complete(@_); + } elsif ($words[1] eq 'debug') { + return sort grep /^\Q$word\E/, sort keys %CPAN::DEBUG, 'all'; + } +} + +package CPAN::Index; +use vars qw($last_time @ISA); +@ISA = qw(CPAN::Debug); +$last_time ||= 0; + +sub force_reload { + my($class) = @_; + $CPAN::Index::last_time = 0; + $class->reload(1); +} + +sub reload { + my($cl,$force) = @_; + my $time = time; + + # XXX check if a newer one is available. (We currently read it from time to time) + return if $last_time + $CPAN::Config->{index_expire}*86400 > $time; + $last_time = $time; + + $cl->read_authindex($cl->reload_x("authors/01mailrc.txt.gz","01mailrc.gz",$force)); + return if $CPAN::Signal; # this is sometimes lengthy + $cl->read_modpacks($cl->reload_x("modules/02packages.details.txt.gz","02packag.gz",$force)); + return if $CPAN::Signal; # this is sometimes lengthy + $cl->read_modlist($cl->reload_x("modules/03modlist.data.gz","03mlist.gz",$force)); +} + +sub reload_x { + my($cl,$wanted,$localname,$force) = @_; + $force ||= 0; + my $abs_wanted = CPAN->catfile($CPAN::Config->{'keep_source_where'},$localname); + if (-f $abs_wanted && -M $abs_wanted < $CPAN::Config->{'index_expire'} && !$force) { + my($s) = $CPAN::Config->{'index_expire'} != 1; + $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} day$s. I\'ll use that.\n}); + return $abs_wanted; + } else { + $force ||= 1; + } + return CPAN::FTP->localize($wanted,$abs_wanted,$force); +} + +sub read_authindex { + my($cl,$index_target) = @_; + my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target"; + warn "Going to read $index_target\n"; + my $fh = IO::File->new("$pipe|"); + while (<$fh>) { + chomp; + my($userid,$fullname,$email) = /alias\s+(\S+)\s+\"([^\"\<]+)\s+<([^\>]+)\>\"/; + next unless $userid && $fullname && $email; + + # instantiate an author object + my $userobj = $CPAN::META->instance('CPAN::Author',$userid); + $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email); + return if $CPAN::Signal; + } + $fh->close; + $? and Carp::croak "FAILED $pipe: exit status [$?]"; +} + +sub read_modpacks { + my($cl,$index_target) = @_; + my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target"; + warn "Going to read $index_target\n"; + my $fh = IO::File->new("$pipe|"); + while (<$fh>) { + next if 1../^\s*$/; + chomp; + my($mod,$version,$dist) = split; + $version =~ s/^\+//; + + # if it as a bundle, instatiate a bundle object + my($bundle) = $mod =~ /^Bundle::(.*)/; + $version = "n/a" if $mod =~ s/(.+::.+::).+/$1*/; # replace the third level with a star + + if ($mod eq 'CPAN') { + 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 + install CPAN + reload cpan + without quitting the current session. It should be a seemless upgrade + while we are running... +}; + sleep 2; + print qq{\n}; + } + } + + my($id); + if ($bundle){ + $id = $CPAN::META->instance('CPAN::Bundle',$mod); + $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)) { +# next; + } else { + # instantiate a module object + $id = $CPAN::META->instance('CPAN::Module',$mod); + $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist); + } + + # determine the author + my($userid) = $dist =~ /([^\/]+)/; + $id->set('CPAN_USERID' => $userid) if $userid =~ /\w/; + + # instantiate a distribution object + unless ($CPAN::META->exists('CPAN::Distribution',$dist)) { + $CPAN::META->instance( + 'CPAN::Distribution' => $dist + )->set( + 'CPAN_USERID' => $userid + ) + if $userid =~ /\w/; + } + + return if $CPAN::Signal; + } + $fh->close; + $? and Carp::croak "FAILED $pipe: exit status [$?]"; +} + +sub read_modlist { + my($cl,$index_target) = @_; + my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target"; + warn "Going to read $index_target\n"; + my $fh = IO::File->new("$pipe|"); + my $eval = ""; + while (<$fh>) { + next if 1../^\s*$/; + next if /use vars/; # will go away in 03... + $eval .= $_; + return if $CPAN::Signal; + } + $eval .= q{CPAN::Modulelist->data;}; + local($^W) = 0; + my($comp) = Safe->new("CPAN::Safe1"); + my $ret = $comp->reval($eval); + Carp::confess($@) if $@; + return if $CPAN::Signal; + for (keys %$ret) { + my $obj = $CPAN::META->instance(CPAN::Module,$_); + $obj->set(%{$ret->{$_}}); + return if $CPAN::Signal; + } +} + +package CPAN::InfoObj; +use vars qw(@ISA); +@ISA = qw(CPAN::Debug); + +sub new { my $this = bless {}, shift; %$this = @_; $this } + +sub set { + my($self,%att) = @_; + my(%oldatt) = %$self; + %$self = (%oldatt, %att); +} + +sub id { shift->{'ID'} } + +sub as_glimpse { + my($self) = @_; + my(@m); + my $class = ref($self); + $class =~ s/^CPAN:://; + push @m, sprintf "%-15s %s\n", $class, $self->{ID}; + join "", @m; +} + +sub as_string { + my($self) = @_; + my(@m); + my $class = ref($self); + $class =~ s/^CPAN:://; + push @m, $class, " id = $self->{ID}\n"; + for (sort keys %$self) { + next if $_ eq 'ID'; + my $extra = ""; + $_ eq "CPAN_USERID" and $extra = " (".$self->author.")"; + if (ref $self->{$_}) { # Should we setup a language interface? XXX + push @m, sprintf " %-12s %s%s\n", $_, "@{$self->{$_}}", $extra; + } else { + push @m, sprintf " %-12s %s%s\n", $_, $self->{$_}, $extra; + } + } + join "", @m, "\n"; +} + +sub author { + my($self) = @_; + $CPAN::META->instance(CPAN::Author,$self->{CPAN_USERID})->fullname; +} + +package CPAN::Author; +use vars qw(@ISA); +@ISA = qw(CPAN::Debug CPAN::InfoObj); + +sub as_glimpse { + my($self) = @_; + my(@m); + my $class = ref($self); + $class =~ s/^CPAN:://; + push @m, sprintf "%-15s %s (%s)\n", $class, $self->{ID}, $self->fullname; + join "", @m; +} + +sub fullname { shift->{'FULLNAME'} } +*name = \&fullname; +sub email { shift->{'EMAIL'} } + +package CPAN::Distribution; +use vars qw(@ISA); +@ISA = qw(CPAN::Debug CPAN::InfoObj); + +sub called_for { + my($self,$id) = @_; + $self->{'CALLED_FOR'} = $id if defined $id; + return $self->{'CALLED_FOR'}; +} + +sub get { + my($self) = @_; + EXCUSE: { + my @e; + exists $self->{'build_dir'} and push @e, "Unwrapped into directory $self->{'build_dir'}"; + print join "", map {" $_\n"} @e and return if @e; + } + my($local_file); + my($local_wanted) = + CPAN->catfile( + $CPAN::Config->{keep_source_where}, + "authors", + "id", + split("/",$self->{ID}) + ); + + $self->debug("Doing localize") if $CPAN::DEBUG; + $local_file = CPAN::FTP->localize("authors/id/$self->{ID}", $local_wanted); + $self->{localfile} = $local_file; + my $builddir = $CPAN::META->{cachemgr}->dir; + $self->debug("doing chdir $builddir") if $CPAN::DEBUG; + chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!"); + my $packagedir; + + $self->debug("local_file[$local_file]") if $CPAN::DEBUG; + if ($local_file =~ /(\.tar\.(gz|Z)|\.tgz|\.zip)$/i){ + $self->debug("Removing tmp") if $CPAN::DEBUG; + File::Path::rmtree("tmp"); + mkdir "tmp", 0777 or Carp::croak "Couldn't mkdir tmp: $!"; + chdir "tmp"; + $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) { + $self->{unwrapped} = "YES"; + } else { + $self->{unwrapped} = "NO"; + } + } elsif ($local_file =~ /zip$/i) { + $self->{archived} = "zip"; + if (system("$CPAN::Config->{unzip} $local_file")==0) { + $self->{unwrapped} = "YES"; + } else { + $self->{unwrapped} = "NO"; + } + } + # Let's check if the package has its own directory. + opendir DIR, "." or Carp::croak("Weird: couldn't opendir .: $!"); + my @readdir = grep $_ !~ /^\.\.?$/, readdir DIR; ### MAC?? + closedir DIR; + my ($distdir,$packagedir); + if (@readdir == 1 && -d $readdir[0]) { + $distdir = $readdir[0]; + $packagedir = $CPAN::META->catdir($builddir,$distdir); + -d $packagedir and print "Removing previously used $packagedir\n"; + File::Path::rmtree($packagedir); + rename($distdir,$packagedir) or Carp::confess("Couldn't rename $distdir to $packagedir"); + } else { + my $pragmatic_dir = $self->{'CPAN_USERID'} . '000'; + $pragmatic_dir =~ s/\W_//g; + $pragmatic_dir++ while -d "../$pragmatic_dir"; + $packagedir = $CPAN::META->catdir($builddir,$pragmatic_dir); + File::Path::mkpath($packagedir); + my($f); + for $f (@readdir) { # is already without "." and ".." + my $to = $CPAN::META->catdir($packagedir,$f); + rename($f,$to) or Carp::confess("Couldn't rename $f to $to"); + } + } + $self->{'build_dir'} = $packagedir; + + chdir ".."; + $self->debug("Changed directory to .. (self is $self [".$self->as_string."])") if $CPAN::DEBUG; + File::Path::rmtree("tmp"); + if ($CPAN::Config->{keep_source_where} =~ /^no/i ){ + print "Going to unlink $local_file\n"; + unlink $local_file or Carp::carp "Couldn't unlink $local_file"; + } + my($makefilepl) = $CPAN::META->catfile($packagedir,"Makefile.PL"); + unless (-f $makefilepl) { + my($configure) = $CPAN::META->catfile($packagedir,"Configure"); + if (-f $configure) { + # do we have anything to do? + $self->{'configure'} = $configure; + } else { + my $fh = IO::File->new(">$makefilepl") or Carp::croak("Could not open >$makefilepl"); + my $cf = $self->called_for || "unknown"; + $fh->print(qq{ +# This Makefile.PL has been autogenerated by the module CPAN.pm +# Autogenerated on: }.scalar localtime().qq{ + use ExtUtils::MakeMaker; + WriteMakefile(NAME => q[$cf]); +}); + print qq{Package comes without Makefile.PL.\n}. + qq{ Writing one on our own (calling it $cf)\n}; + } + } + } else { + $self->{archived} = "NO"; + } + return $self; +} + +sub new { + my($class,%att) = @_; + + $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); + + my $this = { %att }; + return bless $this, $class; +} + +sub readme { + my($self) = @_; + print "Readme not yet implemented (says ".$self->id.")\n"; +} + +sub verifyMD5 { + my($self) = @_; + EXCUSE: { + my @e; + $self->{MD5_STATUS} and push @e, "MD5 Checksum was ok"; + print join "", map {" $_\n"} @e and return if @e; + } + my($local_file); + my(@local) = split("/",$self->{ID}); + my($basename) = pop @local; + push @local, "CHECKSUMS"; + my($local_wanted) = + CPAN->catfile( + $CPAN::Config->{keep_source_where}, + "authors", + "id", + @local + ); + local($") = "/"; + if ( + -f $local_wanted + && + $self->MD5_check_file($local_wanted,$basename) + ) { + return $self->{MD5_STATUS}="OK"; + } + $local_file = CPAN::FTP->localize("authors/id/@local", $local_wanted, 'force>:-{'); + my($checksum_pipe); + if ($local_file) { + # fine + } else { + $local[-1] .= ".gz"; + $local_file = CPAN::FTP->localize( + "authors/id/@local", + "$local_wanted.gz", + 'force>:-{' + ); + my $system = "$CPAN::Config->{gzip} --decompress $local_file"; + system($system)==0 or die "Could not uncompress $local_file"; + $local_file =~ s/\.gz$//; + } + $self->MD5_check_file($local_file,$basename); +} + +sub MD5_check_file { + my($self,$lfile,$basename) = @_; + my($cksum); + my $fh = new IO::File; + local($/)=undef; + if (open $fh, $lfile){ + my $eval = <$fh>; + close $fh; + my($comp) = Safe->new(); + $cksum = $comp->reval($eval); + Carp::confess($@) if $@; + if ($cksum->{$basename}->{md5}) { + $self->debug("Found checksum for $basename: $cksum->{$basename}->{md5}\n") if $CPAN::DEBUG; + my $file = $self->{localfile}; + my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $self->{localfile}|"; + if ( + open($fh, $file) && $self->eq_MD5($fh,$cksum->{$basename}->{md5}) + or + open($fh, $pipe) && $self->eq_MD5($fh,$cksum->{$basename}->{'md5-ungz'}) + ){ + print "Checksum for $file ok\n"; + return $self->{MD5_STATUS}="OK"; + } else { + die join( + "", + "\nChecksum mismatch for distribution file. Please investigate.\n\n", + $self->as_string, + $CPAN::META->instance('CPAN::Author',$self->{CPAN_USERID})->as_string, + "Please contact the author or your CPAN site admin" + ); + } + close $fh if fileno($fh); + } else { + print "No md5 checksum for $basename in local $lfile\n"; + return; + } + } else { + Carp::carp "Could not open $lfile for reading"; + } +} + +sub eq_MD5 { + my($self,$fh,$expectMD5) = @_; + my $md5 = new MD5; + $md5->addfile($fh); + my $hexdigest = $md5->hexdigest; + $hexdigest eq $expectMD5; +} + +sub force { + my($self) = @_; + $self->{'force_update'}++; + delete $self->{'MD5_STATUS'}; + delete $self->{'archived'}; + delete $self->{'build_dir'}; + delete $self->{'localfile'}; + delete $self->{'make'}; + delete $self->{'install'}; + delete $self->{'unwrapped'}; + delete $self->{'writemakefile'}; +} + +sub make { + my($self) = @_; + $self->debug($self->id) if $CPAN::DEBUG; + print "Running make\n"; + $self->get; + if ($CPAN::META->hasMD5) { + $self->verifyMD5; + } + EXCUSE: { + my @e; + $self->{archived} eq "NO" and push @e, "Is neither a tar nor a zip archive."; + $self->{unwrapped} eq "NO" and push @e, "had problems unarchiving. Please build manually"; + exists $self->{writemakefile} && $self->{writemakefile} eq "NO" and push @e, "Had some problem writing Makefile"; + defined $self->{'make'} and push @e, "Has already been processed within this session"; + print join "", map {" $_\n"} @e and return if @e; + } + print "\n CPAN: Going to build ".$self->id."\n\n"; + my $builddir = $self->dir; + chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!"); + $self->debug("Changed directory to $builddir") if $CPAN::DEBUG; + + my $system; + if ($self->{'configure'}) { + $system = $self->{'configure'}; + } else { + my($perl) = $^X =~ /^\.\// ? "$CPAN::Cwd/$^X" : $^X; # XXX subclassing folks, forgive me! + $system = "$perl Makefile.PL $CPAN::Config->{makepl_arg}"; + } + if (system($system)!=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) { + print " $system -- OK\n"; + $self->{'make'} = "YES"; + } else { + $self->{writemakefile} = "YES"; + $self->{'make'} = "NO"; + print " $system -- NOT OK\n"; + } +} + +sub test { + my($self) = @_; + $self->make; + return if $CPAN::Signal; + print "Running make test\n"; + EXCUSE: { + my @e; + exists $self->{'make'} or push @e, "Make had some problems, maybe interrupted? Won't test"; + exists $self->{'make'} and $self->{'make'} eq 'NO' and push @e, "Oops, make had returned bad status"; + exists $self->{'build_dir'} or push @e, "Has no own directory"; + print join "", map {" $_\n"} @e and return if @e; + } + 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) { + print " $system -- OK\n"; + $self->{'make_test'} = "YES"; + } else { + $self->{'make_test'} = "NO"; + print " $system -- NOT OK\n"; + } +} + +sub clean { + my($self) = @_; + print "Running make clean\n"; + EXCUSE: { + my @e; + exists $self->{'build_dir'} or push @e, "Has no own directory"; + print join "", map {" $_\n"} @e and return if @e; + } + 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) { + print " $system -- OK\n"; + $self->force; + } else { + # Hmmm, what to do if make clean failed? + } +} + +sub install { + my($self) = @_; + $self->test; + return if $CPAN::Signal; + print "Running make install\n"; + EXCUSE: { + my @e; + exists $self->{'build_dir'} or push @e, "Has no own directory"; + exists $self->{'make'} or push @e, "Make had some problems, maybe interrupted? Won't install"; + exists $self->{'make'} and $self->{'make'} eq 'NO' and push @e, "Oops, make had returned bad status"; + exists $self->{'install'} and push @e, $self->{'install'} eq "YES" ? "Already done" : "Already tried without success"; + print join "", map {" $_\n"} @e and return if @e; + } + 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'}, "install", $CPAN::Config->{make_install_arg}; + my($pipe) = IO::File->new("$system 2>&1 |"); + my($makeout) = ""; + while (<$pipe>){ + print; + $makeout .= $_; + } + $pipe->close; + if ($?==0) { + print " $system -- OK\n"; + $self->{'install'} = "YES"; + } else { + $self->{'install'} = "NO"; + print " $system -- NOT OK\n"; + if ($makeout =~ /permission/s && $> > 0) { + print " You may have to su to root to install the package\n"; + } + } +} + +sub dir { + shift->{'build_dir'}; +} + +package CPAN::Bundle; +use vars qw(@ISA); +@ISA = qw(CPAN::Debug CPAN::InfoObj CPAN::Module); + +sub as_string { + my($self) = @_; + $self->contains; + return $self->SUPER::as_string; +} + +sub contains { + my($self) = @_; + my($parsefile) = $self->inst_file; + unless ($parsefile) { + # 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"); + $to = $CPAN::META->catfile($todir,"$me.pm"); + rename($from, $to) or Carp::croak("Couldn't rename $from to $to: $!"); + $parsefile = $to; + } + my @result; + my $fh = new IO::File; + local $/ = "\n"; + open($fh,$parsefile) or die "Could not open '$parsefile': $!"; + my $inpod = 0; + while (<$fh>) { + $inpod = /^=(?!head1\s+CONTENTS)/ ? 0 : /^=head1\s+CONTENTS/ ? 1 : $inpod; + next unless $inpod; + next if /^=/; + next if /^\s+$/; + chomp; + push @result, (split " ", $_, 2)[0]; + } + close $fh; + delete $self->{STATUS}; + $self->{CONTAINS} = [@result]; + @result; +} + +sub inst_file { + my($self) = @_; + my($me,$inst_file); + ($me = $self->id) =~ s/.*://; + $inst_file = $CPAN::META->catfile($CPAN::Config->{'cpan_home'},"Bundle", "$me.pm"); + return $self->{'INST_FILE'} = $inst_file if -f $inst_file; + $inst_file = $self->SUPER::inst_file; + return $self->{'INST_FILE'} = $inst_file if -f $inst_file; + return $self->{'INST_FILE'}; # even if undefined? +} + +sub rematein { + my($self,$meth) = @_; + $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG; + my($s); + for $s ($self->contains) { + $CPAN::META->instance('CPAN::Module',$s)->$meth(); + } +} + +sub install { shift->rematein('install',@_); } +sub clean { shift->rematein('clean',@_); } +sub test { shift->rematein('test',@_); } +sub make { shift->rematein('make',@_); } + +# XXX not yet implemented! +sub readme { + my($self) = @_; + my($file) = $self->cpan_file or print("No File found for bundle ", $self->id, "\n"), return; + $self->debug("self[$self] file[$file]") if $CPAN::DEBUG; + $CPAN::META->instance('CPAN::Distribution',$file)->readme; +# CPAN::FTP->localize("authors/id/$file",$index_wanted); # XXX +} + +package CPAN::Module; +use vars qw(@ISA); +@ISA = qw(CPAN::Debug CPAN::InfoObj); + +sub as_glimpse { + my($self) = @_; + my(@m); + my $class = ref($self); + $class =~ s/^CPAN:://; + push @m, sprintf "%-15s %-15s (%s)\n", $class, $self->{ID}, $self->cpan_file; + join "", @m; +} + +sub as_string { + my($self) = @_; + my(@m); + CPAN->debug($self) if $CPAN::DEBUG; + my $class = ref($self); + $class =~ s/^CPAN:://; + local($^W) = 0; + push @m, $class, " id = $self->{ID}\n"; + my $sprintf = " %-12s %s\n"; + push @m, sprintf $sprintf, 'DESCRIPTION', $self->{description} if $self->{description}; + my $sprintf2 = " %-12s %s (%s)\n"; + my($userid); + if ($userid = $self->{'CPAN_USERID'} || $self->{'userid'}){ + push @m, sprintf( + $sprintf2, + 'CPAN_USERID', + $userid, + $CPAN::META->instance(CPAN::Author,$userid)->fullname + ) + } + push @m, sprintf $sprintf, 'CPAN_VERSION', $self->{CPAN_VERSION} if $self->{CPAN_VERSION}; + push @m, sprintf $sprintf, 'CPAN_FILE', $self->{CPAN_FILE} if $self->{CPAN_FILE}; + my $sprintf3 = " %-12s %1s%1s%1s%1s (%s,%s,%s,%s)\n"; + my(%statd,%stats,%statl,%stati); + @statd{qw,? i c a b R M S,} = qw,unknown idea pre-alpha alpha beta released mature standard,; + @stats{qw,? m d u n,} = qw,unknown mailing-list developer comp.lang.perl.* none,; + @statl{qw,? p c + o,} = qw,unknown perl C C++ other,; + @stati{qw,? f r O,} = qw,unknown functions references+ties object-oriented,; + $statd{' '} = 'unknown'; + $stats{' '} = 'unknown'; + $statl{' '} = 'unknown'; + $stati{' '} = 'unknown'; + push @m, sprintf( + $sprintf3, + 'DSLI_STATUS', + $self->{statd}, + $self->{stats}, + $self->{statl}, + $self->{stati}, + $statd{$self->{statd}}, + $stats{$self->{stats}}, + $statl{$self->{statl}}, + $stati{$self->{stati}} + ) if $self->{statd}; + my $local_file = $self->inst_file; + if ($local_file && ! exists $self->{MANPAGE}) { + my $fh = IO::File->new($local_file) or Carp::croak("Couldn't open $local_file: $!"); + my $inpod = 0; + my(@result); + local $/ = "\n"; + while (<$fh>) { + $inpod = /^=(?!head1\s+NAME)/ ? 0 : /^=head1\s+NAME/ ? 1 : $inpod; + next unless $inpod; + next if /^=/; + next if /^\s+$/; + chomp; + push @result, $_; + } + close $fh; + $self->{MANPAGE} = join " ", @result; + } + push @m, sprintf $sprintf, 'MANPAGE', $self->{MANPAGE} if $self->{MANPAGE}; + push @m, sprintf $sprintf, 'INST_FILE', $local_file || "(not installed)"; + push @m, sprintf $sprintf, 'INST_VERSION', $self->inst_version if $local_file; + join "", @m, "\n"; +} + +sub cpan_file { + my $self = shift; + CPAN->debug($self->id) if $CPAN::DEBUG; + unless (defined $self->{'CPAN_FILE'}) { + CPAN::Index->reload; + } + if (defined $self->{'CPAN_FILE'}){ + return $self->{'CPAN_FILE'}; + } elsif (defined $self->{'userid'}) { + return "Contact Author ".$self->{'userid'}."=".$CPAN::META->instance(CPAN::Author,$self->{'userid'})->fullname + } else { + return "N/A"; + } +} + +*name = \&cpan_file; + +sub cpan_version { shift->{'CPAN_VERSION'} } + +sub force { + my($self) = @_; + $self->{'force_update'}++; +} + +sub rematein { + my($self,$meth) = @_; + $self->debug($self->id) if $CPAN::DEBUG; + my $cpan_file = $self->cpan_file; + return if $cpan_file eq "N/A"; + return if $cpan_file =~ /^Contact Author/; + my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file); + $pack->called_for($self->id); + $pack->force if exists $self->{'force_update'}; + $pack->$meth(); + delete $self->{'force_update'}; +} + +sub readme { shift->rematein('readme') } +sub make { shift->rematein('make') } +sub clean { shift->rematein('clean') } +sub test { shift->rematein('test') } +sub install { + my($self) = @_; + my($doit) = 0; + my($latest) = $self->cpan_version; + $latest ||= 0; + my($inst_file) = $self->inst_file; + my($have) = 0; + 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; + } + $self->rematein('install') if $doit; +} + +sub inst_file { + my($self) = @_; + my($dir,@packpath); + @packpath = split /::/, $self->{ID}; + $packpath[-1] .= ".pm"; + foreach $dir (@INC) { + my $pmfile = CPAN->catfile($dir,@packpath); + if (-f $pmfile){ + return $pmfile; + } + } +} + +sub xs_file { + my($self) = @_; + my($dir,@packpath); + @packpath = split /::/, $self->{ID}; + push @packpath, $packpath[-1]; + $packpath[-1] .= "." . $Config::Config{'dlext'}; + foreach $dir (@INC) { + my $xsfile = CPAN->catfile($dir,'auto',@packpath); + if (-f $xsfile){ + return $xsfile; + } + } +} + +sub inst_version { + my($self) = @_; + my $parsefile = $self->inst_file or return 0; + my $have = MY->parse_version($parsefile); + $have ||= 0; + $have =~ s/\s+//g; + $have ||= 0; + $have; +} + +package CPAN::CacheMgr; +use vars qw($Du @ISA); +@ISA=qw(CPAN::Debug CPAN::InfoObj); +use File::Find; + +sub as_string { + eval { require Data::Dumper }; + if ($@) { + return shift->SUPER::as_string; + } else { + return Data::Dumper::Dumper(shift); + } +} + +sub cachesize { + shift->{DU}; +} + +# sub check { +# my($self,@dirs) = @_; +# return unless -d $self->{ID}; +# my $dir; +# @dirs = $self->dirs unless @dirs; +# for $dir (@dirs) { +# $self->disk_usage($dir); +# } +# } + +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 dir { + shift->{ID}; +} + +sub entries { + my($self,$dir) = @_; + $dir ||= $self->{ID}; + my($cwd) = Cwd::cwd(); + chdir $dir or Carp::croak("Can't chdir to $dir: $!"); + my $dh = DirHandle->new(".") or Carp::croak("Couldn't opendir $dir: $!"); + my(@entries); + for ($dh->read) { + next if $_ eq "." || $_ eq ".."; + if (-f $_) { + push @entries, $CPAN::META->catfile($dir,$_); + } elsif (-d _) { + push @entries, $CPAN::META->catdir($dir,$_); + } else { + print STDERR "Warning: weird direntry in $dir: $_\n"; + } + } + chdir $cwd or Carp::croak("Can't chdir to $cwd: $!"); + sort {-M $b <=> -M $a} @entries; +} + +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}; + local($Du) = 0; + find( + sub { + return if -l $_; + $Du += -s; + }, + $dir + ); + $self->{SIZE}{$dir} = $Du/1024/1024; + push @{$self->{FIFO}}, $dir; + $self->debug("measured $dir is $Du") if $CPAN::DEBUG; + $self->{DU} += $Du/1024/1024; + if ($self->{DU} > $self->{'MAX'} ) { + printf "...Hold on a sec... CPAN's cleaning the cache: %.2f MB > %.2f MB\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->{DU}; +} + +sub force_clean_cache { + my($self,$dir) = @_; + $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}") if $CPAN::DEBUG; + File::Path::rmtree($dir); + $self->{DU} -= $self->{SIZE}{$dir}; + delete $self->{SIZE}{$dir}; +} + +sub new { + my $class = shift; + my $self = { ID => $CPAN::Config->{'build_dir'}, MAX => $CPAN::Config->{'build_cache'}, DU => 0 }; + File::Path::mkpath($self->{ID}); + my $dh = DirHandle->new($self->{ID}); + bless $self, $class; + $self->debug("dir [$self->{ID}]") if $CPAN::DEBUG; + 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); + } + $self; +} + +package CPAN::Debug; + +sub debug { + my($self,$arg) = @_; + my($caller,$func,$line,@rest) = caller(1); # caller(0) eg Complete, caller(1) eg readline + ($caller) = caller(0); + $caller =~ s/.*:://; +# print "caller[$caller]func[$func]line[$line]rest[@rest]\n"; +# print "CPAN::DEBUG{caller}[$CPAN::DEBUG{$caller}]CPAN::DEBUG[$CPAN::DEBUG]\n"; + if ($CPAN::DEBUG{$caller} & $CPAN::DEBUG){ + if (ref $arg) { + eval { require Data::Dumper }; + if ($@) { + print $arg->as_string; + } else { + print Data::Dumper::Dumper($arg); + } + } else { + print "Debug($caller:$func,$line,@rest): $arg\n" + } + } +} + +package CPAN::Config; +import ExtUtils::MakeMaker 'neatvalue'; +use vars qw(%can); + +%can = ( + 'commit' => "Commit changes to disk", + 'defaults' => "Reload defaults from disk", +); + +sub edit { + my($class,@args) = @_; + return unless @args; + CPAN->debug("class[$class]args[@args]"); + my($o,$str,$func,$args,$key_exists); + $o = shift @args; + if($can{$o}) { + $class->$o(@args); + return 1; + } + return unless exists $CPAN::Config->{$o}; + + if (ref($CPAN::Config->{$o}) eq ARRAY) { + if (@args) { + $func = shift @args; + # Let's avoid eval, it's easier to comprehend without. + if ($func eq "push") { + push @{$CPAN::Config->{$o}}, @args; + } elsif ($func eq "pop") { + pop @{$CPAN::Config->{$o}}; + } elsif ($func eq "shift") { + shift @{$CPAN::Config->{$o}}; + } elsif ($func eq "unshift") { + unshift @{$CPAN::Config->{$o}}, @args; + } elsif ($func eq "splice") { + splice @{$CPAN::Config->{$o}}, @args; + } else { + $CPAN::Config->{$o} = [@args]; + } + } else { + print qq{ $o }, neatvalue($CPAN::Config->{$o}), qq{ +Usage: + o conf $o [shift|pop] +or + o conf $o [unshift|push|splice] <list> +}; + } + } else { + if (@args) { + $CPAN::Config->{$o} = $args[0]; + } + print " $o "; + print defined $CPAN::Config->{$o} ? $CPAN::Config->{$o} : "UNDEFINED"; + } +} + +sub commit { + my($self, $configpm) = @_; + my $mode; + # mkpath!? + + my($fh) = IO::File->new; + $configpm ||= cfile(); + if (-f $configpm) { + $mode = (stat $configpm)[2]; + if ($mode && ! -w _) { + print "$configpm is not writable\n" and return; + } + #chmod 0644, $configpm; #? + } + + my $msg = <<EOF unless $configpm =~ /MyConfig/; + +# This is CPAN.pm's systemwide configuration file. This file provides +# defaults for users, and the values can be changed in a per-user configuration +# file. The user-config file is being looked for as ~/.cpan/CPAN/MyConfig.pm. + +EOF + $msg ||= "\n"; + open $fh, ">$configpm" or warn "Couldn't open >$configpm: $!"; + print $fh qq[$msg\$CPAN::Config = \{\n]; + foreach (sort keys %$CPAN::Config) { + print $fh " '$_' => ", ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$_}), ",\n"; + } + + print $fh "};\n1;\n__END__\n"; + close $fh; + + #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 ); + #chmod $mode, $configpm; + $self->defaults; + print "commit: wrote $configpm\n"; + 1; +} + +*default = \&defaults; +sub defaults { + my($self) = @_; + $self->unload; + $self->load; + 1; +} + +my $dot_cpan; +sub load { + my($self) = @_; + 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) = MY->catdir($path_to_cpan,"CPAN"); + my($configpmtest) = MY->catfile($configpmdir,"Config.pm"); + if (-d $configpmdir || File::Path::mkpath($configpmdir)) { +#_#_# following code dumped core on me with 5.003_11, a.k. +#_#_# $fh = IO::File->new; +#_#_# if ($fh->open(">$configpmtest")) { +#_#_# $fh->print("1;\n"); +#_#_# $configpm = $configpmtest; +#_#_# } + if (-w $configpmtest or -w $configpmdir) { + $configpm = $configpmtest; + } + } + unless ($configpm) { + $configpmdir = MY->catdir($ENV{HOME},".cpan","CPAN"); + File::Path::mkpath($configpmdir); + $configpmtest = MY->catfile($configpmdir,"MyConfig.pm"); + if (-w $configpmtest or -w $configpmdir) { + $configpm = $configpmtest; + } else { + warn "WARNING: CPAN.pm is unable to create a configuration file.\n"; + } + } + } + warn "Calling CPAN::FirstTime::init($configpm)"; + CPAN::FirstTime::init($configpm); + } +} + +sub load_succeeded { + my($miss) = 0; + 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 + )) { + $miss++ unless defined $CPAN::Config->{$_}; # we want them all + } + return !$miss; +} + +sub unload { + delete $INC{'CPAN/MyConfig.pm'}; + delete $INC{'CPAN/Config.pm'}; +} + +sub cfile { + $INC{'CPAN/MyConfig.pm'} || $INC{'CPAN/Config.pm'}; +} + +*h = \&help; +sub help { + print <<EOF; +Known options: + defaults reload default config values from disk + commit commit session changes to disk + +You may edit key values in the follow fashion: + + o conf build_cache 15 + + o conf build_dir "/foo/bar" + + o conf urllist shift + + o conf urllist unshift ftp://ftp.foo.bar/ + +EOF + undef; #don't reprint CPAN::Config +} + +sub complete { + my($word,$line,$pos) = @_; + $word ||= ""; + my(@words) = split " ", $line; + my(@o_conf) = (sort keys %CPAN::Config::can, sort keys %$CPAN::Config); + return (@o_conf) unless @words>2; + if($words[2] =~ /->(.*)/) { + my $meth = $1; + my(@methods) = qw(shift unshift push pop splice); + return @methods unless $meth; + return sort grep /^\Q$meth\E/, @methods; + } + return sort grep /^\Q$word\E/, @o_conf; +} + +1; + +=head1 NAME + +CPAN - query, download and build perl modules from CPAN sites + +=head1 SYNOPSIS + +Interactive mode: + + perl -MCPAN -e shell; + +Batch mode: + + use CPAN; + + autobundle, bundle, clean, expand, install, make, recompile, test + +=head1 DESCRIPTION + +The CPAN module is designed to automate the building and installing of +perl modules and extensions including the searching and fetching from +the net. + +Modules are fetched from one or more of the mirrored CPAN +(Comprehensive Perl Archive Network) sites and unpacked in a dedicated +directory. + +The CPAN module also supports the concept of named and versioned +'bundles' of modules. Bundles simplify the handling of sets of +related modules. See BUNDLES below. + +The package contains a session manager and a cache manager. There is +no status retained between sessions. The session manager keeps track +of what has been fetched, built and installed in the current +session. The cache manager keeps track of the disk space occupied by +the make processes and deletes excess space in a simple FIFO style. + +=head2 Interactive Mode + +The interactive mode is entered by running + + perl -MCPAN -e shell + +which puts you into a readline interface. You will have most fun if +you install Term::ReadKey and Term::ReadLine to enjoy both history and +completion. + +Once you are on the command line, type 'h' and the rest should be +self-explanatory. + +=head2 CPAN::Shell + +The commands that are available in the shell interface are methods in +the package CPAN::Shell. If you enter the shell command, all your +input is split on whitespace, the first word is being interpreted as +the method to be called and the rest of the words are treated as +arguments to this method. + +If you do not enter the shell, most of the available shell commands +are both available as methods (C<CPAN::Shell-E<gt>install(...)>) and as +functions in the calling package (C<install(...)>). + +=head2 Cache Manager + +Currently the cache manager only keeps track of the build directory +($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that +deletes complete directories below build_dir as soon as the size of +all directories there gets bigger than $CPAN::Config->{build_cache} +(in MB). The contents of this cache may be used for later +re-installations that you intend to do manually, but will never be +trusted by CPAN itself. + +There is another directory ($CPAN::Config->{keep_source_where}) where +the original distribution files are kept. This directory is not +covered by the cache manager and must be controlled by the user. If +you choose to have the same directory as build_dir and as +keep_source_where directory, then your sources will be deleted with +the same fifo mechanism. + +=head2 Bundles + +A bundle is just a perl module in the namespace Bundle:: that does not +define any functions or methods. It usually only contains documentation. + +It starts like a perl module with a package declaration and a $VERSION +variable. After that the pod section looks like any other pod with the +only difference, that one pod section exists starting with (verbatim): + + =head1 CONTENTS + +In this pod section each line obeys the format + + Module_Name [Version_String] [- optional text] + +The only required part is the first field, the name of a module +(eg. Foo::Bar, ie. I<not> the name of the distribution file). The rest +of the line is optional. The comment part is delimited by a dash just +as in the man page header. + +The distribution of a bundle should follow the same convention as +other distributions. The bundle() function in the CPAN module simply +parses the module that defines the bundle and returns the module names +that are listed in the described CONTENTS section. + +Bundles are treated specially in the CPAN package. If you say 'install +Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all +the modules in the CONTENTS section of the pod. You can install your +own Bundles locally by placing a conformant Bundle file somewhere into +your @INC path. The autobundle() command which is available in the +shell interface does that for you by including all currently installed +modules in a snapshot bundle file. + +=head2 autobundle + +autobundle() writes a bundle file into the directory +$CPAN::Config->{cpan_home}/Bundle directory. The file contains a list +of all modules that are both available from CPAN and currently +installed within @INC. The name of the bundle file is based on the +current date and a counter. + +=head2 Pragma: force + +Normally CPAN keeps track of what it has done within the current +session and doesn't try to build a package a second time regardless if +it succeeded or not. The force command takes as first argument the +method to invoke (currently: make, test, or install) and executes the +command from scratch. + +Example: + + cpan> install OpenGL + OpenGL is up to date. + cpan> force install OpenGL + Running make + OpenGL-0.4/ + OpenGL-0.4/COPYRIGHT + [...] + +=head2 recompile + +recompile() is a very special command in that it takes no argument and +runs the make/test/install cycle with brute force over all installed +dynamically loadable extensions (aka XS modules) with 'force' in +effect. Primary purpose of this command is to act as a rescue in case +your 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. + +=head1 CONFIGURATION + +When the CPAN module is installed a site wide configuration file is +created as CPAN/Config.pm. The default values defined there can be +overridden in another configuration file: CPAN/MyConfig.pm. You can +store this file in $HOME/.cpan/CPAN/MyConfig.pm if you want, because +$HOME/.cpan is added to the search path of the CPAN module before the +use() or require() statements. + +Currently the following keys in the hash reference $CPAN::Config are +defined: + + build_cache size of cache for directories to build modules + build_dir locally accessible directory to build modules + index_expire after how many days refetch index files + cpan_home local directory reserved for this package + gzip location of external program gzip + inhibit_startup_message + if true, does not print the startup message + keep_source keep the source in a local directory? + keep_source_where where keep the source (if we do) + make location of external program make + make_arg arguments that should always be passed to 'make' + make_install_arg same as make_arg for 'make install' + makepl_arg arguments passed to 'perl Makefile.PL' + pager location of external program more (or any pager) + tar location of external program tar + unzip location of external program unzip + urllist arrayref to nearby CPAN sites (or equivalent locations) + +You can set and query each of these options interactively in the cpan +shell with the command set defined within the C<o conf> command: + +=over 2 + +=item o conf E<lt>scalar optionE<gt> + +prints the current value of the I<scalar option> + +=item o conf E<lt>scalar optionE<gt> E<lt>valueE<gt> + +Sets the value of the I<scalar option> to I<value> + +=item o conf E<lt>list optionE<gt> + +prints the current value of the I<list option> in MakeMaker's +neatvalue format. + +=item o conf E<lt>list optionE<gt> [shift|pop] + +shifts or pops the array in the I<list option> variable + +=item o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt> + +works like the corresponding perl commands. Whitespace is used to +determine the arguments. + +=back + +=head1 SECURITY + +There's no strong security layer in CPAN.pm. CPAN.pm helps you to +install foreign, unmasked, unsigned code on your machine. We compare +to a checksum that comes from the net just as the distribution file +itself. If somebody has managed to tamper with the distribution file, +they may have as well tampered with the CHECKSUMS file. Future +development will go towards stong authentification. + +=head1 EXPORT + +Most functions in package CPAN are exported per default. The reason +for this is that the primary use is intended for the cpan shell or for +oneliners. + +=head1 Debugging + +The debugging of this module is pretty difficult, because we have +interferences of the software producing the indices on CPAN, of the +mirroring process on CPAN, of packaging, of configuration, of +synchronicity, and of bugs within CPAN.pm. + +In interactive mode you can try "o debug" which will list options for +debugging the various parts of the package. The output may not be very +useful for you as it's just a byproduct of my own testing, but if you +have an idea which part of the package may have a bug, it's sometimes +worth to give it a try and send me more specific output. You should +know that "o debug" has built-in completion support. + +=head2 Prerequisites + +If you have a local mirror of CPAN and can access all files with +"file:" URLs, then you only need perl5.003 to run this +module. Otherwise you need Net::FTP intalled. LWP may be required for +non-UNIX systems or if your nearest CPAN site is associated with an +URL that is not C<ftp:>. + +This module presumes that all packages on CPAN + +=over 2 + +=item * + +declare their $VERSION variable in an easy to parse manner. This +prerequisite can hardly be relaxed because it consumes by far too much +memory to load all packages into the running program just to determine +the $VERSION variable . Currently all programs that are dealing with +VERSION use something like this + + perl -MExtUtils::MakeMaker -le \ + 'print MM->parse_version($ARGV[0])' filename + +If you are author of a package and wonder if your VERSION can be +parsed, please try the above method. + +=item * + +come as compressed or gzipped tarfiles or as zip files and contain a +Makefile.PL (well we try to handle a bit more, but without much +enthusiasm). + +=back + +=head1 AUTHOR + +Andreas König E<lt>a.koenig@mind.deE<gt> + +=head1 SEE ALSO + +perl(1), CPAN::Nox(3) + +=cut + diff --git a/lib/CPAN/FirstTime.pm b/lib/CPAN/FirstTime.pm new file mode 100644 index 0000000000..9cac32d0ac --- /dev/null +++ b/lib/CPAN/FirstTime.pm @@ -0,0 +1,284 @@ +package CPAN::Mirrored::By; + +sub new { + my($self,@arg) = @_; + bless [@arg], $self; +} +sub con { shift->[0] } +sub cou { shift->[1] } +sub url { shift->[2] } + +package CPAN::FirstTime; + +use strict; +use ExtUtils::MakeMaker qw(prompt); +require File::Path; +use vars qw($VERSION); +$VERSION = "1.00"; + +=head1 NAME + +CPAN::FirstTime - Utility for CPAN::Config file Initialization + +=head1 SYNOPSIS + +CPAN::FirstTime::init() + +=head1 DESCRIPTION + +The init routine asks a few questions and writes a CPAN::Config +file. Nothing special. + +=cut + + +sub init { + my($configpm) = @_; + use Config; + require CPAN::Nox; + eval {require CPAN::Config;}; + $CPAN::Config ||= {}; + + my($ans,$default,$local,$cont,$url,$expected_size); + + print qq{ + +The CPAN module needs a directory of its own to cache important +index files and maybe keep a temporary mirror of CPAN files. This may +be a site-wide directory or a personal directory. +}; + + my $cpan_home = $CPAN::Config->{cpan_home} || MM->catdir($ENV{HOME}, ".cpan"); + if (-d $cpan_home) { + print qq{ + +I see you already have a directory + $cpan_home +Shall we use it as the general CPAN build and cache directory? + +}; + } else { + print qq{ + +First of all, I\'d like to create this directory. Where? + +}; + } + + $default = $cpan_home; + $ans = prompt("CPAN build and cache directory?",$default); + File::Path::mkpath($ans); # dies if it can't + $CPAN::Config->{cpan_home} = $ans; + + print qq{ + +If you want, I can keep the source files after a build in the cpan +home directory. If you choose so then future builds will take the +files from there. If you don\'t want to keep them, answer 0 to the +next question. + +}; + + $CPAN::Config->{keep_source_where} = MM->catdir($CPAN::Config->{cpan_home},"sources"); + $CPAN::Config->{build_dir} = MM->catdir($CPAN::Config->{cpan_home},"build"); + + print qq{ + +How big should the disk cache be for keeping the build directories +with all the intermediate files? + +}; + + $default = $CPAN::Config->{build_cache} || 10; + $ans = prompt("Cache size for build directory (in MB)?", $default); + $CPAN::Config->{build_cache} = $ans; + + # XXX This the time when we refetch the index files (in days) + $CPAN::Config->{'index_expire'} = 1; + + print qq{ + +The CPAN module will need a few external programs to work +properly. Please correct me, if I guess the wrong path for a program. + +}; + + my(@path) = split($Config{path_sep},$ENV{PATH}); + my $prog; + for $prog (qw/gzip tar unzip make/){ + my $path = $CPAN::Config->{$prog} || find_exe($prog,[@path]) || $prog; + $ans = prompt("Where is your $prog program?",$path) || $path; + $CPAN::Config->{$prog} = $ans; + } + my $path = $CPAN::Config->{'pager'} || + $ENV{PAGER} || find_exe("less",[@path]) || + find_exe("more",[@path]) || "more"; + $ans = prompt("What is your favorite pager program?",$path) || $path; + $CPAN::Config->{'pager'} = $ans; + print qq{ + +Every Makefile.PL is run by perl in a seperate process. Likewise we +run \'make\' and \'make install\' in processes. If you have any parameters +\(e.g. PREFIX, INSTALLPRIVLIB, UNINST or the like\) you want to pass to +the calls, please specify them here. + +}; + + $default = $CPAN::Config->{makepl_arg} || ""; + $CPAN::Config->{makepl_arg} = + prompt("Parameters for the 'perl Makefile.PL' command?",$default); + $default = $CPAN::Config->{make_arg} || ""; + $CPAN::Config->{make_arg} = prompt("Parameters for the 'make' command?",$default); + + $default = $CPAN::Config->{make_install_arg} || $CPAN::Config->{make_arg} || ""; + $CPAN::Config->{make_install_arg} = + prompt("Parameters for the 'make install' command?",$default); + + $local = 'MIRRORED.BY'; + if (@{$CPAN::Config->{urllist}||[]}) { + print qq{ +I found a list of URLs in CPAN::Config and will use this. +You can change it later with the 'o conf' command. + +} + } elsif (-f $local) { # if they really have a MIRRORED.BY in the + # current directory, we can't help + read_mirrored_by($local); + } else { + $CPAN::Config->{urllist} ||= []; + while (! @{$CPAN::Config->{urllist}}) { + print qq{ +We need to know the URL of your favorite CPAN site. +Please enter it here: }; + chop($_ = <>); + s/\s//g; + push @{$CPAN::Config->{urllist}}, $_ if $_; + } + } + + # We don't ask that now, it will be noticed in time.... + $CPAN::Config->{'inhibit_startup_message'} = 0; + + print "\n\n"; + CPAN::Config->commit($configpm); +} + +sub find_exe { + my($exe,$path) = @_; + my($dir,$MY); + $MY = {}; + bless $MY, 'MY'; + for $dir (@$path) { + my $abs = $MY->catfile($dir,$exe); + if ($MY->maybe_command($abs)) { + return $abs; + } + } +} + +sub read_mirrored_by { + my($local) = @_; + my(%all,$url,$expected_size,$default,$ans,$host,$dst,$country,$continent,@location); + open FH, $local or die "Couldn't open $local: $!"; + while (<FH>) { + ($host) = /^([\w\.\-]+)/ unless defined $host; + next unless defined $host; + next unless /\s+dst_(dst|location)/; + /location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and + ($continent, $country) = @location[-1,-2]; + $continent =~ s/\s\(.*//; + /dst_dst\s+=\s+\"([^\"]+)/ and $dst = $1; + next unless $host && $dst && $continent && $country; + $all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst); + undef $host; + $dst=$continent=$country=""; + } + $CPAN::Config->{urllist} ||= []; + if ($expected_size = @{$CPAN::Config->{urllist}}) { + for $url (@{$CPAN::Config->{urllist}}) { + # sanity check, scheme+colon, not "q" there: + next unless $url =~ /^\w+:\/./; + $all{"[From previous setup]"}{"found URL"}{$url}=CPAN::Mirrored::By->new('[From previous setup]','found URL',$url); + } + $CPAN::Config->{urllist} = []; + } else { + $expected_size = 6; + } + + print qq{ + +Now we need to know, where your favorite CPAN sites are located. Push +a few sites onto the array (just in case the first on the array won\'t +work). If you are mirroring CPAN to your local workstation, specify a +file: URL. + +You can enter the number in front of the URL on the next screen, a +file:, ftp: or http: URL, or "q" to finish selecting. + +}; + + $ans = prompt("Press RETURN to continue"); + my $other; + $ans = $other = ""; + my(%seen); + + while () { + my $pipe = -t *STDIN ? "| $CPAN::Config->{'pager'}" : ">/dev/null"; + my(@valid,$previous_best); + open FH, $pipe; + { + my($cont,$country,$url,$item); + my(@cont) = sort keys %all; + for $cont (@cont) { + print FH " $cont\n"; + for $country (sort {lc $a cmp lc $b} keys %{$all{$cont}}) { + for $url (sort {lc $a cmp lc $b} keys %{$all{$cont}{$country}}) { + my $t = sprintf( + " %-18s (%2d) %s\n", + $country, + ++$item, + $url + ); + if ($cont =~ /^\[/) { + $previous_best ||= $item; + } + push @valid, $all{$cont}{$country}{$url}; + print FH $t; + } + } + } + } + close FH; + $previous_best ||= 1; + $default = + @{$CPAN::Config->{urllist}} >= $expected_size ? "q" : $previous_best; + $ans = prompt( + "\nSelect an$other ftp or file URL or a number (q to finish)", + $default + ); + my $sel; + if ($ans =~ /^\d/) { + my $this = $valid[$ans-1]; + my($con,$cou,$url) = ($this->con,$this->cou,$this->url); + push @{$CPAN::Config->{urllist}}, $url unless $seen{$url}++; + delete $all{$con}{$cou}{$url}; + # print "Was a number [$ans] con[$con] cou[$cou] url[$url]\n"; + } elsif (@{$CPAN::Config->{urllist}} && $ans =~ /^q/i) { + last; + } else { + $ans =~ s|/?$|/|; # has to end with one slash + $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file: + if ($ans =~ /^\w+:\/./) { + push @{$CPAN::Config->{urllist}}, $ans unless $seen{$ans}++; + } else { + print qq{"$ans" doesn\'t look like an URL at first sight. +I\'ll ignore it for now. You can add it to lib/CPAN/Config.pm +later and report a bug in my Makefile.PL to me (andreas koenig). +Thanks.\n}; + } + } + $other ||= "other"; + } +} + +1; diff --git a/lib/CPAN/Nox.pm b/lib/CPAN/Nox.pm new file mode 100644 index 0000000000..b0b70fec04 --- /dev/null +++ b/lib/CPAN/Nox.pm @@ -0,0 +1,33 @@ +BEGIN{$CPAN::Suppress_readline++;} + +use CPAN; + +$CPAN::META->hasMD5(0); +$CPAN::META->hasLWP(0); +@EXPORT = @CPAN::EXPORT; + +*AUTOLOAD = \&CPAN::AUTOLOAD; + +=head1 NAME + +CPAN::Nox - Wrapper around CPAN.pm without using any XS module + +=head1 SYNOPSIS + +Interactive mode: + + perl -MCPAN::Nox -e shell; + +=head1 DESCRIPTION + +This package has the same functionality as CPAN.pm, but tries to +prevent the usage of compiled extensions during it's own +execution. It's primary purpose is a rescue in case you upgraded perl +and broke binary compatibility somehow. + +=head1 SEE ALSO + +CPAN(3) + +=cut + diff --git a/lib/Fatal.pm b/lib/Fatal.pm index 0d9c51b113..281474c336 100644 --- a/lib/Fatal.pm +++ b/lib/Fatal.pm @@ -43,7 +43,7 @@ sub _make_fatal { $code .= "\(\@_\) || croak \"Can't $name\(\@_\): \$!\";\n}\n"; print $code if $Debug; eval($code); - die($@) if $@; + die if $@; local($^W) = 0; # to avoid: Subroutine foo redefined ... no strict 'refs'; # to avoid: Can't use string (...) as a symbol ref ... *{$sub} = \&{"Fatal::$name"}; diff --git a/lib/File/Compare.pm b/lib/File/Compare.pm new file mode 100644 index 0000000000..e76c10fb5f --- /dev/null +++ b/lib/File/Compare.pm @@ -0,0 +1,136 @@ +package File::Compare; + +use strict; +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $Too_Big *FROM *TO); + +require Exporter; +use Carp; +use UNIVERSAL qw(isa); + +$VERSION = '1.1'; +@ISA = qw(Exporter); +@EXPORT = qw(compare); +@EXPORT_OK = qw(cmp); + +$Too_Big = 1024 * 1024 * 2; + +sub VERSION { + # Version of File::Compare + return $File::Compare::VERSION; +} + +sub compare { + croak("Usage: compare( file1, file2 [, buffersize]) ") + unless(@_ == 2 || @_ == 3); + + my $from = shift; + my $to = shift; + my $closefrom=0; + my $closeto=0; + my ($size, $status, $fr, $tr, $fbuf, $tbuf); + local(*FROM, *TO); + local($\) = ''; + + croak("from undefined") unless (defined $from); + croak("to undefined") unless (defined $to); + + if (ref($from) && (isa($from,'GLOB') || isa($from,'IO::Handle'))) { + *FROM = *$from; + } elsif (ref(\$from) eq 'GLOB') { + *FROM = $from; + } else { + open(FROM,"<$from") or goto fail_open1; + binmode FROM; + $closefrom = 1; + } + + if (ref($to) && (isa($to,'GLOB') || isa($to,'IO::Handle'))) { + *TO = *$to; + } elsif (ref(\$to) eq 'GLOB') { + *TO = $to; + } else { + open(TO,"<$to") or goto fail_open2; + binmode TO; + $closeto = 1; + } + + if (@_) { + $size = shift(@_) + 0; + croak("Bad buffer size for compare: $size\n") unless ($size > 0); + } else { + $size = -s FROM; + $size = 1024 if ($size < 512); + $size = $Too_Big if ($size > $Too_Big); + } + + $fbuf = ''; + $tbuf = ''; + while(defined($fr = read(FROM,$fbuf,$size)) && $fr > 0) { + unless (defined($tr = read(TO,$tbuf,$fr)) and $tbuf eq $fbuf) { + goto fail_inner; + } + } + goto fail_inner if (defined($tr = read(TO,$tbuf,$size)) && $tr > 0); + + close(TO) || goto fail_open2 if $closeto; + close(FROM) || goto fail_open1 if $closefrom; + + return 0; + + # All of these contortions try to preserve error messages... + fail_inner: + close(TO) || goto fail_open2 if $closeto; + close(FROM) || goto fail_open1 if $closefrom; + + return 1; + + fail_open2: + if ($closefrom) { + $status = $!; + $! = 0; + close FROM; + $! = $status unless $!; + } + fail_open1: + return -1; +} + +*cmp = \&compare; + +1; + +__END__ + +=head1 NAME + +File::Compare - Compare files or filehandles + +=head1 SYNOPSIS + + use File::Compare; + + if (compare("file1","file2") == 0) { + print "They're equal\n"; + } + +=head1 DESCRIPTION + +The File::Compare::compare function compares the contents of two +sources, each of which can be a file or a file handle. It is exported +from File::Compare by default. + +File::Compare::cmp is a synonym for File::Compare::compare. It is +exported from File::Compare only by request. + +=head1 RETURN + +File::Compare::compare return 0 if the files are equal, 1 if the +files are unequal, or -1 if an error was encountered. + +=head1 AUTHOR + +File::Compare was written by Nick Ing-Simmons. +Its original documentation was written by Chip Salzenberg. + +=cut + diff --git a/lib/FileHandle.pm b/lib/FileHandle.pm index b215147590..e2ce83d44a 100644 --- a/lib/FileHandle.pm +++ b/lib/FileHandle.pm @@ -1,6 +1,6 @@ package FileHandle; -require 5.003; +use 5.003_11; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); @@ -39,6 +39,24 @@ require IO::File; import IO::Handle grep { !defined(&$_) } @EXPORT, @EXPORT_OK; # +# Some people call "FileHandle::function", so all the functions +# that were in the old FileHandle class must be imported, too. +# +{ + no strict 'refs'; + for my $f (qw(DESTROY new_from_fd fdopen close fileno getc ungetc gets eof + setbuf setvbuf _open_mode_string)) { + *{$f} = \&{"IO::Handle::$f"} or die "$f missing"; + } + for my $f (qw(seek tell fgetpos fsetpos fflush ferror clearerr)) { + *{$f} = \&{"IO::Seekable::$f"} or die "$f missing"; + } + for my $f (qw(new new_tmpfile open)) { + *{$f} = \&{"IO::File::$f"} or die "$f missing"; + } +} + +# # Specialized importer for Fcntl magic. # sub import { diff --git a/lib/Getopt/Long.pm b/lib/Getopt/Long.pm index d684577f8d..4047bf1f59 100644 --- a/lib/Getopt/Long.pm +++ b/lib/Getopt/Long.pm @@ -1,11 +1,11 @@ # GetOpt::Long.pm -- POSIX compatible options parsing -# RCS Status : $Id: GetoptLong.pm,v 2.4 1996-10-02 11:16:26+02 jv Exp $ +# RCS Status : $Id: GetoptLong.pm,v 2.5 1996-10-19 16:47:51+02 jv Exp $ # Author : Johan Vromans # Created On : Tue Sep 11 15:00:12 1990 # Last Modified By: Johan Vromans -# Last Modified On: Wed Oct 2 11:13:12 1996 -# Update Count : 500 +# Last Modified On: Sat Oct 19 16:46:23 1996 +# Update Count : 504 # Status : Released package Getopt::Long; @@ -14,7 +14,7 @@ require Exporter; @ISA = qw(Exporter); @EXPORT = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER); -$VERSION = sprintf("%d.%02d", '$Revision: 2.4 $ ' =~ /(\d+)\.(\d+)/); +$VERSION = sprintf("%d.%02d", '$Revision: 2.5 $ ' =~ /(\d+)\.(\d+)/); use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order $passthrough $error $debug $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER @@ -86,7 +86,7 @@ followed by an argument specifier. Values for argument specifiers are: =over 8 -=item <none> +=item E<lt>noneE<gt> Option does not take an argument. The option variable will be set to 1. @@ -225,7 +225,7 @@ The option name is always the true name, not an abbreviation or alias. The option name may actually be a list of option names, separated by "|"s, e.g. "foo|bar|blech=s". In this example, "foo" is the true name -op this option. If no linkage is specified, options "foo", "bar" and +of this option. If no linkage is specified, options "foo", "bar" and "blech" all will set $opt_foo. Option names may be abbreviated to uniqueness, depending on @@ -233,7 +233,7 @@ configuration variable $Getopt::Long::autoabbrev. =head2 Non-option call-back routine -A special option specifier, <>, can be used to designate a subroutine +A special option specifier, E<lt>E<gt>, can be used to designate a subroutine to handle non-option arguments. GetOptions will immediately call this subroutine for every non-option it encounters in the options list. This subroutine gets the name of the non-option passed. @@ -316,11 +316,11 @@ Example of using variable references: With command line options "-foo blech -bar 24 -ar xx -ar yy" this will result in: - $bar = 'blech' + $foo = 'blech' $opt_bar = 24 @ar = ('xx','yy') -Example of using the <> option specifier: +Example of using the E<lt>E<gt> option specifier: @ARGV = qw(-foo 1 bar -foo 2 blech); &GetOptions("foo=i", \$myfoo, "<>", \&mysub); @@ -530,7 +530,7 @@ sub GetOptions { # than once in differing environments $error = 0; - print STDERR ('GetOptions $Revision: 2.4 $ ', + print STDERR ('GetOptions $Revision: 2.5 $ ', "[GetOpt::Long $Getopt::Long::VERSION] -- ", "called from package \"$pkg\".\n", " (@ARGV)\n", diff --git a/lib/Net/FTP.pm b/lib/Net/FTP.pm new file mode 100644 index 0000000000..64b21fe751 --- /dev/null +++ b/lib/Net/FTP.pm @@ -0,0 +1,943 @@ +;# Net::FTP.pm +;# +;# Copyright (c) 1995 Graham Barr <Graham.Barr@tiuk.ti.com>. All rights +;# reserved. This program is free software; you can redistribute it and/or +;# modify it under the same terms as Perl itself. + +;#Notes +;# should I have a dataconn::close sub which calls response ?? +;# FTP should hold state reguarding cmds sent +;# A::read needs some more thought +;# A::write What is previous pkt ended in \r or not ?? +;# need to do some heavy tidy-ing up !!!! +;# need some documentation + +package Net::FTP; + +=head1 NAME + +Net::FTP - FTP Client class + +=head1 SYNOPSIS + + require Net::FTP; + + $ftp = Net::FTP->new("some.host.name"); + $ftp->login("anonymous","me@here.there"); + $ftp->cwd("/pub"); + $ftp->get("that.file"); + $ftp->quit; + +=head1 DESCRIPTION + +C<Net::FTP> is a class implementing a simple FTP client in Perl as described +in RFC959 + +=head2 TO BE CONTINUED ... + +=cut + +require 5.001; +use Socket 1.3; +use Carp; +use Net::Socket; + +@ISA = qw(Net::Socket); + +$VERSION = sprintf("%d.%02d", q$Revision: 1.18 $ =~ /(\d+)\.(\d+)/); +sub Version { $VERSION } + +use strict; + +=head1 METHODS + +All methods return 0 or undef upon failure + +=head2 * new($host [, option => value [,...]] ) + +Constructor for the FTP client. It will create the connection to the +remote host. Possible options are: + + Port => port to use for FTP connection + Timeout => set timeout value (defaults to 120) + Debug => debug level + +=cut + +sub FTP_READY { 0 } # Ready +sub FTP_RESPONSE { 1 } # Waiting for a response +sub FTP_XFER { 2 } # Doing data xfer + +sub new { + my $pkg = shift; + my $host = shift; + my %arg = @_; + my $me = bless Net::Socket->new(Peer => $host, + Service => 'ftp', + Port => $arg{Port} || 'ftp' + ), $pkg; + + ${*$me} = ""; # partial response text + @{*$me} = (); # Last response text + + %{*$me} = (%{*$me}, # Copy current values + Code => 0, # Last response code + Type => 'A', # Ascii/Binary/etc mode + Timeout => $arg{Timeout} || 120, # Timeout value + Debug => $arg{Debug} || 0, # Output debug information + FtpHost => $host, # Remote hostname + State => FTP_RESPONSE, # Current state + + ############################################################## + # Other elements used during the lifetime of the object are + # + # LISTEN Listen socket + # DATA Data socket + ); + + $me->autoflush(1); + + $me->debug($arg{Debug}) + if(exists $arg{Debug}); + + unless(2 == $me->response()) + { + $me->close(); + undef $me; + } + + $me; +} + +## +## User interface methods +## + +=head2 * debug( $value ) + +Set the level of debug information for this object. If no argument is given +then the current state is returned. Otherwise the state is changed to +C<$value>and the previous state returned. + +=cut + +sub debug { + my $me = shift; + my $debug = ${*$me}{Debug}; + + if(@_) + { + ${*$me}{Debug} = 0 + shift; + + printf STDERR "\n$me VERSION %s\n", $Net::FTP::VERSION + if(${*$me}{Debug}); + } + + $debug; +} + +=head2 quit + +Send the QUIT command to the remote FTP server and close the socket connection. + +=cut + +sub quit { + my $me = shift; + + return undef + unless $me->QUIT; + + close($me); + + return 1; +} + +=head2 ascii/ebcdic/binary/byte + +Put the remote FTP server ant the FTP package into the given mode +of data transfer. + +=cut + +sub ascii { shift->type('A',@_); } +sub ebcdic { shift->type('E',@_); } +sub binary { shift->type('I',@_); } +sub byte { shift->type('L',@_); } + +# Allow the user to send a command directly, BE CAREFUL !! + +sub quot { + my $me = shift; + my $cmd = shift; + + $me->send_cmd( uc $cmd, @_); + + $me->response(); +} + +=head2 login([$login [, $password [, $account]]]) + +Log into the remote FTP server with the given login information. If +no arguments are given then the users $HOME/.netrc file is searched +for the remote server's hostname. If no information is found then +a login of I<anonymous> is used. If no password is given and the login +is anonymous then the users Email address will be used for a password + +=cut + +sub login { + my $me = shift; + my $user = shift; + my $pass = shift if(defined $user); + my $acct = shift if(defined $pass); + my $ok; + + unless(defined $user) + { + require Net::Netrc; + my $rc = Net::Netrc->lookup(${*$me}{FtpHost}); + + ($user,$pass,$acct) = $rc->lpa() + if $rc; + } + + $user = "anonymous" + unless defined $user; + + $pass = "-" . (getpwuid($>))[0] . "@" + if !defined $pass && $user eq "anonymous"; + + $ok = $me->USER($user); + + $ok = $me->PASS($pass) + if $ok == 3; + + $ok = $me->ACCT($acct || "") + if $ok == 3; + + $ok == 2; +} + +=head2 authorise($auth, $resp) + +This is a protocol used by some firewall ftp proxies. It is used +to authorise the user to send data out. + +=cut + +sub authorise { + my($me,$auth,$resp) = @_; + my $ok; + + carp "Net::FTP::authorise <auth> <resp>\n" + unless defined $auth && defined $resp; + + $ok = $me->AUTH($auth); + + $ok = $me->RESP($resp) + if $ok == 3; + + $ok == 2; +} + +=head2 rename( $oldname, $newname) + +Rename a file on the remote FTP server from C<$oldname> to C<$newname> + +=cut + +sub rename { + my($me,$from,$to) = @_; + + croak "Net::FTP:rename <from> <to>\n" + unless defined $from && defined $to; + + $me->RNFR($from) and $me->RNTO($to); +} + +sub type { + my $me = shift; + my $type = shift; + my $ok = 0; + + return ${*$me}{Type} + unless defined $type; + + return undef + unless($me->TYPE($type,@_)); + + ${*$me}{Type} = join(" ",$type,@_); +} + +sub abort { + my $me = shift; + + ${*$me}{DATA}->abort() + if defined ${*$me}{DATA}; +} + +sub get { + my $me = shift; + my $remote = shift; + my $local = shift; + my $where = shift || 0; + my($loc,$len,$buf,$resp,$localfd,$data); + local *FD; + + $localfd = ref($local) ? fileno($local) + : 0; + + ($local = $remote) =~ s#^.*/## unless(defined $local); + + if($localfd) + { + $loc = $local; + } + else + { + $loc = \*FD; + + unless(($where) ? open($loc,">>$local") : open($loc,">$local")) + { + carp "Cannot open Local file $local: $!\n"; + return undef; + } + } + + if ($where) { + $data = $me->rest_cmd($where,$remote) or + return undef; + } + else { + $data = $me->retr($remote) or + return undef; + } + + $buf = ''; + + do + { + $len = $data->read($buf,1024); + } + while($len > 0 && syswrite($loc,$buf,$len) == $len); + + close($loc) + unless $localfd; + + $data->close() == 2; # implied $me->response +} + +sub cwd { + my $me = shift; + my $dir = shift || "/"; + + return $dir eq ".." ? $me->CDUP() + : $me->CWD($dir); +} + +sub pwd { + my $me = shift; + + $me->PWD() ? ($me->message =~ /\"([^\"]+)/)[0] + : undef; +} + +sub put { shift->send("stor",@_) } +sub put_unique { shift->send("stou",@_) } +sub append { shift->send("appe",@_) } + +sub nlst { shift->data_cmd("NLST",@_) } +sub list { shift->data_cmd("LIST",@_) } +sub retr { shift->data_cmd("RETR",@_) } +sub stor { shift->data_cmd("STOR",@_) } +sub stou { shift->data_cmd("STOU",@_) } +sub appe { shift->data_cmd("APPE",@_) } + +sub send { + my $me = shift; + my $cmd = shift; + my $local = shift; + my $remote = shift; + my($loc,$sock,$len,$buf,$localfd); + local *FD; + + $localfd = ref($local) ? fileno($local) + : 0; + + unless(defined $remote) + { + croak "Must specify remote filename with stream input\n" + if $localfd; + + ($remote = $local) =~ s%.*/%%; + } + + if($localfd) + { + $loc = $local; + } + else + { + $loc = \*FD; + + unless(open($loc,"<$local")) + { + carp "Cannot open Local file $local: $!\n"; + return undef; + } + } + + $cmd = lc $cmd; + + $sock = $me->$cmd($remote) or + return undef; + + do + { + $len = sysread($loc,$buf,1024); + } + while($len && $sock->write($buf,$len) == $len); + + close($loc) + unless $localfd; + + $sock->close(); + + ($remote) = $me->message =~ /unique file name:\s*(\S*)\s*\)/ + if $cmd eq 'stou' ; + + return $remote; +} + +sub port { + my $me = shift; + my $port = shift; + my $ok; + + unless(defined $port) + { + my $listen; + + if(defined ${*$me}{LISTEN}) + { + ${*$me}{LISTEN}->close(); + delete ${*$me}{LISTEN}; + } + + # create a Listen socket at same address as the command socket + + $listen = Net::Socket->new(Listen => 5, + Service => 'ftp', + Addr => $me->sockhost, + ); + + ${*$me}{LISTEN} = $listen; + + my($myport, @myaddr) = ($listen->sockport, split(/\./,$listen->sockhost)); + + $port = join(',', @myaddr, $myport >> 8, $myport & 0xff); + } + + $ok = $me->PORT($port); + + ${*$me}{Port} = $port; + + $ok; +} + +sub ls { shift->list_cmd("NLST",@_); } +sub lsl { shift->list_cmd("LIST",@_); } + +sub pasv { + my $me = shift; + my $hostport; + + return undef + unless $me->PASV(); + + ($hostport) = $me->message =~ /(\d+(,\d+)+)/; + + ${*$me}{Pasv} = $hostport; +} + +## +## Communication methods +## + +sub timeout { + my $me = shift; + my $timeout = ${*$me}{Timeout}; + + ${*$me}{Timeout} = 0 + shift if(@_); + + $timeout; +} + +sub accept { + my $me = shift; + + return undef unless defined ${*$me}{LISTEN}; + + my $data = ${*$me}{LISTEN}->accept; + + ${*$me}{LISTEN}->close(); + delete ${*$me}{LISTEN}; + + ${*$data}{Timeout} = ${*$me}{Timeout}; + ${*$data}{Cmd} = $me; + ${*$data} = ""; + + ${*$me}{State} = FTP_XFER; + ${*$me}{DATA} = bless $data, "Net::FTP::" . ${*$me}{Type}; +} + +sub message { + my $me = shift; + join("\n", @{*$me}); +} + +sub ok { + my $me = shift; + my $code = ${*$me}{Code} || 0; + + 0 < $code && $code < 400; +} + +sub code { + my $me = shift; + + ${*$me}{Code}; +} + +sub list_cmd { + my $me = shift; + my $cmd = lc shift; + my $data = $me->$cmd(@_); + + return undef + unless(defined $data); + + bless $data, "Net::FTP::A"; # Force ASCII mode + + my $databuf = ''; + my $buf = ''; + + while($data->read($databuf,1024)) { + $buf .= $databuf; + } + + my $list = [ split(/\n/,$buf) ]; + + $data->close(); + + wantarray ? @{$list} : $list; +} + +sub data_cmd { + my $me = shift; + my $cmd = uc shift; + my $ok = 1; + my $pasv = defined ${*$me}{Pasv} ? 1 : 0; + + $ok = $me->port + unless $pasv || defined ${*$me}{Port}; + + $ok = $me->$cmd(@_) + if $ok; + + return $pasv ? $ok + : $ok ? $me->accept() + : undef; +} + +sub rest_cmd { + my $me = shift; + my $ok = 1; + my $pasv = defined ${*$me}{Pasv} ? 1 : 0; + my $where = shift; + my $file = shift; + + $ok = $me->port + unless $pasv || defined ${*$me}{Port}; + + $ok = $me->REST($where) + if $ok; + + $ok = $me->RETR($file) + if $ok; + + return $pasv ? $ok + : $ok ? $me->accept() + : undef; +} + +sub cmd { + my $me = shift; + + $me->send_cmd(@_); + $me->response(); +} + +sub send_cmd { + my $me = shift; + + if(scalar(@_)) { + my $cmd = join(" ", @_) . "\r\n"; + + delete ${*$me}{Pasv}; + delete ${*$me}{Port}; + + syswrite($me,$cmd,length $cmd); + + ${*$me}{State} = FTP_RESPONSE; + + printf STDERR "\n$me>> %s", $cmd=~/^(pass|resp)/i ? "$1 ....\n" : $cmd + if $me->debug; + } + + $me; +} + +sub pasv_wait { + my $me = shift; + my $non_pasv = shift; + my $file; + + my($rin,$rout); + vec($rin,fileno($me),1) = 1; + select($rout=$rin, undef, undef, undef); + + $me->response(); + $non_pasv->response(); + + return undef + unless $me->ok() && $non_pasv->ok(); + + return $1 + if $me->message =~ /unique file name:\s*(\S*)\s*\)/; + + return $1 + if $non_pasv->message =~ /unique file name:\s*(\S*)\s*\)/; + + return 1; +} + +sub response { + my $me = shift; + my $timeout = ${*$me}{Timeout}; + my($code,$more,$rin,$rout,$partial,$buf) = (undef,0,'','','',''); + + @{*$me} = (); # the responce + $buf = ${*$me}; + my @buf = (); + + vec($rin,fileno($me),1) = 1; + + do + { + if(length($buf) || ($timeout==0) || select($rout=$rin, undef, undef, $timeout)) + { + unless(length($buf) || sysread($me, $buf, 1024)) + { + carp "Unexpected EOF on command channel"; + return undef; + } + + substr($buf,0,0) = $partial; ## prepend from last sysread + + @buf = split(/\r?\n/, $buf); ## break into lines + + $partial = (substr($buf, -1, 1) eq "\n") ? '' + : pop(@buf); + + $buf = ""; + + while (@buf) + { + my $cmd = shift @buf; + print STDERR "$me<< $cmd\n" + if $me->debug; + + ($code,$more) = ($1,$2) + if $cmd =~ /^(\d\d\d)(.)/; + + push(@{*$me},$'); + + last unless(defined $more && $more eq "-"); + } + } + else + { + carp "$me: Timeout" if($me->debug); + return undef; + } + } + while((scalar(@{*$me}) == 0) || (defined $more && $more eq "-")); + + ${*$me} = @buf ? join("\n",@buf,"") : ""; + ${*$me} .= $partial; + + ${*$me}{Code} = $code; + ${*$me}{State} = FTP_READY; + + substr($code,0,1); +} + +;######################################## +;# +;# RFC959 commands +;# + +sub no_imp { croak "Not implemented\n"; } + +sub ABOR { shift->send_cmd("ABOR")->response() == 2} +sub CDUP { shift->send_cmd("CDUP")->response() == 2} +sub NOOP { shift->send_cmd("NOOP")->response() == 2} +sub PASV { shift->send_cmd("PASV")->response() == 2} +sub QUIT { shift->send_cmd("QUIT")->response() == 2} +sub DELE { shift->send_cmd("DELE",@_)->response() == 2} +sub CWD { shift->send_cmd("CWD", @_)->response() == 2} +sub PORT { shift->send_cmd("PORT",@_)->response() == 2} +sub RMD { shift->send_cmd("RMD", @_)->response() == 2} +sub MKD { shift->send_cmd("MKD", @_)->response() == 2} +sub PWD { shift->send_cmd("PWD", @_)->response() == 2} +sub TYPE { shift->send_cmd("TYPE",@_)->response() == 2} +sub APPE { shift->send_cmd("APPE",@_)->response() == 1} +sub LIST { shift->send_cmd("LIST",@_)->response() == 1} +sub NLST { shift->send_cmd("NLST",@_)->response() == 1} +sub RETR { shift->send_cmd("RETR",@_)->response() == 1} +sub STOR { shift->send_cmd("STOR",@_)->response() == 1} +sub STOU { shift->send_cmd("STOU",@_)->response() == 1} +sub RNFR { shift->send_cmd("RNFR",@_)->response() == 3} +sub RNTO { shift->send_cmd("RNTO",@_)->response() == 2} +sub ACCT { shift->send_cmd("ACCT",@_)->response() == 2} +sub RESP { shift->send_cmd("RESP",@_)->response() == 2} +sub REST { shift->send_cmd("REST",@_)->response() == 3} +sub USER { my $ok = shift->send_cmd("USER",@_)->response();($ok == 2 || $ok == 3) ? $ok : 0;} +sub PASS { my $ok = shift->send_cmd("PASS",@_)->response();($ok == 2 || $ok == 3) ? $ok : 0;} +sub AUTH { my $ok = shift->send_cmd("AUTH",@_)->response();($ok == 2 || $ok == 3) ? $ok : 0;} + +sub ALLO { no_imp; } +sub SMNT { no_imp; } +sub HELP { no_imp; } +sub MODE { no_imp; } +sub SITE { no_imp; } +sub SYST { no_imp; } +sub STAT { no_imp; } +sub STRU { no_imp; } +sub REIN { no_imp; } + +package Net::FTP::dataconn; +use Carp; +no strict 'vars'; + +sub abort { + my $fd = shift; + my $ftp = ${*$fd}{Cmd}; + + $ftp->send_cmd("ABOR"); + $fd->close(); +} + +sub close { + my $fd = shift; + my $ftp = ${*$fd}{Cmd}; + + $fd->Net::Socket::close(); + delete ${*$ftp}{DATA}; + + $ftp->response(); +} + +sub timeout { + my $me = shift; + my $timeout = ${*$me}{Timeout}; + + ${*$me}{Timeout} = 0 + shift if(@_); + + $timeout; +} + +sub _select { + my $fd = shift; + local *timeout = \$_[0]; shift; + my $rw = shift; + my($rin,$win); + + return 1 unless $timeout; + + $rin = ''; + vec($rin,fileno($fd),1) = 1; + + $win = $rw ? undef : $rin; + $rin = undef unless $rw; + + my $nfound = select($rin, $win, undef, $timeout); + + croak "select: $!" + if $nfound < 0; + + return $nfound; +} + +sub can_read { + my $fd = shift; + local *timeout = \$_[0]; + + $fd->_select($timeout,1); +} + +sub can_write { + my $fd = shift; + local *timeout = \$_[0]; + + $fd->_select($timeout,0); +} + +sub cmd { + my $me = shift; + + ${*$me}{Cmd}; +} + + +@Net::FTP::L::ISA = qw(Net::FTP::I); +@Net::FTP::E::ISA = qw(Net::FTP::I); + +package Net::FTP::A; +@Net::FTP::A::ISA = qw(Net::FTP::dataconn); +use Carp; + +no strict 'vars'; + +sub read { + my $fd = shift; + local *buf = \$_[0]; shift; + my $size = shift || croak 'read($buf,$size,[$offset])'; + my $offset = shift || 0; + my $timeout = ${*$fd}{Timeout}; + my $l; + + croak "Bad offset" + if($offset < 0); + + $offset = length $buf + if($offset > length $buf); + + $l = 0; + READ: + { + $fd->can_read($timeout) or + croak "Timeout"; + + my $n = sysread($fd, ${*$fd}, $size, length ${*$fd}); + + return $n + unless($n >= 0); + +# my $lf = substr(${*$fd},-1,1) eq "\r" ? chop(${*$fd}) +# : ""; + + my $lf = (length ${*$fd} > 0 && substr(${*$fd},-1,1) eq "\r") ? chop(${*$fd}) + : ""; + + ${*$fd} =~ s/\r\n/\n/go; + + substr($buf,$offset) = ${*$fd}; + + $l += length(${*$fd}); + $offset += length(${*$fd}); + + ${*$fd} = $lf; + + redo READ + if($l == 0 && $n > 0); + + if($n == 0 && $l == 0) + { + substr($buf,$offset) = ${*$fd}; + ${*$fd} = ""; + } + } + + return $l; +} + +sub write { + my $fd = shift; + local *buf = \$_[0]; shift; + my $size = shift || croak 'write($buf,$size,[$timeout])'; + my $timeout = @_ ? shift : ${*$fd}{Timeout}; + + $fd->can_write($timeout) or + croak "Timeout"; + + # What is previous pkt ended in \r or not ?? + + my $tmp; + ($tmp = $buf) =~ s/(?!\r)\n/\r\n/g; + + my $len = $size + length($tmp) - length($buf); + my $wrote = syswrite($fd, $tmp, $len); + + if($wrote >= 0) + { + $wrote = $wrote == $len ? $size + : $len - $wrote + } + + return $wrote; +} + +package Net::FTP::I; +@Net::FTP::I::ISA = qw(Net::FTP::dataconn); +use Carp; + +no strict 'vars'; + +sub read { + my $fd = shift; + local *buf = \$_[0]; shift; + my $size = shift || croak 'read($buf,$size,[$timeout])'; + my $timeout = @_ ? shift : ${*$fd}{Timeout}; + + $fd->can_read($timeout) or + croak "Timeout"; + + my $n = sysread($fd, $buf, $size); + + $n; +} + +sub write { + my $fd = shift; + local *buf = \$_[0]; shift; + my $size = shift || croak 'write($buf,$size,[$timeout])'; + my $timeout = @_ ? shift : ${*$fd}{Timeout}; + + $fd->can_write($timeout) or + croak "Timeout"; + + syswrite($fd, $buf, $size); +} + +=head2 AUTHOR + +Graham Barr <Graham.Barr@tiuk.ti.com> + +=head2 REVISION + +$Revision: 1.17 $ + +=head2 COPYRIGHT + +Copyright (c) 1995 Graham Barr. All rights reserved. This program is free +software; you can redistribute it and/or modify it under the same terms +as Perl itself. + +=cut + + +1; + diff --git a/lib/Net/Netrc.pm b/lib/Net/Netrc.pm new file mode 100644 index 0000000000..58f066363d --- /dev/null +++ b/lib/Net/Netrc.pm @@ -0,0 +1,123 @@ +package Net::Netrc; + +use Carp; +use strict; + +my %netrc = (); + +sub _readrc { + my $host = shift; + my $file = (getpwuid($>))[7] . "/.netrc"; + my($login,$pass,$acct) = (undef,undef,undef); + local *NETRC; + local $_; + + $netrc{default} = undef; + + my @stat = stat($file); + + if(@stat) + { + if($stat[2] & 077) + { + carp "Bad permissions: $file"; + return (); + } + if($stat[4] != $<) + { + carp "Not owner: $file"; + return (); + } + } + + if(open(NETRC,$file)) + { + my($mach,$macdef,$tok,@tok) = (0,0); + + while(<NETRC>) + { + undef $macdef if /\A\n\Z/; + + if($macdef) + { + push(@$macdef,$_); + next; + } + + push(@tok, split(/[\s\n]+/, $_)); + +TOKEN: + while(@tok) + { + if($tok[0] eq "default") + { + shift(@tok); + $mach = $netrc{default} = {}; + + next TOKEN; + } + + last TOKEN unless @tok > 1; + $tok = shift(@tok); + + if($tok eq "machine") + { + my $host = shift @tok; + $mach = $netrc{$host} = {}; + } + elsif($tok =~ /^(login|password|account)$/) + { + next TOKEN unless $mach; + my $value = shift @tok; + $mach->{$1} = $value; + } + elsif($tok eq "macdef") + { + next TOKEN unless $mach; + my $value = shift @tok; + $mach->{macdef} = {} unless exists $mach->{macdef}; + $macdef = $mach->{machdef}{$value} = []; + } + } + } + close(NETRC); + } +} + +sub lookup { + my $pkg = shift; + my $mach = shift; + + _readrc() unless exists $netrc{default}; + + return bless \$mach if exists $netrc{$mach}; + + return bless \("default") if defined $netrc{default}; + + return undef; +} + +sub login { + my $me = shift; + $me = $netrc{$$me}; + exists $me->{login} ? $me->{login} : undef; +} + +sub account { + my $me = shift; + $me = $netrc{$$me}; + exists $me->{account} ? $me->{account} : undef; +} + +sub password { + my $me = shift; + $me = $netrc{$$me}; + exists $me->{password} ? $me->{password} : undef; +} + +sub lpa { + my $me = shift; + ($me->login, $me->password, $me->account); +} + +1; diff --git a/lib/Net/Socket.pm b/lib/Net/Socket.pm new file mode 100644 index 0000000000..d24e625233 --- /dev/null +++ b/lib/Net/Socket.pm @@ -0,0 +1,332 @@ +package Net::Socket; + +=head1 NAME + +Net::Socket - TEMPORARY Socket filedescriptor class, so Net::FTP still +works while IO::Socket is having a re-fit <GBARR> + +=head1 DESCRIPTION + +NO TEXT --- THIS MODULE IS TEMPORARY + +=cut + +require 5.001; +use Socket 1.3; +use Carp; +require Exporter; + +@ISA = qw(Exporter); +@EXPORT_OK = @Socket::EXPORT; + +$VERSION = sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/); +sub Version { $VERSION } + +## +## Really WANT FileHandle::new to return this !!! +## +my $seq = 0; +sub _gensym { + my $pkg = @_ ? ref($_[0]) || $_[0] : ""; + local *{$pkg . "::GLOB" . ++$seq}; + \delete ${$pkg . "::"}{'GLOB' . $seq}; +} + +my %socket_type = ( + tcp => SOCK_STREAM, + udp => SOCK_DGRAM, + rpc => SOCK_DGRAM, +); + +# Peer => remote host name for a 'connect' socket +# Proto => specifiy protocol by it self (but override by Service) +# Service => require service eg 'ftp' or 'ftp/tcp', overrides Proto +# Port => port num for connect eg 'ftp' or 21, defaults to Service +# Bind => port to bind to, defaults to INADDR_ANY +# Listen => queue size for listen +# +# if Listen is defined then a listen socket is created, else if the socket +# type, which is derived from the protocol, is SOCK_STREAM then a connect +# is called + +=head2 new( %args ) + +The new constructor takes its arguments in the form of a hash. Accepted +arguments are + + Peer => remote host name for a 'connect' socket + Proto => specifiy protocol by it self (but override by Service) + Service => require service eg 'ftp' or 'ftp/tcp', overrides Proto + Port => port num for connect eg 'ftp' or 21, defaults to Service + Bind => port to bind to, defaults to INADDR_ANY + Listen => queue size for listen + +=cut + +sub new { + my $pkg = shift; + my %arg = @_; + + my $proto = $arg{Proto} || ""; + my $bindport = $arg{Bind} || 0; + my $servport = $arg{Port} || 0; + + my $service = $arg{Service} || $servport || $bindport; + + ($service,$proto) = split(m,/,, $service) + if $service =~ m,/,; + + my @serv = $service =~ /\D/ ? getservbyname($service,$proto) + : getservbyport($service,$proto); + + $proto = $proto || $serv[3]; + + croak "cannot determine protocol" + unless $proto; + + my @proto = $proto =~ /\D/ ? getprotobyname($proto) + : getprotobynumber($proto); + + croak "unknown protocol" + unless @proto; + + my $type = $arg{Type} || $socket_type{$proto[0]} or + croak "Unknown socket type"; + + my $bindaddr = exists $arg{Addr} ? inet_aton($arg{Addr}) + : INADDR_ANY; + + croak "bad bind address $arg{Addr}" + unless $bindaddr; + + my $sock = bless _gensym(), ref($pkg) || $pkg; + + socket($sock, AF_INET, $type, $proto[2]) or + croak "socket: $!"; + + $bindport = (getservbyname($bindport,$proto))[2] + if $bindport =~ /\D/; + + bind($sock, sockaddr_in($bindport, $bindaddr)) or + croak "bind: $!"; + + if(defined $arg{Listen}) + { + my $queue = $arg{Listen} || 1; + + listen($sock, $queue) or + croak "listen: $!"; + } + else + { + $servport = $serv[2] || 0 + unless $servport =~ /^\d+$/ && $servport > 0; + + croak "cannot determine port" + unless($servport); + + my $destaddr = defined $arg{Peer} ? inet_aton($arg{Peer}) + : undef; + + my $peername = defined $destaddr ? sockaddr_in($servport,$destaddr) + : undef; + + + if($type == SOCK_STREAM || $destaddr) + { + croak "bad peer address" + unless defined $destaddr; + + connect($sock, $peername) or + croak "connect: $!"; + + ${*$sock}{Peername} = getpeername($sock); + } + else + { + ${*$sock}{Peername} = $peername; + } + } + + ${*$sock}{Sockname} = getsockname($sock); + + $sock; +} + +=head2 autoflush( [$val] ) + +Set the file descriptor to autoflush, depending on C<$val> + +=cut + +sub autoflush { + my $sock = shift; + my $val = @_ ? shift : 0; + + select((select($sock), $| = $val)[$[]); +} + +=head2 accept + +perform the system call C<accept> on the socket and return a new Net::Socket +object. This object can be used to communicate with the client that was trying +to connect. + +=cut + +sub accept { + my $sock = shift; + + my $new = bless _gensym(); + + accept($new,$sock) or + croak "accept: $!"; + + ${*$new}{Peername} = getpeername($new) or + croak "getpeername: $!"; + + ${*$new}{Sockname} = getsockname($new) or + croak "getsockname: $!"; + + $new; +} + +=head2 close + +Close the file descriptor + +=cut + +sub close { + my $sock = shift; + + delete ${*$sock}{Sockname}; + delete ${*$sock}{Peername}; + + close($sock); +} + +=head2 dup + +Create a duplicate of the socket object + +=cut + +sub dup { + my $sock = shift; + my $dup = bless _gensym(), ref($sock); + + if(open($dup,">&" . fileno($sock))) { + # Copy all the internals + ${*$dup} = ${*$sock}; + @{*$dup} = @{*$sock}; + %{*$dup} = %{*$sock}; + } + else { + undef $dup; + } + + $dup; +} + +# Some info about the local socket + +=head2 sockname + +Return a packed sockaddr structure for the socket + +=head2 sockaddr + +Return the address part of the sockaddr structure for the socket + +=head2 sockport + +Return the port number that the socket is using on the local host + +=head2 sockhost + +Return the address part of the sockaddr structure for the socket in a +text form xx.xx.xx.xx + +=cut + +sub sockname { my $sock = shift; ${*$sock}{Sockname} } +sub sockaddr { (sockaddr_in(shift->sockname))[1]} +sub sockport { (sockaddr_in(shift->sockname))[0]} +sub sockhost { inet_ntoa( shift->sockaddr);} + +# Some info about the remote socket, for connect-d sockets + +=head2 peername, peeraddr, peerport, peerhost + +Same as for the sock* functions, but returns the data about the peer +host instead of the local host. + +=cut + +sub peername { my $sock = shift; ${*$sock}{Peername} or croak "no peer" } +sub peeraddr { (sockaddr_in(shift->peername))[1]} +sub peerport { (sockaddr_in(shift->peername))[0]} +sub peerhost { inet_ntoa( shift->peeraddr);} + +=head2 send( $buf [, $flags [, $to]] ) + +For a udp socket, send the contents of C<$buf> to the remote host C<$to> using +flags C<$flags>. + +If C<$to> is not specified then the data is sent to the host which the socket +last communicated with, ie sent to or recieved from. + +If C<$flags> is ommited then 0 is used + +=cut + +sub send { + my $sock = shift; + local *buf = \$_[0]; shift; + my $flags = shift || 0; + my $to = shift || $sock->peername; + + # remember who we send to + ${*$sock}{Peername} = $to; + + send($sock, $buf, $flags, $to); +} + +=head2 recv( $buf, $len [, $flags] ) + +Receive C<$len> bytes of data from the socket and place into C<$buf> + +If C<$flags> is ommited then 0 is used + +=cut + +sub recv { + my $sock = shift; + local *buf = \$_[0]; shift; + my $len = shift; + my $flags = shift || 0; + + # remember who we recv'd from + ${*$sock}{Peername} = recv($sock, $buf='', $len, $flags); +} + +=head1 AUTHOR + +Graham Barr <Graham.Barr@tiuk.ti.com> + +=head1 REVISION + +$Revision: 1.2 $ + +=head1 COPYRIGHT + +Copyright (c) 1995 Graham Barr. All rights reserved. This program is free +software; you can redistribute it and/or modify it under the same terms +as Perl itself. + +=cut + +1; # Keep require happy + + diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm index 5d7d8bfef0..cca05b7291 100644 --- a/lib/Test/Harness.pm +++ b/lib/Test/Harness.pm @@ -1,6 +1,7 @@ package Test::Harness; -use 5.002; +require 5.002; + use Exporter; use Benchmark; use Config; diff --git a/lib/Tie/RefHash.pm b/lib/Tie/RefHash.pm new file mode 100644 index 0000000000..66de2572fc --- /dev/null +++ b/lib/Tie/RefHash.pm @@ -0,0 +1,123 @@ +package Tie::RefHash; + +=head1 NAME + +Tie::RefHash - use references as hash keys + +=head1 SYNOPSIS + + require 5.004; + use Tie::RefHash; + tie HASHVARIABLE, 'Tie::RefHash', LIST; + + untie HASHVARIABLE; + +=head1 DESCRIPTION + +This module provides the ability to use references as hash keys if +you first C<tie> the hash variable to this module. + +It is implemented using the standard perl TIEHASH interface. Please +see the C<tie> entry in perlfunc(1) and perltie(1) for more information. + +=head1 EXAMPLE + + use Tie::RefHash; + tie %h, 'Tie::RefHash'; + $a = []; + $b = {}; + $c = \*main; + $d = \"gunk"; + $e = sub { 'foo' }; + %h = ($a => 1, $b => 2, $c => 3, $d => 4, $e => 5); + $a->[0] = 'foo'; + $b->{foo} = 'bar'; + for (keys %h) { + print ref($_), "\n"; + } + + +=head1 AUTHOR + +Gurusamy Sarathy gsar@umich.edu + +=head1 VERSION + +Version 1.2 15 Dec 1996 + +=head1 SEE ALSO + +perl(1), perlfunc(1), perltie(1) + +=cut + +require 5.003_11; +use Tie::Hash; +@ISA = qw(Tie::Hash); +use strict; + +sub TIEHASH { + my $c = shift; + my $s = []; + bless $s, $c; + while (@_) { + $s->STORE(shift, shift); + } + return $s; +} + +sub FETCH { + my($s, $k) = @_; + (ref $k) ? $s->[0]{"$k"}[1] : $s->[1]{$k}; +} + +sub STORE { + my($s, $k, $v) = @_; + if (ref $k) { + $s->[0]{"$k"} = [$k, $v]; + } + else { + $s->[1]{$k} = $v; + } + $v; +} + +sub DELETE { + my($s, $k) = @_; + (ref $k) ? delete($s->[0]{"$k"}) : delete($s->[1]{$k}); +} + +sub EXISTS { + my($s, $k) = @_; + (ref $k) ? exists($s->[0]{"$k"}) : exists($s->[1]{$k}); +} + +sub FIRSTKEY { + my $s = shift; + my $a = scalar(keys %{$s->[0]}) + scalar(keys %{$s->[1]}); + $s->[2] = 0; + $s->NEXTKEY; +} + +sub NEXTKEY { + my $s = shift; + my ($k, $v); + if (!$s->[2]) { + if (($k, $v) = each %{$s->[0]}) { + return $s->[0]{"$k"}[0]; + } + else { + $s->[2] = 1; + } + } + return each %{$s->[1]}; +} + +sub CLEAR { + my $s = shift; + $s->[2] = 0; + %{$s->[0]} = (); + %{$s->[1]} = (); +} + +1; diff --git a/lib/blib.pm b/lib/blib.pm index 4d8f609b52..8af1727d8f 100644 --- a/lib/blib.pm +++ b/lib/blib.pm @@ -38,7 +38,6 @@ Nick Ing-Simmons nik@tiuk.ti.com use Cwd; -warn __FILE__; sub import { @@ -60,7 +59,7 @@ sub import if (-d $blib && -d "$blib/arch" && -d "$blib/lib") { unshift(@INC,"$blib/arch","$blib/lib"); - warn "Using $blib"; + warn "Using $blib\n"; return; } $dir .= "/.."; diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm index c3e5b93f20..31e7670b82 100755 --- a/lib/diagnostics.pm +++ b/lib/diagnostics.pm @@ -1,18 +1,4 @@ -#!/usr/local/bin/perl -eval 'exec perl -S $0 ${1+"$@"}' - if 0; - -use Config; -if ($^O eq 'VMS') { - $diagnostics::PODFILE = VMS::Filespec::unixify($Config{'privlibexp'}) . - '/pod/perldiag.pod'; -} -else { $diagnostics::PODFILE= $Config{privlibexp} . "/pod/perldiag.pod"; } - package diagnostics; -require 5.001; -use English; -use Carp; =head1 NAME @@ -176,6 +162,18 @@ Tom Christiansen F<E<lt>tchrist@mox.perl.comE<gt>>, 25 June 1995. =cut +require 5.001; +use English; +use Carp; + +use Config; +if ($^O eq 'VMS') { + $PODFILE = VMS::Filespec::unixify($Config{privlibexp}).'/pod/perldiag.pod'; +} +else { + $PODFILE = $Config{privlibexp} . "/pod/perldiag.pod"; +} + $DEBUG ||= 0; my $WHOAMI = ref bless []; # nobody's business, prolly not even mine diff --git a/makeaperl.SH b/makeaperl.SH index d621e67f03..16b74350e0 100755 --- a/makeaperl.SH +++ b/makeaperl.SH @@ -20,8 +20,8 @@ echo "Extracting makeaperl (with variable substitutions)" rm -f makeaperl $spitshell >makeaperl <<!GROK!THIS! $startperl - eval 'exec perl -S \$0 "\$@"' - if 0; + eval 'exec $perlpath -S \$0 \${1+"\$@"}' + if \$running_under_some_shell; !GROK!THIS! $spitshell >>makeaperl <<'!NO!SUBS!' @@ -130,11 +130,6 @@ static u_short blk_shift[11 - 3] = {256, 128, 64, 32, # define MAX_NONSHIFT 2 /* Shift 64 greater than chunk 32. */ }; -# ifdef DEBUGGING_MSTATS -static u_int sbrk_slack; -static u_int start_slack; -# endif - #else /* !PACK_MALLOC */ # define OV_MAGIC(block,bucket) (block)->ov_magic @@ -151,8 +146,12 @@ static u_int start_slack; #ifdef TWO_POT_OPTIMIZE -# define PERL_PAGESIZE 4096 -# define FIRST_BIG_TWO_POT 14 /* 16K */ +# ifndef PERL_PAGESIZE +# define PERL_PAGESIZE 4096 +# endif +# ifndef FIRST_BIG_TWO_POT +# define FIRST_BIG_TWO_POT 14 /* 16K */ +# endif # define FIRST_BIG_BLOCK (1<<FIRST_BIG_TWO_POT) /* 16K */ /* If this value or more, check against bigger blocks. */ # define FIRST_BIG_BOUND (FIRST_BIG_BLOCK - M_OVERHEAD) @@ -239,6 +238,9 @@ extern char *sbrk(); * for a given block size. */ static u_int nmalloc[NBUCKETS]; +static u_int goodsbrk; +static u_int sbrk_slack; +static u_int start_slack; #endif #ifdef DEBUGGING @@ -337,9 +339,6 @@ malloc(nbytes) #ifndef PACK_MALLOC OV_INDEX(p) = bucket; #endif -#ifdef DEBUGGING_MSTATS - nmalloc[bucket]++; -#endif #ifdef RCHECK /* * Record allocated size of block and @@ -386,7 +385,7 @@ morecore(bucket) if ((u_int)op & 0x3ff) (void)sbrk(slack = 1024 - ((u_int)op & 0x3ff)); # endif -# if defined(DEBUGGING_MSTATS) && defined(PACK_MALLOC) +# if defined(DEBUGGING_MSTATS) sbrk_slack += slack; # endif # else @@ -414,6 +413,9 @@ morecore(bucket) if (op == (union overhead *)-1) return; } +#ifdef DEBUGGING_MSTATS + goodsbrk += needed; +#endif /* * Round up to minimum allocation size boundary * and deduct from block count to reflect. @@ -450,6 +452,9 @@ morecore(bucket) } else op++; /* One chunk per block. */ #endif /* !PACK_MALLOC */ nextf[bucket] = op; +#ifdef DEBUGGING_MSTATS + nmalloc[bucket] += nblks; +#endif while (--nblks > 0) { op->ov_next = (union overhead *)((caddr_t)op + siz); op = (union overhead *)((caddr_t)op + siz); @@ -518,9 +523,6 @@ free(mp) size = OV_INDEX(op); op->ov_next = nextf[size]; nextf[size] = op; -#ifdef DEBUGGING_MSTATS - nmalloc[size]--; -#endif } /* @@ -705,7 +707,7 @@ dump_mstats(s) { register int i, j; register union overhead *p; - int topbucket=0, totfree=0, totused=0; + int topbucket=0, totfree=0, total=0; u_int nfree[NBUCKETS]; for (i=0; i < NBUCKETS; i++) { @@ -713,28 +715,23 @@ dump_mstats(s) ; nfree[i] = j; totfree += nfree[i] * (1 << (i + 3)); - totused += nmalloc[i] * (1 << (i + 3)); - if (nfree[i] || nmalloc[i]) + total += nmalloc[i] * (1 << (i + 3)); + if (nmalloc[i]) topbucket = i; } if (s) PerlIO_printf(PerlIO_stderr(), "Memory allocation statistics %s (buckets 8..%d)\n", s, (1 << (topbucket + 3)) ); - PerlIO_printf(PerlIO_stderr(), " %7d free: ", totfree); + PerlIO_printf(PerlIO_stderr(), "%8d free:", totfree); for (i=0; i <= topbucket; i++) { - PerlIO_printf(PerlIO_stderr(), (i<5)?" %5d":" %3d", nfree[i]); + PerlIO_printf(PerlIO_stderr(), (i<5 || i==7)?" %5d": (i<9)?" %3d":" %d", nfree[i]); } - PerlIO_printf(PerlIO_stderr(), "\n %7d used: ", totused); + PerlIO_printf(PerlIO_stderr(), "\n%8d used:", total - totfree); for (i=0; i <= topbucket; i++) { - PerlIO_printf(PerlIO_stderr(), (i<5)?" %5d":" %3d", nmalloc[i]); + PerlIO_printf(PerlIO_stderr(), (i<5 || i==7)?" %5d": (i<9)?" %3d":" %d", nmalloc[i] - nfree[i]); } - PerlIO_printf(PerlIO_stderr(), "\n"); -#ifdef PACK_MALLOC - if (sbrk_slack || start_slack) { - PerlIO_printf(PerlIO_stderr(), "Odd ends: %7d bytes from sbrk(), %7d from malloc.\n", - sbrk_slack, start_slack); - } -#endif + PerlIO_printf(PerlIO_stderr(), "\nTotal sbrk(): %8d. Odd ends: sbrk(): %7d, malloc(): %7d bytes.\n", + goodsbrk + sbrk_slack, sbrk_slack, start_slack); } #else void @@ -1101,6 +1101,37 @@ MAGIC* mg; } int +magic_setvivary(sv,mg) +SV* sv; +MAGIC* mg; +{ + if (LvTARGLEN(sv)) { + AV* av = (AV*)LvTARG(sv); + if (LvTARGOFF(sv) <= AvFILL(av)) { + SV** svp = AvARRAY(av) + LvTARGOFF(sv); + LvTARG(sv) = newSVsv(*svp); + SvREFCNT_dec(*svp); + *svp = SvREFCNT_inc(LvTARG(sv)); + } + else + LvTARG(sv) = Nullsv; + LvTARGLEN(sv) = 0; + SvREFCNT_dec(av); + } + if (LvTARG(sv)) + sv_setsv(LvTARG(sv), sv); + return 0; +} + +int +magic_freevivary(sv,mg) +SV* sv; +MAGIC* mg; +{ + SvREFCNT_dec(LvTARG(sv)); +} + +int magic_setmglob(sv,mg) SV* sv; MAGIC* mg; diff --git a/miniperlmain.c b/miniperlmain.c index 2d66964093..680b04284a 100644 --- a/miniperlmain.c +++ b/miniperlmain.c @@ -40,6 +40,7 @@ char **env; if (!my_perl) exit(1); perl_construct( my_perl ); + perl_destruct_level = 0; } exitstatus = perl_parse( my_perl, xs_init, argc, argv, (char **) NULL ); @@ -189,9 +189,18 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix) seq > (I32)SvNVX(sv) && strEQ(SvPVX(sv), name)) { - I32 depth = CvDEPTH(cv) ? CvDEPTH(cv) : 1; - AV *oldpad = (AV*)*av_fetch(curlist, depth, FALSE); - SV *oldsv = *av_fetch(oldpad, off, TRUE); + I32 depth; + AV *oldpad; + SV *oldsv; + + depth = CvDEPTH(cv); + if (!depth) { + if (newoff) + return 0; /* don't clone inactive stack frame */ + depth = 1; + } + oldpad = (AV*)*av_fetch(curlist, depth, FALSE); + oldsv = *av_fetch(oldpad, off, TRUE); if (!newoff) { /* Not a mere clone operation. */ SV *sv = NEWSV(1103,0); newoff = pad_alloc(OP_PADSV, SVs_PADMY); @@ -201,9 +210,17 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix) SvNVX(sv) = (double)curcop->cop_seq; SvIVX(sv) = 999999999; /* A ref, intro immediately */ SvFLAGS(sv) |= SVf_FAKE; + /* "It's closures all the way down." */ + CvCLONE_on(compcv); + if (cv != startcv) { + CV *bcv; + for (bcv = startcv; + bcv && bcv != cv && !CvCLONE(bcv); + bcv = CvOUTSIDE(bcv)) + CvCLONE_on(bcv); + } } av_store(comppad, newoff, SvREFCNT_inc(oldsv)); - CvCLONE_on(compcv); return newoff; } } @@ -441,9 +458,9 @@ OP *op; break; case OP_NEXTSTATE: case OP_DBSTATE: + Safefree(cCOP->cop_label); SvREFCNT_dec(cCOP->cop_filegv); break; - /* case OP_ANONCODE: XXX breaks eval of anon subs in closures (cf. Opcode) */ case OP_CONST: SvREFCNT_dec(cSVOP->op_sv); break; @@ -900,7 +917,6 @@ I32 type; { OP *kid; SV *sv; - char mtype; if (!op || error_count) return op; @@ -922,6 +938,10 @@ I32 type; else croak("That use of $[ is unsupported"); break; + case OP_STUB: + if (op->op_flags & OPf_PARENS) + break; + goto nomod; case OP_ENTERSUB: if ((type == OP_UNDEF || type == OP_REFGEN) && !(op->op_flags & OPf_STACKED)) { @@ -1024,23 +1044,13 @@ I32 type; case OP_KEYS: if (type != OP_SASSIGN) goto nomod; - mtype = 'k'; - goto makelv; + /* FALL THROUGH */ case OP_POS: - mtype = '.'; - goto makelv; case OP_VEC: - mtype = 'v'; - goto makelv; case OP_SUBSTR: - mtype = 'x'; - makelv: pad_free(op->op_targ); op->op_targ = pad_alloc(op->op_type, SVs_PADMY); - sv = PAD_SV(op->op_targ); - sv_upgrade(sv, SVt_PVLV); - sv_magic(sv, Nullsv, mtype, Nullch, 0); - curpad[op->op_targ] = sv; + assert(SvTYPE(PAD_SV(op->op_targ)) == SVt_NULL); if (op->op_flags & OPf_KIDS) mod(cBINOP->op_first->op_sibling, type); break; @@ -1127,8 +1137,10 @@ I32 type; ref(cUNOP->op_first, op->op_type); /* FALL THROUGH */ case OP_PADSV: - if (type == OP_RV2AV || type == OP_RV2HV) { - op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV); + if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) { + op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV + : type == OP_RV2HV ? OPpDEREF_HV + : OPpDEREF_SV); op->op_flags |= OPf_MOD; } break; @@ -1155,8 +1167,10 @@ I32 type; case OP_AELEM: case OP_HELEM: ref(cBINOP->op_first, op->op_type); - if (type == OP_RV2AV || type == OP_RV2HV) { - op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV); + if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) { + op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV + : type == OP_RV2HV ? OPpDEREF_HV + : OPpDEREF_SV); op->op_flags |= OPf_MOD; } break; @@ -2698,7 +2712,7 @@ newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont else { sv = newGVOP(OP_GV, 0, defgv); } - if (expr->op_type == OP_RV2AV) { + if (expr->op_type == OP_RV2AV || expr->op_type == OP_PADAV) { expr = scalar(ref(expr, OP_ITER)); iterflags |= OPf_STACKED; } @@ -2767,16 +2781,43 @@ CV *cv; } } -CV * -cv_clone(proto) +#ifdef DEBUG_CLOSURES +static void +cv_dump(cv) +CV* cv; +{ + CV *outside = CvOUTSIDE(cv); + AV* padlist = CvPADLIST(cv); + AV* pad_name = (AV*)*av_fetch(padlist, 0, FALSE); + AV* pad = (AV*)*av_fetch(padlist, 1, FALSE); + SV** pname = AvARRAY(pad_name); + SV** ppad = AvARRAY(pad); + I32 ix; + + PerlIO_printf(Perl_debug_log, "\tCV=0x%p (%s), OUTSIDE=0x%p (%s)\n", + cv, CvANON(cv) ? "ANON" : GvNAME(CvGV(cv)), + outside, CvANON(outside) ? "ANON" : GvNAME(CvGV(outside))); + + for (ix = 1; ix <= AvFILL(pad); ix++) { + if (SvPOK(pname[ix])) + PerlIO_printf(Perl_debug_log, "\t%4d. 0x%p (\"%s\")\n", + ix, ppad[ix], SvPVX(pname[ix])) + } +} +#endif /* DEBUG_CLOSURES */ + +static CV * +cv_clone2(proto, outside) CV* proto; +CV* outside; { AV* av; I32 ix; AV* protopadlist = CvPADLIST(proto); AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE); AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE); - SV** svp = AvARRAY(protopad); + SV** pname = AvARRAY(protopad_name); + SV** ppad = AvARRAY(protopad); AV* comppadlist; CV* cv; @@ -2788,14 +2829,16 @@ CV* proto; cv = compcv = (CV*)NEWSV(1104,0); sv_upgrade((SV *)cv, SVt_PVCV); CvCLONED_on(cv); + if (CvANON(proto)) + CvANON_on(cv); CvFILEGV(cv) = CvFILEGV(proto); CvGV(cv) = GvREFCNT_inc(CvGV(proto)); CvSTASH(cv) = CvSTASH(proto); CvROOT(cv) = CvROOT(proto); CvSTART(cv) = CvSTART(proto); - if (CvOUTSIDE(proto)) - CvOUTSIDE(cv) = (CV*)SvREFCNT_inc((SV*)CvOUTSIDE(proto)); + if (outside) + CvOUTSIDE(cv) = (CV*)SvREFCNT_inc(outside); comppad = newAV(); @@ -2804,7 +2847,7 @@ CV* proto; av_store(comppadlist, 0, SvREFCNT_inc((SV*)protopad_name)); av_store(comppadlist, 1, (SV*)comppad); CvPADLIST(cv) = comppadlist; - av_extend(comppad, AvFILL(protopad)); + av_fill(comppad, AvFILL(protopad)); curpad = AvARRAY(comppad); av = newAV(); /* will be @_ */ @@ -2812,37 +2855,75 @@ CV* proto; av_store(comppad, 0, (SV*)av); AvFLAGS(av) = AVf_REIFY; - svp = AvARRAY(protopad_name); - for ( ix = AvFILL(protopad); ix > 0; ix--) { - SV *sv; - if (svp[ix] != &sv_undef) { - char *name = SvPVX(svp[ix]); /* XXX */ - if (SvFLAGS(svp[ix]) & SVf_FAKE) { /* lexical from outside? */ - I32 off = pad_findlex(name,ix,curcop->cop_seq, CvOUTSIDE(proto), - cxstack_ix); - if (off != ix) + for (ix = AvFILL(protopad); ix > 0; ix--) { + SV* sv; + if (pname[ix] != &sv_undef) { + char *name = SvPVX(pname[ix]); /* XXX */ + if (SvFLAGS(pname[ix]) & SVf_FAKE) { /* lexical from outside? */ + I32 off = pad_findlex(name, ix, SvIVX(pname[ix]), + CvOUTSIDE(cv), cxstack_ix); + if (!off) + curpad[ix] = SvREFCNT_inc(ppad[ix]); + else if (off != ix) croak("panic: cv_clone: %s", name); } else { /* our own lexical */ - if (*name == '@') - av_store(comppad, ix, sv = (SV*)newAV()); + if (*name == '&') { + /* anon code -- we'll come back for it */ + sv = SvREFCNT_inc(ppad[ix]); + } + else if (*name == '@') + sv = (SV*)newAV(); else if (*name == '%') - av_store(comppad, ix, sv = (SV*)newHV()); + sv = (SV*)newHV(); else - av_store(comppad, ix, sv = NEWSV(0,0)); - SvPADMY_on(sv); + sv = NEWSV(0,0); + if (!SvPADBUSY(sv)) + SvPADMY_on(sv); + curpad[ix] = sv; } } else { - av_store(comppad, ix, sv = NEWSV(0,0)); + sv = NEWSV(0,0); SvPADTMP_on(sv); + curpad[ix] = sv; } } + /* Now that vars are all in place, clone nested closures. */ + + for (ix = AvFILL(protopad); ix > 0; ix--) { + if (pname[ix] != &sv_undef + && !(SvFLAGS(pname[ix]) & SVf_FAKE) + && *SvPVX(pname[ix]) == '&' + && CvCLONE(ppad[ix])) + { + CV *kid = cv_clone2((CV*)ppad[ix], cv); + SvREFCNT_dec(ppad[ix]); + CvCLONE_on(kid); + SvPADMY_on(kid); + curpad[ix] = (SV*)kid; + } + } + +#ifdef DEBUG_CLOSURES + PerlIO_printf(Perl_debug_log, "Cloned from:\n"); + cv_dump(proto); + PerlIO_printf(Perl_debug_log, " to:\n"); + cv_dump(cv); +#endif + LEAVE; return cv; } +CV * +cv_clone(proto) +CV* proto; +{ + return cv_clone2(proto, CvOUTSIDE(proto)); +} + SV * cv_const_sv(cv) CV *cv; @@ -3300,6 +3381,19 @@ OP *o; /* Check routines. */ OP * +ck_anoncode(op) +OP *op; +{ + PADOFFSET ix = pad_alloc(op->op_type, SVs_PADMY); + av_store(comppad_name, ix, newSVpv("&", 1)); + av_store(comppad, ix, cSVOP->op_sv); + SvPADMY_on(cSVOP->op_sv); + cSVOP->op_sv = Nullsv; + cSVOP->op_targ = ix; + return op; +} + +OP * ck_bitop(op) OP *op; { @@ -3346,10 +3440,14 @@ ck_delete(op) OP *op; { op = ck_fun(op); + op->op_private = 0; if (op->op_flags & OPf_KIDS) { OP *kid = cUNOP->op_first; - if (kid->op_type != OP_HELEM) - croak("%s argument is not a HASH element", op_desc[op->op_type]); + if (kid->op_type == OP_HSLICE) + op->op_private |= OPpSLICE; + else if (kid->op_type != OP_HELEM) + croak("%s argument is not a HASH element or slice", + op_desc[op->op_type]); null(kid); } return op; @@ -3431,6 +3529,20 @@ OP *op; } OP * +ck_exists(op) +OP *op; +{ + op = ck_fun(op); + if (op->op_flags & OPf_KIDS) { + OP *kid = cUNOP->op_first; + if (kid->op_type != OP_HELEM) + croak("%s argument is not a HASH element", op_desc[op->op_type]); + null(kid); + } + return op; +} + +OP * ck_gvconst(o) register OP *o; { @@ -4232,7 +4344,7 @@ register OP* o; case OP_GV: if (o->op_next->op_type == OP_RV2SV) { - if (!(o->op_next->op_private & (OPpDEREF_HV|OPpDEREF_AV))) { + if (!(o->op_next->op_private & OPpDEREF)) { null(o->op_next); o->op_private |= o->op_next->op_private & OPpLVAL_INTRO; o->op_next = o->op_next->op_next; @@ -4246,8 +4358,7 @@ register OP* o; if (pop->op_type == OP_CONST && (op = pop->op_next) && pop->op_next->op_type == OP_AELEM && - !(pop->op_next->op_private & - (OPpDEREF_HV|OPpDEREF_AV|OPpLVAL_INTRO)) && + !(pop->op_next->op_private & (OPpDEREF|OPpLVAL_INTRO)) && (i = SvIV(((SVOP*)pop)->op_sv) - compiling.cop_arybase) <= 255 && i >= 0) @@ -86,8 +86,10 @@ typedef U32 PADOFFSET; /* (lower bits carry hints) */ #define OPpENTERSUB_AMPER 8 /* Used & form to call. */ #define OPpENTERSUB_DB 16 /* Debug subroutine. */ -#define OPpDEREF_AV 32 /* Want ref to AV. */ -#define OPpDEREF_HV 64 /* Want ref to HV. */ +#define OPpDEREF (32|64) /* Want ref to something: */ +#define OPpDEREF_AV 32 /* Want ref to AV. */ +#define OPpDEREF_HV 64 /* Want ref to HV. */ +#define OPpDEREF_SV (32|64) /* Want ref to SV. */ /* Private for OP_CONST */ #define OPpCONST_ENTERED 16 /* Has been entered as symbol. */ @@ -100,9 +102,12 @@ typedef U32 PADOFFSET; /* Private for OP_LIST */ #define OPpLIST_GUESSED 64 /* Guessed that pushmark was needed. */ -/* Private for OP_LEAVE and friends */ +/* 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 */ + /* Private for OP_SORT, OP_PRTF, OP_SPRINTF, string cmp'n, and case changers */ #define OPpLOCALE 64 /* Use locale */ @@ -1052,12 +1052,14 @@ EXT char *op_desc[] = { }; #endif +OP * ck_anoncode _((OP* op)); OP * ck_bitop _((OP* op)); OP * ck_concat _((OP* op)); OP * ck_delete _((OP* op)); OP * ck_eof _((OP* op)); OP * ck_eval _((OP* op)); OP * ck_exec _((OP* op)); +OP * ck_exists _((OP* op)); OP * ck_ftst _((OP* op)); OP * ck_fun _((OP* op)); OP * ck_fun_locale _((OP* op)); @@ -1799,7 +1801,7 @@ EXT OP * (*check[]) _((OP *op)) = { ck_rvconst, /* rv2sv */ ck_null, /* av2arylen */ ck_rvconst, /* rv2cv */ - ck_null, /* anoncode */ + ck_anoncode, /* anoncode */ ck_null, /* prototype */ ck_spair, /* refgen */ ck_null, /* srefgen */ @@ -1912,7 +1914,7 @@ EXT OP * (*check[]) _((OP *op)) = { ck_fun, /* values */ ck_fun, /* keys */ ck_delete, /* delete */ - ck_delete, /* exists */ + ck_exists, /* exists */ ck_rvconst, /* rv2hv */ ck_null, /* helem */ ck_null, /* hslice */ @@ -2261,7 +2263,7 @@ EXT U32 opargs[] = { 0x00000408, /* each */ 0x00000408, /* values */ 0x00000408, /* keys */ - 0x00000104, /* delete */ + 0x00000100, /* delete */ 0x00000114, /* exists */ 0x00000048, /* rv2hv */ 0x00001404, /* helem */ @@ -214,7 +214,7 @@ rv2gv ref-to-glob cast ck_rvconst ds rv2sv scalar deref ck_rvconst ds av2arylen array length ck_null is rv2cv subroutine deref ck_rvconst d -anoncode anonymous subroutine ck_null 0 +anoncode anonymous subroutine ck_anoncode 0 prototype subroutine prototype ck_null s S refgen reference constructor ck_spair m L srefgen scalar ref constructor ck_null fs S @@ -362,8 +362,8 @@ aslice array slice ck_null m A L each each ck_fun t H values values ck_fun t H keys keys ck_fun t H -delete delete ck_delete s S -exists exists operator ck_delete is S +delete delete ck_delete 0 S +exists exists operator ck_exists is S rv2hv associative array deref ck_rvconst dt helem associative array elem ck_null s H S hslice associative array slice ck_null m H L diff --git a/patchlevel.h b/patchlevel.h index a047efb8ce..73210e2242 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1,5 +1,5 @@ #define PATCHLEVEL 3 -#define SUBVERSION 11 +#define SUBVERSION 12 /* local_patches -- list of locally applied less-than-subversion patches. @@ -117,6 +117,7 @@ register PerlInterpreter *sv_interp; rsfp = Nullfp; statname = Nullsv; tmps_floor = -1; + perl_destruct_level = 1; #endif init_ids(); @@ -159,11 +160,22 @@ register PerlInterpreter *sv_interp; #ifdef DEBUGGING { char *s; - if (s = getenv("PERL_DESTRUCT_LEVEL")) - destruct_level = atoi(s); + if (s = getenv("PERL_DESTRUCT_LEVEL")) { + int i = atoi(s); + if (destruct_level < i) + destruct_level = i; + } } #endif + /* unhook hooks which will soon be, or use, destroyed data */ + SvREFCNT_dec(warnhook); + warnhook = Nullsv; + SvREFCNT_dec(diehook); + diehook = Nullsv; + SvREFCNT_dec(parsehook); + parsehook = Nullsv; + LEAVE; FREETMPS; @@ -192,15 +204,23 @@ register PerlInterpreter *sv_interp; return; } - /* unhook hooks which may now point to, or use, broken code */ - if (warnhook && SvREFCNT(warnhook)) - SvREFCNT_dec(warnhook); - if (diehook && SvREFCNT(diehook)) - SvREFCNT_dec(diehook); - if (parsehook && SvREFCNT(parsehook)) - SvREFCNT_dec(parsehook); - + /* loosen bonds of global variables */ + + setdefout(Nullgv); + + sv_free(nrs); + nrs = Nullsv; + + sv_free(lastscream); + lastscream = Nullsv; + + sv_free(statname); + statname = Nullsv; + statgv = Nullgv; + laststatval = -1; + /* Prepare to destruct main symbol table. */ + hv = defstash; defstash = 0; SvREFCNT_dec(hv); @@ -1943,15 +1963,32 @@ static void init_stacks() { curstack = newAV(); - mainstack = curstack; /* remember in case we switch stacks */ - AvREAL_off(curstack); /* not a real array */ + mainstack = curstack; /* remember in case we switch stacks */ + AvREAL_off(curstack); /* not a real array */ av_extend(curstack,127); stack_base = AvARRAY(curstack); stack_sp = stack_base; stack_max = stack_base + 127; - /* Shouldn't these stacks be per-interpreter? */ + cxstack_max = 8192 / sizeof(CONTEXT) - 2; /* Use most of 8K. */ + New(50,cxstack,cxstack_max + 1,CONTEXT); + cxstack_ix = -1; + + New(50,tmps_stack,128,SV*); + tmps_ix = -1; + tmps_max = 128; + + DEBUG( { + New(51,debname,128,char); + New(52,debdelim,128,char); + } ) + + /* + * The following stacks almost certainly should be per-interpreter, + * but for now they're not. XXX + */ + if (markstack) { markstack_ptr = markstack; } else { @@ -1982,20 +2019,7 @@ init_stacks() New(54,retstack,16,OP*); retstack_ix = 0; retstack_max = 16; - } - - cxstack_max = 8192 / sizeof(CONTEXT) - 2; /* Use most of 8K. */ - New(50,cxstack,cxstack_max + 1,CONTEXT); - cxstack_ix = -1; - - New(50,tmps_stack,128,SV*); - tmps_ix = -1; - tmps_max = 128; - - DEBUG( { - New(51,debname,128,char); - New(52,debdelim,128,char); - } ) + } } static void @@ -2003,6 +2027,10 @@ nuke_stacks() { Safefree(cxstack); Safefree(tmps_stack); + DEBUG( { + Safefree(debname); + Safefree(debdelim); + } ) } static PerlIO *tmpfp; /* moved outside init_lexer() because of UNICOS bug */ @@ -1285,7 +1285,6 @@ EXT SV ** curpad; /* temp space */ EXT SV * Sv; -EXT HE He; EXT XPV * Xpv; EXT char buf[2048]; /* should be longer than PATH_MAX */ EXT char tokenbuf[256]; @@ -1664,7 +1663,7 @@ IEXT char * Ie_tmpname; IEXT PerlIO * Ie_fp; IEXT U32 Iperldb; /* This value may be raised by extensions for testing purposes */ -IEXT int Iperl_destruct_level; /* 0=none, 1=full, 2=full with checks */ +IEXT int Iperl_destruct_level IINIT(1); /* 0=none, 1=full, 2=full with checks */ /* magical thingies */ IEXT Time_t Ibasetime; /* $^T */ @@ -1886,6 +1885,8 @@ EXT MGVTBL vtbl_substr = {0, magic_setsubstr, 0, 0, 0}; EXT MGVTBL vtbl_vec = {0, magic_setvec, 0, 0, 0}; +EXT MGVTBL vtbl_vivary = {0, magic_setvivary, + 0, 0, magic_freevivary}; EXT MGVTBL vtbl_pos = {magic_getpos, magic_setpos, 0, 0, 0}; @@ -1929,6 +1930,7 @@ EXT MGVTBL vtbl_nkeys; EXT MGVTBL vtbl_taint; EXT MGVTBL vtbl_substr; EXT MGVTBL vtbl_vec; +EXT MGVTBL vtbl_vivary; EXT MGVTBL vtbl_pos; EXT MGVTBL vtbl_bm; EXT MGVTBL vtbl_fm; diff --git a/perl_exp.SH b/perl_exp.SH index cef4d64fd0..49e8119591 100755 --- a/perl_exp.SH +++ b/perl_exp.SH @@ -20,13 +20,25 @@ echo "Extracting perl.exp" rm -f perl.exp echo "#!" > perl.exp -sed -n '/^[A-Za-z]/ s/^/Perl_/p' global.sym >> perl.exp - -# -# also add symbols from interp.sym -# They are only needed if -DMULTIPLICITY is not set but it -# doesn't hurt to include them anyway. -sed -n '/^[A-Za-z]/ s/^/Perl_/p' interp.sym >> perl.exp +case "$bincompat3" in +y*) + global=/tmp/exp$$g + interp=/tmp/exp$$i + compat3=/tmp/exp$$c + trap 'rm -f $global $interp $compat3' 0 + trap 'exit 1' 1 2 3 13 15 + grep '^[A-Za-z]' global.sym | sort >$global + grep '^[A-Za-z]' interp.sym | sort >$interp + grep '^[A-Za-z]' compat3.sym | sort >$compat3 + comm -23 $global $compat3 | sed 's/^/Perl_/p' >> perl.exp + comm -12 $global $compat3 >> perl.exp + comm -12 $interp $compat3 | sed 's/^/Perl_/p' >> perl.exp + comm -23 $interp $compat3 >> perl.exp + ;; +*) + sed -n '/^[A-Za-z]/ s/^/Perl_/p' global.sym interp.sym >> perl.exp + ;; +esac # extra globals not included above. cat <<END >> perl.exp @@ -1273,7 +1273,7 @@ int yyerrflag; int yychar; YYSTYPE yyval; YYSTYPE yylval; -#line 620 "perly.y" +#line 624 "perly.y" /* PROGRAM */ #line 1349 "perly.c" #define YYABORT goto yyabort @@ -1658,34 +1658,38 @@ break; case 31: #line 206 "perly.y" { copline = yyvsp[-3].ival; - yyval.opval = newWHILEOP(0, 1, (LOOP*)Nullop, - scope(yyvsp[-2].opval), yyvsp[-1].opval, yyvsp[0].opval); } + deprecate("while BLOCK BLOCK"); + yyval.opval = newSTATEOP(0, yyvsp[-4].pval, + newWHILEOP(0, 1, (LOOP*)Nullop, + scope(yyvsp[-2].opval), yyvsp[-1].opval, yyvsp[0].opval)); } break; case 32: -#line 210 "perly.y" +#line 212 "perly.y" { copline = yyvsp[-3].ival; - yyval.opval = newWHILEOP(0, 1, (LOOP*)Nullop, - invert(scalar(scope(yyvsp[-2].opval))), - yyvsp[-1].opval, yyvsp[0].opval); } + deprecate("until BLOCK BLOCK"); + yyval.opval = newSTATEOP(0, yyvsp[-4].pval, + newWHILEOP(0, 1, (LOOP*)Nullop, + invert(scalar(scope(yyvsp[-2].opval))), + yyvsp[-1].opval, yyvsp[0].opval)); } break; case 33: -#line 215 "perly.y" +#line 219 "perly.y" { yyval.opval = block_end(yyvsp[-6].ival, newFOROP(0, yyvsp[-9].pval, yyvsp[-8].ival, yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval)); } break; case 34: -#line 218 "perly.y" +#line 222 "perly.y" { yyval.opval = block_end(yyvsp[-4].ival, newFOROP(0, yyvsp[-8].pval, yyvsp[-7].ival, mod(yyvsp[-6].opval, OP_ENTERLOOP), yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval)); } break; case 35: -#line 222 "perly.y" +#line 226 "perly.y" { yyval.opval = block_end(yyvsp[-4].ival, newFOROP(0, yyvsp[-7].pval, yyvsp[-6].ival, Nullop, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval)); } break; case 36: -#line 226 "perly.y" +#line 230 "perly.y" { copline = yyvsp[-9].ival; yyval.opval = block_end(yyvsp[-7].ival, append_elem(OP_LINESEQ, scalar(yyvsp[-6].opval), @@ -1695,356 +1699,356 @@ case 36: yyvsp[0].opval, scalar(yyvsp[-2].opval))))); } break; case 37: -#line 234 "perly.y" +#line 238 "perly.y" { yyval.opval = newSTATEOP(0, yyvsp[-2].pval, newWHILEOP(0, 1, (LOOP*)Nullop, Nullop, yyvsp[-1].opval, yyvsp[0].opval)); } break; case 38: -#line 240 "perly.y" +#line 244 "perly.y" { yyval.opval = Nullop; } break; case 40: -#line 245 "perly.y" +#line 249 "perly.y" { (void)scan_num("1"); yyval.opval = yylval.opval; } break; case 42: -#line 250 "perly.y" +#line 254 "perly.y" { yyval.opval = invert(scalar(yyvsp[0].opval)); } break; case 43: -#line 254 "perly.y" +#line 258 "perly.y" { yyval.opval = yyvsp[0].opval; intro_my(); } break; case 44: -#line 258 "perly.y" +#line 262 "perly.y" { yyval.opval = yyvsp[0].opval; intro_my(); } break; case 45: -#line 262 "perly.y" +#line 266 "perly.y" { yyval.opval = yyvsp[0].opval; intro_my(); } break; case 46: -#line 266 "perly.y" +#line 270 "perly.y" { yyval.opval = yyvsp[0].opval; intro_my(); } break; case 47: -#line 270 "perly.y" +#line 274 "perly.y" { yyval.pval = Nullch; } break; case 49: -#line 275 "perly.y" +#line 279 "perly.y" { yyval.ival = 0; } break; case 50: -#line 277 "perly.y" +#line 281 "perly.y" { yyval.ival = 0; } break; case 51: -#line 279 "perly.y" +#line 283 "perly.y" { yyval.ival = 0; } break; case 52: -#line 281 "perly.y" +#line 285 "perly.y" { yyval.ival = 0; } break; case 53: -#line 285 "perly.y" +#line 289 "perly.y" { newFORM(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); } break; case 54: -#line 287 "perly.y" +#line 291 "perly.y" { newFORM(yyvsp[-1].ival, Nullop, yyvsp[0].opval); } break; case 55: -#line 291 "perly.y" +#line 295 "perly.y" { newSUB(yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval, yyvsp[0].opval); } break; case 56: -#line 293 "perly.y" +#line 297 "perly.y" { newSUB(yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval, Nullop); expect = XSTATE; } break; case 57: -#line 297 "perly.y" +#line 301 "perly.y" { yyval.opval = Nullop; } break; case 59: -#line 302 "perly.y" +#line 306 "perly.y" { yyval.ival = start_subparse(); } break; case 60: -#line 306 "perly.y" +#line 310 "perly.y" { package(yyvsp[-1].opval); } break; case 61: -#line 308 "perly.y" +#line 312 "perly.y" { package(Nullop); } break; case 62: -#line 312 "perly.y" +#line 316 "perly.y" { utilize(yyvsp[-5].ival, yyvsp[-4].ival, yyvsp[-3].opval, yyvsp[-2].opval, yyvsp[-1].opval); } break; case 63: -#line 316 "perly.y" +#line 320 "perly.y" { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 64: -#line 318 "perly.y" +#line 322 "perly.y" { yyval.opval = newLOGOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 66: -#line 323 "perly.y" +#line 327 "perly.y" { yyval.opval = yyvsp[-1].opval; } break; case 67: -#line 325 "perly.y" +#line 329 "perly.y" { yyval.opval = append_elem(OP_LIST, yyvsp[-2].opval, yyvsp[0].opval); } break; case 69: -#line 330 "perly.y" +#line 334 "perly.y" { yyval.opval = convert(yyvsp[-2].ival, OPf_STACKED, prepend_elem(OP_LIST, newGVREF(yyvsp[-2].ival,yyvsp[-1].opval), yyvsp[0].opval) ); } break; case 70: -#line 333 "perly.y" +#line 337 "perly.y" { yyval.opval = convert(yyvsp[-4].ival, OPf_STACKED, prepend_elem(OP_LIST, newGVREF(yyvsp[-4].ival,yyvsp[-2].opval), yyvsp[-1].opval) ); } break; case 71: -#line 336 "perly.y" +#line 340 "perly.y" { yyval.opval = convert(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, scalar(yyvsp[-5].opval), yyvsp[-1].opval), newUNOP(OP_METHOD, 0, yyvsp[-3].opval))); } break; case 72: -#line 341 "perly.y" +#line 345 "perly.y" { yyval.opval = convert(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, yyvsp[-1].opval, yyvsp[0].opval), newUNOP(OP_METHOD, 0, yyvsp[-2].opval))); } break; case 73: -#line 346 "perly.y" +#line 350 "perly.y" { yyval.opval = convert(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, yyvsp[-3].opval, yyvsp[-1].opval), newUNOP(OP_METHOD, 0, yyvsp[-4].opval))); } break; case 74: -#line 351 "perly.y" +#line 355 "perly.y" { yyval.opval = convert(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; case 75: -#line 353 "perly.y" +#line 357 "perly.y" { yyval.opval = convert(yyvsp[-3].ival, 0, yyvsp[-1].opval); } break; case 76: -#line 355 "perly.y" +#line 359 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, newANONSUB(yyvsp[-2].ival, 0, yyvsp[-1].opval), yyvsp[0].opval), yyvsp[-3].opval)); } break; case 79: -#line 366 "perly.y" +#line 370 "perly.y" { yyval.opval = newASSIGNOP(OPf_STACKED, yyvsp[-2].opval, yyvsp[-1].ival, yyvsp[0].opval); } break; case 80: -#line 368 "perly.y" +#line 372 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 81: -#line 370 "perly.y" +#line 374 "perly.y" { if (yyvsp[-1].ival != OP_REPEAT) scalar(yyvsp[-2].opval); yyval.opval = newBINOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, scalar(yyvsp[0].opval)); } break; case 82: -#line 374 "perly.y" +#line 378 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 83: -#line 376 "perly.y" +#line 380 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 84: -#line 378 "perly.y" +#line 382 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 85: -#line 380 "perly.y" +#line 384 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 86: -#line 382 "perly.y" +#line 386 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 87: -#line 384 "perly.y" +#line 388 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 88: -#line 386 "perly.y" +#line 390 "perly.y" { yyval.opval = newRANGE(yyvsp[-1].ival, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval));} break; case 89: -#line 388 "perly.y" +#line 392 "perly.y" { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 90: -#line 390 "perly.y" +#line 394 "perly.y" { yyval.opval = newLOGOP(OP_OR, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 91: -#line 392 "perly.y" +#line 396 "perly.y" { yyval.opval = newCONDOP(0, yyvsp[-4].opval, yyvsp[-2].opval, yyvsp[0].opval); } break; case 92: -#line 394 "perly.y" +#line 398 "perly.y" { yyval.opval = bind_match(yyvsp[-1].ival, yyvsp[-2].opval, yyvsp[0].opval); } break; case 93: -#line 397 "perly.y" +#line 401 "perly.y" { yyval.opval = newUNOP(OP_NEGATE, 0, scalar(yyvsp[0].opval)); } break; case 94: -#line 399 "perly.y" +#line 403 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 95: -#line 401 "perly.y" +#line 405 "perly.y" { yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); } break; case 96: -#line 403 "perly.y" +#line 407 "perly.y" { yyval.opval = newUNOP(OP_COMPLEMENT, 0, scalar(yyvsp[0].opval));} break; case 97: -#line 405 "perly.y" +#line 409 "perly.y" { yyval.opval = newUNOP(OP_REFGEN, 0, mod(yyvsp[0].opval,OP_REFGEN)); } break; case 98: -#line 407 "perly.y" +#line 411 "perly.y" { yyval.opval = newUNOP(OP_POSTINC, 0, mod(scalar(yyvsp[-1].opval), OP_POSTINC)); } break; case 99: -#line 410 "perly.y" +#line 414 "perly.y" { yyval.opval = newUNOP(OP_POSTDEC, 0, mod(scalar(yyvsp[-1].opval), OP_POSTDEC)); } break; case 100: -#line 413 "perly.y" +#line 417 "perly.y" { yyval.opval = newUNOP(OP_PREINC, 0, mod(scalar(yyvsp[0].opval), OP_PREINC)); } break; case 101: -#line 416 "perly.y" +#line 420 "perly.y" { yyval.opval = newUNOP(OP_PREDEC, 0, mod(scalar(yyvsp[0].opval), OP_PREDEC)); } break; case 102: -#line 419 "perly.y" +#line 423 "perly.y" { yyval.opval = localize(yyvsp[0].opval,yyvsp[-1].ival); } break; case 103: -#line 421 "perly.y" +#line 425 "perly.y" { yyval.opval = sawparens(yyvsp[-1].opval); } break; case 104: -#line 423 "perly.y" +#line 427 "perly.y" { yyval.opval = sawparens(newNULLLIST()); } break; case 105: -#line 425 "perly.y" +#line 429 "perly.y" { yyval.opval = newANONLIST(yyvsp[-1].opval); } break; case 106: -#line 427 "perly.y" +#line 431 "perly.y" { yyval.opval = newANONLIST(Nullop); } break; case 107: -#line 429 "perly.y" +#line 433 "perly.y" { yyval.opval = newANONHASH(yyvsp[-2].opval); } break; case 108: -#line 431 "perly.y" +#line 435 "perly.y" { yyval.opval = newANONHASH(Nullop); } break; case 109: -#line 433 "perly.y" +#line 437 "perly.y" { yyval.opval = newANONSUB(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); } break; case 110: -#line 435 "perly.y" +#line 439 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 111: -#line 437 "perly.y" +#line 441 "perly.y" { yyval.opval = newBINOP(OP_GELEM, 0, newGVREF(0,yyvsp[-4].opval), yyvsp[-2].opval); } break; case 112: -#line 439 "perly.y" +#line 443 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 113: -#line 441 "perly.y" +#line 445 "perly.y" { yyval.opval = newBINOP(OP_AELEM, 0, oopsAV(yyvsp[-3].opval), scalar(yyvsp[-1].opval)); } break; case 114: -#line 443 "perly.y" +#line 447 "perly.y" { yyval.opval = newBINOP(OP_AELEM, 0, ref(newAVREF(yyvsp[-4].opval),OP_RV2AV), scalar(yyvsp[-1].opval));} break; case 115: -#line 447 "perly.y" +#line 451 "perly.y" { assertref(yyvsp[-3].opval); yyval.opval = newBINOP(OP_AELEM, 0, ref(newAVREF(yyvsp[-3].opval),OP_RV2AV), scalar(yyvsp[-1].opval));} break; case 116: -#line 451 "perly.y" +#line 455 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 117: -#line 453 "perly.y" +#line 457 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 118: -#line 455 "perly.y" +#line 459 "perly.y" { yyval.opval = newUNOP(OP_AV2ARYLEN, 0, ref(yyvsp[0].opval, OP_AV2ARYLEN));} break; case 119: -#line 457 "perly.y" +#line 461 "perly.y" { yyval.opval = newBINOP(OP_HELEM, 0, oopsHV(yyvsp[-4].opval), jmaybe(yyvsp[-2].opval)); expect = XOPERATOR; } break; case 120: -#line 460 "perly.y" +#line 464 "perly.y" { yyval.opval = newBINOP(OP_HELEM, 0, ref(newHVREF(yyvsp[-5].opval),OP_RV2HV), jmaybe(yyvsp[-2].opval)); expect = XOPERATOR; } break; case 121: -#line 465 "perly.y" +#line 469 "perly.y" { assertref(yyvsp[-4].opval); yyval.opval = newBINOP(OP_HELEM, 0, ref(newHVREF(yyvsp[-4].opval),OP_RV2HV), jmaybe(yyvsp[-2].opval)); expect = XOPERATOR; } break; case 122: -#line 470 "perly.y" +#line 474 "perly.y" { yyval.opval = newSLICEOP(0, yyvsp[-1].opval, yyvsp[-4].opval); } break; case 123: -#line 472 "perly.y" +#line 476 "perly.y" { yyval.opval = newSLICEOP(0, yyvsp[-1].opval, Nullop); } break; case 124: -#line 474 "perly.y" +#line 478 "perly.y" { yyval.opval = prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, @@ -2052,7 +2056,7 @@ case 124: ref(yyvsp[-3].opval, OP_ASLICE))); } break; case 125: -#line 480 "perly.y" +#line 484 "perly.y" { yyval.opval = prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, @@ -2061,37 +2065,37 @@ case 125: expect = XOPERATOR; } break; case 126: -#line 487 "perly.y" +#line 491 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 127: -#line 489 "perly.y" +#line 493 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, 0, scalar(yyvsp[0].opval)); } break; case 128: -#line 491 "perly.y" +#line 495 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar(yyvsp[-2].opval)); } break; case 129: -#line 493 "perly.y" +#line 497 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[-1].opval, scalar(yyvsp[-3].opval))); } break; case 130: -#line 496 "perly.y" +#line 500 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); } break; case 131: -#line 499 "perly.y" +#line 503 "perly.y" { yyval.opval = newUNOP(OP_DOFILE, 0, scalar(yyvsp[0].opval)); } break; case 132: -#line 501 "perly.y" +#line 505 "perly.y" { yyval.opval = newUNOP(OP_NULL, OPf_SPECIAL, scope(yyvsp[0].opval)); } break; case 133: -#line 503 "perly.y" +#line 507 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, @@ -2101,7 +2105,7 @@ case 133: )),Nullop)); dep();} break; case 134: -#line 511 "perly.y" +#line 515 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, append_elem(OP_LIST, @@ -2112,150 +2116,150 @@ case 134: )))); dep();} break; case 135: -#line 520 "perly.y" +#line 524 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, scalar(newCVREF(0,scalar(yyvsp[-2].opval))), Nullop)); dep();} break; case 136: -#line 524 "perly.y" +#line 528 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, yyvsp[-1].opval, scalar(newCVREF(0,scalar(yyvsp[-3].opval))))); dep();} break; case 137: -#line 529 "perly.y" +#line 533 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, OPf_SPECIAL); hints |= HINT_BLOCK_SCOPE; } break; case 138: -#line 532 "perly.y" +#line 536 "perly.y" { yyval.opval = newLOOPEX(yyvsp[-1].ival,yyvsp[0].opval); } break; case 139: -#line 534 "perly.y" +#line 538 "perly.y" { yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); } break; case 140: -#line 536 "perly.y" +#line 540 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, 0); } break; case 141: -#line 538 "perly.y" +#line 542 "perly.y" { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; case 142: -#line 540 "perly.y" +#line 544 "perly.y" { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; case 143: -#line 542 "perly.y" +#line 546 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); } break; case 144: -#line 545 "perly.y" +#line 549 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, 0); } break; case 145: -#line 547 "perly.y" +#line 551 "perly.y" { yyval.opval = newOP(yyvsp[-2].ival, 0); } break; case 146: -#line 549 "perly.y" +#line 553 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, 0, scalar(yyvsp[0].opval)); } break; case 147: -#line 552 "perly.y" +#line 556 "perly.y" { yyval.opval = newOP(yyvsp[-2].ival, OPf_SPECIAL); } break; case 148: -#line 554 "perly.y" +#line 558 "perly.y" { yyval.opval = newUNOP(yyvsp[-3].ival, 0, yyvsp[-1].opval); } break; case 149: -#line 556 "perly.y" +#line 560 "perly.y" { yyval.opval = pmruntime(yyvsp[-3].opval, yyvsp[-1].opval, Nullop); } break; case 150: -#line 558 "perly.y" +#line 562 "perly.y" { yyval.opval = pmruntime(yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval); } break; case 153: -#line 564 "perly.y" +#line 568 "perly.y" { yyval.opval = Nullop; } break; case 154: -#line 566 "perly.y" +#line 570 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 155: -#line 570 "perly.y" +#line 574 "perly.y" { yyval.opval = Nullop; } break; case 156: -#line 572 "perly.y" +#line 576 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 157: -#line 574 "perly.y" +#line 578 "perly.y" { yyval.opval = yyvsp[-1].opval; } break; case 158: -#line 577 "perly.y" +#line 581 "perly.y" { yyval.ival = 0; } break; case 159: -#line 578 "perly.y" +#line 582 "perly.y" { yyval.ival = 1; } break; case 160: -#line 582 "perly.y" +#line 586 "perly.y" { in_my = 0; yyval.opval = my(yyvsp[0].opval); } break; case 161: -#line 586 "perly.y" +#line 590 "perly.y" { yyval.opval = newCVREF(yyvsp[-1].ival,yyvsp[0].opval); } break; case 162: -#line 590 "perly.y" +#line 594 "perly.y" { yyval.opval = newSVREF(yyvsp[0].opval); } break; case 163: -#line 594 "perly.y" +#line 598 "perly.y" { yyval.opval = newAVREF(yyvsp[0].opval); } break; case 164: -#line 598 "perly.y" +#line 602 "perly.y" { yyval.opval = newHVREF(yyvsp[0].opval); } break; case 165: -#line 602 "perly.y" +#line 606 "perly.y" { yyval.opval = newAVREF(yyvsp[0].opval); } break; case 166: -#line 606 "perly.y" +#line 610 "perly.y" { yyval.opval = newGVREF(0,yyvsp[0].opval); } break; case 167: -#line 610 "perly.y" +#line 614 "perly.y" { yyval.opval = scalar(yyvsp[0].opval); } break; case 168: -#line 612 "perly.y" +#line 616 "perly.y" { yyval.opval = scalar(yyvsp[0].opval); } break; case 169: -#line 614 "perly.y" +#line 618 "perly.y" { yyval.opval = scope(yyvsp[0].opval); } break; case 170: -#line 617 "perly.y" +#line 621 "perly.y" { yyval.opval = yyvsp[0].opval; } break; -#line 2245 "perly.c" +#line 2249 "perly.c" } yyssp -= yym; yystate = *yyssp; diff --git a/perly.c.diff b/perly.c.diff index 172fae5e79..a3472508b8 100644 --- a/perly.c.diff +++ b/perly.c.diff @@ -1,5 +1,4 @@ -*** y.tab.c.ORIG Thu Dec 5 13:55:38 1996 ---- y.tab.c Thu Dec 5 13:56:27 1996 +Index: perly.c *************** *** 13,82 **** } @@ -89,7 +88,7 @@ - short yyss[YYSTACKSIZE]; - YYSTYPE yyvs[YYSTACKSIZE]; - #define yystacksize YYSTACKSIZE - #line 620 "perly.y" + #line 624 "perly.y" /* PROGRAM */ --- 1272,1277 ---- *************** @@ -301,14 +300,14 @@ yystate, yyn, yyrule[yyn]); #endif *************** -*** 2252,2257 **** +*** 2256,2261 **** #if YYDEBUG if (yydebug) ! printf("yydebug: after reduction, shifting from state 0 to\ ! state %d\n", YYFINAL); #endif yystate = YYFINAL; ---- 2266,2272 ---- +--- 2270,2276 ---- #if YYDEBUG if (yydebug) ! fprintf(stderr, @@ -317,20 +316,20 @@ #endif yystate = YYFINAL; *************** -*** 2267,2271 **** +*** 2271,2275 **** if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; ! printf("yydebug: state %d, reading %d (%s)\n", YYFINAL, yychar, yys); } ---- 2282,2286 ---- +--- 2286,2290 ---- if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; ! fprintf(stderr, "yydebug: state %d, reading %d (%s)\n", YYFINAL, yychar, yys); } *************** -*** 2282,2291 **** +*** 2286,2295 **** #if YYDEBUG if (yydebug) ! printf("yydebug: after reduction, shifting from state %d \ @@ -341,7 +340,7 @@ ! goto yyoverflow; } *++yyssp = yystate; ---- 2297,2321 ---- +--- 2301,2325 ---- #if YYDEBUG if (yydebug) ! fprintf(stderr, @@ -368,7 +367,7 @@ } *++yyssp = yystate; *************** -*** 2293,2300 **** +*** 2297,2304 **** goto yyloop; yyoverflow: ! yyerror("yacc stack overflow"); @@ -377,7 +376,7 @@ yyaccept: ! return (0); } ---- 2323,2330 ---- +--- 2327,2334 ---- goto yyloop; yyoverflow: ! yyerror("Out of memory for yacc stack"); @@ -204,13 +204,17 @@ loop : label WHILE '(' remember mtexpr ')' mblock cont $5, $7, $8))); } | label WHILE block block cont { copline = $2; - $$ = newWHILEOP(0, 1, (LOOP*)Nullop, - scope($3), $4, $5); } + deprecate("while BLOCK BLOCK"); + $$ = newSTATEOP(0, $1, + newWHILEOP(0, 1, (LOOP*)Nullop, + scope($3), $4, $5)); } | label UNTIL block block cont { copline = $2; - $$ = newWHILEOP(0, 1, (LOOP*)Nullop, - invert(scalar(scope($3))), - $4, $5); } + deprecate("until BLOCK BLOCK"); + $$ = newSTATEOP(0, $1, + newWHILEOP(0, 1, (LOOP*)Nullop, + invert(scalar(scope($3))), + $4, $5)); } | label FOR MY remember my_scalar '(' mexpr ')' mblock cont { $$ = block_end($4, newFOROP(0, $1, $2, $5, $7, $9, $10)); } diff --git a/pod/checkpods.PL b/pod/checkpods.PL index 25d1f18fb6..5265a19808 100644 --- a/pod/checkpods.PL +++ b/pod/checkpods.PL @@ -26,9 +26,9 @@ print "Extracting $file (with variable substitutions)\n"; # You can use $Config{...} to use Configure variables. print OUT <<"!GROK!THIS!"; -$Config{'startperl'} - eval 'exec perl -S \$0 "\$@"' - if 0; +$Config{startperl} + eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' + if \$running_under_some_shell; !GROK!THIS! # In the following, perl variables are not expanded during extraction. diff --git a/pod/perl.pod b/pod/perl.pod index 2487a5e742..e43424f26b 100644 --- a/pod/perl.pod +++ b/pod/perl.pod @@ -19,7 +19,7 @@ For ease of access, the Perl manual has been split up into a number of sections: perl Perl overview (this section) - perltoc Perl documentation table of contents + perlnews Perl news about changes from previous version perldata Perl data structures perlsyn Perl syntax @@ -31,11 +31,12 @@ of sections: perlsub Perl subroutines perlmod Perl modules perlform Perl formats - perli18n Perl internalization + perllocale Perl locale support perlref Perl references perldsc Perl data structures intro perllol Perl data structures: lists of lists + perltoot Perl OO tutorial perlobj Perl objects perltie Perl objects hidden behind simple variables perlbot Perl OO tricks and examples @@ -69,7 +70,7 @@ in the appropriate start-up files. To find out where these are, type: perl -V:man.dir If the directories were F</usr/local/man/man1> and F</usr/local/man/man3>, -you would only need to add F</usr/local/man> to your MANPATH. If +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 that doesn't work for some reason, you can still use the @@ -82,7 +83,7 @@ will often point out exactly where the trouble is. =head1 DESCRIPTION -Perl is an interpreted language optimized for scanning arbitrary +Perl is a language optimized for scanning arbitrary text files, extracting information from those text files, and printing reports based on that information. It's also a good language for many system management tasks. The language is intended to be practical @@ -138,7 +139,8 @@ 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". +to better privacy for "programming in the large". Anonymous +subroutines exhibit deep binding of lexical variables (closures). =item * Arbitrarily nested data structures @@ -166,7 +168,7 @@ Perl may now be embedded easily in your C or C++ application, and can either call or be called by your routines through a documented interface. The XS preprocessor is provided to make it easy to glue your C or C++ routines into Perl. Dynamic loading of modules is -supported. +supported, and Perl itself can be made into a dynamic library. =item * POSIX compliant @@ -191,7 +193,7 @@ to an object class which defines its access methods. =item * Subroutine definitions may now be autoloaded In fact, the AUTOLOAD mechanism also allows you to define any arbitrary -semantics for undefined subroutine calls. It's not just for autoloading. +semantics for undefined subroutine calls. It's not for just autoloading. =item * Regular expression enhancements @@ -201,6 +203,18 @@ with embedded whitespace and comments for readability. A consistent extensibility mechanism has been added that is upwardly compatible with all old regular expressions. +=item * Innumerable Unbundled Modules + +The Comprehensive Perl Archive Network described in L<perlmod> +contains hundreds of plug-and-play modules full of reusable +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 +optimized C code. + =back Ok, that's I<definitely> enough hype. @@ -239,6 +253,12 @@ The command used to get the debugger code. If unset, uses BEGIN { require 'perl5db.pl' } +=item PERL_DESTRUCT_LEVEL + +Relevant only if your perl executable was built with B<-DDEBUGGING>, +this controls the behavior of global destruction of objects and other +references. + =item PERLLIB A colon-separated list of directories in which to look for Perl library @@ -267,7 +287,7 @@ Larry Wall E<lt>F<larry@wall.org>E<gt>, with the help of oodles of other folks. =head1 FILES "/tmp/perl-e$$" temporary file for -e commands - "@INC" locations of perl 5 libraries + "@INC" locations of perl libraries =head1 SEE ALSO @@ -297,8 +317,8 @@ switch? The B<-w> switch is not mandatory. Perl is at the mercy of your machine's definitions of various -operations such as type casting, atof() and sprintf(). The latter -can even trigger a coredump when passed ludicrous input values. +operations such as type casting, atof(), and sprintf(). The latter +can even trigger a core dump when passed ludicrous input values. If your stdio requires a seek or eof between reads and writes on a particular stream, so does Perl. (This doesn't apply to sysread() @@ -310,7 +330,7 @@ given variable name may not be longer than 255 characters, and no component of your PATH may be longer than 255 if you use B<-S>. A regular expression may not compile to more than 32767 bytes internally. -See the perl bugs database at F<http://perl.com/perl/bugs/>. You may +See the perl bugs database at F<http://www.perl.com/perl/bugs/>. You may mail your bug reports (be sure to include full configuration information as output by the myconfig program in the perl source tree, or by C<perl -V>) to F<perlbug@perl.com>. diff --git a/pod/perlapio.pod b/pod/perlapio.pod index d2fd74ab5c..ae67494ce2 100644 --- a/pod/perlapio.pod +++ b/pod/perlapio.pod @@ -128,7 +128,7 @@ the meaning of "fileno" may not match UNIX. =item B<PerlIO_clearerr(f)> -This corresponds to clearerr(), i.e. clears 'eof' and 'error' +This corresponds to clearerr(), i.e., clears 'eof' and 'error' flags for the "stream". =item B<PerlIO_flush(f)> @@ -156,7 +156,7 @@ in terms of PerlIO_seek() at some point. =item B<PerlIO_tmpfile()> -This corresponds to tmpfile(), i.e. returns an anonymous +This corresponds to tmpfile(), i.e., returns an anonymous PerlIO which will automatically be deleted when closed. =back @@ -201,7 +201,7 @@ behaviour. =item B<PerlIO_setlinebuf(f)> This corresponds to setlinebuf(). Use is deprecated pending -further discussion. (Perl core I<only> uses it when "dumping" +further discussion. (Perl core uses it I<only> when "dumping" is has nothing to do with $| auto-flush.) =back @@ -209,7 +209,7 @@ is has nothing to do with $| auto-flush.) In addition to user API above there is an "implementation" interface which allows perl to get at internals of PerlIO. The following calls correspond to the various FILE_xxx macros determined -by Configure. This section is really only of interest to those +by Configure. This section is really of interest to only those concerned with detailed perl-core behaviour or implementing a PerlIO mapping. @@ -236,7 +236,7 @@ bytes in the buffer. =item B<PerlIO_fast_gets(f)> Implementation has all the interfaces required to -allow perls fast code to handle <FILE> mechanism. +allow perl's fast code to handle <FILE> mechanism. PerlIO_fast_gets(f) = PerlIO_has_cntptr(f) && \ PerlIO_canset_cnt(f) && \ @@ -245,14 +245,14 @@ allow perls fast code to handle <FILE> mechanism. =item B<PerlIO_set_ptrcnt(f,p,c)> Set pointer into buffer, and a count of bytes still in the -buffer. Should only be used to set +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>. =item B<PerlIO_set_cnt(f,c)> Obscure - set count of bytes in the buffer. Deprecated. -Currently only used in doio.c to force count < -1 to -1. +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". diff --git a/pod/perlbot.pod b/pod/perlbot.pod index 0f7078f197..30d00558b4 100644 --- a/pod/perlbot.pod +++ b/pod/perlbot.pod @@ -57,7 +57,7 @@ See L<CLASS CONTEXT AND THE OBJECT>. =item 7 -IO syntax is certainly less noisy, but it is also prone to ambiguities which +IO syntax is certainly less noisy, but it is also prone to ambiguities that can cause difficult-to-find bugs. Allow people to use the sure-thing OO syntax, even if you don't like it. @@ -404,7 +404,7 @@ This problem can be solved by using the object to define the context of the method. Let the method look in the object for a reference to the data. The alternative is to force the method to go hunting for the data ("Is it in my class, or in a subclass? Which subclass?"), and this can be inconvenient -and will lead to hackery. It is better to just let the object tell the +and will lead to hackery. It is better just to let the object tell the method where that data is located. package Bar; diff --git a/pod/perlcall.pod b/pod/perlcall.pod index ac9229fbb1..20c863cc57 100644 --- a/pod/perlcall.pod +++ b/pod/perlcall.pod @@ -5,7 +5,7 @@ perlcall - Perl calling conventions from C =head1 DESCRIPTION The purpose of this document is to show you how to call Perl subroutines -directly from C, i.e. how to write I<callbacks>. +directly from C, i.e., how to write I<callbacks>. Apart from discussing the C interface provided by Perl for writing callbacks the document uses a series of examples to show how the @@ -30,7 +30,7 @@ called instead. The classic example of where callbacks are used is when writing an event driven program like for an X windows application. In this case you register functions to be called whenever specific events occur, -e.g. a mouse button is pressed, the cursor moves into a window or a +e.g., a mouse button is pressed, the cursor moves into a window or a menu item is selected. =back @@ -61,7 +61,7 @@ subroutines. They are The key function is I<perl_call_sv>. All the other functions are fairly simple wrappers which make it easier to call Perl subroutines in special cases. At the end of the day they will all call I<perl_call_sv> -to actually invoke the Perl subroutine. +to invoke the Perl subroutine. All the I<perl_call_*> functions have a C<flags> parameter which is used to pass a bit mask of options to Perl. This bit mask operates @@ -84,9 +84,9 @@ use of I<perl_call_sv>. The function, I<perl_call_pv>, is similar to I<perl_call_sv> except it expects its first parameter to be a C char* which identifies the Perl -subroutine you want to call, e.g. C<perl_call_pv("fred", 0)>. If the +subroutine you want to call, e.g., C<perl_call_pv("fred", 0)>. If the subroutine you want to call is in another package, just include the -package name in the string, e.g. C<"pkg::fred">. +package name in the string, e.g., C<"pkg::fred">. =item B<perl_call_method> @@ -208,10 +208,10 @@ automatically for you. Note that it is still possible to indicate a context to the Perl subroutine by using either G_SCALAR or G_ARRAY. If you do not set this flag then it is I<very> important that you make -sure that any temporaries (i.e. parameters passed to the Perl +sure that any temporaries (i.e., parameters passed to the Perl subroutine and values returned from the subroutine) are disposed of yourself. The section I<Returning a Scalar> gives details of how to -explicitly dispose of these temporaries and the section I<Using Perl to +dispose of these temporaries explicitly and the section I<Using Perl to dispose of temporaries> discusses the specific circumstances where you can ignore the problem and let Perl deal with it for you. @@ -254,7 +254,7 @@ belongs to C<joe>. =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 +abnormally, e.g., by calling I<die> explicitly or by not actually existing. By default, when either of these of events occurs, the process will terminate immediately. If though, you want to trap this type of event, specify the G_EVAL flag. It will put an I<eval { }> @@ -408,7 +408,7 @@ Enough of the definition talk, let's have a few examples. Perl provides many macros to assist in accessing the Perl stack. Wherever possible, these macros should always be used when interfacing -to Perl internals. Hopefully this should make the code less vulnerable +to Perl internals. We hope this should make the code less vulnerable to any changes made to Perl in the future. Another point worth noting is that in the first series of examples I @@ -458,7 +458,7 @@ specified. =item 3. We aren't interested in anything returned from I<PrintUID>, so -G_DISCARD is specified. Even if I<PrintUID> was changed to actually +G_DISCARD is specified. Even if I<PrintUID> was changed to return some value(s), having specified G_DISCARD will mean that they will be wiped by the time control returns from I<perl_call_pv>. @@ -529,15 +529,15 @@ have used this macro. The exception to this rule is if you are calling a Perl subroutine directly from an XSUB function. In this case it is not necessary to -explicitly use the C<dSP> macro - it will be declared for you +use the C<dSP> macro explicitly - it will be declared for you automatically. =item 3. Any parameters to be pushed onto the stack should be bracketed by the C<PUSHMARK> and C<PUTBACK> macros. The purpose of these two macros, in -this context, is to automatically count the number of parameters you -are pushing. Then whenever Perl is creating the C<@_> array for the +this context, is to count the number of parameters you are +pushing automatically. Then whenever Perl is creating the C<@_> array for the subroutine, it knows how big to make it. The C<PUSHMARK> macro tells Perl to make a mental note of the current @@ -555,7 +555,7 @@ local copy, I<not> the global copy. =item 4. -The only flag specified this time is G_DISCARD. Since we are passing 2 +The only flag specified this time is G_DISCARD. Because we are passing 2 parameters to the Perl subroutine this time, we have not specified G_NOARGS. @@ -580,7 +580,7 @@ function. Now for an example of dealing with the items returned from a Perl subroutine. -Here is a Perl subroutine, I<Adder>, which takes 2 integer parameters +Here is a Perl subroutine, I<Adder>, that takes 2 integer parameters and simply returns their sum. sub Adder @@ -589,7 +589,7 @@ and simply returns their sum. $a + $b ; } -Since we are now concerned with the return value from I<Adder>, the C +Because we are now concerned with the return value from I<Adder>, the C function required to call it is now a bit more complex. static void @@ -685,7 +685,7 @@ Expecting a single value is not quite the same as knowing that there will be one. If someone modified I<Adder> to return a list and we didn't check for that possibility and take appropriate action the Perl stack would end up in an inconsistent state. That is something you -I<really> don't want to ever happen. +I<really> don't want to happen ever. =item 5. @@ -998,7 +998,7 @@ refers to the C equivalent of C<$@>. Note that the stack is popped using C<POPs> in the block where C<SvTRUE(GvSV(errgv))> is true. This is necessary because whenever a I<perl_call_*> function invoked with G_EVAL|G_SCALAR returns an error, -the top of the stack holds the value I<undef>. Since we want the +the top of the stack holds the value I<undef>. Because we want the program to continue after detecting this error, it is essential that the stack is tidied up by removing the I<undef>. @@ -1026,7 +1026,7 @@ version of the call_Subtract example above inside a destructor: This example will fail to recognize that an error occurred inside the C<eval {}>. Here's why: the call_Subtract code got executed while perl -was cleaning up temporaries when exiting the eval block, and since +was cleaning up temporaries when exiting the eval block, and because call_Subtract is implemented with I<perl_call_pv> using the G_EVAL flag, it promptly reset C<$@>. This results in the failure of the outermost test for C<$@>, and thereby the failure of the error trap. @@ -1064,7 +1064,7 @@ Here is a snippet of XSUB which defines I<CallSubPV>. perl_call_pv(name, G_DISCARD|G_NOARGS) ; That is fine as far as it goes. The thing is, the Perl subroutine -can be specified only as a string. For Perl 4 this was adequate, +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. @@ -1079,7 +1079,7 @@ I<perl_call_sv> instead of I<perl_call_pv>. PUSHMARK(sp) ; perl_call_sv(name, G_DISCARD|G_NOARGS) ; -Since we are using an SV to call I<fred> the following can all be used +Because we are using an SV to call I<fred> the following can all be used CallSubSV("fred") ; CallSubSV(\&fred) ; @@ -1092,7 +1092,7 @@ how you can specify the Perl subroutine. You should note that if it is necessary to store the SV (C<name> in the example above) which corresponds to the Perl subroutine so that it can -be used later in the program, it not enough to just store a copy of the +be used later in the program, it not enough just to store a copy of the pointer to the SV. Say the code above had been like this static SV * rememberSub ; @@ -1143,7 +1143,7 @@ the version of Perl you are using) The variable C<$ref> may have referred to the subroutine C<fred> whenever the call to C<SaveSub1> was made but by the time -C<CallSavedSub1> gets called it now holds the number C<47>. Since we +C<CallSavedSub1> gets called it now holds the number C<47>. Because we saved only a pointer to the original SV in C<SaveSub1>, any changes to C<$ref> will be tracked by the pointer C<rememberSub>. This means that whenever C<CallSavedSub1> gets called, it will attempt to execute the @@ -1185,7 +1185,7 @@ SV. The code below shows C<SaveSub2> modified to do that PUSHMARK(sp) ; perl_call_sv(keepSub, G_DISCARD|G_NOARGS) ; -In order to avoid creating a new SV every time C<SaveSub2> is called, +To avoid creating a new SV every time C<SaveSub2> is called, the function first checks to see if it has been called before. If not, then space for a new SV is allocated and the reference to the Perl subroutine, C<name> is copied to the variable C<keepSub> in one @@ -1247,9 +1247,9 @@ Consider the following Perl code } } -It just implements a very simple class to manage an array. Apart from +It implements just a very simple class to manage an array. Apart from the constructor, C<new>, it declares methods, one static and one -virtual. The static method, C<PrintID>, simply prints out the class +virtual. The static method, C<PrintID>, prints out simply the class name and a version number. The virtual method, C<Display>, prints out a single element of the array. Here is an all Perl example of using it. @@ -1346,7 +1346,7 @@ The output from that will be =head2 Using Perl to dispose of temporaries In the examples given to date, any temporaries created in the callback -(i.e. parameters passed on the stack to the I<perl_call_*> function or +(i.e., parameters passed on the stack to the I<perl_call_*> function or values returned via the stack) have been freed by one of these methods =over 5 @@ -1441,7 +1441,7 @@ 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 -to actually dispose of your temporaries, control must drop back to the +to dispose of your temporaries, control must drop back to the enclosing scope at some stage. In the event driven scenario that may never happen. This means that as time goes on, your program will create more and more temporaries, none of which will ever be freed. As @@ -1450,7 +1450,7 @@ eventually consume all the available memory in your system - kapow! So here is the bottom line - if you are sure that control will revert back to the enclosing Perl scope fairly quickly after the end of your -callback, then it isn't absolutely necessary to explicitly dispose of +callback, then it isn't absolutely necessary to dispose explicitly of any temporaries you may have created. Mind you, if you are at all uncertain about what to do, it doesn't do any harm to tidy up anyway. @@ -1524,7 +1524,7 @@ registers, C<pcb1>, might look like this The mapping between the C callback and the Perl equivalent is stored in the global variable C<callback>. -This will be adequate if you ever need to have only 1 callback +This will be adequate if you ever need to have only one callback registered at any time. An example could be an error handler like the code sketched out above. Remember though, repeated calls to C<register_fatal> will replace the previously registered callback @@ -1761,7 +1761,7 @@ series of C functions to act as the interface to Perl, thus asynch_close(fh) ; -In this case the functions C<fn1>, C<fn2> and C<fn3> are used to +In this case the functions C<fn1>, C<fn2>, and C<fn3> are used to remember the Perl subroutine to be called. Each of the functions holds a separate hard-wired index which is used in the function C<Pcb> to access the C<Map> array and actually call the Perl subroutine. diff --git a/pod/perldata.pod b/pod/perldata.pod index c1144715d8..407a25204f 100644 --- a/pod/perldata.pod +++ b/pod/perldata.pod @@ -19,7 +19,7 @@ I<identifier>, that is, a string beginning with a letter or underscore, and containing letters, underscores, and digits. In some cases, it may be a chain of identifiers, separated by C<::> (or by C<'>, but that's deprecated); all but the last are interpreted as names of -packages, in order to locate the namespace in which to look +packages, to locate the namespace in which to look up the final identifier (see L<perlmod/Packages> for details). It's possible to substitute for a simple identifier an expression which produces a reference to the value at runtime; this is @@ -65,14 +65,14 @@ This means that $foo and @foo are two different variables. It also means that C<$foo[1]> is a part of @foo, not a part of $foo. This may seem a bit weird, but that's okay, because it is weird. -Since variable and array references always start with '$', '@', or '%', +Because variable and array references always start with '$', '@', or '%', the "reserved" words aren't in fact reserved with respect to variable names. (They ARE reserved with respect to labels and filehandles, however, which don't have an initial special character. You can't have a filehandle named "log", for instance. Hint: you could say C<open(LOG,'logfile')> rather than C<open(log,'logfile')>. Using uppercase filehandles also improves readability and protects you from conflict -with future reserved words.) Case I<IS> significant--"FOO", "Foo" and +with future reserved words.) Case I<IS> significant--"FOO", "Foo", and "foo" are all different names. Names that start with a letter or underscore may also contain digits and underscores. @@ -80,9 +80,9 @@ It is possible to replace such an alphanumeric name with an expression that returns a reference to an object of that type. For a description of this, see L<perlref>. -Names that start with a digit may only contain more digits. Names +Names that start with a digit may contain only more digits. Names which do not start with a letter, underscore, or digit are limited to -one character, e.g. C<$%> or C<$$>. (Most of these one character names +one character, e.g., C<$%> or C<$$>. (Most of these one character names have a predefined significance to Perl. For instance, C<$$> is the current process id.) @@ -135,7 +135,7 @@ Scalar variables may contain various kinds of singular data, such as numbers, strings, and references. In general, conversion from one form to another is transparent. (A scalar may not contain multiple values, but may contain a reference to an array or hash containing multiple values.) -Because of the automatic conversion of scalars, operations and functions +Because of the automatic conversion of scalars, operations, and functions that return scalars don't need to care (and, in fact, can't care) whether the context is looking for a string or a number. @@ -183,7 +183,7 @@ for details on regular expressions. The length of an array is a scalar value. You may find the length of array @days by evaluating C<$#days>, as in B<csh>. (Actually, it's not -the length of the array, it's the subscript of the last element, since +the length of the array, it's the subscript of the last element, because there is (ordinarily) a 0th element.) Assigning to C<$#days> changes the length of the array. Shortening an array by this method destroys intervening values. Lengthening an array that was previously shortened @@ -207,7 +207,7 @@ last value, like the C comma operator.) The following is always true: Version 5 of Perl changed the semantics of C<$[>: files that don't set the value of C<$[> no longer need to worry about whether another file changed its value. (In other words, use of C<$[> is deprecated.) -So in general you can just assume that +So in general you can assume that scalar(@whatever) == $#whatever + 1; @@ -220,7 +220,7 @@ If you evaluate a hash in a scalar context, it returns a value which is true if and only if the hash contains any key/value pairs. (If there are any key/value pairs, the value returned is a string consisting of the number of used buckets and the number of allocated buckets, separated -by a slash. This is pretty much only useful to find out whether Perl's +by a slash. This is pretty much useful only to find out whether Perl's (compiled in) hashing algorithm is performing poorly on your data set. For example, you stick 10,000 things in a hash, but evaluating %HASH in scalar context reveals "1/16", which means only one out of sixteen buckets @@ -247,7 +247,7 @@ The usual Unix backslash rules apply for making characters such as newline, tab, etc., as well as some more exotic forms. See L<perlop/Quote and Quotelike Operators> for a list. -You can also embed newlines directly in your strings, i.e. they can end +You can also embed newlines directly in your strings, i.e., they can end on a different line than they begin. This is nice, but if you forget your trailing quote, the error will not be reported until Perl finds another line containing the quote character, which may be much further @@ -276,16 +276,16 @@ in the subscript will be interpreted as an expression. Note that a single-quoted string must be separated from a preceding word by a -space, since single quote is a valid (though deprecated) character in +space, because single quote is a valid (though deprecated) character in a variable name (see L<perlmod/Packages>). Two special literals are __LINE__ and __FILE__, which represent the current line number and filename at that point in your program. They -may only be used as separate tokens; they will not be interpolated into +may be used only as separate tokens; they will not be interpolated into strings. In addition, the token __END__ may be used to indicate the logical end of the script before the actual end of file. Any following text is ignored, but may be read via the DATA filehandle. (The DATA -filehandle may read data only from the main script, but not from any +filehandle may read data from only the main script, but not from any required file or evaluated string.) The two control characters ^D and ^Z are synonyms for __END__ (or __DATA__ in a module; see L<SelfLoader> for details on __DATA__). @@ -432,7 +432,7 @@ put the list in parentheses to avoid ambiguity. Examples: $time = (stat($file))[8]; # SYNTAX ERROR HERE. - $time = stat($file)[8]; # OOPS, FORGOT PARENS + $time = stat($file)[8]; # OOPS, FORGOT PARENTHESES # Find a hex digit. $hexdigit = ('a','b','c','d','e','f')[$digit-10]; @@ -454,7 +454,7 @@ produced by the expression on the right side of the assignment: $x = (($foo,$bar) = f()); # set $x to f()'s return count This is very handy when you want to do a list assignment in a Boolean -context, since most list functions return a null list when finished, +context, because most list functions return a null list when finished, which when assigned produces a 0, which is interpreted as FALSE. The final element may be an array or a hash: @@ -513,7 +513,7 @@ Note that just because a hash is initialized in that order doesn't mean that it comes out in that order. See L<perlfunc/sort> for examples of how to arrange for an output ordering. -=head2 Typeglobs +=head2 Typeglobs and Filehandles 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 @@ -522,7 +522,29 @@ 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 that we have the *foo{THING} notation it isn't often needed for that, -either. +either. It is still needed to pass new filehandles into functions +(*HANDLE{IO} only works if HANDLE has already been used). + +If you need to use a typeglob to save away a filehandle, do it this way: + + $fh = *STDOUT; + +or perhaps as a real reference, like this: + + $fh = \*STDOUT; + +This is also a way to create a local filehandle. For example: + + sub newopen { + my $path = shift; + local *FH; # not my! + open (FH, $path) || return undef; + return \*FH; + } + $fh = newopen('/etc/passwd'); + +Another way to create local filehandles is with IO::Handle and its ilk, +see the bottom of L<perlfunc/open()>. See L<perlref>, L<perlsub>, and L<perlmod/"Symbol Tables"> for more discussion on typeglobs. diff --git a/pod/perldebug.pod b/pod/perldebug.pod index f9dd6f4ab6..5d67ba41a6 100644 --- a/pod/perldebug.pod +++ b/pod/perldebug.pod @@ -11,7 +11,7 @@ First of all, have you tried using the B<-w> switch? If you invoke Perl with the B<-d> switch, your script runs under the 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 +source code, set breakpoints, get stack back-traces, 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 interactively to see what they do. For example: @@ -63,12 +63,12 @@ it's run through your pager, as in =item p expr Same as C<print {$DB::OUT} expr> in the current package. In particular, -since this is just Perl's own B<print> function, this means that nested +because this is just Perl's own B<print> function, this means that nested data structures and objects are not dumped, unlike with the C<x> command. =item x expr -Evals 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. @@ -97,7 +97,7 @@ Same as C<V currentpackage [vars]>. =item T -Produce a stack backtrace. See below for details on its output. +Produce a stack back-trace. See below for details on its output. =item s [expr] @@ -218,7 +218,7 @@ or, with the C<O>ption C<frame=2> set, Set a breakpoint. If line is omitted, sets a breakpoint on the line that is about to be executed. If a condition is specified, it's evaluated each time the statement is reached and a breakpoint is taken -only if the condition is true. Breakpoints may only be set on lines +only if the condition is true. Breakpoints may be set on only lines that begin an executable statement. Conditions don't use B<if>: b 237 $x > 30 @@ -332,7 +332,7 @@ affects printing of return value after C<r> command. affects printing messages on entry and exit from subroutines. If C<frame & 2> is false, messages are printed on entry only. (Printing -on exit may be useful if interdispersed with other messages.) +on exit may be useful if inter(di)spersed with other messages.) If C<frame & 4>, arguments to functions are printed as well as the context and caller info. @@ -455,37 +455,37 @@ See L<"Debugger Internals"> below for more details. =item E<lt> [ command ] Set an action (Perl command) to happen before every debugger prompt. -A multiline command may be entered by backslashing the newlines. If +A multi-line command may be entered by backslashing the newlines. If C<command> is missing, resets the list of actions. =item E<lt>E<lt> command Add an action (Perl command) to happen before every debugger prompt. -A multiline command may be entered by backslashing the newlines. +A multi-line command may be entered by backslashing the newlines. =item E<gt> command Set an action (Perl command) to happen after the prompt when you've -just given a command to return to executing the script. A multiline +just given a command to return to executing the script. A multi-line command may be entered by backslashing the newlines. If C<command> is missing, resets the list of actions. =item E<gt>E<gt> command Adds an action (Perl command) to happen after the prompt when you've -just given a command to return to executing the script. A multiline +just given a command to return to executing the script. A multi-line command may be entered by backslashing the newlines. =item { [ command ] Set an action (debugger command) to happen before every debugger prompt. -A multiline command may be entered by backslashing the newlines. If +A multi-line command may be entered by backslashing the newlines. If C<command> is missing, resets the list of actions. =item {{ command Add an action (debugger command) to happen before every debugger prompt. -A multiline command may be entered by backslashing the newlines. +A multi-line command may be entered by backslashing the newlines. =item ! number @@ -525,9 +525,9 @@ Restart the debugger by B<exec>ing a new session. It tries to maintain your history across this, but internal settings and command line options may be lost. -Currently the following setting are preserved: history, breakpoints -and actions, debugger C<O>ptions and the following command-line -options: B<-w>, B<-I>, B<-e>. +Currently the following setting are preserved: history, breakpoints, +actions, debugger C<O>ptions, and the following command-line +options: B<-w>, B<-I>, and B<-e>. =item |dbcmd @@ -566,7 +566,7 @@ 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 built-in 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 @@ -588,7 +588,7 @@ normally end the debugger command with a backslash. Here's an example: Note that this business of escaping a newline is specific to interactive commands typed into the debugger. -Here's an example of what a stack backtrace might look like: +Here's an example of what a stack back-trace might look like: $ = main::infested called from file `Ambulation.pm' line 10 @ = Ambulation::legs(1, 2, 3, 4) called from file `camel_flea' line 7 @@ -763,16 +763,16 @@ the form C<(eval 31)> for subroutines defined inside C<eval>s. =item * -When an exection of the application reaches a place that can have a -breakpoint, a call to C<DB::DB()> is performed if any one of -variables $DB::trace, $DB::single, $DB::signal is true. (Note that +When execution of the application reaches a place that can have +a breakpoint, a call to C<DB::DB()> is performed if any one of +variables $DB::trace, $DB::single, or $DB::signal is true. (Note that these variables are not C<local>izable.) This feature is disabled when the control is inside C<DB::DB()> or functions called from it (unless C<$^D & 1 E<lt>E<lt> 30>). =item * -When an exection of the application reaches a subroutine call, a call +When execution of the application reaches a subroutine call, a call to C<&DB::sub>(I<args>) is performed instead, with C<$DB::sub> being the name of the called subroutine. (Unless the subroutine is compiled in the package C<DB>.) @@ -792,7 +792,7 @@ 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. -After the rc file is read, the debugger reads environment variable +After the rc file is read, the debugger reads environment variable PERLDB_OPTS and parses it as a rest of C<O ...> line in debugger prompt. It also maintains magical internal variables, such as C<@DB::dbline>, @@ -807,7 +807,7 @@ function C<DB::dump_trace(skip[, count])> skips the specified number of frames, and returns an array containing info about the caller frames (all if C<count> is missing). Each entry is a hash with keys 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 +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 @@ -824,7 +824,4 @@ You cannot get the stack frame information or otherwise debug functions that were not compiled by Perl, such as C or C++ extensions. If you alter your @_ arguments in a subroutine (such as with B<shift> -or B<pop>, the stack backtrace will not show the original values. - -Some subroutines are called without creating a call frame. This may -confuse backtrace C<T> and output of C<fE<gt>=4>. +or B<pop>, the stack back-trace will not show the original values. diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 20f4fbd585..bbd699faaa 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -53,7 +53,7 @@ no useful value. See L<perlmod>. =item % may only be used in unpack -(F) You can't pack a string by supplying a checksum, since the +(F) You can't pack a string by supplying a checksum, because the checksumming process loses information, and you can't go the other way. See L<perlfunc/unpack>. @@ -61,15 +61,27 @@ way. See L<perlfunc/unpack>. (W) You've run afoul of the rule that says that any list operator followed by parentheses turns into a function, with all the list operators arguments -found inside the parens. See L<perlop/Terms and List Operators (Leftward)>. +found inside the parentheses. See L<perlop/Terms and List Operators (Leftward)>. =item %s argument is not a HASH element -(F) The argument to delete() or exists() must be a hash element, such as +(F) The argument to exists() must be a hash element, such as $foo{$bar} $ref->[12]->{"susie"} +=item %s argument is not a HASH element or slice + +(F) The argument to delete() must be either a hash element, such as + + $foo{$bar} + $ref->[12]->{"susie"} + +or a hash slice, such as + + @foo{$bar, $baz, $xyzzy} + @{$ref->[12]}{"susie", "queue"} + =item %s did not return a true value (F) A required (or used) file must return a true value to indicate that @@ -176,7 +188,7 @@ the return value of your socket() call? See L<perlfunc/accept>. (W)(S) You said something that may not be interpreted the way you thought. Normally it's pretty easy to disambiguate it by supplying -a missing quote, operator, paren pair or declaration. +a missing quote, operator, parenthesis pair or declaration. =item Args must match #! line @@ -252,7 +264,7 @@ dereference it first. See L<perlfunc/substr>. (F) You passed a buffer of the wrong size to one of msgctl(), semctl() or shmctl(). In C parlance, the correct sizes are, respectively, -S<sizeof(struct msqid_ds *)>, S<sizeof(struct semid_ds *)> and +S<sizeof(struct msqid_ds *)>, S<sizeof(struct semid_ds *)>, and S<sizeof(struct shmid_ds *)>. =item Bad associative array @@ -336,7 +348,7 @@ exited by calling exit. except that there's this itty bitty problem called there isn't a current block. Note that an "if" or "else" block doesn't count as a "loopish" block. You can usually double the curlies to get the same -effect though, since the inner curlies will be considered a block +effect though, because the inner curlies will be considered a block that loops once. See L<perlfunc/last>. =item Can't "next" outside a block @@ -344,7 +356,7 @@ that loops once. See L<perlfunc/last>. (F) A "next" statement was executed to reiterate the current block, but there isn't a current block. Note that an "if" or "else" block doesn't count as a "loopish" block. You can usually double the curlies to get -the same effect though, since the inner curlies will be considered a block +the same effect though, because the inner curlies will be considered a block that loops once. See L<perlfunc/last>. =item Can't "redo" outside a block @@ -352,7 +364,7 @@ that loops once. See L<perlfunc/last>. (F) A "redo" statement was executed to restart the current block, but there isn't a current block. Note that an "if" or "else" block doesn't count as a "loopish" block. You can usually double the curlies to get -the same effect though, since the inner curlies will be considered a block +the same effect though, because the inner curlies will be considered a block that loops once. See L<perlfunc/last>. =item Can't bless non-reference value @@ -427,14 +439,14 @@ or other plumbing problems. =item Can't declare %s in my -(F) Only scalar, array and hash variables may be declared as lexical variables. +(F) Only scalar, array, and hash variables may be declared as lexical variables. They must have ordinary identifiers as names. =item Can't do inplace edit on %s: %s (S) The creation of the new file failed for the indicated reason. -=item Can't do inplace edit without backup +=item Can't do in-place 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 @@ -484,7 +496,7 @@ For example, it'd be kind of silly to put a B<-x> on the #! line. =item Can't exec "%s": %s -(W) An system(), exec() or piped open call could not execute the named +(W) An system(), exec(), or piped open call could not execute the named program for the indicated reason. Typical reasons include: the permissions were wrong on the file, the file wasn't found in C<$ENV{PATH}>, the executable in question was compiled for another architecture, or the @@ -510,7 +522,7 @@ for us to go to. See L<perlfunc/goto>. =item Can't find string terminator %s anywhere before EOF (F) Perl strings can stretch over multiple lines. This message means that -the closing delimiter was omitted. Since bracketed quotes count nesting +the closing delimiter was omitted. Because bracketed quotes count nesting levels, the following is missing its final parenthesis: print q(The character '(' starts a side comment.) @@ -537,7 +549,7 @@ assumes that the stat buffer contains all the necessary information, and passes it, instead of the filespec, to the access checking routine. It will try to retrieve the filespec using the device name and FID present in the stat buffer, but this works only if you haven't made a subsequent call to the CRTL stat() -routine, since the device name is overwritten with each call. If this warning +routine, because the device name is overwritten with each call. If this warning appears, the name lookup failed, and the access checking routine gave up and returned FALSE, just to be conservative. (Note: The access checking routine knows about the Perl C<stat> operator and file tests, so you shouldn't ever @@ -558,7 +570,7 @@ mailbox buffers to be, and didn't get an answer. (F) The deeply magical "goto subroutine" call can only replace one subroutine call for another. It can't manufacture one out of whole cloth. In general -you should only be calling it out of an AUTOLOAD routine anyway. See +you should be calling it out of only an AUTOLOAD routine anyway. See L<perlfunc/goto>. =item Can't localize a reference @@ -602,16 +614,16 @@ a B<-e> switch. Maybe your /tmp partition is full, or clobbered. =item Can't modify %s in %s (F) You aren't allowed to assign to the item indicated, or otherwise try to -change it, such as with an autoincrement. +change it, such as with an auto-increment. =item Can't modify non-existent substring (P) The internal routine that does assignment to a substr() was handed a NULL. -=item Can't msgrcv to readonly var +=item Can't msgrcv to read-only var -(F) The target of a msgrcv must be modifiable in order to be used as a receive +(F) The target of a msgrcv must be modifiable to be used as a receive buffer. =item Can't open %s: %s @@ -684,7 +696,7 @@ of suidperl. =item Can't take log of %g -(F) Logarithms are only defined on positive real numbers. +(F) Logarithms are defined on only positive real numbers. =item Can't take sqrt of %g @@ -738,7 +750,7 @@ test the type of the reference, if need be. (W) In an ordinary expression, backslash is a unary operator that creates a reference to its argument. The use of backslash to indicate a backreference -to a matched substring is only valid as part of a regular expression pattern. +to a matched substring is valid only as part of a regular expression pattern. Trying to do this in ordinary Perl code produces a value that prints out looking like SCALAR(0xdecaf). Use the $1 form instead. @@ -755,7 +767,7 @@ be a defined value. This helps to de-lurk some insidious errors. =item Can't use global %s in "my" (F) You tried to declare a magical variable as a lexical variable. This is -not allowed, because the magic can only be tied to one location (namely +not allowed, because the magic can be tied to only one location (namely the global variable) and it would be incredibly confusing to have variables in your program that looked like magical variables but weren't. @@ -771,7 +783,7 @@ didn't look like an array reference, or anything else subscriptable. (F) The write routine failed for some reason while trying to process a B<-e> switch. Maybe your /tmp partition is full, or clobbered. -=item Can't x= to readonly value +=item Can't x= to read-only value (F) You tried to repeat a constant value (often the undefined value) with an assignment operator, which implies modifying the value itself. @@ -830,7 +842,12 @@ case it indicates something else. (W) You probably said %hash{$key} when you meant $hash{$key} or @hash{@keys}. On the other hand, maybe you just meant %hash and got carried away. -=item Do you need to predeclare %s? +=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 Do you need to pre-declare %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 @@ -869,7 +886,7 @@ The interpreter is immediately exited. =item Error converting file specification %s -(F) An error peculiar to VMS. Since Perl may have to deal with file +(F) An error peculiar to VMS. Because Perl may have to deal with file specifications in either VMS or Unix syntax, it converts them to a single form when it must operate on them directly. Either you've passed an invalid file specification to Perl, or you've found a @@ -912,20 +929,20 @@ PDP-11 or something? You need to do an open() or a socket() call, or call a constructor from the FileHandle package. -=item Filehandle %s opened only for input +=item Filehandle %s opened for only input (W) You tried to write on a read-only filehandle. If you intended it to be a read-write filehandle, you needed to open it with "+E<lt>" or "+E<gt>" or "+E<gt>E<gt>" instead of with "E<lt>" or nothing. If -you only intended to write the file, use "E<gt>" or "E<gt>E<gt>". See +you intended only to write the file, use "E<gt>" or "E<gt>E<gt>". See L<perlfunc/open>. -=item Filehandle only opened for input +=item Filehandle opened for only input (W) You tried to write on a read-only filehandle. If you intended it to be a read-write filehandle, you needed to open it with "+E<lt>" or "+E<gt>" or "+E<gt>E<gt>" instead of with "E<lt>" or nothing. If -you only intended to write the file, use "E<gt>" or "E<gt>E<gt>". See +you intended only to write the file, use "E<gt>" or "E<gt>E<gt>". See L<perlfunc/open>. =item Final $ should be \$ or $name @@ -1022,8 +1039,8 @@ is now heavily deprecated. (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 occurence, as some software packages +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, or it may indicate that a logical name table has been corrupted. @@ -1084,7 +1101,7 @@ architecture. On a 32-bit architecture the largest octal literal is =item Internal inconsistency in tracking vforks (S) A warning peculiar to VMS. Perl keeps track of the number -of times you've called C<fork> and C<exec>, in order to determine +of times you've called C<fork> and C<exec>, to determine whether the current call to C<exec> should affect the current script or a subprocess (see L<perlvms/exec>). Somehow, this count has become scrambled, so Perl is making a guess and treating @@ -1192,7 +1209,7 @@ the previous line just because you saw this message. =item Modification of a read-only value attempted (F) You tried, directly or indirectly, to change the value of a -constant. You didn't, of course, try "2 = 1", since the compiler +constant. You didn't, of course, try "2 = 1", because the compiler catches that. But an easy way to do the same thing is: sub mod { $_[0] = 1 } @@ -1238,10 +1255,10 @@ that is less than 0. This is difficult to imagine. =item nested *?+ in regexp -(F) You can't quantify a quantifier without intervening parens. So +(F) You can't quantify a quantifier without intervening parentheses. So things like ** or +* or ?* are illegal. -Note, however, that the minimal matching quantifiers, *?, +? and ?? appear +Note, however, that the minimal matching quantifiers, C<*?>, C<+?>, and C<??> appear to be nested quantifiers, but aren't. See L<perlre>. =item No #! line @@ -1284,7 +1301,7 @@ right. =item No dbm on this machine (P) This is counted as an internal error, because every machine should -supply dbm nowadays, since Perl comes with SDBM. See L<SDBM_File>. +supply dbm nowadays, because Perl comes with SDBM. See L<SDBM_File>. =item No DBsub routine @@ -1414,7 +1431,7 @@ See L<perlform>. =item Null filename used -(F) You can't require the null filename, especially since on many machines +(F) You can't require the null filename, especially because on many machines that means the current directory! See L<perlfunc/require>. =item Null picture in formline @@ -1433,7 +1450,7 @@ supplied it an uninitialized value. See L<perlform>. =item NULL regexp argument -(P) The internal pattern matching routines blew it bigtime. +(P) The internal pattern matching routines blew it big time. =item NULL regexp parameter @@ -1442,7 +1459,7 @@ supplied it an uninitialized value. See L<perlform>. =item Odd number of elements in hash list (S) You specified an odd number of elements to a hash list, which is odd, -since hash lists come in key/value pairs. +because hash lists come in key/value pairs. =item Offset outside string @@ -1554,7 +1571,7 @@ it wasn't a block context. =item panic: leave_scope clearsv -(P) A writable lexical variable became readonly somehow within the scope. +(P) A writable lexical variable became read-only somehow within the scope. =item panic: leave_scope inconsistency @@ -1640,7 +1657,7 @@ was string. (P) The lexer got into a bad state while processing a case modifier. -=item Parens missing around "%s" list +=item Pareneses missing around "%s" list (W) You said something like @@ -1675,7 +1692,7 @@ the BSD version, which takes a pid. =item Possible attempt to put comments in qw() list -(W) You probably wrote somthing like this: +(W) You probably wrote something like this: qw( a # a comment b # another comment @@ -1689,7 +1706,7 @@ when you should have written this: =item Possible attempt to separate words with commas -(W) You probably wrote somthing like this: +(W) You probably wrote something like this: qw( a, b, c ); @@ -1716,7 +1733,7 @@ is now misinterpreted as because of the strict regularization of Perl 5's grammar into unary and list operators. (The old open was a little of both.) You must put -parens around the filehandle, or use the new "or" operator instead of "||". +parentheses around the filehandle, or use the new "or" operator instead of "||". =item print on closed filehandle %s @@ -1738,7 +1755,7 @@ last argument of the previous construct, for example: =item Prototype mismatch: (%s) vs (%s) -(S) The subroutine being defined had a predeclared (forward) declaration +(S) The subroutine being defined had a pre-declared (forward) declaration with a different function prototype. =item Read on closed filehandle E<lt>%sE<gt> @@ -1803,10 +1820,10 @@ an array. Generally it's better to ask for a scalar value (indicated by $). The difference is that C<$foo[&bar]> always behaves like a scalar, both when 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 only expecting one subscript. +subscript, which can do weird things if you're expecting only one subscript. On the other hand, if you were actually hoping to treat the array -element as a list, you need to look into how references work, since +element as a list, you need to look into how references work, because Perl will not magically convert between scalars and lists for you. See L<perlref>. @@ -1851,7 +1868,7 @@ Check your logic flow. =item Sequence (?#... not terminated (F) A regular expression comment must be terminated by a closing -parenthesis. Embedded parens aren't allowed. See L<perlre>. +parenthesis. Embedded parentheses aren't allowed. See L<perlre>. =item Sequence (?%s...) not implemented @@ -1963,7 +1980,7 @@ by itself. (P) The substitution was looping infinitely. (Obviously, a substitution shouldn't iterate more times than there are characters of input, which is what happened.) See the discussion of substitution in -L<perlop/"Quote and Quotelike Operators">. +L<perlop/"Quote and Quote-like Operators">. =item Substitution pattern not terminated @@ -2001,7 +2018,7 @@ Often there will be another error message associated with the syntax error giving more information. (Sometimes it helps to turn on B<-w>.) The error message itself often tells you where it was in the line when it decided to give up. Sometimes the actual error is several tokens -before this, since Perl is good at understanding random input. +before this, because Perl is good at understanding random input. Occasionally the line number may be misleading, and once in a blue moon the only way to figure out what's triggering the error is to call C<perl -c> repeatedly, chopping away half the program each time to see @@ -2015,7 +2032,7 @@ into Perl yourself. =item System V IPC is not implemented on this machine -(F) You tried to do something with a function beginning with "sem", "shm" +(F) You tried to do something with a function beginning with "sem", "shm", or "msg". See L<perlfunc/semctl>, for example. =item Syswrite on closed filehandle @@ -2036,7 +2053,7 @@ open. Check your logic. See also L<perlfunc/-X>. =item That use of $[ is unsupported (F) Assignment to C<$[> is now strictly circumscribed, and interpreted as -a compiler directive. You may only say one of +a compiler directive. You may say only one of $[ = 0; $[ = 1; @@ -2087,7 +2104,7 @@ into Perl yourself. =item Too many args to syscall -(F) Perl only supports a maximum of 14 args to syscall(). +(F) Perl supports a maximum of only 14 args to syscall(). =item Too many arguments for %s @@ -2122,7 +2139,7 @@ certain type. Arrays must be @NAME or C<@{EXPR}>. Hashes must be =item umask: argument is missing initial 0 -(W) A umask of 222 is incorrect. It should be 0222, since octal literals +(W) A umask of 222 is incorrect. It should be 0222, because octal literals always start with 0 in Perl, as in C. =item Unable to create sub named "%s" @@ -2186,13 +2203,13 @@ representative, who probably put it there in the first place. =item Unknown BYTEORDER -(F) There are no byteswapping functions for a machine with this byte order. +(F) There are no byte-swapping functions for a machine with this byte order. =item unmatched () in regexp (F) Unbackslashed parentheses must always be balanced in regular expressions. If you're a vi user, the % key is valuable for finding -the matching paren. See L<perlre>. +the matching parenthesis. See L<perlre>. =item Unmatched right bracket @@ -2263,15 +2280,15 @@ Use an explicit printf() or sprintf() instead. =item Use of $* is deprecated -(D) This variable magically turned on multiline pattern matching, both for +(D) This variable magically turned on multi-line pattern matching, both for you and for any luckless subroutine that you happen to call. You should use the new C<//m> and C<//s> modifiers now to do that without the dangerous action-at-a-distance effects of C<$*>. =item Use of %s in printf format not supported -(F) You attempted to use a feature of printf that is accessible only -from C. This usually means there's a better way to do it in Perl. +(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 @@ -2346,12 +2363,17 @@ on the front of your variable. of Perl. Check the E<lt>#!E<gt> line, or manually feed your script into Perl yourself. +=item Warning: something's wrong. + +(W) You passed warn() an empty string (the equivalent of C<warn "">) or +you called it with no args and C<$_> was empty. + =item Warning: unable to close filehandle %s properly. (S) The implicit close() done by an open() got an error indication on the -close(). This usually indicates your filesystem ran out of disk space. +close(). This usually indicates your file system ran out of disk space. -=item Warning: Use of "%s" without parens is ambiguous +=item Warning: Use of "%s" without parentheses is ambiguous (S) You wrote a unary operator followed by something that looks like a binary operator that could also have been interpreted as a term or @@ -2368,7 +2390,7 @@ but in actual fact, you got rand(+5); -So put in parens to say what you really mean. +So put in parentheses to say what you really mean. =item Write on closed filehandle @@ -2401,7 +2423,7 @@ Use a filename instead. =item YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET! -(F) And you probably never will, since you probably don't have the +(F) And you probably never will, because you probably don't have the sources to your kernel, and your vendor probably doesn't give a rip about what you want. Your best bet is to use the wrapsuid script in the eg directory to put a setuid C wrapper around your script. @@ -2422,7 +2444,7 @@ See L<perlfunc/getsockopt>. =item \1 better written as $1 (W) Outside of patterns, backreferences live on as variables. The use -of backslashes is grandfathered on the righthand side of a +of backslashes is grandfathered on the right-hand side of a substitution, but stylistically it's better to use the variable form because other Perl programmers will expect it, and it works better if there are more than 9 backreferences. @@ -2451,7 +2473,7 @@ streams, such as =item Got an error from DosAllocMem: (P) An error peculiar to OS/2. Most probably you use an obsolete version -of perl, and should not happen anyway. +of perl, and this should not happen anyway. =item Malformed PERLLIB_PREFIX diff --git a/pod/perldsc.pod b/pod/perldsc.pod index 6991e7a085..5beaa8bbe9 100644 --- a/pod/perldsc.pod +++ b/pod/perldsc.pod @@ -30,7 +30,7 @@ with three dimensions! Alas, however simple this may appear, underneath it's a much more elaborate construct than meets the eye! -How do you print it out? Why can't you just say C<print @LoL>? How do +How do you print it out? Why can't you say just C<print @LoL>? How do you sort it? How can you pass it to a function or get one of these back from a function? Is is an object? Can you save it to disk to read back later? How do you access whole rows or columns of that matrix? Do @@ -41,11 +41,11 @@ of the blame for this can be attributed to the reference-based implementation, it's really more due to a lack of existing documentation with examples designed for the beginner. -This document is meant to be a detailed but understandable treatment of -the many different sorts of data structures you might want to develop. It should -also serve as a cookbook of examples. That way, when you need to create one of these -complex data structures, you can just pinch, pilfer, or purloin -a drop-in example from here. +This document is meant to be a detailed but understandable treatment of the +many different sorts of data structures you might want to develop. It +should also serve as a cookbook of examples. That way, when you need to +create one of these complex data structures, you can just pinch, pilfer, or +purloin a drop-in example from here. Let's look at each of these possible constructs in detail. There are separate documents on each of the following: @@ -76,15 +76,15 @@ of these types of data structures. The most important thing to understand about all data structures in Perl -- including multidimensional arrays--is that even though they might appear otherwise, Perl C<@ARRAY>s and C<%HASH>es are all internally -one-dimensional. They can only hold scalar values (meaning a string, +one-dimensional. They can hold only scalar values (meaning a string, number, or a reference). They cannot directly contain other arrays or hashes, but instead contain I<references> to other arrays or hashes. -You can't use a reference to a array or hash in quite the same way that -you would a real array or hash. For C or C++ programmers unused to distinguishing -between arrays and pointers to the same, this can be confusing. If so, -just think of it as the difference between a structure and a pointer to a -structure. +You can't use a reference to a array or hash in quite the same way that you +would a real array or hash. For C or C++ programmers unused to +distinguishing between arrays and pointers to the same, this can be +confusing. If so, just think of it as the difference between a structure +and a pointer to a structure. You can (and should) read more about references in the perlref(1) man page. Briefly, references are rather like pointers that know what they @@ -102,7 +102,7 @@ multidimensional arrays work as well. $hash{string}[7] # hash of arrays $hash{string}{'another string'} # hash of hashes -Now, because the top level only contains references, if you try to print +Now, because the top level contains only references, if you try to print out your array in with a simple print() function, you'll get something that doesn't look very nice, like this: @@ -149,7 +149,7 @@ again and again: $LoL[$i] = \@list; # WRONG! } -So, just what's the big problem with that? It looks right, doesn't it? +So, what's the big problem with that? It looks right, doesn't it? After all, I just told you that you need an array of references, so by golly, you've made me one! @@ -218,7 +218,7 @@ something is "interesting", that rather than meaning "intriguing", they're disturbingly more apt to mean that it's "annoying", "difficult", or both? :-) -So just remember to always use the array or hash constructors with C<[]> +So just remember always to use the array or hash constructors with C<[]> or C<{}>, and you'll be fine, although it's not always optimally efficient. @@ -290,14 +290,14 @@ this: my $listref = [ [ "fred", "barney", "pebbles", "bambam", "dino", ], [ "homer", "bart", "marge", "maggie", ], - [ "george", "jane", "alroy", "judy", ], + [ "george", "jane", "elroy", "judy", ], ]; print $listref[2][2]; The compiler would immediately flag that as an error I<at compile time>, because you were accidentally accessing C<@listref>, an undeclared -variable, and it would thereby remind you to instead write: +variable, and it would thereby remind you to write instead: print $listref->[2][2] @@ -325,7 +325,7 @@ example, given the assignment to $LoL above, here's the debugger output: 2 ARRAY(0x13b540) 0 'george' 1 'jane' - 2 'alroy' + 2 'elroy' 3 'judy' There's also a lower-case B<x> command which is nearly the same. @@ -449,7 +449,7 @@ types of data structures. # print the whole thing with indices foreach $family ( keys %HoL ) { print "family: "; - foreach $i ( 0 .. $#{ $HoL{$family} ) { + foreach $i ( 0 .. $#{ $HoL{$family} } ) { print " $i = $HoL{$family}[$i]"; } print "\n"; @@ -746,7 +746,7 @@ many different sorts: # reading from file # this is most easily done by having the file itself be # in the raw data format as shown above. perl is happy - # to parse complex datastructures if declared as data, so + # to parse complex data structures if declared as data, so # sometimes it's easiest to do that # here's a piece by piece build up @@ -817,7 +817,7 @@ You cannot easily tie a multilevel data structure (such as a hash of hashes) to a dbm file. The first problem is that all but GDBM and Berkeley DB have size limitations, but beyond that, you also have problems with how references are to be represented on disk. One experimental -module that does attempt to partially address this need is the MLDBM +module that does partially attempt to address this need is the MLDBM module. Check your nearest CPAN site as described in L<perlmod> for source code to MLDBM. diff --git a/pod/perlembed.pod b/pod/perlembed.pod index 186dc88a7b..ea0e8331f2 100644 --- a/pod/perlembed.pod +++ b/pod/perlembed.pod @@ -16,7 +16,7 @@ Read L<perlcall> and L<perlxs>. =item B<Use a UNIX program from Perl?> -Read about backquotes and about C<system> and C<exec> in L<perlfunc>. +Read about back-quotes and about C<system> and C<exec> in L<perlfunc>. =item B<Use Perl from Perl?> @@ -142,7 +142,7 @@ I<miniperlmain.c> containing the essentials of embedding: Note that we do not use the C<env> pointer here or in any of the following examples. -Normally handed to C<perl_parse> as it's final argument, +Normally handed to C<perl_parse> as its final argument, we hand it a B<NULL> instead, in which case the current environment is used. @@ -303,14 +303,14 @@ substitutions: I<match()>, I<substitute()>, and I<matches()>. char match(char *string, char *pattern); -Given a string and a pattern (e.g. "m/clasp/" or "/\b\w*\b/", which in +Given a string and a pattern (e.g., "m/clasp/" or "/\b\w*\b/", which in your program might be represented as C<"/\\b\\w*\\b/">), returns 1 if the string matches the pattern and 0 otherwise. int substitute(char *string[], char *pattern); -Given a pointer to a string and an "=~" operation (e.g. "s/bob/robert/g" or +Given a pointer to a string and an "=~" operation (e.g., "s/bob/robert/g" or "tr[A-Z][a-z]"), modifies the string according to the operation, returning the number of substitutions made. @@ -488,9 +488,9 @@ described in L<perlcall>. Once you've understood those, embedding Perl in C is easy. -Since C has no built-in function for integer exponentiation, let's +Because C has no built-in function for integer exponentiation, let's make Perl's ** operator available to it (this is less useful than it -sounds, since Perl implements ** with C's I<pow()> function). First +sounds, because Perl implements ** with C's I<pow()> function). First I'll create a stub exponentiation function in I<power.pl>: sub expo { @@ -612,7 +612,7 @@ counterpart for each of the extension's XSUBs. Don't worry about this part; leave that to the I<xsubpp> and extension authors. If your extension is dynamically loaded, DynaLoader creates I<Module::bootstrap()> for you on the fly. In fact, if you have a working DynaLoader then there -is rarely any need to statically link in any other extensions. +is rarely any need to link in any other extensions statically. Once you have this code, slap it into the second argument of I<perl_parse()>: @@ -644,7 +644,7 @@ Consult L<perlxs> and L<perlguts> for more details. =head1 MORAL You can sometimes I<write faster code> in C, but -you can always I<write code faster> in Perl. Since you can use +you can always I<write code faster> in Perl. Because you can use each from the other, combine them as you wish. diff --git a/pod/perlform.pod b/pod/perlform.pod index a9ce4a7876..4fac1a69e3 100644 --- a/pod/perlform.pod +++ b/pod/perlform.pod @@ -198,7 +198,7 @@ Much better! =head1 NOTES -Since 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: diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 35f840fa33..49b77f02fc 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -14,8 +14,8 @@ a unary operator, but merely separates the arguments of a list operator. A unary operator generally provides a scalar context to its argument, while a list operator may provide either scalar and list contexts for its arguments. If it does both, the scalar arguments will -be first, and the list argument will follow. (Note that there can only -ever be one list argument.) For instance, splice() has three scalar +be first, and the list argument will follow. (Note that there can ever +be only one list argument.) For instance, splice() has three scalar arguments followed by a list. In the syntax descriptions that follow, list operators that expect a @@ -28,7 +28,7 @@ Elements of the LIST should be separated by commas. Any function in the list below may be used either with or without parentheses around its arguments. (The syntax descriptions omit the -parens.) If you use the parens, the simple (but occasionally +parentheses.) If you use the parentheses, the simple (but occasionally surprising) rule is this: It I<LOOKS> like a function, therefore it I<IS> a function, and precedence doesn't matter. Otherwise it's a list operator or unary operator, and precedence does matter. And whitespace @@ -252,12 +252,12 @@ operator may be any of: -C Same for inode change time. The interpretation of the file permission operators C<-r>, C<-R>, C<-w>, -C<-W>, C<-x> and C<-X> is based solely on the mode of the file and the +C<-W>, C<-x>, and C<-X> is based solely on the mode of the file and the uids and gids of the user. There may be other reasons you can't actually read, write or execute the file. Also note that, for the superuser, -C<-r>, C<-R>, C<-w> and C<-W> always return 1, and C<-x> and C<-X> return +C<-r>, C<-R>, C<-w>, and C<-W> always return 1, and C<-x> and C<-X> return 1 if any execute bit is set in the mode. Scripts run by the superuser may -thus need to do a stat() in order to determine the actual mode of the +thus need to do a stat() to determine the actual mode of the file, or temporarily set the uid to something else. Example: @@ -385,7 +385,7 @@ is taken as the name of the filehandle. This function tells the referenced object (passed as REF) that it is now an object in the CLASSNAME package--or the current package if no CLASSNAME is specified, which is often the case. It returns the reference for -convenience, since a bless() is often the last thing in a constructor. +convenience, because a bless() is often the last thing in a constructor. Always use the two-argument version if the function doing the blessing might be inherited by a derived class. See L<perlobj> for more about the blessing (and blessings) of objects. @@ -536,7 +536,7 @@ omitted, does chroot to $_. Closes the file or pipe associated with the file handle, returning TRUE only if stdio successfully flushes buffers and closes the system file descriptor. You don't have to close FILEHANDLE if you are immediately -going to do another open() on it, since open() will close it for you. (See +going to do another open() on it, because open() will close it for you. (See open().) However, an explicit close on an input file resets the line counter ($.), while the implicit close done by open() does not. Also, closing a pipe will wait for the process executing on the pipe to @@ -603,7 +603,7 @@ their own password: print "ok\n"; } -Of course, typing in your own password to whoever asks you +Of course, typing in your own password to whomever asks you for it is unwise. =item dbmclose ASSOC_ARRAY @@ -622,7 +622,7 @@ normal open, the first argument is I<NOT> a filehandle, even though it looks like one). DBNAME is the name of the database (without the F<.dir> or F<.pag> extension if any). If the database does not exist, it is created with protection specified by MODE (as modified by the umask()). -If your system only supports the older DBM functions, you may perform only +If your system supports only the older DBM functions, you may perform only one dbmopen() in your program. In older versions of Perl, if your system had neither DBM nor ndbm, calling dbmopen() produced a fatal error; it now falls back to sdbm(3). @@ -687,35 +687,41 @@ matched "nothing". But it didn't really match nothing--rather, it matched something that happened to be 0 characters long. This is all very above-board and honest. When a function returns an undefined value, it's an admission that it couldn't give you an honest answer. So -you should only use defined() when you're questioning the integrity +you should use defined() only when you're questioning the integrity of what you're trying to do. At other times, a simple comparison to 0 or "" is what you want. =item delete EXPR -Deletes the specified value from its hash array. Returns the deleted -value, or the undefined value if nothing was deleted. Deleting from -C<$ENV{}> modifies the environment. Deleting from an array tied to a DBM -file deletes the entry from the DBM file. (But deleting from a tie()d -hash doesn't necessarily return anything.) +Deletes the specified key(s) and their associated values from a hash +array. For each key, returns the deleted value associated with that key, +or the undefined value if there was no such key. Deleting from C<$ENV{}> +modifies the environment. Deleting from an array tied to a DBM file +deletes the entry from the DBM file. (But deleting from a tie()d hash +doesn't necessarily return anything.) The following deletes all the values of an associative array: - foreach $key (keys %ARRAY) { - delete $ARRAY{$key}; + foreach $key (keys %HASH) { + delete $HASH{$key}; } -(But it would be faster to use the undef() command.) Note that the -EXPR can be arbitrarily complicated as long as the final operation is -a hash key lookup: +And so does this: + + delete @HASH{keys %HASH} + +(But both of these are slower than the undef() command.) Note that the +EXPR can be arbitrarily complicated as long as the final operation is a +hash element lookup or hash slice: delete $ref->[$x][$y]{$key}; + delete @{$ref->[$x][$y]}{$key1, $key2, @morekeys}; =item die LIST 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)> (backtick `command` status). If C<($? E<gt>E<gt> 8)> is 0, +C<($? E<gt>E<gt> 8)> (back-tick `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. @@ -768,7 +774,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 -reparse the file every time you call it, so you probably don't want to +re-parse 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 @@ -813,7 +819,7 @@ Example: When called in a list context, returns a 2-element array consisting of the key and value for the next element of an associative array, so that you can iterate over it. When called in a scalar context, -returns the key only for the next element in the associative array. +returns the key for only the next element in the associative array. Entries are returned in an apparently random order. When the array is entirely read, a null array is returned in list context (which when assigned produces a FALSE (0) value), and C<undef> is returned in a @@ -821,7 +827,7 @@ scalar context. The next call to each() after that will start iterating again. The iterator can be reset only by reading all the elements from the array. You should not add elements to an array while you're iterating over it. There is a single iterator for each -associative array, shared by all each(), keys() and values() function +associative array, shared by all each(), keys(), and values() function calls in the program. The following prints out your environment like the printenv(1) program, only in a different order: @@ -847,7 +853,7 @@ as terminals may lose the end-of-file condition if you do. An C<eof> without an argument uses the last file read as argument. Empty parentheses () may be used to indicate -the pseudofile formed of the files listed on the command line, i.e. +the pseudo file formed of the files listed on the command line, i.e., C<eof()> is reasonable to use inside a while (E<lt>E<gt>) loop to detect the end of only the last file. Use C<eof(ARGV)> or eof without the parentheses to test I<EACH> file in a while (E<lt>E<gt>) loop. Examples: @@ -877,7 +883,7 @@ input operators return undef when they run out of data. EXPR is parsed and executed as if it were a little Perl program. It is executed in the context of the current Perl program, so that any -variable settings, subroutine or format definitions remain afterwards. +variable settings or subroutine and format definitions remain afterwards. The value returned is the value of the last expression evaluated, or a return statement may be used, just as with subroutines. The last expression is evaluated in scalar or array context, depending on the @@ -889,7 +895,7 @@ error message. If there was no error, C<$@> is guaranteed to be a null string. If EXPR is omitted, evaluates $_. The final semicolon, if any, may be omitted from the expression. -Note that, since eval() traps otherwise-fatal errors, it is useful for +Note that, because eval() traps otherwise-fatal errors, it is useful for determining whether a particular feature (such as socket() or symlink()) is implemented. It is also Perl's exception trapping mechanism, where the die operator is used to raise exceptions. @@ -974,7 +980,7 @@ if the corresponding value is undefined. print "Defined\n" if defined $array{$key}; print "True\n" if $array{$key}; -A hash element can only be TRUE if it's defined, and defined if +A hash element can be TRUE only if it's defined, and defined if it exists, but the reverse doesn't necessarily hold true. Note that the EXPR can be arbitrarily complicated as long as the final @@ -1028,7 +1034,7 @@ OPERATION. Returns TRUE for success, FALSE on failure. Will produce a fatal error if used on a machine that doesn't implement either flock(2) or fcntl(2). The fcntl(2) system call will be automatically used if flock(2) is missing from your system. This makes flock() the portable file locking -strategy, although it will only lock entire files, not records. Note also +strategy, although it will lock only entire files, not records. Note also that some versions of flock() cannot lock things over the network; you would need to use the more system-specific fcntl() for that. @@ -1123,7 +1129,7 @@ that the C<~> and C<~~> tokens will treat the entire PICTURE as a single line. You may therefore need to use multiple formlines to implement a single record format, just like the format compiler. -Be careful if you put double quotes around the picture, since an "C<@>" +Be careful if you put double quotes around the picture, because an "C<@>" character may be taken to mean the beginning of an array name. formline() always returns TRUE. See L<perlform> for other examples. @@ -1149,7 +1155,7 @@ single-characters, however. For that, try something more like: system "stty -cbreak </dev/tty >/dev/tty 2>&1"; } else { - system "stty", 'icanon', 'eol', '^@'; # ascii null + system "stty", 'icanon', 'eol', '^@'; # ASCII null } print "\n"; @@ -1317,7 +1323,7 @@ operator, except it's easier to use. =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 timezone. +with the time localized for the standard Greenwich time zone. Typically used as follows: @@ -1372,7 +1378,7 @@ or equivalently, @foo = grep {!/^#/} @bar; # weed out comments -Note that, since $_ is a reference into the list value, it can be used +Note that, because $_ is a reference into the list value, it can be used to modify the elements of the array. While this is useful and supported, it can cause bizarre results if the LIST is not a named array. @@ -1575,8 +1581,8 @@ it succeeded, FALSE otherwise. See example in L<perlipc/"Sockets: Client/Server =item local EXPR A local modifies the listed variables to be local to the enclosing block, -subroutine, C<eval{}> or C<do>. If more than one value is listed, the -list must be placed in parens. See L<perlsub/"Temporary Values via +subroutine, C<eval{}>, or C<do>. If more than one value is listed, the +list must be placed in parentheses. See L<perlsub/"Temporary Values via local()"> for details. But you really probably want to be using my() instead, because local() isn't @@ -1586,7 +1592,7 @@ via my()"> for details. =item localtime EXPR Converts a time as returned by the time function to a 9-element array -with the time analyzed for the local timezone. Typically used as +with the time analyzed for the local time zone. Typically used as follows: ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = @@ -1598,7 +1604,7 @@ the range 0..6. If EXPR is omitted, does localtime(time). In a scalar context, prints out the ctime(3) value: - $now_string = localtime; # e.g. "Thu Oct 13 04:54:34 1994" + $now_string = localtime; # e.g., "Thu Oct 13 04:54:34 1994" Also see the F<timelocal.pl> library, and the strftime(3) function available via the POSIX module. @@ -1686,7 +1692,7 @@ an error. A "my" declares the listed variables to be local (lexically) to the enclosing block, subroutine, C<eval>, or C<do/require/use>'d file. If -more than one value is listed, the list must be placed in parens. See +more than one value is listed, the list must be placed in parentheses. See L<perlsub/"Private Variables via my()"> for details. =item next LABEL @@ -1727,22 +1733,28 @@ If EXPR is omitted, uses $_. =item open FILEHANDLE Opens the file whose filename is given by EXPR, and associates it with -FILEHANDLE. If FILEHANDLE is an expression, its value is used as the name -of the real filehandle wanted. If EXPR is omitted, the scalar variable of -the same name as the FILEHANDLE contains the filename. If the filename -begins with "E<lt>" or nothing, the file is opened for input. If the filename -begins with "E<gt>", the file is opened for output. If the filename begins -with "E<gt>E<gt>", the file is opened for appending. You can put a '+' in -front of the 'E<gt>' or 'E<lt>' to indicate that you want both read and write -access to the file; thus '+E<lt>' is usually preferred for read/write -updates--the '+E<gt>' mode would clobber the file first. These correspond to -the fopen(3) modes of 'r', 'r+', 'w', 'w+', 'a', and 'a+'. - -If the filename begins with "|", the filename is interpreted -as a command to which output is to be piped, and if the filename ends with -a "|", the filename is interpreted See L<perlipc/"Using open() for IPC"> -for more examples of this. as command which pipes input to us. (You may -not have a raw open() to a command that pipes both in I<and> out, but see L<open2>, +FILEHANDLE. If FILEHANDLE is an expression, its value is used as the +name of the real filehandle wanted. If EXPR is omitted, the scalar +variable of the same name as the FILEHANDLE contains the filename. +(Note that lexical variables--those declared with C<my>--will not work +for this purpose; so if you're using C<my>, specify EXPR in your call +to open.) + +If the filename begins with '<' or nothing, the file is opened for input. +If the filename begins with '>', the file is truncated and opened for +output. If the filename begins with '>>', the file is opened for +appending. You can put a '+' in front of the '>' or '<' to indicate that +you want both read and write access to the file; thus '+<' is almost +always preferred for read/write updates--the '+>' mode would clobber the +file first. The prefix and the filename may be separated with spaces. +These various prefixes correspond to the fopen(3) modes of 'r', 'r+', 'w', +'w+', 'a', and 'a+'. + +If the filename begins with "|", the filename is interpreted as a command +to which output is to be piped, and if the filename ends with a "|", the +filename is interpreted See L<perlipc/"Using open() for IPC"> for more +examples of this. as command which pipes input to us. (You may not have +a raw open() to a command that pipes both in I<and> out, but see L<open2>, L<open3>, and L<perlipc/"Bidirectional Communication"> for alternatives.) Opening '-' opens STDIN and opening 'E<gt>-' opens STDOUT. Open returns @@ -1799,7 +1811,7 @@ You may also, in the Bourne shell tradition, specify an EXPR beginning with "E<gt>&", in which case the rest of the string is interpreted as the name of a filehandle (or file descriptor, if numeric) which is to be duped and opened. You may use & after E<gt>, E<gt>E<gt>, E<lt>, +E<gt>, -+E<gt>E<gt> and +E<lt>. The ++E<gt>E<gt>, and +E<lt>. The mode you specify should match the mode of the original filehandle. (Duping a filehandle does not take into account any existing contents of stdio buffers.) @@ -1835,7 +1847,7 @@ parsimonious of file descriptors. For example: open(FILEHANDLE, "<&=$fd") -If you open a pipe on the command "-", i.e. either "|-" or "-|", then +If you open a pipe on the command "-", i.e., either "|-" or "-|", then there is an implicit fork done, and the return value of open is the pid of the child within the parent process, and 0 within the child process. (Use C<defined($pid)> to determine whether the open was successful.) @@ -1862,16 +1874,17 @@ Note: on any operation which may do a fork, unflushed buffers remain unflushed in both processes, which means you may need to set C<$|> to avoid duplicate output. -Using the FileHandle constructor from the FileHandle package, +Using the constructor from the IO::Handle package (or one of its +subclasses, such as IO::File or IO::Socket), you can generate anonymous filehandles which have the scope of whatever variables hold references to them, and automatically close whenever and however you leave that scope: - use FileHandle; + use IO::File; ... sub read_myfile_munged { my $ALL = shift; - my $handle = new FileHandle; + my $handle = new IO::File; open($handle, "myfile") or die "myfile: $!"; $first = <$handle> or return (); # Automatically closed here. @@ -1881,7 +1894,7 @@ and however you leave that scope: } The filename that is passed to open will have leading and trailing -whitespace deleted. In order to open a file with arbitrary weird +whitespace deleted. To open a file with arbitrary weird characters in it, it's necessary to protect any leading and trailing whitespace thusly: @@ -1905,7 +1918,7 @@ See L</seek()> for some details about mixing reading and writing. =item opendir DIRHANDLE,EXPR Opens a directory named EXPR for processing by readdir(), telldir(), -seekdir(), rewinddir() and closedir(). Returns TRUE if successful. +seekdir(), rewinddir(), and closedir(). Returns TRUE if successful. DIRHANDLEs have their own namespace separate from FILEHANDLEs. =item ord EXPR @@ -1961,7 +1974,7 @@ follows: @ Null fill to absolute position. Each letter may optionally be followed by a number which gives a repeat -count. With all types except "a", "A", "b", "B", "h" and "H", and "P" the +count. With all types except "a", "A", "b", "B", "h", "H", and "P" the pack function will gobble up that many values from the LIST. A * for the repeat count means to use however many items are left. The "a" and "A" types gobble just one value, but pack it as a string of length count, @@ -1977,7 +1990,7 @@ point data written on one machine may not be readable on another - even if both use IEEE floating point arithmetic (as the endian-ness of the memory representation is not part of the IEEE spec). Note that Perl uses doubles internally for all numeric calculation, and converting from double into -float and thence back to double again will lose precision (i.e. +float and thence back to double again will lose precision (i.e., C<unpack("f", pack("f", $foo)>) will not in general equal $foo). Examples: @@ -2018,11 +2031,11 @@ Declares the compilation unit as being in the given namespace. The scope of the package declaration is from the declaration itself through the end of the enclosing block (the same scope as the local() operator). All further unqualified dynamic identifiers will be in this namespace. A package -statement only affects dynamic variables--including those you've used +statement affects only dynamic variables--including those you've used local() on--but I<not> lexical variables created with my(). Typically it would be the first declaration in a file to be included by the C<require> or C<use> operator. You can switch into a package in more than one place; -it merely influences which symbol table is used by the compiler for the +it influences merely which symbol table is used by the compiler for the rest of that block. You can refer to variables and filehandles in other packages by prefixing the identifier with the package name and a double colon: C<$Package::Variable>. If the package name is null, the C<main> @@ -2073,7 +2086,7 @@ if successful. FILEHANDLE may be a scalar variable name, in which case the variable contains the name of or a reference to the filehandle, thus introducing one level of indirection. (NOTE: If FILEHANDLE is a variable and the next token is a term, it may be misinterpreted as an operator unless you -interpose a + or put parens around the arguments.) If FILEHANDLE is +interpose a + or put parentheses around the arguments.) If FILEHANDLE is omitted, prints by default to standard output (or to the last selected output channel--see L</select>). If LIST is also omitted, prints $_ to STDOUT. To set the default output channel to something other than @@ -2083,7 +2096,7 @@ subroutine that you call will have one or more of its expressions evaluated in a list context. Also be careful not to follow the print keyword with a left parenthesis unless you want the corresponding right parenthesis to terminate the arguments to the print--interpose a + or -put parens around all the arguments. +put parentheses around all the arguments. Note that if you're storing FILEHANDLES in an array or other expression, you will have to use a block returning its value instead: @@ -2091,18 +2104,18 @@ you will have to use a block returning its value instead: print { $files[$i] } "stuff\n"; print { $OK ? STDOUT : STDERR } "stuff\n"; -=item printf FILEHANDLE LIST +=item printf FILEHANDLE FORMAT, LIST -=item printf LIST +=item printf FORMAT, LIST -Equivalent to a "print FILEHANDLE sprintf(LIST)". The first argument +Equivalent to a "print FILEHANDLE sprintf(FORMAT, LIST)". The first argument of the list will be interpreted as the printf format. =item prototype FUNCTION Returns the prototype of a function as a string (or C<undef> if the -function has no prototype). FUNCTION is a reference to the the -function whose prototype you want to retrieve. +function has no prototype). FUNCTION is a reference to, or the name of, +the function whose prototype you want to retrieve. =item push ARRAY,LIST @@ -2172,7 +2185,7 @@ directory. If there are no more entries, returns an undefined value in a scalar context or a null list in a list context. If you're planning to filetest the return values out of a readdir(), you'd -better prepend the directory in question. Otherwise, since we didn't +better prepend the directory in question. Otherwise, because we didn't chdir() there, it would have been testing the wrong file. opendir(DIR, $some_dir) || die "can't opendir $some_dir: $!"; @@ -2256,7 +2269,7 @@ See also L<perlref>. =item rename OLDNAME,NEWNAME Changes the name of a file. Returns 1 for success, 0 otherwise. Will -not work across filesystem boundaries. +not work across file system boundaries. =item require EXPR @@ -2315,16 +2328,16 @@ variables and reset ?? searches so that they work again. The expression is interpreted as a list of single characters (hyphens allowed for ranges). All variables and arrays beginning with one of those letters are reset to their pristine state. If the expression is -omitted, one-match searches (?pattern?) are reset to match again. Only -resets variables or searches in the current package. Always returns +omitted, one-match searches (?pattern?) are reset to match again. Resets +only variables or searches in the current package. Always returns 1. Examples: reset 'X'; # reset all X variables reset 'a-z'; # reset lower case variables reset; # just reset ?? searches -Resetting "A-Z" is not recommended since you'll wipe out your -ARGV and ENV arrays. Only resets package variables--lexical variables +Resetting "A-Z" is not recommended because you'll wipe out your +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>. @@ -2405,7 +2418,7 @@ EOF on your read, and then sleep for a while, you might have to stick in a seek() to reset things. First the simple trick listed above to clear the filepointer. The seek() doesn't change the current position, but it I<does> clear the end-of-file condition on the handle, so that the next -C<E<lt>FILEE<gt>> makes Perl try again to read something. Hopefully. +C<E<lt>FILEE<gt>> makes Perl try again to read something. We hope. If that doesn't work (some stdios are particularly cantankerous), then you may need something more like this: @@ -2455,7 +2468,7 @@ methods, preferring to write the last example as: =item select RBITS,WBITS,EBITS,TIMEOUT -This calls the select(2) system call with the bitmasks specified, which +This calls the select(2) system call with the bit masks specified, which can be constructed using fileno() and vec(), along these lines: $rin = $win = $ein = ''; @@ -2485,10 +2498,10 @@ or to block until something becomes ready just do this $nfound = select($rout=$rin, $wout=$win, $eout=$ein, undef); -Most systems do not both to return anything useful in $timeleft, so +Most systems do not bother to return anything useful in $timeleft, so calling select() in a scalar context just returns $nfound. -Any of the bitmasks can also be undef. The timeout, if specified, is +Any of the bit masks can also be undef. The timeout, if specified, is in seconds, which may be fractional. Note: not all implementations are capable of returning the $timeleft. If not, they always return $timeleft equal to the supplied $timeout. @@ -2543,7 +2556,7 @@ See L<perlipc/"UDP: Message Passing"> for examples. Sets the current process group for the specified PID, 0 for the current process. Will produce a fatal error if used on a machine that doesn't -implement setpgrp(2). If the arguments are ommitted, it defaults to +implement setpgrp(2). If the arguments are omitted, it defaults to 0,0. Note that the POSIX version of setpgrp() does not accept any arguments, so only setpgrp 0,0 is portable. @@ -2613,7 +2626,7 @@ returns sine of $_. Causes the script to sleep for EXPR seconds, or forever if no EXPR. May be interrupted by sending the process a SIGALRM. Returns the number of seconds actually slept. You probably cannot mix alarm() and -sleep() calls, since sleep() is often implemented using alarm(). +sleep() calls, because sleep() is often implemented using alarm(). On some older systems, it may sleep up to a full second less than what you requested, depending on how it counts seconds. Most modern systems @@ -2623,17 +2636,19 @@ 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. +See also the POSIX module's sigpause() function. + =item socket SOCKET,DOMAIN,TYPE,PROTOCOL Opens a socket of the specified kind and attaches it to filehandle -SOCKET. DOMAIN, TYPE and PROTOCOL are specified the same as for the +SOCKET. DOMAIN, TYPE, and PROTOCOL are specified the same as for the system call of the same name. You should "use Socket;" first to get the proper definitions imported. See the example in L<perlipc/"Sockets: Client/Server Communication">. =item socketpair SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL Creates an unnamed pair of sockets in the specified domain, of the -specified type. DOMAIN, TYPE and PROTOCOL are specified the same as +specified type. DOMAIN, TYPE, and PROTOCOL are specified the same as for the system call of the same name. If unimplemented, yields a fatal error. Returns TRUE if successful. @@ -2688,7 +2703,7 @@ Examples: @sortedclass = sort byage @class; # this sorts the %age associative arrays by value - # instead of key using an inline function + # instead of key using an in-line function @eldest = sort { $age{$b} <=> $age{$a} } keys %age; sub backwards { $b cmp $a; } @@ -2765,7 +2780,7 @@ Removes the elements designated by OFFSET and LENGTH from an array, and replaces them with the elements of LIST, if any. Returns the elements removed from the array. The array grows or shrinks as necessary. If LENGTH is omitted, removes everything from OFFSET onward. The -following equivalencies hold (assuming C<$[ == 0>): +following equivalences hold (assuming C<$[ == 0>): push(@a,$x,$y) splice(@a,$#a+1,0,$x,$y) pop(@a) splice(@a,-1) @@ -2820,7 +2835,7 @@ characters at each point it matches that way. For example: produces the output 'h:i:t:h:e:r:e'. -The LIMIT parameter can be used to partially split a line +The LIMIT parameter can be used to split a line partially ($login, $passwd, $remainder) = split(/:/, $_, 3); @@ -2869,7 +2884,7 @@ Example: (Note that $shell above will still have a newline on it. See L</chop>, L</chomp>, and L</join>.) -=item sprintf FORMAT,LIST +=item sprintf FORMAT, LIST Returns a string formatted by the usual printf conventions of the C language. See L<sprintf(3)> or L<printf(3)> on your system for details. @@ -2888,9 +2903,9 @@ root of $_. =item srand EXPR Sets the random number seed for the C<rand> operator. If EXPR is omitted, -uses a semirandom value based on the current time and process ID, among +uses a semi-random value based on the current time and process ID, among other things. Of course, you'd need something much more random than that for -cryptographic purposes, since it's easy to guess the current time. +cryptographic purposes, because it's easy to guess the current time. Checksumming the compressed output of rapidly changing operating system status programs is the usual method. Examples are posted regularly to the comp.security.unix newsgroup. @@ -2919,13 +2934,13 @@ meaning of the fields: mode file mode (type and permissions) nlink number of (hard) links to the file uid numeric user ID of file's owner - gid numer group 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 type!) since the epoch - blksize preferred blocksize for file system I/O + blksize preferred block size for file system I/O blocks actual number of blocks allocated (The epoch was at 00:00 January 1, 1970 GMT.) @@ -2938,7 +2953,7 @@ last stat or filetest are returned. Example: print "$file is executable NFS file\n"; } -(This only works on machines for which the device number is negative under NFS.) +(This works on machines only for which the device number is negative under NFS.) =item study SCALAR @@ -2949,7 +2964,7 @@ 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 -runtimes with and without it to see which runs faster. Those loops +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 @@ -2994,7 +3009,7 @@ out the names of those files that contain a match: @ARGV = @files; undef $/; eval $search; # this screams - $/ = "\n"; # put back to normal input delim + $/ = "\n"; # put back to normal input delimiter foreach $file (sort keys(%seen)) { print $file, "\n"; } @@ -3053,7 +3068,7 @@ like numbers. require 'syscall.ph'; # may need to run h2ph syscall(&SYS_write, fileno(STDOUT), "hi there\n", 9); -Note that Perl only supports passing of up to 14 arguments to your system call, +Note that Perl supports passing of up to only 14 arguments to your system call, which in practice should usually suffice. =item sysopen FILEHANDLE,FILENAME,MODE @@ -3103,7 +3118,7 @@ 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 merely use backticks, as +the output from a command, for that you should use merely back-ticks, as described in L<perlop/"`STRING`">. =item syswrite FILEHANDLE,SCALAR,LENGTH,OFFSET @@ -3249,13 +3264,13 @@ If EXPR is omitted, uses $_. =item umask Sets the umask for the process and returns the old one. If EXPR is -omitted, merely returns current umask. +omitted, returns merely the current umask. =item undef EXPR =item undef -Undefines the value of EXPR, which must be an lvalue. Use only on a +Undefines the value of EXPR, which must be an lvalue. Use on only a scalar value, an entire array, 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 @@ -3292,7 +3307,7 @@ If LIST is omitted, uses $_. Unpack does the reverse of pack: it takes a string representing a structure and expands it out into a list value, returning the array -value. (In a scalar context, it merely returns the first value +value. (In a scalar context, it returns merely the first value produced.) The TEMPLATE has the same format as in the pack function. Here's a subroutine that does substring: @@ -3391,12 +3406,12 @@ are also implemented this way. Currently implemented pragmas are: use strict qw(subs vars refs); use subs qw(afunc blurfl); -These pseudomodules import semantics into the current block scope, unlike +These pseudo-modules import semantics into the current block scope, unlike ordinary modules, which import symbols into the current package (which are effective through the end of the file). There's a corresponding "no" command that unimports meanings imported -by use, i.e. it calls C<unimport Module LIST> instead of C<import>. +by use, i.e., it calls C<unimport Module LIST> instead of C<import>. no integer; no strict 'refs'; @@ -3428,16 +3443,16 @@ on the same array. See also keys(), each(), and sort(). =item vec EXPR,OFFSET,BITS Treats the string in EXPR as a vector of unsigned integers, and -returns the value of the bitfield specified by OFFSET. BITS specifies +returns the value of the bit field specified by OFFSET. BITS specifies the number of bits that are reserved for each entry in the bit vector. This must be a power of two from 1 to 32. vec() may also be -assigned to, in which case parens are needed to give the expression +assigned to, in which case parentheses are needed to give the expression the correct precedence as in vec($image, $max_x * $x + $y, 8) = 3; Vectors created with vec() can also be manipulated with the logical -operators |, & and ^, which will assume a bit vector operation is +operators |, &, and ^, which will assume a bit vector operation is desired when both operands are strings. To transform a bit vector into a string or array of 0's and 1's, use these: @@ -3459,12 +3474,12 @@ Waits for a particular child process to terminate and returns the pid of the deceased process, or -1 if there is no such child process. The status is returned in C<$?>. If you say - use POSIX ":wait_h"; + use POSIX ":sys_wait_h"; ... waitpid(-1,&WNOHANG); then you can do a non-blocking wait for any process. Non-blocking wait -is only available on machines supporting either the waitpid(2) or +is available on machines supporting either the waitpid(2) or wait4(2) system calls. However, waiting for a particular pid with FLAGS of 0 is implemented everywhere. (Perl emulates the system call by remembering the status values of processes that have exited but have diff --git a/pod/perlguts.pod b/pod/perlguts.pod index 251d959e3a..6743032dae 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -8,7 +8,7 @@ This document attempts to describe some of the internal functions of the Perl executable. It is far from complete and probably contains many errors. Please refer any questions or comments to the author below. -=head1 Datatypes +=head2 Datatypes Perl has three typedefs that handle Perl's three main data types: @@ -20,13 +20,13 @@ Each typedef has specific routines that manipulate the various data types. =head2 What is an "IV"? -Perl uses a special typedef IV which is large enough to hold either an -integer or a pointer. +Perl uses a special typedef IV which is a simple integer type that is +guaranteed to be large enough to hold a pointer (as well as an integer). Perl also uses two special typedefs, I32 and I16, which will always be at least 32-bits and 16-bits long, respectively. -=head2 Working with SVs +=head2 Working with SV's 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, @@ -54,6 +54,14 @@ 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 +with a NUL character. If it is not NUL-terminated there is a risk of +core dumps and corruptions from code which passes the string to C +functions or system calls which expect a NUL-terminated string. +Perl's own functions typically add a trailing NUL for this reason. +Nevertheless, you should be very careful when you pass a string stored +in an SV to a C function or system call. + To access the actual value that an SV points to, you can use the macros: SvIV(SV*) @@ -67,9 +75,9 @@ 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 -NULs and not be terminated by a NUL. +NUL's and might not be terminated by a NUL. -If you simply want to know if the scalar value is TRUE, you can use: +If you want to know simply if the scalar value is TRUE, you can use: SvTRUE(SV*) @@ -80,7 +88,9 @@ Perl to allocate more memory for your SV, you can use the macro which will determine if more memory needs to be allocated. If so, it will call the function C<sv_grow>. Note that C<SvGROW> can only increase, not -decrease, the allocated memory of an SV. +decrease, the allocated memory of an SV and that it does not automatically +add a byte for the a trailing NUL (perl's own string functions typically do +SvGROW(sv, len + 1)). If you have an SV and want to know what kind of data Perl thinks is stored in it, you can use the following macros to check the type of SV you have. @@ -118,7 +128,7 @@ be interpreted as a string. If you know the name of a scalar variable, you can get a pointer to its SV by using the following: - SV* perl_get_sv("varname", FALSE); + SV* perl_get_sv("package::varname", FALSE); This returns NULL if the variable does not exist. @@ -146,16 +156,16 @@ Take this code: This code tries to return a new SV (which contains the value 42) if it should return a real value, or undef otherwise. Instead it has returned a null pointer which, somewhere down the line, will cause a segmentation violation, -bus error, or just plain weird results. Change the zero to C<&sv_undef> in -the first line and all will be well. +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<Mortality>. +call is not necessary (see the section on L<Mortality>). =head2 What's Really Stored in an SV? Recall that the usual method of determining the type of scalar you have is -to use C<Sv*OK> macros. Since a scalar can be both a number and a string, +to use C<Sv*OK> macros. Because a scalar can be both a number and a string, usually these macros will always return TRUE and calling the C<Sv*V> macros will do the appropriate conversion of string to integer/double or integer/double to string. @@ -170,23 +180,23 @@ pointer in an SV, you can use the following three macros instead: These will tell you if you truly have an integer, double, or string pointer stored in your SV. The "p" stands for private. -In general, though, it's best to just use the C<Sv*V> macros. +In general, though, it's best just to use the C<Sv*V> macros. -=head2 Working with AVs +=head2 Working with AV's -There are two ways to create and load an AV. The first method just creates +There are two ways to create and load an AV. The first method creates just an empty AV: AV* newAV(); -The second method both creates the AV and initially populates it with SVs: +The second method both creates the AV and initially populates it with SV's: 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 SVs can be destroyed, if so desired. +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. -Once the AV has been created, the following operations are possible on AVs: +Once the AV has been created, the following operations are possible on AV's: void av_push(AV*, SV*); SV* av_pop(AV*); @@ -200,63 +210,77 @@ to these new elements. Here are some other functions: - I32 av_len(AV*); /* Returns highest index value in array */ - + I32 av_len(AV*); SV** av_fetch(AV*, I32 key, I32 lval); - /* Fetches value at key offset, but it stores an undef value - at the offset if lval is non-zero */ SV** av_store(AV*, I32 key, SV* val); - /* Stores val at offset key */ -Take note that C<av_fetch> and C<av_store> return C<SV**>s, not C<SV*>s. +The C<av_len> function returns the highest index value in array (just +like $#array in Perl). If the array is empty, -1 is returned. The +C<av_fetch> function returns the value at index C<key>, but if C<lval> +is non-zero, then C<av_fetch> will store an undef value at that index. +The C<av_store> function stores the value C<val> at index C<key>. +note that C<av_fetch> and C<av_store> both return C<SV**>'s, not C<SV*>'s +as their return value. void av_clear(AV*); - /* Clear out all elements, but leave the array */ void av_undef(AV*); - /* Undefines the array, removing all elements */ void av_extend(AV*, I32 key); - /* Extend the array to a total of key elements */ + +The C<av_clear> function deletes all the elements in the AV* array, but +does not actually delete the array itself. The C<av_undef> function will +delete all the elements in the array plus the array itself. The +C<av_extend> function extends the array so that it contains C<key> +elements. If C<key> is less than the current length of the array, then +nothing is done. If you know the name of an array variable, you can get a pointer to its AV by using the following: - AV* perl_get_av("varname", FALSE); + AV* perl_get_av("package::varname", FALSE); This returns NULL if the variable does not exist. -=head2 Working with HVs +=head2 Working with HV's To create an HV, you use the following routine: HV* newHV(); -Once the HV has been created, the following operations are possible on HVs: +Once the HV has been created, the following operations are possible on HV's: SV** hv_store(HV*, char* key, U32 klen, SV* val, U32 hash); SV** hv_fetch(HV*, char* key, U32 klen, I32 lval); -The C<klen> parameter is the length of the key being passed in. The C<val> -argument contains the SV pointer to the scalar being stored, and C<hash> is -the pre-computed 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. +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 +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 +key and C<hv_fetch> will return as if the value had already existed. -Remember that C<hv_store> and C<hv_fetch> return C<SV**>s and not just -C<SV*>. In order to access the scalar value, you must first dereference -the return value. However, you should check to make sure that the return -value is not NULL before dereferencing it. +Remember that C<hv_store> and C<hv_fetch> return C<SV**>'s and not just +C<SV*>. To access the scalar value, you must first dereference the return +value. However, you should check to make sure that the return value is +not NULL before dereferencing it. These two functions check if a hash table entry exists, and deletes it. bool hv_exists(HV*, char* key, U32 klen); SV* hv_delete(HV*, char* key, U32 klen, I32 flags); +If C<flags> does not include the C<G_DISCARD> flag then C<hv_delete> will +create and return a mortal copy of the deleted value. + And more miscellaneous functions: void hv_clear(HV*); - /* Clears all entries in hash table */ void hv_undef(HV*); - /* Undefines the hash table */ + +Like their AV counterparts, C<hv_clear> deletes all the entries in the hash +table but does not actually delete the hash table. The C<hv_undef> deletes +both the entries and the hash table itself. Perl keeps the actual data in linked list of structures with a typedef of HE. These contain the actual key and value pointers (plus extra administrative @@ -284,11 +308,11 @@ specified below. If you know the name of a hash variable, you can get a pointer to its HV by using the following: - HV* perl_get_hv("varname", FALSE); + HV* perl_get_hv("package::varname", FALSE); This returns NULL if the variable does not exist. -The hash algorithm, for those who are interested, is: +The hash algorithm is defined in the PERL_HASH(hash, key, klen) macro: i = klen; hash = 0; @@ -301,12 +325,16 @@ The hash algorithm, for those who are interested, is: References are a special type of scalar that point to other data types (including references). -To create a reference, use the following command: +To create a reference, use the following functions: - SV* newRV((SV*) thing); + SV* newRV_inc((SV*) thing); + SV* newRV_noinc((SV*) thing); -The C<thing> argument can be any of an C<SV*>, C<AV*>, or C<HV*>. Once -you have a reference, you can use the following macro to dereference the +The C<thing> argument can be any of an C<SV*>, C<AV*>, or C<HV*>. The +functions are identical except that C<newRV_inc> increments the +reference count of C<thing>, while C<newRV_noinc> does not. (For +historical reasons, "newRV" is a synonym for "newRV_inc".) Once you +have a reference, you can use the following macro to dereference the reference: SvRV(SV*) @@ -318,8 +346,8 @@ To determine if an SV is a reference, you can use the following macro: SvROK(SV*) -To actually discover what the reference refers to, you must use the following -macro and then check the value returned. +To discover what type of value the reference refers to, you must use the +following macro and then check the value returned. SvTYPE(SvRV(SV*)) @@ -328,10 +356,14 @@ The most useful types that will be returned are: SVt_IV Scalar SVt_NV Scalar SVt_PV Scalar + SVt_RV Scalar SVt_PVAV Array SVt_PVHV Hash SVt_PVCV Code - SVt_PVMG Blessed Scalar + SVt_PVGV Glob (possible a file handle) + SVt_PVMG Blessed or Magical Scalar + + See the sv.h header file for more details. =head2 Blessed References and Class Objects @@ -363,8 +395,8 @@ if classname is non-null. SV* sv_setref_iv(SV* rv, char* classname, IV iv); SV* sv_setref_nv(SV* rv, char* classname, NV iv); -Copies pointer (I<not a string!>) into an SV whose reference is rv. -SV is blessed if classname is non-null. +Copies the pointer value (I<the address, not the string!>) into an SV whose +reference is rv. SV is blessed if classname is non-null. SV* sv_setref_pv(SV* rv, char* classname, PV iv); @@ -377,228 +409,32 @@ SV is blessed if classname is non-null. int sv_isa(SV* sv, char* name); int sv_isobject(SV* sv); -=head1 Creating New Variables +=head2 Creating New Variables -To create a new Perl variable, which can be accessed from your Perl script, -use the following routines, depending on the variable type. +To create a new Perl variable with an undef value which can be accessed from +your Perl script, use the following routines, depending on the variable type. - SV* perl_get_sv("varname", TRUE); - AV* perl_get_av("varname", TRUE); - HV* perl_get_hv("varname", TRUE); + SV* perl_get_sv("package::varname", TRUE); + AV* perl_get_av("package::varname", TRUE); + HV* perl_get_hv("package::varname", TRUE); Notice the use of TRUE as the second parameter. The new variable can now be set, using the routines appropriate to the data type. -There are additional bits that may be OR'ed with the TRUE argument to enable -certain extra features. Those bits are: +There are additional macros whose values may be bitwise OR'ed with the +C<TRUE> argument to enable certain extra features. Those bits are: - 0x02 Marks the variable as multiply defined, thus preventing the - "Identifier <varname> used only once: possible typo" warning. - 0x04 Issues a "Had to create <varname> unexpectedly" warning if - the variable didn't actually exist. This is useful if - you expected the variable to already exist and want to propagate - this warning back to the user. + GV_ADDMULTI Marks the variable as multiply defined, thus preventing the + "Indentifier <varname> used only once: possible typo" warning. + GV_ADDWARN Issues a "Had to create <varname> unexpectedly" warning if + the variable didn't actually exist. This is useful if + you expected the variable to exist already and want to + propagate this warning back to the user. If the C<varname> argument does not contain a package specifier, it is created in the current package. -=head1 XSUBs and the Argument Stack - -The XSUB mechanism is a simple way for Perl programs to access C subroutines. -An XSUB routine will have a stack that contains the arguments from the Perl -program, and a way to map from the Perl data structures to a C equivalent. - -The stack arguments are accessible through the C<ST(n)> macro, which returns -the C<n>'th stack argument. Argument 0 is the first argument passed in the -Perl subroutine call. These arguments are C<SV*>, and can be used anywhere -an C<SV*> is used. - -Most of the time, output from the C routine can be handled through use of -the RETVAL and OUTPUT directives. However, there are some cases where the -argument stack is not already long enough to handle all the return values. -An example is the POSIX tzname() call, which takes no arguments, but returns -two, the local timezone's standard and summer time abbreviations. - -To handle this situation, the PPCODE directive is used and the stack is -extended using the macro: - - EXTEND(sp, num); - -where C<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 IVs, doubles, strings, and SV pointers respectively: - - PUSHi(IV) - PUSHn(double) - PUSHp(char*, I32) - PUSHs(SV*) - -And now the Perl program calling C<tzname>, the two values will be assigned -as in: - - ($standard_abbrev, $summer_abbrev) = POSIX::tzname; - -An alternate (and possibly simpler) method to pushing values on the stack is -to use the macros: - - XPUSHi(IV) - XPUSHn(double) - XPUSHp(char*, I32) - XPUSHs(SV*) - -These macros automatically adjust the stack for you, if needed. Thus, you -do not need to call C<EXTEND> to extend the stack. - -For more information, consult L<perlxs>. - -=head1 Localizing Changes - -Perl has a very handy construction - - { - local $var = 2; - ... - } - -This construction is I<approximately> equivalent to - - { - my $oldvar = $var; - $var = 2; - ... - $var = $oldvar; - } - -The biggest difference is that the first construction would would -reinstate the initial value of $var, irrespective of how control exits -the block: C<goto>, C<return>, C<die>/C<eval> etc. It is a little bit -more efficient as well. - -There is a way to achieve a similar task from C via Perl API: create a -I<pseudo-block>, and arrange for some changes to be automatically -undone at the end of it, either explicit, or via a non-local exit (via -die()). A I<block>-like construct is created by a pair of -C<ENTER>/C<LEAVE> macros (see L<perlcall/EXAMPLE/"Returning a -Scalar">). Such a construct may be created specially for some -important localized task, or an existing one (like boundaries of -enclosing Perl subroutine/block, or an existing pair for freeing TMPs) -may be used. (In the second case the overhead of additional -localization must be almost negligible.) Note that any XSUB is -automatically enclosed in an C<ENTER>/C<LEAVE> pair. - -Inside such a I<pseudo-block> the following service is available: - -=over - -=item C<SAVEINT(int i)> - -=item C<SAVEIV(IV i)> - -=item C<SAVEI16(I16 i)> - -=item C<SAVEI32(I32 i)> - -=item C<SAVELONG(long i)> - -These macros arrange things to restore the value of integer variable -C<i> at the end of enclosing I<pseudo-block>. - -=item C<SAVESPTR(p)> - -=item C<SAVEPPTR(s)> - -These macros arrange things to restore the value of pointers C<s> and -C<p>. C<p> must be a pointer of a type which survives conversion to -C<SV*> and back, C<s> should be able to survive conversion to C<char*> -and back. - -=item C<SAVEFREESV(SV *sv)> - -The refcount of C<sv> would be decremented at the end of -I<pseudo-block>. This is similar to C<sv_2mortal>, which should (?) be -used instead. - -=item C<SAVEFREEOP(OP *op)> - -The C<OP *> is op_free()ed at the end of I<pseudo-block>. - -=item C<SAVEFREEPV(p)> - -The chunk of memory which is pointed to by C<p> is Safefree()ed at the -end of I<pseudo-block>. - -=item C<SAVECLEARSV(SV *sv)> - -Clears a slot in the current scratchpad which corresponds to C<sv> at -the end of I<pseudo-block>. - -=item C<SAVEDELETE(HV *hv, char *key, I32 length)> - -The key C<key> of C<hv> is deleted at the end of I<pseudo-block>. The -string pointed to by C<key> is Safefree()ed. If one has a I<key> in -short-lived storage, the corresponding string may be reallocated like -this: - - SAVEDELETE(defstash, savepv(tmpbuf), strlen(tmpbuf)); - -=item C<SAVEDESTRUCTOR(f,p)> - -At the end of I<pseudo-block> the function C<f> is called with the -only argument (of type C<void*>) C<p>. - -=item C<SAVESTACK_POS()> - -The current offset on the Perl internal stack (cf. C<SP>) is restored -at the end of I<pseudo-block>. - -=back - -The following API list contains functions, thus one needs to -provide pointers to the modifiable data explicitly (either C pointers, -or Perlish C<GV *>s): - -=over - -=item C<SV* save_scalar(GV *gv)> - -Equivalent to Perl code C<local $gv>. - -=item C<AV* save_ary(GV *gv)> - -=item C<HV* save_hash(GV *gv)> - -Similar to C<save_scalar>, but localize C<@gv> and C<%gv>. - -=item C<void save_item(SV *item)> - -Duplicates the current value of C<SV>, on the exit from the current -C<ENTER>/C<LEAVE> I<pseudo-block> will restore the value of C<SV> -using the stored value. - -=item C<void save_list(SV **sarg, I32 maxsarg)> - -A variant of C<save_item> which takes multiple arguments via an array -C<sarg> of C<SV*> of length C<maxsarg>. - -=item C<SV* save_svref(SV **sptr)> - -Similar to C<save_scalar>, but will reinstate a C<SV *>. - -=item C<void save_aptr(AV **aptr)> - -=item C<void save_hptr(HV **hptr)> - -Similar to C<save_svref>, but localize C<AV *> and C<HV *>. - -=item C<void save_nogv(GV *gv)> - -Will postpone destruction of a I<stub> glob. - -=back - -=head1 Mortality +=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 @@ -606,38 +442,45 @@ reference count of 1. If the reference count of an xV ever drops to 0, then they will be destroyed and their memory made available for reuse. This normally doesn't happen at the Perl level unless a variable is -undef'ed. At the internal level, however, reference counts can be +undef'ed or the last variable holding a reference to it is changed or +overwritten. At the internal level, however, reference counts can be manipulated with the following macros: int SvREFCNT(SV* sv); - void SvREFCNT_inc(SV* sv); + SV* SvREFCNT_inc(SV* sv); void SvREFCNT_dec(SV* sv); However, there is one other function which manipulates the reference -count of its argument. The C<newRV> function, as you should recall, -creates a reference to the specified argument. As a side effect, it -increments the argument's reference count, which is ok in most -circumstances. But imagine you want to return a reference from an XS +count of its argument. The C<newRV_inc> function, as you should +recall, creates a reference to the specified argument. As a side +effect, it increments the argument's reference count. If this is not +what you want, use C<newRV_noinc> instead. + +For example, imagine you want to return a reference from an XSUB function. You create a new SV which initially has a reference count -of 1. Then you call C<newRV>, passing the just-created SV. This returns -the reference as a new SV, but the reference count of the SV you passed -to C<newRV> has been incremented to 2. Now you return the reference and -forget about the SV. But Perl hasn't! Whenever the returned reference -is destroyed, the reference count of the original SV is decreased to 1 -and nothing happens. The SV will hang around without any way to access -it until Perl itself terminates. This is a memory leak. - -The correct procedure, then, is to call C<SvREFCNT_dec> on the SV after -C<newRV> has returned. Then, if and when the reference is destroyed, -the reference count of the SV will go to 0 and also be destroyed, stopping +of one. Then you call C<newRV_inc>, passing the just-created SV. +This returns the reference as a new SV, but the reference count of the +SV you passed to C<newRV_inc> has been incremented to two. Now you +return the reference and forget about the SV. But Perl hasn't! +Whenever the returned reference is destroyed, the reference count of +the original SV is decreased to one and nothing happens. The SV will +hang around without any way to access it until Perl itself terminates. +This is a memory leak. + +The correct procedure, then, is to use C<newRV_noinc> instead of +C<newRV_inc>. Then, if and when the last reference is destroyed, the +reference count of the SV will go to 0 and also be destroyed, stopping any memory leak. -There are some convenience functions available that can help with this -process. 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 the "current context" is left. -Generally the "current context" means a single Perl statement, such as -a call to an XSUB function. +There are some convenience functions available that can help with the +destruction of old xV objects. 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 reference count +decremented depends on two macros, SAVETMPS and FREETMPS. Take a look +at L<perlcall> and L<perlxs> for more details on these macros. "Mortalization" then is at its simplest a deferred C<SvREFCNT_dec>. However, if you mortalize a variable twice, the reference count will @@ -645,8 +488,7 @@ later be decremented twice. You should be careful about creating mortal variables. Strange things can happen if you make the same value mortal within multiple contexts, -or if you make a variable mortal multiple times. Doing the latter can -cause a variable to become invalid prematurely. +or if you make a variable mortal multiple times. To create a mortal variable, use the functions: @@ -654,25 +496,15 @@ To create a mortal variable, use the functions: SV* sv_2mortal(SV*) SV* sv_mortalcopy(SV*) -The first call creates a mortal SV, the second converts an existing SV to -a mortal SV, the third creates a mortal copy of an existing SV (possibly -destroying it in the process). +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 SVs -- AVs and HVs can be made mortal -by passing their address (and casting them to C<SV*>) to the C<sv_2mortal> or +The mortal routines are not for just SV's -- AV's and HV's can be made +mortal by passing their address (casted to C<SV*>) to the C<sv_2mortal> or C<sv_mortalcopy> routines. -I<From Ilya:> -Beware that the sv_2mortal() call is eventually equivalent to -svREFCNT_dec(). A value can happily be mortal in two different contexts, -and it will be svREFCNT_dec()ed twice, once on exit from these -contexts. It can also be mortal twice in the same context. This means -that you should be very careful to make a value mortal exactly as many -times as it is needed. The value that go to the Perl stack I<should> -be mortal. - - -=head1 Stashes +=head2 Stashes and Globs A stash is a hash table (associative array) that contains all of the different objects that are contained within a package. Each key of the @@ -689,11 +521,11 @@ objects of that name, including (but not limited to) the following: Format Subroutine -Perl stores various stashes in a separate GV structure (for global -variable) but represents them with an HV structure. The keys in this -larger GV are the various package names; the values are the C<GV*>s -which are stashes. It may help to think of a stash purely as an HV, -and that the term "GV" means the global variable hash. +There is a single stash called "defstash" that holds the items that exist +in the "main" package. To get at the items in other packages, append the +string "::" to the package name. The items in the "Foo" package are in +the stash "Foo::" in defstash. The items in the "Bar::Baz" package are +in the stash "Baz::" in "Bar::"'s stash. To get the stash pointer for a particular package, use the function: @@ -718,8 +550,8 @@ then use the following to get the package name itself: char* HvNAME(HV* stash); -If you need to return a blessed value to your Perl script, you can use the -following function: +If you need to bless or re-bless an object you can use the following +function: SV* sv_bless(SV*, HV* stash) @@ -729,14 +561,14 @@ as any other SV. For more information on references and blessings, consult L<perlref>. -=head1 Magic +=head2 Magic [This section still under construction. Ignore everything here. Post no bills. Everything not permitted is forbidden.] Any SV may be magical, that is, it has special features that a normal SV does not have. These features are stored in the SV structure in a -linked list of C<struct magic>s, typedef'ed to C<MAGIC>. +linked list of C<struct magic>'s, typedef'ed to C<MAGIC>. struct magic { MAGIC* mg_moremagic; @@ -835,8 +667,8 @@ the various routines for the various magical types begin with C<magic_>. The current kinds of Magic Virtual Tables are: - mg_type MGVTBL Type of magicalness - ------- ------ ------------------- + mg_type MGVTBL Type of magic + ------- ------ ---------------------------- \0 vtbl_sv Regexp??? A vtbl_amagic Operator Overloading a vtbl_amagicelem Operator Overloading @@ -849,7 +681,6 @@ The current kinds of Magic Virtual Tables are: i vtbl_isaelem @ISA array element L 0 (but sets RMAGICAL) Perl Module/Debugger??? l vtbl_dbline Debugger? - o vtbl_collxfrm Locale Collation P vtbl_pack Tied Array or Hash p vtbl_packelem Tied Array or Hash element q vtbl_packelem Tied Scalar or Handle @@ -862,13 +693,25 @@ The current kinds of Magic Virtual Tables are: * vtbl_glob GV??? # vtbl_arylen Array Length . vtbl_pos $. scalar variable - ~ Reserved for extensions, but multiple extensions may clash + ~ None Used by certain extensions When an upper-case and lower-case letter both exist in the table, then the upper-case letter is used to represent some kind of composite type (a list or a hash), and the lower-case letter is used to represent an element of that composite type. +The '~' magic type is defined specifically for use by extensions and +will not be used by perl itself. Extensions can use ~ magic to 'attach' +private information to variables (typically objects). This is especially +useful because there is no way for normal perl code to corrupt this +private information (unlike using extra elements of a hash object). + +Note that because multiple extensions may be using ~ magic it is +important for extensions to take extra care with it. Typically only +using it on objects blessed into the same class as the extension +is sufficient. It may also be appropriate to add an I32 'signature' +at the top of the private data area and check that. + =head2 Finding Magic MAGIC* mg_find(SV*, int type); /* Finds the magic pointer of that type */ @@ -883,7 +726,7 @@ This routine checks to see what types of magic C<sv> has. If the mg_type field is an upper-case letter, then the mg_obj is copied to C<nsv>, but the mg_type field is changed to be the lower-case letter. -=head1 Double-Typed SVs +=head2 Double-Typed SV's Scalar variables normally contain only one type of value, an integer, double, pointer, or reference. Perl will automatically convert the @@ -923,7 +766,58 @@ following code: If the order of C<sv_setiv> and C<sv_setpv> had been reversed, then the macro C<SvPOK_on> would need to be called instead of C<SvIOK_on>. -=head1 Calling Perl Routines from within C Programs +=head2 XSUB's and the Argument Stack + +The XSUB mechanism is a simple way for Perl programs to access C subroutines. +An XSUB routine will have a stack that contains the arguments from the Perl +program, and a way to map from the Perl data structures to a C equivalent. + +The stack arguments are accessible through the C<ST(n)> macro, which returns +the C<n>'th stack argument. Argument 0 is the first argument passed in the +Perl subroutine call. These arguments are C<SV*>, and can be used anywhere +an C<SV*> is used. + +Most of the time, output from the C routine can be handled through use of +the RETVAL and OUTPUT directives. However, there are some cases where the +argument stack is not already long enough to handle all the return values. +An example is the POSIX tzname() call, which takes no arguments, but returns +two, the local time zone's standard and summer time abbreviations. + +To handle this situation, the PPCODE directive is used and the stack is +extended using the macro: + + EXTEND(sp, num); + +where C<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: + + PUSHi(IV) + PUSHn(double) + PUSHp(char*, I32) + PUSHs(SV*) + +And now the Perl program calling C<tzname>, the two values will be assigned +as in: + + ($standard_abbrev, $summer_abbrev) = POSIX::tzname; + +An alternate (and possibly simpler) method to pushing values on the stack is +to use the macros: + + XPUSHi(IV) + XPUSHn(double) + XPUSHp(char*, I32) + XPUSHs(SV*) + +These macros automatically adjust the stack for you, if needed. Thus, you +do not need to call C<EXTEND> to extend the stack. + +For more information, consult L<perlxs> and L<perlxstut>. + +=head2 Calling Perl Routines from within C Programs There are four routines that can be used to call a Perl subroutine from within a C program. These four are: @@ -958,26 +852,30 @@ functions: XPUSH*() POP*() -For more information, consult L<perlcall>. +For a detailed description of calling conventions from C to Perl, +consult L<perlcall>. -=head1 Memory Allocation +=head2 Memory Allocation -It is strongly suggested that you use the version of malloc that is distributed -with Perl. It keeps pools of various sizes of unallocated memory in order to -more quickly satisfy allocation requests. -However, on some platforms, it may cause spurious malloc or free errors. +It is suggested that you use the version of malloc that is distributed +with Perl. It keeps pools of various sizes of unallocated memory in +satisfy allocation requests more quickly. However, on some platforms, it +may cause spurious malloc or free errors. New(x, pointer, number, type); Newc(x, pointer, number, type, cast); Newz(x, pointer, number, type); -These three macros are used to initially allocate memory. The first argument -C<x> was a "magic cookie" that was used to keep track of who called the macro, -to help when debugging memory problems. However, the current code makes no -use of this feature (Larry has switched to using a run-time memory checker), -so this argument can be any number. +These three macros are used to allocate memory. + +The first argument C<x> was a "magic cookie" that was used to keep track +of who called the macro, to help when debugging memory problems. However, +the current code makes no use of this feature (Larry has switched to using +a run-time memory checker), so this argument can be any number. + +The second argument C<pointer> should be the name of a variable that will +point to the newly allocated memory. -The second argument C<pointer> will point to the newly allocated memory. The third and fourth arguments C<number> and C<type> specify how many of the specified type of data structure should be allocated. The argument C<type> is passed to C<sizeof>. The final argument to C<Newc>, C<cast>, @@ -1006,9 +904,21 @@ destination starting points. Perl will move, copy, or zero out C<number> instances of the size of the C<type> data structure (using the C<sizeof> function). -=head1 Scratchpads +=head2 PerlIO -=head2 Putting a C value on Perl stack +The most recent development releases of Perl has been experimenting with +removing Perl's dependency on the "normal" standard I/O suite and allowing +other stdio implementations to be used. This involves creating a new +abstraction layer that then calls whichever implementation of stdio Perl +was compiled with. All XSUB's should now use the functions in the PerlIO +abstraction layer and not make any assumptions about what kind of stdio +is being used. + +For a complete description of the PerlIO abstraction, consult L<perlapio>. + +=head2 Scratchpads + +=head3 Putting a C value on Perl stack A lot of opcodes (this is an elementary operation in the internal perl stack machine) put an SV* on the stack. However, as an optimization @@ -1025,25 +935,25 @@ The macro to put this target on stack is C<PUSHTARG>, and it is directly used in some opcodes, as well as indirectly in zillions of others, which use it via C<(X)PUSH[pni]>. -=head2 Scratchpads +=head3 Scratchpads -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 +The question remains on when the SV's 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. -Scratchpad keeps SVs which are lexicals for the current unit and are +A scratchpad keeps SV's 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 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 +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 would not conflict with the expected life of the temporary. -=head2 Scratchpads and recursions +=head3 Scratchpads and recursions In fact it is not 100% true that a compiled unit contains a pointer to the scratchpad AV. In fact it contains a pointer to an AV of @@ -1057,15 +967,15 @@ for the subroutine-parent (lifespan of which covers the call to the child), the parent and the child should have different scratchpads. (I<And> the lexicals should be separate anyway!) -So each subroutine is born with an array of scratchpads (of length -1). On each entry to the subroutine it is checked that the current +So each subroutine is born with an array of scratchpads (of length 1). +On each entry to the subroutine it is checked that the current depth of the recursion is not more than the length of this array, and if it is, new scratchpad is created and pushed into the array. The I<target>s on this scratchpad are C<undef>s, but they are already marked with correct flags. -=head1 API LISTING +=head2 API LISTING This is a listing of functions, macros, flags, and variables that may be useful to extension writers or that may be found while reading other @@ -1108,7 +1018,7 @@ Returns the highest index in the array. Returns -1 if the array is empty. Creates a new AV and populates it with a list of SVs. The SVs are copied into the array, so they may be freed after the call to av_make. The new AV -will have a refcount of 1. +will have a reference count of 1. AV* av_make _((I32 size, SV** svp)); @@ -1395,7 +1305,7 @@ Undefines the hash. =item isALNUM Returns a boolean indicating whether the C C<char> is an ascii alphanumeric -character. +character or digit. int isALNUM (char c) @@ -1532,48 +1442,57 @@ memory is zeroed with C<memzero>. =item newAV -Creates a new AV. The refcount is set to 1. +Creates a new AV. The reference count is set to 1. AV* newAV _((void)); =item newHV -Creates a new HV. The refcount is set to 1. +Creates a new HV. The reference count is set to 1. HV* newHV _((void)); -=item newRV +=item newRV_inc -Creates an RV wrapper for an SV. The refcount for the original SV is +Creates an RV wrapper for an SV. The reference count for the original SV is incremented. - SV* newRV _((SV* ref)); + SV* newRV_inc _((SV* ref)); + +For historical reasons, "newRV" is a synonym for "newRV_inc". + +=item newRV_noinc + +Creates an RV wrapper for an SV. The reference count for the original +SV is B<not> incremented. + + SV* newRV_noinc _((SV* ref)); =item newSV Creates a new SV. The C<len> parameter indicates the number of bytes of -pre-allocated string space the SV should have. The refcount for the new SV +pre-allocated string space the SV should have. The reference count for the new SV is set to 1. SV* newSV _((STRLEN len)); =item newSViv -Creates a new SV and copies an integer into it. The refcount for the SV is +Creates a new SV and copies an integer into it. The reference count for the SV is set to 1. SV* newSViv _((IV i)); =item newSVnv -Creates a new SV and copies a double into it. The refcount for the SV is +Creates a new SV and copies a double into it. The reference count for the SV is set to 1. SV* newSVnv _((NV i)); =item newSVpv -Creates a new SV and copies a string into it. The refcount for the SV is +Creates a new SV and copies a string into it. The reference count for the SV is set to 1. If C<len> is zero then Perl will compute the length. SV* newSVpv _((char* s, STRLEN len)); @@ -1583,7 +1502,7 @@ set to 1. If C<len> is zero then Perl will compute the length. Creates a new SV for the RV, C<rv>, to point to. If C<rv> is not an RV then it will be upgraded to one. If C<classname> is non-null then the new SV will be blessed in the specified package. The new SV is returned and its -refcount is 1. +reference count is 1. SV* newSVrv _((SV* rv, char* classname)); @@ -1848,7 +1767,7 @@ C<SPAGAIN>. =item SPAGAIN -Refetch the stack pointer. Used after a callback. See L<perlcall>. +Re-fetch the stack pointer. Used after a callback. See L<perlcall>. SPAGAIN; @@ -1922,7 +1841,7 @@ ends. =item sv_bless Blesses an SV into a specified package. The SV must be an RV. The package -must be designated by its stash (see C<gv_stashpv()>). The refcount of the +must be designated by its stash (see C<gv_stashpv()>). The reference count of the SV is unaffected. SV* sv_bless _((SV* sv, HV* stash)); @@ -1977,13 +1896,13 @@ Set the length of the string which is in the SV. See C<SvCUR>. =item sv_dec -Autodecrement of the value in the SV. +Auto-decrement of the value in the SV. void sv_dec _((SV* sv)); =item sv_dec -Autodecrement of the value in the SV. +Auto-decrement of the value in the SV. void sv_dec _((SV* sv)); @@ -2016,7 +1935,7 @@ Use C<SvGROW>. =item sv_inc -Autoincrement of the value in the SV. +Auto increment of the value in the SV. void sv_inc _((SV* sv)); @@ -2112,7 +2031,7 @@ Adds magic to an SV. =item sv_mortalcopy Creates a new SV which is a copy of the original SV. The new SV is marked -as mortal. The old SV may become invalid if it was marked as a temporary. +as mortal. SV* sv_mortalcopy _((SV* oldsv)); @@ -2124,7 +2043,7 @@ Returns a boolean indicating whether the value is an SV. =item sv_newmortal -Creates a new SV which is mortal. The refcount of the SV is set to 1. +Creates a new SV which is mortal. The reference count of the SV is set to 1. SV* sv_newmortal _((void)); @@ -2254,19 +2173,19 @@ Returns a pointer to the string in the SV. The SV must contain a string. =item SvREFCNT -Returns the value of the object's refcount. +Returns the value of the object's reference count. int SvREFCNT (SV* sv); =item SvREFCNT_dec -Decrements the refcount of the given SV. +Decrements the reference count of the given SV. void SvREFCNT_dec (SV* sv) =item SvREFCNT_inc -Increments the refcount of the given SV. +Increments the reference count of the given SV. void SvREFCNT_inc (SV* sv) @@ -2325,7 +2244,7 @@ Copies an integer into a new SV, optionally blessing the SV. The C<rv> argument will be upgraded to an RV. That RV will be modified to point to the new SV. The C<classname> argument indicates the package for the blessing. Set C<classname> to C<Nullch> to avoid the blessing. The new SV -will be returned and will have a refcount of 1. +will be returned and will have a reference count of 1. SV* sv_setref_iv _((SV *rv, char *classname, IV iv)); @@ -2335,7 +2254,7 @@ Copies a double into a new SV, optionally blessing the SV. The C<rv> argument will be upgraded to an RV. That RV will be modified to point to the new SV. The C<classname> argument indicates the package for the blessing. Set C<classname> to C<Nullch> to avoid the blessing. The new SV -will be returned and will have a refcount of 1. +will be returned and will have a reference count of 1. SV* sv_setref_nv _((SV *rv, char *classname, double nv)); @@ -2346,7 +2265,7 @@ argument will be upgraded to an RV. That RV will be modified to point to the new SV. If the C<pv> argument is NULL then C<sv_undef> will be placed into the SV. The C<classname> argument indicates the package for the blessing. Set C<classname> to C<Nullch> to avoid the blessing. The new SV -will be returned and will have a refcount of 1. +will be returned and will have a reference count of 1. SV* sv_setref_pv _((SV *rv, char *classname, void* pv)); @@ -2362,7 +2281,7 @@ string must be specified with C<n>. The C<rv> argument will be upgraded to an RV. That RV will be modified to point to the new SV. The C<classname> argument indicates the package for the blessing. Set C<classname> to C<Nullch> to avoid the blessing. The new SV will be returned and will have -a refcount of 1. +a reference count of 1. SV* sv_setref_pvn _((SV *rv, char *classname, char* pv, I32 n)); @@ -2371,14 +2290,10 @@ Note that C<sv_setref_pv> copies the pointer while this copies the string. =item sv_setsv Copies the contents of the source SV C<ssv> into the destination SV C<dsv>. -The source SV may be destroyed if it is mortal or temporary. +The source SV may be destroyed if it is mortal. void sv_setsv _((SV* dsv, SV* ssv)); -=item SvSetSV - -A wrapper around C<sv_setsv>. Safe even if C<dst==ssv>. - =item SvSTASH Returns the stash of the SV. @@ -2448,7 +2363,7 @@ This is the C<undef> SV. Always refer to this as C<&sv_undef>. =item sv_unref -Unsets the RV status of the SV, and decrements the refcount of whatever was +Unsets the RV status of the SV, and decrements the reference count of whatever was being referenced by the RV. This can almost be thought of as a reversal of C<newSVrv>. See C<SvROK_off>. @@ -2632,7 +2547,7 @@ destination, C<n> is the number of items, and C<t> is the type. =back -=head1 AUTHOR +=head1 EDITOR Jeff Okamoto <okamoto@corp.hp.com> @@ -2644,4 +2559,4 @@ API Listing by Dean Roehrich <roehrich@cray.com>. =head1 DATE -Version 23.1: 1996/10/19 +Version 25.2: 1996/12/16 diff --git a/pod/perllocale.pod b/pod/perllocale.pod new file mode 100644 index 0000000000..a1a5b53457 --- /dev/null +++ b/pod/perllocale.pod @@ -0,0 +1,614 @@ +=head1 NAME + +perllocale - Perl locale handling (internationlization) + +=head1 DESCRIPTION + +Perl supports language-specific notions of data such as "is this a +letter", "what is the upper-case equivalent of this letter", and +"which of these letters comes first". These are important issues, +especially for languages other than English - but also for English: it +would be very naÔve to think that C<A-Za-z> defines all the "letters". +Perl is also aware that some character other than '.' may be preferred +as a decimal point, and that output date representations may be +language-specific. + +Perl can understand language-specific data via the standardized +(ISO C, XPG4, POSIX 1.c) method called "the locale system". +The locale system is controlled per application using a pragma, one +function call, and several environment variables. + +B<NOTE>: This feature is new in Perl 5.004, and does not apply unless +an application specifically requests it - see L<Backward +compatibility>. + +=head1 PREPARING TO USE LOCALES + +If Perl applications are to be able to understand and present your +data correctly according a locale of your choice, B<all> of the following +must be true: + +=over 4 + +=item * + +B<Your operating system must support the locale system>. If it does, +you should find that the C<setlocale> function is a documented part of +its C library. + +=item * + +B<Definitions for the locales which you use must be installed>. You, +or your system administrator, must make sure that this is the case. +The available locales, the location in which they are kept, and the +manner in which they are installed, vary from system to system. Some +systems provide only a few, hard-wired, locales, and do not allow more +to be added; others allow you to add "canned" locales provided by the +system supplier; still others allow you or the system administrator +to define and add arbitrary locales. (You may have to ask your +supplier to provide canned locales whch are not delivered with your +operating system.) Read your system documentation for further +illumination. + +=item * + +B<Perl must believe that the locale system is supported>. If it does, +C<perl -V:d_setlocale> will say that the value for C<d_setlocale> is +C<define>. + +=back + +If you want a Perl application to process and present your data +according to a particular locale, the application code should include +the S<C<use locale>> pragma (L<The use locale Pragma>) where +appropriate, and B<at least one> of the following must be true: + +=over 4 + +=item * + +B<The locale-determining environment variables (see L<ENVIRONMENT>) must +be correctly set up>, either by yourself, or by the person who set up +your system account, at the time the application is started. + +=item * + +B<The application must set its own locale> using the method described +in L<The C<setlocale> function>. + +=back + +=head1 USING LOCALES + +=head2 The use locale pragma + +By default, Perl ignores the current locale. The S<C<use locale>> pragma +tells Perl to use the current locale for some operations: + +=over 4 + +=item * + +B<The comparison operators> (C<lt>, C<le>, C<cmp>, C<ge>, and C<gt>) +use C<LC_COLLATE>. The C<sort> function is also affected if it is +used without an explicit comparison function because it uses C<cmp> by +default. + +B<Note:> The C<eq> and C<ne> operators are unaffected by the locale: +they always perform a byte-by-byte comparison of their scalar +arguments. If you really want to know if two strings - which C<eq> +may consider different - are equal as far as collation is concerned, +use something like + + !("space and case ignored" cmp "SpaceAndCaseIgnored") + +(which would be true if the collation locale specified a +dictionary-like ordering). + +I<Editor's note:> I am right about C<eq> and C<ne>, aren't I? + +=item * + +B<Regular expressions and case-modification functions> (C<uc>, +C<lc>, C<ucfirst>, and C<lcfirst>) use C<LC_CTYPE> + +=item * + +B<The formatting functions> (C<printf> and C<sprintf>) use +C<LC_NUMERIC> + +=item * + +B<The POSIX date formatting function> (C<strftime>) uses C<LC_TIME>. + +=back + +C<LC_COLLATE>, C<LC_CTYPE>, and so on, are discussed further in +L<LOCALE CATEGORIES>. + +The default behaviour returns with S<C<no locale>> or on reaching the end +of the enclosing block. + +Note that the result of any operation that uses locale information is +tainted (see L<perlsec.pod>), since locales can be created by +unprivileged users on some systems. + +=head2 The setlocale function + +You can switch locales as often as you wish at runtime with the +C<POSIX::setlocale> function: + + # This functionality not usable prior to Perl 5.004 + require 5.004; + + # Import locale-handling tool set from POSIX module. + # This example uses: setlocale -- the function call + # LC_CTYPE -- explained below + use POSIX qw(locale_h); + + # query and save the old locale. + $old_locale = setlocale(LC_CTYPE); + + setlocale(LC_CTYPE, "fr_CA.ISO8859-1"); + # LC_CTYPE now in locale "French, Canada, codeset ISO 8859-1" + + setlocale(LC_CTYPE, ""); + # LC_CTYPE now reset to default defined by LC_ALL/LC_CTYPE/LANG + # environment variables. See below for documentation. + + # restore the old locale + setlocale(LC_CTYPE, $old_locale); + +The first argument of C<setlocale> gives the B<category>, the second +the B<locale>. The category tells in what aspect of data processing +you want to apply locale-specific rules. Category names are discussed +in L<LOCALE CATEGORIES> and L<ENVIRONMENT>. The locale is the name of +a collection of customization information corresponding to a paricular +combination of language, country or territory, and codeset. Read on +for hints on the naming of locales: not all systems name locales as in +the example. + +If no second argument is provided, the function returns a string +naming the current locale for the category. You can use this value as +the second argument in a subsequent call to C<setlocale>. If a second +argument is given and it corresponds to a valid locale, the locale for +the category is set to that value, and the function returns the +now-current locale value. You can use this in a subsequent call to +C<setlocale>. (In some implementations, the return value may sometimes +differ from the value you gave as the second argument - think of it as +an alias for the value that you gave.) + +As the example shows, if the second argument is an empty string, the +category's locale is returned to the default specified by the +corresponding environment variables. Generally, this results in a +return to the default which was in force when Perl started up: changes +to the environment made by the application after start-up 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 for the category is not changed, and the function returns +C<undef>. + +For further information about the categories, consult +L<setlocale(3)>. For the locales available in your system, +also consult L<setlocale(3)> and see whether it leads you +to the list of the available locales (search for the C<SEE ALSO> +section). If that fails, try the following command lines: + + locale -a + + nlsinfo + + ls /usr/lib/nls/loc + + ls /usr/lib/locale + + ls /usr/lib/nls + +and see whether they list something resembling these + + en_US.ISO8859-1 de_DE.ISO8859-1 ru_RU.ISO8859-5 + en_US de_DE ru_RU + en de ru + english german russian + english.iso88591 german.iso88591 russian.iso88595 + +Sadly, even though the calling interface for C<setlocale> has been +standardized, the names of the locales have not. The form of the name +is usually I<language_country>B</>I<territory>B<.>I<codeset>, but the +latter parts are not always present. + +Two special locales are worth particular mention: "C" and +"POSIX". Currently these are effectively the same locale: the +difference is mainly that the first one is defined by the C standard +and the second by the POSIX standard. What they define is the +B<default locale> in which every program starts in the absence of +locale information in its environment. (The default default locale, +if you will.) Its language is (American) English and its character +codeset ASCII. + +B<NOTE>: Not all systems have the "POSIX" locale (not all systems +are POSIX-conformant), so use "C" when you need explicitly to +specify this default locale. + +=head2 The localeconv function + +The C<POSIX::localeconv> function allows you to get particulars of the +locale-dependent numeric formatting information specified by the +current C<LC_NUMERIC> and C<LC_MONETARY> locales. (If you just want +the name of the current locale for a particular category, use +C<POSIX::setlocale> with a single parameter - see L<The setlocale +function>.) + + use POSIX qw(locale_h); + use locale; + + # Get a reference to a hash of locale-dependent info + $locale_values = localeconv(); + + # Output sorted list of the values + for (sort keys %$locale_values) { + printf "%-20s = %s\n", $_, $locale_values->{$_} + } + +C<localeconv> takes no arguments, and returns B<a reference to> a +hash. The keys of this hash are formatting variable names such as +C<decimal_point> and C<thousands_sep>; the values are the +corresponding values. See L<POSIX (3)/localeconv> for a longer +example, which lists all the categories an implementation might be +expected to provide; some provide more and others fewer, however. + +I<Editor's note:> I can't work out whether C<POSIX::localeconv> +correctly obeys C<use locale> and C<no locale>. In my opinion, it +should, if only to be consistent with other locale stuff - although +it's hardly a show-stopper if it doesn't. Could someone check, +please? + +Here's a simple-minded example program which rewrites its command line +parameters as integers formatted correctly in the current locale: + + # See comments in previous example + require 5.004; + use POSIX qw(locale_h); + use locale; + + # Get some of locale's numeric formatting parameters + my ($thousands_sep, $grouping) = + @{localeconv()}{'thousands_sep', 'grouping'}; + + # Apply defaults if values are missing + $thousands_sep = ',' unless $thousands_sep; + $grouping = 3 unless $grouping; + + # Format command line params for current locale + for (@ARGV) + { + $_ = int; # Chop non-integer part + 1 while + s/(\d)(\d{$grouping}($|$thousands_sep))/$1$thousands_sep$2/; + print "$_ "; + } + print "\n"; + +I<Editor's note:> Like all the examples, this needs testing on systems +which, unlike mine, have non-toy implementations of locale handling. + +=head1 LOCALE CATEGORIES + +The subsections which follow descibe basic locale categories. As well +as these, there are some combination categories which allow the +manipulation of of more than one basic category at a time. See +L<ENVIRONMENT VARIABLES> for a discussion of these. + +=head2 Category LC_COLLATE: Collation + +When in the scope of S<C<use locale>>, Perl looks to the B<LC_COLLATE> +environment variable to determine the application's notions on the +collation (ordering) of characters. ('B' follows 'A' in Latin +alphabets, but where do '¡' and 'Ÿ' belong?) + +Here is a code snippet that will tell you what are the alphanumeric +characters in the current locale, in the locale order: + + use locale; + print +(sort grep /\w/, map { chr() } 0..255), "\n"; + +I<Editor's note:> The original example had C<setlocale(LC_COLLATE, "")> +prior to C<print ...>. I think this is wrong: as soon as you utter +S<C<use locale>>, the default behaviour of C<sort> (well, C<cmp>, really) +becomes locale-aware. The locale it's aware of is the current locale +which, unless you've changed it yourself, is the default locale +defined by your environment. + +Compare this with the characters that you see and their order if you state +explicitly that the locale should be ignored: + + no locale; + print +(sort grep /\w/, map { chr() } 0..255), "\n"; + +This machine-native collation (which is what you get unless S<C<use +locale>> has appeared earlier in the same block) must be used for +sorting raw binary data, whereas the locale-dependent collation of the +first example is useful for written text. + +B<NOTE>: In some locales some characters may have no collation value +at all - for example, if '-' is such a character, 'relocate' and +'re-locate' may be considered to be equal to each other, and so sort +to the same position. + +=head2 Category LC_CTYPE: Character Types + +When in the scope of S<C<use locale>>, Perl obeys the C<LC_CTYPE> locale +setting. This controls the application's notion of which characters +are alphabetic. This affects Perl's C<\w> regular expression +metanotation, which stands for alphanumeric characters - that is, +alphabetic and numeric characters. (Consult L<perlre> for more +information about regular expressions.) Thanks to C<LC_CTYPE>, +depending on your locale setting, characters like '', 'Š', +'þ', and '¯' may be understood as C<\w> characters. + +C<LC_CTYPE> also affects the POSIX character-class test functions - +C<isalpha>, C<islower> and so on. For example, if you move from the +"C" locale to a 7-bit Scandinavian one, you may find - possibly to +your surprise -that "|" moves from the C<ispunct> class to C<isalpha>. + +I<Editor's note:> I can't work out whether the C<POSIX::is...> stuff +correctly obeys C<use locale> and C<no locale>. In my opinion, they +should. Could someone check, please? + +B<Note:> A broken or malicious C<LC_CTYPE> locale definition may +result in clearly ineligible characters being considered to be +alphanumeric by your application. For strict matching of (unaccented) +letters and digits - for example, in command strings - locale-aware +applications should use C<\w> inside a C<no locale> block. + +=head2 Category LC_NUMERIC: Numeric Formatting + +When in the scope of S<C<use locale>>, Perl obeys the C<LC_NUMERIC> +locale information which controls application's idea of how numbers +should be formatted for human readability by the C<printf>, C<fprintf>, +and C<write> functions. String to numeric conversion by the +C<POSIX::strtod> function is also affected. In most impementations +the only effect is to change the character used for the decimal point +- perhaps from '.' to ',': these functions aren't aware of such +niceties as thousands separation and so on. (See L<The localeconv +function> if you care about these things.) + +I<Editor's note:> I can't work out whether C<POSIX::strtod> correctly +obeys C<use locale> and C<no locale>. In my opinion, it should - +although it's hardly a show-stopper if it doesn't. Could someone +check, please? + +Note that output produced by C<print> is B<never> affected by the +current locale: it is independent of whether C<use locale> or C<no +locale> is in effect, and corresponds to what you'd get from C<printf> +in the "C" locale. The same is true for Perl's internal conversions +between numeric and string formats: + + use POSIX qw(strtod); + use locale; + $n = 5/2; # Assign numeric 2.5 to $n + + $a = " $n"; # Locale-independent conversion to string + + print "half five is $n\n"; # Locale-independent output + + printf "half five is %g\n", $n; # Locale-dependent output + + print "DECIMAL POINT IS COMMA\n" # Locale-dependent conversion + if $n == (strtod("2,5"))[0]; + +=head2 Category LC_MONETARY: Formatting of monetary amounts + +The C standard defines the C<LC_MONETARY> category, but no function +that is affected by its contents. (Those with experience of standards +committees will recognise that the working group decided to punt on +the issue.) Consequently, Perl takes no notice of it. If you really +want to use C<LC_MONETARY>, you can query its contents - see L<The +localeconv function> - and use the information that it returns in your +application's own formating of currency amounts. However, you may +well find that the information, though voluminous and complex, does +not quite meet your requirements: currency formatting is a hard nut to +crack. + +=head2 LC_TIME + +The output produced by C<POSIX::strftime>, which builds a formatted +human-readable date/time string, is affected by the current C<LC_TIME> +locale. Thus, in a French locale, the output produced by the C<%B> +format element (full month name) for the first month of the year would +be "janvier". Here's how to get a list of the long month names in the +current locale: + + use POSIX qw(strftime); + use locale; + for (0..11) + { + $long_month_name[$_] = strftime("%B", 0, 0, 0, 1, $_, 96); + } + +I<Editor's note:> Unchecked in "alien" locales: my system can't do +French... + +=head2 Other categories + +The remaining locale category, C<LC_MESSAGES> (possibly supplemented by +others in particular implementations) is not currently used by Perl - +except possibly to affect the behaviour of library functions called +by extensions which are not part of the standard Perl distribution. + +=head1 ENVIRONMENT + +=over 12 + +=item PERL_BADLANG + +A string that controls whether Perl warns in its startup about failed +locale settings. This can happen if the locale support in the +operating system is lacking (broken) is some way. If this string has +an integer value differing from zero, Perl will not complain. + +B<NOTE>: This is just hiding the warning message. The message tells +about some problem in your system's locale support and you should +investigate what the problem is. + +=back + +The following environment variables are not specific to Perl: They are +part of the standardized (ISO C, XPG4, POSIX 1.c) setlocale method to +control an application's opinion on data. + +=over 12 + +=item LC_ALL + +C<LC_ALL> is the "override-all" locale environment variable. If it is +set, it overrides all the rest of the locale environment variables. + +=item LC_CTYPE + +In the absence of C<LC_ALL>, C<LC_CTYPE> chooses the character type +locale. In the absence of both C<LC_ALL> and C<LC_CTYPE>, C<LANG> +chooses the character type locale. + +=item LC_COLLATE + +In the absence of C<LC_ALL>, C<LC_COLLATE> chooses the collation (sorting) +locale. In the absence of both C<LC_ALL> and C<LC_COLLATE>, C<LANG> +chooses the collation locale. + +=item LC_MONETARY + +In the absence of C<LC_ALL>, C<LC_MONETARY> chooses the montary formatting +locale. In the absence of both C<LC_ALL> and C<LC_MONETARY>, C<LANG> +chooses the monetary formatting locale. + +=item LC_NUMERIC + +In the absence of C<LC_ALL>, C<LC_NUMERIC> chooses the numeric format +locale. In the absence of both C<LC_ALL> and C<LC_NUMERIC>, C<LANG> +chooses the numeric format. + +=item LC_TIME + +In the absence of C<LC_ALL>, C<LC_TIME> chooses the date and time formatting +locale. In the absence of both C<LC_ALL> and C<LC_TIME>, C<LANG> +chooses the date and time formatting locale. + +=item LANG + +C<LANG> is the "catch-all" locale environment variable. If it is set, +it is used as the last resort after the overall C<LC_ALL> and the +category-specific C<LC_...>. + +=back + +=head1 NOTES + +=head2 Backward compatibility + +Versions of Perl prior to 5.004 ignored locale information, generally +behaving as if something similar to the C<"C"> locale (see L<The +setlocale function>) was always in force, even if the program +environment suggested otherwise. By default, Perl still behaves this +way so as to maintain backward compatibility. If you want a Perl +application to pay attention to locale information, you B<must> use +the S<C<use locale>> pragma (see L<The S<C<use locale>> Pragma>) to +instruct it to do so. + +=head2 Sort speed + +Comparing and sorting by locale is usually slower than the default +sorting; factors of 2 to 4 have been observed. It will also consume +more memory: while a Perl scalar variable is participating in any +string comparison or sorting operation and obeying the locale +collation rules it will take about 3-15 (the exact value depends on +the operating system and the locale) times more memory than normally. +These downsides are dictated more by the operating system +implementation of the locale system than by Perl. + +=head2 I18N:Collate + +In Perl 5.003 (and later development releases prior to 5.003_06), +per-locale collation was possible using the C<I18N::Collate> library +module. This is now mildly obsolete and should be avoided in new +applications. The C<LC_COLLATE> functionality is integrated into the +Perl core language and one can use locale-specific scalar data +completely normally - there is no need to juggle with the scalar +references of C<I18N::Collate>. + +=head2 An imperfect standard + +Internationalization, as defined in the C and POSIX standards, can be +criticized as incomplete, ungainly, and having too large a +granularity. (Locales apply to a whole process, when it would +arguably be more useful to have them apply to a single thread, window +group, or whatever.) They also have a tendency, like standards +groups, to divide the world into nations, when we all know that the +world can equally well be divided into bankers, bikers, gamers, and so +on. But, for now, it's the only standard we've got. This may be +construed as a bug. + +=head2 Freely available locale definitions + +There is a large collection of locale definitions at +C<ftp://dkuug.dk/i18n/WG15-collection>. You should be aware that they +are unsupported, and are not claimed to be fit for any purpose. If +your system allows the installation of arbitrary locales, you may find +them useful as they are, or as a basis for the development of your own +locales. + +=head2 i18n and l10n + +Internationalization is often abbreviated as B<i18n> because its first +and last letters are separated by eighteen others. You can also talk of +localization (B<l10n>), the process of tailoring an +internationalizated application for use in a particular locale. + +=head1 BUGS + +=head2 Broken systems + +In certain system environments the operating system's locale support +is broken and cannot be fixed or used by Perl. Such deficiencies can +and will result in mysterious hangs and/or Perl core dumps. One +example is IRIX before release 6.2, in which the C<LC_COLLATE> support +simply does not work. When confronted with such a system, please +report in excruciating detail to C<perlbug@perl.com>, and complain to +your vendor: maybe some bug fixes exist for these problems in your +operating system. Sometimes such bug fixes are called an operating +system upgrade. + +=head2 Rendering of this documentation + +This manual page contains non-ASCII characters, which should all be +rendered as accented letters, and which should make some sort of sense +in context. If this is not the case, your system is probably not +using the ISO 8859-1 character set which was used to write them, +and/or your formatting, display, and printing software are not +correctly mapping them to your host's character set. If this annoys +you, and if you can convince yourself that it is due to a bug in one +of Perl's various C<pod2>... utilities, by all means report it as a +Perl bug. Otherwise, pausing only to curse anyone who ever invented +yet another character set, see if you can make it handle ISO 8859-1 +sensibly. + +=head1 SEE ALSO + +L<POSIX (3)/isalnum>, L<POSIX (3)/isalpha>, L<POSIX (3)/isdigit>, +L<POSIX (3)/isgraph>, L<POSIX (3)/islower>, L<POSIX (3)/isprint>, +L<POSIX (3)/ispunct>, L<POSIX (3)/isspace>, L<POSIX (3)/isupper>, +L<POSIX (3)/isxdigit>, L<POSIX (3)/localeconv>, L<POSIX (3)/setlocale>, +L<POSIX (3)/strtod> + +I<Editor's note:> That looks horrible after going through C<pod2man>. +But I do want to call out all thse sectins by name. What should I +have done? + +=head1 HISTORY + +Perl 5.003's F<perli18n.pod> heavily hacked by Dominic Dunlop. + +Last update: +Mon Dec 16 14:13:10 WET 1996 diff --git a/pod/perllol.pod b/pod/perllol.pod index c97aac918d..37adac7ef5 100644 --- a/pod/perllol.pod +++ b/pod/perllol.pod @@ -27,7 +27,7 @@ a declaration of the array: Now you should be very careful that the outer bracket type is a round one, that is, parentheses. That's because you're assigning to -an @list, so you need parens. If you wanted there I<not> to be an @LoL, +an @list, so you need parentheses. If you wanted there I<not> to be an @LoL, but rather just a reference to it, you could do something more like this: # assign a reference to list of list references @@ -144,10 +144,10 @@ you'd have to do something like this: push @$ref_to_LoL, [ split ]; } -Actually, if you were using strict, you'd not only have to declare $ref_to_LoL as -you had to declare @LoL, but you'd I<also> having to initialize it to a -reference to an empty list. (This was a bug in 5.001m that's been fixed -for the 5.002 release.) +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 +initialize it to a reference to an empty list. (This was a bug in 5.001m +that's been fixed for the 5.002 release.) my $ref_to_LoL = []; while (<>) { @@ -155,7 +155,7 @@ for the 5.002 release.) } Ok, now you can add new rows. What about adding new columns? If you're -just dealing with matrices, it's often easiest to use simple assignment: +dealing with just matrices, it's often easiest to use simple assignment: for $x (1 .. 10) { for $y (1 .. 10) { @@ -171,13 +171,13 @@ 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. -If you just wanted to append to a row, you'd have +If you wanted just to append to a row, you'd have to do something a bit funnier looking: # add new columns to an existing row push @{ $LoL[0] }, "wilma", "betty"; -Notice that I I<couldn't> just say: +Notice that I I<couldn't> say just: push $LoL[0], "wilma", "betty"; # WRONG! @@ -187,17 +187,17 @@ to push() must be a real array, not just a reference to such. =head1 Access and Printing Now it's time to print your data structure out. How -are you going to do that? Well, if you only want one +are you going to do that? Well, if you want only one of the elements, it's trivial: print $LoL[0][0]; If you want to print the whole thing, though, you can't -just say +say print @LoL; # WRONG -because you'll just get references listed, and perl will never +because you'll get just references listed, and perl will never automatically dereference things for you. Instead, you have to roll yourself a loop or two. This prints the whole structure, using the shell-style for() construct to loop across the outer @@ -231,7 +231,7 @@ sometimes is easier to take a temporary on your way through: } } -Hm... that's still a bit ugly. How about this: +Hmm... that's still a bit ugly. How about this: for $i ( 0 .. $#LoL ) { $aref = $LoL[$i]; @@ -266,7 +266,7 @@ That same loop could be replaced with a slice operation: but as you might well imagine, this is pretty rough on the reader. Ah, but what if you wanted a I<two-dimensional slice>, such as having -$x run from 4..8 and $y run from 7 to 12? Hm... here's the simple way: +$x run from 4..8 and $y run from 7 to 12? Hmm... here's the simple way: @newLoL = (); for ($startx = $x = 4; $x <= 8; $x++) { diff --git a/pod/perlmod.pod b/pod/perlmod.pod index 7cb3a4907e..4fb5ec838b 100644 --- a/pod/perlmod.pod +++ b/pod/perlmod.pod @@ -13,11 +13,11 @@ Perl. The package statement declares the compilation unit as being in the given namespace. The scope of the package declaration is from the declaration itself through the end of the enclosing block (the same scope as the local() operator). All further unqualified dynamic identifiers -will be in this namespace. A package statement only affects dynamic +will be in this namespace. A package statement affects only dynamic variables--including those you've used local() on--but I<not> lexical variables created with my(). Typically it would be the first declaration in a file to be included by the C<require> or C<use> operator. You can -switch into a package in more than one place; it merely influences which +switch into a package in more than one place; it influences merely which symbol table is used by the compiler for the rest of that block. You can refer to variables and filehandles in other packages by prefixing the identifier with the package name and a double colon: @@ -39,10 +39,10 @@ It would treat package C<INNER> as a totally separate global package. Only identifiers starting with letters (or underscore) are stored in a package's symbol table. All other symbols are kept in package C<main>, including all of the punctuation variables like $_. In addition, the -identifiers STDIN, STDOUT, STDERR, ARGV, ARGVOUT, ENV, INC and SIG are +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>, -C<s> or C<y>, then you can't use the qualified form of an identifier +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. @@ -62,7 +62,7 @@ temporarily switches back to the C<main> package to evaluate various expressions in the context of the C<main> package (or wherever you came from). See L<perldebug>. -See L<perlsub> for other scoping issues related to my() and local(), +See L<perlsub> for other scoping issues related to my() and local(), or L<perlref> regarding closures. =head2 Symbol Tables @@ -119,9 +119,9 @@ Assignment to a typeglob performs an aliasing operation, i.e., *dick = *richard; -causes variables, subroutines and file handles accessible via the +causes variables, subroutines, and file handles accessible via the identifier C<richard> to also be accessible via the identifier C<dick>. If -you only want to alias a particular variable or subroutine, you can +you want to alias only a particular variable or subroutine, you can assign a reference instead: *dick = \$richard; @@ -140,10 +140,10 @@ thing. # now use %hashsym normally, and you # will affect the caller's %another_hash my %nhash = (); # do what you want - return \%nhash; + return \%nhash; } -On return, the reference wil overwrite the hash slot in the +On return, the reference will overwrite the hash slot in the symbol table specified by the *some_hash typeglob. This is a somewhat tricky way of passing around references cheaply when you won't want to have to remember to dereference variables @@ -197,7 +197,7 @@ order of definition; that is: last in, first out (LIFO). Inside an C<END> subroutine C<$?> contains the value that the script is going to pass to C<exit()>. You can modify C<$?> to change the exit -value of the script. Beware of changing C<$?> by accident (eg, by +value of the script. Beware of changing C<$?> by accident (e.g.,, by running something via C<system>). Note that when you use the B<-n> and B<-p> switches to Perl, C<BEGIN> @@ -208,7 +208,7 @@ and C<END> work just as they do in B<awk>, as a degenerate case. There is no special class syntax in Perl, but a package may function as a class if it provides subroutines that function as methods. Such a package may also derive some of its methods from another class package -by listing the other package name in its @ISA array. +by listing the other package name in its @ISA array. For more on this, see L<perlobj>. @@ -225,15 +225,18 @@ symbols. Or it can do a little of both. For example, to start a normal module called Fred, create a file called Fred.pm and put this at the start of it: - package Fred; - use Exporter (); + package Fred; + use strict; + use Exporter (); + use vars qw(@ISA @EXPORT @EXPORT_OK); @ISA = qw(Exporter); - @EXPORT = qw(func1 func2); - @EXPORT_OK = qw($sally @listabob %harry func3); + @EXPORT = qw(&func1 &func2); + @EXPORT_OK = qw($sally @listabob %harry &func3); + use vars qw($sally @listabob %harry); Then go on to declare and use your variables in functions without any qualifications. -See L<Exporter> and the I<Perl Modules File> for details on +See L<Exporter> and the I<Perl Modules File> for details on mechanics and style issues in module creation. Perl modules are included into your program by saying @@ -278,7 +281,7 @@ instead of C<use>. With require you can get into this problem: require Cwd; # make Cwd:: accessible $here = Cwd::getcwd(); - use Cwd; # import names from Cwd:: + use Cwd; # import names from Cwd:: $here = getcwd(); require Cwd; # make Cwd:: accessible @@ -299,7 +302,7 @@ the module. If so, these will be entirely transparent to the user of the module. It is the responsibility of the F<.pm> file to load (or arrange to autoload) any additional functionality. The POSIX module happens to do both dynamic loading and autoloading, but the user can -just say C<use POSIX> to get it all. +say just C<use POSIX> to get it all. For more information on writing extension modules, see L<perlxs> and L<perlguts>. @@ -315,14 +318,14 @@ because it has a shotgun. The module and its user have a contract, part of which is common law, and part of which is "written". Part of the common law contract is that a module doesn't pollute any namespace it wasn't asked to. The -written contract for the module (AKA documentation) may make other +written contract for the module (A.K.A. documentation) may make other provisions. But then you know when you C<use RedefineTheWorld> that you're redefining the world and willing to take the consequences. =head1 THE PERL MODULE LIBRARY -A number of modules are included the the Perl distribution. These are -described below, and all end in F<.pm>. You may also discover files in +A number of modules are included the Perl distribution. These are +described below, and all end in F<.pm>. You may also discover files in the library directory that end in either F<.pl> or F<.ph>. These are old libraries supplied so that old programs that use them still run. The F<.pl> files will all eventually be converted into standard modules, and @@ -334,7 +337,7 @@ conversion, but it's just a mechanical process, so is far from bulletproof. =head2 Pragmatic Modules They work somewhat like pragmas in that they tend to affect the compilation of -your program, and thus will usually only work well when used within a +your program, and thus will usually work well only when used within a C<use>, or C<no>. Most of these are locally scoped, so an inner BLOCK may countermand any of these by saying: @@ -343,7 +346,7 @@ may countermand any of these by saying: which lasts until the end of that BLOCK. -Unlike the pragrmas that effect the C<$^H> hints variable, the C<use +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 <I>file</I> rather than just a block. Such declarations are effective @@ -354,6 +357,11 @@ The following pragmas are defined (and have their own documentation). =over 12 +=item blib + +manipulate @INC at compile time to use MakeMaker's uninstalled version +of a package + =item diagnostics force verbose warning diagnostics @@ -370,13 +378,17 @@ request less of something from the compiler manipulate @INC at compile time +=item locale + +use or ignore current locale for built-in operations (see L<perli18n>) + =item ops -restrict unsafe operations when compiling +restrict named opcodes when compiling or running Perl code =item overload -package for overloading perl operations +overload basic Perl operations =item sigtrap @@ -388,11 +400,11 @@ restrict unsafe constructs =item subs -predeclare sub names +pre-declare sub names =item vars -predeclare global variable names +pre-declare global variable names =back @@ -424,6 +436,10 @@ benchmark running times of code warn of errors (from perspective of caller) +=item Class::Template + +struct/member template builder + =item Config access Perl configuration information @@ -446,7 +462,7 @@ supply object methods for directory handles =item DynaLoader -Dynamically load C libraries into Perl code +dynamically load C libraries into Perl code =item English @@ -462,7 +478,7 @@ implements default import method for modules =item ExtUtils::Embed -Utilities for embedding Perl in C/C++ applications +utilities for embedding Perl in C/C++ applications =item ExtUtils::Install @@ -472,6 +488,18 @@ install files from here to there determine libraries to use and how to use them +=item ExtUtils::MM_OS2 + +methods to override UN*X behaviour in ExtUtils::MakeMaker + +=item ExtUtils::MM_Unix + +methods used by ExtUtils::MakeMaker + +=item ExtUtils::MM_VMS + +methods to override UN*X behaviour in ExtUtils::MakeMaker + =item ExtUtils::MakeMaker create an extension Makefile @@ -480,10 +508,6 @@ create an extension Makefile utilities to write and check a MANIFEST file -=item ExtUtils::Miniperl - -write the C code for perlmain.c - =item ExtUtils::Mkbootstrap make a bootstrap file for use by DynaLoader @@ -492,21 +516,21 @@ make a bootstrap file for use by DynaLoader write linker options files for dynamic extension -=item ExtUtils::MM_OS2 +=item ExtUtils::testlib -methods to override UN*X behaviour in ExtUtils::MakeMaker +add blib/* directories to @INC -=item ExtUtils::MM_Unix +=item CPAN -methods used by ExtUtils::MakeMaker +interface to Comprehensive Perl Archive Network -=item ExtUtils::MM_VMS +=item CPAN::FirstTime -methods to override UN*X behaviour in ExtUtils::MakeMaker +create a CPAN configuration file -=item ExtUtils::testlib +=item CPAN::Nox -add blib/* directories to @INC +run CPAN while avoiding compiled extensions =item Fatal @@ -518,39 +542,47 @@ load the C Fcntl.h defines =item File::Basename -parse file specifications - -=item FileCache - -keep more files open than the system permits +split a pathname into pieces =item File::CheckTree run many filetest checks on a tree +=item File::Compare + +compare files or filehandles + =item File::Copy -Copy files or filehandles +copy files or filehandles =item File::Find traverse a file tree -=item FileHandle - -supply object methods for filehandles - =item File::Path create or remove a series of directories +=item File::stat + +by-name interface to Perl's built-in stat() functions + +=item FileCache + +keep more files open than the system permits + +=item FileHandle + +supply object methods for filehandles + =item FindBin locate directory of original perl script =item GDBM_File -access to the gdbm library. +access to the gdbm library =item Getopt::Long @@ -616,13 +648,41 @@ complex numbers and associated mathematical functions tied access to ndbm files +=item Net::FTP + +File Transfer Protocol client + =item Net::Ping check a host for upness +=item Net::Netrc + +parser for ".netrc" files a la Berkeley UNIX + +=item Net::Socket + +support class for Net::FTP + +=item Net::hostent + +by-name interface to Perl's built-in gethost*() functions + +=item Net::netent + +by-name interface to Perl's built-in getnet*() functions + +=item Net::protoent + +by-name interface to Perl's built-in getproto*() functions + +=item Net::servent + +by-name interface to Perl's built-in getserv*() functions + =item Opcode -disable named opcodes when compiling perl code +disable named opcodes when compiling or running perl code =item Pod::Text @@ -630,16 +690,16 @@ convert POD data to formatted ASCII text =item POSIX -interface to IEEE Std 1003.1 - -=item Safe - -compile and execute code in restricted compartments +interface to IEEE Standard 1003.1 =item SDBM_File tied access to sdbm files +=item Safe + +compile and execute code in restricted compartments + =item Search::Dict search for key in dictionary file @@ -674,7 +734,7 @@ interface to the UNIX syslog(3) calls =item Term::Cap -Perl termcap interface +termcap interface =item Term::Complete @@ -682,7 +742,7 @@ word completion module =item Term::ReadLine -interface to various readline packages. +interface to various C<readline> packages =item Test::Harness @@ -698,7 +758,7 @@ parse text into an array of tokens =item Text::Soundex -implementation of the Soundex Algorithm as Described by Knuth +implementation of the Soundex Algorithm as described by Knuth =item Text::Tabs @@ -712,6 +772,10 @@ line wrapping to form simple paragraphs base class definitions for tied hashes +=item Tie::RefHash + +base class definitions for tied hashes with references as keys + =item Tie::Scalar base class definitions for tied scalars @@ -724,10 +788,30 @@ fixed-table-size, fixed-key-length hashing efficiently compute time from local and GMT time +=item Time::gmtime + +by-name interface to Perl's built-in gmtime() function + +=item Time::localtime + +by-name interface to Perl's built-in localtime() function + +=item Time::tm + +internal object used by Time::gmtime and Time::localtime + =item UNIVERSAL base class for ALL classes (blessed references) +=item User::grent + +by-name interface to Perl's built-in getgr*() functions + +=item User::pwent + +by-name interface to Perl's built-in getpw*() functions + =back To find out I<all> the modules installed on your system, including @@ -745,7 +829,7 @@ dynamically loaded into Perl if and when you need them. Supported extension modules include the Socket, Fcntl, and POSIX modules. Many popular C extension modules do not come bundled (at least, not -completely) due to their size, volatility, or simply lack of time for +completely) due to their sizes, volatility, or simply lack of time for adequate testing and configuration across the multitude of platforms on which Perl was beta-tested. You are encouraged to look for them in archie(1L), the Perl FAQ or Meta-FAQ, the WWW page, and even with their @@ -755,13 +839,13 @@ disposition. =head1 CPAN CPAN stands for the Comprehensive Perl Archive Network. This is a globally -replicated collection of all known Perl materials, including hundreds +replicated collection of all known Perl materials, including hundreds of unbundled modules. Here are the major categories of modules: =over =item * -Language Extensions and Documentation Tools +Language Extensions and Documentation Tools =item * Development Support @@ -788,16 +872,16 @@ Interfaces to / Emulations of Other Programming Languages File Names, File Systems and File Locking (see also File Handles) =item * -String Processing, Language Text Processing, Parsing and Searching +String Processing, Language Text Processing, Parsing, and Searching =item * -Option, Argument, Parameter and Configuration File Processing +Option, Argument, Parameter, and Configuration File Processing =item * Internationalization and Locale =item * -Authentication, Security and Encryption +Authentication, Security, and Encryption =item * World Wide Web, HTML, HTTP, CGI, MIME @@ -809,7 +893,7 @@ Server and Daemon Utilities Archiving and Compression =item * -Images, Pixmap and Bitmap Manipulation, Drawing and Graphing +Images, Pixmap and Bitmap Manipulation, Drawing, and Graphing =item * Mail and Usenet News @@ -898,15 +982,15 @@ ftp://ftp.is.co.za/programming/perl/CPAN/ =back -For an up-to-date listing of CPAN sites, +For an up-to-date listing of CPAN sites, see F<http://www.perl.com/perl/CPAN> or F<ftp://ftp.perl.com/perl/>. -=head1 Modules: Creation, Use and Abuse +=head1 Modules: Creation, Use, and Abuse (The following section is borrowed directly from Tim Bunce's modules file, available at your nearest CPAN site.) -Perl 5 implements a class using a package, but the presence of a +Perl implements a class using a package, but the presence of a package doesn't imply the presence of a class. A package is just a namespace. A class is a package that provides subroutines that can be used as methods. A method is just a subroutine that expects, as its @@ -944,9 +1028,9 @@ scheme as the original author. Use blessed references. Use the two argument form of bless to bless into the class name given as the first parameter of the constructor, -e.g.: +e.g.,: - sub new { + sub new { my $class = shift; return bless {}, $class; } @@ -954,7 +1038,7 @@ e.g.: or even this if you'd like it to be used as either a static or a virtual method. - sub new { + sub new { my $self = shift; my $class = ref($self) || $self; return bless {}, $class; @@ -1021,7 +1105,7 @@ or nature of a variable. For example: $no_caps_here function scope my() or local() variables Function and method names seem to work best as all lowercase. -E.g., C<$obj-E<gt>as_string()>. +e.g.,, C<$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. @@ -1039,11 +1123,11 @@ short or common names to reduce the risk of name clashes. Generally anything not exported is still accessible from outside the module using the ModuleName::item_name (or C<$blessed_ref-E<gt>method>) syntax. By convention you can use a leading underscore on names to -informally indicate that they are 'internal' and not for public use. +indicate informally that they are 'internal' and not for public use. (It is actually possible to get private functions by saying: C<my $subref = sub { ... }; &$subref;>. But there's no way to call that -directly as a method, since a method must have a name in the symbol +directly as a method, because a method must have a name in the symbol table.) As a general rule, if the module is trying to be object oriented @@ -1052,12 +1136,12 @@ then export nothing. If it's just a collection of functions then =item Select a name for the module. -This name should be as descriptive, accurate and complete as +This name should be as descriptive, accurate, and complete as possible. Avoid any risk of ambiguity. Always try to use two or more whole words. Generally the name should reflect what is special about what the module does rather than how it does it. Please use -nested module names to informally group or categorise a module. -A module should have a very good reason not to have a nested name. +nested module names to group informally or categorize a module. +There should be a very good reason for a module not to have a nested name. Module names should begin with a capital letter. Having 57 modules all called Sort will not make life easy for anyone @@ -1137,16 +1221,16 @@ Copying, ToDo etc. =item Adding a Copyright Notice. -How you choose to licence your work is a personal decision. +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 +GPL and The Artistic License (see the files README, Copying, and Artistic). Larry has good reasons for NOT just using the GNU GPL. -My personal recommendation, out of respect for Larry, Perl and the -perl community at large is to simply state something like: +My personal recommendation, out of respect for Larry, Perl, and the +perl community at large is to state something simply like: Copyright (c) 1995 Your Name. All rights reserved. This program is free software; you can redistribute it and/or @@ -1160,8 +1244,8 @@ Remember to include the other words in addition to the Copyright. To be fully compatible with the Exporter and MakeMaker modules you should store your module's version number in a non-my package -variable called $VERSION. This should be a valid floating point -number with at least two digits after the decimal (ie hundredths, +variable called $VERSION. This should be a floating point +number with at least two digits after the decimal (i.e., hundredths, e.g, C<$VERSION = "0.01">). Don't use a "1.3.2" style version. See Exporter.pm in Perl5.001m or later for details. @@ -1178,7 +1262,7 @@ Usenet newsgroup. This will at least ensure very wide once-off distribution. If possible you should place the module into a major ftp archive and -include details of it's location in your announcement. +include details of its location in your announcement. Some notes about ftp archives: Please use a long descriptive file name which includes the version number. Most incoming directories @@ -1195,10 +1279,10 @@ Follow the instructions and links on http://franz.ww.tu-berlin.de/modulelist -or upload to one of these sites: +or upload to one of these sites: ftp://franz.ww.tu-berlin.de/incoming - ftp://ftp.cis.ufl.edu/incoming + ftp://ftp.cis.ufl.edu/incoming and notify upload@franz.ww.tu-berlin.de. @@ -1289,8 +1373,7 @@ fragment of code built on top of the reusable modules. In these cases the application could invoked as: perl -e 'use Module::Name; method(@ARGV)' ... -or +or perl -mModule::Name ... (in perl5.002) =back - diff --git a/pod/perlnews.pod b/pod/perlnews.pod new file mode 100644 index 0000000000..7e6e626723 --- /dev/null +++ b/pod/perlnews.pod @@ -0,0 +1,642 @@ +=head1 NAME + +perlnews - what's new for perl5.004 + +=head1 DESCRIPTION + +This document describes differences between the 5.003 release (as +documented in I<Programming Perl>, second edition--the Camel Book) and +this one. + +=head1 Supported Environments + +Perl5.004 builds out of the box on Unix, Plan9, LynxOS, VMS, OS/2, +QNX, and AmigaOS. + +=head1 Core Changes + +Most importantly, many bugs were fixed. See the F<Changes> +file in the distribution for details. + +=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 +compatibility, you do not have to recompile your extensions, but you +might have symbol conflicts if you embed Perl in another application. + +=head2 Internal Change: FileHandle Deprecated + +Filehandles are now stored internally as type IO::Handle. +Although C<use FileHandle> and C<*STDOUT{FILEHANDLE}> +are still supported for backwards compatibility +C<use IO::Handle> (or C<IO::Seekable> or C<IO::File>) and +C<*STDOUT{IO}> are the way of the future. + +=head2 Internal Change: Safe Module Absorbed into Opcode + +A new Opcode module subsumes 5.003's Safe module. The Safe +interface is still available, so existing scripts should still +work, but users are encouraged to read the new Opcode documentation. + +=head2 Internal Change: PerlIO internal IO 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 + +=over + +=item $^E + +Extended error message under some platforms ($EXTENDED_OS_ERROR +if you C<use English>). + +=item $^H + +The current set of syntax checks enabled by C<use strict>. See the +documentation of C<strict> for more details. Not actually new, but +newly documented. +Because it is intended for internal use by Perl core components, +there is no C<use English> long name for this variable. + +=item $^M + +By default, running out of memory it is not trappable. However, if +compiled for this, Perl may use the contents of C<$^M> as an emergency +pool after die()ing with this message. Suppose that your Perl were +compiled with -DEMERGENCY_SBRK and used Perl's malloc. Then + + $^M = 'a' x (1<<16); + +would allocate 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 C<use English> long name for this variable. + +=back + +=head2 New and Changed Built-in Functions + +=over + +=item delete on slices + +This now works. (e.g. C<delete @ENV{'PATH', 'MANPATH'}>) + +=item flock + +is now supported on more platforms, and prefers fcntl +to lockf when emulating. + +=item keys as an lvalue + +As an lvalue, C<keys> allows you to increase the number of hash buckets +allocated for the given associative array. This can gain you a measure +of efficiency if you know the hash is going to get big. (This is +similar to pre-extending an array by assigning a larger number to +$#array.) If you say + + keys %hash = 200; + +then C<%hash> will have at least 200 buckets allocated for it. These +buckets will be retained even if you do C<%hash = ()>; use C<undef +%hash> if you want to free the storage while C<%hash> is still in scope. +You can't shrink the number of buckets allocated for the hash using +C<keys> in this way (but you needn't worry about doing this by accident, +as trying has no effect). + +=item my() in Control Structures + +You can now use my() (with or without the parentheses) in the control +expressions of control structures such as: + + while (my $line = <>) { + $line = lc $line; + } continue { + print $line; + } + + if ((my $answer = <STDIN>) =~ /^yes$/i) { + user_agrees(); + } elsif ($answer =~ /^no$/i) { + user_disagrees(); + } else { + chomp $answer; + die "'$answer' is neither 'yes' nor 'no'"; + } + +Also, you can declare a foreach loop control variable as lexical by +preceding it with the word "my". For example, in: + + foreach my $i (1, 2, 3) { + some_function(); + } + +$i is a lexical variable, and the scope of $i extends to the end of +the loop, but not beyond it. + +Note that you still cannot use my() on global punctuation variables +such as $_ and the like. + +=item unpack() and pack() + +A new format 'w' represents a BER compressed integer (as defined in +ASN.1). Its format is a sequence of one or more bytes, each of which +provides seven bits of the total value, with the most significant +first. Bit eight of each byte is set, except for the last byte, in +which bit eight is clear. + +=item use VERSION + +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 +is less than VERSION, then an error message is printed and Perl exits +immediately. 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.) + +=item use Module VERSION LIST + +If the VERSION argument is present between Module and LIST, then the +C<use> will fail if the $VERSION variable in package Module is +less than VERSION. + +Note that there is not a comma after the version! + +=item prototype(FUNCTION) + +Returns the prototype of a function as a string (or C<undef> if the +function has no prototype). FUNCTION is a reference to or the name of the +function whose prototype you want to retrieve. +(Not actually new; just never documented before.) + +=item $_ as Default + +Functions documented in the Camel to default to $_ now in +fact do, and all those that do are so documented in L<perlfunc>. + +=back + +=head2 New Built-in Methods + +The C<UNIVERSAL> package automatically contains the following methods that +are inherited by all other classes: + +=over 4 + +=item isa(CLASS) + +C<isa> returns I<true> if its object is blessed into a sub-class of C<CLASS> + +C<isa> is also exportable and can be called as a sub with two arguments. This +allows the ability to check what a reference points to. Example: + + use UNIVERSAL qw(isa); + + if(isa($ref, 'ARRAY')) { + ... + } + +=item can(METHOD) + +C<can> checks to see if its object has a method called C<METHOD>, +if it does then a reference to the sub is returned; if it does not then +I<undef> is returned. + +=item VERSION( [NEED] ) + +C<VERSION> returns the version number of the class (package). If the +NEED argument is given then it will check that the current version is +not less than NEED and die if this is not the case. This method is +normally called as a class method. This method is also called when the +C<VERSION> form of C<use> is used. + + use A 1.2 qw(some imported subs); + + A->VERSION( 1.2 ); + $ref->is_instance(); # True + +=item class() + +C<class> returns the class name of its object. + +=item is_instance() + +C<is_instance> returns true if its object is an instance of some +class, false if its object is the class (package) itself. Example + + A->is_instance(); # False + + $var = 'A'; + $var->is_instance(); # False + + $ref = bless [], 'A'; + $ref->is_instance(); # True + +=back + +B<NOTE:> C<can> directly uses Perl's internal code for method lookup, and +C<isa> uses a very similar method and cache-ing strategy. This may cause +strange effects if the Perl code dynamically changes @ISA in any package. + +You may add other methods to the UNIVERSAL class via Perl or XS code. +You do not need to C<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 + +=over + +=item TIEHANDLE classname, LIST + +This is the constructor for the class. That means it is expected to +return an object of some sort. The reference can be used to +hold some internal information. + + sub TIEHANDLE { print "<shout>\n"; my $i; bless \$i, shift } + +=item PRINT this, LIST + +This method will be triggered every time the tied handle is printed to. +Beyond its self reference it also expects the list that was passed to +the print function. + + sub PRINT { $r = shift; $$r++; print join($,,map(uc($_),@_)),$\ } + +=item READLINE this + +This method will be called when the handle is read from. The method +should return undef when there is no more data. + + sub READLINE { $r = shift; "PRINT called $$r times\n"; } + +=item DESTROY this + +As with the other types of ties, this method will be called when the +tied handle is about to be destroyed. This is useful for debugging and +possibly for cleaning up. + + sub DESTROY { print "</shout>\n" } + +=back + +=head1 Pragmata + +Three new pragmatic modules exist: + +=over + +=item use blib + +Looks for MakeMaker-like I<'blib'> directory structure starting in +I<dir> (or current directory) and working back up to five levels of +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 locale + +Tells the compiler to enable (or disable) the use of POSIX locales for +built-in 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 +ordering; and LC_NUMERIC for numeric formating in printf and sprintf +(but B<not> in print). LC_NUMERIC is always used in write, since +lexical scoping of formats is problematic at best. + +Each C<use locale> or C<no locale> affects statements to the end of +the enclosing BLOCK or, if not inside a BLOCK, to the end of the +current file. Locales can be switched and queried with +POSIX::setlocale(). + +See L<perllocale> for more information. + +=item use ops + +Restricts unsafe operations when compiling. + +=back + +=head1 Modules + +=head2 Module Information Summary + +Brand new modules: + + IO.pm Top-level interface to IO::* classes + IO/File.pm IO::File extension Perl module + IO/Handle.pm IO::Handle extension Perl module + IO/Pipe.pm IO::Pipe extension Perl module + IO/Seekable.pm IO::Seekable extension Perl module + IO/Select.pm IO::Select extension Perl module + IO/Socket.pm IO::Socket extension Perl module + + Opcode.pm Disable named opcodes when compiling Perl code + + ExtUtils/Embed.pm Utilities for embedding Perl in C programs + ExtUtils/testlib.pm Fixes up @INC to use just-built extension + + Fatal.pm Make do-or-die equivalents of functions + FindBin.pm Find path of currently executing program + + Class/Template.pm Structure/member template builder + File/stat.pm Object-oriented wrapper around CORE::stat + Net/hostent.pm Object-oriented wrapper around CORE::gethost* + Net/netent.pm Object-oriented wrapper around CORE::getnet* + Net/protoent.pm Object-oriented wrapper around CORE::getproto* + Net/servent.pm Object-oriented wrapper around CORE::getserv* + Time/gmtime.pm Object-oriented wrapper around CORE::gmtime + Time/localtime.pm Object-oriented wrapper around CORE::localtime + Time/tm.pm Perl implementation of "struct tm" for {gm,local}time + User/grent.pm Object-oriented wrapper around CORE::getgr* + User/pwent.pm Object-oriented wrapper around CORE::getpw* + + UNIVERSAL.pm Base class for *ALL* classes + +=head2 IO + +The IO module provides a simple mechanism to load all of the IO modules at one +go. Currently this includes: + + IO::Handle + IO::Seekable + IO::File + IO::Pipe + IO::Socket + +For more information on any of these modules, please see its +respective documentation. + +=head2 Math::Complex + +The Math::Complex module has been totally rewritten, and now supports +more operations. These are overloaded: + + + - * / ** <=> neg ~ abs sqrt exp log sin cos atan2 "" (stringify) + +And these functions are now exported: + + pi i Re Im arg + log10 logn cbrt root + tan cotan asin acos atan acotan + sinh cosh tanh cotanh asinh acosh atanh acotanh + cplx cplxe + +=head2 Overridden Built-ins + +Many of the Perl built-ins returning lists now have +object-oriented overrides. These are: + + File::stat + Net::hostent + Net::netent + Net::protoent + Net::servent + Time::gmtime + Time::localtime + User::grent + User::pwent + +For example, you can now say + + use File::stat; + use User::pwent; + $his = (stat($filename)->st_uid == pwent($whoever)->pw_uid); + +=head1 Efficiency Enhancements + +All hash keys with the same string are only allocated once, so +even if you have 100 copies of the same hash, the immutable keys +never have to be re-allocated. + +Functions that do nothing but return a fixed value are now inlined. + +=head1 Documentation Changes + +Many of the base and library pods were updated. These +new pods are included in section 1: + +=over 4 + +=item L<perli18n> + +Internationalization. + +=item L<perlapio> + +Perl internal IO abstraction interface. + +=item L<perltoot> + +Tutorial on Perl OO programming. + +=item L<perldebug> + +Although not new, this has been massively updated. + +=item L<perlsec> + +Although not new, this has been massively updated. + +=back + +=head1 New Diagnostics + +Several new conditions will trigger warnings that were +silent before. Some only affect certain platforms. +The following new warnings and errors +outline these: + +=over 4 + +=item "my" variable %s masks earlier declaration in same scope + +(S) A lexical variable has been redeclared in the same scope, effectively +eliminating all access to the previous instance. This is almost always +a typographical error. Note that the earlier variable will still exist +until the end of the scope or until all closure referents to it are +destroyed. + +=item Allocation too large: %lx + +(X) You can't allocate more than 64K on an MSDOS 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 + +(P) Perl maintains a reference counted internal table of strings to +optimize the storage and access of hash keys and other strings. This +indicates someone tried to decrement the reference count of a string +that can no longer be found in the table. + +=item Attempt to use reference as lvalue in substr + +(W) You supplied a reference as the first argument to substr() used +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 Integer overflow in hex number + +(S) The literal hex number you have specified is too big for your +architecture. On a 32-bit architecture the largest hex literal is +0xFFFFFFFF. + +=item Integer overflow in octal number + +(S) The literal octal number you have specified is too big for your +architecture. On a 32-bit architecture the largest octal literal is +037777777777. + +=item Null picture in formline + +(F) The first argument to formline must be a valid format picture +specification. It was found to be empty, which probably means you +supplied it an uninitialized value. See L<perlform>. + +=item Offset outside string + +(F) You tried to do a read/write/send/recv operation with an offset +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 Out of memory! + +(X|F) The malloc() function returned 0, indicating there was insufficient +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. +However, if compiled for this, Perl may use the contents of C<$^M> as +an emergency pool after die()ing with this message. In this case the +error is trappable I<once>. + +=item Out of memory during request for %s + +(F) The malloc() function returned 0, indicating there was insufficient +remaining memory (or virtual memory) to satisfy the request. However, +the request was judged large enough (compile-time default is 64K), so +a possibility to shut down by trapping this error is granted. + +=item Possible attempt to put comments in qw() list + +(W) You probably wrote something like this: + + qw( a # a comment + b # another comment + ) ; + +when you should have written this: + + qw( a + b + ) ; + +=item Possible attempt to separate words with commas + +(W) You probably wrote something like this: + + qw( a, b, c ); + +when you should have written this: + + qw( a b c ); + +=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 Got an error from DosAllocMem: + +(P) An error peculiar to OS/2. Most probably you use an obsolete version +of Perl, and should not happen anyway. + +=item Malformed PERLLIB_PREFIX + +(F) An error peculiar to OS/2. PERLLIB_PREFIX should be of the form + + prefix1;prefix2 + +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">. + +=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">. + +=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">. + +=back + +=head1 BUGS + +If you find what you think is a bug, you might check the headers +of recently posted articles +in the comp.lang.perl.misc newsgroup. There may also be +information at http://www.perl.com/perl/, the Perl Home Page. + +If you believe you have an unreported bug, please run the B<perlbug> +program included with your release. Make sure you trim your bug +down to a tiny but sufficient test case. Your bug report, along +with the output of C<perl -V>, will be sent off to perlbug@perl.com +to be analysed by the Perl porting team. + +=head1 SEE ALSO + +The F<Changes> file for exhaustive details on what changed. + +The F<INSTALL> file for how to build Perl. This file has been +significantly updated for 5.004, so even veteran users should +look through it. + +The F<README> file for general stuff. + +The F<Copying> file for copyright information. + +=head1 HISTORY + +Constructed by Tom Christiansen, grabbing material with permission +from innumerable contributors, with kibitzing by more than a few Perl +porters. + +Last update: +Wed Dec 18 16:18:27 EST 1996 diff --git a/pod/perlobj.pod b/pod/perlobj.pod index 691ce8b9ee..1d13d90c9a 100644 --- a/pod/perlobj.pod +++ b/pod/perlobj.pod @@ -4,10 +4,13 @@ perlobj - Perl objects =head1 DESCRIPTION -First of all, you need to understand what references are in Perl. See -L<perlref> for that. +First of all, you need to understand what references are in Perl. +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>. -Here are three very simple definitions that you should find reassuring. +If you're still with us, then +here are three very simple definitions that you should find reassuring. =over 4 @@ -44,7 +47,7 @@ constructor: 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, since the referenced object itself knows that +This is for convenience, because the referenced object itself knows that it has been blessed, and its reference to it could have been returned directly, like this: @@ -65,7 +68,7 @@ that wish to call methods in the class as part of the construction: } If you care about inheritance (and you should; see -L<perlmod/"Modules: Creation, Use and Abuse">), +L<perlmod/"Modules: Creation, Use, and Abuse">), then you want to use the two-arg form of bless so that your constructors may be inherited: @@ -94,17 +97,17 @@ object into: Within the class package, the methods will typically deal with the reference as an ordinary reference. Outside the class package, the reference is generally treated as an opaque value that may -only be accessed through the class's methods. +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 only -belong to one class at a time. (Although of course it's free to +later. The previous blessing is forgotten, as an object may belong +to only one class at a time. (Although of course it's free to inherit methods from many classes.) A clarification: Perl objects are blessed. References are not. Objects know which package they belong to. References do not. The bless() -function simply uses the reference in order to find the object. Consider +function uses the reference to find the object. Consider the following example: $a = {}; @@ -118,7 +121,7 @@ operated on the object and not on the reference. =head2 A Class is Simply a Package Unlike say C++, Perl doesn't provide any special syntax for class -definitions. You just use a package as a class by putting method +definitions. You use a package as a class by putting method definitions into the class. There is a special array within each package called @ISA which says @@ -143,7 +146,7 @@ supplied in the UNIVERSAL class; see L<"Default UNIVERSAL methods"> for more details.) If that doesn't work, Perl finally gives up and complains. -Perl classes only do method inheritance. Data inheritance is left +Perl classes do only method inheritance. Data inheritance is left up to the class itself. By and large, this is not a problem in Perl, because most classes model the attributes of their object using an anonymous hash, which serves as its own little namespace to be @@ -163,9 +166,9 @@ the two C++ method types they most closely resemble.) A class method expects a class name as the first argument. It provides functionality for the class as a whole, not for any individual object belonging to the class. Constructors are typically class -methods. Many class methods simply ignore their first argument, since +methods. Many class methods simply ignore their first argument, because they already know what package they're in, and don't care what package -they were invoked via. (These aren't necessarily the same, since +they were invoked via. (These aren't necessarily the same, because class methods follow the inheritance tree just like ordinary instance methods.) Another typical use for class methods is to look up an object by name: @@ -224,7 +227,7 @@ Indirect object method calls are parsed using the same rule as list operators: "If it looks like a function, it is a function". (Presuming for the moment that you think two words in a row can look like a function name. C++ programmers seem to think so with some regularity, -especially when the first word is "new".) Thus, the parens of +especially when the first word is "new".) Thus, the parentheses of new Critter ('Barney', 1.5, 70) @@ -246,8 +249,8 @@ call, being sure to pass the requisite first argument explicitly: $fred = MyCritter::find("Critter", "Fred"); MyCritter::display($fred, 'Height', 'Weight'); -Note however, that this does not do any inheritance. If you merely -wish to specify that Perl should I<START> looking for a method in a +Note however, that this does not do any inheritance. If you wish +merely to specify that Perl should I<START> looking for a method in a particular package, use an ordinary method call, but qualify the method name with the package like this: @@ -255,13 +258,13 @@ name with the package like this: $fred->MyCritter::display('Height', 'Weight'); If you're trying to control where the method search begins I<and> you're -executing in the class itself, then you may use the SUPER pseudoclass, +executing in the class itself, then you may use the SUPER pseudo class, which says to start looking in your base class's @ISA list without having -to explicitly name it: +to name it explicitly: $self->SUPER::display('Height', 'Weight'); -Please note that the C<SUPER::> construct is I<only> meaningful within the +Please note that the C<SUPER::> construct is meaningful I<only> within the class. Sometimes you want to call a method when you don't know the method name @@ -344,9 +347,9 @@ your class. It will automatically be called at the appropriate moment, and you can do any extra cleanup you need to do. Perl doesn't do nested destruction for you. If your constructor -reblessed a reference from one of your base classes, your DESTROY may -need to call DESTROY for any base classes that need it. But this only -applies to reblessed objects--an object reference that is merely +re-blessed a reference from one of your base classes, your DESTROY may +need to call DESTROY for any base classes that need it. But this applies +to only re-blessed objects--an object reference that is merely I<CONTAINED> in the current object will be freed and destroyed automatically when the current object is freed. @@ -367,7 +370,7 @@ are equivalent, but AB and CD are different: =head2 Summary -That's about all there is to it. Now you just need to go off and buy a +That's about all there is to it. Now you need just to go off and buy a book about object-oriented design methodology, and bang your forehead with it for the next six months or so. @@ -413,7 +416,7 @@ When an interpreter thread finally shuts down (usually when your program exits), then a rather costly but complete mark-and-sweep style of garbage collection is performed, and everything allocated by that thread gets destroyed. This is essential to support Perl as an embedded or a -multithreadable language. For example, this program demonstrates Perl's +multi-threadable language. For example, this program demonstrates Perl's two-phased garbage collection: #!/usr/bin/perl @@ -462,7 +465,7 @@ garbage collector reaching the unreachable. Objects are always destructed, even when regular refs aren't and in fact are destructed in a separate pass before ordinary refs just to try to prevent object destructors from using refs that have been themselves -destructed. Plain refs are only garbage collected if the destruct level +destructed. Plain refs are only garbage-collected if the destruct level is greater than 0. You can test the higher levels of global destruction by setting the PERL_DESTRUCT_LEVEL environment variable, presuming C<-DDEBUGGING> was enabled during perl build time. @@ -472,6 +475,8 @@ at a future date. =head1 SEE ALSO +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, 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 5645234bf4..a75cb4947d 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -43,7 +43,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, -quote and quotelike operators, any expression in parentheses, +quote and quote-like operators, any expression in parentheses, and any function whose arguments are parenthesized. Actually, there aren't really functions in this sense, just list operators and unary operators behaving as functions because you put parentheses around @@ -66,7 +66,7 @@ the commas on the right of the sort are evaluated before the sort, but the commas on the left are evaluated after. In other words, list operators tend to gobble up all the arguments that follow them, and then act like a simple TERM with regard to the preceding expression. -Note that you have to be careful with parens: +Note that you have to be careful with parentheses: # These evaluate exit before doing the print: print($foo, exit); # Obviously not what you want. @@ -88,7 +88,7 @@ Also parsed as terms are the C<do {}> and C<eval {}> constructs, as well as subroutine and method calls, and the anonymous constructors C<[]> and C<{}>. -See also L<Quote and Quotelike Operators> toward the end of this section, +See also L<Quote and Quote-Like Operators> toward the end of this section, as well as L<"I/O Operators">. =head2 The Arrow Operator @@ -104,16 +104,16 @@ containing the method name, and the left side must either be an object (a blessed reference) or a class name (that is, a package name). See L<perlobj>. -=head2 Autoincrement and Autodecrement +=head2 Auto-increment and Auto-decrement "++" and "--" work as in C. That is, if placed before a variable, they increment or decrement the variable before returning the value, and if placed after, increment or decrement the variable after returning the value. -The autoincrement operator has a little extra built-in magic to it. If +The auto-increment operator has a little extra built-in 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 only been used in string contexts since it was set, and +variable has been used in only string contexts since it was set, and has a value that is not null and matches the pattern C</^[a-zA-Z]*[0-9]*$/>, the increment is done as a string, preserving each character within its range, with carry: @@ -123,7 +123,7 @@ character within its range, with carry: print ++($foo = 'Az'); # prints 'Ba' print ++($foo = 'zz'); # prints 'aaa' -The autodecrement operator is not magical. +The auto-decrement operator is not magical. =head2 Exponentiation @@ -134,7 +134,7 @@ internally.) =head2 Symbolic Unary Operators -Unary "!" performs logical negation, i.e. "not". See also C<not> for a lower +Unary "!" performs logical negation, i.e., "not". See also C<not> for a lower precedence version of this. Unary "-" performs arithmetic negation if the operand is numeric. If @@ -144,7 +144,7 @@ starts with a plus or minus, a string starting with the opposite sign is returned. One effect of these rules is that C<-bareword> is equivalent to C<"-bareword">. -Unary "~" performs bitwise negation, i.e. 1's complement. +Unary "~" performs bitwise negation, i.e., 1's complement. (See also L<Integer Arithmetic>.) Unary "+" has no effect whatsoever, even on strings. It is useful @@ -167,7 +167,7 @@ supposed to be searched, substituted, or translated instead of the default $_. The return value indicates the success of the operation. (If the right argument is an expression rather than a search pattern, substitution, or translation, it is interpreted as a search pattern at run -time. This is less efficient than an explicit search, since the pattern +time. This is less efficient than an explicit search, because the pattern must be compiled every time the expression is evaluated--unless you've used C</o>.) @@ -185,7 +185,7 @@ Binary "%" computes the modulus of the two numbers. Binary "x" is the repetition operator. In a scalar context, it returns a string consisting of the left operand repeated the number of times specified by the right operand. In a list context, if the left -operand is a list in parens, it repeats the list. +operand is a list in parentheses, it repeats the list. print '-' x 80; # print row of dashes @@ -389,7 +389,7 @@ As a list operator: @foo = @foo[$#foo-4 .. $#foo]; # slice last 5 items The range operator (in a list context) makes use of the magical -autoincrement algorithm if the operands are strings. You +auto-increment algorithm if the operands are strings. You can say @alphabet = ('A' .. 'Z'); @@ -506,14 +506,14 @@ It's the equivalent of "!" except for the very low precedence. Binary "and" returns the logical conjunction of the two surrounding expressions. It's equivalent to && except for the very low -precedence. This means that it short-circuits: i.e. the right +precedence. This means that it short-circuits: i.e., the right expression is evaluated only if the left expression is true. =head2 Logical or and Exclusive Or Binary "or" returns the logical disjunction of the two surrounding expressions. It's equivalent to || except for the very low -precedence. This means that it short-circuits: i.e. the right +precedence. This means that it short-circuits: i.e., the right expression is evaluated only if the left expression is false. Binary "xor" returns the exclusive-OR of the two surrounding expressions. @@ -540,7 +540,7 @@ Type casting operator. =back -=head2 Quote and Quotelike Operators +=head2 Quote and Quote-like Operators While we usually think of quotes as literal values, in Perl they function as operators, providing various kinds of interpolating and @@ -587,13 +587,13 @@ pattern from the variables. If this is not what you want, use C<\Q> to interpolate a variable literally. Apart from the above, there are no multiple levels of interpolation. In -particular, contrary to the expectations of shell programmers, backquotes +particular, contrary to the expectations of shell programmers, back-quotes do I<NOT> interpolate within double quotes, nor do single quotes impede evaluation of variables when used within double quotes. -=head2 Regexp Quotelike Operators +=head2 Regexp Quote-Like Operators -Here are the quotelike operators that apply to pattern +Here are the quote-like operators that apply to pattern matching and related activities. =over 8 @@ -602,7 +602,7 @@ matching and related activities. This is just like the C</pattern/> search, except that it matches only once between calls to the reset() operator. This is a useful -optimization when you only want to see the first occurrence of +optimization when you want to see only the first occurrence of something in each file of a set of files, for instance. Only C<??> patterns local to the current package are reset. @@ -622,10 +622,10 @@ L<perlre>. Options are: - g Match globally, i.e. find all occurrences. + g Match globally, i.e., find all occurrences. i Do case-insensitive pattern matching. m Treat string as multiple lines. - o Only compile pattern once. + o Compile pattern only once. s Treat string as single line. x Use extended regular expressions. @@ -649,7 +649,7 @@ successfully executed regular expression is used instead. If used in a context that requires a list value, a pattern match returns a list consisting of the subexpressions matched by the parentheses in the -pattern, i.e. (C<$1>, $2, $3...). (Note that here $1 etc. are also set, and +pattern, i.e., (C<$1>, $2, $3...). (Note that here $1 etc. are also set, and that this differs from Perl 4's behavior.) If the match fails, a null array is returned. If the match succeeds, but there were no parentheses, a list value of (1) is returned. @@ -672,8 +672,8 @@ Examples: if (($F1, $F2, $Etc) = ($foo =~ /^(\S+)\s+(\S+)\s*(.*)/)) This last example splits $foo into the first two words and the -remainder of the line, and assigns those three fields to $F1, $F2 and -$Etc. The conditional is true if any variables were assigned, i.e. if +remainder of the line, and assigns those three fields to $F1, $F2, and +$Etc. The conditional is true if any variables were assigned, i.e., if the pattern matched. The C</g> modifier specifies global pattern matching--that is, matching @@ -695,7 +695,7 @@ beginning. Examples: ($one,$five,$fifteen) = (`uptime` =~ /(\d+\.\d+)/g); # scalar context - $/ = ""; $* = 1; # $* deprecated in Perl 5 + $/ = ""; $* = 1; # $* deprecated in modern perls while ($paragraph = <>) { while ($paragraph =~ /[a-z]['")]*[.!?]+['")]*\s/g) { $sentences++; @@ -759,13 +759,13 @@ made. Otherwise it returns false (specifically, the empty string). If no string is specified via the C<=~> or C<!~> operator, the C<$_> variable is searched and modified. (The string specified with C<=~> must be a scalar variable, an array element, a hash element, or an assignment -to one of those, i.e. an lvalue.) +to one of those, i.e., an lvalue.) If the delimiter chosen is single quote, no variable interpolation is done on either the PATTERN or the REPLACEMENT. Otherwise, if the PATTERN contains a $ that looks like a variable rather than an end-of-string test, the variable will be interpolated into the pattern -at run-time. If you only want the pattern compiled once the first time +at run-time. If you want the pattern compiled only once the first time the variable is interpolated, use the C</o> option. If the pattern evaluates to a null string, the last successfully executed regular expression is used instead. See L<perlre> for further explanation on these. @@ -773,20 +773,20 @@ expression is used instead. See L<perlre> for further explanation on these. Options are: e Evaluate the right side as an expression. - g Replace globally, i.e. all occurrences. + g Replace globally, i.e., all occurrences. i Do case-insensitive pattern matching. m Treat string as multiple lines. - o Only compile pattern once. + o Compile pattern only once. s Treat string as single line. x Use extended regular expressions. Any non-alphanumeric, non-whitespace delimiter may replace the slashes. If single quotes are used, no interpretation is done on the replacement string (the C</e> modifier overrides this, however). Unlike -Perl 4, Perl 5 treats backticks as normal delimiters; the replacement +Perl 4, Perl 5 treats back-ticks 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. +pair of quotes, which may or may not be bracketing quotes, e.g., C<s(foo)(bar)> or C<sE<lt>fooE<gt>/bar/>. A C</e> will cause the replacement portion to be interpreter as a full-fledged Perl expression and eval()ed right then and there. It is, however, syntax checked at @@ -829,10 +829,10 @@ Examples: s/([^ ]*) *([^ ]*)/$2 $1/; # reverse 1st two fields Note the use of $ instead of \ in the last example. Unlike -B<sed>, we only use the \E<lt>I<digit>E<gt> form in the left hand side. +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>. -Occasionally, you can't just use a C</g> to get all the changes +Occasionally, you can't use just a C</g> to get all the changes to occur. Here are two common cases: # put commas in the right places in an integer @@ -852,10 +852,10 @@ 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, +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]> +quotes, which may or may not be bracketing quotes, e.g., C<tr[A-Z][a-z]> or C<tr(+-*/)/ABCD/>. Options: @@ -920,7 +920,7 @@ an eval(): =head2 I/O Operators There are several I/O operators you should know about. -A string is enclosed by backticks (grave accents) first undergoes +A string is enclosed by back-ticks (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 @@ -933,7 +933,7 @@ 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 backticks is C<qx//>. (Because backticks +The generalized form of back-ticks is C<qx//>. (Because back-ticks always undergo shell expansion as well, see L<perlsec> for security concerns.) @@ -954,8 +954,8 @@ write.) Anyway, the following lines are equivalent to each other: print while defined($_ = <STDIN>); print while <STDIN>; -The filehandles STDIN, STDOUT and STDERR are predefined. (The -filehandles C<stdin>, C<stdout> and C<stderr> will also work except in +The filehandles STDIN, STDOUT, and STDERR are predefined. (The +filehandles C<stdin>, C<stdout>, and C<stderr> will also work except in packages, where they would be interpreted as local identifiers rather than global.) Additional filehandles may be created with the open() function. See L<perlfunc/open()> for details on this. @@ -989,9 +989,9 @@ is equivalent to the following Perl-like pseudo code: except that it isn't so cumbersome to say, and will actually work. It really does shift array @ARGV and put the current filename into variable -$ARGV. It also uses filehandle I<ARGV> internally--E<lt>E<gt> is just a synonym -for E<lt>ARGVE<gt>, which is magical. (The pseudo code above doesn't work -because it treats E<lt>ARGVE<gt> as non-magical.) +$ARGV. It also uses filehandle I<ARGV> internally--E<lt>E<gt> is just a +synonym for E<lt>ARGVE<gt>, which is magical. (The pseudo code above +doesn't work because it treats E<lt>ARGVE<gt> as non-magical.) You can modify @ARGV before the first E<lt>E<gt> as long as the array ends up containing the list of filenames you really want. Line numbers (C<$.>) @@ -1018,7 +1018,7 @@ this it will assume you are processing another @ARGV list, and if you haven't set @ARGV, will input from STDIN. If the string inside the angle brackets is a reference to a scalar -variable (e.g. E<lt>$fooE<gt>), then that variable contains the name of the +variable (e.g., E<lt>$fooE<gt>), then that variable contains the name of the filehandle to input from, or a reference to the same. For example: $fh = \*STDIN; @@ -1055,11 +1055,11 @@ machine.) Of course, the shortest way to do the above is: chmod 0644, <*.c>; Because globbing invokes a shell, it's often faster to call readdir() yourself -and just do your own grep() on the filenames. Furthermore, due to its current +and do your own grep() on the filenames. Furthermore, due to its current implementation of using a shell, the glob() routine may get "Arg list too long" errors (unless you've installed tcsh(1L) as F</bin/csh>). -A glob only evaluates its (embedded) argument when it is starting a new +A glob evaluates its (embedded) argument only when it is starting a new list. All values must be read before it will start over. In a list context this isn't important, because you automatically get them all anyway. In a scalar context, however, the operator returns the next value @@ -1126,5 +1126,5 @@ The bitwise operators ("&", "|", "^", "~", "<<", and ">>") always produce integral results. However, C<use integer> still has meaning for them. By default, their results are interpreted as unsigned integers. However, if C<use integer> is in effect, their results are -interpeted as signed integers. For example, C<~0> usually evaluates +interpreted as signed integers. For example, C<~0> usually evaluates to a large integral value. However, C<use integer; ~0> is -1. diff --git a/pod/perlpod.pod b/pod/perlpod.pod index 3722e2c36c..dcf615daa3 100644 --- a/pod/perlpod.pod +++ b/pod/perlpod.pod @@ -94,10 +94,10 @@ here and in commands: S<text> text contains non-breaking spaces C<code> literal code L<name> A link (cross reference) to name - L<name> manpage - L<name/ident> item in manpage - L<name/"sec"> section in other manpage - L<"sec"> section in this manpage + L<name> manual page + L<name/ident> item in manual page + L<name/"sec"> section in other manual page + L<"sec"> section in this manual page (the quotes are optional) L</"sec"> ditto F<file> Used for filenames @@ -117,7 +117,7 @@ to look like paragraphs (block format), so that they stand out visually, and so that I could run them through fmt easily to reformat them (that's F7 in my version of B<vi>). I wanted the translator (and not me) to worry about whether " or ' is a left quote or a right quote -within filled text, and I wanted it to leave the quotes alone dammit in +within filled text, and I wanted it to leave the quotes alone, dammit, in verbatim mode, so I could slurp in a working program, shift it over 4 spaces, and have it print out, er, verbatim. And presumably in a constant width font. diff --git a/pod/perlre.pod b/pod/perlre.pod index c4dbac63c6..ce054ec448 100644 --- a/pod/perlre.pod +++ b/pod/perlre.pod @@ -5,7 +5,7 @@ perlre - Perl regular expressions =head1 DESCRIPTION This page describes the syntax of regular expressions in Perl. For a -description of how to actually I<use> regular expressions in matching +description of how to I<use> regular expressions in matching operations, plus various examples of the same, see C<m//> and C<s///> in L<perlop>. @@ -22,7 +22,7 @@ Do case-insensitive pattern matching. =item m Treat string as multiple lines. That is, change "^" and "$" from matching -only at the very start or end of the string to the start or end of any +at only the very start or end of the string to the start or end of any line anywhere within the string, =item s @@ -45,7 +45,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 metacharacter introducing a comment, +character is also treated as a meta-character 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, @@ -63,7 +63,7 @@ See L<Version 8 Regular Expressions> for details. In particular the following metacharacters have their standard I<egrep>-ish meanings: - \ Quote the next metacharacter + \ Quote the next meta-character ^ Match the beginning of the line . Match any character (except newline) $ Match the end of the line (or before newline at the end) @@ -71,8 +71,8 @@ meanings: () Grouping [] Character class -By default, the "^" character is guaranteed to match only at the -beginning of the string, the "$" character only at the end (or before the +By default, the "^" character is guaranteed to match at only the +beginning of the string, the "$" character at only the end (or before the newline at the end) and Perl does certain optimizations with the assumption that the string contains only one line. Embedded newlines will not be matched by "^" or "$". You may, however, wish to treat a @@ -80,7 +80,7 @@ string as a multi-line buffer, such that the "^" will match after any newline within the string, and "$" will match before any newline. At the cost of a little more overhead, you can do this by using the /m modifier on the pattern match operator. (Older programs did this by setting C<$*>, -but this practice is deprecated in Perl 5.) +but this practice is now deprecated.) To facilitate multi-line substitutions, the "." character never matches a newline unless you use the C</s> modifier, which in effect tells Perl to pretend @@ -102,7 +102,7 @@ as a regular character.) The "*" modifier is equivalent to C<{0,}>, the "+" modifier to C<{1,}>, and the "?" modifier to C<{0,1}>. n and m are limited to integral values less than 65536. -By default, a quantified subpattern is "greedy", that is, it will match as +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 @@ -117,7 +117,7 @@ Note that the meanings don't change, just the "gravity": {n,}? Match at least n times {n,m}? Match at least n but not more than m times -Since patterns are processed as double quoted strings, the following +Because patterns are processed as double quoted strings, the following also work: \t tab (HT, TAB) @@ -147,15 +147,15 @@ In addition, Perl defines the following: Note that C<\w> matches a single alphanumeric character, not a whole word. To match a word you'd need to say C<\w+>. You may use C<\w>, -C<\W>, C<\s>, C<\S>, C<\d> and C<\D> within character classes (though not +C<\W>, C<\s>, C<\S>, C<\d>, and C<\D> within character classes (though not as either end of a range). Perl defines the following zero-width assertions: \b Match a word boundary \B Match a non-(word boundary) - \A Match only at beginning of string - \Z Match only at end of string (or before newline at the end) + \A Match at only beginning of string + \Z Match at only end of string (or before newline at the end) \G Match only where previous m//g left off A word boundary (C<\b>) is defined as a spot between two characters that @@ -175,13 +175,13 @@ outside the current pattern, this should not be relied upon. See the WARNING below.) The scope of $E<lt>digitE<gt> (and C<$`>, C<$&>, and C<$'>) extends to the end of the enclosing BLOCK or eval string, or to the next successful pattern match, whichever comes first. If you want to use -parentheses to delimit a subpattern (e.g. a set of alternatives) without +parentheses to delimit a subpattern (e.g., a set of alternatives) without saving it as a subpattern, follow the ( with a ?:. You may have as many parentheses as you wish. If you have more than 9 substrings, the variables $10, $11, ... refer to the corresponding substring. Within the pattern, \10, \11, etc. refer back -to substrings if there have been at least that many left parens before +to substrings if there have been at least that many left parentheses before the backreference. Otherwise (for backward compatibility) \10 is the same as \010, a backspace, and \11 the same as \011, a tab. And so on. (\1 through \9 are always backreferences.) @@ -203,9 +203,9 @@ 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 metacharacter. This makes it +interpreted as a literal character, not a meta-character. This makes it simple to quote a string that you want to use for a pattern but that -you are afraid might contain metacharacters. Simply quote all the +you are afraid might contain metacharacters. Quote simply all the non-alphanumeric characters: $pattern =~ s/(\W)/\\$1/g; @@ -216,11 +216,11 @@ is to say /$unquoted\Q$quoted\E$unquoted/ -Perl 5 defines a consistent extension syntax for regular expressions. -The syntax is a pair of parens with a question mark as the first thing -within the parens (this was a syntax error in Perl 4). The character -after the question mark gives the function of the extension. Several -extensions are already supported: +Perl defines a consistent extension syntax for regular expressions. +The syntax is a pair of parentheses with a question mark as the first +thing within the parentheses (this was a syntax error in older +versions of Perl). The character after the question mark gives the +function of the extension. Several extensions are already supported: =over 10 @@ -268,7 +268,7 @@ easier just to say: One or more embedded pattern-match modifiers. This is particularly useful for patterns that are specified in a table somewhere, some of which want to be case sensitive, and some of which don't. The case -insensitive ones merely need to include C<(?i)> at the front of the +insensitive ones need to include merely C<(?i)> at the front of the pattern. For example: $pattern = "foobar"; @@ -390,11 +390,10 @@ As you see, this can be a bit tricky. It's important to realize that a regular expression is merely a set of assertions that gives a definition of success. There may be 0, 1, or several different ways that the definition might succeed against a particular string. And if there are -multiple ways it might succeed, you need to understand backtracking in -order to know which variety of success you will achieve. +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 nondigits 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"; @@ -421,12 +420,12 @@ This prints 3: got AB 4: got ABC -You might have expected test 3 to fail because it just seems to a more +You might have expected test 3 to fail because it seems to a more general purpose version of test 1. The important difference between them is that test 3 contains a quantifier (C<\D*>) and so can use backtracking, whereas test 1 will not. What's happening is that you've asked "Is it true that at the start of $x, following 0 or more -nondigits, you have something that's not 123?" If the pattern matcher had +non-digits, you have something that's not 123?" If the pattern matcher had let C<\D*> expand to "ABC", this would have caused the whole pattern to fail. The search engine will initially match C<\D*> with "ABC". Then it will @@ -437,7 +436,7 @@ in the hope of matching the complete regular expression. Well now, the pattern really, I<really> wants to succeed, so it uses the -standard regexp backoff-and-retry and lets C<\D*> expand to just "AB" this +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 "123". It's in fact "C123", which suffices. @@ -477,10 +476,10 @@ 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<metacharacter> +Any single character matches itself, unless it is a I<meta-character> 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 +literally by prefixing them with a "\" (e.g., "\." matches a ".", not any character; "\\" matches a "\"). A series of characters matches that series of characters in the target string, so the pattern C<blurfl> would match "blurfl" in the target string. @@ -492,13 +491,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 metacharacter syntax much like that +Characters may be specified using a meta-character 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 "." metacharacter matches any +ASCII character control-I<x>. Finally, the "." meta-character matches any character except "\n" (unless you use C</s>). You can specify a series of alternatives for a pattern using "|" to @@ -513,14 +512,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 subpatterns for later reference by +Within a pattern, you may designate sub-patterns for later reference by enclosing them in parentheses, and you may refer back to the I<n>th -subpattern later in the pattern using the metacharacter \I<n>. -Subpatterns are numbered based on the left to right order of their +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 opening parenthesis. Note that a backreference matches whatever -actually matched the subpattern in the string being examined, not the -rules for that subpattern. Therefore, C<(0|0x)\d*\s\1\d*> will -match "0x1234 0x4321",but not "0x1234 01234", since subpattern 1 +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 "0x", even though the rule C<0|0x> could potentially match the leading 0 in the second number. @@ -532,7 +531,7 @@ Some people get too used to writing things like This is grandfathered for the RHS of a substitute to avoid shocking the B<sed> addicts, but it's a dirty habit to get into. That's because in -PerlThink, the right-hand side of a C<s///> is a double-quoted string. C<\1> in +PerlThink, the righthand side of a C<s///> is a double-quoted string. C<\1> in the usual double-quoted string means a control-A. The customary Unix meaning of C<\1> is kludged in for C<s///>. However, if you get into the habit of doing that, you get yourself into trouble if you then add an C</e> diff --git a/pod/perlref.pod b/pod/perlref.pod index 5303c3a12a..bbbe57feba 100644 --- a/pod/perlref.pod +++ b/pod/perlref.pod @@ -7,9 +7,9 @@ perlref - Perl references and nested data structures Before release 5 of Perl it was difficult to represent complex data structures, because all references had to be symbolic, and even that was difficult to do when you wanted to refer to a variable rather than a -symbol table entry. Perl 5 not only makes it easier to use symbolic +symbol table entry. Perl not only makes it easier to use symbolic references to variables, but lets you have "hard" references to any piece -of data. Any scalar may hold a hard reference. Since arrays and hashes +of data. Any scalar may hold a hard reference. Because arrays and hashes contain scalars, you can now easily build arrays of arrays, arrays of hashes, hashes of arrays, arrays of hashes of functions, and so on. @@ -25,7 +25,7 @@ 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 merely contains the name of a file. +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. @@ -44,7 +44,7 @@ References can be constructed several ways. By using the backslash operator on a variable, subroutine, or value. (This works much like the & (address-of) operator works in C.) Note -that this typically creates I<ANOTHER> reference to a variable, since +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 reference that the backslash returned. Here are some examples: @@ -55,9 +55,11 @@ reference that the backslash returned. Here are some examples: $coderef = \&handler; $globref = \*foo; -It isn't possible to create a reference to an IO handle (filehandle or +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. +*foo{THING} syntax below. (However, you're apt to find Perl code +out there using globrefs as though they were IO handles, which is +grandfathered into continued functioning.) =item 2. @@ -167,7 +169,7 @@ newprint() I<despite> the fact that the "my $x" has seemingly gone out of scope by the time the anonymous subroutine runs. That's what closure is all about. -This only applies to lexical variables, by the way. Dynamic variables +This applies to only lexical variables, by the way. Dynamic variables continue to work as they have always worked. Closure is not something that most Perl programmers need trouble themselves about to begin with. @@ -186,7 +188,7 @@ named new(), but don't have to be: =item 6. References of the appropriate type can spring into existence if you -dereference them in a context that assumes they exist. Since we haven't +dereference them in a context that assumes they exist. Because we haven't talked about dereferencing yet, we can't show you any examples yet. =item 7. @@ -209,8 +211,13 @@ IO handle, used for file handles (L<perlfunc/open>), sockets (L<perlfunc/opendir>). For compatibility with previous versions of Perl, *foo{FILEHANDLE} is a synonym for *foo{IO}. -The use of *foo{IO} is the best way to pass bareword filehandles into -or out of subroutines, or to store them in larger data structures. +*foo{THING} returns undef if that particular THING hasn't been used yet, +except in the case of scalars. *foo{SCALAR} returns a reference to an +anonymous scalar if $foo hasn't been used yet. This might change in a +future release. + +The use of *foo{IO} is the best way to pass bareword filehandles into or +out of subroutines, or to store them in larger data structures. splutter(*STDOUT{IO}); sub splutter { @@ -224,9 +231,18 @@ or out of subroutines, or to store them in larger data structures. return scalar <$fh>; } -The best way to do this used to be to use the entire *foo typeglob (or a -reference to it), so you'll probably come across old code which does it -that way. +Beware, though, that you can't do this with a routine which is going to +open the filehandle for you, because *HANDLE{IO} will be undef if HANDLE +hasn't been used yet. Use \*HANDLE for that sort of thing instead. + +Using \*HANDLE (or *HANDLE) is another way to use and store non-bareword +filehandles (before 5.002 it was the only way). The two methods are +largely interchangeable, you can do + + splutter(\*STDOUT); + $rec = get_rec(\*STDIN); + +with the above subroutine definitions. =back @@ -282,7 +298,7 @@ subscripted expressions: Because of being able to omit the curlies for the simple case of C<$$x>, people often make the mistake of viewing the dereferencing symbols as proper operators, and wonder about their precedence. If they were, -though, you could use parens instead of braces. That's not the case. +though, you could use parentheses instead of braces. That's not the case. Consider the difference below; case 0 is a short-hand version of case 1, I<NOT> case 2: @@ -348,7 +364,7 @@ reference is pointing to. See L<perlfunc>. The bless() operator may be used to associate a reference with a package functioning as an object class. See L<perlobj>. -A typeglob may be dereferenced the same way a reference can, since +A typeglob may be dereferenced the same way a reference can, because the dereference syntax always indicates the kind of reference desired. So C<${*foo}> and C<${\$foo}> both indicate the same scalar variable. @@ -447,7 +463,7 @@ subscripting a hash. So now, instead of writing $array{ "aaa" }{ "bbb" }{ "ccc" } -you can just write +you can write just $array{ aaa }{ bbb }{ ccc } @@ -464,7 +480,7 @@ makes it more than a bareword: $array{ shift @_ } The B<-w> switch will warn you if it interprets a reserved word as a string. -But it will no longer warn you about using lowercase words, since the +But it will no longer warn you about using lowercase words, because the string is effectively quoted. =head1 WARNING diff --git a/pod/perlrun.pod b/pod/perlrun.pod index c69a03eb53..083b567e19 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -33,7 +33,7 @@ Contained in the file specified by the first filename on the command line. =item 3. -Passed in implicitly via standard input. This only works if there are +Passed in implicitly via standard input. This works only if there are no filename arguments--to pass arguments to a STDIN script you must explicitly specify a "-" for the script name. @@ -46,11 +46,11 @@ scans for the first line starting with #! and containing the word embedded in a larger message. (In this case you would indicate the end of the script using the __END__ token.) -As of Perl 5, the #! line is always examined for switches as the line is -being parsed. Thus, if you're on a machine that only allows one argument -with the #! line, or worse, doesn't even recognize the #! line, you still -can get consistent switch behavior regardless of how Perl was invoked, -even if B<-x> was used to find the beginning of the script. +The #! line is always examined for switches as the line is being +parsed. Thus, if you're on a machine that allows only one argument +with the #! line, or worse, doesn't even recognize the #! line, you +still can get consistent switch behavior regardless of how Perl was +invoked, even if B<-x> was used to find the beginning of the script. Because many operating systems silently chop off kernel interpretation of the #! line after 32 characters, some switches may be passed in on the @@ -67,8 +67,8 @@ The sequences "-*" and "- " are specifically ignored so that you could, if you were so inclined, say #!/bin/sh -- # -*- perl -*- -p - eval 'exec perl $0 -S ${1+"$@"}' - if 0; + eval 'exec /usr/bin/perl $0 -S ${1+"$@"}' + if $running_under_some_shell; to let Perl see the B<-p> switch. @@ -109,7 +109,7 @@ can say this: find . -name '*.bak' -print0 | perl -n0e unlink The special value 00 will cause Perl to slurp files in paragraph mode. -The value 0777 will cause Perl to slurp files whole since there is no +The value 0777 will cause Perl to slurp files whole because there is no legal character with that value. =item B<-a> @@ -133,7 +133,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, -since these are considered as occurring outside the execution of +because these are considered as occurring outside the execution of your program. =item B<-d> @@ -151,10 +151,10 @@ Devel::DProf profiler. See L<perldebug>. =item B<-D>I<list> sets debugging flags. To watch how it executes your script, use -B<-D14>. (This only works if debugging is compiled into your +B<-D14>. (This works only if debugging is compiled into your Perl.) Another nice value is B<-D1024>, which lists your compiled syntax tree. And B<-D512> displays compiled regular expressions. As an -alternative specify a list of letters instead of numbers (e.g. B<-D14> is +alternative specify a list of letters instead of numbers (e.g., B<-D14> is equivalent to B<-Dtls>): 1 p Tokenizing and Parsing @@ -186,7 +186,7 @@ Make sure to use semicolons where you would in a normal program. =item B<-F>I<pattern> specifies the pattern to split on if B<-a> is also in effect. The -pattern may be surrounded by C<//>, C<""> or C<''>, otherwise it will be +pattern may be surrounded by C<//>, C<"">, or C<''>, otherwise it will be put in single quotes. =item B<-h> @@ -330,9 +330,9 @@ the implicit loop, just as in awk. =item B<-P> causes your script to be run through the C preprocessor before -compilation by Perl. (Since both comments and cpp directives begin +compilation by Perl. (Because both comments and cpp directives begin with the # character, you should avoid starting comments with any words -recognized by the C preprocessor such as "if", "else" or "define".) +recognized by the C preprocessor such as "if", "else", or "define".) =item B<-s> @@ -353,7 +353,7 @@ this is used to emulate #! startup on machines that don't support #!, in the following manner: #!/usr/bin/perl - eval "exec /usr/bin/perl -S $0 $*" + eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' if $running_under_some_shell; The system ignores the first line and feeds the script to /bin/sh, @@ -365,15 +365,15 @@ script if necessary. After Perl locates the script, it parses the lines and ignores them because the variable $running_under_some_shell is never true. A better construct than C<$*> would be C<${1+"$@"}>, which handles embedded spaces and such in the filenames, but doesn't work if -the script is being interpreted by csh. In order to start up sh rather +the script is being interpreted by csh. To start up sh rather than csh, some systems may have to replace the #! line with a line containing just a colon, which will be politely ignored by Perl. Other systems can't control that, and need a totally devious construct that -will work under any of csh, sh or Perl, such as the following: +will work under any of csh, sh, or Perl, such as the following: eval '(exit $?0)' && eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' & eval 'exec /usr/bin/perl -S $0 $argv:q' - if 0; + if $running_under_some_shell; =item B<-T> @@ -419,7 +419,7 @@ Prints to STDOUT the value of the named configuration variable. prints warnings about variable names that are mentioned only once, and scalar variables that are used before being set. Also warns about redefined subroutines, and references to undefined filehandles or -filehandles opened readonly that you are attempting to write on. Also +filehandles opened read-only that you are attempting to write on. Also warns you if you use values as a number that doesn't look like numbers, using an array as though it were a scalar, if your subroutines recurse more than 100 deep, and innumerable other things. @@ -432,8 +432,8 @@ garbage will be discarded until the first line that starts with #! and contains the string "perl". Any meaningful switches on that line will be applied (but only one group of switches, as with normal #! processing). If a directory name is specified, Perl will switch to -that directory before running the script. The B<-x> switch only -controls the the disposal of leading garbage. The script must be +that directory before running the script. The B<-x> switch controls +only the disposal of leading garbage. The script must be terminated with C<__END__> if there is trailing garbage to be ignored (the script can process any or all of the trailing garbage via the DATA filehandle if desired). diff --git a/pod/perlsec.pod b/pod/perlsec.pod index facddedfbf..2b6972701f 100644 --- a/pod/perlsec.pod +++ b/pod/perlsec.pod @@ -1,4 +1,3 @@ - =head1 NAME perlsec - Perl security @@ -17,7 +16,7 @@ Perl automatically enables a set of special security checks, called I<taint mode>, when it detects its program running with differing real and effective user or group IDs. The setuid bit in Unix permissions is mode 04000, the setgid bit mode 02000; either or both may be set. You can also enable taint -mode explicitly by using the the B<-T> command line flag. This flag is +mode explicitly by using the B<-T> command line flag. This flag is I<strongly> suggested for server programs and any program run on behalf of someone else, such as a CGI script. @@ -33,7 +32,7 @@ You may not use data derived from outside your program to affect something else outside your program--at least, not by accident. All command-line arguments, environment variables, and file input are marked as "tainted". Tainted data may not be used directly or indirectly in any command that -invokes a subshell, nor in any command that modifies files, directories, +invokes a sub-shell, nor in any command that modifies files, directories, or processes. Any variable set within an expression that has previously referenced a tainted value itself becomes tainted, even if it is logically impossible for the tainted value to influence the variable. Because @@ -102,9 +101,9 @@ taintedness. Instead, the slightly more efficient and conservative approach is used that if any tainted value has been accessed within the same expression, the whole expression is considered tainted. -But testing for taintedness only gets you so far. Sometimes you just have +But testing for taintedness gets you only so far. Sometimes you have just to clear your data's taintedness. The only way to bypass the tainting -mechanism is by referencing subpatterns from a regular expression match. +mechanism is by referencing sub-patterns 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 @@ -123,7 +122,7 @@ or a dot. die "Bad data in $data"; # log this somewhere } -This is fairly secure since C</\w+/> doesn't normally match shell +This is fairly secure because C</\w+/> doesn't normally match shell metacharacters, nor are dot, dash, or at going to mean something special to the shell. Use of C</.+/> would have been insecure in theory because it lets everything through, but Perl doesn't check for that. The lesson @@ -156,7 +155,7 @@ 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 -backtick functions provide no such alternate calling convention, so more +back-tick 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 @@ -168,11 +167,11 @@ environment variables, umasks, current working directories, back to the originals or known safe values. Then the child process, which no longer has any special permissions, does the B<open> or other system call. Finally, the child passes the data it managed to access back to the -parent. Since the file or pipe was opened in the child while running +parent. Because the file or pipe was opened in the child while running under less privilege than the parent, it's not apt to be tricked into doing something it shouldn't. -Here's a way to do backticks reasonably safely. Notice how the B<exec> is +Here's a way to do back-ticks 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 diff --git a/pod/perlstyle.pod b/pod/perlstyle.pod index 46c17ddae3..734b9ad032 100644 --- a/pod/perlstyle.pod +++ b/pod/perlstyle.pod @@ -32,7 +32,7 @@ Opening curly on same line as keyword, if possible, otherwise line up. =item * -Space before the opening curly of a multiline BLOCK. +Space before the opening curly of a multi-line BLOCK. =item * @@ -64,7 +64,7 @@ Uncuddled elses. =item * -No space between function name and its opening paren. +No space between function name and its opening parenthesis. =item * @@ -76,7 +76,7 @@ Long lines broken after an operator (except "and" and "or"). =item * -Space after last paren matching on current line. +Space after last parenthesis matching on current line. =item * @@ -117,7 +117,7 @@ is better than $verbose && print "Starting analysis\n"; -since the main point isn't whether the user typed B<-v> or not. +because the main point isn't whether the user typed B<-v> or not. Similarly, just because an operator lets you assume default arguments doesn't mean that you have to make use of the defaults. The defaults @@ -135,7 +135,7 @@ schmuck bounce on the % key in B<vi>. Even if you aren't in doubt, consider the mental welfare of the person who has to maintain the code after you, and who will probably put -parens in the wrong place. +parentheses in the wrong place. =item * @@ -189,7 +189,7 @@ Package names are sometimes an exception to this rule. Perl informally 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 -filesystems' representations of module names as files that must fit into a +file systems' representations of module names as files that must fit into a few sparse bites. =item * @@ -216,9 +216,9 @@ Don't use slash as a delimiter when your regexp has slashes or backslashes. =item * Use the new "and" and "or" operators to avoid having to parenthesize -list operators so much, and to reduce the incidence of punctuational +list operators so much, and to reduce the incidence of punctuation operators like C<&&> and C<||>. Call your subroutines as if they were -functions or list operators to avoid excessive ampersands and parens. +functions or list operators to avoid excessive ampersands and parentheses. =item * diff --git a/pod/perlsub.pod b/pod/perlsub.pod index 1c3a3c0709..6bd3fe8d84 100644 --- a/pod/perlsub.pod +++ b/pod/perlsub.pod @@ -22,8 +22,8 @@ To import subroutines: To call subroutines: - NAME(LIST); # & is optional with parens. - NAME LIST; # Parens optional if predeclared/imported. + NAME(LIST); # & is optional with parentheses. + NAME LIST; # Parentheses optional if pre-declared/imported. &NAME; # Passes current @_ to subroutine. =head1 DESCRIPTION @@ -105,7 +105,7 @@ Use array assignment to a local list to name your formal arguments: } This also has the effect of turning call-by-reference into call-by-value, -since the assignment copies the values. Otherwise a function is free to +because the assignment copies the values. Otherwise a function is free to do in-place modifications of @_ and change its caller's values. upcase_in($v1, $v2); # this changes $v1 and $v2 @@ -149,13 +149,14 @@ Because like its flat incoming parameter list, the return list is also flat. So all you have managed to do here is stored everything in @a and made @b an empty list. See L</"Pass by Reference"> for alternatives. -A subroutine may be called using the "&" prefix. The "&" is optional in -Perl 5, and so are the parens if the subroutine has been 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 using the C<&$subref()> or -C<&{$subref}()> constructs. See L<perlref> for more on that.) +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 +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 +using the C<&$subref()> or C<&{$subref}()> constructs. See L<perlref> +for more on that.) Subroutines may be called recursively. If a subroutine is called using the "&" form, the argument list is optional, and if omitted, no @_ array is @@ -190,7 +191,7 @@ A "my" declares the listed variables to be confined (lexically) to the enclosing block, conditional (C<if/unless/elsif/else>), loop (C<for/foreach/while/until/continue>), subroutine, C<eval>, or C<do/require/use>'d file. If more than one value is listed, the list -must be placed in parens. All listed elements must be legal lvalues. +must be placed in parentheses. All listed elements must be legal lvalues. Only alphanumeric identifiers may be lexically scoped--magical builtins like $/ must currently be localized with "local" instead. @@ -226,11 +227,11 @@ change whether those variables is viewed as a scalar or an array. So my ($foo) = <STDIN>; my @FOO = <STDIN>; -both supply a list context to the righthand side, while +both supply a list context to the right-hand side, while my $foo = <STDIN>; -supplies a scalar context. But the following only declares one variable: +supplies a scalar context. But the following declares only one variable: my $foo, $bar = 1; @@ -282,7 +283,7 @@ but not beyond it. modifiers appended to simple statements. Such modifiers are not control structures and have no effect on scoping.) -The C<foreach> loop defaults to dynamically scoping its index variable +The C<foreach> loop defaults to scoping its index variable dynamically (in the manner of C<local>; see below). However, if the index variable is prefixed with the keyword "my", then it is lexically scoped instead. Thus in the loop @@ -328,8 +329,8 @@ lexical of the same name is also visible: That will print out 20 and 10. -You may declare "my" variables at the outer most scope of a file to -totally hide any such identifiers from the outside world. This is similar +You may declare "my" variables at the outermost scope of a file to +hide any such identifiers totally from the outside world. This is similar to C's static variables at the file level. To do this with a subroutine requires the use of a closure (anonymous function). If a block (such as an eval(), function, or C<package>) wants to create a private subroutine @@ -341,7 +342,7 @@ variable containing an anonymous sub reference: &$secret_sub(); As long as the reference is never returned by any function within the -module, no outside module can see the subroutine, since its name is not in +module, no outside module can see the subroutine, because its name is not in any package's symbol table. Remember that it's not I<REALLY> called $some_pack::secret_version or anything; it's just $secret_version, unqualified and unqualifiable. @@ -370,7 +371,7 @@ 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() to be executed early, either by putting the whole block above -your pain program, or more likely, merely placing 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: @@ -406,15 +407,15 @@ Synopsis: 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 +block, (or subroutine, C<eval{}>, or C<do>) and I<any called from within that block>. A local() just gives temporary values to global (meaning package) variables. This is known as dynamic scoping. Lexical scoping is done with "my", which works more like C's auto declarations. If more than one variable is given to local(), they must be placed in -parens. All listed elements must be legal lvalues. This operator works +parentheses. All listed elements must be legal lvalues. This operator works by saving the current values of those variables in its argument list on a -hidden stack and restoring them upon exiting the block, subroutine or +hidden stack and restoring them upon exiting the block, subroutine, or eval. This means that called subroutines can also reference the local variable, but not the global one. The argument list may be assigned to if desired, which allows you to initialize your local variables. (If no @@ -449,7 +450,7 @@ as a scalar or an array. So local($foo) = <STDIN>; local @FOO = <STDIN>; -both supply a list context to the righthand side, while +both supply a list context to the right-hand side, while local $foo = <STDIN>; @@ -466,12 +467,12 @@ Sometimes you don't want to pass the value of an array to a subroutine but rather the name of it, so that the subroutine can modify the global copy of it rather than working with a local copy. In perl you can refer to all objects of a particular name by prefixing the name -with a star: C<*foo>. This is often known as a "typeglob", since the +with a star: C<*foo>. This is often known as a "typeglob", because the star on the front can be thought of as a wildcard match for all the funny prefix characters on variables and subroutines and such. When evaluated, the typeglob produces a scalar value that represents -all the objects of that name, including any filehandle, format or +all the objects of that name, including any filehandle, format, or subroutine. When assigned to, it causes the name mentioned to refer to whatever "*" value was assigned to it. Example: @@ -488,11 +489,11 @@ Note that scalars are already passed by reference, so you can modify scalar arguments without using this mechanism by referring explicitly to C<$_[0]> etc. You can modify all the elements of an array by passing all the elements as scalars, but you have to use the * mechanism (or -the equivalent reference mechanism) to push, pop or change the size of +the equivalent reference mechanism) to push, pop, or change the size of an array. It will certainly be faster to pass the typeglob (or reference). Even if you don't want to modify an array, this mechanism is useful for -passing multiple arrays in a single LIST, since normally the LIST +passing multiple arrays in a single LIST, because normally the LIST mechanism will merge all the array values so that you can't extract out the individual arrays. For more on typeglobs, see L<perldata/"Typeglobs and FileHandles">. @@ -534,9 +535,9 @@ list of keys occurring in all the hashes passed to it: return grep { $seen{$_} == @_ } keys %seen; } -So far, we're just using the normal list return mechanism. +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 only using one of them, or you don't mind them +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. @@ -546,7 +547,7 @@ Where people get into trouble is here: or (%a, %b) = func(%c, %d); -That syntax simply won't work. It just sets @a or %a and clears the @b or +That syntax simply won't work. It sets just @a or %a and clears the @b or %b. Plus the function didn't get passed into two separate arrays or hashes: it got one long list in @_, as always. @@ -581,7 +582,38 @@ It turns out that you can actually do this also: 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() -variables, since only globals (well, and local()s) are in the symbol table. +variables, because only globals (well, and local()s) are in the symbol table. + +If you're passing around filehandles, you could usually just use the bare +typeglob, like *STDOUT, but typeglobs references would be better because +they'll still work properly under C<use strict 'refs'>. For example: + + splutter(\*STDOUT); + sub splutter { + my $fh = shift; + print $fh "her um well a hmmm\n"; + } + + $rec = get_rec(\*STDIN); + sub get_rec { + my $fh = shift; + return scalar <$fh>; + } + +Another way to do this is using *HANDLE{IO}, see L<perlref> for usage +and caveats. + +If you're planning on generating new filehandles, you could do this: + + sub openit { + my $name = shift; + local *FH; + return open (FH, $path) ? \*FH : undef; + } + +Although that will actually produce a small memory leak. See the bottom +of L<perlfunc/open()> for a somewhat cleaner way using the IO::Handle +package. =head2 Prototypes @@ -591,7 +623,7 @@ As of the 5.002 release of perl, if you declare then mypush() takes arguments exactly like push() does. The declaration of the function to be called must be visible at compile time. The prototype -only affects the interpretation of new-style calls to the function, where +affects only the interpretation of new-style calls to the function, where new-style is defined as not using the C<&> character. In other words, if you call it like a builtin function, then it behaves like a builtin function. If you call it like an old-fashioned subroutine, then it @@ -600,10 +632,10 @@ this rule that prototypes have no influence on subroutine references like C<\&foo> or on indirect subroutine calls like C<&{$subref}>. Method calls are not influenced by prototypes either, because the -function to be called is indeterminate at compile time, since it depends +function to be called is indeterminate at compile time, because it depends on inheritance. -Since the intent is primarily to let you define subroutines that work +Because the intent is primarily to let you define subroutines that work like builtin commands, here are the prototypes for some other functions that parse almost exactly like the corresponding builtins. @@ -644,7 +676,7 @@ A semicolon separates mandatory arguments from optional arguments. Note how the last three examples above are treated specially by the parser. mygrep() is parsed as a true list operator, myrand() is parsed as a true unary operator with unary precedence the same as rand(), and -mytime() is truly argumentless, just like time(). That is, if you +mytime() is truly without arguments, just like time(). That is, if you say mytime +2; @@ -674,7 +706,7 @@ That prints "unphooey". (Yes, there are still unresolved issues having to do with the visibility of @_. I'm ignoring that question for the moment. (But note that if we make @_ lexically scoped, those anonymous subroutines can act like closures... (Gee, -is this sounding a little Lispish? (Nevermind.)))) +is this sounding a little Lispish? (Never mind.)))) And here's a reimplementation of grep: @@ -715,23 +747,23 @@ returning a list: Then you've just supplied an automatic scalar() in front of their argument, which can be more than a bit surprising. The old @foo which used to hold one thing doesn't get passed in. Instead, -the func() now gets passed in 1, that is, the number of elments +the func() now gets passed in 1, that is, the number of elements 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 only be used in moderation +This is all very powerful, of course, and should be used only in moderation to make the world a better place. =head2 Overriding Builtin Functions -Many builtin functions may be overridden, though this should only be -tried occasionally and for good reason. Typically this might be +Many builtin functions may be overridden, though this should be tried +only occasionally and for good reason. Typically this might be done by a package attempting to emulate missing builtin functionality on a non-Unix system. -Overriding may only be done by importing the name from a +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, predeclare subs +C<subs> pragma (compiler directive) lets you, in effect, pre-declare subs via the import syntax, and these names may then override the builtin ones: use subs 'chdir', 'chroot', 'chmod', 'chown'; @@ -739,7 +771,7 @@ via the import syntax, and these names may then override the builtin ones: sub chdir { ... } Library modules should not in general export builtin names like "open" -or "chdir" as part of their default @EXPORT list, since these may +or "chdir" as part of their default @EXPORT list, because these may sneak into someone else's namespace and change the semantics unexpectedly. Instead, if the module adds the name to the @EXPORT_OK list, then it's possible for a user to import the name explicitly, but not implicitly. @@ -784,7 +816,7 @@ should just call system() with those arguments. All you'd do is this: who('am', 'i'); ls('-l'); -In fact, if you preclare the functions you want to call that way, you don't +In fact, if you pre-declare the functions you want to call that way, you don't even need the parentheses: use subs qw(date who ls); diff --git a/pod/perlsyn.pod b/pod/perlsyn.pod index b0f77f4149..9cf39a3d5a 100644 --- a/pod/perlsyn.pod +++ b/pod/perlsyn.pod @@ -35,7 +35,7 @@ take effect at compile time. Typically all the declarations are put at the beginning or the end of the script. However, if you're using lexically-scoped private variables created with 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 to be able to access those private variables. +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 @@ -63,7 +63,7 @@ The only kind of simple statement is an expression evaluated for its side effects. Every simple statement must be terminated with a semicolon, unless it is the final statement in a block, in which case the semicolon is optional. (A semicolon is still encouraged there if the -block takes up more than one line, since you may eventually add another line.) +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), and thus need an explicit termination if used as the last item in a statement. @@ -91,7 +91,7 @@ can write loops like: } until $line eq ".\n"; See L<perlfunc/do>. Note also that the loop control -statements described later will I<NOT> work in this construct, since +statements described later will I<NOT> work in this construct, because modifiers don't take loop labels. Sorry. You can always wrap another block around it to do that sort of thing. @@ -128,7 +128,7 @@ all do the same thing: open(FOO) ? 'hi mom' : die "Can't open $FOO: $!"; # a bit exotic, that last one -The C<if> statement is straightforward. Since BLOCKs are always +The C<if> statement is straightforward. Because BLOCKs are always bounded by curly brackets, there is never any ambiguity about which C<if> an C<else> goes with. If you use C<unless> in place of C<if>, the sense of the test is reversed. @@ -322,7 +322,7 @@ do it: See how much easier this is? It's cleaner, safer, and faster. It's cleaner because it's less noisy. It's safer because if code gets added between the inner and outer loops later on, the new code won't be -accidentally executed, the C<next> explicitly iterates the other loop +accidentally executed. The C<next> explicitly iterates the other loop rather than merely terminating the inner one. And it's faster because Perl executes a C<foreach> statement more rapidly than it would the equivalent C<for> loop. @@ -496,7 +496,7 @@ and your documentation text freely, as in ......... } -Note that pod translators should only look at 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 paragraph. This means that the following secret stuff will be diff --git a/pod/perltie.pod b/pod/perltie.pod index 7c4314188a..7624881bde 100644 --- a/pod/perltie.pod +++ b/pod/perltie.pod @@ -13,8 +13,8 @@ perltie - how to hide an object class in a simple variable =head1 DESCRIPTION Prior to release 5.0 of Perl, a programmer could use dbmopen() -to magically connect an on-disk database in the standard Unix dbm(3x) -format to a %HASH in their program. However, their Perl was either +to connect an on-disk database in the standard Unix dbm(3x) +format magically to a %HASH in their program. However, their Perl was either built with one particular dbm library or another, but not both, and you couldn't extend this mechanism to other packages or types of variables. @@ -33,12 +33,12 @@ In the tie() call, C<VARIABLE> is the name of the variable to be enchanted. C<CLASSNAME> is the name of a class implementing objects of the correct type. Any additional arguments in the C<LIST> are passed to the appropriate constructor method for that class--meaning TIESCALAR(), -TIEARRAY(), TIEHASH() or TIEHANDLE(). (Typically these are arguments +TIEARRAY(), TIEHASH(), or TIEHANDLE(). (Typically these are arguments such as might be passed to the dbminit() function of C.) The object returned by the "new" method is also returned by the tie() function, which would be useful if you wanted to access other methods in C<CLASSNAME>. (You don't actually have to return a reference to a right -"type" (e.g. HASH or C<CLASSNAME>) so long as it's a properly blessed +"type" (e.g., HASH or C<CLASSNAME>) so long as it's a properly blessed object.) You can also retrieve a reference to the underlying object using the tied() function. @@ -105,8 +105,8 @@ variable C<$^W> to see whether to emit a bit of noise anyway. This method will be triggered every time the tied variable is accessed (read). It takes no arguments beyond its self reference, which is the -object representing the scalar we're dealing with. Since in this case -we're just using a SCALAR ref for the tied scalar object, a simple $$self +object representing the scalar we're dealing with. Because in this case +we're using just a SCALAR ref for the tied scalar object, a simple $$self allows the method to get at the real value stored there. In our example below, that real value is the process ID to which we've tied our variable. @@ -160,7 +160,7 @@ argument--the new value the user is trying to assign. =item DESTROY this This method will be triggered when the tied variable needs to be destructed. -As with other object classes, such a method is seldom necessary, since Perl +As with other object classes, such a method is seldom necessary, because Perl deallocates its moribund object's memory for you automatically--this isn't C++, you know. We'll use a DESTROY method here for debugging purposes only. @@ -173,7 +173,7 @@ C++, you know. We'll use a DESTROY method here for debugging purposes only. =back That's about all there is to it. Actually, it's more than all there -is to it, since we've done a few nice things here for the sake +is to it, because we've done a few nice things here for the sake of completeness, robustness, and general aesthetics. Simpler TIESCALAR classes are certainly possible. @@ -253,7 +253,7 @@ As you may have noticed, the name of the FETCH method (et al.) is the same for all accesses, even though the constructors differ in names (TIESCALAR vs TIEARRAY). While in theory you could have the same class servicing several tied types, in practice this becomes cumbersome, and it's easiest -to simply keep them at one tie type per class. +to keep them at simply one tie type per class. =item STORE this, index, value @@ -303,8 +303,8 @@ value pairs. FIRSTKEY and NEXTKEY implement the keys() and each() functions to iterate over all the keys. And DESTROY is called when the tied variable is garbage collected. -If this seems like a lot, then feel free to merely inherit -from the standard Tie::Hash module for most of your methods, redefining only +If this seems like a lot, then feel free to inherit from +merely the standard Tie::Hash module for most of your methods, redefining only the interesting ones. See L<Tie::Hash> for details. Remember that Perl distinguishes between a key not existing in the hash, @@ -313,8 +313,8 @@ C<undef>. The two possibilities can be tested with the C<exists()> and C<defined()> functions. Here's an example of a somewhat interesting tied hash class: it gives you -a hash representing a particular user's dotfiles. You index into the hash -with the name of the file (minus the dot) and you get back that dotfile's +a hash representing a particular user's dot files. You index into the hash +with the name of the file (minus the dot) and you get back that dot file's contents. For example: use DotFiles; @@ -323,7 +323,7 @@ contents. For example: $dot{login} =~ /MANPATH/ || $dot{cshrc} =~ /MANPATH/ ) { - print "you seem to set your manpath\n"; + print "you seem to set your MANPATH\n"; } Or here's another sample of using our tied class: @@ -347,7 +347,7 @@ whose dot files this object represents =item HOME -where those dotfiles live +where those dot files live =item CLOBBER @@ -355,7 +355,7 @@ whether we should try to change or remove those dot files =item LIST -the hash of dotfile names and content mappings +the hash of dot file names and content mappings =back @@ -367,7 +367,7 @@ Here's the start of F<Dotfiles.pm>: my $DEBUG = 0; sub debug { $DEBUG = @_ ? shift : 1 } -For our example, we want to able to emit debugging info to help in tracing +For our example, we want to be able to emit debugging info to help in tracing during development. We keep also one convenience function around internally to help print out warnings; whowasi() returns the function name that calls it. @@ -413,7 +413,7 @@ Here's the constructor: It's probably worth mentioning that if you're going to filetest the return values out of a readdir, you'd better prepend the directory -in question. Otherwise, since we didn't chdir() there, it would +in question. Otherwise, because we didn't chdir() there, it would have been testing the wrong file. =item FETCH this, key @@ -445,7 +445,7 @@ Here's the fetch for our DotFiles example. It was easy to write by having it call the Unix cat(1) command, but it would probably be more portable to open the file manually (and somewhat -more efficient). Of course, since dot files are a Unixy concept, we're +more efficient). Of course, because dot files are a Unixy concept, we're not that concerned. =item STORE this, key, value @@ -526,14 +526,14 @@ the caller whether the file was successfully deleted. This method is triggered when the whole hash is to be cleared, usually by assigning the empty list to it. -In our example, that would remove all the user's dotfiles! It's such a +In our example, that would remove all the user's dot files! It's such a dangerous thing that they'll have to set CLOBBER to something higher than 1 to make it happen. sub CLEAR { carp &whowasi if $DEBUG; my $self = shift; - croak "@{[&whowasi]}: won't remove all dotfiles for $self->{USER}" + croak "@{[&whowasi]}: won't remove all dot files for $self->{USER}" unless $self->{CLOBBER} > 1; my $dot; foreach $dot ( keys %{$self->{LIST}}) { @@ -574,8 +574,8 @@ second argument which is the last key that had been accessed. This is useful if you're carrying about ordering or calling the iterator from more than one sequence, or not really storing things in a hash anywhere. -For our example, we're using a real hash so we'll just do the simple -thing, but we'll have to indirect through the LIST field. +For our example, we're using a real hash so we'll do just the simple +thing, but we'll have to go through the LIST field indirectly. sub NEXTKEY { carp &whowasi if $DEBUG; @@ -628,9 +628,9 @@ In our example we're going to create a shouting handle. This is the constructor for the class. That means it is expected to return a blessed reference of some sort. The reference can be used to -hold some internal information. We won't use it in out example. +hold some internal information. - sub TIEHANDLE { print "<shout>\n"; my $i; bless \$i, shift } + sub TIEHANDLE { print "<shout>\n"; my $r; bless \$r, shift } =item PRINT this, LIST @@ -680,7 +680,7 @@ You cannot easily tie a multilevel data structure (such as a hash of hashes) to a dbm file. The first problem is that all but GDBM and Berkeley DB have size limitations, but beyond that, you also have problems with how references are to be represented on disk. One experimental -module that does attempt to partially address this need is the MLDBM +module that does attempt to address this need partially is the MLDBM module. Check your nearest CPAN site as described in L<perlmod> for source code to MLDBM. diff --git a/pod/perltoc.pod b/pod/perltoc.pod index 7c16f94edc..2821fa363a 100644 --- a/pod/perltoc.pod +++ b/pod/perltoc.pod @@ -6,7 +6,7 @@ perltoc - perl documentation table of contents =head1 DESCRIPTION This page provides a brief table of contents for the rest of the Perl -documentation set. It is meant to be be quickly scanned or grepped +documentation set. It is meant to be scanned quickly or grepped through to locate the proper section you're looking for. =head1 BASIC DOCUMENTATION @@ -144,7 +144,7 @@ HOME, LOGDIR, PATH, PERL5LIB, PERL5DB, PERLLIB =item The Arrow Operator -=item Autoincrement and Autodecrement +=item Auto-increment and Auto-decrement =item Exponentiation @@ -215,10 +215,10 @@ HOME, LOGDIR, PATH, PERL5LIB, PERL5DB, PERLLIB unary &, unary *, (TYPE) -=item Quote and Quotelike Operators +=item Quote and Quote-like Operators -=item Regexp Quotelike Operators +=item Regexp Quote-like Operators ?PATTERN?, m/PATTERN/gimosx, /PATTERN/gimosx, q/STRING/, C<'STRING'>, @@ -1748,7 +1748,7 @@ C<overload::Method(obj,op)> -=head2 sigtrap - Perl pragma to enable stack backtrace on unexpected +=head2 sigtrap - Perl pragma to enable stack back-trace on unexpected signals =item SYNOPSIS @@ -1773,7 +1773,7 @@ C<strict refs>, C<strict vars>, C<strict subs> -=head2 subs - Perl pragma to predeclare sub names +=head2 subs - Perl pragma to pre-declare sub names =item SYNOPSIS @@ -1784,7 +1784,7 @@ C<strict refs>, C<strict vars>, C<strict subs> -=head2 vars - Perl pragma to predeclare global variable names +=head2 vars - Perl pragma to pre-declare global variable names =item SYNOPSIS @@ -2167,7 +2167,7 @@ maybe_command_in_dirs, maybe_command, perl_script guess_name, init_main, init_dirscan, init_others, find_perl -=item Methods to actually produce chunks of text for the Makefile +=item Methods to produce chunks of text for the Makefile post_initialize, const_config, constants, const_loadlibs, const_cccmd, @@ -3157,8 +3157,8 @@ TIESCALAR classname, LIST, FETCH this, STORE this, value, DESTROY this =head1 AUXILIARY DOCUMENTATION -Here should be listed all the extra program's docs, but they don't all -have man pages yet: +Here should be listed all the extra program's documentation, but they don't all +have manual pages yet: =item a2p diff --git a/pod/perltoot.pod b/pod/perltoot.pod new file mode 100644 index 0000000000..3fdedc2513 --- /dev/null +++ b/pod/perltoot.pod @@ -0,0 +1,1779 @@ +=head1 NAME + +perltoot - Tom's object-oriented tutorial for perl + +=head1 DESCRIPTION + +Object-oriented programming is a big seller these days. Some managers +would rather have objects than sliced bread. Why is that? What's so +special about an object? Just what I<is> an object anyway? + +An object is nothing but a way of tucking away complex behaviours into +a neat little easy-to-use bundle. (This is what professors call +abstraction.) Smart people who have nothing to do but sit around for +weeks on end figuring out really hard problems make these nifty +objects that even regular people can use. (This is what professors call +software reuse.) Users (well, programmers) can play with this little +bundle all they want, but they aren't to open it up and mess with the +insides. Just like an expensive piece of hardware, the contract says +that you void the warranty if you muck with the cover. So don't do that. + +The heart of objects is the class, a protected little private namespace +full of data and functions. A class is a set of related routines that +addresses some problem area. You can think of it as a user-defined type. +The Perl package mechanism, also used for more traditional modules, +is used for class modules as well. Objects "live" in a class, meaning +that they belong to some package. + +More often than not, the class provides the user with little bundles. +These bundles are objects. They know whose class they belong to, +and how to behave. Users ask the class to do something, like "give +me an object." Or they can ask one of these objects to do something. +Asking a class to do something for you is calling a I<class method>. +Asking an object to do something for you is calling an I<object method>. +Asking either a class (usually) or an object (sometimes) to give you +back an object is calling a I<constructor>, which is just a +kind of method. + +That's all well and good, but how is an object different from any other +Perl data type? Just what is an object I<really>; that is, what's its +fundamental type? The answer to the first question is easy. An object +is different from any other data type in Perl in one and only one way: +you may dereference it using not merely string or numeric subscripts +as with simple arrays and hashes, but with named subroutine calls. +In a word, with I<methods>. + +The answer to the second question is that it's a reference, and not just +any reference, mind you, but one whose referent has been I<bless>()ed +into a particular class (read: package). What kind of reference? Well, +the answer to that one is a bit less concrete. That's because in Perl +the designer of the class can employ any sort of reference they'd like +as the underlying intrinsic data type. It could be a scalar, an array, +or a hash reference. It could even be a code reference. But because +of its inherent flexibility, an object is usually a hash reference. + +=head1 Creating a Class + +Before you create a class, you need to decide what to name it. That's +because the class (package) name governs the name of the file used to +house it, just as with regular modules. Then, that class (package) +should provide one or more ways to generate objects. Finally, it should +provide mechanisms to allow users of its objects to indirectly manipulate +these objects from a distance. + +For example, let's make a simple Person class module. It gets stored in +the file Person.pm. If it were called a Happy::Person class, it would +be stored in the file Happy/Person.pm, and its package would become +Happy::Person instead of just Person. (On a personal computer not +running Unix or Plan 9, but something like MacOS or VMS, the directory +separator may be different, but the principle is the same.) Do not assume +any formal relationship between modules based on their directory names. +This is merely a grouping convenience, and has no effect on inheritance, +variable accessibility, or anything else. + +For this module we aren't going to use Exporter, because we're +a well-behaved class module that doesn't export anything at all. +In order to manufacture objects, a class needs to have a I<constructor +method>. A constructor gives you back not just a regular data type, +but a brand-new object in that class. This magic is taken care of by +the bless() function, whose sole purpose is to enable its referent to +be used as an object. Remember: being an object really means nothing +more than that methods may now be called against it. + +While a constructor may be named anything you'd like, most Perl +programmers seem to like to call theirs new(). However, new() is not +a reserved word, and a class is under no obligation to supply such. +Some programmers have also been known to use a function with +the same name as the class as the constructor. + +=head2 Object Representation + +By far the most common mechanism used in Perl to represent a Pascal +record, a C struct, or a C++ class an anonymous hash. That's because a +hash has an arbitrary number of data fields, each conveniently accessed by +an arbitrary name of your own devising. + +If you were just doing a simple +struct-like emulation, you would likely go about it something like this: + + $rec = { + name => "Jason", + age => 23, + peers => [ "Norbert", "Rhys", "Phineas"], + }; + +If you felt like it, you could add a bit of visual distinction +by up-casing the hash keys: + + $rec = { + NAME => "Jason", + AGE => 23, + PEERS => [ "Norbert", "Rhys", "Phineas"], + }; + +And so you could get at C<$rec-E<gt>{NAME}> to find "Jason", or +C<@{ $rec-E<gt>{PEERS} }> to get at "Norbert", "Rhys", and "Phineas". +(Have you ever noticed how many 23-year-old programmers seem to +be named "Jason" these days? :-) + +This same model is often used for classes, although it is not considered +the pinnacle of programming propriety for folks from outside the +class to come waltzing into an object, brazenly accessing its data +members directly. Generally speaking, an object should be considered +an opaque cookie that you use I<object methods> to access. Visually, +methods look like you're dereffing a reference using a function name +instead of brackets or braces. + +=head2 Class Interface + +Some languages provide a formal syntactic interface to a class's methods, +but Perl does not. It relies on you to read the documentation of each +class. If you try to call an undefined method on an object, Perl won't +complain, but the program will trigger an exception while it's running. +Likewise, if you call a method expecting a prime number as its argument +with an even one instead, you can't expect the compiler to catch this. +(Well, you can expect it all you like, but it's not going to happen.) + +Let's suppose you have a well-educated user of your Person class, +someone who has read the docs that explain the prescribed +interface. Here's how they might use the Person class: + + use Person; + + $him = Person->new(); + $him->name("Jason"); + $him->age(23); + $him->peers( "Norbert", "Rhys", "Phineas" ); + + push @All_Recs, $him; # save object in array for later + + printf "%s is %d years old.\n", $him->name, $him->age; + print "His peers are: ", join(", ", $him->peers), "\n"; + + printf "Last rec's name is %s\n", $All_Recs[-1]->name; + +As you can see, the user of the class doesn't know (or at least, has no +business paying attention to the fact) that the object has one particular +implementation or another. The interface to the class and its objects +is exclusively via methods, and that's all the user of the class should +ever play with. + +=head2 Constructors and Instance Methods + +Still, I<someone> has to know what's in the object. And that someone is +the class. It implements methods that the programmer uses to access +the object. Here's how to implement the Person class using the standard +hash-ref-as-an-object idiom. We'll make a class method called new() to +act as the constructor, and three object methods called name(), age(), and +peers() to get at per-object data hidden away in our anonymous hash. + + package Person; + use strict; + + ################################################## + ## the object constructor (simplistic version) ## + ################################################## + sub new { + my $self = {}; + $self->{NAME} = undef; + $self->{AGE} = undef; + $self->{PEERS} = []; + bless($self); # but see below + return $self; + } + + ############################################## + ## methods to access per-object data ## + ## ## + ## With args, they set the value. Without ## + ## any, they only retrieve it/them. ## + ############################################## + + sub name { + my $self = shift; + if (@_) { $self->{NAME} = shift } + return $self->{NAME}; + } + + sub age { + my $self = shift; + if (@_) { $self->{AGE} = shift } + return $self->{AGE}; + } + + sub peers { + my $self = shift; + if (@_) { @{ $self->{PEERS} } = @_ } + return @{ $self->{PEERS} }; + } + + 1; # so the require or use succeeds + +We've created three methods to access an object's data, name(), age(), +and peers(). These are all substantially similar. If called with an +argument, they set the appropriate field; otherwise they return the +value held by that field, meaning the value of that hash key. + +=head2 Planning for the Future: Better Constructors + +Even though at this point you may not even know what it means, someday +you're going to worry about inheritance. (You can safely ignore this +for now and worry about it later if you'd like.) To ensure that this +all works out smoothly, you must use the double-argument form of bless(). +The second argument is the class into which the referent will be blessed. +By not assuming our own class as the default second argument and instead +using the class passed into us, we make our constructor inheritable. + +While we're at it, let's make our constructor a bit more flexible. +Rather than being uniquely a class method, we'll set it up so that +it can be called as either a class method I<or> an object +method. That way you can say: + + $me = Person->new(); + $him = $me->new(); + +To do this, all we have to do is check whether what was passed in +was a reference or not. If so, we were invoked as an object method, +and we need to extract the package (class) using the ref() function. +If not, we just use the string passed in as the package name +for blessing our referent. + + sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + $self->{NAME} = undef; + $self->{AGE} = undef; + $self->{PEERS} = []; + bless ($self, $class); + return $self; + } + +That's about all there is for constructors. These methods bring objects +to life, returning neat little opaque bundles to the user to be used in +subsequent method calls. + +=head2 Destructors + +Every story has a beginning and an end. The beginning of the object's +story is its constructor, explicitly called when the object comes into +existence. But the ending of its story is the I<destructor>, a method +implicitly called when an object leaves this life. Any per-object +clean-up code is placed in the destructor, which must (in Perl) be called +DESTROY. + +If constructors can have arbitrary names, then why not destructors? +Because while a constructor is explicitly called, a destructor is not. +Destruction happens automatically via Perl's garbage collection (GC) +system, which is a quick but somewhat lazy reference-based GC system. +To know what to call, Perl insists that the destructor be named DESTROY. + +Why is DESTROY in all caps? Perl on occasion uses purely upper-case +function names as a convention to indicate that the function will +be automatically called by Perl in some way. Others that are called +implicitly include BEGIN, END, AUTOLOAD, plus all methods used by +tied objects, described in L<perltie>. + +In really good object-oriented programming languages, the user doesn't +care when the destructor is called. It just happens when it's supposed +to. In low-level languages without any GC at all, there's no way to +depend on this happening at the right time, so the programmer must +explicitly call the destructor to clean up memory and state, crossing +their fingers that it's the right time to do so. Unlike C++, an +object destructor is nearly never needed in Perl, and even when it is, +explicit invocation is uncalled for. In the case of our Person class, +we don't need a destructor because Perl takes care of simple matters +like memory deallocation. + +The only situation where Perl's reference-based GC won't work is +when there's a circularity in the data structure, such as: + + $this->{WHATEVER} = $this; + +In that case, you must delete the self-reference manually if you expect +your program not to leak memory. While admittedly error-prone, this is +the best we can do right now. Nonetheless, rest assured that when your +program is finished, its objects' destructors are all duly called. +So you are guaranteed that an object I<eventually> gets properly +destroyed, except in the unique case of a program that never exits. +(If you're running Perl embedded in another application, this full GC +pass happens a bit more frequently--whenever a thread shuts down.) + +=head2 Other Object Methods + +The methods we've talked about so far have either been constructors or +else simple "data methods", interfaces to data stored in the object. +These are a bit like an object's data members in the C++ world, except +that strangers don't access them as data. Instead, they should only +access the object's data indirectly via its methods. This is an +important rule: in Perl, access to an object's data should I<only> +be made through methods. + +Perl doesn't impose restrictions on who gets to use which methods. +The public-versus-private distinction is by convention, not syntax. +(Well, unless you use the Alias module described below in L</"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 +closest acquaintances, its immediate subclasses. But this distinction +is not enforced by Perl itself. It's up to the programmer to behave. + +There's no reason to limit methods to those that simply access data. +Methods can do anything at all. The key point is that they're invoked +against an object or a class. Let's say we'd like object methods that +do more than fetch or set one particular field. + + sub exclaim { + my $self = shift; + return sprintf "Hi, I'm %s, age %d, working with %s", + $self->{NAME}, $self->{AGE}, join(", ", $self->{PEERS}); + } + +Or maybe even one like this: + + sub happy_birthday { + my $self = shift; + return ++$self->{AGE}; + } + +Some might argue that one should go at these this way: + + sub exclaim { + my $self = shift; + return sprintf "Hi, I'm %s, age %d, working with %s", + $self->name, $self->age, join(", ", $self->peers); + } + + sub happy_birthday { + my $self = shift; + return $self->age( $self->age() + 1 ); + } + +But since these methods are all executing in the class itself, this +may not be critical. There are trade-offs to be made. Using direct +hash access is faster (about an order of magnitude faster, in fact), and +it's more convenient when you want to interpolate in strings. But using +methods (the external interface) internally shields not just the users of +your class but even you yourself from changes in your data representation. + +=head1 Class Data + +What about "class data", data items common to each object in a class? +What would you want that for? Well, in your Person class, you might +like to keep track of the total people alive. How do you implement that? + +You I<could> make it a global variable called $Person::Census. But about +only reason you'd do that would be if you I<wanted> people to be able to +get at your class data directly. They could just say $Person::Census +and play around with it. Maybe this is ok in your design scheme. +You might even conceivably want to make it an exported variable. To be +exportable, a variable must be a (package) global. If this were a +traditional module rather than an object-oriented one, you might do that. + +While this approach is expected in most traditional modules, it's +generally considered rather poor form in most object modules. In an +object module, you should set up a protective veil to separate interface +from implementation. So provide a class method to access class data +just as you provide object methods to access object data. + +So, you I<could> still keep $Census as a package global and rely upon +others to honor the contract of the module and therefore not play around +with its implementation. You could even be supertricky and make $Census a +tied object as described in L<perltie>, thereby intercepting all accesses. + +But more often than not, you just want to make your class data a +file-scoped lexical. To do so, simply put this at the top of the file: + + my $Census = 0; + +Even though the scope of a my() normally expires when the block in which +it was declared is done (in this case the whole file being required or +used), Perl's deep binding of lexical variables guarantees that the +variable will not be deallocated, remaining accessible to functions +declared within that scope. This doesn't work with global variables +given temporary values via local(), though. + +Irrespective of whether you leave $Census a package global or make +it instead a file-scoped lexical, you should make these +changes to your Person::new() constructor: + + sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + $Census++; + $self->{NAME} = undef; + $self->{AGE} = undef; + $self->{PEERS} = []; + bless ($self, $class); + return $self; + } + + sub population { + return $Census; + } + +Now that we've done this, we certainly do need a destructor so that +when Person is destroyed, the $Census goes down. Here's how +this could be done: + + sub DESTROY { --$Census } + +Notice how there's no memory to deallocate in the destructor? That's +something that Perl takes care of for you all by itself. + +=head2 Accessing Class Data + +It turns out that this is not really a good way to go about handling +class data. A good scalable rule is that I<you must never reference class +data directly from an object method>. Otherwise you aren't building a +scalable, inheritable class. The object must be the rendezvous point +for all operations, especially from an object method. The globals +(class data) would in some sense be in the "wrong" package in your +derived classes. In Perl, methods execute in the context of the class +they were defined in, I<not> that of the object that triggered them. +Therefore, namespace visibility of package globals in methods is unrelated +to inheritance. + +Got that? Maybe not. Ok, let's say that some other class "borrowed" +(well, inherited) the DESTROY method as it was defined above. When those +objects are destructed, the original $Census variable will be altered, +not the one in the new class's package namespace. Perhaps this is what +you want, but probably it isn't. + +Here's how to fix this. We'll store a reference to the data in the +value accessed by the hash key "_CENSUS". Why the underscore? Well, +mostly because an initial underscore already conveys strong feelings +of magicalness to a C programmer. It's really just a mnemonic device +to remind ourselves that this field is special and not to be used as +a public data member in the same way that NAME, AGE, and PEERS are. +(Because we've been developing this code under the strict pragma, prior +to 5.004 we'll have to quote the field name.) + + sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + $self->{NAME} = undef; + $self->{AGE} = undef; + $self->{PEERS} = []; + # "private" data + $self->{"_CENSUS"} = \$Census; + bless ($self, $class); + ++ ${ $self->{"_CENSUS"} }; + return $self; + } + + sub population { + my $self = shift; + if (ref $self) { + return ${ $self->{"_CENSUS"} }; + } else { + return $Census; + } + } + + sub DESTROY { + my $self = shift; + -- ${ $self->{"_CENSUS"} }; + } + +=head2 Debugging Methods + +It's common for a class to have a debugging mechanism. For example, +you might want to see when objects are created or destroyed. To do that, +add a debugging variable as a file-scoped lexical. For this, we'll pull +in the standard Carp module to emit our warnings and fatal messages. +That way messages will come out with the caller's filename and +line number instead of our own; if we wanted them to be from our own +perspective, we'd just use die() and warn() directly instead of croak() +and carp() respectively. + + use Carp; + my $Debugging = 0; + +Now add a new class method to access the variable. + + sub debug { + my $class = shift; + if (ref $class) { confess "Class method called as object method" } + unless (@_ == 1) { confess "usage: CLASSNAME->debug(level)" } + $Debugging = shift; + } + +Now fix up DESTROY to murmur a bit as the moribund object expires: + + sub DESTROY { + my $self = shift; + if ($Debugging) { carp "Destroying $self " . $self->name } + -- ${ $self->{"_CENSUS"} }; + } + +One could conceivably make a per-object debug state. That +way you could call both of these: + + Person->debug(1); # entire class + $him->debug(1); # just this object + +To do so, we need our debugging method to be a "bimodal" one, one that +works on both classes I<and> objects. Therefore, adjust the debug() +and DESTROY methods as follows: + + sub debug { + my $self = shift; + confess "usage: thing->debug(level)" unless @_ == 1; + my $level = shift; + if (ref($self)) { + $self->{"_DEBUG"} = $level; # just myself + } else { + $Debugging = $level; # whole class + } + } + + sub DESTROY { + my $self = shift; + if ($Debugging || $self->{"_DEBUG"}) { + carp "Destroying $self " . $self->name; + } + -- ${ $self->{"_CENSUS"} }; + } + +What happens if a derived class (which we'll all C<Employee>) inherits +methods from this person one? Then C<Employee->debug()> when called +as a class method manipulates $Person::Debugging not $Employee::Debugging. + +=head2 Class Destructors + +The object destructor handles the death of each distinct object. But sometimes +you want a bit of cleanup when the entire class is shut down, which +currently only happens when the program exits. To make such a +I<class destructor>, create a function in that class's package named +END. This works just like the END function in traditional modules, +meaning that it gets called whenever your program exits unless it execs +or dies of an uncaught signal. For example, + + sub END { + if ($Debugging) { + print "All persons are going away now.\n"; + } + } + +When the program exits, all the class destructors (END functions) are +be called in the opposite order that they were loaded in (LIFO order). + +=head2 Documenting the Interface + +And there you have it: we've just shown you the I<implementation> of this +Person class. Its I<interface> would be its documentation. Usually this +means putting it in pod ("plain old documentation") format right there +in the same file. In our Person example, we would place the following +docs anywhere in the Person.pm file. Even though it looks mostly like +code, it's not. It's embedded documentation such as would be used by +the pod2man, pod2html, or pod2text programs. The Perl compiler ignores +pods entirely, just as the translators ignore code. Here's an example of +some pods describing the informal interface: + + =head1 NAME + + Person - class to implement people + + =head1 SYNOPSIS + + use Person; + + ################# + # class methods # + ################# + $ob = Person->new; + $count = Person->population; + + ####################### + # object data methods # + ####################### + + ### get versions ### + $who = $ob->name; + $years = $ob->age; + @pals = $ob->peers; + + ### set versions ### + $ob->name("Jason"); + $ob->age(23); + $ob->peers( "Norbert", "Rhys", "Phineas" ); + + ######################## + # other object methods # + ######################## + + $phrase = $ob->exclaim; + $ob->happy_birthday; + + =head1 DESCRIPTION + + The Person class implements dah dee dah dee dah.... + +That's all there is to the matter of interface versus implementation. +A programmer who opens up the module and plays around with all the private +little shiny bits that were safely locked up behind the interface contract +has voided the warranty, and you shouldn't worry about their fate. + +=head1 Aggregation + +Suppose you later want to change the class to implement better names. +Perhaps you'd like to support both given names (called Christian names, +irrespective of one's religion) and family names (called surnames), plus +nicknames and titles. If users of your Person class have been properly +accessing it through its documented interface, then you can easily change +the underlying implementation. If they haven't, then they lose and +it's their fault for breaking the contract and voiding their warranty. + +To do this, we'll make another class, this one called Fullname. What's +the Fullname class look like? To answer that question, you have to +first figure out how you want to use it. How about we use it this way: + + $him = Person->new(); + $him->fullname->title("St"); + $him->fullname->christian("Thomas"); + $him->fullname->surname("Aquinas"); + $him->fullname->nickname("Tommy"); + printf "His normal name is %s\n", $him->name; + printf "But his real name is %s\n", $him->fullname->as_string; + +Ok. To do this, we'll change Person::new() so that it supports +a full name field this way: + + sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + $self->{FULLNAME} = Fullname->new(); + $self->{AGE} = undef; + $self->{PEERS} = []; + $self->{"_CENSUS"} = \$Census; + bless ($self, $class); + ++ ${ $self->{"_CENSUS"} }; + return $self; + } + + sub fullname { + my $self = shift; + return $self->{FULLNAME}; + } + +Then to support old code, define Person::name() this way: + + sub name { + my $self = shift; + return $self->{FULLNAME}->nickname(@_) + || $self->{FULLNAME}->christian(@_); + } + +Here's the Fullname class. We'll use the same technique +of using a hash reference to hold data fields, and methods +by the appropriate name to access them: + + package Fullname; + use strict; + + sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = { + TITLE => undef, + CHRISTIAN => undef, + SURNAME => undef, + NICK => undef, + }; + bless ($self, $class); + return $self; + } + + sub christian { + my $self = shift; + if (@_) { $self->{CHRISTIAN} = shift } + return $self->{CHRISTIAN}; + } + + sub surname { + my $self = shift; + if (@_) { $self->{SURNAME} = shift } + return $self->{SURNAME}; + } + + sub nickname { + my $self = shift; + if (@_) { $self->{NICK} = shift } + return $self->{NICK}; + } + + sub title { + my $self = shift; + if (@_) { $self->{TITLE} = shift } + return $self->{TITLE}; + } + + sub as_string { + my $self = shift; + my $name = join(" ", @$self{'CHRISTIAN', 'SURNAME'}); + if ($self->{TITLE}) { + $name = $self->{TITLE} . " " . $name; + } + return $name; + } + + 1; + +Finally, here's the test program: + + #!/usr/bin/perl -w + use strict; + use Person; + sub END { show_census() } + + sub show_census () { + printf "Current population: %d\n", Person->population; + } + + Person->debug(1); + + show_census(); + + my $him = Person->new(); + + $him->fullname->christian("Thomas"); + $him->fullname->surname("Aquinas"); + $him->fullname->nickname("Tommy"); + $him->fullname->title("St"); + $him->age(1); + + printf "%s is really %s.\n", $him->name, $him->fullname; + printf "%s's age: %d.\n", $him->name, $him->age; + $him->happy_birthday; + printf "%s's age: %d.\n", $him->name, $him->age; + + show_census(); + +=head1 Inheritance + +Object-oriented programming systems all support some notion of +inheritance. Inheritance means allowing one class to piggy-back on +top of another one so you don't have to write the same code again and +again. It's about software reuse, and therefore related to Laziness, +the principal virtue of a programmer. (The import/export mechanisms in +traditional modules are also a form of code reuse, but a simpler one than +the true inheritance that you find in object modules.) + +Sometimes the syntax of inheritance is built into the core of the +language, and sometimes it's not. Perl has no special syntax for +specifying the class (or classes) to inherit from. Instead, it's all +strictly in the semantics. Each package can have a variable called @ISA, +which governs (method) inheritance. If you try to call a method on an +object or class, and that method is not found in that object's package, +Perl then looks to @ISA for other packages to go looking through in +search of the missing method. + +Like the special per-package variables recognized by Exporter (such as +@EXPORT, @EXPORT_OK, @EXPORT_FAIL, %EXPORT_TAGS, and $VERSION), the @ISA +array I<must> be a package-scoped global and not a file-scoped lexical +created via my(). Most classes have just one item in their @ISA array. +In this case, we have what's called "single inheritance", or SI for short. + +Consider this class: + + package Employee; + use Person; + @ISA = ("Person"); + 1; + +Not a lot to it, eh? All it's doing so far is loading in another +class and stating that this one will inherit methods from that +other class if need be. We have given it none of its own methods. +We rely upon an Employee to behave just like a Person. + +Setting up an empty class like this is called the "empty subclass test"; +that is, making a derived class that does nothing but inherit from a +base class. If the original base class has been designed properly, +then the new derived class can be used as a drop-in replacement for the +old one. This means you should be able to write a program like this: + + use Employee + my $empl = Employee->new(); + $empl->name("Jason"); + $empl->age(23); + printf "%s is age %d.\n", $empl->name, $empl->age; + +By proper design, we mean always using the two-argument form of bless(), +avoiding direct access of global data, and not exporting anything. If you +look back at the Person::new() function we defined above, we were careful +to do that. There's a bit of package data used in the constructor, +but the reference to this is stored on the object itself and all other +methods access package data via that reference, so we should be ok. + +What do we mean by the Person::new() function -- isn't that actually +a method? Well, in principle, yes. A method is just a function that +expects as its first argument a class name (package) or object +(blessed reference). Person::new() is the function that both the +C<Person-E<gt>new()> method and the C<Employee-E<gt>new()> method end +up calling. Understand that while a method call looks a lot like a +function call, they aren't really quite the same, and if you treat them +as the same, you'll very soon be left with nothing but broken programs. +First, the actual underlying calling conventions are different: method +calls get an extra argument. Second, function calls don't do inheritance, +but methods do. + + Method Call Resulting Function Call + ----------- ------------------------ + Person->new() Person::new("Person") + Employee->new() Person::new("Employee") + +So don't use function calls when you mean to call a method. + +If an employee is just a Person, that's not all too very interesting. +So let's add some other methods. We'll give our employee +data fields to access their salary, their employee ID, and their +start date. + +If you're getting a little tired of creating all these nearly identical +methods just to get at the object's data, do not despair. Later, +we'll describe several different convenience mechanisms for shortening +this up. Meanwhile, here's the straight-forward way: + + sub salary { + my $self = shift; + if (@_) { $self->{SALARY} = shift } + return $self->{SALARY}; + } + + sub id_number { + my $self = shift; + if (@_) { $self->{ID} = shift } + return $self->{ID}; + } + + sub start_date { + my $self = shift; + if (@_) { $self->{START_DATE} = shift } + return $self->{START_DATE}; + } + +=head2 Overridden Methods + +What happens when both a derived class and its base class have the same +method defined? Well, then you get the derived class's version of that +method. For example, let's say that we want the peers() method called on +an employee to act a bit differently. Instead of just returning the list +of peer names, let's return slightly different strings. So doing this: + + $empl->peers("Peter", "Paul", "Mary"); + printf "His peers are: %s\n", join(", ", $empl->peers); + +will produce: + + His peers are: PEON=PETER, PEON=PAUL, PEON=MARY + +To do this, merely add this definition into the Employee.pm file: + + sub peers { + my $self = shift; + if (@_) { @{ $self->{PEERS} } = @_ } + return map { "PEON=\U$_" } @{ $self->{PEERS} }; + } + +There, we've just demonstrated the high-falutin' concept known in certain +circles as I<polymorphism>. We've taken on the form and behaviour of +an existing object, and then we've altered it to suit our own purposes. +This is a form of Laziness. (Getting polymorphed is also what happens +when the wizard decides you'd look better as a frog.) + +Every now and then you'll want to have a method call trigger both its +derived class (also know as "subclass") version as well as its base class +(also known as "superclass") version. In practice, constructors and +destructors are likely to want to do this, and it probably also makes +sense in the debug() method we showed previously. + +To do this, add this to Employee.pm: + + use Carp; + my $Debugging = 0; + + sub debug { + my $self = shift; + confess "usage: thing->debug(level)" unless @_ == 1; + my $level = shift; + if (ref($self)) { + $self->{"_DEBUG"} = $level; + } else { + $Debugging = $level; # whole class + } + Person::debug($self, $Debugging); # don't really do this + } + +As you see, we turn around and call the Person package's debug() function. +But this is far too fragile for good design. What if Person doesn't +have a debug() function, but is inheriting I<its> debug() method +from elsewhere? It would have been slightly better to say + + Person->debug($Debugging); + +But even that's got too much hard-coded. It's somewhat better to say + + $self->Person::debug($Debugging); + +Which is a funny way to say to start looking for a debug() method up +in Person. This strategy is more often seen on overridden object methods +than on overridden class methods. + +There is still something a bit off here. We've hard-coded our +superclass's name. This in particular is bad if you change which classes +you inherit from, or add others. Fortunately, the pseudoclass SUPER +comes to the rescue here. + + $class->SUPER::debug($Debugging); + +This way it starts looking in my class's @ISA. This only makes sense +from I<within> a method call, though. Don't try to access anything +in SUPER:: from anywhere else, because it doesn't exist outside +an overridden method call. + +Things are getting a bit complicated here. Have we done anything +we shouldn't? As before, one way to test whether we're designing +a decent class is via the empty subclass test. Since we already have +an Employee class that we're trying to check, we'd better get a new +empty subclass that can derive from Employee. Here's one: + + package Boss; + use Employee; # :-) + @ISA = qw(Employee); + +And here's the test program: + + #!/usr/bin/perl -w + use strict; + use Boss; + Boss->debug(1); + + my $boss = Boss->new(); + + $boss->fullname->title("Don"); + $boss->fullname->surname("Pichon Alvarez"); + $boss->fullname->christian("Federico Jesus"); + $boss->fullname->nickname("Fred"); + + $boss->age(47); + $boss->peers("Frank", "Felipe", "Faust"); + + printf "%s is age %d.\n", $boss->fullname, $boss->age; + printf "His peers are: %s\n", join(", ", $boss->peers); + +Running it, we see that we're still ok. If you'd like to dump out your +object in a nice format, somewhat like the way the 'x' command works in +the debugger, you could use the Data::Dumper module from CPAN this way: + + use Data::Dumper; + print "Here's the boss:\n"; + print Dumper($boss); + +Which shows us something like this: + + Here's the boss: + $VAR1 = bless( { + _CENSUS => \1, + FULLNAME => bless( { + TITLE => 'Don', + SURNAME => 'Pichon Alvarez', + NICK => 'Fred', + CHRISTIAN => 'Federico Jesus' + }, 'Fullname' ), + AGE => 47, + PEERS => [ + 'Frank', + 'Felipe', + 'Faust' + ] + }, 'Boss' ); + +Hm.... something's missing there. What about the salary, start date, +and ID fields? Well, we never set them to anything, even undef, so they +don't show up in the hash's keys. The Employee class has no new() method +of its own, and the new() method in Person doesn't know about Employees. +(Nor should it: proper OO design dictates that a subclass be allowed to +know about its immediate superclass, but never vice-versa.) So let's +fix up Employee::new() this way: + + sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(); + $self->{SALARY} = undef; + $self->{ID} = undef; + $self->{START_DATE} = undef; + bless ($self, $class); # reconsecrate + return $self; + } + +Now if you dump out an Employee or Boss object, you'll find +that new fields show up there now. + +=head2 Multiple Inheritance + +Ok, at the risk of confusing beginners and annoying OO gurus, it's +time to confess that Perl's object system includes that controversial +notion known as multiple inheritance, or MI for short. All this means +is that rather than having just one parent class who in turn might +itself have a parent class, etc., that you can directly inherit from +two or more parents. It's true that some uses of MI can get you into +trouble, although hopefully not quite so much trouble with Perl as with +dubiously-OO languages like C++. + +The way it works is actually pretty simple: just put more than one package +name in your @ISA array. When it comes time for Perl to go finding +methods for your object, it looks at each of these packages in order. +Well, kinda. It's actually a fully recursive, depth-first order. +Consider a bunch of @ISA arrays like this: + + @First::ISA = qw( Alpha ); + @Second::ISA = qw( Beta ); + @Third::ISA = qw( First Second ); + +If you have an object of class Third: + + my $ob = Third->new(); + $ob->spin(); + +How do we find a spin() method (or a new() method for that matter)? +Because the search is depth-first, classes will be looked up +in the following order: Third, First, Alpha, Second, and Beta. + +In practice, few class modules have been seen that actually +make use of MI. One nearly always chooses simple containership of +one class within another over MI. That's why our Person +object I<contained> a Fullname object. That doesn't mean +it I<was> one. + +However, there is one particular area where MI in Perl is rampant: +borrowing another class's class methods. This is rather common, +especially with some bundled "objectless" classes, +like Exporter, DynaLoader, AutoLoader, and SelfLoader. These classes +do not provide constructors; they exist only so you may inherit their +class methods. (It's not entirely clear why inheritance was done +here rather than traditional module importation.) + +For example, here is the POSIX module's @ISA: + + package POSIX; + @ISA = qw(Exporter DynaLoader); + +The POSIX module isn't really an object module, but then, +neither are Exporter or DynaLoader. They're just lending their +classes' behaviours to POSIX. + +Why don't people use MI for object methods much? One reason is that +it can have complicated side-effects. For one thing, your inheritance +graph (no longer a tree) might converge back to the same base class. +Although Perl guards against recursive inheritance, merely having parents +who are related to each other via a common ancestor, incestuous though +it sounds, is not forbidden. What if in our Third class shown above we +wanted its new() method to also call both overridden constructors in its +two parent classes? The SUPER notation would only find the first one. +Also, what about if the Alpha and Beta classes both had a common ancestor, +like Nought? If you kept climbing up the inheritance tree calling +overridden methods, you'd end up calling Nought::new() twice, +which might well be a bad idea. + +=head2 UNIVERSAL: The Root of All Objects + +Wouldn't it be convenient if all objects were rooted at some ultimate +base class? That way you could give every object common methods without +having to go and add it to each and every @ISA. Well, it turns out that +you can. You don't see it, but Perl tacitly and irrevocably assumes +that there's an extra element at the end of @ISA: the class UNIVERSAL. +In 5.003, there were no predefined methods there, but you could put +whatever you felt like into it. + +However, as of 5.004 (or some subversive releases, like 5.003_08), +UNIVERSAL has some methods in it already. These are built-in to your Perl +binary, so they don't take any extra time to load. Predefined methods +include isa(), can(), and VERSION(). isa() tells you whether an object or +class "is" another one without having to traverse the hierarchy yourself: + + $has_io = $fd->isa("IO::Handle"); + $itza_handle = IO::Socket->isa("IO::Handle"); + +The can() method, called against that object or class, reports back +whether its string argument is a callable method name in that class. +In fact, it gives you back a function reference to that method: + + $his_print_method = $obj->can('as_string'); + +Finally, the VERSION method checks whether the class (or the object's +class) has a package global called $VERSION that's high enough, as in: + + Some_Module->VERSION(3.0); + $his_vers = $ob->VERSION(); + +However, we don't usually call VERSION ourselves. (Remember that an all +upper-case function name is a Perl convention that indicates that the +function will be automatically used by Perl in some way.) In this case, +it happens when you say + + use Some_Module 3.0; + +If you wanted to add versioning to your Person class explained +above, just add this to Person.pm: + + use vars qw($VERSION); + $VERSION = '1.1'; + +and then in Employee.pm could you can say + + use Employee 1.1; + +And it would make sure that you have at least that version number or +higher available. This is not the same as loading in that exact version +number. No mechanism currently exists for concurrent installation of +multiple versions of a module. Lamentably. + +=head1 Alternate Object Representations + +Nothing requires objects to be implemented as hash references. An object +can be any sort of reference so long as its referent has been suitably +blessed. That means scalar, array, and code references are also fair +game. + +A scalar would work if the object has only one datum to hold. An array +would work for most cases, but makes inheritance a bit dodgy because +you have to invent new indices for the derived classes. + +=head2 Arrays as Objects + +If the user of your class honors the contract and sticks to the advertised +interface, then you can change its underlying interface if you feel +like it. Here's another implementation that conforms to the same +interface specification. This time we'll use an array reference +instead of a hash reference to represent the object. + + package Person; + use strict; + + my($NAME, $AGE, $PEERS) = ( 0 .. 2 ); + + ############################################ + ## the object constructor (array version) ## + ############################################ + sub new { + my $self = []; + $self->[$NAME] = undef; # this is unnecessary + $self->[$AGE] = undef; # as it this + $self->[$PEERS] = []; # but this isn't, really + bless($self); + return $self; + } + + sub name { + my $self = shift; + if (@_) { $self->[$NAME] = shift } + return $self->[$NAME]; + } + + sub age { + my $self = shift; + if (@_) { $self->[$AGE] = shift } + return $self->[$AGE]; + } + + sub peers { + my $self = shift; + if (@_) { @{ $self->[$PEERS] } = @_ } + return @{ $self->[$PEERS] }; + } + + 1; # so the require or use succeeds + +You might guess that the array access will be a lot faster than the +hash access, but they're actually comparable. The array is a little +bit faster, but not more than ten or fifteen percent, even when you +replace the variables above like $AGE with literal numbers, like 1. +A bigger difference between the two approaches can be found in memory use. +A hash representation takes up more memory than an array representation +because you have to allocation memory for the keys as well as the values. +However, it really isn't that bad, especially since as of 5.004, +memory is only allocated once for a given hash key, no matter how many +hashes have that key. It's expected that sometime in the future, even +these differences will fade into obscurity as more efficient underlying +representations are devised. + +Still, the tiny edge in speed (and somewhat larger one in memory) +is enough to make some programmers choose an array representation +for simple classes. There's still a little problem with +scalability, though, because later in life when you feel +like creating subclasses, you'll find that hashes just work +out better. + +=head2 Closures as Objects + +Using a code reference to represent an object offers some fascinating +possibilities. We can create a new anonymous function (closure) who +alone in all the world can see the object's data. This is because we +put the data into an anonymous hash that's lexically visible only to +the closure we create, bless, and return as the object. This object's +methods turn around and call the closure as a regular subroutine call, +passing it the field we want to affect. (Yes, +the double-function call is slow, but if you wanted fast, you wouldn't +be using objects at all, eh? :-) + +Use would be similar to before: + + use Person; + $him = Person->new(); + $him->name("Jason"); + $him->age(23); + $him->peers( [ "Norbert", "Rhys", "Phineas" ] ); + printf "%s is %d years old.\n", $him->name, $him->age; + print "His peers are: ", join(", ", @{$him->peers}), "\n"; + +but the implementation would be radically, perhaps even sublimely +different: + + package Person; + + sub new { + my $that = shift; + my $class = ref($that) || $that; + my $self = { + NAME => undef, + AGE => undef, + PEERS => [], + }; + my $closure = sub { + my $field = shift; + if (@_) { $self->{$field} = shift } + return $self->{$field}; + }; + bless($closure, $class); + return $closure; + } + + sub name { &{ $_[0] }("NAME", @_[ 1 .. $#_ ] ) } + sub age { &{ $_[0] }("AGE", @_[ 1 .. $#_ ] ) } + sub peers { &{ $_[0] }("PEERS", @_[ 1 .. $#_ ] ) } + + 1; + +Because this object is hidden behind a code reference, it's probably a bit +mysterious to those whose background is more firmly rooted in standard +procedural or object-based programming languages than in functional +programming languages whence closures derive. The object +created and returned by the new() method is itself not a data reference +as we've seen before. It's an anonymous code reference that has within +it access to a specific version (lexical binding and instantiation) +of the object's data, which are stored in the private variable $self. +Although this is the same function each time, it contains a different +version of $self. + +When a method like C<$him-E<gt>name("Jason")> is called, its implicit +zeroth argument is as the invoking object just as it is with all method +calls. But in this case, it's our code reference (something like a +function pointer in C++, but with deep binding of lexical variables). +There's not a lot to be done with a code reference beyond calling it, so +that's just what we do when we say C<&{$_[0]}>. This is just a regular +function call, not a method call. The initial argument is the string +"NAME", and any remaining arguments are whatever had been passed to the +method itself. + +Once we're executing inside the closure that had been created in new(), +the $self hash reference suddenly becomes visible. The closure grabs +its first argument ("NAME" in this case because that's what the name() +method passed it), and uses that string to subscript into the private +hash hidden in its unique version of $self. + +Nothing under the sun will allow anyone outside the executing method to +be able to get at this hidden data. Well, nearly nothing. You I<could> +single step through the program using the debugger and find out the +pieces while you're in the method, but everyone else is out of luck. + +There, if that doesn't excite the Scheme folks, then I just don't know +what will. Translation of this technique into C++, Java, or any other +braindead-static language is left as a futile exercise for aficionados +of those camps. + +You could even add a bit of nosiness via the caller() function and +make the closure refuse to operate unless called via its own package. +This would no doubt satisfy certain fastidious concerns of programming +police and related puritans. + +If you were wondering when Hubris, the third principle virtue of a +programmer, would come into play, here you have it. (More seriously, +Hubris is just the pride in craftsmanship that comes from having written +a sound bit of well-designed code.) + +=head1 AUTOLOAD: Proxy Methods + +Autoloading is a way to intercept calls to undefined methods. An autoload +routine may choose to create a new function on the fly, either loaded +from disk or perhaps just eval()ed right there. This define-on-the-fly +strategy is why it's called autoloading. + +But that's only one possible approach. Another one is to just +have the autoloaded method itself directly provide the +requested service. When used in this way, you may think +of autoloaded methods as "proxy" methods. + +When Perl tries to call an undefined function in a particular package +and that function is not defined, it looks for a function in +that same package called AUTOLOAD. If one exists, it's called +with the same arguments as the original function would have had. +The fully-qualified name of the function is stored in that package's +global variable $AUTOLOAD. Once called, the function can do anything +it would like, including defining a new function by the right name, and +then doing a really fancy kind of C<goto> right to it, erasing itself +from the call stack. + +What does this have to do with objects? After all, we keep talking about +functions, not methods. Well, since a method is just a function with +an extra argument and some fancier semantics about where it's found, +we can use autoloading for methods, too. Perl doesn't start looking +for an AUTOLOAD method until it has exhausted the recursive hunt up +through @ISA, though. Some programmers have even been known to define +a UNIVERSAL::AUTOLOAD method to trap unresolved method calls to any +kind of object. + +=head2 Autoloaded Data Methods + +You probably began to get a little suspicious about the duplicated +code way back earlier when we first showed you the Person class, and +then later the Employee class. Each method used to access the +hash fields looked virtually identical. This should have tickled +that great programming virtue, Impatience, but for the time, +we let Laziness win out, and so did nothing. Proxy methods can cure +this. + +Instead of writing a new function every time we want a new data field, +we'll use the autoload mechanism to generate (actually, mimic) methods on +the fly. To verify that we're accessing a valid member, we will check +against an C<_permitted> (pronounced "under-permitted") field, which +is a reference to a file-scoped lexical (like a C file static) hash of permitted fields in this record +called %fields. Why the underscore? For the same reason as the _CENSUS +field we once used: as a marker that means "for internal use only". + +Here's what the module initialization code and class +constructor will look like when taking this approach: + + package Person; + use Carp; + use vars qw($AUTOLOAD); # it's a package global + + my %fields = ( + name => undef, + age => undef, + peers => undef, + ); + + sub new { + my $that = shift; + my $class = ref($that) || $that; + my $self = { + _permitted => \%fields, + %fields, + }; + bless $self, $class; + return $self; + } + +If we wanted our record to have default values, we could fill those in +where current we have C<undef> in the %fields hash. + +Notice how we saved a reference to our class data on the object itself? +Remember that it's important to access class data through the object +itself instead of having any method reference %fields directly, or else +you won't have a decent inheritance. + +The real magic, though, is going to reside in our proxy method, which +will handle all calls to undefined methods for objects of class Person +(or subclasses of Person). It has to be called AUTOLOAD. Again, it's +all caps because it's called for us implicitly by Perl itself, not by +a user directly. + + sub AUTOLOAD { + my $self = shift; + my $type = ref($self) + or croak "$self is not an object"; + + my $name = $AUTOLOAD; + $name =~ s/.*://; # strip fully-qualified portion + + unless (exists $self->{_permitted}->{$name} ) { + croak "Can't access `$name' field in class $type"; + } + + if (@_) { + return $self->{$name} = shift; + } else { + return $self->{$name}; + } + } + +Pretty nifty, eh? All we have to do to add new data fields +is modify %fields. No new functions need be written. + +I could have avoided the C<_permitted> field entirely, but I +wanted to demonstrate how to store a reference to class data on the +object so you wouldn't have to access that class data +directly from an object method. + +=head2 Inherited Autoloaded Data Methods + +But what about inheritance? Can we define our Employee +class similarly? Yes, so long as we're careful enough. + +Here's how to be careful: + + package Employee; + use Person; + use strict; + use vars qw(@ISA); + @ISA = qw(Person); + + my %fields = ( + id => undef, + salary => undef, + ); + + sub new { + my $that = shift; + my $class = ref($that) || $that; + my $self = bless $that->SUPER::new(), $class; + my($element); + foreach $element (keys %fields) { + $self->{_permitted}->{$element} = $fields{$element}; + } + @{$self}{keys %fields} = values %fields; + return $self; + } + +Once we've done this, we don't even need to have an +AUTOLOAD function in the Employee package, because +we'll grab Person's version of that via inheritance, +and it will all work out just fine. + +=head1 Metaclassical Tools + +Even though proxy methods can provide a more convenient approach to making +more struct-like classes than tediously coding up data methods as +functions, it still leaves a bit to be desired. For one thing, it means +you have to handle bogus calls that you don't mean to trap via your proxy. +It also means you have to be quite careful when dealing with inheritance, +as detailed above. + +Perl programmers have responded to this by creating several different +class construction classes. These metaclasses are classes +that create other classes. A couple worth looking at are +Class::Template and Alias. These and other related metaclasses can be +found in the modules directory on CPAN. + +=head2 Class::Template + +One of the older ones is Class::Template. In fact, its syntax and +interface were sketched out long before perl5 even solidified into a +real thing. What it does is provide you a way to "declare" +a class as having objects whose fields are of a specific type. +The function that does this is called, not surprisingly +enough, struct(). + +Here's a simple example of using it: + + use Class::Template qw(struct); + use Jobbie; # user-defined; see below + + struct 'Fred' => { + one => '$', + many => '@', + profession => Jobbie, # calls Jobbie->new() + }; + + $ob = Fred->new; + $ob->one("hmmmm"); + + $ob->many(0, "here"); + $ob->many(1, "you"); + $ob->many(2, "go"); + print "Just set: ", $ob->many(2), "\n"; + + $ob->profession->salary(10_000); + +You can declare types in the struct to be basic Perl types, or +user-defined types (classes). User types will be initialized by calling +that class's new() method. + +Here's a real-world example of using struct generation. Let's say you +wanted to override Perl's idea of gethostbyname() and gethostbyaddr() so +that they would return objects that acted like C structures. We don't +care about high-falutin' OO gunk. All we want is for these objects to +act like structs in the C sense. + + use Socket; + use Net::hostent; + $h = gethostbyname("perl.com"); # object return + printf "perl.com's real name is %s, address %s\n", + $h->name, inet_ntoa($h->addr); + +Here's how to do this using the Class::Template module. +The crux is going to be this call: + + struct 'Net::hostent' => [ # note bracket + name => '$', + aliases => '@', + addrtype => '$', + 'length' => '$', + addr_list => '@', + ]; + +Which creates object methods of those names and types. +It even creates a new() method for us. + +We could also have implemented our object this way: + + struct 'Net::hostent' => { # note brace + name => '$', + aliases => '@', + addrtype => '$', + 'length' => '$', + addr_list => '@', + }; + +and then Class::Template would have used an anonymous hash as the object +type, instead of an anonymous array. The array is faster and smaller, +but the hash works out better if you eventually want to do inheritance. +Since for this struct-like object we aren't planning on inheritance, +this time we'll opt for better speed and size over better flexibility. + +Here's the whole implementation: + + package Net::hostent; + use strict; + + BEGIN { + use Exporter (); + use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); + @ISA = qw(Exporter); + @EXPORT = qw(gethostbyname gethostbyaddr gethost); + @EXPORT_OK = qw( + $h_name @h_aliases + $h_addrtype $h_length + @h_addr_list $h_addr + ); + %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); + } + use vars @EXPORT_OK; + + use Class::Template qw(struct); + struct 'Net::hostent' => [ + name => '$', + aliases => '@', + addrtype => '$', + 'length' => '$', + addr_list => '@', + ]; + + sub addr { shift->addr_list->[0] } + + sub populate (@) { + return unless @_; + my $hob = new(); # Class::Template made this! + $h_name = $hob->[0] = $_[0]; + @h_aliases = @{ $hob->[1] } = split ' ', $_[1]; + $h_addrtype = $hob->[2] = $_[2]; + $h_length = $hob->[3] = $_[3]; + $h_addr = $_[4]; + @h_addr_list = @{ $hob->[4] } = @_[ (4 .. $#_) ]; + return $hob; + } + + sub gethostbyname ($) { populate(CORE::gethostbyname(shift)) } + + sub gethostbyaddr ($;$) { + my ($addr, $addrtype); + $addr = shift; + require Socket unless @_; + $addrtype = @_ ? shift : Socket::AF_INET(); + populate(CORE::gethostbyaddr($addr, $addrtype)) + } + + sub gethost($) { + if ($_[0] =~ /^\d+(?:\.\d+(?:\.\d+(?:\.\d+)?)?)?$/) { + require Socket; + &gethostbyaddr(Socket::inet_aton(shift)); + } else { + &gethostbyname; + } + } + + 1; + +We've snuck in quite a fair bit of other concepts besides just dynamic +class creation, like overriding core functions, import/export bits, +function prototyping, and short-cut function call via C<&whatever>. +These all mostly make sense from the perspective of a traditional module, +but as you can see, we can also use them in an object module. + +You can look at other object-based, struct-like overrides of core +functions in the 5.004 release of Perl in File::stat, Net::hostent, +Net::netent, Net::protoent, Net::servent, Time::gmtime, Time::localtime, +User::grent, and User::pwent. These modules have a final component +that's all lower-case, by convention reserved for compiler pragmas, +because they affect the compilation and change a built-in function. +They also have the type names that a C programmer would most expect. + +=head2 Data Members as Variables + +If you're used to C++ objects, then you're accustomed to being able to +get at an object's data members as simple variables from within a method. +The Alias module provides for this, as well as a good bit more, such +as the possibility of private methods that the object can call but folks +outside the class cannot. + +Here's an example of creating a Person using the Alias module. +When you update these magical instance variables, you automatically +update value fields in the hash. Convenient, eh? + + package Person; + + # this is the same as before... + sub new { + my $that = shift; + my $class = ref($that) || $that; + my $self = { + NAME => undef, + AGE => undef, + PEERS => [], + }; + bless($self, $class); + return $self; + } + + use Alias qw(attr); + use vars qw($NAME $AGE $PEERS); + + sub name { + my $self = attr shift; + if (@_) { $NAME = shift; } + return $NAME; + } + + sub age { + my $self = attr shift; + if (@_) { $AGE = shift; } + return $AGE; + } + + sub peers { + my $self = attr shift; + if (@_) { @PEERS = @_; } + return @PEERS; + } + + sub exclaim { + my $self = attr shift; + return sprintf "Hi, I'm %s, age %d, working with %s", + $NAME, $AGE, join(", ", @PEERS); + } + + sub happy_birthday { + my $self = attr shift; + return ++$AGE; + } + +The need for the C<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. +These package variables are localized to the block enclosing the attr() +call just as if you'd used a local() on them. However, that means that +they're still considered global variables with temporary values, just +as with any other local(). + +It would be nice to combine Alias with +something like Class::Template or Class::MethodMaker. + +=head2 NOTES + +=head2 Object Terminology + +In the various OO literature, it seems that a lot of different words +are used to describe only a few different concepts. If you're not +already an object programmer, then you don't need to worry about all +these fancy words. But if you are, then you might like to know how to +get at the same concepts in Perl. + +For example, it's common to call an object an I<instance> of a class +and to call those objects' methods I<instance methods>. Data fields +peculiar to each object are often called I<instance data> or I<object +attributes>, and data fields common to all members of that class are +I<class data>, I<class attributes>, or I<static data members>. + +Also, I<base class>, I<generic class>, and I<superclass> all describe +the same notion, whereas I<derived class>, I<specific class>, and +I<subclass> describe the other related one. + +C++ programmers have I<static methods> and I<virtual methods>, +but Perl only has I<class methods> and I<object methods>. +Actually, Perl only has methods. Whether a method gets used +as a class or object method is by usage only. You could accidentally +call a class method (one expecting a string argument) on an +object (one expecting a reference), or vice versa. + +>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 +functions can be. + +Because a class is itself something of an object, Perl's classes can be +taken as describing both a "class as meta-object" (also called I<object +factory>) philosophy and the "class as type definition" (I<declaring> +behaviour, not I<defining> mechanism) idea. C++ supports the latter +notion, but not the former. + +=head1 SEE ALSO + +The following man pages will doubtless provide more +background for this one: +L<perlmod>, +L<perlref>, +L<perlobj>, +L<perlbot>, +L<perltie>, +and +L<overload>. + +=head1 COPYRIGHT + +I I<really> hate to have to say this, but recent unpleasant +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 +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, +permission is granted to freely distribute verbatim copies of this +document provided that no modifications outside of formatting be made, +and that this notice remain intact. You are permitted and encouraged to +use its code and derivatives thereof in your own source code for fun or +for profit as you see fit. But so help me, if in six months I find some +book out there with a hacked-up version of this material in it claiming to +be written by someone else, I'll tell all the world that you're a jerk. +Furthermore, your lawyer will meet my lawyer (or O'Reilly's) over lunch +to arrange for you to receive your just deserts. Count on it. + +=head2 Acknowledgments + +Thanks to +Larry Wall, +Roderick Schertler, +Gurusamy Sarathy, +Dean Roehrich, +Raphael Manfredi, +Brent Halsey, +Greg Bacon, +Brad Appleton, +and many others for their helpful comments. diff --git a/pod/perltrap.pod b/pod/perltrap.pod index e85f5c9007..391c98b129 100644 --- a/pod/perltrap.pod +++ b/pod/perltrap.pod @@ -101,8 +101,8 @@ basically incompatible with C.) =item * The concatenation operator is ".", not the null string. (Using the -null string would render C</pat/ /pat/> unparsable, since the third slash -would be interpreted as a division operator--the tokener is in fact +null string would render C</pat/ /pat/> unparsable, because the third slash +would be interpreted as a division operator--the tokenizer is in fact slightly context sensitive for operators like "/", "?", and "E<gt>". And in fact, "." itself can be the beginning of a number.) @@ -183,7 +183,7 @@ Comments begin with "#", not "/*". =item * You can't take the address of anything, although a similar operator -in Perl 5 is the backslash, which creates a reference. +in Perl is the backslash, which creates a reference. =item * @@ -231,18 +231,18 @@ Sharp shell programmers should take note of the following: =item * -The backtick operator does variable interpolation without regard to +The back-tick operator does variable interpolation without regard to the presence of single quotes in the command. =item * -The backtick operator does no translation of the return value, unlike B<csh>. +The back-tick 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 only in certain constructs -such as double quotes, backticks, angle brackets, and search patterns. +command line. Perl does substitution in only certain constructs +such as double quotes, back-ticks, angle brackets, and search patterns. =item * @@ -275,16 +275,16 @@ context than they do in a scalar one. See L<perldata> for details. =item * Avoid barewords if you can, especially all lower-case ones. -You can't tell just by looking at it whether a bareword is +You can't tell by just looking at it whether a bareword is a function or a string. By using quotes on strings and -parens on function calls, you won't ever get them confused. +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()) and which are list operators (like print() and unlink()). -(User-defined subroutines can B<only> be list operators, never +(User-defined subroutines can be B<only> list operators, never unary ones.) See L<perlop>. =item * @@ -296,7 +296,7 @@ you might expect to do not. =item * The E<lt>FHE<gt> construct is not the name of the filehandle, it is a readline -operation on that handle. The data read is only assigned to $_ if the +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>) { } @@ -332,7 +332,7 @@ external name is still an alias for the original. =back -=head2 Perl4 to Perl5 Traps +=head2 Perl4 to Perl5 Traps Practicing Perl4 Programmers should take note of the following Perl4-to-Perl5 specific traps. @@ -419,7 +419,7 @@ for C<$_> itself (and C<@_>, etc.). =item * Deprecation Double-colon is now a valid package separator in a variable name. Thus these -behave differently in perl4 vs. perl5, since the packages don't exist. +behave differently in perl4 vs. perl5, because the packages don't exist. $a=1;$b=2;$c=3;$var=4; print "$a::$b::$c "; @@ -652,9 +652,9 @@ Formatted output and significant digits =item * Numerical -This specific item has been deleted. It demonstrated how the autoincrement +This specific item has been deleted. It demonstrated how the auto-increment operator would not catch when a number went over the signed int limit. Fixed -in 5.003_04. But always be wary when using large ints. If in doubt: +in 5.003_04. But always be wary when using large integers. If in doubt: use Math::BigInt; @@ -795,7 +795,7 @@ The behavior is slightly different for: Variable suicide behavior is more consistent under Perl 5. Perl5 exhibits the same behavior for associative arrays and scalars, -that perl4 exhibits only for scalars. +that perl4 exhibits for only scalars. $aGlobal{ "aKey" } = "global value"; print "MAIN:", $aGlobal{"aKey"}, "\n"; @@ -953,8 +953,8 @@ now works as a C programmer would expect. open FOO || die; -is now incorrect. You need parens around the filehandle. -Otherwise, perl5 leaves the statement as it's default precedence: +is now incorrect. You need parentheses around the filehandle. +Otherwise, perl5 leaves the statement as its default precedence: open(FOO || die); @@ -1055,8 +1055,8 @@ Also see L<Numerical Traps> for another example of this new feature. =item * Regular Expression -C<s`lhs`rhs`> (using backticks) is now a normal substitution, with no -backtick expansion +C<s`lhs`rhs`> (using back-ticks) is now a normal substitution, with no +back-tick expansion $string = ""; $string =~ s`^`hostname`; @@ -1187,7 +1187,7 @@ on the handler _not_ being reset will have to be reworked. =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 +the right thing w.r.t. the fopen() man page. e.g., - When a file is opened for append, it is impossible to overwrite information already in the file. diff --git a/pod/perlvar.pod b/pod/perlvar.pod index b0e2cf319f..a049e9d5a1 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -7,7 +7,7 @@ perlvar - Perl predefined variables =head2 Predefined Names The following names have special meaning to Perl. Most of the -punctuational names have reasonable mnemonics, or analogues in one of +punctuation names have reasonable mnemonics, or analogues in one of the shells. Nevertheless, if you wish to use the long variable names, you just need to say @@ -51,7 +51,7 @@ a reference, you'll raise a run-time exception. The default input and pattern-searching space. The following pairs are equivalent: - while (<>) {...} # only equivalent in while! + while (<>) {...} # equivalent in only while! while ($_ = <>) {...} /^Subject:/ @@ -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 subpattern from the corresponding set of parentheses in +Contains the sub-pattern from the corresponding set of parentheses in the last pattern matched, not counting patterns matched in nested blocks that have been exited already. (Mnemonic: like \digit.) These variables are all read-only. @@ -162,15 +162,15 @@ This variable is read-only. =item $* -Set to 1 to do multiline matching within a string, 0 to tell Perl +Set to 1 to do multi-line matching within a string, 0 to tell Perl that it can assume that strings contain a single line, for the purpose of optimizing pattern matches. Pattern matches on strings containing multiple newlines can produce confusing results when "C<$*>" is 0. Default is 0. (Mnemonic: * matches multiple things.) Note that this variable -only influences the interpretation of "C<^>" and "C<$>". A literal newline can +influences the interpretation of only "C<^>" and "C<$>". A literal newline can be searched for even when C<$* == 0>. -Use of "C<$*>" is deprecated in Perl 5. +Use of "C<$*>" is deprecated in modern perls. =item input_line_number HANDLE EXPR @@ -182,7 +182,7 @@ Use of "C<$*>" is deprecated in Perl 5. The current input line number for the last file handle from which you read (or performed a C<seek> or C<tell> on). An -explicit close on a filehandle resets the line number. Since +explicit close on a filehandle resets the line number. Because "C<E<lt>E<gt>>" never does an explicit close, line numbers increase across ARGV files (but see examples under eof()). Localizing C<$.> has the effect of also localizing Perl's notion of "the last read @@ -221,8 +221,8 @@ delimit line boundaries when quoting poetry.) If set to nonzero, forces a flush 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<$|> only tells -you whether you've asked Perl to explicitly flush after each write). +the channel is actually buffered by the system or not; C<$|> tells you +only whether you've asked Perl explicitly to flush after each write). Note that STDOUT will typically be line buffered if output is to the terminal and block buffered otherwise. Setting this variable is useful primarily when you are outputting to a pipe, such as when you are running @@ -239,8 +239,8 @@ has no effect on input buffering. =item $, The output field separator for the print operator. Ordinarily the -print operator simply prints out the comma separated fields you -specify. In order to get behavior more like B<awk>, set this variable +print operator simply prints out the comma-separated fields you +specify. To get behavior more like B<awk>, set this variable as you would set B<awk>'s OFS variable to specify what is printed between fields. (Mnemonic: what is printed when there is a , in your print statement.) @@ -254,9 +254,9 @@ print statement.) =item $\ The output record separator for the print operator. Ordinarily the -print operator simply prints out the comma separated fields you -specify, with no trailing newline or record separator assumed. In -order to get behavior more like B<awk>, set this variable as you would +print operator simply prints out the comma-separated fields you +specify, with no trailing newline or record separator assumed. +To get behavior more like B<awk>, set this variable as you would set B<awk>'s ORS variable to specify what is printed at the end of the print. (Mnemonic: you set "C<$\>" instead of adding \n at the end of the print. Also, it's just like C<$/>, but it's what you get "back" from @@ -299,7 +299,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 in Perl 5. +Consider using "real" multi-dimensional arrays. =item $OFMT @@ -313,7 +313,7 @@ of the macro DBL_DIG from your system's F<float.h>. This is different from B<awk>'s default OFMT setting of %.6g, so you need to set "C<$#>" explicitly to get B<awk>'s value. (Mnemonic: # is the number sign.) -Use of "C<$#>" is deprecated in Perl 5. +Use of "C<$#>" is deprecated. =item format_page_number HANDLE EXPR @@ -379,7 +379,7 @@ poetry is a part of a line.) =item $^L -What formats output to perform a formfeed. Default is \f. +What formats output to perform a form feed. Default is \f. =item $ACCUMULATOR @@ -396,7 +396,7 @@ L<perlfunc/formline()>. =item $? -The status returned by the last pipe close, backtick (C<``>) command, +The status returned by the last pipe close, back-tick (C<``>) command, or system() operator. Note that this is the status word returned by the wait() system call, so the exit value of the subprocess is actually (C<$? E<gt>E<gt> 8>). Thus on many systems, C<$? & 255> gives which signal, @@ -418,7 +418,7 @@ all the usual caveats. (This means that you shouldn't depend on the value of "C<$!>" to be anything in particular unless you've gotten a specific error return indicating a system error.) If used in a string context, yields the corresponding system error string. You can assign -to "C<$!>" in order to set I<errno> if, for instance, you want "C<$!>" to return the +to "C<$!>" to set I<errno> if, for instance, you want "C<$!>" to return the string for error I<n>, or you want to set the exit value for the die() operator. (Mnemonic: What just went bang?) @@ -429,7 +429,7 @@ operator. (Mnemonic: What just went bang?) More specific information about the last system error than that provided by C<$!>, if available. (If not, it's just C<$!> again, except under OS/2.) -At the moment, this differs from C<$!> only under VMS and OS/2, where it +At the moment, this differs from C<$!> under only VMS and OS/2, where it provides the VMS status value from the last system error, and OS/2 error code of the last call to OS/2 API which was not directed via CRT. The caveats mentioned in the description of C<$!> apply here, too. @@ -481,7 +481,7 @@ The effective uid of this process. Example: ($<,$>) = ($>,$<); # swap real and effective uid (Mnemonic: it's the uid you went I<TO>, if you're running setuid.) Note: -"C<$E<lt>>" and "C<$E<gt>>" can only be swapped on machines supporting setreuid(). +"C<$E<lt>>" and "C<$E<gt>>" can be swapped on only machines supporting setreuid(). =item $REAL_GROUP_ID @@ -510,10 +510,11 @@ which may be the same as the first number. (Mnemonic: parentheses are used to I<GROUP> things. The effective gid is the group that's I<RIGHT> for you, if you're running setgid.) -Note: "C<$E<lt>>", "C<$E<gt>>", "C<$(>" and "C<$)>" can only be set on machines -that support the corresponding I<set[re][ug]id()> routine. "C<$(>" and "C<$)>" -can only be swapped on machines supporting setregid(). Because Perl doesn't -currently use initgroups(), you can't set your group vector to multiple groups. +Note: "C<$E<lt>>", "C<$E<gt>>", "C<$(>" and "C<$)>" can be set only on +machines that support the corresponding I<set[re][ug]id()> routine. "C<$(>" +and "C<$)>" can be swapped on only machines supporting setregid(). Because +Perl doesn't currently use initgroups(), you can't set your group vector to +multiple groups. =item $PROGRAM_NAME @@ -612,7 +613,7 @@ it. =item $^T The time at which the script began running, in seconds since the -epoch (beginning of 1970). The values returned by the B<-M>, B<-A> +epoch (beginning of 1970). The values returned by the B<-M>, B<-A>, and B<-C> filetests are based on this value. @@ -637,7 +638,7 @@ contains the name of the current file when reading from E<lt>E<gt>. The array @ARGV contains the command line arguments intended for the script. Note that C<$#ARGV> is the generally number of arguments minus -one, since C<$ARGV[0]> is the first argument, I<NOT> the command name. See +one, because C<$ARGV[0]> is the first argument, I<NOT> the command name. See "C<$0>" for the command name. =item @INC @@ -647,8 +648,8 @@ be evaluated by the C<do EXPR>, C<require>, or C<use> constructs. It initially consists of the arguments to any B<-I> command line switches, followed by the default Perl library, probably F</usr/local/lib/perl>, followed by ".", to represent the current directory. If you need to -modify this at runtime, you should use the C<use lib> pragma in order -to also get the machine-dependent library properly loaded: +modify this at runtime, you should use the C<use lib> pragma +to get the machine-dependent library properly loaded also: use lib '/mypath/libdir/'; use SomeMod; @@ -684,7 +685,7 @@ signals. Example: $SIG{'INT'} = 'DEFAULT'; # restore default action $SIG{'QUIT'} = 'IGNORE'; # ignore SIGQUIT -The %SIG array only contains values for the signals actually set within +The %SIG array contains values for only the signals actually set within the Perl script. Here are some other examples: $SIG{PIPE} = Plumber; # SCARY!! diff --git a/pod/perlxs.pod b/pod/perlxs.pod index 6a898a5331..cc83c8b843 100644 --- a/pod/perlxs.pod +++ b/pod/perlxs.pod @@ -560,7 +560,7 @@ the following statement. =head2 Returning Undef And Empty Lists -Occasionally the programmer will want to simply return +Occasionally the programmer will want to return simply C<undef> or an empty list if a function fails rather than a separate status value. The rpcb_gettime() function offers just this situation. If the function succeeds we would like @@ -631,7 +631,7 @@ other C<XSRETURN> macros. The REQUIRE: keyword is used to indicate the minimum version of the B<xsubpp> compiler needed to compile the XS module. An XS module which -contains the following statement will only compile with B<xsubpp> version +contains the following statement will compile with only B<xsubpp> version 1.922 or greater: REQUIRE: 1.922 @@ -664,7 +664,7 @@ terminate the code block. =head2 The VERSIONCHECK: Keyword The VERSIONCHECK: keyword corresponds to B<xsubpp>'s C<-versioncheck> and -C<-noversioncheck> options. This keyword overrides the commandline +C<-noversioncheck> options. This keyword overrides the command line options. Version checking is enabled by default. When version checking is enabled the XS module will attempt to verify that its version matches the version of the PM module. @@ -680,7 +680,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 commandline 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. @@ -844,7 +844,7 @@ C<&> through, so the function call looks like C<rpcb_gettime(host, &timep)>. =head2 Inserting Comments and C Preprocessor Directives C preprocessor directives are allowed within BOOT:, PREINIT: INIT:, -CODE:, PPCODE: and CLEANUP: blocks, as well as outside the functions. +CODE:, PPCODE:, and CLEANUP: blocks, as well as outside the functions. Comments are allowed anywhere after the MODULE keyword. The compiler will pass the preprocessor directives through untouched and will remove the commented lines. diff --git a/pod/perlxstut.pod b/pod/perlxstut.pod index 0c6cf3fb22..501a34845e 100644 --- a/pod/perlxstut.pod +++ b/pod/perlxstut.pod @@ -10,8 +10,8 @@ L<perlxs>. This tutorial starts with very simple examples and becomes more complex, with each new example adding new features. Certain concepts may not be -completely explained until later in the tutorial in order to slowly ease -the reader into building extensions. +completely explained until later in the tutorial to ease the +reader slowly into building extensions. =head2 VERSION CAVEAT @@ -63,7 +63,7 @@ Some systems may have installed Perl version 5 as "perl5". =head2 DYNAMIC VERSUS STATIC It is commonly thought that if a system does not have the capability to -dynamically load a library, you cannot build XSUBs. This is incorrect. +load a library dynamically, you cannot build XSUBs. This is incorrect. You I<can> build them, but you must link the XSUB's subroutines with the rest of Perl, creating a new executable. This situation is similar to Perl 4. @@ -227,7 +227,7 @@ Now re-run 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. -In order to test that our extension works, we now need to look at the +To test that our extension works, we now need to look at the file test.pl. This file is set up to imitate the same kind of testing structure that Perl itself has. Within the test script, you perform a number of tests to confirm the behavior of the extension, printing "ok" @@ -446,7 +446,7 @@ section on the argument stack. =head2 WARNING In general, it's not a good idea to write extensions that modify their input -parameters, as in Example 3. However, in order to better accommodate calling +parameters, as in Example 3. However, to accommodate better calling pre-existing C routines, which often do modify their input parameters, this behavior is tolerated. The next example will show how to do this. @@ -577,7 +577,7 @@ and add the following lines to the end of the script: print &Mytest2::foo(1, 2, "0.0") == 7 ? "ok 3\n" : "not ok 3\n"; print abs(&Mytest2::foo(0, 0, "-3.4") - 0.6) <= 0.01 ? "ok 4\n" : "not ok 4\n"; -(When dealing with floating-point comparisons, it is often useful to not check +(When dealing with floating-point comparisons, it is often useful not to check for equality, but rather the difference being below a certain epsilon factor, 0.01 in this case) @@ -607,7 +607,7 @@ C<constant> routine. The .pm file has exported the name TESTVAL in the @EXPORT array. This could lead to name clashes. A good rule of thumb is that if the #define -is only going to be used by the C routines themselves, and not by the user, +is going to be used by only the C routines themselves, and not by the user, they should be removed from the @EXPORT array. Alternately, if you don't mind using the "fully qualified name" of a variable, you could remove most or all of the items in the @EXPORT array. @@ -620,12 +620,12 @@ processed at all by h2xs. There is no good solution to this right now. =back We've also told Perl about the library that we built in the mylib -subdirectory. That required only the addition of the MYEXTLIB variable +subdirectory. That required the addition of only the MYEXTLIB variable to the WriteMakefile call and the replacement of the postamble subroutine to cd into the subdirectory and run make. The Makefile.PL for the library is a bit more complicated, but not excessively so. Again we replaced the postamble subroutine to insert our own code. This code -simply specified that the library to be created here was a static +specified simply that the library to be created here was a static archive (as opposed to a dynamically loadable library) and provided the commands to build it. @@ -696,7 +696,7 @@ Sometimes you might want to provide some extra methods or subroutines to assist in making the interface between Perl and your extension simpler or easier to understand. These routines should live in the .pm file. Whether they are automatically loaded when the extension itself is loaded -or only loaded when called depends on where in the .pm file the subroutine +or loaded only when called depends on where in the .pm file the subroutine definition is placed. =head2 DOCUMENTING YOUR EXTENSION diff --git a/pod/pod2html.PL b/pod/pod2html.PL index ced84783e5..b41e0c37d6 100644 --- a/pod/pod2html.PL +++ b/pod/pod2html.PL @@ -25,14 +25,15 @@ print "Extracting $file (with variable substitutions)\n"; # You can use $Config{...} to use Configure variables. print OUT <<"!GROK!THIS!"; -$Config{'startperl'} +$Config{startperl} + eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' + if \$running_under_some_shell; !GROK!THIS! # In the following, perl variables are not expanded during extraction. print OUT <<'!NO!SUBS!'; -eval 'exec perl -S $0 ${1+"$@"}' - if $running_under_some_shell; + # # pod2html - convert pod format to html # Version 1.15 diff --git a/pod/pod2latex.PL b/pod/pod2latex.PL index 602364e2ec..ebace22aef 100644 --- a/pod/pod2latex.PL +++ b/pod/pod2latex.PL @@ -25,9 +25,9 @@ print "Extracting $file (with variable substitutions)\n"; # You can use $Config{...} to use Configure variables. print OUT <<"!GROK!THIS!"; -$Config{'startperl'} - eval 'exec perl -S \$0 "\$@"' - if 0; +$Config{startperl} + eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' + if \$running_under_some_shell; !GROK!THIS! # In the following, perl variables are not expanded during extraction. diff --git a/pod/pod2man.PL b/pod/pod2man.PL index 0a51fc8efd..68121e482c 100644 --- a/pod/pod2man.PL +++ b/pod/pod2man.PL @@ -25,14 +25,14 @@ print "Extracting $file (with variable substitutions)\n"; # You can use $Config{...} to use Configure variables. print OUT <<"!GROK!THIS!"; -$Config{'startperl'} +$Config{startperl} + eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' + if \$running_under_some_shell; !GROK!THIS! # In the following, perl variables are not expanded during extraction. print OUT <<'!NO!SUBS!'; -eval 'exec perl -S $0 "$@"' - if 0; =head1 NAME diff --git a/pod/pod2text.PL b/pod/pod2text.PL index 49198078c0..033a0d8f55 100644 --- a/pod/pod2text.PL +++ b/pod/pod2text.PL @@ -25,9 +25,9 @@ print "Extracting $file (with variable substitutions)\n"; # You can use $Config{...} to use Configure variables. print OUT <<"!GROK!THIS!"; -$Config{'startperl'} - eval 'exec perl -S \$0 "\$@"' - if 0; +$Config{startperl} + eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' + if \$running_under_some_shell; !GROK!THIS! # In the following, perl variables are not expanded during extraction. @@ -142,28 +142,8 @@ PP(pp_rv2gv) sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV); } } - if (op->op_private & OPpLVAL_INTRO) { - GP *ogp = GvGP(sv); - - SSCHECK(3); - SSPUSHPTR(SvREFCNT_inc(sv)); - SSPUSHPTR(ogp); - SSPUSHINT(SAVEt_GP); - - if (op->op_flags & OPf_SPECIAL) { - GvGP(sv)->gp_refcnt++; /* will soon be assigned */ - GvINTRO_on(sv); - } - else { - GP *gp; - Newz(602,gp, 1, GP); - GvGP(sv) = gp; - GvREFCNT(sv) = 1; - GvSV(sv) = NEWSV(72,0); - GvLINE(sv) = curcop->cop_line; - GvEGV(sv) = (GV*)sv; - } - } + if (op->op_private & OPpLVAL_INTRO) + save_gp((GV*)sv, !(op->op_flags & OPf_SPECIAL)); SETs(sv); RETURN; } @@ -208,7 +188,7 @@ PP(pp_rv2sv) if (op->op_flags & OPf_MOD) { if (op->op_private & OPpLVAL_INTRO) sv = save_scalar((GV*)TOPs); - else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV)) + else if (op->op_private & OPpDEREF) provide_ref(op, sv); } SETs(sv); @@ -234,7 +214,12 @@ PP(pp_pos) dSP; dTARGET; dPOPss; if (op->op_flags & OPf_MOD) { - LvTYPE(TARG) = '<'; + if (SvTYPE(TARG) < SVt_PVLV) { + sv_upgrade(TARG, SVt_PVLV); + sv_magic(TARG, Nullsv, '.', Nullch, 0); + } + + LvTYPE(TARG) = '.'; LvTARG(TARG) = sv; PUSHs(TARG); /* no SvSETMAGIC */ RETURN; @@ -279,10 +264,8 @@ PP(pp_prototype) ret = &sv_undef; cv = sv_2cv(TOPs, &stash, &gv, FALSE); - if (cv && SvPOK(cv)) { - char *p = SvPVX(cv); - ret = sv_2mortal(newSVpv(p ? p : "", SvLEN(cv))); - } + if (cv && SvPOK(cv)) + ret = sv_2mortal(newSVpv(SvPVX(cv), SvCUR(cv))); SETs(ret); RETURN; } @@ -290,12 +273,10 @@ PP(pp_prototype) PP(pp_anoncode) { dSP; - CV* cv = (CV*)cSVOP->op_sv; - EXTEND(SP,1); - + CV* cv = (CV*)curpad[op->op_targ]; if (CvCLONE(cv)) cv = (CV*)sv_2mortal((SV*)cv_clone(cv)); - + EXTEND(SP,1); PUSHs((SV*)cv); RETURN; } @@ -1328,7 +1309,7 @@ PP(pp_srand) _ckvmssts(sys$gettim(when)); anum = when[0] ^ when[1]; #else -# if defined(I_SYS_TIME) && !defined(PLAN9) +# ifdef HAS_GETTIMEOFDAY struct timeval when; gettimeofday(&when,(struct timezone *) 0); anum = when.tv_sec ^ when.tv_usec; @@ -1516,12 +1497,13 @@ PP(pp_substr) else sv_setpvn(sv,"",0); /* avoid lexical reincarnation */ } + if (SvTYPE(TARG) < SVt_PVLV) { sv_upgrade(TARG, SVt_PVLV); sv_magic(TARG, Nullsv, 'x', Nullch, 0); } - LvTYPE(TARG) = 's'; + LvTYPE(TARG) = 'x'; LvTARG(TARG) = sv; LvTARGOFF(TARG) = pos; LvTARGLEN(TARG) = rem; @@ -1974,17 +1956,35 @@ PP(pp_delete) { dSP; SV *sv; - SV *tmpsv = POPs; - HV *hv = (HV*)POPs; - STRLEN len; - if (SvTYPE(hv) != SVt_PVHV) { - DIE("Not a HASH reference"); + HV *hv; + + if (op->op_private & OPpSLICE) { + dMARK; dORIGMARK; + hv = (HV*)POPs; + 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); + *MARK = sv ? sv : &sv_undef; + } + if (GIMME != G_ARRAY) { + MARK = ORIGMARK; + *++MARK = *SP; + SP = MARK; + } + } + else { + SV *keysv = POPs; + 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); + if (!sv) + sv = &sv_undef; + PUSHs(sv); } - sv = hv_delete_ent(hv, tmpsv, - (op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0), 0); - if (!sv) - RETPUSHUNDEF; - PUSHs(sv); RETURN; } @@ -2116,7 +2116,6 @@ PP(pp_anonlist) PP(pp_anonhash) { dSP; dMARK; dORIGMARK; - STRLEN len; HV* hv = (HV*)sv_2mortal((SV*)newHV()); while (MARK < SP) { @@ -3567,6 +3566,7 @@ PP(pp_pack) *--in = div128(norm, &done) | 0x80; result[len - 1] &= 0x7F; /* clear continue bit */ sv_catpvn(cat, in, (result + len) - in); + Safefree(result); SvREFCNT_dec(norm); /* free norm */ } else if (SvNOKp(fromstr)) { @@ -859,7 +859,7 @@ I32 startingblock; switch (cx->cx_type) { case CXt_SUBST: if (dowarn) - warn("Exiting substitition via %s", op_name[op->op_type]); + warn("Exiting substitution via %s", op_name[op->op_type]); break; case CXt_SUB: if (dowarn) @@ -1636,8 +1636,10 @@ PP(pp_goto) for ( ;ix > 0; ix--) { if (svp[ix] != &sv_undef) { char *name = SvPVX(svp[ix]); - if (SvFLAGS(svp[ix]) & SVf_FAKE) { - /* outer lexical? */ + if ((SvFLAGS(svp[ix]) & SVf_FAKE) + || *name == '&') + { + /* outer lexical or anon code */ av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]) ); } @@ -2362,13 +2364,12 @@ SV *sv; skipspaces++; arg -= skipspaces; if (arg) { - if (postspace) { + if (postspace) *fpc++ = FF_SPACE; - postspace = FALSE; - } *fpc++ = FF_LITERAL; *fpc++ = arg; } + postspace = FALSE; if (s <= send) skipspaces--; if (skipspaces) { @@ -217,7 +217,7 @@ PP(pp_padsv) if (op->op_flags & OPf_MOD) { if (op->op_private & OPpLVAL_INTRO) SAVECLEARSV(curpad[op->op_targ]); - else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV)) + else if (op->op_private & OPpDEREF) provide_ref(op, curpad[op->op_targ]); } RETURN; @@ -725,6 +725,8 @@ PP(pp_aassign) SP = lastrelem; else SP = firstrelem + (lastlelem - firstlelem); + while (relem <= SP) + *relem++ = &sv_undef; RETURN; } else { @@ -786,7 +788,7 @@ PP(pp_match) } if (!rx->nparens && !global) gimme = G_SCALAR; /* accidental array context? */ - safebase = (gimme == G_ARRAY) || global; + safebase = (((gimme == G_ARRAY) || global) && !sawampersand); if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) { SAVEINT(multiline); multiline = pm->op_pmflags & PMf_MULTILINE; @@ -795,7 +797,7 @@ PP(pp_match) play_it_again: if (global && rx->startp[0]) { t = s = rx->endp[0]; - if (s > strend) + if (s >= strend) goto nope; minmatch = (s == rx->startp[0]); } @@ -868,6 +870,7 @@ play_it_again: } if (global) { truebase = rx->subbeg; + strend = rx->subend; if (rx->startp[0] && rx->startp[0] == rx->endp[0]) ++rx->endp[0]; goto play_it_again; @@ -885,7 +888,7 @@ play_it_again: mg = mg_find(TARG, 'g'); } if (rx->startp[0]) { - mg->mg_len = rx->endp[0] - truebase; + mg->mg_len = rx->endp[0] - rx->subbeg; if (rx->startp[0] == rx->endp[0]) mg->mg_flags |= MGf_MINMATCH; else @@ -903,6 +906,8 @@ yup: curpm = pm; if (pm->op_pmflags & PMf_ONCE) pm->op_pmflags |= PMf_USED; + Safefree(rx->subbase); + rx->subbase = Nullch; if (global) { rx->subbeg = truebase; rx->subend = strend; @@ -913,8 +918,6 @@ yup: if (sawampersand) { char *tmps; - if (rx->subbase) - Safefree(rx->subbase); tmps = rx->subbase = savepvn(t, strend-t); rx->subbeg = tmps; rx->subend = tmps + (strend-t); @@ -1234,9 +1237,13 @@ PP(pp_helem) if (lval) { if (!he || HeVAL(he) == &sv_undef) DIE(no_helem, SvPV(keysv, na)); - if (op->op_private & OPpLVAL_INTRO) - save_svref(&HeVAL(he)); - else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV)) + if (op->op_private & OPpLVAL_INTRO) { + if (HvNAME(hv) && isGV(HeVAL(he))) + save_gp((GV*)HeVAL(he), !(op->op_flags & OPf_SPECIAL)); + else + save_svref(&HeVAL(he)); + } + else if (op->op_private & OPpDEREF) provide_ref(op, HeVAL(he)); } PUSHs(he ? HeVAL(he) : &sv_undef); @@ -1300,7 +1307,7 @@ PP(pp_iter) { dSP; register CONTEXT *cx; - SV *sv; + SV* sv; AV* av; EXTEND(sp, 1); @@ -1314,13 +1321,26 @@ PP(pp_iter) if (cx->blk_loop.iterix >= AvFILL(av)) RETPUSHNO; - if (sv = AvARRAY(av)[++cx->blk_loop.iterix]) { + if (sv = AvARRAY(av)[++cx->blk_loop.iterix]) SvTEMP_off(sv); - *cx->blk_loop.itervar = sv; - } else - *cx->blk_loop.itervar = &sv_undef; - + sv = &sv_undef; + if (av != curstack && SvIMMORTAL(sv)) { + SV *lv = cx->blk_loop.iterlval; + if (lv) + SvREFCNT_dec(LvTARG(lv)); + else { + lv = cx->blk_loop.iterlval = newSVsv(sv); + sv_upgrade(lv, SVt_PVLV); + sv_magic(lv, Nullsv, 'y', Nullch, 0); + LvTYPE(lv) = 'y'; + } + LvTARG(lv) = SvREFCNT_inc(av); + LvTARGOFF(lv) = cx->blk_loop.iterix; + LvTARGLEN(lv) = 1; + sv = (SV*)lv; + } + *cx->blk_loop.itervar = sv; RETPUSHYES; } @@ -1370,7 +1390,7 @@ PP(pp_subst) pm = curpm; rx = pm->op_pmregexp; } - safebase = ((!rx || !rx->nparens) && !sawampersand); + safebase = (!rx->nparens && !sawampersand); if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) { SAVEINT(multiline); multiline = pm->op_pmflags & PMf_MULTILINE; @@ -1518,7 +1538,7 @@ PP(pp_subst) else c = Nullch; if (pregexec(rx, s, strend, orig, 0, - SvSCREAM(TARG) ? TARG : Nullsv, safebase)) { + SvSCREAM(TARG) ? TARG : Nullsv, safebase)) { long_way: if (force_on_match) { force_on_match = 0; @@ -1550,8 +1570,7 @@ PP(pp_subst) sv_catpvn(dstr, c, clen); if (once) break; - } while (pregexec(rx, s, strend, orig, s == m, Nullsv, - safebase)); + } while (pregexec(rx, s, strend, orig, s == m, Nullsv, safebase)); sv_catpvn(dstr, s, strend - s); (void)SvOOK_off(TARG); @@ -1831,7 +1850,8 @@ PP(pp_entersub) if (CvDEPTH(cv) < 2) (void)SvREFCNT_inc(cv); else { /* save temporaries on recursion? */ - if (CvDEPTH(cv) == 100 && dowarn) + if (CvDEPTH(cv) == 100 && dowarn + && !(perldb && cv == GvCV(DBsub))) warn("Deep recursion on subroutine \"%s\"",GvENAME(CvGV(cv))); if (CvDEPTH(cv) > AvFILL(padlist)) { AV *av; @@ -1842,9 +1862,10 @@ PP(pp_entersub) for ( ;ix > 0; ix--) { if (svp[ix] != &sv_undef) { char *name = SvPVX(svp[ix]); - if (SvFLAGS(svp[ix]) & SVf_FAKE) { /* outer lexical? */ - av_store(newpad, ix, - SvREFCNT_inc(oldpad[ix]) ); + if ((SvFLAGS(svp[ix]) & SVf_FAKE) /* outer lexical? */ + || *name == '&') /* anonymous code? */ + { + av_store(newpad, ix, SvREFCNT_inc(oldpad[ix])); } else { /* our own lexical */ if (*name == '@') @@ -1929,7 +1950,7 @@ PP(pp_aelem) DIE(no_aelem, elem); if (op->op_private & OPpLVAL_INTRO) save_svref(svp); - else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV)) + else if (op->op_private & OPpDEREF) provide_ref(op, *svp); } PUSHs(svp ? *svp : &sv_undef); @@ -1946,9 +1967,25 @@ SV* sv; if (!SvOK(sv)) { if (SvREADONLY(sv)) croak(no_modify); - (void)SvUPGRADE(sv, SVt_RV); - SvRV(sv) = (op->op_private & OPpDEREF_HV ? - (SV*)newHV() : (SV*)newAV()); + if (SvTYPE(sv) < SVt_RV) + sv_upgrade(sv, SVt_RV); + else if (SvTYPE(sv) >= SVt_PV) { + (void)SvOOK_off(sv); + Safefree(SvPVX(sv)); + SvLEN(sv) = SvCUR(sv) = 0; + } + switch (op->op_private & OPpDEREF) + { + case OPpDEREF_SV: + SvRV(sv) = newSV(0); + break; + case OPpDEREF_AV: + SvRV(sv) = (SV*)newAV(); + break; + case OPpDEREF_HV: + SvRV(sv) = (SV*)newHV(); + break; + } SvROK_on(sv); SvSETMAGIC(sv); } @@ -284,11 +284,13 @@ PP(pp_open) if (MAXARG > 1) sv = POPs; - else if (SvTYPE(TOPs) == SVt_PVGV) - sv = GvSV(TOPs); - else + if (!isGV(TOPs)) DIE(no_usym, "filehandle"); + if (MAXARG <= 1) + sv = GvSV(TOPs); gv = (GV*)POPs; + if (!isGV(gv)) + DIE(no_usym, "filehandle"); if (GvIOp(gv)) IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT; tmps = SvPV(sv, len); @@ -2271,11 +2273,21 @@ PP(pp_fttext) STDCHAR tbuf[512]; register STDCHAR *s; register IO *io; - SV *sv; + register SV *sv; + GV *gv; - if (op->op_flags & OPf_REF) { + if (op->op_flags & OPf_REF) + gv = cGVOP->op_gv; + else if (isGV(TOPs)) + gv = (GV*)POPs; + else if (SvROK(TOPs) && isGV(SvRV(TOPs))) + gv = (GV*)SvRV(POPs); + else + gv = Nullgv; + + if (gv) { EXTEND(SP, 1); - if (cGVOP->op_gv == defgv) { + if (gv == defgv) { if (statgv) io = GvIO(statgv); else { @@ -2284,13 +2296,17 @@ PP(pp_fttext) } } else { - statgv = cGVOP->op_gv; + statgv = gv; + laststatval = -1; sv_setpv(statname, ""); io = GvIO(statgv); } if (io && IoIFP(io)) { - if (PerlIO_has_base(IoIFP(io))) { - Fstat(PerlIO_fileno(IoIFP(io)), &statcache); + if (! PerlIO_has_base(IoIFP(io))) + DIE("-T and -B not implemented on filehandles"); + laststatval = Fstat(PerlIO_fileno(IoIFP(io)), &statcache); + if (laststatval < 0) + RETPUSHUNDEF; if (S_ISDIR(statcache.st_mode)) /* handle NFS glitch */ if (op->op_type == OP_FTTEXT) RETPUSHNO; @@ -2308,10 +2324,6 @@ PP(pp_fttext) /* sfio can have large buffers - limit to 512 */ if (len > 512) len = 512; - } - else { - DIE("-T and -B not implemented on filehandles"); - } } else { if (dowarn) @@ -2323,9 +2335,10 @@ PP(pp_fttext) } else { sv = POPs; + really_filename: statgv = Nullgv; + laststatval = -1; sv_setpv(statname, SvPV(sv, na)); - really_filename: #ifdef HAS_OPEN3 i = open(SvPV(sv, na), O_RDONLY, 0); #else @@ -2336,7 +2349,9 @@ PP(pp_fttext) warn(warn_nl, "open"); RETPUSHUNDEF; } - Fstat(i, &statcache); + laststatval = Fstat(i, &statcache); + if (laststatval < 0) + RETPUSHUNDEF; len = read(i, tbuf, 512); (void)close(i); if (len <= 0) { @@ -178,7 +178,8 @@ I32 looks_like_number _((SV* sv)); int magic_clearenv _((SV* sv, MAGIC* mg)); int magic_clearpack _((SV* sv, MAGIC* mg)); int magic_clearsig _((SV* sv, MAGIC* mg)); -int magic_existspack _((SV* sv, MAGIC* mg)); +int magic_existspack _((SV* sv, MAGIC* mg)); +int magic_freevivary _((SV* sv, MAGIC* mg)); int magic_get _((SV* sv, MAGIC* mg)); int magic_getarylen _((SV* sv, MAGIC* mg)); int magic_getpack _((SV* sv, MAGIC* mg)); @@ -210,11 +211,14 @@ int magic_setsubstr _((SV* sv, MAGIC* mg)); int magic_settaint _((SV* sv, MAGIC* mg)); int magic_setuvar _((SV* sv, MAGIC* mg)); int magic_setvec _((SV* sv, MAGIC* mg)); +int magic_setvivary _((SV* sv, MAGIC* mg)); int magic_wipepack _((SV* sv, MAGIC* mg)); void magicname _((char* sym, char* name, I32 namlen)); int main _((int argc, char** argv, char** env)); void markstack_grow _((void)); +#ifdef USE_LOCALE_COLLATE char* mem_collxfrm _((const char *s, STRLEN len, STRLEN *xlen)); +#endif char* mess _((char* pat, va_list* args)); int mg_clear _((SV* sv)); int mg_copy _((SV *, SV *, char *, I32)); @@ -227,13 +231,15 @@ int mg_set _((SV* sv)); OP* mod _((OP* op, I32 type)); char* moreswitches _((char* s)); OP * my _(( OP *)); +#if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY) char* my_bcopy _((char* from, char* to, I32 len)); +#endif #if !defined(HAS_BZERO) && !defined(HAS_MEMSET) char* my_bzero _((char* loc, I32 len)); #endif void my_exit _((U32 status)) __attribute__((noreturn)); I32 my_lstat _((void)); -#ifndef HAS_MEMCMP +#if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP) I32 my_memcmp _((char* s1, char* s2, I32 len)); #endif I32 my_pclose _((PerlIO* ptr)); @@ -380,6 +386,7 @@ void save_destructor _((void (*f)(void*), void* p)); void save_freesv _((SV* sv)); void save_freeop _((OP* op)); void save_freepv _((char* pv)); +void save_gp _((GV* gv, I32 empty)); HV* save_hash _((GV* gv)); void save_hptr _((HV** hptr)); void save_I16 _((I16* intp)); @@ -431,7 +438,9 @@ void sv_clean_objs _((void)); void sv_clear _((SV* sv)); I32 sv_cmp _((SV* sv1, SV* sv2)); I32 sv_cmp_locale _((SV* sv1, SV* sv2)); +#ifdef USE_LOCALE_COLLATE char* sv_collxfrm _((SV* sv, STRLEN* nxp)); +#endif void sv_dec _((SV* sv)); void sv_dump _((SV* sv)); bool sv_derived_from _((SV* sv, char* name)); @@ -524,24 +524,16 @@ got_it: prog->subbeg = strbeg; prog->subend = strend; prog->exec_tainted = regtainted; - if (!safebase && (prog->nparens || sawampersand)) { + + /* make sure $`, $&, $', and $digit will work later */ + if (!safebase && (strbeg != prog->subbase)) { I32 i = strend - startpos + (stringarg - strbeg); - if (safebase) { /* no need for $digit later */ - s = strbeg; - prog->subend = s+i; - } - else if (strbeg != prog->subbase) { - s = savepvn(strbeg,i); /* so $digit will work later */ - if (prog->subbase) - Safefree(prog->subbase); - prog->subbeg = prog->subbase = s; - prog->subend = s+i; - } - else { - prog->subbeg = s = prog->subbase; - prog->subend = s+i; - } - s += (stringarg - strbeg); + s = savepvn(strbeg, i); + Safefree(prog->subbase); + prog->subbase = s; + prog->subbeg = prog->subbase; + prog->subend = prog->subbase + i; + s = prog->subbase + (stringarg - strbeg); for (i = 0; i <= prog->nparens; i++) { if (prog->endp[i]) { prog->startp[i] = s + (prog->startp[i] - startpos); @@ -727,8 +719,9 @@ char *prog; sayNO; if (regeol - locinput < ln) sayNO; - if (ln > 1 && ((OP(scan) == EXACTF) - ? ibcmp : ibcmp_locale)(s, locinput, ln) != 0) + if (ln > 1 && (OP(scan) == EXACTF + ? ibcmp(s, locinput, ln) + : ibcmp_locale(s, locinput, ln))) sayNO; locinput += ln; nextchar = UCHARAT(locinput); @@ -885,6 +878,7 @@ char *prog; * that we can try again after backing off. */ + CHECKPOINT cp; CURCUR* cc = regcc; n = cc->cur + 1; /* how many we know we matched */ reginput = locinput; @@ -923,8 +917,12 @@ char *prog; if (cc->minmod) { regcc = cc->oldcc; ln = regcc->cur; - if (regmatch(cc->next)) + cp = regcppush(cc->parenfloor); + if (regmatch(cc->next)) { + regcpblow(cp); sayYES; /* All done. */ + } + regcppop(); regcc->cur = ln; regcc = cc; @@ -935,8 +933,12 @@ char *prog; reginput = locinput; cc->cur = n; cc->lastloc = locinput; - if (regmatch(cc->scan)) + cp = regcppush(cc->parenfloor); + if (regmatch(cc->scan)) { + regcpblow(cp); sayYES; + } + regcppop(); cc->cur = n - 1; sayNO; } @@ -944,11 +946,13 @@ char *prog; /* Prefer scan over next for maximal matching. */ if (n < cc->max) { /* More greed allowed? */ - regcppush(cc->parenfloor); + cp = regcppush(cc->parenfloor); cc->cur = n; cc->lastloc = locinput; - if (regmatch(cc->scan)) + if (regmatch(cc->scan)) { + regcpblow(cp); sayYES; + } regcppop(); /* Restore some previous $<digit>s? */ reginput = locinput; } @@ -143,27 +143,30 @@ GV *gv; return sv; } -#ifdef INLINED_ELSEWHERE void -save_gp(gv) +save_gp(gv, empty) GV *gv; +I32 empty; { - register GP *gp; - GP *ogp = GvGP(gv); - SSCHECK(3); SSPUSHPTR(SvREFCNT_inc(gv)); - SSPUSHPTR(ogp); + SSPUSHPTR(GvGP(gv)); SSPUSHINT(SAVEt_GP); - Newz(602,gp, 1, GP); - GvGP(gv) = gp; - GvREFCNT(gv) = 1; - GvSV(gv) = NEWSV(72,0); - GvLINE(gv) = curcop->cop_line; - GvEGV(gv) = gv; + if (empty) { + register GP *gp; + Newz(602, gp, 1, GP); + GvGP(gv) = gp; + GvREFCNT(gv) = 1; + GvSV(gv) = NEWSV(72,0); + GvLINE(gv) = curcop->cop_line; + GvEGV(gv) = gv; + } + else { + GvGP(gv)->gp_refcnt++; + GvINTRO_on(gv); + } } -#endif SV* save_svref(sptr) @@ -375,6 +375,9 @@ sv_free_arenas() if (!SvFAKE(sva)) Safefree((void *)sva); } + + sv_arenaroot = 0; + sv_root = 0; } static XPVIV* @@ -2386,6 +2389,9 @@ I32 namlen; case 'x': mg->mg_virtual = &vtbl_substr; break; + case 'y': + mg->mg_virtual = &vtbl_vivary; + break; case '*': mg->mg_virtual = &vtbl_glob; break; @@ -2611,7 +2617,7 @@ register SV *sv; SvROK_off(ret); SvREFCNT(sv) = 0; } else { - croak("panic: dangling references in DESTROY"); + croak("DESTROY created new reference to dead object"); } } } @@ -2619,7 +2625,10 @@ register SV *sv; mg_free(sv); switch (SvTYPE(sv)) { case SVt_PVIO: - io_close((IO*)sv); + if (IoIFP(sv) != PerlIO_stdin() && + IoIFP(sv) != PerlIO_stdout() && + IoIFP(sv) != PerlIO_stderr()) + io_close((IO*)sv); Safefree(IoTOP_NAME(sv)); Safefree(IoFMT_NAME(sv)); Safefree(IoBOTTOM_NAME(sv)); @@ -3406,6 +3415,19 @@ SV *ref; return sv; } +#ifdef CRIPPLED_CC +SV * +newRV_noinc(ref) +SV *ref; +{ + register SV *sv; + + sv = newRV(ref); + SvREFCNT_dec(ref); + return sv; +} +#endif /* CRIPPLED_CC */ + /* make an exact duplicate of old */ SV * @@ -80,8 +80,6 @@ struct io { (Sv && ++SvREFCNT(Sv)), (SV*)Sv) #define SvREFCNT_dec(sv) sv_free((SV*)sv) #endif -#define newRV_noinc(sv) ((Sv = newRV(sv)), \ - (--SvREFCNT(sv)), (SV*)Sv) #define SVTYPEMASK 0xff #define SvTYPE(sv) ((sv)->sv_flags & SVTYPEMASK) @@ -549,6 +547,13 @@ I32 SvTRUE _((SV *)); #endif /* CRIPPLED_CC */ +#define newRV_inc(sv) newRV(sv) +#ifdef CRIPPLED_CC +SV *newRV_noinc _((SV *)); +#else +#define newRV_noinc(sv) ((Sv = newRV(sv)), --SvREFCNT(SvRV(Sv)), Sv) +#endif + /* the following macro updates any magic values this sv is associated with */ #define SvSETMAGIC(x) if (SvSMAGICAL(x)) mg_set(x) diff --git a/t/lib/filehand.t b/t/lib/filehand.t index 038a73cdd7..11836f1c52 100755 --- a/t/lib/filehand.t +++ b/t/lib/filehand.t @@ -64,12 +64,19 @@ print "ok 10\n"; ($rd,$wr) = FileHandle::pipe; -if (fork) { - $wr->close; - print $rd->getline; +if ($^O eq 'VMS' || $^O eq 'os2') { + $wr->autoflush; + $wr->printf("ok %d\n",11); + print $rd->getline; } else { - $rd->close; - $wr->printf("ok %d\n",11); - exit(0); + if (fork) { + $wr->close; + print $rd->getline; + } + else { + $rd->close; + $wr->printf("ok %d\n",11); + exit(0); + } } diff --git a/t/op/delete.t b/t/op/delete.t index 010cbf1003..4e00566cd7 100755 --- a/t/op/delete.t +++ b/t/op/delete.t @@ -2,11 +2,13 @@ # $RCSfile: delete.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:44 $ -print "1..7\n"; +print "1..16\n"; $foo{1} = 'a'; $foo{2} = 'b'; $foo{3} = 'c'; +$foo{4} = 'd'; +$foo{5} = 'e'; $foo = delete $foo{2}; @@ -14,9 +16,21 @@ if ($foo eq 'b') {print "ok 1\n";} else {print "not ok 1 $foo\n";} if ($foo{2} eq '') {print "ok 2\n";} else {print "not ok 2 $foo{2}\n";} if ($foo{1} eq 'a') {print "ok 3\n";} else {print "not ok 3\n";} if ($foo{3} eq 'c') {print "ok 4\n";} else {print "not ok 4\n";} +if ($foo{4} eq 'd') {print "ok 5\n";} else {print "not ok 5\n";} +if ($foo{5} eq 'e') {print "ok 6\n";} else {print "not ok 6\n";} + +@foo = delete @foo{4, 5}; + +if (@foo == 2) {print "ok 7\n";} else {print "not ok 7 ", @foo+0, "\n";} +if ($foo[0] eq 'd') {print "ok 8\n";} else {print "not ok 8 ", $foo[0], "\n";} +if ($foo[1] eq 'e') {print "ok 9\n";} else {print "not ok 9 ", $foo[1], "\n";} +if ($foo{4} eq '') {print "ok 10\n";} else {print "not ok 10 $foo{4}\n";} +if ($foo{5} eq '') {print "ok 11\n";} else {print "not ok 11 $foo{5}\n";} +if ($foo{1} eq 'a') {print "ok 12\n";} else {print "not ok 12\n";} +if ($foo{3} eq 'c') {print "ok 13\n";} else {print "not ok 13\n";} $foo = join('',values(foo)); -if ($foo eq 'ac' || $foo eq 'ca') {print "ok 5\n";} else {print "not ok 5\n";} +if ($foo eq 'ac' || $foo eq 'ca') {print "ok 14\n";} else {print "not ok 14\n";} foreach $key (keys foo) { delete $foo{$key}; @@ -26,7 +40,7 @@ $foo{'foo'} = 'x'; $foo{'bar'} = 'y'; $foo = join('',values(foo)); -if ($foo eq 'xy' || $foo eq 'yx') {print "ok 6\n";} else {print "not ok 6\n";} +print +($foo eq 'xy' || $foo eq 'yx') ? "ok 15\n" : "not ok 15\n"; $refhash{"top"}->{"foo"} = "FOO"; $refhash{"top"}->{"bar"} = "BAR"; @@ -34,4 +48,4 @@ $refhash{"top"}->{"bar"} = "BAR"; delete $refhash{"top"}->{"bar"}; @list = keys %{$refhash{"top"}}; -print "@list" eq "foo" ? "ok 7\n" : "not ok 7 @list\n"; +print "@list" eq "foo" ? "ok 16\n" : "not ok 16 @list\n"; diff --git a/t/op/recurse.t b/t/op/recurse.t index e69de29bb2..6b21c66106 100755 --- a/t/op/recurse.t +++ b/t/op/recurse.t @@ -0,0 +1,90 @@ +#!./perl + +# +# test recursive functions. +# + +print "1..23\n"; + +sub gcd ($$) { + return gcd($_[0] - $_[1], $_[1]) if ($_[0] > $_[1]); + return gcd($_[0], $_[1] - $_[0]) if ($_[0] < $_[1]); + $_[0]; +} + +sub factorial ($) { + $_[0] < 2 ? 1 : $_[0] * factorial($_[0] - 1); +} + +sub fibonacci ($) { + $_[0] < 2 ? 1 : fibonacci($_[0] - 2) + fibonacci($_[0] - 1); +} + +# Highly recursive, highly aggressive. +# Kids, don't try this at home. +# For example ackermann(4,0) will take quite a long time. +# +# In fact, the current Perl, 5.004, will complain loudly: +# "Deep recursion on subroutine." (see perldiag) when +# computing the ackermann(4,0) because the recursion will +# become so deep (>100 levels) that Perl suspects the script +# has been lost in an infinite recursion. + +sub ackermann ($$) { + return $_[1] + 1 if ($_[0] == 0); + return ackermann($_[0] - 1, 1) if ($_[1] == 0); + ackermann($_[0] - 1, ackermann($_[0], $_[1] - 1)); +} + +# Highly recursive, highly boring. + +sub takeuchi ($$$) { + $_[1] < $_[0] ? + takeuchi(takeuchi($_[0] - 1, $_[1], $_[2]), + takeuchi($_[1] - 1, $_[2], $_[0]), + takeuchi($_[2] - 1, $_[0], $_[1])) + : $_[2]; +} + +print 'not ' unless (($d = gcd(1147, 1271)) == 31); +print "ok 1\n"; +print "# gcd(1147, 1271) = $d\n"; + +print 'not ' unless (($d = gcd(1908, 2016)) == 36); +print "ok 2\n"; +print "# gcd(1908, 2016) = $d\n"; + +print 'not ' unless (($f = factorial(10)) == 3628800); +print "ok 3\n"; +print "# factorial(10) = $f\n"; + +print 'not ' unless (($f = factorial(factorial(3))) == 720); +print "ok 4\n"; +print "# factorial(factorial(3)) = $f\n"; + +print 'not ' unless (($f = fibonacci(10)) == 89); +print "ok 5\n"; +print "# fibonacci(10) = $f\n"; + +print 'not ' unless (($f = fibonacci(fibonacci(7))) == 17711); +print "ok 6\n"; +print "# fibonacci(fibonacci(7)) = $f\n"; + +$i = 7; + +@ack = qw(1 2 3 4 2 3 4 5 3 5 7 9 5 13 29 61); + +for $x (0..3) { + for $y (0..3) { + $a = ackermann($x, $y); + print 'not ' unless ($a == shift(@ack)); + print "ok ", $i++, "\n"; + print "# ackermann($x, $y) = $a\n"; + } +} + +($x, $y, $z) = (18, 12, 6); + +print 'not ' unless (($t = takeuchi($x, $y, $z)) == $z + 1); +print "ok ", $i++, "\n"; +print "# takeuchi($x, $y, $z) = $t\n"; diff --git a/t/op/stat.t b/t/op/stat.t index 0ec31689cd..b018b6cb2c 100755 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -116,8 +116,9 @@ if (! -b '.') {print "ok 34\n";} else {print "not ok 34\n";} $cnt = $uid = 0; die "Can't run op/stat.t test 35 without pwd working" unless $cwd; -print ("not ok 35\n"), goto tty_test unless -d '/usr/bin'; -chdir '/usr/bin' || die "Can't cd to /usr/bin"; +($bin) = grep {-d} qw(/bin /usr/bin) + or print ("not ok 35\n"), goto tty_test; +chdir $bin || die "Can't cd to $bin: $!"; while (defined($_ = <*>)) { $cnt++; $uid++ if -u; @@ -111,10 +111,11 @@ MEM_SIZE size; #endif /* !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE) */ #ifdef HAS_64K_LIMIT - if (size > 0xffff) { - PerlIO_printf(PerlIO_stderr(), "Reallocation too large: %lx\n", size) FLUSH; - my_exit(1); - } + if (size > 0xffff) { + PerlIO_printf(PerlIO_stderr(), + "Reallocation too large: %lx\n", size) FLUSH; + my_exit(1); + } #endif /* HAS_64K_LIMIT */ if (!where) croak("Null realloc"); @@ -174,10 +175,11 @@ MEM_SIZE size; Malloc_t ptr; #ifdef HAS_64K_LIMIT - if (size * count > 0xffff) { - PerlIO_printf(PerlIO_stderr(), "Allocation too large: %lx\n", size * count) FLUSH; - my_exit(1); - } + if (size * count > 0xffff) { + PerlIO_printf(PerlIO_stderr(), + "Allocation too large: %lx\n", size * count) FLUSH; + my_exit(1); + } #endif /* HAS_64K_LIMIT */ #ifdef DEBUGGING if ((long)size < 0 || (long)count < 0) @@ -501,29 +503,33 @@ perl_new_numeric(newnum) #endif /* USE_LOCALE_NUMERIC */ } -#ifdef USE_LOCALE_NUMERIC - void perl_set_numeric_standard() { +#ifdef USE_LOCALE_NUMERIC + if (! numeric_standard) { setlocale(LC_NUMERIC, "C"); numeric_standard = TRUE; numeric_local = FALSE; } + +#endif /* USE_LOCALE_NUMERIC */ } void perl_set_numeric_local() { +#ifdef USE_LOCALE_NUMERIC + if (! numeric_local) { setlocale(LC_NUMERIC, numeric_name); numeric_standard = FALSE; numeric_local = TRUE; } -} #endif /* USE_LOCALE_NUMERIC */ +} /* @@ -542,8 +548,9 @@ perl_init_i18nl10n(printwarn) #ifdef USE_LOCALE +#ifdef LC_ALL char *lc_all = getenv("LC_ALL"); - char *lang = getenv("LANG"); +#endif /* LC_ALL */ #ifdef USE_LOCALE_CTYPE char *lc_ctype = getenv("LC_CTYPE"); char *curctype = NULL; @@ -556,122 +563,152 @@ perl_init_i18nl10n(printwarn) char *lc_numeric = getenv("LC_NUMERIC"); char *curnum = NULL; #endif /* USE_LOCALE_NUMERIC */ + char *lang = getenv("LANG"); bool setlocale_failure = FALSE; - char *subloc; #ifdef LC_ALL - subloc = NULL; + if (! setlocale(LC_ALL, "")) setlocale_failure = TRUE; -#else - subloc = ""; -#endif /* LC_ALL */ + else { +#ifdef USE_LOCALE_CTYPE + curctype = setlocale(LC_CTYPE, Nullch); +#endif /* USE_LOCALE_CTYPE */ +#ifdef USE_LOCALE_COLLATE + curcoll = setlocale(LC_COLLATE, Nullch); +#endif /* USE_LOCALE_COLLATE */ +#ifdef USE_LOCALE_NUMERIC + curnum = setlocale(LC_NUMERIC, Nullch); +#endif /* USE_LOCALE_NUMERIC */ + } + +#else /* !LC_ALL */ #ifdef USE_LOCALE_CTYPE - if (! (curctype = setlocale(LC_CTYPE, subloc))) + if (! (curctype = setlocale(LC_CTYPE, ""))) setlocale_failure = TRUE; #endif /* USE_LOCALE_CTYPE */ #ifdef USE_LOCALE_COLLATE - if (! (curcoll = setlocale(LC_COLLATE, subloc))) + if (! (curcoll = setlocale(LC_COLLATE, ""))) setlocale_failure = TRUE; #endif /* USE_LOCALE_COLLATE */ #ifdef USE_LOCALE_NUMERIC - if (! (curnum = setlocale(LC_NUMERIC, subloc))) + if (! (curnum = setlocale(LC_NUMERIC, ""))) setlocale_failure = TRUE; #endif /* USE_LOCALE_NUMERIC */ - if (setlocale_failure && (lc_all || lang)) { - char *perl_badlang; +#endif /* LC_ALL */ + + if (setlocale_failure) { + char *p; + bool locwarn = (printwarn > 1 || + printwarn && + (!(p = getenv("PERL_BADLANG")) || atoi(p))); - if (printwarn > 1 || - printwarn && - (!(perl_badlang = getenv("PERL_BADLANG")) || atoi(perl_badlang))) { - + if (locwarn) { +#ifdef LC_ALL + + PerlIO_printf(PerlIO_stderr(), + "perl: warning: Setting locale failed.\n"); + +#else /* !LC_ALL */ + PerlIO_printf(PerlIO_stderr(), "perl: warning: Setting locale failed for the categories:\n\t"); #ifdef USE_LOCALE_CTYPE if (! curctype) - PerlIO_printf(PerlIO_stderr(), "USE_LOCALE_CTYPE "); + PerlIO_printf(PerlIO_stderr(), "LC_CTYPE "); #endif /* USE_LOCALE_CTYPE */ #ifdef USE_LOCALE_COLLATE if (! curcoll) - PerlIO_printf(PerlIO_stderr(), "USE_LOCALE_COLLATE "); + PerlIO_printf(PerlIO_stderr(), "LC_COLLATE "); #endif /* USE_LOCALE_COLLATE */ #ifdef USE_LOCALE_NUMERIC if (! curnum) - PerlIO_printf(PerlIO_stderr(), "USE_LOCALE_NUMERIC "); + PerlIO_printf(PerlIO_stderr(), "LC_NUMERIC "); #endif /* USE_LOCALE_NUMERIC */ PerlIO_printf(PerlIO_stderr(), "\n"); +#endif /* LC_ALL */ + PerlIO_printf(PerlIO_stderr(), "perl: warning: Please check that your locale settings:\n"); +#ifdef LC_ALL PerlIO_printf(PerlIO_stderr(), "\tLC_ALL = %c%s%c,\n", lc_all ? '"' : '(', lc_all ? lc_all : "unset", lc_all ? '"' : ')'); -#ifdef USE_LOCALE_CTYPE - if (! curctype) - PerlIO_printf(PerlIO_stderr(), - "\tLC_CTYPE = %c%s%c,\n", - lc_ctype ? '"' : '(', - lc_ctype ? lc_ctype : "unset", - lc_ctype ? '"' : ')'); -#endif /* USE_LOCALE_CTYPE */ -#ifdef USE_LOCALE_COLLATE - if (! curcoll) - PerlIO_printf(PerlIO_stderr(), - "\tLC_COLLATE = %c%s%c,\n", - lc_collate ? '"' : '(', - lc_collate ? lc_collate : "unset", - lc_collate ? '"' : ')'); -#endif /* USE_LOCALE_COLLATE */ -#ifdef USE_LOCALE_NUMERIC - if (! curnum) - PerlIO_printf(PerlIO_stderr(), - "\tLC_NUMERIC = %c%s%c,\n", - lc_numeric ? '"' : '(', - lc_numeric ? lc_numeric : "unset", - lc_numeric ? '"' : ')'); -#endif /* USE_LOCALE_NUMERIC */ +#endif /* LC_ALL */ + + { + char **e; + for (e = environ; *e; e++) { + if (strnEQ(*e, "LC_", 3) + && strnNE(*e, "LC_ALL=", 7) + && (p = strchr(*e, '='))) + PerlIO_printf(PerlIO_stderr(), "\t%.*s = \"%s\",\n", + (p - *e), *e, p + 1); + } + } + PerlIO_printf(PerlIO_stderr(), "\tLANG = %c%s%c\n", - lang ? '"' : ')', + lang ? '"' : '(', lang ? lang : "unset", lang ? '"' : ')'); PerlIO_printf(PerlIO_stderr(), " are supported and installed on your system.\n"); + } +#ifdef LC_ALL + + if (setlocale(LC_ALL, "C")) { + if (locwarn) + PerlIO_printf(PerlIO_stderr(), + "perl: warning: Falling back to the standard locale (\"C\").\n"); ok = 0; } + else { + if (locwarn) + PerlIO_printf(PerlIO_stderr(), + "perl: warning: Failed to fall back to the standard locale (\"C\").\n"); + ok = -1; + } -#ifdef LC_ALL - if (setlocale_failure) { - PerlIO_printf(PerlIO_stderr(), - "perl: warning: Falling back to the \"C\" locale.\n"); - if (setlocale(LC_ALL, "C")) { +#else /* ! LC_ALL */ + + if (0 #ifdef USE_LOCALE_CTYPE - curctype = "C"; + || !(curctype || setlocale(LC_CTYPE, "C")) #endif /* USE_LOCALE_CTYPE */ #ifdef USE_LOCALE_COLLATE - curcoll = "C"; + || !(curcoll || setlocale(LC_COLLATE, "C")) #endif /* USE_LOCALE_COLLATE */ #ifdef USE_LOCALE_NUMERIC - curnum = "C"; + || !(curnum || setlocale(LC_NUMERIC, "C")) #endif /* USE_LOCALE_NUMERIC */ - } - else { + ) + { + if (locwarn) PerlIO_printf(PerlIO_stderr(), - "perl: warning: Failed to fall back to the \"C\" locale.\n"); - ok = -1; - } + "perl: warning: Cannot fall back to the standard locale (\"C\").\n"); + ok = -1; } -#else /* ! LC_ALL */ - PerlIO_printf(PerlIO_stderr(), - "perl: warning: Cannot fall back to the \"C\" locale.\n"); + #endif /* ! LC_ALL */ + +#ifdef USE_LOCALE_CTYPE + curctype = setlocale(LC_CTYPE, Nullch); +#endif /* USE_LOCALE_CTYPE */ +#ifdef USE_LOCALE_COLLATE + curcoll = setlocale(LC_COLLATE, Nullch); +#endif /* USE_LOCALE_COLLATE */ +#ifdef USE_LOCALE_NUMERIC + curnum = setlocale(LC_NUMERIC, Nullch); +#endif /* USE_LOCALE_NUMERIC */ } #ifdef USE_LOCALE_CTYPE @@ -696,7 +733,7 @@ int perl_init_i18nl14n(printwarn) int printwarn; { - perl_init_i18nl10n(printwarn); + return perl_init_i18nl10n(printwarn); } #ifdef USE_LOCALE_COLLATE @@ -1034,7 +1071,7 @@ mess(pat, args) } va_end(*args); - if (s[-1] != '\n') { + if (!(s > s_start && s[-1] == '\n')) { if (dirty) strcpy(s, " during global destruction.\n"); else { @@ -1551,8 +1588,8 @@ VTOH(vtohs,short) VTOH(vtohl,long) #endif -#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) \ - && !defined(VMS) /* VMS' my_popen() is in VMS.c, same with OS/2. */ + /* VMS' my_popen() is in VMS.c, same with OS/2. */ +#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) PerlIO * my_popen(cmd,mode) char *cmd; @@ -1809,9 +1846,8 @@ Sigsave_t *save; #endif /* !HAS_SIGACTION */ - -#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) \ - && !defined(VMS) /* VMS' my_popen() is in VMS.c */ + /* VMS' my_pclose() is in VMS.c; same with OS/2 */ +#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) I32 my_pclose(ptr) PerlIO *ptr; diff --git a/utils/Makefile b/utils/Makefile index 33947c87f1..958dc038d7 100644 --- a/utils/Makefile +++ b/utils/Makefile @@ -4,16 +4,16 @@ PERL = ../miniperl # Files to be built with variable substitution after miniperl is # available. Dependencies handled manually below (for now). -pl = c2ph.PL h2ph.PL h2xs.PL perlbug.PL perldoc.PL - -pl = c2ph.PL h2ph.PL h2xs.PL perlbug.PL perldoc.PL pl2pm.PL -plextract = c2ph h2ph h2xs perlbug perldoc pl2pm +pl = c2ph.PL h2ph.PL h2xs.PL perlbug.PL perldoc.PL pl2pm.PL splain.PL +plextract = c2ph h2ph h2xs perlbug perldoc pl2pm splain all: $(plextract) $(plextract): $(PERL) -I../lib $@.PL +splain: ../lib/diagnostics.pm + clean: realclean: diff --git a/utils/c2ph.PL b/utils/c2ph.PL index 97d17af655..5f4523aa84 100644 --- a/utils/c2ph.PL +++ b/utils/c2ph.PL @@ -25,9 +25,9 @@ print "Extracting $file (with variable substitutions)\n"; # You can use $Config{...} to use Configure variables. print OUT <<"!GROK!THIS!"; -$Config{'startperl'} - eval 'exec perl -S \$0 "\$@"' - if 0; +$Config{startperl} + eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' + if \$running_under_some_shell; !GROK!THIS! # In the following, perl variables are not expanded during extraction. diff --git a/utils/h2ph.PL b/utils/h2ph.PL index 22161b9791..1b2ce312a0 100644 --- a/utils/h2ph.PL +++ b/utils/h2ph.PL @@ -26,10 +26,9 @@ print "Extracting $file (with variable substitutions)\n"; # You can use $Config{...} to use Configure variables. print OUT <<"!GROK!THIS!"; -$Config{'startperl'} - eval 'exec perl -S \$0 "\$@"' - if 0; - +$Config{startperl} + eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' + if \$running_under_some_shell; !GROK!THIS! # In the following, perl variables are not expanded during extraction. @@ -55,6 +54,10 @@ $inif = 0; @ARGV = ('-') unless @ARGV; foreach $file (@ARGV) { + # Recover from header files with unbalanced cpp directives + $t = ''; + $tab = 0; + if ($file eq '-') { open(IN, "-"); open(OUT, ">-"); @@ -103,7 +106,7 @@ foreach $file (@ARGV) { $args = "local($args) = \@_;\n$t "; } s/^\s+//; - do expr(); + expr(); $new =~ s/(["\\])/\\$1/g; if ($t ne '') { $new =~ s/(['\\])/\\$1/g; @@ -117,7 +120,7 @@ foreach $file (@ARGV) { } else { s/^\s+//; - do expr(); + expr(); $new = 1 if $new eq ''; if ($t ne '') { $new =~ s/(['\\])/\\$1/g; @@ -145,7 +148,7 @@ foreach $file (@ARGV) { elsif (s/^if\s+//) { $new = ''; $inif = 1; - do expr(); + expr(); $inif = 0; print OUT $t,"if ($new) {\n"; $tab += 4; @@ -154,7 +157,7 @@ foreach $file (@ARGV) { elsif (s/^elif\s+//) { $new = ''; $inif = 1; - do expr(); + expr(); $inif = 0; $tab -= 4; $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); @@ -194,10 +197,31 @@ sub expr { } next; }; - s/^sizeof\s*\(([^)]+)\)/{$1}/ && do { - $new .= '$sizeof'; - next; - }; + # replace "sizeof(foo)" with "{foo}" + # also, remove * (C dereference operator) to avoid perl syntax + # problems. Where the %sizeof array comes from is anyone's + # guess (c2ph?), but this at least avoids fatal syntax errors. + # Behavior is undefined if sizeof() delimiters are unbalanced. + # This code was modified to able to handle constructs like this: + # sizeof(*(p)), which appear in the HP-UX 10.01 header files. + s/^sizeof\s*\(// && do { + $new .= '$sizeof'; + my $lvl = 1; # already saw one open paren + # tack { on the front, and skip it in the loop + $_ = "{" . "$_"; + my $index = 1; + # find balanced closing paren + while ($index <= length($_) && $lvl > 0) { + $lvl++ if substr($_, $index, 1) eq "("; + $lvl-- if substr($_, $index, 1) eq ")"; + $index++; + } + # tack } on the end, replacing ) + substr($_, $index - 1, 1) = "}"; + # remove pesky * operators within the sizeof argument + substr($_, 0, $index - 1) =~ s/\*//g; + next; + }; s/^([_a-zA-Z]\w*)// && do { $id = $1; if ($id eq 'struct') { diff --git a/utils/h2xs.PL b/utils/h2xs.PL index 7e54d49acf..73df801a24 100644 --- a/utils/h2xs.PL +++ b/utils/h2xs.PL @@ -25,9 +25,9 @@ print "Extracting $file (with variable substitutions)\n"; # You can use $Config{...} to use Configure variables. print OUT <<"!GROK!THIS!"; -$Config{'startperl'} - eval 'exec perl -S \$0 "\$@"' - if 0; +$Config{startperl} + eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' + if \$running_under_some_shell; !GROK!THIS! # In the following, perl variables are not expanded during extraction. diff --git a/utils/perlbug.PL b/utils/perlbug.PL index f1363722d9..7f894d89a2 100644 --- a/utils/perlbug.PL +++ b/utils/perlbug.PL @@ -25,9 +25,9 @@ print "Extracting $file (with variable substitutions)\n"; # You can use $Config{...} to use Configure variables. print OUT <<"!GROK!THIS!"; -$Config{'startperl'} - eval 'exec perl -S \$0 "\$@"' - if 0; +$Config{startperl} + eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' + if \$running_under_some_shell; !GROK!THIS! # In the following, perl variables are not expanded during extraction. diff --git a/utils/perldoc.PL b/utils/perldoc.PL index 8c5e0c9476..e0f8a43b86 100644 --- a/utils/perldoc.PL +++ b/utils/perldoc.PL @@ -25,9 +25,9 @@ print "Extracting $file (with variable substitutions)\n"; # You can use $Config{...} to use Configure variables. print OUT <<"!GROK!THIS!"; -$Config{'startperl'} - eval 'exec perl -S \$0 "\$@"' - if 0; +$Config{startperl} + eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' + if \$running_under_some_shell; \@pagers = (); push \@pagers, "$Config{'pager'}" if -x "$Config{'pager'}"; diff --git a/utils/pl2pm.PL b/utils/pl2pm.PL index 60e66f824d..8d47481341 100644 --- a/utils/pl2pm.PL +++ b/utils/pl2pm.PL @@ -25,9 +25,9 @@ print "Extracting $file (with variable substitutions)\n"; # You can use $Config{...} to use Configure variables. print OUT <<"!GROK!THIS!"; -$Config{'startperl'} - eval 'exec perl -S \$0 "\$@"' - if 0; +$Config{startperl} + eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' + if \$running_under_some_shell; !GROK!THIS! # In the following, perl variables are not expanded during extraction. diff --git a/utils/splain.PL b/utils/splain.PL new file mode 100644 index 0000000000..53954db65a --- /dev/null +++ b/utils/splain.PL @@ -0,0 +1,47 @@ +#!/usr/local/bin/perl + +use Config; +use File::Basename qw(&basename &dirname); + +# List explicitly here the variables you want Configure to +# generate. Metaconfig only looks for shell variables, so you +# have to mention them as if they were shell variables, not +# %Config entries: +# $startperl +# $perlpath +# $eunicefix + +# This forces PL files to create target in same directory as PL file. +# This is so that make depend always knows where to find PL derivatives. +chdir(dirname($0)); +($file = basename($0)) =~ s/\.PL$//; +$file =~ s/\.pl$// + if ($^O eq 'VMS' or $^O eq 'os2'); # "case-forgiving" + +# Open input file before creating output file. +$IN = '../lib/diagnostics.pm'; +open IN or die "Can't open $IN: $!\n"; + +# Create output file. +open OUT,">$file" or die "Can't create $file: $!"; + +print "Extracting $file (with variable substitutions)\n"; + +# In this section, perl variables will be expanded during extraction. +# You can use $Config{...} to use Configure variables. + +print OUT <<"!GROK!THIS!"; +$Config{startperl} + eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' + if \$running_under_some_shell; +!GROK!THIS! + +while (<IN>) { + print OUT unless /^package diagnostics/; +} + +close IN; + +close OUT or die "Can't close $file: $!"; +chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; +exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; diff --git a/vms/Makefile b/vms/Makefile index 7b9d2b5535..3622ad9c42 100644 --- a/vms/Makefile +++ b/vms/Makefile @@ -1,4 +1,4 @@ -#> This file produced from Descrip.MMS by mms2make.pl +#> This file produced from descrip.mms by mms2make.pl #> Lines beginning with "#>" were commented out during the #> conversion process. For more information, see mms2make.pl #> @@ -18,21 +18,33 @@ #### Start of system configuration section. #### +#> .ifdef AXE # File type to use for object files +#> O = .abj # File type to use for object libraries +#> OLB = .alb # File type to use for executable images +#> E = .axe +#> .else # File type to use for object files O = .obj # File type to use for object libraries OLB = .olb # File type to use for executable images E = .exe +#> .endif +#> .ifdef __AXP__ +#> DECC = 1 +#> ARCH = VMS_AXP +#> OBJVAL = $(O) +#> .else ARCH = VMS_VAX OBJVAL = $@ +#> .endif # Updated by fndvers.com -- do not edit by hand -PERL_VERSION = 5_00307# +PERL_VERSION = 5_00311# ARCHDIR = [.lib.$(ARCH).$(PERL_VERSION)] @@ -40,19 +52,51 @@ ARCHCORE = [.lib.$(ARCH).$(PERL_VERSION).CORE] ARCHAUTO = [.lib.$(ARCH).$(PERL_VERSION).auto] +#> .ifdef DECC_PIPES_BROKEN +#> PIPES_BROKEN = 1 +#> .endif +#> .ifdef GNUC +#> .first: +#> @ $$@[.vms]fndvers.com "" "" "[.vms]Makefile" +#> @ If f$$TrnLnm("Sys").eqs."" Then Define/NoLog SYS GNU_CC_Include:[VMS] +#> CC = gcc # -fno-builtin avoids bug in gcc up to version 2.6.2 which can destroy # data when memcpy() is called on large (>64 kB) blocks of memory # (fixed in gcc 2.6.3) +#> XTRACCFLAGS = /Obj=$@/NoCase_Hack/Optimize=2/CC1="""""-fno-builtin""""" +#> DBGSPECFLAGS = +#> XTRADEF = ,GNUC_ATTRIBUTE_CHECK +#> XTRAOBJS = +#> LIBS1 = GNU_CC:[000000]GCCLIB.OLB/Library +#> LIBS2 = sys$$Share:VAXCRTL/Shareable +#> POSIX = +#> .else XTRAOBJS = LIBS1 = $(XTRAOBJS) DBGSPECFLAGS = /Show=(Source,Include,Expansion) +#> .ifdef decc # Some versions of DECCRTL on AXP have a bug in chdir() which causes the change # to persist after the image exits, even when this was not requested, iff # SYSNAM is enabled. This is fixed in CSC Patch # AXPACRT04_061, but turning # off SYSNAM for the MM[SK] subprocess doesn't hurt anything, so we do it # just in case. +#> .first: +#> @ Set Process/Privilege=(NoSYSNAM) +#> @ $$@[.vms]fndvers.com "" "" "[.vms]Makefile" +#> @ If f$$TrnLnm("Sys").eqs."" .and. f$$TrnLnm("DECC$System_Include").nes."" Then Define/NoLog SYS DECC$System_Include +#> .ifdef __AXP__ +#> @ If f$$TrnLnm("Sys").eqs."" .and. f$$TrnLnm("DECC$System_Include").eqs."" Then Define/NoLog SYS sys$$Library +#> .else +#> @ If f$$TrnLnm("Sys").eqs."" .and. f$$TrnLnm("DECC$System_Include").eqs."" Then Define/NoLog SYS DECC$Library_Include +#> .endif +#> +#> LIBS2 = +#> XTRACCFLAGS = /Include=[]/Standard=Relaxed_ANSI/Prefix=All/Obj=$(OBJVAL) +#> XTRADEF = +#> POSIX = POSIX +#> .else # VAXC .first: @ $$@[.vms]fndvers.com "" "" "[.vms]Makefile" @ If f$$TrnLnm("Sys").eqs."" .and. f$$TrnLnm("VAXC$Include").eqs."" Then Define/NoLog SYS sys$$Library @@ -61,15 +105,34 @@ DBGSPECFLAGS = /Show=(Source,Include,Expansion) XTRACCFLAGS = /Include=[]/Object=$(O) XTRADEF = LIBS2 = sys$$Share:VAXCRTL/Shareable +POSIX = +#> .endif +#> .endif +#> .ifdef __DEBUG__ +#> DBGCCFLAGS = /List/Debug/NoOpt$(DBGSPECFLAGS) +#> DBGLINKFLAGS = /Trace/Debug/Map/Full/Cross +#> DBG = DBG +#> .else DBGCCFLAGS = /NoList DBGLINKFLAGS = /NoMap DBG = +#> .endif +#> .ifdef SOCKET +#> SOCKDEF = ,VMS_DO_SOCKETS +#> SOCKLIB = SocketShr/Share # N.B. the targets for $(SOCKC) and $(SOCKH) assume that the permanent # copies live in [.vms], and the `clean' target will delete copies of # these files in the current default directory. +#> SOCKC = sockadapt.c +#> SOCKH = sockadapt.h +#> SOCKCLIS = ,$(SOCKC) +#> SOCKHLIS = ,$(SOCKH) +#> SOCKOBJ = ,sockadapt$(O) +#> SOCKPM = [.lib]Socket.pm +#> .else SOCKDEF = SOCKLIB = SOCKC = @@ -78,6 +141,7 @@ SOCKCLIS = SOCKHLIS = SOCKOBJ = SOCKPM = +#> .endif # C preprocessor manifest "DEBUGGING" ==> perl -D, not the VMS debugger CFLAGS = /Define=(DEBUGGING$(SOCKDEF)$(XTRADEF))$(XTRACCFLAGS)$(DBGCCFLAGS) @@ -104,8 +168,13 @@ MYEXT = DynaLoader # there are any object files specified # These must be built separately, or you must add rules below to build them myextobj = [.ext.dynaloader]dl_vms$(O), +#> .ifdef SOCKET +#> EXT = $(MYEXT) Socket +#> extobj = $(myextobj) [.ext.socket]socket$(O), +#> .else EXT = $(MYEXT) extobj = $(myextobj) +#> .endif #### End of system configuration section. #### @@ -138,13 +207,19 @@ ac6 = $(ARCHCORE)pp.h $(ARCHCORE)proto.h $(ARCHCORE)regcomp.h $(ARCHCORE)perlio. ac7 = $(ARCHCORE)regexp.h $(ARCHCORE)scope.h $(ARCHCORE)sv.h $(ARCHCORE)util.h ac8 = $(ARCHCORE)vmsish.h $(ARCHCORE)$(DBG)libperl$(OLB) $(ARCHCORE)perlshr_attr.opt ac9 = $(ARCHCORE)$(DBG)perlshr_bld.opt +#> .ifdef SOCKET +#> acs = $(ARCHCORE)$(SOCKH) +#> .else acs = +#> .endif CRTL = []crtl.opt CRTLOPTS =,$(CRTL)/Options .suffixes: +#> .ifdef LINK_ONLY +#> .else .suffixes: $(O) .c .xs .xs.c : @@ -157,13 +232,14 @@ CRTLOPTS =,$(CRTL)/Options .xs$(O) : $(XSUBPP) $< >$(MMS$SOURCE_NAME).c $(CC) $(CFLAGS) $(MMS$SOURCE_NAME).c +#> .endif all : base extras libmods utils podxform archcorefiles preplibrary perlpods @ $(NOOP) base : miniperl perl @ $(NOOP) -extras : Fcntl FileHandle IO Opcode libmods utils podxform +extras : Fcntl IO Opcode $(POSIX) libmods utils podxform @ $(NOOP) libmods : [.lib]Config.pm $(ARCHDIR)Config.pm [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm @ $(NOOP) @@ -208,7 +284,11 @@ perl : $(DBG)perl$(E) @ Continue $(DBG)perl$(E) : perlmain$(O), $(DBG)perlshr$(E), $(MINIPERL_EXE) @ $$@[.vms]genopt "PerlShr.Opt/Write" "|" "''f$$Environment("Default")'$(DBG)PerlShr$(E)/Share" +#> .ifdef gnuc +#> Link $(LINKFLAGS)/Exe=$@ perlmain$(O), perlshr.opt/Option, perlshr_attr.opt/Option, crtl.opt/Option +#> .else Link $(LINKFLAGS)/Exe=$@ perlmain$(O), perlshr.opt/Option, perlshr_attr.opt/Option +#> .endif $(DBG)perlshr$(E) : $(DBG)libperl$(OLB) $(extobj) $(DBG)perlshr_xtras.ts Link /NoTrace$(LINKFLAGS)/Share=$@ $(extobj) []$(DBG)perlshr_bld.opt/Option, perlshr_attr.opt/Option @@ -218,8 +298,18 @@ $(DBG)perlshr$(E) : $(DBG)libperl$(OLB) $(extobj) $(DBG)perlshr_xtras.ts # perlshr_gbl*.mar, perlshr_gbl*$(O) - VAX only # The song and dance with gen_shrfls.opt accomodates DCL's 255 character # line length limit. +#> .ifdef PIPES_BROKEN # This is a backup target used only with older versions of the DECCRTL which # can't deal with pipes properly. See ReadMe.VMS for details. +#> $(DBG)perlshr_xtras.ts : perl.h config.h vmsish.h proto.h [.vms]gen_shrfls.pl $(MINIPERL_EXE) $(MAKEFILE) $(CRTL) +#> $(CC) $(CFLAGS)/NoObject/NoList/PreProcess=perl.i perl.h +#> @ $(MINIPERL) -e "print join('|',@ARGV),'|';" "~~NOCC~~perl.i~~$(CC)$(CFLAGS)" >gen_shrfls.opt +#> @ $(MINIPERL) -e "print join('|',@ARGV);" "$(O)" "$(DBG)" "$(OLB)" "$(EXT)" "$(CRTL)" >>gen_shrfls.opt +#> $(MINIPERL) [.vms]gen_shrfls.pl -f gen_shrfls.opt +#> @ Delete/NoLog/NoConfirm perl.i;, gen_shrfls.opt; +#> @ If f$$Search("$(DBG)perlshr_xtras.ts").nes."" Then Delete/NoLog/NoConfirm $(DBG)perlshr_xtras.ts;* +#> @ Copy _NLA0: $(DBG)perlshr_xtras.ts +#> .else $(DBG)perlshr_xtras.ts : perl.h config.h vmsish.h proto.h [.vms]gen_shrfls.pl $(MINIPERL_EXE) $(MAKEFILE) $(CRTL) @ $(MINIPERL) -e "print join('|',@ARGV),'|';" "$(CC)$(CFLAGS)" >gen_shrfls.opt @ $(MINIPERL) -e "print join('|',@ARGV);" "$(O)" "$(DBG)" "$(OLB)" "$(EXT)" "$(CRTL)" >>gen_shrfls.opt @@ -227,6 +317,7 @@ $(DBG)perlshr_xtras.ts : perl.h config.h vmsish.h proto.h [.vms]gen_shrfls.pl $( @ Delete/NoLog/NoConfirm gen_shrfls.opt; @ If f$$Search("$(DBG)perlshr_xtras.ts").nes."" Then Delete/NoLog/NoConfirm $(DBG)perlshr_xtras.ts;* @ Copy _NLA0: $(DBG)perlshr_xtras.ts +#> .endif $(ARCHDIR)config.pm : [.lib]config.pm Create/Directory $(ARCHDIR) @@ -282,43 +373,43 @@ Opcode : [.lib]Opcode.pm [.lib]ops.pm [.lib]Safe.pm [.lib.auto.Opcode]Opcode$(E) [.ext.Opcode]Makefile : [.ext.Opcode]Makefile.PL $(ARCHDIR)Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm $(DBG)perlshr$(E) $(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.Opcode]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]" -FileHandle : [.lib]FileHandle.pm [.lib.auto.FileHandle]FileHandle$(E) +Fcntl : [.lib]Fcntl.pm [.lib.auto.Fcntl]Fcntl$(E) @ $(NOOP) -[.lib]FileHandle.pm : [.ext.FileHandle]Makefile +[.lib]Fcntl.pm : [.ext.Fcntl]Makefile @ If f$$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto] - @ Set Default [.ext.FileHandle] + @ Set Default [.ext.Fcntl] $(MMS) @ Set Default [--] -[.lib.auto.FileHandle]FileHandle$(E) : [.ext.FileHandle]Makefile - @ Set Default [.ext.FileHandle] +[.lib.auto.Fcntl]Fcntl$(E) : [.ext.Fcntl]Makefile + @ Set Default [.ext.Fcntl] $(MMS) @ Set Default [--] # Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C<chdir> # ${@} necessary to distract different versions of MM[SK]/make -[.ext.FileHandle]Makefile : [.ext.FileHandle]Makefile.PL $(ARCHDIR)Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm $(DBG)perlshr$(E) - $(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.FileHandle]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]" +[.ext.Fcntl]Makefile : [.ext.Fcntl]Makefile.PL $(ARCHDIR)Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm $(DBG)perlshr$(E) + $(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.Fcntl]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]" -Fcntl : [.lib]Fcntl.pm [.lib.auto.Fcntl]Fcntl$(E) +POSIX : [.lib]POSIX.pm [.lib.auto.POSIX]POSIX$(E) @ $(NOOP) -[.lib]Fcntl.pm : [.ext.Fcntl]Makefile +[.lib]POSIX.pm : [.ext.POSIX]Makefile @ If f$$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto] - @ Set Default [.ext.Fcntl] + @ Set Default [.ext.POSIX] $(MMS) @ Set Default [--] -[.lib.auto.Fcntl]Fcntl$(E) : [.ext.Fcntl]Makefile - @ Set Default [.ext.Fcntl] +[.lib.auto.POSIX]POSIX$(E) : [.ext.POSIX]Makefile + @ Set Default [.ext.POSIX] $(MMS) @ Set Default [--] # Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C<chdir> # ${@} necessary to distract different versions of MM[SK]/make -[.ext.Fcntl]Makefile : [.ext.Fcntl]Makefile.PL $(ARCHDIR)Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm $(DBG)perlshr$(E) - $(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.Fcntl]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]" +[.ext.POSIX]Makefile : [.ext.POSIX]Makefile.PL $(ARCHDIR)Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm $(DBG)perlshr$(E) + $(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.POSIX]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]" IO : [.lib]IO.pm [.lib.IO]File.pm [.lib.IO]Handle.pm [.lib.IO]Pipe.pm [.lib.IO]Seekable.pm [.lib.IO]Socket.pm [.lib.auto.IO]IO$(E) @ $(NOOP) @@ -558,6 +649,30 @@ printconfig : @ $$@[.vms]make_command $(MMS) $(MMSQUALIFIERS) $(MMSTARGETS) @ $$@[.vms]myconfig "$(CC)" "$(CFLAGS)" "$(LINKFLAGS)" "$(LIBS1)" "$(LIBS2)" "$(SOCKLIB)" "$(EXT)" "$(DBG)" +#> .ifdef SOCKET +#> +#> .ifdef LINK_ONLY +#> .else +#> $(SOCKOBJ) : $(SOCKC) $(SOCKH) +#> +#> [.ext.Socket]Socket$(O) : [.ext.Socket]Socket.c +#> $(CC) $(CFLAGS) /Object=$@ [.ext.Socket]Socket.c +#> +#> [.ext.Socket]Socket.c : [.ext.Socket]Socket.xs $(MINIPERL_EXE) +#> $(XSUBPP) [.ext.Socket]Socket.xs >$@ +#> .endif # !LINK_ONLY +#> +#> vmsish.h : $(SOCKH) +#> +#> $(SOCKC) : [.vms]$(SOCKC) +#> Copy/Log/NoConfirm [.vms]$(SOCKC) []$(SOCKC) +#> +#> $(SOCKH) : [.vms]$(SOCKH) +#> Copy/Log/NoConfirm [.vms]$(SOCKH) []$(SOCKH) +#> +#> [.lib]Socket.pm : [.ext.Socket]Socket.pm +#> Copy/Log/NoConfirm [.ext.Socket]Socket.pm $@ +#> .endif # The following three header files are generated automatically # keywords.h : keywords.pl @@ -589,8 +704,11 @@ perly.h : [.vms]perly_h.vms # rename y.tab.h perly.h # $(INSTPERL) [.vms]vms_yfix.pl perly.c perly.h [.vms]perly_c.vms [.vms]perly_h.vms +#> .ifdef LINK_ONLY +#> .else perly$(O) : perly.c, perly.h, $(h) $(CC) $(CFLAGS) perly.c +#> .endif test : all - @[.VMS]Test.Com "$(E)" @@ -684,6 +802,11 @@ $(ARCHCORE)util.h : util.h $(ARCHCORE)vmsish.h : vmsish.h @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log vmsish.h $@ +#> .ifdef SOCKET +#> $(ARCHCORE)$(SOCKH) : $(SOCKH) +#> @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) +#> Copy/Log $(SOCKH) $@ +#> .endif $(ARCHCORE)$(DBG)libperl$(OLB) : $(DBG)libperl$(OLB) $(DBG)perlshr_xtras.ts @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(DBG)libperl$(OLB) $@ @@ -697,6 +820,8 @@ $(ARCHAUTO)time.stamp : @ If f$$Search("$(ARCHDIR)auto.dir").eqs."" Then Create/Directory $(ARCHAUTO) @ If f$$Search("$@").eqs."" Then Copy/NoConfirm _NLA0: $(MMS$TARGET) +#> .ifdef LINK_ONLY +#> .else # AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE av$(O) : EXTERN.h av$(O) : av.c @@ -1369,6 +1494,7 @@ globals$(O) : scope.h globals$(O) : sv.h globals$(O) : vmsish.h globals$(O) : util.h +#> .endif # !LINK_ONLY config.h : [.vms]config.vms Copy/Log/NoConfirm [.vms]config.vms []config.h @@ -1389,9 +1515,9 @@ cleanlis : - If f$$Search("*.Map").nes."" Then Delete/NoConfirm/Log *.Map;* tidy : cleanlis - - If f$$Search("*.Opt;-1").nes."" Then Purge/NoConfirm/Log *.Opt - - If f$$Search("*$(O);-1").nes."" Then Purge/NoConfirm/Log *$(O) - - If f$$Search("*$(E);-1").nes."" Then Purge/NoConfirm/Log *$(E) + - If f$$Search("[...]*.Opt;-1").nes."" Then Purge/NoConfirm/Log [...]*.Opt + - If f$$Search("[...]*$(O);-1").nes."" Then Purge/NoConfirm/Log [...]*$(O) + - If f$$Search("[...]*$(E);-1").nes."" Then Purge/NoConfirm/Log [...]*$(E) - If f$$Search("Config.H;-1").nes."" Then Purge/NoConfirm/Log Config.H - If f$$Search("Config.SH;-1").nes."" Then Purge/NoConfirm/Log Config.SH - If f$$Search("perly.c;-1").nes."" Then Purge/NoConfirm/Log perly.c @@ -1415,7 +1541,8 @@ tidy : cleanlis - If f$$Search("[.Lib.VMS]*.*;-1").nes."" Then Purge/NoConfirm/Log [.Lib.VMS]*.* - If f$$Search("[.Lib.Pod]*.Pod;-1").nes."" Then Purge/NoConfirm/Log [.Lib.Pod]*.Pod - If f$$Search("$(ARCHCORE)*.*").nes."" Then Purge/NoConfirm/Log $(ARCHCORE)*.* - - If f$$Search("[.utils]*.;-1").nes."" Then Purge/NoConfirm/Log [.utils]*. + - If f$$Search("[.utils]*.;-1").nes."" Then Purge/NoConfirm/Log [.utils]*./Exclude=Makefile. + - If f$$Search("[.lib]perlbug.;-1").nes."" Then Purge/NoConfirm/Log [.lib]perlbug. - If f$$Search("[.lib.pod]*.;-1").nes."" Then Purge/NoConfirm/Log [.lib.pod]*. clean : tidy @@ -1431,6 +1558,11 @@ clean : tidy Set Default [.ext.Opcode] - $(MMS) clean Set Default [--] +#> .ifdef DECC +#> Set Default [.ext.POSIX] +#> - $(MMS) clean +#> Set Default [--] +#> .endif - If f$$Search("*.Opt").nes."" Then Delete/NoConfirm/Log *.Opt;*/Exclude=PerlShr_*.Opt - If f$$Search("*$(O);*") .nes."" Then Delete/NoConfirm/Log *$(O);* - If f$$Search("Config.H").nes."" Then Delete/NoConfirm/Log Config.H;* @@ -1464,6 +1596,11 @@ realclean : clean Set Default [.ext.Opcode] - $(MMS) realclean Set Default [--] +#> .ifdef DECC +#> Set Default [.ext.POSIX] +#> - $(MMS) realclean +#> Set Default [--] +#> .endif - If f$$Search("*$(OLB)").nes."" Then Delete/NoConfirm/Log *$(OLB);* - If f$$Search("*.Opt").nes."" Then Delete/NoConfirm/Log *.Opt;* - $(MINIPERL) -e "use File::Path; rmtree(['lib/auto','lib/VMS','lib/$(ARCH)'],1,0);" @@ -1473,7 +1610,7 @@ realclean : clean - If f$$Search("[.Lib]perlbug.").nes."" Then Delete/NoConfirm/Log [.Lib]perlbug.;* - If f$$Search("$(ARCHDIR)Config.pm").nes."" Then Delete/NoConfirm/Log $(ARCHDIR)Config.pm;* - If f$$Search("[.lib.ExtUtils]Miniperl.pm").nes."" Then Delete/NoConfirm/Log [.lib.ExtUtils]Miniperl.pm;* - - If f$$Search("[.utils]*.").nes."" Then Delete/NoConfirm/Log [.utils]*.;* + - If f$$Search("[.utils]*.").nes."" Then Delete/NoConfirm/Log [.utils]*.;*/Exclude=Makefile. - If f$$Search("[.lib.pod]*.pod").nes."" Then Delete/NoConfirm/Log [.lib.pod]*.pod;* - If f$$Search("[.lib.pod]perldoc.").nes."" Then Delete/NoConfirm/Log [.lib.pod]perldoc.;* - If f$$Search("[.lib.pod]pod2*.").nes."" Then Delete/NoConfirm/Log [.lib.pod]pod2*.;* diff --git a/vms/descrip.mms b/vms/descrip.mms index 607e2d6c4f..b86cbd53ce 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_00310# +PERL_VERSION = 5_00311# ARCHDIR = [.lib.$(ARCH).$(PERL_VERSION)] @@ -270,7 +270,7 @@ all : base extras libmods utils podxform archcorefiles preplibrary perlpods @ $(NOOP) base : miniperl perl @ $(NOOP) -extras : Fcntl FileHandle IO Opcode $(POSIX) libmods utils podxform +extras : Fcntl IO Opcode $(POSIX) libmods utils podxform @ $(NOOP) libmods : [.lib]Config.pm $(ARCHDIR)Config.pm [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm @ $(NOOP) @@ -404,25 +404,6 @@ Opcode : [.lib]Opcode.pm [.lib]ops.pm [.lib]Safe.pm [.lib.auto.Opcode]Opcode$(E) [.ext.Opcode]Descrip.MMS : [.ext.Opcode]Makefile.PL $(ARCHDIR)Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm $(DBG)perlshr$(E) $(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.Opcode]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]" -FileHandle : [.lib]FileHandle.pm [.lib.auto.FileHandle]FileHandle$(E) - @ $(NOOP) - -[.lib]FileHandle.pm : [.ext.FileHandle]Descrip.MMS - @ If F$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto] - @ Set Default [.ext.FileHandle] - $(MMS) - @ Set Default [--] - -[.lib.auto.FileHandle]FileHandle$(E) : [.ext.FileHandle]Descrip.MMS - @ Set Default [.ext.FileHandle] - $(MMS) - @ Set Default [--] - -# Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C<chdir> -# ${@} necessary to distract different versions of MM[SK]/make -[.ext.FileHandle]Descrip.MMS : [.ext.FileHandle]Makefile.PL $(ARCHDIR)Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm $(DBG)perlshr$(E) - $(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.FileHandle]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]" - Fcntl : [.lib]Fcntl.pm [.lib.auto.Fcntl]Fcntl$(E) @ $(NOOP) @@ -1591,7 +1572,7 @@ tidy : cleanlis - If F$Search("[.Lib.VMS]*.*;-1").nes."" Then Purge/NoConfirm/Log [.Lib.VMS]*.* - If F$Search("[.Lib.Pod]*.Pod;-1").nes."" Then Purge/NoConfirm/Log [.Lib.Pod]*.Pod - If F$Search("$(ARCHCORE)*.*").nes."" Then Purge/NoConfirm/Log $(ARCHCORE)*.* - - If F$Search("[.utils]*.;-1").nes."" Then Purge/NoConfirm/Log [.utils]*. + - If F$Search("[.utils]*.;-1").nes."" Then Purge/NoConfirm/Log [.utils]*./Exclude=Makefile. - If F$Search("[.lib]perlbug.;-1").nes."" Then Purge/NoConfirm/Log [.lib]perlbug. - If F$Search("[.lib.pod]*.;-1").nes."" Then Purge/NoConfirm/Log [.lib.pod]*. @@ -1660,7 +1641,7 @@ realclean : clean - If F$Search("[.Lib]perlbug.").nes."" Then Delete/NoConfirm/Log [.Lib]perlbug.;* - If F$Search("$(ARCHDIR)Config.pm").nes."" Then Delete/NoConfirm/Log $(ARCHDIR)Config.pm;* - If F$Search("[.lib.ExtUtils]Miniperl.pm").nes."" Then Delete/NoConfirm/Log [.lib.ExtUtils]Miniperl.pm;* - - If F$Search("[.utils]*.").nes."" Then Delete/NoConfirm/Log [.utils]*.;* + - If F$Search("[.utils]*.").nes."" Then Delete/NoConfirm/Log [.utils]*.;*/Exclude=Makefile. - If F$Search("[.lib.pod]*.pod").nes."" Then Delete/NoConfirm/Log [.lib.pod]*.pod;* - If F$Search("[.lib.pod]perldoc.").nes."" Then Delete/NoConfirm/Log [.lib.pod]perldoc.;* - If F$Search("[.lib.pod]pod2*.").nes."" Then Delete/NoConfirm/Log [.lib.pod]pod2*.;* diff --git a/vms/ext/DCLsym/0README.txt b/vms/ext/DCLsym/0README.txt new file mode 100644 index 0000000000..9dc721d36b --- /dev/null +++ b/vms/ext/DCLsym/0README.txt @@ -0,0 +1,21 @@ +VMS::DCLsym is an extension to Perl 5 which allows it to manipulate DCL symbols +via an object-oriented or tied-hash interface. + +In order to build the extension, just say + +$ Perl Makefile.PL +$ MMK + +in the directory containing the source files. Once it's built, you can run the +test script by saying + +$ Perl "-Iblib" test.pl + +Finally, if you want to make it part of your regular Perl library, you can say +$ MMK install + +If you have any problems or suggestions, please feel free to let me know. + +Regards, +Charles Bailey bailey@genetics.upenn.edu +17-Aug-1995 diff --git a/vms/ext/DCLsym/DCLsym.pm b/vms/ext/DCLsym/DCLsym.pm new file mode 100644 index 0000000000..057951dd99 --- /dev/null +++ b/vms/ext/DCLsym/DCLsym.pm @@ -0,0 +1,268 @@ +package VMS::DCLsym; + +use Carp; +use DynaLoader; +use vars qw( @ISA $VERSION ); +use strict; + +# Package globals +@ISA = ( 'DynaLoader' ); +$VERSION = '1.01'; +my(%Locsyms) = ( ':ID' => 'LOCAL' ); +my(%Gblsyms) = ( ':ID' => 'GLOBAL'); +my $DoCache = 1; +my $Cache_set = 0; + + +#====> OO methods + +sub new { + my($pkg,$type) = @_; + bless { TYPE => $type }, $pkg; +} + +sub DESTROY { } + +sub getsym { + my($self,$name) = @_; + my($val,$table); + + if (($val,$table) = _getsym($name)) { + if ($table eq 'GLOBAL') { $Gblsyms{$name} = $val; } + else { $Locsyms{$name} = $val; } + } + wantarray ? ($val,$table) : $val; +} + +sub setsym { + my($self,$name,$val,$table) = @_; + + $table = $self->{TYPE} unless $table; + if (_setsym($name,$val,$table)) { + if ($table eq 'GLOBAL') { $Gblsyms{$name} = $val; } + else { $Locsyms{$name} = $val; } + 1; + } + else { 0; } +} + +sub delsym { + my($self,$name,$table) = @_; + + $table = $self->{TYPE} unless $table; + if (_delsym($name,$table)) { + if ($table eq 'GLOBAL') { delete $Gblsyms{$name}; } + else { delete $Locsyms{$name}; } + 1; + } + else { 0; } +} + +sub clearcache { + my($self,$perm) = @_; + my($old); + + $Cache_set = 0; + %Locsyms = ( ':ID' => 'LOCAL'); + %Gblsyms = ( ':ID' => 'GLOBAL'); + $old = $DoCache; + $DoCache = $perm if defined($perm); + $old; +} + +#====> TIEHASH methods + +sub TIEHASH { + $_[0]->new(@_); +} + +sub FETCH { + my($self,$name) = @_; + if ($name eq ':GLOBAL') { $self->{TYPE} eq 'GLOBAL'; } + elsif ($name eq ':LOCAL' ) { $self->{TYPE} eq 'LOCAL'; } + else { scalar($self->getsym($name)); } +} + +sub STORE { + my($self,$name,$val) = @_; + if ($name eq ':GLOBAL') { $self->{TYPE} = 'GLOBAL'; } + elsif ($name eq ':LOCAL' ) { $self->{TYPE} = 'LOCAL'; } + else { $self->setsym($name,$val); } +} + +sub DELETE { + my($self,$name) = @_; + + $self->delsym($name); +} + +sub FIRSTKEY { + my($self) = @_; + my($name,$eqs,$val); + + if (!$DoCache || !$Cache_set) { + # We should eventually replace this with a C routine which walks the + # CLI symbol table directly. If I ever get 'hold of an I&DS manual . . . + open(P,'Show Symbol * |'); + while (<P>) { + ($name,$eqs,$val) = /^\s+(\S+) (=+) (.+)/ + or carp "VMS::CLISym: unparseable line $_"; + $name =~ s#\*##; + $val =~ s/"(.*)"$/$1/ or $val =~ s/^(\S+).*/$1/; + if ($eqs eq '==') { $Gblsyms{$name} = $val; } + else { $Locsyms{$name} = $val; } + } + close P; + $Cache_set = 1; + } + $self ->{IDX} = 0; + $self->{CACHE} = $self->{TYPE} eq 'GLOBAL' ? \%Gblsyms : \%Locsyms; + while (($name,$val) = each(%{$self->{CACHE}}) and !defined($name)) { + if ($self->{CACHE}{':ID'} eq 'GLOBAL') { return undef; } + $self->{CACHE} = \%Gblsyms; + } + $name; +} + +sub NEXTKEY { + my($self) = @_; + my($name,$val); + + while (($name,$val) = each(%{$self->{CACHE}}) and !defined($name)) { + if ($self->{CACHE}{':ID'} eq 'GLOBAL') { return undef; } + $self->{CACHE} = \%Gblsyms; + } + $name; +} + + +sub EXISTS { defined($_[0]->FETCH(@_)) ? 1 : 0 } + +sub CLEAR { } + + +bootstrap VMS::DCLsym; + +1; + +__END__ + +=head1 NAME + +VMS::DCLsym - Perl extension to manipulate DCL symbols + +=head1 SYNOPSIS + + tie %allsyms, VMS::DCLsym; + tie %cgisyms, VMS::DCLsym, 'GLOBAL'; + + + $handle = new VMS::DCLsyms; + $value = $handle->getsym($name); + $handle->setsym($name,$value,'GLOBAL') or die "Can't create symbol: $!\n"; + $handle->delsym($name,'LOCAL') or die "Can't delete symbol: $!\n"; + $handle->clearcache(); + +=head1 DESCRIPTION + +The VMS::DCLsym extension provides access to DCL symbols using a +tied hash interface. This allows Perl scripts to manipulate symbols in +a manner similar to the way in which logical names are manipulated via +the built-in C<%ENV> hash. Alternatively, one can call methods in this +package directly to read, create, and delete symbols. + +=head2 Tied hash interface + +This interface lets you treat the DCL symbol table as a Perl associative array, +in which the key of each element is the symbol name, and the value of the +element is that symbol's value. Case is not significant in the key string, as +DCL converts symbol names to uppercase, but it is significant in the value +string. All of the usual operations on associative arrays are supported. +Reading an element retrieves the current value of the symbol, assigning to it +defines a new symbol (or overwrites the old value of an existing symbol), and +deleting an element deletes the corresponding symbol. Setting an element to +C<undef>, or C<undef>ing it directly, sets the corresponding symbol to the null +string. You may also read the special keys ':GLOBAL' and ':LOCAL' to find out +whether a default symbol table has been specified for this hash (see C<table> +below), or set either or these keys to specify a default symbol table. + +When you call the C<tie> function to bind an associative array to this package, +you may specify as an optional argument the symbol table in which you wish to +create and delete symbols. If the argument is the string 'GLOBAL', then the +global symbol table is used; any other string causes the local symbol table to +be used. Note that this argument does not affect attempts to read symbols; if +a symbol with the specified name exists in the local symbol table, it is always +returned in preference to a symbol by the same name in the global symbol table. + +=head2 Object interface + +Although it's less convenient in some ways than the tied hash interface, you +can also call methods directly to manipulate individual symbols. In some +cases, this allows you finer control than using a tied hash aggregate. The +following methods are supported: + +=item new + +This creates a C<VMS::DCLsym> object which can be used as a handle for later +method calls. The single optional argument specifies the symbol table used +by default in future method calls, in the same way as the optional argument to +C<tie> described above. + +=item getsym + +If called in a scalar context, C<getsym> returns the value of the symbol whose +name is given as the argument to the call, or C<undef> if no such symbol +exists. Symbols in the local symbol table are always used in preference to +symbols in the global symbol table. If called in an array context, C<getsym> +returns a two-element list, whose first element is the value of the symbol, and +whose second element is the string 'GLOBAL' or 'LOCAL', indicating the table +from which the symbol's value was read. + +=item setsym + +The first two arguments taken by this method are the name of the symbol and the +value which should be assigned to it. The optional third argument is a string +specifying the symbol table to be used; 'GLOBAL' specifies the global symbol +table, and any other string specifies the local symbol table. If this argument +is omitted, the default symbol table for the object is used. C<setsym> returns +TRUE if successful, and FALSE otherwise. + +=item delsym + +This method deletes the symbol whose name is given as the first argument. The +optional second argument specifies the symbol table, as described above under +C<setsym>. It returns TRUE if the symbol was successfully deleted, and FALSE +if it was not. + +=item clearcache + +Because of the overhead associated with obtaining the list of defined symbols +for the tied hash iterator, it is only done once, and the list is reused for +subsequent iterations. Changes to symbols made through this package are +recorded, but in the rare event that someone changes the process' symbol table +from outside (as is possible using some software from the net), the iterator +will be out of sync with the symbol table. If you expect this to happen, you +can reset the cache by calling this method. In addition, if you pass a FALSE +value as the first argument, caching will be disabled. It can be reenabled +later by calling C<clearcache> again with a TRUE value as the first argument. +It returns TRUE or FALSE to indicate whether caching was previously enabled or +disabled, respectively. + +This method is a stopgap until we can incorporate code into this extension to +traverse the process' symbol table directly, so it may disappear in a future +version of this package. + +=head1 AUTHOR + +Charles Bailey bailey@genetics.upenn.edu + +=head1 VERSION + +1.01 08-Dec-1996 + +=head1 BUGS + +The list of symbols for the iterator is assembled by spawning off a +subprocess, which can be slow. Ideally, we should just traverse the +process' symbol table directly from C. + diff --git a/vms/ext/DCLsym/DCLsym.xs b/vms/ext/DCLsym/DCLsym.xs new file mode 100644 index 0000000000..3918eb11e5 --- /dev/null +++ b/vms/ext/DCLsym/DCLsym.xs @@ -0,0 +1,151 @@ +/* VMS::DCLsym - manipulate DCL symbols + * + * Version: 1.0 + * Author: Charles Bailey bailey@genetics.upenn.edu + * Revised: 17-Aug-1995 + * + * + * Revision History: + * + * 1.0 17-Aug-1995 Charles Bailey bailey@genetics.upenn.edu + * original production version + */ + +#include <descrip.h> +#include <lib$routines.h> +#include <libclidef.h> +#include <libdef.h> +#include <ssdef.h> +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +MODULE = VMS::DCLsym PACKAGE = VMS::DCLsym + +void +_getsym(name) + SV * name + PPCODE: + { + struct dsc$descriptor_s namdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0}, + valdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0}; + STRLEN namlen; + int tbltype; + unsigned long int retsts; + SETERRNO(0,SS$_NORMAL); + if (!name) { + PUSHs(sv_newmortal()); + SETERRNO(EINVAL,LIB$_INVARG); + return; + } + namdsc.dsc$a_pointer = SvPV(name,namlen); + namdsc.dsc$w_length = (unsigned short int) namlen; + retsts = lib$get_symbol(&namdsc,&valdsc,0,&tbltype); + if (retsts & 1) { + PUSHs(sv_2mortal(newSVpv(valdsc.dsc$w_length ? + valdsc.dsc$a_pointer : "",valdsc.dsc$w_length))); + if (GIMME) { + EXTEND(sp,2); /* just in case we're at the end of the stack */ + if (tbltype == LIB$K_CLI_LOCAL_SYM) + PUSHs(sv_2mortal(newSVpv("LOCAL",5))); + else + PUSHs(sv_2mortal(newSVpv("GLOBAL",6))); + } + _ckvmssts(lib$sfree1_dd(&valdsc)); + } + else { + ST(0) = &sv_undef; /* error - we're returning undef, if anything */ + switch (retsts) { + case LIB$_NOSUCHSYM: + break; /* nobody home */; + case LIB$_INVSYMNAM: /* user errors; set errno return undef */ + case LIB$_INSCLIMEM: + case LIB$_NOCLI: + set_errno(EVMSERR); + set_vaxc_errno(retsts); + break; + default: /* bail out */ + { _ckvmssts(retsts); } + } + } + } + + +void +_setsym(name,val,typestr="LOCAL") + SV * name + SV * val + char * typestr + CODE: + { + struct dsc$descriptor_s namdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0}, + valdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0}; + STRLEN slen; + int type; + unsigned long int retsts; + SETERRNO(0,SS$_NORMAL); + if (!name || !val) { + SETERRNO(EINVAL,LIB$_INVARG); + XSRETURN_UNDEF; + } + namdsc.dsc$a_pointer = SvPV(name,slen); + namdsc.dsc$w_length = (unsigned short int) slen; + valdsc.dsc$a_pointer = SvPV(val,slen); + valdsc.dsc$w_length = (unsigned short int) slen; + type = strNE(typestr,"GLOBAL") ? + LIB$K_CLI_LOCAL_SYM : LIB$K_CLI_GLOBAL_SYM; + retsts = lib$set_symbol(&namdsc,&valdsc,&type); + if (retsts & 1) { XSRETURN_YES; } + else { + switch (retsts) { + case LIB$_AMBSYMDEF: /* user errors; set errno and return */ + case LIB$_INSCLIMEM: + case LIB$_INVSYMNAM: + case LIB$_NOCLI: + set_errno(EVMSERR); + set_vaxc_errno(retsts); + XSRETURN_NO; + break; /* NOTREACHED */ + default: /* bail out */ + { _ckvmssts(retsts); } + } + } + } + + +void +_delsym(name,typestr="LOCAL") + SV * name + char * typestr + CODE: + { + struct dsc$descriptor_s namdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0}; + STRLEN slen; + int type; + unsigned long int retsts; + SETERRNO(0,SS$_NORMAL); + if (!name || !typestr) { + SETERRNO(EINVAL,LIB$_INVARG); + XSRETURN_UNDEF; + } + namdsc.dsc$a_pointer = SvPV(name,slen); + namdsc.dsc$w_length = (unsigned short int) slen; + type = strNE(typestr,"GLOBAL") ? + LIB$K_CLI_LOCAL_SYM : LIB$K_CLI_GLOBAL_SYM; + retsts = lib$delete_symbol(&namdsc,&type); + if (retsts & 1) { XSRETURN_YES; } + else { + switch (retsts) { + case LIB$_INVSYMNAM: /* user errors; set errno and return */ + case LIB$_NOCLI: + case LIB$_NOSUCHSYM: + set_errno(EVMSERR); + set_vaxc_errno(retsts); + XSRETURN_NO; + break; /* NOTREACHED */ + default: /* bail out */ + { _ckvmssts(retsts); } + } + } + } + diff --git a/vms/ext/DCLsym/Makefile.PL b/vms/ext/DCLsym/Makefile.PL new file mode 100644 index 0000000000..8e6f5bce40 --- /dev/null +++ b/vms/ext/DCLsym/Makefile.PL @@ -0,0 +1,3 @@ +use ExtUtils::MakeMaker; + +WriteMakefile( 'VERSION_FROM' => 'DCLsym.pm' ); diff --git a/vms/ext/DCLsym/test.pl b/vms/ext/DCLsym/test.pl new file mode 100644 index 0000000000..57f2afbd20 --- /dev/null +++ b/vms/ext/DCLsym/test.pl @@ -0,0 +1,41 @@ +print "1..15\n"; + +require VMS::DCLsym or die "failed 1\n"; +print "ok 1\n"; + +tie %syms, VMS::DCLsym or die "failed 2\n"; +print "ok 2\n"; + +$name = 'FOO_'.time(); +$syms{$name} = 'Perl_test'; +print +($! ? "(\$! = $!) not " : ''),"ok 3\n"; + +print +($syms{$name} eq 'Perl_test' ? '' : 'not '),"ok 4\n"; + +($val) = `Show Symbol $name` =~ /(\w+)"$/; +print +($val eq 'Perl_test' ? '' : 'not '),"ok 5\n"; + +while (($sym,$val) = each %syms) { + last if $sym eq $name && $val eq 'Perl_test'; +} +print +($sym ? '' : 'not '),"ok 6\n"; + +delete $syms{$name}; +print +($! ? "(\$! = $!) not " : ''),"ok 7\n"; + +print +(defined($syms{$name}) ? 'not ' : ''),"ok 8\n"; +undef %syms; + +$obj = new VMS::DCLsym 'GLOBAL'; +print +($obj ? '' : 'not '),"ok 9\n"; + +print +($obj->clearcache(0) ? '' : 'not '),"ok 10\n"; +print +($obj->clearcache(1) ? 'not ' : ''),"ok 11\n"; + +print +($obj->setsym($name,'Another_test') ? '' : 'not '),"ok 12\n"; + +($val,$tab) = $obj->getsym($name); +print +($val eq 'Another_test' && $tab eq 'GLOBAL' ? '' : 'not '),"ok 13\n"; + +print +($obj->delsym($name,'LOCAL') ? 'not ' : ''),"ok 14\n"; +print +($obj->delsym($name,'GLOBAL') ? '' : 'not '),"ok 15\n"; diff --git a/vms/ext/Stdio/Stdio.pm b/vms/ext/Stdio/Stdio.pm index af71f0bb9e..ad16af366f 100644 --- a/vms/ext/Stdio/Stdio.pm +++ b/vms/ext/Stdio/Stdio.pm @@ -1,8 +1,8 @@ # VMS::Stdio - VMS extensions to Perl's stdio calls # # Author: Charles Bailey bailey@genetics.upenn.edu -# Version: 2.0 -# Revised: 28-Feb-1996 +# Version: 2.01 +# Revised: 10-Dec-1996 package VMS::Stdio; @@ -12,7 +12,7 @@ use Carp '&croak'; use DynaLoader (); use Exporter (); -$VERSION = '2.0'; +$VERSION = '2.01'; @ISA = qw( Exporter DynaLoader IO::File ); @EXPORT = qw( &O_APPEND &O_CREAT &O_EXCL &O_NDELAY &O_NOWAIT &O_RDONLY &O_RDWR &O_TRUNC &O_WRONLY ); @@ -32,15 +32,14 @@ sub AUTOLOAD { if ($constname =~ /^O_/) { my($val) = constant($constname); defined $val or croak("Unknown VMS::Stdio constant $constname"); + *$AUTOLOAD = sub { val; } } else { # We don't know about it; hand off to IO::File require IO::File; - my($obj) = shift(@_); - my($val) = eval "\$obj->IO::File::$constname(@_)"; - croak "Error autoloading $constname: $@" if $@; + *$AUTOLOAD = eval "sub { shift->IO::File::$constname(\@_) }"; + croak "Error autoloading IO::File::$constname: $@" if $@; } - *$AUTOLOAD = sub { $val }; goto &$AUTOLOAD; } @@ -189,9 +188,9 @@ reason, it is unable to generate a name, it returns C<undef>. =item vmsopen The C<vmsopen> function enables you to specify optional RMS arguments -to the VMS CRTL when opening a file. It is similar to the built-in +to the VMS CRTL when opening a file. Its operation is similar to the built-in Perl C<open> function (see L<perlfunc> for a complete description), -but will only open normal files; it cannot open pipes or duplicate +but it will only open normal files; it cannot open pipes or duplicate existing I/O handles. Up to 8 optional arguments may follow the file name. These arguments should be strings which specify optional file characteristics as allowed by the CRTL. (See the @@ -199,7 +198,7 @@ CRTL reference manual description of creat() and fopen() for details.) If successful, C<vmsopen> returns a VMS::Stdio file handle; if an error occurs, it returns C<undef>. -You can use the file handle returned by C<vmsfopen> just as you +You can use the file handle returned by C<vmsopen> just as you would any other Perl file handle. The class VMS::Stdio ISA IO::File, so you can call IO::File methods using the handle returned by C<vmsopen>. However, C<use>ing VMS::Stdio does not @@ -232,6 +231,6 @@ task by calling the CRTL routine fwait(). =head1 REVISION -This document was last revised on 28-Jan-1996, for Perl 5.002. +This document was last revised on 10-Dec-1996, for Perl 5.004. =cut diff --git a/vms/ext/Stdio/Stdio.xs b/vms/ext/Stdio/Stdio.xs index a1ec91f500..200268c7f1 100644 --- a/vms/ext/Stdio/Stdio.xs +++ b/vms/ext/Stdio/Stdio.xs @@ -100,7 +100,7 @@ newFH(FILE *fp, char type) { gv_init(gv,stash,"__FH__",6,0); io = GvIOp(gv) = newIO(); IoIFP(io) = fp; - if (type != '>') IoOFP(io) = fp; + if (type != '<') IoOFP(io) = fp; IoTYPE(io) = type; rv = newRV((SV *)gv); SvREFCNT_dec(gv); @@ -225,7 +225,7 @@ vmsopen(spec,...) break; } if (fp != Nullfp) { - SV *fh = newFH(fp,(mode[1] ? '+' : (mode[0] == 'r' ? '<' : '>'))); + SV *fh = newFH(fp,(mode[1] ? '+' : (mode[0] == 'r' ? '<' : (mode[0] == 'a' ? 'a' : '>')))); ST(0) = (fh ? sv_2mortal(fh) : &sv_undef); } else { ST(0) = &sv_undef; } diff --git a/vms/ext/Stdio/test.pl b/vms/ext/Stdio/test.pl index 12e508aa1f..0b50d63e3a 100644 --- a/vms/ext/Stdio/test.pl +++ b/vms/ext/Stdio/test.pl @@ -1,8 +1,8 @@ -# Tests for VMS::Stdio v2.0 +# Tests for VMS::Stdio v2.01 use VMS::Stdio; import VMS::Stdio qw(&flush &getname &rewind &sync); -print "1..13\n"; +print "1..14\n"; print +(defined(&getname) ? '' : 'not '), "ok 1\n"; $name = "test$$"; @@ -16,26 +16,29 @@ print +(sync($fh) ? '' : 'not '),"ok 4\n"; $time = (stat("$name.tmp"))[9]; print +($time ? '' : 'not '), "ok 5\n"; -print 'not ' unless print $fh scalar(localtime($time)),"\n"; +$fh->autoflush; # Can we autoload autoflush from IO::File? Do or die. print "ok 6\n"; -print +(rewind($fh) ? '' : 'not '),"ok 7\n"; +print 'not ' unless print $fh scalar(localtime($time)),"\n"; +print "ok 7\n"; + +print +(rewind($fh) ? '' : 'not '),"ok 8\n"; chop($line = <$fh>); -print +($line eq localtime($time) ? '' : 'not '), "ok 8\n"; +print +($line eq localtime($time) ? '' : 'not '), "ok 9\n"; ($gotname) = (getname($fh) =~/\](.*);/); -print +($gotname eq "\U$name.tmp" ? '' : 'not '), "ok 9\n"; +print +($gotname eq "\U$name.tmp" ? '' : 'not '), "ok 10\n"; $sfh = VMS::Stdio::vmssysopen($name, O_RDONLY, 0, 'ctx=rec', 'shr=put', 'dna=.tmp'); -print +($sfh ? '' : 'not ($!) '), "ok 10\n"; +print +($sfh ? '' : 'not ($!) '), "ok 11\n"; close($fh); sysread($sfh,$line,24); -print +($line eq localtime($time) ? '' : 'not '), "ok 11\n"; +print +($line eq localtime($time) ? '' : 'not '), "ok 12\n"; undef $sfh; -print +(stat("$name.tmp") ? 'not ' : ''),"ok 12\n"; +print +(stat("$name.tmp") ? 'not ' : ''),"ok 13\n"; -print +(&VMS::Stdio::tmpnam ? '' : 'not '),"ok 13\n"; +print +(&VMS::Stdio::tmpnam ? '' : 'not '),"ok 14\n"; diff --git a/vms/genopt.com b/vms/genopt.com index 70013aec42..53ee6a82b6 100644 --- a/vms/genopt.com +++ b/vms/genopt.com @@ -9,6 +9,21 @@ $loop: $ x=f$element(element,p2,p3) $ if x .eqs. p2 then goto out $ y=f$edit(x,"COLLAPSE") ! lose spaces +$! Expand potential name-only args so we find shareable images +$! either via a logical name or in the default location +$ if y .nes. "" .and. - + f$locate("/SHARE",f$edit(y,"UPCASE")) .ne. f$length(y) +$ then +$ name = f$element(0,"/",y) +$ tail = f$extract(f$length(name),1024,y) +$ name = f$parse(name,"sys$share:.exe;") ! Look where image activator will +$ name = f$search(name) ! Does it really exist? +$ if name .nes. "" +$ then +$ name = name - f$parse(name,,,"version") ! Insist on current version +$ y = name + tail +$ endif +$ endif $ if y .nes. "" then write file y $ element=element+1 $ goto loop diff --git a/vms/perly_c.vms b/vms/perly_c.vms index b1cb69cdfc..28b84e492f 100644 --- a/vms/perly_c.vms +++ b/vms/perly_c.vms @@ -13,1105 +13,1055 @@ dep() deprecate("\"do\" to call subroutines"); } +#line 16 "perly.c" #define YYERRCODE 256 dEXT short yylhs[] = { -1, - 31, 0, 5, 3, 6, 6, 6, 7, 7, 7, - 7, 21, 21, 21, 21, 21, 21, 11, 11, 11, - 9, 9, 9, 9, 30, 30, 8, 8, 8, 8, - 8, 8, 8, 8, 10, 10, 25, 25, 29, 29, - 1, 1, 1, 1, 2, 2, 32, 32, 28, 28, - 4, 33, 33, 34, 13, 13, 13, 12, 12, 12, - 26, 26, 26, 26, 26, 26, 26, 26, 27, 27, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 22, 22, 23, 23, 23, 20, - 15, 16, 17, 18, 19, 24, 24, 24, 24, + 40, 0, 7, 5, 8, 6, 9, 9, 9, 10, + 10, 10, 10, 22, 22, 22, 22, 22, 22, 13, + 13, 13, 12, 12, 12, 12, 37, 37, 11, 11, + 11, 11, 11, 11, 11, 11, 11, 24, 24, 25, + 25, 26, 27, 28, 29, 30, 39, 39, 1, 1, + 1, 1, 3, 3, 41, 41, 36, 36, 4, 42, + 42, 43, 14, 14, 14, 23, 23, 23, 34, 34, + 34, 34, 34, 34, 34, 34, 35, 35, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 31, 31, 32, 32, 32, 2, 2, 38, + 21, 16, 17, 18, 19, 20, 33, 33, 33, 33, }; dEXT short yylen[] = { 2, - 0, 2, 4, 0, 0, 2, 2, 2, 1, 2, - 3, 1, 1, 3, 3, 3, 3, 0, 2, 6, - 6, 6, 4, 4, 0, 2, 7, 7, 5, 5, - 8, 7, 10, 3, 0, 1, 0, 1, 0, 1, - 1, 1, 1, 1, 4, 3, 5, 5, 0, 1, - 0, 3, 2, 6, 3, 3, 1, 2, 3, 1, - 3, 5, 6, 3, 5, 2, 4, 4, 1, 1, + 0, 2, 4, 0, 4, 0, 0, 2, 2, 2, + 1, 2, 3, 1, 1, 3, 3, 3, 3, 0, + 2, 6, 7, 7, 4, 4, 0, 2, 8, 8, + 5, 5, 10, 9, 8, 11, 3, 0, 1, 0, + 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, + 1, 1, 4, 3, 5, 5, 0, 1, 0, 3, + 2, 6, 3, 3, 1, 2, 3, 1, 3, 5, + 6, 3, 5, 2, 4, 4, 1, 1, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, - 3, 3, 5, 3, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 3, 2, 3, 2, 4, 3, - 4, 1, 5, 1, 4, 5, 4, 1, 1, 1, - 5, 6, 5, 6, 5, 4, 5, 1, 1, 3, - 4, 3, 2, 2, 4, 5, 4, 5, 1, 2, - 2, 1, 2, 2, 2, 1, 3, 1, 3, 4, - 4, 6, 1, 1, 0, 1, 0, 1, 2, 2, - 2, 2, 2, 2, 2, 1, 1, 1, 1, + 5, 3, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 3, 2, 3, 2, 4, 3, 4, 1, + 5, 1, 4, 5, 4, 1, 1, 1, 5, 6, + 5, 6, 5, 4, 5, 1, 1, 3, 4, 3, + 2, 2, 4, 5, 4, 5, 1, 2, 2, 1, + 2, 2, 2, 1, 3, 1, 3, 4, 4, 6, + 1, 1, 0, 1, 0, 1, 2, 1, 1, 1, + 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, }; dEXT short yydefred[] = { 1, - 0, 5, 0, 40, 51, 51, 0, 51, 6, 41, - 7, 9, 0, 42, 43, 44, 0, 0, 0, 53, - 0, 12, 4, 143, 0, 0, 118, 0, 138, 0, - 51, 51, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 7, 0, 48, 59, 59, 0, 59, 8, 49, + 9, 11, 0, 50, 51, 52, 0, 0, 0, 61, + 0, 14, 4, 151, 0, 0, 126, 0, 146, 0, + 59, 59, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 158, 159, 0, + 0, 0, 0, 0, 0, 0, 0, 12, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 10, 0, 0, + 0, 0, 116, 118, 0, 0, 0, 0, 152, 0, + 54, 0, 60, 0, 7, 167, 170, 169, 168, 0, + 0, 0, 0, 0, 0, 4, 0, 4, 0, 4, + 0, 4, 0, 4, 4, 0, 0, 0, 0, 0, + 141, 0, 0, 0, 0, 74, 0, 165, 0, 132, + 0, 0, 0, 0, 0, 161, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 106, 0, 162, 163, + 164, 166, 0, 0, 37, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 10, 0, 0, 0, - 0, 0, 0, 0, 0, 8, 0, 0, 0, 0, - 0, 108, 110, 0, 0, 0, 144, 0, 46, 0, - 52, 0, 5, 156, 159, 158, 157, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 154, 0, 124, - 0, 0, 0, 0, 0, 0, 150, 0, 0, 0, - 0, 66, 0, 133, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 98, 0, 151, 152, 153, 155, - 0, 34, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 90, 91, 0, 0, 0, 0, - 0, 0, 0, 0, 11, 45, 50, 0, 0, 0, - 64, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 36, 0, 137, 139, - 0, 0, 0, 0, 0, 0, 100, 0, 122, 0, - 0, 0, 97, 26, 0, 0, 0, 0, 0, 0, - 55, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 69, 0, 70, - 0, 0, 0, 0, 0, 0, 0, 120, 0, 48, - 47, 0, 3, 0, 141, 0, 68, 101, 0, 29, - 0, 30, 0, 0, 0, 23, 0, 24, 0, 0, - 0, 140, 149, 67, 0, 125, 0, 127, 0, 99, - 0, 0, 0, 0, 0, 0, 0, 107, 0, 105, - 0, 116, 0, 121, 54, 65, 0, 0, 0, 0, - 19, 0, 0, 0, 0, 0, 62, 126, 128, 115, - 0, 113, 0, 0, 106, 0, 111, 117, 103, 142, - 27, 28, 21, 0, 22, 0, 32, 0, 114, 112, - 63, 0, 0, 31, 0, 0, 20, 33, + 0, 0, 0, 0, 0, 0, 98, 99, 0, 0, + 0, 0, 0, 0, 0, 0, 13, 0, 53, 58, + 0, 0, 0, 72, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 4, 145, + 147, 0, 0, 0, 0, 0, 0, 0, 108, 0, + 130, 0, 0, 105, 28, 0, 0, 19, 0, 0, + 0, 63, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 77, 0, + 78, 0, 0, 0, 0, 0, 0, 0, 128, 0, + 0, 56, 55, 0, 3, 0, 149, 0, 76, 109, + 0, 45, 0, 31, 46, 0, 32, 0, 0, 0, + 0, 25, 0, 26, 160, 0, 0, 39, 44, 0, + 0, 0, 148, 157, 75, 0, 133, 0, 135, 0, + 107, 0, 0, 0, 0, 0, 0, 0, 115, 0, + 113, 0, 124, 0, 129, 62, 73, 0, 0, 0, + 0, 6, 21, 0, 0, 0, 0, 0, 0, 70, + 134, 136, 123, 0, 121, 0, 0, 114, 0, 119, + 125, 111, 150, 0, 0, 0, 7, 0, 0, 0, + 0, 0, 0, 122, 120, 71, 29, 30, 23, 0, + 0, 24, 0, 35, 0, 0, 5, 0, 0, 0, + 34, 22, 33, 0, 36, }; dEXT short yydgoto[] = { 1, - 9, 10, 83, 17, 86, 3, 11, 12, 66, 195, - 266, 67, 202, 69, 70, 71, 72, 73, 74, 75, - 197, 122, 203, 88, 187, 77, 241, 178, 13, 142, - 2, 14, 15, 16, + 9, 66, 10, 17, 85, 337, 88, 313, 3, 11, + 12, 68, 272, 268, 70, 71, 72, 73, 74, 75, + 76, 278, 78, 279, 262, 265, 269, 281, 263, 266, + 116, 204, 90, 79, 242, 181, 145, 276, 13, 2, + 14, 15, 16, }; dEXT short yysindex[] = { 0, - 0, 0, 303, 0, 0, 0, -53, 0, 0, 0, - 0, 0, 607, 0, 0, 0, -111, -242, -32, 0, - -216, 0, 0, 0, 149, 149, 0, 8, 0, 2109, - 0, 0, -15, -8, 4, 6, 32, 2109, 13, 20, - 57, 149, 994, 2109, 1057, -206, 149, 2109, 938, 1291, - 2109, 2109, 2109, 2109, 2109, 1347, 0, 2109, 2109, 1403, - 149, 149, 149, 149, -203, 0, 68, 664, 491, -67, - -52, 0, 0, -21, 73, 65, 0, 7, 0, -135, - 0, -126, 0, 0, 0, 0, 0, 2109, 92, 2109, - 491, 7, -135, 2109, 7, 2109, 7, 2109, 7, 2109, - 7, 1466, 101, 491, 112, 1700, 938, 0, 102, 0, - 1228, -22, 1228, 39, -58, 2109, 0, 68, 0, 68, - -67, 0, 2109, 0, 1228, 472, 472, 472, -88, -88, - 78, -10, 472, 472, 0, -85, 0, 0, 0, 0, - 7, 0, 2109, 2109, 2109, 2109, 2109, 2109, 2109, 2109, - 2109, 2109, 2109, 2109, 2109, 2109, 2109, 2109, 2109, 2109, - 2109, 2109, 2109, 2109, 0, 0, -29, 2109, 2109, 2109, - 2109, 2109, 2109, 1756, 0, 0, 0, -46, 2109, 391, - 0, 2109, -25, 2109, 7, -214, 129, -203, -5, -203, - 1, -167, 9, -167, 117, 52, 0, 2109, 0, 0, - 23, 60, 132, 2109, 1812, 1875, 0, 53, 0, 68, - 2109, 86, 0, 0, 491, -214, -214, -214, -214, -147, - 0, -54, 382, 1228, 1090, 771, 115, 491, 2942, 1523, - 314, 1554, 392, 677, 472, 472, 2109, 0, 2109, 0, - 141, 89, -42, 99, 46, 114, 64, 0, 26, 0, - 0, 124, 0, 143, 0, 2109, 0, 0, 7, 0, - 7, 0, 7, 7, 146, 0, 7, 0, 2109, 7, - 35, 0, 0, 0, 37, 0, 49, 0, 55, 0, - 130, 2109, 63, 2109, 67, 166, 2109, 0, 66, 0, - 71, 0, 74, 0, 0, 0, 1170, -203, -203, -167, - 0, 2109, -167, 131, -203, 7, 0, 0, 0, 0, - 185, 0, 1119, 76, 0, 161, 0, 0, 0, 0, - 0, 0, 0, 58, 0, 1466, 0, -203, 0, 0, - 0, 7, 162, 0, -167, 7, 0, 0, + 0, 0, -178, 0, 0, 0, -49, 0, 0, 0, + 0, 0, 616, 0, 0, 0, -108, -233, 3, 0, + -230, 0, 0, 0, -24, -24, 0, 28, 0, 1899, + 0, 0, -17, -12, -11, -10, -35, 1899, 39, 54, + 60, 992, 936, -24, 1055, 1319, -217, 0, 0, -24, + 1899, 1899, 1899, 1899, 1899, 1899, 1375, 0, 1899, 1899, + 1431, -24, -24, -24, -24, 1899, -161, 0, 277, 3829, + -69, -42, 0, 0, -4, 88, 89, 97, 0, 24, + 0, -107, 0, -105, 0, 0, 0, 0, 0, 1899, + 114, 1899, 328, 24, -107, 0, 24, 0, 24, 0, + 24, 0, 24, 0, 0, 115, 3829, 133, 1490, 936, + 0, 328, 0, -69, 97, 0, 1899, 0, 137, 0, + 328, -19, 56, 19, 1899, 0, 97, 98, 98, 98, + -82, -82, 93, -21, 98, 98, 0, -87, 0, 0, + 0, 0, 328, 24, 0, 1899, 1899, 1899, 1899, 1899, + 1899, 1899, 1899, 1899, 1899, 1899, 1899, 1899, 1899, 1899, + 1899, 1899, 1899, 1899, 1899, 1899, 0, 0, -32, 1899, + 1899, 1899, 1899, 1899, 1899, 1665, 0, 1899, 0, 0, + -8, 1899, 357, 0, 1899, 82, 1899, 24, 1899, -161, + 1899, -161, 1899, -234, 1899, -234, 144, 1724, 0, 0, + 0, 4, 11, 138, 1899, 97, 1780, 1836, 0, 61, + 0, 1899, 96, 0, 0, -176, -176, 0, -176, -176, + -95, 0, 21, 1092, 328, 373, 434, 92, 3829, 1204, + 3238, 3721, 2430, 815, 419, 98, 98, 1899, 0, 1899, + 0, 173, -80, 55, -68, 57, -54, 68, 0, 6, + 3829, 0, 0, 157, 0, 178, 0, 1899, 0, 0, + -176, 0, 181, 0, 0, 183, 0, -176, 190, 112, + 209, 0, 231, 0, 0, 210, 277, 0, 0, 237, + 224, 1899, 0, 0, 0, 9, 0, 15, 0, 17, + 0, 105, 1899, 163, 1899, 81, 119, 1899, 0, 168, + 0, 175, 0, 185, 0, 0, 0, 1146, 112, 112, + 112, 0, 0, 1899, 112, 1899, 112, 1899, 279, 0, + 0, 0, 0, 143, 0, 3863, 202, 0, 300, 0, + 0, 0, 0, -161, -161, -234, 0, 321, -234, 326, + -161, 309, 112, 0, 0, 0, 0, 0, 0, 398, + 112, 0, 112, 0, 1724, -161, 0, -234, -161, 336, + 0, 0, 0, 112, 0, }; dEXT short yyrindex[] = { 0, - 0, 0, 269, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 220, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 2241, 1964, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 2857, 2901, + 0, 0, 0, 0, 0, 0, 0, 2159, 1989, 0, + 0, 2799, 2867, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 107, 0, 360, -1, 62, 3027, - 3078, 0, 0, 2286, 2020, 0, 0, 0, 0, -12, - 0, 0, 0, 0, 0, 0, 0, 2415, 0, 0, - 1251, 0, 82, 173, 0, 0, 0, 0, 0, 0, - 0, 157, 0, 1661, 0, 0, 178, 0, 2150, 0, - 3927, 3027, 3958, 0, 0, 2415, 0, 2537, 454, 2581, - 548, 0, 0, 0, 3989, 3384, 3425, 3461, 3122, 3163, - 2636, 0, 3497, 3533, 0, 0, 0, 0, 0, 0, - 0, 0, 2680, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 65, 0, -25, 193, + 2910, 2954, 0, 0, 2225, 2048, 0, 333, 0, 0, + 0, 2, 0, 0, 0, 0, 0, 0, 0, 2284, + 0, 0, 3575, 0, 257, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 3017, 0, 0, 348, + 0, 3642, 496, 557, 2395, 0, 0, 0, 2111, 0, + 3695, 2910, 0, 0, 2284, 0, 2520, 3065, 3103, 3190, + 659, 2997, 2563, 0, 3301, 3354, 0, 0, 0, 0, + 0, 0, 3741, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 163, 882, - 0, 178, 0, 2415, 0, 2, 0, 107, 0, 107, - 0, 175, 0, 175, 0, 165, 0, 0, 0, 0, - 0, 180, 0, 0, 0, 0, 0, 0, 0, 2723, - 0, 2985, 0, 0, 2785, 11, 14, 33, 59, 833, - 0, 0, -30, 4020, 4036, 3817, 3850, 3275, 0, 1611, - 4179, 4114, 4098, 3894, 3569, 3646, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 2631, 0, 0, + 0, 331, 880, 0, 348, 0, 2284, 0, 352, 65, + 0, 65, 0, 164, 0, 164, 0, 338, 0, 0, + 0, 0, 358, 0, 0, 2674, 0, 0, 0, 0, + 0, 0, 2718, 0, 0, -22, 36, 0, 91, 110, + -33, 0, 0, 2573, 1267, 1531, 3476, 3521, 3675, 0, + -27, 3826, 3794, 1587, -6, 3392, 3440, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 3787, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 134, 0, 0, 0, 0, 0, 0, 359, 0, 0, + 0, 0, 0, 0, 0, 0, 155, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 168, 0, + 0, 0, 0, 0, 0, 0, 0, 348, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 178, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 107, 107, 175, - 0, 0, 175, 0, 107, 0, 0, 0, 0, 0, - 0, 0, 2462, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 190, 0, 107, 0, 0, - 0, 0, 0, 0, 175, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 349, 0, 0, + 0, 0, 0, 0, 0, 1953, 0, 0, 0, 0, + 0, 0, 0, 65, 65, 164, 0, 0, 164, 0, + 65, 0, 0, 0, 0, 0, 0, 0, 0, 880, + 0, 0, 0, 0, 368, 65, 0, 164, 65, 0, + 0, 0, 0, 0, 0, }; dEXT short yygindex[] = { 0, - 0, 0, 0, 148, -13, 106, 0, 0, 0, -91, - -184, 452, -11, 4373, 886, 0, 0, 0, 0, 0, - 234, -62, -173, 460, -20, 0, 0, 174, 0, -131, - 0, 0, 0, 0, + 0, 0, 0, 136, -29, 0, 4145, 680, -78, 0, + 0, 0, -193, -13, 3266, 519, 0, 0, 0, 0, + 0, 400, 885, 0, 0, 267, -196, 63, 124, 250, + -16, -167, 20, 0, 0, 320, 356, 0, 0, 0, + 0, 0, 0, }; -#define YYTABLESIZE 4657 -dEXT short yytable[] = { 65, - 208, 68, 168, 79, 283, 20, 61, 213, 254, 268, - 80, 23, 250, 80, 80, 255, 289, 206, 256, 95, - 97, 99, 101, 170, 94, 181, 81, 80, 80, 110, - 212, 96, 80, 115, 150, 261, 124, 157, 172, 13, - 82, 263, 38, 98, 132, 100, 49, 90, 136, 267, - 116, 16, 105, 209, 17, 169, 260, 13, 262, 106, - 38, 239, 80, 272, 176, 168, 294, 61, 170, 16, - 171, 102, 17, 14, 141, 306, 23, 307, 184, 148, - 149, 188, 186, 190, 189, 192, 191, 194, 193, 308, - 196, 14, 270, 237, 201, 309, 107, 150, 332, 15, - 169, 173, 60, 273, 291, 60, 25, 23, 264, 265, - 49, 143, 174, 316, 23, 323, 252, 15, 325, 60, - 60, 257, 293, 175, 177, 314, 23, 214, 23, 23, - 179, 182, 216, 217, 218, 219, 220, 221, 222, 25, - 198, 205, 25, 25, 25, 78, 25, 149, 25, 25, - 337, 25, 199, 18, 60, 21, 242, 243, 244, 245, - 246, 247, 249, 207, 251, 25, 321, 322, 211, 259, - 25, 258, 274, 327, 18, 269, 282, 280, 92, 93, - 287, 288, 295, 296, 61, 302, 271, 312, 180, 326, - 317, 290, 275, 277, 279, 318, 334, 25, 319, 281, - 330, 331, 336, 19, 49, 168, 292, 18, 148, 149, - 18, 18, 18, 37, 18, 35, 18, 18, 147, 18, - 148, 145, 310, 13, 167, 285, 37, 286, 238, 25, - 35, 25, 25, 18, 333, 148, 149, 150, 18, 148, - 149, 80, 80, 80, 80, 298, 76, 299, 304, 300, - 301, 148, 149, 303, 0, 151, 305, 186, 315, 152, - 153, 154, 155, 80, 80, 18, 185, 80, 2, 0, - 311, 23, 156, 158, 159, 160, 161, 329, 162, 163, - 0, 0, 164, 148, 149, 165, 166, 167, 148, 149, - 324, 0, 328, 0, 148, 149, 0, 18, 0, 18, - 18, 39, 148, 149, 39, 39, 39, 0, 39, 0, - 39, 39, 0, 39, 68, 0, 148, 149, 335, 148, - 149, 0, 338, 144, 145, 146, 147, 39, 148, 149, - 148, 149, 39, 60, 60, 60, 60, 0, 0, 148, - 149, 0, 148, 149, 0, 148, 149, 0, 148, 149, - 0, 148, 149, 148, 149, 60, 60, 148, 149, 39, - 148, 149, 25, 25, 25, 25, 25, 25, 0, 25, - 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, - 25, 25, 148, 149, 0, 25, 25, 0, 25, 25, - 25, 39, 148, 149, 39, 25, 25, 25, 25, 25, - 57, 154, 25, 25, 168, 84, 0, 148, 149, 25, - 85, 0, 0, 25, 0, 25, 25, 0, 57, 163, - 0, 0, 164, 148, 149, 165, 166, 167, 0, 0, - 18, 18, 18, 18, 18, 18, 150, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 0, 0, 57, 18, 18, 0, 18, 18, 18, 148, - 149, 0, 0, 18, 18, 18, 18, 18, 0, 0, - 18, 18, 168, 0, 0, 0, 0, 18, 148, 149, - 0, 18, 168, 18, 18, 89, 156, 0, 0, 156, - 156, 156, 0, 156, 143, 156, 156, 143, 156, 118, - 120, 108, 0, 0, 150, 0, 117, 0, 123, 0, - 0, 143, 143, 0, 150, 253, 143, 156, 0, 0, - 137, 138, 139, 140, 39, 39, 39, 39, 39, 39, - 0, 39, 39, 39, 0, 0, 0, 39, 0, 120, - 39, 39, 39, 39, 143, 0, 143, 39, 39, 0, - 39, 39, 39, 157, 0, 0, 0, 39, 39, 39, - 39, 39, 168, 0, 39, 39, 204, 120, 4, 5, - 6, 39, 7, 8, 210, 39, 143, 39, 39, 156, - 157, 168, 0, 157, 157, 157, 0, 157, 102, 157, - 157, 102, 157, 0, 150, 0, 0, 0, 152, 153, - 154, 155, 0, 0, 0, 102, 102, 0, 0, 0, - 102, 157, 0, 150, 160, 161, 0, 162, 163, 0, - 0, 164, 0, 0, 165, 166, 167, 0, 0, 0, - 120, 57, 57, 57, 57, 120, 0, 0, 0, 51, - 102, 0, 61, 63, 47, 0, 56, 0, 64, 59, - 0, 58, 0, 57, 57, 0, 4, 5, 6, 0, - 7, 8, 0, 0, 0, 57, 152, 153, 154, 155, - 62, 0, 0, 157, 0, 0, 152, 153, 154, 155, - 158, 159, 160, 161, 0, 162, 163, 0, 0, 164, - 0, 0, 165, 166, 167, 162, 163, 60, 0, 164, - 0, 0, 165, 166, 167, 0, 0, 0, 0, 0, - 156, 156, 156, 156, 156, 0, 156, 156, 156, 0, - 0, 0, 156, 0, 0, 143, 143, 143, 143, 23, - 0, 0, 52, 156, 143, 156, 156, 156, 143, 143, - 143, 143, 156, 156, 156, 156, 156, 143, 143, 156, - 156, 143, 143, 143, 143, 143, 156, 143, 143, 0, - 156, 143, 156, 156, 143, 143, 143, 168, 0, 0, - 0, 151, 0, 0, 0, 152, 153, 154, 155, 164, - 0, 0, 165, 166, 167, 0, 0, 0, 156, 158, - 159, 160, 161, 0, 162, 163, 0, 0, 164, 150, - 0, 165, 166, 167, 157, 157, 157, 157, 157, 0, - 157, 157, 157, 0, 0, 0, 157, 0, 0, 102, - 102, 102, 102, 0, 0, 0, 0, 157, 102, 157, - 157, 157, 102, 102, 102, 102, 157, 157, 157, 157, - 157, 102, 102, 157, 157, 102, 102, 102, 102, 102, - 157, 102, 102, 0, 157, 102, 157, 157, 102, 102, - 102, 168, 22, 24, 25, 26, 27, 28, 0, 29, - 30, 31, 0, 56, 0, 32, 56, 0, 33, 34, - 35, 36, 0, 0, 0, 37, 38, 0, 39, 40, - 41, 56, 0, 150, 0, 42, 43, 44, 45, 46, - 0, 0, 48, 49, 0, 0, 0, 0, 0, 50, - 87, 87, 0, 53, 39, 54, 55, 39, 39, 39, - 0, 39, 103, 39, 39, 56, 39, 87, 112, 0, - 0, 0, 87, 0, 121, 144, 145, 146, 147, 0, - 39, 0, 0, 0, 0, 39, 87, 87, 87, 87, - 0, 0, 0, 0, 0, 0, 0, 148, 149, 0, - 0, 0, 0, 154, 155, 0, 0, 0, 0, 0, - 51, 0, 39, 61, 63, 47, 0, 56, 0, 64, - 59, 163, 58, 0, 164, 0, 0, 165, 166, 167, - 0, 0, 121, 0, 0, 0, 0, 0, 0, 0, - 0, 62, 0, 0, 39, 0, 0, 39, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 51, 0, 60, 61, - 63, 47, 0, 56, 0, 64, 59, 0, 58, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 240, 0, 0, 0, 0, 62, 0, 0, - 23, 0, 0, 52, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 163, 0, 0, 164, 0, - 0, 165, 166, 167, 60, 0, 0, 0, 0, 51, - 0, 0, 61, 63, 47, 0, 56, 0, 64, 59, - 0, 58, 0, 0, 56, 56, 56, 56, 0, 0, - 0, 0, 0, 0, 0, 114, 23, 0, 0, 52, - 62, 0, 0, 0, 0, 0, 56, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 39, 39, 39, - 39, 39, 39, 0, 39, 39, 39, 60, 0, 0, - 39, 0, 0, 39, 39, 39, 39, 0, 0, 0, - 39, 39, 0, 39, 39, 39, 0, 0, 0, 0, - 39, 39, 39, 39, 39, 0, 0, 39, 39, 0, - 168, 157, 52, 0, 39, 0, 0, 0, 39, 0, - 39, 39, 0, 0, 119, 25, 26, 27, 28, 85, - 29, 30, 31, 0, 0, 0, 32, 0, 0, 168, - 320, 0, 150, 0, 0, 0, 0, 38, 0, 39, - 40, 41, 0, 0, 0, 0, 42, 43, 44, 45, - 46, 0, 157, 48, 49, 0, 0, 0, 0, 0, - 50, 150, 0, 0, 53, 0, 54, 55, 0, 0, - 109, 25, 26, 27, 28, 0, 29, 30, 31, 0, - 168, 0, 32, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 38, 0, 39, 40, 41, 0, 0, - 0, 0, 42, 43, 44, 45, 46, 0, 0, 48, - 49, 135, 150, 0, 135, 0, 50, 0, 0, 0, - 53, 0, 54, 55, 0, 0, 0, 0, 135, 135, - 0, 0, 0, 24, 25, 26, 27, 28, 168, 29, - 30, 31, 0, 51, 0, 32, 61, 63, 47, 0, - 56, 0, 64, 59, 0, 58, 38, 0, 39, 40, - 41, 0, 0, 135, 0, 42, 43, 44, 45, 46, - 150, 0, 48, 49, 62, 0, 0, 0, 0, 50, - 0, 0, 0, 53, 0, 54, 55, 0, 0, 0, - 0, 0, 0, 0, 152, 0, 154, 155, 0, 51, - 0, 60, 61, 63, 47, 0, 56, 131, 64, 59, - 0, 58, 0, 162, 163, 0, 0, 164, 0, 151, - 165, 166, 167, 152, 153, 154, 155, 0, 0, 0, - 62, 0, 0, 23, 0, 0, 52, 158, 159, 160, - 161, 0, 162, 163, 0, 0, 164, 0, 0, 165, - 166, 167, 0, 0, 0, 51, 0, 60, 61, 63, - 47, 0, 56, 0, 64, 59, 0, 58, 0, 0, - 151, 0, 0, 0, 152, 153, 154, 155, 0, 0, - 0, 0, 0, 0, 0, 0, 62, 156, 158, 159, - 160, 161, 52, 162, 163, 0, 0, 164, 0, 0, - 165, 166, 167, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 60, 0, 135, 0, 0, 51, 0, - 0, 61, 63, 47, 0, 56, 0, 64, 59, 0, - 58, 0, 0, 0, 154, 155, 0, 0, 0, 0, - 0, 0, 135, 135, 135, 135, 0, 0, 52, 62, - 0, 162, 163, 0, 0, 164, 0, 0, 165, 166, - 167, 0, 0, 0, 135, 135, 0, 24, 25, 26, - 27, 28, 0, 29, 30, 31, 60, 0, 0, 32, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 38, 0, 39, 40, 41, 0, 0, 0, 0, 42, - 43, 44, 45, 46, 0, 0, 48, 49, 0, 0, - 0, 52, 0, 50, 0, 0, 0, 53, 0, 54, - 55, 0, 0, 24, 25, 26, 27, 28, 0, 29, - 30, 31, 0, 168, 0, 32, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 38, 0, 39, 40, - 41, 0, 0, 0, 0, 42, 43, 44, 45, 46, - 0, 0, 48, 49, 168, 150, 0, 0, 0, 50, - 0, 82, 0, 53, 82, 54, 55, 0, 0, 24, - 25, 26, 27, 28, 0, 29, 30, 31, 82, 82, - 0, 32, 0, 82, 0, 0, 150, 0, 0, 0, - 0, 0, 38, 0, 39, 40, 41, 0, 0, 0, - 0, 42, 43, 44, 45, 46, 0, 0, 48, 49, - 0, 130, 0, 82, 130, 50, 0, 0, 0, 53, - 0, 54, 55, 0, 0, 0, 0, 0, 130, 130, - 0, 22, 24, 25, 26, 27, 28, 0, 29, 30, - 31, 0, 51, 0, 32, 61, 63, 47, 0, 56, - 200, 64, 59, 0, 58, 38, 0, 39, 40, 41, - 0, 0, 0, 130, 42, 43, 44, 45, 46, 0, - 0, 48, 49, 62, 0, 0, 0, 0, 50, 0, - 0, 0, 53, 0, 54, 55, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 51, 0, - 60, 61, 63, 47, 0, 56, 248, 64, 59, 0, - 58, 0, 0, 0, 0, 0, 0, 152, 153, 154, - 155, 0, 0, 0, 0, 0, 0, 0, 0, 62, - 0, 0, 159, 160, 161, 52, 162, 163, 0, 0, - 164, 0, 0, 165, 166, 167, 0, 0, 152, 153, - 154, 155, 0, 0, 51, 0, 60, 61, 63, 47, - 0, 56, 276, 64, 59, 161, 58, 162, 163, 0, - 0, 164, 0, 0, 165, 166, 167, 0, 0, 0, - 0, 0, 0, 0, 0, 62, 0, 0, 0, 0, - 0, 52, 82, 82, 82, 82, 0, 0, 0, 0, - 0, 82, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 60, 0, 82, 82, 0, 51, 82, 82, - 61, 63, 47, 0, 56, 278, 64, 59, 0, 58, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 130, 130, 130, 130, 0, 52, 62, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 130, 130, 24, 25, 26, 27, - 28, 0, 29, 30, 31, 60, 0, 0, 32, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, - 0, 39, 40, 41, 0, 0, 0, 0, 42, 43, - 44, 45, 46, 0, 0, 48, 49, 0, 0, 0, - 52, 0, 50, 0, 136, 0, 53, 136, 54, 55, - 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, - 31, 136, 136, 0, 32, 0, 136, 0, 0, 0, - 0, 0, 0, 0, 0, 38, 0, 39, 40, 41, - 0, 0, 0, 0, 42, 43, 44, 45, 46, 0, - 0, 48, 49, 0, 136, 0, 136, 0, 50, 0, - 119, 0, 53, 119, 54, 55, 0, 0, 24, 25, - 26, 27, 28, 0, 29, 30, 31, 119, 119, 0, - 32, 0, 119, 0, 0, 0, 136, 0, 0, 0, - 0, 38, 0, 39, 40, 41, 0, 0, 0, 0, - 42, 43, 44, 45, 46, 0, 0, 48, 49, 0, - 119, 0, 119, 0, 50, 0, 0, 0, 53, 0, - 54, 55, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, - 0, 51, 119, 32, 61, 63, 47, 0, 56, 0, - 64, 59, 0, 58, 38, 0, 39, 40, 41, 0, - 0, 0, 0, 42, 43, 44, 45, 46, 0, 0, - 48, 49, 62, 0, 0, 0, 0, 50, 0, 0, - 0, 53, 0, 54, 55, 0, 0, 0, 0, 0, - 143, 0, 0, 143, 0, 0, 0, 0, 0, 60, - 0, 0, 0, 0, 0, 0, 0, 143, 143, 0, - 0, 0, 143, 0, 0, 0, 0, 0, 0, 0, +#define YYTABLESIZE 4333 +dEXT short yytable[] = { 69, + 62, 280, 274, 62, 105, 214, 183, 64, 170, 20, + 64, 62, 299, 90, 23, 15, 90, 256, 18, 213, + 208, 172, 96, 82, 301, 64, 84, 98, 100, 102, + 90, 90, 124, 15, 83, 90, 18, 83, 303, 125, + 152, 270, 271, 134, 283, 91, 305, 138, 174, 320, + 252, 83, 83, 171, 284, 321, 83, 322, 240, 64, + 57, 83, 117, 118, 27, 90, 189, 92, 191, 126, + 193, 172, 195, 184, 197, 198, 42, 210, 108, 294, + 173, 139, 140, 141, 142, 319, 83, 4, 5, 6, + 238, 7, 8, 109, 42, 202, 203, 27, 23, 110, + 27, 27, 27, 171, 27, 23, 27, 27, 211, 27, + 23, 23, 23, 300, 23, 302, 144, 338, 175, 340, + 150, 151, 257, 27, 57, 258, 304, 176, 27, 205, + 329, 16, 216, 217, 219, 220, 221, 222, 223, 327, + 178, 18, 349, 21, 159, 352, 23, 177, 80, 16, + 17, 182, 180, 185, 199, 27, 243, 244, 245, 246, + 247, 248, 250, 20, 362, 254, 94, 95, 17, 282, + 259, 203, 170, 200, 41, 261, 207, 217, 285, 62, + 209, 217, 170, 212, 277, 291, 293, 27, 170, 27, + 27, 286, 41, 288, 290, 43, 20, 323, 292, 20, + 20, 20, 151, 20, 152, 20, 20, 19, 20, 150, + 151, 328, 298, 15, 152, 306, 150, 151, 307, 2, + 152, 309, 20, 310, 296, 239, 297, 20, 150, 151, + 311, 169, 86, 68, 312, 344, 68, 87, 64, 64, + 64, 64, 150, 151, 90, 90, 90, 90, 314, 316, + 68, 68, 47, 90, 20, 47, 47, 47, 350, 47, + 104, 47, 47, 64, 47, 83, 83, 83, 83, 90, + 90, 315, 90, 90, 83, 150, 151, 317, 47, 324, + 83, 83, 318, 47, 203, 68, 20, 325, 20, 20, + 83, 83, 330, 83, 83, 83, 83, 83, 83, 331, + 150, 151, 150, 151, 261, 150, 151, 150, 151, 332, + 47, 150, 151, 150, 151, 150, 151, 150, 151, 343, + 27, 27, 27, 27, 27, 27, 345, 27, 27, 27, + 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, + 346, 69, 47, 27, 27, 47, 27, 27, 27, 27, + 27, 150, 151, 150, 151, 27, 27, 27, 27, 27, + 27, 351, 153, 27, 150, 151, 353, 355, 154, 155, + 156, 157, 27, 65, 27, 27, 364, 150, 151, 57, + 156, 158, 160, 161, 162, 163, 164, 165, 155, 153, + 166, 65, 40, 167, 168, 169, 38, 165, 156, 43, + 166, 150, 151, 167, 168, 169, 166, 40, 38, 167, + 168, 169, 77, 218, 188, 150, 151, 360, 170, 20, + 20, 20, 20, 20, 20, 65, 20, 20, 20, 20, + 20, 20, 20, 20, 20, 20, 20, 20, 20, 150, + 151, 342, 20, 20, 273, 20, 20, 20, 20, 20, + 152, 0, 0, 0, 20, 20, 20, 20, 20, 20, + 0, 0, 20, 170, 68, 68, 68, 68, 0, 0, + 0, 20, 0, 20, 20, 47, 47, 47, 47, 47, + 47, 255, 47, 47, 47, 0, 0, 0, 47, 68, + 68, 47, 47, 47, 47, 152, 0, 0, 47, 47, + 0, 47, 47, 47, 47, 47, 0, 0, 0, 170, + 47, 47, 47, 47, 47, 47, 0, 0, 47, 0, + 0, 0, 357, 0, 170, 0, 0, 47, 167, 47, + 47, 167, 167, 167, 0, 167, 151, 167, 167, 151, + 167, 152, 0, 89, 89, 264, 0, 267, 146, 147, + 148, 149, 0, 151, 151, 106, 152, 0, 151, 167, + 0, 114, 89, 122, 0, 0, 0, 0, 89, 0, + 0, 0, 0, 150, 151, 0, 0, 0, 0, 0, + 89, 89, 89, 89, 0, 0, 151, 0, 151, 168, + 0, 0, 168, 168, 168, 0, 168, 110, 168, 168, + 110, 168, 0, 0, 65, 65, 65, 65, 0, 0, + 0, 0, 0, 0, 110, 110, 156, 157, 151, 110, + 168, 167, 4, 5, 6, 0, 7, 8, 114, 65, + 65, 0, 164, 165, 0, 0, 166, 0, 0, 167, + 168, 169, 0, 0, 0, 0, 0, 0, 52, 110, + 0, 62, 64, 50, 0, 57, 0, 65, 60, 154, + 59, 156, 157, 4, 5, 6, 0, 7, 8, 0, + 0, 0, 0, 0, 58, 0, 0, 164, 165, 63, + 0, 166, 168, 0, 167, 168, 169, 241, 0, 347, + 348, 0, 0, 0, 0, 0, 354, 0, 0, 100, + 0, 0, 100, 0, 0, 0, 61, 156, 157, 0, + 0, 361, 0, 0, 363, 275, 100, 100, 0, 0, + 0, 100, 0, 0, 165, 0, 0, 166, 0, 0, + 167, 168, 169, 0, 0, 0, 0, 0, 23, 165, + 0, 53, 166, 0, 0, 167, 168, 169, 0, 0, + 0, 100, 167, 167, 167, 167, 167, 0, 167, 167, + 167, 0, 0, 0, 167, 0, 0, 151, 151, 151, + 151, 0, 0, 0, 0, 167, 151, 167, 167, 167, + 167, 167, 151, 151, 151, 151, 167, 167, 167, 167, + 167, 167, 151, 151, 167, 151, 151, 151, 151, 151, + 151, 151, 0, 167, 151, 167, 167, 151, 151, 151, + 0, 0, 0, 168, 168, 168, 168, 168, 0, 168, + 168, 168, 0, 0, 0, 168, 0, 0, 110, 110, + 110, 110, 0, 0, 0, 0, 168, 110, 168, 168, + 168, 168, 168, 110, 110, 110, 110, 168, 168, 168, + 168, 168, 168, 110, 110, 168, 110, 110, 110, 110, + 110, 110, 110, 0, 168, 110, 168, 168, 110, 110, + 110, 22, 24, 25, 26, 27, 28, 0, 29, 30, + 31, 0, 0, 0, 32, 0, 0, 33, 34, 35, + 36, 0, 0, 0, 37, 38, 0, 39, 40, 41, + 42, 43, 0, 0, 0, 170, 44, 45, 46, 47, + 48, 49, 47, 0, 51, 47, 47, 47, 0, 47, + 0, 47, 47, 54, 47, 55, 56, 115, 0, 0, + 100, 100, 100, 100, 0, 127, 0, 152, 47, 100, + 0, 0, 0, 47, 0, 100, 100, 100, 100, 0, + 0, 0, 0, 0, 0, 100, 100, 0, 100, 100, + 100, 100, 100, 100, 100, 0, 0, 100, 52, 0, + 47, 62, 64, 50, 115, 57, 0, 65, 60, 0, + 59, 0, 0, 0, 0, 0, 0, 0, 334, 335, + 336, 0, 0, 0, 339, 0, 341, 0, 0, 63, + 0, 206, 47, 0, 0, 47, 0, 0, 0, 115, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 52, 136, 136, 136, 136, 0, - 143, 0, 143, 0, 136, 0, 0, 0, 136, 136, - 136, 136, 0, 0, 0, 0, 0, 136, 136, 0, - 0, 136, 136, 136, 136, 136, 0, 136, 136, 0, - 0, 136, 143, 0, 136, 136, 136, 0, 0, 0, - 0, 129, 0, 0, 129, 0, 0, 0, 0, 0, - 0, 119, 119, 119, 119, 0, 0, 0, 129, 129, - 119, 0, 0, 129, 119, 119, 119, 119, 0, 0, - 0, 0, 0, 119, 119, 0, 0, 119, 119, 119, - 119, 119, 0, 119, 119, 0, 104, 119, 0, 104, - 119, 119, 119, 129, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 104, 104, 0, 0, 0, 104, 0, + 0, 0, 356, 0, 52, 0, 61, 62, 64, 50, + 358, 57, 359, 65, 60, 0, 59, 0, 0, 0, + 0, 0, 0, 365, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 63, 0, 0, 23, 0, + 0, 53, 0, 0, 0, 0, 115, 0, 0, 0, + 0, 115, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 61, 0, 0, 0, 0, 52, 0, 0, + 62, 64, 50, 0, 57, 0, 65, 60, 0, 59, + 0, 154, 155, 156, 157, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 23, 0, 0, 53, 63, 164, + 165, 0, 0, 166, 0, 0, 167, 168, 169, 0, + 0, 0, 0, 0, 0, 47, 47, 47, 47, 47, + 47, 0, 47, 47, 47, 61, 0, 0, 47, 0, + 0, 47, 47, 47, 47, 0, 0, 0, 47, 47, + 0, 47, 47, 47, 47, 47, 0, 0, 0, 0, + 47, 47, 47, 47, 47, 47, 0, 23, 47, 0, + 53, 0, 170, 0, 0, 0, 333, 47, 0, 47, + 47, 0, 113, 25, 26, 27, 28, 87, 29, 30, + 31, 0, 0, 0, 32, 0, 0, 0, 159, 0, + 0, 0, 0, 0, 152, 38, 0, 39, 40, 41, + 42, 43, 0, 0, 0, 0, 44, 45, 46, 47, + 48, 49, 0, 0, 51, 0, 170, 0, 0, 0, + 0, 0, 0, 54, 0, 55, 56, 0, 24, 25, + 26, 27, 28, 0, 29, 30, 31, 0, 0, 0, + 32, 295, 0, 0, 0, 0, 159, 0, 152, 0, + 0, 38, 0, 39, 40, 41, 42, 43, 0, 0, + 0, 0, 44, 45, 46, 47, 48, 49, 0, 0, + 51, 0, 0, 0, 170, 0, 0, 0, 0, 54, + 0, 55, 56, 0, 0, 0, 0, 84, 0, 0, + 84, 119, 25, 26, 27, 28, 0, 29, 30, 31, + 0, 0, 0, 32, 84, 84, 152, 0, 0, 84, + 0, 0, 0, 0, 38, 0, 39, 40, 41, 42, + 43, 0, 0, 0, 0, 44, 45, 46, 47, 48, + 49, 52, 0, 51, 62, 64, 50, 0, 57, 84, + 65, 60, 54, 59, 55, 56, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 123, 154, 155, + 156, 157, 63, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 160, 161, 162, 163, 164, 165, 0, 0, + 166, 0, 0, 167, 168, 169, 0, 52, 0, 61, + 62, 64, 50, 0, 57, 133, 65, 60, 0, 59, + 0, 0, 0, 0, 0, 0, 153, 0, 0, 0, + 0, 0, 154, 155, 156, 157, 0, 0, 63, 0, + 0, 0, 0, 0, 53, 158, 160, 161, 162, 163, + 164, 165, 0, 0, 166, 0, 0, 167, 168, 169, + 0, 0, 0, 52, 0, 61, 62, 64, 50, 0, + 57, 0, 65, 60, 0, 59, 0, 0, 0, 0, + 0, 0, 0, 0, 153, 0, 0, 0, 0, 0, + 154, 155, 156, 157, 63, 0, 0, 0, 0, 0, + 53, 0, 0, 158, 160, 161, 162, 163, 164, 165, + 0, 0, 166, 0, 0, 167, 168, 169, 0, 0, + 0, 61, 52, 137, 0, 62, 64, 50, 0, 57, + 201, 65, 60, 0, 59, 0, 0, 0, 84, 84, + 84, 84, 0, 0, 0, 0, 0, 84, 0, 0, + 0, 0, 0, 63, 84, 0, 53, 0, 0, 0, + 0, 0, 0, 84, 84, 0, 84, 84, 84, 84, + 84, 85, 0, 0, 85, 24, 25, 26, 27, 28, + 61, 29, 30, 31, 0, 0, 0, 32, 85, 85, + 0, 0, 0, 85, 0, 0, 0, 0, 38, 0, + 39, 40, 41, 42, 43, 0, 0, 0, 0, 44, + 45, 46, 47, 48, 49, 53, 0, 51, 0, 0, + 0, 0, 0, 85, 0, 0, 54, 86, 55, 56, + 86, 24, 25, 26, 27, 28, 0, 29, 30, 31, + 0, 0, 0, 32, 86, 86, 0, 0, 0, 86, + 0, 0, 0, 0, 38, 0, 39, 40, 41, 42, + 43, 0, 0, 0, 0, 44, 45, 46, 47, 48, + 49, 0, 0, 51, 0, 0, 0, 0, 0, 86, + 0, 0, 54, 0, 55, 56, 0, 24, 25, 26, + 27, 28, 0, 29, 30, 31, 0, 52, 0, 32, + 62, 64, 50, 0, 57, 249, 65, 60, 0, 59, + 38, 0, 39, 40, 41, 42, 43, 0, 0, 0, + 0, 44, 45, 46, 47, 48, 49, 0, 63, 51, + 0, 0, 0, 0, 0, 0, 0, 0, 54, 0, + 55, 56, 0, 0, 0, 0, 24, 25, 26, 27, + 28, 0, 29, 30, 31, 61, 52, 0, 32, 62, + 64, 50, 0, 57, 0, 65, 60, 0, 59, 38, + 0, 39, 40, 41, 42, 43, 0, 0, 0, 0, + 44, 45, 46, 47, 48, 49, 0, 63, 51, 0, + 53, 0, 0, 0, 0, 0, 0, 54, 0, 55, + 56, 0, 85, 85, 85, 85, 0, 0, 0, 0, + 0, 85, 52, 0, 61, 62, 64, 50, 0, 57, + 287, 65, 60, 0, 59, 0, 0, 85, 85, 0, + 85, 85, 85, 85, 85, 0, 0, 0, 0, 0, + 0, 0, 0, 63, 0, 0, 0, 0, 0, 53, + 0, 0, 0, 0, 0, 0, 0, 0, 86, 86, + 86, 86, 0, 0, 0, 0, 0, 86, 52, 0, + 61, 62, 64, 50, 0, 57, 289, 65, 60, 0, + 59, 0, 0, 86, 86, 0, 86, 86, 86, 86, + 86, 0, 0, 0, 0, 0, 0, 0, 0, 63, + 0, 0, 0, 0, 0, 53, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 129, 0, 24, 25, 26, 27, 28, - 0, 29, 30, 31, 0, 0, 104, 32, 104, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 38, 0, - 39, 40, 41, 0, 0, 0, 0, 42, 43, 44, - 45, 46, 0, 0, 48, 49, 0, 0, 0, 0, - 0, 50, 0, 0, 0, 53, 0, 54, 55, 0, - 0, 143, 143, 143, 143, 0, 0, 0, 0, 0, - 143, 0, 0, 0, 143, 143, 143, 143, 0, 0, - 0, 0, 0, 143, 143, 0, 0, 143, 143, 143, - 143, 143, 0, 143, 143, 145, 0, 143, 145, 0, - 143, 143, 143, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 145, 145, 0, 0, 0, 145, 0, 0, + 0, 24, 25, 26, 27, 28, 61, 29, 30, 31, + 0, 52, 0, 32, 62, 64, 50, 0, 57, 0, + 65, 60, 0, 59, 38, 0, 39, 40, 41, 42, + 43, 0, 0, 0, 0, 44, 45, 46, 47, 48, + 49, 53, 63, 51, 0, 0, 0, 0, 0, 0, + 0, 0, 54, 0, 55, 56, 0, 0, 0, 22, + 24, 25, 26, 27, 28, 0, 29, 30, 31, 61, + 0, 0, 32, 91, 0, 0, 91, 0, 0, 0, + 0, 0, 0, 38, 0, 39, 40, 41, 42, 43, + 91, 91, 0, 0, 44, 45, 46, 47, 48, 49, + 0, 0, 51, 0, 53, 0, 0, 0, 0, 144, + 0, 54, 144, 55, 56, 0, 24, 25, 26, 27, + 28, 0, 29, 30, 31, 91, 144, 144, 32, 0, + 0, 144, 0, 0, 0, 0, 0, 0, 0, 38, + 0, 39, 40, 41, 42, 43, 0, 0, 0, 0, + 44, 45, 46, 47, 48, 49, 0, 0, 51, 144, + 0, 144, 0, 0, 0, 0, 0, 54, 127, 55, + 56, 127, 24, 25, 26, 27, 28, 0, 29, 30, + 31, 0, 0, 0, 32, 127, 127, 0, 0, 0, + 127, 144, 0, 0, 0, 38, 0, 39, 40, 41, + 42, 43, 0, 0, 0, 0, 44, 45, 46, 47, + 48, 49, 0, 0, 51, 0, 0, 0, 127, 0, + 127, 0, 0, 54, 0, 55, 56, 0, 0, 0, + 0, 151, 0, 0, 151, 24, 25, 26, 27, 28, + 0, 29, 30, 31, 0, 0, 0, 32, 151, 151, + 127, 0, 0, 151, 0, 0, 0, 0, 38, 0, + 39, 40, 41, 42, 43, 0, 0, 0, 0, 44, + 45, 46, 47, 48, 49, 0, 0, 51, 0, 137, + 0, 151, 137, 151, 0, 0, 54, 0, 55, 56, + 0, 0, 0, 0, 0, 0, 137, 137, 0, 0, + 0, 137, 0, 0, 91, 91, 91, 91, 0, 0, + 0, 0, 0, 151, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 91, + 91, 137, 91, 0, 0, 0, 0, 0, 0, 0, + 144, 144, 144, 144, 0, 112, 0, 0, 112, 144, + 0, 0, 0, 0, 0, 144, 144, 144, 144, 0, + 0, 137, 112, 112, 0, 144, 144, 112, 144, 144, + 144, 144, 144, 144, 144, 0, 0, 144, 0, 0, + 144, 144, 144, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 112, 0, 112, 0, 127, + 127, 127, 127, 0, 153, 0, 0, 153, 127, 0, + 0, 0, 0, 0, 127, 127, 127, 127, 0, 0, + 0, 153, 153, 0, 127, 127, 153, 127, 127, 127, + 127, 127, 127, 127, 0, 0, 127, 0, 0, 127, + 127, 127, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 153, 0, 0, 0, + 0, 0, 151, 151, 151, 151, 0, 0, 0, 0, + 0, 151, 0, 0, 0, 0, 0, 151, 151, 151, + 151, 0, 0, 0, 0, 0, 153, 151, 151, 0, + 151, 151, 151, 151, 151, 151, 151, 0, 0, 151, + 0, 0, 151, 151, 151, 0, 0, 0, 0, 0, + 137, 137, 137, 137, 0, 154, 0, 0, 0, 137, + 0, 0, 0, 0, 0, 137, 137, 137, 137, 0, + 0, 0, 154, 154, 0, 137, 137, 154, 137, 137, + 137, 137, 137, 137, 137, 0, 0, 137, 0, 0, + 137, 137, 137, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 154, 0, 154, 0, 0, + 0, 0, 0, 0, 0, 0, 112, 112, 112, 112, + 0, 0, 0, 0, 0, 112, 0, 0, 0, 0, + 0, 112, 112, 112, 112, 0, 0, 154, 0, 0, + 170, 112, 112, 0, 112, 112, 112, 112, 112, 112, + 112, 0, 0, 112, 0, 0, 112, 112, 112, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 152, 0, 0, 153, 153, 153, 153, 0, + 139, 0, 0, 0, 153, 0, 0, 0, 0, 0, + 153, 153, 153, 153, 0, 0, 0, 139, 139, 0, + 153, 153, 139, 153, 153, 153, 153, 153, 153, 153, + 0, 0, 153, 0, 0, 153, 153, 153, 0, 0, + 0, 0, 0, 104, 0, 0, 104, 0, 0, 0, + 139, 0, 139, 88, 0, 0, 88, 0, 0, 0, + 104, 104, 0, 0, 0, 104, 0, 0, 0, 0, + 88, 88, 0, 0, 0, 88, 0, 0, 0, 0, + 0, 0, 139, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 104, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 88, 154, 154, 154, 154, + 0, 66, 0, 0, 66, 154, 0, 0, 0, 0, + 0, 154, 154, 154, 154, 104, 0, 0, 66, 66, + 0, 154, 154, 66, 154, 154, 154, 154, 154, 154, + 154, 0, 0, 154, 0, 0, 154, 154, 154, 0, + 0, 0, 0, 0, 69, 0, 154, 155, 156, 157, + 0, 0, 0, 66, 0, 0, 0, 0, 0, 0, + 0, 69, 69, 163, 164, 165, 69, 0, 166, 0, + 0, 167, 168, 169, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 66, 0, 0, 0, 0, 103, 0, + 0, 103, 0, 0, 69, 0, 69, 0, 0, 0, + 0, 0, 0, 0, 0, 103, 103, 0, 0, 0, + 103, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 139, 139, 139, 139, 0, 69, 0, 0, 0, + 139, 0, 0, 0, 0, 0, 139, 139, 139, 139, + 103, 0, 0, 0, 0, 0, 139, 139, 0, 139, + 139, 139, 139, 139, 139, 139, 0, 0, 139, 0, + 0, 139, 139, 139, 104, 104, 104, 104, 0, 140, + 103, 0, 140, 104, 88, 88, 88, 88, 0, 104, + 104, 104, 104, 0, 0, 0, 140, 140, 0, 104, + 104, 140, 104, 104, 104, 104, 104, 104, 104, 88, + 88, 104, 88, 0, 104, 104, 104, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 83, 0, 0, 83, 0, 145, 0, 0, - 0, 0, 129, 129, 129, 129, 0, 0, 0, 83, - 83, 129, 0, 0, 0, 129, 129, 129, 129, 0, - 0, 0, 0, 0, 129, 129, 0, 145, 129, 129, - 129, 129, 129, 0, 129, 129, 0, 0, 129, 0, - 0, 129, 129, 129, 83, 0, 0, 104, 104, 104, - 104, 0, 0, 0, 0, 0, 104, 0, 0, 0, - 104, 104, 104, 104, 0, 0, 0, 131, 0, 104, - 104, 0, 0, 104, 104, 104, 104, 104, 0, 104, - 104, 0, 0, 104, 131, 131, 104, 104, 104, 131, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 146, 0, 0, 0, 0, 0, 131, 0, 131, - 0, 0, 0, 0, 0, 0, 0, 0, 146, 146, - 0, 0, 0, 146, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 131, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 146, 0, 146, 0, 0, 96, 0, 0, 96, - 0, 0, 0, 0, 0, 0, 145, 145, 145, 145, - 0, 0, 0, 96, 96, 145, 0, 0, 96, 145, - 145, 145, 145, 146, 0, 0, 0, 0, 145, 145, - 0, 0, 145, 145, 145, 145, 145, 0, 145, 145, - 58, 0, 145, 58, 0, 145, 145, 145, 96, 0, - 0, 0, 0, 83, 83, 83, 83, 58, 58, 0, - 0, 0, 58, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 83, 83, 0, 96, 83, - 0, 0, 0, 61, 0, 0, 0, 0, 0, 0, - 0, 0, 58, 0, 0, 0, 0, 0, 0, 0, - 61, 61, 0, 0, 0, 61, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 58, 0, 0, 0, 0, 0, 131, 131, - 131, 131, 0, 61, 0, 61, 0, 131, 0, 0, - 0, 131, 131, 131, 131, 59, 0, 0, 59, 0, - 131, 131, 0, 0, 131, 131, 131, 131, 131, 0, - 131, 131, 59, 59, 131, 61, 0, 131, 131, 131, - 0, 0, 146, 146, 146, 146, 0, 0, 0, 0, - 0, 146, 0, 0, 0, 146, 146, 146, 146, 0, - 0, 0, 0, 0, 146, 146, 0, 59, 146, 146, - 146, 146, 146, 0, 146, 146, 0, 0, 146, 0, - 0, 146, 146, 146, 0, 0, 0, 145, 0, 0, - 145, 0, 0, 0, 0, 0, 0, 96, 96, 96, - 96, 0, 0, 0, 145, 145, 96, 0, 0, 145, - 96, 96, 96, 96, 0, 0, 0, 0, 0, 96, - 96, 0, 0, 96, 96, 96, 96, 96, 0, 96, - 96, 132, 0, 96, 132, 0, 96, 96, 96, 145, - 0, 58, 58, 58, 58, 0, 0, 0, 132, 132, - 58, 0, 0, 132, 58, 58, 58, 58, 0, 0, - 0, 0, 0, 58, 58, 0, 0, 58, 58, 58, - 58, 58, 0, 58, 58, 0, 0, 58, 0, 0, - 58, 58, 58, 132, 61, 61, 61, 61, 0, 284, - 0, 0, 0, 61, 157, 0, 0, 61, 61, 61, - 61, 0, 0, 0, 0, 0, 61, 61, 0, 0, - 61, 61, 61, 61, 61, 95, 61, 61, 95, 0, - 61, 0, 168, 61, 61, 61, 0, 0, 0, 0, + 0, 140, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 66, 66, 66, 66, 0, 153, 0, 0, + 153, 66, 0, 0, 0, 0, 0, 66, 66, 66, + 66, 0, 0, 0, 153, 153, 0, 66, 66, 153, + 66, 66, 66, 66, 66, 66, 66, 0, 0, 66, + 0, 0, 66, 66, 66, 69, 69, 69, 69, 0, + 110, 0, 0, 110, 69, 0, 0, 0, 0, 153, + 69, 69, 69, 69, 0, 0, 0, 110, 110, 0, + 69, 69, 110, 69, 69, 69, 69, 69, 69, 69, + 0, 0, 69, 0, 0, 69, 69, 69, 0, 103, + 103, 103, 103, 0, 117, 0, 0, 117, 103, 0, + 0, 0, 110, 0, 103, 103, 103, 103, 0, 0, + 0, 117, 117, 0, 103, 103, 117, 103, 103, 103, + 103, 103, 103, 103, 0, 0, 103, 0, 0, 103, + 103, 103, 0, 0, 0, 0, 0, 101, 0, 0, + 101, 0, 0, 0, 0, 0, 117, 0, 0, 0, + 0, 0, 0, 0, 101, 101, 0, 138, 0, 101, + 138, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 140, 140, 140, 140, 138, 138, 0, 0, 0, 140, + 0, 0, 0, 0, 0, 140, 140, 140, 140, 101, + 0, 0, 0, 0, 0, 140, 140, 0, 140, 140, + 140, 140, 140, 140, 140, 95, 0, 140, 95, 138, + 140, 140, 140, 0, 0, 0, 0, 0, 0, 0, 0, 0, 95, 95, 0, 0, 0, 95, 0, 0, - 0, 0, 0, 0, 0, 0, 59, 59, 59, 59, - 0, 0, 0, 0, 150, 0, 0, 102, 0, 0, - 102, 0, 0, 0, 0, 0, 0, 95, 59, 59, - 0, 0, 0, 0, 102, 102, 0, 0, 0, 102, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 95, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 109, 102, - 0, 109, 0, 0, 0, 0, 0, 0, 145, 145, - 145, 145, 0, 0, 0, 109, 109, 145, 0, 0, - 109, 145, 145, 145, 145, 0, 0, 0, 0, 0, - 145, 145, 0, 0, 145, 145, 145, 145, 145, 0, - 145, 145, 92, 0, 145, 92, 0, 145, 145, 145, - 109, 0, 132, 132, 132, 132, 0, 0, 0, 92, - 92, 132, 0, 0, 92, 132, 132, 132, 132, 0, - 0, 0, 0, 0, 132, 132, 0, 0, 132, 132, - 132, 132, 132, 93, 132, 132, 93, 0, 132, 0, - 0, 132, 132, 132, 92, 0, 0, 0, 0, 0, - 93, 93, 151, 0, 0, 93, 152, 153, 154, 155, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 156, - 158, 159, 160, 161, 0, 162, 163, 0, 0, 164, - 0, 0, 165, 166, 167, 93, 95, 95, 95, 95, - 0, 0, 0, 0, 0, 95, 0, 0, 0, 95, - 95, 95, 95, 0, 0, 0, 0, 0, 95, 95, - 0, 0, 95, 95, 95, 95, 95, 0, 95, 95, - 0, 0, 95, 0, 0, 95, 95, 95, 102, 102, - 102, 102, 0, 0, 0, 0, 0, 102, 0, 0, - 0, 102, 102, 102, 102, 71, 0, 0, 71, 0, - 102, 102, 0, 0, 102, 102, 102, 102, 102, 0, - 102, 102, 71, 71, 102, 0, 0, 102, 102, 102, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 109, - 109, 109, 109, 0, 0, 0, 0, 0, 109, 0, - 0, 0, 109, 109, 109, 109, 0, 71, 0, 0, - 0, 109, 109, 0, 0, 109, 109, 109, 109, 109, - 0, 109, 109, 0, 0, 109, 0, 0, 109, 109, - 109, 0, 0, 92, 92, 92, 92, 0, 0, 0, - 0, 0, 92, 0, 0, 0, 92, 92, 92, 92, - 0, 0, 0, 0, 0, 92, 92, 0, 0, 92, - 92, 92, 92, 92, 87, 92, 92, 87, 0, 92, - 0, 0, 0, 0, 93, 93, 93, 93, 0, 0, - 0, 87, 87, 93, 0, 0, 87, 93, 93, 93, - 93, 0, 0, 0, 0, 0, 93, 93, 0, 0, - 93, 93, 93, 93, 93, 88, 93, 93, 88, 0, - 93, 0, 0, 0, 0, 0, 87, 0, 0, 0, - 0, 0, 88, 88, 0, 0, 0, 88, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 89, 0, 0, 89, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 88, 89, 89, - 0, 0, 0, 89, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, - 85, 0, 0, 0, 0, 0, 71, 71, 71, 71, - 0, 0, 0, 89, 85, 85, 0, 0, 0, 85, - 0, 0, 0, 0, 0, 0, 0, 0, 71, 71, - 0, 0, 0, 86, 0, 0, 86, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 85, - 86, 86, 0, 0, 0, 86, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 84, - 0, 0, 84, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 86, 84, 84, 0, 0, - 0, 84, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 87, 87, 87, 87, 0, - 0, 84, 0, 0, 87, 0, 0, 0, 87, 87, - 87, 87, 0, 0, 0, 0, 0, 87, 87, 0, - 0, 87, 87, 87, 87, 87, 72, 87, 87, 72, - 0, 0, 0, 0, 0, 0, 88, 88, 88, 88, - 0, 0, 0, 72, 72, 88, 0, 0, 72, 88, - 88, 88, 88, 0, 0, 0, 0, 0, 88, 88, - 0, 0, 88, 88, 88, 88, 88, 0, 88, 88, - 0, 0, 89, 89, 89, 89, 0, 0, 72, 0, - 0, 89, 0, 0, 0, 89, 89, 89, 89, 0, - 0, 0, 0, 0, 89, 89, 0, 0, 89, 89, - 89, 89, 89, 0, 89, 89, 0, 0, 85, 85, - 85, 85, 0, 0, 0, 0, 0, 85, 0, 0, - 0, 85, 85, 85, 85, 0, 0, 0, 0, 0, - 85, 85, 0, 0, 85, 85, 85, 85, 85, 0, - 85, 85, 0, 0, 86, 86, 86, 86, 0, 0, - 0, 0, 0, 86, 0, 0, 0, 86, 86, 86, - 86, 0, 0, 0, 0, 0, 86, 86, 0, 0, - 86, 86, 86, 86, 86, 0, 86, 86, 0, 0, - 84, 84, 84, 84, 0, 0, 0, 0, 0, 84, - 0, 0, 0, 84, 84, 84, 84, 73, 0, 0, - 73, 0, 84, 84, 0, 0, 84, 84, 84, 84, - 84, 0, 84, 84, 73, 73, 0, 0, 0, 73, + 0, 0, 0, 0, 0, 0, 0, 0, 153, 153, + 153, 153, 0, 96, 0, 0, 96, 153, 0, 0, + 0, 0, 0, 153, 153, 153, 153, 95, 0, 0, + 96, 96, 0, 153, 153, 96, 153, 153, 153, 153, + 153, 153, 153, 0, 0, 153, 0, 0, 153, 153, + 153, 110, 110, 110, 110, 0, 0, 0, 0, 0, + 110, 0, 0, 0, 0, 96, 110, 110, 110, 110, + 0, 0, 0, 0, 0, 0, 110, 110, 0, 110, + 110, 110, 110, 110, 110, 110, 0, 0, 110, 0, + 0, 110, 110, 110, 0, 117, 117, 117, 117, 0, + 97, 0, 0, 97, 117, 0, 0, 0, 0, 0, + 117, 117, 117, 117, 0, 0, 0, 97, 97, 0, + 117, 117, 97, 117, 117, 117, 117, 117, 117, 117, + 0, 0, 117, 0, 0, 117, 117, 117, 101, 101, + 101, 101, 0, 0, 0, 0, 0, 101, 0, 0, + 0, 0, 97, 101, 101, 101, 101, 0, 138, 138, + 138, 138, 0, 101, 101, 93, 101, 101, 101, 101, + 101, 101, 101, 107, 0, 101, 0, 112, 0, 0, + 121, 0, 0, 138, 138, 0, 0, 128, 129, 130, + 131, 132, 0, 0, 135, 136, 0, 0, 170, 0, + 0, 143, 0, 0, 0, 0, 95, 95, 95, 95, + 0, 93, 0, 0, 93, 95, 0, 0, 0, 0, + 0, 95, 95, 95, 95, 0, 0, 186, 93, 93, + 152, 95, 95, 93, 95, 95, 95, 95, 95, 95, + 95, 0, 0, 0, 96, 96, 96, 96, 0, 0, + 0, 0, 0, 96, 0, 0, 0, 0, 0, 96, + 96, 96, 96, 93, 94, 0, 0, 94, 0, 96, + 96, 0, 96, 96, 96, 96, 96, 96, 96, 0, + 0, 94, 94, 0, 0, 0, 94, 0, 224, 225, + 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, + 236, 237, 92, 0, 0, 92, 0, 0, 0, 0, + 0, 0, 0, 251, 0, 0, 94, 0, 0, 92, + 92, 0, 0, 0, 92, 0, 0, 0, 0, 0, + 0, 97, 97, 97, 97, 0, 0, 0, 0, 0, + 97, 0, 0, 0, 0, 0, 97, 97, 97, 97, + 80, 0, 0, 80, 92, 0, 97, 97, 0, 97, + 97, 97, 97, 97, 97, 97, 0, 80, 80, 0, + 0, 0, 80, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 81, 0, 0, 81, + 0, 0, 0, 308, 154, 155, 156, 157, 0, 0, + 0, 0, 80, 81, 81, 0, 0, 0, 81, 161, + 162, 163, 164, 165, 0, 0, 166, 0, 0, 167, + 168, 169, 0, 0, 0, 0, 0, 0, 0, 0, + 326, 82, 0, 0, 82, 0, 0, 0, 81, 0, + 0, 0, 93, 93, 93, 93, 0, 0, 82, 82, + 0, 93, 0, 82, 0, 0, 0, 93, 93, 93, + 93, 0, 0, 0, 0, 0, 0, 93, 93, 0, + 93, 93, 93, 93, 93, 93, 93, 0, 0, 0, + 0, 0, 0, 82, 0, 143, 0, 0, 143, 0, + 0, 0, 0, 0, 0, 94, 94, 94, 94, 0, + 0, 0, 143, 143, 94, 0, 0, 143, 0, 0, + 94, 94, 94, 94, 0, 0, 0, 0, 0, 0, + 94, 94, 0, 94, 94, 94, 94, 94, 94, 94, + 0, 0, 0, 92, 92, 92, 92, 143, 0, 0, + 0, 0, 92, 0, 0, 0, 0, 0, 92, 92, + 92, 92, 142, 0, 0, 142, 0, 0, 92, 92, + 0, 92, 92, 92, 92, 92, 92, 92, 0, 142, + 142, 0, 0, 0, 142, 0, 0, 0, 0, 0, + 0, 80, 80, 80, 80, 79, 0, 0, 79, 0, + 80, 0, 0, 0, 0, 0, 80, 80, 80, 80, + 0, 0, 79, 79, 142, 131, 80, 80, 131, 80, + 80, 80, 80, 80, 80, 80, 0, 81, 81, 81, + 81, 0, 131, 131, 0, 0, 81, 131, 0, 0, + 0, 0, 81, 81, 81, 81, 0, 79, 0, 0, + 0, 0, 81, 81, 0, 81, 81, 81, 81, 81, + 81, 102, 0, 0, 102, 0, 0, 131, 0, 0, + 0, 0, 82, 82, 82, 82, 0, 0, 102, 102, + 0, 82, 0, 102, 0, 0, 0, 82, 82, 0, + 82, 170, 0, 0, 0, 0, 0, 82, 82, 0, + 82, 82, 82, 82, 82, 82, 0, 67, 0, 0, + 67, 0, 0, 102, 87, 0, 0, 87, 0, 0, + 0, 0, 0, 152, 67, 67, 143, 143, 143, 143, + 0, 87, 87, 0, 0, 143, 87, 0, 0, 0, + 0, 143, 143, 0, 0, 0, 89, 0, 0, 89, + 0, 143, 143, 0, 143, 143, 143, 143, 143, 67, + 0, 0, 0, 89, 89, 0, 87, 0, 89, 0, + 0, 159, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 74, 0, 0, 74, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 74, 74, 73, - 0, 0, 74, 0, 0, 0, 0, 72, 72, 72, - 72, 0, 0, 0, 0, 0, 72, 0, 0, 0, - 72, 72, 72, 72, 75, 0, 0, 75, 0, 72, - 72, 0, 74, 72, 72, 72, 72, 72, 0, 72, - 72, 75, 75, 0, 0, 0, 75, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 123, 0, 0, - 123, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 123, 123, 75, 0, 0, 123, - 0, 0, 0, 0, 0, 0, 0, 0, 94, 0, - 0, 94, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 94, 94, 0, 0, 123, - 94, 0, 0, 0, 0, 0, 0, 0, 0, 134, - 0, 0, 134, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 134, 134, 0, 0, - 94, 134, 0, 0, 0, 0, 0, 0, 0, 0, - 76, 0, 0, 76, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 77, 76, 76, 77, - 0, 134, 76, 0, 0, 0, 0, 0, 73, 73, - 73, 73, 0, 77, 77, 0, 0, 73, 77, 0, - 0, 73, 73, 73, 73, 0, 0, 0, 0, 0, - 73, 73, 76, 0, 73, 73, 73, 73, 73, 0, - 73, 74, 74, 74, 74, 0, 0, 0, 77, 0, - 74, 0, 0, 0, 74, 74, 0, 74, 78, 0, - 0, 78, 0, 74, 74, 0, 0, 74, 74, 74, - 74, 74, 0, 74, 79, 78, 78, 79, 0, 0, - 78, 0, 0, 0, 0, 75, 75, 75, 75, 0, - 0, 79, 79, 0, 75, 0, 79, 0, 75, 75, - 0, 0, 0, 0, 0, 0, 0, 75, 75, 0, - 78, 75, 75, 75, 75, 75, 0, 75, 123, 123, - 123, 123, 0, 0, 0, 0, 79, 123, 0, 0, - 0, 123, 123, 0, 0, 0, 0, 0, 0, 81, - 123, 123, 81, 0, 123, 123, 123, 123, 123, 94, - 94, 94, 94, 0, 0, 0, 81, 81, 94, 0, - 0, 81, 94, 94, 0, 0, 0, 0, 0, 0, - 0, 94, 94, 0, 0, 94, 94, 94, 94, 94, - 134, 134, 134, 134, 0, 0, 0, 0, 0, 134, - 0, 81, 0, 134, 134, 0, 0, 0, 0, 0, - 0, 0, 134, 134, 0, 0, 134, 134, 134, 134, - 134, 76, 76, 76, 76, 0, 0, 0, 0, 0, - 76, 0, 0, 0, 0, 76, 0, 77, 77, 77, - 77, 0, 0, 76, 76, 0, 77, 76, 76, 76, - 76, 76, 0, 0, 0, 0, 0, 0, 0, 77, - 77, 0, 0, 77, 77, 77, 77, 77, 0, 0, + 0, 0, 0, 142, 142, 142, 142, 0, 89, 170, + 0, 0, 142, 0, 0, 159, 0, 0, 142, 142, + 0, 0, 0, 0, 0, 0, 0, 0, 142, 142, + 0, 142, 142, 142, 142, 142, 79, 79, 79, 79, + 0, 152, 0, 170, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 131, 131, 131, 131, + 0, 79, 79, 0, 0, 131, 0, 0, 0, 0, + 0, 131, 131, 0, 0, 152, 0, 0, 0, 0, + 0, 131, 131, 0, 131, 131, 131, 131, 131, 0, + 0, 0, 0, 0, 0, 0, 0, 154, 155, 156, + 157, 0, 102, 102, 102, 102, 0, 0, 0, 0, + 0, 102, 0, 162, 163, 164, 165, 102, 102, 166, + 0, 0, 167, 168, 169, 0, 0, 102, 102, 0, + 102, 102, 102, 102, 102, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 67, 67, + 67, 67, 0, 0, 0, 87, 87, 87, 87, 0, + 0, 0, 0, 0, 87, 0, 0, 0, 0, 0, + 0, 0, 0, 67, 67, 0, 0, 0, 0, 0, + 87, 87, 0, 87, 87, 87, 87, 89, 89, 89, + 89, 0, 0, 0, 0, 0, 89, 0, 0, 153, + 0, 0, 0, 0, 0, 154, 155, 156, 157, 0, + 0, 0, 89, 89, 0, 89, 89, 89, 158, 160, + 161, 162, 163, 164, 165, 0, 0, 166, 0, 0, + 167, 168, 169, 153, 0, 0, 0, 0, 0, 154, + 155, 156, 157, 0, 0, 0, 0, 67, 0, 0, + 0, 81, 0, 160, 161, 162, 163, 164, 165, 0, + 0, 166, 0, 0, 167, 168, 169, 97, 99, 101, + 103, 0, 0, 0, 0, 0, 111, 0, 0, 120, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 78, - 78, 78, 78, 0, 0, 0, 0, 0, 78, 0, - 0, 0, 0, 0, 0, 79, 79, 79, 79, 0, - 0, 78, 78, 0, 79, 78, 78, 78, 78, 78, - 0, 0, 91, 0, 0, 0, 0, 79, 79, 0, - 104, 79, 79, 79, 79, 111, 113, 0, 0, 0, - 0, 0, 125, 126, 127, 128, 129, 130, 0, 0, - 133, 134, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 81, 81, 81, 81, 0, 0, 0, 0, 0, 81, - 0, 0, 183, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 81, 81, 0, 0, 81, 81, 81, 0, + 0, 0, 0, 0, 179, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 187, 0, + 0, 190, 0, 192, 0, 194, 0, 196, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 215, 0, 0, 0, 0, - 0, 0, 0, 223, 224, 225, 226, 227, 228, 229, - 230, 231, 232, 233, 234, 235, 236, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 215, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 297, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 313, + 0, 0, 0, 0, 0, 253, 0, 0, 0, 0, + 0, 0, 260, }; dEXT short yycheck[] = { 13, - 59, 13, 91, 17, 59, 59, 36, 93, 182, 194, - 41, 123, 59, 44, 257, 41, 59, 40, 44, 33, - 34, 35, 36, 91, 40, 88, 59, 58, 59, 43, - 41, 40, 63, 45, 123, 41, 50, 63, 91, 41, - 257, 41, 41, 40, 56, 40, 59, 40, 60, 41, - 257, 41, 40, 116, 41, 123, 188, 59, 190, 40, - 59, 91, 93, 41, 78, 91, 41, 36, 91, 59, - 123, 40, 59, 41, 278, 41, 123, 41, 92, 294, - 295, 95, 94, 97, 96, 99, 98, 101, 100, 41, - 102, 59, 41, 123, 106, 41, 40, 123, 41, 41, - 123, 123, 41, 44, 59, 44, 0, 123, 276, 277, - 123, 44, 40, 287, 123, 300, 179, 59, 303, 58, - 59, 184, 59, 59, 260, 59, 123, 141, 123, 123, - 257, 40, 144, 145, 146, 147, 148, 149, 150, 33, - 40, 40, 36, 37, 38, 257, 40, 295, 42, 43, - 335, 45, 41, 6, 93, 8, 168, 169, 170, 171, - 172, 173, 174, 125, 178, 59, 298, 299, 91, 41, - 64, 185, 41, 305, 0, 59, 91, 125, 31, 32, - 40, 93, 59, 41, 36, 40, 198, 125, 83, 59, - 125, 93, 204, 205, 206, 125, 328, 91, 125, 211, - 125, 41, 41, 257, 123, 91, 93, 33, 294, 295, - 36, 37, 38, 41, 40, 59, 42, 43, 41, 45, - 41, 59, 93, 59, 313, 237, 59, 239, 258, 123, - 41, 125, 126, 59, 326, 294, 295, 123, 64, 294, - 295, 272, 273, 274, 275, 259, 13, 261, 269, 263, - 264, 294, 295, 267, -1, 281, 270, 269, 93, 285, - 286, 287, 288, 294, 295, 91, 93, 298, 0, -1, - 282, 123, 298, 299, 300, 301, 302, 93, 304, 305, - -1, -1, 308, 294, 295, 311, 312, 313, 294, 295, - 302, -1, 306, -1, 294, 295, -1, 123, -1, 125, - 126, 33, 294, 295, 36, 37, 38, -1, 40, -1, - 42, 43, -1, 45, 326, -1, 294, 295, 332, 294, - 295, -1, 336, 272, 273, 274, 275, 59, 294, 295, - 294, 295, 64, 272, 273, 274, 275, -1, -1, 294, - 295, -1, 294, 295, -1, 294, 295, -1, 294, 295, - -1, 294, 295, 294, 295, 294, 295, 294, 295, 91, - 294, 295, 256, 257, 258, 259, 260, 261, -1, 263, - 264, 265, 266, 267, 268, 269, 270, 271, 272, 273, - 274, 275, 294, 295, -1, 279, 280, -1, 282, 283, - 284, 123, 294, 295, 126, 289, 290, 291, 292, 293, - 41, 287, 296, 297, 91, 257, -1, 294, 295, 303, - 262, -1, -1, 307, -1, 309, 310, -1, 59, 305, - -1, -1, 308, 294, 295, 311, 312, 313, -1, -1, - 256, 257, 258, 259, 260, 261, 123, 263, 264, 265, + 36, 198, 196, 36, 40, 93, 85, 41, 91, 59, + 44, 36, 93, 41, 123, 41, 44, 185, 41, 41, + 40, 91, 40, 257, 93, 59, 257, 40, 40, 40, + 58, 59, 46, 59, 41, 63, 59, 44, 93, 257, + 123, 276, 277, 57, 41, 26, 41, 61, 91, 41, + 59, 58, 59, 123, 44, 41, 63, 41, 91, 93, + 59, 59, 43, 44, 0, 93, 96, 40, 98, 50, + 100, 91, 102, 90, 104, 105, 41, 59, 40, 59, + 123, 62, 63, 64, 65, 282, 93, 266, 267, 268, + 123, 270, 271, 40, 59, 109, 110, 33, 123, 40, + 36, 37, 38, 123, 40, 123, 42, 43, 125, 45, + 123, 123, 123, 59, 123, 59, 278, 314, 123, 316, + 297, 298, 41, 59, 123, 44, 59, 40, 64, 110, + 298, 41, 146, 147, 148, 149, 150, 151, 152, 59, + 44, 6, 336, 8, 63, 339, 123, 59, 257, 59, + 41, 257, 260, 40, 40, 91, 170, 171, 172, 173, + 174, 175, 176, 0, 358, 182, 31, 32, 59, 199, + 187, 185, 91, 41, 41, 189, 40, 191, 41, 36, + 125, 195, 91, 91, 198, 125, 91, 123, 91, 125, + 126, 205, 59, 207, 208, 41, 33, 93, 212, 36, + 37, 38, 298, 40, 123, 42, 43, 257, 45, 297, + 298, 93, 40, 59, 123, 59, 297, 298, 41, 0, + 123, 41, 59, 41, 238, 258, 240, 64, 297, 298, + 41, 314, 257, 41, 123, 93, 44, 262, 272, 273, + 274, 275, 297, 298, 272, 273, 274, 275, 40, 40, + 58, 59, 33, 281, 91, 36, 37, 38, 337, 40, + 296, 42, 43, 297, 45, 272, 273, 274, 275, 297, + 298, 41, 300, 301, 281, 297, 298, 41, 59, 293, + 287, 288, 59, 64, 298, 93, 123, 125, 125, 126, + 297, 298, 125, 300, 301, 302, 303, 304, 305, 125, + 297, 298, 297, 298, 318, 297, 298, 297, 298, 125, + 91, 297, 298, 297, 298, 297, 298, 297, 298, 41, + 256, 257, 258, 259, 260, 261, 125, 263, 264, 265, 266, 267, 268, 269, 270, 271, 272, 273, 274, 275, - -1, -1, 93, 279, 280, -1, 282, 283, 284, 294, - 295, -1, -1, 289, 290, 291, 292, 293, -1, -1, - 296, 297, 91, -1, -1, -1, -1, 303, 294, 295, - -1, 307, 91, 309, 310, 26, 33, -1, -1, 36, - 37, 38, -1, 40, 41, 42, 43, 44, 45, 48, - 49, 42, -1, -1, 123, -1, 47, -1, 49, -1, - -1, 58, 59, -1, 123, 125, 63, 64, -1, -1, - 61, 62, 63, 64, 256, 257, 258, 259, 260, 261, - -1, 263, 264, 265, -1, -1, -1, 269, -1, 88, - 272, 273, 274, 275, 91, -1, 93, 279, 280, -1, - 282, 283, 284, 63, -1, -1, -1, 289, 290, 291, - 292, 293, 91, -1, 296, 297, 107, 116, 266, 267, - 268, 303, 270, 271, 123, 307, 123, 309, 310, 126, - 33, 91, -1, 36, 37, 38, -1, 40, 41, 42, - 43, 44, 45, -1, 123, -1, -1, -1, 285, 286, - 287, 288, -1, -1, -1, 58, 59, -1, -1, -1, - 63, 64, -1, 123, 301, 302, -1, 304, 305, -1, - -1, 308, -1, -1, 311, 312, 313, -1, -1, -1, - 179, 272, 273, 274, 275, 184, -1, -1, -1, 33, - 93, -1, 36, 37, 38, -1, 40, -1, 42, 43, - -1, 45, -1, 294, 295, -1, 266, 267, 268, -1, - 270, 271, -1, -1, -1, 59, 285, 286, 287, 288, - 64, -1, -1, 126, -1, -1, 285, 286, 287, 288, - 299, 300, 301, 302, -1, 304, 305, -1, -1, 308, - -1, -1, 311, 312, 313, 304, 305, 91, -1, 308, - -1, -1, 311, 312, 313, -1, -1, -1, -1, -1, - 257, 258, 259, 260, 261, -1, 263, 264, 265, -1, - -1, -1, 269, -1, -1, 272, 273, 274, 275, 123, - -1, -1, 126, 280, 281, 282, 283, 284, 285, 286, - 287, 288, 289, 290, 291, 292, 293, 294, 295, 296, - 297, 298, 299, 300, 301, 302, 303, 304, 305, -1, - 307, 308, 309, 310, 311, 312, 313, 91, -1, -1, - -1, 281, -1, -1, -1, 285, 286, 287, 288, 308, - -1, -1, 311, 312, 313, -1, -1, -1, 298, 299, - 300, 301, 302, -1, 304, 305, -1, -1, 308, 123, - -1, 311, 312, 313, 257, 258, 259, 260, 261, -1, - 263, 264, 265, -1, -1, -1, 269, -1, -1, 272, - 273, 274, 275, -1, -1, -1, -1, 280, 281, 282, - 283, 284, 285, 286, 287, 288, 289, 290, 291, 292, - 293, 294, 295, 296, 297, 298, 299, 300, 301, 302, - 303, 304, 305, -1, 307, 308, 309, 310, 311, 312, - 313, 91, 256, 257, 258, 259, 260, 261, -1, 263, - 264, 265, -1, 41, -1, 269, 44, -1, 272, 273, - 274, 275, -1, -1, -1, 279, 280, -1, 282, 283, - 284, 59, -1, 123, -1, 289, 290, 291, 292, 293, - -1, -1, 296, 297, -1, -1, -1, -1, -1, 303, - 25, 26, -1, 307, 33, 309, 310, 36, 37, 38, - -1, 40, 37, 42, 43, 93, 45, 42, 43, -1, - -1, -1, 47, -1, 49, 272, 273, 274, 275, -1, - 59, -1, -1, -1, -1, 64, 61, 62, 63, 64, - -1, -1, -1, -1, -1, -1, -1, 294, 295, -1, - -1, -1, -1, 287, 288, -1, -1, -1, -1, -1, - 33, -1, 91, 36, 37, 38, -1, 40, -1, 42, - 43, 305, 45, -1, 308, -1, -1, 311, 312, 313, - -1, -1, 107, -1, -1, -1, -1, -1, -1, -1, - -1, 64, -1, -1, 123, -1, -1, 126, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 33, -1, 91, 36, - 37, 38, -1, 40, -1, 42, 43, -1, 45, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 167, -1, -1, -1, -1, 64, -1, -1, - 123, -1, -1, 126, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 305, -1, -1, 308, -1, - -1, 311, 312, 313, 91, -1, -1, -1, -1, 33, - -1, -1, 36, 37, 38, -1, 40, -1, 42, 43, - -1, 45, -1, -1, 272, 273, 274, 275, -1, -1, - -1, -1, -1, -1, -1, 59, 123, -1, -1, 126, - 64, -1, -1, -1, -1, -1, 294, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 256, 257, 258, - 259, 260, 261, -1, 263, 264, 265, 91, -1, -1, - 269, -1, -1, 272, 273, 274, 275, -1, -1, -1, - 279, 280, -1, 282, 283, 284, -1, -1, -1, -1, - 289, 290, 291, 292, 293, -1, -1, 296, 297, -1, - 91, 63, 126, -1, 303, -1, -1, -1, 307, -1, - 309, 310, -1, -1, 257, 258, 259, 260, 261, 262, - 263, 264, 265, -1, -1, -1, 269, -1, -1, 91, - 41, -1, 123, -1, -1, -1, -1, 280, -1, 282, - 283, 284, -1, -1, -1, -1, 289, 290, 291, 292, - 293, -1, 63, 296, 297, -1, -1, -1, -1, -1, - 303, 123, -1, -1, 307, -1, 309, 310, -1, -1, - 257, 258, 259, 260, 261, -1, 263, 264, 265, -1, - 91, -1, 269, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 280, -1, 282, 283, 284, -1, -1, - -1, -1, 289, 290, 291, 292, 293, -1, -1, 296, - 297, 41, 123, -1, 44, -1, 303, -1, -1, -1, - 307, -1, 309, 310, -1, -1, -1, -1, 58, 59, - -1, -1, -1, 257, 258, 259, 260, 261, 91, 263, - 264, 265, -1, 33, -1, 269, 36, 37, 38, -1, - 40, -1, 42, 43, -1, 45, 280, -1, 282, 283, - 284, -1, -1, 93, -1, 289, 290, 291, 292, 293, - 123, -1, 296, 297, 64, -1, -1, -1, -1, 303, - -1, -1, -1, 307, -1, 309, 310, -1, -1, -1, - -1, -1, -1, -1, 285, -1, 287, 288, -1, 33, - -1, 91, 36, 37, 38, -1, 40, 41, 42, 43, - -1, 45, -1, 304, 305, -1, -1, 308, -1, 281, - 311, 312, 313, 285, 286, 287, 288, -1, -1, -1, - 64, -1, -1, 123, -1, -1, 126, 299, 300, 301, - 302, -1, 304, 305, -1, -1, 308, -1, -1, 311, - 312, 313, -1, -1, -1, 33, -1, 91, 36, 37, - 38, -1, 40, -1, 42, 43, -1, 45, -1, -1, - 281, -1, -1, -1, 285, 286, 287, 288, -1, -1, - -1, -1, -1, -1, -1, -1, 64, 298, 299, 300, - 301, 302, 126, 304, 305, -1, -1, 308, -1, -1, - 311, 312, 313, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 91, -1, 93, -1, -1, 33, -1, - -1, 36, 37, 38, -1, 40, -1, 42, 43, -1, - 45, -1, -1, -1, 287, 288, -1, -1, -1, -1, - -1, -1, 272, 273, 274, 275, -1, -1, 126, 64, - -1, 304, 305, -1, -1, 308, -1, -1, 311, 312, - 313, -1, -1, -1, 294, 295, -1, 257, 258, 259, - 260, 261, -1, 263, 264, 265, 91, -1, -1, 269, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 280, -1, 282, 283, 284, -1, -1, -1, -1, 289, - 290, 291, 292, 293, -1, -1, 296, 297, -1, -1, - -1, 126, -1, 303, -1, -1, -1, 307, -1, 309, - 310, -1, -1, 257, 258, 259, 260, 261, -1, 263, - 264, 265, -1, 91, -1, 269, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 280, -1, 282, 283, - 284, -1, -1, -1, -1, 289, 290, 291, 292, 293, - -1, -1, 296, 297, 91, 123, -1, -1, -1, 303, - -1, 41, -1, 307, 44, 309, 310, -1, -1, 257, - 258, 259, 260, 261, -1, 263, 264, 265, 58, 59, - -1, 269, -1, 63, -1, -1, 123, -1, -1, -1, - -1, -1, 280, -1, 282, 283, 284, -1, -1, -1, - -1, 289, 290, 291, 292, 293, -1, -1, 296, 297, - -1, 41, -1, 93, 44, 303, -1, -1, -1, 307, - -1, 309, 310, -1, -1, -1, -1, -1, 58, 59, - -1, 256, 257, 258, 259, 260, 261, -1, 263, 264, - 265, -1, 33, -1, 269, 36, 37, 38, -1, 40, - 41, 42, 43, -1, 45, 280, -1, 282, 283, 284, - -1, -1, -1, 93, 289, 290, 291, 292, 293, -1, - -1, 296, 297, 64, -1, -1, -1, -1, 303, -1, - -1, -1, 307, -1, 309, 310, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 33, -1, - 91, 36, 37, 38, -1, 40, 41, 42, 43, -1, - 45, -1, -1, -1, -1, -1, -1, 285, 286, 287, - 288, -1, -1, -1, -1, -1, -1, -1, -1, 64, - -1, -1, 300, 301, 302, 126, 304, 305, -1, -1, - 308, -1, -1, 311, 312, 313, -1, -1, 285, 286, - 287, 288, -1, -1, 33, -1, 91, 36, 37, 38, - -1, 40, 41, 42, 43, 302, 45, 304, 305, -1, - -1, 308, -1, -1, 311, 312, 313, -1, -1, -1, - -1, -1, -1, -1, -1, 64, -1, -1, -1, -1, - -1, 126, 272, 273, 274, 275, -1, -1, -1, -1, - -1, 281, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 91, -1, 294, 295, -1, 33, 298, 299, - 36, 37, 38, -1, 40, 41, 42, 43, -1, 45, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 272, 273, 274, 275, -1, 126, 64, -1, + 41, 355, 123, 279, 280, 126, 282, 283, 284, 285, + 286, 297, 298, 297, 298, 291, 292, 293, 294, 295, + 296, 41, 281, 299, 297, 298, 41, 59, 287, 288, + 289, 290, 308, 41, 310, 311, 41, 297, 298, 123, + 289, 300, 301, 302, 303, 304, 305, 306, 41, 59, + 309, 59, 41, 312, 313, 314, 59, 306, 41, 41, + 309, 297, 298, 312, 313, 314, 309, 59, 41, 312, + 313, 314, 13, 147, 95, 297, 298, 355, 91, 256, + 257, 258, 259, 260, 261, 93, 263, 264, 265, 266, + 267, 268, 269, 270, 271, 272, 273, 274, 275, 297, + 298, 318, 279, 280, 195, 282, 283, 284, 285, 286, + 123, -1, -1, -1, 291, 292, 293, 294, 295, 296, + -1, -1, 299, 91, 272, 273, 274, 275, -1, -1, + -1, 308, -1, 310, 311, 256, 257, 258, 259, 260, + 261, 125, 263, 264, 265, -1, -1, -1, 269, 297, + 298, 272, 273, 274, 275, 123, -1, -1, 279, 280, + -1, 282, 283, 284, 285, 286, -1, -1, -1, 91, + 291, 292, 293, 294, 295, 296, -1, -1, 299, -1, + -1, -1, 125, -1, 91, -1, -1, 308, 33, 310, + 311, 36, 37, 38, -1, 40, 41, 42, 43, 44, + 45, 123, -1, 25, 26, 190, -1, 192, 272, 273, + 274, 275, -1, 58, 59, 37, 123, -1, 63, 64, + -1, 43, 44, 45, -1, -1, -1, -1, 50, -1, + -1, -1, -1, 297, 298, -1, -1, -1, -1, -1, + 62, 63, 64, 65, -1, -1, 91, -1, 93, 33, + -1, -1, 36, 37, 38, -1, 40, 41, 42, 43, + 44, 45, -1, -1, 272, 273, 274, 275, -1, -1, + -1, -1, -1, -1, 58, 59, 289, 290, 123, 63, + 64, 126, 266, 267, 268, -1, 270, 271, 110, 297, + 298, -1, 305, 306, -1, -1, 309, -1, -1, 312, + 313, 314, -1, -1, -1, -1, -1, -1, 33, 93, + -1, 36, 37, 38, -1, 40, -1, 42, 43, 287, + 45, 289, 290, 266, 267, 268, -1, 270, 271, -1, + -1, -1, -1, -1, 59, -1, -1, 305, 306, 64, + -1, 309, 126, -1, 312, 313, 314, 169, -1, 334, + 335, -1, -1, -1, -1, -1, 341, -1, -1, 41, + -1, -1, 44, -1, -1, -1, 91, 289, 290, -1, + -1, 356, -1, -1, 359, 197, 58, 59, -1, -1, + -1, 63, -1, -1, 306, -1, -1, 309, -1, -1, + 312, 313, 314, -1, -1, -1, -1, -1, 123, 306, + -1, 126, 309, -1, -1, 312, 313, 314, -1, -1, + -1, 93, 257, 258, 259, 260, 261, -1, 263, 264, + 265, -1, -1, -1, 269, -1, -1, 272, 273, 274, + 275, -1, -1, -1, -1, 280, 281, 282, 283, 284, + 285, 286, 287, 288, 289, 290, 291, 292, 293, 294, + 295, 296, 297, 298, 299, 300, 301, 302, 303, 304, + 305, 306, -1, 308, 309, 310, 311, 312, 313, 314, + -1, -1, -1, 257, 258, 259, 260, 261, -1, 263, + 264, 265, -1, -1, -1, 269, -1, -1, 272, 273, + 274, 275, -1, -1, -1, -1, 280, 281, 282, 283, + 284, 285, 286, 287, 288, 289, 290, 291, 292, 293, + 294, 295, 296, 297, 298, 299, 300, 301, 302, 303, + 304, 305, 306, -1, 308, 309, 310, 311, 312, 313, + 314, 256, 257, 258, 259, 260, 261, -1, 263, 264, + 265, -1, -1, -1, 269, -1, -1, 272, 273, 274, + 275, -1, -1, -1, 279, 280, -1, 282, 283, 284, + 285, 286, -1, -1, -1, 91, 291, 292, 293, 294, + 295, 296, 33, -1, 299, 36, 37, 38, -1, 40, + -1, 42, 43, 308, 45, 310, 311, 43, -1, -1, + 272, 273, 274, 275, -1, 51, -1, 123, 59, 281, + -1, -1, -1, 64, -1, 287, 288, 289, 290, -1, + -1, -1, -1, -1, -1, 297, 298, -1, 300, 301, + 302, 303, 304, 305, 306, -1, -1, 309, 33, -1, + 91, 36, 37, 38, 90, 40, -1, 42, 43, -1, + 45, -1, -1, -1, -1, -1, -1, -1, 309, 310, + 311, -1, -1, -1, 315, -1, 317, -1, -1, 64, + -1, 117, 123, -1, -1, 126, -1, -1, -1, 125, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 294, 295, 257, 258, 259, 260, + -1, -1, 343, -1, 33, -1, 91, 36, 37, 38, + 351, 40, 353, 42, 43, -1, 45, -1, -1, -1, + -1, -1, -1, 364, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 64, -1, -1, 123, -1, + -1, 126, -1, -1, -1, -1, 182, -1, -1, -1, + -1, 187, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 91, -1, -1, -1, -1, 33, -1, -1, + 36, 37, 38, -1, 40, -1, 42, 43, -1, 45, + -1, 287, 288, 289, 290, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 123, -1, -1, 126, 64, 305, + 306, -1, -1, 309, -1, -1, 312, 313, 314, -1, + -1, -1, -1, -1, -1, 256, 257, 258, 259, 260, 261, -1, 263, 264, 265, 91, -1, -1, 269, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 280, - -1, 282, 283, 284, -1, -1, -1, -1, 289, 290, - 291, 292, 293, -1, -1, 296, 297, -1, -1, -1, - 126, -1, 303, -1, 41, -1, 307, 44, 309, 310, - -1, -1, 257, 258, 259, 260, 261, -1, 263, 264, - 265, 58, 59, -1, 269, -1, 63, -1, -1, -1, - -1, -1, -1, -1, -1, 280, -1, 282, 283, 284, - -1, -1, -1, -1, 289, 290, 291, 292, 293, -1, - -1, 296, 297, -1, 91, -1, 93, -1, 303, -1, - 41, -1, 307, 44, 309, 310, -1, -1, 257, 258, - 259, 260, 261, -1, 263, 264, 265, 58, 59, -1, - 269, -1, 63, -1, -1, -1, 123, -1, -1, -1, - -1, 280, -1, 282, 283, 284, -1, -1, -1, -1, - 289, 290, 291, 292, 293, -1, -1, 296, 297, -1, - 91, -1, 93, -1, 303, -1, -1, -1, 307, -1, - 309, 310, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 257, 258, 259, 260, 261, -1, 263, 264, 265, - -1, 33, 123, 269, 36, 37, 38, -1, 40, -1, - 42, 43, -1, 45, 280, -1, 282, 283, 284, -1, - -1, -1, -1, 289, 290, 291, 292, 293, -1, -1, - 296, 297, 64, -1, -1, -1, -1, 303, -1, -1, - -1, 307, -1, 309, 310, -1, -1, -1, -1, -1, - 41, -1, -1, 44, -1, -1, -1, -1, -1, 91, - -1, -1, -1, -1, -1, -1, -1, 58, 59, -1, - -1, -1, 63, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 126, 272, 273, 274, 275, -1, - 91, -1, 93, -1, 281, -1, -1, -1, 285, 286, - 287, 288, -1, -1, -1, -1, -1, 294, 295, -1, - -1, 298, 299, 300, 301, 302, -1, 304, 305, -1, - -1, 308, 123, -1, 311, 312, 313, -1, -1, -1, - -1, 41, -1, -1, 44, -1, -1, -1, -1, -1, - -1, 272, 273, 274, 275, -1, -1, -1, 58, 59, - 281, -1, -1, 63, 285, 286, 287, 288, -1, -1, - -1, -1, -1, 294, 295, -1, -1, 298, 299, 300, - 301, 302, -1, 304, 305, -1, 41, 308, -1, 44, - 311, 312, 313, 93, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 58, 59, -1, -1, -1, 63, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 123, -1, 257, 258, 259, 260, 261, - -1, 263, 264, 265, -1, -1, 91, 269, 93, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 280, -1, - 282, 283, 284, -1, -1, -1, -1, 289, 290, 291, - 292, 293, -1, -1, 296, 297, -1, -1, -1, -1, - -1, 303, -1, -1, -1, 307, -1, 309, 310, -1, - -1, 272, 273, 274, 275, -1, -1, -1, -1, -1, - 281, -1, -1, -1, 285, 286, 287, 288, -1, -1, - -1, -1, -1, 294, 295, -1, -1, 298, 299, 300, - 301, 302, -1, 304, 305, 41, -1, 308, 44, -1, - 311, 312, 313, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 58, 59, -1, -1, -1, 63, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 41, -1, -1, 44, -1, 93, -1, -1, - -1, -1, 272, 273, 274, 275, -1, -1, -1, 58, - 59, 281, -1, -1, -1, 285, 286, 287, 288, -1, - -1, -1, -1, -1, 294, 295, -1, 123, 298, 299, - 300, 301, 302, -1, 304, 305, -1, -1, 308, -1, - -1, 311, 312, 313, 93, -1, -1, 272, 273, 274, - 275, -1, -1, -1, -1, -1, 281, -1, -1, -1, - 285, 286, 287, 288, -1, -1, -1, 41, -1, 294, - 295, -1, -1, 298, 299, 300, 301, 302, -1, 304, - 305, -1, -1, 308, 58, 59, 311, 312, 313, 63, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 41, -1, -1, -1, -1, -1, 91, -1, 93, - -1, -1, -1, -1, -1, -1, -1, -1, 58, 59, - -1, -1, -1, 63, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 123, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 91, -1, 93, -1, -1, 41, -1, -1, 44, - -1, -1, -1, -1, -1, -1, 272, 273, 274, 275, - -1, -1, -1, 58, 59, 281, -1, -1, 63, 285, - 286, 287, 288, 123, -1, -1, -1, -1, 294, 295, - -1, -1, 298, 299, 300, 301, 302, -1, 304, 305, - 41, -1, 308, 44, -1, 311, 312, 313, 93, -1, - -1, -1, -1, 272, 273, 274, 275, 58, 59, -1, - -1, -1, 63, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 294, 295, -1, 123, 298, - -1, -1, -1, 41, -1, -1, -1, -1, -1, -1, - -1, -1, 93, -1, -1, -1, -1, -1, -1, -1, - 58, 59, -1, -1, -1, 63, -1, -1, -1, -1, + -1, 272, 273, 274, 275, -1, -1, -1, 279, 280, + -1, 282, 283, 284, 285, 286, -1, -1, -1, -1, + 291, 292, 293, 294, 295, 296, -1, 123, 299, -1, + 126, -1, 91, -1, -1, -1, 41, 308, -1, 310, + 311, -1, 257, 258, 259, 260, 261, 262, 263, 264, + 265, -1, -1, -1, 269, -1, -1, -1, 63, -1, + -1, -1, -1, -1, 123, 280, -1, 282, 283, 284, + 285, 286, -1, -1, -1, -1, 291, 292, 293, 294, + 295, 296, -1, -1, 299, -1, 91, -1, -1, -1, + -1, -1, -1, 308, -1, 310, 311, -1, 257, 258, + 259, 260, 261, -1, 263, 264, 265, -1, -1, -1, + 269, 58, -1, -1, -1, -1, 63, -1, 123, -1, + -1, 280, -1, 282, 283, 284, 285, 286, -1, -1, + -1, -1, 291, 292, 293, 294, 295, 296, -1, -1, + 299, -1, -1, -1, 91, -1, -1, -1, -1, 308, + -1, 310, 311, -1, -1, -1, -1, 41, -1, -1, + 44, 257, 258, 259, 260, 261, -1, 263, 264, 265, + -1, -1, -1, 269, 58, 59, 123, -1, -1, 63, + -1, -1, -1, -1, 280, -1, 282, 283, 284, 285, + 286, -1, -1, -1, -1, 291, 292, 293, 294, 295, + 296, 33, -1, 299, 36, 37, 38, -1, 40, 93, + 42, 43, 308, 45, 310, 311, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 59, 287, 288, + 289, 290, 64, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 301, 302, 303, 304, 305, 306, -1, -1, + 309, -1, -1, 312, 313, 314, -1, 33, -1, 91, + 36, 37, 38, -1, 40, 41, 42, 43, -1, 45, + -1, -1, -1, -1, -1, -1, 281, -1, -1, -1, + -1, -1, 287, 288, 289, 290, -1, -1, 64, -1, + -1, -1, -1, -1, 126, 300, 301, 302, 303, 304, + 305, 306, -1, -1, 309, -1, -1, 312, 313, 314, + -1, -1, -1, 33, -1, 91, 36, 37, 38, -1, + 40, -1, 42, 43, -1, 45, -1, -1, -1, -1, + -1, -1, -1, -1, 281, -1, -1, -1, -1, -1, + 287, 288, 289, 290, 64, -1, -1, -1, -1, -1, + 126, -1, -1, 300, 301, 302, 303, 304, 305, 306, + -1, -1, 309, -1, -1, 312, 313, 314, -1, -1, + -1, 91, 33, 93, -1, 36, 37, 38, -1, 40, + 41, 42, 43, -1, 45, -1, -1, -1, 272, 273, + 274, 275, -1, -1, -1, -1, -1, 281, -1, -1, + -1, -1, -1, 64, 288, -1, 126, -1, -1, -1, + -1, -1, -1, 297, 298, -1, 300, 301, 302, 303, + 304, 41, -1, -1, 44, 257, 258, 259, 260, 261, + 91, 263, 264, 265, -1, -1, -1, 269, 58, 59, + -1, -1, -1, 63, -1, -1, -1, -1, 280, -1, + 282, 283, 284, 285, 286, -1, -1, -1, -1, 291, + 292, 293, 294, 295, 296, 126, -1, 299, -1, -1, + -1, -1, -1, 93, -1, -1, 308, 41, 310, 311, + 44, 257, 258, 259, 260, 261, -1, 263, 264, 265, + -1, -1, -1, 269, 58, 59, -1, -1, -1, 63, + -1, -1, -1, -1, 280, -1, 282, 283, 284, 285, + 286, -1, -1, -1, -1, 291, 292, 293, 294, 295, + 296, -1, -1, 299, -1, -1, -1, -1, -1, 93, + -1, -1, 308, -1, 310, 311, -1, 257, 258, 259, + 260, 261, -1, 263, 264, 265, -1, 33, -1, 269, + 36, 37, 38, -1, 40, 41, 42, 43, -1, 45, + 280, -1, 282, 283, 284, 285, 286, -1, -1, -1, + -1, 291, 292, 293, 294, 295, 296, -1, 64, 299, + -1, -1, -1, -1, -1, -1, -1, -1, 308, -1, + 310, 311, -1, -1, -1, -1, 257, 258, 259, 260, + 261, -1, 263, 264, 265, 91, 33, -1, 269, 36, + 37, 38, -1, 40, -1, 42, 43, -1, 45, 280, + -1, 282, 283, 284, 285, 286, -1, -1, -1, -1, + 291, 292, 293, 294, 295, 296, -1, 64, 299, -1, + 126, -1, -1, -1, -1, -1, -1, 308, -1, 310, + 311, -1, 272, 273, 274, 275, -1, -1, -1, -1, + -1, 281, 33, -1, 91, 36, 37, 38, -1, 40, + 41, 42, 43, -1, 45, -1, -1, 297, 298, -1, + 300, 301, 302, 303, 304, -1, -1, -1, -1, -1, + -1, -1, -1, 64, -1, -1, -1, -1, -1, 126, + -1, -1, -1, -1, -1, -1, -1, -1, 272, 273, + 274, 275, -1, -1, -1, -1, -1, 281, 33, -1, + 91, 36, 37, 38, -1, 40, 41, 42, 43, -1, + 45, -1, -1, 297, 298, -1, 300, 301, 302, 303, + 304, -1, -1, -1, -1, -1, -1, -1, -1, 64, + -1, -1, -1, -1, -1, 126, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 123, -1, -1, -1, -1, -1, 272, 273, - 274, 275, -1, 91, -1, 93, -1, 281, -1, -1, - -1, 285, 286, 287, 288, 41, -1, -1, 44, -1, - 294, 295, -1, -1, 298, 299, 300, 301, 302, -1, - 304, 305, 58, 59, 308, 123, -1, 311, 312, 313, + -1, 257, 258, 259, 260, 261, 91, 263, 264, 265, + -1, 33, -1, 269, 36, 37, 38, -1, 40, -1, + 42, 43, -1, 45, 280, -1, 282, 283, 284, 285, + 286, -1, -1, -1, -1, 291, 292, 293, 294, 295, + 296, 126, 64, 299, -1, -1, -1, -1, -1, -1, + -1, -1, 308, -1, 310, 311, -1, -1, -1, 256, + 257, 258, 259, 260, 261, -1, 263, 264, 265, 91, + -1, -1, 269, 41, -1, -1, 44, -1, -1, -1, + -1, -1, -1, 280, -1, 282, 283, 284, 285, 286, + 58, 59, -1, -1, 291, 292, 293, 294, 295, 296, + -1, -1, 299, -1, 126, -1, -1, -1, -1, 41, + -1, 308, 44, 310, 311, -1, 257, 258, 259, 260, + 261, -1, 263, 264, 265, 93, 58, 59, 269, -1, + -1, 63, -1, -1, -1, -1, -1, -1, -1, 280, + -1, 282, 283, 284, 285, 286, -1, -1, -1, -1, + 291, 292, 293, 294, 295, 296, -1, -1, 299, 91, + -1, 93, -1, -1, -1, -1, -1, 308, 41, 310, + 311, 44, 257, 258, 259, 260, 261, -1, 263, 264, + 265, -1, -1, -1, 269, 58, 59, -1, -1, -1, + 63, 123, -1, -1, -1, 280, -1, 282, 283, 284, + 285, 286, -1, -1, -1, -1, 291, 292, 293, 294, + 295, 296, -1, -1, 299, -1, -1, -1, 91, -1, + 93, -1, -1, 308, -1, 310, 311, -1, -1, -1, + -1, 41, -1, -1, 44, 257, 258, 259, 260, 261, + -1, 263, 264, 265, -1, -1, -1, 269, 58, 59, + 123, -1, -1, 63, -1, -1, -1, -1, 280, -1, + 282, 283, 284, 285, 286, -1, -1, -1, -1, 291, + 292, 293, 294, 295, 296, -1, -1, 299, -1, 41, + -1, 91, 44, 93, -1, -1, 308, -1, 310, 311, + -1, -1, -1, -1, -1, -1, 58, 59, -1, -1, + -1, 63, -1, -1, 272, 273, 274, 275, -1, -1, + -1, -1, -1, 123, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 297, + 298, 93, 300, -1, -1, -1, -1, -1, -1, -1, + 272, 273, 274, 275, -1, 41, -1, -1, 44, 281, + -1, -1, -1, -1, -1, 287, 288, 289, 290, -1, + -1, 123, 58, 59, -1, 297, 298, 63, 300, 301, + 302, 303, 304, 305, 306, -1, -1, 309, -1, -1, + 312, 313, 314, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 91, -1, 93, -1, 272, + 273, 274, 275, -1, 41, -1, -1, 44, 281, -1, + -1, -1, -1, -1, 287, 288, 289, 290, -1, -1, + -1, 58, 59, -1, 297, 298, 63, 300, 301, 302, + 303, 304, 305, 306, -1, -1, 309, -1, -1, 312, + 313, 314, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 93, -1, -1, -1, -1, -1, 272, 273, 274, 275, -1, -1, -1, -1, - -1, 281, -1, -1, -1, 285, 286, 287, 288, -1, - -1, -1, -1, -1, 294, 295, -1, 93, 298, 299, - 300, 301, 302, -1, 304, 305, -1, -1, 308, -1, - -1, 311, 312, 313, -1, -1, -1, 41, -1, -1, - 44, -1, -1, -1, -1, -1, -1, 272, 273, 274, - 275, -1, -1, -1, 58, 59, 281, -1, -1, 63, - 285, 286, 287, 288, -1, -1, -1, -1, -1, 294, - 295, -1, -1, 298, 299, 300, 301, 302, -1, 304, - 305, 41, -1, 308, 44, -1, 311, 312, 313, 93, - -1, 272, 273, 274, 275, -1, -1, -1, 58, 59, - 281, -1, -1, 63, 285, 286, 287, 288, -1, -1, - -1, -1, -1, 294, 295, -1, -1, 298, 299, 300, - 301, 302, -1, 304, 305, -1, -1, 308, -1, -1, - 311, 312, 313, 93, 272, 273, 274, 275, -1, 58, - -1, -1, -1, 281, 63, -1, -1, 285, 286, 287, - 288, -1, -1, -1, -1, -1, 294, 295, -1, -1, - 298, 299, 300, 301, 302, 41, 304, 305, 44, -1, - 308, -1, 91, 311, 312, 313, -1, -1, -1, -1, - -1, -1, 58, 59, -1, -1, -1, 63, -1, -1, + -1, 281, -1, -1, -1, -1, -1, 287, 288, 289, + 290, -1, -1, -1, -1, -1, 123, 297, 298, -1, + 300, 301, 302, 303, 304, 305, 306, -1, -1, 309, + -1, -1, 312, 313, 314, -1, -1, -1, -1, -1, + 272, 273, 274, 275, -1, 41, -1, -1, -1, 281, + -1, -1, -1, -1, -1, 287, 288, 289, 290, -1, + -1, -1, 58, 59, -1, 297, 298, 63, 300, 301, + 302, 303, 304, 305, 306, -1, -1, 309, -1, -1, + 312, 313, 314, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 91, -1, 93, -1, -1, -1, -1, -1, -1, -1, -1, 272, 273, 274, 275, - -1, -1, -1, -1, 123, -1, -1, 41, -1, -1, - 44, -1, -1, -1, -1, -1, -1, 93, 294, 295, - -1, -1, -1, -1, 58, 59, -1, -1, -1, 63, + -1, -1, -1, -1, -1, 281, -1, -1, -1, -1, + -1, 287, 288, 289, 290, -1, -1, 123, -1, -1, + 91, 297, 298, -1, 300, 301, 302, 303, 304, 305, + 306, -1, -1, 309, -1, -1, 312, 313, 314, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 123, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 41, 93, - -1, 44, -1, -1, -1, -1, -1, -1, 272, 273, - 274, 275, -1, -1, -1, 58, 59, 281, -1, -1, - 63, 285, 286, 287, 288, -1, -1, -1, -1, -1, - 294, 295, -1, -1, 298, 299, 300, 301, 302, -1, - 304, 305, 41, -1, 308, 44, -1, 311, 312, 313, - 93, -1, 272, 273, 274, 275, -1, -1, -1, 58, - 59, 281, -1, -1, 63, 285, 286, 287, 288, -1, - -1, -1, -1, -1, 294, 295, -1, -1, 298, 299, - 300, 301, 302, 41, 304, 305, 44, -1, 308, -1, - -1, 311, 312, 313, 93, -1, -1, -1, -1, -1, - 58, 59, 281, -1, -1, 63, 285, 286, 287, 288, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 298, - 299, 300, 301, 302, -1, 304, 305, -1, -1, 308, - -1, -1, 311, 312, 313, 93, 272, 273, 274, 275, - -1, -1, -1, -1, -1, 281, -1, -1, -1, 285, - 286, 287, 288, -1, -1, -1, -1, -1, 294, 295, - -1, -1, 298, 299, 300, 301, 302, -1, 304, 305, - -1, -1, 308, -1, -1, 311, 312, 313, 272, 273, - 274, 275, -1, -1, -1, -1, -1, 281, -1, -1, - -1, 285, 286, 287, 288, 41, -1, -1, 44, -1, - 294, 295, -1, -1, 298, 299, 300, 301, 302, -1, - 304, 305, 58, 59, 308, -1, -1, 311, 312, 313, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 272, - 273, 274, 275, -1, -1, -1, -1, -1, 281, -1, - -1, -1, 285, 286, 287, 288, -1, 93, -1, -1, - -1, 294, 295, -1, -1, 298, 299, 300, 301, 302, - -1, 304, 305, -1, -1, 308, -1, -1, 311, 312, - 313, -1, -1, 272, 273, 274, 275, -1, -1, -1, - -1, -1, 281, -1, -1, -1, 285, 286, 287, 288, - -1, -1, -1, -1, -1, 294, 295, -1, -1, 298, - 299, 300, 301, 302, 41, 304, 305, 44, -1, 308, - -1, -1, -1, -1, 272, 273, 274, 275, -1, -1, - -1, 58, 59, 281, -1, -1, 63, 285, 286, 287, - 288, -1, -1, -1, -1, -1, 294, 295, -1, -1, - 298, 299, 300, 301, 302, 41, 304, 305, 44, -1, - 308, -1, -1, -1, -1, -1, 93, -1, -1, -1, - -1, -1, 58, 59, -1, -1, -1, 63, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 41, -1, -1, 44, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 93, 58, 59, - -1, -1, -1, 63, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 41, -1, -1, - 44, -1, -1, -1, -1, -1, 272, 273, 274, 275, - -1, -1, -1, 93, 58, 59, -1, -1, -1, 63, - -1, -1, -1, -1, -1, -1, -1, -1, 294, 295, + -1, -1, 123, -1, -1, 272, 273, 274, 275, -1, + 41, -1, -1, -1, 281, -1, -1, -1, -1, -1, + 287, 288, 289, 290, -1, -1, -1, 58, 59, -1, + 297, 298, 63, 300, 301, 302, 303, 304, 305, 306, + -1, -1, 309, -1, -1, 312, 313, 314, -1, -1, -1, -1, -1, 41, -1, -1, 44, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 93, + 91, -1, 93, 41, -1, -1, 44, -1, -1, -1, 58, 59, -1, -1, -1, 63, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 41, - -1, -1, 44, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 93, 58, 59, -1, -1, - -1, 63, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 272, 273, 274, 275, -1, - -1, 93, -1, -1, 281, -1, -1, -1, 285, 286, - 287, 288, -1, -1, -1, -1, -1, 294, 295, -1, - -1, 298, 299, 300, 301, 302, 41, 304, 305, 44, - -1, -1, -1, -1, -1, -1, 272, 273, 274, 275, - -1, -1, -1, 58, 59, 281, -1, -1, 63, 285, - 286, 287, 288, -1, -1, -1, -1, -1, 294, 295, - -1, -1, 298, 299, 300, 301, 302, -1, 304, 305, - -1, -1, 272, 273, 274, 275, -1, -1, 93, -1, - -1, 281, -1, -1, -1, 285, 286, 287, 288, -1, - -1, -1, -1, -1, 294, 295, -1, -1, 298, 299, - 300, 301, 302, -1, 304, 305, -1, -1, 272, 273, - 274, 275, -1, -1, -1, -1, -1, 281, -1, -1, - -1, 285, 286, 287, 288, -1, -1, -1, -1, -1, - 294, 295, -1, -1, 298, 299, 300, 301, 302, -1, - 304, 305, -1, -1, 272, 273, 274, 275, -1, -1, - -1, -1, -1, 281, -1, -1, -1, 285, 286, 287, - 288, -1, -1, -1, -1, -1, 294, 295, -1, -1, - 298, 299, 300, 301, 302, -1, 304, 305, -1, -1, - 272, 273, 274, 275, -1, -1, -1, -1, -1, 281, - -1, -1, -1, 285, 286, 287, 288, 41, -1, -1, - 44, -1, 294, 295, -1, -1, 298, 299, 300, 301, - 302, -1, 304, 305, 58, 59, -1, -1, -1, 63, + 58, 59, -1, -1, -1, 63, -1, -1, -1, -1, + -1, -1, 123, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 93, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 93, 272, 273, 274, 275, + -1, 41, -1, -1, 44, 281, -1, -1, -1, -1, + -1, 287, 288, 289, 290, 123, -1, -1, 58, 59, + -1, 297, 298, 63, 300, 301, 302, 303, 304, 305, + 306, -1, -1, 309, -1, -1, 312, 313, 314, -1, + -1, -1, -1, -1, 41, -1, 287, 288, 289, 290, + -1, -1, -1, 93, -1, -1, -1, -1, -1, -1, + -1, 58, 59, 304, 305, 306, 63, -1, 309, -1, + -1, 312, 313, 314, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 123, -1, -1, -1, -1, 41, -1, + -1, 44, -1, -1, 91, -1, 93, -1, -1, -1, + -1, -1, -1, -1, -1, 58, 59, -1, -1, -1, + 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 272, 273, 274, 275, -1, 123, -1, -1, -1, + 281, -1, -1, -1, -1, -1, 287, 288, 289, 290, + 93, -1, -1, -1, -1, -1, 297, 298, -1, 300, + 301, 302, 303, 304, 305, 306, -1, -1, 309, -1, + -1, 312, 313, 314, 272, 273, 274, 275, -1, 41, + 123, -1, 44, 281, 272, 273, 274, 275, -1, 287, + 288, 289, 290, -1, -1, -1, 58, 59, -1, 297, + 298, 63, 300, 301, 302, 303, 304, 305, 306, 297, + 298, 309, 300, -1, 312, 313, 314, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 41, -1, -1, 44, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 58, 59, 93, - -1, -1, 63, -1, -1, -1, -1, 272, 273, 274, - 275, -1, -1, -1, -1, -1, 281, -1, -1, -1, - 285, 286, 287, 288, 41, -1, -1, 44, -1, 294, - 295, -1, 93, 298, 299, 300, 301, 302, -1, 304, - 305, 58, 59, -1, -1, -1, 63, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 41, -1, -1, + -1, 93, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 272, 273, 274, 275, -1, 41, -1, -1, + 44, 281, -1, -1, -1, -1, -1, 287, 288, 289, + 290, -1, -1, -1, 58, 59, -1, 297, 298, 63, + 300, 301, 302, 303, 304, 305, 306, -1, -1, 309, + -1, -1, 312, 313, 314, 272, 273, 274, 275, -1, + 41, -1, -1, 44, 281, -1, -1, -1, -1, 93, + 287, 288, 289, 290, -1, -1, -1, 58, 59, -1, + 297, 298, 63, 300, 301, 302, 303, 304, 305, 306, + -1, -1, 309, -1, -1, 312, 313, 314, -1, 272, + 273, 274, 275, -1, 41, -1, -1, 44, 281, -1, + -1, -1, 93, -1, 287, 288, 289, 290, -1, -1, + -1, 58, 59, -1, 297, 298, 63, 300, 301, 302, + 303, 304, 305, 306, -1, -1, 309, -1, -1, 312, + 313, 314, -1, -1, -1, -1, -1, 41, -1, -1, + 44, -1, -1, -1, -1, -1, 93, -1, -1, -1, + -1, -1, -1, -1, 58, 59, -1, 41, -1, 63, 44, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 58, 59, 93, -1, -1, 63, - -1, -1, -1, -1, -1, -1, -1, -1, 41, -1, - -1, 44, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 58, 59, -1, -1, 93, - 63, -1, -1, -1, -1, -1, -1, -1, -1, 41, - -1, -1, 44, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 58, 59, -1, -1, - 93, 63, -1, -1, -1, -1, -1, -1, -1, -1, - 41, -1, -1, 44, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 41, 58, 59, 44, - -1, 93, 63, -1, -1, -1, -1, -1, 272, 273, - 274, 275, -1, 58, 59, -1, -1, 281, 63, -1, - -1, 285, 286, 287, 288, -1, -1, -1, -1, -1, - 294, 295, 93, -1, 298, 299, 300, 301, 302, -1, - 304, 272, 273, 274, 275, -1, -1, -1, 93, -1, - 281, -1, -1, -1, 285, 286, -1, 288, 41, -1, - -1, 44, -1, 294, 295, -1, -1, 298, 299, 300, - 301, 302, -1, 304, 41, 58, 59, 44, -1, -1, - 63, -1, -1, -1, -1, 272, 273, 274, 275, -1, - -1, 58, 59, -1, 281, -1, 63, -1, 285, 286, - -1, -1, -1, -1, -1, -1, -1, 294, 295, -1, - 93, 298, 299, 300, 301, 302, -1, 304, 272, 273, - 274, 275, -1, -1, -1, -1, 93, 281, -1, -1, - -1, 285, 286, -1, -1, -1, -1, -1, -1, 41, - 294, 295, 44, -1, 298, 299, 300, 301, 302, 272, - 273, 274, 275, -1, -1, -1, 58, 59, 281, -1, - -1, 63, 285, 286, -1, -1, -1, -1, -1, -1, - -1, 294, 295, -1, -1, 298, 299, 300, 301, 302, - 272, 273, 274, 275, -1, -1, -1, -1, -1, 281, - -1, 93, -1, 285, 286, -1, -1, -1, -1, -1, - -1, -1, 294, 295, -1, -1, 298, 299, 300, 301, - 302, 272, 273, 274, 275, -1, -1, -1, -1, -1, - 281, -1, -1, -1, -1, 286, -1, 272, 273, 274, - 275, -1, -1, 294, 295, -1, 281, 298, 299, 300, - 301, 302, -1, -1, -1, -1, -1, -1, -1, 294, - 295, -1, -1, 298, 299, 300, 301, 302, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 272, - 273, 274, 275, -1, -1, -1, -1, -1, 281, -1, + 272, 273, 274, 275, 58, 59, -1, -1, -1, 281, + -1, -1, -1, -1, -1, 287, 288, 289, 290, 93, + -1, -1, -1, -1, -1, 297, 298, -1, 300, 301, + 302, 303, 304, 305, 306, 41, -1, 309, 44, 93, + 312, 313, 314, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 58, 59, -1, -1, -1, 63, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 272, 273, + 274, 275, -1, 41, -1, -1, 44, 281, -1, -1, + -1, -1, -1, 287, 288, 289, 290, 93, -1, -1, + 58, 59, -1, 297, 298, 63, 300, 301, 302, 303, + 304, 305, 306, -1, -1, 309, -1, -1, 312, 313, + 314, 272, 273, 274, 275, -1, -1, -1, -1, -1, + 281, -1, -1, -1, -1, 93, 287, 288, 289, 290, + -1, -1, -1, -1, -1, -1, 297, 298, -1, 300, + 301, 302, 303, 304, 305, 306, -1, -1, 309, -1, + -1, 312, 313, 314, -1, 272, 273, 274, 275, -1, + 41, -1, -1, 44, 281, -1, -1, -1, -1, -1, + 287, 288, 289, 290, -1, -1, -1, 58, 59, -1, + 297, 298, 63, 300, 301, 302, 303, 304, 305, 306, + -1, -1, 309, -1, -1, 312, 313, 314, 272, 273, + 274, 275, -1, -1, -1, -1, -1, 281, -1, -1, + -1, -1, 93, 287, 288, 289, 290, -1, 272, 273, + 274, 275, -1, 297, 298, 30, 300, 301, 302, 303, + 304, 305, 306, 38, -1, 309, -1, 42, -1, -1, + 45, -1, -1, 297, 298, -1, -1, 52, 53, 54, + 55, 56, -1, -1, 59, 60, -1, -1, 91, -1, + -1, 66, -1, -1, -1, -1, 272, 273, 274, 275, + -1, 41, -1, -1, 44, 281, -1, -1, -1, -1, + -1, 287, 288, 289, 290, -1, -1, 92, 58, 59, + 123, 297, 298, 63, 300, 301, 302, 303, 304, 305, + 306, -1, -1, -1, 272, 273, 274, 275, -1, -1, + -1, -1, -1, 281, -1, -1, -1, -1, -1, 287, + 288, 289, 290, 93, 41, -1, -1, 44, -1, 297, + 298, -1, 300, 301, 302, 303, 304, 305, 306, -1, + -1, 58, 59, -1, -1, -1, 63, -1, 153, 154, + 155, 156, 157, 158, 159, 160, 161, 162, 163, 164, + 165, 166, 41, -1, -1, 44, -1, -1, -1, -1, + -1, -1, -1, 178, -1, -1, 93, -1, -1, 58, + 59, -1, -1, -1, 63, -1, -1, -1, -1, -1, + -1, 272, 273, 274, 275, -1, -1, -1, -1, -1, + 281, -1, -1, -1, -1, -1, 287, 288, 289, 290, + 41, -1, -1, 44, 93, -1, 297, 298, -1, 300, + 301, 302, 303, 304, 305, 306, -1, 58, 59, -1, + -1, -1, 63, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 41, -1, -1, 44, + -1, -1, -1, 258, 287, 288, 289, 290, -1, -1, + -1, -1, 93, 58, 59, -1, -1, -1, 63, 302, + 303, 304, 305, 306, -1, -1, 309, -1, -1, 312, + 313, 314, -1, -1, -1, -1, -1, -1, -1, -1, + 295, 41, -1, -1, 44, -1, -1, -1, 93, -1, + -1, -1, 272, 273, 274, 275, -1, -1, 58, 59, + -1, 281, -1, 63, -1, -1, -1, 287, 288, 289, + 290, -1, -1, -1, -1, -1, -1, 297, 298, -1, + 300, 301, 302, 303, 304, 305, 306, -1, -1, -1, + -1, -1, -1, 93, -1, 41, -1, -1, 44, -1, -1, -1, -1, -1, -1, 272, 273, 274, 275, -1, - -1, 294, 295, -1, 281, 298, 299, 300, 301, 302, - -1, -1, 30, -1, -1, -1, -1, 294, 295, -1, - 38, 298, 299, 300, 301, 43, 44, -1, -1, -1, - -1, -1, 50, 51, 52, 53, 54, 55, -1, -1, - 58, 59, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 272, 273, 274, 275, -1, -1, -1, -1, -1, 281, - -1, -1, 90, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 294, 295, -1, -1, 298, 299, 300, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 143, -1, -1, -1, -1, - -1, -1, -1, 151, 152, 153, 154, 155, 156, 157, - 158, 159, 160, 161, 162, 163, 164, -1, -1, -1, + -1, -1, 58, 59, 281, -1, -1, 63, -1, -1, + 287, 288, 289, 290, -1, -1, -1, -1, -1, -1, + 297, 298, -1, 300, 301, 302, 303, 304, 305, 306, + -1, -1, -1, 272, 273, 274, 275, 93, -1, -1, + -1, -1, 281, -1, -1, -1, -1, -1, 287, 288, + 289, 290, 41, -1, -1, 44, -1, -1, 297, 298, + -1, 300, 301, 302, 303, 304, 305, 306, -1, 58, + 59, -1, -1, -1, 63, -1, -1, -1, -1, -1, + -1, 272, 273, 274, 275, 41, -1, -1, 44, -1, + 281, -1, -1, -1, -1, -1, 287, 288, 289, 290, + -1, -1, 58, 59, 93, 41, 297, 298, 44, 300, + 301, 302, 303, 304, 305, 306, -1, 272, 273, 274, + 275, -1, 58, 59, -1, -1, 281, 63, -1, -1, + -1, -1, 287, 288, 289, 290, -1, 93, -1, -1, + -1, -1, 297, 298, -1, 300, 301, 302, 303, 304, + 305, 41, -1, -1, 44, -1, -1, 93, -1, -1, + -1, -1, 272, 273, 274, 275, -1, -1, 58, 59, + -1, 281, -1, 63, -1, -1, -1, 287, 288, -1, + 290, 91, -1, -1, -1, -1, -1, 297, 298, -1, + 300, 301, 302, 303, 304, 305, -1, 41, -1, -1, + 44, -1, -1, 93, 41, -1, -1, 44, -1, -1, + -1, -1, -1, 123, 58, 59, 272, 273, 274, 275, + -1, 58, 59, -1, -1, 281, 63, -1, -1, -1, + -1, 287, 288, -1, -1, -1, 41, -1, -1, 44, + -1, 297, 298, -1, 300, 301, 302, 303, 304, 93, + -1, -1, -1, 58, 59, -1, 93, -1, 63, -1, + -1, 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 272, 273, 274, 275, -1, 93, 91, + -1, -1, 281, -1, -1, 63, -1, -1, 287, 288, + -1, -1, -1, -1, -1, -1, -1, -1, 297, 298, + -1, 300, 301, 302, 303, 304, 272, 273, 274, 275, + -1, 123, -1, 91, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 272, 273, 274, 275, + -1, 297, 298, -1, -1, 281, -1, -1, -1, -1, + -1, 287, 288, -1, -1, 123, -1, -1, -1, -1, + -1, 297, 298, -1, 300, 301, 302, 303, 304, -1, + -1, -1, -1, -1, -1, -1, -1, 287, 288, 289, + 290, -1, 272, 273, 274, 275, -1, -1, -1, -1, + -1, 281, -1, 303, 304, 305, 306, 287, 288, 309, + -1, -1, 312, 313, 314, -1, -1, 297, 298, -1, + 300, 301, 302, 303, 304, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 272, 273, + 274, 275, -1, -1, -1, 272, 273, 274, 275, -1, + -1, -1, -1, -1, 281, -1, -1, -1, -1, -1, + -1, -1, -1, 297, 298, -1, -1, -1, -1, -1, + 297, 298, -1, 300, 301, 302, 303, 272, 273, 274, + 275, -1, -1, -1, -1, -1, 281, -1, -1, 281, + -1, -1, -1, -1, -1, 287, 288, 289, 290, -1, + -1, -1, 297, 298, -1, 300, 301, 302, 300, 301, + 302, 303, 304, 305, 306, -1, -1, 309, -1, -1, + 312, 313, 314, 281, -1, -1, -1, -1, -1, 287, + 288, 289, 290, -1, -1, -1, -1, 13, -1, -1, + -1, 17, -1, 301, 302, 303, 304, 305, 306, -1, + -1, 309, -1, -1, 312, 313, 314, 33, 34, 35, + 36, -1, -1, -1, -1, -1, 42, -1, -1, 45, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 80, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 94, -1, + -1, 97, -1, 99, -1, 101, -1, 103, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 144, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 256, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 284, + -1, -1, -1, -1, -1, 181, -1, -1, -1, -1, + -1, -1, 188, }; #define YYFINAL 1 #ifndef YYDEBUG #define YYDEBUG 0 #endif -#define YYMAXTOKEN 313 +#define YYMAXTOKEN 314 #if YYDEBUG dEXT char * yyname[] = { "end-of-file",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, @@ -1124,9 +1074,9 @@ dEXT char * yyname[] = { 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,"WORD","METHOD","FUNCMETH","THING", "PMFUNC","PRIVATEREF","FUNC0SUB","UNIOPSUB","LSTOPSUB","LABEL","FORMAT","SUB", "ANONSUB","PACKAGE","USE","WHILE","UNTIL","IF","UNLESS","ELSE","ELSIF", -"CONTINUE","FOR","LOOPEX","DOTDOT","FUNC0","FUNC1","FUNC","RELOP","EQOP", -"MULOP","ADDOP","DOLSHARP","DO","LOCAL","HASHBRACK","NOAMP","OROP","ANDOP", -"NOTOP","LSTOP","ASSIGNOP","OROR","ANDAND","BITOROP","BITANDOP","UNIOP", +"CONTINUE","FOR","LOOPEX","DOTDOT","FUNC0","FUNC1","FUNC","UNIOP","LSTOP", +"RELOP","EQOP","MULOP","ADDOP","DOLSHARP","DO","HASHBRACK","NOAMP","LOCAL","MY", +"OROP","ANDOP","NOTOP","ASSIGNOP","OROR","ANDAND","BITOROP","BITANDOP", "SHIFTOP","MATCHOP","UMINUS","REFGEN","POWOP","PREINC","PREDEC","POSTINC", "POSTDEC","ARROW", }; @@ -1136,6 +1086,8 @@ dEXT char * yyrule[] = { "prog : $$1 lineseq", "block : '{' remember lineseq '}'", "remember :", +"mblock : '{' mremember lineseq '}'", +"mremember :", "lineseq :", "lineseq : lineseq decl", "lineseq : lineseq line", @@ -1148,28 +1100,34 @@ dEXT char * yyrule[] = { "sideff : expr IF expr", "sideff : expr UNLESS expr", "sideff : expr WHILE expr", -"sideff : expr UNTIL expr", +"sideff : expr UNTIL iexpr", "else :", -"else : ELSE block", -"else : ELSIF '(' expr ')' block else", -"cond : IF '(' expr ')' block else", -"cond : UNLESS '(' expr ')' block else", +"else : ELSE mblock", +"else : ELSIF '(' mexpr ')' mblock else", +"cond : IF '(' remember mexpr ')' mblock else", +"cond : UNLESS '(' remember miexpr ')' mblock else", "cond : IF block block else", "cond : UNLESS block block else", "cont :", "cont : CONTINUE block", -"loop : label WHILE '(' texpr ')' block cont", -"loop : label UNTIL '(' expr ')' block cont", +"loop : label WHILE '(' remember mtexpr ')' mblock cont", +"loop : label UNTIL '(' remember miexpr ')' mblock cont", "loop : label WHILE block block cont", "loop : label UNTIL block block cont", -"loop : label FOR scalar '(' expr ')' block cont", -"loop : label FOR '(' expr ')' block cont", -"loop : label FOR '(' nexpr ';' texpr ';' nexpr ')' block", +"loop : label FOR MY remember my_scalar '(' mexpr ')' mblock cont", +"loop : label FOR scalar '(' remember mexpr ')' mblock cont", +"loop : label FOR '(' remember mexpr ')' mblock cont", +"loop : label FOR '(' remember mnexpr ';' mtexpr ';' mnexpr ')' mblock", "loop : label block cont", "nexpr :", "nexpr : sideff", "texpr :", "texpr : expr", +"iexpr : expr", +"mexpr : expr", +"mnexpr : nexpr", +"mtexpr : texpr", +"miexpr : iexpr", "label :", "label : LABEL", "decl : format", @@ -1225,7 +1183,7 @@ dEXT char * yyrule[] = { "term : term POSTDEC", "term : PREINC term", "term : PREDEC term", -"term : LOCAL term", +"term : local term", "term : '(' expr ')'", "term : '(' ')'", "term : '[' expr ']'", @@ -1281,6 +1239,9 @@ dEXT char * yyrule[] = { "listexprcom :", "listexprcom : expr", "listexprcom : expr ','", +"local : LOCAL", +"local : MY", +"my_scalar : scalar", "amper : '&' indirob", "scalar : '$' indirob", "ary : '@' indirob", @@ -1313,9 +1274,9 @@ dEXT int yyerrflag; dEXT int yychar; dEXT YYSTYPE yyval; dEXT YYSTYPE yylval; -#line 571 "perly.y" +#line 624 "perly.y" /* PROGRAM */ -#line 1388 "y_tab.c" +#line 1349 "perly.c" #define YYABORT goto yyabort #define YYACCEPT goto yyaccept #define YYERROR goto yyerrlab @@ -1336,15 +1297,15 @@ yydestruct(ptr) void* ptr; { struct ysv* ysave = (struct ysv*)ptr; - if (ysave->yyss) safefree((char *)ysave->yyss); - if (ysave->yyvs) safefree((char *)ysave->yyvs); + if (ysave->yyss) Safefree(ysave->yyss); + if (ysave->yyvs) Safefree(ysave->yyvs); yydebug = ysave->oldyydebug; yynerrs = ysave->oldyynerrs; yyerrflag = ysave->oldyyerrflag; yychar = ysave->oldyychar; yyval = ysave->oldyyval; yylval = ysave->oldyylval; - safefree((char *)ysave); + Safefree(ysave); } int @@ -1540,7 +1501,7 @@ yyreduce: switch (yyn) { case 1: -#line 84 "perly.y" +#line 85 "perly.y" { #if defined(YYDEBUG) && defined(DEBUGGING) yydebug = (debug & 1); @@ -1549,38 +1510,50 @@ case 1: } break; case 2: -#line 91 "perly.y" +#line 92 "perly.y" { newPROG(yyvsp[0].opval); } break; case 3: -#line 95 "perly.y" -{ yyval.opval = block_end(yyvsp[-3].ival,yyvsp[-2].ival,yyvsp[-1].opval); } +#line 96 "perly.y" +{ if (copline > (line_t)yyvsp[-3].ival) + copline = yyvsp[-3].ival; + yyval.opval = block_end(yyvsp[-2].ival, yyvsp[-1].opval); } break; case 4: -#line 99 "perly.y" -{ yyval.ival = block_start(); } +#line 102 "perly.y" +{ yyval.ival = block_start(TRUE); } break; case 5: -#line 103 "perly.y" -{ yyval.opval = Nullop; } +#line 106 "perly.y" +{ if (copline > (line_t)yyvsp[-3].ival) + copline = yyvsp[-3].ival; + yyval.opval = block_end(yyvsp[-2].ival, yyvsp[-1].opval); } break; case 6: -#line 105 "perly.y" -{ yyval.opval = yyvsp[-1].opval; } +#line 112 "perly.y" +{ yyval.ival = block_start(FALSE); } break; case 7: -#line 107 "perly.y" +#line 116 "perly.y" +{ yyval.opval = Nullop; } +break; +case 8: +#line 118 "perly.y" +{ yyval.opval = yyvsp[-1].opval; } +break; +case 9: +#line 120 "perly.y" { yyval.opval = append_list(OP_LINESEQ, (LISTOP*)yyvsp[-1].opval, (LISTOP*)yyvsp[0].opval); pad_reset_pending = TRUE; if (yyvsp[-1].opval && yyvsp[0].opval) hints |= HINT_BLOCK_SCOPE; } break; -case 8: -#line 114 "perly.y" +case 10: +#line 127 "perly.y" { yyval.opval = newSTATEOP(0, yyvsp[-1].pval, yyvsp[0].opval); } break; -case 10: -#line 117 "perly.y" +case 12: +#line 130 "perly.y" { if (yyvsp[-1].pval != Nullch) { yyval.opval = newSTATEOP(0, yyvsp[-1].pval, newOP(OP_NULL, 0)); } @@ -1590,467 +1563,501 @@ case 10: } expect = XSTATE; } break; -case 11: -#line 126 "perly.y" +case 13: +#line 139 "perly.y" { yyval.opval = newSTATEOP(0, yyvsp[-2].pval, yyvsp[-1].opval); expect = XSTATE; } break; -case 12: -#line 131 "perly.y" -{ yyval.opval = Nullop; } -break; -case 13: -#line 133 "perly.y" -{ yyval.opval = yyvsp[0].opval; } -break; case 14: -#line 135 "perly.y" -{ yyval.opval = newLOGOP(OP_AND, 0, yyvsp[0].opval, yyvsp[-2].opval); } +#line 144 "perly.y" +{ yyval.opval = Nullop; } break; case 15: -#line 137 "perly.y" -{ yyval.opval = newLOGOP(OP_OR, 0, yyvsp[0].opval, yyvsp[-2].opval); } +#line 146 "perly.y" +{ yyval.opval = yyvsp[0].opval; } break; case 16: -#line 139 "perly.y" -{ yyval.opval = newLOOPOP(OPf_PARENS, 1, scalar(yyvsp[0].opval), yyvsp[-2].opval); } +#line 148 "perly.y" +{ yyval.opval = newLOGOP(OP_AND, 0, yyvsp[0].opval, yyvsp[-2].opval); } break; case 17: -#line 141 "perly.y" -{ yyval.opval = newLOOPOP(OPf_PARENS, 1, invert(scalar(yyvsp[0].opval)), yyvsp[-2].opval);} +#line 150 "perly.y" +{ yyval.opval = newLOGOP(OP_OR, 0, yyvsp[0].opval, yyvsp[-2].opval); } break; case 18: -#line 145 "perly.y" -{ yyval.opval = Nullop; } +#line 152 "perly.y" +{ yyval.opval = newLOOPOP(OPf_PARENS, 1, scalar(yyvsp[0].opval), yyvsp[-2].opval); } break; case 19: -#line 147 "perly.y" -{ yyval.opval = scope(yyvsp[0].opval); } +#line 154 "perly.y" +{ yyval.opval = newLOOPOP(OPf_PARENS, 1, yyvsp[0].opval, yyvsp[-2].opval);} break; case 20: -#line 149 "perly.y" -{ copline = yyvsp[-5].ival; - yyval.opval = newSTATEOP(0, 0, - newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval)); - hints |= HINT_BLOCK_SCOPE; } +#line 158 "perly.y" +{ yyval.opval = Nullop; } break; case 21: -#line 156 "perly.y" -{ copline = yyvsp[-5].ival; - yyval.opval = newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval); } +#line 160 "perly.y" +{ yyval.opval = scope(yyvsp[0].opval); } break; case 22: -#line 159 "perly.y" +#line 162 "perly.y" { copline = yyvsp[-5].ival; - yyval.opval = newCONDOP(0, - invert(scalar(yyvsp[-3].opval)), scope(yyvsp[-1].opval), yyvsp[0].opval); } + yyval.opval = newSTATEOP(0, Nullch, + newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval)); + hints |= HINT_BLOCK_SCOPE; } break; case 23: -#line 163 "perly.y" +#line 169 "perly.y" +{ copline = yyvsp[-6].ival; + yyval.opval = block_end(yyvsp[-4].ival, + newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval)); } +break; +case 24: +#line 173 "perly.y" +{ copline = yyvsp[-6].ival; + yyval.opval = block_end(yyvsp[-4].ival, + newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval)); } +break; +case 25: +#line 177 "perly.y" { copline = yyvsp[-3].ival; deprecate("if BLOCK BLOCK"); yyval.opval = newCONDOP(0, scope(yyvsp[-2].opval), scope(yyvsp[-1].opval), yyvsp[0].opval); } break; -case 24: -#line 167 "perly.y" +case 26: +#line 181 "perly.y" { copline = yyvsp[-3].ival; deprecate("unless BLOCK BLOCK"); yyval.opval = newCONDOP(0, invert(scalar(scope(yyvsp[-2].opval))), scope(yyvsp[-1].opval), yyvsp[0].opval); } break; -case 25: -#line 174 "perly.y" -{ yyval.opval = Nullop; } -break; -case 26: -#line 176 "perly.y" -{ yyval.opval = scope(yyvsp[0].opval); } -break; case 27: -#line 180 "perly.y" -{ copline = yyvsp[-5].ival; - yyval.opval = newSTATEOP(0, yyvsp[-6].pval, - newWHILEOP(0, 1, (LOOP*)Nullop, - yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval) ); } +#line 188 "perly.y" +{ yyval.opval = Nullop; } break; case 28: -#line 185 "perly.y" -{ copline = yyvsp[-5].ival; - yyval.opval = newSTATEOP(0, yyvsp[-6].pval, - newWHILEOP(0, 1, (LOOP*)Nullop, - invert(scalar(yyvsp[-3].opval)), yyvsp[-1].opval, yyvsp[0].opval) ); } +#line 190 "perly.y" +{ yyval.opval = scope(yyvsp[0].opval); } break; case 29: -#line 190 "perly.y" -{ copline = yyvsp[-3].ival; - yyval.opval = newSTATEOP(0, yyvsp[-4].pval, - newWHILEOP(0, 1, (LOOP*)Nullop, - scope(yyvsp[-2].opval), yyvsp[-1].opval, yyvsp[0].opval) ); } +#line 194 "perly.y" +{ copline = yyvsp[-6].ival; + yyval.opval = block_end(yyvsp[-4].ival, + newSTATEOP(0, yyvsp[-7].pval, + newWHILEOP(0, 1, (LOOP*)Nullop, + yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval))); } break; case 30: -#line 195 "perly.y" -{ copline = yyvsp[-3].ival; - yyval.opval = newSTATEOP(0, yyvsp[-4].pval, - newWHILEOP(0, 1, (LOOP*)Nullop, - invert(scalar(scope(yyvsp[-2].opval))), yyvsp[-1].opval, yyvsp[0].opval)); } +#line 200 "perly.y" +{ copline = yyvsp[-6].ival; + yyval.opval = block_end(yyvsp[-4].ival, + newSTATEOP(0, yyvsp[-7].pval, + newWHILEOP(0, 1, (LOOP*)Nullop, + yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval))); } break; case 31: -#line 200 "perly.y" -{ yyval.opval = newFOROP(0, yyvsp[-7].pval, yyvsp[-6].ival, mod(yyvsp[-5].opval, OP_ENTERLOOP), - yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval); } +#line 206 "perly.y" +{ copline = yyvsp[-3].ival; + deprecate("while BLOCK BLOCK"); + yyval.opval = newSTATEOP(0, yyvsp[-4].pval, + newWHILEOP(0, 1, (LOOP*)Nullop, + scope(yyvsp[-2].opval), yyvsp[-1].opval, yyvsp[0].opval)); } break; case 32: -#line 203 "perly.y" -{ yyval.opval = newFOROP(0, yyvsp[-6].pval, yyvsp[-5].ival, Nullop, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval); } +#line 212 "perly.y" +{ copline = yyvsp[-3].ival; + deprecate("until BLOCK BLOCK"); + yyval.opval = newSTATEOP(0, yyvsp[-4].pval, + newWHILEOP(0, 1, (LOOP*)Nullop, + invert(scalar(scope(yyvsp[-2].opval))), + yyvsp[-1].opval, yyvsp[0].opval)); } break; case 33: -#line 206 "perly.y" -{ copline = yyvsp[-8].ival; - yyval.opval = append_elem(OP_LINESEQ, - newSTATEOP(0, yyvsp[-9].pval, scalar(yyvsp[-6].opval)), - newSTATEOP(0, yyvsp[-9].pval, - newWHILEOP(0, 1, (LOOP*)Nullop, - scalar(yyvsp[-4].opval), yyvsp[0].opval, scalar(yyvsp[-2].opval)) )); } +#line 219 "perly.y" +{ yyval.opval = block_end(yyvsp[-6].ival, + newFOROP(0, yyvsp[-9].pval, yyvsp[-8].ival, yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval)); } break; case 34: -#line 213 "perly.y" +#line 222 "perly.y" +{ yyval.opval = block_end(yyvsp[-4].ival, + newFOROP(0, yyvsp[-8].pval, yyvsp[-7].ival, mod(yyvsp[-6].opval, OP_ENTERLOOP), + yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval)); } +break; +case 35: +#line 226 "perly.y" +{ yyval.opval = block_end(yyvsp[-4].ival, + newFOROP(0, yyvsp[-7].pval, yyvsp[-6].ival, Nullop, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval)); } +break; +case 36: +#line 230 "perly.y" +{ copline = yyvsp[-9].ival; + yyval.opval = block_end(yyvsp[-7].ival, + append_elem(OP_LINESEQ, scalar(yyvsp[-6].opval), + newSTATEOP(0, yyvsp[-10].pval, + newWHILEOP(0, 1, (LOOP*)Nullop, + scalar(yyvsp[-4].opval), + yyvsp[0].opval, scalar(yyvsp[-2].opval))))); } +break; +case 37: +#line 238 "perly.y" { yyval.opval = newSTATEOP(0, yyvsp[-2].pval, newWHILEOP(0, 1, (LOOP*)Nullop, Nullop, yyvsp[-1].opval, yyvsp[0].opval)); } break; -case 35: -#line 219 "perly.y" +case 38: +#line 244 "perly.y" { yyval.opval = Nullop; } break; -case 37: -#line 224 "perly.y" +case 40: +#line 249 "perly.y" { (void)scan_num("1"); yyval.opval = yylval.opval; } break; -case 39: -#line 229 "perly.y" +case 42: +#line 254 "perly.y" +{ yyval.opval = invert(scalar(yyvsp[0].opval)); } +break; +case 43: +#line 258 "perly.y" +{ yyval.opval = yyvsp[0].opval; intro_my(); } +break; +case 44: +#line 262 "perly.y" +{ yyval.opval = yyvsp[0].opval; intro_my(); } +break; +case 45: +#line 266 "perly.y" +{ yyval.opval = yyvsp[0].opval; intro_my(); } +break; +case 46: +#line 270 "perly.y" +{ yyval.opval = yyvsp[0].opval; intro_my(); } +break; +case 47: +#line 274 "perly.y" { yyval.pval = Nullch; } break; -case 41: -#line 234 "perly.y" +case 49: +#line 279 "perly.y" { yyval.ival = 0; } break; -case 42: -#line 236 "perly.y" +case 50: +#line 281 "perly.y" { yyval.ival = 0; } break; -case 43: -#line 238 "perly.y" +case 51: +#line 283 "perly.y" { yyval.ival = 0; } break; -case 44: -#line 240 "perly.y" +case 52: +#line 285 "perly.y" { yyval.ival = 0; } break; -case 45: -#line 244 "perly.y" +case 53: +#line 289 "perly.y" { newFORM(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); } break; -case 46: -#line 246 "perly.y" +case 54: +#line 291 "perly.y" { newFORM(yyvsp[-1].ival, Nullop, yyvsp[0].opval); } break; -case 47: -#line 250 "perly.y" +case 55: +#line 295 "perly.y" { newSUB(yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval, yyvsp[0].opval); } break; -case 48: -#line 252 "perly.y" +case 56: +#line 297 "perly.y" { newSUB(yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval, Nullop); expect = XSTATE; } break; -case 49: -#line 256 "perly.y" +case 57: +#line 301 "perly.y" { yyval.opval = Nullop; } break; -case 51: -#line 261 "perly.y" +case 59: +#line 306 "perly.y" { yyval.ival = start_subparse(); } break; -case 52: -#line 265 "perly.y" +case 60: +#line 310 "perly.y" { package(yyvsp[-1].opval); } break; -case 53: -#line 267 "perly.y" +case 61: +#line 312 "perly.y" { package(Nullop); } break; -case 54: -#line 271 "perly.y" +case 62: +#line 316 "perly.y" { utilize(yyvsp[-5].ival, yyvsp[-4].ival, yyvsp[-3].opval, yyvsp[-2].opval, yyvsp[-1].opval); } break; -case 55: -#line 275 "perly.y" +case 63: +#line 320 "perly.y" { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; -case 56: -#line 277 "perly.y" +case 64: +#line 322 "perly.y" { yyval.opval = newLOGOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; -case 58: -#line 282 "perly.y" +case 66: +#line 327 "perly.y" { yyval.opval = yyvsp[-1].opval; } break; -case 59: -#line 284 "perly.y" +case 67: +#line 329 "perly.y" { yyval.opval = append_elem(OP_LIST, yyvsp[-2].opval, yyvsp[0].opval); } break; -case 61: -#line 289 "perly.y" +case 69: +#line 334 "perly.y" { yyval.opval = convert(yyvsp[-2].ival, OPf_STACKED, prepend_elem(OP_LIST, newGVREF(yyvsp[-2].ival,yyvsp[-1].opval), yyvsp[0].opval) ); } break; -case 62: -#line 292 "perly.y" +case 70: +#line 337 "perly.y" { yyval.opval = convert(yyvsp[-4].ival, OPf_STACKED, prepend_elem(OP_LIST, newGVREF(yyvsp[-4].ival,yyvsp[-2].opval), yyvsp[-1].opval) ); } break; -case 63: -#line 295 "perly.y" +case 71: +#line 340 "perly.y" { yyval.opval = convert(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, - prepend_elem(OP_LIST, yyvsp[-5].opval, yyvsp[-1].opval), + prepend_elem(OP_LIST, scalar(yyvsp[-5].opval), yyvsp[-1].opval), newUNOP(OP_METHOD, 0, yyvsp[-3].opval))); } break; -case 64: -#line 300 "perly.y" +case 72: +#line 345 "perly.y" { yyval.opval = convert(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, yyvsp[-1].opval, yyvsp[0].opval), newUNOP(OP_METHOD, 0, yyvsp[-2].opval))); } break; -case 65: -#line 305 "perly.y" +case 73: +#line 350 "perly.y" { yyval.opval = convert(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, yyvsp[-3].opval, yyvsp[-1].opval), newUNOP(OP_METHOD, 0, yyvsp[-4].opval))); } break; -case 66: -#line 310 "perly.y" +case 74: +#line 355 "perly.y" { yyval.opval = convert(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; -case 67: -#line 312 "perly.y" +case 75: +#line 357 "perly.y" { yyval.opval = convert(yyvsp[-3].ival, 0, yyvsp[-1].opval); } break; -case 68: -#line 314 "perly.y" +case 76: +#line 359 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, newANONSUB(yyvsp[-2].ival, 0, yyvsp[-1].opval), yyvsp[0].opval), yyvsp[-3].opval)); } break; -case 71: -#line 325 "perly.y" +case 79: +#line 370 "perly.y" { yyval.opval = newASSIGNOP(OPf_STACKED, yyvsp[-2].opval, yyvsp[-1].ival, yyvsp[0].opval); } break; -case 72: -#line 327 "perly.y" +case 80: +#line 372 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; -case 73: -#line 329 "perly.y" +case 81: +#line 374 "perly.y" { if (yyvsp[-1].ival != OP_REPEAT) scalar(yyvsp[-2].opval); yyval.opval = newBINOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, scalar(yyvsp[0].opval)); } break; -case 74: -#line 333 "perly.y" +case 82: +#line 378 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; -case 75: -#line 335 "perly.y" +case 83: +#line 380 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; -case 76: -#line 337 "perly.y" +case 84: +#line 382 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; -case 77: -#line 339 "perly.y" +case 85: +#line 384 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; -case 78: -#line 341 "perly.y" +case 86: +#line 386 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; -case 79: -#line 343 "perly.y" +case 87: +#line 388 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; -case 80: -#line 345 "perly.y" +case 88: +#line 390 "perly.y" { yyval.opval = newRANGE(yyvsp[-1].ival, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval));} break; -case 81: -#line 347 "perly.y" +case 89: +#line 392 "perly.y" { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; -case 82: -#line 349 "perly.y" +case 90: +#line 394 "perly.y" { yyval.opval = newLOGOP(OP_OR, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; -case 83: -#line 351 "perly.y" +case 91: +#line 396 "perly.y" { yyval.opval = newCONDOP(0, yyvsp[-4].opval, yyvsp[-2].opval, yyvsp[0].opval); } break; -case 84: -#line 353 "perly.y" +case 92: +#line 398 "perly.y" { yyval.opval = bind_match(yyvsp[-1].ival, yyvsp[-2].opval, yyvsp[0].opval); } break; -case 85: -#line 356 "perly.y" +case 93: +#line 401 "perly.y" { yyval.opval = newUNOP(OP_NEGATE, 0, scalar(yyvsp[0].opval)); } break; -case 86: -#line 358 "perly.y" +case 94: +#line 403 "perly.y" { yyval.opval = yyvsp[0].opval; } break; -case 87: -#line 360 "perly.y" +case 95: +#line 405 "perly.y" { yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); } break; -case 88: -#line 362 "perly.y" +case 96: +#line 407 "perly.y" { yyval.opval = newUNOP(OP_COMPLEMENT, 0, scalar(yyvsp[0].opval));} break; -case 89: -#line 364 "perly.y" +case 97: +#line 409 "perly.y" { yyval.opval = newUNOP(OP_REFGEN, 0, mod(yyvsp[0].opval,OP_REFGEN)); } break; -case 90: -#line 366 "perly.y" +case 98: +#line 411 "perly.y" { yyval.opval = newUNOP(OP_POSTINC, 0, mod(scalar(yyvsp[-1].opval), OP_POSTINC)); } break; -case 91: -#line 369 "perly.y" +case 99: +#line 414 "perly.y" { yyval.opval = newUNOP(OP_POSTDEC, 0, mod(scalar(yyvsp[-1].opval), OP_POSTDEC)); } break; -case 92: -#line 372 "perly.y" +case 100: +#line 417 "perly.y" { yyval.opval = newUNOP(OP_PREINC, 0, mod(scalar(yyvsp[0].opval), OP_PREINC)); } break; -case 93: -#line 375 "perly.y" +case 101: +#line 420 "perly.y" { yyval.opval = newUNOP(OP_PREDEC, 0, mod(scalar(yyvsp[0].opval), OP_PREDEC)); } break; -case 94: -#line 378 "perly.y" +case 102: +#line 423 "perly.y" { yyval.opval = localize(yyvsp[0].opval,yyvsp[-1].ival); } break; -case 95: -#line 380 "perly.y" +case 103: +#line 425 "perly.y" { yyval.opval = sawparens(yyvsp[-1].opval); } break; -case 96: -#line 382 "perly.y" +case 104: +#line 427 "perly.y" { yyval.opval = sawparens(newNULLLIST()); } break; -case 97: -#line 384 "perly.y" +case 105: +#line 429 "perly.y" { yyval.opval = newANONLIST(yyvsp[-1].opval); } break; -case 98: -#line 386 "perly.y" +case 106: +#line 431 "perly.y" { yyval.opval = newANONLIST(Nullop); } break; -case 99: -#line 388 "perly.y" +case 107: +#line 433 "perly.y" { yyval.opval = newANONHASH(yyvsp[-2].opval); } break; -case 100: -#line 390 "perly.y" +case 108: +#line 435 "perly.y" { yyval.opval = newANONHASH(Nullop); } break; -case 101: -#line 392 "perly.y" +case 109: +#line 437 "perly.y" { yyval.opval = newANONSUB(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); } break; -case 102: -#line 394 "perly.y" +case 110: +#line 439 "perly.y" { yyval.opval = yyvsp[0].opval; } break; -case 103: -#line 396 "perly.y" +case 111: +#line 441 "perly.y" { yyval.opval = newBINOP(OP_GELEM, 0, newGVREF(0,yyvsp[-4].opval), yyvsp[-2].opval); } break; -case 104: -#line 398 "perly.y" +case 112: +#line 443 "perly.y" { yyval.opval = yyvsp[0].opval; } break; -case 105: -#line 400 "perly.y" +case 113: +#line 445 "perly.y" { yyval.opval = newBINOP(OP_AELEM, 0, oopsAV(yyvsp[-3].opval), scalar(yyvsp[-1].opval)); } break; -case 106: -#line 402 "perly.y" +case 114: +#line 447 "perly.y" { yyval.opval = newBINOP(OP_AELEM, 0, ref(newAVREF(yyvsp[-4].opval),OP_RV2AV), scalar(yyvsp[-1].opval));} break; -case 107: -#line 406 "perly.y" +case 115: +#line 451 "perly.y" { assertref(yyvsp[-3].opval); yyval.opval = newBINOP(OP_AELEM, 0, ref(newAVREF(yyvsp[-3].opval),OP_RV2AV), scalar(yyvsp[-1].opval));} break; -case 108: -#line 410 "perly.y" +case 116: +#line 455 "perly.y" { yyval.opval = yyvsp[0].opval; } break; -case 109: -#line 412 "perly.y" +case 117: +#line 457 "perly.y" { yyval.opval = yyvsp[0].opval; } break; -case 110: -#line 414 "perly.y" +case 118: +#line 459 "perly.y" { yyval.opval = newUNOP(OP_AV2ARYLEN, 0, ref(yyvsp[0].opval, OP_AV2ARYLEN));} break; -case 111: -#line 416 "perly.y" +case 119: +#line 461 "perly.y" { yyval.opval = newBINOP(OP_HELEM, 0, oopsHV(yyvsp[-4].opval), jmaybe(yyvsp[-2].opval)); expect = XOPERATOR; } break; -case 112: -#line 419 "perly.y" +case 120: +#line 464 "perly.y" { yyval.opval = newBINOP(OP_HELEM, 0, ref(newHVREF(yyvsp[-5].opval),OP_RV2HV), jmaybe(yyvsp[-2].opval)); expect = XOPERATOR; } break; -case 113: -#line 424 "perly.y" +case 121: +#line 469 "perly.y" { assertref(yyvsp[-4].opval); yyval.opval = newBINOP(OP_HELEM, 0, ref(newHVREF(yyvsp[-4].opval),OP_RV2HV), jmaybe(yyvsp[-2].opval)); expect = XOPERATOR; } break; -case 114: -#line 429 "perly.y" +case 122: +#line 474 "perly.y" { yyval.opval = newSLICEOP(0, yyvsp[-1].opval, yyvsp[-4].opval); } break; -case 115: -#line 431 "perly.y" +case 123: +#line 476 "perly.y" { yyval.opval = newSLICEOP(0, yyvsp[-1].opval, Nullop); } break; -case 116: -#line 433 "perly.y" +case 124: +#line 478 "perly.y" { yyval.opval = prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, list(yyvsp[-1].opval), ref(yyvsp[-3].opval, OP_ASLICE))); } break; -case 117: -#line 439 "perly.y" +case 125: +#line 484 "perly.y" { yyval.opval = prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, @@ -2058,38 +2065,38 @@ case 117: ref(oopsHV(yyvsp[-4].opval), OP_HSLICE))); expect = XOPERATOR; } break; -case 118: -#line 446 "perly.y" +case 126: +#line 491 "perly.y" { yyval.opval = yyvsp[0].opval; } break; -case 119: -#line 448 "perly.y" +case 127: +#line 493 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, 0, scalar(yyvsp[0].opval)); } break; -case 120: -#line 450 "perly.y" +case 128: +#line 495 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar(yyvsp[-2].opval)); } break; -case 121: -#line 452 "perly.y" +case 129: +#line 497 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[-1].opval, scalar(yyvsp[-3].opval))); } break; -case 122: -#line 455 "perly.y" +case 130: +#line 500 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); } break; -case 123: -#line 458 "perly.y" +case 131: +#line 503 "perly.y" { yyval.opval = newUNOP(OP_DOFILE, 0, scalar(yyvsp[0].opval)); } break; -case 124: -#line 460 "perly.y" +case 132: +#line 505 "perly.y" { yyval.opval = newUNOP(OP_NULL, OPf_SPECIAL, scope(yyvsp[0].opval)); } break; -case 125: -#line 462 "perly.y" +case 133: +#line 507 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, @@ -2098,8 +2105,8 @@ case 125: scalar(yyvsp[-2].opval) )),Nullop)); dep();} break; -case 126: -#line 470 "perly.y" +case 134: +#line 515 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, append_elem(OP_LIST, @@ -2109,139 +2116,151 @@ case 126: scalar(yyvsp[-3].opval) )))); dep();} break; -case 127: -#line 479 "perly.y" +case 135: +#line 524 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, scalar(newCVREF(0,scalar(yyvsp[-2].opval))), Nullop)); dep();} break; -case 128: -#line 483 "perly.y" +case 136: +#line 528 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, yyvsp[-1].opval, scalar(newCVREF(0,scalar(yyvsp[-3].opval))))); dep();} break; -case 129: -#line 488 "perly.y" +case 137: +#line 533 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, OPf_SPECIAL); hints |= HINT_BLOCK_SCOPE; } break; -case 130: -#line 491 "perly.y" +case 138: +#line 536 "perly.y" { yyval.opval = newLOOPEX(yyvsp[-1].ival,yyvsp[0].opval); } break; -case 131: -#line 493 "perly.y" +case 139: +#line 538 "perly.y" { yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); } break; -case 132: -#line 495 "perly.y" +case 140: +#line 540 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, 0); } break; -case 133: -#line 497 "perly.y" +case 141: +#line 542 "perly.y" { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; -case 134: -#line 499 "perly.y" +case 142: +#line 544 "perly.y" { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; -case 135: -#line 501 "perly.y" +case 143: +#line 546 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); } break; -case 136: -#line 504 "perly.y" +case 144: +#line 549 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, 0); } break; -case 137: -#line 506 "perly.y" +case 145: +#line 551 "perly.y" { yyval.opval = newOP(yyvsp[-2].ival, 0); } break; -case 138: -#line 508 "perly.y" +case 146: +#line 553 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, 0, scalar(yyvsp[0].opval)); } break; -case 139: -#line 511 "perly.y" +case 147: +#line 556 "perly.y" { yyval.opval = newOP(yyvsp[-2].ival, OPf_SPECIAL); } break; -case 140: -#line 513 "perly.y" +case 148: +#line 558 "perly.y" { yyval.opval = newUNOP(yyvsp[-3].ival, 0, yyvsp[-1].opval); } break; -case 141: -#line 515 "perly.y" +case 149: +#line 560 "perly.y" { yyval.opval = pmruntime(yyvsp[-3].opval, yyvsp[-1].opval, Nullop); } break; -case 142: -#line 517 "perly.y" +case 150: +#line 562 "perly.y" { yyval.opval = pmruntime(yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval); } break; -case 145: -#line 523 "perly.y" +case 153: +#line 568 "perly.y" { yyval.opval = Nullop; } break; -case 146: -#line 525 "perly.y" +case 154: +#line 570 "perly.y" { yyval.opval = yyvsp[0].opval; } break; -case 147: -#line 529 "perly.y" +case 155: +#line 574 "perly.y" { yyval.opval = Nullop; } break; -case 148: -#line 531 "perly.y" +case 156: +#line 576 "perly.y" { yyval.opval = yyvsp[0].opval; } break; -case 149: -#line 533 "perly.y" +case 157: +#line 578 "perly.y" { yyval.opval = yyvsp[-1].opval; } break; -case 150: -#line 537 "perly.y" +case 158: +#line 581 "perly.y" +{ yyval.ival = 0; } +break; +case 159: +#line 582 "perly.y" +{ yyval.ival = 1; } +break; +case 160: +#line 586 "perly.y" +{ in_my = 0; yyval.opval = my(yyvsp[0].opval); } +break; +case 161: +#line 590 "perly.y" { yyval.opval = newCVREF(yyvsp[-1].ival,yyvsp[0].opval); } break; -case 151: -#line 541 "perly.y" +case 162: +#line 594 "perly.y" { yyval.opval = newSVREF(yyvsp[0].opval); } break; -case 152: -#line 545 "perly.y" +case 163: +#line 598 "perly.y" { yyval.opval = newAVREF(yyvsp[0].opval); } break; -case 153: -#line 549 "perly.y" +case 164: +#line 602 "perly.y" { yyval.opval = newHVREF(yyvsp[0].opval); } break; -case 154: -#line 553 "perly.y" +case 165: +#line 606 "perly.y" { yyval.opval = newAVREF(yyvsp[0].opval); } break; -case 155: -#line 557 "perly.y" +case 166: +#line 610 "perly.y" { yyval.opval = newGVREF(0,yyvsp[0].opval); } break; -case 156: -#line 561 "perly.y" +case 167: +#line 614 "perly.y" { yyval.opval = scalar(yyvsp[0].opval); } break; -case 157: -#line 563 "perly.y" +case 168: +#line 616 "perly.y" { yyval.opval = scalar(yyvsp[0].opval); } break; -case 158: -#line 565 "perly.y" +case 169: +#line 618 "perly.y" { yyval.opval = scope(yyvsp[0].opval); } break; -case 159: -#line 568 "perly.y" +case 170: +#line 621 "perly.y" { yyval.opval = yyvsp[0].opval; } break; -#line 2230 "y_tab.c" +#line 2249 "perly.c" } yyssp -= yym; yystate = *yyssp; diff --git a/vms/perly_h.vms b/vms/perly_h.vms index c6ec3a41ad..dd927648bf 100644 --- a/vms/perly_h.vms +++ b/vms/perly_h.vms @@ -27,35 +27,36 @@ #define FUNC0 282 #define FUNC1 283 #define FUNC 284 -#define RELOP 285 -#define EQOP 286 -#define MULOP 287 -#define ADDOP 288 -#define DOLSHARP 289 -#define DO 290 -#define LOCAL 291 -#define HASHBRACK 292 -#define NOAMP 293 -#define OROP 294 -#define ANDOP 295 -#define NOTOP 296 -#define LSTOP 297 -#define ASSIGNOP 298 -#define OROR 299 -#define ANDAND 300 -#define BITOROP 301 -#define BITANDOP 302 -#define UNIOP 303 -#define SHIFTOP 304 -#define MATCHOP 305 -#define UMINUS 306 -#define REFGEN 307 -#define POWOP 308 -#define PREINC 309 -#define PREDEC 310 -#define POSTINC 311 -#define POSTDEC 312 -#define ARROW 313 +#define UNIOP 285 +#define LSTOP 286 +#define RELOP 287 +#define EQOP 288 +#define MULOP 289 +#define ADDOP 290 +#define DOLSHARP 291 +#define DO 292 +#define HASHBRACK 293 +#define NOAMP 294 +#define LOCAL 295 +#define MY 296 +#define OROP 297 +#define ANDOP 298 +#define NOTOP 299 +#define ASSIGNOP 300 +#define OROR 301 +#define ANDAND 302 +#define BITOROP 303 +#define BITANDOP 304 +#define SHIFTOP 305 +#define MATCHOP 306 +#define UMINUS 307 +#define REFGEN 308 +#define POWOP 309 +#define PREINC 310 +#define PREDEC 311 +#define POSTINC 312 +#define POSTDEC 313 +#define ARROW 314 typedef union { I32 ival; char *pval; @@ -402,6 +402,7 @@ kill_file(char *name) set_errno(ENOENT); break; case RMS$_DEV: set_errno(ENODEV); break; + case RMS$_FNM: case RMS$_SYN: case SS$_INVFILFOROP: set_errno(EINVAL); break; diff --git a/vms/vmsish.h b/vms/vmsish.h index 1e8d6840e3..b2814ade8b 100644 --- a/vms/vmsish.h +++ b/vms/vmsish.h @@ -237,6 +237,11 @@ /* Assorted fiddling with sigs . . . */ # include <signal.h> #define ABORT() abort() + /* VAXC's signal.h doesn't #define SIG_ERR, but provides BADSIG instead. */ +#if !defined(SIG_ERR) && defined(BADSIG) +# define SIG_ERR BADSIG +#endif + /* Used with our my_utime() routine in vms.c */ struct utimbuf { @@ -258,6 +263,9 @@ struct utimbuf { clock_t tms_cutime; /* user time, children */ clock_t tms_cstime; /* system time, children - always 0 on VMS */ }; +#else + /* The new headers change the times() prototype to tms from tbuffer */ +# define tbuffer_t struct tms #endif /* Prior to VMS 7.0, the CRTL gmtime() routine was a stub which always diff --git a/x2p/a2py.c b/x2p/a2py.c index 454e2dc860..0c37b6bbf9 100644 --- a/x2p/a2py.c +++ b/x2p/a2py.c @@ -154,7 +154,9 @@ register char **env; tmpstr = walk(0,0,root,&i,P_MIN); str = str_make(STARTPERL); - str_cat(str, "\neval 'exec perl -S $0 \"$@\"'\n\ + str_cat(str, "\neval 'exec "); + str_cat(str, BIN); + str_cat(str, "/perl -S $0 ${1+\"$@\"}'\n\ if $running_under_some_shell;\n\ # this emulates #! processing on NIH machines.\n\ # (remove #! line above if indigestible)\n\n"); diff --git a/x2p/find2perl.PL b/x2p/find2perl.PL index 32f78fe23f..c024faf9fd 100644 --- a/x2p/find2perl.PL +++ b/x2p/find2perl.PL @@ -25,10 +25,11 @@ print "Extracting $file (with variable substitutions)\n"; # You can use $Config{...} to use Configure variables. print OUT <<"!GROK!THIS!"; -$Config{'startperl'} - eval 'exec perl -S \$0 "\$@"' - if 0; +$Config{startperl} + eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' + if \$running_under_some_shell; \$startperl = "$Config{startperl}"; +\$perlpath = "$Config{perlpath}"; !GROK!THIS! # In the following, perl variables are not expanded during extraction. @@ -241,8 +242,7 @@ while (@ARGV) { print <<"END"; $startperl - -eval 'exec perl -S \$0 \${1+"\$@"}' + eval 'exec $perlpath -S \$0 \${1+"\$@"}' if \$running_under_some_shell; END diff --git a/x2p/s2p.PL b/x2p/s2p.PL index 9d7297b2ae..e5c5bd6f01 100644 --- a/x2p/s2p.PL +++ b/x2p/s2p.PL @@ -25,10 +25,11 @@ print "Extracting $file (with variable substitutions)\n"; # You can use $Config{...} to use Configure variables. print OUT <<"!GROK!THIS!"; -$Config{'startperl'} - eval 'exec perl -S \$0 "\$@"' - if 0; +$Config{startperl} + eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' + if \$running_under_some_shell; \$startperl = "$Config{startperl}"; +\$perlpath = "$Config{perlpath}"; !GROK!THIS! # In the following, perl variables are not expanded during extraction. @@ -366,7 +367,7 @@ unless ($debug) { print &q(<<"EOT"); : $startperl -: eval 'exec perl -S \$0 \${1+"\$@"}' +: eval 'exec $perlpath -S \$0 \${1+"\$@"}' : if \$running_under_some_shell; : EOT |