diff options
125 files changed, 12108 insertions, 4959 deletions
diff --git a/.dotest/last b/.dotest/last deleted file mode 100644 index e69de29bb2..0000000000 --- a/.dotest/last +++ /dev/null @@ -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 @@ -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/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 index 12d97e703b..e76c10fb5f 100644 --- a/lib/File/Compare.pm +++ b/lib/File/Compare.pm @@ -1,19 +1,18 @@ 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); -@ISA=qw(Exporter); -@EXPORT=qw(compare); -@EXPORT_OK=qw(compare cmp); - -$File::Compare::VERSION = '1.0'; -$File::Compare::Too_Big = 1024 * 1024 * 2; +$VERSION = '1.1'; +@ISA = qw(Exporter); +@EXPORT = qw(compare); +@EXPORT_OK = qw(cmp); - -use strict; -use vars qw($\ *FROM *TO); +$Too_Big = 1024 * 1024 * 2; sub VERSION { # Version of File::Compare @@ -61,7 +60,7 @@ sub compare { } else { $size = -s FROM; $size = 1024 if ($size < 512); - $size = $File::Compare::Too_Big if ($size > $File::Compare::Too_Big); + $size = $Too_Big if ($size > $Too_Big); } $fbuf = ''; @@ -98,3 +97,40 @@ sub compare { *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 index 20f0d58bcc..66de2572fc 100644 --- a/lib/Tie/RefHash.pm +++ b/lib/Tie/RefHash.pm @@ -1,11 +1,57 @@ -# -# Tie/RefHash.pm - use references as hash keys -# -# Documentation at the __END__ -# - -require 5.004; 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; @@ -75,62 +121,3 @@ sub CLEAR { } 1; - -__END__ - -=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 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 ae7e3f8c88..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 @@ -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 @@ -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,7 +317,7 @@ 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 +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 @@ -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/perlcall.pod b/pod/perlcall.pod index f9fe54bd6b..20c863cc57 100644 --- a/pod/perlcall.pod +++ b/pod/perlcall.pod @@ -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 7842039e89..407a25204f 100644 --- a/pod/perldata.pod +++ b/pod/perldata.pod @@ -72,7 +72,7 @@ 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. @@ -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. @@ -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 b6b3550c65..5d67ba41a6 100644 --- a/pod/perldebug.pod +++ b/pod/perldebug.pod @@ -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 inter-dispersed 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. @@ -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 @@ -763,9 +763,9 @@ the form C<(eval 31)> for subroutines defined inside C<eval>s. =item * -When execution 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>). @@ -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 @@ -825,6 +825,3 @@ 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 back-trace will not show the original values. - -Some subroutines are called without creating a call frame. This may -confuse back-trace C<T> and output of C<fE<gt>=4>. diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 4a36443a15..bbd699faaa 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -65,11 +65,23 @@ 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 @@ -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 @@ -427,7 +439,7 @@ 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 @@ -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 @@ -830,6 +842,11 @@ 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 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 @@ -1241,7 +1258,7 @@ that is less than 0. This is difficult to imagine. (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 @@ -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 @@ -2346,6 +2363,11 @@ 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 @@ -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 ab236e5159..5beaa8bbe9 100644 --- a/pod/perldsc.pod +++ b/pod/perldsc.pod @@ -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"; diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 1ff25185d2..49b77f02fc 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -252,10 +252,10 @@ 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() to determine the actual mode of the file, or temporarily set the uid to something else. @@ -693,23 +693,29 @@ of what you're trying to do. At other times, a simple comparison to =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 @@ -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: @@ -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 @@ -1575,7 +1581,7 @@ 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 +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. @@ -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.) @@ -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. @@ -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, @@ -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 -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 @@ -2485,7 +2498,7 @@ 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 bit masks can also be undef. The timeout, if specified, is @@ -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. @@ -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) @@ -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. @@ -3437,7 +3452,7 @@ 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,7 +3474,7 @@ 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); diff --git a/pod/perlguts.pod b/pod/perlguts.pod index 0499401499..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,7 +75,7 @@ In the C<SvPV> macro, the length of the string returned is placed into the variable C<len> (this is a macro, so you do I<not> use C<&len>). If you do not care what the length of the data is, use the global variable C<na>. Remember, however, that Perl allows arbitrary strings of data that may both contain -NULs and not be terminated by a NUL. +NUL's and might not be terminated by a NUL. If you want to know simply if the scalar value is TRUE, you can use: @@ -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,11 +156,11 @@ 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? @@ -172,21 +182,21 @@ stored in your SV. The "p" stands for private. 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 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*>. 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 discover what the reference actually 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 exist already 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 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 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 reference count 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 for just 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; @@ -836,7 +668,7 @@ 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 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 to -satisfy allocation requests more quickly. -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 allocate memory initially. 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 + +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. -=head2 Putting a C value on Perl stack +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 @@ -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) @@ -1542,12 +1452,21 @@ 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 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 @@ -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)); @@ -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. @@ -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/perlmod.pod b/pod/perlmod.pod index e27d0f1a0f..4fb5ec838b 100644 --- a/pod/perlmod.pod +++ b/pod/perlmod.pod @@ -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,7 +119,7 @@ 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 want to alias only a particular variable or subroutine, you can assign a reference instead: @@ -140,7 +140,7 @@ 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 will overwrite the hash slot in the @@ -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 @@ -322,7 +325,7 @@ you're redefining the world and willing to take the consequences. =head1 THE PERL MODULE LIBRARY A number of modules are included the Perl distribution. These are -described below, and all end in F<.pm>. You may also discover files in +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 @@ -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 @@ -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 @@ -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 @@ -946,7 +1030,7 @@ Use blessed references. Use the two argument form of bless to bless into the class name given as the first parameter of the constructor, e.g.,: - sub new { + 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; @@ -1052,7 +1136,7 @@ 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 @@ -1142,10 +1226,10 @@ 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 +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. @@ -1160,7 +1244,7 @@ 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 +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. @@ -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 aebdb72746..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 @@ -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: @@ -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 f836576c5a..a75cb4947d 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -672,7 +672,7 @@ 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 +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. @@ -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++; @@ -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. diff --git a/pod/perlre.pod b/pod/perlre.pod index c395250e01..ce054ec448 100644 --- a/pod/perlre.pod +++ b/pod/perlre.pod @@ -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 @@ -147,7 +147,7 @@ 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: @@ -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 parentheses with a question mark as the first thing -within the parentheses (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 @@ -531,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 93198eafec..bbbe57feba 100644 --- a/pod/perlref.pod +++ b/pod/perlref.pod @@ -7,7 +7,7 @@ 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. Because arrays and hashes contain scalars, you can now easily build arrays of arrays, arrays of @@ -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. @@ -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 diff --git a/pod/perlrun.pod b/pod/perlrun.pod index 78e902a594..083b567e19 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -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 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. +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. @@ -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> @@ -332,7 +332,7 @@ the implicit loop, just as in awk. causes your script to be run through the C preprocessor before compilation by Perl. (Because both comments and cpp directives begin with the # character, you should avoid starting comments with any words -recognized by the C preprocessor such as "if", "else" or "define".) +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, @@ -369,11 +369,11 @@ 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> diff --git a/pod/perlsec.pod b/pod/perlsec.pod index 6101d798c2..2b6972701f 100644 --- a/pod/perlsec.pod +++ b/pod/perlsec.pod @@ -1,4 +1,3 @@ - =head1 NAME perlsec - Perl security diff --git a/pod/perlsub.pod b/pod/perlsub.pod index da8d00b4a2..6bd3fe8d84 100644 --- a/pod/perlsub.pod +++ b/pod/perlsub.pod @@ -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 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.) +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 @@ -406,7 +407,7 @@ 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. @@ -414,7 +415,7 @@ 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 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 @@ -471,7 +472,7 @@ 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,7 +489,7 @@ 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 @@ -583,6 +584,37 @@ 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, 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 As of the 5.002 release of perl, if you declare diff --git a/pod/perltie.pod b/pod/perltie.pod index 962a7e31d1..7624881bde 100644 --- a/pod/perltie.pod +++ b/pod/perltie.pod @@ -33,7 +33,7 @@ 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 @@ -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 diff --git a/pod/perltoot.pod b/pod/perltoot.pod index 698f655372..3fdedc2513 100644 --- a/pod/perltoot.pod +++ b/pod/perltoot.pod @@ -1,6 +1,6 @@ =head1 NAME -perltoot - tchrist's object-oriented perl tutorial (rev 0.4) +perltoot - Tom's object-oriented tutorial for perl =head1 DESCRIPTION @@ -33,7 +33,7 @@ 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 -particular kind of method. +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 @@ -83,7 +83,7 @@ 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 +Some programmers have also been known to use a function with the same name as the class as the constructor. =head2 Object Representation @@ -91,7 +91,7 @@ the same name as the class as the constructor. 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. +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: @@ -134,7 +134,7 @@ 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 you Person class, +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: @@ -295,7 +295,7 @@ 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 -destructed, except in the unique case of a program that never exits. +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.) @@ -321,7 +321,7 @@ 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 . +do more than fetch or set one particular field. sub exclaim { my $self = shift; @@ -538,9 +538,13 @@ and DESTROY methods as follows: -- ${ $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 for each particular object. But sometimes +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 @@ -806,9 +810,9 @@ 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 -method. Well, in principle, yes. A method is just a function that +a method? Well, in principle, yes. A method is just a function that expects as its first argument a class name (package) or object -(bless reference). Person::new() is the function that both the +(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 @@ -825,7 +829,7 @@ but methods do. 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 +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. @@ -876,7 +880,7 @@ To do this, merely add this definition into the Employee.pm file: } There, we've just demonstrated the high-falutin' concept known in certain -circles as I<polymorphism>. We've taken on the form and behavior of +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.) @@ -962,29 +966,31 @@ And here's the test program: 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, the way the 'x' command does in the debugger, -you could use these undocumented calls the debugger employs (until -its author changes them). +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: - require 'dumpvar.pl'; + use Data::Dumper; print "Here's the boss:\n"; - dumpValue($boss); + print Dumper($boss); Which shows us something like this: - Boss=HASH(0x8104084) - '_CENSUS' => SCALAR(0x80c949c) - -> 1 - 'AGE' => 47 - 'FULLNAME' => Fullname=HASH(0x81040d8) - 'CHRISTIAN' => 'Federico Miguel' - 'NICK' => 'Fred' - 'SURNAME' => 'Pichon Alvarez' - 'TITLE' => 'Don' - 'PEERS' => ARRAY(0x80ebb3c) - 0 'Frank' - 1 'Felipe' - 2 'Faust' + 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 @@ -1046,10 +1052,10 @@ 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, -particularly with some bundled "objectless" classes, +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 entirey clear why inheritance was done +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: @@ -1064,7 +1070,7 @@ 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, but having parents +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 @@ -1191,7 +1197,7 @@ 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 one for a given hash key, no matter how many +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. @@ -1211,7 +1217,7 @@ 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 as a particular argument the field we want to affect. (Yes, +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? :-) @@ -1256,15 +1262,15 @@ different: 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 -procedural programming languages whence closures derive. The object +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 particular version (lexical binding and instantiation) +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 +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). @@ -1312,7 +1318,7 @@ 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 is a particular package +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. @@ -1345,7 +1351,7 @@ 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-static hash of permitted fields in this record +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". @@ -1409,6 +1415,11 @@ a user directly. 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 @@ -1444,7 +1455,7 @@ 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 Metaclass Tools +=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 @@ -1455,8 +1466,8 @@ as detailed above. Perl programmers have responded to this by creating several different class construction classes. These metaclasses are classes -that create other classes. Three worth looking at are -Class::Template, Class::MethodMaker, and Alias. All can be +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 @@ -1464,7 +1475,7 @@ found in the modules directory on CPAN. 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 particular type. +a class as having objects whose fields are of a specific type. The function that does this is called, not surprisingly enough, struct(). @@ -1497,7 +1508,7 @@ 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. +act like structs in the C sense. use Socket; use Net::hostent; @@ -1506,9 +1517,9 @@ act like structs in the C sense. $h->name, inet_ntoa($h->addr); Here's how to do this using the Class::Template module. -They crux is going to be this call: +The crux is going to be this call: - struct 'Net::hostent' => [ + struct 'Net::hostent' => [ # note bracket name => '$', aliases => '@', addrtype => '$', @@ -1521,7 +1532,7 @@ It even creates a new() method for us. We could also have implemented our object this way: - struct 'Net::hostent' => { + struct 'Net::hostent' => { # note brace name => '$', aliases => '@', addrtype => '$', @@ -1533,7 +1544,7 @@ 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, -we'll go for better speed and size over better flexibility. +this time we'll opt for better speed and size over better flexibility. Here's the whole implementation: @@ -1610,7 +1621,7 @@ 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 name that a C programmer would most expect. +They also have the type names that a C programmer would most expect. =head2 Data Members as Variables @@ -1694,19 +1705,19 @@ 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 -particular to each object are often called I<instance data> or <object +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<subclass> all describe +Also, I<base class>, I<generic class>, and I<superclass> all describe the same notion, whereas I<derived class>, I<specific class>, and -I<superclass> describe the other related one. +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>. +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 +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. @@ -1717,24 +1728,9 @@ 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> -behavior, not I<defining> mechanism) idea. C++ supports the latter +behaviour, not I<defining> mechanism) idea. C++ supports the latter notion, but not the former. -=head2 Programming with Style - -Remember the underscores we used on "start_date" and "START_DATE"? -While some programmers might be tempted to leave them out, please don't. -Otherwise it's hard for some people to read. Also, you'd have to make -up a new rule for identifiers that you've rendered in all capitals, -like START_DATE. Plus you get people wondering whether it's "startdate", -"Startdate", "startDate", "StartDate", or some other crazy variation. -And adding another word, like "employee_start_date", just racks up the -confusion. Nobody but a compiler wants to parse "employeestartdate" or -even "EmployeeStartDate". So (almost) always use underscores to separate -words in identifiers. See also L<perlstyle> and either L<perlmod> or the -list of registered modules posted periodically to comp.lang.perl.modules -or found on CPAN in the http://www.perl.com/CPAN/modules/ directory. - =head1 SEE ALSO The following man pages will doubtless provide more @@ -1771,6 +1767,13 @@ to arrange for you to receive your just deserts. Count on it. =head2 Acknowledgments -Thanks to Brad Appleton, Raphael Manfredi, Dean Roehrich, Gurusamy -Sarathy, and many others from the perl porters list for their helpful -comments. +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 1c0f7a420c..391c98b129 100644 --- a/pod/perltrap.pod +++ b/pod/perltrap.pod @@ -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 * @@ -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. diff --git a/pod/perlvar.pod b/pod/perlvar.pod index 42910e1c4f..a049e9d5a1 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -170,7 +170,7 @@ is 0. (Mnemonic: * matches multiple things.) Note that this variable influences the interpretation of only "C<^>" and "C<$>". A literal newline can be searched for even when C<$* == 0>. -Use of "C<$*>" is deprecated in Perl 5. +Use of "C<$*>" is deprecated in modern perls. =item input_line_number HANDLE EXPR @@ -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 @@ -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 be set on only 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. +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. diff --git a/pod/perlxs.pod b/pod/perlxs.pod index 9108342c1f..cc83c8b843 100644 --- a/pod/perlxs.pod +++ b/pod/perlxs.pod @@ -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/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]) ); } @@ -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/filecmp.t b/t/lib/filecmp.t deleted file mode 100644 index 209ee478e3..0000000000 --- a/t/lib/filecmp.t +++ /dev/null @@ -1,193 +0,0 @@ -# $Id: test.pl,v 1.3 1996/10/19 10:49:54 joseph Exp joseph $ -# $Log: test.pl,v $ -# Revision 1.3 1996/10/19 10:49:54 joseph -# oops, fixed a stupid bug in the test script -# -# Revision 1.2 1996/10/19 08:07:04 joseph -# now has a real test script, i hope -# -# Revision 1.1 1996/10/15 08:42:55 joseph -# Initial revision -# -# - -# Before `make install' is performed this script should be runnable with -# `make test'. After `make install' it should work as `perl test.pl' - -######################### We start with some black magic to print on failure. - -# Change 1..1 below to 1..last_test_to_print . -# (It may become useful if the test is moved to ./t subdirectory.) - -BEGIN { $| = 1; print "1..18\n"; } -END {print "not ok 1\n" unless $loaded;} -use File::Compare; -$loaded = 1; -print "ok 1\n"; - -######################### End of black magic. - -# Insert your test code below (better if it prints "ok 13" -# (correspondingly "not ok 13") depending on the success of chunk 13 -# of the test code): - -use Carp; -use IO::File (); - -$test_num = 2; - -# Simple text file compare (this one!) - -if (compare(__FILE__, __FILE__) == 0) { - print "ok ", $test_num++, "\n"; -} else { - print "NOT ok (same file) ", $test_num++, "\n"; -} - -eval { - - print "creating some test files\n"; - $test_blob = ''; - srand(); - for ($i = 0; $i < 10000; $i++) { - $test_blob .= pack 'S', rand 0xffff; - } - - open F, '>xx' or croak "couldn't create: $!"; - print F $test_blob; - - open F, '>xxcopy' or croak "couldn't create: $!"; - print F $test_blob; - - open F, '>xxshort' or croak "couldn't create: $!"; - print F substr $test_blob, 0, 19999; - - (substr $test_blob, 7654, 1) =~ tr/\0-\377/\01-\377\0/; - open F, '>xx1byte' or croak "couldn't create: $!"; - print F $test_blob; - - (substr $test_blob, -1, 1) =~ tr/\0-\377/\01-\377\0/; - open F, '>xx2byte' or croak "couldn't create: $!"; - print F $test_blob; - close F; - - if (File::Compare::cmp('xx', 'xx') == 0) { - print "ok ", $test_num++, "\n"; - } else { - print "NOT ok (same file) ", $test_num++, "\n"; - } - - if (compare('xx', 'xxcopy') == 0) { - print "ok ", $test_num++, "\n"; - } else { - print "NOT ok (copy of file) ", $test_num++, "\n"; - } - - if (compare('xx', 'xxshort') > 0) { - print "ok ", $test_num++, "\n"; - } else { - print "NOT ok (truncated copy of file) ", $test_num++, "\n"; - } - - if (compare('xxshort', 'xx') > 0) { - print "ok ", $test_num++, "\n"; - } else { - print "NOT ok (truncated copy of file) ", $test_num++, "\n"; - } - - if (compare('xx', 'xxfrobizz') < 0) { - print "ok ", $test_num++, "\n"; - } else { - print "NOT ok (file doesn'xx exist) ", $test_num++, "\n"; - } - - if (compare('xxfrobizz', 'xx') < 0) { - print "ok ", $test_num++, "\n"; - } else { - print "NOT ok (file doesn'xx exist) ", $test_num++, "\n"; - } - - if (compare('xx', 'xx1byte') > 0) { - print "ok ", $test_num++, "\n"; - } else { - print "NOT ok (1 byte difference) ", $test_num++, "\n"; - } - - if (compare('xx1byte', 'xx') > 0) { - print "ok ", $test_num++, "\n"; - } else { - print "NOT ok (1 byte difference) ", $test_num++, "\n"; - } - - if (compare('xx1byte', 'xx2byte') > 0) { - print "ok ", $test_num++, "\n"; - } else { - print "NOT ok (1 byte at end) ", $test_num++, "\n"; - } - - if (compare('xx2byte', 'xx1byte') > 0) { - print "ok ", $test_num++, "\n"; - } else { - print "NOT ok (1 byte at end) ", $test_num++, "\n"; - } - - open(STDIN,'xx') or croak "couldn't open xx as STDIN: $!"; - - seek(STDIN,0,0) || croak "couldn't seek STDIN: $!"; - if (compare('xx', *STDIN) == 0) { - print "ok ", $test_num++, "\n"; - } else { - print "NOT ok (glob to) ", $test_num++, "\n"; - } - - seek(STDIN,0,0) || croak "couldn't seek STDIN: $!"; - if (compare(*STDIN, 'xx') == 0) { - print "ok ", $test_num++, "\n"; - } else { - print "NOT ok (glob from) ", $test_num++, "\n"; - } - - seek(STDIN,0,0) || croak "couldn't seek STDIN: $!"; - if (compare('xx', \*STDIN) == 0) { - print "ok ", $test_num++, "\n"; - } else { - print "NOT ok (ref glob to) ", $test_num++, "\n"; - } - - seek(STDIN,0,0) || croak "couldn't seek STDIN: $!"; - if (compare(\*STDIN, 'xx') == 0) { - print "ok ", $test_num++, "\n"; - } else { - print "NOT ok (ref glob from) ", $test_num++, "\n"; - } - - $fh = IO::File->new("cat xx |") or die "Cannot open pipe:$!"; - if (compare($fh, 'xx') == 0) { - print "ok ", $test_num++, "\n"; - } else { - print "NOT ok (pipe from) ", $test_num++, "\n"; - } - $fh->close; - - $fh = IO::File->new("cat xx2byte |") or die "Cannot open pipe:$!"; - if (compare('xx1byte', $fh) > 0) { - print "ok ", $test_num++, "\n"; - } else { - print "NOT ok (pipe to) ", $test_num++, "\n"; - } - $fh->close; - -}; - -if ($@) { - print "... something went wrong during the tests.\n"; -} - -print "tidying up ...\n"; -foreach (glob 'xx*') - { - unlink($_) || warn "Cannot delete $_:$!"; - } - -print "... all done\n"; - 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 |