# ignore bug*.pl
bug*.pl
+# Exists during ./Configure
+/UU
+
# files produced by './configure.gnu' on a Linux machine
Makefile.old
/Makefile
Anton Berezin <tobez@tobez.org>
Anton Tagunov <tagunov@motor.ru>
Archer Sully <archer@meer.net>
+Aristotle Pagaltzis <pagaltzis@gmx.de>
Arjen Laarhoven <arjen@nl.demon.net>
+Arkturuz <arkturuz@gmail.com>
Arne Ahrend <aahrend@web.de>
Arnold D. Robbins <arnold@gnu.ai.mit.edu>
Art Green <Art_Green@mercmarine.com>
Craig A. Berry <craigberry@mac.com>
Craig Milo Rogers <Rogers@ISI.EDU>
Curtis Poe <cp@onsitetech.com>
+Curtis Jewell <perl@csjewell.fastmail.us>
Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
Dale Amon <amon@vnl.com>
Damian Conway <damian@conway.org>
James A. Duncan <jduncan@fotango.com>
James FitzGibbon <james@ican.net>
James Jurach <muaddib@erf.net>
+James E Keenan <jkeen@verizon.net>
James Mastros <james@mastros.biz>
Jamshid Afshar
Jan D. <jan.djarv@mbox200.swipnet.se>
Kingpin <mthurn@copper.dulles.tasc.com>
Kirrily Robert <skud@infotrope.net>
Kiyotaka Sakai <ksakai@netwk.ntt-at.co.jp>
+kmx <kmx@volny.cz>
Kragen Sitaker <kragen@pobox.com>
Krishna Sethuraman <krishna@sgi.com>
Kriton Kyrimis <kyrimis@princeton.edu>
Mark Fowler <mark@twoshortplanks.com>
Mark Hanson
Mark J. Reed <mreed@strange.turner.com>
+Mark Jason Dominus <mjd@plover.com>
Mark K Trettin <mkt@lucent.com>
Mark Kaehny <kaehny@execpc.com>
Mark Kettenis <kettenis@wins.uva.nl>
Mark Pizzolato <mark@infocomm.com>
Mark R. Levinson <mrl@isc.upenn.edu>
Mark Stosberg <mark@summersault.com>
-Mark-Jason Dominus <mjd@plover.com>
Marko Asplund <aspa@merlot.kronodoc.fi>
Marnix van Ammers <marnix@gmail.com>
Martien Verbruggen <mgjv@comdyn.com.au>
Matt Kraai <kraai@ftbfs.org>
Matt Sergeant <matt@sergeant.org>
Matt Taggart <taggart@debian.org>
+Matt S Trout <mst@shadowcat.co.uk>
Matthew Black <black@csulb.edu>
Matthew Green <mrg@splode.eterna.com.au>
Matthew Sachs <matthewg@zevils.com>
Nicholas Clark <nick@ccl4.org>
Nicholas Oxhøj
Nicholas Perez <nperez@cpan.org>
+Nick Cleaton <nick@cleaton.net>
Nick Duffek
Nick Gianniotis
Nick Ing-Simmons
Reini Urban <rurban@x-ray.at>
Renee Baecker <renee.baecker@smart-websolutions.de>
Rex Dieter <rdieter@math.unl.edu>
-Ricardo SIGNES <rjbs@cpan.org>
+Ricardo Signes <rjbs@cpan.org>
Rich Morin <rdm@cfcl.com>
Rich Rauenzahn <rrauenza@hp.com>
Rich Salz <rsalz@bbn.com>
Ruben Schattevoy <schattev@imb-jena.de>
Rudolph Todd Maceyko <rm55+@pitt.edu>
Rujith S. de Silva <desilva@netbox.com>
+Ruslan Zakirov <ruz@bestpractical.com>
Russ Allbery <rra@stanford.edu>
Russell Fulton <russell@ccu1.auckland.ac.nz>
Russell Mosemann <mose@ccsn.edu>
Spiros Denaxas <spiros@lokku.com>
Sreeji K Das <sreeji_k@yahoo.com>
Stas Bekman <stas@stason.org>
-Steffen Müller <7k8lrvf02@sneakemail.com>
+Steffen Müller <smueller@cpan.org>
Steffen Ullrich <coyote.frank@gmx.net>
Stéphane Payrard <stef@mongueurs.net>
Stepan Kasal <skasal@redhat.com>
Stephen Zander <gibreel@pobox.com>
Steve A Fink <sfink@cs.berkeley.edu>
Steve Grazzini <grazz@pobox.com>
-Steve Hay <SteveHay@planit.com>
+Steve Hay <steve.m.hay@googlemail.com>
Steve Kelem <steve.kelem@xilinx.com>
Steve McDougall <swmcd@world.std.com>
Steve Nielsen <spn@enteract.com>
Timur I. Bakeyev <bsdi@listserv.bat.ru>
Tkil <tkil@reptile.scrye.com>
Todd C. Miller <Todd.Miller@courtesan.com>
+Todd Rinaldo <toddr@cpanel.net>
Todd T. Fries <todd@fries.int.mrleng.com>
Todd Vierling <tv@duh.org>
Tom Bates <tom_bates@att.net>
# $Id: Head.U 6 2006-08-25 22:21:46Z rmanfredi $
#
-# Generated on Fri Nov 6 07:43:05 CET 2009 [metaconfig 3.5 PL0]
+# Generated on Mon Mar 29 10:12:43 CEST 2010 [metaconfig 3.5 PL0]
# (with additional metaconfig patches by perlbug@perl.org)
cat >c1$$ <<EOF
rm -f c1$$ c2$$
if test -f /dev/cputype -a -f /dev/drivers -a -f /dev/osversion; then
- cat >&4 <<EOF
+ cat <<EOF
***
*** I'm sorry but this system looks like Plan 9 and Plan 9 doesn't do
*** Configure that well. (Plan 9 is close to UNIX but not close enough.)
fi
if test ! -c /dev/null ; then
- cat >&4 <<EOF
+ cat <<EOF
***
*** I'm sorry, but /dev/null appears to be a file rather than a device.
*** Please consult your operating sytem's notes for making a device
d_pipe=''
d_poll=''
d_portable=''
+d_prctl=''
+d_prctl_set_name=''
d_procselfexe=''
procselfexe=''
d_old_pthread_create_joinable=''
incpath=''
mips_type=''
usrinc=''
+vaproto=''
d_vendorarch=''
installvendorarch=''
vendorarch=''
_egrep=$grep
;;
esac
+case "$less" in
+'') ;;
+*) if $less -R </dev/null >/dev/null; then
+ echo "Substituting less -R for less."
+ less="$less -R"
+ _less=$less
+ fi
+ ;;
+esac
case "$ln" in
ln)
echo "Substituting cp for ln."
: DTrace support
dflt_dtrace='/usr/sbin/dtrace'
+$test -x /usr/bin/dtrace && dflt_dtrace='/usr/bin/dtrace'
+
cat <<EOM
Perl can be built to support DTrace on platforms that support it.
set poll d_poll
eval $inlibc
+: see if prctl exists
+set prctl d_prctl
+eval $inlibc
+
+: see if prctl supports PR_SET_NAME
+d_prctl_set_name=$undef
+case $d_prctl in
+ $define)
+ $cat >try.c <<EOM
+#include <sys/prctl.h>
+
+int main (int argc, char *argv[])
+{
+ return (prctl (PR_SET_NAME, "Test"));
+ } /* main */
+EOM
+ set try
+ if eval $compile_ok && $run ./try; then
+ echo "Your prctl (PR_SET_NAME, ...) works"
+ d_prctl_set_name=$define
+ fi
+ $rm_try
+ ;;
+ esac
+
: see if readlink exists
set readlink d_readlink
eval $inlibc
;;
esac
+: see if prototypes support variable argument declarations
+echo " "
+case "$prototype$i_stdarg" in
+$define$define)
+ echo "It appears we'll be able to prototype varargs functions." >&4
+ val="$define"
+ ;;
+*)
+ echo "Too bad... We won't be using prototyped varargs functions..." >&4
+ val="$undef"
+ ;;
+esac
+set vaproto
+eval $setvar
+
: determine compiler compiler
case "$yacc" in
'')
./Cppsym < Cppsym.know > Cppsym.true
: Add in any linux cpp "predefined macros":
case "$osname::$gccversion" in
- *linux*::*.*|*gnukfreebsd*::*.*)
+ *linux*::*.*|*gnukfreebsd*::*.*|gnu::*.*)
tHdrH=_tmpHdr
rm -f $tHdrH'.h' $tHdrH
touch $tHdrH'.h'
d_pipe='$d_pipe'
d_poll='$d_poll'
d_portable='$d_portable'
+d_prctl='$d_prctl'
+d_prctl_set_name='$d_prctl_set_name'
d_printf_format_null='$d_printf_format_null'
d_procselfexe='$d_procselfexe'
d_pseudofork='$d_pseudofork'
uvtype='$uvtype'
uvuformat='$uvuformat'
uvxformat='$uvxformat'
+vaproto='$vaproto'
vendorarch='$vendorarch'
vendorarchexp='$vendorarchexp'
vendorbin='$vendorbin'
aphostname='/bin/hostname'
api_revision='5'
api_subversion='0'
-api_version='11'
-api_versionstring='5.11.0'
+api_version='13'
+api_versionstring='5.13.0'
ar='ar'
-archlib='/usr/lib/perl5/5.11.3/armv4l-linux'
-archlibexp='/usr/lib/perl5/5.11.3/armv4l-linux'
+archlib='/usr/lib/perl5/5.13.0/armv4l-linux'
+archlibexp='/usr/lib/perl5/5.13.0/armv4l-linux'
archname64=''
archname='armv4l-linux'
archobjs=''
cat='cat'
cc='cc'
cccdlflags='-fpic'
-ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.11.3/armv4l-linux/CORE'
+ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.13.0/armv4l-linux/CORE'
ccflags='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64'
ccflags_uselargefiles='-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64'
ccname='arm-linux-gcc'
d_pipe='define'
d_poll='define'
d_portable='define'
+d_prctl='define'
+d_prctl_set_name='define'
d_printf_format_null='undef'
d_procselfexe='define'
d_pseudofork='undef'
inc_version_list_init='0'
incpath=''
inews=''
-installarchlib='./install_me_here/usr/lib/perl5/5.11.3/armv4l-linux'
+installarchlib='./install_me_here/usr/lib/perl5/5.13.0/armv4l-linux'
installbin='./install_me_here/usr/bin'
installhtml1dir=''
installhtml3dir=''
installman3dir='./install_me_here/usr/share/man/man3'
installprefix='./install_me_here/usr'
installprefixexp='./install_me_here/usr'
-installprivlib='./install_me_here/usr/lib/perl5/5.11.3'
+installprivlib='./install_me_here/usr/lib/perl5/5.13.0'
installscript='./install_me_here/usr/bin'
-installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.11.3/armv4l-linux'
+installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.13.0/armv4l-linux'
installsitebin='./install_me_here/usr/bin'
installsitehtml1dir=''
installsitehtml3dir=''
-installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.11.3'
+installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.13.0'
installsiteman1dir='./install_me_here/usr/share/man/man1'
installsiteman3dir='./install_me_here/usr/share/man/man3'
installsitescript='./install_me_here/usr/bin'
pr=''
prefix='/usr'
prefixexp='/usr'
-privlib='/usr/lib/perl5/5.11.3'
-privlibexp='/usr/lib/perl5/5.11.3'
+privlib='/usr/lib/perl5/5.13.0'
+privlibexp='/usr/lib/perl5/5.13.0'
procselfexe='"/proc/self/exe"'
prototype='define'
ptrsize='4'
sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 6, 17, 29, 31, 0'
sig_size='68'
signal_t='void'
-sitearch='/usr/lib/perl5/site_perl/5.11.3/armv4l-linux'
-sitearchexp='/usr/lib/perl5/site_perl/5.11.3/armv4l-linux'
+sitearch='/usr/lib/perl5/site_perl/5.13.0/armv4l-linux'
+sitearchexp='/usr/lib/perl5/site_perl/5.13.0/armv4l-linux'
sitebin='/usr/bin'
sitebinexp='/usr/bin'
sitehtml1dir=''
sitehtml1direxp=''
sitehtml3dir=''
sitehtml3direxp=''
-sitelib='/usr/lib/perl5/site_perl/5.11.3'
+sitelib='/usr/lib/perl5/site_perl/5.13.0'
sitelib_stem='/usr/lib/perl5/site_perl'
-sitelibexp='/usr/lib/perl5/site_perl/5.11.3'
+sitelibexp='/usr/lib/perl5/site_perl/5.13.0'
siteman1dir='/usr/share/man/man1'
siteman1direxp='/usr/share/man/man1'
siteman3dir='/usr/share/man/man3'
strerror_r_proto='0'
strings='/usr/include/string.h'
submit=''
-subversion='3'
+subversion='0'
sysman='/usr/share/man/man1'
tail=''
tar=''
uvtype='unsigned long'
uvuformat='"lu"'
uvxformat='"lx"'
+vaproto='undef'
vendorarch=''
vendorarchexp=''
vendorbin=''
vendorprefixexp=''
vendorscript=''
vendorscriptexp=''
-version='5.11.3'
-version_patchlevel_string='version 11 subversion 3'
+version='5.13.0'
+version_patchlevel_string='version 13 subversion 0'
versiononly='undef'
vi=''
voidflags='15'
config_args=''
config_argc=0
PERL_REVISION=5
-PERL_VERSION=11
-PERL_SUBVERSION=3
+PERL_VERSION=13
+PERL_SUBVERSION=0
PERL_API_REVISION=5
-PERL_API_VERSION=11
+PERL_API_VERSION=13
PERL_API_SUBVERSION=0
PERL_PATCHLEVEL=
PERL_CONFIG_SH=true
aphostname='/bin/hostname'
api_revision='5'
api_subversion='0'
-api_version='11'
-api_versionstring='5.11.0'
+api_version='13'
+api_versionstring='5.13.0'
ar='ar'
-archlib='/usr/lib/perl5/5.11.3/armv4l-linux'
-archlibexp='/usr/lib/perl5/5.11.3/armv4l-linux'
+archlib='/usr/lib/perl5/5.13.0/armv4l-linux'
+archlibexp='/usr/lib/perl5/5.13.0/armv4l-linux'
archname64=''
archname='armv4l-linux'
archobjs=''
cat='cat'
cc='arm-none-linux-gnueabi-gcc'
cccdlflags='-fpic'
-ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.11.3/armv4l-linux/CORE'
+ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.13.0/armv4l-linux/CORE'
ccflags='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64'
ccflags_uselargefiles='-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64'
ccname='arm-linux-gcc'
inc_version_list_init='0'
incpath=''
inews=''
-installarchlib='./install_me_here/usr/lib/perl5/5.11.3/armv4l-linux'
+installarchlib='./install_me_here/usr/lib/perl5/5.13.0/armv4l-linux'
installbin='./install_me_here/usr/bin'
installhtml1dir=''
installhtml3dir=''
installman3dir='./install_me_here/usr/share/man/man3'
installprefix='./install_me_here/usr'
installprefixexp='./install_me_here/usr'
-installprivlib='./install_me_here/usr/lib/perl5/5.11.3'
+installprivlib='./install_me_here/usr/lib/perl5/5.13.0'
installscript='./install_me_here/usr/bin'
-installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.11.3/armv4l-linux'
+installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.13.0/armv4l-linux'
installsitebin='./install_me_here/usr/bin'
installsitehtml1dir=''
installsitehtml3dir=''
-installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.11.3'
+installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.13.0'
installsiteman1dir='./install_me_here/usr/share/man/man1'
installsiteman3dir='./install_me_here/usr/share/man/man3'
installsitescript='./install_me_here/usr/bin'
pr=''
prefix='/usr'
prefixexp='/usr'
-privlib='/usr/lib/perl5/5.11.3'
-privlibexp='/usr/lib/perl5/5.11.3'
+privlib='/usr/lib/perl5/5.13.0'
+privlibexp='/usr/lib/perl5/5.13.0'
procselfexe='"/proc/self/exe"'
prototype='define'
ptrsize='4'
sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 6, 17, 29, 31, 0'
sig_size='68'
signal_t='void'
-sitearch='/usr/lib/perl5/site_perl/5.11.3/armv4l-linux'
-sitearchexp='/usr/lib/perl5/site_perl/5.11.3/armv4l-linux'
+sitearch='/usr/lib/perl5/site_perl/5.13.0/armv4l-linux'
+sitearchexp='/usr/lib/perl5/site_perl/5.13.0/armv4l-linux'
sitebin='/usr/bin'
sitebinexp='/usr/bin'
sitehtml1dir=''
sitehtml1direxp=''
sitehtml3dir=''
sitehtml3direxp=''
-sitelib='/usr/lib/perl5/site_perl/5.11.3'
+sitelib='/usr/lib/perl5/site_perl/5.13.0'
sitelib_stem='/usr/lib/perl5/site_perl'
-sitelibexp='/usr/lib/perl5/site_perl/5.11.3'
+sitelibexp='/usr/lib/perl5/site_perl/5.13.0'
siteman1dir='/usr/share/man/man1'
siteman1direxp='/usr/share/man/man1'
siteman3dir='/usr/share/man/man3'
strerror_r_proto='0'
strings='/usr/include/string.h'
submit=''
-subversion='3'
+subversion='0'
sysman='/usr/share/man/man1'
tail=''
tar=''
vendorprefixexp=''
vendorscript=''
vendorscriptexp=''
-version='5.11.3'
-version_patchlevel_string='version 11 subversion 3'
+version='5.13.0'
+version_patchlevel_string='version 13 subversion 0'
versiononly='undef'
vi=''
voidflags='15'
config_args=''
config_argc=0
PERL_REVISION=5
-PERL_VERSION=11
-PERL_SUBVERSION=3
+PERL_VERSION=13
+PERL_SUBVERSION=0
PERL_API_REVISION=5
-PERL_API_VERSION=11
+PERL_API_VERSION=13
PERL_API_SUBVERSION=0
PERL_PATCHLEVEL=
PERL_CONFIG_SH=true
L<"Reporting Problems"> below.
For information on what's new in this release, see the
-pod/perl5113delta.pod file. For more information about how to find more
+pod/perl5131delta.pod file. For more information about how to find more
specific detail about changes, see the Changes file.
=head1 DESCRIPTION
=head2 Changes and Incompatibilities
-Please see pod/perl5113delta.pod for a description of the changes and
+Please see pod/perl5131delta.pod for a description of the changes and
potential incompatibilities introduced with this release. A few of
the most important issues are listed below, but you should refer
-to pod/perl5113delta.pod for more detailed information.
+to pod/perl5131delta.pod for more detailed information.
B<WARNING:> This version is not binary compatible with prior releases of Perl.
If you have built extensions (i.e. modules that include C code)
On a related issue, old modules may possibly be affected by the changes
in the Perl language in the current release. Please see
-pod/perl5113delta.pod for a description of what's changed. See your
+pod/perl5131delta.pod for a description of what's changed. See your
installed copy of the perllocal.pod file for a (possibly incomplete)
list of locally installed modules. Also see CPAN::autobundle for one
way to make a "bundle" of your currently installed modules.
On these systems, it might be the default compilation mode, and there
is currently no guarantee that passing no use64bitall option to the
Configure process will build a 32bit perl. Implementing -Duse32bit*
-options is planned for perl 5.12.
+options is planned for a future release of perl.
=head3 Long doubles
=item Directories for the perl distribution
-By default, Configure will use the following directories for 5.11.3.
+By default, Configure will use the following directories for 5.13.1.
$version is the full perl version number, including subversion, e.g.
-5.11.3 or 5.9.5, and $archname is a string like sun4-sunos,
+5.13.1 or 5.9.5, and $archname is a string like sun4-sunos,
determined by Configure. The full definitions of all Configure
variables are in the file Porting/Glossary.
"-Duserelocatableinc" is that everything is relocated. The initial
install is done to the original configured prefix.
+This option is not compatible with the building of a shared libperl
+("-Duseshrplib"), because in that case perl is linked with an hard-coded
+rpath that points at the libperl.so, that cannot be relocated.
+
=head2 Site-wide Policy settings
After Configure runs, it stores a number of common site-wide "policy"
To disable certain extensions so that they are not built, use the
-Dnoextensions=... and -Donlyextensions=... options. They both accept
-a space-separated list of extensions. The extensions listed in
+a space-separated list of extensions, such as C<IPC/SysV>. The extensions
+listed in
C<noextensions> are removed from the list of extensions to build, while
the C<onlyextensions> is rather more severe and builds only the listed
extensions. The latter should be used with extreme caution since
SCO prior to 3.2.4 may be missing dbmclose(). An upgrade to 3.2.4
that includes libdbm.nfs (which includes dbmclose()) may be available.
+=item error: too few arguments to function 'dbmclose'
+
+Building ODBM_File on some (Open)SUSE distributions might run into this
+error, as the header file is broken. There are two ways to deal with this
+
+ 1. Disable the use of ODBM_FILE
+
+ Configure ... -Dnoextensions=ODBM_File
+
+ 2. Fix the header file, somewhat like this:
+
+ --- a/usr/include/dbm.h 2010-03-24 08:54:59.000000000 +0100
+ +++ b/usr/include/dbm.h 2010-03-24 08:55:15.000000000 +0100
+ @@ -59,4 +59,4 @@ extern datum firstkey __P((void));
+
+ extern datum nextkey __P((datum key));
+
+ -extern int dbmclose __P((DBM *));
+ +extern int dbmclose __P((void));
+
=item Note (probably harmless): No library found for -lsomething
If you see such a message during the building of an extension, but
by hand to see if it makes any difference. If individual tests
bomb, you can run them by hand, e.g.,
- cd t ; ./perl -MTestInit op/groups.t
+ ./perl -MTestInit t/op/groups.t
Another way to get more detailed information about failed tests and
individual subtests is to cd to the t directory and run
=head1 Coexistence with earlier versions of perl 5
-Perl 5.11 is not binary compatible with earlier versions of Perl.
+Perl 5.12 is not binary compatible with earlier versions of Perl.
In other words, you will have to recompile your XS modules.
In general, you can usually safely upgrade from one version of Perl (e.g.
libraries after 5.6.0, but not for executables. TODO?) One convenient
way to do this is by using a separate prefix for each version, such as
- sh Configure -Dprefix=/opt/perl5.11.3
+ sh Configure -Dprefix=/opt/perl5.13.1
-and adding /opt/perl5.11.3/bin to the shell PATH variable. Such users
+and adding /opt/perl5.13.1/bin to the shell PATH variable. Such users
may also wish to add a symbolic link /usr/local/bin/perl so that
scripts can still start with #!/usr/local/bin/perl.
=head2 Upgrading from 5.11.0 or earlier
-B<Perl 5.11.3 is binary incompatible with Perl 5.11.1 and any earlier
+B<Perl 5.13.1 is binary incompatible with Perl 5.11.1 and any earlier
Perl release.> Perl modules having binary parts
(meaning that a C compiler is used) will have to be recompiled to be
-used with 5.11.3. If you find you do need to rebuild an extension with
-5.11.3, you may safely do so without disturbing the older
+used with 5.13.1. If you find you do need to rebuild an extension with
+5.13.1, you may safely do so without disturbing the older
installations. (See L<"Coexistence with earlier versions of perl 5">
above.)
cpan/CGI/t/uploadInfo.t See if CGI.pm works
cpan/CGI/t/upload_post_text.txt Test data for CGI.pm
cpan/CGI/t/upload.t See if CGI.pm works
+cpan/CGI/t/url.t See if CGI.pm works
cpan/CGI/t/user_agent.t See if CGI->user_agent() works
cpan/CGI/t/utf8.t See if CGI.pm works
cpan/CGI/t/util-58.t See if 5.8-dependent features work
cpan/CGI/t/util.t See if CGI.pm works
-cpan/Class-ISA/ChangeLog Changes for Class::ISA
-cpan/Class-ISA/lib/Class/ISA.pm Class::ISA
-cpan/Class-ISA/t/00_about_verbose.t Tests for Class::ISA
-cpan/Class-ISA/t/01_old_junk.t Tests for Class::ISA
cpan/Compress-Raw-Bzip2/bzip2-src/blocksort.c
-cpan/Compress-Raw-Bzip2/bzip2-src/bzip2.c
-cpan/Compress-Raw-Bzip2/bzip2-src/bzip2recover.c
cpan/Compress-Raw-Bzip2/bzip2-src/bzlib.c
cpan/Compress-Raw-Bzip2/bzip2-src/bzlib.h
cpan/Compress-Raw-Bzip2/bzip2-src/bzlib_private.h
cpan/Compress-Raw-Bzip2/bzip2-src/compress.c
cpan/Compress-Raw-Bzip2/bzip2-src/crctable.c
cpan/Compress-Raw-Bzip2/bzip2-src/decompress.c
-cpan/Compress-Raw-Bzip2/bzip2-src/dlltest.c
cpan/Compress-Raw-Bzip2/bzip2-src/huffman.c
cpan/Compress-Raw-Bzip2/bzip2-src/LICENSE
-cpan/Compress-Raw-Bzip2/bzip2-src/mk251.c
cpan/Compress-Raw-Bzip2/bzip2-src/randtable.c
-cpan/Compress-Raw-Bzip2/bzip2-src/spewG.c
-cpan/Compress-Raw-Bzip2/bzip2-src/unzcrash.c
cpan/Compress-Raw-Bzip2/Bzip2.xs
cpan/Compress-Raw-Bzip2/Changes
cpan/Compress-Raw-Bzip2/fallback/constants.h
cpan/CPAN/lib/CPAN/Tarzip.pm helper package for CPAN.pm
cpan/CPAN/lib/CPAN/URL.pm
cpan/CPAN/lib/CPAN/Version.pm Simple math with different flavors of version strings
-cpan/CPAN/Makefile.PL
cpan/CPAN/PAUSE2003.pub CPAN public key
cpan/CPAN/PAUSE2005.pub CPAN public key
cpan/CPAN/PAUSE2007.pub CPAN public key
cpan/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm converts Perl XS code into C code
cpan/ExtUtils-ParseXS/lib/ExtUtils/xsubpp External subroutine preprocessor
cpan/ExtUtils-ParseXS/t/basic.t See if ExtUtils::ParseXS works
+cpan/ExtUtils-ParseXS/t/lib/IncludeTester.pm ExtUtils::ParseXS testing utility
cpan/ExtUtils-ParseXS/t/more.t Extended ExtUtils::ParseXS testing
cpan/ExtUtils-ParseXS/t/typemap Standard typemap for controlled testing
cpan/ExtUtils-ParseXS/t/usage.t ExtUtils::ParseXS tests
cpan/ExtUtils-ParseXS/t/XSUsage.xs ExtUtils::ParseXS tests
cpan/File-Fetch/lib/File/Fetch.pm File::Fetch
cpan/File-Fetch/t/01_File-Fetch.t File::Fetch tests
+cpan/File-Fetch/t/null_subclass.t
cpan/File-Path/lib/File/Path.pm Do things like 'mkdir -p' and 'rm -r'
cpan/File-Path/t/Path.t See if File::Path works
cpan/File-Path/t/taint.t See if File::Path works with -T
cpan/List-Util/t/weak.t Scalar::Util
cpan/List-Util/XS.pp List::Util
cpan/Locale-Codes/ChangeLog Locale::Codes
+cpan/Locale-Codes/lib/Locale/Codes/Changes.pod Locale::Codes documentation
+cpan/Locale-Codes/lib/Locale/Codes/Country.pm Locale::Codes
+cpan/Locale-Codes/lib/Locale/Codes/Currency.pm Locale::Codes
+cpan/Locale-Codes/lib/Locale/Codes/Language.pm Locale::Codes
+cpan/Locale-Codes/lib/Locale/Codes.pm Locale::Codes
+cpan/Locale-Codes/lib/Locale/Codes.pod Locale::Codes documentation
+cpan/Locale-Codes/lib/Locale/Codes/Script.pm Locale::Codes
cpan/Locale-Codes/lib/Locale/Constants.pm Locale::Codes
cpan/Locale-Codes/lib/Locale/Constants.pod Locale::Codes documentation
cpan/Locale-Codes/lib/Locale/Country.pm Locale::Codes
cpan/Locale-Codes/lib/Locale/Language.pod Locale::Codes documentation
cpan/Locale-Codes/lib/Locale/Script.pm Locale::Codes
cpan/Locale-Codes/lib/Locale/Script.pod Locale::Codes documentation
-cpan/Locale-Codes/Makefile.PL
-cpan/Locale-Codes/README Locale::Codes
-cpan/Locale-Codes/t/all.t See if Locale::Codes work
-cpan/Locale-Codes/t/constants.t See if Locale::Codes work
-cpan/Locale-Codes/t/country.t See if Locale::Codes work
-cpan/Locale-Codes/t/currency.t See if Locale::Codes work
-cpan/Locale-Codes/t/language.t See if Locale::Codes work
-cpan/Locale-Codes/t/rename.t See if Locale::Codes work
-cpan/Locale-Codes/t/script.t See if Locale::Codes work
-cpan/Locale-Codes/t/uk.t See if Locale::Codes work
+cpan/Locale-Codes/LICENSE Locale::Codes
+cpan/Locale-Codes/README.first Locale::Codes
+cpan/Locale-Codes/t/alias_code.t Locale::Codes tests
+cpan/Locale-Codes/t/code2country.t Locale::Codes tests
+cpan/Locale-Codes/t/code2currency.t Locale::Codes tests
+cpan/Locale-Codes/t/code2language.t Locale::Codes tests
+cpan/Locale-Codes/t/code2script.t Locale::Codes tests
+cpan/Locale-Codes/t/country2code.t Locale::Codes tests
+cpan/Locale-Codes/t/country_code2code.t Locale::Codes tests
+cpan/Locale-Codes/t/country.t Locale::Codes tests
+cpan/Locale-Codes/t/currency2code.t Locale::Codes tests
+cpan/Locale-Codes/t/language2code.t Locale::Codes tests
+cpan/Locale-Codes/t/language.t Locale::Codes tests
+cpan/Locale-Codes/t/script2code.t Locale::Codes tests
+cpan/Locale-Codes/t/testfunc.pl Locale::Codes tests
cpan/Locale-Maketext-Simple/lib/Locale/Maketext/Simple.pm Locale::Simple
cpan/Locale-Maketext-Simple/t/0-signature.t Locale::Simple tests
cpan/Locale-Maketext-Simple/t/1-basic.t Locale::Simple tests
cpan/podlators/t/basic.t podlators test
cpan/podlators/t/basic.txt podlators test
cpan/podlators/t/color.t podlators test
+cpan/podlators/t/devise-date.t podlators test
cpan/podlators/t/filehandle.t podlators test
+cpan/podlators/t/man-heading.t podlators test
cpan/podlators/t/man-options.t podlators test
cpan/podlators/t/man.t podlators test
cpan/podlators/t/man-utf8.t podlators test
+cpan/podlators/t/overstrike.t podlators test
cpan/podlators/t/parselink.t podlators test
cpan/podlators/t/pod-parser.t podlators test
cpan/podlators/t/pod-spelling.t podlators test
cpan/podlators/t/text-options.t podlators test
cpan/podlators/t/text.t podlators test
cpan/podlators/t/text-utf8.t podlators test
-cpan/podlators/VERSION podlators custom Makefile.PL
cpan/podlators/VERSION podlators distribution version
cpan/Pod-Parser/lib/Pod/Checker.pm Pod-Parser - check POD documents for syntax errors
cpan/Pod-Parser/lib/Pod/Find.pm used by pod/splitpod
dist/Data-Dumper/Todo Data pretty printer, futures
dist/Data-Dumper/t/overload.t See if Data::Dumper works for overloaded data
dist/Data-Dumper/t/pair.t See if Data::Dumper pair separator works
+dist/Data-Dumper/t/terse.t See if Data::Dumper terse option works
dist/ExtUtils-Install/Changes ExtUtils-Install change log
dist/ExtUtils-Install/lib/ExtUtils/Installed.pm Information on installed extensions
dist/ExtUtils-Install/lib/ExtUtils/Install.pm Handles 'make install' on extensions
dist/Pod-Perldoc/t/checkerbasic.t test Pod::Perldoc::ToChecker
dist/Pod-Perldoc/t/perldocbasic.t test Pod::Perldoc basic operation
dist/Pod-Perldoc/t/textbasic.t test Pod::Perldoc::ToText
-dist/Pod-Plainer/Plainer.pm Pod migration utility module
-dist/Pod-Plainer/t/plainer.t Test Pod::Plainer
dist/Safe/Changes Changes for Safe.pm
dist/Safe/Makefile.PL Makefile.PL for Safe.pm
dist/Safe/MANIFEST MANIFEST for Safe.pm
dist/Safe/t/safeops.t Tests that all ops can be trapped by Safe
dist/Safe/t/safesort.t Tests Safe with sort
dist/Safe/t/safeuniversal.t Tests Safe with functions from universal.c
+dist/Safe/t/safeutf8.t Tests Safe with utf8.pm
+dist/Safe/t/safewrap.t Tests Safe::wrap_code_ref()
dist/SelfLoader/lib/SelfLoader.pm Load functions only on demand
dist/SelfLoader/t/01SelfLoader.t See if SelfLoader works
dist/SelfLoader/t/02SelfLoader-buggy.t See if SelfLoader works
dist/Storable/t/utf8hash.t See if Storable works
dist/Storable/t/utf8.t See if Storable works
dist/Storable/t/weak.t Can Storable store weakrefs
-dist/Switch/Changes Changes for Switch.pm
-dist/Switch/Makefile.PL Makefile.PL for Switch.pm
-dist/Switch/MANIFEST MANIFEST for Switch.pm
-dist/Switch/META.yml META.yml for Switch.pm
-dist/Switch/README README for Switch.pm
-dist/Switch/Switch.pm Switch for Perl
-dist/Switch/t/given.t See if Perl 6 given (switch) works
-dist/Switch/t/nested.t See if nested switch works
-dist/Switch/t/switch.t See if Perl 5 switch works
dist/Thread-Queue/lib/Thread/Queue.pm Thread-safe queues
dist/Thread-Queue/t/01_basic.t Thread::Queue tests
dist/Thread-Queue/t/02_refs.t Thread::Queue tests
doop.c Support code for various operations
dosish.h Some defines for MS/DOSish machines
dump.c Debugging output
-emacs/cperl-mode.el An alternate perl-mode
-emacs/e2ctags.pl etags to ctags converter
-emacs/ptags Creates smart TAGS file
embed.fnc Database used by embed.pl
embed.h Maps symbols to safer names
embed.pl Produces {embed,embedvar,proto}.h, global.sym
ext/XS-APItest-KeywordRPN/README XS::APItest::KeywordRPN extension
ext/XS-APItest-KeywordRPN/t/keyword_plugin.t test keyword plugin mechanism
ext/XS-APItest-KeywordRPN/t/multiline.t test plugin parsing across lines
+ext/XS-APItest-KeywordRPN/t/stuff_svcur_bug.t test for a bug in lex_stuff_pvn
ext/XS-APItest/Makefile.PL XS::APItest extension
ext/XS-APItest/MANIFEST XS::APItest extension
ext/XS-APItest/notcore.c Test API functions when PERL_CORE is not defined
ext/XS-APItest/t/my_cxt.t XS::APItest: test MY_CXT interface
ext/XS-APItest/t/my_exit.t XS::APItest: test my_exit
ext/XS-APItest/t/op.t XS::APItest: tests for OP related APIs
-ext/XS-APItest/t/pmflag.t Test deprecation warning for Perl_pmflag()
+ext/XS-APItest/t/pmflag.t Test removal of Perl_pmflag()
ext/XS-APItest/t/printf.t XS::APItest extension
+ext/XS-APItest/t/ptr_table.t Test ptr_table_* APIs
ext/XS-APItest/t/push.t XS::APItest extension
ext/XS-APItest/t/rmagical.t XS::APItest extension
ext/XS-APItest/t/svpeek.t XS::APItest extension
ext/XS-APItest/t/utf16_to_utf8.t Test behaviour of utf16_to_utf8{,reversed}
ext/XS-APItest/t/xs_special_subs_require.t for require too
ext/XS-APItest/t/xs_special_subs.t Test that XS BEGIN/CHECK/INIT/END work
+ext/XS-APItest/typemap
ext/XS-Typemap/Makefile.PL XS::Typemap extension
ext/XS-Typemap/README XS::Typemap extension
ext/XS-Typemap/stdio.c XS::Typemap extension
lib/unicore/PropList.txt Unicode character database
lib/unicore/PropValueAliases.txt Unicode character database
lib/unicore/README.perl Unicode character database
-lib/unicore/README.perl Unicode character database
lib/unicore/ReadMe.txt Unicode character database info
lib/unicore/Scripts.txt Unicode character database
lib/unicore/SpecialCasing.txt Unicode character database
pod/perl5111delta.pod Perl changes in version 5.11.1
pod/perl5112delta.pod Perl changes in version 5.11.2
pod/perl5113delta.pod Perl changes in version 5.11.3
+pod/perl5114delta.pod Perl changes in version 5.11.4
+pod/perl5115delta.pod Perl changes in version 5.11.5
+pod/perl5120delta.pod Perl changes in version 5.12.0
+pod/perl5130delta.pod Perl changes in version 5.13.0
+pod/perl5131delta.pod Perl changes in version 5.13.1
pod/perl561delta.pod Perl changes in version 5.6.1
pod/perl56delta.pod Perl changes in version 5.6
pod/perl570delta.pod Perl changes in version 5.7.0
Porting/checkansi.pl Check source code for ANSI-C violations
Porting/checkAUTHORS.pl Check that the AUTHORS file is complete
Porting/checkcfgvar.pl Check that config scripts define all symbols
+Porting/check-cpan-pollution Check for commits that may wrongly touch CPAN distros
+Porting/checkpodencoding.pl Check POD encoding
Porting/checkURL.pl Check whether we have working URLs
Porting/checkVERSION.pl Check whether we have $VERSIONs
Porting/cmpVERSION.pl Compare whether two trees have changed modules
Porting/config.sh Sample config.sh
Porting/core-cpan-diff Compare core distros with their CPAN equivalents
Porting/corecpan.pl Reports outdated dual-lived modules
-Porting/corelist-perldelta.pl Generates data perldelta from Module::CoreList
+Porting/corelist-diff Tool to produce corelist diffs
+Porting/corelist-perldelta.pl Generates data perldelta from Module::CoreList
Porting/corelist.pl Generates data for Module::CoreList
Porting/curliff.pl Curliff or liff your curliffable files.
Porting/expand-macro.pl A tool to expand C macro definitions in the Perl source
t/io/binmode.t See if binmode() works
t/io/crlf.t See if :crlf works
t/io/crlf_through.t See if pipe passes data intact with :crlf
+t/io/defout.t See if PL_defoutgv works
t/io/dup.t See if >& works right
t/io/errno.t See if $! is correctly set
t/io/fflush.t See if auto-flush on fork/exec/system/qx works
t/op/dbm.t See if dbmopen/dbmclose work
t/op/defins.t See if auto-insert of defined() works
t/op/delete.t See if delete works
+t/op/die_except.t See if die/eval avoids $@ clobberage
t/op/die_exit.t See if die and exit status interaction works
+t/op/die_keeperr.t See if G_KEEPERR works for destructors
t/op/die.t See if die works
t/op/dor.t See if defined-or (//) works
t/op/do.t See if subroutines work
t/op/exists_sub.t See if exists(&sub) works
t/op/exp.t See if math functions work
t/op/fh.t See if filehandles work
+t/op/filehandle.t Tests for http://rt.perl.org/rt3/Ticket/Display.html?id=72586
t/op/filetest.t See if file tests work
t/op/filetest_t.t See if -t file test works
t/op/flip.t See if range operator works
t/op/or.t See if || works in weird situations
t/op/overload_integer.t See if overload::constant for integer works after "use".
t/op/override.t See if operator overriding works
+t/op/packagev.t See if package VERSION work
t/op/pack.t See if pack and unpack work
t/op/pos.t See if pos works
t/op/pow.t See if ** works
+t/op/protowarn.t See if the illegalproto warnings work
t/op/push.t See if push and pop work
t/op/pwent.t See if getpw*() functions work
t/op/qq.t See if qq works
t/op/reverse.t See if reverse operator works
t/op/runlevel.t See if die() works from perl_call_*()
t/op/setpgrpstack.t See if setpgrp works
+t/op/sigdispatch.t See if signals are always dispatched
t/op/sleep.t See if sleep works
t/op/smartmatch.t See if the ~~ operator works
t/op/sort.t See if sort works
t/op/studytied.t See if study works with tied scalars
t/op/sub_lval.t See if lvalue subroutines work
t/op/sub.t See if subroutines work
+t/op/svleak.t See if stuff leaks SVs
t/op/switch.t See if switches (given/when) work
t/op/symbolcache.t See if undef/delete works on stashes with functions
t/op/sysio.t See if sysread and syswrite work
t/op/tiearray.t See if tie for arrays works
t/op/tiehandle.t See if tie for handles works
t/op/tie.t See if tie/untie functions work
+t/op/time_loop.t Test that very large values don't hang gmtime and localtime.
t/op/time.t See if time functions work
t/op/tr.t See if tr works
t/op/undef.t See if undef works
t/op/upgrade.t See if upgrading and assigning scalars works
t/op/utf8cache.t Tests malfunctions of utf8 cache
t/op/utf8decode.t See if UTF-8 decoding works
+t/op/utf8magic.t See if utf8:: functions handle magic variables
t/op/utfhash.t See if utf8 keys in hashes behave
t/op/utftaint.t See if utf8 and taint work together
t/op/vec.t See if vectors work
t/op/ver.t See if v-strings and the %v format flag work
t/op/wantarray.t See if wantarray works
+t/op/warn.t See if warn works
t/op/while_readdir.t See if while(readdir) works
t/op/write.t See if write works (formats work)
t/op/yadayada.t See if ... works
name: perl
-version: 5.011003
+version: 5.013000
abstract: Practical Extraction and Report Language
author: perl5-porters@perl.org
license: perl
homepage: http://www.perl.org/
bugtracker: http://rt.perl.org/perlbug/
license: http://dev.perl.org/licenses/
+ repository: http://perl5.git.perl.org/
distribution_type: core
generated_by: Porting/makemeta
no_index:
- dist/XSLoader
- ext/Time-Local
- lib/version
+ - win32
file:
- dist/IO/ChangeLog
- lib/Exporter.t
- lib/Exporter/Heavy.pm
- lib/newgetopt.pl
+ - lib/unicore/mktables
- lib/version.pm
- lib/version.pod
- lib/version.t
- pod/pod2usage.PL
- pod/podchecker.PL
- pod/podselect.PL
+ - Porting/Maintainers.pm
+ - Porting/perldelta_template.pod
+ - TestInit.pm
obj2 = hv$(OBJ_EXT) av$(OBJ_EXT) run$(OBJ_EXT) pp_hot$(OBJ_EXT) sv$(OBJ_EXT) pp$(OBJ_EXT) scope$(OBJ_EXT) pp_ctl$(OBJ_EXT) pp_sys$(OBJ_EXT)
obj3 = doop$(OBJ_EXT) doio$(OBJ_EXT) regexec$(OBJ_EXT) utf8$(OBJ_EXT) taint$(OBJ_EXT) deb$(OBJ_EXT) universal$(OBJ_EXT) globals$(OBJ_EXT) perlio$(OBJ_EXT) perlapi$(OBJ_EXT) numeric$(OBJ_EXT) mathoms$(OBJ_EXT) locale$(OBJ_EXT) pp_pack$(OBJ_EXT) pp_sort$(OBJ_EXT)
-mini_obj = $(obj1) $(obj2) $(obj3) $(ARCHOBJS)
+mini_obj = $(obj1) $(obj2) $(obj3) $(ARCHOBJS) $(DTRACE_O)
ndt_obj = $(obj0) $(obj1) $(obj2) $(obj3) $(ARCHOBJS)
obj = $(ndt_obj) $(DTRACE_O)
.PHONY: all translators utilities
-lib/Config_git.pl git_version.h: $(MINIPERL_EXE) make_patchnum.pl
+# Both git_version.h and lib/Config_git.pl are built
+# by make_patchnum.pl.
+git_version.h: lib/Config_git.pl
+
+lib/Config_git.pl: $(MINIPERL_EXE) make_patchnum.pl
$(MINIPERL) make_patchnum.pl
# make sure that we recompile perl.c if the git version changes
globals\$(OBJ_EXT): uudmap.h bitcount.h
-uudmap.h bitcount.h: generate_uudmap\$(HOST_EXE_EXT)
+uudmap.h: bitcount.h
+
+bitcount.h: generate_uudmap\$(HOST_EXE_EXT)
\$(RUN) ./generate_uudmap\$(HOST_EXE_EXT) uudmap.h bitcount.h
generate_uudmap\$(HOST_EXE_EXT): generate_uudmap\$(OBJ_EXT)
.PHONY: preplibrary
preplibrary: $(MINIPERL_EXE) $(CONFIGPM) lib/re.pm $(PREPLIBRARY_LIBPERL)
-$(CONFIGPM_FROM_CONFIG_SH) $(CONFIGPOD): config.sh $(MINIPERL_EXE) configpm Porting/Glossary lib/Config_git.pl
+$(CONFIGPM_FROM_CONFIG_SH): $(CONFIGPOD)
+
+$(CONFIGPOD): config.sh $(MINIPERL_EXE) configpm Porting/Glossary lib/Config_git.pl
$(MINIPERL) configpm
lib/ExtUtils/Miniperl.pm: miniperlmain.c $(MINIPERL_EXE) minimod.pl $(CONFIGPM)
pod/perltoc.pod: $(perltoc_pod_prereqs) $(PERL_EXE) $(ext) pod/buildtoc
$(RUN_PERL) -f -Ilib pod/buildtoc --build-toc -q
-pod/perlapi.pod pod/perlintern.pod: $(MINIPERL_EXE) autodoc.pl embed.fnc
+pod/perlapi.pod: pod/perlintern.pod
+
+pod/perlintern.pod: $(MINIPERL_EXE) autodoc.pl embed.fnc
$(MINIPERL) autodoc.pl
pod/perlmodlib.pod: $(MINIPERL_EXE) pod/perlmodlib.PL MANIFEST
$(MINIPERL) $(Icwd) pod/perlmodlib.PL -q
-pod/perldelta.pod: pod/perl5113delta.pod
- $(LNS) perl5113delta.pod pod/perldelta.pod
+pod/perldelta.pod: pod/perl5131delta.pod
+ $(LNS) perl5131delta.pod pod/perldelta.pod
extra.pods: $(MINIPERL_EXE)
-@test ! -f extra.pods || rm -f `cat extra.pods`
makedepend: makedepend.SH config.sh
sh ./makedepend.SH
+runtests: runtests.SH config.sh
+ sh ./runtests.SH
+
.PHONY: test check test_prep test_prep_nodll test_prep_pre \
test_prep_reonly test_tty test-tty test_notty test-notty \
utest ucheck test.utf8 check.utf8 test.torture torturetest \
test_prep_pre: preplibrary utilities $(nonxs_ext)
-test_prep: test_prep_pre $(MINIPERL_EXE) $(unidatafiles) $(PERL_EXE) $(dynamic_ext) $(TEST_PERL_DLL)
+test_prep: test_prep_pre $(MINIPERL_EXE) $(unidatafiles) $(PERL_EXE) $(dynamic_ext) $(TEST_PERL_DLL) runtests
cd t && (rm -f $(PERL_EXE); $(LNS) ../$(PERL_EXE) $(PERL_EXE))
test_prep_reonly: $(MINIPERL_EXE) $(PERL_EXE) $(dynamic_ext_re) $(TEST_PERL_DLL)
# Here comes the CW tools - TO BE FILLED TO BUILD WITH CW -
-MODULE_DESC = "Perl 5.11.3 for NetWare"
+MODULE_DESC = "Perl 5.13.0 for NetWare"
CCTYPE = CodeWarrior
C_COMPILER = mwccnlm -c
CPP_COMPILER = mwccnlm
# versioned installation can be obtained by setting INST_TOP above to a
# path that includes an arbitrary version string.
#
-INST_VER = \5.11.3
+INST_VER = \5.13.0
#
# Comment this out if you DON'T want your perl installation to have
d_pipe='define'
d_poll='undef'
d_portable='define'
+d_prctl='undef'
+d_prctl_set_name='undef'
d_printf_format_null='undef'
d_procselfexe='undef'
d_pseudofork='undef'
uvtype='unsigned long'
uvuformat='"lu"'
uvxformat='"lx"'
+vaproto='undef'
vendorarch=''
vendorarchexp=''
vendorbin=''
* This symbol contains the ~name expanded version of ARCHLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define ARCHLIB "c:\\perl\\5.11.3\\lib\\NetWare-x86-multi-thread" /**/
+#define ARCHLIB "c:\\perl\\5.13.0\\lib\\NetWare-x86-multi-thread" /**/
/*#define ARCHLIB_EXP "" /**/
/* ARCHNAME:
* This symbol is the filename expanded version of the BIN symbol, for
* programs that do not want to deal with that at run-time.
*/
-#define BIN "c:\\perl\\5.11.3\\bin\\NetWare-x86-multi-thread" /**/
-#define BIN_EXP "c:\\perl\\5.11.3\\bin\\NetWare-x86-multi-thread" /**/
+#define BIN "c:\\perl\\5.13.0\\bin\\NetWare-x86-multi-thread" /**/
+#define BIN_EXP "c:\\perl\\5.13.0\\bin\\NetWare-x86-multi-thread" /**/
/* BYTEORDER:
* This symbol holds the hexadecimal constant defined in byteorder,
* This symbol contains the ~name expanded version of SITEARCH, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define SITEARCH "c:\\perl\\site\\5.11.3\\lib\\NetWare-x86-multi-thread" /**/
+#define SITEARCH "c:\\perl\\site\\5.13.0\\lib\\NetWare-x86-multi-thread" /**/
/*#define SITEARCH_EXP "" /**/
/* SITELIB:
* removed. The elements in inc_version_list (inc_version_list.U) can
* be tacked onto this variable to generate a list of directories to search.
*/
-#define SITELIB "c:\\perl\\site\\5.11.3\\lib" /**/
+#define SITELIB "c:\\perl\\site\\5.13.0\\lib" /**/
/*#define SITELIB_EXP "" /**/
#define SITELIB_STEM "" /**/
indicates to the C program that it should not assume that it is
running on the machine it was compiled on.
+d_prctl (d_prctl.U):
+ This variable conditionally defines the HAS_PRCTL symbol, which
+ indicates to the C program that the prctl() routine is available.
+
+d_prctl_set_name (d_prctl.U):
+ This variable conditionally defines the HAS_PRCTL_SET_NAME symbol,
+ which indicates to the C program that the prctl() routine supports
+ the PR_SET_NAME option.
+
d_PRId64 (quadfio.U):
This variable conditionally defines the PERL_PRId64 symbol, which
indiciates that stdio has a symbol to print 64-bit decimal numbers.
This variable contains the format string used for printing
a Perl UV as an unsigned hexadecimal integer in uppercase ABCDEF.
+vaproto (vaproto.U):
+ This variable conditionally defines CAN_VAPROTO on systems supporting
+ prototype declaration of functions with a variable number of
+ arguments. See also prototype.
+
vendorarch (vendorarch.U):
This variable contains the value of the PERL_VENDORARCH symbol.
It may have a ~ on the front.
# Also, a "module" does not necessarily mean a CPAN module, it
# might mean a file or files or a subdirectory.
# Most (but not all) of the modules have dual lives in the core
-# and in CPAN. Those that have a CPAN existence, have the CPAN
-# attribute set to true.
+# and in CPAN.
package Maintainers;
'sadahiro' => 'SADAHIRO Tomoyuki <SADAHIRO@cpan.org>',
'salva' => 'Salvador Fandiño GarcÃa <salva@cpan.org>',
'saper' => 'Sébastien Aperghis-Tramoni <saper@cpan.org>',
+ 'sbeck' => 'Sullivan Beck <sbeck@cpan.org>',
'sburke' => 'Sean Burke <sburke@cpan.org>',
'mschwern' => 'Michael Schwern <mschwern@cpan.org>',
'simonw' => 'Simon Wistow <simonw@cpan.org>',
# Each entry in the %Modules hash roughly represents a distribution,
-# except in the case of CPAN=1, where it *exactly* represents a single
+# except when DISTRIBUTION is set, where it *exactly* represents a single
# CPAN distribution.
# The keys of %Modules are human descriptions of the distributions, and
# names to be recursed down, which collectively generate a complete list
# of the files associated with the distribution.
-# CPAN can be either 1 (this distribution is also available on CPAN),
-# or 0 (there is no # valid CPAN release).
-
# UPSTREAM indicates where patches should go. undef implies
# that this hasn't been discussed for the module at hand.
# "blead" indicates that the copy of the module in the blead
'Archive::Extract' =>
{
'MAINTAINER' => 'kane',
- 'DISTRIBUTION' => 'BINGOS/Archive-Extract-0.36.tar.gz',
+ 'DISTRIBUTION' => 'BINGOS/Archive-Extract-0.38.tar.gz',
'FILES' => q[cpan/Archive-Extract],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
'BUGS' => 'bug-archive-extract@rt.cpan.org',
},
'MAINTAINER' => 'kane',
'DISTRIBUTION' => 'BINGOS/Archive-Tar-1.54.tar.gz',
'FILES' => q[cpan/Archive-Tar],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
'BUGS' => 'bug-archive-tar@rt.cpan.org',
},
'MAINTAINER' => 'rgarcia',
'DISTRIBUTION' => 'SMUELLER/Attribute-Handlers-0.87.tar.gz',
'FILES' => q[dist/Attribute-Handlers],
- 'CPAN' => 1,
'UPSTREAM' => 'blead',
},
t/system.t
)
],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
'DISTRIBUTION' => 'SMUELLER/AutoLoader-5.70.tar.gz',
'FILES' => q[cpan/AutoLoader],
'EXCLUDED' => [ qw( t/00pod.t ) ],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
{
'MAINTAINER' => 'smccam',
'FILES' => q[ext/B/B/Concise.pm ext/B/t/concise.t],
- 'CPAN' => 0,
'UPSTREAM' => undef,
},
'B::Debug' =>
{
'MAINTAINER' => 'rurban',
- 'DISTRIBUTION' => 'RURBAN/B-Debug-1.11.tar.gz',
+ 'DISTRIBUTION' => 'RURBAN/B-Debug-1.12.tar.gz',
'FILES' => q[cpan/B-Debug],
'EXCLUDED' => [ qw( t/coverage.html t/pod.t ) ],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
{
'MAINTAINER' => 'smccam',
'FILES' => q[dist/B-Deparse],
- 'CPAN' => 0,
'UPSTREAM' => 'blead',
},
'DISTRIBUTION' => 'JJORE/B-Lint-1.11.tar.gz',
'FILES' => q[cpan/B-Lint],
'EXCLUDED' => [ qw( t/test.pl ) ],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
'MAINTAINER' => 'rgarcia',
'DISTRIBUTION' => 'RGARCIA/base-2.15.tar.gz',
'FILES' => q[dist/base],
- 'CPAN' => 1,
'UPSTREAM' => 'blead',
},
'DISTRIBUTION' => 'TELS/math/bignum-0.23.tar.gz',
'FILES' => q[cpan/bignum],
'EXCLUDED' => [ qr{^inc/Module/}, qw(t/pod.t t/pod_cov.t) ],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
'CGI' =>
{
'MAINTAINER' => 'lstein',
- 'DISTRIBUTION' => 'LDS/CGI.pm-3.48.tar.gz',
+ 'DISTRIBUTION' => 'LDS/CGI.pm-3.49.tar.gz',
'FILES' => q[cpan/CGI],
'EXCLUDED' => [ qr{^t/lib/Test},
qw( cgi-lib_porting.html
t/fast.t
)
],
- 'CPAN' => 1,
- 'UPSTREAM' => 'cpan',
- },
-
- 'Class::ISA' =>
- {
- 'MAINTAINER' => 'smueller',
- 'DISTRIBUTION' => 'SMUELLER/Class-ISA-0.36.tar.gz',
- 'FILES' => q[cpan/Class-ISA],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
- 'DEPRECATED' => 5.011,
},
'Compress::Raw::Bzip2' =>
qw( bzip2-src/bzip2-cpp.patch
)
],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
t/99pod.t
)
],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
eg/synopsis.pl
)
],
- 'CPAN' => 1,
'UPSTREAM' => 'blead',
},
'CPAN' =>
{
'MAINTAINER' => 'andk',
- 'DISTRIBUTION' => 'ANDK/CPAN-1.94_53.tar.gz',
+ 'DISTRIBUTION' => 'ANDK/CPAN-1.94_56.tar.gz',
'FILES' => q[cpan/CPAN],
'EXCLUDED' => [ qr{^distroprefs/},
qr{^inc/Test/},
qr{^t/CPAN/authors/},
qw{
lib/CPAN/Admin.pm
+ Makefile.PL
SlayMakefile
t/00signature.t
t/04clean_load.t
t/yaml_code.yml
},
],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
t/032_CPANPLUS-Internals-Source-via-sqlite.t
},
],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
'BUGS' => 'bug-cpanplus@rt.cpan.org',
},
'CPANPLUS::Dist::Build' =>
{
'MAINTAINER' => 'bingos',
- 'DISTRIBUTION' => 'BINGOS/CPANPLUS-Dist-Build-0.44.tar.gz',
+ 'DISTRIBUTION' => 'BINGOS/CPANPLUS-Dist-Build-0.46.tar.gz',
'FILES' => q[cpan/CPANPLUS-Dist-Build],
'EXCLUDED' => [ qr{^inc/},
qw{ t/99_pod.t
t/99_pod_coverage.t
},
],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
'MAINTAINER' => 'p5p', # Not gsar. Not ilyam
'DISTRIBUTION' => 'SMUELLER/Data-Dumper-2.125.tar.gz',
'FILES' => q[dist/Data-Dumper],
- 'CPAN' => 1,
'UPSTREAM' => 'blead',
},
fallback.xs
},
],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
'DISTRIBUTION' => 'MHX/Devel-PPPort-3.19.tar.gz',
'FILES' => q[cpan/Devel-PPPort],
'EXCLUDED' => [ qw{PPPort.pm} ], # we use PPPort_pm.PL instead
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
'DISTRIBUTION' => 'GAAS/Digest-1.16.tar.gz',
'FILES' => q[cpan/Digest],
'EXCLUDED' => [ qw{digest-bench} ],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
'DISTRIBUTION' => 'GAAS/Digest-MD5-2.39.tar.gz',
'FILES' => q[cpan/Digest-MD5],
'EXCLUDED' => [ qw{rfc1321.txt} ],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
'DISTRIBUTION' => 'MSHELOR/Digest-SHA-5.47.tar.gz',
'FILES' => q[cpan/Digest-SHA],
'EXCLUDED' => [ qw{t/pod.t t/podcover.t examples/dups} ],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
'MAINTAINER' => 'dankogai',
'DISTRIBUTION' => 'DANKOGAI/Encode-2.39.tar.gz',
'FILES' => q[cpan/Encode],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
qw{t/0-signature.t Makefile.PL MANIFEST META.yml
README SIGNATURE},
],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
'MAP' => { 't/' => 'lib/',
'lib/' => 'lib/',
},
- 'CPAN' => 1,
'UPSTREAM' => 'blead',
},
'MAINTAINER' => 'kwilliams',
'DISTRIBUTION' => 'DAGOLDEN/ExtUtils-CBuilder-0.27.tar.gz',
'FILES' => q[cpan/ExtUtils-CBuilder],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
lib/Shell/Command.pm
},
],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
examples/perl_regcomp_posix_keyword.pl
},
],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
t/pod.t
},
],
- 'CPAN' => 1,
'UPSTREAM' => 'blead',
},
'EXCLUDED' => [ qr{^t/lib/Test/},
qr{^inc/ExtUtils/},
],
- 'CPAN' => 1,
'UPSTREAM' => 'first-come',
},
'MAINTAINER' => 'rkobes',
'DISTRIBUTION' => 'RKOBES/ExtUtils-Manifest-1.57.tar.gz',
'FILES' => q[cpan/ExtUtils-Manifest],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
'ExtUtils::ParseXS' =>
{
'MAINTAINER' => 'kwilliams',
- 'DISTRIBUTION' => 'DAGOLDEN/ExtUtils-ParseXS-2.21.tar.gz',
+ 'DISTRIBUTION' => 'DAGOLDEN/ExtUtils-ParseXS-2.2205.tar.gz',
'EXCLUDED' => [ qw{
t/bugs/RT48104.xs
t/bugs/typemap
t/include/nscore.h
}],
'FILES' => q[cpan/ExtUtils-ParseXS],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
{
'MAINTAINER' => 'perlfaq',
'FILES' => q[pod/perlfaq*],
- 'CPAN' => 0,
'UPSTREAM' => undef,
},
'File::Fetch' =>
{
'MAINTAINER' => 'kane',
- 'DISTRIBUTION' => 'BINGOS/File-Fetch-0.22.tar.gz',
+ 'DISTRIBUTION' => 'BINGOS/File-Fetch-0.24.tar.gz',
'FILES' => q[cpan/File-Fetch],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
'MAP' => { '' => 'cpan/File-Path/lib/File/',
't/' => 'cpan/File-Path/t/',
},
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
misc/results.txt
}
],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
'EXCLUDED' => [ qw(Makefile.PL MANIFEST README META.yml),
qr{^demo/}
],
- 'CPAN' => 1,
'UPSTREAM' => 'blead',
},
'perlfilter.pod' => 'pod/perlfilter.pod',
'' => 'cpan/Filter-Util-Call/',
},
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
'MAP' => { '' => 'cpan/Getopt-Long/',
'lib/newgetopt.pl' => 'lib/newgetopt.pl',
},
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
'MAINTAINER' => 'p5p',
'DISTRIBUTION' => 'SBURKE/I18N-LangTags-0.35.tar.gz',
'FILES' => q[dist/I18N-LangTags],
- 'CPAN' => 0,
'UPSTREAM' => 'blead',
},
'MAINTAINER' => 'ilyaz',
'DISTRIBUTION' => 'ILYAZ/modules/if-0.0401.tar.gz',
'FILES' => q[cpan/if],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
'DISTRIBUTION' => 'GBARR/IO-1.25.tar.gz',
'FILES' => q[dist/IO/],
'EXCLUDED' => [ qw{t/test.pl}, ],
- 'CPAN' => 1,
'UPSTREAM' => 'blead',
},
'DISTRIBUTION' => 'PMQS/IO-Compress-2.021.tar.gz',
'FILES' => q[cpan/IO-Compress],
'EXCLUDED' => [ qr{t/Test/} ],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
'MAINTAINER' => 'tomhughes',
'DISTRIBUTION' => 'TOMHUGHES/IO-Zlib-1.10.tar.gz',
'FILES' => q[cpan/IO-Zlib],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
'IPC::Cmd' =>
{
'MAINTAINER' => 'kane',
- 'DISTRIBUTION' => 'BINGOS/IPC-Cmd-0.54.tar.gz',
+ 'DISTRIBUTION' => 'BINGOS/IPC-Cmd-0.58.tar.gz',
'FILES' => q[cpan/IPC-Cmd],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
'DISTRIBUTION' => 'MHX/IPC-SysV-2.01.tar.gz',
'FILES' => q[cpan/IPC-SysV],
'EXCLUDED' => [ qw{const-c.inc const-xs.inc} ],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
'DISTRIBUTION' => 'SMUELLER/lib-0.62.tar.gz',
'FILES' => q[dist/lib/],
'EXCLUDED' => [ qw{forPAUSE/lib.pm t/00pod.t} ],
- 'CPAN' => 1,
'UPSTREAM' => 'blead',
},
'DISTRIBUTION' => 'GBARR/libnet-1.22.tar.gz',
'FILES' => q[cpan/libnet],
'EXCLUDED' => [ qw{Configure install-nomake} ],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
'Locale-Codes' =>
{
- 'MAINTAINER' => 'neilb',
- 'DISTRIBUTION' => 'NEILB/Locale-Codes-2.07.tar.gz',
+ 'MAINTAINER' => 'sbeck',
+ 'DISTRIBUTION' => 'SBECK/Locale-Codes-3.12.tar.gz',
'FILES' => q[cpan/Locale-Codes],
- 'CPAN' => 1,
- 'UPSTREAM' => undef,
+ 'EXCLUDED' => [ qw{t/pod_coverage.t t/pod.t}, qr{^t/runtests},
+ qr{^internal/}, qr{^examples/} ],
+ 'UPSTREAM' => 'cpan',
},
'Locale::Maketext' =>
'DISTRIBUTION' => 'FERREIRA/Locale-Maketext-1.13.tar.gz',
'FILES' => q[dist/Locale-Maketext],
'EXCLUDED' => [ qw{perlcriticrc t/00_load.t t/pod.t} ],
- 'CPAN' => 1,
'UPSTREAM' => 'blead',
},
'DISTRIBUTION' => 'JESSE/Locale-Maketext-Simple-0.21.tar.gz',
'FILES' => q[cpan/Locale-Maketext-Simple],
'EXCLUDED' => [ qr{^inc/} ],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
'MAINTAINER' => 'kane',
'DISTRIBUTION' => 'KANE/Log-Message-0.02.tar.gz',
'FILES' => q[cpan/Log-Message],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
'MAINTAINER' => 'kane',
'DISTRIBUTION' => 'BINGOS/Log-Message-Simple-0.06.tar.gz',
'FILES' => q[cpan/Log-Message-Simple],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
{
'MAINTAINER' => 'lwall',
'FILES' => q[mad],
- 'CPAN' => 0,
'UPSTREAM' => undef,
},
t/pod_cov.t
}
],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
'lib/Math/BigInt/FastCalc.pm'
=> 'cpan/Math-BigInt-FastCalc/FastCalc.pm',
},
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
t/pod_cov.t
},
],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
t/pod-coverage.t
},
],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
Memoize/Saves.pm
},
],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
'MIME::Base64' =>
{
'MAINTAINER' => 'gaas',
- 'DISTRIBUTION' => 'GAAS/MIME-Base64-3.08.tar.gz',
+ 'DISTRIBUTION' => 'GAAS/MIME-Base64-3.09.tar.gz',
'FILES' => q[cpan/MIME-Base64],
'EXCLUDED' => [ qw{ t/bad-sv.t }, ],
- 'CPAN' => 1,
- 'UPSTREAM' => undef,
+ 'UPSTREAM' => 'cpan',
},
'Module::Build' =>
{
'MAINTAINER' => 'kwilliams',
- 'DISTRIBUTION' => 'DAGOLDEN/Module-Build-0.36.tar.gz',
+ 'DISTRIBUTION' => 'DAGOLDEN/Module-Build-0.3603.tar.gz',
'FILES' => q[cpan/Module-Build],
'EXCLUDED' => [ qw{ t/par.t t/signature.t },
qr!^contrib/!, qr!^devtools! ],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
'MAINTAINER' => 'rgarcia',
'DISTRIBUTION' => 'BINGOS/Module-CoreList-2.23.tar.gz',
'FILES' => q[dist/Module-CoreList],
- 'CPAN' => 1,
'UPSTREAM' => 'blead',
},
'MAINTAINER' => 'kane',
'DISTRIBUTION' => 'KANE/Module-Load-0.16.tar.gz',
'FILES' => q[cpan/Module-Load],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
'Module::Load::Conditional' =>
{
'MAINTAINER' => 'kane',
- 'DISTRIBUTION' => 'BINGOS/Module-Load-Conditional-0.34.tar.gz',
+ 'DISTRIBUTION' => 'BINGOS/Module-Load-Conditional-0.38.tar.gz',
'FILES' => q[cpan/Module-Load-Conditional],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
'MAINTAINER' => 'kane',
'DISTRIBUTION' => 'BINGOS/Module-Loaded-0.06.tar.gz',
'FILES' => q[cpan/Module-Loaded],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
'MAINTAINER' => 'simonw',
'DISTRIBUTION' => 'SIMONW/Module-Pluggable-3.9.tar.gz',
'FILES' => q[cpan/Module-Pluggable],
- 'CPAN' => 1,
- 'UPSTREAM' => undef,
+ 'UPSTREAM' => 'cpan',
},
'Net::Ping' =>
'MAINTAINER' => 'smpeters',
'DISTRIBUTION' => 'SMPETERS/Net-Ping-2.36.tar.gz',
'FILES' => q[dist/Net-Ping],
- 'CPAN' => 1,
'UPSTREAM' => 'blead',
},
'DISTRIBUTION' => 'FLORA/NEXT-0.64.tar.gz',
'FILES' => q[cpan/NEXT],
'EXCLUDED' => [ qr{^demo/} ],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
'MAINTAINER' => 'kane',
'DISTRIBUTION' => 'BINGOS/Object-Accessor-0.36.tar.gz',
'FILES' => q[cpan/Object-Accessor],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
'MAINTAINER' => 'kane',
'DISTRIBUTION' => 'KANE/Package-Constants-0.02.tar.gz',
'FILES' => q[cpan/Package-Constants],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
# the tarball. Russell's Paradox eat your heart out.
'EXCLUDED' => [ qw( Params-Check-0.26.tar.gz ) ],
'FILES' => q[cpan/Params-Check],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
'MAINTAINER' => 'corion',
'DISTRIBUTION' => 'CORION/parent-0.223.tar.gz',
'FILES' => q[cpan/parent],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
'DISTRIBUTION' => 'SMUELLER/Parse-CPAN-Meta-1.40.tar.gz',
'FILES' => q[cpan/Parse-CPAN-Meta],
'EXCLUDED' => [ qw( t/97_meta.t t/98_pod.t t/99_pmv.t ) ],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
# NOTE: 'perl uupacktool.pl t/data/utf_16_le_bom.yml.packed'
# run by hand after import, as the core's test harness doesn't
'DISTRIBUTION' => 'SMUELLER/PathTools-3.31.tar.gz',
'FILES' => q[cpan/Cwd],
'EXCLUDED' => [ qr{^t/lib/Test/} ],
- 'CPAN' => 1,
'UPSTREAM' => "cpan",
# NOTE: PathTools is in cpan/Cwd/ because it contains Cwd.xs and
# something, possibly Makefile.SH, makes an assumption that the
{
'MAINTAINER' => 'pvhp',
'FILES' => q[pod/perlebcdic.pod],
- 'CPAN' => 0,
'UPSTREAM' => undef,
},
{
'MAINTAINER' => 'p5p',
'FILES' => q[ext/PerlIO],
- 'CPAN' => 0,
'UPSTREAM' => undef,
},
'MAINTAINER' => 'elizabeth',
'DISTRIBUTION' => 'ELIZABETH/PerlIO-via-QuotedPrint-0.06.tar.gz',
'FILES' => q[cpan/PerlIO-via-QuotedPrint],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
{
'MAINTAINER' => 'laun',
'FILES' => q[pod/perlpacktut.pod],
- 'CPAN' => 0,
'UPSTREAM' => undef,
},
{
'MAINTAINER' => 'sburke',
'FILES' => q[pod/perlpodspec.pod],
- 'CPAN' => 0,
'UPSTREAM' => undef,
},
'MAINTAINER' => 'abigail',
'FILES' => q[pod/perlrecharclass.pod
pod/perlrebackslash.pod],
- 'CPAN' => 0,
'UPSTREAM' => undef,
},
{
MAINTAINER => 'avar',
FILES => q[pod/perlreapi.pod],
- CPAN => 0,
'UPSTREAM' => undef,
},
{
'MAINTAINER' => 'mjd',
'FILES' => q[pod/perlreftut.pod],
- 'CPAN' => 0,
'UPSTREAM' => undef,
},
{
'MAINTAINER' => 'elizabeth',
'FILES' => q[pod/perlthrtut.pod],
- 'CPAN' => 0,
'UPSTREAM' => undef,
},
'MAINTAINER' => 'arandal',
'DISTRIBUTION' => 'SBURKE/Pod-Escapes-1.04.tar.gz',
'FILES' => q[cpan/Pod-Escapes],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
'MAP' => { '' => 'cpan/Pod-LaTeX/',
'pod2latex.PL' => 'pod/pod2latex.PL',
},
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
'MAP' => { '' => 'cpan/Pod-Parser/',
'scripts/' => 'pod/',
},
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
'MAP' => { '' => 'dist/Pod-Perldoc/',
'lib/perldoc.pod' => 'pod/perldoc.pod',
},
- 'CPAN' => 1,
'UPSTREAM' => 'blead',
},
- 'Pod::Plainer' =>
- {
- 'DISTRIBUTION' => 'RMBARKER/Pod-Plainer-1.01.tar.gz',
- 'MAINTAINER' => 'rmbarker',
- 'FILES' => q[dist/Pod-Plainer],
- 'CPAN' => 1,
- 'UPSTREAM' => 'blead',
- 'EXCLUDED' => [ qw(t/pod.t t/pod-coverage.t) ],
- 'DEPRECATED' => 5.011,
- },
-
'Pod::Simple' =>
{
'MAINTAINER' => 'arandal',
# have been in blead a long time. I'm going to assume then that
# the blead versions of these two files are authoritative - DAPM
'EXCLUDED' => [ qw( lib/perlpod.pod lib/perlpodspec.pod ) ],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
'podlators' =>
{
'MAINTAINER' => 'rra',
- 'DISTRIBUTION' => 'RRA/podlators-2.2.2.tar.gz',
+ 'DISTRIBUTION' => 'RRA/podlators-2.3.1.tar.gz',
'FILES' => q[cpan/podlators
pod/pod2man.PL
pod/pod2text.PL
'MAP' => { '' => 'cpan/podlators/',
'scripts/' => 'pod/',
},
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
'Safe' =>
{
'MAINTAINER' => 'rgarcia',
- 'DISTRIBUTION' => 'RGARCIA/Safe-2.19.tar.gz',
+ 'DISTRIBUTION' => 'RGARCIA/Safe-2.22.tar.gz',
'FILES' => q[dist/Safe],
- 'CPAN' => 1,
'UPSTREAM' => 'blead',
},
'Scalar-List-Utils' =>
{
'MAINTAINER' => 'gbarr',
- 'DISTRIBUTION' => 'GBARR/Scalar-List-Utils-1.21.tar.gz',
+ 'DISTRIBUTION' => 'GBARR/Scalar-List-Utils-1.23.tar.gz',
# Note that perl uses its own version of Makefile.PL
'FILES' => q[cpan/List-Util],
'EXCLUDED' => [ qr{^inc/Module/},
qr{^inc/Test/},
qw{ mytypemap },
],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
'DISTRIBUTION' => 'SMUELLER/SelfLoader-1.17.tar.gz',
'FILES' => q[dist/SelfLoader],
'EXCLUDED' => [ qw{ t/00pod.t } ],
- 'CPAN' => 1,
'UPSTREAM' => 'blead',
},
'DISTRIBUTION' => 'AMS/Storable-2.21.tar.gz',
'FILES' => q[dist/Storable],
'EXCLUDED' => [ qr{^t/Test/} ],
- 'CPAN' => 1,
- 'UPSTREAM' => 'blead',
- },
-
- 'Switch' =>
- {
- 'MAINTAINER' => 'rgarcia',
- 'DISTRIBUTION' => 'RGARCIA/Switch-2.15.tar.gz',
- 'FILES' => q[dist/Switch],
- 'CPAN' => 1,
'UPSTREAM' => 'blead',
- 'DEPRECATED' => 5.011,
},
'Sys::Syslog' =>
win32/PerlLog.RES
},
],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
'DISTRIBUTION' => 'RRA/ANSIColor-2.02.tar.gz',
'FILES' => q[cpan/Term-ANSIColor],
'EXCLUDED' => [ qr{^tests/}, qw(t/pod-spelling.t t/pod.t) ],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
'MAINTAINER' => 'jstowe',
'DISTRIBUTION' => 'JSTOWE/Term-Cap-1.12.tar.gz',
'FILES' => q[cpan/Term-Cap],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
'MAINTAINER' => 'kane',
'DISTRIBUTION' => 'KANE/Term-UI-0.20.tar.gz',
'FILES' => q[cpan/Term-UI],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
'MAINTAINER' => 'jesse',
'DISTRIBUTION' => 'JESSE/Test-1.25_02.tar.gz',
'FILES' => q[cpan/Test],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
t/lib/if.pm
}
],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
lib/Test/Builder/IO/Scalar.pm
}
],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
'DISTRIBUTION' => 'ADAMK/Text-Balanced-2.02.tar.gz',
'FILES' => q[cpan/Text-Balanced],
'EXCLUDED' => [ qw( t/97_meta.t t/98_pod.t t/99_pmv.t ) ],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
'ParseWords.pm' => 'cpan/Text-ParseWords/lib/Text/ParseWords.pm',
'' => 'cpan/Text-ParseWords/',
},
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
# considerably over the years
'test.pl' => 'cpan/Text-Soundex/t/Soundex.t',
},
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
'DISTRIBUTION' => 'MUIR/modules/Text-Tabs+Wrap-2009.0305.tar.gz',
'FILES' => q[cpan/Text-Tabs],
'EXCLUDED' => [ qw( t/dnsparks.t ) ], # see af6492bf9e
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
t/99_pod.t
t/test.pl
) ],
- 'CPAN' => 1,
'UPSTREAM' => 'blead',
},
t/99_pod.t
t/test.pl
) ],
- 'CPAN' => 1,
'UPSTREAM' => 'blead',
},
'threads' =>
{
'MAINTAINER' => 'jdhedden',
- 'DISTRIBUTION' => 'JDHEDDEN/threads-1.75.tar.gz',
+ 'DISTRIBUTION' => 'JDHEDDEN/threads-1.77.tar.gz',
'FILES' => q[dist/threads],
- 'EXCLUDED' => [ qw(examples/pool.pl
- t/pod.t
+ 'EXCLUDED' => [ qr{^examples/},
+ qw(t/pod.t
t/test.pl
threads.h
) ],
- 'CPAN' => 1,
'UPSTREAM' => 'blead',
},
'threads::shared' =>
{
'MAINTAINER' => 'jdhedden',
- 'DISTRIBUTION' => 'JDHEDDEN/threads-shared-1.32.tar.gz',
+ 'DISTRIBUTION' => 'JDHEDDEN/threads-shared-1.33.tar.gz',
'FILES' => q[dist/threads-shared],
'EXCLUDED' => [ qw(examples/class.pl
shared.h
t/pod.t
t/test.pl
) ],
- 'CPAN' => 1,
'UPSTREAM' => 'blead',
},
'MAINTAINER' => 'mjd',
'DISTRIBUTION' => 'MJD/Tie-File-0.96.tar.gz',
'FILES' => q[cpan/Tie-File],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
'MAINTAINER' => 'nuffin',
'DISTRIBUTION' => 'NUFFIN/Tie-RefHash-1.38.tar.gz',
'FILES' => q[cpan/Tie-RefHash],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
'MAINTAINER' => 'zefram',
'DISTRIBUTION' => 'JHI/Time-HiRes-1.9719.tar.gz',
'FILES' => q[cpan/Time-HiRes],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
'DISTRIBUTION' => 'DROLSKY/Time-Local-1.1901.tar.gz',
'FILES' => q[ext/Time-Local],
'EXCLUDED' => [ qw(t/pod-coverage.t t/pod.t) ],
- 'CPAN' => 1,
'UPSTREAM' => 'blead',
# Currently Time::Local is no longer backwards compatible with Pre-5.11 perls
# the version in core has now deviated from the CPAN version. To re-dual-life
'MAINTAINER' => 'msergeant',
'DISTRIBUTION' => 'MSERGEANT/Time-Piece-1.15.tar.gz',
'FILES' => q[cpan/Time-Piece],
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
'EXCLUDED' => [ qr{X$},
qw{disableXS enableXS }
],
- 'CPAN' => 1,
'UPSTREAM' => 'first-come',
},
'DISTRIBUTION' => 'SADAHIRO/Unicode-Normalize-1.03.tar.gz',
'FILES' => q[cpan/Unicode-Normalize],
'EXCLUDED' => [ qw{MANIFEST.N Normalize.pmN disableXS enableXS }],
- 'CPAN' => 1,
'UPSTREAM' => 'first-come',
},
'MAP' => { 'lib/' => 'lib/',
't/coretests.pm' => 'lib/version.t',
},
- 'CPAN' => 1,
'UPSTREAM' => undef,
},
{
'MAINTAINER' => 'craig',
'FILES' => q[vms configure.com README.vms],
- 'CPAN' => 0,
'UPSTREAM' => undef,
},
{
'MAINTAINER' => 'craig',
'FILES' => q[ext/VMS-DCLsym],
- 'CPAN' => 0,
'UPSTREAM' => undef,
},
{
'MAINTAINER' => 'craig',
'FILES' => q[ext/VMS-Stdio],
- 'CPAN' => 0,
'UPSTREAM' => undef,
},
lib/warnings
t/lib/warnings
],
- 'CPAN' => 0,
'UPSTREAM' => undef,
},
{
'MAINTAINER' => 'jand',
'FILES' => q[win32 t/win32 README.win32 ext/Win32CORE],
- 'CPAN' => 0,
'UPSTREAM' => undef,
},
'MAINTAINER' => 'jand',
'DISTRIBUTION' => "JDB/Win32-0.39.tar.gz",
'FILES' => q[cpan/Win32],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
'EXCLUDED' => [ qr{^ex/},
qw{t/pod.t},
],
- 'CPAN' => 1,
'UPSTREAM' => 'cpan',
},
{
'MAINTAINER' => 'zefram',
'FILES' => q[ext/XS-APItest-KeywordRPN],
- 'CPAN' => 0,
'UPSTREAM' => 'blead',
},
t/portfs.t
XSLoader.pm}, # we use XSLoader_pm.PL
],
- 'CPAN' => 1,
'UPSTREAM' => 'blead',
},
{
'MAINTAINER' => 'laun',
'FILES' => q[x2p/s2p.PL],
- 'CPAN' => 0,
'UPSTREAM' => undef,
},
lib/vars{.pm,.t,_carp.t}
lib/vmsish.{pm,t}
],
- 'CPAN' => 0,
'UPSTREAM' => undef,
},
);
+# legacy CPAN flag
+for (values %Modules) {
+ $_->{CPAN} = !!$_->{DISTRIBUTION};
+}
+
1;
undef,
],
+ # perl511, perl511.dll, perl511.lib, perl511s.lib, libperl511.a
+ [
+ qr{\b ((?:lib)?) perl (\d\d\d) (s?) \b }x,
+ sub {$2, "$1perl$newx$newy$3" },
+ "$oldx$oldy",
+ qr/makedef|win32|hints/, # makedef.pl, README.win32, win32/*, hints/*
+ ],
+
);
my %contents;
for my $file (sort keys %changes) {
open my $fh, '<', $file or die "open '$file': $!\n";
+ binmode $fh;
$contents{$file} = [ <$fh> ];
chomp @{$contents{$file}};
close $fh or die "close: '$file': $!\n";
for my $file (sort keys %contents) {
my $nfile = "$file-new";
open my $fh, '>', $nfile or die "create '$nfile' failed: $!\n";
+ binmode $fh;
print $fh $_, "\n" for @{$contents{$file}};
close $fh or die "failed to close $nfile; aborting: $!\n";
--- /dev/null
+#!perl
+use strict;
+use warnings;
+use Getopt::Long qw/GetOptions/;
+use Term::ANSIColor qw/color/;
+use constant GITCMD => 'git';
+
+sub usage {
+ print <<HERE;
+Usage: $0 [options] [<start-commit> [<end-commit>]]
+
+Scans the commit logs for commits that are potentially, illegitimately
+touching modules that are primarily maintained outside of the perl core.
+Also checks for commits that span multiple distributions in cpan/ or dist/.
+Makes sure that updated CPAN distributions also update Porting/Maintainers.pl,
+but otherwise ignores changes to that file (and MANIFEST).
+
+Skip the <start-commit> to go back indefinitely. <end-commit> defaults to
+HEAD.
+
+ -h/--help shows this help
+ -v/--verbose shows the output of "git show --stat <commit>" for each commit
+ -c/--color uses colored output
+HERE
+ exit(1);
+}
+
+our $Verbose = 0;
+our $Color = 0;
+GetOptions(
+ 'h|help' => \&usage,
+ 'v|verbose' => \$Verbose,
+ 'c|color|colour' => \$Color,
+);
+
+my $start_commit = shift;
+my $end_commit = shift;
+$end_commit = 'HEAD' if not defined $end_commit;
+my $commit_range_cmd = defined($start_commit) ? " $start_commit..$end_commit" : "";
+
+# format: hash\0author\0committer\0short_msg
+our $LogCmd = GITCMD() . q{ log --no-color -M -C --name-only '--pretty=format:%h%x00%an%x00%cn%x00%s'} . $commit_range_cmd;
+our @ColumnSpec = qw(hash author committer commit_msg);
+
+open my $fh, '-|', $LogCmd
+ or die "Can't run '$LogCmd' to get the commit log: $!";
+
+my ($safe_commits, $unsafe_commits) = parse_log($fh);
+
+if (@$unsafe_commits) {
+ my $header = "Potentially unsafe commits:";
+ print color("red") if $Color;
+ print $header, "\n";
+ print("=" x length($header), "\n\n") if $Verbose;
+ print color("reset") if $Color;
+ print_commit_info($_) foreach reverse @$unsafe_commits;
+ print "\n";
+}
+
+if (@$safe_commits) {
+ my $header = "Presumably safe commits:";
+ print color("green") if $Color;
+ print $header, "\n";
+ print("=" x length($header), "\n") if $Verbose;
+ print color("reset") if $Color;
+ print_commit_info($_) foreach reverse @$safe_commits;
+ print "\n";
+}
+
+exit(0);
+
+
+
+# single-line info about the commit at hand
+sub print_commit_info {
+ my $commit = shift;
+
+ my $author_info = "by $commit->{author}"
+ . ($commit->{author} eq $commit->{committer}
+ ? ''
+ : " committed by $commit->{committer}");
+
+ if ($Verbose) {
+ print color("yellow") if $Color;
+ my $header = "$commit->{hash} $author_info: $commit->{msg}";
+ print "$header\n", ("-" x length($header)), "\n";
+ print color("reset") if $Color;
+
+ my $cmd = GITCMD() . ' show --stat ' . ($Color?'--color ':'')
+ . $commit->{hash};
+ print `$cmd`; # make sure git knows this isn't a terminal
+ print "\n";
+ }
+ else {
+ print color("yellow") if $Color;
+ print " $commit->{hash} $author_info: $commit->{msg}\n";
+ print color("reset") if $Color;
+ }
+}
+
+
+# check whether the commit at hand is safe, unsafe or uninteresting
+sub check_commit {
+ my $commit = shift;
+ my $safe = shift;
+ my $unsafe = shift;
+
+ # Note to self: Adding any more greps and such will make this
+ # look even more silly. Just use a single foreach, smart guy!
+ my $touches_maintainers_pl = 0;
+ my @files = grep {
+ $touches_maintainers_pl = 1
+ if $_ eq 'Porting/Maintainers.pl';
+ $_ ne 'MANIFEST' and $_ ne 'Porting/Maintainers.pl'
+ }
+ @{$commit->{files}};
+ my @touching_cpan = grep {/^cpan\//} @files;
+ return if not @touching_cpan;
+
+ # check for unsafe commits to cpan/
+ my %touched_cpan_dirs;
+ $touched_cpan_dirs{$_}++ for grep {defined $_}
+ map {s/^cpan\/([^\/]*).*$/$1/; $_}
+ @touching_cpan;
+
+ my $touches_multiple_cpan_dists = (keys(%touched_cpan_dirs) > 1);
+
+ my $touches_others = @files - @touching_cpan;
+
+ if (@touching_cpan) {
+ if ($touches_others) {
+ $commit->{msg} = 'Touched files under cpan/ and other locations';
+ push @$unsafe, $commit;
+ }
+ elsif ($touches_multiple_cpan_dists) {
+ $commit->{msg} = 'Touched multiple directories under cpan/';
+ push @$unsafe, $commit;
+ }
+ elsif (not $touches_maintainers_pl) {
+ $commit->{msg} = 'Touched files under cpan/, but does not update '
+ . 'Porting/Maintainers.pl';
+ push @$unsafe, $commit;
+ }
+ elsif ($commit->{commit_msg} =~ /(?:up(?:grad|dat)|import)(?:ed?|ing)/i) {
+ $commit->{msg} = 'Touched files under cpan/ with '
+ . '"upgrading"-like commit message';
+ push @$safe, $commit;
+ }
+ else {
+ $commit->{msg} = 'Touched files under cpan/ without '
+ . '"upgrading"-like commit message';
+ push @$unsafe, $commit;
+ }
+ }
+
+ # check for unsafe commits to dist/
+ my @touching_dist = grep {/^dist\//} @files;
+ my %touched_dist_dirs;
+ $touched_dist_dirs{$_}++ for grep {defined $_}
+ map {s/^dist\/([^\/]*).*$/$1/; $_}
+ @touching_dist;
+ $touches_others = @files - @touching_dist;
+ my $touches_multiple_dists = (keys(%touched_dist_dirs) > 1);
+
+ if (@touching_dist) {
+ if ($touches_others) {
+ $commit->{msg} = 'Touched files under dist/ and other locations';
+ push @$unsafe, $commit;
+ }
+ elsif ($touches_multiple_dists) {
+ $commit->{msg} = 'Touched multiple directories under cpan/';
+ push @$unsafe, $commit;
+ }
+ }
+}
+
+# given file handle, parse the git log output and put the resulting commit
+# structure into safe/unsafe compartments
+sub parse_log {
+ my $fh = shift;
+ my @safe_commits;
+ my @unsafe_commits;
+ my $commit;
+ while (defined(my $line = <$fh>)) {
+ chomp $line;
+ if (not $commit) {
+ next if $line =~ /^\s*$/;
+ my @cols = split /\0/, $line;
+ @cols == @ColumnSpec && !grep {!defined($_)} @cols
+ or die "Malformed commit header line: '$line'";
+ $commit = {
+ files => [],
+ map {$ColumnSpec[$_] => $cols[$_]} (0..$#cols)
+ };
+ next;
+ }
+ elsif ($line =~ /^\s*$/) { # within commit, blank line
+ check_commit($commit, \@safe_commits, \@unsafe_commits);
+ $commit = undef;
+ }
+ else { # within commit, non-blank (file) line
+ push @{$commit->{files}}, $line;
+ }
+ }
+
+ return(\@safe_commits, \@unsafe_commits);
+}
+
sub eight_dot_three {
return () if $seen{$_[0]}++;
- my ($dir, $base, $ext) = ($_[0] =~ m{^(?:(.+)/)?([^/.]+)(?:\.([^/.]+))?$});
+ my ($dir, $base, $ext) = ($_[0] =~ m{^(?:(.+)/)?([^/.]*)(?:\.([^/.]+))?$});
my $file = $base . ( defined $ext ? ".$ext" : "" );
$base = substr($base, 0, 8);
$ext = substr($ext, 0, 3) if defined $ext;
if (defined $dir && $dir =~ /\./) {
print "directory name contains '.': $dir\n";
}
+ if ($base eq "") {
+ print "filename starts with dot: $_[0]\n";
+ }
if ($file =~ /[^A-Za-z0-9\._-]/) {
print "filename contains non-portable characters: $_[0]\n";
}
next;
}
while (m!/|\z!g) {
- my ($dir, $edt) = eight_dot_three($`);
+ my ($dir, $edt) = eight_dot_three("$`");
next unless defined $dir;
($dir, $edt) = map { lc } ($dir, $edt);
push @{$dir{$dir}->{$edt}}, $_;
use strict;
use Text::Wrap;
$Text::Wrap::columns = 80;
-my ($committer, $patch, $log,$date);
+my ($committer, $patch, $author, $date);
use Getopt::Long;
my ($rank, $percentage, $cumulative, $reverse, $ta, @authors, %authors,
if (!$result or (($rank||0) + ($ta||0) + (@authors ? 1 : 0) != 1) or !@ARGV) {
die <<"EOS";
-$0 --rank Changelogs # rank authors by patches
-$0 --acknowledged <authors file> Changelogs # Display unacknowledged authors
-$0 --thanks-applied Changelogs # ranks committers
+$0 --rank changes # rank authors by patches
+$0 --acknowledged <authors file> changes # Display unacknowledged authors
+$0 --thanks-applied changes # ranks committers of others' patches
$0 --percentage ... # show rankings as percentages
$0 --cumulative ... # show rankings cumulatively
$0 --reverse ... # show rankings in reverse
Specify stdin as - if needs be. Remember that option names can be abbreviated.
+Generate changes with git log --pretty=fuller rev1..rev2
EOS
}
my @lines = split(/^commit\s*/sm,join('',<>));
for ( @lines) {
- next if m/^$/;
+ next if m/^$/;
next if m/^(\S*?)^Merge:/ism; # skip merge commits
- if (m/^(.*?)^Author:\s*(.*?)^Date:\s*(.*?)^(.*)$/gism) {
+if (m/^(.*?)^Author:\s*(.*?)^AuthorDate:\s*(.*?)^Commit:\s*(.*?)^(.*)$/gism) {
# new patch
- ($patch, $committer, $date,$log) = ($1,$2,$3,$4);
+ ($patch, $author, $date, $committer) = ($1,$2,$3,$4);
+ chomp($author);
+ unless ($author) { die $_}
chomp($committer);
unless ($committer) { die $_}
- &process ($committer, $patch, $log);
+ &process($committer, $patch, $author);
} else { die "XXX $_ did not match";}
}
}
sub process {
- my ($committer, $patch, $log) = @_;
+ my ($committer, $patch, $author) = @_;
+ return unless $author;
return unless $committer;
- my @authors = $log =~ /From:\s+.*?([^"\@ \t\n<>]+\@[^"\@ \t\n<>]+)/gm;
- if (@authors) {
- foreach my $addr (@authors) {
+ $author = _raw_address($author);
+ $patchers{$author}++;
- $patchers{_raw_address($addr)}++;
- }
- # print "$patch: @authors\n";
- $committers{_raw_address($committer)}++;
- } else {
- # print "$patch: $committer\n";
- # Not entirely fair as this means that the maint pumpking scores for
- # everything intergrated that wasn't a third party patch in blead
- $patchers{_raw_address($committer)}++;
+ $committer = _raw_address($committer);
+ if ($committer ne $author) {
+ # separate commit credit only if committing someone else's patch
+ $committers{$committer}++;
}
}
$addr =~ s/^\s*(.*)\s*<\s*(.*?)\s*>.*$/$2/ ;
$real_name = $1;
}
+ $addr =~ s/\[mailto://;
+ $addr =~ s/\]//;
$addr = lc $addr;
$addr = $map{$addr} || $addr;
$addr =~ s/\\100/@/g; # Sometimes, there are encoded @ signs in the git log.
sky sky\100nanisky.com
+ artur\100contiller.se
+ arthur\100contiller.se
-steveh stevehay\100planit.com
+steveh steve.m.hay\100googlemail.com
++ stevehay\100planit.com
+ steve.hay\100uk.radan.com
stevep steve\100fisharerojo.org
+ steve.peters\100gmail.com
+ david\100wheeler.net
dennis\100booking.com dennis\100camel.ams6.corp.booking.com
dev-perl\100pimb.org knew-p5p\100pimb.org
++ lists-p5p\100pimb.org
djberg86\100attbi.com djberg96\100attbi.com
domo\100computer.org shouldbedomo\100mac.com
+ domo\100slipper.ip.lu
jpeacock\100rowman.com john.peacock\100havurah-software.org
+ jpeacock\100havurah-software.org
+ jpeacock\100dsl092-147-156.wdc1.dsl.speakeasy.net
++ jpeacock\100jpeacock-hp.doesntexist.org
jql\100accessone.com jql\100jql.accessone.com
jsm28\100hermes.cam.ac.uk jsm28\100cam.ac.uk
+ ml1050\100freemail.hu
lewart\100uiuc.edu lewart\100vadds.cvm.uiuc.edu
+ d-lewart\100uiuc.edu
+lkundrak\100v3.sk lubo.rintel\100gooddata.com
lstein\100cshl.org lstein\100formaggio.cshl.org
+ lstein\100genome.wi.mit.edu
lupe\100lupe-christoph.de lupe\100alanya.m.isar.de
rmbarker\100cpan.org rmb1\100cise.npl.co.uk
+ robin.barker\100npl.co.uk
+ rmb\100cise.npl.co.uk
++ robin\100spade-ubuntu.(none)
robertmay\100cpan.org rob\100themayfamily.me.uk
roberto\100keltia.freenix.fr roberto\100eurocontrol.fr
robin\100cpan.org robin\100kitsite.com
--- /dev/null
+#!/usr/bin/env perl
+use 5.010;
+use open qw< :encoding(utf8) :std >;
+use autodie;
+use strict;
+use File::Find;
+use Encode::Guess;
+
+# Check if POD files contain non-ASCII without specifying
+# =encoding. Run it as:
+
+## perl Porting/checkpodencoding.pl
+
+find(
+ {
+ wanted => \&finder,
+ no_chdir => 1,
+ },
+ '.'
+);
+
+sub finder {
+ my $file = $_;
+
+ return if -B $file;
+
+ open my $fh, '<', $file;
+
+ #say STDERR "Checking $file";
+
+ next if
+ # Test cases
+ $file ~~ m[Pod-Simple/t];
+
+ my ($in_pod, $has_encoding, @non_ascii);
+
+ FILE: while (my $line = <$fh>) {
+ chomp $line;
+ if ($line ~~ /^=[a-z]+/) {
+ $in_pod = 1;
+ }
+
+ if ($in_pod) {
+ if ($line ~~ /^=encoding (\S+)/) {
+ $has_encoding = 1;
+ last FILE;
+ } elsif ($line ~~ /[^[:ascii:]]/) {
+ my $encoding = guess_encoding($line);
+ push @non_ascii => {
+ num => $.,
+ line => $line,
+ encoding => (ref $encoding ? "$encoding->{Name}?" : 'unknown!'),
+ };
+ }
+ }
+
+ if ($line ~~ /^=cut/) {
+ $in_pod = 0;
+ }
+ }
+
+ if (@non_ascii and not $has_encoding) {
+ say "$file:";
+ $DB::single = 1;
+ for (@non_ascii) {
+ say " $_->{num} ($_->{encoding}): $_->{line}";
+ }
+ }
+}
use Maintainers;
sub usage {
-die <<'EOF';
+die <<"EOF";
usage: $0 [ -d -x ] source_dir1 source_dir2
EOF
}
aphostname=''
api_revision='5'
api_subversion='0'
-api_version='11'
-api_versionstring='5.11.0'
+api_version='13'
+api_versionstring='5.13.0'
ar='ar'
-archlib='/opt/perl/lib/5.11.3/i686-linux-64int'
-archlibexp='/opt/perl/lib/5.11.3/i686-linux-64int'
+archlib='/opt/perl/lib/5.13.0/i686-linux-64int'
+archlibexp='/opt/perl/lib/5.13.0/i686-linux-64int'
archname64='64int'
archname='i686-linux-64int'
archobjs=''
d_pipe='define'
d_poll='define'
d_portable='define'
+d_prctl='define'
+d_prctl_set_name='define'
d_printf_format_null='define'
d_procselfexe='define'
d_pseudofork='undef'
incpath=''
inews=''
initialinstalllocation='/opt/perl/bin'
-installarchlib='/opt/perl/lib/5.11.3/i686-linux-64int'
+installarchlib='/opt/perl/lib/5.13.0/i686-linux-64int'
installbin='/opt/perl/bin'
installhtml1dir=''
installhtml3dir=''
installman3dir='/opt/perl/man/man3'
installprefix='/opt/perl'
installprefixexp='/opt/perl'
-installprivlib='/opt/perl/lib/5.11.3'
+installprivlib='/opt/perl/lib/5.13.0'
installscript='/opt/perl/bin'
-installsitearch='/opt/perl/lib/site_perl/5.11.3/i686-linux-64int'
+installsitearch='/opt/perl/lib/site_perl/5.13.0/i686-linux-64int'
installsitebin='/opt/perl/bin'
installsitehtml1dir=''
installsitehtml3dir=''
-installsitelib='/opt/perl/lib/site_perl/5.11.3'
+installsitelib='/opt/perl/lib/site_perl/5.13.0'
installsiteman1dir='/opt/perl/man/man1'
installsiteman3dir='/opt/perl/man/man3'
installsitescript='/opt/perl/bin'
perl_patchlevel='34948'
perladmin='yourname@yourhost.yourplace.com'
perllibs='-lnsl -ldl -lm -lcrypt -lutil -lc'
-perlpath='/opt/perl/bin/perl5.11.3'
+perlpath='/opt/perl/bin/perl5.13.0'
pg='pg'
phostname=''
pidtype='pid_t'
pr=''
prefix='/opt/perl'
prefixexp='/opt/perl'
-privlib='/opt/perl/lib/5.11.3'
-privlibexp='/opt/perl/lib/5.11.3'
+privlib='/opt/perl/lib/5.13.0'
+privlibexp='/opt/perl/lib/5.13.0'
procselfexe='"/proc/self/exe"'
prototype='define'
ptrsize='4'
sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 6, 17, 29, 31, 0'
sig_size='69'
signal_t='void'
-sitearch='/opt/perl/lib/site_perl/5.11.3/i686-linux-64int'
-sitearchexp='/opt/perl/lib/site_perl/5.11.3/i686-linux-64int'
+sitearch='/opt/perl/lib/site_perl/5.13.0/i686-linux-64int'
+sitearchexp='/opt/perl/lib/site_perl/5.13.0/i686-linux-64int'
sitebin='/opt/perl/bin'
sitebinexp='/opt/perl/bin'
sitehtml1dir=''
sitehtml1direxp=''
sitehtml3dir=''
sitehtml3direxp=''
-sitelib='/opt/perl/lib/site_perl/5.11.3'
+sitelib='/opt/perl/lib/site_perl/5.13.0'
sitelib_stem='/opt/perl/lib/site_perl'
-sitelibexp='/opt/perl/lib/site_perl/5.11.3'
+sitelibexp='/opt/perl/lib/site_perl/5.13.0'
siteman1dir='/opt/perl/man/man1'
siteman1direxp='/opt/perl/man/man1'
siteman3dir='/opt/perl/man/man3'
srandom_r_proto='0'
src='.'
ssizetype='ssize_t'
-startperl='#!/opt/perl/bin/perl5.11.3'
+startperl='#!/opt/perl/bin/perl5.13.0'
startsh='#!/bin/sh'
static_ext=' '
stdchar='char'
strerror_r_proto='0'
strings='/usr/include/string.h'
submit=''
-subversion='3'
+subversion='0'
sysman='/usr/share/man/man1'
tail=''
tar=''
uvtype='unsigned long long'
uvuformat='"Lu"'
uvxformat='"Lx"'
+vaproto='undef'
vendorarch=''
vendorarchexp=''
vendorbin=''
vendorprefixexp=''
vendorscript=''
vendorscriptexp=''
-version='5.11.3'
-version_patchlevel_string='version 11 subversion 3'
+version='5.13.0'
+version_patchlevel_string='version 13 subversion 0'
versiononly='define'
vi=''
voidflags='15'
config_arg8='-Dusedevel'
config_arg9='-dE'
PERL_REVISION=5
-PERL_VERSION=11
-PERL_SUBVERSION=3
+PERL_VERSION=13
+PERL_SUBVERSION=0
PERL_API_REVISION=5
-PERL_API_VERSION=11
+PERL_API_VERSION=13
PERL_API_SUBVERSION=0
PERL_PATCHLEVEL=34948
PERL_CONFIG_SH=true
* This symbol contains the ~name expanded version of ARCHLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define ARCHLIB "/pro/lib/perl5/5.11.3/i686-linux-64int" /**/
-#define ARCHLIB_EXP "/pro/lib/perl5/5.11.3/i686-linux-64int" /**/
+#define ARCHLIB "/pro/lib/perl5/5.13.0/i686-linux-64int" /**/
+#define ARCHLIB_EXP "/pro/lib/perl5/5.13.0/i686-linux-64int" /**/
/* ARCHNAME:
* This symbol holds a string representing the architecture name.
* This symbol contains the ~name expanded version of PRIVLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define PRIVLIB "/pro/lib/perl5/5.11.3" /**/
-#define PRIVLIB_EXP "/pro/lib/perl5/5.11.3" /**/
+#define PRIVLIB "/pro/lib/perl5/5.13.0" /**/
+#define PRIVLIB_EXP "/pro/lib/perl5/5.13.0" /**/
/* CAN_PROTOTYPE:
* If defined, this macro indicates that the C compiler can handle
* This symbol contains the ~name expanded version of SITEARCH, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define SITEARCH "/pro/lib/perl5/site_perl/5.11.3/i686-linux-64int" /**/
-#define SITEARCH_EXP "/pro/lib/perl5/site_perl/5.11.3/i686-linux-64int" /**/
+#define SITEARCH "/pro/lib/perl5/site_perl/5.13.0/i686-linux-64int" /**/
+#define SITEARCH_EXP "/pro/lib/perl5/site_perl/5.13.0/i686-linux-64int" /**/
/* SITELIB:
* This symbol contains the name of the private library for this package.
* removed. The elements in inc_version_list (inc_version_list.U) can
* be tacked onto this variable to generate a list of directories to search.
*/
-#define SITELIB "/pro/lib/perl5/site_perl/5.11.3" /**/
-#define SITELIB_EXP "/pro/lib/perl5/site_perl/5.11.3" /**/
+#define SITELIB "/pro/lib/perl5/site_perl/5.13.0" /**/
+#define SITELIB_EXP "/pro/lib/perl5/site_perl/5.13.0" /**/
#define SITELIB_STEM "/pro/lib/perl5/site_perl" /**/
/* Size_t_size:
* script to make sure (one hopes) that it runs with perl and not
* some shell.
*/
-#define STARTPERL "#!/pro/bin/perl5.11.3" /**/
+#define STARTPERL "#!/pro/bin/perl5.13.0" /**/
/* HAS_STDIO_STREAM_ARRAY:
* This symbol, if defined, tells that there is an array
-r/--reverse Reverses the diff (perl to CPAN).
+-u/--upstream only print modules with the given upstream (defaults to all)
+
-v/--verbose List the fate of *all* files in the tarball, not just those
that differ or are missing.
my $scan_all;
my $diff_opts;
my $reverse = 0;
+ my @wanted_upstreams;
my $cache_dir;
my $use_diff;
my $output_file;
'h|help' => \&usage,
'o|output=s' => \$output_file,
'r|reverse' => \$reverse,
+ 'u|upstream=s@'=> \@wanted_upstreams,
'v|verbose' => \$verbose,
'x|crosscheck' => \$do_crosscheck,
) or usage;
}
else {
do_compare(\@modules, $outfh, $output_file, $cache_dir, $verbose, $use_diff,
- $reverse, $diff_opts);
+ $reverse, $diff_opts, \@wanted_upstreams);
}
}
sub do_compare {
my ($modules, $outfh, $output_file, $cache_dir, $verbose,
- $use_diff, $reverse, $diff_opts) = @_;
+ $use_diff, $reverse, $diff_opts, $wanted_upstreams) = @_;
# first, make sure we have a directory where they can all be untarred,
warn "WARNING: duplicate entry for $dist in $module\n"
}
+ my $upstream = $m->{UPSTREAM} || 'UNKNOWN';
+ next if @$wanted_upstreams and ! ($upstream ~~ $wanted_upstreams);
print $outfh "\n$module - ".$Maintainers::Modules{$module}->{DISTRIBUTION}."\n" unless $use_diff;
print $outfh " upstream is: ".($m->{UPSTREAM} || 'UNKNOWN!')."\n";
--- /dev/null
+use strict;
+use 5.010;
+use lib 'dist/Module-CoreList/lib';
+
+use List::MoreUtils qw(uniq);
+use Module::CoreList;
+use Text::Table;
+
+my $old_ver = "5.010000";
+my $new_ver = "5.011005";
+
+my $old = $Module::CoreList::version{ $old_ver };
+my $new = $Module::CoreList::version{ $new_ver };
+
+my $table = Text::Table->new('perl', \' | ', $old_ver, \' | ', $new_ver);
+
+for my $lib (uniq sort (keys %$old, keys %$new)) {
+ my $old = exists $old->{ $lib } ? $old->{ $lib } // '(undef)' : '(absent)';
+ my $new = exists $new->{ $lib } ? $new->{ $lib } // '(undef)' : '(absent)';
+
+ next if $old eq $new;
+
+ $table->add($lib, $old, $new);
+}
+
+print $table;
my ($old, $new) = @ARGV;
$old ||= $versions[-2];
$new ||= $versions[-1];
-
$deprecated = $Module::CoreList::deprecated{$new};
my (@new,@deprecated,@removed,@pragmas,@modules);
# %Modules defines what is currently in core
for my $k ( keys %Modules ) {
+ warn "Considering $k";
next unless exists $corelist->{$new}{$k};
my $old_ver = $corelist->{$old}{$k};
my $new_ver = $corelist->{$new}{$k};
--- /dev/null
+=head1 NAME
+
+perlepigraphs - list of Perl release epigraphs
+
+=head1 DESCRIPTION
+
+Many Perl release announcements included an I<epigraph>, a short excerpt
+from a literary or other creative work, chosen by the pumpking or
+release manager. This file assembles the known list of epigraph for
+posterity.
+
+I<Note>: these have also been referred to as <epigrams>, but the
+definition of I<epigraph> is closer to the way they have been used.
+Consult your favorite dictionary for details.
+
+=head1 EPIGRAPHS
+
+=head2 v5.13.0 - Jules Verne, "A Journey to the Centre of the Earth"
+
+=over
+
+The heat still remained at quite a supportable degree. With an
+involuntary shudder, I reflected on what the heat must have been
+when the volcano of Sneffels was pouring its smoke, flames, and
+streams of boiling lava -- all of which must have come up by the
+road we were now following. I could imagine the torrents of hot
+seething stone darting on, bubbling up with accompaniments of
+smoke, steam, and sulphurous stench!
+
+"Only to think of the consequences," I mused, "if the old
+volcano were once more to set to work."
+
+=back
+
+=head2 v5.12.1 - Kurt Vonnegut, "Cat's Cradle"
+
+=over
+
+"Now suppose," chortled Dr. Breed, enjoying himself, "that there were
+many possible ways in which water could crystallize, could freeze.
+Suppose that the sort of ice we skate upon and put into highballs—
+what we might call ice-one—is only one of several types of ice.
+Suppose water always froze as ice-one on Earth because it had never
+had a seed to teach it how to form ice-two, ice-three, ice-four
+...? And suppose," he rapped on his desk with his old hand again,
+"that there were one form, which we will call ice-nine—a crystal as
+hard as this desk—with a melting point of, let us say, one-hundred
+degrees Fahrenheit, or, better still, a melting point of one-hundred-
+and-thirty degrees."
+
+=back
+
+=head2 v5.12.1-RC2 - Kurt Vonnegut, "Cat's Cradle"
+
+=over
+
+San Lorenzo was fifty miles long and twenty miles wide, I learned from
+the supplement to the New York Sunday Times. Its population was four
+hundred, fifty thousand souls, "...all fiercely dedicated to the ideals
+of the Free World."
+
+Its highest point, Mount McCabe, was eleven thousand feet above sea
+level. Its capital was Bolivar, "...a strikingly modern city built on a
+harbor capable of sheltering the entire United States Navy." The principal
+exports were sugar, coffee, bananas, indigo, and handcrafted novelties.
+
+=back
+
+=head2 v5.12.1-RC2 - Kurt Vonnegut, "Cat's Cradle"
+
+=over
+
+Which brings me to the Bokononist concept of a wampeter. A wampeter is
+the pivot of a karass. No karass is without a wampeter, Bokonon tells us,
+just as no wheel is without a hub. Anything can be a wampeter: a tree,
+a rock, an animal, an idea, a book, a melody, the Holy Grail. Whatever
+it is, the members of its karass revolve about it in the majestic chaos
+of a spiral nebula. The orbits of the members of a karass about their
+common wampeter are spiritual orbits, naturally. It is souls and not
+bodies that revolve. As Bokonon invites us to sing:
+
+ Around and around and around we spin,
+ With feet of lead and wings of tin . . .
+
+=back
+
+=head2 v5.12.0 - Lewis Carroll, "Alice's Adventures in Wonderland"
+
+=over
+
+'Please would you tell me,' said Alice, a little timidly, for she was
+not quite sure whether it was good manners for her to speak first, 'why
+your cat grins like that?'
+
+'It's a Cheshire cat,' said the Duchess, 'and that's why. Pig!'
+
+She said the last word with such sudden violence that Alice quite
+jumped; but she saw in another moment that it was addressed to the baby,
+and not to her, so she took courage, and went on again:--
+
+'I didn't know that Cheshire cats always grinned; in fact, I didn't know
+that cats COULD grin.'
+
+'They all can,' said the Duchess; 'and most of 'em do.'
+
+=back
+
+=head2 v5.12.0-RC5 - Lewis Carroll, "Alice's Adventures in Wonderland"
+
+=over
+
+'Not QUITE right, I'm afraid,' said Alice, timidly; 'some of the words
+have got altered.'
+
+'It is wrong from beginning to end,' said the Caterpillar decidedly, and
+there was silence for some minutes.
+
+=back
+
+=head2 v5.12.0-RC4 - Lewis Carroll, "Alice's Adventures in Wonderland"
+
+=over
+
+'It was much pleasanter at home,' thought poor Alice, 'when one wasn't
+always growing larger and smaller, and being ordered about by mice and
+rabbits. I almost wish I hadn't gone down that rabbit-hole--and yet--and
+yet--it's rather curious, you know, this sort of life! I do wonder what
+can have happened to me! When I used to read fairy-tales, I fancied that
+kind of thing never happened, and now here I am in the middle of one!
+
+=back
+
+=head2 v5.12.0-RC3 - Lewis Carroll, "Alice's Adventures in Wonderland"
+
+=over
+
+At last the Mouse, who seemed to be a person of authority among them,
+called out, 'Sit down, all of you, and listen to me! I'LL soon make you
+dry enough!' They all sat down at once, in a large ring, with the Mouse
+in the middle. Alice kept her eyes anxiously fixed on it, for she felt
+sure she would catch a bad cold if she did not get dry very soon.
+
+'Ahem!' said the Mouse with an important air, 'are you all ready? This
+is the driest thing I know. Silence all round, if you please! "William
+the Conqueror, whose cause was favoured by the pope, was soon submitted
+to by the English, who wanted leaders, and had been of late much
+accustomed to usurpation and conquest. Edwin and Morcar, the earls of
+Mercia and Northumbria—"'
+
+=back
+
+=head2 v5.12.0-RC2 - no epigraph
+
+=head2 v5.12.0-RC1 - Lewis Carroll, "Alice's Adventures in Wonderland"
+
+=over
+
+So she was considering in her own mind (as well as she could, for the
+hot day made her feel very sleepy and stupid), whether the pleasure of
+making a daisy-chain would be worth the trouble of getting up and
+picking the daisies, when suddenly a White Rabbit with pink eyes ran
+close by her.
+
+There was nothing so VERY remarkable in that; nor did Alice think it so
+VERY much out of the way to hear the Rabbit say to itself, 'Oh dear! Oh
+dear! I shall be late!' (when she thought it over afterwards, it
+occurred to her that she ought to have wondered at this, but at the time
+it all seemed quite natural); but when the Rabbit actually TOOK A WATCH
+OUT OF ITS WAISTCOAT-POCKET, and looked at it, and then hurried on,
+Alice started to her feet, for it flashed across her mind that she had
+never before seen a rabbit with either a waistcoat-pocket, or a watch to
+take out of it, and burning with curiosity, she ran across the field
+after it, and fortunately was just in time to see it pop down a large
+rabbit-hole under the hedge.
+
+In another moment down went Alice after it, never once considering how
+in the world she was to get out again.
+
+=back
+
+=head2 v5.12.0-RC0 - no epigraph
+
+=head2 v5.11.5 - Samuel Taylor Coleridge, "Christabel"
+
+=over
+
+ A little child, a limber elf,
+ Singing, dancing to itself,
+ A fairy thing with red round cheeks,
+ That always finds, and never seeks,
+ Makes such a vision to the sight
+ As fills a father's eyes with light;
+ And pleasures flow in so thick and fast
+ Upon his heart, that he at last
+ Must needs express his love's excess
+ With words of unmeant bitterness.
+ Perhaps 'tis pretty to force together
+ Thoughts so all unlike each other;
+ To mutter and mock a broken charm,
+ To dally with wrong that does no harm.
+ Perhaps 'tis tender too and pretty
+ At each wild word to feel within
+ A sweet recoil of love and pity.
+ And what, if in a world of sin
+ (O sorrow and shame should this be true!)
+ Such giddiness of heart and brain
+ Comes seldom save from rage and pain,
+ So talks as it's most used to do.
+
+=back
+
+=head2 v5.11.4 - Fyodor Dostoevsky, "Crime and Punishment"
+
+=over
+
+And you don't suppose that I went into it headlong like a fool? I went
+into it like a wise man, and that was just my destruction. And you
+mustn't suppose that I didn't know, for instance, that if I began to
+question myself whether I had the right to gain power -- I certainly
+hadn't the right -- or that if I asked myself whether a human being is a
+louse it proved that it wasn't so for me, though it might be for a man
+who would go straight to his goal without asking questions.... If I
+worried myself all those days, wondering whether Napoleon would have
+done it or not, I felt clearly of course that I wasn't Napoleon.
+
+=back
+
+=head2 v5.11.3 - Mark Twain, "The Adventures of Tom Sawyer"
+
+=over
+
+"Say -- I'm going in a swimming, I am. Don't you wish you could? But of
+course you'd druther work—wouldn't you? Course you would!"
+
+Tom contemplated the boy a bit, and said: "What do you call work?"
+
+"Why ain't that work?"
+
+Tom resumed his whitewashing, and answered carelessly: "Well, maybe it
+is, and maybe it aint. All I know, is, it suits Tom Sawyer."
+
+"Oh come, now, you don't mean to let on that you like it?"
+
+The brush continued to move. "Like it? Well I don't see why I oughtn't
+to like it. Does a boy get a chance to whitewash a fence every day?"
+
+That put the thing in a new light. Ben stopped nibbling his apple. Tom
+swept his brush daintily back and forth -- stepped back to note the effect
+-- added a touch here and there-criticised the effect again -- Ben
+watching every move and getting more and more interested, more and more
+absorbed. Presently he said: "Say, Tom, let me whitewash a little."
+
+=back
+
+
+=head2 v5.11.2 - Michael Marshall Smith, "Only Forward"
+
+=over
+
+The streets were pretty quiet, which was nice. They're always quiet here
+at that time: you have to be wearing a black jacket to be out on the
+streets between seven and nine in the evening, and not many people in
+the area have black jackets. It's just one of those things. I currently
+live in Colour Neighbourhood, which is for people who are heavily into
+colour. All the streets and buildings are set for instant colourmatch:
+as you walk down the road they change hue to offset whatever you're
+wearing. When the streets are busy it's kind of intense, and anyone
+prone to epileptic seizures isn't allowed to live in the Neighbourhood,
+however much they're into colour.
+
+=back
+
+=head2 v5.11.1 - Joseph Heller, "Catch-22"
+
+=over
+
+Milo had been caught red-handed in the act of plundering his countrymen,
+and, as a result, his stock had never been higher. He proved good as his
+word when a rawboned major from Minnesota curled his lip in rebellious
+disavowal and demanded his share of the syndicate Milo kept saying
+everybody owned. Milo met the challenge by writing the words "A Share"
+on the nearest scrap of paper and handing it away with a virtuous disdain
+that won the envy and admiration of almost everyone who knew him. His
+glory was at a peak, and Colonel Cathcart, who knew and admired his
+war record, was astonished by the deferential humility with which Mil
+presented himself at Group Headquarters and made his fantastic appeal
+for more hazardous assignment.
+
+=back
+
+=head2 v5.11.0 - Mikhail Bulgakov, "The Master and Margarita"
+
+=over
+
+Whispers of an "evil power" were heard in lines at dairy shops, in
+streetcars, stores, arguments, kitchens, suburban and long-distance
+trains, at stations large and small, in dachas and on beaches. Needless
+to say, truly mature and cultured people did not tell these stories
+about an evil power's visit to the capital. In fact, they even made fun
+of them and tried to talk sense into those who told them. Nevertheless,
+facts are facts, as they say, and cannot simply be dismissed without
+explanation: somebody had visited the capital. The charred cinders of
+Griboyedov alone, and many other things besides, confirmed it. Cultured
+people shared the point of view of the investigating team: it was the
+work of a gang of hypnotists and ventriloquists magnificently skilled in
+their art.
+
+=back
+
+
+=head2 v5.10.1 - Right Hon. James Hacker MP, "The Complete Yes Minister: The Diaries of a Cabinet Minister"
+
+=over
+
+'Briefly, sir, I am the Permanent Under-Secretary of State, known as
+the Permanent Secretary. Woolley here is your Principal Private
+Secretary. I, too, have a Principal Private Secretary, and he is the
+Principal Private Secretary to the Permanent Secretary. Directly
+responsible to me are ten Deputy Secretaries, eighty-seven Under
+Secretaries and two hundred and nineteen Assistant Secretaries.
+Directly responsible to the Principal Private Secretaries are plain
+Private Secretaries. The Prime Minister will be appointing two
+Parliamentary Under-Secretaries and you will be appointing your own
+Parliamentary Private Secretary.'
+
+'Can they all type?' I joked.
+
+'None of us can type, Minister,' replied Sir Humphrey smoothly. 'Mrs
+McKay types - she is your Secretary.'
+
+I couldn't tell whether or not he was joking. 'What a pity,' I said.
+'We could have opened an agency.'
+
+Sir Humphrey and Bernard laughed. 'Very droll, sir,' said Sir
+Humphrey. 'Most amusing, sir,' said Bernard. Were they genuinely
+amused at my wit, or just being rather patronising? 'I suppose they
+all say that, do they?' I ventured.
+
+Sir Humphrey reassured me on that. 'Certainly not, Minister,' he
+replied. 'Not quite all.'
+
+=back
+
+=head2 v5.10.1-RC2 - no epigraph
+
+=head2 v5.10.1-RC1 - no epigraph
+
+=head2 v5.10.0 - Laurence Sterne, "Tristram Shandy"
+
+=over
+
+He would often declare, in speaking his thoughts upon the subject, that
+he did not conceive how the greatest family in England could stand it
+out against an uninterrupted succession of six or seven short
+noses.--And for the contrary reason, he would generally add, That it
+must be one of the greatest problems in civil life, where the same
+number of long and jolly noses, following one another in a direct line,
+did not raise and hoist it up into the best vacancies in the kingdom.
+
+=back
+
+=head2 v5.10.0-RC2 - no epigraph
+
+=head2 v5.10.0-RC1 - no epigraph
+
+=head2 v5.9.5 - no epigraph
+
+=head2 v5.9.4 - no epigraph
+
+=head2 v5.9.3 - no epigraph
+
+=head2 v5.9.2 - Thomas Pynchon, "V"
+
+=over
+
+This word flip was weird. Every recording date of McClintic's he'd
+gotten into the habit of talking electricity with the audio men and
+technicians of the studio. McClintic once couldn't have cared less
+about electricity, but now it seemed if that was helping him reach a
+bigger audience, some digging, some who would never dig, but all
+paying and those royalties keeping the Triumph in gas and McClintic
+in J. Press suits, then McClintic ought to be grateful to
+electricity, ought maybe to learn a little more about it. So he'd
+picked up some here and there, and one day last summer he got around
+to talking stochastic music and digital computers with one
+technician. Out of the conversation had come Set/Reset, which was
+getting to be a signature for the group. He had found out from this
+sound man about a two-triode circuit called a flip-flop, which when
+it turned on could be one of two ways, depending on which tube was
+conducting and which was cut off: set or reset, flip or flop.
+
+"And that," the man said, "can be yes or no, or one or zero. And
+that is what you might call one of the basic units, or specialized
+`cells' in a big `electronic brain.' "
+
+"Crazy," said McClintic, having lost him back there someplace. But
+one thing that did occur to him was if a computer's brain could go
+flip or flop, why so could a musician's. As long as you were flop,
+everything was cool. But where did the trigger-pulse come from to
+make you flip?
+
+=back
+
+=head2 v5.9.1 - Tom Stoppard, "Arcadia"
+
+=over
+
+Aren't you supposed to have a pony?
+
+=back
+
+=head2 v5.9.0 - Doris Lessing, "Martha Quest"
+
+=over
+
+What of October, that ambiguous month
+
+=back
+
+=head2 v5.8.9 - Right Hon. James Hacker MP, "The Complete Yes Minister: The Diaries of a Cabinet Minister"
+
+=over
+
+Frank and I, unlike the civil servants, were still puzzled that such a
+proposal as the Europass could even be seriously under consideration by
+the FCO. We can both see clearly that it is wonderful ammunition for the
+anti-Europeans. I asked Humphrey if the Foreign Office doesn't realise
+how damaging this would be to the European ideal?
+
+'I'm sure they do, Minister, he said. That's why they support it.'
+
+This was even more puzzling, since I'd always been under the impression
+that the FO is pro-Europe. 'Is it or isn't it?' I asked Humphrey.
+
+'Yes and no,' he replied of course, 'if you'll pardon the
+expression. The Foreign Office is pro-Europe because it is really
+anti-Europe. In fact the Civil Service was united in its desire to make
+sure the Common Market didn't work. That's why we went into it.'
+
+This sounded like a riddle to me. I asked him to explain further. And
+basically his argument was as follows: Britain has had the same foreign
+policy objective for at least the last five hundred years - to create a
+disunited Europe. In that cause we have fought with the Dutch against
+the Spanish, with the Germans against the French, with the French and
+Italians against the Germans, and with the French against the Italians
+and Germans. [The Dutch rebellion against Phillip II of Spain, the
+Napoleonic Wars, the First World War, and the Second World War - Ed.]
+
+In other words, divide and rule. And the Foreign Office can see no
+reason to change when it has worked so well until now.
+
+I was aware of this, naturally, but I regarded it as ancient history.
+Humphrey thinks that it is, in fact, current policy. It was necessary
+for us to break up the EEC, he explained, so we had to get inside. We
+had previously tried to break it up from the outside, but that didn't
+work. [A reference to our futile and short-lived involvement in EFTA,
+the European Free Trade Association, founded in 1960 and which the UK
+left in 1972 - Ed.] Now that we're in, we are able to make a complete
+pig's breakfast out of it. We've now set the Germans against the French,
+the French against the Italians, the Italians against the Dutch... and
+the Foreign office is terribly happy. It's just like old time.
+
+I was staggered by all of this. I thought that the all of us who are
+publicly pro-European believed in the European ideal. I said this to Sir
+Humphrey, and he simply chuckled.
+
+So I asked him: if we don't believe in the European Ideal, why are we
+pushing to increase the membership?
+
+'Same reason,' came the reply. 'It's just like the United Nations. The
+more members it has, the more arguments you can stir up, and the more
+futile and impotent it becomes.'
+
+This all strikes me as the most appalling cynicism, and I said so.
+
+Sir Humphrey agreed completely. 'Yes Minister. We call it
+diplomacy. It's what made Britain great, you know.'
+
+=back
+
+=head2 v5.8.9-RC2 - Right Hon. James Hacker MP, "The Complete Yes Minister: The Diaries of a Cabinet Minister"
+
+=over
+
+There was silence in the office. I didn't know what we were going to do
+about the four hundred new people supervising our economy drive or the
+four hundred new people for the Bureaucratic Watchdog Office, or
+anything! I simply sat and waited and hoped that my head would stop
+thumping and that some idea would be suggested by someone sometime soon.
+
+Sir Humphrey obliged. 'Minister... if we were to end the economy drive
+and close the Bureaucratic Watchdog Office we could issue an immediate
+press announcement that you had axed eight hundred jobs.' He had
+obviously thought this out carefully in advance, for at this moment he
+produced a slim folder from under his arm. 'If you'd like to approve
+this draft...'
+
+I couldn't believe the impertinence of the suggestion. Axed eight
+hundred jobs? 'But no one was ever doing these jobs,' I pointed out
+incredulously. 'No one's been appointed yet.'
+
+'Even greater economy,' he replied instantly. 'We've saved eight hundred
+redundancy payments as well.'
+
+'But...' I attempted to explain '... that's just phony. It's dishonest,
+it's juggling with figures, it's pulling the wool over people's eyes.'
+
+'A government press release, in fact.' said Humphrey.
+
+=back
+
+=head2 v5.8.9-RC1 - Right Hon. James Hacker MP, "The Complete Yes Minister: The Diaries of a Cabinet Minister"
+
+=over
+
+A jumbo jet touched down, with BURANDAN AIRWAYS written on the side. I
+was hugely impressed. British Airways are having to pawn their Concordes,
+and here is this little tiny African state with its own airline, jumbo
+jets and all.
+
+I asked Bernard how many planes Burandan Airways had. 'None,' he said.
+
+I told him not to be silly and use his eyes. 'No Minister, it belongs to
+Freddie Laker,' he said. 'They chartered it last week and repainted it
+specially.' Apparently most of the Have-Nots (I mean, LDCs) do this - at
+the opening of the UN General Assembly the runways of Kennedy Airport are
+jam-packed with phoney flag-carriers. 'In fact,' said Bernard with a sly
+grin, 'there was one 747 that belonged to nine different African airlines
+in a month. They called it the mumbo-jumbo.'
+
+While we watched nothing much happening on the TV except the mumbo-jumbo
+taxiing around Prestwick and the Queen looking a bit chilly, Bernard gave
+me the next day's schedule and explained that I was booked on the night
+sleeper from King's Cross to Edinburgh because I had to vote in a
+three-line whip at the House tonight and would have to miss the last
+plane. Then the commentator, in that special hushed BBC voice used for any
+occasion with which Royalty is connected, announced reverentially that we
+were about to catch our first glimpse of President Selim.
+
+And out of the plane stepped Charlie. My old friend Charlie Umtali. We
+were at LSE together. Not Selim Mohammed at all, but Charlie.
+
+Bernard asked me if I were sure. Silly question. How could you forget a
+name like Charlie Umtali?
+
+I sent Bernard for Sir Humphrey, who was delighted to hear that we now
+know something about our official visitor.
+
+Bernard's official brief said nothing. Amazing! Amazing how little the FCO
+has been able to find out. Perhaps they were hoping it would all be on the
+car radio. All the brief says is that Colonel Selim Mohammed had converted
+to Islam some years ago, they didn't know his original name, and therefore
+knew little of his background.
+
+I was able to tell Humphrey and Bernard /all/ about his background.
+Charlie was a red-hot political economist, I informed them. Got the top
+first. Wiped the floor with everyone.
+
+Bernard seemed relieved. 'Well that's all right then.'
+
+'Why?' I enquired.
+
+'I think Bernard means,' said Sir Humphrey helpfully, 'that he'll know how
+to behave if he was at an English University. Even if it was the LSE.' I
+never know whether or not Humphrey is insulting me intentionally.
+
+Humphrey was concerned about Charlie's political colour. 'When you said
+that he was red-hot, were you speaking politically?'
+
+In a way I was. 'The thing about Charlie is that you never quite know
+where you are with him. He's the sort of chap who follows you into a
+revolving door and comes out in front.'
+
+'No deeply held convictions?' asked Sir Humphrey.
+
+'No. The only thing Charlie was committed too was Charlie.'
+
+'Ah, I see. A politician, Minister.'
+
+=back
+
+=head2 v5.8.8 - Joe Raposo, "Bein' Green"
+
+=over
+
+ It's not that easy bein' green
+ Having to spend each day the color of the leaves
+ When I think it could be nicer being red or yellow or gold
+ Or something much more colorful like that
+
+ It's not easy bein' green
+ It seems you blend in with so many other ordinary things
+ And people tend to pass you over 'cause you're
+ Not standing out like flashy sparkles in the water
+ Or stars in the sky
+
+ But green's the color of Spring
+ And green can be cool and friendly-like
+ And green can be big like an ocean
+ Or important like a mountain
+ Or tall like a tree
+
+ When green is all there is to be
+ It could make you wonder why, but why wonder why?
+ Wonder I am green and it'll do fine, it's beautiful
+ And I think it's what I want to be
+
+=back
+
+=head2 v5.8.8-RC1 - Cosgrove Hall Productions, "Dangermouse"
+
+=over
+
+ Greenback: And the world is mine, all mine. Muhahahahaha. See to it!
+
+ Stiletto: Si, Barone. Subito, Barone.
+
+=back
+
+=head2 v5.8.7 - Sergei Prokofiev, "Peter and the Wolf"
+
+=over
+
+And now, imagine the triumphant procession: Peter at the head; after him the
+hunters leading the wolf; and winding up the procession, grandfather and the
+cat.
+
+Grandfather shook his head discontentedly: "Well, and if Peter hadn't caught
+the wolf? What then?"
+
+=back
+
+=head2 v5.8.7-RC1 - Sergei Prokofiev, "Peter and the Wolf"
+
+=over
+
+And now this is how things stood: The cat was sitting on one branch. The
+bird on another, not too close to the cat. And the wolf walked round and
+round the tree, looking at them with greedy eyes.
+
+In the meantime, Peter, without the slightest fear, stood behind the
+gate, watching all that was going on. He ran home,got a strong rope and
+climbed up the high stone wall.
+
+One of the branches of the tree, around which the wolf was walking,
+stretched out over the wall.
+
+Grabbing hold of the branch, Peter lightly climbed over on to the tree.
+Peter said to the bird: "Fly down and circle round the wolf's head, only
+take care that he doesn't catch you!".
+
+The bird almost touched the wolf's head with its wings, while the wolf
+snapped angrily at him from this side and that.
+
+How that bird teased the wolf, how that wolf wanted to catch him! But
+the bird was clever and the wolf simply couldn't do anything about it.
+
+=back
+
+=head2 v5.8.6 - A. A. Milne, "The House at Pooh Corner"
+
+=over
+
+"Hallo, Pooh," said Piglet, giving a jump of surprise. "I knew it was
+you."
+
+"So did I,", said Pooh. "What are you doing?"
+
+"I'm planting a haycorn, Pooh, so that it can grow up into an oak-tree,
+and have lots of haycorns just outside the front door instead of having
+to walk miles and miles, do you see, Pooh?"
+
+"Supposing it doesn't?" said Pooh.
+
+"It will, because Christopher Robin says it will, so that's why I'm
+planting it."
+
+"Well," aid Pooh, "if I plant a honeycomb outside my house, then it will
+grow up into a beehive."
+
+Piglet wasn't quite sure about this.
+
+"Or a /piece/ of a honeycomb," said Pooh, "so as not to waste too much.
+Only then I might only get a piece of a beehive, and it might be the
+wrong piece, where the bees were buzzing and not hunnying. Bother"
+
+Piglet agreed that that would be rather bothering.
+
+"Besides, Pooh, it's a very difficult thing, planting unless you know
+how to do it," he said; and he put the acorn in the hole he had made,
+and covered it up with earth, and jumped on it.
+
+=back
+
+=head2 v5.8.6-RC1 - A. A. Milne, "Winnie the Pooh"
+
+=over
+
+"Hallo!" said Piglet, "whare are /you/ doing?"
+
+"Hunting," said Pooh.
+
+"Hunting what?"
+
+"Tracking something," said Winnie-the-Pooh very mysteriously.
+
+"Tracking what?" said Piglet, coming closer.
+
+"That's just what I ask myself, I ask myself, What?"
+
+"What do you think you'll answer?"
+
+"I shall have to wait until I catch up with it," said Winnie-the-Pooh.
+"Now, look there." He pointed to the ground in front of him. "What do
+you see there?"
+
+"Track," said Piglet. "Paw-marks." He gave a little squeak of
+excitement. "Oh, Pooh!" Do you think it's a--a--a Woozle?"
+
+=back
+
+=head2 v5.8.5 - wikipedia, "Yew"
+
+=over
+
+Yews are relatively slow growing trees, widely used in landscaping and
+ornamental horticulture. They have flat, dark-green needles, reddish
+bark, and bear seeds with red arils, which are eaten by thrushes,
+waxwings and other birds, dispersing the hard seeds undamaged in their
+droppings. Yew wood is reddish brown (with white sapwood), and very
+hard. It was traditionally used to make bows, especially the English
+longbow.
+
+In England, the Common Yew (Taxus baccata, also known as English Yew) is
+often found in churchyards. It is sometimes suggested that these are
+placed there as a symbol of long life or trees of death, and some are
+likely to be over 3,000 years old. It is also suggested that yew trees
+may have a pre-Christian association with old pagan holy sites, and the
+Christian church found it expedient to use and take over existing sites.
+Another explanation is that the poisonous berries and foliage discourage
+farmers and drovers from letting their animals wander into the burial
+grounds. The yew tree is a frequent symbol in the Christian poetry of
+T.S. Eliot, especially his Four Quartets.
+
+=back
+
+=head2 v5.8.5-RC2 - wikipedia, "Beech"
+
+=over
+
+Beeches are trees of the Genus Fagus, family Fagaceae, including about
+ten species in Europe, Asia, and North America. The leaves are entire or
+sparsely toothed. The fruit is a small, sharply-angled nut, borne in
+pairs in spiny husks. The beech most commonly grown as an ornamental or
+shade tree is the European beech (Fagus sylvatica).
+
+The southern beeches belong to a different but related genus,
+Nothofagus. They are found in Australia, New Zealand, New Guinea, New
+Caledonia and South America.
+
+=back
+
+=head2 v5.8.5-RC1 - wikipedia, "Pedunculate Oak" (abridged)
+
+=over
+
+The Pedunculate Oak is called the Common Oak in Britain, and is also
+often called the English Oak in other English speaking countries It is a
+large deciduous tree to 25-35m tall (exceptionally to 40m), with lobed
+and sessile (stalk-less) leaves. Flowering takes place in early to mid
+spring, and their fruit, called "acorns", ripen by autumn of the same
+year. The acorns are pedunculate (having a peduncle or acorn-stalk) and
+may occur singly, or several acorns may occur on a stalk.
+
+It forms a long-lived tree, with a large widespreading head of rugged
+branches. While it may naturally live to an age of a few centuries, many
+of the oldest trees are pollarded or coppiced, both pruning techniques
+that extend the tree's potential lifespan, if not its health.
+
+Within its native range it is valued for its importance to insects and
+other wildlife. Numerous insects live on the leaves, buds, and in the
+acorns. The acorns form a valuable food resource for several small
+mammals and some birds, notably Jays Garrulus glandarius.
+
+It is planted for forestry, and produces a long-lasting and durable
+heartwood, much in demand for interior and furniture work.
+
+=back
+
+=head2 v5.8.4 - T. S. Eliot, "The Old Gumbie Cat"
+
+=over
+
+ I have a Gumbie Cat in mind, her name is Jennyanydots;
+ The curtain-cord she likes to wind, and tie it into sailor-knots.
+ She sits upon the window-sill, or anything that's smooth and flat:
+ She sits and sits and sits and sits -- and that's what makes a Gumbie Cat!
+
+ But when the day's hustle and bustle is done,
+ Then the Gumbie Cat's work is but hardly begun.
+ She thinks that the cockroaches just need employment
+ To prevent them from idle and wanton destroyment.
+ So she's formed, from that a lot of disorderly louts,
+ A troop of well-disciplined helpful boy-scouts,
+ With a purpose in life and a good deed to do--
+ And she's even created a Beetles' Tattoo.
+
+
+ So for Old Gumbie Cats let us now give three cheers --
+ On whom well-ordered households depend, it appears.
+
+=back
+
+
+=head2 v5.8.4-RC2 - T. S. Eliot, "Macavity: The Mystery Cat"
+
+=over
+
+ Macavity's a Mystery Cat: he's called the Hidden Paw --
+ For he's the master criminal who can defy the Law.
+ He's the bafflement of Scotland Yard, the Flying Squad's despair:
+ For when they reach the scene of crime -- /Macavity's not there/!
+
+ Macavity, Macavity, there's no one like Macavity,
+ He's broken every human law, he breaks the law of gravity.
+ His powers of levitation would make a fakir stare,
+ And when you reach the scene of crime -- /Macavity's not there/!
+ You may seek him in the basement, you may look up in the air --
+ But I tell you once and once again, /Macavity's not there/!
+
+=back
+
+=head2 v5.8.4-RC1 - T. S. Eliot, "Skimbleshanks: The Railway Cat"
+
+=over
+
+ There's a whisper down the line at 11.39
+ When the Night Mail's ready to depart,
+ Saying 'Skimble where is Skimble has he gone to hunt the thimble?
+ We must find him of the train can't start.'
+ All the guards and all the porters and the stationmaster's daughters
+ They are searching high and low,
+ Saying 'Skimble where is Skimble for unless he's very nimble
+ Then the Night Mail just can't go'
+ At 11.42 then the signal's overdue
+ And the passengers are frantic to a man--
+ Then Skimble will appear and he'll saunter to the rear:
+ He's been busy in the luggage van!
+ He gives one flash of his glass-green eyes
+ And the the signal goes 'All Clear!'
+ And we're off at last of the northern part
+ Of the Northern Hemisphere!
+
+=back
+
+=head2 v5.8.3 - Arthur William Edgar O'Shaugnessy, "Ode"
+
+=over
+
+ We are the music makers,
+ And we are the dreamers of dreams,
+ Wandering by lonely sea-breakers,
+ And sitting by desolate streams; --
+ World-losers and world-forsakers,
+ On whom the pale moon gleams:
+ Yet we are the movers and shakers
+ Of the world for ever, it seems.
+
+=back
+
+=head2 v5.8.3-RC1 - Irving Berlin, "Let's Face the Music and Dance"
+
+=over
+
+ There may be trouble ahead,
+ But while there's music and moonlight,
+ And love and romance,
+ Let's face the music and dance.
+
+ Before the fiddlers have fled,
+ Before they ask us to pay the bill,
+ And while we still have that chance,
+ Let's face the music and dance.
+
+ Soon, we'll be without the moon,
+ Humming a different tune, and then,
+
+ There may be teardrops to shed,
+ So while there's music and moonlight,
+ And love and romance,
+ Let's face the music and dance.
+
+=back
+
+=head2 v5.8.2 - Walt Whitman, "Passage to India"
+
+=over
+
+ Passage, immediate passage! the blood burns in my veins!
+ Away O soul! hoist instantly the anchor!
+ Cut the hawsers - hall out - shake out every sail!
+ Have we not stood here like trees in the ground long enough?
+ Have we not grovel'd here long enough, eating and drinking like mere brutes?
+ Have we not darken'd and dazed ourselves with books long enough?
+
+
+ Sail forth - steer for the deep waters only,
+ Reckless O soul, exploring, I with the and thou with me,
+ For we are bound where mariner has not yet dared to go,
+ And we will risk the ship, ourselves and all.
+
+ O my brave soul!
+ O farther farther sail!
+ O daring job, but safe! are they not all the seas of God?
+ O farther, farther, farther sail!
+
+=back
+
+=head2 v5.8.2-RC2 - Eric Idle/John Du Prez, "Accountancy Shanty"
+
+=over
+
+ It's fun to charter an accountant
+ And sail the wide accountan-cy,
+ To find, explore the funds offshore
+ And skirt the shoals of bankruptcy.
+
+=back
+
+=head2 v5.8.2-RC1 - Edward Lear, "The Jumblies"
+
+=over
+
+ They went to sea in a Sieve, they did,
+ In a Sieve they went to sea:
+ In spite of all their friends could say,
+ On a winter's morn, on a stormy day,
+ In a Sieve they went to sea!
+ And when the Sieve turned round and round,
+ And everyone cried, "You'll all be drowned!"
+ They cried aloud, "Our Sieve ain't big,
+ But we don't care a button, we don't care a fig!
+ In a Sieve we'll go to sea!"
+
+ Far and few, far and few,
+ Are the lands where the Jumblies live;
+ Their heads are green, and their hands are blue,
+ And they went to sea in a Sieve.
+
+=back
+
+=head2 v5.8.1 - Terry Pratchett, "The Color of Magic"
+
+=over
+
+"What happens next?" asked Twoflower.
+
+Hrun screwed a finger in his ear and inspected it absently.
+
+"Oh,", he said, "I expect in a minute the door will be
+flung back and I'll be dragged off to some sort of temple
+arena where I'll fight maybe a couple of giant spiders
+and an eight-foot slave from the jungles of Klatch and then
+I'll rescue some kind of a princess from the altar and then
+I'll kill off a few guards or whatever and then this girl
+will show me the secret passage out of the place and we'll
+liberate a couple of horses and escape with the treasure."
+Hrun leaned his head back on his hands and looked at the
+ceiling, whistling tunelessly.
+
+"All that?" said Twoflower.
+
+"Usually."
+
+=back
+
+=head2 v5.8.1-RC5 - Terry Pratchett, "Lords and Ladies"
+
+=over
+
+No matter what she did with her hair it took about
+three minutes for it to tangle itself up again,
+like a garden hosepipe in a shed [Footnote: Which,
+no matter how carefully coiled, will always uncoil
+overnight and tie the lawnmower to the bicycles].
+
+=back
+
+=head2 v5.6.2 - Sterne, "Tristram Shandy"
+
+=over
+
+When great or unexpected events fall out upon the stage of this
+sublunary word--the mind of man, which is an inquisitive kind of
+a substance, naturally takes a flight, behind the scenes, to see
+what is the cause and first spring of them--The search was not
+long in this instance.
+
+=back
+
+=head2 v5.6.2-RC1 - Sterne, "Tristram Shandy"
+
+=over
+
+"Pray, my dear", quoth my mother, "have you not forgot to wind up the clock?"
+
+=back
+
+=head2 5.005_05-RC1 - no epigraph
+
+=head2 5.005_04 - no epigraph
+
+=head2 5.005_04-RC2 - Rudyard Kipling, "The Jungle Book"
+
+=over
+
+The monkeys called the place their city, and pretended to despise
+the Jungle-People because they lived in the forest. And yet they
+never knew what the buildings were made for nor how to use
+them. They would sit in circles on the hall of the king's council
+chamber, and scratch for fleas and pretend to be men; or they would
+run in and out of the roofless houses and collect pieces of plaster
+and old bricks in a corner, and forget where they had hidden them,
+and fight and cry in scuffling crowds, and then break off to play up
+and down the terraces of the king's garden, where they would shake
+the rose trees and the oranges in sport to see the fruit and flowers
+fall.
+
+=back
+
+=head2 5.005_04-RC1 - Lewis Carroll, "Alice's Adventures in Wonderland"
+
+=over
+
+Either the well was very deep, or she fell very slowly, for she had
+plenty of time as she went down to look about her and to wonder what was
+going to happen next. First, she tried to look down and make out what
+she was coming to, but it was too dark to see anything; then she looked
+at the sides of the well, and noticed that they were filled with
+cupboards and book-shelves; here and there she saw maps and pictures
+hung upon pegs. She took down a jar from one of the shelves as she
+passed; it was labelled 'ORANGE MARMALADE', but to her great
+disappointment it was empty: she did not like to drop the jar for fear
+of killing somebody, so managed to put it into one of the cupboards as
+she fell past it.
+
+=back
+
+=head1 ACKNOWLEDGEMENTS
+
+This document was originally compiled based on a list of epigraphs
+on L<Perl Monks|http://perlmonks.org> titled
+L<Recent Perl Release Announcement|http://perlmonks.org/?node_id=372406>
+by ysth.
+
+=cut
+# vim:tw=72:
You can find the list of committers and authors by:
- % git log v5.11.1..HEAD | perl -nlwe '$seen{$1}++ if /^Author: ([^<]*)/; END { print for sort keys %seen }'
+ % git log --pretty='format:%an' v5.11.1..HEAD | sort | uniq
And how many files where changed by:
- % git diff v5.11.1..HEAD | diffstat
+ % git diff --stat=200,200 v5.11.1..HEAD
=item Reporting Bugs
use Maintainers qw(%Modules get_module_files get_module_pat);
my @CPAN = grep { $Modules{$_}{CPAN} } keys %Modules;
-my @files = map { get_module_files($_) } @CPAN;
-my @dirs = ('cpan', grep { -d $_ && $_ !~ /^cpan/ } map { get_module_pat($_) } @CPAN);
+my @files = ('lib/unicore/mktables', 'TestInit.pm',
+ 'Porting/Maintainers.pm', 'Porting/perldelta_template.pod',
+ map { get_module_files($_) } @CPAN);
+my @dirs = ('cpan', 'win32', grep { -d $_ && $_ !~ /^cpan/ } map { get_module_pat($_) } @CPAN);
my %dirs;
@dirs{@dirs} = ();
homepage: http://www.perl.org/
bugtracker: http://rt.perl.org/perlbug/
license: http://dev.perl.org/licenses/
+ repository: http://perl5.git.perl.org/
distribution_type: core
generated_by: $0
no_index:
# A tool to build a perl release tarball
# Very basic but functional - if you're on a unix system.
#
+# If you're on Win32 then it should still work, but various Unix command-line
+# tools will need to be available somewhere. An obvious choice is to install
+# Cygwin and ensure its 'bin' folder is on the PATH in the shell where you run
+# this script. The Cygwin 'bin' folder needs to precede the Windows 'system32'
+# folder so that Cygwin's 'find' command is found in preference to the Windows
+# 'find' command. Your Cygwin installation will need to contain at least the
+# 'cpio' command, in addition to the commands installed by default, and it will
+# also be useful to have 'curl' and 'diffstat' installed too for later stages
+# of the release process (namely, Porting\corelist.pl and generating the commit
+# statistics for the perlXYZdelta.pod file respectively). Finally, ensure that
+# the 'awk' and 'shasum' commands are copies of gawk.exe and sha1sum.exe
+# respectively, rather the links to them that only work in a Cygwin bash shell
+# which they are by default.
+#
# No matter how automated this gets, you'll always need to read
# and re-read pumpkin.pod and release_managers_guide.pod to
# check for things to be done at various stages of the process.
$|=1;
sub usage { die <<EOF; }
-usage: $0 [ -r rootdir ] [-s suffix ] [ -b ]
+usage: $0 [ -r rootdir ] [-s suffix ] [ -b ] [ -n ]
-r rootdir directory under which to create the build dir and tarball
defaults to '..'
-s suffix suffix to append to to the perl-x.y.z dir and tarball name
defaults to the concatenaion of the local_patches entry
in patchlevel.h (or blank, if none)
-b make a .bz2 file in addtion to a .gz file
+ -n do not make any tarballs, just the directory
EOF
my %opts;
-getopts('br:s:', \%opts) or usage;
+getopts('bnr:s:', \%opts) or usage;
@ARGV && usage;
$relroot = defined $opts{r} ? $opts{r} : "..";
chdir ".." or die $!;
+exit if $opts{n};
+
my $src = (-e $perl) ? $perl : 'perl'; # 'perl' in maint branch
print "Creating and compressing the tar.gz file...\n";
system("ls -ld $perl*");
print "\n";
+my $null = $^O eq 'MSWin32' ? 'NUL' : '/dev/null';
for my $sha (qw(sha1 shasum sha1sum)) {
- if (`which $sha 2>/dev/null`) {
+ if (`which $sha 2>$null`) {
system("$sha $perl*.tar.*");
last;
}
+=encoding utf8
+
=head1 NAME
[ this is a template for a new perldelta file. Any text flagged as
the 5.XXX.XXX release.
If you are upgrading from an earlier release such as 5.XXX.XXX, first read
-the L<perl5XXXdelta>, which describes differences between 5.XXX.XXX and
-5.10.0
+L<perl5XXXdelta>, which describes differences between 5.XXX.XXX and
+5.XXX.XXX.
=head1 Notice
+=encoding utf8
+
=head1 NAME
release_managers_guide - Releasing a new version of perl 5.x
https://pause.perl.org/pause/query?ACTION=request_id
Check that your account is allowed to upload perl distros: goto
-https://pause.perl.org/, login, then select 'upload file to CPAN'; there
+L<https://pause.perl.org/>, login, then select 'upload file to CPAN'; there
should be a "For pumpkings only: Send a CC" tickbox. If not, ask Andreas
König to add your ID to the list of people allowed to upload something
called perl. You can find Andreas' email address at:
Get perldelta in a mostly finished state.
-Peruse F<Porting/how_to_write_a_perldelta.pod>, and try to make sure that
+Read F<Porting/how_to_write_a_perldelta.pod>, and try to make sure that
every section it lists is, if necessary, populated and complete. Copy
edit the whole document.
rename perl-5^.10^.1.dir perl-5_10_1.dir
-Have a look a couple lines up from that. You'll see roman numerals.
-Update those too. Find someone with VMS clue if you have to update
-the Roman numerals for a .0 release.
-
Commit your changes:
$ git st
- $ git diff
- B<review the delta carefully>
+ $ git diff
+ B<review the delta carefully>
$ git commit -a -m 'Bump the perl version in various places for 5.x.y'
+When the version number is bumped, you should also update Module::CoreList (as
+described below in L<"Building a release - on the day">) to reflect the new
+version number.
+
=item *
I<You MUST SKIP this step for SNAPSHOT>
I<You MAY SKIP this step for SNAPSHOT>
+L<perlport> has a section currently named I<Supported Platforms> that
+indicates which platforms are known to build in the current release.
+If necessary update the list and the indicated version number.
+
+=item *
+
+I<You MAY SKIP this step for SNAPSHOT>
+
Update F<AUTHORS>, using the C<Porting/checkAUTHORS.pl> script, and if
necessary, update the script to include new alias mappings for porters
already in F<AUTHORS>
- $ git log | perl Porting/checkAUTHORS.pl --acknowledged AUTHORS -
+ $ git log --pretty=fuller | perl Porting/checkAUTHORS.pl --acknowledged AUTHORS -
=back
F<corelist.pl> uses ftp.funet.fi to verify information about dual-lived
modules on CPAN. It can use a full, local CPAN mirror or fall back
-to C<wget> or C<curl> to fetch only package metadata remotely.
+to C<wget> or C<curl> to fetch only package metadata remotely. (If you're
+on Win32, then installing Cygwin is one way to have commands like C<wget>
+and C<curl> available.)
(If you'd prefer to have a full CPAN mirror, see
http://www.cpan.org/misc/cpan-faq.html#How_mirror_CPAN)
$ make perl
-If this not the first update for this version, first edit
+If this not the first update for this version (e.g. if it was updated
+when the version number was originally bumped), first edit
F<dist/Module-CoreList/lib/Module/CoreList.pm> to delete the existing
entries for this version from the C<%released> and C<%version> hashes:
they will have a key like C<5.010001> for 5.10.1.
Edit the version number in the new C<< 'Module::CoreList' => 'X.YZ' >>
entry, as that is likely to reflect the previous version number.
+Also edit Module::CoreList's new version number in its F<Changes> file and
+in its F<META.yml> file.
+
In addition, if this is a final release (rather than a release candidate):
=over 4
I<You MUST SKIP this step for SNAPSHOT>
-Tag the release:
+Tag the release (e.g.):
$ git tag v5.11.0 -m'First release of the v5.11 series!'
+(Adjust the syntax appropriately if you're working on Win32, i.e. use
+C<-m "..."> rather than C<-m'...'>.)
+
It is VERY important that from this point forward, you not push
your git changes to the Perl master repository. If anything goes
wrong before you publish your newly-created tag, you can delete
$ bin/perl -MCPAN -e'shell'
+(Use C<... -e "shell"> instead on Win32. You probably also need a set of
+Unix command-line tools available for CPAN to function correctly without
+Perl alternatives like LWP installed. Cygwin is an obvious choice.)
+
=item *
Try installing a popular CPAN module that's reasonably complex and that
42
$
+(Use C<... -lwe "use ..."> instead on Win32.)
+
=item *
Bootstrap the CPANPLUS client on the clean install:
$ bin/cpanp
+(Again, on Win32 you'll need something like Cygwin installed, but make sure
+that you don't end up with its various F<bin/cpan*> programs being found on
+the PATH before those of the Perl that you're trying to test.)
+
=item *
Install an XS module, for example:
(Login, then select 'Upload a file to CPAN')
+If your workstation is not connected to a high-bandwidth,
+high-reliability connection to the Internet, you should probably use the
+"GET URL" feature (rather than "HTTP UPLOAD") to have PAUSE retrieve the
+new release from wherever you put it for testers to find it. This will
+eliminate anxious gnashing of teeth while you wait to see if your
+15 megabyte HTTP upload successfully completes across your slow, twitchy
+cable modem. You can make use of your home directory on dromedary for
+this purpose: F<http://users.perl5.git.perl.org/~USERNAME> maps to
+F</home/USERNAME/public_html>, where F<USERNAME> is your login account
+on dromedary. I<Remember>: if your upload is partially successful, you
+may need to contact a PAUSE administrator or even bump the version of perl.
+
Upload both the .gz and .bz2 versions of the tarball.
+Wait until you receive notification emails from the PAUSE indexer
+confirming that your uploads have been successfully indexed. Do not
+proceed any further until you are sure that the indexing of your uploads
+has been successful.
+
=item *
Now that you've shipped the new perl release to PAUSE, it's
-time to publish the tag you created earlier to the public git repo:
+time to publish the tag you created earlier to the public git repo (e.g.):
$ git push origin tag v5.11.0
=item *
+Add your quote to F<Porting/epigraphs.pod> and commit it.
+
+=item *
+
Wait 24 hours or so, then post the announcement to use.perl.org.
(if you don't have access rights to post news, ask someone like Rafael to
do it for you.)
=item *
-Ask Jarkko to add the tarball to http://www.cpan.org/src/
+Check http://www.cpan.org/src/ to see if the new tarballs have appeared.
+They should appear automatically, but if they don't then ask Jarkko to look
+into it, since his scripts must have broken.
=item *
I<You MUST SKIP this step for RC>
-Bump the perlXYZ version number.
+Bump the perlXYZdelta version number.
First, create a new empty perlNNNdelta.pod file for the current release + 1;
see F<Porting/how_to_write_a_perldelta.pod>.
I<You MUST SKIP this step for RC, BLEAD>
-If this was a major release (5.x.0), then create a new maint branch
-based on the commit tagged as the current release and bump the version
-in the blead branch in git, e.g. 5.12.0 to 5.13.0.
+If this was the first release of a new maint series, (5.x.0 where x is
+even), then create a new maint branch based on the commit tagged as
+the current release and bump the version in the blead branch in git,
+e.g. 5.12.0 to 5.13.0.
[ XXX probably lots more stuff to do, including perldelta,
C<lib/feature.pm> ]
-XXX need a git recipe
+Assuming you're using git 1.7.x or newer:
+
+ $ git checkout -b maint-5.12
+ $ git push origin -u maint-5.12
=item *
=item *
+If necessary, send an email to C<perlbug-admin at perl.org> requesting
+that new version numbers be added to the RT fields C<Perl Version> and
+C<Fixed In>.
+
+=item *
+
I<You MUST RETIRE to your preferred PUB, CAFE or SEASIDE VILLA for some
much-needed rest and relaxation>.
+=encoding utf8
+
=head1 Release schedule
This document lists the release engineers for at least the next
=head2 2009
- October 2 - 5.11.0 - Jesse Vincent
- October 20 - 5.11.1 - Jesse Vincent
- November 20 - 5.11.2 - Leon Brocard
- December 20 - 5.11.3 - Jesse Vincent or minion
+ October 2 - Jesse Vincent
+ October 20 - Jesse Vincent
+ November 20 - Leon Brocard
+ December 20 - Jesse Vincent
=head2 2010
- January 20 - 5.11.4 - Ricardo Signes
- February 20 - 5.11.5 - Steve Hay
- March 20 - 5.11.6 - Ask Bjørn Hansen
+ January 20 - Ricardo Signes
+ February 20 - Steve Hay
+ March 20 - Ask Bjørn Hansen
+ April 20 - Leon Brocard
+ May 20 - Ricardo Signes
+ June 20 - Matt Trout
+ July 20 - David Golden
+ August 20 - Florian Ragwitz
+ September 20 - Steve Hay
+ October 20 - Tatsuhiko Miyagawa
+ November 20 - Chris Williams
=head1 VICTIMS
Leon Brocard <F<acme@astray.com>>
Yves Orton <F<demerphq@gmail.com>>
Ricardo Signes <F<rjbs@manxome.org>>
-Steve Hay <F<stevehay@planit.com>>
+Steve Hay <F<steve.m.hay@googlemail.com>>
Ask Bjørn Hansen <F<ask@perl.org>>
-
+David Golden <F<dagolden@cpan.org>>
+Philippe Bruhat <F<book@cpan.org>>
+Matt Trout <F<mst@shadowcat.co.uk>>
+Florian Ragwitz <F<rafl@debian.org>>
+Tatsuhiko Miyagawa <F<miyagawa@bulknews.net>>
+Chris Williams <F<bingos@cpan.org>>
=head2 Reticent victims
These folks have said that they'd be willing to release Perl but would
prefer that others have the opportunity before they pitch in:
-David Golden <F<xdave@gmail.com>>
=head1 AUTHOR
-Perl is Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
-2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 by Larry Wall and others.
-All rights reserved.
+Perl is Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
+2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 by Larry Wall
+and others. All rights reserved.
For an introduction to the language's features, see pod/perlintro.pod.
For a discussion of the important changes in this release, see
-pod/perl5113delta.pod. (This will also be installed as perldelta.pod).
+pod/perl5131delta.pod. (This will also be installed as perldelta.pod).
There are also many Perl books available, covering a wide variety of topics,
from various publishers. See pod/perlbook.pod for more information.
=head1 NAME
-README.aix - Perl version 5 on IBM Unix (AIX) systems
+README.aix - Perl version 5 on IBM AIX (UNIX) systems
=head1 DESCRIPTION
-This document describes various features of IBM's Unix operating
-system (AIX) that will affect how Perl version 5 (hereafter just Perl)
+This document describes various features of IBM's UNIX operating
+system AIX that will affect how Perl version 5 (hereafter just Perl)
is compiled and/or runs.
=head2 Compiling Perl 5 on AIX
-For information on compilers on older versions of AIX, see L<Compiling
+For information on compilers on older versions of AIX, see L<Compiling
Perl 5 on older AIX versions up to 4.3.3>.
When compiling Perl, you must use an ANSI C compiler. AIX does not ship
-an ANSI compliant C-compiler with AIX by default, but binary builds of
-gcc for AIX are widely available.
+an ANSI compliant C compiler with AIX by default, but binary builds of
+gcc for AIX are widely available. A version of gcc is also included in
+the AIX Toolbox which is shipped with AIX.
=head2 Supported Compilers
This will not build a threaded Perl, but a thread-enabled Perl. See
also L<Threaded Perl> later on.
-As of writing (2009-08) only the IBM XL C for AIX or XL C/C++ for AIX
-compiler is supported by IBM on AIX 5L/6.1.
+As of writing (2010-05) only the I<IBM XL C for AIX> or I<IBM XL C/C++
+for AIX> compiler is supported by IBM on AIX 5L/6.1.
-The following compiler versions are supported by IBM:
+The following compiler versions are currently supported by IBM:
-XL C and XL C/C++ V7, V8, V9, V10
+ IBM XL C and IBM XL C/C++ V8, V9, V10
-The XL C for AIX is integrated in the XL C/C++ for AIX compiler.
+The XL C for AIX is integrated in the XL C/C++ for AIX compiler and
+therefore also supported.
If you choose XL C/C++ V9 you need APAR IZ35785 installed
otherwise the integrated SDBM_File do not compile correctly due
The PTF for APAR IZ35785 which solves this problem is available
from IBM (April 2009 PTF for XL C/C++ Enterprise Edition for AIX, V9.0).
+If you choose XL C/C++ V11 you need the April 2010 PTF installed
+otherwise you will not get a working Perl version.
+
Perl can be compiled with either IBM's ANSI C compiler or with gcc.
The former is recommended, as not only it can compile Perl with no
difficulty, but also can take advantage of features listed later
=head2 Incompatibility with AIX Toolbox lib gdbm
-If the AIX Toolbox version of lib gdbm 1.8.x is installed on the
-system then Perl will not work. This library contains a defect version
-of the dbm_store() function. The lib gdbm will be automatically removed
-from the wanted libraries.
-
-=head2 Perl 5.10 was successfully compiled and tested on:
-
- AIX Level | Compiler Level | w th | w/o th
- --------------------------+-------------------------+------+-------
- 5.1 TL9 32 bit | XL C/C++ V7 | OK | OK
- 5.1 TL9 32 bit | gcc 3.2.2 | OK | OK
- 5.1 TL9 64 bit | XL C/C++ V7 | OK | OK
- 5.2 TL10 32 bit | XL C/C++ V8 | OK | OK
- 5.2 TL8 64 bit | VA C/C++ V6 | OK | OK
- 5.2 TL10 64 bit | XL C/C++ V8 | OK | OK
- 5.3 TL7 32 bit | XL C/C++ V9 + IZ35785 | OK | OK
- 5.3 TL7 32 bit | gcc 4.2.4 | OK | OK
- 5.3 TL7 64 bit | XL C/C++ V9 + IZ35785 | OK | OK
- 6.1 TL1 32 bit | XL C/C++ V10 | OK | OK
- 6.1 TL1 64 bit + IZ39077 | XL C/C++ V10 | OK | OK
-
- w th = with thread
- w/o th = without thread
+If the AIX Toolbox version of lib gdbm < 1.8.3-5 is installed on your
+system then Perl will not work. This library contains the header files
+/opt/freeware/include/gdbm/dbm.h|ndbm.h which conflict with the AIX
+system versions. The lib gdbm will be automatically removed from the
+wanted libraries if the presence of one of these two header files is
+detected. If you want to build Perl with GDBM support then please install
+at least gdbm-devel-1.8.3-5 (or higher).
+
+=head2 Perl 5.12 was successfully compiled and tested on:
+
+ AIX Level | Compiler Level | w th | w/o th
+ ---------------------+---------------------------+------+-------
+ 5.1 TL9 32 bit | XL C/C++ V7 | OK | OK
+ 5.1 TL9 64 bit | XL C/C++ V7 | OK | OK
+ 5.2 TL10 SP8 32 bit | XL C/C++ V8 | OK | OK
+ 5.2 TL10 SP8 32 bit | gcc 3.2.2 | OK | OK
+ 5.2 TL10 SP8 64 bit | XL C/C++ V8 | OK | OK
+ 5.3 TL8 SP8 32 bit | XL C/C++ V9 + IZ35785 | OK | OK
+ 5.3 TL8 SP8 32 bit | gcc 4.2.4 | OK | OK
+ 5.3 TL8 SP8 64 bit | XL C/C++ V9 + IZ35785 | OK | OK
+ 5.3 TL10 SP3 32 bit | XL C/C++ V11 + April 2010 | OK | OK
+ 5.3 TL10 SP3 64 bit | XL C/C++ V11 + April 2010 | OK | OK
+ 6.1 TL1 SP7 32 bit | XL C/C++ V10 | OK | OK
+ 6.1 TL1 SP7 64 bit | XL C/C++ V10 | OK | OK
+
+ w th = with thread support
+ w/o th = without thread support
OK = tested
-Successfully tested means that all "make test" runs finish with an
+Successfully tested means that all "make test" runs finish with a
result of 100% OK. All tests were conducted with -Duseshrplib set.
+All tests were conducted on the oldest supported AIX technology level
+with the latest support package applied. If the tested AIX version is
+out of support (AIX 4.3.3, 5.1, 5.2) then the last available support
+level was used.
+
=head2 Building Dynamic Extensions on AIX
-Starting from Perl 5.7.2 (and consequently 5.8.x / 5.10.x) and AIX 4.3
-or newer Perl uses the AIX native dynamic loading interface in the so
-called runtime linking mode instead of the emulated interface that was
-used in Perl releases 5.6.1 and earlier or, for AIX releases 4.2 and
-earlier. This change does break backward compatibility with compiled
-modules from earlier Perl releases. The change was made to make Perl
-more compliant with other applications like Apache/mod_perl which are
-using the AIX native interface. This change also enables the use of
-C++ code with static constructors and destructors in Perl extensions,
+Starting from Perl 5.7.2 (and consequently 5.8.x / 5.10.x / 5.12.x)
+and AIX 4.3 or newer Perl uses the AIX native dynamic loading interface
+in the so called runtime linking mode instead of the emulated interface
+that was used in Perl releases 5.6.1 and earlier or, for AIX releases
+4.2 and earlier. This change does break backward compatibility with
+compiled modules from earlier Perl releases. The change was made to make
+Perl more compliant with other applications like Apache/mod_perl which are
+using the AIX native interface. This change also enables the use of
+C++ code with static constructors and destructors in Perl extensions,
which was not possible using the emulated interface.
It is highly recommended to use the new interface.
Should yield no problems with AIX 5.1 / 5.2 / 5.3 and 6.1.
IBM uses the AIX system Perl (V5.6.0 on AIX 5.1 and V5.8.2 on
-AIX 5.2 / 5.3 and 6.1) for some AIX
-system scripts. If you switch the links in /usr/bin from the
+AIX 5.2 / 5.3 and 6.1; V5.8.8 on AIX 5.3 TL11 and AIX 6.1 TL4) for
+some AIX system scripts. If you switch the links in /usr/bin from the
AIX system Perl (/usr/opt/perl5) to the newly build Perl then you
-get the same features as with the IBM AIX system Perl if the
-threaded options are used.
+get the same features as with the IBM AIX system Perl if the threaded
+options are used.
The threaded Perl build works also on AIX 5.1 but the IBM Perl
build (Perl v5.6.0) is not threaded on AIX 5.1.
+Perl 5.12 is not compatible with the IBM fileset perl.libext.
+
=head2 64-bit Perl
If your AIX system is installed with 64-bit support, you can expect 64-bit
configurations to work. If you want to use 64-bit Perl on AIX 6.1
-you need a APAR for a libc.a bug which affects (n)dbm_XXX functions.
+you need an APAR for a libc.a bug which affects (n)dbm_XXX functions.
The APAR number for this problem is IZ39077.
If you need more memory (larger data segment) for your Perl programs you
data = -1 (default is 262144 * 512 byte)
With the default setting the size is limited to 128MB.
-The -1 removes this limit. If the "make test" fails please change
+The -1 removes this limit. If the "make test" fails please change
your /etc/security/limits as stated above.
=head2 Recommended Options AIX 5.1/5.2/5.3 and 6.1 (threaded/32-bit)
=head2 Recommended Options AIX 5.1/5.2/5.3 and 6.1(64-bit)
-With the following options you get a Perl version which passes all
+With the following options you get a Perl version which passes all
make tests in 64-bit mode.
export OBJECT_MODE=64 / setenv OBJECT_MODE 64 (depending on your shell)
-Duse64bitall \
-Dprefix=/usr/opt/perl5_64
-The -Dprefix option will install Perl in a directory parallel to the
+The -Dprefix option will install Perl in a directory parallel to the
IBM AIX system Perl installation.
-If you choose gcc to compile 64-bit Perl then you need to add the
+If you choose gcc to compile 64-bit Perl then you need to add the
following option:
-Dcc='gcc -maix64'
=head2 Compiling Perl 5 on older AIX versions up to 4.3.3
-Due to the fact that AIX 4.3.3 reached end-of-service in December 31,
-2003 this information is provided as is. The Perl versions prior to
-Perl 5.8.9 could be compiled on AIX up to 4.3.3 with the following
+Due to the fact that AIX 4.3.3 reached end-of-service in December 31,
+2003 this information is provided as is. The Perl versions prior to
+Perl 5.8.9 could be compiled on AIX up to 4.3.3 with the following
settings (your mileage may vary):
When compiling Perl, you must use an ANSI C compiler. AIX does not ship
bos.adt.syscalls 5.1.0.36 COMMITTED System Calls Application
#
-=head2 Building Dynamic Extensions on AIX
+=head2 Building Dynamic Extensions on AIX E<lt> 5L
AIX supports dynamically loadable objects as well as shared libraries.
Shared libraries by convention end with the suffix .a, which is a bit
http://www.ibm.com/servers/aix/products/aixos/linux/
-=head2 Using Large Files with Perl
+=head2 Using Large Files with Perl E<lt> 5L
Should yield no problems.
-=head2 Threaded Perl
+=head2 Threaded Perl E<lt> 5L
Threads seem to work OK, though at the moment not all tests pass when
threads are used in combination with 64-bit configurations.
You may get a warning when doing a threaded build:
- "pp_sys.c", line 4640.39: 1506-280 (W) Function argument assignment between types "unsigned char*" and "const void*" is not allowed.
+ "pp_sys.c", line 4640.39: 1506-280 (W) Function argument assignment
+ between types "unsigned char*" and "const void*" is not allowed.
The exact line number may vary, but if the warning (W) comes from a line
line this
different prototype than its non-reentrant variant, but the difference
is not really significant here.
-=head2 64-bit Perl
+=head2 64-bit Perl E<lt> 5L
If your AIX is installed with 64-bit support, you can expect 64-bit
configurations to work. In combination with threads some tests might
=head1 DATE
-Version 0.0.10: 07 Aug 2009
+Version 5.13.0 / 2010-05-14
=cut
Make perl executable and create a symlink for libperl:
chmod a+x /boot/common/bin/perl
- cd /boot/common/lib; ln -s perl5/5.11.3/BePC-haiku/CORE/libperl.so .
+ cd /boot/common/lib; ln -s perl5/5.13.0/BePC-haiku/CORE/libperl.so .
-Replace C<5.11.3> with your respective version of Perl.
+Replace C<5.13.0> with your respective version of Perl.
=head1 KNOWN PROBLEMS
=item Additional Perl modules
- unzip perl_ste.zip -d f:/perllib/lib/site_perl/5.11.3/
+ unzip perl_ste.zip -d f:/perllib/lib/site_perl/5.13.0/
Same remark as above applies. Additionally, if this directory is not
one of directories on @INC (and @INC is influenced by C<PERLLIB_PREFIX>), you
provided with previous versions of Perl, do I<not> use the ODS-2
compatability qualifier. Instead, use a command like the following:
- vmstar -xvf perl-5^.11^.3.tar
+ vmstar -xvf perl-5^.13^.0.tar
Then rename the top-level source directory like so:
- set security/protection=(o:rwed) perl-5^.11^.3.dir
- rename perl-5^.11^.3.dir perl-5_11_3.dir
+ set security/protection=(o:rwed) perl-5^.13^.0.dir
+ rename perl-5^.13^.0.dir perl-5_12_0.dir
The reason for this last step is that while filenames with multiple dots
are generally supported by Perl on VMS, I<directory> names with multiple
The MinGW64 compiler is available at http://sourceforge.net/projects/mingw-w64.
The latter is actually a cross-compiler targeting Win64. There's also a trimmed
down compiler (no java, or gfortran) suitable for building perl available at:
-http://svn.ali.as/cpan/users/kmx/strawberry_gcc-toolchain/
+http://strawberryperl.com/package/kmx/64_gcctoolchain/mingw64-w64-20100123-kmx-v2.zip
NOTE: If you're using a 32-bit compiler to build perl on a 64-bit Windows
operating system, then you should set the WIN64 environment variable to "undef".
+Also, the trimmed down compiler only passes tests when USE_ITHREADS *= define
+(as opposed to undef) and when the CFG *= Debug line is commented out.
This port fully supports MakeMaker (the set of modules that
is used to build extensions to perl). Therefore, you should be
Type "dmake" (or "nmake" if you are using that make).
This should build everything. Specifically, it will create perl.exe,
-perl511.dll at the perl toplevel, and various other extension dll's
+perl513.dll at the perl toplevel, and various other extension dll's
under the lib\auto directory. If the build fails for any reason, make
sure you have done the previous steps correctly.
# define ferror PerlSIO_ferror
# define clearerr PerlSIO_clearerr
# define getc PerlSIO_getc
+# define fgets PerlSIO_fgets
# define fputc PerlSIO_fputc
# define fputs PerlSIO_fputs
# define fflush PerlSIO_fflush
}
sub output {
- my ($podname, $header, $dochash, $footer) = @_;
+ my ($podname, $header, $dochash, $missing, $footer) = @_;
my $filename = "pod/$podname.pod";
open my $fh, '>', $filename or die "Can't open $filename: $!";
print $fh "\n=back\n";
}
+ if (@$missing) {
+ print $fh "\n=head1 Undocumented functions\n\n";
+ print $fh "These functions are currently undocumented:\n\n=over\n\n";
+ for my $missing (sort @$missing) {
+ print $fh "=item $missing\nX<$missing>\n\n";
+ }
+ print $fh "=back\n\n";
+ }
+
print $fh $footer, <<'_EOF_';
=cut
# walk table providing an array of components in each line to
# subroutine, printing the result
-output('perlapi', <<'_EOB_', $docs{api}, <<'_EOE_');
+my @missing_api = grep $funcflags{$_}{flags} =~ /A/ && !$docs{api}{$_}, keys %funcflags;
+output('perlapi', <<'_EOB_', $docs{api}, \@missing_api, <<'_EOE_');
=head1 NAME
perlapi - autogenerated documentation for the perl public API
=head1 SEE ALSO
-perlguts(1), perlxs(1), perlxstut(1), perlintern(1)
+L<perlguts>, L<perlxs>, L<perlxstut>, L<perlintern>
_EOE_
-output('perlintern', <<'END', $docs{guts}, <<'END');
+my @missing_guts = grep $funcflags{$_}{flags} !~ /A/ && !$docs{guts}{$_}, keys %funcflags;
+
+output('perlintern', <<'END', $docs{guts}, \@missing_guts, <<'END');
=head1 NAME
perlintern - autogenerated documentation of purely B<internal>
=head1 SEE ALSO
-perlguts(1), perlapi(1)
+L<perlguts>, L<perlapi>
END
mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied);
if (mg) {
- dSP;
- ENTER;
- SAVETMPS;
- PUSHSTACKi(PERLSI_MAGIC);
- PUSHMARK(SP);
- EXTEND(SP,2);
- PUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
- mPUSHi(key + 1);
- PUTBACK;
- call_method("EXTEND", G_SCALAR|G_DISCARD);
- POPSTACK;
- FREETMPS;
- LEAVE;
+ SV *arg1 = sv_newmortal();
+ sv_setiv(arg1, (IV)(key + 1));
+ Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "EXTEND", G_DISCARD, 1,
+ arg1);
return;
}
if (key > AvMAX(av)) {
sv = sv_newmortal();
sv_upgrade(sv, SVt_PVLV);
mg_copy(MUTABLE_SV(av), sv, 0, key);
+ if (!tied_magic) /* for regdata, force leavesub to make copies */
+ SvTEMP_off(sv);
LvTYPE(sv) = 't';
LvTARG(sv) = sv; /* fake (SV**) */
return &(LvTARG(sv));
Perl_croak(aTHX_ "%s", PL_no_modify);
if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
- dSP;
- PUSHSTACKi(PERLSI_MAGIC);
- PUSHMARK(SP);
- EXTEND(SP,2);
- PUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
- PUSHs(val);
- PUTBACK;
- ENTER;
- call_method("PUSH", G_SCALAR|G_DISCARD);
- LEAVE;
- POPSTACK;
+ Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "PUSH", G_DISCARD, 1,
+ val);
return;
}
av_store(av,AvFILLp(av)+1,val);
if (SvREADONLY(av))
Perl_croak(aTHX_ "%s", PL_no_modify);
if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
- dSP;
- PUSHSTACKi(PERLSI_MAGIC);
- PUSHMARK(SP);
- XPUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
- PUTBACK;
- ENTER;
- if (call_method("POP", G_SCALAR)) {
- retval = newSVsv(*PL_stack_sp--);
- } else {
- retval = &PL_sv_undef;
- }
- LEAVE;
- POPSTACK;
+ retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "POP", 0, 0);
+ if (retval)
+ retval = newSVsv(retval);
return retval;
}
if (AvFILL(av) < 0)
Perl_croak(aTHX_ "%s", PL_no_modify);
if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
- dSP;
- PUSHSTACKi(PERLSI_MAGIC);
- PUSHMARK(SP);
- EXTEND(SP,1+num);
- PUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
- while (num-- > 0) {
- PUSHs(&PL_sv_undef);
- }
- PUTBACK;
- ENTER;
- call_method("UNSHIFT", G_SCALAR|G_DISCARD);
- LEAVE;
- POPSTACK;
+ Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "UNSHIFT",
+ G_DISCARD | G_UNDEF_FILL, num);
return;
}
if (SvREADONLY(av))
Perl_croak(aTHX_ "%s", PL_no_modify);
if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
- dSP;
- PUSHSTACKi(PERLSI_MAGIC);
- PUSHMARK(SP);
- XPUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
- PUTBACK;
- ENTER;
- if (call_method("SHIFT", G_SCALAR)) {
- retval = newSVsv(*PL_stack_sp--);
- } else {
- retval = &PL_sv_undef;
- }
- LEAVE;
- POPSTACK;
+ retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "SHIFT", 0, 0);
+ if (retval)
+ retval = newSVsv(retval);
return retval;
}
if (AvFILL(av) < 0)
if (fill < 0)
fill = -1;
if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
- dSP;
- ENTER;
- SAVETMPS;
- PUSHSTACKi(PERLSI_MAGIC);
- PUSHMARK(SP);
- EXTEND(SP,2);
- PUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
- mPUSHi(fill + 1);
- PUTBACK;
- call_method("STORESIZE", G_SCALAR|G_DISCARD);
- POPSTACK;
- FREETMPS;
- LEAVE;
+ SV *arg1 = sv_newmortal();
+ sv_setiv(arg1, (IV)(fill + 1));
+ Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "STORESIZE", G_DISCARD,
+ 1, arg1);
return;
}
if (fill <= AvMAX(av)) {
mg = mg_find(sv, PERL_MAGIC_tiedelem);
if (mg) {
magic_existspack(sv, mg);
- return (bool)SvTRUE(sv);
+ return cBOOL(SvTRUE(sv));
}
}
*/
#$i_vfork I_VFORK /**/
+/* CAN_VAPROTO:
+ * This variable is defined on systems supporting prototype declaration
+ * of functions with a variable number of arguments.
+ */
+/* _V:
+ * This macro is used to declare function parameters in prototypes for
+ * functions with a variable number of parameters. Use double parentheses.
+ * For example:
+ *
+ * int printf _V((char *fmt, ...));
+ *
+ * Remember to use the plain simple _() macro when declaring a function
+ * with no variable number of arguments, since it might be possible to
+ * have a non-effect _V() macro and still get prototypes via _().
+ */
+#$vaproto CAN_VAPROTO /**/
+#ifdef CAN_VAPROTO
+#define _V(args) args
+#else
+#define _V(args) ()
+#endif
+
/* INTSIZE:
* This symbol contains the value of sizeof(int) so that the C
* preprocessor can make decisions based on it.
#$d_ctime_r HAS_CTIME_R /**/
#define CTIME_R_PROTO $ctime_r_proto /**/
+/* SETUID_SCRIPTS_ARE_SECURE_NOW:
+ * This symbol, if defined, indicates that the bug that prevents
+ * setuid scripts from being secure is not present in this kernel.
+ */
+/* DOSUID:
+ * This symbol, if defined, indicates that the C program should
+ * check the script that it is executing for setuid/setgid bits, and
+ * attempt to emulate setuid/setgid on systems that have disabled
+ * setuid #! scripts because the kernel can't do it securely.
+ * It is up to the package designer to make sure that this emulation
+ * is done securely. Among other things, it should do an fstat on
+ * the script it just opened to make sure it really is a setuid/setgid
+ * script, it should make sure the arguments passed correspond exactly
+ * to the argument on the #! line, and it should not trust any
+ * subprocesses to which it must pass the filename rather than the
+ * file descriptor of the script to be executed.
+ */
+#$d_suidsafe SETUID_SCRIPTS_ARE_SECURE_NOW /**/
+#$d_dosuid DOSUID /**/
+
/* HAS_DRAND48_R:
* This symbol, if defined, indicates that the drand48_r routine
* is available to drand48 re-entrantly.
*/
#$ebcdic EBCDIC /**/
-/* SETUID_SCRIPTS_ARE_SECURE_NOW:
- * This symbol, if defined, indicates that the bug that prevents
- * setuid scripts from being secure is not present in this kernel.
- */
-/* DOSUID:
- * This symbol, if defined, indicates that the C program should
- * check the script that it is executing for setuid/setgid bits, and
- * attempt to emulate setuid/setgid on systems that have disabled
- * setuid #! scripts because the kernel can't do it securely.
- * It is up to the package designer to make sure that this emulation
- * is done securely. Among other things, it should do an fstat on
- * the script it just opened to make sure it really is a setuid/setgid
- * script, it should make sure the arguments passed correspond exactly
- * to the argument on the #! line, and it should not trust any
- * subprocesses to which it must pass the filename rather than the
- * file descriptor of the script to be executed.
- */
-#$d_suidsafe SETUID_SCRIPTS_ARE_SECURE_NOW /**/
-#$d_dosuid DOSUID /**/
-
/* PERL_USE_DEVEL:
* This symbol, if defined, indicates that Perl was configured with
* -Dusedevel, to enable development features. This should not be
*/
#$d_off64_t HAS_OFF64_T /**/
+/* HAS_PRCTL:
+ * This symbol, if defined, indicates that the prctl routine is
+ * available to set process title.
+ */
+/* HAS_PRCTL_SET_NAME:
+ * This symbol, if defined, indicates that the prctl routine is
+ * available to set process title and supports PR_SET_NAME.
+ */
+#$d_prctl HAS_PRCTL /**/
+#$d_prctl_set_name HAS_PRCTL_SET_NAME /**/
+
/* HAS_PROCSELFEXE:
* This symbol is defined if PROCSELFEXE_PATH is a symlink
* to the absolute pathname of the executing program.
$ static_ext = ""
$ dynamic_ext = ""
$ nonxs_ext = ""
+$ nonxs_ext2 = ""
$ vms_default_directory_name = F$ENVIRONMENT("DEFAULT")
$ max_allowed_dir_depth = 3 ! e.g. [A.B.PERLxxx] not [A.B.C.PERLxxx]
$! max_allowed_dir_depth = 2 ! e.g. [A.PERLxxx] not [A.B.PERLxxx]
$ xxx = nonxs_ext
$ gosub may_already_have_extension
$ ENDIF
+$ IF $STATUS .EQ. 1
+$ THEN
+$ xxx = nonxs_ext2
+$ gosub may_already_have_extension
+$ ENDIF
$ IF $STATUS .NE. 1 THEN goto ext_loop
$ goto found_new_extension
$!
$ may_already_have_extension:
$ idx = F$LOCATE(extspec, xxx)
$ extlen = F$LENGTH(xxx)
-$ IF idx .EQ. extlen THEN return 1
-$! But "Flirble" may just be part of "Acme-Flirble"
+$ IF idx .EQ. extlen THEN return 1 ! didn't find it
+$! But "Flirble" may just be part of "Acme-Flirble". This is not
+$! bullet-proof because we may only be looking at one chunk of the
+$! existing extension list.
$ IF idx .GT. 0 .AND. F$EXTRACT(idx - 1, 1, xxx) .NES. " "
$ THEN
$ xxx = F$EXTRACT(idx + F$LENGTH(extspec) + 1, extlen, xxx)
$ found_new_extension:
$ IF F$SEARCH("[-.ext.''extension_dir_name']*.xs") .EQS. "" .AND. F$SEARCH("[-.dist.''extension_dir_name']*.xs") .EQS. "" .AND. F$SEARCH("[-.cpan.''extension_dir_name']*.xs") .EQS. ""
$ THEN
-$ nonxs_ext = nonxs_ext + " ''extspec'"
+$! Bit if a hack to get around the 1K buffer on older systems.
+$ IF F$LENGTH(nonxs_ext) .GT. 950
+$ THEN
+$ nonxs_ext2 = nonxs_ext2 + " ''extspec'"
+$ ELSE
+$ nonxs_ext = nonxs_ext + " ''extspec'"
+$ ENDIF
$ ELSE
$ known_extensions = known_extensions + " ''extspec'"
$ ENDIF
$ ENDIF
$ dflt = dflt - "Win32API/File" - "Win32" ! need Dave Cutler's other project
$ nonxs_ext = nonxs_ext - "Win32CORE"
+$ nonxs_ext2 = nonxs_ext2 - "Win32CORE"
$ dflt = F$EDIT(dflt,"TRIM,COMPRESS")
$ nonxs_ext = F$EDIT(nonxs_ext,"TRIM,COMPRESS")
+$ nonxs_ext2 = F$EDIT(nonxs_ext2,"TRIM,COMPRESS")
$!
$! Ask for their default list of extensions to build
$ echo ""
$ bool_dflt = "y"
$ IF F$TYPE(useperlio) .NES. ""
$ then
-$ if f$extract(0,1,f$edit(useperlio,"collapse,upcase")) .eqs. "N" .or. useperlio .eqs. "undef" then bool_dflt = "n"
+$ if .not. useperlio .or. useperlio .eqs. "undef" then bool_dflt = "n"
$ endif
$ IF .NOT. silent
$ THEN
$ WC "d_attribute_pure='undef'"
$ WC "d_attribute_unused='undef'"
$ WC "d_attribute_warn_unused_result='undef'"
+$ WC "d_prctl='undef'"
+$ WC "d_prctl_set_name='undef'"
$ WC "d_printf_format_null='undef'"
$ WC "d_bcmp='" + d_bcmp + "'"
$ WC "d_bcopy='" + d_bcopy + "'"
$!
$! The extensions symbols may be quite long
$!
-$ tmp = "extensions='" + nonxs_ext + " " + dynamic_ext + "'"
-$ WC/symbol tmp
-$ DELETE/SYMBOL tmp
+$ WC/symbol "extensions='", nonxs_ext, " ", nonxs_ext2, " ", dynamic_ext, "'"
$ WC "fflushNULL='define'"
$ WC "fflushall='undef'"
$ WC "fpostype='fpos_t'"
$ WC "netdb_host_type='" + netdb_host_type + "'"
$ WC "netdb_name_type='" + netdb_name_type + "'"
$ WC "netdb_net_type='" + netdb_net_type + "'"
-$ tmp = "nonxs_ext='" + nonxs_ext + "'"
-$ WC/symbol tmp
-$ DELETE/SYMBOL tmp
+$ WC/symbol "nonxs_ext='", nonxs_ext, " ", nonxs_ext2, "'"
$ WC "nveformat='" + nveformat + "'"
$ WC "nvfformat='" + nvfformat + "'"
$ WC "nvgformat='" + nvgformat + "'"
$ WC "uvxformat='" + uvxformat + "'"
$ WC "uvXUformat='" + uvXUformat + "'"
$ WC "vendorarch='" + "'"
+$ WC "vaproto='define'"
$ WC "vendorarchexp='" + "'"
$ WC "vendorbin='" + "'"
$ WC "vendorbinexp='" + "'"
*/
/* A jmpenv packages the state required to perform a proper non-local jump.
- * Note that there is a start_env initialized when perl starts, and top_env
- * points to this initially, so top_env should always be non-null.
+ * Note that there is a PL_start_env initialized when perl starts, and
+ * PL_top_env points to this initially, so PL_top_env should always be
+ * non-null.
*
- * Existence of a non-null top_env->je_prev implies it is valid to call
- * longjmp() at that runlevel (we make sure start_env.je_prev is always
+ * Existence of a non-null PL_top_env->je_prev implies it is valid to call
+ * longjmp() at that runlevel (we make sure PL_start_env.je_prev is always
* null to ensure this).
*
* je_mustcatch, when set at any runlevel to TRUE, means eval ops must
#define JMPENV_PUSH(v) \
STMT_START { \
- DEBUG_l(Perl_deb(aTHX_ "Setting up jumplevel %p, was %p at %s:%d\n", \
- (void*)&cur_env, (void*)PL_top_env, \
- __FILE__, __LINE__)); \
+ DEBUG_l({ \
+ int i = 0; JMPENV *p = PL_top_env; \
+ while (p) { i++; p = p->je_prev; } \
+ Perl_deb(aTHX_ "JUMPENV_PUSH level=%d at %s:%d\n", \
+ i, __FILE__, __LINE__);}) \
cur_env.je_prev = PL_top_env; \
OP_REG_TO_MEM; \
cur_env.je_ret = PerlProc_setjmp(cur_env.je_buf, SCOPE_SAVES_SIGNAL_MASK); \
#define JMPENV_POP \
STMT_START { \
- DEBUG_l(Perl_deb(aTHX_ "popping jumplevel was %p, now %p at %s:%d\n", \
- (void*)PL_top_env, (void*)cur_env.je_prev, \
- __FILE__, __LINE__)); \
+ DEBUG_l({ \
+ int i = -1; JMPENV *p = PL_top_env; \
+ while (p) { i++; p = p->je_prev; } \
+ Perl_deb(aTHX_ "JUMPENV_POP level=%d at %s:%d\n", \
+ i, __FILE__, __LINE__);}) \
assert(PL_top_env == &cur_env); \
PL_top_env = cur_env.je_prev; \
} STMT_END
#define JMPENV_JUMP(v) \
STMT_START { \
+ DEBUG_l({ \
+ int i = -1; JMPENV *p = PL_top_env; \
+ while (p) { i++; p = p->je_prev; } \
+ Perl_deb(aTHX_ "JUMPENV_JUMP(%d) level=%d at %s:%d\n", \
+ (int)v, i, __FILE__, __LINE__);}) \
OP_REG_TO_MEM; \
if (PL_top_env->je_prev) \
PerlProc_longjmp(PL_top_env->je_buf, (v)); \
} STMT_END
#define CATCH_GET (PL_top_env->je_mustcatch)
-#define CATCH_SET(v) (PL_top_env->je_mustcatch = (v))
+#define CATCH_SET(v) \
+ STMT_START { \
+ DEBUG_l( \
+ Perl_deb(aTHX_ \
+ "JUMPLEVEL set catch %d => %d (for %p) at %s:%d\n", \
+ PL_top_env->je_mustcatch, v, (void*)PL_top_env, \
+ __FILE__, __LINE__);) \
+ PL_top_env->je_mustcatch = (v); \
+ } STMT_END
#include "mydtrace.h"
#define blk_loop cx_u.cx_blk.blk_u.blku_loop
#define blk_givwhen cx_u.cx_blk.blk_u.blku_givwhen
+#define DEBUG_CX(action) \
+ DEBUG_l(WITH_THX( \
+ Perl_deb(aTHX_ "CX %ld %s %s (scope %ld,%ld) at %s:%d\n", \
+ (long)cxstack_ix, \
+ action, \
+ PL_block_type[CxTYPE(&cxstack[cxstack_ix])], \
+ (long)PL_scopestack_ix, \
+ (long)(cxstack[cxstack_ix].blk_oldscopesp), \
+ __FILE__, __LINE__)));
+
/* Enter a block. */
#define PUSHBLOCK(cx,t,sp) CXINC, cx = &cxstack[cxstack_ix], \
cx->cx_type = t, \
cx->blk_oldscopesp = PL_scopestack_ix, \
cx->blk_oldpm = PL_curpm, \
cx->blk_gimme = (U8)gimme; \
- DEBUG_l( PerlIO_printf(Perl_debug_log, "Entering block %ld, type %s\n", \
- (long)cxstack_ix, PL_block_type[CxTYPE(cx)]); )
+ DEBUG_CX("PUSH");
/* Exit a block (RETURN and LAST). */
-#define POPBLOCK(cx,pm) cx = &cxstack[cxstack_ix--], \
+#define POPBLOCK(cx,pm) \
+ DEBUG_CX("POP"); \
+ cx = &cxstack[cxstack_ix--], \
newsp = PL_stack_base + cx->blk_oldsp, \
PL_curcop = cx->blk_oldcop, \
PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \
PL_scopestack_ix = cx->blk_oldscopesp, \
pm = cx->blk_oldpm, \
- gimme = cx->blk_gimme; \
- DEBUG_SCOPE("POPBLOCK"); \
- DEBUG_l( PerlIO_printf(Perl_debug_log, "Leaving block %ld, type %s\n", \
- (long)cxstack_ix+1,PL_block_type[CxTYPE(cx)]); )
+ gimme = cx->blk_gimme;
/* Continue a block elsewhere (NEXT and REDO). */
-#define TOPBLOCK(cx) cx = &cxstack[cxstack_ix], \
+#define TOPBLOCK(cx) \
+ DEBUG_CX("TOP"); \
+ cx = &cxstack[cxstack_ix], \
PL_stack_sp = PL_stack_base + cx->blk_oldsp, \
PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \
PL_scopestack_ix = cx->blk_oldscopesp, \
- PL_curpm = cx->blk_oldpm; \
- DEBUG_SCOPE("TOPBLOCK");
+ PL_curpm = cx->blk_oldpm;
/* substitution context */
struct subst {
hash actions codes defined in hv.h */
#define G_EVAL 8 /* Assume eval {} around subroutine call. */
#define G_NOARGS 16 /* Don't construct a @_ array. */
-#define G_KEEPERR 32 /* Append errors to $@, don't overwrite it */
+#define G_KEEPERR 32 /* Warn for errors, don't overwrite $@ */
#define G_NODEBUG 64 /* Disable debugging at toplevel. */
#define G_METHOD 128 /* Calling method. */
#define G_FAKINGEVAL 256 /* Faking an eval context for call_sv or
fold_constants. */
+#define G_UNDEF_FILL 512 /* Fill the stack with &PL_sv_undef
+ A special case for UNSHIFT in
+ Perl_magic_methcall(). */
/* flag bits for PL_in_eval */
#define EVAL_NULL 0 /* not in an eval */
#define PUSHSTACKi(type) \
STMT_START { \
PERL_SI *next = PL_curstackinfo->si_next; \
+ DEBUG_l({ \
+ int i = 0; PERL_SI *p = PL_curstackinfo; \
+ while (p) { i++; p = p->si_prev; } \
+ Perl_deb(aTHX_ "push STACKINFO %d at %s:%d\n", \
+ i, __FILE__, __LINE__);}) \
if (!next) { \
next = new_stackinfo(32, 2048/sizeof(PERL_CONTEXT) - 1); \
next->si_prev = PL_curstackinfo; \
STMT_START { \
dSP; \
PERL_SI * const prev = PL_curstackinfo->si_prev; \
+ DEBUG_l({ \
+ int i = -1; PERL_SI *p = PL_curstackinfo; \
+ while (p) { i++; p = p->si_prev; } \
+ Perl_deb(aTHX_ "pop STACKINFO %d at %s:%d\n", \
+ i, __FILE__, __LINE__);}) \
if (!prev) { \
PerlIO_printf(Perl_error_log, "panic: POPSTACK\n"); \
my_exit(1); \
$_ALLOW_BIN $_ALLOW_PURE_PERL $_ALLOW_TAR_ITER
];
-$VERSION = '0.36';
+$VERSION = '0.38';
$PREFER_BIN = 0;
$WARN = 1;
$DEBUG = 0;
$self->_error( $self->_no_buffer_content( $self->archive ) );
}
- print $fh $buffer if defined $buffer;
+ $self->_print($fh, $buffer) if defined $buffer;
close $fh;
$self->_gunzip_to, $! ));
my $buffer;
- $fh->print($buffer) while $gz->gzread($buffer) > 0;
+ $self->_print($fh, $buffer) while $gz->gzread($buffer) > 0;
$fh->close;
### set what files where extract, and where they went ###
$self->_error( $self->_no_buffer_content( $self->archive ) );
}
- print $fh $buffer if defined $buffer;
+ $self->_print($fh, $buffer) if defined $buffer;
close $fh;
$self->_error( $self->_no_buffer_content( $self->archive ) );
}
- print $fh $buffer if defined $buffer;
+ $self->_print($fh, $buffer) if defined $buffer;
close $fh;
$self->_error( $self->_no_buffer_content( $self->archive ) );
}
- print $fh $buffer if defined $buffer;
+ $self->_print($fh, $buffer) if defined $buffer;
close $fh;
$self->archive, $@));
}
- print $fh $buffer if defined $buffer;
+ $self->_print($fh, $buffer) if defined $buffer;
close $fh;
#
#################################
+# For printing binaries that avoids interfering globals
+sub _print {
+ my $self = shift;
+ my $fh = shift;
+
+ local( $\, $", $, ) = ( undef, ' ', '' );
+ return print $fh @_;
+}
+
sub _error {
my $self = shift;
my $error = shift;
diag( "\n\n*** DEBUG INFORMATION ENABLED ***\n\n" ) if $Debug;
+# Be as evil as possible to print
+$\ = "ORS_FLAG";
+$, = "OFS_FLAG";
+$" = "LISTSEP_FLAG";
+
my $tmpl = {
### plain files
'x.bz2' => { programs => [qw[bunzip2]],
package B::Debug;
-our $VERSION = '1.11';
+our $VERSION = '1.12';
use strict;
require 5.006;
=head1 Changes
+ 1.12 2010-02-10 rurban
+ remove archlib installation cruft, and use the proper PM rule.
+ By Todd Rinaldo (toddr)
+
1.11 2008-07-14 rurban
avoid B::Flags in CORE tests not to crash on old XS in @INC
+Version 3.49
+
+ [BUG FIXES]
+ 1. Fix a regression since 3.44 involving a case when the header includes "Content-Length: 0".
+ Thanks to Alex Vandiver (RT#51109)
+ 2. Suppress uninitialized warnings under -w. Thanks to burak. (RT#50301)
+ 3. url() now uses virtual_port() instead of server_port(). Thanks to MKANAT and Yanick Champoux. (RT#51562)
+
+ [SECURITY]
+ 1. embedded newlines are now filtered out of header values in header().
+ Thanks to Mark Stosberg and Yanick Champoux.
+
+ [DOCUMENTATION]
+ 1. README was updated to reflect that CGI.pm was moved under ./lib.
+ Thanks to Alex Vandiver.
+
+ [INTERNALS]
+ 1. More tests were added for autoescape, thanks to Bob Kuo. (RT#25485)
+ 2. Attempt to avoid test failures with t/fast, thanks to Steve Hay. (RT#49599)
+
Version 3.48
[BUG FIXES]
# http://stein.cshl.org/WWW/software/CGI/
$CGI::revision = '$Id: CGI.pm,v 1.266 2009/07/30 16:32:34 lstein Exp $';
-$CGI::VERSION='3.48';
+$CGI::VERSION='3.49';
# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
if ( $content_length > 0 ) {
$self->read_from_client(\$query_string,$content_length,0);
}
- else {
+ elsif (not defined $ENV{CONTENT_LENGTH}) {
$self->read_from_stdin(\$query_string);
# should this be PUTDATA in case of PUT ?
my($param) = $meth . 'DATA' ;
'EXPIRES','NPH','CHARSET',
'ATTACHMENT','P3P'],@p);
+ # CR escaping for values, per RFC 822
+ for my $header ($type,$status,$cookie,$target,$expires,$nph,$charset,$attachment,$p3p,@other) {
+ if (defined $header) {
+ $header =~ s/
+ (?<=\n) # For any character proceeded by a newline
+ (?=\S) # ... that is not whitespace
+ / /xg; # ... inject a leading space in the new line
+ }
+ }
+
$nph ||= $NPH;
$type ||= 'text/html' unless defined($type);
# need to fix it up a little.
for (@other) {
# Don't use \s because of perl bug 21951
- next unless my($header,$value) = /([^ \r\n\t=]+)=\"?(.+?)\"?$/;
+ next unless my($header,$value) = /([^ \r\n\t=]+)=\"?(.+?)\"?$/s;
($_ = $header) =~ s/^(\w)(.*)/"\u$1\L$2" . ': '.$self->unescapeHTML($value)/e;
}
my(@values);
@values = $self->_set_values_and_labels($values,\$labels,$name);
$tabindex = $self->element_tab($tabindex);
+ $name = q{} if ! defined $name;
$result = qq/<select name="$name" $tabindex$other>\n/;
for (@values) {
if (/<optgroup/) {
@values = $self->_set_values_and_labels($values,\$labels,$name,$labeled,$novals);
my($other) = @other ? " @other" : '';
- $name=$self->_maybe_escapeHTML($name);
+ $name = $self->_maybe_escapeHTML($name) || q{};
$result = qq/<optgroup label="$name"$other>\n/;
for (@values) {
if (/<optgroup/) {
# $uri =~ s/\Q$path\E$// if defined $path; # remove path
if ($full) {
- my $protocol = $self->protocol();
- $url = "$protocol://";
- my $vh = http('x_forwarded_host') || http('host') || '';
- $vh =~ s/\:\d+$//; # some clients add the port number (incorrectly). Get rid of it.
- if ($vh) {
- $url .= $vh;
- } else {
- $url .= server_name();
- }
- my $port = $self->server_port;
- $url .= ":" . $port
- unless (lc($protocol) eq 'http' && $port == 80)
- || (lc($protocol) eq 'https' && $port == 443);
+ my $protocol = $self->protocol();
+ $url = "$protocol://";
+ my $vh = http('x_forwarded_host') || http('host') || '';
+ $vh =~ s/\:\d+$//; # some clients add the port number (incorrectly). Get rid of it.
+
+ $url .= $vh || server_name();
+
+ my $port = $self->virtual_port;
+
+ # add the port to the url unless it's the protocol's default port
+ $url .= ':' . $port unless (lc($protocol) eq 'http' && $port == 80)
+ or (lc($protocol) eq 'https' && $port == 443);
+
return $url if $base;
- $url .= $uri;
+
+ $url .= $uri;
} elsif ($relative) {
($url) = $uri =~ m!([^/]+)$!;
} elsif ($absolute) {
use CGI;
- open (OUT,">>test.out") || die;
+ open (OUT,'>>','test.out') || die;
$records = 5;
for (0..$records) {
my $q = CGI->new;
close OUT;
# reopen for reading
- open (IN,"test.out") || die;
+ open (IN,'<','test.out') || die;
while (!eof(IN)) {
my $q = CGI->new(\*IN);
print $q->param('counter'),"\n";
P3P: policyref="/w3c/p3p.xml" cp="CAO DSP LAW CURa"
+Note that if a header value contains a carriage return, a leading space will be
+added to each new line that doesn't already have one as specified by RFC2616
+section 4.2. For example:
+
+ print header( -ingredients => "ham\neggs\nbacon" );
+
+will generate
+
+ Ingredients: ham
+ eggs
+ bacon
+
=head2 GENERATING A REDIRECTION HEADER
print $q->redirect('http://somewhere.else/in/movie/land');
# undef may be returned if it's not a valid file handle
if (defined $lightweight_fh) {
# Upgrade the handle to one compatible with IO::Handle:
- my $io_handle = $lightweight_fh->handle;
+ my $io_handle = $lightweight_fh->handle;
- open (OUTFILE,">>/usr/local/web/users/feedback");
- while ($bytesread = $io_handle->read($buffer,1024)) {
- print OUTFILE $buffer;
- }
+ open (OUTFILE,'>>','/usr/local/web/users/feedback');
+ while ($bytesread = $io_handle->read($buffer,1024)) {
+ print OUTFILE $buffer;
+ }
}
In a list context, upload() will return an array of filehandles.
}
sub do_work {
- my(@values,$key);
print "<h2>Here are the current settings in this form</h2>";
- for $key (param) {
+ for my $key (param) {
print "<strong>$key</strong> -> ";
- @values = param($key);
+ my @values = param($key);
print join(", ",@values),"<br>\n";
}
}
sub die {
my ($arg,@rest) = @_;
- if ($DIE_HANDLER) {
- &$DIE_HANDLER($arg,@rest);
- }
+ &$DIE_HANDLER($arg,@rest) if $DIE_HANDLER;
- if ( ineval() ) {
- if (!ref($arg)) {
- $arg = join("",($arg,@rest)) || "Died";
- my($file,$line,$id) = id(1);
- $arg .= " at $file line $line.\n" unless $arg=~/\n$/;
- realdie($arg);
- }
- else {
- realdie($arg,@rest);
- }
- }
+ # if called as die( $object, 'string' ),
+ # all is stringified, just like with
+ # the real 'die'
+ $arg = join '' => "$arg", @rest if @rest;
+
+ $arg ||= 'Died';
+
+ my($file,$line,$id) = id(1);
+
+ $arg .= " at $file line $line.\n" unless ref $arg or $arg=~/\n$/;
+
+ realdie $arg if ineval();
+ &fatalsToBrowser($arg) if $WRAP;
+
+ $arg=~s/^/ stamp() /gme if $arg =~ /\n$/ or not exists $ENV{MOD_PERL};
+
+ $arg .= "\n" unless $arg =~ /\n$/;
- if (!ref($arg)) {
- $arg = join("", ($arg,@rest));
- my($file,$line,$id) = id(1);
- $arg .= " at $file line $line." unless $arg=~/\n$/;
- &fatalsToBrowser($arg) if $WRAP;
- if (($arg =~ /\n$/) || !exists($ENV{MOD_PERL})) {
- my $stamp = stamp;
- $arg=~s/^/$stamp/gm;
- }
- if ($arg !~ /\n$/) {
- $arg .= "\n";
- }
- }
realdie $arg;
}
# headers
sub fatalsToBrowser {
- my($msg) = @_;
+ my $msg = shift;
+
+ $msg = "$msg" if ref $msg;
+
$msg=~s/&/&/g;
$msg=~s/>/>/g;
$msg=~s/</</g;
- $msg=~s/\"/"/g;
+ $msg=~s/"/"/g;
+
my($wm) = $ENV{SERVER_ADMIN} ?
qq[the webmaster (<a href="mailto:$ENV{SERVER_ADMIN}">$ENV{SERVER_ADMIN}</a>)] :
"this site's webmaster";
package CGI::Cookie;
+use strict;
+use warnings;
+
# See the bottom of this file for the POD documentation. Search for the
# string '=head'.
$r ||= eval { $MOD_PERL == 2 ?
Apache2::RequestUtil->request() :
Apache->request } if $MOD_PERL;
- if ($r) {
- $raw_cookie = $r->headers_in->{'Cookie'};
- } else {
- if ($MOD_PERL && !exists $ENV{REQUEST_METHOD}) {
- die "Run $r->subprocess_env; before calling fetch()";
- }
- $raw_cookie = $ENV{HTTP_COOKIE} || $ENV{COOKIE};
- }
+
+ return $r->headers_in->{'Cookie'} if $r;
+
+ die "Run $r->subprocess_env; before calling fetch()"
+ if $MOD_PERL and !exists $ENV{REQUEST_METHOD};
+
+ return $ENV{HTTP_COOKIE} || $ENV{COOKIE};
}
shift if ref $_[0]
&& eval { $_[0]->isa('Apache::Request::Req') || $_[0]->isa('Apache') };
my($name,$value,$path,$domain,$secure,$expires,$httponly) =
- rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES,HTTPONLY],@_);
+ rearrange([ 'NAME', ['VALUE','VALUES'], qw/ PATH DOMAIN SECURE EXPIRES
+ HTTPONLY / ], @_);
# Pull out our parameters.
my @values;
package CGI::Fast;
use strict;
-$^W=1; # A way to say "use warnings" that's compatible with even older perls.
+
+# A way to say "use warnings" that's compatible with even older perls.
+# making it local will not affect the code that loads this module
+# and since we're not in a BLOCK, warnings are enabled until the EOF
+local $^W = 1;
# See the bottom of this file for the POD documentation. Search for the
# string '=head'.
# wish, but if you redistribute a modified version, please attach a note
# listing the modifications you have made.
-$CGI::Fast::VERSION='1.07';
+$CGI::Fast::VERSION='1.08';
use CGI;
use FCGI;
# was always so and cannot be fixed without breaking the binary data case.
# -- Stepan Kasal <skasal@redhat.com>
#
+if ($] == 5.008) {
+ package utf8;
+
+ no warnings 'redefine'; # needed for Perl 5.8.1+
+
+ my $is_utf8_redefinition = <<'EOR';
+ sub is_utf8 {
+ my ($text) = @_;
+
+ my $ctext = pack q{C0a*}, $text;
+
+ return ($text ne $ctext) && ($ctext =~ m/^(
+ [\x09\x0A\x0D\x20-\x7E]
+ | [\xC2-\xDF][\x80-\xBF]
+ | \xE0[\xA0-\xBF][\x80-\xBF]
+ | [\xE1-\xEC\xEE\xEF][\x80-\xBF]{2}
+ | \xED[\x80-\x9F][\x80-\xBF]
+ | \xF0[\x90-\xBF][\x80-\xBF]{2}
+ | [\xF1-\xF3][\x80-\xBF]{3}
+ | \xF4[\x80-\x8F][\x80-\xBF]{2}
+ )*$/xo);
+ }
+EOR
+
+ eval $is_utf8_redefinition;
+}
+
sub escape {
shift() if @_ > 1 and ( ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass));
my $toencode = shift;
return undef unless defined($toencode);
- utf8::encode($toencode) if ($] > 5.008001 && utf8::is_utf8($toencode));
+ utf8::encode($toencode) if ($] >= 5.008 && utf8::is_utf8($toencode));
if ($EBCDIC) {
$toencode=~s/([^a-zA-Z0-9_.~-])/uc sprintf("%%%02x",$E2A[ord($1)])/eg;
} else {
use strict;
-use Test::More tests => 41;
+use Test::More tests => 59;
use IO::Handle;
BEGIN { use_ok('CGI::Carp') };
# Test that realwarn is called
{
local $^W = 0;
- eval 'sub CGI::Carp::realdie {my $mess = shift; return $mess};';
-}
+ local *CGI::Carp::realdie = sub { my $mess = shift; return $mess };
-like(CGI::Carp::die('There is a problem'),
- $stamp,
- 'CGI::Carp::die calls CORE::die, but adds stamp');
+ like(CGI::Carp::die('There is a problem'),
+ $stamp,
+ 'CGI::Carp::die calls CORE::die, but adds stamp');
+
+}
#-----------------------------------------------------------------------------
# Test set_message
ok( defined buffer('::STDOUT'), 'STDIN returns proper filehandle');
ok( defined buffer(*main::STDOUT), 'STDIN returns proper filehandle');
ok(!defined buffer("WIBBLE"), '"WIBBLE" doesn\'t returns proper filehandle');
+
+# Calling die with code refs with no WRAP
+{
+ local $CGI::Carp::WRAP = 0;
+
+ eval { CGI::Carp::die( 'regular string' ) };
+ like $@ => qr/regular string/, 'die with string';
+
+ eval { CGI::Carp::die( [ 1..10 ] ) };
+ like $@ => qr/ARRAY\(0x[\da-f]+\)/, 'die with array ref';
+
+ eval { CGI::Carp::die( { a => 1 } ) };
+ like $@ => qr/HASH\(0x[\da-f]+\)/, 'die with hash ref';
+
+ eval { CGI::Carp::die( sub { 'Farewell' } ) };
+ like $@ => qr/CODE\(0x[\da-f]+\)/, 'die with code ref';
+
+ eval { CGI::Carp::die( My::Plain::Object->new ) };
+ isa_ok $@, 'My::Plain::Object';
+
+ eval { CGI::Carp::die( My::Plain::Object->new, ' and another argument' ) };
+ like $@ => qr/My::Plain::Object/, 'object is stringified';
+ like $@ => qr/and another argument/, 'second argument is present';
+
+ eval { CGI::Carp::die( My::Stringified::Object->new ) };
+ isa_ok $@, 'My::Stringified::Object';
+
+ eval { CGI::Carp::die( My::Stringified::Object->new, ' and another argument' ) };
+ like $@ => qr/stringified/, 'object is stringified';
+ like $@ => qr/and another argument/, 'second argument is present';
+
+ eval { CGI::Carp::die() };
+ like $@ => qr/Died at/, 'die with no argument';
+}
+
+# Calling die with code refs when WRAPped
+{
+ local $CGI::Carp::WRAP = 1;
+ local *CGI::Carp::realdie = sub { return @_ };
+ local *STDOUT;
+
+ tie *STDOUT, 'StoreStuff';
+
+ my %result; # store results because stdout is kidnapped
+
+ CGI::Carp::die( 'regular string' );
+ $result{string} .= $_ while <STDOUT>;
+
+ CGI::Carp::die( [ 1..10 ] );
+ $result{array_ref} .= $_ while <STDOUT>;
+
+ CGI::Carp::die( { a => 1 } );
+ $result{hash_ref} .= $_ while <STDOUT>;
+
+ CGI::Carp::die( sub { 'Farewell' } );
+ $result{code_ref} .= $_ while <STDOUT>;
+
+ CGI::Carp::die( My::Plain::Object->new );
+ $result{plain_object} .= $_ while <STDOUT>;
+
+ CGI::Carp::die( My::Stringified::Object->new );
+ $result{string_object} .= $_ while <STDOUT>;
+
+ CGI::Carp::die();
+ $result{no_args} .= $_ while <STDOUT>;
+
+ untie *STDOUT;
+
+ like $result{string} => qr/regular string/, 'regular string, wrapped';
+ like $result{array_ref} => qr/ARRAY\(\w+?\)/, 'array ref, wrapped';
+ like $result{hash_ref} => qr/HASH\(\w+?\)/, 'hash ref, wrapped';
+ like $result{code_ref} => qr/CODE\(\w+?\)/, 'code ref, wrapped';
+ like $result{plain_object} => qr/My::Plain::Object/,
+ 'plain object, wrapped';
+ like $result{string_object} => qr/stringified/,
+ 'stringified object, wrapped';
+ like $result{no_args} => qr/Died at/, 'no args, wrapped';
+
+}
+
+{
+ package My::Plain::Object;
+
+ sub new {
+ return bless {}, shift;
+ }
+}
+
+{
+ package My::Stringified::Object;
+
+ use overload '""' => sub { 'stringified' };
+
+ sub new {
+ return bless {}, shift;
+ }
+}
if (ord("\t") != 9) { $CRLF = "\r\n"; }
-# Web servers on EBCDIC hosts are typically set up to do an EBCDIC -> ASCII
-# translation hence CRLF is used as \r\n within CGI.pm on such machines.
-
-if (ord("\t") != 9) { $CRLF = "\r\n"; }
-
# Set up a CGI environment
$ENV{REQUEST_METHOD}='GET';
$ENV{QUERY_STRING} ='game=chess&game=checkers&weather=dull';
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More tests => 4; # last test to print
+
+use CGI qw/ :all /;
+
+$ENV{HTTP_X_FORWARDED_HOST} = 'proxy:8484';
+$ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
+$ENV{SERVER_PORT} = 8080;
+$ENV{SERVER_NAME} = 'the.good.ship.lollypop.com';
+
+is virtual_port() => 8484, 'virtual_port()';
+is server_port() => 8080, 'server_port()';
+
+is url() => 'http://proxy:8484', 'url()';
+
+# let's see if we do the defaults right
+
+$ENV{HTTP_X_FORWARDED_HOST} = 'proxy:80';
+
+is url() => 'http://proxy', 'url() with default port';
+
+2010-02-17 Andreas J. Koenig <andk@cpan.org>
+
+ * release 1.94_56
+
+ * No code change, only version bumps on files that had changed but did
+ not get a version bump. Requested by Steve Hay in his role as perl
+ pumpkin.
+
+2010-02-03 Andreas J. Koenig <andk@cpan.org>
+
+ * release 1.94_55
+
+ * Fixed rt.perl.org#72362 (CPAN ignoring configure_requires).
+ Also fixed (MY)META.yml processing to always prefer
+ Parse::CPAN::Meta, if available. Reported by Joshua B Jore
+ and patched by David Golden
+
+ * Fixed rt.perl.org#72348 (missing CPAN::HandleConfig::output);
+ Reported by Joshua B Jore and patched by David Golden
+
+ * Quieter user interface: made lots of '$module missing' type
+ warnings only warn once; eliminated 'no YAML' warnings for
+ distroprefs if there are no distroprefs.
+
+ * now with 359 distroprefs files
+
+2010-01-14 Andreas J. Koenig <andk@cpan.org>
+
+ * release 1.94_54
+
+ * David Golden fixes several recent regressions related to external
+ transport tools (ncftp, lynx, curl, etc)
+
+ * fixed quoting for downloading into directories containing
+ whitespace (reported by Jarkko Hietaniemi)
+
+ * amended lib/App/Cpan.pm because of a regression reported by Zefram as
+ rt.cpan.org #53305 and rt.perl.org #71838
+
2009-12-18 Andreas J. Koenig <andk@cpan.org>
* release 1.94_53
+++ /dev/null
-#!/usr/bin/perl -w -*- mode: cperl -*-
-use strict;
-use vars qw( $VERSION @ST_PREFS );
-BEGIN {$CPAN::Config_loaded=1}
-BEGIN {$CPAN::Config_loaded=1} # keep old perls with -w quiet
-use ExtUtils::MakeMaker qw(:DEFAULT);
-use File::Path;
-eval { require File::Spec; };
-my $HAVE_FILE_SPEC = !$@;
-eval { require YAML::Syck; };
-my $HAVE_YAML_SYCK = !$@;
-use File::Basename qw(basename);
-require Config;
-my $HAVE_MAKE = basename($Config::Config{make}) eq "make"; # file-scoped!
-
-# storable pref files
-@ST_PREFS = qw(
- );
-
-
-my $Id = q$Id: Makefile.PL 146 2005-08-09 04:25:21Z k $;
-$VERSION = sprintf "%.3f", 1 + substr(q$Rev: 146 $,4)/1000;
-
-my $version_diff = 0; # we'll have to die if this becomes true
-my $version_from;
-{
- local $^W;
- $ExtUtils::MakeMaker::VERSION = eval $ExtUtils::MakeMaker::VERSION;
-}
-if ($HAVE_FILE_SPEC) {
- $version_from = File::Spec->catfile(qw(lib CPAN.pm));
- my $version_set_manually = 1; # not by SVN
-
- if ($ARGV[0] && $ARGV[0] eq "--setversion") {
- die "Your perl is a bit dated[$]].\nDo not make a release with it\n" if $] < 5.008;
- die "Your MakeMaker is a bit dated[$ExtUtils::MakeMaker::VERSION].\nDo not make a release with it\n"
- if $ExtUtils::MakeMaker::VERSION < 6.4502;
- die "Your MakeMaker doesn't do the sign woodoo" unless
- MM->can("signature_target");
- shift @ARGV;
- my $st;
- local $ENV{LANG} = "C";
- my $dirty = ! system "git status -a > /dev/null";
- die "Not everything checked in or out?" if $dirty;
-
- if ($version_set_manually) {
- # we must control that the VERSION in CPAN.pm is the same as in the Makefile
- unshift @INC, "lib";
- require $version_from;
- open my $fh, "make the-release-name|" or die;
- my $have_version;
- while (<$fh>) {
- next unless /^version\s+([\d\._]+)/;
- $have_version = eval $1;
- }
- die "could not determine current version from Makefile" unless $have_version;
- eval q{
- no warnings "numeric";
- if ($CPAN::VERSION != $have_version) {
- warn "Not equal: CPAN::VERSION[$CPAN::VERSION] Makefile version[$have_version]";
- $version_diff = 1;
- }
-};
- die $@ if $@;
- }
- exit unless $version_diff;
- }
-}
-
-# for 5.004_05 I installed all of them manually despite errors;
-# version hints as of 2006-02
-my $prereq_pm = {
- 'File::Spec' => 0, # KWILLIAMS; requires
- # Scalar::Util;
- # PathTools-3.16.tar.gz
- 'File::Temp' => 0, # TJENNESS; requires Test::More;
- 'Net::Ping' => 0, # SMPETERS;
- 'Scalar::Util' => 0, # GBARR;
- # Scalar-List-Utils-1.18.tar.gz;
- 'Test::Harness' => 2.62,
- 'Test::More' => 0, # MSCHWERN;
- # Test-Simple-0.62.tar.gz;
- };
-if ($^O eq "darwin") {
- $prereq_pm->{'File::HomeDir'} = 0.69;
-}
-
-# if they have one of these we declare it as prereq for better reporting
-for my $interesting_module (qw(
- Archive::Tar
- Archive::Zip
- CPAN::Checksums
- Compress::Zlib
- Data::Dumper
- Digest::SHA
- ExtUtils::CBuilder
- File::Copy
- File::HomeDir
- File::Spec
- File::Temp
- File::Which
- IO::Compress::Base
- IO::Zlib
- Module::Build
- Net::FTP
- Parse::CPAN::Meta
- Scalar::Util
- Term::ReadKey
- Term::ReadLine::Perl
- Test::More
- Text::Glob
- Text::ParseWords
- Text::Wrap
- YAML
- YAML::Syck
- YAML::XS
- )) {
- eval "require $interesting_module";
- if (!$@) {
- $prereq_pm->{$interesting_module} ||= 0;
- }
-}
-if ($HAVE_FILE_SPEC) {
- # import PAUSE public key to user's keychain
- require Config;
- my $dir;
- for $dir (split /$Config::Config{path_sep}/, $ENV{PATH}) {
- my $abs = File::Spec->catfile($dir, 'gpg');
- my $cmd;
- if ($cmd = MM->maybe_command($abs)) {
- print "Importing PAUSE public key into your GnuPG keychain... ";
- system($cmd, '--quiet', '--import', <PAUSE*.pub>);
- print "done!\n";
- print "(You may wish to trust it locally with 'gpg --lsign-key 450F89EC')\n";
- last;
- }
- }
-}
-
-if ($HAVE_FILE_SPEC) {
- my $have_distroprefs = -d "distroprefs";
- my $have_notinchecksums = -f File::Spec->catdir("t","CPAN","authors","id","A","AN","ANDK","NotInChecksums-0.000.tar.gz");
- if ($have_distroprefs && !$have_notinchecksums) {
- warn <<EOW;
-
-####-Note-for-repository-users-####
-Please try
- make testdistros
-before running 'make test'
-It builds various missing pieces
-####-Note-for-repository-users-####
-
-EOW
- }
-}
-my @sign = (MM->can("signature_target") ? (SIGN => 1) : ());
-# warn "sign[@sign]";
-WriteMakefile(
- INSTALLDIRS => 'perl', # as it is coming with perl
- NAME => 'CPAN',
- VERSION_FROM => $version_from,
- EXE_FILES => [qw(scripts/cpan)],
- PREREQ_PM => $prereq_pm,
- ($ExtUtils::MakeMaker::VERSION >= 6.3002 ?
- (LICENSE => "perl") : (),
- ),
- ($ExtUtils::MakeMaker::VERSION >= 6.48 ?
- (MIN_PERL_VERSION => '5.004') : (),
- ),
- clean => {
- FILES => "lib/CPAN/Config.pm t/dot-cpan/FTPstats.yml",
- },
- @sign,
- ($] >= 5.005 ?
- (
- ABSTRACT_FROM => 'lib/CPAN.pm', # retrieve abstract from module
- AUTHOR => 'Andreas Koenig <andreas.koenig.gmwojprw@franz.ak.mind.de>') : (),
- ),
- dist => {
- DIST_DEFAULT => join(" ", # note: order matters!
- "verify-no-subdir",
- "verify-changes-date",
- "verify-changes-version",
- "kwalify-distroprefs",
- "Makefile",
- "no_CR",
- "META.yml",
- "setversion",
- "README",
- "testdistros",
- "all",
- "tardist",
- ),
- COMPRESS => 'gzip -9',
- },
- # I took it from RT-CPAN ticket 30098:
- ($ExtUtils::MakeMaker::VERSION >= 6.4502 ?
- (META_ADD => {
- resources => {
- repository => "git://github.com/andk/cpanpm.git",
- },
- keywords => ['CPAN','module','module installation'],
- }) : ()),
- );
-
-if ($version_diff){
- die "
-==> I had to update some \$VERSIONs <==
-==> Your Makefile has been rebuilt. <==
-==> Please rerun the make command. <==
-";
-}
-
-package MY;
-
-sub macro {
- q{
-LC_ALL_noexport=en_GB.utf8
-
-YAML_MODULE=YAML::Syck
-}
-}
-
-sub postamble {
- return "" unless $HAVE_MAKE; # dmake has unknown issues with my Makefile
- my @m;
- push @m, q{
-.SUFFIXES: .rnc .rng
-
-.rnc.rng:
- trang -I rnc -O rng $*.rnc $*.rng
-
-update: dd-prefs
-
-# the subdirs on MY OWN BOX are allowed here (only used for make dist!)
-OKDIRS=CPAN|DIST|bin|blib|cover_db|\
- distroprefs|eg|inc|lib|logs|patches|perlbug|\
- protocols|related|release-lib|scripts|t|talks
-
-verify-no-subdir:
- @$(PERL) -e 'my$$s=join",",grep{!/^($(OKDIRS))\z/x&&-d($$_)}glob"*";' \
- -e 'die"unexpected dir:$$s"if$$s'
-
-verify-changes-date:
- @$(PERL) -ne 'BEGIN{my@t=(localtime)[5,4,3];$$t[0]+=1900;$$t[1]++;$$t=sprintf"%04d-%02d-%02d",@t}' \
- -e '$$ok++,exit if /^$$t\s/; END{die "Alert: did not find <$$t> in Changes file" unless $$ok}' Changes
-
-verify-changes-version:
- @$(PERL) -ne '$$ok++,exit if /\b$(VERSION)\b/; END{die "Alert: did not find <$(VERSION)> in Changes file" unless $$ok}' Changes
-
-kwalify-distroprefs:
- `echo $(PERL) | sed -e 's/perl$$/slaymake/'` validate
-
-setversion:
- $(PERL) Makefile.PL --setversion
-
-README: lib/CPAN.pm Makefile
- -[ -r $@ ] && chmod +w $@
- -$(PERL) -MPod::Text -e 'Pod::Text->new->parse_from_file(\*ARGV)' lib/CPAN.pm > $@
-
-the-release-name :
- $(NOECHO) $(ECHO) 'version ' $(VERSION)
- $(NOECHO) $(ECHO) 'release-name ' $(DISTVNAME).tar$(SUFFIX)
-
-release :: disttest
- git tag -m 'This is $(VERSION)' "$(VERSION)"
- ls -l $(DISTVNAME).tar$(SUFFIX)
- rm -rf $(DISTVNAME)
- $(NOECHO) $(ECHO) '% lftp pause.perl.org'
- $(NOECHO) $(ECHO) '> cd incoming'
- $(NOECHO) $(ECHO) '> put $(DISTVNAME).tar$(SUFFIX)'
- $(NOECHO) $(ECHO) '> quit'
- $(NOECHO) $(ECHO) '% git push --tags master'
-
-snapshot : Makefile no_CR META.yml README testdistros all tardist
-
-# 16=Distribution; 32=Bundle; 32768=Queue
-depefails:
- $(PERL) -Ilib -MCPAN -e 'CPAN::HandleConfig->load;$$CPAN::DEBUG|=16;$$CPAN::DEBUG|=32;$$CPAN::DEBUG|=32768;install(qw(CPAN::Test::Dummy::Perl5::Build::DepeFails));'
-
-logs/.exists :
- mkdir -p logs
- touch $@
-
-run :
- $(PERL) -Ilib -MCPAN -eshell
-
-run_testenv_db :
- $(PERL) -Ilib -It -MCPAN::MyConfig -MCPAN -deshell
-
-record-session :
- $(PERL) -Ilib -MCPAN -e '$$CPAN::Suppress_readline=$$CPAN::Echo_readline=1;shell' | tee ttt.out
-
-run-with-sqlite :
- $(PERL) -I$$HOME/.cpan -Ilib -MCPAN::SQLite -MCPAN::MyConfig -MCPAN -e '$$CPAN::Config->{use_sqlite}++; $$CPAN::Config->{sqlite_dbname}="cpandb-sqlite"; shell'
-
-testrun_very_offline : rm_mirrored_by run_emu_offline
-
-testrun_emu_offline :
- $(PERL) -I$$HOME/.cpan -Ilib -MCPAN::MyConfig -MCPAN -e '@CPAN::Defaultsites = qw(file:///dev/null); $$CPAN::Config->{urllist} = []; shell'
-
-rm_mirrored_by :
- rm -f $$HOME/.cpan/sources/MIRRORED.BY*
-
-testrun_http_only :
- $(PERL) -I$$HOME/.cpan -Ilib -MCPAN::MyConfig -MCPAN -e '$$CPAN::Config->{urllist} = [qw(http://www.planet-elektronik.de/CPAN/)]; shell'
-
-urllist :
- $(PERL) -Ilib -MCPAN -MCPAN::FirstTime -e 'CPAN::FirstTime::init("$$ENV{HOME}/.cpan/CPAN/MyConfig", args => [qw(urllist)])'
-
-runadmin :
- $(PERL) -Ilib -MCPAN::Admin -eshell
-
-rundb :
- $(PERL) -Ilib -MCPAN -deshell
-
-sign:
- cpansign -s
-
-show-batch-signing-keys:
- for f in PAUSE*.pub; do echo "++++$$f++++"; gpg --verbose --with-colons $$f; done
-
-show-imported:
- gpg --list-sigs --with-colons 450F89EC
-
-# seems to need at least gnupg 1.4.2:
-upload-batch-signing-key:
- gpg --send-key 450F89EC
-
-howto-release:
- @$(ECHO) make ci dist \&\& make release
-
-META.yml: metafile
- $(CP) $(DISTVNAME)/META.yml ./META.yml
-
-install-devel-cover-unless-uptodate:
- $(PERL) -Ilib -MCPAN -e 'CPAN::Shell->install("/home/src/perl/devel-cover/SVN/.") unless CPAN::Shell->expand("Module","Devel::Cover")->uptodate'
-
-install-devel-cover-unconditionally:
- $(PERL) -Ilib -MCPAN -e 'CPAN::Shell->install("/home/src/perl/devel-cover/SVN/.")'
-
-testcover: testdistros install-devel-cover-unless-uptodate
- :>SIGNATURE
- $(PERL) -MDevel::Cover -e 0
- `dirname $(PERL)`/cover -delete
- HARNESS_PERL_SWITCHES=-MDevel::Cover $(MAKE) test
- `dirname $(PERL)`/cover
-
-man:
- $(PERL)doc -F lib/CPAN.pm
-
-testdistros: \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build-1.03.tar.gz \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build-DepeFails-1.02.tar.gz \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build-Fails-1.03.tar.gz \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-BuildOrMake-1.02.tar.gz \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-1.05.tar.gz \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-CircDepeOne-1.00.tar.gz \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-CircDepeTwo-1.00.tar.gz \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-CircDepeThree-1.00.tar.gz \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-ConfReq-1.00.tar.gz \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Expect-1.00.tar.gz \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Failearly-1.02.tar.gz \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Features-1.06.tar.gz \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-UnsatPrereq-1.00.tar.gz \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Zip-1.03.zip \
- t/CPAN/authors/id/A/AN/ANDK/NotInChecksums-0.000.tar.gz
-
-# sorry, unix centric (and only makes sense on a working copy of the
-# repository; else 'make test TEST_FILES=t/30shell.t TEST_VERBOSE=1'
-# will do)
-testshell-with-protocol: testdistros
- $(PERL) -e 'for ("protocols"){-d $$_ or mkdir $$_, 0755}'
- $(MAKE) test TEST_FILES=t/30shell.t TEST_VERBOSE=1 PERL='$(PERL)' | \
- tee protocols/make-test-`date +%Y%m%dT%H%M%S`
- ls -lt protocols | head
-
-testshell-with-protocol-without-expect: testdistros
- $(PERL) -e 'for ("protocols"){-d $$_ or mkdir $$_, 0755}'
- CPAN_RUN_SHELL_TEST_WITHOUT_EXPECT=1 $(MAKE) test \
- TEST_FILES=t/30shell.t TEST_VERBOSE=1 | \
- tee protocols/make-test-`date +%Y%m%dT%H%M%S`
- ls -lt protocols | head
-
-testshell-with-protocol-twice: testdistros
- $(PERL) -e 'for ("protocols"){-d $$_ or mkdir $$_, 0755}'
- $(PERL) -p -i~ -e 's/colorize_output\D+\d/colorize_output=>0/' t/CPAN/TestConfig.pm
- $(MAKE) test TEST_FILES=t/30shell.t TEST_VERBOSE=1 | \
- tee protocols/make-test-`date +%Y%m%dT%H%M%S`
- $(PERL) -p -i~ -e 's/colorize_output\D+\d/colorize_output=>1/' t/CPAN/TestConfig.pm
- $(MAKE) test TEST_FILES=t/30shell.t TEST_VERBOSE=1 | \
- tee protocols/make-test-`date +%Y%m%dT%H%M%S`
- $(PERL) -p -i~ -e 's/colorize_output\D+\d/colorize_output=>0/' t/CPAN/TestConfig.pm
- ls -ltr protocols | tail
-
-#
-# testdistros
-#
-
-t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build-1.03.tar.gz: \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build/Changes \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build/MANIFEST \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build/Build.PL \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build/lib/CPAN/Test/Dummy/Perl5/Build.pm \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build/t/00_load.t
- cd t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build && \
- $(PERL) Build.PL && \
- ./Build dist && \
- mv CPAN-Test-Dummy-Perl5-Build-1.03.tar.gz .. && \
- ./Build clean
- ls -l $@
-
-t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build-DepeFails-1.02.tar.gz: \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build-DepeFails/Changes \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build-DepeFails/MANIFEST \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build-DepeFails/README \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build-DepeFails/Build.PL \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build-DepeFails/lib/CPAN/Test/Dummy/Perl5/Build/DepeFails.pm \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build-DepeFails/t/00_load.t
- cd t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build-DepeFails && \
- $(PERL) Build.PL && \
- ./Build dist && \
- mv CPAN-Test-Dummy-Perl5-Build-DepeFails-1.02.tar.gz .. && \
- ./Build clean
- ls -l $@
-
-t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build-Fails-1.03.tar.gz: \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build-Fails/Changes \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build-Fails/MANIFEST \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build-Fails/README \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build-Fails/Build.PL \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build-Fails/lib/CPAN/Test/Dummy/Perl5/Build/Fails.pm \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build-Fails/t/00_load.t
- cd t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build-Fails && \
- $(PERL) Build.PL && \
- ./Build dist && \
- mv CPAN-Test-Dummy-Perl5-Build-Fails-1.03.tar.gz .. && \
- ./Build clean
- ls -l $@
-
-t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-BuildOrMake-1.02.tar.gz: \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-BuildOrMake/MANIFEST \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-BuildOrMake/Build.PL \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-BuildOrMake/Makefile.PL \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-BuildOrMake/lib/CPAN/Test/Dummy/Perl5/BuildOrMake.pm \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-BuildOrMake/t/00_load.t
- cd t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-BuildOrMake && \
- $(PERL) Build.PL && \
- ./Build dist && \
- mv CPAN-Test-Dummy-Perl5-BuildOrMake-1.02.tar.gz .. && \
- ./Build clean
- ls -l $@
-
-t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-1.05.tar.gz: \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make/Changes \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make/MANIFEST \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make/Makefile.PL \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make/lib/Bundle/CpanTestDummies.pm \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make/lib/CPAN/Test/Dummy/Perl5/Make.pm \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make/t/00_load.t
- cd t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make && \
- $(PERL) Makefile.PL && \
- $(MAKE) dist && \
- mv CPAN-Test-Dummy-Perl5-Make-1.05.tar.gz .. && \
- $(MAKE) clean
- ls -l $@
-
-t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-CircDepeOne-1.00.tar.gz: \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-CircDepeOne/Changes \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-CircDepeOne/MANIFEST \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-CircDepeOne/Makefile.PL \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-CircDepeOne/lib/CPAN/Test/Dummy/Perl5/Make/CircDepeOne.pm \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-CircDepeOne/t/00_load.t
- cd t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-CircDepeOne && \
- $(PERL) Makefile.PL && \
- $(MAKE) dist && \
- mv CPAN-Test-Dummy-Perl5-Make-CircDepeOne-1.00.tar.gz .. && \
- $(MAKE) clean
- ls -l $@
-
-t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-CircDepeTwo-1.00.tar.gz: \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-CircDepeTwo/Changes \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-CircDepeTwo/MANIFEST \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-CircDepeTwo/Makefile.PL \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-CircDepeTwo/lib/CPAN/Test/Dummy/Perl5/Make/CircDepeTwo.pm \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-CircDepeTwo/t/00_load.t
- cd t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-CircDepeTwo && \
- $(PERL) Makefile.PL && \
- $(MAKE) dist && \
- mv CPAN-Test-Dummy-Perl5-Make-CircDepeTwo-1.00.tar.gz .. && \
- $(MAKE) clean
- ls -l $@
-
-t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-CircDepeThree-1.00.tar.gz: \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-CircDepeThree/Changes \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-CircDepeThree/MANIFEST \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-CircDepeThree/Makefile.PL \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-CircDepeThree/lib/CPAN/Test/Dummy/Perl5/Make/CircDepeThree.pm \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-CircDepeThree/t/00_load.t
- cd t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-CircDepeThree && \
- $(PERL) Makefile.PL && \
- $(MAKE) dist && \
- mv CPAN-Test-Dummy-Perl5-Make-CircDepeThree-1.00.tar.gz .. && \
- $(MAKE) clean
- ls -l $@
-
-t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-ConfReq-1.00.tar.gz: \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-ConfReq/Changes \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-ConfReq/MANIFEST \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-ConfReq/mymeta.yml \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-ConfReq/Makefile.PL \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-ConfReq/lib/CPAN/Test/Dummy/Perl5/Make/ConfReq.pm \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-ConfReq/t/00_load.t
- cd t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-ConfReq && \
- $(PERL) Makefile.PL open_the_backdoor && \
- $(MAKE) dist && \
- mv CPAN-Test-Dummy-Perl5-Make-ConfReq-1.00.tar.gz .. && \
- $(MAKE) clean
- ls -l $@
-
-t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Features-1.06.tar.gz: \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Features/Changes \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Features/MANIFEST \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Features/mymeta.yml \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Features/Makefile.PL \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Features/lib/CPAN/Test/Dummy/Perl5/Make/Features.pm \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Features/t/00_load.t
- cd t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Features && \
- $(PERL) Makefile.PL open_the_backdoor && \
- $(MAKE) dist && \
- mv CPAN-Test-Dummy-Perl5-Make-Features-1.06.tar.gz ../ && \
- $(MAKE) clean
- ls -l $@
-
-t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Expect-1.00.tar.gz: \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Expect/Changes \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Expect/MANIFEST \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Expect/Makefile.PL \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Expect/lib/CPAN/Test/Dummy/Perl5/Make/Expect.pm \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Expect/t/00_load.t
- cd t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Expect && \
- $(PERL) Makefile.PL && \
- $(MAKE) dist && \
- mv CPAN-Test-Dummy-Perl5-Make-Expect-1.00.tar.gz .. && \
- $(MAKE) clean
- ls -l $@
-
-t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Failearly-1.02.tar.gz: \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Failearly/MANIFEST \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Failearly/Makefile.PL \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Failearly/lib/CPAN/Test/Dummy/Perl5/Make/Failearly.pm
- cd t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Failearly && \
- $(PERL) Makefile.PL && \
- $(MAKE) dist && \
- mv CPAN-Test-Dummy-Perl5-Make-Failearly-1.02.tar.gz .. && \
- $(MAKE) clean
- ls -l $@
-
-t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-UnsatPrereq-1.00.tar.gz: \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-UnsatPrereq/Changes \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-UnsatPrereq/MANIFEST \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-UnsatPrereq/Makefile.PL \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-UnsatPrereq/README \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-UnsatPrereq/lib/CPAN/Test/Dummy/Perl5/Make/UnsatPrereq.pm \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-UnsatPrereq/t/00_load.t
- cd t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-UnsatPrereq/ && \
- $(PERL) Makefile.PL && \
- $(MAKE) dist && \
- mv CPAN-Test-Dummy-Perl5-Make-UnsatPrereq-1.00.tar.gz .. && \
- $(MAKE) clean
- ls -l $@
-
-t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Zip-1.03.zip: \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Zip/MANIFEST \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Zip/Makefile.PL \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Zip/lib/CPAN/Test/Dummy/Perl5/Make/Zip.pm \
- t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Zip/t/00_load.t
- cd t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Zip && \
- $(PERL) Makefile.PL && \
- $(MAKE) dist && \
- mv CPAN-Test-Dummy-Perl5-Make-Zip-1.03.zip .. && \
- $(MAKE) clean
- ls -l $@
-
-t/CPAN/authors/id/A/AN/ANDK/NotInChecksums-0.000.tar.gz :
- echo " ----No content---- " > t/CPAN/authors/id/A/AN/ANDK/tempfile
- cd t/CPAN/authors/id/A/AN/ANDK && tar cvzf NotInChecksums-0.000.tar.gz tempfile
- $(RM) t/CPAN/authors/id/A/AN/ANDK/tempfile
- ls -l $@
-
-#
-#
-#
-
-clean ::
- $(RM) t/CPAN/authors/id/A/AN/ANDK/*/Build \
- t/CPAN/authors/id/A/AN/ANDK/*/Makefile.old
- $(RM_RF) t/CPAN/authors/id/A/AN/ANDK/*/_build
-
-no_CR : META.yml
- $(PERL) bin/no_CR.pl MANIFEST
-
-foreign-prefs : dd-prefs st-prefs
-
-dd-prefs ::
- `echo $(PERL) | sed -e 's/perl$$/slaymake/'` dd-prefs
-
-st-prefs ::
-
-chlog ::
-
-};
-
- for my $base (@main::ST_PREFS) {
- push @m, qq{
-st-prefs :: $base.st
-
-};
- if ($HAVE_YAML_SYCK) {
- push @m, qq{$base.st : Makefile
- \$(PERL) -MYAML::Syck=LoadFile -MStorable=nstore -e '\$\$x=shift; \@y=LoadFile("\$\$x.yml"); nstore(\\\@y, "\$\$x.st")' $base
-
-};
- }
- }
-
- join "", @m;
-}
-
-sub dist_test {
- return q{
-# if we depend on $(DISTVNAME).tar$(SUFFIX), then the rest of the
-# Makefile breaks our intent to NOT remake dist
-disttest :
- rm -rf $(DISTVNAME)
- tar xvzf $(DISTVNAME).tar$(SUFFIX)
- cd $(DISTVNAME) && $(ABSPERLRUN) Makefile.PL
- cd $(DISTVNAME) && $(MAKE) $(PASTHRU)
- cd $(DISTVNAME) && $(MAKE) test $(PASTHRU)
-
-distdir ::
- touch $(DISTVNAME)/SIGNATURE && $(CP) $(DISTVNAME)/SIGNATURE ./SIGNATURE
- $(CP) $(DISTVNAME)/META.yml ./META.yml
- $(CP) $(DISTVNAME)/MANIFEST ./MANIFEST
-
-}
-}
-
-sub distdir {
- my $self = shift;
- my $out = $self->SUPER::distdir;
- $out =~ s/distdir :/distdir ::/g;
- return $out;
-}
-
-# dist_dir was the name in very old MakeMaker as of 5.005_04
-sub dist_dir {
- my $self = shift;
- my $out = $self->SUPER::dist_dir;
- $out =~ s/distdir :/distdir ::/g;
- return $out;
-}
use warnings;
use vars qw($VERSION);
-$VERSION = '1.570001'; # 1.57 + local patches for bleadperl
+$VERSION = '1.5701';
=head1 NAME
{
# this is what CPAN.pm would do otherwise
CPAN::HandleConfig->load(
- be_silent => 1,
+ # be_silent => 1, # candidate to be ripped out forever
write_file => 0,
);
}
=for comment
-CPAN.pm sends all the good stuff either to STDOUT, or to a temp
-file if $CPAN::Be_Silent is set. I have to intercept that output
-so I can find out what happened.
+CPAN.pm sends all the good stuff either to STDOUT. I have to intercept
+that output so I can find out what happened.
=cut
# vim: ts=4 sts=4 sw=4:
use strict;
package CPAN;
-$CPAN::VERSION = '1.94_5301'; # 1.94_53 + local patches for bleadperl
+$CPAN::VERSION = '1.94_56';
$CPAN::VERSION =~ s/_//;
# we need to run chdir all over and we would get at wrong libraries
prerequisites_policy
what to do if you are missing module prerequisites
('follow' automatically, 'ask' me, or 'ignore')
+ For 'follow', also sets PERL_AUTOINSTALL and
+ PERL_EXTUTILS_AUTOINSTALL for "--defaultdeps" if
+ not already set
prefs_dir local directory to store per-distro build options
proxy_user username for accessing an authenticating proxy
proxy_pass password for accessing an authenticating proxy
=head1 PREREQUISITES
+The CPAN program is trying to depend on as little as possible so the
+user can use it in hostile enviroment. It works better the more goodies
+the environment provides. For example if you try in the CPAN shell
+
+ install Bundle::CPAN
+
+or
+
+ install Bundle::CPANxxl
+
+you will find the shell more convenient than the bare shell before.
+
If you have a local mirror of CPAN and can access all files with
"file:" URLs, then you only need a perl later than perl5.003 to run
this module. Otherwise Net::FTP is strongly recommended. LWP may be
=head1 TRANSLATIONS
-Kawai,Takanori provides a Japanese translation of this manpage at
+Kawai,Takanori provides a Japanese translation of a very old version
+of this manpage at
L<http://homepage3.nifty.com/hippo2000/perltips/CPAN.htm>
=head1 SEE ALSO
-L<cpan>, L<CPAN::Nox>, L<CPAN::Version>
+Many people enter the CPAN shell by running the L<cpan> utility
+program which is installed in the same directory as perl itself. So if
+you have this directory in your PATH variable (or some equivalent in
+your operating system) then typing C<cpan> in a console window will
+work for you as well. Above that the utility provides several
+commandline shortcuts.
=cut
use strict;
use vars qw($VERSION);
-$VERSION = "5.5";
+$VERSION = "5.5001";
# module is internal to CPAN.pm
%CPAN::DEBUG = qw[
if ($arg and ref $arg) {
eval { require Data::Dumper };
if ($@) {
- $CPAN::Frontend->myprint($arg->as_string);
+ $CPAN::Frontend->myprint("Debug(\n" . $arg->as_string . ")\n");
} else {
- $CPAN::Frontend->myprint(Data::Dumper::Dumper($arg));
+ $CPAN::Frontend->myprint("Debug(\n" . Data::Dumper::Dumper($arg) . ")\n");
}
} else {
my $outer = "";
use CPAN::InfoObj;
@CPAN::Distribution::ISA = qw(CPAN::InfoObj);
use vars qw($VERSION);
-$VERSION = "1.94";
+$VERSION = "1.9456_01";
# Accessors
sub cpan_comment {
my($color) = shift || 0;
my($ancestors) = shift || [];
# a distribution needs to recurse into its prereq_pms
+ $self->debug("color_cmd_tmps[$depth,$color,@$ancestors]") if $CPAN::DEBUG;
return if exists $self->{incommandcolor}
&& $color==1
#-> sub CPAN::Distribution::parse_meta_yml ;
sub parse_meta_yml {
- my($self) = @_;
+ my($self, $yaml) = @_;
+ $self->debug(sprintf("parse_meta_yml[%s]",$yaml||'undef')) if $CPAN::DEBUG;
my $build_dir = $self->{build_dir} or die "PANIC: cannot parse yaml without a build_dir";
- my $yaml = File::Spec->catfile($build_dir,"META.yml");
- $self->debug("yaml[$yaml]") if $CPAN::DEBUG;
+ $yaml ||= File::Spec->catfile($build_dir,"META.yml");
+ $self->debug("meta[$yaml]") if $CPAN::DEBUG;
return unless -f $yaml;
my $early_yaml;
eval {
- require Parse::CPAN::Meta;
- $early_yaml = Parse::CPAN::Meta::LoadFile($yaml)->[0];
+ $CPAN::META->has_inst("Parse::CPAN::Meta") or die;
+ # P::C::M returns last document in scalar context
+ $early_yaml = Parse::CPAN::Meta::LoadFile($yaml);
};
unless ($early_yaml) {
eval { $early_yaml = CPAN->_yaml_loadfile($yaml)->[0]; };
}
- unless ($early_yaml) {
- return;
- }
- return $early_yaml;
+ $self->debug(sprintf("yaml[%s]", $early_yaml || 'UNDEF')) if $CPAN::DEBUG;
+ $self->debug($early_yaml) if $CPAN::DEBUG && $early_yaml;
+ return $early_yaml || undef;
}
#-> sub CPAN::Distribution::satisfy_requires ;
sub satisfy_requires {
my ($self) = @_;
+ $self->debug("Entering satisfy_requires") if $CPAN::DEBUG;
if (my @prereq = $self->unsat_prereq("later")) {
+ $self->debug("unsatisfied[@prereq]") if $CPAN::DEBUG;
+ $self->debug(@prereq) if $CPAN::DEBUG && @prereq;
if ($prereq[0][0] eq "perl") {
my $need = "requires perl '$prereq[0][1]'";
my $id = $self->pretty_id;
}
}
}
+ return;
}
#-> sub CPAN::Distribution::satisfy_configure_requires ;
sub satisfy_configure_requires {
my($self) = @_;
+ $self->debug("Entering satisfy_configure_requires") if $CPAN::DEBUG;
my $enable_configure_requires = 1;
if (!$enable_configure_requires) {
return 1;
# configure_requires that means, things with
# configure_requires simply fail, all others succeed
}
- my @prereq = $self->unsat_prereq("configure_requires_later") or return 1;
+ my @prereq = $self->unsat_prereq("configure_requires_later");
+ $self->debug("configure_requires[@prereq]") if $CPAN::DEBUG;
+ return 1 unless @prereq;
+ $self->debug(\@prereq) if $CPAN::DEBUG;
if ($self->{configure_requires_later}) {
for my $k (keys %{$self->{configure_requires_later_for}||{}}) {
if ($self->{configure_requires_later_for}{$k}>1) {
my $dir = $self->{build_dir};
unless (File::Spec->canonpath(File::Basename::dirname($dir))
eq File::Spec->canonpath($CPAN::Config->{build_dir})) {
- $CPAN::Frontend->mywarn("Directory '$dir' not below $CPAN::Config->{build_dir}, ".
- "will not store persistent state\n");
+ $CPAN::Frontend->mywarnonce("Directory '$dir' not below $CPAN::Config->{build_dir}, ".
+ "will not store persistent state\n");
return;
}
my $file = sprintf "%s.yml", $dir;
}
);
} else {
- $CPAN::Frontend->myprint("Warning (usually harmless): '$yaml_module' not installed, ".
- "will not store persistent state\n");
+ $CPAN::Frontend->myprintonce("'$yaml_module' not installed, ".
+ "will not store persistent state\n");
}
}
$patch = $f if -f $f;
}
unless (-f $patch) {
+ CPAN->debug("not on disk: patch[$patch]") if $CPAN::DEBUG;
if (my $trydl = $self->try_download($patch)) {
$patch = $trydl;
} else {
"make",
"modulebuild",
"prereq_pm",
- "prereq_pm_detected",
],
test => [
"badtestcnt",
$env{$k} = $v;
}
local %ENV = %env;
+ if ($CPAN::Config->{prerequisites_policy} eq "follow") {
+ $ENV{PERL_AUTOINSTALL} ||= "--defaultdeps";
+ $ENV{PERL_EXTUTILS_AUTOINSTALL} ||= "--defaultdeps";
+ }
my $system;
my $pl_commandline;
if ($self->prefs->{pl}) {
if ($@) {
$CPAN::Frontend->mydie("Cannot create directory $prefs_dir");
}
+ # shortcut if there are no distroprefs files
+ {
+ my $dh = DirHandle->new($prefs_dir) or $CPAN::Frontend->mydie("Couldn't open '$prefs_dir': $!");
+ my @files = map { /\.(yml|dd|st)\z/i } $dh->read;
+ return unless @files;
+ }
my $yaml_module = CPAN::_yaml_module();
my $ext_map = {};
my @extensions;
if (@fallbacks) {
local $" = " and ";
unless ($self->{have_complained_about_missing_yaml}++) {
- $CPAN::Frontend->mywarn("'$yaml_module' not installed, falling back ".
- "to @fallbacks to read prefs '$prefs_dir'\n");
+ $CPAN::Frontend->mywarnonce("'$yaml_module' not installed, falling back ".
+ "to @fallbacks to read prefs '$prefs_dir'\n");
}
} else {
unless ($self->{have_complained_about_missing_yaml}++) {
- $CPAN::Frontend->mywarn("'$yaml_module' not installed, cannot ".
- "read prefs '$prefs_dir'\n");
+ $CPAN::Frontend->mywarnonce("'$yaml_module' not installed, cannot ".
+ "read prefs '$prefs_dir'\n");
}
}
}
%{$prefs_depends->{configure_requires}||{}},
%{$feature_depends->{configure_requires}||{}},
);
+ if (-f "Build.PL"
+ && ! -f "Makefile.PL"
+ && ! exists $merged{"Module::Build"}
+ && ! $CPAN::META->has_inst("Module::Build")
+ ) {
+ $CPAN::Frontend->mywarn(
+ " Warning: CPAN.pm discovered Module::Build as undeclared prerequisite.\n".
+ " Adding it now as such.\n"
+ );
+ $CPAN::Frontend->mysleep(5);
+ $merged{"Module::Build"} = 0;
+ delete $self->{writemakefile};
+ }
$prereq_pm = {}; # configure_requires defined as "b"
} elsif ($slot eq "later") {
my $prereq_pm_0 = $self->prereq_pm || {};
or $need_version eq '0' # "==" would trigger warning when not numeric
or $need_version eq "undef"
)) {
- next NEED;
+ unless ($nmo->inst_deprecated) {
+ next NEED;
+ }
+
}
$available_version = $nmo->available_version;
#-> sub CPAN::Distribution::read_yaml ;
sub read_yaml {
my($self) = @_;
- return $self->{yaml_content} if exists $self->{yaml_content};
my $build_dir;
unless ($build_dir = $self->{build_dir}) {
# maybe permission on build_dir was missing
# if MYMETA.yml exists, that takes precedence over META.yml
my $meta = File::Spec->catfile($build_dir,"META.yml");
my $mymeta = File::Spec->catfile($build_dir,"MYMETA.yml");
- my $yaml = -f $mymeta ? $mymeta : $meta;
- $self->debug("yaml[$yaml]") if $CPAN::DEBUG;
- return unless -f $yaml;
- eval { $self->{yaml_content} = CPAN->_yaml_loadfile($yaml)->[0]; };
- if ($@) {
- $CPAN::Frontend->mywarn("Could not read ".
- "'$yaml'. Falling back to other ".
- "methods to determine prerequisites\n");
- return $self->{yaml_content} = undef; # if we die, then we
- # cannot read YAML's own
- # META.yml
+ my $meta_file = -f $mymeta ? $mymeta : $meta;
+ $self->debug("meta_file[$meta_file]") if $CPAN::DEBUG;
+ return unless -f $meta_file;
+ my $yaml;
+ eval { $yaml = $self->parse_meta_yml($meta_file) };
+ if ($@ or ! $yaml) {
+ $CPAN::Frontend->mywarnonce("Could not read ".
+ "'$meta_file'. Falling back to other ".
+ "methods to determine prerequisites\n");
+ return undef; # if we die, then we cannot read YAML's own META.yml
}
# not "authoritative"
- for ($self->{yaml_content}) {
- if (defined $_ && (! ref $_ || ref $_ ne "HASH")) {
- $CPAN::Frontend->mywarn("META.yml does not seem to be conforming, cannot use it.\n");
- $self->{yaml_content} = +{};
- }
- }
- # MYMETA.yml is not dynamic by definition
- if ( $yaml ne $mymeta &&
- ( not exists $self->{yaml_content}{dynamic_config}
- or $self->{yaml_content}{dynamic_config}
- )
- ) {
- $self->{yaml_content} = undef;
+ if (defined $yaml && (! ref $yaml || ref $yaml ne "HASH")) {
+ $CPAN::Frontend->mywarn("META.yml does not seem to be conforming, cannot use it.\n");
+ $yaml = undef;
}
- $self->debug(sprintf "yaml_content[%s]", $self->{yaml_content} || "UNDEF")
+ $self->debug(sprintf "yaml[%s]", $yaml || "UNDEF")
if $CPAN::DEBUG;
- return $self->{yaml_content};
+ $self->debug($yaml) if $CPAN::DEBUG && $yaml;
+ # MYMETA.yml is static and authoritative by definition
+ if ( $meta_file eq $mymeta ) {
+ return $yaml;
+ }
+ # META.yml is authoritative only if dynamic_config is defined and false
+ if ( defined $yaml->{dynamic_config} && ! $yaml->{dynamic_config} ) {
+ return $yaml;
+ }
+ # otherwise, we can't use what we found
+ return undef;
}
#-> sub CPAN::Distribution::prereq_pm ;
sub prereq_pm {
my($self) = @_;
- $self->{prereq_pm_detected} ||= 0;
- CPAN->debug("ID[$self->{ID}]prereq_pm_detected[$self->{prereq_pm_detected}]") if $CPAN::DEBUG;
- return $self->{prereq_pm} if $self->{prereq_pm_detected};
return unless $self->{writemakefile} # no need to have succeeded
# but we must have run it
|| $self->{modulebuild};
}
}
}
- if (-f "Build.PL"
- && ! -f "Makefile.PL"
- && ! exists $req->{"Module::Build"}
- && ! $CPAN::META->has_inst("Module::Build")) {
- $CPAN::Frontend->mywarn(" Warning: CPAN.pm discovered Module::Build as ".
- "undeclared prerequisite.\n".
- " Adding it now as such.\n"
- );
- $CPAN::Frontend->mysleep(5);
- $req->{"Module::Build"} = 0;
- delete $self->{writemakefile};
- }
if ($req || $breq) {
- $self->{prereq_pm_detected}++;
return $self->{prereq_pm} = { requires => $req, build_requires => $breq };
}
}
# available
if ( ! $CPAN::META->has_inst("CPAN::Reporter")) {
- $CPAN::Frontend->mywarn(
+ $CPAN::Frontend->mywarnonce(
"CPAN::Reporter not installed. No reports will be sent.\n"
);
return $self->{should_report} = 0;
next DLPRG unless defined $funkyftp;
next DLPRG if $funkyftp =~ /^\s*$/;
- my($asl_ungz, $asl_gz);
- ($asl_ungz = $aslocal) =~ s/\.gz//;
- $asl_gz = "$asl_ungz.gz";
-
my($src_switch) = "";
my($chdir) = "";
- my($stdout_redir) = " > $asl_ungz";
+ my($stdout_redir) = " > \"$aslocal\"";
if ($f eq "lynx") {
$src_switch = " -source";
} elsif ($f eq "ncftp") {
+ next DLPRG unless $url =~ m{\Aftp://};
$src_switch = " -c";
} elsif ($f eq "wget") {
- $src_switch = " -O $asl_ungz";
+ $src_switch = " -O \"$aslocal\"";
$stdout_redir = "";
} elsif ($f eq 'curl') {
$src_switch = ' -L -f -s -S --netrc-optional';
if ($proxy_vars->{http_proxy}) {
$src_switch .= qq{ -U "$proxy_vars->{proxy_user}:$proxy_vars->{proxy_pass}" -x "$proxy_vars->{http_proxy}"};
}
- }
-
- if ($f eq "ncftpget") {
+ } elsif ($f eq "ncftpget") {
+ next DLPRG unless $url =~ m{\Aftp://};
$chdir = "cd $aslocal_dir && ";
$stdout_redir = "";
}
$CPAN::Frontend->myprint(
qq[
-Trying with "$funkyftp$src_switch" to get
- "$url"
+Trying with
+ $funkyftp$src_switch
+to get
+ $url
]);
my($system) =
"$chdir$funkyftp$src_switch \"$url\" $devnull$stdout_redir";
my($wstatus) = system($system);
if ($f eq "lynx") {
# lynx returns 0 when it fails somewhere
- if (-s $asl_ungz) {
+ if (-s $aslocal) {
my $content = do { local *FH;
- open FH, $asl_ungz or die;
+ open FH, $aslocal or die;
local $/;
<FH> };
if ($content =~ /^<.*(<title>[45]|Error [45])/si) {
if (-s $aslocal) {
# Looks good
$some_dl_success++;
- } elsif ($asl_ungz ne $aslocal) {
- # test gzip integrity
- if (eval{CPAN::Tarzip->new($asl_ungz)->gtest}) {
- # e.g. foo.tar is gzipped --> foo.tar.gz
- rename $asl_ungz, $aslocal;
- $some_dl_success++;
- } else {
- eval{CPAN::Tarzip->new($asl_gz)->gzip($asl_ungz)};
- if ($@) {
- warn "Warning: $@";
- } else {
- $some_dl_success++;
- }
- }
}
$ThesiteURL = $ro_url;
return $aslocal;
- } elsif ($url !~ /\.gz(?!\n)\Z/) {
- unlink $asl_ungz if
- -f $asl_ungz && -s _ == 0;
- my $gz = "$aslocal.gz";
- my $gzurl = "$url.gz";
- $CPAN::Frontend->myprint(
- qq[
- Trying with "$funkyftp$src_switch" to get
- "$url.gz"
- ]);
- my($system) = "$funkyftp$src_switch \"$url.gz\" $devnull > $asl_gz";
- $self->debug("system[$system]") if $CPAN::DEBUG;
- my($wstatus);
- if (($wstatus = system($system)) == 0
- &&
- -s $asl_gz
- ) {
- # test gzip integrity
- my $ct = eval{CPAN::Tarzip->new($asl_gz)};
- if ($ct && $ct->gtest) {
- $ct->gunzip($aslocal);
- } else {
- # somebody uncompressed file for us?
- rename $asl_ungz, $aslocal;
- }
- $ThesiteURL = $ro_url;
- return $aslocal;
- } else {
- unlink $asl_gz if -f $asl_gz;
- }
} else {
my $estatus = $wstatus >> 8;
my $size = -f $aslocal ?
"cd /",
map("cd $_", split /\//, $dir), # RFC 1738
"bin",
+ "passive",
"get $getfile $targetfile",
"quit"
);
use File::Spec ();
use CPAN::Mirrors ();
use vars qw($VERSION $silent);
-$VERSION = "5.530001"; # 5.53 + local patches for bleadperl
+$VERSION = "5.5301";
=head1 NAME
The CPAN module can detect when a module which you are trying to build
depends on prerequisites. If this happens, it can build the
prerequisites for you automatically ('follow'), ask you for
-confirmation ('ask'), or just ignore them ('ignore'). Please set your
-policy to one of the three values.
+confirmation ('ask'), or just ignore them ('ignore'). Choosing
+'follow' also sets PERL_AUTOINSTALL and PERL_EXTUTILS_AUTOINSTALL for
+"--defaultdeps" if not already set.
+
+Please set your policy to one of the three values.
Policy on building prerequisites (follow, ask or ignore)?
#= Do we follow PREREQ_PM?
#
- my_prompt_loop(prerequisites_policy => 'ask', $matcher,
+ my_prompt_loop(prerequisites_policy => 'follow', $matcher,
'follow|ask|ignore');
- my_prompt_loop(build_requires_install_policy => 'ask/yes', $matcher,
+ my_prompt_loop(build_requires_install_policy => 'yes', $matcher,
'yes|no|ask/yes|ask/no');
#
my_dflt_prompt(yaml_module => "YAML", $matcher);
my $old_v = $CPAN::Config->{load_module_verbosity};
$CPAN::Config->{load_module_verbosity} = q[none];
- unless ($CPAN::META->has_inst($CPAN::Config->{yaml_module})) {
+ if (!$silent && !$CPAN::META->has_inst($CPAN::Config->{yaml_module})) {
$CPAN::Frontend->mywarn
("Warning (maybe harmless): '$CPAN::Config->{yaml_module}' not installed.\n");
$CPAN::Frontend->mysleep(3);
# verbosity
#
- my_prompt_loop(tar_verbosity => 'v', $matcher,
+ my_prompt_loop(tar_verbosity => 'none', $matcher,
'none|v|vv');
my_prompt_loop(load_module_verbosity => 'none', $matcher,
'none|v');
- my_prompt_loop(perl5lib_verbosity => 'v', $matcher,
+ my_prompt_loop(perl5lib_verbosity => 'none', $matcher,
'none|v');
my_yn_prompt(inhibit_startup_message => 0, $matcher);
use strict;
use vars qw(%can %keys $loading $VERSION);
-$VERSION = "5.5";
+$VERSION = "5.5001"; # see also CPAN::Config::VERSION at end of file
%can = (
commit => "Commit changes to disk",
my($self, %args) = @_;
$CPAN::Be_Silent++ if $args{be_silent};
my $doit;
- $doit = delete $args{doit};
+ $doit = delete $args{doit} || 0;
+ $loading = 0 unless defined $loading;
use Carp;
require_myconfig_or_config;
if ($configpm) {
$INC{$inc_key} = $configpm;
} else {
- my $text = qq{WARNING: CPAN.pm is unable to } .
- qq{create a configuration file.};
- output($text, 'confess');
+ my $myconfigpm = File::Spec->catfile(home,".cpan","CPAN","MyConfig.pm");
+ $CPAN::Frontend->mydie(<<"END");
+WARNING: CPAN.pm is unable to write a configuration file. You need write
+access to your default perl library directories or you must be able to
+create and write to '$myconfigpm'.
+
+Aborting configuration.
+END
}
}
o conf inhibit_startup_message 1
]);
- undef; #don't reprint CPAN::Config
+ 1; #don't reprint CPAN::Config
}
sub cpl {
use strict;
use vars qw($AUTOLOAD $VERSION);
- $VERSION = "5.5";
+ $VERSION = "5.5001";
# formerly CPAN::HandleConfig was known as CPAN::Config
sub AUTOLOAD { ## no critic
package CPAN::Mirrors;
use strict;
use vars qw($VERSION $urllist $silent);
-$VERSION = "1.770001"; # 1.77 + local patches for bleadperl
+$VERSION = "1.77";
use Carp;
use FileHandle;
"CPAN/Tarzip.pm",
"CPAN/Version.pm",
);
-$VERSION = "5.5";
+$VERSION = "5.5001";
# record the initial timestamp for reload.
$reload = { map {$INC{$_} ? ($_,(stat $INC{$_})[9]) : ()} @relo };
@CPAN::Shell::ISA = qw(CPAN::Debug);
#-> sub CPAN::Shell::m ;
sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
my $self = shift;
- $CPAN::Frontend->myprint($self->format_result('Module',@_));
+ my @m = @_;
+ for (@m) {
+ if (m|(?:\w+/)*\w+\.pm$|) { # same regexp in expandany
+ s/.pm$//;
+ s|/|::|g;
+ }
+ }
+ $CPAN::Frontend->myprint($self->format_result('Module',@m));
}
#-> sub CPAN::Shell::i ;
my($self,$s) = @_;
CPAN->debug("s[$s]") if $CPAN::DEBUG;
my $module_as_path = "";
- if ($s =~ m|(?:\w+/)*\w+\.pm$|) {
+ if ($s =~ m|(?:\w+/)*\w+\.pm$|) { # same regexp in sub m
$module_as_path = $s;
$module_as_path =~ s/.pm$//;
$module_as_path =~ s|/|::|g;
);
}
+my %already_printed;
+#-> sub CPAN::Shell::mywarnonce ;
+sub myprintonce {
+ my($self,$what) = @_;
+ $self->myprint($what) unless $already_printed{$what}++;
+}
+
sub optprint {
my($self,$category,$what) = @_;
my $vname = $category . "_verbosity";
$self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red on_white');
}
+my %already_warned;
+#-> sub CPAN::Shell::mywarnonce ;
+sub mywarnonce {
+ my($self,$what) = @_;
+ $self->mywarn($what) unless $already_warned{$what}++;
+}
+
# only to be used for shell commands
#-> sub CPAN::Shell::mydie ;
sub mydie {
use vars qw($VERSION @ISA $BUGHUNTING);
use CPAN::Debug;
use File::Basename qw(basename);
-$VERSION = "5.501";
+$VERSION = "5.5011";
# module is internal to CPAN.pm
@ISA = qw(CPAN::Debug); ## no critic
} else {
$CPAN::Frontend->mydie(qq{
CPAN.pm needs the external program bzip2 in order to handle '$file'.
-Please install it now and run 'o conf init' to register it as external
-program.
+Please install it now and run 'o conf init bzip2' from the
+CPAN shell prompt to register it as external program.
});
}
}
return if $CPAN::Signal;
}
return 1;
- } else {
- my $unzip = $CPAN::Config->{unzip} or
- $CPAN::Frontend->mydie("Cannot unzip, no unzip program available");
+ } elsif ( my $unzip = $CPAN::Config->{unzip} ) {
my @system = ($unzip, $file);
return system(@system) == 0;
}
+ else {
+ $CPAN::Frontend->mydie(<<"END");
+
+Can't unzip '$file':
+
+You have not configured an 'unzip' program and do not have Archive::Zip
+installed. Please either install Archive::Zip or else configure 'unzip'
+by running the command 'o conf init unzip' from the CPAN shell prompt.
+
+END
+ }
}
1;
local $Params::Check::VERBOSE = 1;
-$VERSION = '0.44';
+$VERSION = '0.46';
=pod
}
}
- else {
- my $file = File::Spec->catfile( $dir, '_build', 'prereqs' );
- return unless -f $file;
- my $fh = FileHandle->new();
+ my $file = File::Spec->catfile( $dir, '_build', 'prereqs' );
+ return unless -f $file;
- unless( $fh->open( $file ) ) {
- error( loc( "Cannot open '%1': %2", $file, $! ) );
- return;
- }
-
- $content = do { local $/; <$fh> };
+ my $fh = FileHandle->new();
+
+ unless( $fh->open( $file ) ) {
+ error( loc( "Cannot open '%1': %2", $file, $! ) );
+ return;
}
+
+ $content = do { local $/; <$fh> };
+
}
return unless $content;
require Exporter;
use vars qw[$VERSION @ISA @EXPORT];
- $VERSION = '0.44';
+ $VERSION = '0.46';
@ISA = qw[Exporter];
@EXPORT = qw[ BUILD_DIR BUILD ];
}
### add CPANPLUS' bin dir to the front of $ENV{PATH}, so that cpanp-run-perl
### and friends get picked up, only under PERL_CORE though.
+ $old_env_path = $ENV{PATH};
if ( $ENV{PERL_CORE} ) {
- $old_env_path = $ENV{PATH};
$ENV{'PATH'} = join $Config{'path_sep'},
- grep { defined } "$FindBin::Bin/../../CPANPLUS/bin", $ENV{'PATH'};
-
+ grep { defined } "$FindBin::Bin/../../../utils", $ENV{'PATH'};
}
### Fix up the path to perl, as we're about to chdir
}
}
+ ### CPANPLUS::Config checks 3 specific scenarios first
+ ### when looking for cpanp-run-perl: parallel to cpanp,
+ ### parallel to CPANPLUS.pm, or installed into a custom
+ ### prefix like /tmp/foo. Only *THEN* does it check the
+ ### the path.
+ ### If the perl core is extracted to a directory that has
+ ### cpanp-run-perl installed the same amount of 'uplevels'
+ ### as the /tmp/foo prefix, we'll pull in the wrong script
+ ### by accident.
+ ### Since we set the path to cpanp-run-perl explicitily
+ ### at the top of this script, it's best to update the config
+ ### ourselves with a path lookup, rather than rely on its
+ ### heuristics. Thanks to David Wheeler, Josh Jore and Vincent
+ ### Pit for helping to track this down.
+ if( $ENV{PERL_CORE} ) {
+ $conf->set_program( "perlwrapper" => IPC::Cmd::can_run('cpanp-run-perl') );
+ }
+
$conf->set_conf( source_engine => $ENV{CPANPLUS_SOURCE_ENGINE} )
if $ENV{CPANPLUS_SOURCE_ENGINE};
use strict;
+BEGIN {
my $old = select STDERR; $|++; # turn on autoflush
select $old; $|++; # turn on autoflush
$0 = shift(@ARGV); # rename the script
my $rv = do($0); # execute the file
die $@ if $@; # die on parse/execute error
-
+}
### XXX 'do' returns last statement evaluated, which may be
### undef as well. So don't die in that case.
#die $! if not defined $rv; # die on execute error
use CPANPLUS::Error;
use CPANPLUS::Internals::Utils;
+# File::Spec and Cwd might return different values for a
+# symlinked directory, so we need to be careful.
+sub paths_are_same {
+ my($have, $want, $name) = @_;
+
+ $have = _resolve_symlinks($have);
+ $want = _resolve_symlinks($want);
+
+ my $builder = Test::More->builder;
+ return $builder->like( $have, qr/\Q$want/i, $name );
+}
+
+# Resolve any symlinks in a path
+sub _resolve_symlinks {
+ my $path = shift;
+ my($vol, $dirs, $file) = File::Spec->splitpath($path);
+
+ my $resolved = File::Spec->catpath( $vol, "", "" );
+
+ for my $dir (File::Spec->splitdir($dirs)) {
+ # Resolve the next part of the path
+ my $next = File::Spec->catdir( $resolved, $dir );
+ $next = eval { readlink $next } || $next;
+
+ # If its absolute, use it.
+ # Otherwise tack it onto the end of the previous path.
+ $resolved = File::Spec->file_name_is_absolute($next)
+ ? $next
+ : File::Spec->catdir( $resolved, $next );
+ }
+
+ return File::Spec->catfile($resolved, $file);
+}
+
my $Cwd = File::Spec->rel2abs(cwd());
my $Class = 'CPANPLUS::Internals::Utils';
my $Dir = 'foo';
### test _chdir ###
{ ok( $Class->_chdir( dir => $Dir), "Chdir to '$Dir'" );
- my $abs_re = quotemeta File::Spec->rel2abs(File::Spec->catdir($Cwd,$Dir));
- like( File::Spec->rel2abs(cwd()), qr/$abs_re/i,
+ my $abs = File::Spec->rel2abs(File::Spec->catdir($Cwd,$Dir));
+ paths_are_same( File::Spec->rel2abs(cwd()), $abs,
" Cwd() is '$Dir'");
- my $cwd_re = quotemeta $Cwd;
ok( $Class->_chdir( dir => $Cwd), "Chdir back to '$Cwd'" );
- like( File::Spec->rel2abs(cwd()), qr/$cwd_re/i,
+ paths_are_same( File::Spec->rel2abs(cwd()), $Cwd,
" Cwd() is '$Cwd'" );
}
### add our own path to the front of $ENV{PATH}, so that cpanp-run-perl
### and friends get picked up
$old_env_path = $ENV{PATH};
- $ENV{'PATH'} = join $Config{'path_sep'},
+ if ( $ENV{PERL_CORE} ) {
+ $ENV{'PATH'} = join $Config{'path_sep'},
+ grep { defined } "$FindBin::Bin/../../../utils", $ENV{'PATH'};
+ }
+ else {
+ $ENV{'PATH'} = join $Config{'path_sep'},
grep { defined } "$FindBin::Bin/../bin", $ENV{'PATH'};
+ }
### Fix up the path to perl, as we're about to chdir
### but only under perlcore, or if the path contains delimiters,
}
}
+ ### CPANPLUS::Config checks 3 specific scenarios first
+ ### when looking for cpanp-run-perl: parallel to cpanp,
+ ### parallel to CPANPLUS.pm, or installed into a custom
+ ### prefix like /tmp/foo. Only *THEN* does it check the
+ ### the path.
+ ### If the perl core is extracted to a directory that has
+ ### cpanp-run-perl installed the same amount of 'uplevels'
+ ### as the /tmp/foo prefix, we'll pull in the wrong script
+ ### by accident.
+ ### Since we set the path to cpanp-run-perl explicitily
+ ### at the top of this script, it's best to update the config
+ ### ourselves with a path lookup, rather than rely on its
+ ### heuristics. Thanks to David Wheeler, Josh Jore and Vincent
+ ### Pit for helping to track this down.
+ if( $ENV{PERL_CORE} ) {
+ $conf->set_program( "perlwrapper" => IPC::Cmd::can_run('cpanp-run-perl') );
+ }
+
$conf->set_conf( source_engine => $ENV{CPANPLUS_SOURCE_ENGINE} )
if $ENV{CPANPLUS_SOURCE_ENGINE};
+++ /dev/null
-Revision history for Perl extension Class::ISA
-
-2009-09-29 Steffen Mueller smueller@cpan.org
-
- * Release 0.36 -- fix installation dirs.
-
-2009-09-26 Steffen Mueller smueller@cpan.org
-
- * Release 0.35 -- minor documentation nit.
-
-2009-09-22 Steffen Mueller smueller@cpan.org
-
- * Release 0.34 -- add core deprecation logic,
- some distribution shuffling. No code changes.
-
-2004-12-29 Sean M. Burke sburke@cpan.org
-
- * Release 0.33 -- just rebundling. No code changes.
-
-
-2000-05-13 Sean M. Burke sburke@cpan.org
-
- * Release 0.32 -- Just noting my new email address.
-
-
-1999-05-14 Sean M. Burke sburke@netadventure.net
-
- * Release 0.31 -- release version.
-
- No changes in functionality -- just changed the core algorithm to
- something that should behave the same, but is cleaner and faster.
-
-
-1999-01-23 Sean M. Burke sburke@netadventure.net
-
- * Release 0.20 -- first release version.
+++ /dev/null
-package Class::ISA;
-require 5;
-use strict;
-use vars qw($Debug $VERSION);
-$VERSION = '0.36';
-$Debug = 0 unless defined $Debug;
-
-use if $] >= 5.011, 'deprecate';
-
-###########################################################################
-
-sub self_and_super_versions {
- no strict 'refs';
- map {
- $_ => (defined(${"$_\::VERSION"}) ? ${"$_\::VERSION"} : undef)
- } self_and_super_path($_[0])
-}
-
-# Also consider magic like:
-# no strict 'refs';
-# my %class2SomeHashr =
-# map { defined(%{"$_\::SomeHash"}) ? ($_ => \%{"$_\::SomeHash"}) : () }
-# Class::ISA::self_and_super_path($class);
-# to get a hash of refs to all the defined (and non-empty) hashes in
-# $class and its superclasses.
-#
-# Or even consider this incantation for doing something like hash-data
-# inheritance:
-# no strict 'refs';
-# %union_hash =
-# map { defined(%{"$_\::SomeHash"}) ? %{"$_\::SomeHash"}) : () }
-# reverse(Class::ISA::self_and_super_path($class));
-# Consider that reverse() is necessary because with
-# %foo = ('a', 'wun', 'b', 'tiw', 'a', 'foist');
-# $foo{'a'} is 'foist', not 'wun'.
-
-###########################################################################
-sub super_path {
- my @ret = &self_and_super_path(@_);
- shift @ret if @ret;
- return @ret;
-}
-
-#--------------------------------------------------------------------------
-sub self_and_super_path {
- # Assumption: searching is depth-first.
- # Assumption: '' (empty string) can't be a class package name.
- # Note: 'UNIVERSAL' is not given any special treatment.
- return () unless @_;
-
- my @out = ();
-
- my @in_stack = ($_[0]);
- my %seen = ($_[0] => 1);
-
- my $current;
- while(@in_stack) {
- next unless defined($current = shift @in_stack) && length($current);
- print "At $current\n" if $Debug;
- push @out, $current;
- no strict 'refs';
- unshift @in_stack,
- map
- { my $c = $_; # copy, to avoid being destructive
- substr($c,0,2) = "main::" if substr($c,0,2) eq '::';
- # Canonize the :: -> main::, ::foo -> main::foo thing.
- # Should I ever canonize the Foo'Bar = Foo::Bar thing?
- $seen{$c}++ ? () : $c;
- }
- @{"$current\::ISA"}
- ;
- # I.e., if this class has any parents (at least, ones I've never seen
- # before), push them, in order, onto the stack of classes I need to
- # explore.
- }
-
- return @out;
-}
-#--------------------------------------------------------------------------
-1;
-
-__END__
-
-=head1 NAME
-
-Class::ISA - report the search path for a class's ISA tree
-
-=head1 SYNOPSIS
-
- # Suppose you go: use Food::Fishstick, and that uses and
- # inherits from other things, which in turn use and inherit
- # from other things. And suppose, for sake of brevity of
- # example, that their ISA tree is the same as:
-
- @Food::Fishstick::ISA = qw(Food::Fish Life::Fungus Chemicals);
- @Food::Fish::ISA = qw(Food);
- @Food::ISA = qw(Matter);
- @Life::Fungus::ISA = qw(Life);
- @Chemicals::ISA = qw(Matter);
- @Life::ISA = qw(Matter);
- @Matter::ISA = qw();
-
- use Class::ISA;
- print "Food::Fishstick path is:\n ",
- join(", ", Class::ISA::super_path('Food::Fishstick')),
- "\n";
-
-That prints:
-
- Food::Fishstick path is:
- Food::Fish, Food, Matter, Life::Fungus, Life, Chemicals
-
-=head1 DESCRIPTION
-
-Suppose you have a class (like Food::Fish::Fishstick) that is derived,
-via its @ISA, from one or more superclasses (as Food::Fish::Fishstick
-is from Food::Fish, Life::Fungus, and Chemicals), and some of those
-superclasses may themselves each be derived, via its @ISA, from one or
-more superclasses (as above).
-
-When, then, you call a method in that class ($fishstick->calories),
-Perl first searches there for that method, but if it's not there, it
-goes searching in its superclasses, and so on, in a depth-first (or
-maybe "height-first" is the word) search. In the above example, it'd
-first look in Food::Fish, then Food, then Matter, then Life::Fungus,
-then Life, then Chemicals.
-
-This library, Class::ISA, provides functions that return that list --
-the list (in order) of names of classes Perl would search to find a
-method, with no duplicates.
-
-=head1 FUNCTIONS
-
-=over
-
-=item the function Class::ISA::super_path($CLASS)
-
-This returns the ordered list of names of classes that Perl would
-search thru in order to find a method, with no duplicates in the list.
-$CLASS is not included in the list. UNIVERSAL is not included -- if
-you need to consider it, add it to the end.
-
-
-=item the function Class::ISA::self_and_super_path($CLASS)
-
-Just like C<super_path>, except that $CLASS is included as the first
-element.
-
-=item the function Class::ISA::self_and_super_versions($CLASS)
-
-This returns a hash whose keys are $CLASS and its
-(super-)superclasses, and whose values are the contents of each
-class's $VERSION (or undef, for classes with no $VERSION).
-
-The code for self_and_super_versions is meant to serve as an example
-for precisely the kind of tasks I anticipate that self_and_super_path
-and super_path will be used for. You are strongly advised to read the
-source for self_and_super_versions, and the comments there.
-
-=back
-
-=head1 CAUTIONARY NOTES
-
-* Class::ISA doesn't export anything. You have to address the
-functions with a "Class::ISA::" on the front.
-
-* Contrary to its name, Class::ISA isn't a class; it's just a package.
-Strange, isn't it?
-
-* Say you have a loop in the ISA tree of the class you're calling one
-of the Class::ISA functions on: say that Food inherits from Matter,
-but Matter inherits from Food (for sake of argument). If Perl, while
-searching for a method, actually discovers this cyclicity, it will
-throw a fatal error. The functions in Class::ISA effectively ignore
-this cyclicity; the Class::ISA algorithm is "never go down the same
-path twice", and cyclicities are just a special case of that.
-
-* The Class::ISA functions just look at @ISAs. But theoretically, I
-suppose, AUTOLOADs could bypass Perl's ISA-based search mechanism and
-do whatever they please. That would be bad behavior, tho; and I try
-not to think about that.
-
-* If Perl can't find a method anywhere in the ISA tree, it then looks
-in the magical class UNIVERSAL. This is rarely relevant to the tasks
-that I expect Class::ISA functions to be put to, but if it matters to
-you, then instead of this:
-
- @supers = Class::Tree::super_path($class);
-
-do this:
-
- @supers = (Class::Tree::super_path($class), 'UNIVERSAL');
-
-And don't say no-one ever told ya!
-
-* When you call them, the Class::ISA functions look at @ISAs anew --
-that is, there is no memoization, and so if ISAs change during
-runtime, you get the current ISA tree's path, not anything memoized.
-However, changing ISAs at runtime is probably a sign that you're out
-of your mind!
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (c) 1999-2009 Sean M. Burke. All rights reserved.
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=head1 AUTHOR
-
-Sean M. Burke C<sburke@cpan.org>
-
-=head1 MAINTAINER
-
-Maintained by Steffen Mueller C<smueller@cpan.org>.
-
-=cut
-
+++ /dev/null
-BEGIN {
- chdir 't' if -d 't';
- #@INC = '../lib';
-}
-
-require 5;
-# Time-stamp: "2004-12-29 20:57:15 AST"
-# Summary of, well, things.
-
-use Test;
-BEGIN {plan tests => 2};
-ok 1;
-
-use Class::ISA ();
-
-#chdir "t" if -e "t";
-
-{
- my @out;
- push @out,
- "\n\nPerl v",
- defined($^V) ? sprintf('%vd', $^V) : $],
- " under $^O ",
- (defined(&Win32::BuildNumber) and defined &Win32::BuildNumber())
- ? ("(Win32::BuildNumber ", &Win32::BuildNumber(), ")") : (),
- (defined $MacPerl::Version)
- ? ("(MacPerl version $MacPerl::Version)") : (),
- "\n"
- ;
-
- # Ugly code to walk the symbol tables:
- my %v;
- my @stack = (''); # start out in %::
- my $this;
- my $count = 0;
- my $pref;
- while(@stack) {
- $this = shift @stack;
- die "Too many packages?" if ++$count > 1000;
- next if exists $v{$this};
- next if $this eq 'main'; # %main:: is %::
-
- #print "Peeking at $this => ${$this . '::VERSION'}\n";
-
- if(defined ${$this . '::VERSION'} ) {
- $v{$this} = ${$this . '::VERSION'}
- } elsif(
- defined *{$this . '::ISA'} or defined &{$this . '::import'}
- or ($this ne '' and grep defined *{$_}{'CODE'}, values %{$this . "::"})
- # If it has an ISA, an import, or any subs...
- ) {
- # It's a class/module with no version.
- $v{$this} = undef;
- } else {
- # It's probably an unpopulated package.
- ## $v{$this} = '...';
- }
-
- $pref = length($this) ? "$this\::" : '';
- push @stack, map m/^(.+)::$/ ? "$pref$1" : (), keys %{$this . '::'};
- #print "Stack: @stack\n";
- }
- push @out, " Modules in memory:\n";
- delete @v{'', '[none]'};
- foreach my $p (sort {lc($a) cmp lc($b)} keys %v) {
- $indent = ' ' x (2 + ($p =~ tr/:/:/));
- push @out, ' ', $indent, $p, defined($v{$p}) ? " v$v{$p};\n" : ";\n";
- }
- push @out, sprintf "[at %s (local) / %s (GMT)]\n",
- scalar(gmtime), scalar(localtime);
- my $x = join '', @out;
- $x =~ s/^/#/mg;
- print $x;
-}
-
-print "# Running",
- (chr(65) eq 'A') ? " in an ASCII world.\n" : " in a non-ASCII world.\n",
- "#\n",
-;
-
-print "# \@INC:\n", map("# [$_]\n", @INC), "#\n#\n";
-
-print "# \%INC:\n";
-foreach my $x (sort {lc($a) cmp lc($b)} keys %INC) {
- print "# [$x] = [", $INC{$x} || '', "]\n";
-}
-
-ok 1;
-
+++ /dev/null
-BEGIN {
- chdir 't' if -d 't';
- #@INC = '../lib';
-}
-
-# Time-stamp: "2004-12-29 19:59:33 AST"
-
-BEGIN { $| = 1; print "1..2\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use Class::ISA;
-$loaded = 1;
-print "ok 1\n";
-
- @Food::Fishstick::ISA = qw(Food::Fish Life::Fungus Chemicals);
- @Food::Fish::ISA = qw(Food);
- @Food::ISA = qw(Matter);
- @Life::Fungus::ISA = qw(Life);
- @Chemicals::ISA = qw(Matter);
- @Life::ISA = qw(Matter);
- @Matter::ISA = qw();
-
- use Class::ISA;
- my @path = Class::ISA::super_path('Food::Fishstick');
- my $flat_path = join ' ', @path;
- print "#Food::Fishstick path is:\n# $flat_path\n";
- print
- "Food::Fish Food Matter Life::Fungus Life Chemicals" eq $flat_path ?
- "ok 2\n" : "fail 2!\n";
* Created : 5th October 2005
* Version : 2.000
*
- * Copyright (c) 2005-2007 Paul Marquess. All rights reserved.
+ * Copyright (c) 2005-2010 Paul Marquess. All rights reserved.
* This program is free software; you can redistribute it and/or
* modify it under the same terms as Perl itself.
*
CHANGES
-------
+ 2.023 9 November 2009
+
+ * Removed redundant bzip2 source files from the bzip2-src directory.
+ [RT# 47225]
+
+ * Fixed instance where $[ should have been $] in t/01bzip2.t
+ Thanks to Robin Barker and zefram [RT #50764] for independantly
+ spotting the issue.
2.021 30 August 2009
Compress-Raw-Bzip2
- Version 2.021
+ Version 2.024
- 30th August 2009
+ 7th January 2010
- Copyright (c) 2005-2009 Paul Marquess. All rights reserved.
+ Copyright (c) 2005-2010 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.
If you haven't installed Compress-Raw-Bzip2 then search Compress::Raw::Bzip2.pm
for a line like this:
- $VERSION = "2.021" ;
+ $VERSION = "2.024" ;
c. The version of bzip2 you have used.
If you have successfully installed Compress-Raw-Bzip2, this one-liner
+++ /dev/null
-
-/*-----------------------------------------------------------*/
-/*--- A block-sorting, lossless compressor bzip2.c ---*/
-/*-----------------------------------------------------------*/
-
-/* ------------------------------------------------------------------
- This file is part of bzip2/libbzip2, a program and library for
- lossless, block-sorting data compression.
-
- bzip2/libbzip2 version 1.0.5 of 10 December 2007
- Copyright (C) 1996-2007 Julian Seward <jseward@bzip.org>
-
- Please read the WARNING, DISCLAIMER and PATENTS sections in the
- README file.
-
- This program is released under the terms of the license contained
- in the file LICENSE.
- ------------------------------------------------------------------ */
-
-
-/* Place a 1 beside your platform, and 0 elsewhere.
- Generic 32-bit Unix.
- Also works on 64-bit Unix boxes.
- This is the default.
-*/
-#define BZ_UNIX 1
-
-/*--
- Win32, as seen by Jacob Navia's excellent
- port of (Chris Fraser & David Hanson)'s excellent
- lcc compiler. Or with MS Visual C.
- This is selected automatically if compiled by a compiler which
- defines _WIN32, not including the Cygwin GCC.
---*/
-#define BZ_LCCWIN32 0
-
-#if defined(_WIN32) && !defined(__CYGWIN__)
-#undef BZ_LCCWIN32
-#define BZ_LCCWIN32 1
-#undef BZ_UNIX
-#define BZ_UNIX 0
-#endif
-
-
-/*---------------------------------------------*/
-/*--
- Some stuff for all platforms.
---*/
-
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <signal.h>
-#include <math.h>
-#include <errno.h>
-#include <ctype.h>
-#include "bzlib.h"
-
-#define ERROR_IF_EOF(i) { if ((i) == EOF) ioError(); }
-#define ERROR_IF_NOT_ZERO(i) { if ((i) != 0) ioError(); }
-#define ERROR_IF_MINUS_ONE(i) { if ((i) == (-1)) ioError(); }
-
-
-/*---------------------------------------------*/
-/*--
- Platform-specific stuff.
---*/
-
-#if BZ_UNIX
-# include <fcntl.h>
-# include <sys/types.h>
-# include <utime.h>
-# include <unistd.h>
-# include <sys/stat.h>
-# include <sys/times.h>
-
-# define PATH_SEP '/'
-# define MY_LSTAT lstat
-# define MY_STAT stat
-# define MY_S_ISREG S_ISREG
-# define MY_S_ISDIR S_ISDIR
-
-# define APPEND_FILESPEC(root, name) \
- root=snocString((root), (name))
-
-# define APPEND_FLAG(root, name) \
- root=snocString((root), (name))
-
-# define SET_BINARY_MODE(fd) /**/
-
-# ifdef __GNUC__
-# define NORETURN __attribute__ ((noreturn))
-# else
-# define NORETURN /**/
-# endif
-
-# ifdef __DJGPP__
-# include <io.h>
-# include <fcntl.h>
-# undef MY_LSTAT
-# undef MY_STAT
-# define MY_LSTAT stat
-# define MY_STAT stat
-# undef SET_BINARY_MODE
-# define SET_BINARY_MODE(fd) \
- do { \
- int retVal = setmode ( fileno ( fd ), \
- O_BINARY ); \
- ERROR_IF_MINUS_ONE ( retVal ); \
- } while ( 0 )
-# endif
-
-# ifdef __CYGWIN__
-# include <io.h>
-# include <fcntl.h>
-# undef SET_BINARY_MODE
-# define SET_BINARY_MODE(fd) \
- do { \
- int retVal = setmode ( fileno ( fd ), \
- O_BINARY ); \
- ERROR_IF_MINUS_ONE ( retVal ); \
- } while ( 0 )
-# endif
-#endif /* BZ_UNIX */
-
-
-
-#if BZ_LCCWIN32
-# include <io.h>
-# include <fcntl.h>
-# include <sys\stat.h>
-
-# define NORETURN /**/
-# define PATH_SEP '\\'
-# define MY_LSTAT _stat
-# define MY_STAT _stat
-# define MY_S_ISREG(x) ((x) & _S_IFREG)
-# define MY_S_ISDIR(x) ((x) & _S_IFDIR)
-
-# define APPEND_FLAG(root, name) \
- root=snocString((root), (name))
-
-# define APPEND_FILESPEC(root, name) \
- root = snocString ((root), (name))
-
-# define SET_BINARY_MODE(fd) \
- do { \
- int retVal = setmode ( fileno ( fd ), \
- O_BINARY ); \
- ERROR_IF_MINUS_ONE ( retVal ); \
- } while ( 0 )
-
-#endif /* BZ_LCCWIN32 */
-
-
-/*---------------------------------------------*/
-/*--
- Some more stuff for all platforms :-)
---*/
-
-typedef char Char;
-typedef unsigned char Bool;
-typedef unsigned char UChar;
-typedef int Int32;
-typedef unsigned int UInt32;
-typedef short Int16;
-typedef unsigned short UInt16;
-
-#define True ((Bool)1)
-#define False ((Bool)0)
-
-/*--
- IntNative is your platform's `native' int size.
- Only here to avoid probs with 64-bit platforms.
---*/
-typedef int IntNative;
-
-
-/*---------------------------------------------------*/
-/*--- Misc (file handling) data decls ---*/
-/*---------------------------------------------------*/
-
-Int32 verbosity;
-Bool keepInputFiles, smallMode, deleteOutputOnInterrupt;
-Bool forceOverwrite, testFailsExist, unzFailsExist, noisy;
-Int32 numFileNames, numFilesProcessed, blockSize100k;
-Int32 exitValue;
-
-/*-- source modes; F==file, I==stdin, O==stdout --*/
-#define SM_I2O 1
-#define SM_F2O 2
-#define SM_F2F 3
-
-/*-- operation modes --*/
-#define OM_Z 1
-#define OM_UNZ 2
-#define OM_TEST 3
-
-Int32 opMode;
-Int32 srcMode;
-
-#define FILE_NAME_LEN 1034
-
-Int32 longestFileName;
-Char inName [FILE_NAME_LEN];
-Char outName[FILE_NAME_LEN];
-Char tmpName[FILE_NAME_LEN];
-Char *progName;
-Char progNameReally[FILE_NAME_LEN];
-FILE *outputHandleJustInCase;
-Int32 workFactor;
-
-static void panic ( const Char* ) NORETURN;
-static void ioError ( void ) NORETURN;
-static void outOfMemory ( void ) NORETURN;
-static void configError ( void ) NORETURN;
-static void crcError ( void ) NORETURN;
-static void cleanUpAndFail ( Int32 ) NORETURN;
-static void compressedStreamEOF ( void ) NORETURN;
-
-static void copyFileName ( Char*, Char* );
-static void* myMalloc ( Int32 );
-static void applySavedFileAttrToOutputFile ( IntNative fd );
-
-
-
-/*---------------------------------------------------*/
-/*--- An implementation of 64-bit ints. Sigh. ---*/
-/*--- Roll on widespread deployment of ANSI C9X ! ---*/
-/*---------------------------------------------------*/
-
-typedef
- struct { UChar b[8]; }
- UInt64;
-
-
-static
-void uInt64_from_UInt32s ( UInt64* n, UInt32 lo32, UInt32 hi32 )
-{
- n->b[7] = (UChar)((hi32 >> 24) & 0xFF);
- n->b[6] = (UChar)((hi32 >> 16) & 0xFF);
- n->b[5] = (UChar)((hi32 >> 8) & 0xFF);
- n->b[4] = (UChar) (hi32 & 0xFF);
- n->b[3] = (UChar)((lo32 >> 24) & 0xFF);
- n->b[2] = (UChar)((lo32 >> 16) & 0xFF);
- n->b[1] = (UChar)((lo32 >> 8) & 0xFF);
- n->b[0] = (UChar) (lo32 & 0xFF);
-}
-
-
-static
-double uInt64_to_double ( UInt64* n )
-{
- Int32 i;
- double base = 1.0;
- double sum = 0.0;
- for (i = 0; i < 8; i++) {
- sum += base * (double)(n->b[i]);
- base *= 256.0;
- }
- return sum;
-}
-
-
-static
-Bool uInt64_isZero ( UInt64* n )
-{
- Int32 i;
- for (i = 0; i < 8; i++)
- if (n->b[i] != 0) return 0;
- return 1;
-}
-
-
-/* Divide *n by 10, and return the remainder. */
-static
-Int32 uInt64_qrm10 ( UInt64* n )
-{
- UInt32 rem, tmp;
- Int32 i;
- rem = 0;
- for (i = 7; i >= 0; i--) {
- tmp = rem * 256 + n->b[i];
- n->b[i] = tmp / 10;
- rem = tmp % 10;
- }
- return rem;
-}
-
-
-/* ... and the Whole Entire Point of all this UInt64 stuff is
- so that we can supply the following function.
-*/
-static
-void uInt64_toAscii ( char* outbuf, UInt64* n )
-{
- Int32 i, q;
- UChar buf[32];
- Int32 nBuf = 0;
- UInt64 n_copy = *n;
- do {
- q = uInt64_qrm10 ( &n_copy );
- buf[nBuf] = q + '0';
- nBuf++;
- } while (!uInt64_isZero(&n_copy));
- outbuf[nBuf] = 0;
- for (i = 0; i < nBuf; i++)
- outbuf[i] = buf[nBuf-i-1];
-}
-
-
-/*---------------------------------------------------*/
-/*--- Processing of complete files and streams ---*/
-/*---------------------------------------------------*/
-
-/*---------------------------------------------*/
-static
-Bool myfeof ( FILE* f )
-{
- Int32 c = fgetc ( f );
- if (c == EOF) return True;
- ungetc ( c, f );
- return False;
-}
-
-
-/*---------------------------------------------*/
-static
-void compressStream ( FILE *stream, FILE *zStream )
-{
- BZFILE* bzf = NULL;
- UChar ibuf[5000];
- Int32 nIbuf;
- UInt32 nbytes_in_lo32, nbytes_in_hi32;
- UInt32 nbytes_out_lo32, nbytes_out_hi32;
- Int32 bzerr, bzerr_dummy, ret;
-
- SET_BINARY_MODE(stream);
- SET_BINARY_MODE(zStream);
-
- if (ferror(stream)) goto errhandler_io;
- if (ferror(zStream)) goto errhandler_io;
-
- bzf = BZ2_bzWriteOpen ( &bzerr, zStream,
- blockSize100k, verbosity, workFactor );
- if (bzerr != BZ_OK) goto errhandler;
-
- if (verbosity >= 2) fprintf ( stderr, "\n" );
-
- while (True) {
-
- if (myfeof(stream)) break;
- nIbuf = fread ( ibuf, sizeof(UChar), 5000, stream );
- if (ferror(stream)) goto errhandler_io;
- if (nIbuf > 0) BZ2_bzWrite ( &bzerr, bzf, (void*)ibuf, nIbuf );
- if (bzerr != BZ_OK) goto errhandler;
-
- }
-
- BZ2_bzWriteClose64 ( &bzerr, bzf, 0,
- &nbytes_in_lo32, &nbytes_in_hi32,
- &nbytes_out_lo32, &nbytes_out_hi32 );
- if (bzerr != BZ_OK) goto errhandler;
-
- if (ferror(zStream)) goto errhandler_io;
- ret = fflush ( zStream );
- if (ret == EOF) goto errhandler_io;
- if (zStream != stdout) {
- Int32 fd = fileno ( zStream );
- if (fd < 0) goto errhandler_io;
- applySavedFileAttrToOutputFile ( fd );
- ret = fclose ( zStream );
- outputHandleJustInCase = NULL;
- if (ret == EOF) goto errhandler_io;
- }
- outputHandleJustInCase = NULL;
- if (ferror(stream)) goto errhandler_io;
- ret = fclose ( stream );
- if (ret == EOF) goto errhandler_io;
-
- if (verbosity >= 1) {
- if (nbytes_in_lo32 == 0 && nbytes_in_hi32 == 0) {
- fprintf ( stderr, " no data compressed.\n");
- } else {
- Char buf_nin[32], buf_nout[32];
- UInt64 nbytes_in, nbytes_out;
- double nbytes_in_d, nbytes_out_d;
- uInt64_from_UInt32s ( &nbytes_in,
- nbytes_in_lo32, nbytes_in_hi32 );
- uInt64_from_UInt32s ( &nbytes_out,
- nbytes_out_lo32, nbytes_out_hi32 );
- nbytes_in_d = uInt64_to_double ( &nbytes_in );
- nbytes_out_d = uInt64_to_double ( &nbytes_out );
- uInt64_toAscii ( buf_nin, &nbytes_in );
- uInt64_toAscii ( buf_nout, &nbytes_out );
- fprintf ( stderr, "%6.3f:1, %6.3f bits/byte, "
- "%5.2f%% saved, %s in, %s out.\n",
- nbytes_in_d / nbytes_out_d,
- (8.0 * nbytes_out_d) / nbytes_in_d,
- 100.0 * (1.0 - nbytes_out_d / nbytes_in_d),
- buf_nin,
- buf_nout
- );
- }
- }
-
- return;
-
- errhandler:
- BZ2_bzWriteClose64 ( &bzerr_dummy, bzf, 1,
- &nbytes_in_lo32, &nbytes_in_hi32,
- &nbytes_out_lo32, &nbytes_out_hi32 );
- switch (bzerr) {
- case BZ_CONFIG_ERROR:
- configError(); break;
- case BZ_MEM_ERROR:
- outOfMemory (); break;
- case BZ_IO_ERROR:
- errhandler_io:
- ioError(); break;
- default:
- panic ( "compress:unexpected error" );
- }
-
- panic ( "compress:end" );
- /*notreached*/
-}
-
-
-
-/*---------------------------------------------*/
-static
-Bool uncompressStream ( FILE *zStream, FILE *stream )
-{
- BZFILE* bzf = NULL;
- Int32 bzerr, bzerr_dummy, ret, nread, streamNo, i;
- UChar obuf[5000];
- UChar unused[BZ_MAX_UNUSED];
- Int32 nUnused;
- void* unusedTmpV;
- UChar* unusedTmp;
-
- nUnused = 0;
- streamNo = 0;
-
- SET_BINARY_MODE(stream);
- SET_BINARY_MODE(zStream);
-
- if (ferror(stream)) goto errhandler_io;
- if (ferror(zStream)) goto errhandler_io;
-
- while (True) {
-
- bzf = BZ2_bzReadOpen (
- &bzerr, zStream, verbosity,
- (int)smallMode, unused, nUnused
- );
- if (bzf == NULL || bzerr != BZ_OK) goto errhandler;
- streamNo++;
-
- while (bzerr == BZ_OK) {
- nread = BZ2_bzRead ( &bzerr, bzf, obuf, 5000 );
- if (bzerr == BZ_DATA_ERROR_MAGIC) goto trycat;
- if ((bzerr == BZ_OK || bzerr == BZ_STREAM_END) && nread > 0)
- fwrite ( obuf, sizeof(UChar), nread, stream );
- if (ferror(stream)) goto errhandler_io;
- }
- if (bzerr != BZ_STREAM_END) goto errhandler;
-
- BZ2_bzReadGetUnused ( &bzerr, bzf, &unusedTmpV, &nUnused );
- if (bzerr != BZ_OK) panic ( "decompress:bzReadGetUnused" );
-
- unusedTmp = (UChar*)unusedTmpV;
- for (i = 0; i < nUnused; i++) unused[i] = unusedTmp[i];
-
- BZ2_bzReadClose ( &bzerr, bzf );
- if (bzerr != BZ_OK) panic ( "decompress:bzReadGetUnused" );
-
- if (nUnused == 0 && myfeof(zStream)) break;
- }
-
- closeok:
- if (ferror(zStream)) goto errhandler_io;
- if (stream != stdout) {
- Int32 fd = fileno ( stream );
- if (fd < 0) goto errhandler_io;
- applySavedFileAttrToOutputFile ( fd );
- }
- ret = fclose ( zStream );
- if (ret == EOF) goto errhandler_io;
-
- if (ferror(stream)) goto errhandler_io;
- ret = fflush ( stream );
- if (ret != 0) goto errhandler_io;
- if (stream != stdout) {
- ret = fclose ( stream );
- outputHandleJustInCase = NULL;
- if (ret == EOF) goto errhandler_io;
- }
- outputHandleJustInCase = NULL;
- if (verbosity >= 2) fprintf ( stderr, "\n " );
- return True;
-
- trycat:
- if (forceOverwrite) {
- rewind(zStream);
- while (True) {
- if (myfeof(zStream)) break;
- nread = fread ( obuf, sizeof(UChar), 5000, zStream );
- if (ferror(zStream)) goto errhandler_io;
- if (nread > 0) fwrite ( obuf, sizeof(UChar), nread, stream );
- if (ferror(stream)) goto errhandler_io;
- }
- goto closeok;
- }
-
- errhandler:
- BZ2_bzReadClose ( &bzerr_dummy, bzf );
- switch (bzerr) {
- case BZ_CONFIG_ERROR:
- configError(); break;
- case BZ_IO_ERROR:
- errhandler_io:
- ioError(); break;
- case BZ_DATA_ERROR:
- crcError();
- case BZ_MEM_ERROR:
- outOfMemory();
- case BZ_UNEXPECTED_EOF:
- compressedStreamEOF();
- case BZ_DATA_ERROR_MAGIC:
- if (zStream != stdin) fclose(zStream);
- if (stream != stdout) fclose(stream);
- if (streamNo == 1) {
- return False;
- } else {
- if (noisy)
- fprintf ( stderr,
- "\n%s: %s: trailing garbage after EOF ignored\n",
- progName, inName );
- return True;
- }
- default:
- panic ( "decompress:unexpected error" );
- }
-
- panic ( "decompress:end" );
- return True; /*notreached*/
-}
-
-
-/*---------------------------------------------*/
-static
-Bool testStream ( FILE *zStream )
-{
- BZFILE* bzf = NULL;
- Int32 bzerr, bzerr_dummy, ret, nread, streamNo, i;
- UChar obuf[5000];
- UChar unused[BZ_MAX_UNUSED];
- Int32 nUnused;
- void* unusedTmpV;
- UChar* unusedTmp;
-
- nUnused = 0;
- streamNo = 0;
-
- SET_BINARY_MODE(zStream);
- if (ferror(zStream)) goto errhandler_io;
-
- while (True) {
-
- bzf = BZ2_bzReadOpen (
- &bzerr, zStream, verbosity,
- (int)smallMode, unused, nUnused
- );
- if (bzf == NULL || bzerr != BZ_OK) goto errhandler;
- streamNo++;
-
- while (bzerr == BZ_OK) {
- nread = BZ2_bzRead ( &bzerr, bzf, obuf, 5000 );
- if (bzerr == BZ_DATA_ERROR_MAGIC) goto errhandler;
- }
- if (bzerr != BZ_STREAM_END) goto errhandler;
-
- BZ2_bzReadGetUnused ( &bzerr, bzf, &unusedTmpV, &nUnused );
- if (bzerr != BZ_OK) panic ( "test:bzReadGetUnused" );
-
- unusedTmp = (UChar*)unusedTmpV;
- for (i = 0; i < nUnused; i++) unused[i] = unusedTmp[i];
-
- BZ2_bzReadClose ( &bzerr, bzf );
- if (bzerr != BZ_OK) panic ( "test:bzReadGetUnused" );
- if (nUnused == 0 && myfeof(zStream)) break;
-
- }
-
- if (ferror(zStream)) goto errhandler_io;
- ret = fclose ( zStream );
- if (ret == EOF) goto errhandler_io;
-
- if (verbosity >= 2) fprintf ( stderr, "\n " );
- return True;
-
- errhandler:
- BZ2_bzReadClose ( &bzerr_dummy, bzf );
- if (verbosity == 0)
- fprintf ( stderr, "%s: %s: ", progName, inName );
- switch (bzerr) {
- case BZ_CONFIG_ERROR:
- configError(); break;
- case BZ_IO_ERROR:
- errhandler_io:
- ioError(); break;
- case BZ_DATA_ERROR:
- fprintf ( stderr,
- "data integrity (CRC) error in data\n" );
- return False;
- case BZ_MEM_ERROR:
- outOfMemory();
- case BZ_UNEXPECTED_EOF:
- fprintf ( stderr,
- "file ends unexpectedly\n" );
- return False;
- case BZ_DATA_ERROR_MAGIC:
- if (zStream != stdin) fclose(zStream);
- if (streamNo == 1) {
- fprintf ( stderr,
- "bad magic number (file not created by bzip2)\n" );
- return False;
- } else {
- if (noisy)
- fprintf ( stderr,
- "trailing garbage after EOF ignored\n" );
- return True;
- }
- default:
- panic ( "test:unexpected error" );
- }
-
- panic ( "test:end" );
- return True; /*notreached*/
-}
-
-
-/*---------------------------------------------------*/
-/*--- Error [non-] handling grunge ---*/
-/*---------------------------------------------------*/
-
-/*---------------------------------------------*/
-static
-void setExit ( Int32 v )
-{
- if (v > exitValue) exitValue = v;
-}
-
-
-/*---------------------------------------------*/
-static
-void cadvise ( void )
-{
- if (noisy)
- fprintf (
- stderr,
- "\nIt is possible that the compressed file(s) have become corrupted.\n"
- "You can use the -tvv option to test integrity of such files.\n\n"
- "You can use the `bzip2recover' program to attempt to recover\n"
- "data from undamaged sections of corrupted files.\n\n"
- );
-}
-
-
-/*---------------------------------------------*/
-static
-void showFileNames ( void )
-{
- if (noisy)
- fprintf (
- stderr,
- "\tInput file = %s, output file = %s\n",
- inName, outName
- );
-}
-
-
-/*---------------------------------------------*/
-static
-void cleanUpAndFail ( Int32 ec )
-{
- IntNative retVal;
- struct MY_STAT statBuf;
-
- if ( srcMode == SM_F2F
- && opMode != OM_TEST
- && deleteOutputOnInterrupt ) {
-
- /* Check whether input file still exists. Delete output file
- only if input exists to avoid loss of data. Joerg Prante, 5
- January 2002. (JRS 06-Jan-2002: other changes in 1.0.2 mean
- this is less likely to happen. But to be ultra-paranoid, we
- do the check anyway.) */
- retVal = MY_STAT ( inName, &statBuf );
- if (retVal == 0) {
- if (noisy)
- fprintf ( stderr,
- "%s: Deleting output file %s, if it exists.\n",
- progName, outName );
- if (outputHandleJustInCase != NULL)
- fclose ( outputHandleJustInCase );
- retVal = remove ( outName );
- if (retVal != 0)
- fprintf ( stderr,
- "%s: WARNING: deletion of output file "
- "(apparently) failed.\n",
- progName );
- } else {
- fprintf ( stderr,
- "%s: WARNING: deletion of output file suppressed\n",
- progName );
- fprintf ( stderr,
- "%s: since input file no longer exists. Output file\n",
- progName );
- fprintf ( stderr,
- "%s: `%s' may be incomplete.\n",
- progName, outName );
- fprintf ( stderr,
- "%s: I suggest doing an integrity test (bzip2 -tv)"
- " of it.\n",
- progName );
- }
- }
-
- if (noisy && numFileNames > 0 && numFilesProcessed < numFileNames) {
- fprintf ( stderr,
- "%s: WARNING: some files have not been processed:\n"
- "%s: %d specified on command line, %d not processed yet.\n\n",
- progName, progName,
- numFileNames, numFileNames - numFilesProcessed );
- }
- setExit(ec);
- exit(exitValue);
-}
-
-
-/*---------------------------------------------*/
-static
-void panic ( const Char* s )
-{
- fprintf ( stderr,
- "\n%s: PANIC -- internal consistency error:\n"
- "\t%s\n"
- "\tThis is a BUG. Please report it to me at:\n"
- "\tjseward@bzip.org\n",
- progName, s );
- showFileNames();
- cleanUpAndFail( 3 );
-}
-
-
-/*---------------------------------------------*/
-static
-void crcError ( void )
-{
- fprintf ( stderr,
- "\n%s: Data integrity error when decompressing.\n",
- progName );
- showFileNames();
- cadvise();
- cleanUpAndFail( 2 );
-}
-
-
-/*---------------------------------------------*/
-static
-void compressedStreamEOF ( void )
-{
- if (noisy) {
- fprintf ( stderr,
- "\n%s: Compressed file ends unexpectedly;\n\t"
- "perhaps it is corrupted? *Possible* reason follows.\n",
- progName );
- perror ( progName );
- showFileNames();
- cadvise();
- }
- cleanUpAndFail( 2 );
-}
-
-
-/*---------------------------------------------*/
-static
-void ioError ( void )
-{
- fprintf ( stderr,
- "\n%s: I/O or other error, bailing out. "
- "Possible reason follows.\n",
- progName );
- perror ( progName );
- showFileNames();
- cleanUpAndFail( 1 );
-}
-
-
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-
-/*---------------------------------------------*/
-static
-void mySignalCatcher ( IntNative n )
-{
- fprintf ( stderr,
- "\n%s: Control-C or similar caught, quitting.\n",
- progName );
- cleanUpAndFail(1);
-}
-
-
-/*---------------------------------------------*/
-static
-void mySIGSEGVorSIGBUScatcher ( IntNative n )
-{
- if (opMode == OM_Z)
- fprintf (
- stderr,
- "\n%s: Caught a SIGSEGV or SIGBUS whilst compressing.\n"
- "\n"
- " Possible causes are (most likely first):\n"
- " (1) This computer has unreliable memory or cache hardware\n"
- " (a surprisingly common problem; try a different machine.)\n"
- " (2) A bug in the compiler used to create this executable\n"
- " (unlikely, if you didn't compile bzip2 yourself.)\n"
- " (3) A real bug in bzip2 -- I hope this should never be the case.\n"
- " The user's manual, Section 4.3, has more info on (1) and (2).\n"
- " \n"
- " If you suspect this is a bug in bzip2, or are unsure about (1)\n"
- " or (2), feel free to report it to me at: jseward@bzip.org.\n"
- " Section 4.3 of the user's manual describes the info a useful\n"
- " bug report should have. If the manual is available on your\n"
- " system, please try and read it before mailing me. If you don't\n"
- " have the manual or can't be bothered to read it, mail me anyway.\n"
- "\n",
- progName );
- else
- fprintf (
- stderr,
- "\n%s: Caught a SIGSEGV or SIGBUS whilst decompressing.\n"
- "\n"
- " Possible causes are (most likely first):\n"
- " (1) The compressed data is corrupted, and bzip2's usual checks\n"
- " failed to detect this. Try bzip2 -tvv my_file.bz2.\n"
- " (2) This computer has unreliable memory or cache hardware\n"
- " (a surprisingly common problem; try a different machine.)\n"
- " (3) A bug in the compiler used to create this executable\n"
- " (unlikely, if you didn't compile bzip2 yourself.)\n"
- " (4) A real bug in bzip2 -- I hope this should never be the case.\n"
- " The user's manual, Section 4.3, has more info on (2) and (3).\n"
- " \n"
- " If you suspect this is a bug in bzip2, or are unsure about (2)\n"
- " or (3), feel free to report it to me at: jseward@bzip.org.\n"
- " Section 4.3 of the user's manual describes the info a useful\n"
- " bug report should have. If the manual is available on your\n"
- " system, please try and read it before mailing me. If you don't\n"
- " have the manual or can't be bothered to read it, mail me anyway.\n"
- "\n",
- progName );
-
- showFileNames();
- if (opMode == OM_Z)
- cleanUpAndFail( 3 ); else
- { cadvise(); cleanUpAndFail( 2 ); }
-}
-
-#ifdef __cplusplus
-}
-#endif
-
-/*---------------------------------------------*/
-static
-void outOfMemory ( void )
-{
- fprintf ( stderr,
- "\n%s: couldn't allocate enough memory\n",
- progName );
- showFileNames();
- cleanUpAndFail(1);
-}
-
-
-/*---------------------------------------------*/
-static
-void configError ( void )
-{
- fprintf ( stderr,
- "bzip2: I'm not configured correctly for this platform!\n"
- "\tI require Int32, Int16 and Char to have sizes\n"
- "\tof 4, 2 and 1 bytes to run properly, and they don't.\n"
- "\tProbably you can fix this by defining them correctly,\n"
- "\tand recompiling. Bye!\n" );
- setExit(3);
- exit(exitValue);
-}
-
-
-/*---------------------------------------------------*/
-/*--- The main driver machinery ---*/
-/*---------------------------------------------------*/
-
-/* All rather crufty. The main problem is that input files
- are stat()d multiple times before use. This should be
- cleaned up.
-*/
-
-/*---------------------------------------------*/
-static
-void pad ( Char *s )
-{
- Int32 i;
- if ( (Int32)strlen(s) >= longestFileName ) return;
- for (i = 1; i <= longestFileName - (Int32)strlen(s); i++)
- fprintf ( stderr, " " );
-}
-
-
-/*---------------------------------------------*/
-static
-void copyFileName ( Char* to, Char* from )
-{
- if ( strlen(from) > FILE_NAME_LEN-10 ) {
- fprintf (
- stderr,
- "bzip2: file name\n`%s'\n"
- "is suspiciously (more than %d chars) long.\n"
- "Try using a reasonable file name instead. Sorry! :-)\n",
- from, FILE_NAME_LEN-10
- );
- setExit(1);
- exit(exitValue);
- }
-
- strncpy(to,from,FILE_NAME_LEN-10);
- to[FILE_NAME_LEN-10]='\0';
-}
-
-
-/*---------------------------------------------*/
-static
-Bool fileExists ( Char* name )
-{
- FILE *tmp = fopen ( name, "rb" );
- Bool exists = (tmp != NULL);
- if (tmp != NULL) fclose ( tmp );
- return exists;
-}
-
-
-/*---------------------------------------------*/
-/* Open an output file safely with O_EXCL and good permissions.
- This avoids a race condition in versions < 1.0.2, in which
- the file was first opened and then had its interim permissions
- set safely. We instead use open() to create the file with
- the interim permissions required. (--- --- rw-).
-
- For non-Unix platforms, if we are not worrying about
- security issues, simple this simply behaves like fopen.
-*/
-static
-FILE* fopen_output_safely ( Char* name, const char* mode )
-{
-# if BZ_UNIX
- FILE* fp;
- IntNative fh;
- fh = open(name, O_WRONLY|O_CREAT|O_EXCL, S_IWUSR|S_IRUSR);
- if (fh == -1) return NULL;
- fp = fdopen(fh, mode);
- if (fp == NULL) close(fh);
- return fp;
-# else
- return fopen(name, mode);
-# endif
-}
-
-
-/*---------------------------------------------*/
-/*--
- if in doubt, return True
---*/
-static
-Bool notAStandardFile ( Char* name )
-{
- IntNative i;
- struct MY_STAT statBuf;
-
- i = MY_LSTAT ( name, &statBuf );
- if (i != 0) return True;
- if (MY_S_ISREG(statBuf.st_mode)) return False;
- return True;
-}
-
-
-/*---------------------------------------------*/
-/*--
- rac 11/21/98 see if file has hard links to it
---*/
-static
-Int32 countHardLinks ( Char* name )
-{
- IntNative i;
- struct MY_STAT statBuf;
-
- i = MY_LSTAT ( name, &statBuf );
- if (i != 0) return 0;
- return (statBuf.st_nlink - 1);
-}
-
-
-/*---------------------------------------------*/
-/* Copy modification date, access date, permissions and owner from the
- source to destination file. We have to copy this meta-info off
- into fileMetaInfo before starting to compress / decompress it,
- because doing it afterwards means we get the wrong access time.
-
- To complicate matters, in compress() and decompress() below, the
- sequence of tests preceding the call to saveInputFileMetaInfo()
- involves calling fileExists(), which in turn establishes its result
- by attempting to fopen() the file, and if successful, immediately
- fclose()ing it again. So we have to assume that the fopen() call
- does not cause the access time field to be updated.
-
- Reading of the man page for stat() (man 2 stat) on RedHat 7.2 seems
- to imply that merely doing open() will not affect the access time.
- Therefore we merely need to hope that the C library only does
- open() as a result of fopen(), and not any kind of read()-ahead
- cleverness.
-
- It sounds pretty fragile to me. Whether this carries across
- robustly to arbitrary Unix-like platforms (or even works robustly
- on this one, RedHat 7.2) is unknown to me. Nevertheless ...
-*/
-#if BZ_UNIX
-static
-struct MY_STAT fileMetaInfo;
-#endif
-
-static
-void saveInputFileMetaInfo ( Char *srcName )
-{
-# if BZ_UNIX
- IntNative retVal;
- /* Note use of stat here, not lstat. */
- retVal = MY_STAT( srcName, &fileMetaInfo );
- ERROR_IF_NOT_ZERO ( retVal );
-# endif
-}
-
-
-static
-void applySavedTimeInfoToOutputFile ( Char *dstName )
-{
-# if BZ_UNIX
- IntNative retVal;
- struct utimbuf uTimBuf;
-
- uTimBuf.actime = fileMetaInfo.st_atime;
- uTimBuf.modtime = fileMetaInfo.st_mtime;
-
- retVal = utime ( dstName, &uTimBuf );
- ERROR_IF_NOT_ZERO ( retVal );
-# endif
-}
-
-static
-void applySavedFileAttrToOutputFile ( IntNative fd )
-{
-# if BZ_UNIX
- IntNative retVal;
-
- retVal = fchmod ( fd, fileMetaInfo.st_mode );
- ERROR_IF_NOT_ZERO ( retVal );
-
- (void) fchown ( fd, fileMetaInfo.st_uid, fileMetaInfo.st_gid );
- /* chown() will in many cases return with EPERM, which can
- be safely ignored.
- */
-# endif
-}
-
-
-/*---------------------------------------------*/
-static
-Bool containsDubiousChars ( Char* name )
-{
-# if BZ_UNIX
- /* On unix, files can contain any characters and the file expansion
- * is performed by the shell.
- */
- return False;
-# else /* ! BZ_UNIX */
- /* On non-unix (Win* platforms), wildcard characters are not allowed in
- * filenames.
- */
- for (; *name != '\0'; name++)
- if (*name == '?' || *name == '*') return True;
- return False;
-# endif /* BZ_UNIX */
-}
-
-
-/*---------------------------------------------*/
-#define BZ_N_SUFFIX_PAIRS 4
-
-const Char* zSuffix[BZ_N_SUFFIX_PAIRS]
- = { ".bz2", ".bz", ".tbz2", ".tbz" };
-const Char* unzSuffix[BZ_N_SUFFIX_PAIRS]
- = { "", "", ".tar", ".tar" };
-
-static
-Bool hasSuffix ( Char* s, const Char* suffix )
-{
- Int32 ns = strlen(s);
- Int32 nx = strlen(suffix);
- if (ns < nx) return False;
- if (strcmp(s + ns - nx, suffix) == 0) return True;
- return False;
-}
-
-static
-Bool mapSuffix ( Char* name,
- const Char* oldSuffix,
- const Char* newSuffix )
-{
- if (!hasSuffix(name,oldSuffix)) return False;
- name[strlen(name)-strlen(oldSuffix)] = 0;
- strcat ( name, newSuffix );
- return True;
-}
-
-
-/*---------------------------------------------*/
-static
-void compress ( Char *name )
-{
- FILE *inStr;
- FILE *outStr;
- Int32 n, i;
- struct MY_STAT statBuf;
-
- deleteOutputOnInterrupt = False;
-
- if (name == NULL && srcMode != SM_I2O)
- panic ( "compress: bad modes\n" );
-
- switch (srcMode) {
- case SM_I2O:
- copyFileName ( inName, (Char*)"(stdin)" );
- copyFileName ( outName, (Char*)"(stdout)" );
- break;
- case SM_F2F:
- copyFileName ( inName, name );
- copyFileName ( outName, name );
- strcat ( outName, ".bz2" );
- break;
- case SM_F2O:
- copyFileName ( inName, name );
- copyFileName ( outName, (Char*)"(stdout)" );
- break;
- }
-
- if ( srcMode != SM_I2O && containsDubiousChars ( inName ) ) {
- if (noisy)
- fprintf ( stderr, "%s: There are no files matching `%s'.\n",
- progName, inName );
- setExit(1);
- return;
- }
- if ( srcMode != SM_I2O && !fileExists ( inName ) ) {
- fprintf ( stderr, "%s: Can't open input file %s: %s.\n",
- progName, inName, strerror(errno) );
- setExit(1);
- return;
- }
- for (i = 0; i < BZ_N_SUFFIX_PAIRS; i++) {
- if (hasSuffix(inName, zSuffix[i])) {
- if (noisy)
- fprintf ( stderr,
- "%s: Input file %s already has %s suffix.\n",
- progName, inName, zSuffix[i] );
- setExit(1);
- return;
- }
- }
- if ( srcMode == SM_F2F || srcMode == SM_F2O ) {
- MY_STAT(inName, &statBuf);
- if ( MY_S_ISDIR(statBuf.st_mode) ) {
- fprintf( stderr,
- "%s: Input file %s is a directory.\n",
- progName,inName);
- setExit(1);
- return;
- }
- }
- if ( srcMode == SM_F2F && !forceOverwrite && notAStandardFile ( inName )) {
- if (noisy)
- fprintf ( stderr, "%s: Input file %s is not a normal file.\n",
- progName, inName );
- setExit(1);
- return;
- }
- if ( srcMode == SM_F2F && fileExists ( outName ) ) {
- if (forceOverwrite) {
- remove(outName);
- } else {
- fprintf ( stderr, "%s: Output file %s already exists.\n",
- progName, outName );
- setExit(1);
- return;
- }
- }
- if ( srcMode == SM_F2F && !forceOverwrite &&
- (n=countHardLinks ( inName )) > 0) {
- fprintf ( stderr, "%s: Input file %s has %d other link%s.\n",
- progName, inName, n, n > 1 ? "s" : "" );
- setExit(1);
- return;
- }
-
- if ( srcMode == SM_F2F ) {
- /* Save the file's meta-info before we open it. Doing it later
- means we mess up the access times. */
- saveInputFileMetaInfo ( inName );
- }
-
- switch ( srcMode ) {
-
- case SM_I2O:
- inStr = stdin;
- outStr = stdout;
- if ( isatty ( fileno ( stdout ) ) ) {
- fprintf ( stderr,
- "%s: I won't write compressed data to a terminal.\n",
- progName );
- fprintf ( stderr, "%s: For help, type: `%s --help'.\n",
- progName, progName );
- setExit(1);
- return;
- };
- break;
-
- case SM_F2O:
- inStr = fopen ( inName, "rb" );
- outStr = stdout;
- if ( isatty ( fileno ( stdout ) ) ) {
- fprintf ( stderr,
- "%s: I won't write compressed data to a terminal.\n",
- progName );
- fprintf ( stderr, "%s: For help, type: `%s --help'.\n",
- progName, progName );
- if ( inStr != NULL ) fclose ( inStr );
- setExit(1);
- return;
- };
- if ( inStr == NULL ) {
- fprintf ( stderr, "%s: Can't open input file %s: %s.\n",
- progName, inName, strerror(errno) );
- setExit(1);
- return;
- };
- break;
-
- case SM_F2F:
- inStr = fopen ( inName, "rb" );
- outStr = fopen_output_safely ( outName, "wb" );
- if ( outStr == NULL) {
- fprintf ( stderr, "%s: Can't create output file %s: %s.\n",
- progName, outName, strerror(errno) );
- if ( inStr != NULL ) fclose ( inStr );
- setExit(1);
- return;
- }
- if ( inStr == NULL ) {
- fprintf ( stderr, "%s: Can't open input file %s: %s.\n",
- progName, inName, strerror(errno) );
- if ( outStr != NULL ) fclose ( outStr );
- setExit(1);
- return;
- };
- break;
-
- default:
- panic ( "compress: bad srcMode" );
- break;
- }
-
- if (verbosity >= 1) {
- fprintf ( stderr, " %s: ", inName );
- pad ( inName );
- fflush ( stderr );
- }
-
- /*--- Now the input and output handles are sane. Do the Biz. ---*/
- outputHandleJustInCase = outStr;
- deleteOutputOnInterrupt = True;
- compressStream ( inStr, outStr );
- outputHandleJustInCase = NULL;
-
- /*--- If there was an I/O error, we won't get here. ---*/
- if ( srcMode == SM_F2F ) {
- applySavedTimeInfoToOutputFile ( outName );
- deleteOutputOnInterrupt = False;
- if ( !keepInputFiles ) {
- IntNative retVal = remove ( inName );
- ERROR_IF_NOT_ZERO ( retVal );
- }
- }
-
- deleteOutputOnInterrupt = False;
-}
-
-
-/*---------------------------------------------*/
-static
-void uncompress ( Char *name )
-{
- FILE *inStr;
- FILE *outStr;
- Int32 n, i;
- Bool magicNumberOK;
- Bool cantGuess;
- struct MY_STAT statBuf;
-
- deleteOutputOnInterrupt = False;
-
- if (name == NULL && srcMode != SM_I2O)
- panic ( "uncompress: bad modes\n" );
-
- cantGuess = False;
- switch (srcMode) {
- case SM_I2O:
- copyFileName ( inName, (Char*)"(stdin)" );
- copyFileName ( outName, (Char*)"(stdout)" );
- break;
- case SM_F2F:
- copyFileName ( inName, name );
- copyFileName ( outName, name );
- for (i = 0; i < BZ_N_SUFFIX_PAIRS; i++)
- if (mapSuffix(outName,zSuffix[i],unzSuffix[i]))
- goto zzz;
- cantGuess = True;
- strcat ( outName, ".out" );
- break;
- case SM_F2O:
- copyFileName ( inName, name );
- copyFileName ( outName, (Char*)"(stdout)" );
- break;
- }
-
- zzz:
- if ( srcMode != SM_I2O && containsDubiousChars ( inName ) ) {
- if (noisy)
- fprintf ( stderr, "%s: There are no files matching `%s'.\n",
- progName, inName );
- setExit(1);
- return;
- }
- if ( srcMode != SM_I2O && !fileExists ( inName ) ) {
- fprintf ( stderr, "%s: Can't open input file %s: %s.\n",
- progName, inName, strerror(errno) );
- setExit(1);
- return;
- }
- if ( srcMode == SM_F2F || srcMode == SM_F2O ) {
- MY_STAT(inName, &statBuf);
- if ( MY_S_ISDIR(statBuf.st_mode) ) {
- fprintf( stderr,
- "%s: Input file %s is a directory.\n",
- progName,inName);
- setExit(1);
- return;
- }
- }
- if ( srcMode == SM_F2F && !forceOverwrite && notAStandardFile ( inName )) {
- if (noisy)
- fprintf ( stderr, "%s: Input file %s is not a normal file.\n",
- progName, inName );
- setExit(1);
- return;
- }
- if ( /* srcMode == SM_F2F implied && */ cantGuess ) {
- if (noisy)
- fprintf ( stderr,
- "%s: Can't guess original name for %s -- using %s\n",
- progName, inName, outName );
- /* just a warning, no return */
- }
- if ( srcMode == SM_F2F && fileExists ( outName ) ) {
- if (forceOverwrite) {
- remove(outName);
- } else {
- fprintf ( stderr, "%s: Output file %s already exists.\n",
- progName, outName );
- setExit(1);
- return;
- }
- }
- if ( srcMode == SM_F2F && !forceOverwrite &&
- (n=countHardLinks ( inName ) ) > 0) {
- fprintf ( stderr, "%s: Input file %s has %d other link%s.\n",
- progName, inName, n, n > 1 ? "s" : "" );
- setExit(1);
- return;
- }
-
- if ( srcMode == SM_F2F ) {
- /* Save the file's meta-info before we open it. Doing it later
- means we mess up the access times. */
- saveInputFileMetaInfo ( inName );
- }
-
- switch ( srcMode ) {
-
- case SM_I2O:
- inStr = stdin;
- outStr = stdout;
- if ( isatty ( fileno ( stdin ) ) ) {
- fprintf ( stderr,
- "%s: I won't read compressed data from a terminal.\n",
- progName );
- fprintf ( stderr, "%s: For help, type: `%s --help'.\n",
- progName, progName );
- setExit(1);
- return;
- };
- break;
-
- case SM_F2O:
- inStr = fopen ( inName, "rb" );
- outStr = stdout;
- if ( inStr == NULL ) {
- fprintf ( stderr, "%s: Can't open input file %s:%s.\n",
- progName, inName, strerror(errno) );
- if ( inStr != NULL ) fclose ( inStr );
- setExit(1);
- return;
- };
- break;
-
- case SM_F2F:
- inStr = fopen ( inName, "rb" );
- outStr = fopen_output_safely ( outName, "wb" );
- if ( outStr == NULL) {
- fprintf ( stderr, "%s: Can't create output file %s: %s.\n",
- progName, outName, strerror(errno) );
- if ( inStr != NULL ) fclose ( inStr );
- setExit(1);
- return;
- }
- if ( inStr == NULL ) {
- fprintf ( stderr, "%s: Can't open input file %s: %s.\n",
- progName, inName, strerror(errno) );
- if ( outStr != NULL ) fclose ( outStr );
- setExit(1);
- return;
- };
- break;
-
- default:
- panic ( "uncompress: bad srcMode" );
- break;
- }
-
- if (verbosity >= 1) {
- fprintf ( stderr, " %s: ", inName );
- pad ( inName );
- fflush ( stderr );
- }
-
- /*--- Now the input and output handles are sane. Do the Biz. ---*/
- outputHandleJustInCase = outStr;
- deleteOutputOnInterrupt = True;
- magicNumberOK = uncompressStream ( inStr, outStr );
- outputHandleJustInCase = NULL;
-
- /*--- If there was an I/O error, we won't get here. ---*/
- if ( magicNumberOK ) {
- if ( srcMode == SM_F2F ) {
- applySavedTimeInfoToOutputFile ( outName );
- deleteOutputOnInterrupt = False;
- if ( !keepInputFiles ) {
- IntNative retVal = remove ( inName );
- ERROR_IF_NOT_ZERO ( retVal );
- }
- }
- } else {
- unzFailsExist = True;
- deleteOutputOnInterrupt = False;
- if ( srcMode == SM_F2F ) {
- IntNative retVal = remove ( outName );
- ERROR_IF_NOT_ZERO ( retVal );
- }
- }
- deleteOutputOnInterrupt = False;
-
- if ( magicNumberOK ) {
- if (verbosity >= 1)
- fprintf ( stderr, "done\n" );
- } else {
- setExit(2);
- if (verbosity >= 1)
- fprintf ( stderr, "not a bzip2 file.\n" ); else
- fprintf ( stderr,
- "%s: %s is not a bzip2 file.\n",
- progName, inName );
- }
-
-}
-
-
-/*---------------------------------------------*/
-static
-void testf ( Char *name )
-{
- FILE *inStr;
- Bool allOK;
- struct MY_STAT statBuf;
-
- deleteOutputOnInterrupt = False;
-
- if (name == NULL && srcMode != SM_I2O)
- panic ( "testf: bad modes\n" );
-
- copyFileName ( outName, (Char*)"(none)" );
- switch (srcMode) {
- case SM_I2O: copyFileName ( inName, (Char*)"(stdin)" ); break;
- case SM_F2F: copyFileName ( inName, name ); break;
- case SM_F2O: copyFileName ( inName, name ); break;
- }
-
- if ( srcMode != SM_I2O && containsDubiousChars ( inName ) ) {
- if (noisy)
- fprintf ( stderr, "%s: There are no files matching `%s'.\n",
- progName, inName );
- setExit(1);
- return;
- }
- if ( srcMode != SM_I2O && !fileExists ( inName ) ) {
- fprintf ( stderr, "%s: Can't open input %s: %s.\n",
- progName, inName, strerror(errno) );
- setExit(1);
- return;
- }
- if ( srcMode != SM_I2O ) {
- MY_STAT(inName, &statBuf);
- if ( MY_S_ISDIR(statBuf.st_mode) ) {
- fprintf( stderr,
- "%s: Input file %s is a directory.\n",
- progName,inName);
- setExit(1);
- return;
- }
- }
-
- switch ( srcMode ) {
-
- case SM_I2O:
- if ( isatty ( fileno ( stdin ) ) ) {
- fprintf ( stderr,
- "%s: I won't read compressed data from a terminal.\n",
- progName );
- fprintf ( stderr, "%s: For help, type: `%s --help'.\n",
- progName, progName );
- setExit(1);
- return;
- };
- inStr = stdin;
- break;
-
- case SM_F2O: case SM_F2F:
- inStr = fopen ( inName, "rb" );
- if ( inStr == NULL ) {
- fprintf ( stderr, "%s: Can't open input file %s:%s.\n",
- progName, inName, strerror(errno) );
- setExit(1);
- return;
- };
- break;
-
- default:
- panic ( "testf: bad srcMode" );
- break;
- }
-
- if (verbosity >= 1) {
- fprintf ( stderr, " %s: ", inName );
- pad ( inName );
- fflush ( stderr );
- }
-
- /*--- Now the input handle is sane. Do the Biz. ---*/
- outputHandleJustInCase = NULL;
- allOK = testStream ( inStr );
-
- if (allOK && verbosity >= 1) fprintf ( stderr, "ok\n" );
- if (!allOK) testFailsExist = True;
-}
-
-
-/*---------------------------------------------*/
-static
-void license ( void )
-{
- fprintf ( stderr,
-
- "bzip2, a block-sorting file compressor. "
- "Version %s.\n"
- " \n"
- " Copyright (C) 1996-2007 by Julian Seward.\n"
- " \n"
- " This program is free software; you can redistribute it and/or modify\n"
- " it under the terms set out in the LICENSE file, which is included\n"
- " in the bzip2-1.0.5 source distribution.\n"
- " \n"
- " This program is distributed in the hope that it will be useful,\n"
- " but WITHOUT ANY WARRANTY; without even the implied warranty of\n"
- " MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n"
- " LICENSE file for more details.\n"
- " \n",
- BZ2_bzlibVersion()
- );
-}
-
-
-/*---------------------------------------------*/
-static
-void usage ( Char *fullProgName )
-{
- fprintf (
- stderr,
- "bzip2, a block-sorting file compressor. "
- "Version %s.\n"
- "\n usage: %s [flags and input files in any order]\n"
- "\n"
- " -h --help print this message\n"
- " -d --decompress force decompression\n"
- " -z --compress force compression\n"
- " -k --keep keep (don't delete) input files\n"
- " -f --force overwrite existing output files\n"
- " -t --test test compressed file integrity\n"
- " -c --stdout output to standard out\n"
- " -q --quiet suppress noncritical error messages\n"
- " -v --verbose be verbose (a 2nd -v gives more)\n"
- " -L --license display software version & license\n"
- " -V --version display software version & license\n"
- " -s --small use less memory (at most 2500k)\n"
- " -1 .. -9 set block size to 100k .. 900k\n"
- " --fast alias for -1\n"
- " --best alias for -9\n"
- "\n"
- " If invoked as `bzip2', default action is to compress.\n"
- " as `bunzip2', default action is to decompress.\n"
- " as `bzcat', default action is to decompress to stdout.\n"
- "\n"
- " If no file names are given, bzip2 compresses or decompresses\n"
- " from standard input to standard output. You can combine\n"
- " short flags, so `-v -4' means the same as -v4 or -4v, &c.\n"
-# if BZ_UNIX
- "\n"
-# endif
- ,
-
- BZ2_bzlibVersion(),
- fullProgName
- );
-}
-
-
-/*---------------------------------------------*/
-static
-void redundant ( Char* flag )
-{
- fprintf (
- stderr,
- "%s: %s is redundant in versions 0.9.5 and above\n",
- progName, flag );
-}
-
-
-/*---------------------------------------------*/
-/*--
- All the garbage from here to main() is purely to
- implement a linked list of command-line arguments,
- into which main() copies argv[1 .. argc-1].
-
- The purpose of this exercise is to facilitate
- the expansion of wildcard characters * and ? in
- filenames for OSs which don't know how to do it
- themselves, like MSDOS, Windows 95 and NT.
-
- The actual Dirty Work is done by the platform-
- specific macro APPEND_FILESPEC.
---*/
-
-typedef
- struct zzzz {
- Char *name;
- struct zzzz *link;
- }
- Cell;
-
-
-/*---------------------------------------------*/
-static
-void *myMalloc ( Int32 n )
-{
- void* p;
-
- p = malloc ( (size_t)n );
- if (p == NULL) outOfMemory ();
- return p;
-}
-
-
-/*---------------------------------------------*/
-static
-Cell *mkCell ( void )
-{
- Cell *c;
-
- c = (Cell*) myMalloc ( sizeof ( Cell ) );
- c->name = NULL;
- c->link = NULL;
- return c;
-}
-
-
-/*---------------------------------------------*/
-static
-Cell *snocString ( Cell *root, Char *name )
-{
- if (root == NULL) {
- Cell *tmp = mkCell();
- tmp->name = (Char*) myMalloc ( 5 + strlen(name) );
- strcpy ( tmp->name, name );
- return tmp;
- } else {
- Cell *tmp = root;
- while (tmp->link != NULL) tmp = tmp->link;
- tmp->link = snocString ( tmp->link, name );
- return root;
- }
-}
-
-
-/*---------------------------------------------*/
-static
-void addFlagsFromEnvVar ( Cell** argList, Char* varName )
-{
- Int32 i, j, k;
- Char *envbase, *p;
-
- envbase = getenv(varName);
- if (envbase != NULL) {
- p = envbase;
- i = 0;
- while (True) {
- if (p[i] == 0) break;
- p += i;
- i = 0;
- while (isspace((Int32)(p[0]))) p++;
- while (p[i] != 0 && !isspace((Int32)(p[i]))) i++;
- if (i > 0) {
- k = i; if (k > FILE_NAME_LEN-10) k = FILE_NAME_LEN-10;
- for (j = 0; j < k; j++) tmpName[j] = p[j];
- tmpName[k] = 0;
- APPEND_FLAG(*argList, tmpName);
- }
- }
- }
-}
-
-
-/*---------------------------------------------*/
-#define ISFLAG(s) (strcmp(aa->name, (s))==0)
-
-IntNative main ( IntNative argc, Char *argv[] )
-{
- Int32 i, j;
- Char *tmp;
- Cell *argList;
- Cell *aa;
- Bool decode;
-
- /*-- Be really really really paranoid :-) --*/
- if (sizeof(Int32) != 4 || sizeof(UInt32) != 4 ||
- sizeof(Int16) != 2 || sizeof(UInt16) != 2 ||
- sizeof(Char) != 1 || sizeof(UChar) != 1)
- configError();
-
- /*-- Initialise --*/
- outputHandleJustInCase = NULL;
- smallMode = False;
- keepInputFiles = False;
- forceOverwrite = False;
- noisy = True;
- verbosity = 0;
- blockSize100k = 9;
- testFailsExist = False;
- unzFailsExist = False;
- numFileNames = 0;
- numFilesProcessed = 0;
- workFactor = 30;
- deleteOutputOnInterrupt = False;
- exitValue = 0;
- i = j = 0; /* avoid bogus warning from egcs-1.1.X */
-
- /*-- Set up signal handlers for mem access errors --*/
- signal (SIGSEGV, mySIGSEGVorSIGBUScatcher);
-# if BZ_UNIX
-# ifndef __DJGPP__
- signal (SIGBUS, mySIGSEGVorSIGBUScatcher);
-# endif
-# endif
-
- copyFileName ( inName, (Char*)"(none)" );
- copyFileName ( outName, (Char*)"(none)" );
-
- copyFileName ( progNameReally, argv[0] );
- progName = &progNameReally[0];
- for (tmp = &progNameReally[0]; *tmp != '\0'; tmp++)
- if (*tmp == PATH_SEP) progName = tmp + 1;
-
-
- /*-- Copy flags from env var BZIP2, and
- expand filename wildcards in arg list.
- --*/
- argList = NULL;
- addFlagsFromEnvVar ( &argList, (Char*)"BZIP2" );
- addFlagsFromEnvVar ( &argList, (Char*)"BZIP" );
- for (i = 1; i <= argc-1; i++)
- APPEND_FILESPEC(argList, argv[i]);
-
-
- /*-- Find the length of the longest filename --*/
- longestFileName = 7;
- numFileNames = 0;
- decode = True;
- for (aa = argList; aa != NULL; aa = aa->link) {
- if (ISFLAG("--")) { decode = False; continue; }
- if (aa->name[0] == '-' && decode) continue;
- numFileNames++;
- if (longestFileName < (Int32)strlen(aa->name) )
- longestFileName = (Int32)strlen(aa->name);
- }
-
-
- /*-- Determine source modes; flag handling may change this too. --*/
- if (numFileNames == 0)
- srcMode = SM_I2O; else srcMode = SM_F2F;
-
-
- /*-- Determine what to do (compress/uncompress/test/cat). --*/
- /*-- Note that subsequent flag handling may change this. --*/
- opMode = OM_Z;
-
- if ( (strstr ( progName, "unzip" ) != 0) ||
- (strstr ( progName, "UNZIP" ) != 0) )
- opMode = OM_UNZ;
-
- if ( (strstr ( progName, "z2cat" ) != 0) ||
- (strstr ( progName, "Z2CAT" ) != 0) ||
- (strstr ( progName, "zcat" ) != 0) ||
- (strstr ( progName, "ZCAT" ) != 0) ) {
- opMode = OM_UNZ;
- srcMode = (numFileNames == 0) ? SM_I2O : SM_F2O;
- }
-
-
- /*-- Look at the flags. --*/
- for (aa = argList; aa != NULL; aa = aa->link) {
- if (ISFLAG("--")) break;
- if (aa->name[0] == '-' && aa->name[1] != '-') {
- for (j = 1; aa->name[j] != '\0'; j++) {
- switch (aa->name[j]) {
- case 'c': srcMode = SM_F2O; break;
- case 'd': opMode = OM_UNZ; break;
- case 'z': opMode = OM_Z; break;
- case 'f': forceOverwrite = True; break;
- case 't': opMode = OM_TEST; break;
- case 'k': keepInputFiles = True; break;
- case 's': smallMode = True; break;
- case 'q': noisy = False; break;
- case '1': blockSize100k = 1; break;
- case '2': blockSize100k = 2; break;
- case '3': blockSize100k = 3; break;
- case '4': blockSize100k = 4; break;
- case '5': blockSize100k = 5; break;
- case '6': blockSize100k = 6; break;
- case '7': blockSize100k = 7; break;
- case '8': blockSize100k = 8; break;
- case '9': blockSize100k = 9; break;
- case 'V':
- case 'L': license(); break;
- case 'v': verbosity++; break;
- case 'h': usage ( progName );
- exit ( 0 );
- break;
- default: fprintf ( stderr, "%s: Bad flag `%s'\n",
- progName, aa->name );
- usage ( progName );
- exit ( 1 );
- break;
- }
- }
- }
- }
-
- /*-- And again ... --*/
- for (aa = argList; aa != NULL; aa = aa->link) {
- if (ISFLAG("--")) break;
- if (ISFLAG("--stdout")) srcMode = SM_F2O; else
- if (ISFLAG("--decompress")) opMode = OM_UNZ; else
- if (ISFLAG("--compress")) opMode = OM_Z; else
- if (ISFLAG("--force")) forceOverwrite = True; else
- if (ISFLAG("--test")) opMode = OM_TEST; else
- if (ISFLAG("--keep")) keepInputFiles = True; else
- if (ISFLAG("--small")) smallMode = True; else
- if (ISFLAG("--quiet")) noisy = False; else
- if (ISFLAG("--version")) license(); else
- if (ISFLAG("--license")) license(); else
- if (ISFLAG("--exponential")) workFactor = 1; else
- if (ISFLAG("--repetitive-best")) redundant(aa->name); else
- if (ISFLAG("--repetitive-fast")) redundant(aa->name); else
- if (ISFLAG("--fast")) blockSize100k = 1; else
- if (ISFLAG("--best")) blockSize100k = 9; else
- if (ISFLAG("--verbose")) verbosity++; else
- if (ISFLAG("--help")) { usage ( progName ); exit ( 0 ); }
- else
- if (strncmp ( aa->name, "--", 2) == 0) {
- fprintf ( stderr, "%s: Bad flag `%s'\n", progName, aa->name );
- usage ( progName );
- exit ( 1 );
- }
- }
-
- if (verbosity > 4) verbosity = 4;
- if (opMode == OM_Z && smallMode && blockSize100k > 2)
- blockSize100k = 2;
-
- if (opMode == OM_TEST && srcMode == SM_F2O) {
- fprintf ( stderr, "%s: -c and -t cannot be used together.\n",
- progName );
- exit ( 1 );
- }
-
- if (srcMode == SM_F2O && numFileNames == 0)
- srcMode = SM_I2O;
-
- if (opMode != OM_Z) blockSize100k = 0;
-
- if (srcMode == SM_F2F) {
- signal (SIGINT, mySignalCatcher);
- signal (SIGTERM, mySignalCatcher);
-# if BZ_UNIX
- signal (SIGHUP, mySignalCatcher);
-# endif
- }
-
- if (opMode == OM_Z) {
- if (srcMode == SM_I2O) {
- compress ( NULL );
- } else {
- decode = True;
- for (aa = argList; aa != NULL; aa = aa->link) {
- if (ISFLAG("--")) { decode = False; continue; }
- if (aa->name[0] == '-' && decode) continue;
- numFilesProcessed++;
- compress ( aa->name );
- }
- }
- }
- else
-
- if (opMode == OM_UNZ) {
- unzFailsExist = False;
- if (srcMode == SM_I2O) {
- uncompress ( NULL );
- } else {
- decode = True;
- for (aa = argList; aa != NULL; aa = aa->link) {
- if (ISFLAG("--")) { decode = False; continue; }
- if (aa->name[0] == '-' && decode) continue;
- numFilesProcessed++;
- uncompress ( aa->name );
- }
- }
- if (unzFailsExist) {
- setExit(2);
- exit(exitValue);
- }
- }
-
- else {
- testFailsExist = False;
- if (srcMode == SM_I2O) {
- testf ( NULL );
- } else {
- decode = True;
- for (aa = argList; aa != NULL; aa = aa->link) {
- if (ISFLAG("--")) { decode = False; continue; }
- if (aa->name[0] == '-' && decode) continue;
- numFilesProcessed++;
- testf ( aa->name );
- }
- }
- if (testFailsExist && noisy) {
- fprintf ( stderr,
- "\n"
- "You can use the `bzip2recover' program to attempt to recover\n"
- "data from undamaged sections of corrupted files.\n\n"
- );
- setExit(2);
- exit(exitValue);
- }
- }
-
- /* Free the argument list memory to mollify leak detectors
- (eg) Purify, Checker. Serves no other useful purpose.
- */
- aa = argList;
- while (aa != NULL) {
- Cell* aa2 = aa->link;
- if (aa->name != NULL) free(aa->name);
- free(aa);
- aa = aa2;
- }
-
- return exitValue;
-}
-
-
-/*-----------------------------------------------------------*/
-/*--- end bzip2.c ---*/
-/*-----------------------------------------------------------*/
+++ /dev/null
-/*-----------------------------------------------------------*/
-/*--- Block recoverer program for bzip2 ---*/
-/*--- bzip2recover.c ---*/
-/*-----------------------------------------------------------*/
-
-/* ------------------------------------------------------------------
- This file is part of bzip2/libbzip2, a program and library for
- lossless, block-sorting data compression.
-
- bzip2/libbzip2 version 1.0.5 of 10 December 2007
- Copyright (C) 1996-2007 Julian Seward <jseward@bzip.org>
-
- Please read the WARNING, DISCLAIMER and PATENTS sections in the
- README file.
-
- This program is released under the terms of the license contained
- in the file LICENSE.
- ------------------------------------------------------------------ */
-
-/* This program is a complete hack and should be rewritten properly.
- It isn't very complicated. */
-
-#include <stdio.h>
-#include <errno.h>
-#include <stdlib.h>
-#include <string.h>
-
-
-/* This program records bit locations in the file to be recovered.
- That means that if 64-bit ints are not supported, we will not
- be able to recover .bz2 files over 512MB (2^32 bits) long.
- On GNU supported platforms, we take advantage of the 64-bit
- int support to circumvent this problem. Ditto MSVC.
-
- This change occurred in version 1.0.2; all prior versions have
- the 512MB limitation.
-*/
-#ifdef __GNUC__
- typedef unsigned long long int MaybeUInt64;
-# define MaybeUInt64_FMT "%Lu"
-#else
-#ifdef _MSC_VER
- typedef unsigned __int64 MaybeUInt64;
-# define MaybeUInt64_FMT "%I64u"
-#else
- typedef unsigned int MaybeUInt64;
-# define MaybeUInt64_FMT "%u"
-#endif
-#endif
-
-typedef unsigned int UInt32;
-typedef int Int32;
-typedef unsigned char UChar;
-typedef char Char;
-typedef unsigned char Bool;
-#define True ((Bool)1)
-#define False ((Bool)0)
-
-
-#define BZ_MAX_FILENAME 2000
-
-Char inFileName[BZ_MAX_FILENAME];
-Char outFileName[BZ_MAX_FILENAME];
-Char progName[BZ_MAX_FILENAME];
-
-MaybeUInt64 bytesOut = 0;
-MaybeUInt64 bytesIn = 0;
-
-
-/*---------------------------------------------------*/
-/*--- Header bytes ---*/
-/*---------------------------------------------------*/
-
-#define BZ_HDR_B 0x42 /* 'B' */
-#define BZ_HDR_Z 0x5a /* 'Z' */
-#define BZ_HDR_h 0x68 /* 'h' */
-#define BZ_HDR_0 0x30 /* '0' */
-
-
-/*---------------------------------------------------*/
-/*--- I/O errors ---*/
-/*---------------------------------------------------*/
-
-/*---------------------------------------------*/
-static void readError ( void )
-{
- fprintf ( stderr,
- "%s: I/O error reading `%s', possible reason follows.\n",
- progName, inFileName );
- perror ( progName );
- fprintf ( stderr, "%s: warning: output file(s) may be incomplete.\n",
- progName );
- exit ( 1 );
-}
-
-
-/*---------------------------------------------*/
-static void writeError ( void )
-{
- fprintf ( stderr,
- "%s: I/O error reading `%s', possible reason follows.\n",
- progName, inFileName );
- perror ( progName );
- fprintf ( stderr, "%s: warning: output file(s) may be incomplete.\n",
- progName );
- exit ( 1 );
-}
-
-
-/*---------------------------------------------*/
-static void mallocFail ( Int32 n )
-{
- fprintf ( stderr,
- "%s: malloc failed on request for %d bytes.\n",
- progName, n );
- fprintf ( stderr, "%s: warning: output file(s) may be incomplete.\n",
- progName );
- exit ( 1 );
-}
-
-
-/*---------------------------------------------*/
-static void tooManyBlocks ( Int32 max_handled_blocks )
-{
- fprintf ( stderr,
- "%s: `%s' appears to contain more than %d blocks\n",
- progName, inFileName, max_handled_blocks );
- fprintf ( stderr,
- "%s: and cannot be handled. To fix, increase\n",
- progName );
- fprintf ( stderr,
- "%s: BZ_MAX_HANDLED_BLOCKS in bzip2recover.c, and recompile.\n",
- progName );
- exit ( 1 );
-}
-
-
-
-/*---------------------------------------------------*/
-/*--- Bit stream I/O ---*/
-/*---------------------------------------------------*/
-
-typedef
- struct {
- FILE* handle;
- Int32 buffer;
- Int32 buffLive;
- Char mode;
- }
- BitStream;
-
-
-/*---------------------------------------------*/
-static BitStream* bsOpenReadStream ( FILE* stream )
-{
- BitStream *bs = (BitStream*) malloc ( sizeof(BitStream) );
- if (bs == NULL) mallocFail ( sizeof(BitStream) );
- bs->handle = stream;
- bs->buffer = 0;
- bs->buffLive = 0;
- bs->mode = 'r';
- return bs;
-}
-
-
-/*---------------------------------------------*/
-static BitStream* bsOpenWriteStream ( FILE* stream )
-{
- BitStream *bs = (BitStream*) malloc ( sizeof(BitStream) );
- if (bs == NULL) mallocFail ( sizeof(BitStream) );
- bs->handle = stream;
- bs->buffer = 0;
- bs->buffLive = 0;
- bs->mode = 'w';
- return bs;
-}
-
-
-/*---------------------------------------------*/
-static void bsPutBit ( BitStream* bs, Int32 bit )
-{
- if (bs->buffLive == 8) {
- Int32 retVal = putc ( (UChar) bs->buffer, bs->handle );
- if (retVal == EOF) writeError();
- bytesOut++;
- bs->buffLive = 1;
- bs->buffer = bit & 0x1;
- } else {
- bs->buffer = ( (bs->buffer << 1) | (bit & 0x1) );
- bs->buffLive++;
- };
-}
-
-
-/*---------------------------------------------*/
-/*--
- Returns 0 or 1, or 2 to indicate EOF.
---*/
-static Int32 bsGetBit ( BitStream* bs )
-{
- if (bs->buffLive > 0) {
- bs->buffLive --;
- return ( ((bs->buffer) >> (bs->buffLive)) & 0x1 );
- } else {
- Int32 retVal = getc ( bs->handle );
- if ( retVal == EOF ) {
- if (errno != 0) readError();
- return 2;
- }
- bs->buffLive = 7;
- bs->buffer = retVal;
- return ( ((bs->buffer) >> 7) & 0x1 );
- }
-}
-
-
-/*---------------------------------------------*/
-static void bsClose ( BitStream* bs )
-{
- Int32 retVal;
-
- if ( bs->mode == 'w' ) {
- while ( bs->buffLive < 8 ) {
- bs->buffLive++;
- bs->buffer <<= 1;
- };
- retVal = putc ( (UChar) (bs->buffer), bs->handle );
- if (retVal == EOF) writeError();
- bytesOut++;
- retVal = fflush ( bs->handle );
- if (retVal == EOF) writeError();
- }
- retVal = fclose ( bs->handle );
- if (retVal == EOF) {
- if (bs->mode == 'w') writeError(); else readError();
- }
- free ( bs );
-}
-
-
-/*---------------------------------------------*/
-static void bsPutUChar ( BitStream* bs, UChar c )
-{
- Int32 i;
- for (i = 7; i >= 0; i--)
- bsPutBit ( bs, (((UInt32) c) >> i) & 0x1 );
-}
-
-
-/*---------------------------------------------*/
-static void bsPutUInt32 ( BitStream* bs, UInt32 c )
-{
- Int32 i;
-
- for (i = 31; i >= 0; i--)
- bsPutBit ( bs, (c >> i) & 0x1 );
-}
-
-
-/*---------------------------------------------*/
-static Bool endsInBz2 ( Char* name )
-{
- Int32 n = strlen ( name );
- if (n <= 4) return False;
- return
- (name[n-4] == '.' &&
- name[n-3] == 'b' &&
- name[n-2] == 'z' &&
- name[n-1] == '2');
-}
-
-
-/*---------------------------------------------------*/
-/*--- ---*/
-/*---------------------------------------------------*/
-
-/* This logic isn't really right when it comes to Cygwin. */
-#ifdef _WIN32
-# define BZ_SPLIT_SYM '\\' /* path splitter on Windows platform */
-#else
-# define BZ_SPLIT_SYM '/' /* path splitter on Unix platform */
-#endif
-
-#define BLOCK_HEADER_HI 0x00003141UL
-#define BLOCK_HEADER_LO 0x59265359UL
-
-#define BLOCK_ENDMARK_HI 0x00001772UL
-#define BLOCK_ENDMARK_LO 0x45385090UL
-
-/* Increase if necessary. However, a .bz2 file with > 50000 blocks
- would have an uncompressed size of at least 40GB, so the chances
- are low you'll need to up this.
-*/
-#define BZ_MAX_HANDLED_BLOCKS 50000
-
-MaybeUInt64 bStart [BZ_MAX_HANDLED_BLOCKS];
-MaybeUInt64 bEnd [BZ_MAX_HANDLED_BLOCKS];
-MaybeUInt64 rbStart[BZ_MAX_HANDLED_BLOCKS];
-MaybeUInt64 rbEnd [BZ_MAX_HANDLED_BLOCKS];
-
-Int32 main ( Int32 argc, Char** argv )
-{
- FILE* inFile;
- FILE* outFile;
- BitStream* bsIn, *bsWr;
- Int32 b, wrBlock, currBlock, rbCtr;
- MaybeUInt64 bitsRead;
-
- UInt32 buffHi, buffLo, blockCRC;
- Char* p;
-
- strcpy ( progName, argv[0] );
- inFileName[0] = outFileName[0] = 0;
-
- fprintf ( stderr,
- "bzip2recover 1.0.5: extracts blocks from damaged .bz2 files.\n" );
-
- if (argc != 2) {
- fprintf ( stderr, "%s: usage is `%s damaged_file_name'.\n",
- progName, progName );
- switch (sizeof(MaybeUInt64)) {
- case 8:
- fprintf(stderr,
- "\trestrictions on size of recovered file: None\n");
- break;
- case 4:
- fprintf(stderr,
- "\trestrictions on size of recovered file: 512 MB\n");
- fprintf(stderr,
- "\tto circumvent, recompile with MaybeUInt64 as an\n"
- "\tunsigned 64-bit int.\n");
- break;
- default:
- fprintf(stderr,
- "\tsizeof(MaybeUInt64) is not 4 or 8 -- "
- "configuration error.\n");
- break;
- }
- exit(1);
- }
-
- if (strlen(argv[1]) >= BZ_MAX_FILENAME-20) {
- fprintf ( stderr,
- "%s: supplied filename is suspiciously (>= %d chars) long. Bye!\n",
- progName, (int)strlen(argv[1]) );
- exit(1);
- }
-
- strcpy ( inFileName, argv[1] );
-
- inFile = fopen ( inFileName, "rb" );
- if (inFile == NULL) {
- fprintf ( stderr, "%s: can't read `%s'\n", progName, inFileName );
- exit(1);
- }
-
- bsIn = bsOpenReadStream ( inFile );
- fprintf ( stderr, "%s: searching for block boundaries ...\n", progName );
-
- bitsRead = 0;
- buffHi = buffLo = 0;
- currBlock = 0;
- bStart[currBlock] = 0;
-
- rbCtr = 0;
-
- while (True) {
- b = bsGetBit ( bsIn );
- bitsRead++;
- if (b == 2) {
- if (bitsRead >= bStart[currBlock] &&
- (bitsRead - bStart[currBlock]) >= 40) {
- bEnd[currBlock] = bitsRead-1;
- if (currBlock > 0)
- fprintf ( stderr, " block %d runs from " MaybeUInt64_FMT
- " to " MaybeUInt64_FMT " (incomplete)\n",
- currBlock, bStart[currBlock], bEnd[currBlock] );
- } else
- currBlock--;
- break;
- }
- buffHi = (buffHi << 1) | (buffLo >> 31);
- buffLo = (buffLo << 1) | (b & 1);
- if ( ( (buffHi & 0x0000ffff) == BLOCK_HEADER_HI
- && buffLo == BLOCK_HEADER_LO)
- ||
- ( (buffHi & 0x0000ffff) == BLOCK_ENDMARK_HI
- && buffLo == BLOCK_ENDMARK_LO)
- ) {
- if (bitsRead > 49) {
- bEnd[currBlock] = bitsRead-49;
- } else {
- bEnd[currBlock] = 0;
- }
- if (currBlock > 0 &&
- (bEnd[currBlock] - bStart[currBlock]) >= 130) {
- fprintf ( stderr, " block %d runs from " MaybeUInt64_FMT
- " to " MaybeUInt64_FMT "\n",
- rbCtr+1, bStart[currBlock], bEnd[currBlock] );
- rbStart[rbCtr] = bStart[currBlock];
- rbEnd[rbCtr] = bEnd[currBlock];
- rbCtr++;
- }
- if (currBlock >= BZ_MAX_HANDLED_BLOCKS)
- tooManyBlocks(BZ_MAX_HANDLED_BLOCKS);
- currBlock++;
-
- bStart[currBlock] = bitsRead;
- }
- }
-
- bsClose ( bsIn );
-
- /*-- identified blocks run from 1 to rbCtr inclusive. --*/
-
- if (rbCtr < 1) {
- fprintf ( stderr,
- "%s: sorry, I couldn't find any block boundaries.\n",
- progName );
- exit(1);
- };
-
- fprintf ( stderr, "%s: splitting into blocks\n", progName );
-
- inFile = fopen ( inFileName, "rb" );
- if (inFile == NULL) {
- fprintf ( stderr, "%s: can't open `%s'\n", progName, inFileName );
- exit(1);
- }
- bsIn = bsOpenReadStream ( inFile );
-
- /*-- placate gcc's dataflow analyser --*/
- blockCRC = 0; bsWr = 0;
-
- bitsRead = 0;
- outFile = NULL;
- wrBlock = 0;
- while (True) {
- b = bsGetBit(bsIn);
- if (b == 2) break;
- buffHi = (buffHi << 1) | (buffLo >> 31);
- buffLo = (buffLo << 1) | (b & 1);
- if (bitsRead == 47+rbStart[wrBlock])
- blockCRC = (buffHi << 16) | (buffLo >> 16);
-
- if (outFile != NULL && bitsRead >= rbStart[wrBlock]
- && bitsRead <= rbEnd[wrBlock]) {
- bsPutBit ( bsWr, b );
- }
-
- bitsRead++;
-
- if (bitsRead == rbEnd[wrBlock]+1) {
- if (outFile != NULL) {
- bsPutUChar ( bsWr, 0x17 ); bsPutUChar ( bsWr, 0x72 );
- bsPutUChar ( bsWr, 0x45 ); bsPutUChar ( bsWr, 0x38 );
- bsPutUChar ( bsWr, 0x50 ); bsPutUChar ( bsWr, 0x90 );
- bsPutUInt32 ( bsWr, blockCRC );
- bsClose ( bsWr );
- }
- if (wrBlock >= rbCtr) break;
- wrBlock++;
- } else
- if (bitsRead == rbStart[wrBlock]) {
- /* Create the output file name, correctly handling leading paths.
- (31.10.2001 by Sergey E. Kusikov) */
- Char* split;
- Int32 ofs, k;
- for (k = 0; k < BZ_MAX_FILENAME; k++)
- outFileName[k] = 0;
- strcpy (outFileName, inFileName);
- split = strrchr (outFileName, BZ_SPLIT_SYM);
- if (split == NULL) {
- split = outFileName;
- } else {
- ++split;
- }
- /* Now split points to the start of the basename. */
- ofs = split - outFileName;
- sprintf (split, "rec%5d", wrBlock+1);
- for (p = split; *p != 0; p++) if (*p == ' ') *p = '0';
- strcat (outFileName, inFileName + ofs);
-
- if ( !endsInBz2(outFileName)) strcat ( outFileName, ".bz2" );
-
- fprintf ( stderr, " writing block %d to `%s' ...\n",
- wrBlock+1, outFileName );
-
- outFile = fopen ( outFileName, "wb" );
- if (outFile == NULL) {
- fprintf ( stderr, "%s: can't write `%s'\n",
- progName, outFileName );
- exit(1);
- }
- bsWr = bsOpenWriteStream ( outFile );
- bsPutUChar ( bsWr, BZ_HDR_B );
- bsPutUChar ( bsWr, BZ_HDR_Z );
- bsPutUChar ( bsWr, BZ_HDR_h );
- bsPutUChar ( bsWr, BZ_HDR_0 + 9 );
- bsPutUChar ( bsWr, 0x31 ); bsPutUChar ( bsWr, 0x41 );
- bsPutUChar ( bsWr, 0x59 ); bsPutUChar ( bsWr, 0x26 );
- bsPutUChar ( bsWr, 0x53 ); bsPutUChar ( bsWr, 0x59 );
- }
- }
-
- fprintf ( stderr, "%s: finished\n", progName );
- return 0;
-}
-
-
-
-/*-----------------------------------------------------------*/
-/*--- end bzip2recover.c ---*/
-/*-----------------------------------------------------------*/
+++ /dev/null
-/*\r
- minibz2\r
- libbz2.dll test program.\r
- by Yoshioka Tsuneo (tsuneo@rr.iij4u.or.jp)\r
- This file is Public Domain. Welcome any email to me.\r
-\r
- usage: minibz2 [-d] [-{1,2,..9}] [[srcfilename] destfilename]\r
-*/\r
-\r
-#define BZ_IMPORT\r
-#include <stdio.h>\r
-#include <stdlib.h>\r
-#include "bzlib.h"\r
-#ifdef _WIN32\r
-#include <io.h>\r
-#endif\r
-\r
-\r
-#ifdef _WIN32\r
-\r
-#define BZ2_LIBNAME "libbz2-1.0.2.DLL" \r
-\r
-#include <windows.h>\r
-static int BZ2DLLLoaded = 0;\r
-static HINSTANCE BZ2DLLhLib;\r
-int BZ2DLLLoadLibrary(void)\r
-{\r
- HINSTANCE hLib;\r
-\r
- if(BZ2DLLLoaded==1){return 0;}\r
- hLib=LoadLibrary(BZ2_LIBNAME);\r
- if(hLib == NULL){\r
- fprintf(stderr,"Can't load %s\n",BZ2_LIBNAME);\r
- return -1;\r
- }\r
- BZ2_bzlibVersion=GetProcAddress(hLib,"BZ2_bzlibVersion");\r
- BZ2_bzopen=GetProcAddress(hLib,"BZ2_bzopen");\r
- BZ2_bzdopen=GetProcAddress(hLib,"BZ2_bzdopen");\r
- BZ2_bzread=GetProcAddress(hLib,"BZ2_bzread");\r
- BZ2_bzwrite=GetProcAddress(hLib,"BZ2_bzwrite");\r
- BZ2_bzflush=GetProcAddress(hLib,"BZ2_bzflush");\r
- BZ2_bzclose=GetProcAddress(hLib,"BZ2_bzclose");\r
- BZ2_bzerror=GetProcAddress(hLib,"BZ2_bzerror");\r
-\r
- if (!BZ2_bzlibVersion || !BZ2_bzopen || !BZ2_bzdopen\r
- || !BZ2_bzread || !BZ2_bzwrite || !BZ2_bzflush\r
- || !BZ2_bzclose || !BZ2_bzerror) {\r
- fprintf(stderr,"GetProcAddress failed.\n");\r
- return -1;\r
- }\r
- BZ2DLLLoaded=1;\r
- BZ2DLLhLib=hLib;\r
- return 0;\r
-\r
-}\r
-int BZ2DLLFreeLibrary(void)\r
-{\r
- if(BZ2DLLLoaded==0){return 0;}\r
- FreeLibrary(BZ2DLLhLib);\r
- BZ2DLLLoaded=0;\r
-}\r
-#endif /* WIN32 */\r
-\r
-void usage(void)\r
-{\r
- puts("usage: minibz2 [-d] [-{1,2,..9}] [[srcfilename] destfilename]");\r
-}\r
-\r
-int main(int argc,char *argv[])\r
-{\r
- int decompress = 0;\r
- int level = 9;\r
- char *fn_r = NULL;\r
- char *fn_w = NULL;\r
-\r
-#ifdef _WIN32\r
- if(BZ2DLLLoadLibrary()<0){\r
- fprintf(stderr,"Loading of %s failed. Giving up.\n", BZ2_LIBNAME);\r
- exit(1);\r
- }\r
- printf("Loading of %s succeeded. Library version is %s.\n",\r
- BZ2_LIBNAME, BZ2_bzlibVersion() );\r
-#endif\r
- while(++argv,--argc){\r
- if(**argv =='-' || **argv=='/'){\r
- char *p;\r
-\r
- for(p=*argv+1;*p;p++){\r
- if(*p=='d'){\r
- decompress = 1;\r
- }else if('1'<=*p && *p<='9'){\r
- level = *p - '0';\r
- }else{\r
- usage();\r
- exit(1);\r
- }\r
- }\r
- }else{\r
- break;\r
- }\r
- }\r
- if(argc>=1){\r
- fn_r = *argv;\r
- argc--;argv++;\r
- }else{\r
- fn_r = NULL;\r
- }\r
- if(argc>=1){\r
- fn_w = *argv;\r
- argc--;argv++;\r
- }else{\r
- fn_w = NULL;\r
- }\r
- {\r
- int len;\r
- char buff[0x1000];\r
- char mode[10];\r
-\r
- if(decompress){\r
- BZFILE *BZ2fp_r = NULL;\r
- FILE *fp_w = NULL;\r
-\r
- if(fn_w){\r
- if((fp_w = fopen(fn_w,"wb"))==NULL){\r
- printf("can't open [%s]\n",fn_w);\r
- perror("reason:");\r
- exit(1);\r
- }\r
- }else{\r
- fp_w = stdout;\r
- }\r
- if((fn_r == NULL && (BZ2fp_r = BZ2_bzdopen(fileno(stdin),"rb"))==NULL)\r
- || (fn_r != NULL && (BZ2fp_r = BZ2_bzopen(fn_r,"rb"))==NULL)){\r
- printf("can't bz2openstream\n");\r
- exit(1);\r
- }\r
- while((len=BZ2_bzread(BZ2fp_r,buff,0x1000))>0){\r
- fwrite(buff,1,len,fp_w);\r
- }\r
- BZ2_bzclose(BZ2fp_r);\r
- if(fp_w != stdout) fclose(fp_w);\r
- }else{\r
- BZFILE *BZ2fp_w = NULL;\r
- FILE *fp_r = NULL;\r
-\r
- if(fn_r){\r
- if((fp_r = fopen(fn_r,"rb"))==NULL){\r
- printf("can't open [%s]\n",fn_r);\r
- perror("reason:");\r
- exit(1);\r
- }\r
- }else{\r
- fp_r = stdin;\r
- }\r
- mode[0]='w';\r
- mode[1] = '0' + level;\r
- mode[2] = '\0';\r
-\r
- if((fn_w == NULL && (BZ2fp_w = BZ2_bzdopen(fileno(stdout),mode))==NULL)\r
- || (fn_w !=NULL && (BZ2fp_w = BZ2_bzopen(fn_w,mode))==NULL)){\r
- printf("can't bz2openstream\n");\r
- exit(1);\r
- }\r
- while((len=fread(buff,1,0x1000,fp_r))>0){\r
- BZ2_bzwrite(BZ2fp_w,buff,len);\r
- }\r
- BZ2_bzclose(BZ2fp_w);\r
- if(fp_r!=stdin)fclose(fp_r);\r
- }\r
- }\r
-#ifdef _WIN32\r
- BZ2DLLFreeLibrary();\r
-#endif\r
- return 0;\r
-}\r
+++ /dev/null
-
-/* Spew out a long sequence of the byte 251. When fed to bzip2
- versions 1.0.0 or 1.0.1, causes it to die with internal error
- 1007 in blocksort.c. This assertion misses an extremely rare
- case, which is fixed in this version (1.0.2) and above.
-*/
-
-/* ------------------------------------------------------------------
- This file is part of bzip2/libbzip2, a program and library for
- lossless, block-sorting data compression.
-
- bzip2/libbzip2 version 1.0.5 of 10 December 2007
- Copyright (C) 1996-2007 Julian Seward <jseward@bzip.org>
-
- Please read the WARNING, DISCLAIMER and PATENTS sections in the
- README file.
-
- This program is released under the terms of the license contained
- in the file LICENSE.
- ------------------------------------------------------------------ */
-
-
-#include <stdio.h>
-
-int main ()
-{
- int i;
- for (i = 0; i < 48500000 ; i++)
- putchar(251);
- return 0;
-}
+++ /dev/null
-
-/* spew out a thoroughly gigantic file designed so that bzip2
- can compress it reasonably rapidly. This is to help test
- support for large files (> 2GB) in a reasonable amount of time.
- I suggest you use the undocumented --exponential option to
- bzip2 when compressing the resulting file; this saves a bit of
- time. Note: *don't* bother with --exponential when compressing
- Real Files; it'll just waste a lot of CPU time :-)
- (but is otherwise harmless).
-*/
-
-/* ------------------------------------------------------------------
- This file is part of bzip2/libbzip2, a program and library for
- lossless, block-sorting data compression.
-
- bzip2/libbzip2 version 1.0.5 of 10 December 2007
- Copyright (C) 1996-2007 Julian Seward <jseward@bzip.org>
-
- Please read the WARNING, DISCLAIMER and PATENTS sections in the
- README file.
-
- This program is released under the terms of the license contained
- in the file LICENSE.
- ------------------------------------------------------------------ */
-
-
-#define _FILE_OFFSET_BITS 64
-
-#include <stdio.h>
-#include <stdlib.h>
-
-/* The number of megabytes of junk to spew out (roughly) */
-#define MEGABYTES 5000
-
-#define N_BUF 1000000
-char buf[N_BUF];
-
-int main ( int argc, char** argv )
-{
- int ii, kk, p;
- srandom(1);
- setbuffer ( stdout, buf, N_BUF );
- for (kk = 0; kk < MEGABYTES * 515; kk+=3) {
- p = 25+random()%50;
- for (ii = 0; ii < p; ii++)
- printf ( "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" );
- for (ii = 0; ii < p-1; ii++)
- printf ( "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" );
- for (ii = 0; ii < p+1; ii++)
- printf ( "ccccccccccccccccccccccccccccccccccccc" );
- }
- fflush(stdout);
- return 0;
-}
+++ /dev/null
-
-/* A test program written to test robustness to decompression of
- corrupted data. Usage is
- unzcrash filename
- and the program will read the specified file, compress it (in memory),
- and then repeatedly decompress it, each time with a different bit of
- the compressed data inverted, so as to test all possible one-bit errors.
- This should not cause any invalid memory accesses. If it does,
- I want to know about it!
-
- PS. As you can see from the above description, the process is
- incredibly slow. A file of size eg 5KB will cause it to run for
- many hours.
-*/
-
-/* ------------------------------------------------------------------
- This file is part of bzip2/libbzip2, a program and library for
- lossless, block-sorting data compression.
-
- bzip2/libbzip2 version 1.0.5 of 10 December 2007
- Copyright (C) 1996-2007 Julian Seward <jseward@bzip.org>
-
- Please read the WARNING, DISCLAIMER and PATENTS sections in the
- README file.
-
- This program is released under the terms of the license contained
- in the file LICENSE.
- ------------------------------------------------------------------ */
-
-
-#include <stdio.h>
-#include <assert.h>
-#include "bzlib.h"
-
-#define M_BLOCK 1000000
-
-typedef unsigned char uchar;
-
-#define M_BLOCK_OUT (M_BLOCK + 1000000)
-uchar inbuf[M_BLOCK];
-uchar outbuf[M_BLOCK_OUT];
-uchar zbuf[M_BLOCK + 600 + (M_BLOCK / 100)];
-
-int nIn, nOut, nZ;
-
-static char *bzerrorstrings[] = {
- "OK"
- ,"SEQUENCE_ERROR"
- ,"PARAM_ERROR"
- ,"MEM_ERROR"
- ,"DATA_ERROR"
- ,"DATA_ERROR_MAGIC"
- ,"IO_ERROR"
- ,"UNEXPECTED_EOF"
- ,"OUTBUFF_FULL"
- ,"???" /* for future */
- ,"???" /* for future */
- ,"???" /* for future */
- ,"???" /* for future */
- ,"???" /* for future */
- ,"???" /* for future */
-};
-
-void flip_bit ( int bit )
-{
- int byteno = bit / 8;
- int bitno = bit % 8;
- uchar mask = 1 << bitno;
- //fprintf ( stderr, "(byte %d bit %d mask %d)",
- // byteno, bitno, (int)mask );
- zbuf[byteno] ^= mask;
-}
-
-int main ( int argc, char** argv )
-{
- FILE* f;
- int r;
- int bit;
- int i;
-
- if (argc != 2) {
- fprintf ( stderr, "usage: unzcrash filename\n" );
- return 1;
- }
-
- f = fopen ( argv[1], "r" );
- if (!f) {
- fprintf ( stderr, "unzcrash: can't open %s\n", argv[1] );
- return 1;
- }
-
- nIn = fread ( inbuf, 1, M_BLOCK, f );
- fprintf ( stderr, "%d bytes read\n", nIn );
-
- nZ = M_BLOCK;
- r = BZ2_bzBuffToBuffCompress (
- zbuf, &nZ, inbuf, nIn, 9, 0, 30 );
-
- assert (r == BZ_OK);
- fprintf ( stderr, "%d after compression\n", nZ );
-
- for (bit = 0; bit < nZ*8; bit++) {
- fprintf ( stderr, "bit %d ", bit );
- flip_bit ( bit );
- nOut = M_BLOCK_OUT;
- r = BZ2_bzBuffToBuffDecompress (
- outbuf, &nOut, zbuf, nZ, 0, 0 );
- fprintf ( stderr, " %d %s ", r, bzerrorstrings[-r] );
-
- if (r != BZ_OK) {
- fprintf ( stderr, "\n" );
- } else {
- if (nOut != nIn) {
- fprintf(stderr, "nIn/nOut mismatch %d %d\n", nIn, nOut );
- return 1;
- } else {
- for (i = 0; i < nOut; i++)
- if (inbuf[i] != outbuf[i]) {
- fprintf(stderr, "mismatch at %d\n", i );
- return 1;
- }
- if (i == nOut) fprintf(stderr, "really ok!\n" );
- }
- }
-
- flip_bit ( bit );
- }
-
-#if 0
- assert (nOut == nIn);
- for (i = 0; i < nOut; i++) {
- if (inbuf[i] != outbuf[i]) {
- fprintf ( stderr, "difference at %d !\n", i );
- return 1;
- }
- }
-#endif
-
- fprintf ( stderr, "all ok\n" );
- return 0;
-}
use bytes ;
our ($VERSION, $XS_VERSION, @ISA, @EXPORT, $AUTOLOAD);
-$VERSION = '2.021';
+$VERSION = '2.024';
$XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
=head1 SEE ALSO
-L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
+L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
L<Compress::Zlib::FAQ|Compress::Zlib::FAQ>
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2005-2009 Paul Marquess. All rights reserved.
+Copyright (c) 2005-2010 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=head1 SEE ALSO
-L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
+L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
L<Compress::Zlib::FAQ|Compress::Zlib::FAQ>
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2005-2009 Paul Marquess. All rights reserved.
+Copyright (c) 2005-2010 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
- my $VERSION = '2.021';
+ my $VERSION = '2.024';
my @NAMES = qw(
);
$count = 103 ;
}
elsif ($] >= 5.006) {
- $count = 157 ;
+ $count = 173 ;
}
else {
- $count = 115 ;
+ $count = 131 ;
}
plan tests => $count + $extra;
foreach (1 .. 2)
{
- next if $[ < 5.005 ;
+ next if $] < 5.005 ;
title 'test bzinflate/bzdeflate with a substr';
my $status = $x->bzdeflate(substr($contents,0), $X);
cmp_ok $status, '==', BZ_RUN_OK ;
- cmp_ok $x->bzflush($X), '==', BZ_RUN_OK ;
+ cmp_ok $x->bzclose($X), '==', BZ_STREAM_END ;
my $append = "Appended" ;
$X .= $append ;
- ok my $k = new Compress::Raw::Bunzip2(1, 0) ;
+ ok my $k = new Compress::Raw::Bunzip2(1, 1) ;
my $Z;
my $keep = $X ;
sub title
{
#diag "" ;
- ok 1, $_[0] ;
+ ok(1, $_[0]) ;
#diag "" ;
}
Append => 1,
Transparent => 0,
RawInflate => 1,
+ UnLzma => 1,
@opts
or croak "Cannot open buffer/file: $AnyUncompressError" ;
Append => 1,
Transparent => 0,
RawInflate => 1,
+ UnLzma => 1,
@opts
or croak "Cannot open buffer/file: $AnyUncompressError" ;
{
my $class = shift ;
- return (0,0) if $class =~ /lzf/i;
+ return (0,0) if $class =~ /lzf|lzma/i;
return (1,0);
}
CHANGES
-------
+ 2.023 9 November 2009
+
+ * fixed instance where $[ should have been $] in t/02zlib.t
+ Thanks to Robin Barker and zefram [RT #50765] for independantly
+ spotting the issue.
+
2.021 30 August 2009
* Changed test harness so that it can cope with PERL5OPT=-MCarp=verbose
Compress-Raw-Zlib
- Version 2.021
+ Version 2.024
- 30th August 2009
+ 7th January 2010
- Copyright (c) 2005-2009 Paul Marquess. All rights reserved.
+ Copyright (c) 2005-2010 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.
If you haven't installed Compress-Raw-Zlib then search Compress::Raw::Zlib.pm
for a line like this:
- $VERSION = "2.021" ;
+ $VERSION = "2.024" ;
c. The version of zlib you have used.
If you have successfully installed Compress-Raw-Zlib, this one-liner
* Created : 22nd January 1996
* Version : 2.000
*
- * Copyright (c) 1995-2009 Paul Marquess. All rights reserved.
+ * Copyright (c) 1995-2010 Paul Marquess. All rights reserved.
* This program is free software; you can redistribute it and/or
* modify it under the same terms as Perl itself.
*
use bytes ;
our ($VERSION, $XS_VERSION, @ISA, @EXPORT, $AUTOLOAD);
-$VERSION = '2.021';
+$VERSION = '2.024';
$XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
=head1 SEE ALSO
-L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
+L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
L<Compress::Zlib::FAQ|Compress::Zlib::FAQ>
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2005-2009 Paul Marquess. All rights reserved.
+Copyright (c) 2005-2010 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=head1 SEE ALSO
-L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
+L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
L<Compress::Zlib::FAQ|Compress::Zlib::FAQ>
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2005-2009 Paul Marquess. All rights reserved.
+Copyright (c) 2005-2010 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
$count = 230 ;
}
elsif ($] >= 5.006) {
- $count = 284 ;
+ $count = 300 ;
}
else {
- $count = 242 ;
+ $count = 258 ;
}
plan tests => $count + $extra;
foreach (1 .. 2)
{
- next if $[ < 5.005 ;
+ next if $] < 5.005 ;
title 'test inflate/deflate with a substr';
sub title
{
#diag "" ;
- ok 1, $_[0] ;
+ ok(1, $_[0]) ;
#diag "" ;
}
Append => 1,
Transparent => 0,
RawInflate => 1,
+ UnLzma => 1,
@opts
or croak "Cannot open buffer/file: $AnyUncompressError" ;
Append => 1,
Transparent => 0,
RawInflate => 1,
+ UnLzma => 1,
@opts
or croak "Cannot open buffer/file: $AnyUncompressError" ;
{
my $class = shift ;
- return (0,0) if $class =~ /lzf/i;
+ return (0,0) if $class =~ /lzf|lzma/i;
return (1,0);
}
my $cmd = shift;
my $ec;
if ($^O eq 'VMS') {
+ # Preserve non-posixified status and don't bit shift the result.
+ use vmsish 'status';
$ec = system("mcr $cmd");
+ return $ec;
}
$ec = system($cmd);
return $ec == -1 ? -1 : $ec >> 8;
# If we make $VERSION an our variable parse_version() breaks
use vars qw($VERSION);
-$VERSION = '6.56';
+$VERSION = '6.5601';
require ExtUtils::MM_Any;
our @ISA = qw(ExtUtils::MM_Any);
$inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod;
next if !$inpod;
chop;
- next unless /^($package\s-\s)(.*)/;
+ next unless /^($package(?:\.pm)?\s+\-+\s+)(.*)/;
$result = $2;
last;
}
my @Prepend_parent;
my %Recognized_Att_Keys;
-our $VERSION = '6.56';
+our $VERSION = '6.5601';
# Emulate something resembling CVS $Revision$
(our $Revision = $VERSION) =~ s{_}{};
if (!$installed_file) {
warn sprintf "Warning: prerequisite %s %s not found.\n",
$prereq, $required_version
- unless $self->{PREREQ_FATAL};
+ unless $self->{PREREQ_FATAL}
+ or $ENV{PERL_CORE};
$unsatisfied{$prereq} = 'not installed';
}
elsif ($pr_version < $required_version ){
warn sprintf "Warning: prerequisite %s %s not found. We have %s.\n",
$prereq, $required_version, ($pr_version || 'unknown version')
- unless $self->{PREREQ_FATAL};
+ unless $self->{PREREQ_FATAL}
+ or $ENV{PERL_CORE};
$unsatisfied{$prereq} = $required_version ? $required_version : 'unknown version' ;
}
local $SIG{__WARN__} = sub {
$warnings .= join '', @_;
};
+ # prerequisite warnings are disbled while building the perl core:
+ local %ENV = %ENV;
+ delete $ENV{PERL_CORE};
WriteMakefile(
NAME => 'Big::Dummy',
Revision history for Perl extension ExtUtils::ParseXS.
+2.2205 - Wed Mar 10 18:15:36 EST 2010
+
+ Other:
+
+ - No longer ships with Build.PL to avoid creating a circular dependency
+
+2.2204 - Wed Mar 10 14:23:52 EST 2010
+
+ Other:
+
+ - Downgraded warnings on using INCLUDE with a command from "deprecated"
+ to "discouraged" and limited it to the case where the command includes
+ "perl" [Steffen Mueller]
+
+2.2203 - Thu Feb 11 14:00:51 EST 2010
+
+ Bug fixes:
+
+ - Build.PL was not including ExtUtils/xsubpp for installation. Fixed
+ by subclassing M::B::find_pm_files to include it [David Golden]
+
+2.2202 - Wed Jan 27 15:04:59 EST 2010
+
+ Bug fixes:
+
+ - The fix to IN/OUT/OUTLIST was itself broken and is now fixed.
+ [Reported by Serdar Dalgic; fix suggested by Rafael Garcia-Suarez]
+
+ We apologize for the fault in the regex. Those responsible
+ have been sacked.
+
+2.2201 Mon Jan 25 16:12:05 EST 2010
+
+ Bug fixes:
+
+ - IN/OUT/OUTLIST, etc. were broken due to a bad regexp. [Simon Cozens]
+
+2.22 - Mon Jan 11 15:00:07 EST 2010
+
+ No changes from 2.21_02
+
+2.21_02 - Sat Dec 19 10:55:41 EST 2009
+
+ Bug fixes:
+
+ - fixed bugs and added tests for INCLUDE_COMMAND [Steffen Mueller]
+
+2.21_01 - Sat Dec 19 07:22:44 EST 2009
+
+ Enhancements:
+
+ - New 'INCLUDE_COMMAND' directive [Steffen Mueller]
+
+ Bug fixes:
+
+ - Workaround for empty newXS macro found in P5NCI [Goro Fuji]
+
2.21 - Mon Oct 5 11:17:53 EDT 2009
Bug fixes:
Bug fixes:
- Use "char* file" for perl < 5.9, not "char[] file"; fixes mod_perl
- breakage due to prior attempts to fix RT#48104 [David Golden]
+ breakage due to prior attempts to fix RT#48104 [David Golden]
2.20_06 - Fri Oct 2 23:45:45 EDT 2009
2.20_03 - Thu Jul 23 23:14:50 EDT 2009
Bug fixes:
- - Fixed "const char *" errors for 5.8.8 (and older) (RT#48104)
- [Vincent Pit]
+ - Fixed "const char *" errors for 5.8.8 (and older) (RT#48104)
+ [Vincent Pit]
- Added newline before a preprocessor directive (RT#30673)
[patch by hjp]
my($XSS_work_idx, $cpp_next_tmp);
use vars qw($VERSION);
-$VERSION = '2.21';
+$VERSION = '2.2205';
$VERSION = eval $VERSION if $VERSION =~ /_/;
use vars qw(%input_expr %output_expr $ProtoUsed @InitFileCode $FH $proto_re $Overload $errors $Fallback
# Match an XS keyword
$BLOCK_re= '\s*(' . join('|', qw(
- REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE OUTPUT
- CLEANUP ALIAS ATTRS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE
- SCOPE INTERFACE INTERFACE_MACRO C_ARGS POSTCALL OVERLOAD FALLBACK
+ REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE
+ OUTPUT CLEANUP ALIAS ATTRS PROTOTYPES PROTOTYPE
+ VERSIONCHECK INCLUDE INCLUDE_COMMAND SCOPE INTERFACE
+ INTERFACE_MACRO C_ARGS POSTCALL OVERLOAD FALLBACK
)) . "|$END)\\s*:";
$xsreturn = 0;
$_ = shift(@line);
- while (my $kwd = check_keyword("REQUIRE|PROTOTYPES|FALLBACK|VERSIONCHECK|INCLUDE|SCOPE")) {
+ while (my $kwd = check_keyword("REQUIRE|PROTOTYPES|FALLBACK|VERSIONCHECK|INCLUDE(?:_COMMAND)?|SCOPE")) {
&{"${kwd}_handler"}() ;
next PARAGRAPH unless @line ;
$_ = shift(@line);
next unless defined($pre) && length($pre);
my $out_type = '';
my $inout_var;
- if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST|OUT|IN_OUT)\s+//) {
+ if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST|OUT|IN_OUT)\b\s*//) {
my $type = $1;
$out_type = $type if $type ne 'IN';
- $arg =~ s/^(IN|IN_OUTLIST|OUTLIST|OUT|IN_OUT)\s+//;
- $pre =~ s/^(IN|IN_OUTLIST|OUTLIST|OUT|IN_OUT)\s+//;
+ $arg =~ s/^(IN|IN_OUTLIST|OUTLIST|OUT|IN_OUT)\b\s*//;
+ $pre =~ s/^(IN|IN_OUTLIST|OUTLIST|OUT|IN_OUT)\b\s*//;
}
my $islength;
if ($name =~ /^length\( \s* (\w+) \s* \)\z/x) {
} else {
@args = split(/\s*,\s*/, $orig_args);
for (@args) {
- if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST|IN_OUT|OUT)\s+//) {
+ if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST|IN_OUT|OUT)\b\s*//) {
my $out_type = $1;
next if $out_type eq 'IN';
$only_C_inlist{$_} = 1 if $out_type eq "OUTLIST";
EOF
}
}
+ elsif($newXS eq 'newXS'){ # work around P5NCI's empty newXS macro
+ push(@InitFileCode,
+ " ${newXS}(\"$pname\", XS_$Full_func_name, file$proto);\n");
+ }
else {
push(@InitFileCode,
" (void)${newXS}(\"$pname\", XS_$Full_func_name, file$proto);\n");
}
+sub PushXSStack
+ {
+ # Save the current file context.
+ push(@XSStack, {
+ type => 'file',
+ LastLine => $lastline,
+ LastLineNo => $lastline_no,
+ Line => \@line,
+ LineNo => \@line_no,
+ Filename => $filename,
+ Filepathname => $filepathname,
+ Handle => $FH,
+ }) ;
+
+ }
+
sub INCLUDE_handler ()
{
# the rest of the current line should contain a valid filename
++ $IncludedFiles{$_} unless /\|\s*$/ ;
- # Save the current file context.
- push(@XSStack, {
- type => 'file',
- LastLine => $lastline,
- LastLineNo => $lastline_no,
- Line => \@line,
- LineNo => \@line_no,
- Filename => $filename,
- Filepathname => $filepathname,
- Handle => $FH,
- }) ;
+ if (/\|\s*$/ && /^\s*perl\s/) {
+ Warn("The INCLUDE directive with a command is discouraged." .
+ " Use INCLUDE_COMMAND instead! In particular using 'perl'" .
+ " in an 'INCLUDE: ... |' directive is not guaranteed to pick" .
+ " up the correct perl. The INCLUDE_COMMAND directive allows" .
+ " the use of \$^X as the currently running perl, see" .
+ " 'perldoc perlxs' for details.");
+ }
+
+ PushXSStack();
$FH = Symbol::gensym();
$lastline = $_ ;
$lastline_no = $. ;
+ }
+
+sub INCLUDE_COMMAND_handler ()
+ {
+ # the rest of the current line should contain a valid command
+
+ TrimWhitespace($_) ;
+
+ death("INCLUDE_COMMAND: command missing")
+ unless $_ ;
+
+ death("INCLUDE_COMMAND: pipes are illegal")
+ if /^\s*\|/ or /\|\s*$/ ;
+
+ PushXSStack();
+
+ $FH = Symbol::gensym();
+
+ # If $^X is used in INCLUDE_COMMAND, we know it's supposed to be
+ # the same perl interpreter as we're currently running
+ s/^\s*\$\^X/$^X/;
+
+ # open the new file
+ open ($FH, "-|", "$_")
+ or death("Cannot run command '$_' to include its output: $!") ;
+
+ print Q(<<"EOF");
+#
+#/* INCLUDE_COMMAND: Including output of '$_' from '$filename' */
+#
+EOF
+
+ $filename = $_ ;
+ $filepathname = "$dir/$filename";
+
+ # Prime the pump by reading the first
+ # non-blank line
+ # skip leading blank lines
+ while (<$FH>) {
+ last unless /^\s*$/ ;
+ }
+
+ $lastline = $_ ;
+ $lastline_no = $. ;
}
sub PopFile()
int
len(char* s, int length(s))
+INCLUDE_COMMAND: $^X -Ilib -It/lib -MIncludeTester -e IncludeTester::print_xs
+
#if 1
INCLUDE: XSInclude.xsh
--- /dev/null
+package IncludeTester;
+use strict;
+
+sub print_xs {
+ print <<'HERE';
+
+int
+sum(a, b)
+ int a
+ int b
+ CODE:
+ RETVAL = a + b;
+ OUTPUT:
+ RETVAL
+
+HERE
+}
+
+1;
+
use attributes;
use overload;
-plan tests => 24;
+plan tests => 25;
my ($source_file, $obj_file, $lib_file);
}
SKIP: {
- skip "no dynamic loading", 5
+ skip "no dynamic loading", 6
if !$b->have_compiler || !$Config{usedl};
my $module = 'XSMore';
$lib_file = $b->link( objects => $obj_file, module_name => $module );
is XSMore::len("foo"), 3, 'the length keyword';
+ is XSMore::sum(5, 9), 14, 'the INCLUDE_COMMAND directive';
+
# Win32 needs to close the DLL before it can unlink it, but unfortunately
# dl_unload_file was missing on Win32 prior to perl change #24679!
if ($^O eq 'MSWin32' and defined &DynaLoader::dl_unload_file) {
$FTP_PASSIVE $TIMEOUT $DEBUG $WARN
];
-$VERSION = '0.22';
+$VERSION = '0.24';
$VERSION = eval $VERSION; # avoid warnings with development releases
$PREFER_BIN = 0; # XXX TODO implement
$FROM_EMAIL = 'File-Fetch@example.com';
bless $args, $class;
if( lc($args->scheme) ne 'file' and not $args->host ) {
- return File::Fetch->_error(loc(
+ return $class->_error(loc(
"Hostname required when fetching from '%1'",$args->scheme));
}
for (qw[path file]) {
unless( $args->$_() ) { # 5.5.x needs the ()
- return File::Fetch->_error(loc("No '%1' specified",$_));
+ return $class->_error(loc("No '%1' specified",$_));
}
}
check( $tmpl, \%hash ) or return;
### parse the uri to usable parts ###
- my $href = __PACKAGE__->_parse_uri( $uri ) or return;
+ my $href = $class->_parse_uri( $uri ) or return;
### make it into a FFI object ###
- my $ff = File::Fetch->_create( %$href ) or return;
+ my $ff = $class->_create( %$href ) or return;
### return the object ###
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+
+my $parent_class = 'File::Fetch';
+my $child_class = 'File::Fetch::Subclass';
+
+use_ok( $parent_class );
+
+my $ff_parent = $parent_class->new( uri => 'http://example.com/index.html' );
+isa_ok( $ff_parent, $parent_class );
+
+can_ok( $child_class, qw( new fetch ) );
+my $ff_child = $child_class->new( uri => 'http://example.com/index.html' );
+isa_ok( $ff_child, $child_class );
+isa_ok( $ff_child, $parent_class );
+
+BEGIN {
+ package File::Fetch::Subclass;
+ use vars qw(@ISA);
+ unshift @ISA, qw(File::Fetch);
+ }
unless $Config{d_getgrent};
skip 'not running as root', $skip_count
unless $< == 0;
+ skip "darwin's nobody and nogroup are -1", $skip_count
+ if $^O eq 'darwin';
my $dir_stem = $dir = catdir($tmp_base, 'owned-by');
CHANGES
-------
+ 2.024 7 January 2010
+
+ * Compress::Zlib
+ Get memGunzip & memGzip to set $gzerrno
+ [RT# 47283]
+
+ * Compress::Zlib
+ Export memGunzip, memGzip and zlib_version on demand
+ [RT# 52992]
+
+ * examples/io/anycat
+ This sample was using IO::Uncompress::AnyInflate. Much better to
+ use IO::Uncompress::AnyUncompress.
+
+ 2.023 9 November 2009
+
+ * IO::Compress::AnyUncompress
+ Added support for lzma_alone & xz.
+
2.022 9 October 2009
* IO::Compress - Makefile.PL
use strict ;
require 5.004 ;
-$::VERSION = '2.021' ;
+$::VERSION = '2.024' ;
use private::MakeUtil;
use ExtUtils::MakeMaker 5.16 ;
- IO-Compress
+ IO-Compress
- Version 2.022
+ Version 2.024
- 9th October 2009
+ 7th January 2010
- Copyright (c) 1995-2009 Paul Marquess. All rights reserved.
+ Copyright (c) 1995-2010 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.
If you haven't installed IO-Compress then search IO::Compress::Gzip.pm
for a line like this:
- $VERSION = "2.021" ;
+ $VERSION = "2.024" ;
2. If you are having problems building IO-Compress, send me a
complete log of what happened. Start by unpacking the IO-Compress
use strict ;
use warnings ;
-use IO::Uncompress::AnyInflate qw( anyinflate $AnyInflateError );
+use IO::Uncompress::AnyUncompress qw( anyuncompress $AnyUncompressError );
@ARGV = '-' unless @ARGV ;
foreach my $file (@ARGV) {
- anyinflate $file => '-',
+ anyuncompress $file => '-',
Transparent => 1,
Strict => 0,
- or die "Cannot uncompress '$file': $AnyInflateError\n" ;
+ or die "Cannot uncompress '$file': $AnyUncompressError\n" ;
}
use IO::Handle ;
use Scalar::Util qw(dualvar);
-use IO::Compress::Base::Common 2.021 ;
-use Compress::Raw::Zlib 2.021 ;
-use IO::Compress::Gzip 2.021 ;
-use IO::Uncompress::Gunzip 2.021 ;
+use IO::Compress::Base::Common 2.024 ;
+use Compress::Raw::Zlib 2.024 ;
+use IO::Compress::Gzip 2.024 ;
+use IO::Uncompress::Gunzip 2.024 ;
use strict ;
use warnings ;
use bytes ;
-our ($VERSION, $XS_VERSION, @ISA, @EXPORT, $AUTOLOAD);
+our ($VERSION, $XS_VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $AUTOLOAD);
-$VERSION = '2.022';
+$VERSION = '2.024';
$XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
push @EXPORT, @Compress::Raw::Zlib::EXPORT ;
+@EXPORT_OK = qw(memGunzip memGzip zlib_version);
+%EXPORT_TAGS = (
+ ALL => \@EXPORT
+);
+
BEGIN
{
*zlib_version = \&Compress::Raw::Zlib::zlib_version;
return $value ;
}
+sub _set_gzerr_undef
+{
+ _set_gzerr(@_);
+ return undef;
+}
sub _save_gzerr
{
my $gz = shift ;
package Compress::Zlib ;
-use IO::Compress::Gzip::Constants 2.021 ;
+use IO::Compress::Gzip::Constants 2.024 ;
sub memGzip($)
{
$] >= 5.008 and (utf8::downgrade($$string, 1)
or croak "Wide character in memGzip");
- IO::Compress::Gzip::gzip($string, \$out, Minimal => 1)
- or return undef ;
+ _set_gzerr(0);
+ if ( ! IO::Compress::Gzip::gzip($string, \$out, Minimal => 1) )
+ {
+ $Compress::Zlib::gzerrno = $IO::Compress::Gzip::GzipError;
+ return undef ;
+ }
return $out;
}
-
sub _removeGzipHeader($)
{
my $string = shift ;
return Z_OK();
}
+sub _ret_gun_error
+{
+ $Compress::Zlib::gzerrno = $IO::Uncompress::Gunzip::GunzipError;
+ return undef;
+}
+
sub memGunzip($)
{
$] >= 5.008 and (utf8::downgrade($$string, 1)
or croak "Wide character in memGunzip");
- _removeGzipHeader($string) == Z_OK()
- or return undef;
+ _set_gzerr(0);
+
+ my $status = _removeGzipHeader($string) ;
+ $status == Z_OK()
+ or return _set_gzerr_undef($status);
my $bufsize = length $$string > 4096 ? length $$string : 4096 ;
my $x = new Compress::Raw::Zlib::Inflate({-WindowBits => - MAX_WBITS(),
-Bufsize => $bufsize})
- or return undef;
+ or return _ret_gun_error();
my $output = "" ;
- my $status = $x->inflate($string, $output);
- return undef
- unless $status == Z_STREAM_END();
+ $status = $x->inflate($string, $output);
+
+ if ( $status == Z_OK() )
+ {
+ _set_gzerr(Z_DATA_ERROR());
+ return undef;
+ }
+
+ return _ret_gun_error()
+ if ($status != Z_STREAM_END());
if (length $$string >= 8)
{
my ($crc, $len) = unpack ("VV", substr($$string, 0, 8));
substr($$string, 0, 8) = '';
- return undef
+ return _set_gzerr_undef(Z_DATA_ERROR())
unless $len == length($output) and
$crc == crc32($output);
}
{
$$string = '';
}
+
return $output;
}
This function is used to create an in-memory gzip file with the minimum
possible gzip header (exactly 10 bytes).
- $dest = Compress::Zlib::memGzip($buffer) ;
+ $dest = Compress::Zlib::memGzip($buffer)
+ or die "Cannot compress: $gzerrno\n";
-If successful, it returns the in-memory gzip file, otherwise it returns
-undef.
+If successful, it returns the in-memory gzip file. Otherwise it returns
+C<undef> and the C<$gzerrno> variable will store the zlib error code.
The C<$buffer> parameter can either be a scalar or a scalar reference.
This function is used to uncompress an in-memory gzip file.
- $dest = Compress::Zlib::memGunzip($buffer) ;
+ $dest = Compress::Zlib::memGunzip($buffer)
+ or die "Cannot uncomprss: $gzerrno\n";
-If successful, it returns the uncompressed gzip file, otherwise it
-returns undef.
+If successful, it returns the uncompressed gzip file. Otherwise it
+returns C<undef> and the C<$gzerrno> variable will store the zlib error
+code.
The C<$buffer> parameter can either be a scalar or a scalar reference. The
contents of the C<$buffer> parameter are destroyed after calling this function.
=head1 SEE ALSO
-L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
+L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
L<Compress::Zlib::FAQ|Compress::Zlib::FAQ>
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 1995-2009 Paul Marquess. All rights reserved.
+Copyright (c) 1995-2010 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.021 qw(:Status);
+use IO::Compress::Base::Common 2.024 qw(:Status);
#use Compress::Bzip2 ;
-use Compress::Raw::Bzip2 2.021 ;
+use Compress::Raw::Bzip2 2.024 ;
our ($VERSION);
-$VERSION = '2.022';
+$VERSION = '2.024';
sub mkCompObject
{
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.021 qw(:Status);
+use IO::Compress::Base::Common 2.024 qw(:Status);
-use Compress::Raw::Zlib 2.021 qw(Z_OK Z_FINISH MAX_WBITS) ;
+use Compress::Raw::Zlib 2.024 qw(Z_OK Z_FINISH MAX_WBITS) ;
our ($VERSION);
-$VERSION = '2.022';
+$VERSION = '2.024';
sub mkCompObject
{
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.021 qw(:Status);
+use IO::Compress::Base::Common 2.024 qw(:Status);
our ($VERSION);
-$VERSION = '2.022';
+$VERSION = '2.024';
sub mkCompObject
{
use strict ;
use warnings;
-use IO::Compress::Base::Common 2.021 ;
+use IO::Compress::Base::Common 2.024 ;
use IO::File ;
use Scalar::Util qw(blessed readonly);
our (@ISA, $VERSION);
@ISA = qw(Exporter IO::File);
-$VERSION = '2.022';
+$VERSION = '2.024';
#Can't locate object method "SWASHNEW" via package "utf8" (perhaps you forgot to load "utf8"?) at .../ext/Compress-Zlib/Gzip/blib/lib/Compress/Zlib/Common.pm line 16.
=head1 SEE ALSO
-L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
+L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
L<Compress::Zlib::FAQ|Compress::Zlib::FAQ>
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2005-2009 Paul Marquess. All rights reserved.
+Copyright (c) 2005-2010 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
require Exporter;
our ($VERSION, @ISA, @EXPORT, %EXPORT_TAGS, $HAS_ENCODE);
@ISA = qw(Exporter);
-$VERSION = '2.022';
+$VERSION = '2.024';
@EXPORT = qw( isaFilehandle isaFilename whatIsInput whatIsOutput
isaFileGlobString cleanFileGlobString oneTarget
use bytes;
require Exporter ;
-use IO::Compress::Base 2.021 ;
+use IO::Compress::Base 2.024 ;
-use IO::Compress::Base::Common 2.021 qw(createSelfTiedObject);
-use IO::Compress::Adapter::Bzip2 2.021 ;
+use IO::Compress::Base::Common 2.024 qw(createSelfTiedObject);
+use IO::Compress::Adapter::Bzip2 2.024 ;
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $Bzip2Error);
-$VERSION = '2.022';
+$VERSION = '2.024';
$Bzip2Error = '';
@ISA = qw(Exporter IO::Compress::Base);
{
my $self = shift ;
- use IO::Compress::Base::Common 2.021 qw(:Parse);
+ use IO::Compress::Base::Common 2.024 qw(:Parse);
return (
'BlockSize100K' => [0, 1, Parse_unsigned, 1],
require Exporter ;
-use IO::Compress::RawDeflate 2.021 ;
+use IO::Compress::RawDeflate 2.024 ;
-use Compress::Raw::Zlib 2.021 ;
-use IO::Compress::Zlib::Constants 2.021 ;
-use IO::Compress::Base::Common 2.021 qw(createSelfTiedObject);
+use Compress::Raw::Zlib 2.024 ;
+use IO::Compress::Zlib::Constants 2.024 ;
+use IO::Compress::Base::Common 2.024 qw(createSelfTiedObject);
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $DeflateError);
-$VERSION = '2.022';
+$VERSION = '2.024';
$DeflateError = '';
@ISA = qw(Exporter IO::Compress::RawDeflate);
=item C<< Append => 0|1 >>
-TODO
+The behaviour of this option is dependent on the type of output data
+stream.
+
+=over 5
+
+=item * A Buffer
+
+If C<Append> is enabled, all compressed data will be append to the end of
+the output buffer. Otherwise the output buffer will be cleared before any
+compressed data is written to it.
+
+=item * A Filename
+
+If C<Append> is enabled, the file will be opened in append mode. Otherwise
+the contents of the file, if any, will be truncated before any compressed
+data is written to it.
+
+=item * A Filehandle
+
+If C<Append> is enabled, the filehandle will be positioned to the end of
+the file via a call to C<seek> before any compressed data is
+written to it. Otherwise the file pointer will not be moved.
+
+=back
+
+When C<Append> is specified, and set to true, it will I<append> all compressed
+data to the output data stream.
+
+So when the output is a filehandle it will carry out a seek to the eof
+before writing any compressed data. If the output is a filename, it will be opened for
+appending. If the output is a buffer, all compressed data will be appened to
+the existing buffer.
+
+Conversely when C<Append> is not specified, or it is present and is set to
+false, it will operate as follows.
+
+When the output is a filename, it will truncate the contents of the file
+before writing any compressed data. If the output is a filehandle
+its position will not be changed. If the output is a buffer, it will be
+wiped before any compressed data is output.
+
+Defaults to 0.
=back
=item * A Buffer
If C<$output> is a buffer and C<Append> is enabled, all compressed data
-will be append to the end if C<$output>. Otherwise C<$output> will be
+will be append to the end of C<$output>. Otherwise C<$output> will be
cleared before any data is written to it.
=item * A Filename
=head1 SEE ALSO
-L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
+L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
L<Compress::Zlib::FAQ|Compress::Zlib::FAQ>
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2005-2009 Paul Marquess. All rights reserved.
+Copyright (c) 2005-2010 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
use bytes;
-use IO::Compress::RawDeflate 2.021 ;
+use IO::Compress::RawDeflate 2.024 ;
-use Compress::Raw::Zlib 2.021 ;
-use IO::Compress::Base::Common 2.021 qw(:Status :Parse createSelfTiedObject);
-use IO::Compress::Gzip::Constants 2.021 ;
-use IO::Compress::Zlib::Extra 2.021 ;
+use Compress::Raw::Zlib 2.024 ;
+use IO::Compress::Base::Common 2.024 qw(:Status :Parse createSelfTiedObject);
+use IO::Compress::Gzip::Constants 2.024 ;
+use IO::Compress::Zlib::Extra 2.024 ;
BEGIN
{
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $GzipError);
-$VERSION = '2.022';
+$VERSION = '2.024';
$GzipError = '' ;
@ISA = qw(Exporter IO::Compress::RawDeflate);
=item C<< Append => 0|1 >>
-TODO
+The behaviour of this option is dependent on the type of output data
+stream.
+
+=over 5
+
+=item * A Buffer
+
+If C<Append> is enabled, all compressed data will be append to the end of
+the output buffer. Otherwise the output buffer will be cleared before any
+compressed data is written to it.
+
+=item * A Filename
+
+If C<Append> is enabled, the file will be opened in append mode. Otherwise
+the contents of the file, if any, will be truncated before any compressed
+data is written to it.
+
+=item * A Filehandle
+
+If C<Append> is enabled, the filehandle will be positioned to the end of
+the file via a call to C<seek> before any compressed data is
+written to it. Otherwise the file pointer will not be moved.
+
+=back
+
+When C<Append> is specified, and set to true, it will I<append> all compressed
+data to the output data stream.
+
+So when the output is a filehandle it will carry out a seek to the eof
+before writing any compressed data. If the output is a filename, it will be opened for
+appending. If the output is a buffer, all compressed data will be appened to
+the existing buffer.
+
+Conversely when C<Append> is not specified, or it is present and is set to
+false, it will operate as follows.
+
+When the output is a filename, it will truncate the contents of the file
+before writing any compressed data. If the output is a filehandle
+its position will not be changed. If the output is a buffer, it will be
+wiped before any compressed data is output.
+
+Defaults to 0.
=back
=item * A Buffer
If C<$output> is a buffer and C<Append> is enabled, all compressed data
-will be append to the end if C<$output>. Otherwise C<$output> will be
+will be append to the end of C<$output>. Otherwise C<$output> will be
cleared before any data is written to it.
=item * A Filename
=head1 SEE ALSO
-L<Compress::Zlib>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
+L<Compress::Zlib>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
L<Compress::Zlib::FAQ|Compress::Zlib::FAQ>
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2005-2009 Paul Marquess. All rights reserved.
+Copyright (c) 2005-2010 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
our ($VERSION, @ISA, @EXPORT, %GZIP_OS_Names);
our ($GZIP_FNAME_INVALID_CHAR_RE, $GZIP_FCOMMENT_INVALID_CHAR_RE);
-$VERSION = '2.022';
+$VERSION = '2.024';
@ISA = qw(Exporter);
use bytes;
-use IO::Compress::Base 2.021 ;
-use IO::Compress::Base::Common 2.021 qw(:Status createSelfTiedObject);
-use IO::Compress::Adapter::Deflate 2.021 ;
+use IO::Compress::Base 2.024 ;
+use IO::Compress::Base::Common 2.024 qw(:Status createSelfTiedObject);
+use IO::Compress::Adapter::Deflate 2.024 ;
require Exporter ;
our ($VERSION, @ISA, @EXPORT_OK, %DEFLATE_CONSTANTS, %EXPORT_TAGS, $RawDeflateError);
-$VERSION = '2.022';
+$VERSION = '2.024';
$RawDeflateError = '';
@ISA = qw(Exporter IO::Compress::Base);
{
my $self = shift ;
- use IO::Compress::Base::Common 2.021 qw(:Parse);
- use Compress::Raw::Zlib 2.021 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY);
+ use IO::Compress::Base::Common 2.024 qw(:Parse);
+ use Compress::Raw::Zlib 2.024 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY);
return (
=item C<< Append => 0|1 >>
-TODO
+The behaviour of this option is dependent on the type of output data
+stream.
+
+=over 5
+
+=item * A Buffer
+
+If C<Append> is enabled, all compressed data will be append to the end of
+the output buffer. Otherwise the output buffer will be cleared before any
+compressed data is written to it.
+
+=item * A Filename
+
+If C<Append> is enabled, the file will be opened in append mode. Otherwise
+the contents of the file, if any, will be truncated before any compressed
+data is written to it.
+
+=item * A Filehandle
+
+If C<Append> is enabled, the filehandle will be positioned to the end of
+the file via a call to C<seek> before any compressed data is
+written to it. Otherwise the file pointer will not be moved.
+
+=back
+
+When C<Append> is specified, and set to true, it will I<append> all compressed
+data to the output data stream.
+
+So when the output is a filehandle it will carry out a seek to the eof
+before writing any compressed data. If the output is a filename, it will be opened for
+appending. If the output is a buffer, all compressed data will be appened to
+the existing buffer.
+
+Conversely when C<Append> is not specified, or it is present and is set to
+false, it will operate as follows.
+
+When the output is a filename, it will truncate the contents of the file
+before writing any compressed data. If the output is a filehandle
+its position will not be changed. If the output is a buffer, it will be
+wiped before any compressed data is output.
+
+Defaults to 0.
=back
=item * A Buffer
If C<$output> is a buffer and C<Append> is enabled, all compressed data
-will be append to the end if C<$output>. Otherwise C<$output> will be
+will be append to the end of C<$output>. Otherwise C<$output> will be
cleared before any data is written to it.
=item * A Filename
=head1 SEE ALSO
-L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
+L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
L<Compress::Zlib::FAQ|Compress::Zlib::FAQ>
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2005-2009 Paul Marquess. All rights reserved.
+Copyright (c) 2005-2010 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.021 qw(:Status createSelfTiedObject);
-use IO::Compress::RawDeflate 2.021 ;
-use IO::Compress::Adapter::Deflate 2.021 ;
-use IO::Compress::Adapter::Identity 2.021 ;
-use IO::Compress::Zlib::Extra 2.021 ;
-use IO::Compress::Zip::Constants 2.021 ;
+use IO::Compress::Base::Common 2.024 qw(:Status createSelfTiedObject);
+use IO::Compress::RawDeflate 2.024 ;
+use IO::Compress::Adapter::Deflate 2.024 ;
+use IO::Compress::Adapter::Identity 2.024 ;
+use IO::Compress::Zlib::Extra 2.024 ;
+use IO::Compress::Zip::Constants 2.024 ;
-use Compress::Raw::Zlib 2.021 qw(crc32) ;
+use Compress::Raw::Zlib 2.024 qw(crc32) ;
BEGIN
{
eval { require IO::Compress::Adapter::Bzip2 ;
- import IO::Compress::Adapter::Bzip2 2.021 ;
+ import IO::Compress::Adapter::Bzip2 2.024 ;
require IO::Compress::Bzip2 ;
- import IO::Compress::Bzip2 2.021 ;
- } ;
- eval { require IO::Compress::Adapter::Lzma ;
- import IO::Compress::Adapter::Lzma 2.020 ;
- require IO::Compress::Lzma ;
- import IO::Compress::Lzma 2.020 ;
+ import IO::Compress::Bzip2 2.024 ;
} ;
+# eval { require IO::Compress::Adapter::Lzma ;
+# import IO::Compress::Adapter::Lzma 2.020 ;
+# require IO::Compress::Lzma ;
+# import IO::Compress::Lzma 2.024 ;
+# } ;
}
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $ZipError);
-$VERSION = '2.022';
+$VERSION = '2.024';
$ZipError = '';
@ISA = qw(Exporter IO::Compress::RawDeflate);
);
*$self->{ZipData}{CRC32} = crc32(undef);
}
- elsif (*$self->{ZipData}{Method} == ZIP_CM_LZMA) {
- ($obj, $errstr, $errno) = IO::Compress::Adapter::Lzma::mkCompObject();
- *$self->{ZipData}{CRC32} = crc32(undef);
- }
+# elsif (*$self->{ZipData}{Method} == ZIP_CM_LZMA) {
+# ($obj, $errstr, $errno) = IO::Compress::Adapter::Lzma::mkCompObject();
+# *$self->{ZipData}{CRC32} = crc32(undef);
+# }
return $self->saveErrorString(undef, $errstr, $errno)
if ! defined $obj;
! defined $IO::Compress::Adapter::Bzip2::VERSION;
return $self->saveErrorString(undef, "Lzma not available")
- if $method == ZIP_CM_LZMA and
- ! defined $IO::Compress::Adapter::Lzma::VERSION;
+ if $method == ZIP_CM_LZMA ;
+ #and
+ #! defined $IO::Compress::Adapter::Lzma::VERSION;
*$self->{ZipData}{Method} = $method;
{
my $self = shift ;
- use IO::Compress::Base::Common 2.021 qw(:Parse);
- use Compress::Raw::Zlib 2.021 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY);
+ use IO::Compress::Base::Common 2.024 qw(:Parse);
+ use Compress::Raw::Zlib 2.024 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY);
my @Bzip2 = ();
=item C<< Append => 0|1 >>
-TODO
+The behaviour of this option is dependent on the type of output data
+stream.
+
+=over 5
+
+=item * A Buffer
+
+If C<Append> is enabled, all compressed data will be append to the end of
+the output buffer. Otherwise the output buffer will be cleared before any
+compressed data is written to it.
+
+=item * A Filename
+
+If C<Append> is enabled, the file will be opened in append mode. Otherwise
+the contents of the file, if any, will be truncated before any compressed
+data is written to it.
+
+=item * A Filehandle
+
+If C<Append> is enabled, the filehandle will be positioned to the end of
+the file via a call to C<seek> before any compressed data is
+written to it. Otherwise the file pointer will not be moved.
+
+=back
+
+When C<Append> is specified, and set to true, it will I<append> all compressed
+data to the output data stream.
+
+So when the output is a filehandle it will carry out a seek to the eof
+before writing any compressed data. If the output is a filename, it will be opened for
+appending. If the output is a buffer, all compressed data will be appened to
+the existing buffer.
+
+Conversely when C<Append> is not specified, or it is present and is set to
+false, it will operate as follows.
+
+When the output is a filename, it will truncate the contents of the file
+before writing any compressed data. If the output is a filehandle
+its position will not be changed. If the output is a buffer, it will be
+wiped before any compressed data is output.
+
+Defaults to 0.
=back
=item * A Buffer
If C<$output> is a buffer and C<Append> is enabled, all compressed data
-will be append to the end if C<$output>. Otherwise C<$output> will be
+will be append to the end of C<$output>. Otherwise C<$output> will be
cleared before any data is written to it.
=item * A Filename
=head1 SEE ALSO
-L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
+L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
L<Compress::Zlib::FAQ|Compress::Zlib::FAQ>
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2005-2009 Paul Marquess. All rights reserved.
+Copyright (c) 2005-2010 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
our ($VERSION, @ISA, @EXPORT, %ZIP_CM_MIN_VERSIONS);
-$VERSION = '2.022';
+$VERSION = '2.024';
@ISA = qw(Exporter);
our ($VERSION, @ISA, @EXPORT);
-$VERSION = '2.022';
+$VERSION = '2.024';
@ISA = qw(Exporter);
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS);
-$VERSION = '2.022';
+$VERSION = '2.024';
-use IO::Compress::Gzip::Constants 2.021 ;
+use IO::Compress::Gzip::Constants 2.024 ;
sub ExtraFieldError
{
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.021 qw(:Status);
+use IO::Compress::Base::Common 2.024 qw(:Status);
-use Compress::Raw::Bzip2 2.021 ;
+use Compress::Raw::Bzip2 2.024 ;
our ($VERSION, @ISA);
-$VERSION = '2.022';
+$VERSION = '2.024';
sub mkUncompObject
{
use strict;
use bytes;
-use IO::Compress::Base::Common 2.021 qw(:Status);
+use IO::Compress::Base::Common 2.024 qw(:Status);
our ($VERSION);
-$VERSION = '2.022';
+$VERSION = '2.024';
-use Compress::Raw::Zlib 2.021 ();
+use Compress::Raw::Zlib 2.024 ();
sub mkUncompObject
{
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.021 qw(:Status);
-use Compress::Raw::Zlib 2.021 qw(Z_OK Z_BUF_ERROR Z_STREAM_END Z_FINISH MAX_WBITS);
+use IO::Compress::Base::Common 2.024 qw(:Status);
+use Compress::Raw::Zlib 2.024 qw(Z_OK Z_BUF_ERROR Z_STREAM_END Z_FINISH MAX_WBITS);
our ($VERSION);
-$VERSION = '2.022';
+$VERSION = '2.024';
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.021 qw(createSelfTiedObject);
+use IO::Compress::Base::Common 2.024 qw(createSelfTiedObject);
-use IO::Uncompress::Adapter::Inflate 2.021 ();
+use IO::Uncompress::Adapter::Inflate 2.024 ();
-use IO::Uncompress::Base 2.021 ;
-use IO::Uncompress::Gunzip 2.021 ;
-use IO::Uncompress::Inflate 2.021 ;
-use IO::Uncompress::RawInflate 2.021 ;
-use IO::Uncompress::Unzip 2.021 ;
+use IO::Uncompress::Base 2.024 ;
+use IO::Uncompress::Gunzip 2.024 ;
+use IO::Uncompress::Inflate 2.024 ;
+use IO::Uncompress::RawInflate 2.024 ;
+use IO::Uncompress::Unzip 2.024 ;
require Exporter ;
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyInflateError);
-$VERSION = '2.022';
+$VERSION = '2.024';
$AnyInflateError = '';
@ISA = qw( Exporter IO::Uncompress::Base );
sub getExtraParams
{
- use IO::Compress::Base::Common 2.021 qw(:Parse);
+ use IO::Compress::Base::Common 2.024 qw(:Parse);
return ( 'RawInflate' => [1, 1, Parse_boolean, 0] ) ;
}
=item C<< Append => 0|1 >>
-TODO
+The behaviour of this option is dependent on the type of output data
+stream.
+
+=over 5
+
+=item * A Buffer
+
+If C<Append> is enabled, all uncompressed data will be append to the end of
+the output buffer. Otherwise the output buffer will be cleared before any
+uncompressed data is written to it.
+
+=item * A Filename
+
+If C<Append> is enabled, the file will be opened in append mode. Otherwise
+the contents of the file, if any, will be truncated before any uncompressed
+data is written to it.
+
+=item * A Filehandle
+
+If C<Append> is enabled, the filehandle will be positioned to the end of
+the file via a call to C<seek> before any uncompressed data is
+written to it. Otherwise the file pointer will not be moved.
+
+=back
+
+When C<Append> is specified, and set to true, it will I<append> all uncompressed
+data to the output data stream.
+
+So when the output is a filehandle it will carry out a seek to the eof
+before writing any uncompressed data. If the output is a filename, it will be opened for
+appending. If the output is a buffer, all uncompressed data will be appened to
+the existing buffer.
+
+Conversely when C<Append> is not specified, or it is present and is set to
+false, it will operate as follows.
+
+When the output is a filename, it will truncate the contents of the file
+before writing any uncompressed data. If the output is a filehandle
+its position will not be changed. If the output is a buffer, it will be
+wiped before any uncompressed data is output.
+
+Defaults to 0.
=item C<< MultiStream => 0|1 >>
=head1 SEE ALSO
-L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyUncompress>
+L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyUncompress>
L<Compress::Zlib::FAQ|Compress::Zlib::FAQ>
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2005-2009 Paul Marquess. All rights reserved.
+Copyright (c) 2005-2010 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.021 qw(createSelfTiedObject);
+use IO::Compress::Base::Common 2.024 qw(createSelfTiedObject);
-use IO::Uncompress::Base 2.021 ;
+use IO::Uncompress::Base 2.024 ;
require Exporter ;
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyUncompressError);
-$VERSION = '2.022';
+$VERSION = '2.024';
$AnyUncompressError = '';
@ISA = qw( Exporter IO::Uncompress::Base );
BEGIN
{
- eval ' use IO::Uncompress::Adapter::Inflate 2.021 ;';
- eval ' use IO::Uncompress::Adapter::Bunzip2 2.021 ;';
- eval ' use IO::Uncompress::Adapter::LZO 2.021 ;';
- eval ' use IO::Uncompress::Adapter::Lzf 2.021 ;';
- #eval ' use IO::Uncompress::Adapter::UnLzma 2.020 ;';
- #eval ' use IO::Uncompress::Adapter::UnXz 2.020 ;';
-
- eval ' use IO::Uncompress::Bunzip2 2.021 ;';
- eval ' use IO::Uncompress::UnLzop 2.021 ;';
- eval ' use IO::Uncompress::Gunzip 2.021 ;';
- eval ' use IO::Uncompress::Inflate 2.021 ;';
- eval ' use IO::Uncompress::RawInflate 2.021 ;';
- eval ' use IO::Uncompress::Unzip 2.021 ;';
- eval ' use IO::Uncompress::UnLzf 2.021 ;';
- #eval ' use IO::Uncompress::UnLzma 2.018 ;';
- #eval ' use IO::Uncompress::UnXz 2.018 ;';
+ eval ' use IO::Uncompress::Adapter::Inflate 2.024 ;';
+ eval ' use IO::Uncompress::Adapter::Bunzip2 2.024 ;';
+ eval ' use IO::Uncompress::Adapter::LZO 2.024 ;';
+ eval ' use IO::Uncompress::Adapter::Lzf 2.024 ;';
+ eval ' use IO::Uncompress::Adapter::UnLzma 2.020 ;';
+ eval ' use IO::Uncompress::Adapter::UnXz 2.020 ;';
+
+ eval ' use IO::Uncompress::Bunzip2 2.024 ;';
+ eval ' use IO::Uncompress::UnLzop 2.024 ;';
+ eval ' use IO::Uncompress::Gunzip 2.024 ;';
+ eval ' use IO::Uncompress::Inflate 2.024 ;';
+ eval ' use IO::Uncompress::RawInflate 2.024 ;';
+ eval ' use IO::Uncompress::Unzip 2.024 ;';
+ eval ' use IO::Uncompress::UnLzf 2.024 ;';
+ eval ' use IO::Uncompress::UnLzma 2.024 ;';
+ eval ' use IO::Uncompress::UnXz 2.024 ;';
}
sub new
sub getExtraParams
{
- use IO::Compress::Base::Common 2.021 qw(:Parse);
+ use IO::Compress::Base::Common 2.024 qw(:Parse);
return ( 'RawInflate' => [1, 1, Parse_boolean, 0] ,
'UnLzma' => [1, 1, Parse_boolean, 0] ) ;
}
}
}
-# if (defined $IO::Uncompress::UnLzma::VERSION && $got->value('UnLzma'))
-# {
-# my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::UnLzma::mkUncompObject();
-#
-# return $self->saveErrorString(undef, $errstr, $errno)
-# if ! defined $obj;
-#
-# *$self->{Uncomp} = $obj;
-#
-# my @possible = qw( UnLzma );
-# #unshift @possible, 'RawInflate'
-# # if $got->value('RawInflate');
-#
-# if ( *$self->{Info} = $self->ckMagic( @possible ))
-# {
-# return 1;
-# }
-# }
-#
-# if (defined $IO::Uncompress::UnXz::VERSION and
-# $magic = $self->ckMagic('UnXz')) {
-# *$self->{Info} = $self->readHeader($magic)
-# or return undef ;
-#
-# my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::UnXz::mkUncompObject();
-#
-# return $self->saveErrorString(undef, $errstr, $errno)
-# if ! defined $obj;
-#
-# *$self->{Uncomp} = $obj;
-#
-# return 1;
-# }
+ if (defined $IO::Uncompress::UnLzma::VERSION && $got->value('UnLzma'))
+ {
+ my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::UnLzma::mkUncompObject();
+
+ return $self->saveErrorString(undef, $errstr, $errno)
+ if ! defined $obj;
+
+ *$self->{Uncomp} = $obj;
+
+ my @possible = qw( UnLzma );
+ #unshift @possible, 'RawInflate'
+ # if $got->value('RawInflate');
+
+ if ( *$self->{Info} = $self->ckMagic( @possible ))
+ {
+ return 1;
+ }
+ }
+
+ if (defined $IO::Uncompress::UnXz::VERSION and
+ $magic = $self->ckMagic('UnXz')) {
+ *$self->{Info} = $self->readHeader($magic)
+ or return undef ;
+
+ my ($obj, $errstr, $errno) =
+ IO::Uncompress::Adapter::UnXz::mkUncompObject();
+
+ return $self->saveErrorString(undef, $errstr, $errno)
+ if ! defined $obj;
+
+ *$self->{Uncomp} = $obj;
+
+ return 1;
+ }
if (defined $IO::Uncompress::Bunzip2::VERSION and
$magic = $self->ckMagic('Bunzip2')) {
=item lzf
+=item lzma
+
+=item xz
+
=back
The module will auto-detect which, if any, of the supported
=item C<< Append => 0|1 >>
-TODO
+The behaviour of this option is dependent on the type of output data
+stream.
+
+=over 5
+
+=item * A Buffer
+
+If C<Append> is enabled, all uncompressed data will be append to the end of
+the output buffer. Otherwise the output buffer will be cleared before any
+uncompressed data is written to it.
+
+=item * A Filename
+
+If C<Append> is enabled, the file will be opened in append mode. Otherwise
+the contents of the file, if any, will be truncated before any uncompressed
+data is written to it.
+
+=item * A Filehandle
+
+If C<Append> is enabled, the filehandle will be positioned to the end of
+the file via a call to C<seek> before any uncompressed data is
+written to it. Otherwise the file pointer will not be moved.
+
+=back
+
+When C<Append> is specified, and set to true, it will I<append> all uncompressed
+data to the output data stream.
+
+So when the output is a filehandle it will carry out a seek to the eof
+before writing any uncompressed data. If the output is a filename, it will be opened for
+appending. If the output is a buffer, all uncompressed data will be appened to
+the existing buffer.
+
+Conversely when C<Append> is not specified, or it is present and is set to
+false, it will operate as follows.
+
+When the output is a filename, it will truncate the contents of the file
+before writing any uncompressed data. If the output is a filehandle
+its position will not be changed. If the output is a buffer, it will be
+wiped before any uncompressed data is output.
+
+Defaults to 0.
=item C<< MultiStream => 0|1 >>
Defaults to 0.
+=item C<< UnLzma => 0|1 >>
+
+When auto-detecting the compressed format, try to test for lzma_alone
+content using the C<IO::Uncompress::UnLzma> module.
+
+The reason this is not default behaviour is because lzma_alone content can
+only be detected by attempting to uncompress it. This process is error
+prone and can result is false positives.
+
+Defaults to 0.
+
=back
=head2 Examples
=head1 SEE ALSO
-L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>
+L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>
L<Compress::Zlib::FAQ|Compress::Zlib::FAQ>
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2005-2009 Paul Marquess. All rights reserved.
+Copyright (c) 2005-2010 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
@ISA = qw(Exporter IO::File);
-$VERSION = '2.022';
+$VERSION = '2.024';
use constant G_EOF => 0 ;
use constant G_ERR => -1 ;
-use IO::Compress::Base::Common 2.021 ;
+use IO::Compress::Base::Common 2.024 ;
#use Parse::Parameters ;
use IO::File ;
=head1 SEE ALSO
-L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
+L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
L<Compress::Zlib::FAQ|Compress::Zlib::FAQ>
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2005-2009 Paul Marquess. All rights reserved.
+Copyright (c) 2005-2010 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.021 qw(:Status createSelfTiedObject);
+use IO::Compress::Base::Common 2.024 qw(:Status createSelfTiedObject);
-use IO::Uncompress::Base 2.021 ;
-use IO::Uncompress::Adapter::Bunzip2 2.021 ;
+use IO::Uncompress::Base 2.024 ;
+use IO::Uncompress::Adapter::Bunzip2 2.024 ;
require Exporter ;
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $Bunzip2Error);
-$VERSION = '2.022';
+$VERSION = '2.024';
$Bunzip2Error = '';
@ISA = qw( Exporter IO::Uncompress::Base );
{
my $self = shift ;
- use IO::Compress::Base::Common 2.021 qw(:Parse);
+ use IO::Compress::Base::Common 2.024 qw(:Parse);
return (
'Verbosity' => [1, 1, Parse_boolean, 0],
use warnings;
use bytes;
-use IO::Uncompress::RawInflate 2.021 ;
+use IO::Uncompress::RawInflate 2.024 ;
-use Compress::Raw::Zlib 2.021 qw( crc32 ) ;
-use IO::Compress::Base::Common 2.021 qw(:Status createSelfTiedObject);
-use IO::Compress::Gzip::Constants 2.021 ;
-use IO::Compress::Zlib::Extra 2.021 ;
+use Compress::Raw::Zlib 2.024 qw( crc32 ) ;
+use IO::Compress::Base::Common 2.024 qw(:Status createSelfTiedObject);
+use IO::Compress::Gzip::Constants 2.024 ;
+use IO::Compress::Zlib::Extra 2.024 ;
require Exporter ;
$GunzipError = '';
-$VERSION = '2.022';
+$VERSION = '2.024';
sub new
{
sub getExtraParams
{
- use IO::Compress::Base::Common 2.021 qw(:Parse);
+ use IO::Compress::Base::Common 2.024 qw(:Parse);
return ( 'ParseExtra' => [1, 1, Parse_boolean, 0] ) ;
}
=item C<< Append => 0|1 >>
-TODO
+The behaviour of this option is dependent on the type of output data
+stream.
+
+=over 5
+
+=item * A Buffer
+
+If C<Append> is enabled, all uncompressed data will be append to the end of
+the output buffer. Otherwise the output buffer will be cleared before any
+uncompressed data is written to it.
+
+=item * A Filename
+
+If C<Append> is enabled, the file will be opened in append mode. Otherwise
+the contents of the file, if any, will be truncated before any uncompressed
+data is written to it.
+
+=item * A Filehandle
+
+If C<Append> is enabled, the filehandle will be positioned to the end of
+the file via a call to C<seek> before any uncompressed data is
+written to it. Otherwise the file pointer will not be moved.
+
+=back
+
+When C<Append> is specified, and set to true, it will I<append> all uncompressed
+data to the output data stream.
+
+So when the output is a filehandle it will carry out a seek to the eof
+before writing any uncompressed data. If the output is a filename, it will be opened for
+appending. If the output is a buffer, all uncompressed data will be appened to
+the existing buffer.
+
+Conversely when C<Append> is not specified, or it is present and is set to
+false, it will operate as follows.
+
+When the output is a filename, it will truncate the contents of the file
+before writing any uncompressed data. If the output is a filehandle
+its position will not be changed. If the output is a buffer, it will be
+wiped before any uncompressed data is output.
+
+Defaults to 0.
=item C<< MultiStream => 0|1 >>
=head1 SEE ALSO
-L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
+L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
L<Compress::Zlib::FAQ|Compress::Zlib::FAQ>
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2005-2009 Paul Marquess. All rights reserved.
+Copyright (c) 2005-2010 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.021 qw(:Status createSelfTiedObject);
-use IO::Compress::Zlib::Constants 2.021 ;
+use IO::Compress::Base::Common 2.024 qw(:Status createSelfTiedObject);
+use IO::Compress::Zlib::Constants 2.024 ;
-use IO::Uncompress::RawInflate 2.021 ;
+use IO::Uncompress::RawInflate 2.024 ;
require Exporter ;
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $InflateError);
-$VERSION = '2.022';
+$VERSION = '2.024';
$InflateError = '';
@ISA = qw( Exporter IO::Uncompress::RawInflate );
=item C<< Append => 0|1 >>
-TODO
+The behaviour of this option is dependent on the type of output data
+stream.
+
+=over 5
+
+=item * A Buffer
+
+If C<Append> is enabled, all uncompressed data will be append to the end of
+the output buffer. Otherwise the output buffer will be cleared before any
+uncompressed data is written to it.
+
+=item * A Filename
+
+If C<Append> is enabled, the file will be opened in append mode. Otherwise
+the contents of the file, if any, will be truncated before any uncompressed
+data is written to it.
+
+=item * A Filehandle
+
+If C<Append> is enabled, the filehandle will be positioned to the end of
+the file via a call to C<seek> before any uncompressed data is
+written to it. Otherwise the file pointer will not be moved.
+
+=back
+
+When C<Append> is specified, and set to true, it will I<append> all uncompressed
+data to the output data stream.
+
+So when the output is a filehandle it will carry out a seek to the eof
+before writing any uncompressed data. If the output is a filename, it will be opened for
+appending. If the output is a buffer, all uncompressed data will be appened to
+the existing buffer.
+
+Conversely when C<Append> is not specified, or it is present and is set to
+false, it will operate as follows.
+
+When the output is a filename, it will truncate the contents of the file
+before writing any uncompressed data. If the output is a filehandle
+its position will not be changed. If the output is a buffer, it will be
+wiped before any uncompressed data is output.
+
+Defaults to 0.
=item C<< MultiStream => 0|1 >>
=head1 SEE ALSO
-L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
+L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
L<Compress::Zlib::FAQ|Compress::Zlib::FAQ>
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2005-2009 Paul Marquess. All rights reserved.
+Copyright (c) 2005-2010 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
use warnings;
use bytes;
-use Compress::Raw::Zlib 2.021 ;
-use IO::Compress::Base::Common 2.021 qw(:Status createSelfTiedObject);
+use Compress::Raw::Zlib 2.024 ;
+use IO::Compress::Base::Common 2.024 qw(:Status createSelfTiedObject);
-use IO::Uncompress::Base 2.021 ;
-use IO::Uncompress::Adapter::Inflate 2.021 ;
+use IO::Uncompress::Base 2.024 ;
+use IO::Uncompress::Adapter::Inflate 2.024 ;
require Exporter ;
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $RawInflateError);
-$VERSION = '2.022';
+$VERSION = '2.024';
$RawInflateError = '';
@ISA = qw( Exporter IO::Uncompress::Base );
=item C<< Append => 0|1 >>
-TODO
+The behaviour of this option is dependent on the type of output data
+stream.
+
+=over 5
+
+=item * A Buffer
+
+If C<Append> is enabled, all uncompressed data will be append to the end of
+the output buffer. Otherwise the output buffer will be cleared before any
+uncompressed data is written to it.
+
+=item * A Filename
+
+If C<Append> is enabled, the file will be opened in append mode. Otherwise
+the contents of the file, if any, will be truncated before any uncompressed
+data is written to it.
+
+=item * A Filehandle
+
+If C<Append> is enabled, the filehandle will be positioned to the end of
+the file via a call to C<seek> before any uncompressed data is
+written to it. Otherwise the file pointer will not be moved.
+
+=back
+
+When C<Append> is specified, and set to true, it will I<append> all uncompressed
+data to the output data stream.
+
+So when the output is a filehandle it will carry out a seek to the eof
+before writing any uncompressed data. If the output is a filename, it will be opened for
+appending. If the output is a buffer, all uncompressed data will be appened to
+the existing buffer.
+
+Conversely when C<Append> is not specified, or it is present and is set to
+false, it will operate as follows.
+
+When the output is a filename, it will truncate the contents of the file
+before writing any uncompressed data. If the output is a filehandle
+its position will not be changed. If the output is a buffer, it will be
+wiped before any uncompressed data is output.
+
+Defaults to 0.
=item C<< MultiStream => 0|1 >>
=head1 SEE ALSO
-L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
+L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
L<Compress::Zlib::FAQ|Compress::Zlib::FAQ>
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2005-2009 Paul Marquess. All rights reserved.
+Copyright (c) 2005-2010 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
use warnings;
use bytes;
-use IO::Uncompress::RawInflate 2.021 ;
-use IO::Compress::Base::Common 2.021 qw(:Status createSelfTiedObject);
-use IO::Uncompress::Adapter::Inflate 2.021 ;
-use IO::Uncompress::Adapter::Identity 2.021 ;
-use IO::Compress::Zlib::Extra 2.021 ;
-use IO::Compress::Zip::Constants 2.021 ;
+use IO::Uncompress::RawInflate 2.024 ;
+use IO::Compress::Base::Common 2.024 qw(:Status createSelfTiedObject);
+use IO::Uncompress::Adapter::Inflate 2.024 ;
+use IO::Uncompress::Adapter::Identity 2.024 ;
+use IO::Compress::Zlib::Extra 2.024 ;
+use IO::Compress::Zip::Constants 2.024 ;
-use Compress::Raw::Zlib 2.021 qw(crc32) ;
+use Compress::Raw::Zlib 2.024 qw(crc32) ;
BEGIN
{
eval { require IO::Uncompress::Adapter::Bunzip2 ;
import IO::Uncompress::Adapter::Bunzip2 } ;
- eval { require IO::Uncompress::Adapter::UnLzma ;
- import IO::Uncompress::Adapter::UnLzma } ;
+# eval { require IO::Uncompress::Adapter::UnLzma ;
+# import IO::Uncompress::Adapter::UnLzma } ;
}
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $UnzipError, %headerLookup);
-$VERSION = '2.022';
+$VERSION = '2.024';
$UnzipError = '';
@ISA = qw(Exporter IO::Uncompress::RawInflate);
sub getExtraParams
{
- use IO::Compress::Base::Common 2.021 qw(:Parse);
+ use IO::Compress::Base::Common 2.024 qw(:Parse);
return (
*$self->{Uncomp} = $obj;
}
- elsif ($compressedMethod == ZIP_CM_LZMA)
- {
- return $self->HeaderError("Unsupported Compression format $compressedMethod")
- if ! defined $IO::Uncompress::Adapter::UnLzma::VERSION ;
-
- *$self->{Type} = 'zip-lzma';
- my $LzmaHeader;
- $self->smartReadExact(\$LzmaHeader, 4)
- or return $self->saveErrorString(undef, "Truncated file");
- my ($verHi, $verLo) = unpack ("CC", substr($LzmaHeader, 0, 2));
- my $LzmaPropertiesSize = unpack ("v", substr($LzmaHeader, 2, 2));
-
-
- my $LzmaPropertyData;
- $self->smartReadExact(\$LzmaPropertyData, $LzmaPropertiesSize)
- or return $self->saveErrorString(undef, "Truncated file");
- #my $LzmaInfo = unpack ("C", substr($LzmaPropertyData, 0, 1));
- #my $LzmaDictSize = unpack ("V", substr($LzmaPropertyData, 1, 4));
-
- # Create an LZMA_Alone header
- $self->pushBack($LzmaPropertyData .
- $uncompressedLength->getPacked_V64());
-
- my $obj =
- IO::Uncompress::Adapter::UnLzma::mkUncompObject();
-
- *$self->{Uncomp} = $obj;
- }
+# elsif ($compressedMethod == ZIP_CM_LZMA)
+# {
+# return $self->HeaderError("Unsupported Compression format $compressedMethod")
+# if ! defined $IO::Uncompress::Adapter::UnLzma::VERSION ;
+#
+# *$self->{Type} = 'zip-lzma';
+# my $LzmaHeader;
+# $self->smartReadExact(\$LzmaHeader, 4)
+# or return $self->saveErrorString(undef, "Truncated file");
+# my ($verHi, $verLo) = unpack ("CC", substr($LzmaHeader, 0, 2));
+# my $LzmaPropertiesSize = unpack ("v", substr($LzmaHeader, 2, 2));
+#
+#
+# my $LzmaPropertyData;
+# $self->smartReadExact(\$LzmaPropertyData, $LzmaPropertiesSize)
+# or return $self->saveErrorString(undef, "Truncated file");
+# #my $LzmaInfo = unpack ("C", substr($LzmaPropertyData, 0, 1));
+# #my $LzmaDictSize = unpack ("V", substr($LzmaPropertyData, 1, 4));
+#
+# # Create an LZMA_Alone header
+# $self->pushBack($LzmaPropertyData .
+# $uncompressedLength->getPacked_V64());
+#
+# my $obj =
+# IO::Uncompress::Adapter::UnLzma::mkUncompObject();
+#
+# *$self->{Uncomp} = $obj;
+# }
elsif ($compressedMethod == ZIP_CM_STORE)
{
# TODO -- add support for reading uncompressed
=item C<< Append => 0|1 >>
-TODO
+The behaviour of this option is dependent on the type of output data
+stream.
+
+=over 5
+
+=item * A Buffer
+
+If C<Append> is enabled, all uncompressed data will be append to the end of
+the output buffer. Otherwise the output buffer will be cleared before any
+uncompressed data is written to it.
+
+=item * A Filename
+
+If C<Append> is enabled, the file will be opened in append mode. Otherwise
+the contents of the file, if any, will be truncated before any uncompressed
+data is written to it.
+
+=item * A Filehandle
+
+If C<Append> is enabled, the filehandle will be positioned to the end of
+the file via a call to C<seek> before any uncompressed data is
+written to it. Otherwise the file pointer will not be moved.
+
+=back
+
+When C<Append> is specified, and set to true, it will I<append> all uncompressed
+data to the output data stream.
+
+So when the output is a filehandle it will carry out a seek to the eof
+before writing any uncompressed data. If the output is a filename, it will be opened for
+appending. If the output is a buffer, all uncompressed data will be appened to
+the existing buffer.
+
+Conversely when C<Append> is not specified, or it is present and is set to
+false, it will operate as follows.
+
+When the output is a filename, it will truncate the contents of the file
+before writing any uncompressed data. If the output is a filehandle
+its position will not be changed. If the output is a buffer, it will be
+wiped before any uncompressed data is output.
+
+Defaults to 0.
=item C<< MultiStream => 0|1 >>
=head1 SEE ALSO
-L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
+L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
L<Compress::Zlib::FAQ|Compress::Zlib::FAQ>
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2005-2009 Paul Marquess. All rights reserved.
+Copyright (c) 2005-2010 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=head1 SEE ALSO
-L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
+L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
L<Compress::Zlib::FAQ|Compress::Zlib::FAQ>
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2005-2009 Paul Marquess. All rights reserved.
+Copyright (c) 2005-2010 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
- my $VERSION = '2.021';
+ my $VERSION = '2.024';
my @NAMES = qw(
Compress::Raw::Bzip2
Compress::Raw::Zlib
Append => 1,
Transparent => 0,
RawInflate => 1,
- #UnLzma => 1,
+ UnLzma => 1,
@opts
or croak "Cannot open buffer/file: $AnyUncompressError" ;
Append => 1,
Transparent => 0,
RawInflate => 1,
- #UnLzma => 1,
+ UnLzma => 1,
@opts
or croak "Cannot open buffer/file: $AnyUncompressError" ;
my $Error = getErrorRef($CompressClass);
my $UnError = getErrorRef($UncompressClass);
+ my @anyUnLz = ();
+ @anyUnLz = (UnLzma => 1 ) if $CompressClass =~ /lzma/i ;
+
my $AnyConstruct = "IO::Uncompress::${AnyClass}" ;
no strict 'refs';
my $AnyError = \${ "IO::Uncompress::${AnyClass}::${AnyClass}Error" };
{
my $unc = new $AnyConstruct $input, Transparent => $trans,
RawInflate => 1,
- #UnLzma => 1,
+ @anyUnLz,
Append => 1 ;
ok $unc, " Created $AnyClass object"
{
my $unc = new $AnyConstruct $input, Transparent => $trans,
RawInflate => 1,
- #UnLzma => 1,
+ @anyUnLz,
Append => 1 ;
ok $unc, " Created $AnyClass object"
my $count = 0 ;
if ($] < 5.005) {
- $count = 390 ;
+ $count = 445 ;
}
else {
- $count = 401 ;
+ $count = 456 ;
}
plan tests => $count + $extra ;
- use_ok('Compress::Zlib', 2) ;
+ use_ok('Compress::Zlib', qw(:ALL memGunzip memGzip zlib_version));
use_ok('IO::Compress::Gzip::Constants') ;
use_ok('IO::Compress::Gzip', qw($GzipError)) ;
my $len = length $hello ;
# Check zlib_version and ZLIB_VERSION are the same.
-is Compress::Zlib::zlib_version, ZLIB_VERSION,
- "ZLIB_VERSION matches Compress::Zlib::zlib_version" ;
+is zlib_version, ZLIB_VERSION,
+ "ZLIB_VERSION matches zlib_version" ;
# generate a long random string
my $contents = '' ;
# create an in-memory gzip file
- my $dest = Compress::Zlib::memGzip($buffer) ;
+ my $dest = memGzip($buffer) ;
ok length $dest ;
+ is $gzerrno, 0;
# write it to disk
ok open(FH, ">$name") ;
1 while unlink $name ;
# now check that memGunzip can deal with it.
- my $ungzip = Compress::Zlib::memGunzip($dest) ;
+ my $ungzip = memGunzip($dest) ;
ok defined $ungzip ;
ok $buffer eq $ungzip ;
+ is $gzerrno, 0;
# now do the same but use a reference
- $dest = Compress::Zlib::memGzip(\$buffer) ;
+ $dest = memGzip(\$buffer) ;
ok length $dest ;
+ is $gzerrno, 0;
# write it to disk
ok open(FH, ">$name") ;
# now check that memGunzip can deal with it.
my $keep = $dest;
- $ungzip = Compress::Zlib::memGunzip(\$dest) ;
+ $ungzip = memGunzip(\$dest) ;
+ is $gzerrno, 0;
ok defined $ungzip ;
ok $buffer eq $ungzip ;
# check memGunzip can cope with missing gzip trailer
my $minimal = substr($keep, 0, -1) ;
- $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
+ $ungzip = memGunzip(\$minimal) ;
ok defined $ungzip ;
ok $buffer eq $ungzip ;
+ is $gzerrno, 0;
$minimal = substr($keep, 0, -2) ;
- $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
+ $ungzip = memGunzip(\$minimal) ;
ok defined $ungzip ;
ok $buffer eq $ungzip ;
+ is $gzerrno, 0;
$minimal = substr($keep, 0, -3) ;
- $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
+ $ungzip = memGunzip(\$minimal) ;
ok defined $ungzip ;
ok $buffer eq $ungzip ;
+ is $gzerrno, 0;
$minimal = substr($keep, 0, -4) ;
- $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
+ $ungzip = memGunzip(\$minimal) ;
ok defined $ungzip ;
ok $buffer eq $ungzip ;
+ is $gzerrno, 0;
$minimal = substr($keep, 0, -5) ;
- $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
+ $ungzip = memGunzip(\$minimal) ;
ok defined $ungzip ;
ok $buffer eq $ungzip ;
+ is $gzerrno, 0;
$minimal = substr($keep, 0, -6) ;
- $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
+ $ungzip = memGunzip(\$minimal) ;
ok defined $ungzip ;
ok $buffer eq $ungzip ;
+ is $gzerrno, 0;
$minimal = substr($keep, 0, -7) ;
- $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
+ $ungzip = memGunzip(\$minimal) ;
ok defined $ungzip ;
ok $buffer eq $ungzip ;
+ is $gzerrno, 0;
$minimal = substr($keep, 0, -8) ;
- $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
+ $ungzip = memGunzip(\$minimal) ;
ok defined $ungzip ;
ok $buffer eq $ungzip ;
+ is $gzerrno, 0;
$minimal = substr($keep, 0, -9) ;
- $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
+ $ungzip = memGunzip(\$minimal) ;
ok ! defined $ungzip ;
+ cmp_ok $gzerrno, "==", Z_DATA_ERROR ;
1 while unlink $name ;
# check corrupt header -- too short
$dest = "x" ;
- my $result = Compress::Zlib::memGunzip($dest) ;
+ my $result = memGunzip($dest) ;
ok !defined $result ;
+ cmp_ok $gzerrno, "==", Z_DATA_ERROR ;
# check corrupt header -- full of junk
$dest = "x" x 200 ;
- $result = Compress::Zlib::memGunzip($dest) ;
+ $result = memGunzip($dest) ;
ok !defined $result ;
+ cmp_ok $gzerrno, "==", Z_DATA_ERROR ;
# corrupt header - 1st byte wrong
my $bad = $keep ;
substr($bad, 0, 1) = "\xFF" ;
- $ungzip = Compress::Zlib::memGunzip(\$bad) ;
+ $ungzip = memGunzip(\$bad) ;
ok ! defined $ungzip ;
+ cmp_ok $gzerrno, "==", Z_DATA_ERROR ;
# corrupt header - 2st byte wrong
$bad = $keep ;
substr($bad, 1, 1) = "\xFF" ;
- $ungzip = Compress::Zlib::memGunzip(\$bad) ;
+ $ungzip = memGunzip(\$bad) ;
ok ! defined $ungzip ;
+ cmp_ok $gzerrno, "==", Z_DATA_ERROR ;
# corrupt header - method not deflated
$bad = $keep ;
substr($bad, 2, 1) = "\xFF" ;
- $ungzip = Compress::Zlib::memGunzip(\$bad) ;
+ $ungzip = memGunzip(\$bad) ;
ok ! defined $ungzip ;
+ cmp_ok $gzerrno, "==", Z_DATA_ERROR ;
# corrupt header - reserverd bits used
$bad = $keep ;
substr($bad, 3, 1) = "\xFF" ;
- $ungzip = Compress::Zlib::memGunzip(\$bad) ;
+ $ungzip = memGunzip(\$bad) ;
ok ! defined $ungzip ;
+ cmp_ok $gzerrno, "==", Z_DATA_ERROR ;
# corrupt trailer - length wrong
$bad = $keep ;
substr($bad, -8, 4) = "\xFF" x 4 ;
- $ungzip = Compress::Zlib::memGunzip(\$bad) ;
+ $ungzip = memGunzip(\$bad) ;
ok ! defined $ungzip ;
+ cmp_ok $gzerrno, "==", Z_DATA_ERROR ;
# corrupt trailer - CRC wrong
$bad = $keep ;
substr($bad, -4, 4) = "\xFF" x 4 ;
- $ungzip = Compress::Zlib::memGunzip(\$bad) ;
+ $ungzip = memGunzip(\$bad) ;
ok ! defined $ungzip ;
+ cmp_ok $gzerrno, "==", Z_DATA_ERROR ;
}
{
my $compr = readFile($name);
ok length $compr ;
- my $unc = Compress::Zlib::memGunzip($compr) ;
+ my $unc = memGunzip($compr) ;
+ is $gzerrno, 0;
ok defined $unc ;
ok $buffer eq $unc ;
1 while unlink $name ;
foreach (1 .. 20000)
{ $contents .= chr int rand 256 }
- ok my $compressed = Compress::Zlib::memGzip(\$contents) ;
+ ok my $compressed = memGzip(\$contents) ;
+ is $gzerrno, 0;
ok length $compressed > 4096 ;
- ok my $out = Compress::Zlib::memGunzip(\$compressed) ;
+ ok my $out = memGunzip(\$compressed) ;
+ is $gzerrno, 0;
ok $contents eq $out ;
is length $out, length $contents ;
my $buffer = $good ;
substr($buffer, 0, 1) = 'x' ;
- ok ! Compress::Zlib::memGunzip(\$buffer) ;
+ ok ! memGunzip(\$buffer) ;
+ cmp_ok $gzerrno, "==", Z_DATA_ERROR ;
}
{
my $buffer = $good ;
substr($buffer, 1, 1) = "\xFF" ;
- ok ! Compress::Zlib::memGunzip(\$buffer) ;
+ ok ! memGunzip(\$buffer) ;
+ cmp_ok $gzerrno, "==", Z_DATA_ERROR ;
}
{
my $buffer = $good ;
substr($buffer, 2, 1) = 'x' ;
- ok ! Compress::Zlib::memGunzip(\$buffer) ;
+ ok ! memGunzip(\$buffer) ;
+ cmp_ok $gzerrno, "==", Z_DATA_ERROR ;
}
{
my $buffer = $good ;
substr($buffer, 3, 1) = "\xff";
- ok ! Compress::Zlib::memGunzip(\$buffer) ;
+ ok ! memGunzip(\$buffer) ;
+ cmp_ok $gzerrno, "==", Z_DATA_ERROR ;
}
}
substr($truncated, $index) = '' ;
- ok ! Compress::Zlib::memGunzip(\$truncated) ;
+ ok ! memGunzip(\$truncated) ;
+ cmp_ok $gzerrno, "==", Z_DATA_ERROR ;
}
substr($truncated, $index) = '' ;
- ok ! Compress::Zlib::memGunzip(\$truncated) ;
+ ok ! memGunzip(\$truncated) ;
+ cmp_ok $gzerrno, "==", Z_DATA_ERROR ;
}
my $Comment = "comment" ;
ok $x->close ;
substr($truncated, $index) = '' ;
- ok ! Compress::Zlib::memGunzip(\$truncated) ;
+ ok ! memGunzip(\$truncated) ;
+ cmp_ok $gzerrno, "==", Z_DATA_ERROR ;
}
for my $index ( GZIP_MIN_HEADER_SIZE .. GZIP_MIN_HEADER_SIZE + GZIP_FHCRC_SIZE -1)
substr($truncated, $index) = '' ;
- ok ! Compress::Zlib::memGunzip(\$truncated) ;
+ ok ! memGunzip(\$truncated) ;
+ cmp_ok $gzerrno, "==", Z_DATA_ERROR ;
}
{
ok defined $buffer ;
- ok my $got = Compress::Zlib::memGunzip($buffer)
+ ok my $got = memGunzip($buffer)
or diag "gzerrno is $gzerrno" ;
is $got, $string ;
+ is $gzerrno, 0;
}
substr($buffer, $trim) = '';
- ok my $u = Compress::Zlib::memGunzip(\$buffer) ;
+ ok my $u = memGunzip(\$buffer) ;
+ is $gzerrno, 0;
ok $u eq $string;
}
my $buffer = $good ;
substr($buffer, -4, 4) = pack('V', 1234);
- ok ! Compress::Zlib::memGunzip(\$buffer) ;
+ ok ! memGunzip(\$buffer) ;
+ cmp_ok $gzerrno, "==", Z_DATA_ERROR ;
}
{
substr($buffer, -4, 4) = pack('V', 1234);
substr($buffer, -8, 4) = pack('V', 1234);
- ok ! Compress::Zlib::memGunzip(\$buffer) ;
+ ok ! memGunzip(\$buffer) ;
+ cmp_ok $gzerrno, "==", Z_DATA_ERROR ;
}
}
plan tests => 29 + $extra ;
- use_ok('Compress::Zlib', 2);
+ use_ok('Compress::Zlib', qw(:ALL zlib_version memGunzip memGzip));
}
# Check zlib_version and ZLIB_VERSION are the same.
-is Compress::Zlib::zlib_version, ZLIB_VERSION,
- "ZLIB_VERSION matches Compress::Zlib::zlib_version" ;
+is zlib_version, ZLIB_VERSION,
+ "ZLIB_VERSION matches zlib_version" ;
{
# length of this string is 2 characters
my $s = "\x{df}\x{100}";
- my $cs = Compress::Zlib::memGzip(Encode::encode_utf8($s));
+ my $cs = memGzip(Encode::encode_utf8($s));
# length stored at end of gzip file should be 4
my ($crc, $len) = unpack ("VV", substr($cs, -8, 8));
title "memGunzip when compressed gzip has been encoded" ;
my $s = "hello world" ;
- my $co = Compress::Zlib::memGzip($s);
- is Compress::Zlib::memGunzip(my $x = $co), $s, " match uncompressed";
+ my $co = memGzip($s);
+ is memGunzip(my $x = $co), $s, " match uncompressed";
utf8::upgrade($co);
- my $un = Compress::Zlib::memGunzip($co);
+ my $un = memGunzip($co);
ok $un, " got uncompressed";
is $un, $s, " uncompressed matched original";
title "Catch wide characters";
my $a = "a\xFF\x{100}";
- eval { Compress::Zlib::memGzip($a) };
+ eval { memGzip($a) };
like($@, qr/Wide character in memGzip/, " wide characters in memGzip");
- eval { Compress::Zlib::memGunzip($a) };
+ eval { memGunzip($a) };
like($@, qr/Wide character in memGunzip/, " wide characters in memGunzip");
- eval { Compress::Zlib::compress($a) };
+ eval { compress($a) };
like($@, qr/Wide character in compress/, " wide characters in compress");
- eval { Compress::Zlib::uncompress($a) };
+ eval { uncompress($a) };
like($@, qr/Wide character in uncompress/, " wide characters in uncompress");
my $lex = new LexFile my $name ;
$USE_IPC_RUN $USE_IPC_OPEN3 $CAN_USE_RUN_FORKED $WARN
];
- $VERSION = '0.54';
+ $VERSION = '0.58';
$VERBOSE = 0;
$DEBUG = 0;
$WARN = 1;
$wait_cycles = $wait_cycles + 1;
Time::HiRes::usleep(250000); # half a second
}
+
+ if (!$child_finished) {
+ kill(9, $pid);
+ }
}
sub open3_run {
}
}
-=head2 $hashref = run_forked( command => COMMAND, { child_stdin => SCALAR, timeout => DIGIT, stdout_handler => CODEREF, stderr_handler => CODEREF} );
+=head2 $hashref = run_forked( COMMAND, { child_stdin => SCALAR, timeout => DIGIT, stdout_handler => CODEREF, stderr_handler => CODEREF} );
-C<run_forked> is used to execute some program,
+C<run_forked> is used to execute some program or a coderef,
optionally feed it with some input, get its return code
and output (both stdout and stderr into seperate buffers).
In addition it allows to terminate the program
stdout and stderr, terminates it in case
it runs longer than specified.
-Invocation requires the command to be executed and optionally a hashref of options:
+Invocation requires the command to be executed or a coderef and optionally a hashref of options:
=over
You may provide a coderef of a subroutine that will be called a portion of data is received on
stderr from the executing program.
+=item C<discard_output>
+
+Discards the buffering of the standard output and standard errors for return by run_forked().
+With this option you have to use the std*_handlers to read what the command outputs.
+Useful for commands that send a lot of output.
+
+=item C<terminate_on_parent_sudden_death>
+
+Enable this option if you wish all spawned processes to be killed if the initially spawned
+process (the parent) is killed or dies without waiting for child processes.
+
=back
C<run_forked> will return a HASHREF with the following keys:
=item C<stdout>
Holds the standard output of the executed command
-(or empty string if there were no stdout output; it's always defined!)
+(or empty string if there were no stdout output or if discard_output was used; it's always defined!)
=item C<stderr>
Holds the standard error of the executed command
-(or empty string if there were no stderr output; it's always defined!)
+(or empty string if there were no stderr output or if discard_output was used; it's always defined!)
=item C<merged>
Holds the standard output and error of the executed command merged into one stream
-(or empty string if there were no output at all; it's always defined!)
+(or empty string if there were no output at all or if discard_output was used; it's always defined!)
=item C<err_msg>
close($parent_stderr_socket);
close($parent_info_socket);
- my $child_timedout = 0;
my $flags;
# prepare sockets to read from child
# print "child $pid started\n";
+ my $child_timedout = 0;
my $child_finished = 0;
my $child_stdout = '';
my $child_stderr = '';
my $child_merged = '';
my $child_exit_code = 0;
+ my $parent_died = 0;
my $got_sig_child = 0;
$SIG{'CHLD'} = sub { $got_sig_child = time(); };
my $child_child_pid;
while (!$child_finished) {
+ my $now = time();
+
+ if ($opts->{'terminate_on_parent_sudden_death'}) {
+ $opts->{'runtime'}->{'last_parent_check'} = 0
+ unless defined($opts->{'runtime'}->{'last_parent_check'});
+
+ # check for parent once each five seconds
+ if ($now - $opts->{'runtime'}->{'last_parent_check'} > 5) {
+ if (getppid() eq "1") {
+ kill (-9, $pid);
+ $parent_died = 1;
+ }
+
+ $opts->{'runtime'}->{'last_parent_check'} = $now;
+ }
+ }
+
# user specified timeout
if ($opts->{'timeout'}) {
- if (time() - $start_time > $opts->{'timeout'}) {
+ if ($now - $start_time > $opts->{'timeout'}) {
kill (-9, $pid);
$child_timedout = 1;
}
# kill process after that and finish wait loop;
# shouldn't ever happen -- remove this code?
if ($got_sig_child) {
- if (time() - $got_sig_child > 10) {
+ if ($now - $got_sig_child > 10) {
print STDERR "waitpid did not return -1 for 10 seconds after SIG_CHLD, killing [$pid]\n";
kill (-9, $pid);
$child_finished = 1;
}
while (my $l = <$child_stdout_socket>) {
- $child_stdout .= $l;
- $child_merged .= $l;
+ if (!$opts->{discard_output}) {
+ $child_stdout .= $l;
+ $child_merged .= $l;
+ }
if ($opts->{'stdout_handler'} && ref($opts->{'stdout_handler'}) eq 'CODE') {
$opts->{'stdout_handler'}->($l);
}
}
while (my $l = <$child_stderr_socket>) {
- $child_stderr .= $l;
- $child_merged .= $l;
-
+ if (!$opts->{discard_output}) {
+ $child_stderr .= $l;
+ $child_merged .= $l;
+ }
if ($opts->{'stderr_handler'} && ref($opts->{'stderr_handler'}) eq 'CODE') {
$opts->{'stderr_handler'}->($l);
}
'merged' => $child_merged,
'timeout' => $child_timedout ? $opts->{'timeout'} : 0,
'exit_code' => $child_exit_code,
+ 'parent_died' => $parent_died,
};
my $err_msg = '';
if ($o->{'timeout'}) {
$err_msg .= "ran more than [$o->{'timeout'}] seconds\n";
}
+ if ($o->{'parent_died'}) {
+ $err_msg .= "parent died\n";
+ }
if ($o->{'stdout'}) {
$err_msg .= "stdout:\n" . $o->{'stdout'} . "\n";
}
close($child_stderr_socket);
close($child_info_socket);
- my $child_exit_code = open3_run($cmd, {
- 'parent_info' => $parent_info_socket,
- 'parent_stdout' => $parent_stdout_socket,
- 'parent_stderr' => $parent_stderr_socket,
- 'child_stdin' => $opts->{'child_stdin'},
- });
+ my $child_exit_code;
+
+ # allow both external programs
+ # and internal perl calls
+ if (!ref($cmd)) {
+ $child_exit_code = open3_run($cmd, {
+ 'parent_info' => $parent_info_socket,
+ 'parent_stdout' => $parent_stdout_socket,
+ 'parent_stderr' => $parent_stderr_socket,
+ 'child_stdin' => $opts->{'child_stdin'},
+ });
+ }
+ elsif (ref($cmd) eq 'CODE') {
+ $child_exit_code = $cmd->({
+ 'opts' => $opts,
+ 'parent_info' => $parent_info_socket,
+ 'parent_stdout' => $parent_stdout_socket,
+ 'parent_stderr' => $parent_stderr_socket,
+ 'child_stdin' => $opts->{'child_stdin'},
+ });
+ }
+ else {
+ print $parent_stderr_socket "Invalid command reference: " . ref($cmd) . "\n";
+ $child_exit_code = 1;
+ }
close($parent_stdout_socket);
close($parent_stderr_socket);
ok($r->{'stderr'}, "stderr: " . $r->{'stderr'});
}
+
+# try discarding the out+err
+{
+ my $out;
+ my $cmd = "echo out ; echo err >&2";
+ my $r = run_forked(
+ $cmd,
+ { discard_output => 1,
+ stderr_handler => sub { $out .= shift },
+ stdout_handler => sub { $out .= shift }
+ });
+
+ ok(ref($r) eq 'HASH', "executed: $cmd");
+ ok(!$r->{'stdout'}, "stdout discarded");
+ ok(!$r->{'stderr'}, "stderr discarded");
+ ok($out =~ m/out/, "stdout handled");
+ ok($out =~ m/err/, "stderr handled");
+}
+
__END__
### special call to check that output is interleaved properly
+1.23 -- Wed Mar 10 20:50:00 CST 2010
+
+ * Add a test file to ensure 'GETMAGIC' called once [gfx]
+ * "GETMAGIC" should be called only once [gfx]
+ * Use PERL_NO_GET_CONTEXT for efficiency (see perlguts) [gfx]
+ * Don't care about dVAR. ExtUtils::ParseXS deals with it. [gfx]
+ * t/p_max.t, t/p_min.t fail on perl5.8.1. [tokuhirom]
+ * avoid non-portable warnings
+ * Fix PP::reftype in edge cases [gfx]
+
1.22 -- Sat Nov 14 09:26:15 CST 2009
* silence a compiler warning about an unreferenced local variable [Steve Hay]
* This program is free software; you can redistribute it and/or
* modify it under the same terms as Perl itself.
*/
-
+#define PERL_NO_GET_CONTEXT /* we want efficiency */
#include <EXTERN.h>
#include <perl.h>
#include <XSUB.h>
# ifndef SvTAINTED
static bool
-sv_tainted(SV *sv)
+sv_tainted(pTHX_ SV *sv)
{
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
MAGIC *mg = mg_find(sv, 't');
}
# define SvTAINTED_on(sv) sv_magic((sv), Nullsv, 't', Nullch, 0)
-# define SvTAINTED(sv) (SvMAGICAL(sv) && sv_tainted(sv))
+# define SvTAINTED(sv) (SvMAGICAL(sv) && sv_tainted(aTHX_ sv))
# endif
# define PL_defgv defgv
# define PL_op op
#define dNOOP extern int Perl___notused PERL_UNUSED_DECL
#endif
-#ifndef dVAR
-#define dVAR dNOOP
-#endif
-
#ifndef GvSVn
# define GvSVn GvSV
#endif
PROTOTYPE: &@
CODE:
{
- dVAR; dMULTICALL;
+ dMULTICALL;
SV *ret = sv_newmortal();
int index;
GV *agv,*bgv,*gv;
PROTOTYPE: &@
CODE:
{
- dVAR; dMULTICALL;
+ dMULTICALL;
int index;
GV *gv;
HV *stash;
PROTOTYPE: @
CODE:
{
- dVAR;
int index;
#if (PERL_VERSION < 9)
struct op dmy_op;
{
if (SvMAGICAL(sv))
mg_get(sv);
- if(!sv_isobject(sv)) {
+ if(!(SvROK(sv) && SvOBJECT(SvRV(sv)))) {
XSRETURN_UNDEF;
}
RETVAL = (char*)sv_reftype(SvRV(sv),TRUE);
@ISA = qw(Exporter);
@EXPORT_OK = qw(first min max minstr maxstr reduce sum shuffle);
-$VERSION = "1.22";
+$VERSION = "1.23";
$XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
@ISA = qw(Exporter);
@EXPORT = qw(first min max minstr maxstr reduce sum shuffle);
-$VERSION = "1.22";
+$VERSION = "1.23";
$VERSION = eval $VERSION;
sub reduce (&@) {
use vars qw($VERSION);
use List::Util;
-$VERSION = "1.22"; # FIXUP
+$VERSION = "1.23"; # FIXUP
$VERSION = eval $VERSION; # FIXUP
sub _VERSION { # FIXUP
@ISA = qw(Exporter);
@EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly openhandle refaddr isvstring looks_like_number set_prototype);
-$VERSION = "1.22";
+$VERSION = "1.23";
$VERSION = eval $VERSION;
unless (defined &dualvar) {
@ISA = qw(Exporter);
@EXPORT = qw(blessed reftype tainted readonly refaddr looks_like_number);
-$VERSION = "1.22";
+$VERSION = "1.23";
$VERSION = eval $VERSION;
sub blessed ($) {
$addr =~ /0x(\w+)/;
local $^W;
+ no warnings 'portable';
hex($1);
}
{
my %tmap = qw(
- B::HV HASH
- B::AV ARRAY
- B::CV CODE
- B::IO IO
- B::NULL SCALAR
- B::NV SCALAR
- B::PV SCALAR
- B::GV GLOB
- B::RV REF
+ B::NULL SCALAR
+
+ B::HV HASH
+ B::AV ARRAY
+ B::CV CODE
+ B::IO IO
+ B::GV GLOB
B::REGEXP REGEXP
);
use overload
'""' => sub { ${$_[0]} },
'+0' => sub { ${$_[0]} },
+ '>' => sub { ${$_[0]} > ${$_[1]} },
fallback => 1;
sub new {
my $class = shift;
use overload
'""' => sub { ${$_[0]} },
'+0' => sub { ${$_[0]} },
+ '<' => sub { ${$_[0]} < ${$_[1]} },
fallback => 1;
sub new {
my $class = shift;
ChangeLog for Locale-Codes Distribution
+As of 3.00, the codes are autogenerated from the standards. With each release, codes will
+be re-generated and tested to see if any code changed. Any time there are any changes to
+the codes, it will be flagged below with a change: NEW CODE(s).
+
+3.13
+
+3.12 2010-04-06 sbeck
+ * NEW CODE(s)
+ * Renamed test.pl to testfunc.pl to avoid causing an error
+ when built as part of perl.
+
+3.11 2010-03-01 sbeck
+ * NEW CODE(s)
+ * Added the IANA domain names to Country
+ * Fixed a problem that produced warnings with perl 5.11.5.
+ Jerry D. Hedden
+
+3.10 2010-02-18 sbeck
+ * NEW CODE(s)
+ * Moved support files into the Locale::Codes namespace.
+ * The work done in each of the Locale::XXX modules was
+ virtually identical to each other. It has all
+ been moved to a central module and the
+ Locale::XXX moduels are now just wrappers.
+ * The XXX_code2code functions would return undef if the
+ same codeset were passed in for both the 2nd and
+ 3rd arguments. This doesn't make sense and has
+ been changed.
+ * Added all semi-private routines (except for the
+ couple that were already present):
+ rename_XXX
+ add_XXX
+ delete_XXX
+ add_XXX_alias
+ delete_XXX_alias
+ rename_XXX_code
+ add_XXX_code_alias
+ delete_XXX_code_alias
+ * Added "UK" alias. Steve Hay
+
+3.01 2010-02-15 sbeck
+ * Fixed Makefile.PL and Build.PL to install as core
+ modules.
+
+3.00 2010-02-10 sbeck
+ * NEW CODE(s)
+ * Took over maintenance of the code
+ * All codes and country names come from the official
+ standards
+ * code2country now returns the name of the country specified
+ in the standard (if the different standards refer
+ to the country by different variations in the name,
+ the results will differe based on the CODESET)
+ * Added code sets
+ FIPS 10 country codes
+ Alpha-3 and Term language codes
+ Numeric currency codes
+ * The rename_country funcion from 2.07 would guess the
+ CODESET (unlike all other functions which used
+ a default of LOCALE_CODE_ALPHA_2). The guess can
+ cause problems since (with the addition of FIPS)
+ codes may appear in different codesets for different
+ countries. The behavior has been changed to be
+ the same as other functions (default to
+ LOCALE_CODE_ALPHA_2).
+ * Dropped support for _alias_code
+ * Added language_code2code, currency_code2code
+
2.07 2004-06-10 neilb
* made $_ local in the initialisation code for each module
change back-propagated from Perl distribution
--- /dev/null
+This module is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+++ /dev/null
-use strict;
-use ExtUtils::MakeMaker;
-
-WriteMakefile (
- NAME => 'Locale-Codes',
- DISTNAME => 'Locale-Codes',
- VERSION => '2.07',
- AUTHOR => 'Neil Bowers <neil@bowers.com>',
- ABSTRACT => 'modules for ISO codes identifying countries, languages, currencies, and scripts',
-);
+++ /dev/null
-
- Locale-Codes Distribution
- v2.07
-
-For changes in this release, please see the ChangeLog file.
-
-This distribution contains four Perl modules which can be used to process
-ISO codes for identifying languages, countries, scripts,
-and currencies & funds.
-
- Locale::Language
- Two letter codes for language identification (ISO 639).
- For example, 'en' is the code for 'English'.
-
- Locale::Country
- Codes for country identification (ISO 3166). This module
- supports the three different code sets defined by the
- standard: alpha-2, alpha-3, and numeric codes.
- For example, 'bo' is the code for 'Bolivia'.
-
- Locale::Currency
- Three letter codes for currency and fund identification (ISO 4217).
- For example, 'sek' is the code for 'Swedish Krona'.
-
- Locale::Script
- Codes for script identification (ISO 15924). This module supports
- the three different code sets defined by the standard:
- alpha-2, alpha-3, and numeric codes.
-
-To install these modules, you should just have to run the following:
-
- % perl Makefile.PL
- % make
- % make test
- % make install
-
-The modules are documented using pod. When you "make install", you
-will get four man-pages: Locale::Language, Locale::Country,
-Locale::Currency, Locale::Script.
-
-The first version of Locale::Currency was written by Michael Hennecke,
-with modifications for inclusion by me. Kudos to Michael.
-
-Please let me know if you experience any problems with these modules,
-or have any ideas for additions.
-
-
-Neil Bowers
-<neil@bowers.com>
--- /dev/null
+
+ Locale-Codes Distribution
+
+For changes in this release, please refer to the Locale::Changes
+man-page.
+
+For changes prior to 3.00, please see the ChangeLog file.
+
+This distribution contains Perl modules which can be used to process
+ISO codes for identifying languages, countries, scripts,
+and currencies & funds.
+
+ Locale::Language
+
+ Codes for language identification including ISO 639.
+
+ For example, 'en' is the code for 'English'.
+
+ Locale::Country
+
+ Codes for country identification including ISO 3166
+ and FIPS 10.
+
+ For example, 'us' is the code for 'United States'.
+
+ Locale::Currency
+
+ Codes for currency and fund identification including
+ ISO 4217.
+
+ For example, 'sek' is the code for 'Swedish Krona'.
+
+ Locale::Script
+
+ Codes for script identification including ISO 15924.
+
+ For example, 'Phnx' is the code for 'Phoenician'.
+
+The modules are documented using pod. When you "make install", you
+will get man-pages: Local::Codes and each of the modules listed above.
+
+The first version of Locale::Currency was written by Michael Hennecke,
+with modifications by Neil Bowers for inclusion.
+
+The first versions of Locale::Language, Locale::Country, and Locale::Script
+were written by Neil Bowers.
+
+Please let me know if you experience any problems with these modules,
+or have any ideas for additions.
+
+Also, I plan on releasing a new version a couple of times a year to make
+sure that all of the codes are current. If a code changes in any standard,
+and you want a new release, just email me and I'll put out a new release.
+
--- /dev/null
+package Locale::Codes;
+# Copyright (C) 2001 Canon Research Centre Europe (CRE).
+# Copyright (C) 2002-2009 Neil Bowers
+# Copyright (c) 2010-2010 Sullivan Beck
+# This program is free software; you can redistribute it and/or modify it
+# under the same terms as Perl itself.
+
+use strict;
+use warnings;
+require 5.002;
+
+use Carp;
+
+#=======================================================================
+# Public Global Variables
+#=======================================================================
+
+# This module is not called directly... %Data is filled in by the
+# calling modules.
+
+use vars qw($VERSION %Data);
+
+# $Data{ TYPE }{ code2id }{ CODESET } { CODE } = [ ID, I ]
+# { id2code }{ CODESET } { ID } = CODE
+# { id2names }{ ID } = [ NAME, NAME, ... ]
+# { alias2id }{ NAME } = [ ID, I ]
+# { id } = FIRST_UNUSED_ID
+# { codealias }{ CODESET } { ALIAS } = CODE
+
+$VERSION='3.12';
+
+#=======================================================================
+#
+# _code2name ( TYPE,CODE,CODESET )
+#
+#=======================================================================
+
+sub _code2name {
+ my($type,$code,$codeset) = @_;
+
+ $code = $Data{$type}{'codealias'}{$codeset}{$code}
+ if (exists $Data{$type}{'codealias'}{$codeset}{$code});
+
+ if (exists $Data{$type}{'code2id'}{$codeset} &&
+ exists $Data{$type}{'code2id'}{$codeset}{$code}) {
+ my ($id,$i) = @{ $Data{$type}{'code2id'}{$codeset}{$code} };
+ my $name = $Data{$type}{'id2names'}{$id}[$i];
+ return $name;
+ } else {
+ #---------------------------------------------------------------
+ # no such code!
+ #---------------------------------------------------------------
+ return undef;
+ }
+}
+
+#=======================================================================
+#
+# _name2code ( TYPE,NAME,CODESET )
+#
+#=======================================================================
+
+sub _name2code {
+ my($type,$name,$codeset) = @_;
+ $name = "" if (! $name);
+ $name = lc($name);
+
+ if (exists $Data{$type}{'alias2id'}{$name}) {
+ my $id = $Data{$type}{'alias2id'}{$name}[0];
+ if (exists $Data{$type}{'id2code'}{$codeset}{$id}) {
+ return $Data{$type}{'id2code'}{$codeset}{$id};
+ }
+ }
+
+ #---------------------------------------------------------------
+ # no such name!
+ #---------------------------------------------------------------
+ return undef;
+ }
+
+#=======================================================================
+#
+# _code2code ( TYPE,CODE,CODESET )
+#
+#=======================================================================
+
+sub _code2code {
+ my($type,$code,$inset,$outset) = @_;
+
+ my $name = _code2name($type,$code,$inset);
+ my $outcode = _name2code($type,$name,$outset);
+ return $outcode;
+}
+
+#=======================================================================
+#
+# _all_codes ( TYPE,CODESET )
+#
+#=======================================================================
+
+sub _all_codes {
+ my($type,$codeset) = @_;
+
+ if (! exists $Data{$type}{'code2id'}{$codeset}) {
+ return ();
+ }
+ my @codes = keys %{ $Data{$type}{'code2id'}{$codeset} };
+ return (sort @codes);
+}
+
+#=======================================================================
+#
+# _all_names ( TYPE,CODESET )
+#
+#=======================================================================
+
+sub _all_names {
+ my($type,$codeset) = @_;
+
+ my @codes = _all_codes($type,$codeset);
+ return () if (! @codes);
+ my @names;
+
+ foreach my $code (@codes) {
+ my($id,$i) = @{ $Data{$type}{'code2id'}{$codeset}{$code} };
+ my $name = $Data{$type}{'id2names'}{$id}[$i];
+ push(@names,$name);
+ }
+ return (sort @names);
+}
+
+#=======================================================================
+#
+# _rename ( TYPE,CODE,NAME,CODESET )
+#
+# Change the official name for a code. The original is retained
+# as an alias, but the new name will be returned if you lookup the
+# name from code.
+#
+#=======================================================================
+
+sub _rename {
+ my($type,$code,$new_name,$codeset,$nowarn) = @_;
+
+ if (! $codeset) {
+ carp "rename_$type(): unknown codeset\n" unless ($nowarn);
+ return 0;
+ }
+
+ $code = $Data{$type}{'codealias'}{$codeset}{$code}
+ if (exists $Data{$type}{'codealias'}{$codeset}{$code});
+
+ # Check that $code exists in the codeset.
+
+ my $id;
+ if (exists $Data{$type}{'code2id'}{$codeset}{$code}) {
+ $id = $Data{$type}{'code2id'}{$codeset}{$code}[0];
+ } else {
+ carp "rename_$type(): unknown code: $code\n" unless ($nowarn);
+ return 0;
+ }
+
+ # Cases:
+ # 1. Renaming to a name which exists with a different ID
+ # Error
+ #
+ # 2. Renaming to a name which exists with the same ID
+ # Just change code2id (I value)
+ #
+ # 3. Renaming to a new name
+ # Create a new alias
+ # Change code2id (I value)
+
+ if (exists $Data{$type}{'alias2id'}{lc($new_name)}) {
+ # Existing name (case 1 and 2)
+
+ my ($new_id,$i) = @{ $Data{$type}{'alias2id'}{lc($new_name)} };
+ if ($new_id != $id) {
+ # Case 1
+ carp "rename_$type(): rename to an existing $type not allowed\n"
+ unless ($nowarn);
+ return 0;
+ }
+
+ # Case 2
+
+ $Data{$type}{'code2id'}{$codeset}{$code}[1] = $i;
+
+ } else {
+
+ # Case 3
+
+ push @{ $Data{$type}{'id2names'}{$id} },$new_name;
+ my $i = $#{ $Data{$type}{'id2names'}{$id} };
+ $Data{$type}{'alias2id'}{lc($new_name)} = [ $id,$i ];
+ $Data{$type}{'code2id'}{$codeset}{$code}[1] = $i;
+ }
+
+ return 1;
+}
+
+#=======================================================================
+#
+# _add_code ( TYPE,CODE,NAME,CODESET )
+#
+# Add a new code to the codeset. Both CODE and NAME must be
+# unused in the code set.
+#
+#=======================================================================
+
+sub _add_code {
+ my($type,$code,$name,$codeset,$nowarn) = @_;
+
+ if (! $codeset) {
+ carp "add_$type(): unknown codeset\n" unless ($nowarn);
+ return 0;
+ }
+
+ # Check that $code is unused.
+
+ if (exists $Data{$type}{'code2id'}{$codeset}{$code} ||
+ exists $Data{$type}{'codealias'}{$codeset}{$code}) {
+ carp "add_$type(): code already in use: $code\n" unless ($nowarn);
+ return 0;
+ }
+
+ # Check to see that $name is unused in this code set. If it is
+ # used (but not in this code set), we'll use that ID. Otherwise,
+ # we'll need to get the next available ID.
+
+ my ($id,$i);
+ if (exists $Data{$type}{'alias2id'}{lc($name)}) {
+ ($id,$i) = @{ $Data{$type}{'alias2id'}{lc($name)} };
+ if (exists $Data{$type}{'id2code'}{$codeset}{$id}) {
+ carp "add_$type(): name already in use: $name\n" unless ($nowarn);
+ return 0;
+ }
+
+ } else {
+ $id = $Data{$type}{'id'}++;
+ $i = 0;
+ $Data{$type}{'alias2id'}{lc($name)} = [ $id,$i ];
+ $Data{$type}{'id2names'}{$id} = [ $name ];
+ }
+
+ # Add the new code
+
+ $Data{$type}{'code2id'}{$codeset}{$code} = [ $id,$i ];
+ $Data{$type}{'id2code'}{$codeset}{$id} = $code;
+
+ return 1;
+}
+
+#=======================================================================
+#
+# _delete_code ( TYPE,CODE,CODESET )
+#
+# Delete a code from the codeset.
+#
+#=======================================================================
+
+sub _delete_code {
+ my($type,$code,$codeset,$nowarn) = @_;
+
+ if (! $codeset) {
+ carp "delete_$type(): unknown codeset\n" unless ($nowarn);
+ return 0;
+ }
+
+ $code = $Data{$type}{'codealias'}{$codeset}{$code}
+ if (exists $Data{$type}{'codealias'}{$codeset}{$code});
+
+ # Check that $code is valid.
+
+ if (! exists $Data{$type}{'code2id'}{$codeset}{$code}) {
+ carp "delete_$type(): code does not exist: $code\n" unless ($nowarn);
+ return 0;
+ }
+
+ # Delete the code
+
+ my $id = $Data{$type}{'code2id'}{$codeset}{$code}[0];
+ delete $Data{$type}{'code2id'}{$codeset}{$code};
+ delete $Data{$type}{'id2code'}{$codeset}{$id};
+
+ # Delete any aliases that are linked to this code
+
+ foreach my $alias (keys %{ $Data{$type}{'codealias'}{$codeset} }) {
+ next if ($Data{$type}{'codealias'}{$codeset}{$alias} ne $code);
+ delete $Data{$type}{'codealias'}{$codeset}{$alias};
+ }
+
+ # If this ID is not used in any other codeset, delete it completely.
+
+ foreach my $c (keys %{ $Data{$type}{'id2code'} }) {
+ return 1 if (exists $Data{$type}{'id2code'}{$c}{$id});
+ }
+
+ my @names = @{ $Data{$type}{'id2names'}{$id} };
+ delete $Data{$type}{'id2names'}{$id};
+
+ foreach my $name (@names) {
+ delete $Data{$type}{'alias2id'}{lc($name)};
+ }
+
+ return 1;
+}
+
+#=======================================================================
+#
+# _add_alias ( TYPE,NAME,NEW_NAME )
+#
+# Add a new alias. NAME must exist, and NEW_NAME must be unused.
+#
+#=======================================================================
+
+sub _add_alias {
+ my($type,$name,$new_name,$nowarn) = @_;
+
+ # Check that $name is used and $new_name is new.
+
+ my($id);
+ if (exists $Data{$type}{'alias2id'}{lc($name)}) {
+ $id = $Data{$type}{'alias2id'}{lc($name)}[0];
+ } else {
+ carp "add_${type}_alias(): name does not exist: $name\n" unless ($nowarn);
+ return 0;
+ }
+
+ if (exists $Data{$type}{'alias2id'}{lc($new_name)}) {
+ carp "add_${type}_alias(): alias already in use: $new_name\n" unless ($nowarn);
+ return 0;
+ }
+
+ # Add the new alias
+
+ push @{ $Data{$type}{'id2names'}{$id} },$new_name;
+ my $i = $#{ $Data{$type}{'id2names'}{$id} };
+ $Data{$type}{'alias2id'}{lc($new_name)} = [ $id,$i ];
+
+ return 1;
+}
+
+#=======================================================================
+#
+# _delete_alias ( TYPE,NAME )
+#
+# This deletes a name from the list of names used by an element.
+# NAME must be used, but must NOT be the only name in the list.
+#
+# Any id2name that references this name will be changed to
+# refer to the first name in the list.
+#
+#=======================================================================
+
+sub _delete_alias {
+ my($type,$name,$nowarn) = @_;
+
+ # Check that $name is used.
+
+ my($id,$i);
+ if (exists $Data{$type}{'alias2id'}{lc($name)}) {
+ ($id,$i) = @{ $Data{$type}{'alias2id'}{lc($name)} };
+ } else {
+ carp "delete_${type}_alias(): name does not exist: $name\n" unless ($nowarn);
+ return 0;
+ }
+
+ my $n = $#{ $Data{$type}{'id2names'}{$id} };
+ if ($n == 1) {
+ carp "delete_${type}_alias(): only one name defined (use _delete_${type} instead)\n"
+ unless ($nowarn);
+ return 0;
+ }
+
+ # Delete the alias.
+
+ splice (@{ $Data{$type}{'id2names'}{$id} },$i,1);
+ delete $Data{$type}{'alias2id'}{lc($name)};
+
+ # Every element that refers to this ID:
+ # Ignore if I < $i
+ # Set to 0 if I = $i
+ # Decrement if I > $i
+
+ foreach my $codeset (keys %{ $Data{'code2id'} }) {
+ foreach my $code (keys %{ $Data{'code2id'}{$codeset} }) {
+ my($jd,$j) = @{ $Data{'code2id'}{$codeset}{$code} };
+ next if ($jd ne $id ||
+ $j < $i);
+ if ($i == $j) {
+ $Data{'code2id'}{$codeset}{$code}[1] = 0;
+ } else {
+ $Data{'code2id'}{$codeset}{$code}[1]--;
+ }
+ }
+ }
+
+ return 1;
+}
+
+#=======================================================================
+#
+# _rename_code ( TYPE,CODE,NEW_CODE,CODESET )
+#
+# Change the official code. The original is retained as an alias, but
+# the new name will be returned if you lookup the code from name.
+#
+#=======================================================================
+
+sub _rename_code {
+ my($type,$code,$new_code,$codeset,$nowarn) = @_;
+
+ if (! $codeset) {
+ carp "rename_$type(): unknown codeset\n" unless ($nowarn);
+ return 0;
+ }
+
+ $code = $Data{$type}{'codealias'}{$codeset}{$code}
+ if (exists $Data{$type}{'codealias'}{$codeset}{$code});
+
+ # Check that $code exists in the codeset.
+
+ if (! exists $Data{$type}{'code2id'}{$codeset}{$code}) {
+ carp "rename_$type(): unknown code: $code\n" unless ($nowarn);
+ return 0;
+ }
+
+ # Cases:
+ # 1. Renaming code to an existing alias of this code:
+ # Make the alias real and the code an alias
+ #
+ # 2. Renaming code to some other existing alias:
+ # Error
+ #
+ # 3. Renaming code to some other code:
+ # Error (
+ #
+ # 4. Renaming code to a new code:
+ # Make code into an alias
+ # Replace code with new_code.
+
+ if (exists $Data{$type}{'codealias'}{$codeset}{$new_code}) {
+ # Cases 1 and 2
+ if ($Data{$type}{'codealias'}{$codeset}{$new_code} eq $code) {
+ # Case 1
+
+ delete $Data{$type}{'codealias'}{$codeset}{$new_code};
+
+ } else {
+ # Case 2
+ carp "rename_$type(): new code already in use: $new_code\n" unless ($nowarn);
+ return 0;
+ }
+
+ } elsif (exists $Data{$type}{'code2id'}{$codeset}{$new_code}) {
+ # Case 3
+ carp "rename_$type(): new code already in use: $new_code\n" unless ($nowarn);
+ return 0;
+ }
+
+ # Cases 1 and 4
+
+ $Data{$type}{'codealias'}{$codeset}{$code} = $new_code;
+
+ my $id = $Data{$type}{'code2id'}{$codeset}{$code}[0];
+ $Data{$type}{'code2id'}{$codeset}{$new_code} = $Data{$type}{'code2id'}{$codeset}{$code};
+ delete $Data{$type}{'code2id'}{$codeset}{$code};
+
+ $Data{$type}{'id2code'}{$codeset}{$id} = $new_code;
+
+ return 1;
+}
+
+#=======================================================================
+#
+# _add_code_alias ( TYPE,CODE,NEW_CODE,CODESET )
+#
+# Adds an alias for the code.
+#
+#=======================================================================
+
+sub _add_code_alias {
+ my($type,$code,$new_code,$codeset,$nowarn) = @_;
+
+ if (! $codeset) {
+ carp "add_${type}_code_alias(): unknown codeset\n" unless ($nowarn);
+ return 0;
+ }
+
+ $code = $Data{$type}{'codealias'}{$codeset}{$code}
+ if (exists $Data{$type}{'codealias'}{$codeset}{$code});
+
+ # Check that $code exists in the codeset and that $new_code
+ # does not exist.
+
+ if (! exists $Data{$type}{'code2id'}{$codeset}{$code}) {
+ carp "add_${type}_code_alias(): unknown code: $code\n" unless ($nowarn);
+ return 0;
+ }
+
+ if (exists $Data{$type}{'code2id'}{$codeset}{$new_code} ||
+ exists $Data{$type}{'codealias'}{$codeset}{$new_code}) {
+ carp "add_${type}_code_alias(): code already in use: $new_code\n" unless ($nowarn);
+ return 0;
+ }
+
+ # Add the alias
+
+ $Data{$type}{'codealias'}{$codeset}{$new_code} = $code;
+
+ return 1;
+}
+
+#=======================================================================
+#
+# _delete_code_alias ( TYPE,CODE,CODESET )
+#
+# Deletes an alias for the code.
+#
+#=======================================================================
+
+sub _delete_code_alias {
+ my($type,$code,$codeset,$nowarn) = @_;
+
+ if (! $codeset) {
+ carp "delete_${type}_code_alias(): unknown codeset\n" unless ($nowarn);
+ return 0;
+ }
+
+ # Check that $code exists in the codeset as an alias.
+
+ if (! exists $Data{$type}{'codealias'}{$codeset}{$code}) {
+ carp "delete_${type}_code_alias(): no alias defined: $code\n" unless ($nowarn);
+ return 0;
+ }
+
+ # Delete the alias
+
+ delete $Data{$type}{'codealias'}{$codeset}{$code};
+
+ return 1;
+}
+
+#=======================================================================
+#
+# alias_code ( ALIAS => CODE [ , CODESET ] )
+#
+# Add an alias for an existing code. If the CODESET isn't specified,
+# then we use the default (currently the alpha-2 codeset).
+#
+# Locale::Country::alias_code('uk' => 'gb');
+#
+#=======================================================================
+
+# sub alias_code {
+# my $nowarn = 0;
+# $nowarn = 1, pop if ($_[$#_] eq "nowarn");
+# my $alias = shift;
+# my $code = shift;
+# my $codeset = @_ > 0 ? shift : LOCALE_CODE_DEFAULT;
+
+# return 0 if ($codeset !~ /^\d+$/);
+
+# if ($codeset == LOCALE_CODE_ALPHA_2) {
+# $codeset = "alpha2";
+# $alias = lc($alias);
+# } elsif ($codeset == LOCALE_CODE_ALPHA_3) {
+# $codeset = "alpha3";
+# $alias = lc($alias);
+# } elsif ($codeset == LOCALE_CODE_FIPS) {
+# $codeset = "fips";
+# $alias = uc($alias);
+# } elsif ($codeset == LOCALE_CODE_NUMERIC) {
+# $codeset = "num";
+# return undef if ($alias =~ /\D/);
+# $alias = sprintf("%.3d", $alias);
+# } else {
+# carp "rename_country(): unknown codeset\n" unless ($nowarn);
+# return 0;
+# }
+
+# # Check that $code exists in the codeset.
+
+# my ($id,$i);
+# if (exists $Data{$type}{'code2id'}{$codeset}{$code}) {
+# ($id,$i) = @{ $Data{$type}{'code2id'}{$codeset}{$code} };
+# } else {
+# carp "alias_code: attempt to alias \"$alias\" to unknown country code \"$code\"\n"
+# unless ($nowarn);
+# return 0;
+# }
+
+# # Cases:
+# # The alias already exists.
+# # Error
+# #
+# # It's new
+# # Create a new entry in Code2CountryID
+# # Replace the entiry in CountryID2Code
+# # Regenerate %Codes
+
+# if (exists $Data{$type}{'code2id'}{$codeset}{$alias}) {
+# carp "alias_code: attempt to alias \"$alias\" which is already in use\n"
+# unless ($nowarn);
+# return 0;
+# }
+
+# $Data{$type}{'code2id'}{$codeset}{$alias} = [ $id, $i ];
+# $Data{$type}{'id2names'}ID2Code{$codeset}{$id} = $alias;
+
+# my @codes = keys %{ $Data{$type}{'code2id'}{$codeset} };
+# $Locale::CountryCodes::Codes{$codeset} = [ sort @codes ];
+
+# return $alias;
+# }
+
+1;
+# Local Variables:
+# mode: cperl
+# indent-tabs-mode: nil
+# cperl-indent-level: 3
+# cperl-continued-statement-offset: 2
+# cperl-continued-brace-offset: 0
+# cperl-brace-offset: 0
+# cperl-brace-imaginary-offset: 0
+# cperl-label-offset: -2
+# End:
--- /dev/null
+=pod
+
+=head1 NAME
+
+Locale::Codes - a distribution of modules to handle locale codes
+
+=head1 DESCRIPTION
+
+B<Locale::Codes> is a distribution containing a set of modules. The
+modules each deal with different types of codes which identify parts
+of the locale including languages, countries, currency, etc.
+
+Currently, the following modules are included:
+
+=over 4
+
+=item B<Locale::Country>
+
+This includes support for country codes (such as those listed in ISO-3166)
+to specify the country.
+
+=item B<Locale::Language>
+
+This includes support for language codes (such as those listed in ISO-639)
+to specify the language.
+
+=item B<Locale::Currency>
+
+This includes support for currency codes (such as those listed in ISO-4217)
+to specify the currency.
+
+=item B<Locale::Script>
+
+This includes support for script codes (such as those listed in ISO-15924)
+to specify the script.
+
+=back
+
+Each module can support an arbitrary number of code sets, and it it
+not required that the relationship between these code sets be
+one-to-one. For example, the Locale::Country module supports code
+sets from ISO-3166 and the FIPS 10 standard, and they do not break the
+world down into exactly the same sets of countries. This does not
+cause any problem (though converting codes from ISO-3166 to FIPS or
+back will not work except for countries that are one-to-one).
+
+All data in all of these modules comes directly from the original
+standards (or as close to direct as possible), so it should be
+up-to-date at the time of release.
+
+I plan on releasing a new version a couple of times a year to
+incorporate any changes made in the standards. However, I don't always
+know about changes that occur, so if any of the standards change, and
+you want a new release sooner, just email me and I'll get one out.
+
+=head1 NEW CODE SETS
+
+I'm always open to suggestions for new code sets.
+
+In order for me to add a code set, I want the following criteria
+to be met:
+
+=over 4
+
+=item B<General-use code set>
+
+If a code set is not general use, I'm not likely to spend the time
+to add and support it.
+
+=item B<An official source of data>
+
+I require an official (or at least, a NEARLY official) source where I
+can get the data on a regular basis.
+
+Ideally, I'd only get data from an official source, but sometimes that
+is not possible. For example the ISO standards are not typically
+available for free, so I may have to get some of that data from
+alternate sources that I'm confident are getting their data from the
+official source.
+
+As an example, I get some country data from the CIA World
+Factbook. Given the nature of the source, I'm sure they're updating
+data from the official sources and I consider it "nearly" official.
+
+There are many 3rd party sites which maintain lists (many of which are
+actually in a more convenient form than the official sites).
+Unfortunately, I will reject most of them since I have no feel for how
+"official" they are.
+
+=item B<A free source of the data>
+
+Obviously, the data must be free-of-charge. I'm not interested in
+paying for the data (and I'm not interested in the overhead of having
+someone else pay for the data for me).
+
+=item B<A reliable source of data>
+
+The source of data must come from a source that I can reasonably expect
+to exist for the foreseeable future since I will be extremely reluctant
+to drop support for a data set once it's included.
+
+I am also reluctant to accept data sent to me by an individual.
+Although I appreciate the offer, it is simply not practical to consider
+an individual contribution as a reliable source of data. The source
+should be an official agency of some sort.
+
+=back
+
+These requirements are open to discussion. If you have a code set
+you'd like to see added, but which may not meet all of the above
+requirements, feel free to email me and we'll discuss it. Depending
+on circumstances, I may be willing to waive some of these criteria.
+
+=head1 COMMON ALIASES
+
+As of version 2.00, the modules supported common variants of names.
+
+For example, Locale::Country supports variant names for countries, and
+a few of the most common ones are included in the data. The country
+code for "United States" is "us", so:
+
+ country2code('United States');
+ => "us"
+
+Now the following will also return 'us':
+
+ country2code('United States of America');
+ country2code('USA');
+
+Any number of common aliases may be included in the data, in addition
+to the names that come directly from the standards. If you have a
+common alias for a country, language, or any other of the types of
+codes, let me know and I'll add it, with some restrictions.
+
+For example, the country name "North Korea" never appeared in any of
+the official sources (instead, it was "Korea, North" or "Korea,
+Democratic People's Republic of". I would honor a request to add an
+alias "North Korea" since that's a very common way to specify the
+country (please don't request this... I've already added it).
+
+On the other hand, a request to add Zaire as an alias for "Congo, The
+Democratic Republic of" may not be honored. The country's official
+name is not Zaire, so adding it as an alias violates the standard.
+Zaire was kept as an alias in versions prior to 3.00, but it has been
+removed. Other aliases (if any) which no longer appear in any standard
+have also been removed.
+
+=head1 ROUTINES
+
+As of 3.10, the interface for all of the modules listed above are
+identical (as a matter of fact, they are all just wrappers around a
+central module which does all the real work).
+
+In order to maintain the documentation for the modules consistently,
+the functions are all documented here, rather than in the documentation
+for the separate modules.
+
+The name of the function depends on the module. For example, every module
+contains a function "code2XXX" where XXX refers to the type of data
+(country, language, currency, or script). So, the Locale::Country module
+contains the function code2country, the Locale::Language module contains
+the function code2language, etc.
+
+In all of the functions below, CODE refers to a code for one element in
+the code set. For example, in the two-letter country codes from ISO 3166-1,
+the code 'fi' is used to refer to the country Finland. CODE is always
+case insensitive (though when a code is returned, it will always be in
+the case as used in the standard), so 'fi', 'FI', and 'Fi' would all
+be equivalent.
+
+CODESET refers to a constant specified in the documentation for each
+module to label the various code sets. For example, in the
+Locale::Language module, CODESET could be LOCALE_CODE_ALPHA_2 or
+LOCALE_CODE_ALPHA_3 (among others). Most functions have a default one,
+so they do not need to be specified. So the following calls are valid:
+
+ code2country("fi");
+ code2country("fi",LOCALE_CODE_ALPHA_2);
+ code2country("fin",LOCALE_CODE_ALPHA_3);
+
+Since LOCALE_CODE_ALPHA_2 is the default code set, the first two are
+identical.
+
+=over 4
+
+=item B<code2country ( CODE [,CODESET] )>
+
+=item B<code2language( CODE [,CODESET] )>
+
+=item B<code2currency( CODE [,CODESET] )>
+
+=item B<code2script ( CODE [,CODESET] )>
+
+These functions take a code and returns a string which contains
+the name of the element identified. If the code is not a valid
+code in the CODESET specified then C<undef> will be returned.
+
+The name of the element is the name as specified in the standard,
+and as a result, different variations of an element name may
+be returned for different values of CODESET.
+
+For example, the B<alpha-2> country code set defines the two-letter
+code "bo" to be "Bolivia, Plurinational State of", whereas the
+B<alpha-3> code set defines the code 'bol' to be the country "Bolivia
+(Plurinational State of)". So:
+
+ code2country('bo',LOCALE_CODE_ALPHA_2);
+ => 'Bolivia, Plurinational State of'
+
+ code2country('bol',LOCALE_CODE_ALPHA_3);
+ => 'Bolivia (Plurinational State of)'
+
+=item B<country2code ( NAME [,CODESET] )>
+
+=item B<language2code( NAME [,CODESET] )>
+
+=item B<currency2code( NAME [,CODESET] )>
+
+=item B<script2code ( NAME [,CODESET] )>
+
+These functions takes the name of an element (or any of it's aliases)
+and returns the code that corresponds to it, if it exists. If NAME
+could not be identified as the name of one of the elements, then
+C<undef> will be returned.
+
+The name is not case sensitive. Also, any known variation of a name
+may be passed in.
+
+For example, even though the country name returned using
+LOCALE_CODE_ALPHA_2 and LOCALE_CODE_ALPHA_3 country codes for Bolivia is different,
+either country name may be passed in since for each code set, in addition to
+the alias 'Bolivia'. So:
+
+ country2code('Bolivia, Plurinational State of',
+ LOCALE_CODE_ALPHA_2);
+ => bo
+
+ country2code('Bolivia (Plurinational State of)',
+ LOCALE_CODE_ALPHA_2);
+ => bo
+
+ country2code('Bolivia',LOCALE_CODE_ALPHA_2);
+ => bo
+
+=item B<country_code2code ( CODE ,CODESET ,CODESET2 )>
+
+=item B<language_code2code( CODE ,CODESET ,CODESET2 )>
+
+=item B<currency_code2code( CODE ,CODESET ,CODESET2 )>
+
+=item B<script_code2code ( CODE ,CODESET ,CODESET2 )>
+
+These functions takes a a code from one code set, and returns the
+corresponding code from another code set. CODE must exists in the code
+set specified by CODESET and must have a corresponding code in the
+code set specified by CODESET2 or C<undef> will be returned.
+
+Both CODESETs must be explicitly entered.
+
+ country_code2code('fin', LOCALE_CODE_ALPHA_3,
+ LOCALE_CODE_ALPHA_2);
+ => 'fi'
+
+=item B<all_country_codes ( [CODESET] )>
+
+=item B<all_language_codes( [CODESET] )>
+
+=item B<all_currency_codes( [CODESET] )>
+
+=item B<all_script_codes ( [CODESET] )>
+
+These returns a list of all code in the code set. The codes will be
+sorted.
+
+=item B<all_country_names ( [CODESET] )>
+
+=item B<all_language_names( [CODESET] )>
+
+=item B<all_currency_names( [CODESET] )>
+
+=item B<all_script_names ( [CODESET] )>
+
+These return a list of all elements names for which there is a
+corresponding code in the specified code set.
+
+The names returned are exactly as they are specified in the standard,
+and are sorted.
+
+Since not all elements are listed in all code sets, the list of
+elements may differ depending on the code set specified.
+
+=back
+
+=head1 SEMI-PRIVATE ROUTINES
+
+Additional semi-private routines which may be used to modify the
+internal data are also available. Given their status, they aren't
+exported, and so need to be called by prefixing the function name with
+the package name.
+
+=over 4
+
+=item B<Locale::Country::rename_country ( CODE ,NEW_NAME [,CODESET] )>
+
+=item B<Locale::Language::rename_language( CODE ,NEW_NAME [,CODESET] )>
+
+=item B<Locale::Currency::rename_currency( CODE ,NEW_NAME [,CODESET] )>
+
+=item B<Locale::Script::rename_script ( CODE ,NEW_NAME [,CODESET] )>
+
+These routines are used to change the official name of an element. At
+that point, the name returned by the code2XXX routine would be
+NEW_NAME instead of the name specified in the standard.
+
+The original name will remain as an alias.
+
+For example, the official country name for code 'gb' is 'United
+Kingdom'. If you want to change that, you might call:
+
+ Locale::Country::rename_country('gb', 'Great Britain');
+
+This means that calling code2country('gb') will now return 'Great
+Britain' instead of 'United Kingdom'.
+
+If any error occurs, a warning is issued and 0 is returned. An error
+occurs if CODE doesn't exist in the specified code set, or if
+NEW_NAME is already in use but for a different element.
+
+If the routine succeeds, 1 is returned.
+
+=item B<Locale::Country::add_country ( CODE ,NAME [,CODESET] )>
+
+=item B<Locale::Language::add_language( CODE ,NAME [,CODESET] )>
+
+=item B<Locale::Currency::add_currency( CODE ,NAME [,CODESET] )>
+
+=item B<Locale::Script::add_script ( CODE ,NAME [,CODESET] )>
+
+These routines are used to add a new code and name to the data.
+
+Both CODE and NAME must be unused in the data set or an error
+occurs (though NAME may be used in a different data set).
+
+For example, to create the fictitious country named "Duchy of
+Grand Fenwick" with codes "gf" and "fen", use the following:
+
+ Locale::Country::add_country("fe","Duchy of Grand Fenwick",
+ LOCALE_CODE_ALPHA_2);
+
+ Locale::Country::add_country("fen","Duchy of Grand Fenwick",
+ LOCALE_CODE_ALPHA_3);
+
+The return value is 1 on success, 0 on an error.
+
+=item B<Locale::Country::delete_country ( CODE [,CODESET] )>
+
+=item B<Locale::Language::delete_language( CODE [,CODESET] )>
+
+=item B<Locale::Currency::delete_currency( CODE [,CODESET] )>
+
+=item B<Locale::Script::delete_script ( CODE [,CODESET] )>
+
+These routines are used to delete a code from the data.
+
+CODE must refer to an existing code in the code set.
+
+The return value is 1 on success, 0 on an error.
+
+=item B<Locale::Country::add_country_alias ( NAME ,NEW_NAME )>
+
+=item B<Locale::Language::add_language_alias( NAME ,NEW_NAME )>
+
+=item B<Locale::Currency::add_currency_alias( NAME ,NEW_NAME )>
+
+=item B<Locale::Script::add_script_alias ( NAME ,NEW_NAME )>
+
+These routines are used to add a new alias to the data. They do
+not alter the return value of the code2XXX function.
+
+NAME must be an existing element name, and NEW_NAME must
+be unused or an error occurs.
+
+The return value is 1 on success, 0 on an error.
+
+=item B<Locale::Country::delete_country_alias ( NAME )>
+
+=item B<Locale::Language::delete_language_alias( NAME )>
+
+=item B<Locale::Currency::delete_currency_alias( NAME )>
+
+=item B<Locale::Script::delete_script_alias ( NAME )>
+
+These routines are used to delete an alias from the data. Once
+removed, the element may not be referred to by NAME.
+
+NAME must be one of a list of at least two names that may be used to
+specify an element. If the element may only be referred to by a single
+name, you'll need to use the add_XXX_alias function to add a new alias
+first, or the remove_XXX function to remove the element entirely.
+
+If the alias is used as the name in any code set, one of the other
+names will be used instead. Predicting exactly which one will
+be used requires you to know the order in which the standards
+were read, which is not reliable, so you may want to use the
+rename_XXX function to force one of the alternate names to be
+used.
+
+The return value is 1 on success, 0 on an error.
+
+=item B<Locale::Country::rename_country_code ( CODE ,NEW_CODE [,CODESET] )>
+
+=item B<Locale::Language::rename_language_code( CODE ,NEW_CODE [,CODESET] )>
+
+=item B<Locale::Currency::rename_currency_code( CODE ,NEW_CODE [,CODESET] )>
+
+=item B<Locale::Script::rename_script_code ( CODE ,NEW_CODE [,CODESET] )>
+
+These routines are used to change the official code for an element. At
+that point, the code returned by the XXX2code routine would be
+NEW_CODE instead of the code specified in the standard.
+
+NEW_CODE may either be a code that is not in use, or it may be an
+alias for CODE (in which case, CODE becomes and alias and NEW_CODE
+becomes the "real" code).
+
+The original code is kept as an alias, so that the code2XXX routines
+will work with either the code from the standard or the new code.
+
+However, the all_XXX_codes routine will only return the codes which
+are considered "real" (which means that the list of codes will now
+contain NEW_CODE, but will not contain CODE).
+
+=item B<Locale::Country::add_country_code_alias ( CODE ,NEW_CODE [,CODESET] )>
+
+=item B<Locale::Language::add_language_code_alias( CODE ,NEW_CODE [,CODESET] )>
+
+=item B<Locale::Currency::add_currency_code_alias( CODE ,NEW_CODE [,CODESET] )>
+
+=item B<Locale::Script::add_script_code_alias ( CODE ,NEW_CODE [,CODESET] )>
+
+These routines add an alias for the code. At that point, NEW_CODE and CODE
+will both work in the code2XXX routines. However, the XXX2code routines will
+still return the original code.
+
+=item B<Locale::Country::delete_country_code_alias ( CODE [,CODESET] )>
+
+=item B<Locale::Language::delete_language_code_alias( CODE [,CODESET] )>
+
+=item B<Locale::Currency::delete_currency_code_alias( CODE [,CODESET] )>
+
+=item B<Locale::Script::delete_script_code_alias ( CODE [,CODESET] )>
+
+These routines delete an alias for the code.
+
+These will only work if CODE is actually an alias. If it is the "real"
+code, it will not be deleted. You will need to use the rename_XXX_code
+function to switch the real code with one of the aliases, and then
+delete the alias.
+
+=back
+
+=head1 KNOWN BUGS AND LIMITATIONS
+
+=over 4
+
+=item B<*>
+
+Because each code set uses a slightly different list of elements, and
+they are not necessarily one-to-one, there may be some confusion
+about the relationship between codes from different code sets.
+
+For example, ISO 3166 assigns one code to the country "United States
+Minor Outlying Islands", but the FIPS 10 codes give different codes
+to different islands (Baker Island, Howland Island, etc.).
+
+This may cause some confusion... I've done the best that I could do
+to minimize it.
+
+=item B<*>
+
+Currently all names must be all ASCII. I plan on relaxing that
+limitation in the future.
+
+=back
+
+=head1 SEE ALSO
+
+=over 4
+
+=item B<Locale::Constants>
+
+Constants for Locale codes.
+
+=item B<Locale::Country>
+
+Codes for identification of countries.
+
+=item B<Locale::Language>
+
+Codes for identification of languages.
+
+=item B<Locale::Script>
+
+Codes for identification of scripts.
+
+=item B<Locale::Currency>
+
+Codes for identification of currencies and funds.
+
+=back
+
+=head1 AUTHOR
+
+Locale::Country and Locale::Language were originally written by Neil
+Bowers at the Canon Research Centre Europe (CRE). They maintained the
+distribution from 1997 to 2001.
+
+Locale::Currency was originally written by Michael Hennecke.
+
+From 2001 to 2004, maintenance was continued by Neil Bowers. He
+modified Locale::Currency for inclusion in the distribution. He also
+added Locale::Constants and Locale::Script.
+
+From 2004-2009, the module was unmaintained.
+
+In 2010, maintenance was taken over by Sullivan Beck (sbeck@cpan.org)
+with Neil Bower's permission.
+
+=head1 COPYRIGHT
+
+ Copyright (c) 1997-2001 Canon Research Centre Europe (CRE).
+ Copyright (c) 2001 Michael Hennecke (Locale::Currency)
+ Copyright (c) 2001-2010 Neil Bowers
+ Copyright (c) 2010-2010 Sullivan Beck
+
+This module is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
+
--- /dev/null
+=pod
+
+=head1 NAME
+
+Locale::Codes::Changes - details important changes after 2.07
+
+=head1 3.10
+
+=over 4
+
+=item B<Changed XXX_code2code behavior slightly>
+
+In previous versions, passing in the same code set for both code set
+arguments would automatically return undef. For example:
+
+ country_code2code('bo',LOCALE_CODE_ALPHA_2,LOCALE_CODE_ALPHA_2);
+ => undef
+
+This doesn't seem like reasonable behavior, so it has been changed
+to allow the same code set:
+
+ country_code2code('bo',LOCALE_CODE_ALPHA_2,LOCALE_CODE_ALPHA_2);
+ => 'bo'
+
+Note that if an invalid code is passed in, undef will still be
+returned:
+
+ country_code2code('bol',LOCALE_CODE_ALPHA_2,LOCALE_CODE_ALPHA_2);
+ => undef
+
+=item B<Added many semi-private routines>
+
+Previous versions had only two semi-private routines: rename_country
+and alias_code which had the ability to modify the internal data in
+a couple very limited ways. It was requested (in an anonymous posting
+by someone named Steve and also by Steve Hay) that better support
+for modifying internal data, so a full set of routines were added.
+
+The full set of routines includes:
+
+ rename_country
+ rename_language
+ rename_currency
+ rename_script
+
+ add_country
+ add_language
+ add_currency
+ add_script
+
+ delete_country
+ delete_language
+ delete_currency
+ delete_script
+
+ add_country_alias
+ add_language_alias
+ add_currency_alias
+ add_script_alias
+
+ delete_country_alias
+ delete_language_alias
+ delete_currency_alias
+ delete_script_alias
+
+ rename_country_code
+ rename_language_code
+ rename_currency_code
+ rename_script_code
+
+ add_country_code_alias
+ add_language_code_alias
+ add_currency_code_alias
+ add_script_code_alias
+
+ delete_country_code_alias
+ delete_language_code_alias
+ delete_currency_code_alias
+ delete_script_code_alias
+
+=back
+
+=head1 3.00
+
+=over 4
+
+=item B<New maintainer>
+
+From 1997 to 2004, Locale::Codes was maintained by Neil
+Bowers. Unfortunately, no updates were made from June 2004 to January
+2010. During that time, a number of changes have been made to the
+standards since then, so the data included was out-of-date.
+
+I contacted Neil to get his permission to assume maintenance of
+the module, and he kindly agreed.
+
+=item B<All codes are generated from standards>
+
+All of the values returned by the various functions are now values
+directly from the standards. This means that the values returned in
+the 2.xx series are not necessarily the same as the values returned
+here.
+
+As an example, the ISO 3166 standard which lists country codes refers
+to the country associated with the code "bo" as "Bolivia,
+Plurinational State of", so that is what is returned. In the 2.xx
+series, "Bolivia" was returned. Also, the country names vary from one
+standard to another. So the code "bol" which is maintained by the
+United Nations returns the name of the country as "Bolivia
+(Plurinational State of)". Some common aliases have been added, so you
+can still request a code associated with a county name "Bolivia".
+
+Since the data comes from the standards, some "incorrect" values are
+no longer supported. For example, 2.07 treated "Zaire" as an alias for
+"Congo", but the country changed it's name, and "Zaire" is not in the
+standard, so it has been dropped in 3.00.
+
+=item B<Added several code sets from standards>
+
+I've added the following code sets:
+
+ FIPS 10 country codes
+ Alpha-3 and Term language codes
+ Numeric currency codes
+
+=item B<Locale::Script changed>
+
+In 2.xx, Locale::Script assigned scripts to country codes, which is NOT
+how it is done currently in the standards. It appears that an older version
+of ISO 15924 did this, but I haven't found an old version to confirm
+that, and in any case, that is not the case in the current standards.
+
+As a result, the Locale::Script module is completely incompatible with
+the 2.xx version with respect to the types of codes it supports. None of
+the old codes will work.
+
+=item B<Added missing functions>
+
+I've added in some functions which were "missing" previously (since there was
+only one set of codes supported, the code2code functions didn't apply):
+
+ language_code2code
+ currency_code2code
+
+so the interfaces for each type of codes are consistent.
+
+=item B<Dropped support for _alias_code>
+
+In Locale::Country, _alias_code was an allowed, but deprecated function
+which was documented to be supported in the 2.xx series. I've removed it.
+
+=back
+
+=head1 SEE ALSO
+
+Locale::Codes
+
+=head1 AUTHOR
+
+See Locale::Codes for full author history.
+
+Currently maintained by Sullivan Beck (sbeck@cpan.org).
+
+=head1 COPYRIGHT
+
+ Copyright (c) 2010-2010 Sullivan Beck
+
+This module is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
--- /dev/null
+package Locale::Codes::Country;
+
+# This file was automatically generated. Any changes to this file will
+# be lost the next time 'get_codes' is run.
+# Generated on: Mon Apr 5 15:40:50 EDT 2010
+
+=pod
+
+=head1 NAME
+
+Locale::Codes::Country - country codes for the Locale::Country module
+
+=head1 SYNOPSIS
+
+This module contains data used by the Locale::Country module. It is
+not intended to be used directly, and contains no calleable routines.
+
+=head1 AUTHOR
+
+See Locale::Codes for full author history.
+
+Currently maintained by Sullivan Beck (sbeck@cpan.org).
+
+=head1 COPYRIGHT
+
+ Copyright (c) 1997-2001 Canon Research Centre Europe (CRE).
+ Copyright (c) 2001-2010 Neil Bowers
+ Copyright (c) 2010-2010 Sullivan Beck
+
+This module is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
+
+use strict;
+use warnings;
+require 5.002;
+
+use vars qw($VERSION);
+$VERSION='3.12';
+
+$Locale::Codes::Data{'country'}{'id'} = '0278';
+
+$Locale::Codes::Data{'country'}{'id2names'} = {
+ q(0001) => [
+ q(Afghanistan),
+ q(Islamic State of Afghanistan),
+ ],
+ q(0002) => [
+ q(Aland Islands),
+ ],
+ q(0003) => [
+ q(Albania),
+ q(Republic of Albania),
+ ],
+ q(0004) => [
+ q(Algeria),
+ q(People's Democratic Republic of Algeria),
+ ],
+ q(0005) => [
+ q(American Samoa),
+ q(Territory of American Samoa),
+ ],
+ q(0006) => [
+ q(Andorra),
+ q(Principality of Andorra),
+ ],
+ q(0007) => [
+ q(Angola),
+ q(Republic of Angola),
+ ],
+ q(0008) => [
+ q(Anguilla),
+ ],
+ q(0009) => [
+ q(Antarctica),
+ ],
+ q(0010) => [
+ q(Antigua and Barbuda),
+ ],
+ q(0011) => [
+ q(Argentina),
+ q(Argentine Republic),
+ ],
+ q(0012) => [
+ q(Armenia),
+ q(Republic of Armenia),
+ ],
+ q(0013) => [
+ q(Aruba),
+ ],
+ q(0014) => [
+ q(Australia),
+ q(Commonwealth of Australia),
+ ],
+ q(0015) => [
+ q(Austria),
+ q(Republic of Austria),
+ ],
+ q(0016) => [
+ q(Azerbaijan),
+ q(Republic of Azerbaijan),
+ ],
+ q(0017) => [
+ q(Bahamas),
+ q(Bahamas, The),
+ q(Commonwealth of the Bahamas),
+ q(The Bahamas),
+ ],
+ q(0018) => [
+ q(Bahrain),
+ q(State of Bahrain),
+ ],
+ q(0019) => [
+ q(Bangladesh),
+ q(People's Republic of Bangladesh),
+ ],
+ q(0020) => [
+ q(Barbados),
+ ],
+ q(0021) => [
+ q(Belarus),
+ q(Republic of Belarus),
+ ],
+ q(0022) => [
+ q(Belgium),
+ q(Kingdom of Belgium),
+ ],
+ q(0023) => [
+ q(Belize),
+ ],
+ q(0024) => [
+ q(Benin),
+ q(Republic of Benin),
+ ],
+ q(0025) => [
+ q(Bermuda),
+ ],
+ q(0026) => [
+ q(Bhutan),
+ q(Kingdom of Bhutan),
+ ],
+ q(0027) => [
+ q(Bolivia, Plurinational State of),
+ q(Bolivia (Plurinational State of)),
+ q(Bolivia),
+ q(Republic of Bolivia),
+ ],
+ q(0028) => [
+ q(Bosnia and Herzegovina),
+ ],
+ q(0029) => [
+ q(Botswana),
+ q(Republic of Botswana),
+ ],
+ q(0030) => [
+ q(Bouvet Island),
+ ],
+ q(0031) => [
+ q(Brazil),
+ q(Federative Republic of Brazil),
+ ],
+ q(0032) => [
+ q(British Indian Ocean Territory),
+ ],
+ q(0033) => [
+ q(Brunei Darussalam),
+ q(Brunei),
+ q(Negara Brunei Darussalam),
+ ],
+ q(0034) => [
+ q(Bulgaria),
+ ],
+ q(0035) => [
+ q(Burkina Faso),
+ ],
+ q(0036) => [
+ q(Burundi),
+ q(Republic of Burundi),
+ ],
+ q(0037) => [
+ q(Cambodia),
+ q(Kingdom of Cambodia),
+ ],
+ q(0038) => [
+ q(Cameroon),
+ q(Republic of Cameroon),
+ ],
+ q(0039) => [
+ q(Canada),
+ ],
+ q(0040) => [
+ q(Cape Verde),
+ q(Republic of Cape Verde),
+ ],
+ q(0041) => [
+ q(Cayman Islands),
+ ],
+ q(0042) => [
+ q(Central African Republic),
+ ],
+ q(0043) => [
+ q(Chad),
+ q(Republic of Chad),
+ ],
+ q(0044) => [
+ q(Chile),
+ q(Republic of Chile),
+ ],
+ q(0045) => [
+ q(China),
+ q(People's Republic of China),
+ ],
+ q(0046) => [
+ q(Christmas Island),
+ q(Territory of Christmas Island),
+ ],
+ q(0047) => [
+ q(Cocos (Keeling) Islands),
+ q(Territory of Cocos (Keeling) Islands),
+ q(Keeling Islands),
+ q(Cocos Islands),
+ ],
+ q(0048) => [
+ q(Colombia),
+ q(Republic of Colombia),
+ ],
+ q(0049) => [
+ q(Comoros),
+ q(Federal Islamic Republic of the Comoros),
+ ],
+ q(0050) => [
+ q(Congo),
+ q(Congo (Brazzaville)),
+ q(Republic of the Congo),
+ q(Congo, Republic of the),
+ q(The Republic of the Congo),
+ ],
+ q(0051) => [
+ q(Congo, The Democratic Republic of the),
+ q(Democratic Republic of the Congo),
+ q(Congo (Kinshasa)),
+ q(Congo, Democratic Republic of the),
+ q(The Democratic Republic of the Congo),
+ ],
+ q(0052) => [
+ q(Cook Islands),
+ ],
+ q(0053) => [
+ q(Costa Rica),
+ q(Republic of Costa Rica),
+ ],
+ q(0054) => [
+ q(Cote d'Ivoire),
+ q(Republic of Cote D'Ivoire),
+ ],
+ q(0055) => [
+ q(Croatia),
+ q(Republic of Croatia),
+ ],
+ q(0056) => [
+ q(Cuba),
+ q(Republic of Cuba),
+ ],
+ q(0057) => [
+ q(Cyprus),
+ q(Republic of Cyprus),
+ ],
+ q(0058) => [
+ q(Czech Republic),
+ ],
+ q(0059) => [
+ q(Denmark),
+ q(Kingdom of Denmark),
+ ],
+ q(0060) => [
+ q(Djibouti),
+ q(Republic of Djibouti),
+ ],
+ q(0061) => [
+ q(Dominica),
+ q(Commonwealth of Dominica),
+ ],
+ q(0062) => [
+ q(Dominican Republic),
+ ],
+ q(0063) => [
+ q(Ecuador),
+ q(Republic of Ecuador),
+ ],
+ q(0064) => [
+ q(Egypt),
+ q(Arab Republic of Egypt),
+ ],
+ q(0065) => [
+ q(El Salvador),
+ q(Republic of El Salvador),
+ ],
+ q(0066) => [
+ q(Equatorial Guinea),
+ q(Republic of Equatorial Guinea),
+ ],
+ q(0067) => [
+ q(Eritrea),
+ q(State of Eritrea),
+ ],
+ q(0068) => [
+ q(Estonia),
+ q(Republic of Estonia),
+ ],
+ q(0069) => [
+ q(Ethiopia),
+ q(Federal Democratic Republic of Ethiopia),
+ ],
+ q(0070) => [
+ q(Falkland Islands (Malvinas)),
+ q(Falkland Islands (Islas Malvinas)),
+ ],
+ q(0071) => [
+ q(Faroe Islands),
+ q(Faeroe Islands),
+ ],
+ q(0072) => [
+ q(Fiji),
+ q(Republic of the Fiji Islands),
+ ],
+ q(0073) => [
+ q(Finland),
+ q(Republic of Finland),
+ ],
+ q(0074) => [
+ q(France),
+ q(French Republic),
+ ],
+ q(0075) => [
+ q(French Guiana),
+ q(Department of Guiana),
+ ],
+ q(0076) => [
+ q(French Polynesia),
+ q(Territory of French Polynesia),
+ ],
+ q(0077) => [
+ q(French Southern Territories),
+ q(French Southern and Antarctic Lands),
+ q(Territory of the French Southern and Antarctic Lands),
+ ],
+ q(0078) => [
+ q(Gabon),
+ q(Gabonese Republic),
+ ],
+ q(0079) => [
+ q(Gambia),
+ q(Gambia, The),
+ q(Republic of the Gambia),
+ ],
+ q(0080) => [
+ q(Georgia),
+ ],
+ q(0081) => [
+ q(Germany),
+ q(Federal Republic of Germany),
+ ],
+ q(0082) => [
+ q(Ghana),
+ q(Republic of Ghana),
+ ],
+ q(0083) => [
+ q(Gibraltar),
+ ],
+ q(0084) => [
+ q(Greece),
+ q(Hellenic Republic),
+ ],
+ q(0085) => [
+ q(Greenland),
+ ],
+ q(0086) => [
+ q(Grenada),
+ ],
+ q(0087) => [
+ q(Guadeloupe),
+ q(Department of Guadeloupe),
+ ],
+ q(0088) => [
+ q(Guam),
+ q(Territory of Guam),
+ ],
+ q(0089) => [
+ q(Guatemala),
+ q(Republic of Guatemala),
+ ],
+ q(0090) => [
+ q(Guernsey),
+ q(Bailiwick of Guernsey),
+ ],
+ q(0091) => [
+ q(Guinea),
+ q(Republic of Guinea),
+ ],
+ q(0092) => [
+ q(Guinea-Bissau),
+ q(Republic of Guinea-Bissau),
+ ],
+ q(0093) => [
+ q(Guyana),
+ q(Co-operative Republic of Guyana),
+ ],
+ q(0094) => [
+ q(Haiti),
+ q(Republic of Haiti),
+ ],
+ q(0095) => [
+ q(Heard Island and Mcdonald Islands),
+ q(Territory of Heard Island and McDonald Islands),
+ ],
+ q(0096) => [
+ q(Holy See (Vatican City State)),
+ q(Holy See),
+ q(Vatican City),
+ q(State of the Vatican City),
+ q(Holy See (Vatican City)),
+ ],
+ q(0097) => [
+ q(Honduras),
+ q(Republic of Honduras),
+ ],
+ q(0098) => [
+ q(Hong Kong),
+ q(China, Hong Kong Special Administrative Region),
+ q(Hong Kong S.A.R.),
+ q(Hong Kong Special Administrative Region),
+ q(Hong Kong Special Administrative Region of China),
+ ],
+ q(0099) => [
+ q(Hungary),
+ q(Republic of Hungary),
+ ],
+ q(0100) => [
+ q(Iceland),
+ q(Republic of Iceland),
+ ],
+ q(0101) => [
+ q(India),
+ q(Republic of India),
+ ],
+ q(0102) => [
+ q(Indonesia),
+ q(Republic of Indonesia),
+ ],
+ q(0103) => [
+ q(Iran, Islamic Republic of),
+ q(Iran (Islamic Republic of)),
+ q(Iran),
+ q(Islamic Republic of Iran),
+ ],
+ q(0104) => [
+ q(Iraq),
+ q(Republic of Iraq),
+ ],
+ q(0105) => [
+ q(Ireland),
+ ],
+ q(0106) => [
+ q(Isle of Man),
+ ],
+ q(0107) => [
+ q(Israel),
+ q(State of Israel),
+ ],
+ q(0108) => [
+ q(Italy),
+ q(Italian Republic),
+ ],
+ q(0109) => [
+ q(Jamaica),
+ ],
+ q(0110) => [
+ q(Japan),
+ ],
+ q(0111) => [
+ q(Jersey),
+ q(Bailiwick of Jersey),
+ ],
+ q(0112) => [
+ q(Jordan),
+ q(Hashemite Kingdom of Jordan),
+ ],
+ q(0113) => [
+ q(Kazakhstan),
+ q(Republic of Kazakhstan),
+ q(Kazakstan),
+ ],
+ q(0114) => [
+ q(Kenya),
+ q(Republic of Kenya),
+ ],
+ q(0115) => [
+ q(Kiribati),
+ q(Republic of Kiribati),
+ ],
+ q(0116) => [
+ q(Korea, Democratic People's Republic of),
+ q(Democratic People's Republic of Korea),
+ q(Korea, North),
+ q(North Korea),
+ ],
+ q(0117) => [
+ q(Korea, Republic of),
+ q(Republic of Korea),
+ q(Korea, South),
+ q(South Korea),
+ ],
+ q(0118) => [
+ q(Kuwait),
+ q(State of Kuwait),
+ ],
+ q(0119) => [
+ q(Kyrgyzstan),
+ q(Kyrgyz Republic),
+ ],
+ q(0120) => [
+ q(Lao People's Democratic Republic),
+ q(Laos),
+ ],
+ q(0121) => [
+ q(Latvia),
+ q(Republic of Latvia),
+ ],
+ q(0122) => [
+ q(Lebanon),
+ q(Lebanese Republic),
+ ],
+ q(0123) => [
+ q(Lesotho),
+ q(Republic of Lesotho),
+ ],
+ q(0124) => [
+ q(Liberia),
+ q(Republic of Liberia),
+ ],
+ q(0125) => [
+ q(Libyan Arab Jamahiriya),
+ q(Libya),
+ q(Great Socialist People's Libyan Arab Jamahiriya),
+ ],
+ q(0126) => [
+ q(Liechtenstein),
+ q(Principality of Liechtenstein),
+ ],
+ q(0127) => [
+ q(Lithuania),
+ q(Republic of Lithuania),
+ ],
+ q(0128) => [
+ q(Luxembourg),
+ q(Grand Duchy of Luxembourg),
+ ],
+ q(0129) => [
+ q(Macao),
+ q(China, Macao Special Administrative Region),
+ q(Macau S.A.R),
+ q(Macau Special Administrative Region),
+ q(Macau),
+ q(Macau S.A.R.),
+ q(Macao Special Administrative Region of China),
+ ],
+ q(0130) => [
+ q(Macedonia, The Former Yugoslav Republic of),
+ q(The former Yugoslav Republic of Macedonia),
+ q(Macedonia),
+ q(Republic of Macedonia),
+ q(Macedonia, Former Yugoslav Republic of),
+ ],
+ q(0131) => [
+ q(Madagascar),
+ q(Republic of Madagascar),
+ ],
+ q(0132) => [
+ q(Malawi),
+ q(Republic of Malawi),
+ ],
+ q(0133) => [
+ q(Malaysia),
+ ],
+ q(0134) => [
+ q(Maldives),
+ q(Republic of Maldives),
+ ],
+ q(0135) => [
+ q(Mali),
+ q(Republic of Mali),
+ ],
+ q(0136) => [
+ q(Malta),
+ q(Republic of Malta),
+ ],
+ q(0137) => [
+ q(Marshall Islands),
+ q(Republic of the Marshall Islands),
+ ],
+ q(0138) => [
+ q(Martinique),
+ q(Department of Martinique),
+ ],
+ q(0139) => [
+ q(Mauritania),
+ q(Islamic Republic of Mauritania),
+ ],
+ q(0140) => [
+ q(Mauritius),
+ q(Republic of Mauritius),
+ ],
+ q(0141) => [
+ q(Mayotte),
+ q(Territorial Collectivity of Mayotte),
+ ],
+ q(0142) => [
+ q(Mexico),
+ q(United Mexican States),
+ ],
+ q(0143) => [
+ q(Micronesia, Federated States of),
+ q(Micronesia (Federated States of)),
+ q(Federated States of Micronesia),
+ ],
+ q(0144) => [
+ q(Moldova, Republic of),
+ q(Republic of Moldova),
+ q(Moldova),
+ ],
+ q(0145) => [
+ q(Monaco),
+ q(Principality of Monaco),
+ ],
+ q(0146) => [
+ q(Mongolia),
+ ],
+ q(0147) => [
+ q(Montenegro),
+ ],
+ q(0148) => [
+ q(Montserrat),
+ ],
+ q(0149) => [
+ q(Morocco),
+ q(Kingdom of Morocco),
+ ],
+ q(0150) => [
+ q(Mozambique),
+ q(Republic of Mozambique),
+ ],
+ q(0151) => [
+ q(Myanmar),
+ q(Burma),
+ q(Union of Burma),
+ ],
+ q(0152) => [
+ q(Namibia),
+ q(Republic of Namibia),
+ ],
+ q(0153) => [
+ q(Nauru),
+ q(Republic of Nauru),
+ ],
+ q(0154) => [
+ q(Nepal),
+ q(Kingdom of Nepal),
+ ],
+ q(0155) => [
+ q(Netherlands),
+ q(Kingdom of the Netherlands),
+ ],
+ q(0156) => [
+ q(Netherlands Antilles),
+ ],
+ q(0157) => [
+ q(New Caledonia),
+ q(Territory of New Caledonia and Dependencies),
+ ],
+ q(0158) => [
+ q(New Zealand),
+ ],
+ q(0159) => [
+ q(Nicaragua),
+ q(Republic of Nicaragua),
+ ],
+ q(0160) => [
+ q(Niger),
+ q(Republic of Niger),
+ ],
+ q(0161) => [
+ q(Nigeria),
+ q(Federal Republic of Nigeria),
+ ],
+ q(0162) => [
+ q(Niue),
+ ],
+ q(0163) => [
+ q(Norfolk Island),
+ q(Territory of Norfolk Island),
+ ],
+ q(0164) => [
+ q(Northern Mariana Islands),
+ q(Commonwealth of the Northern Mariana Islands),
+ ],
+ q(0165) => [
+ q(Norway),
+ q(Kingdom of Norway),
+ ],
+ q(0166) => [
+ q(Oman),
+ q(Sultanate of Oman),
+ ],
+ q(0167) => [
+ q(Pakistan),
+ q(Islamic Republic of Pakistan),
+ ],
+ q(0168) => [
+ q(Palau),
+ q(Republic of Palau),
+ ],
+ q(0169) => [
+ q(Palestinian Territory, Occupied),
+ q(Occupied Palestinian Territory),
+ ],
+ q(0170) => [
+ q(Panama),
+ q(Republic of Panama),
+ ],
+ q(0171) => [
+ q(Papua New Guinea),
+ q(Independent State of Papua New Guinea),
+ ],
+ q(0172) => [
+ q(Paraguay),
+ q(Republic of Paraguay),
+ ],
+ q(0173) => [
+ q(Peru),
+ q(Republic of Peru),
+ ],
+ q(0174) => [
+ q(Philippines),
+ q(Republic of the Philippines),
+ ],
+ q(0175) => [
+ q(Pitcairn),
+ q(Pitcairn Islands),
+ q(Pitcairn, Henderson, Ducie and Oeno Islands),
+ q(Pitcairn Island),
+ ],
+ q(0176) => [
+ q(Poland),
+ q(Republic of Poland),
+ ],
+ q(0177) => [
+ q(Portugal),
+ q(Portuguese Republic),
+ ],
+ q(0178) => [
+ q(Puerto Rico),
+ q(Commonwealth of Puerto Rico),
+ ],
+ q(0179) => [
+ q(Qatar),
+ q(State of Qatar),
+ ],
+ q(0180) => [
+ q(Reunion),
+ q(Department of Reunion),
+ ],
+ q(0181) => [
+ q(Romania),
+ ],
+ q(0182) => [
+ q(Russian Federation),
+ q(Russia),
+ ],
+ q(0183) => [
+ q(Rwanda),
+ q(Rwandese Republic),
+ ],
+ q(0184) => [
+ q(Saint Barthelemy),
+ q(Saint-Barthelemy),
+ ],
+ q(0185) => [
+ q(Saint Helena, Ascension and Tristan da Cunha),
+ q(Saint Helena),
+ ],
+ q(0186) => [
+ q(Saint Kitts and Nevis),
+ q(Federation of Saint Kitts and Nevis),
+ ],
+ q(0187) => [
+ q(Saint Lucia),
+ ],
+ q(0188) => [
+ q(Saint Martin),
+ q(Saint-Martin (French part)),
+ ],
+ q(0189) => [
+ q(Saint Pierre and Miquelon),
+ q(Territorial Collectivity of Saint Pierre and Miquelon),
+ ],
+ q(0190) => [
+ q(Saint Vincent and the Grenadines),
+ ],
+ q(0191) => [
+ q(Samoa),
+ q(Independent State of Samoa),
+ ],
+ q(0192) => [
+ q(San Marino),
+ q(Republic of San Marino),
+ ],
+ q(0193) => [
+ q(Sao Tome and Principe),
+ q(Democratic Republic of Sao Tome and Principe),
+ ],
+ q(0194) => [
+ q(Saudi Arabia),
+ q(Kingdom of Saudi Arabia),
+ ],
+ q(0195) => [
+ q(Senegal),
+ q(Republic of Senegal),
+ ],
+ q(0196) => [
+ q(Serbia),
+ ],
+ q(0197) => [
+ q(Seychelles),
+ q(Republic of Seychelles),
+ ],
+ q(0198) => [
+ q(Sierra Leone),
+ q(Republic of Sierra Leone),
+ ],
+ q(0199) => [
+ q(Singapore),
+ q(Republic of Singapore),
+ ],
+ q(0200) => [
+ q(Slovakia),
+ q(Slovak Republic),
+ ],
+ q(0201) => [
+ q(Slovenia),
+ q(Republic of Slovenia),
+ ],
+ q(0202) => [
+ q(Solomon Islands),
+ ],
+ q(0203) => [
+ q(Somalia),
+ ],
+ q(0204) => [
+ q(South Africa),
+ q(Republic of South Africa),
+ ],
+ q(0205) => [
+ q(South Georgia and the South Sandwich Islands),
+ q(South Georgia and the Islands),
+ ],
+ q(0206) => [
+ q(Spain),
+ q(Kingdom of Spain),
+ ],
+ q(0207) => [
+ q(Sri Lanka),
+ q(Democratic Socialist Republic of Sri Lanka),
+ ],
+ q(0208) => [
+ q(Sudan),
+ q(Republic of the Sudan),
+ ],
+ q(0209) => [
+ q(Suriname),
+ q(Republic of Suriname),
+ ],
+ q(0210) => [
+ q(Svalbard and Jan Mayen),
+ q(Svalbard and Jan Mayen Islands),
+ ],
+ q(0211) => [
+ q(Swaziland),
+ q(Kingdom of Swaziland),
+ ],
+ q(0212) => [
+ q(Sweden),
+ q(Kingdom of Sweden),
+ ],
+ q(0213) => [
+ q(Switzerland),
+ q(Swiss Confederation),
+ ],
+ q(0214) => [
+ q(Syrian Arab Republic),
+ q(Syria),
+ q(Golan Heights (Israeli-occupied)),
+ ],
+ q(0215) => [
+ q(Taiwan, Province of China),
+ q(Taiwan),
+ ],
+ q(0216) => [
+ q(Tajikistan),
+ q(Republic of Tajikistan),
+ ],
+ q(0217) => [
+ q(Tanzania, United Republic of),
+ q(United Republic of Tanzania),
+ q(Tanzania),
+ ],
+ q(0218) => [
+ q(Thailand),
+ q(Kingdom of Thailand),
+ ],
+ q(0219) => [
+ q(Timor-Leste),
+ q(East Timor),
+ ],
+ q(0220) => [
+ q(Togo),
+ q(Togolese Republic),
+ ],
+ q(0221) => [
+ q(Tokelau),
+ ],
+ q(0222) => [
+ q(Tonga),
+ q(Kingdom of Tonga),
+ ],
+ q(0223) => [
+ q(Trinidad and Tobago),
+ q(Republic of Trinidad and Tobago),
+ ],
+ q(0224) => [
+ q(Tunisia),
+ q(Republic of Tunisia),
+ ],
+ q(0225) => [
+ q(Turkey),
+ q(Republic of Turkey),
+ ],
+ q(0226) => [
+ q(Turkmenistan),
+ ],
+ q(0227) => [
+ q(Turks and Caicos Islands),
+ ],
+ q(0228) => [
+ q(Tuvalu),
+ ],
+ q(0229) => [
+ q(Uganda),
+ ],
+ q(0230) => [
+ q(Ukraine),
+ ],
+ q(0231) => [
+ q(United Arab Emirates),
+ ],
+ q(0232) => [
+ q(United Kingdom),
+ q(United Kingdom of Great Britain and Northern Ireland),
+ q(Great Britain),
+ q(UK),
+ ],
+ q(0233) => [
+ q(United States),
+ q(United States of America),
+ q(US),
+ q(USA),
+ ],
+ q(0234) => [
+ q(United States Minor Outlying Islands),
+ ],
+ q(0235) => [
+ q(Uruguay),
+ q(Oriental Republic of Uruguay),
+ ],
+ q(0236) => [
+ q(Uzbekistan),
+ q(Republic of Uzbekistan),
+ ],
+ q(0237) => [
+ q(Vanuatu),
+ q(Republic of Vanuatu),
+ ],
+ q(0238) => [
+ q(Venezuela, Bolivarian Republic of),
+ q(Venezuela (Bolivarian Republic of)),
+ q(Venezuela),
+ q(Bolivarian Republic of Venezuela),
+ ],
+ q(0239) => [
+ q(Viet Nam),
+ q(Vietnam),
+ q(Socialist Republic of Vietnam),
+ ],
+ q(0240) => [
+ q(Virgin Islands, British),
+ q(British Virgin Islands),
+ q(Virgin Islands (UK)),
+ ],
+ q(0241) => [
+ q(Virgin Islands, U.S.),
+ q(United States Virgin Islands),
+ q(Virgin Islands),
+ q(Virgin Islands of the United States),
+ q(Virgin Islands (US)),
+ ],
+ q(0242) => [
+ q(Wallis and Futuna),
+ q(Wallis and Futuna Islands),
+ q(Territory of the Wallis and Futuna Islands),
+ ],
+ q(0243) => [
+ q(Western Sahara),
+ ],
+ q(0244) => [
+ q(Yemen),
+ q(Republic of Yemen),
+ ],
+ q(0245) => [
+ q(Zambia),
+ q(Republic of Zambia),
+ ],
+ q(0246) => [
+ q(Zimbabwe),
+ q(Republic of Zimbabwe),
+ ],
+ q(0247) => [
+ q(Channel Islands),
+ ],
+ q(0248) => [
+ q(Serbia and Montenegro),
+ ],
+ q(0249) => [
+ q(Ashmore and Cartier Islands),
+ q(Territory of Ashmore and Cartier Islands),
+ ],
+ q(0250) => [
+ q(Baker Island),
+ ],
+ q(0251) => [
+ q(Bassas da India),
+ ],
+ q(0252) => [
+ q(Clipperton Island),
+ ],
+ q(0253) => [
+ q(Coral Sea Islands),
+ q(Coral Sea Islands Territory),
+ ],
+ q(0254) => [
+ q(Europa Island),
+ ],
+ q(0255) => [
+ q(Gaza Strip),
+ ],
+ q(0256) => [
+ q(Glorioso Islands),
+ ],
+ q(0257) => [
+ q(Howland Island),
+ ],
+ q(0258) => [
+ q(Jan Mayen),
+ ],
+ q(0259) => [
+ q(Jarvis Island),
+ ],
+ q(0260) => [
+ q(Johnston Atoll),
+ ],
+ q(0261) => [
+ q(Juan De Nova Island),
+ ],
+ q(0262) => [
+ q(Kingman Reef),
+ ],
+ q(0263) => [
+ q(Midway Islands),
+ ],
+ q(0264) => [
+ q(Navassa Island),
+ ],
+ q(0265) => [
+ q(Palmyra Atoll),
+ ],
+ q(0266) => [
+ q(Paracel Islands),
+ ],
+ q(0267) => [
+ q(Spratly Islands),
+ ],
+ q(0268) => [
+ q(Svalbard),
+ ],
+ q(0269) => [
+ q(Tromelin Island),
+ ],
+ q(0270) => [
+ q(Wake Atoll),
+ q(Wake Island),
+ ],
+ q(0271) => [
+ q(West Bank),
+ ],
+ q(0272) => [
+ q(Ascension Island),
+ ],
+ q(0273) => [
+ q(European Union),
+ ],
+ q(0274) => [
+ q(Soviet Union ),
+ ],
+ q(0275) => [
+ q(Portuguese Timor ),
+ ],
+ q(0276) => [
+ q(France, Metropolitan),
+ ],
+ q(0277) => [
+ q(Kosovo),
+ ],
+};
+
+$Locale::Codes::Data{'country'}{'alias2id'} = {
+ q(afghanistan) => [
+ q(0001),
+ q(0),
+ ],
+ q(aland islands) => [
+ q(0002),
+ q(0),
+ ],
+ q(albania) => [
+ q(0003),
+ q(0),
+ ],
+ q(algeria) => [
+ q(0004),
+ q(0),
+ ],
+ q(american samoa) => [
+ q(0005),
+ q(0),
+ ],
+ q(andorra) => [
+ q(0006),
+ q(0),
+ ],
+ q(angola) => [
+ q(0007),
+ q(0),
+ ],
+ q(anguilla) => [
+ q(0008),
+ q(0),
+ ],
+ q(antarctica) => [
+ q(0009),
+ q(0),
+ ],
+ q(antigua and barbuda) => [
+ q(0010),
+ q(0),
+ ],
+ q(arab republic of egypt) => [
+ q(0064),
+ q(1),
+ ],
+ q(argentina) => [
+ q(0011),
+ q(0),
+ ],
+ q(argentine republic) => [
+ q(0011),
+ q(1),
+ ],
+ q(armenia) => [
+ q(0012),
+ q(0),
+ ],
+ q(aruba) => [
+ q(0013),
+ q(0),
+ ],
+ q(ascension island) => [
+ q(0272),
+ q(0),
+ ],
+ q(ashmore and cartier islands) => [
+ q(0249),
+ q(0),
+ ],
+ q(australia) => [
+ q(0014),
+ q(0),
+ ],
+ q(austria) => [
+ q(0015),
+ q(0),
+ ],
+ q(azerbaijan) => [
+ q(0016),
+ q(0),
+ ],
+ q(bahamas) => [
+ q(0017),
+ q(0),
+ ],
+ q(bahamas, the) => [
+ q(0017),
+ q(1),
+ ],
+ q(bahrain) => [
+ q(0018),
+ q(0),
+ ],
+ q(bailiwick of guernsey) => [
+ q(0090),
+ q(1),
+ ],
+ q(bailiwick of jersey) => [
+ q(0111),
+ q(1),
+ ],
+ q(baker island) => [
+ q(0250),
+ q(0),
+ ],
+ q(bangladesh) => [
+ q(0019),
+ q(0),
+ ],
+ q(barbados) => [
+ q(0020),
+ q(0),
+ ],
+ q(bassas da india) => [
+ q(0251),
+ q(0),
+ ],
+ q(belarus) => [
+ q(0021),
+ q(0),
+ ],
+ q(belgium) => [
+ q(0022),
+ q(0),
+ ],
+ q(belize) => [
+ q(0023),
+ q(0),
+ ],
+ q(benin) => [
+ q(0024),
+ q(0),
+ ],
+ q(bermuda) => [
+ q(0025),
+ q(0),
+ ],
+ q(bhutan) => [
+ q(0026),
+ q(0),
+ ],
+ q(bolivarian republic of venezuela) => [
+ q(0238),
+ q(3),
+ ],
+ q(bolivia) => [
+ q(0027),
+ q(2),
+ ],
+ q(bolivia (plurinational state of)) => [
+ q(0027),
+ q(1),
+ ],
+ q(bolivia, plurinational state of) => [
+ q(0027),
+ q(0),
+ ],
+ q(bosnia and herzegovina) => [
+ q(0028),
+ q(0),
+ ],
+ q(botswana) => [
+ q(0029),
+ q(0),
+ ],
+ q(bouvet island) => [
+ q(0030),
+ q(0),
+ ],
+ q(brazil) => [
+ q(0031),
+ q(0),
+ ],
+ q(british indian ocean territory) => [
+ q(0032),
+ q(0),
+ ],
+ q(british virgin islands) => [
+ q(0240),
+ q(1),
+ ],
+ q(brunei) => [
+ q(0033),
+ q(1),
+ ],
+ q(brunei darussalam) => [
+ q(0033),
+ q(0),
+ ],
+ q(bulgaria) => [
+ q(0034),
+ q(0),
+ ],
+ q(burkina faso) => [
+ q(0035),
+ q(0),
+ ],
+ q(burma) => [
+ q(0151),
+ q(1),
+ ],
+ q(burundi) => [
+ q(0036),
+ q(0),
+ ],
+ q(cambodia) => [
+ q(0037),
+ q(0),
+ ],
+ q(cameroon) => [
+ q(0038),
+ q(0),
+ ],
+ q(canada) => [
+ q(0039),
+ q(0),
+ ],
+ q(cape verde) => [
+ q(0040),
+ q(0),
+ ],
+ q(cayman islands) => [
+ q(0041),
+ q(0),
+ ],
+ q(central african republic) => [
+ q(0042),
+ q(0),
+ ],
+ q(chad) => [
+ q(0043),
+ q(0),
+ ],
+ q(channel islands) => [
+ q(0247),
+ q(0),
+ ],
+ q(chile) => [
+ q(0044),
+ q(0),
+ ],
+ q(china) => [
+ q(0045),
+ q(0),
+ ],
+ q(china, hong kong special administrative region) => [
+ q(0098),
+ q(1),
+ ],
+ q(china, macao special administrative region) => [
+ q(0129),
+ q(1),
+ ],
+ q(christmas island) => [
+ q(0046),
+ q(0),
+ ],
+ q(clipperton island) => [
+ q(0252),
+ q(0),
+ ],
+ q(co-operative republic of guyana) => [
+ q(0093),
+ q(1),
+ ],
+ q(cocos (keeling) islands) => [
+ q(0047),
+ q(0),
+ ],
+ q(cocos islands) => [
+ q(0047),
+ q(3),
+ ],
+ q(colombia) => [
+ q(0048),
+ q(0),
+ ],
+ q(commonwealth of australia) => [
+ q(0014),
+ q(1),
+ ],
+ q(commonwealth of dominica) => [
+ q(0061),
+ q(1),
+ ],
+ q(commonwealth of puerto rico) => [
+ q(0178),
+ q(1),
+ ],
+ q(commonwealth of the bahamas) => [
+ q(0017),
+ q(2),
+ ],
+ q(commonwealth of the northern mariana islands) => [
+ q(0164),
+ q(1),
+ ],
+ q(comoros) => [
+ q(0049),
+ q(0),
+ ],
+ q(congo) => [
+ q(0050),
+ q(0),
+ ],
+ q(congo (brazzaville)) => [
+ q(0050),
+ q(1),
+ ],
+ q(congo (kinshasa)) => [
+ q(0051),
+ q(2),
+ ],
+ q(congo, democratic republic of the) => [
+ q(0051),
+ q(3),
+ ],
+ q(congo, republic of the) => [
+ q(0050),
+ q(3),
+ ],
+ q(congo, the democratic republic of the) => [
+ q(0051),
+ q(0),
+ ],
+ q(cook islands) => [
+ q(0052),
+ q(0),
+ ],
+ q(coral sea islands) => [
+ q(0253),
+ q(0),
+ ],
+ q(coral sea islands territory) => [
+ q(0253),
+ q(1),
+ ],
+ q(costa rica) => [
+ q(0053),
+ q(0),
+ ],
+ q(cote d'ivoire) => [
+ q(0054),
+ q(0),
+ ],
+ q(croatia) => [
+ q(0055),
+ q(0),
+ ],
+ q(cuba) => [
+ q(0056),
+ q(0),
+ ],
+ q(cyprus) => [
+ q(0057),
+ q(0),
+ ],
+ q(czech republic) => [
+ q(0058),
+ q(0),
+ ],
+ q(democratic people's republic of korea) => [
+ q(0116),
+ q(1),
+ ],
+ q(democratic republic of sao tome and principe) => [
+ q(0193),
+ q(1),
+ ],
+ q(democratic republic of the congo) => [
+ q(0051),
+ q(1),
+ ],
+ q(democratic socialist republic of sri lanka) => [
+ q(0207),
+ q(1),
+ ],
+ q(denmark) => [
+ q(0059),
+ q(0),
+ ],
+ q(department of guadeloupe) => [
+ q(0087),
+ q(1),
+ ],
+ q(department of guiana) => [
+ q(0075),
+ q(1),
+ ],
+ q(department of martinique) => [
+ q(0138),
+ q(1),
+ ],
+ q(department of reunion) => [
+ q(0180),
+ q(1),
+ ],
+ q(djibouti) => [
+ q(0060),
+ q(0),
+ ],
+ q(dominica) => [
+ q(0061),
+ q(0),
+ ],
+ q(dominican republic) => [
+ q(0062),
+ q(0),
+ ],
+ q(east timor) => [
+ q(0219),
+ q(1),
+ ],
+ q(ecuador) => [
+ q(0063),
+ q(0),
+ ],
+ q(egypt) => [
+ q(0064),
+ q(0),
+ ],
+ q(el salvador) => [
+ q(0065),
+ q(0),
+ ],
+ q(equatorial guinea) => [
+ q(0066),
+ q(0),
+ ],
+ q(eritrea) => [
+ q(0067),
+ q(0),
+ ],
+ q(estonia) => [
+ q(0068),
+ q(0),
+ ],
+ q(ethiopia) => [
+ q(0069),
+ q(0),
+ ],
+ q(europa island) => [
+ q(0254),
+ q(0),
+ ],
+ q(european union) => [
+ q(0273),
+ q(0),
+ ],
+ q(faeroe islands) => [
+ q(0071),
+ q(1),
+ ],
+ q(falkland islands (islas malvinas)) => [
+ q(0070),
+ q(1),
+ ],
+ q(falkland islands (malvinas)) => [
+ q(0070),
+ q(0),
+ ],
+ q(faroe islands) => [
+ q(0071),
+ q(0),
+ ],
+ q(federal democratic republic of ethiopia) => [
+ q(0069),
+ q(1),
+ ],
+ q(federal islamic republic of the comoros) => [
+ q(0049),
+ q(1),
+ ],
+ q(federal republic of germany) => [
+ q(0081),
+ q(1),
+ ],
+ q(federal republic of nigeria) => [
+ q(0161),
+ q(1),
+ ],
+ q(federated states of micronesia) => [
+ q(0143),
+ q(2),
+ ],
+ q(federation of saint kitts and nevis) => [
+ q(0186),
+ q(1),
+ ],
+ q(federative republic of brazil) => [
+ q(0031),
+ q(1),
+ ],
+ q(fiji) => [
+ q(0072),
+ q(0),
+ ],
+ q(finland) => [
+ q(0073),
+ q(0),
+ ],
+ q(france) => [
+ q(0074),
+ q(0),
+ ],
+ q(france, metropolitan) => [
+ q(0276),
+ q(0),
+ ],
+ q(french guiana) => [
+ q(0075),
+ q(0),
+ ],
+ q(french polynesia) => [
+ q(0076),
+ q(0),
+ ],
+ q(french republic) => [
+ q(0074),
+ q(1),
+ ],
+ q(french southern and antarctic lands) => [
+ q(0077),
+ q(1),
+ ],
+ q(french southern territories) => [
+ q(0077),
+ q(0),
+ ],
+ q(gabon) => [
+ q(0078),
+ q(0),
+ ],
+ q(gabonese republic) => [
+ q(0078),
+ q(1),
+ ],
+ q(gambia) => [
+ q(0079),
+ q(0),
+ ],
+ q(gambia, the) => [
+ q(0079),
+ q(1),
+ ],
+ q(gaza strip) => [
+ q(0255),
+ q(0),
+ ],
+ q(georgia) => [
+ q(0080),
+ q(0),
+ ],
+ q(germany) => [
+ q(0081),
+ q(0),
+ ],
+ q(ghana) => [
+ q(0082),
+ q(0),
+ ],
+ q(gibraltar) => [
+ q(0083),
+ q(0),
+ ],
+ q(glorioso islands) => [
+ q(0256),
+ q(0),
+ ],
+ q(golan heights (israeli-occupied)) => [
+ q(0214),
+ q(2),
+ ],
+ q(grand duchy of luxembourg) => [
+ q(0128),
+ q(1),
+ ],
+ q(great britain) => [
+ q(0232),
+ q(2),
+ ],
+ q(great socialist people's libyan arab jamahiriya) => [
+ q(0125),
+ q(2),
+ ],
+ q(greece) => [
+ q(0084),
+ q(0),
+ ],
+ q(greenland) => [
+ q(0085),
+ q(0),
+ ],
+ q(grenada) => [
+ q(0086),
+ q(0),
+ ],
+ q(guadeloupe) => [
+ q(0087),
+ q(0),
+ ],
+ q(guam) => [
+ q(0088),
+ q(0),
+ ],
+ q(guatemala) => [
+ q(0089),
+ q(0),
+ ],
+ q(guernsey) => [
+ q(0090),
+ q(0),
+ ],
+ q(guinea) => [
+ q(0091),
+ q(0),
+ ],
+ q(guinea-bissau) => [
+ q(0092),
+ q(0),
+ ],
+ q(guyana) => [
+ q(0093),
+ q(0),
+ ],
+ q(haiti) => [
+ q(0094),
+ q(0),
+ ],
+ q(hashemite kingdom of jordan) => [
+ q(0112),
+ q(1),
+ ],
+ q(heard island and mcdonald islands) => [
+ q(0095),
+ q(0),
+ ],
+ q(hellenic republic) => [
+ q(0084),
+ q(1),
+ ],
+ q(holy see) => [
+ q(0096),
+ q(1),
+ ],
+ q(holy see (vatican city state)) => [
+ q(0096),
+ q(0),
+ ],
+ q(holy see (vatican city)) => [
+ q(0096),
+ q(4),
+ ],
+ q(honduras) => [
+ q(0097),
+ q(0),
+ ],
+ q(hong kong) => [
+ q(0098),
+ q(0),
+ ],
+ q(hong kong s.a.r.) => [
+ q(0098),
+ q(2),
+ ],
+ q(hong kong special administrative region) => [
+ q(0098),
+ q(3),
+ ],
+ q(hong kong special administrative region of china) => [
+ q(0098),
+ q(4),
+ ],
+ q(howland island) => [
+ q(0257),
+ q(0),
+ ],
+ q(hungary) => [
+ q(0099),
+ q(0),
+ ],
+ q(iceland) => [
+ q(0100),
+ q(0),
+ ],
+ q(independent state of papua new guinea) => [
+ q(0171),
+ q(1),
+ ],
+ q(independent state of samoa) => [
+ q(0191),
+ q(1),
+ ],
+ q(india) => [
+ q(0101),
+ q(0),
+ ],
+ q(indonesia) => [
+ q(0102),
+ q(0),
+ ],
+ q(iran) => [
+ q(0103),
+ q(2),
+ ],
+ q(iran (islamic republic of)) => [
+ q(0103),
+ q(1),
+ ],
+ q(iran, islamic republic of) => [
+ q(0103),
+ q(0),
+ ],
+ q(iraq) => [
+ q(0104),
+ q(0),
+ ],
+ q(ireland) => [
+ q(0105),
+ q(0),
+ ],
+ q(islamic republic of iran) => [
+ q(0103),
+ q(3),
+ ],
+ q(islamic republic of mauritania) => [
+ q(0139),
+ q(1),
+ ],
+ q(islamic republic of pakistan) => [
+ q(0167),
+ q(1),
+ ],
+ q(islamic state of afghanistan) => [
+ q(0001),
+ q(1),
+ ],
+ q(isle of man) => [
+ q(0106),
+ q(0),
+ ],
+ q(israel) => [
+ q(0107),
+ q(0),
+ ],
+ q(italian republic) => [
+ q(0108),
+ q(1),
+ ],
+ q(italy) => [
+ q(0108),
+ q(0),
+ ],
+ q(jamaica) => [
+ q(0109),
+ q(0),
+ ],
+ q(jan mayen) => [
+ q(0258),
+ q(0),
+ ],
+ q(japan) => [
+ q(0110),
+ q(0),
+ ],
+ q(jarvis island) => [
+ q(0259),
+ q(0),
+ ],
+ q(jersey) => [
+ q(0111),
+ q(0),
+ ],
+ q(johnston atoll) => [
+ q(0260),
+ q(0),
+ ],
+ q(jordan) => [
+ q(0112),
+ q(0),
+ ],
+ q(juan de nova island) => [
+ q(0261),
+ q(0),
+ ],
+ q(kazakhstan) => [
+ q(0113),
+ q(0),
+ ],
+ q(kazakstan) => [
+ q(0113),
+ q(2),
+ ],
+ q(keeling islands) => [
+ q(0047),
+ q(2),
+ ],
+ q(kenya) => [
+ q(0114),
+ q(0),
+ ],
+ q(kingdom of belgium) => [
+ q(0022),
+ q(1),
+ ],
+ q(kingdom of bhutan) => [
+ q(0026),
+ q(1),
+ ],
+ q(kingdom of cambodia) => [
+ q(0037),
+ q(1),
+ ],
+ q(kingdom of denmark) => [
+ q(0059),
+ q(1),
+ ],
+ q(kingdom of morocco) => [
+ q(0149),
+ q(1),
+ ],
+ q(kingdom of nepal) => [
+ q(0154),
+ q(1),
+ ],
+ q(kingdom of norway) => [
+ q(0165),
+ q(1),
+ ],
+ q(kingdom of saudi arabia) => [
+ q(0194),
+ q(1),
+ ],
+ q(kingdom of spain) => [
+ q(0206),
+ q(1),
+ ],
+ q(kingdom of swaziland) => [
+ q(0211),
+ q(1),
+ ],
+ q(kingdom of sweden) => [
+ q(0212),
+ q(1),
+ ],
+ q(kingdom of thailand) => [
+ q(0218),
+ q(1),
+ ],
+ q(kingdom of the netherlands) => [
+ q(0155),
+ q(1),
+ ],
+ q(kingdom of tonga) => [
+ q(0222),
+ q(1),
+ ],
+ q(kingman reef) => [
+ q(0262),
+ q(0),
+ ],
+ q(kiribati) => [
+ q(0115),
+ q(0),
+ ],
+ q(korea, democratic people's republic of) => [
+ q(0116),
+ q(0),
+ ],
+ q(korea, north) => [
+ q(0116),
+ q(2),
+ ],
+ q(korea, republic of) => [
+ q(0117),
+ q(0),
+ ],
+ q(korea, south) => [
+ q(0117),
+ q(2),
+ ],
+ q(kosovo) => [
+ q(0277),
+ q(0),
+ ],
+ q(kuwait) => [
+ q(0118),
+ q(0),
+ ],
+ q(kyrgyz republic) => [
+ q(0119),
+ q(1),
+ ],
+ q(kyrgyzstan) => [
+ q(0119),
+ q(0),
+ ],
+ q(lao people's democratic republic) => [
+ q(0120),
+ q(0),
+ ],
+ q(laos) => [
+ q(0120),
+ q(1),
+ ],
+ q(latvia) => [
+ q(0121),
+ q(0),
+ ],
+ q(lebanese republic) => [
+ q(0122),
+ q(1),
+ ],
+ q(lebanon) => [
+ q(0122),
+ q(0),
+ ],
+ q(lesotho) => [
+ q(0123),
+ q(0),
+ ],
+ q(liberia) => [
+ q(0124),
+ q(0),
+ ],
+ q(libya) => [
+ q(0125),
+ q(1),
+ ],
+ q(libyan arab jamahiriya) => [
+ q(0125),
+ q(0),
+ ],
+ q(liechtenstein) => [
+ q(0126),
+ q(0),
+ ],
+ q(lithuania) => [
+ q(0127),
+ q(0),
+ ],
+ q(luxembourg) => [
+ q(0128),
+ q(0),
+ ],
+ q(macao) => [
+ q(0129),
+ q(0),
+ ],
+ q(macao special administrative region of china) => [
+ q(0129),
+ q(6),
+ ],
+ q(macau) => [
+ q(0129),
+ q(4),
+ ],
+ q(macau s.a.r) => [
+ q(0129),
+ q(2),
+ ],
+ q(macau s.a.r.) => [
+ q(0129),
+ q(5),
+ ],
+ q(macau special administrative region) => [
+ q(0129),
+ q(3),
+ ],
+ q(macedonia) => [
+ q(0130),
+ q(2),
+ ],
+ q(macedonia, former yugoslav republic of) => [
+ q(0130),
+ q(4),
+ ],
+ q(macedonia, the former yugoslav republic of) => [
+ q(0130),
+ q(0),
+ ],
+ q(madagascar) => [
+ q(0131),
+ q(0),
+ ],
+ q(malawi) => [
+ q(0132),
+ q(0),
+ ],
+ q(malaysia) => [
+ q(0133),
+ q(0),
+ ],
+ q(maldives) => [
+ q(0134),
+ q(0),
+ ],
+ q(mali) => [
+ q(0135),
+ q(0),
+ ],
+ q(malta) => [
+ q(0136),
+ q(0),
+ ],
+ q(marshall islands) => [
+ q(0137),
+ q(0),
+ ],
+ q(martinique) => [
+ q(0138),
+ q(0),
+ ],
+ q(mauritania) => [
+ q(0139),
+ q(0),
+ ],
+ q(mauritius) => [
+ q(0140),
+ q(0),
+ ],
+ q(mayotte) => [
+ q(0141),
+ q(0),
+ ],
+ q(mexico) => [
+ q(0142),
+ q(0),
+ ],
+ q(micronesia (federated states of)) => [
+ q(0143),
+ q(1),
+ ],
+ q(micronesia, federated states of) => [
+ q(0143),
+ q(0),
+ ],
+ q(midway islands) => [
+ q(0263),
+ q(0),
+ ],
+ q(moldova) => [
+ q(0144),
+ q(2),
+ ],
+ q(moldova, republic of) => [
+ q(0144),
+ q(0),
+ ],
+ q(monaco) => [
+ q(0145),
+ q(0),
+ ],
+ q(mongolia) => [
+ q(0146),
+ q(0),
+ ],
+ q(montenegro) => [
+ q(0147),
+ q(0),
+ ],
+ q(montserrat) => [
+ q(0148),
+ q(0),
+ ],
+ q(morocco) => [
+ q(0149),
+ q(0),
+ ],
+ q(mozambique) => [
+ q(0150),
+ q(0),
+ ],
+ q(myanmar) => [
+ q(0151),
+ q(0),
+ ],
+ q(namibia) => [
+ q(0152),
+ q(0),
+ ],
+ q(nauru) => [
+ q(0153),
+ q(0),
+ ],
+ q(navassa island) => [
+ q(0264),
+ q(0),
+ ],
+ q(negara brunei darussalam) => [
+ q(0033),
+ q(2),
+ ],
+ q(nepal) => [
+ q(0154),
+ q(0),
+ ],
+ q(netherlands) => [
+ q(0155),
+ q(0),
+ ],
+ q(netherlands antilles) => [
+ q(0156),
+ q(0),
+ ],
+ q(new caledonia) => [
+ q(0157),
+ q(0),
+ ],
+ q(new zealand) => [
+ q(0158),
+ q(0),
+ ],
+ q(nicaragua) => [
+ q(0159),
+ q(0),
+ ],
+ q(niger) => [
+ q(0160),
+ q(0),
+ ],
+ q(nigeria) => [
+ q(0161),
+ q(0),
+ ],
+ q(niue) => [
+ q(0162),
+ q(0),
+ ],
+ q(norfolk island) => [
+ q(0163),
+ q(0),
+ ],
+ q(north korea) => [
+ q(0116),
+ q(3),
+ ],
+ q(northern mariana islands) => [
+ q(0164),
+ q(0),
+ ],
+ q(norway) => [
+ q(0165),
+ q(0),
+ ],
+ q(occupied palestinian territory) => [
+ q(0169),
+ q(1),
+ ],
+ q(oman) => [
+ q(0166),
+ q(0),
+ ],
+ q(oriental republic of uruguay) => [
+ q(0235),
+ q(1),
+ ],
+ q(pakistan) => [
+ q(0167),
+ q(0),
+ ],
+ q(palau) => [
+ q(0168),
+ q(0),
+ ],
+ q(palestinian territory, occupied) => [
+ q(0169),
+ q(0),
+ ],
+ q(palmyra atoll) => [
+ q(0265),
+ q(0),
+ ],
+ q(panama) => [
+ q(0170),
+ q(0),
+ ],
+ q(papua new guinea) => [
+ q(0171),
+ q(0),
+ ],
+ q(paracel islands) => [
+ q(0266),
+ q(0),
+ ],
+ q(paraguay) => [
+ q(0172),
+ q(0),
+ ],
+ q(people's democratic republic of algeria) => [
+ q(0004),
+ q(1),
+ ],
+ q(people's republic of bangladesh) => [
+ q(0019),
+ q(1),
+ ],
+ q(people's republic of china) => [
+ q(0045),
+ q(1),
+ ],
+ q(peru) => [
+ q(0173),
+ q(0),
+ ],
+ q(philippines) => [
+ q(0174),
+ q(0),
+ ],
+ q(pitcairn) => [
+ q(0175),
+ q(0),
+ ],
+ q(pitcairn island) => [
+ q(0175),
+ q(3),
+ ],
+ q(pitcairn islands) => [
+ q(0175),
+ q(1),
+ ],
+ q(pitcairn, henderson, ducie and oeno islands) => [
+ q(0175),
+ q(2),
+ ],
+ q(poland) => [
+ q(0176),
+ q(0),
+ ],
+ q(portugal) => [
+ q(0177),
+ q(0),
+ ],
+ q(portuguese republic) => [
+ q(0177),
+ q(1),
+ ],
+ q(portuguese timor ) => [
+ q(0275),
+ q(0),
+ ],
+ q(principality of andorra) => [
+ q(0006),
+ q(1),
+ ],
+ q(principality of liechtenstein) => [
+ q(0126),
+ q(1),
+ ],
+ q(principality of monaco) => [
+ q(0145),
+ q(1),
+ ],
+ q(puerto rico) => [
+ q(0178),
+ q(0),
+ ],
+ q(qatar) => [
+ q(0179),
+ q(0),
+ ],
+ q(republic of albania) => [
+ q(0003),
+ q(1),
+ ],
+ q(republic of angola) => [
+ q(0007),
+ q(1),
+ ],
+ q(republic of armenia) => [
+ q(0012),
+ q(1),
+ ],
+ q(republic of austria) => [
+ q(0015),
+ q(1),
+ ],
+ q(republic of azerbaijan) => [
+ q(0016),
+ q(1),
+ ],
+ q(republic of belarus) => [
+ q(0021),
+ q(1),
+ ],
+ q(republic of benin) => [
+ q(0024),
+ q(1),
+ ],
+ q(republic of bolivia) => [
+ q(0027),
+ q(3),
+ ],
+ q(republic of botswana) => [
+ q(0029),
+ q(1),
+ ],
+ q(republic of burundi) => [
+ q(0036),
+ q(1),
+ ],
+ q(republic of cameroon) => [
+ q(0038),
+ q(1),
+ ],
+ q(republic of cape verde) => [
+ q(0040),
+ q(1),
+ ],
+ q(republic of chad) => [
+ q(0043),
+ q(1),
+ ],
+ q(republic of chile) => [
+ q(0044),
+ q(1),
+ ],
+ q(republic of colombia) => [
+ q(0048),
+ q(1),
+ ],
+ q(republic of costa rica) => [
+ q(0053),
+ q(1),
+ ],
+ q(republic of cote d'ivoire) => [
+ q(0054),
+ q(1),
+ ],
+ q(republic of croatia) => [
+ q(0055),
+ q(1),
+ ],
+ q(republic of cuba) => [
+ q(0056),
+ q(1),
+ ],
+ q(republic of cyprus) => [
+ q(0057),
+ q(1),
+ ],
+ q(republic of djibouti) => [
+ q(0060),
+ q(1),
+ ],
+ q(republic of ecuador) => [
+ q(0063),
+ q(1),
+ ],
+ q(republic of el salvador) => [
+ q(0065),
+ q(1),
+ ],
+ q(republic of equatorial guinea) => [
+ q(0066),
+ q(1),
+ ],
+ q(republic of estonia) => [
+ q(0068),
+ q(1),
+ ],
+ q(republic of finland) => [
+ q(0073),
+ q(1),
+ ],
+ q(republic of ghana) => [
+ q(0082),
+ q(1),
+ ],
+ q(republic of guatemala) => [
+ q(0089),
+ q(1),
+ ],
+ q(republic of guinea) => [
+ q(0091),
+ q(1),
+ ],
+ q(republic of guinea-bissau) => [
+ q(0092),
+ q(1),
+ ],
+ q(republic of haiti) => [
+ q(0094),
+ q(1),
+ ],
+ q(republic of honduras) => [
+ q(0097),
+ q(1),
+ ],
+ q(republic of hungary) => [
+ q(0099),
+ q(1),
+ ],
+ q(republic of iceland) => [
+ q(0100),
+ q(1),
+ ],
+ q(republic of india) => [
+ q(0101),
+ q(1),
+ ],
+ q(republic of indonesia) => [
+ q(0102),
+ q(1),
+ ],
+ q(republic of iraq) => [
+ q(0104),
+ q(1),
+ ],
+ q(republic of kazakhstan) => [
+ q(0113),
+ q(1),
+ ],
+ q(republic of kenya) => [
+ q(0114),
+ q(1),
+ ],
+ q(republic of kiribati) => [
+ q(0115),
+ q(1),
+ ],
+ q(republic of korea) => [
+ q(0117),
+ q(1),
+ ],
+ q(republic of latvia) => [
+ q(0121),
+ q(1),
+ ],
+ q(republic of lesotho) => [
+ q(0123),
+ q(1),
+ ],
+ q(republic of liberia) => [
+ q(0124),
+ q(1),
+ ],
+ q(republic of lithuania) => [
+ q(0127),
+ q(1),
+ ],
+ q(republic of macedonia) => [
+ q(0130),
+ q(3),
+ ],
+ q(republic of madagascar) => [
+ q(0131),
+ q(1),
+ ],
+ q(republic of malawi) => [
+ q(0132),
+ q(1),
+ ],
+ q(republic of maldives) => [
+ q(0134),
+ q(1),
+ ],
+ q(republic of mali) => [
+ q(0135),
+ q(1),
+ ],
+ q(republic of malta) => [
+ q(0136),
+ q(1),
+ ],
+ q(republic of mauritius) => [
+ q(0140),
+ q(1),
+ ],
+ q(republic of moldova) => [
+ q(0144),
+ q(1),
+ ],
+ q(republic of mozambique) => [
+ q(0150),
+ q(1),
+ ],
+ q(republic of namibia) => [
+ q(0152),
+ q(1),
+ ],
+ q(republic of nauru) => [
+ q(0153),
+ q(1),
+ ],
+ q(republic of nicaragua) => [
+ q(0159),
+ q(1),
+ ],
+ q(republic of niger) => [
+ q(0160),
+ q(1),
+ ],
+ q(republic of palau) => [
+ q(0168),
+ q(1),
+ ],
+ q(republic of panama) => [
+ q(0170),
+ q(1),
+ ],
+ q(republic of paraguay) => [
+ q(0172),
+ q(1),
+ ],
+ q(republic of peru) => [
+ q(0173),
+ q(1),
+ ],
+ q(republic of poland) => [
+ q(0176),
+ q(1),
+ ],
+ q(republic of san marino) => [
+ q(0192),
+ q(1),
+ ],
+ q(republic of senegal) => [
+ q(0195),
+ q(1),
+ ],
+ q(republic of seychelles) => [
+ q(0197),
+ q(1),
+ ],
+ q(republic of sierra leone) => [
+ q(0198),
+ q(1),
+ ],
+ q(republic of singapore) => [
+ q(0199),
+ q(1),
+ ],
+ q(republic of slovenia) => [
+ q(0201),
+ q(1),
+ ],
+ q(republic of south africa) => [
+ q(0204),
+ q(1),
+ ],
+ q(republic of suriname) => [
+ q(0209),
+ q(1),
+ ],
+ q(republic of tajikistan) => [
+ q(0216),
+ q(1),
+ ],
+ q(republic of the congo) => [
+ q(0050),
+ q(2),
+ ],
+ q(republic of the fiji islands) => [
+ q(0072),
+ q(1),
+ ],
+ q(republic of the gambia) => [
+ q(0079),
+ q(2),
+ ],
+ q(republic of the marshall islands) => [
+ q(0137),
+ q(1),
+ ],
+ q(republic of the philippines) => [
+ q(0174),
+ q(1),
+ ],
+ q(republic of the sudan) => [
+ q(0208),
+ q(1),
+ ],
+ q(republic of trinidad and tobago) => [
+ q(0223),
+ q(1),
+ ],
+ q(republic of tunisia) => [
+ q(0224),
+ q(1),
+ ],
+ q(republic of turkey) => [
+ q(0225),
+ q(1),
+ ],
+ q(republic of uzbekistan) => [
+ q(0236),
+ q(1),
+ ],
+ q(republic of vanuatu) => [
+ q(0237),
+ q(1),
+ ],
+ q(republic of yemen) => [
+ q(0244),
+ q(1),
+ ],
+ q(republic of zambia) => [
+ q(0245),
+ q(1),
+ ],
+ q(republic of zimbabwe) => [
+ q(0246),
+ q(1),
+ ],
+ q(reunion) => [
+ q(0180),
+ q(0),
+ ],
+ q(romania) => [
+ q(0181),
+ q(0),
+ ],
+ q(russia) => [
+ q(0182),
+ q(1),
+ ],
+ q(russian federation) => [
+ q(0182),
+ q(0),
+ ],
+ q(rwanda) => [
+ q(0183),
+ q(0),
+ ],
+ q(rwandese republic) => [
+ q(0183),
+ q(1),
+ ],
+ q(saint barthelemy) => [
+ q(0184),
+ q(0),
+ ],
+ q(saint helena) => [
+ q(0185),
+ q(1),
+ ],
+ q(saint helena, ascension and tristan da cunha) => [
+ q(0185),
+ q(0),
+ ],
+ q(saint kitts and nevis) => [
+ q(0186),
+ q(0),
+ ],
+ q(saint lucia) => [
+ q(0187),
+ q(0),
+ ],
+ q(saint martin) => [
+ q(0188),
+ q(0),
+ ],
+ q(saint pierre and miquelon) => [
+ q(0189),
+ q(0),
+ ],
+ q(saint vincent and the grenadines) => [
+ q(0190),
+ q(0),
+ ],
+ q(saint-barthelemy) => [
+ q(0184),
+ q(1),
+ ],
+ q(saint-martin (french part)) => [
+ q(0188),
+ q(1),
+ ],
+ q(samoa) => [
+ q(0191),
+ q(0),
+ ],
+ q(san marino) => [
+ q(0192),
+ q(0),
+ ],
+ q(sao tome and principe) => [
+ q(0193),
+ q(0),
+ ],
+ q(saudi arabia) => [
+ q(0194),
+ q(0),
+ ],
+ q(senegal) => [
+ q(0195),
+ q(0),
+ ],
+ q(serbia) => [
+ q(0196),
+ q(0),
+ ],
+ q(serbia and montenegro) => [
+ q(0248),
+ q(0),
+ ],
+ q(seychelles) => [
+ q(0197),
+ q(0),
+ ],
+ q(sierra leone) => [
+ q(0198),
+ q(0),
+ ],
+ q(singapore) => [
+ q(0199),
+ q(0),
+ ],
+ q(slovak republic) => [
+ q(0200),
+ q(1),
+ ],
+ q(slovakia) => [
+ q(0200),
+ q(0),
+ ],
+ q(slovenia) => [
+ q(0201),
+ q(0),
+ ],
+ q(socialist republic of vietnam) => [
+ q(0239),
+ q(2),
+ ],
+ q(solomon islands) => [
+ q(0202),
+ q(0),
+ ],
+ q(somalia) => [
+ q(0203),
+ q(0),
+ ],
+ q(south africa) => [
+ q(0204),
+ q(0),
+ ],
+ q(south georgia and the islands) => [
+ q(0205),
+ q(1),
+ ],
+ q(south georgia and the south sandwich islands) => [
+ q(0205),
+ q(0),
+ ],
+ q(south korea) => [
+ q(0117),
+ q(3),
+ ],
+ q(soviet union ) => [
+ q(0274),
+ q(0),
+ ],
+ q(spain) => [
+ q(0206),
+ q(0),
+ ],
+ q(spratly islands) => [
+ q(0267),
+ q(0),
+ ],
+ q(sri lanka) => [
+ q(0207),
+ q(0),
+ ],
+ q(state of bahrain) => [
+ q(0018),
+ q(1),
+ ],
+ q(state of eritrea) => [
+ q(0067),
+ q(1),
+ ],
+ q(state of israel) => [
+ q(0107),
+ q(1),
+ ],
+ q(state of kuwait) => [
+ q(0118),
+ q(1),
+ ],
+ q(state of qatar) => [
+ q(0179),
+ q(1),
+ ],
+ q(state of the vatican city) => [
+ q(0096),
+ q(3),
+ ],
+ q(sudan) => [
+ q(0208),
+ q(0),
+ ],
+ q(sultanate of oman) => [
+ q(0166),
+ q(1),
+ ],
+ q(suriname) => [
+ q(0209),
+ q(0),
+ ],
+ q(svalbard) => [
+ q(0268),
+ q(0),
+ ],
+ q(svalbard and jan mayen) => [
+ q(0210),
+ q(0),
+ ],
+ q(svalbard and jan mayen islands) => [
+ q(0210),
+ q(1),
+ ],
+ q(swaziland) => [
+ q(0211),
+ q(0),
+ ],
+ q(sweden) => [
+ q(0212),
+ q(0),
+ ],
+ q(swiss confederation) => [
+ q(0213),
+ q(1),
+ ],
+ q(switzerland) => [
+ q(0213),
+ q(0),
+ ],
+ q(syria) => [
+ q(0214),
+ q(1),
+ ],
+ q(syrian arab republic) => [
+ q(0214),
+ q(0),
+ ],
+ q(taiwan) => [
+ q(0215),
+ q(1),
+ ],
+ q(taiwan, province of china) => [
+ q(0215),
+ q(0),
+ ],
+ q(tajikistan) => [
+ q(0216),
+ q(0),
+ ],
+ q(tanzania) => [
+ q(0217),
+ q(2),
+ ],
+ q(tanzania, united republic of) => [
+ q(0217),
+ q(0),
+ ],
+ q(territorial collectivity of mayotte) => [
+ q(0141),
+ q(1),
+ ],
+ q(territorial collectivity of saint pierre and miquelon) => [
+ q(0189),
+ q(1),
+ ],
+ q(territory of american samoa) => [
+ q(0005),
+ q(1),
+ ],
+ q(territory of ashmore and cartier islands) => [
+ q(0249),
+ q(1),
+ ],
+ q(territory of christmas island) => [
+ q(0046),
+ q(1),
+ ],
+ q(territory of cocos (keeling) islands) => [
+ q(0047),
+ q(1),
+ ],
+ q(territory of french polynesia) => [
+ q(0076),
+ q(1),
+ ],
+ q(territory of guam) => [
+ q(0088),
+ q(1),
+ ],
+ q(territory of heard island and mcdonald islands) => [
+ q(0095),
+ q(1),
+ ],
+ q(territory of new caledonia and dependencies) => [
+ q(0157),
+ q(1),
+ ],
+ q(territory of norfolk island) => [
+ q(0163),
+ q(1),
+ ],
+ q(territory of the french southern and antarctic lands) => [
+ q(0077),
+ q(2),
+ ],
+ q(territory of the wallis and futuna islands) => [
+ q(0242),
+ q(2),
+ ],
+ q(thailand) => [
+ q(0218),
+ q(0),
+ ],
+ q(the bahamas) => [
+ q(0017),
+ q(3),
+ ],
+ q(the democratic republic of the congo) => [
+ q(0051),
+ q(4),
+ ],
+ q(the former yugoslav republic of macedonia) => [
+ q(0130),
+ q(1),
+ ],
+ q(the republic of the congo) => [
+ q(0050),
+ q(4),
+ ],
+ q(timor-leste) => [
+ q(0219),
+ q(0),
+ ],
+ q(togo) => [
+ q(0220),
+ q(0),
+ ],
+ q(togolese republic) => [
+ q(0220),
+ q(1),
+ ],
+ q(tokelau) => [
+ q(0221),
+ q(0),
+ ],
+ q(tonga) => [
+ q(0222),
+ q(0),
+ ],
+ q(trinidad and tobago) => [
+ q(0223),
+ q(0),
+ ],
+ q(tromelin island) => [
+ q(0269),
+ q(0),
+ ],
+ q(tunisia) => [
+ q(0224),
+ q(0),
+ ],
+ q(turkey) => [
+ q(0225),
+ q(0),
+ ],
+ q(turkmenistan) => [
+ q(0226),
+ q(0),
+ ],
+ q(turks and caicos islands) => [
+ q(0227),
+ q(0),
+ ],
+ q(tuvalu) => [
+ q(0228),
+ q(0),
+ ],
+ q(uganda) => [
+ q(0229),
+ q(0),
+ ],
+ q(uk) => [
+ q(0232),
+ q(3),
+ ],
+ q(ukraine) => [
+ q(0230),
+ q(0),
+ ],
+ q(union of burma) => [
+ q(0151),
+ q(2),
+ ],
+ q(united arab emirates) => [
+ q(0231),
+ q(0),
+ ],
+ q(united kingdom) => [
+ q(0232),
+ q(0),
+ ],
+ q(united kingdom of great britain and northern ireland) => [
+ q(0232),
+ q(1),
+ ],
+ q(united mexican states) => [
+ q(0142),
+ q(1),
+ ],
+ q(united republic of tanzania) => [
+ q(0217),
+ q(1),
+ ],
+ q(united states) => [
+ q(0233),
+ q(0),
+ ],
+ q(united states minor outlying islands) => [
+ q(0234),
+ q(0),
+ ],
+ q(united states of america) => [
+ q(0233),
+ q(1),
+ ],
+ q(united states virgin islands) => [
+ q(0241),
+ q(1),
+ ],
+ q(uruguay) => [
+ q(0235),
+ q(0),
+ ],
+ q(us) => [
+ q(0233),
+ q(2),
+ ],
+ q(usa) => [
+ q(0233),
+ q(3),
+ ],
+ q(uzbekistan) => [
+ q(0236),
+ q(0),
+ ],
+ q(vanuatu) => [
+ q(0237),
+ q(0),
+ ],
+ q(vatican city) => [
+ q(0096),
+ q(2),
+ ],
+ q(venezuela) => [
+ q(0238),
+ q(2),
+ ],
+ q(venezuela (bolivarian republic of)) => [
+ q(0238),
+ q(1),
+ ],
+ q(venezuela, bolivarian republic of) => [
+ q(0238),
+ q(0),
+ ],
+ q(viet nam) => [
+ q(0239),
+ q(0),
+ ],
+ q(vietnam) => [
+ q(0239),
+ q(1),
+ ],
+ q(virgin islands) => [
+ q(0241),
+ q(2),
+ ],
+ q(virgin islands (uk)) => [
+ q(0240),
+ q(2),
+ ],
+ q(virgin islands (us)) => [
+ q(0241),
+ q(4),
+ ],
+ q(virgin islands of the united states) => [
+ q(0241),
+ q(3),
+ ],
+ q(virgin islands, british) => [
+ q(0240),
+ q(0),
+ ],
+ q(virgin islands, u.s.) => [
+ q(0241),
+ q(0),
+ ],
+ q(wake atoll) => [
+ q(0270),
+ q(0),
+ ],
+ q(wake island) => [
+ q(0270),
+ q(1),
+ ],
+ q(wallis and futuna) => [
+ q(0242),
+ q(0),
+ ],
+ q(wallis and futuna islands) => [
+ q(0242),
+ q(1),
+ ],
+ q(west bank) => [
+ q(0271),
+ q(0),
+ ],
+ q(western sahara) => [
+ q(0243),
+ q(0),
+ ],
+ q(yemen) => [
+ q(0244),
+ q(0),
+ ],
+ q(zambia) => [
+ q(0245),
+ q(0),
+ ],
+ q(zimbabwe) => [
+ q(0246),
+ q(0),
+ ],
+};
+
+$Locale::Codes::Data{'country'}{'code2id'} = {
+ q(alpha2) => {
+ q(ad) => [
+ q(0006),
+ q(0),
+ ],
+ q(ae) => [
+ q(0231),
+ q(0),
+ ],
+ q(af) => [
+ q(0001),
+ q(0),
+ ],
+ q(ag) => [
+ q(0010),
+ q(0),
+ ],
+ q(ai) => [
+ q(0008),
+ q(0),
+ ],
+ q(al) => [
+ q(0003),
+ q(0),
+ ],
+ q(am) => [
+ q(0012),
+ q(0),
+ ],
+ q(an) => [
+ q(0156),
+ q(0),
+ ],
+ q(ao) => [
+ q(0007),
+ q(0),
+ ],
+ q(aq) => [
+ q(0009),
+ q(0),
+ ],
+ q(ar) => [
+ q(0011),
+ q(0),
+ ],
+ q(as) => [
+ q(0005),
+ q(0),
+ ],
+ q(at) => [
+ q(0015),
+ q(0),
+ ],
+ q(au) => [
+ q(0014),
+ q(0),
+ ],
+ q(aw) => [
+ q(0013),
+ q(0),
+ ],
+ q(ax) => [
+ q(0002),
+ q(0),
+ ],
+ q(az) => [
+ q(0016),
+ q(0),
+ ],
+ q(ba) => [
+ q(0028),
+ q(0),
+ ],
+ q(bb) => [
+ q(0020),
+ q(0),
+ ],
+ q(bd) => [
+ q(0019),
+ q(0),
+ ],
+ q(be) => [
+ q(0022),
+ q(0),
+ ],
+ q(bf) => [
+ q(0035),
+ q(0),
+ ],
+ q(bg) => [
+ q(0034),
+ q(0),
+ ],
+ q(bh) => [
+ q(0018),
+ q(0),
+ ],
+ q(bi) => [
+ q(0036),
+ q(0),
+ ],
+ q(bj) => [
+ q(0024),
+ q(0),
+ ],
+ q(bl) => [
+ q(0184),
+ q(0),
+ ],
+ q(bm) => [
+ q(0025),
+ q(0),
+ ],
+ q(bn) => [
+ q(0033),
+ q(0),
+ ],
+ q(bo) => [
+ q(0027),
+ q(0),
+ ],
+ q(br) => [
+ q(0031),
+ q(0),
+ ],
+ q(bs) => [
+ q(0017),
+ q(0),
+ ],
+ q(bt) => [
+ q(0026),
+ q(0),
+ ],
+ q(bv) => [
+ q(0030),
+ q(0),
+ ],
+ q(bw) => [
+ q(0029),
+ q(0),
+ ],
+ q(by) => [
+ q(0021),
+ q(0),
+ ],
+ q(bz) => [
+ q(0023),
+ q(0),
+ ],
+ q(ca) => [
+ q(0039),
+ q(0),
+ ],
+ q(cc) => [
+ q(0047),
+ q(0),
+ ],
+ q(cd) => [
+ q(0051),
+ q(0),
+ ],
+ q(cf) => [
+ q(0042),
+ q(0),
+ ],
+ q(cg) => [
+ q(0050),
+ q(0),
+ ],
+ q(ch) => [
+ q(0213),
+ q(0),
+ ],
+ q(ci) => [
+ q(0054),
+ q(0),
+ ],
+ q(ck) => [
+ q(0052),
+ q(0),
+ ],
+ q(cl) => [
+ q(0044),
+ q(0),
+ ],
+ q(cm) => [
+ q(0038),
+ q(0),
+ ],
+ q(cn) => [
+ q(0045),
+ q(0),
+ ],
+ q(co) => [
+ q(0048),
+ q(0),
+ ],
+ q(cr) => [
+ q(0053),
+ q(0),
+ ],
+ q(cu) => [
+ q(0056),
+ q(0),
+ ],
+ q(cv) => [
+ q(0040),
+ q(0),
+ ],
+ q(cx) => [
+ q(0046),
+ q(0),
+ ],
+ q(cy) => [
+ q(0057),
+ q(0),
+ ],
+ q(cz) => [
+ q(0058),
+ q(0),
+ ],
+ q(de) => [
+ q(0081),
+ q(0),
+ ],
+ q(dj) => [
+ q(0060),
+ q(0),
+ ],
+ q(dk) => [
+ q(0059),
+ q(0),
+ ],
+ q(dm) => [
+ q(0061),
+ q(0),
+ ],
+ q(do) => [
+ q(0062),
+ q(0),
+ ],
+ q(dz) => [
+ q(0004),
+ q(0),
+ ],
+ q(ec) => [
+ q(0063),
+ q(0),
+ ],
+ q(ee) => [
+ q(0068),
+ q(0),
+ ],
+ q(eg) => [
+ q(0064),
+ q(0),
+ ],
+ q(eh) => [
+ q(0243),
+ q(0),
+ ],
+ q(er) => [
+ q(0067),
+ q(0),
+ ],
+ q(es) => [
+ q(0206),
+ q(0),
+ ],
+ q(et) => [
+ q(0069),
+ q(0),
+ ],
+ q(fi) => [
+ q(0073),
+ q(0),
+ ],
+ q(fj) => [
+ q(0072),
+ q(0),
+ ],
+ q(fk) => [
+ q(0070),
+ q(0),
+ ],
+ q(fm) => [
+ q(0143),
+ q(0),
+ ],
+ q(fo) => [
+ q(0071),
+ q(0),
+ ],
+ q(fr) => [
+ q(0074),
+ q(0),
+ ],
+ q(fx) => [
+ q(0276),
+ q(0),
+ ],
+ q(ga) => [
+ q(0078),
+ q(0),
+ ],
+ q(gb) => [
+ q(0232),
+ q(0),
+ ],
+ q(gd) => [
+ q(0086),
+ q(0),
+ ],
+ q(ge) => [
+ q(0080),
+ q(0),
+ ],
+ q(gf) => [
+ q(0075),
+ q(0),
+ ],
+ q(gg) => [
+ q(0090),
+ q(0),
+ ],
+ q(gh) => [
+ q(0082),
+ q(0),
+ ],
+ q(gi) => [
+ q(0083),
+ q(0),
+ ],
+ q(gl) => [
+ q(0085),
+ q(0),
+ ],
+ q(gm) => [
+ q(0079),
+ q(0),
+ ],
+ q(gn) => [
+ q(0091),
+ q(0),
+ ],
+ q(gp) => [
+ q(0087),
+ q(0),
+ ],
+ q(gq) => [
+ q(0066),
+ q(0),
+ ],
+ q(gr) => [
+ q(0084),
+ q(0),
+ ],
+ q(gs) => [
+ q(0205),
+ q(0),
+ ],
+ q(gt) => [
+ q(0089),
+ q(0),
+ ],
+ q(gu) => [
+ q(0088),
+ q(0),
+ ],
+ q(gw) => [
+ q(0092),
+ q(0),
+ ],
+ q(gy) => [
+ q(0093),
+ q(0),
+ ],
+ q(hk) => [
+ q(0098),
+ q(0),
+ ],
+ q(hm) => [
+ q(0095),
+ q(0),
+ ],
+ q(hn) => [
+ q(0097),
+ q(0),
+ ],
+ q(hr) => [
+ q(0055),
+ q(0),
+ ],
+ q(ht) => [
+ q(0094),
+ q(0),
+ ],
+ q(hu) => [
+ q(0099),
+ q(0),
+ ],
+ q(id) => [
+ q(0102),
+ q(0),
+ ],
+ q(ie) => [
+ q(0105),
+ q(0),
+ ],
+ q(il) => [
+ q(0107),
+ q(0),
+ ],
+ q(im) => [
+ q(0106),
+ q(0),
+ ],
+ q(in) => [
+ q(0101),
+ q(0),
+ ],
+ q(io) => [
+ q(0032),
+ q(0),
+ ],
+ q(iq) => [
+ q(0104),
+ q(0),
+ ],
+ q(ir) => [
+ q(0103),
+ q(0),
+ ],
+ q(is) => [
+ q(0100),
+ q(0),
+ ],
+ q(it) => [
+ q(0108),
+ q(0),
+ ],
+ q(je) => [
+ q(0111),
+ q(0),
+ ],
+ q(jm) => [
+ q(0109),
+ q(0),
+ ],
+ q(jo) => [
+ q(0112),
+ q(0),
+ ],
+ q(jp) => [
+ q(0110),
+ q(0),
+ ],
+ q(ke) => [
+ q(0114),
+ q(0),
+ ],
+ q(kg) => [
+ q(0119),
+ q(0),
+ ],
+ q(kh) => [
+ q(0037),
+ q(0),
+ ],
+ q(ki) => [
+ q(0115),
+ q(0),
+ ],
+ q(km) => [
+ q(0049),
+ q(0),
+ ],
+ q(kn) => [
+ q(0186),
+ q(0),
+ ],
+ q(kp) => [
+ q(0116),
+ q(0),
+ ],
+ q(kr) => [
+ q(0117),
+ q(0),
+ ],
+ q(kw) => [
+ q(0118),
+ q(0),
+ ],
+ q(ky) => [
+ q(0041),
+ q(0),
+ ],
+ q(kz) => [
+ q(0113),
+ q(0),
+ ],
+ q(la) => [
+ q(0120),
+ q(0),
+ ],
+ q(lb) => [
+ q(0122),
+ q(0),
+ ],
+ q(lc) => [
+ q(0187),
+ q(0),
+ ],
+ q(li) => [
+ q(0126),
+ q(0),
+ ],
+ q(lk) => [
+ q(0207),
+ q(0),
+ ],
+ q(lr) => [
+ q(0124),
+ q(0),
+ ],
+ q(ls) => [
+ q(0123),
+ q(0),
+ ],
+ q(lt) => [
+ q(0127),
+ q(0),
+ ],
+ q(lu) => [
+ q(0128),
+ q(0),
+ ],
+ q(lv) => [
+ q(0121),
+ q(0),
+ ],
+ q(ly) => [
+ q(0125),
+ q(0),
+ ],
+ q(ma) => [
+ q(0149),
+ q(0),
+ ],
+ q(mc) => [
+ q(0145),
+ q(0),
+ ],
+ q(md) => [
+ q(0144),
+ q(0),
+ ],
+ q(me) => [
+ q(0147),
+ q(0),
+ ],
+ q(mf) => [
+ q(0188),
+ q(0),
+ ],
+ q(mg) => [
+ q(0131),
+ q(0),
+ ],
+ q(mh) => [
+ q(0137),
+ q(0),
+ ],
+ q(mk) => [
+ q(0130),
+ q(0),
+ ],
+ q(ml) => [
+ q(0135),
+ q(0),
+ ],
+ q(mm) => [
+ q(0151),
+ q(0),
+ ],
+ q(mn) => [
+ q(0146),
+ q(0),
+ ],
+ q(mo) => [
+ q(0129),
+ q(0),
+ ],
+ q(mp) => [
+ q(0164),
+ q(0),
+ ],
+ q(mq) => [
+ q(0138),
+ q(0),
+ ],
+ q(mr) => [
+ q(0139),
+ q(0),
+ ],
+ q(ms) => [
+ q(0148),
+ q(0),
+ ],
+ q(mt) => [
+ q(0136),
+ q(0),
+ ],
+ q(mu) => [
+ q(0140),
+ q(0),
+ ],
+ q(mv) => [
+ q(0134),
+ q(0),
+ ],
+ q(mw) => [
+ q(0132),
+ q(0),
+ ],
+ q(mx) => [
+ q(0142),
+ q(0),
+ ],
+ q(my) => [
+ q(0133),
+ q(0),
+ ],
+ q(mz) => [
+ q(0150),
+ q(0),
+ ],
+ q(na) => [
+ q(0152),
+ q(0),
+ ],
+ q(nc) => [
+ q(0157),
+ q(0),
+ ],
+ q(ne) => [
+ q(0160),
+ q(0),
+ ],
+ q(nf) => [
+ q(0163),
+ q(0),
+ ],
+ q(ng) => [
+ q(0161),
+ q(0),
+ ],
+ q(ni) => [
+ q(0159),
+ q(0),
+ ],
+ q(nl) => [
+ q(0155),
+ q(0),
+ ],
+ q(no) => [
+ q(0165),
+ q(0),
+ ],
+ q(np) => [
+ q(0154),
+ q(0),
+ ],
+ q(nr) => [
+ q(0153),
+ q(0),
+ ],
+ q(nu) => [
+ q(0162),
+ q(0),
+ ],
+ q(nz) => [
+ q(0158),
+ q(0),
+ ],
+ q(om) => [
+ q(0166),
+ q(0),
+ ],
+ q(pa) => [
+ q(0170),
+ q(0),
+ ],
+ q(pe) => [
+ q(0173),
+ q(0),
+ ],
+ q(pf) => [
+ q(0076),
+ q(0),
+ ],
+ q(pg) => [
+ q(0171),
+ q(0),
+ ],
+ q(ph) => [
+ q(0174),
+ q(0),
+ ],
+ q(pk) => [
+ q(0167),
+ q(0),
+ ],
+ q(pl) => [
+ q(0176),
+ q(0),
+ ],
+ q(pm) => [
+ q(0189),
+ q(0),
+ ],
+ q(pn) => [
+ q(0175),
+ q(0),
+ ],
+ q(pr) => [
+ q(0178),
+ q(0),
+ ],
+ q(ps) => [
+ q(0169),
+ q(0),
+ ],
+ q(pt) => [
+ q(0177),
+ q(0),
+ ],
+ q(pw) => [
+ q(0168),
+ q(0),
+ ],
+ q(py) => [
+ q(0172),
+ q(0),
+ ],
+ q(qa) => [
+ q(0179),
+ q(0),
+ ],
+ q(re) => [
+ q(0180),
+ q(0),
+ ],
+ q(ro) => [
+ q(0181),
+ q(0),
+ ],
+ q(rs) => [
+ q(0196),
+ q(0),
+ ],
+ q(ru) => [
+ q(0182),
+ q(0),
+ ],
+ q(rw) => [
+ q(0183),
+ q(0),
+ ],
+ q(sa) => [
+ q(0194),
+ q(0),
+ ],
+ q(sb) => [
+ q(0202),
+ q(0),
+ ],
+ q(sc) => [
+ q(0197),
+ q(0),
+ ],
+ q(sd) => [
+ q(0208),
+ q(0),
+ ],
+ q(se) => [
+ q(0212),
+ q(0),
+ ],
+ q(sg) => [
+ q(0199),
+ q(0),
+ ],
+ q(sh) => [
+ q(0185),
+ q(0),
+ ],
+ q(si) => [
+ q(0201),
+ q(0),
+ ],
+ q(sj) => [
+ q(0210),
+ q(0),
+ ],
+ q(sk) => [
+ q(0200),
+ q(0),
+ ],
+ q(sl) => [
+ q(0198),
+ q(0),
+ ],
+ q(sm) => [
+ q(0192),
+ q(0),
+ ],
+ q(sn) => [
+ q(0195),
+ q(0),
+ ],
+ q(so) => [
+ q(0203),
+ q(0),
+ ],
+ q(sr) => [
+ q(0209),
+ q(0),
+ ],
+ q(st) => [
+ q(0193),
+ q(0),
+ ],
+ q(sv) => [
+ q(0065),
+ q(0),
+ ],
+ q(sy) => [
+ q(0214),
+ q(0),
+ ],
+ q(sz) => [
+ q(0211),
+ q(0),
+ ],
+ q(tc) => [
+ q(0227),
+ q(0),
+ ],
+ q(td) => [
+ q(0043),
+ q(0),
+ ],
+ q(tf) => [
+ q(0077),
+ q(0),
+ ],
+ q(tg) => [
+ q(0220),
+ q(0),
+ ],
+ q(th) => [
+ q(0218),
+ q(0),
+ ],
+ q(tj) => [
+ q(0216),
+ q(0),
+ ],
+ q(tk) => [
+ q(0221),
+ q(0),
+ ],
+ q(tl) => [
+ q(0219),
+ q(0),
+ ],
+ q(tm) => [
+ q(0226),
+ q(0),
+ ],
+ q(tn) => [
+ q(0224),
+ q(0),
+ ],
+ q(to) => [
+ q(0222),
+ q(0),
+ ],
+ q(tr) => [
+ q(0225),
+ q(0),
+ ],
+ q(tt) => [
+ q(0223),
+ q(0),
+ ],
+ q(tv) => [
+ q(0228),
+ q(0),
+ ],
+ q(tw) => [
+ q(0215),
+ q(0),
+ ],
+ q(tz) => [
+ q(0217),
+ q(0),
+ ],
+ q(ua) => [
+ q(0230),
+ q(0),
+ ],
+ q(ug) => [
+ q(0229),
+ q(0),
+ ],
+ q(um) => [
+ q(0234),
+ q(0),
+ ],
+ q(us) => [
+ q(0233),
+ q(0),
+ ],
+ q(uy) => [
+ q(0235),
+ q(0),
+ ],
+ q(uz) => [
+ q(0236),
+ q(0),
+ ],
+ q(va) => [
+ q(0096),
+ q(0),
+ ],
+ q(vc) => [
+ q(0190),
+ q(0),
+ ],
+ q(ve) => [
+ q(0238),
+ q(0),
+ ],
+ q(vg) => [
+ q(0240),
+ q(0),
+ ],
+ q(vi) => [
+ q(0241),
+ q(0),
+ ],
+ q(vn) => [
+ q(0239),
+ q(0),
+ ],
+ q(vu) => [
+ q(0237),
+ q(0),
+ ],
+ q(wf) => [
+ q(0242),
+ q(0),
+ ],
+ q(ws) => [
+ q(0191),
+ q(0),
+ ],
+ q(ye) => [
+ q(0244),
+ q(0),
+ ],
+ q(yt) => [
+ q(0141),
+ q(0),
+ ],
+ q(za) => [
+ q(0204),
+ q(0),
+ ],
+ q(zm) => [
+ q(0245),
+ q(0),
+ ],
+ q(zw) => [
+ q(0246),
+ q(0),
+ ],
+ },
+ q(alpha3) => {
+ q(abw) => [
+ q(0013),
+ q(0),
+ ],
+ q(afg) => [
+ q(0001),
+ q(0),
+ ],
+ q(ago) => [
+ q(0007),
+ q(0),
+ ],
+ q(aia) => [
+ q(0008),
+ q(0),
+ ],
+ q(ala) => [
+ q(0002),
+ q(0),
+ ],
+ q(alb) => [
+ q(0003),
+ q(0),
+ ],
+ q(and) => [
+ q(0006),
+ q(0),
+ ],
+ q(ant) => [
+ q(0156),
+ q(0),
+ ],
+ q(are) => [
+ q(0231),
+ q(0),
+ ],
+ q(arg) => [
+ q(0011),
+ q(0),
+ ],
+ q(arm) => [
+ q(0012),
+ q(0),
+ ],
+ q(asm) => [
+ q(0005),
+ q(0),
+ ],
+ q(ata) => [
+ q(0009),
+ q(0),
+ ],
+ q(atf) => [
+ q(0077),
+ q(1),
+ ],
+ q(atg) => [
+ q(0010),
+ q(0),
+ ],
+ q(aus) => [
+ q(0014),
+ q(0),
+ ],
+ q(aut) => [
+ q(0015),
+ q(0),
+ ],
+ q(aze) => [
+ q(0016),
+ q(0),
+ ],
+ q(bdi) => [
+ q(0036),
+ q(0),
+ ],
+ q(bel) => [
+ q(0022),
+ q(0),
+ ],
+ q(ben) => [
+ q(0024),
+ q(0),
+ ],
+ q(bfa) => [
+ q(0035),
+ q(0),
+ ],
+ q(bgd) => [
+ q(0019),
+ q(0),
+ ],
+ q(bgr) => [
+ q(0034),
+ q(0),
+ ],
+ q(bhr) => [
+ q(0018),
+ q(0),
+ ],
+ q(bhs) => [
+ q(0017),
+ q(0),
+ ],
+ q(bih) => [
+ q(0028),
+ q(0),
+ ],
+ q(blm) => [
+ q(0184),
+ q(1),
+ ],
+ q(blr) => [
+ q(0021),
+ q(0),
+ ],
+ q(blz) => [
+ q(0023),
+ q(0),
+ ],
+ q(bmu) => [
+ q(0025),
+ q(0),
+ ],
+ q(bol) => [
+ q(0027),
+ q(1),
+ ],
+ q(bra) => [
+ q(0031),
+ q(0),
+ ],
+ q(brb) => [
+ q(0020),
+ q(0),
+ ],
+ q(brn) => [
+ q(0033),
+ q(0),
+ ],
+ q(btn) => [
+ q(0026),
+ q(0),
+ ],
+ q(bvt) => [
+ q(0030),
+ q(0),
+ ],
+ q(bwa) => [
+ q(0029),
+ q(0),
+ ],
+ q(caf) => [
+ q(0042),
+ q(0),
+ ],
+ q(can) => [
+ q(0039),
+ q(0),
+ ],
+ q(cck) => [
+ q(0047),
+ q(0),
+ ],
+ q(che) => [
+ q(0213),
+ q(0),
+ ],
+ q(chl) => [
+ q(0044),
+ q(0),
+ ],
+ q(chn) => [
+ q(0045),
+ q(0),
+ ],
+ q(civ) => [
+ q(0054),
+ q(0),
+ ],
+ q(cmr) => [
+ q(0038),
+ q(0),
+ ],
+ q(cod) => [
+ q(0051),
+ q(1),
+ ],
+ q(cog) => [
+ q(0050),
+ q(0),
+ ],
+ q(cok) => [
+ q(0052),
+ q(0),
+ ],
+ q(col) => [
+ q(0048),
+ q(0),
+ ],
+ q(com) => [
+ q(0049),
+ q(0),
+ ],
+ q(cpv) => [
+ q(0040),
+ q(0),
+ ],
+ q(cri) => [
+ q(0053),
+ q(0),
+ ],
+ q(cub) => [
+ q(0056),
+ q(0),
+ ],
+ q(cxr) => [
+ q(0046),
+ q(0),
+ ],
+ q(cym) => [
+ q(0041),
+ q(0),
+ ],
+ q(cyp) => [
+ q(0057),
+ q(0),
+ ],
+ q(cze) => [
+ q(0058),
+ q(0),
+ ],
+ q(deu) => [
+ q(0081),
+ q(0),
+ ],
+ q(dji) => [
+ q(0060),
+ q(0),
+ ],
+ q(dma) => [
+ q(0061),
+ q(0),
+ ],
+ q(dnk) => [
+ q(0059),
+ q(0),
+ ],
+ q(dom) => [
+ q(0062),
+ q(0),
+ ],
+ q(dza) => [
+ q(0004),
+ q(0),
+ ],
+ q(ecu) => [
+ q(0063),
+ q(0),
+ ],
+ q(egy) => [
+ q(0064),
+ q(0),
+ ],
+ q(eri) => [
+ q(0067),
+ q(0),
+ ],
+ q(esh) => [
+ q(0243),
+ q(0),
+ ],
+ q(esp) => [
+ q(0206),
+ q(0),
+ ],
+ q(est) => [
+ q(0068),
+ q(0),
+ ],
+ q(eth) => [
+ q(0069),
+ q(0),
+ ],
+ q(fin) => [
+ q(0073),
+ q(0),
+ ],
+ q(fji) => [
+ q(0072),
+ q(0),
+ ],
+ q(flk) => [
+ q(0070),
+ q(0),
+ ],
+ q(fra) => [
+ q(0074),
+ q(0),
+ ],
+ q(fro) => [
+ q(0071),
+ q(1),
+ ],
+ q(fsm) => [
+ q(0143),
+ q(1),
+ ],
+ q(fxx) => [
+ q(0276),
+ q(0),
+ ],
+ q(gab) => [
+ q(0078),
+ q(0),
+ ],
+ q(gbr) => [
+ q(0232),
+ q(1),
+ ],
+ q(geo) => [
+ q(0080),
+ q(0),
+ ],
+ q(ggy) => [
+ q(0090),
+ q(0),
+ ],
+ q(gha) => [
+ q(0082),
+ q(0),
+ ],
+ q(gib) => [
+ q(0083),
+ q(0),
+ ],
+ q(gin) => [
+ q(0091),
+ q(0),
+ ],
+ q(glp) => [
+ q(0087),
+ q(0),
+ ],
+ q(gmb) => [
+ q(0079),
+ q(0),
+ ],
+ q(gnb) => [
+ q(0092),
+ q(0),
+ ],
+ q(gnq) => [
+ q(0066),
+ q(0),
+ ],
+ q(grc) => [
+ q(0084),
+ q(0),
+ ],
+ q(grd) => [
+ q(0086),
+ q(0),
+ ],
+ q(grl) => [
+ q(0085),
+ q(0),
+ ],
+ q(gtm) => [
+ q(0089),
+ q(0),
+ ],
+ q(guf) => [
+ q(0075),
+ q(0),
+ ],
+ q(gum) => [
+ q(0088),
+ q(0),
+ ],
+ q(guy) => [
+ q(0093),
+ q(0),
+ ],
+ q(hkg) => [
+ q(0098),
+ q(1),
+ ],
+ q(hmd) => [
+ q(0095),
+ q(0),
+ ],
+ q(hnd) => [
+ q(0097),
+ q(0),
+ ],
+ q(hrv) => [
+ q(0055),
+ q(0),
+ ],
+ q(hti) => [
+ q(0094),
+ q(0),
+ ],
+ q(hun) => [
+ q(0099),
+ q(0),
+ ],
+ q(idn) => [
+ q(0102),
+ q(0),
+ ],
+ q(imn) => [
+ q(0106),
+ q(0),
+ ],
+ q(ind) => [
+ q(0101),
+ q(0),
+ ],
+ q(iot) => [
+ q(0032),
+ q(0),
+ ],
+ q(irl) => [
+ q(0105),
+ q(0),
+ ],
+ q(irn) => [
+ q(0103),
+ q(1),
+ ],
+ q(irq) => [
+ q(0104),
+ q(0),
+ ],
+ q(isl) => [
+ q(0100),
+ q(0),
+ ],
+ q(isr) => [
+ q(0107),
+ q(0),
+ ],
+ q(ita) => [
+ q(0108),
+ q(0),
+ ],
+ q(jam) => [
+ q(0109),
+ q(0),
+ ],
+ q(jey) => [
+ q(0111),
+ q(0),
+ ],
+ q(jor) => [
+ q(0112),
+ q(0),
+ ],
+ q(jpn) => [
+ q(0110),
+ q(0),
+ ],
+ q(kaz) => [
+ q(0113),
+ q(0),
+ ],
+ q(ken) => [
+ q(0114),
+ q(0),
+ ],
+ q(kgz) => [
+ q(0119),
+ q(0),
+ ],
+ q(khm) => [
+ q(0037),
+ q(0),
+ ],
+ q(kir) => [
+ q(0115),
+ q(0),
+ ],
+ q(kna) => [
+ q(0186),
+ q(0),
+ ],
+ q(kor) => [
+ q(0117),
+ q(1),
+ ],
+ q(kwt) => [
+ q(0118),
+ q(0),
+ ],
+ q(lao) => [
+ q(0120),
+ q(0),
+ ],
+ q(lbn) => [
+ q(0122),
+ q(0),
+ ],
+ q(lbr) => [
+ q(0124),
+ q(0),
+ ],
+ q(lby) => [
+ q(0125),
+ q(0),
+ ],
+ q(lca) => [
+ q(0187),
+ q(0),
+ ],
+ q(lie) => [
+ q(0126),
+ q(0),
+ ],
+ q(lka) => [
+ q(0207),
+ q(0),
+ ],
+ q(lso) => [
+ q(0123),
+ q(0),
+ ],
+ q(ltu) => [
+ q(0127),
+ q(0),
+ ],
+ q(lux) => [
+ q(0128),
+ q(0),
+ ],
+ q(lva) => [
+ q(0121),
+ q(0),
+ ],
+ q(mac) => [
+ q(0129),
+ q(1),
+ ],
+ q(maf) => [
+ q(0188),
+ q(1),
+ ],
+ q(mar) => [
+ q(0149),
+ q(0),
+ ],
+ q(mco) => [
+ q(0145),
+ q(0),
+ ],
+ q(mda) => [
+ q(0144),
+ q(1),
+ ],
+ q(mdg) => [
+ q(0131),
+ q(0),
+ ],
+ q(mdv) => [
+ q(0134),
+ q(0),
+ ],
+ q(mex) => [
+ q(0142),
+ q(0),
+ ],
+ q(mhl) => [
+ q(0137),
+ q(0),
+ ],
+ q(mkd) => [
+ q(0130),
+ q(1),
+ ],
+ q(mli) => [
+ q(0135),
+ q(0),
+ ],
+ q(mlt) => [
+ q(0136),
+ q(0),
+ ],
+ q(mmr) => [
+ q(0151),
+ q(0),
+ ],
+ q(mne) => [
+ q(0147),
+ q(0),
+ ],
+ q(mng) => [
+ q(0146),
+ q(0),
+ ],
+ q(mnp) => [
+ q(0164),
+ q(0),
+ ],
+ q(moz) => [
+ q(0150),
+ q(0),
+ ],
+ q(mrt) => [
+ q(0139),
+ q(0),
+ ],
+ q(msr) => [
+ q(0148),
+ q(0),
+ ],
+ q(mtq) => [
+ q(0138),
+ q(0),
+ ],
+ q(mus) => [
+ q(0140),
+ q(0),
+ ],
+ q(mwi) => [
+ q(0132),
+ q(0),
+ ],
+ q(mys) => [
+ q(0133),
+ q(0),
+ ],
+ q(myt) => [
+ q(0141),
+ q(0),
+ ],
+ q(nam) => [
+ q(0152),
+ q(0),
+ ],
+ q(ncl) => [
+ q(0157),
+ q(0),
+ ],
+ q(ner) => [
+ q(0160),
+ q(0),
+ ],
+ q(nfk) => [
+ q(0163),
+ q(0),
+ ],
+ q(nga) => [
+ q(0161),
+ q(0),
+ ],
+ q(nic) => [
+ q(0159),
+ q(0),
+ ],
+ q(niu) => [
+ q(0162),
+ q(0),
+ ],
+ q(nld) => [
+ q(0155),
+ q(0),
+ ],
+ q(nor) => [
+ q(0165),
+ q(0),
+ ],
+ q(npl) => [
+ q(0154),
+ q(0),
+ ],
+ q(nru) => [
+ q(0153),
+ q(0),
+ ],
+ q(nzl) => [
+ q(0158),
+ q(0),
+ ],
+ q(omn) => [
+ q(0166),
+ q(0),
+ ],
+ q(pak) => [
+ q(0167),
+ q(0),
+ ],
+ q(pan) => [
+ q(0170),
+ q(0),
+ ],
+ q(pcn) => [
+ q(0175),
+ q(0),
+ ],
+ q(per) => [
+ q(0173),
+ q(0),
+ ],
+ q(phl) => [
+ q(0174),
+ q(0),
+ ],
+ q(plw) => [
+ q(0168),
+ q(0),
+ ],
+ q(png) => [
+ q(0171),
+ q(0),
+ ],
+ q(pol) => [
+ q(0176),
+ q(0),
+ ],
+ q(pri) => [
+ q(0178),
+ q(0),
+ ],
+ q(prk) => [
+ q(0116),
+ q(1),
+ ],
+ q(prt) => [
+ q(0177),
+ q(0),
+ ],
+ q(pry) => [
+ q(0172),
+ q(0),
+ ],
+ q(pse) => [
+ q(0169),
+ q(1),
+ ],
+ q(pyf) => [
+ q(0076),
+ q(0),
+ ],
+ q(qat) => [
+ q(0179),
+ q(0),
+ ],
+ q(reu) => [
+ q(0180),
+ q(0),
+ ],
+ q(rou) => [
+ q(0181),
+ q(0),
+ ],
+ q(rus) => [
+ q(0182),
+ q(0),
+ ],
+ q(rwa) => [
+ q(0183),
+ q(0),
+ ],
+ q(sau) => [
+ q(0194),
+ q(0),
+ ],
+ q(sdn) => [
+ q(0208),
+ q(0),
+ ],
+ q(sen) => [
+ q(0195),
+ q(0),
+ ],
+ q(sgp) => [
+ q(0199),
+ q(0),
+ ],
+ q(shn) => [
+ q(0185),
+ q(1),
+ ],
+ q(sjm) => [
+ q(0210),
+ q(1),
+ ],
+ q(slb) => [
+ q(0202),
+ q(0),
+ ],
+ q(sle) => [
+ q(0198),
+ q(0),
+ ],
+ q(slv) => [
+ q(0065),
+ q(0),
+ ],
+ q(smr) => [
+ q(0192),
+ q(0),
+ ],
+ q(som) => [
+ q(0203),
+ q(0),
+ ],
+ q(spm) => [
+ q(0189),
+ q(0),
+ ],
+ q(srb) => [
+ q(0196),
+ q(0),
+ ],
+ q(stp) => [
+ q(0193),
+ q(0),
+ ],
+ q(sur) => [
+ q(0209),
+ q(0),
+ ],
+ q(svk) => [
+ q(0200),
+ q(0),
+ ],
+ q(svn) => [
+ q(0201),
+ q(0),
+ ],
+ q(swe) => [
+ q(0212),
+ q(0),
+ ],
+ q(swz) => [
+ q(0211),
+ q(0),
+ ],
+ q(syc) => [
+ q(0197),
+ q(0),
+ ],
+ q(syr) => [
+ q(0214),
+ q(0),
+ ],
+ q(tca) => [
+ q(0227),
+ q(0),
+ ],
+ q(tcd) => [
+ q(0043),
+ q(0),
+ ],
+ q(tgo) => [
+ q(0220),
+ q(0),
+ ],
+ q(tha) => [
+ q(0218),
+ q(0),
+ ],
+ q(tjk) => [
+ q(0216),
+ q(0),
+ ],
+ q(tkl) => [
+ q(0221),
+ q(0),
+ ],
+ q(tkm) => [
+ q(0226),
+ q(0),
+ ],
+ q(tls) => [
+ q(0219),
+ q(0),
+ ],
+ q(ton) => [
+ q(0222),
+ q(0),
+ ],
+ q(tto) => [
+ q(0223),
+ q(0),
+ ],
+ q(tun) => [
+ q(0224),
+ q(0),
+ ],
+ q(tur) => [
+ q(0225),
+ q(0),
+ ],
+ q(tuv) => [
+ q(0228),
+ q(0),
+ ],
+ q(twn) => [
+ q(0215),
+ q(1),
+ ],
+ q(tza) => [
+ q(0217),
+ q(1),
+ ],
+ q(uga) => [
+ q(0229),
+ q(0),
+ ],
+ q(ukr) => [
+ q(0230),
+ q(0),
+ ],
+ q(umi) => [
+ q(0234),
+ q(0),
+ ],
+ q(ury) => [
+ q(0235),
+ q(0),
+ ],
+ q(usa) => [
+ q(0233),
+ q(1),
+ ],
+ q(uzb) => [
+ q(0236),
+ q(0),
+ ],
+ q(vat) => [
+ q(0096),
+ q(1),
+ ],
+ q(vct) => [
+ q(0190),
+ q(0),
+ ],
+ q(ven) => [
+ q(0238),
+ q(1),
+ ],
+ q(vgb) => [
+ q(0240),
+ q(1),
+ ],
+ q(vir) => [
+ q(0241),
+ q(1),
+ ],
+ q(vnm) => [
+ q(0239),
+ q(0),
+ ],
+ q(vut) => [
+ q(0237),
+ q(0),
+ ],
+ q(wlf) => [
+ q(0242),
+ q(1),
+ ],
+ q(wsm) => [
+ q(0191),
+ q(0),
+ ],
+ q(yem) => [
+ q(0244),
+ q(0),
+ ],
+ q(zaf) => [
+ q(0204),
+ q(0),
+ ],
+ q(zmb) => [
+ q(0245),
+ q(0),
+ ],
+ q(zwe) => [
+ q(0246),
+ q(0),
+ ],
+ },
+ q(dom) => {
+ q(AC) => [
+ q(0272),
+ q(0),
+ ],
+ q(AD) => [
+ q(0006),
+ q(0),
+ ],
+ q(AE) => [
+ q(0231),
+ q(0),
+ ],
+ q(AF) => [
+ q(0001),
+ q(0),
+ ],
+ q(AG) => [
+ q(0010),
+ q(0),
+ ],
+ q(AI) => [
+ q(0008),
+ q(0),
+ ],
+ q(AL) => [
+ q(0003),
+ q(0),
+ ],
+ q(AM) => [
+ q(0012),
+ q(0),
+ ],
+ q(AN) => [
+ q(0156),
+ q(0),
+ ],
+ q(AO) => [
+ q(0007),
+ q(0),
+ ],
+ q(AQ) => [
+ q(0009),
+ q(0),
+ ],
+ q(AR) => [
+ q(0011),
+ q(0),
+ ],
+ q(AS) => [
+ q(0005),
+ q(0),
+ ],
+ q(AT) => [
+ q(0015),
+ q(0),
+ ],
+ q(AU) => [
+ q(0014),
+ q(0),
+ ],
+ q(AW) => [
+ q(0013),
+ q(0),
+ ],
+ q(AX) => [
+ q(0002),
+ q(0),
+ ],
+ q(AZ) => [
+ q(0016),
+ q(0),
+ ],
+ q(BA) => [
+ q(0028),
+ q(0),
+ ],
+ q(BB) => [
+ q(0020),
+ q(0),
+ ],
+ q(BD) => [
+ q(0019),
+ q(0),
+ ],
+ q(BE) => [
+ q(0022),
+ q(0),
+ ],
+ q(BF) => [
+ q(0035),
+ q(0),
+ ],
+ q(BG) => [
+ q(0034),
+ q(0),
+ ],
+ q(BH) => [
+ q(0018),
+ q(0),
+ ],
+ q(BI) => [
+ q(0036),
+ q(0),
+ ],
+ q(BJ) => [
+ q(0024),
+ q(0),
+ ],
+ q(BL) => [
+ q(0184),
+ q(0),
+ ],
+ q(BM) => [
+ q(0025),
+ q(0),
+ ],
+ q(BN) => [
+ q(0033),
+ q(0),
+ ],
+ q(BO) => [
+ q(0027),
+ q(2),
+ ],
+ q(BR) => [
+ q(0031),
+ q(0),
+ ],
+ q(BS) => [
+ q(0017),
+ q(0),
+ ],
+ q(BT) => [
+ q(0026),
+ q(0),
+ ],
+ q(BV) => [
+ q(0030),
+ q(0),
+ ],
+ q(BW) => [
+ q(0029),
+ q(0),
+ ],
+ q(BY) => [
+ q(0021),
+ q(0),
+ ],
+ q(BZ) => [
+ q(0023),
+ q(0),
+ ],
+ q(CA) => [
+ q(0039),
+ q(0),
+ ],
+ q(CC) => [
+ q(0047),
+ q(0),
+ ],
+ q(CD) => [
+ q(0051),
+ q(0),
+ ],
+ q(CF) => [
+ q(0042),
+ q(0),
+ ],
+ q(CG) => [
+ q(0050),
+ q(0),
+ ],
+ q(CH) => [
+ q(0213),
+ q(0),
+ ],
+ q(CI) => [
+ q(0054),
+ q(0),
+ ],
+ q(CK) => [
+ q(0052),
+ q(0),
+ ],
+ q(CL) => [
+ q(0044),
+ q(0),
+ ],
+ q(CM) => [
+ q(0038),
+ q(0),
+ ],
+ q(CN) => [
+ q(0045),
+ q(0),
+ ],
+ q(CO) => [
+ q(0048),
+ q(0),
+ ],
+ q(CR) => [
+ q(0053),
+ q(0),
+ ],
+ q(CU) => [
+ q(0056),
+ q(0),
+ ],
+ q(CV) => [
+ q(0040),
+ q(0),
+ ],
+ q(CX) => [
+ q(0046),
+ q(0),
+ ],
+ q(CY) => [
+ q(0057),
+ q(0),
+ ],
+ q(CZ) => [
+ q(0058),
+ q(0),
+ ],
+ q(DE) => [
+ q(0081),
+ q(0),
+ ],
+ q(DJ) => [
+ q(0060),
+ q(0),
+ ],
+ q(DK) => [
+ q(0059),
+ q(0),
+ ],
+ q(DM) => [
+ q(0061),
+ q(0),
+ ],
+ q(DO) => [
+ q(0062),
+ q(0),
+ ],
+ q(DZ) => [
+ q(0004),
+ q(0),
+ ],
+ q(EC) => [
+ q(0063),
+ q(0),
+ ],
+ q(EE) => [
+ q(0068),
+ q(0),
+ ],
+ q(EG) => [
+ q(0064),
+ q(0),
+ ],
+ q(EH) => [
+ q(0243),
+ q(0),
+ ],
+ q(ER) => [
+ q(0067),
+ q(0),
+ ],
+ q(ES) => [
+ q(0206),
+ q(0),
+ ],
+ q(ET) => [
+ q(0069),
+ q(0),
+ ],
+ q(EU) => [
+ q(0273),
+ q(0),
+ ],
+ q(FI) => [
+ q(0073),
+ q(0),
+ ],
+ q(FJ) => [
+ q(0072),
+ q(0),
+ ],
+ q(FK) => [
+ q(0070),
+ q(0),
+ ],
+ q(FM) => [
+ q(0143),
+ q(0),
+ ],
+ q(FO) => [
+ q(0071),
+ q(0),
+ ],
+ q(FR) => [
+ q(0074),
+ q(0),
+ ],
+ q(FX) => [
+ q(0276),
+ q(0),
+ ],
+ q(GA) => [
+ q(0078),
+ q(0),
+ ],
+ q(GB) => [
+ q(0232),
+ q(0),
+ ],
+ q(GD) => [
+ q(0086),
+ q(0),
+ ],
+ q(GE) => [
+ q(0080),
+ q(0),
+ ],
+ q(GF) => [
+ q(0075),
+ q(0),
+ ],
+ q(GG) => [
+ q(0090),
+ q(0),
+ ],
+ q(GH) => [
+ q(0082),
+ q(0),
+ ],
+ q(GI) => [
+ q(0083),
+ q(0),
+ ],
+ q(GL) => [
+ q(0085),
+ q(0),
+ ],
+ q(GM) => [
+ q(0079),
+ q(0),
+ ],
+ q(GN) => [
+ q(0091),
+ q(0),
+ ],
+ q(GP) => [
+ q(0087),
+ q(0),
+ ],
+ q(GQ) => [
+ q(0066),
+ q(0),
+ ],
+ q(GR) => [
+ q(0084),
+ q(0),
+ ],
+ q(GS) => [
+ q(0205),
+ q(0),
+ ],
+ q(GT) => [
+ q(0089),
+ q(0),
+ ],
+ q(GU) => [
+ q(0088),
+ q(0),
+ ],
+ q(GW) => [
+ q(0092),
+ q(0),
+ ],
+ q(GY) => [
+ q(0093),
+ q(0),
+ ],
+ q(HK) => [
+ q(0098),
+ q(0),
+ ],
+ q(HM) => [
+ q(0095),
+ q(0),
+ ],
+ q(HN) => [
+ q(0097),
+ q(0),
+ ],
+ q(HR) => [
+ q(0055),
+ q(0),
+ ],
+ q(HT) => [
+ q(0094),
+ q(0),
+ ],
+ q(HU) => [
+ q(0099),
+ q(0),
+ ],
+ q(ID) => [
+ q(0102),
+ q(0),
+ ],
+ q(IE) => [
+ q(0105),
+ q(0),
+ ],
+ q(IL) => [
+ q(0107),
+ q(0),
+ ],
+ q(IM) => [
+ q(0106),
+ q(0),
+ ],
+ q(IN) => [
+ q(0101),
+ q(0),
+ ],
+ q(IO) => [
+ q(0032),
+ q(0),
+ ],
+ q(IQ) => [
+ q(0104),
+ q(0),
+ ],
+ q(IR) => [
+ q(0103),
+ q(0),
+ ],
+ q(IS) => [
+ q(0100),
+ q(0),
+ ],
+ q(IT) => [
+ q(0108),
+ q(0),
+ ],
+ q(JE) => [
+ q(0111),
+ q(0),
+ ],
+ q(JM) => [
+ q(0109),
+ q(0),
+ ],
+ q(JO) => [
+ q(0112),
+ q(0),
+ ],
+ q(JP) => [
+ q(0110),
+ q(0),
+ ],
+ q(KE) => [
+ q(0114),
+ q(0),
+ ],
+ q(KG) => [
+ q(0119),
+ q(0),
+ ],
+ q(KH) => [
+ q(0037),
+ q(0),
+ ],
+ q(KI) => [
+ q(0115),
+ q(0),
+ ],
+ q(KM) => [
+ q(0049),
+ q(0),
+ ],
+ q(KN) => [
+ q(0186),
+ q(0),
+ ],
+ q(KP) => [
+ q(0116),
+ q(0),
+ ],
+ q(KR) => [
+ q(0117),
+ q(0),
+ ],
+ q(KW) => [
+ q(0118),
+ q(0),
+ ],
+ q(KY) => [
+ q(0041),
+ q(0),
+ ],
+ q(KZ) => [
+ q(0113),
+ q(0),
+ ],
+ q(LA) => [
+ q(0120),
+ q(0),
+ ],
+ q(LB) => [
+ q(0122),
+ q(0),
+ ],
+ q(LC) => [
+ q(0187),
+ q(0),
+ ],
+ q(LI) => [
+ q(0126),
+ q(0),
+ ],
+ q(LK) => [
+ q(0207),
+ q(0),
+ ],
+ q(LR) => [
+ q(0124),
+ q(0),
+ ],
+ q(LS) => [
+ q(0123),
+ q(0),
+ ],
+ q(LT) => [
+ q(0127),
+ q(0),
+ ],
+ q(LU) => [
+ q(0128),
+ q(0),
+ ],
+ q(LV) => [
+ q(0121),
+ q(0),
+ ],
+ q(LY) => [
+ q(0125),
+ q(0),
+ ],
+ q(MA) => [
+ q(0149),
+ q(0),
+ ],
+ q(MC) => [
+ q(0145),
+ q(0),
+ ],
+ q(MD) => [
+ q(0144),
+ q(0),
+ ],
+ q(ME) => [
+ q(0147),
+ q(0),
+ ],
+ q(MF) => [
+ q(0188),
+ q(0),
+ ],
+ q(MG) => [
+ q(0131),
+ q(0),
+ ],
+ q(MH) => [
+ q(0137),
+ q(0),
+ ],
+ q(MK) => [
+ q(0130),
+ q(0),
+ ],
+ q(ML) => [
+ q(0135),
+ q(0),
+ ],
+ q(MM) => [
+ q(0151),
+ q(0),
+ ],
+ q(MN) => [
+ q(0146),
+ q(0),
+ ],
+ q(MO) => [
+ q(0129),
+ q(0),
+ ],
+ q(MP) => [
+ q(0164),
+ q(0),
+ ],
+ q(MQ) => [
+ q(0138),
+ q(0),
+ ],
+ q(MR) => [
+ q(0139),
+ q(0),
+ ],
+ q(MS) => [
+ q(0148),
+ q(0),
+ ],
+ q(MT) => [
+ q(0136),
+ q(0),
+ ],
+ q(MU) => [
+ q(0140),
+ q(0),
+ ],
+ q(MV) => [
+ q(0134),
+ q(0),
+ ],
+ q(MW) => [
+ q(0132),
+ q(0),
+ ],
+ q(MX) => [
+ q(0142),
+ q(0),
+ ],
+ q(MY) => [
+ q(0133),
+ q(0),
+ ],
+ q(MZ) => [
+ q(0150),
+ q(0),
+ ],
+ q(NA) => [
+ q(0152),
+ q(0),
+ ],
+ q(NC) => [
+ q(0157),
+ q(0),
+ ],
+ q(NE) => [
+ q(0160),
+ q(0),
+ ],
+ q(NF) => [
+ q(0163),
+ q(0),
+ ],
+ q(NG) => [
+ q(0161),
+ q(0),
+ ],
+ q(NI) => [
+ q(0159),
+ q(0),
+ ],
+ q(NL) => [
+ q(0155),
+ q(0),
+ ],
+ q(NO) => [
+ q(0165),
+ q(0),
+ ],
+ q(NP) => [
+ q(0154),
+ q(0),
+ ],
+ q(NR) => [
+ q(0153),
+ q(0),
+ ],
+ q(NU) => [
+ q(0162),
+ q(0),
+ ],
+ q(NZ) => [
+ q(0158),
+ q(0),
+ ],
+ q(OM) => [
+ q(0166),
+ q(0),
+ ],
+ q(PA) => [
+ q(0170),
+ q(0),
+ ],
+ q(PE) => [
+ q(0173),
+ q(0),
+ ],
+ q(PF) => [
+ q(0076),
+ q(0),
+ ],
+ q(PG) => [
+ q(0171),
+ q(0),
+ ],
+ q(PH) => [
+ q(0174),
+ q(0),
+ ],
+ q(PK) => [
+ q(0167),
+ q(0),
+ ],
+ q(PL) => [
+ q(0176),
+ q(0),
+ ],
+ q(PM) => [
+ q(0189),
+ q(0),
+ ],
+ q(PN) => [
+ q(0175),
+ q(0),
+ ],
+ q(PR) => [
+ q(0178),
+ q(0),
+ ],
+ q(PS) => [
+ q(0169),
+ q(0),
+ ],
+ q(PT) => [
+ q(0177),
+ q(0),
+ ],
+ q(PW) => [
+ q(0168),
+ q(0),
+ ],
+ q(PY) => [
+ q(0172),
+ q(0),
+ ],
+ q(QA) => [
+ q(0179),
+ q(0),
+ ],
+ q(RE) => [
+ q(0180),
+ q(0),
+ ],
+ q(RO) => [
+ q(0181),
+ q(0),
+ ],
+ q(RS) => [
+ q(0196),
+ q(0),
+ ],
+ q(RU) => [
+ q(0182),
+ q(0),
+ ],
+ q(RW) => [
+ q(0183),
+ q(0),
+ ],
+ q(SA) => [
+ q(0194),
+ q(0),
+ ],
+ q(SB) => [
+ q(0202),
+ q(0),
+ ],
+ q(SC) => [
+ q(0197),
+ q(0),
+ ],
+ q(SD) => [
+ q(0208),
+ q(0),
+ ],
+ q(SE) => [
+ q(0212),
+ q(0),
+ ],
+ q(SG) => [
+ q(0199),
+ q(0),
+ ],
+ q(SH) => [
+ q(0185),
+ q(0),
+ ],
+ q(SI) => [
+ q(0201),
+ q(0),
+ ],
+ q(SJ) => [
+ q(0210),
+ q(0),
+ ],
+ q(SK) => [
+ q(0200),
+ q(0),
+ ],
+ q(SL) => [
+ q(0198),
+ q(0),
+ ],
+ q(SM) => [
+ q(0192),
+ q(0),
+ ],
+ q(SN) => [
+ q(0195),
+ q(0),
+ ],
+ q(SO) => [
+ q(0203),
+ q(0),
+ ],
+ q(SR) => [
+ q(0209),
+ q(0),
+ ],
+ q(ST) => [
+ q(0193),
+ q(0),
+ ],
+ q(SU) => [
+ q(0274),
+ q(0),
+ ],
+ q(SV) => [
+ q(0065),
+ q(0),
+ ],
+ q(SY) => [
+ q(0214),
+ q(0),
+ ],
+ q(SZ) => [
+ q(0211),
+ q(0),
+ ],
+ q(TC) => [
+ q(0227),
+ q(0),
+ ],
+ q(TD) => [
+ q(0043),
+ q(0),
+ ],
+ q(TF) => [
+ q(0077),
+ q(0),
+ ],
+ q(TG) => [
+ q(0220),
+ q(0),
+ ],
+ q(TH) => [
+ q(0218),
+ q(0),
+ ],
+ q(TJ) => [
+ q(0216),
+ q(0),
+ ],
+ q(TK) => [
+ q(0221),
+ q(0),
+ ],
+ q(TL) => [
+ q(0219),
+ q(0),
+ ],
+ q(TM) => [
+ q(0226),
+ q(0),
+ ],
+ q(TN) => [
+ q(0224),
+ q(0),
+ ],
+ q(TO) => [
+ q(0222),
+ q(0),
+ ],
+ q(TP) => [
+ q(0275),
+ q(0),
+ ],
+ q(TR) => [
+ q(0225),
+ q(0),
+ ],
+ q(TT) => [
+ q(0223),
+ q(0),
+ ],
+ q(TV) => [
+ q(0228),
+ q(0),
+ ],
+ q(TW) => [
+ q(0215),
+ q(1),
+ ],
+ q(TZ) => [
+ q(0217),
+ q(0),
+ ],
+ q(UA) => [
+ q(0230),
+ q(0),
+ ],
+ q(UG) => [
+ q(0229),
+ q(0),
+ ],
+ q(UK) => [
+ q(0232),
+ q(0),
+ ],
+ q(UM) => [
+ q(0234),
+ q(0),
+ ],
+ q(US) => [
+ q(0233),
+ q(0),
+ ],
+ q(UY) => [
+ q(0235),
+ q(0),
+ ],
+ q(UZ) => [
+ q(0236),
+ q(0),
+ ],
+ q(VA) => [
+ q(0096),
+ q(0),
+ ],
+ q(VC) => [
+ q(0190),
+ q(0),
+ ],
+ q(VE) => [
+ q(0238),
+ q(0),
+ ],
+ q(VG) => [
+ q(0240),
+ q(0),
+ ],
+ q(VI) => [
+ q(0241),
+ q(0),
+ ],
+ q(VN) => [
+ q(0239),
+ q(0),
+ ],
+ q(VU) => [
+ q(0237),
+ q(0),
+ ],
+ q(WF) => [
+ q(0242),
+ q(0),
+ ],
+ q(WS) => [
+ q(0191),
+ q(0),
+ ],
+ q(YE) => [
+ q(0244),
+ q(0),
+ ],
+ q(YT) => [
+ q(0141),
+ q(0),
+ ],
+ q(ZA) => [
+ q(0204),
+ q(0),
+ ],
+ q(ZM) => [
+ q(0245),
+ q(0),
+ ],
+ q(ZW) => [
+ q(0246),
+ q(0),
+ ],
+ },
+ q(fips) => {
+ q(AA) => [
+ q(0013),
+ q(0),
+ ],
+ q(AC) => [
+ q(0010),
+ q(0),
+ ],
+ q(AE) => [
+ q(0231),
+ q(0),
+ ],
+ q(AF) => [
+ q(0001),
+ q(1),
+ ],
+ q(AG) => [
+ q(0004),
+ q(1),
+ ],
+ q(AJ) => [
+ q(0016),
+ q(1),
+ ],
+ q(AL) => [
+ q(0003),
+ q(1),
+ ],
+ q(AM) => [
+ q(0012),
+ q(1),
+ ],
+ q(AN) => [
+ q(0006),
+ q(1),
+ ],
+ q(AO) => [
+ q(0007),
+ q(1),
+ ],
+ q(AQ) => [
+ q(0005),
+ q(1),
+ ],
+ q(AR) => [
+ q(0011),
+ q(1),
+ ],
+ q(AS) => [
+ q(0014),
+ q(1),
+ ],
+ q(AT) => [
+ q(0249),
+ q(1),
+ ],
+ q(AU) => [
+ q(0015),
+ q(1),
+ ],
+ q(AV) => [
+ q(0008),
+ q(0),
+ ],
+ q(AY) => [
+ q(0009),
+ q(0),
+ ],
+ q(BA) => [
+ q(0018),
+ q(1),
+ ],
+ q(BB) => [
+ q(0020),
+ q(0),
+ ],
+ q(BC) => [
+ q(0029),
+ q(1),
+ ],
+ q(BD) => [
+ q(0025),
+ q(0),
+ ],
+ q(BE) => [
+ q(0022),
+ q(1),
+ ],
+ q(BF) => [
+ q(0017),
+ q(2),
+ ],
+ q(BG) => [
+ q(0019),
+ q(1),
+ ],
+ q(BH) => [
+ q(0023),
+ q(0),
+ ],
+ q(BK) => [
+ q(0028),
+ q(0),
+ ],
+ q(BL) => [
+ q(0027),
+ q(3),
+ ],
+ q(BM) => [
+ q(0151),
+ q(2),
+ ],
+ q(BN) => [
+ q(0024),
+ q(1),
+ ],
+ q(BO) => [
+ q(0021),
+ q(1),
+ ],
+ q(BP) => [
+ q(0202),
+ q(0),
+ ],
+ q(BQ) => [
+ q(0264),
+ q(0),
+ ],
+ q(BR) => [
+ q(0031),
+ q(1),
+ ],
+ q(BS) => [
+ q(0251),
+ q(0),
+ ],
+ q(BT) => [
+ q(0026),
+ q(1),
+ ],
+ q(BU) => [
+ q(0034),
+ q(0),
+ ],
+ q(BV) => [
+ q(0030),
+ q(0),
+ ],
+ q(BX) => [
+ q(0033),
+ q(2),
+ ],
+ q(BY) => [
+ q(0036),
+ q(1),
+ ],
+ q(CA) => [
+ q(0039),
+ q(0),
+ ],
+ q(CB) => [
+ q(0037),
+ q(1),
+ ],
+ q(CD) => [
+ q(0043),
+ q(1),
+ ],
+ q(CE) => [
+ q(0207),
+ q(1),
+ ],
+ q(CF) => [
+ q(0050),
+ q(2),
+ ],
+ q(CG) => [
+ q(0051),
+ q(2),
+ ],
+ q(CH) => [
+ q(0045),
+ q(1),
+ ],
+ q(CI) => [
+ q(0044),
+ q(1),
+ ],
+ q(CJ) => [
+ q(0041),
+ q(0),
+ ],
+ q(CK) => [
+ q(0047),
+ q(1),
+ ],
+ q(CM) => [
+ q(0038),
+ q(1),
+ ],
+ q(CN) => [
+ q(0049),
+ q(1),
+ ],
+ q(CO) => [
+ q(0048),
+ q(1),
+ ],
+ q(CQ) => [
+ q(0164),
+ q(1),
+ ],
+ q(CR) => [
+ q(0253),
+ q(1),
+ ],
+ q(CS) => [
+ q(0053),
+ q(1),
+ ],
+ q(CT) => [
+ q(0042),
+ q(0),
+ ],
+ q(CU) => [
+ q(0056),
+ q(1),
+ ],
+ q(CV) => [
+ q(0040),
+ q(1),
+ ],
+ q(CW) => [
+ q(0052),
+ q(0),
+ ],
+ q(CY) => [
+ q(0057),
+ q(1),
+ ],
+ q(DA) => [
+ q(0059),
+ q(1),
+ ],
+ q(DJ) => [
+ q(0060),
+ q(1),
+ ],
+ q(DO) => [
+ q(0061),
+ q(1),
+ ],
+ q(DQ) => [
+ q(0259),
+ q(0),
+ ],
+ q(DR) => [
+ q(0062),
+ q(0),
+ ],
+ q(EC) => [
+ q(0063),
+ q(1),
+ ],
+ q(EG) => [
+ q(0064),
+ q(1),
+ ],
+ q(EI) => [
+ q(0105),
+ q(0),
+ ],
+ q(EK) => [
+ q(0066),
+ q(1),
+ ],
+ q(EN) => [
+ q(0068),
+ q(1),
+ ],
+ q(ER) => [
+ q(0067),
+ q(1),
+ ],
+ q(ES) => [
+ q(0065),
+ q(1),
+ ],
+ q(ET) => [
+ q(0069),
+ q(1),
+ ],
+ q(EU) => [
+ q(0254),
+ q(0),
+ ],
+ q(EZ) => [
+ q(0058),
+ q(0),
+ ],
+ q(FG) => [
+ q(0075),
+ q(1),
+ ],
+ q(FI) => [
+ q(0073),
+ q(1),
+ ],
+ q(FJ) => [
+ q(0072),
+ q(1),
+ ],
+ q(FK) => [
+ q(0070),
+ q(1),
+ ],
+ q(FM) => [
+ q(0143),
+ q(2),
+ ],
+ q(FO) => [
+ q(0071),
+ q(0),
+ ],
+ q(FP) => [
+ q(0076),
+ q(1),
+ ],
+ q(FQ) => [
+ q(0250),
+ q(0),
+ ],
+ q(FR) => [
+ q(0074),
+ q(1),
+ ],
+ q(FS) => [
+ q(0077),
+ q(2),
+ ],
+ q(GA) => [
+ q(0079),
+ q(2),
+ ],
+ q(GB) => [
+ q(0078),
+ q(1),
+ ],
+ q(GG) => [
+ q(0080),
+ q(0),
+ ],
+ q(GH) => [
+ q(0082),
+ q(1),
+ ],
+ q(GI) => [
+ q(0083),
+ q(0),
+ ],
+ q(GJ) => [
+ q(0086),
+ q(0),
+ ],
+ q(GK) => [
+ q(0090),
+ q(1),
+ ],
+ q(GL) => [
+ q(0085),
+ q(0),
+ ],
+ q(GM) => [
+ q(0081),
+ q(1),
+ ],
+ q(GO) => [
+ q(0256),
+ q(0),
+ ],
+ q(GP) => [
+ q(0087),
+ q(1),
+ ],
+ q(GQ) => [
+ q(0088),
+ q(1),
+ ],
+ q(GR) => [
+ q(0084),
+ q(1),
+ ],
+ q(GT) => [
+ q(0089),
+ q(1),
+ ],
+ q(GV) => [
+ q(0091),
+ q(1),
+ ],
+ q(GY) => [
+ q(0093),
+ q(1),
+ ],
+ q(GZ) => [
+ q(0255),
+ q(0),
+ ],
+ q(HA) => [
+ q(0094),
+ q(1),
+ ],
+ q(HK) => [
+ q(0098),
+ q(3),
+ ],
+ q(HM) => [
+ q(0095),
+ q(1),
+ ],
+ q(HO) => [
+ q(0097),
+ q(1),
+ ],
+ q(HQ) => [
+ q(0257),
+ q(0),
+ ],
+ q(HR) => [
+ q(0055),
+ q(1),
+ ],
+ q(HU) => [
+ q(0099),
+ q(1),
+ ],
+ q(IC) => [
+ q(0100),
+ q(1),
+ ],
+ q(ID) => [
+ q(0102),
+ q(1),
+ ],
+ q(IM) => [
+ q(0106),
+ q(0),
+ ],
+ q(IN) => [
+ q(0101),
+ q(1),
+ ],
+ q(IO) => [
+ q(0032),
+ q(0),
+ ],
+ q(IP) => [
+ q(0252),
+ q(0),
+ ],
+ q(IR) => [
+ q(0103),
+ q(3),
+ ],
+ q(IS) => [
+ q(0107),
+ q(1),
+ ],
+ q(IT) => [
+ q(0108),
+ q(1),
+ ],
+ q(IV) => [
+ q(0054),
+ q(1),
+ ],
+ q(IZ) => [
+ q(0104),
+ q(1),
+ ],
+ q(JA) => [
+ q(0110),
+ q(0),
+ ],
+ q(JE) => [
+ q(0111),
+ q(1),
+ ],
+ q(JM) => [
+ q(0109),
+ q(0),
+ ],
+ q(JN) => [
+ q(0258),
+ q(0),
+ ],
+ q(JO) => [
+ q(0112),
+ q(1),
+ ],
+ q(JQ) => [
+ q(0260),
+ q(0),
+ ],
+ q(JU) => [
+ q(0261),
+ q(0),
+ ],
+ q(KE) => [
+ q(0114),
+ q(1),
+ ],
+ q(KG) => [
+ q(0119),
+ q(1),
+ ],
+ q(KN) => [
+ q(0116),
+ q(2),
+ ],
+ q(KQ) => [
+ q(0262),
+ q(0),
+ ],
+ q(KR) => [
+ q(0115),
+ q(1),
+ ],
+ q(KS) => [
+ q(0117),
+ q(2),
+ ],
+ q(KT) => [
+ q(0046),
+ q(1),
+ ],
+ q(KU) => [
+ q(0118),
+ q(1),
+ ],
+ q(KV) => [
+ q(0277),
+ q(0),
+ ],
+ q(KZ) => [
+ q(0113),
+ q(1),
+ ],
+ q(LA) => [
+ q(0120),
+ q(1),
+ ],
+ q(LE) => [
+ q(0122),
+ q(1),
+ ],
+ q(LG) => [
+ q(0121),
+ q(1),
+ ],
+ q(LH) => [
+ q(0127),
+ q(1),
+ ],
+ q(LI) => [
+ q(0124),
+ q(1),
+ ],
+ q(LO) => [
+ q(0200),
+ q(1),
+ ],
+ q(LQ) => [
+ q(0265),
+ q(0),
+ ],
+ q(LS) => [
+ q(0126),
+ q(1),
+ ],
+ q(LT) => [
+ q(0123),
+ q(1),
+ ],
+ q(LU) => [
+ q(0128),
+ q(1),
+ ],
+ q(LY) => [
+ q(0125),
+ q(2),
+ ],
+ q(MA) => [
+ q(0131),
+ q(1),
+ ],
+ q(MB) => [
+ q(0138),
+ q(1),
+ ],
+ q(MC) => [
+ q(0129),
+ q(3),
+ ],
+ q(MD) => [
+ q(0144),
+ q(2),
+ ],
+ q(MF) => [
+ q(0141),
+ q(1),
+ ],
+ q(MG) => [
+ q(0146),
+ q(0),
+ ],
+ q(MH) => [
+ q(0148),
+ q(0),
+ ],
+ q(MI) => [
+ q(0132),
+ q(1),
+ ],
+ q(MJ) => [
+ q(0147),
+ q(0),
+ ],
+ q(MK) => [
+ q(0130),
+ q(3),
+ ],
+ q(ML) => [
+ q(0135),
+ q(1),
+ ],
+ q(MN) => [
+ q(0145),
+ q(1),
+ ],
+ q(MO) => [
+ q(0149),
+ q(1),
+ ],
+ q(MP) => [
+ q(0140),
+ q(1),
+ ],
+ q(MQ) => [
+ q(0263),
+ q(0),
+ ],
+ q(MR) => [
+ q(0139),
+ q(1),
+ ],
+ q(MT) => [
+ q(0136),
+ q(1),
+ ],
+ q(MU) => [
+ q(0166),
+ q(1),
+ ],
+ q(MV) => [
+ q(0134),
+ q(1),
+ ],
+ q(MX) => [
+ q(0142),
+ q(1),
+ ],
+ q(MY) => [
+ q(0133),
+ q(0),
+ ],
+ q(MZ) => [
+ q(0150),
+ q(1),
+ ],
+ q(NC) => [
+ q(0157),
+ q(1),
+ ],
+ q(NE) => [
+ q(0162),
+ q(0),
+ ],
+ q(NF) => [
+ q(0163),
+ q(1),
+ ],
+ q(NG) => [
+ q(0160),
+ q(1),
+ ],
+ q(NH) => [
+ q(0237),
+ q(1),
+ ],
+ q(NI) => [
+ q(0161),
+ q(1),
+ ],
+ q(NL) => [
+ q(0155),
+ q(1),
+ ],
+ q(NO) => [
+ q(0165),
+ q(1),
+ ],
+ q(NP) => [
+ q(0154),
+ q(1),
+ ],
+ q(NR) => [
+ q(0153),
+ q(1),
+ ],
+ q(NS) => [
+ q(0209),
+ q(1),
+ ],
+ q(NT) => [
+ q(0156),
+ q(0),
+ ],
+ q(NU) => [
+ q(0159),
+ q(1),
+ ],
+ q(NZ) => [
+ q(0158),
+ q(0),
+ ],
+ q(PA) => [
+ q(0172),
+ q(1),
+ ],
+ q(PC) => [
+ q(0175),
+ q(2),
+ ],
+ q(PE) => [
+ q(0173),
+ q(1),
+ ],
+ q(PF) => [
+ q(0266),
+ q(0),
+ ],
+ q(PG) => [
+ q(0267),
+ q(0),
+ ],
+ q(PK) => [
+ q(0167),
+ q(1),
+ ],
+ q(PL) => [
+ q(0176),
+ q(1),
+ ],
+ q(PM) => [
+ q(0170),
+ q(1),
+ ],
+ q(PO) => [
+ q(0177),
+ q(1),
+ ],
+ q(PP) => [
+ q(0171),
+ q(1),
+ ],
+ q(PS) => [
+ q(0168),
+ q(1),
+ ],
+ q(PU) => [
+ q(0092),
+ q(1),
+ ],
+ q(QA) => [
+ q(0179),
+ q(1),
+ ],
+ q(RE) => [
+ q(0180),
+ q(1),
+ ],
+ q(RI) => [
+ q(0196),
+ q(0),
+ ],
+ q(RM) => [
+ q(0137),
+ q(1),
+ ],
+ q(RN) => [
+ q(0188),
+ q(0),
+ ],
+ q(RO) => [
+ q(0181),
+ q(0),
+ ],
+ q(RP) => [
+ q(0174),
+ q(1),
+ ],
+ q(RQ) => [
+ q(0178),
+ q(1),
+ ],
+ q(RS) => [
+ q(0182),
+ q(1),
+ ],
+ q(RW) => [
+ q(0183),
+ q(1),
+ ],
+ q(SA) => [
+ q(0194),
+ q(1),
+ ],
+ q(SB) => [
+ q(0189),
+ q(1),
+ ],
+ q(SC) => [
+ q(0186),
+ q(1),
+ ],
+ q(SE) => [
+ q(0197),
+ q(1),
+ ],
+ q(SF) => [
+ q(0204),
+ q(1),
+ ],
+ q(SG) => [
+ q(0195),
+ q(1),
+ ],
+ q(SH) => [
+ q(0185),
+ q(1),
+ ],
+ q(SI) => [
+ q(0201),
+ q(1),
+ ],
+ q(SL) => [
+ q(0198),
+ q(1),
+ ],
+ q(SM) => [
+ q(0192),
+ q(1),
+ ],
+ q(SN) => [
+ q(0199),
+ q(1),
+ ],
+ q(SO) => [
+ q(0203),
+ q(0),
+ ],
+ q(SP) => [
+ q(0206),
+ q(1),
+ ],
+ q(ST) => [
+ q(0187),
+ q(0),
+ ],
+ q(SU) => [
+ q(0208),
+ q(1),
+ ],
+ q(SV) => [
+ q(0268),
+ q(0),
+ ],
+ q(SW) => [
+ q(0212),
+ q(1),
+ ],
+ q(SX) => [
+ q(0205),
+ q(0),
+ ],
+ q(SY) => [
+ q(0214),
+ q(1),
+ ],
+ q(SZ) => [
+ q(0213),
+ q(1),
+ ],
+ q(TB) => [
+ q(0184),
+ q(0),
+ ],
+ q(TD) => [
+ q(0223),
+ q(1),
+ ],
+ q(TE) => [
+ q(0269),
+ q(0),
+ ],
+ q(TH) => [
+ q(0218),
+ q(1),
+ ],
+ q(TI) => [
+ q(0216),
+ q(1),
+ ],
+ q(TK) => [
+ q(0227),
+ q(0),
+ ],
+ q(TL) => [
+ q(0221),
+ q(0),
+ ],
+ q(TN) => [
+ q(0222),
+ q(1),
+ ],
+ q(TO) => [
+ q(0220),
+ q(1),
+ ],
+ q(TP) => [
+ q(0193),
+ q(1),
+ ],
+ q(TS) => [
+ q(0224),
+ q(1),
+ ],
+ q(TT) => [
+ q(0219),
+ q(1),
+ ],
+ q(TU) => [
+ q(0225),
+ q(1),
+ ],
+ q(TV) => [
+ q(0228),
+ q(0),
+ ],
+ q(TW) => [
+ q(0215),
+ q(1),
+ ],
+ q(TX) => [
+ q(0226),
+ q(0),
+ ],
+ q(TZ) => [
+ q(0217),
+ q(2),
+ ],
+ q(UG) => [
+ q(0229),
+ q(0),
+ ],
+ q(UK) => [
+ q(0232),
+ q(0),
+ ],
+ q(UP) => [
+ q(0230),
+ q(0),
+ ],
+ q(US) => [
+ q(0233),
+ q(0),
+ ],
+ q(UV) => [
+ q(0035),
+ q(0),
+ ],
+ q(UY) => [
+ q(0235),
+ q(1),
+ ],
+ q(UZ) => [
+ q(0236),
+ q(1),
+ ],
+ q(VC) => [
+ q(0190),
+ q(0),
+ ],
+ q(VE) => [
+ q(0238),
+ q(3),
+ ],
+ q(VI) => [
+ q(0240),
+ q(1),
+ ],
+ q(VM) => [
+ q(0239),
+ q(2),
+ ],
+ q(VQ) => [
+ q(0241),
+ q(3),
+ ],
+ q(VT) => [
+ q(0096),
+ q(3),
+ ],
+ q(WA) => [
+ q(0152),
+ q(1),
+ ],
+ q(WE) => [
+ q(0271),
+ q(0),
+ ],
+ q(WF) => [
+ q(0242),
+ q(2),
+ ],
+ q(WI) => [
+ q(0243),
+ q(0),
+ ],
+ q(WQ) => [
+ q(0270),
+ q(0),
+ ],
+ q(WS) => [
+ q(0191),
+ q(1),
+ ],
+ q(WZ) => [
+ q(0211),
+ q(1),
+ ],
+ q(YI) => [
+ q(0248),
+ q(0),
+ ],
+ q(YM) => [
+ q(0244),
+ q(1),
+ ],
+ q(ZA) => [
+ q(0245),
+ q(1),
+ ],
+ q(ZI) => [
+ q(0246),
+ q(1),
+ ],
+ },
+ q(num) => {
+ q(004) => [
+ q(0001),
+ q(0),
+ ],
+ q(008) => [
+ q(0003),
+ q(0),
+ ],
+ q(010) => [
+ q(0009),
+ q(0),
+ ],
+ q(012) => [
+ q(0004),
+ q(0),
+ ],
+ q(016) => [
+ q(0005),
+ q(0),
+ ],
+ q(020) => [
+ q(0006),
+ q(0),
+ ],
+ q(024) => [
+ q(0007),
+ q(0),
+ ],
+ q(028) => [
+ q(0010),
+ q(0),
+ ],
+ q(031) => [
+ q(0016),
+ q(0),
+ ],
+ q(032) => [
+ q(0011),
+ q(0),
+ ],
+ q(036) => [
+ q(0014),
+ q(0),
+ ],
+ q(040) => [
+ q(0015),
+ q(0),
+ ],
+ q(044) => [
+ q(0017),
+ q(0),
+ ],
+ q(048) => [
+ q(0018),
+ q(0),
+ ],
+ q(050) => [
+ q(0019),
+ q(0),
+ ],
+ q(051) => [
+ q(0012),
+ q(0),
+ ],
+ q(052) => [
+ q(0020),
+ q(0),
+ ],
+ q(056) => [
+ q(0022),
+ q(0),
+ ],
+ q(060) => [
+ q(0025),
+ q(0),
+ ],
+ q(064) => [
+ q(0026),
+ q(0),
+ ],
+ q(068) => [
+ q(0027),
+ q(1),
+ ],
+ q(070) => [
+ q(0028),
+ q(0),
+ ],
+ q(072) => [
+ q(0029),
+ q(0),
+ ],
+ q(074) => [
+ q(0030),
+ q(0),
+ ],
+ q(076) => [
+ q(0031),
+ q(0),
+ ],
+ q(084) => [
+ q(0023),
+ q(0),
+ ],
+ q(086) => [
+ q(0032),
+ q(0),
+ ],
+ q(090) => [
+ q(0202),
+ q(0),
+ ],
+ q(092) => [
+ q(0240),
+ q(1),
+ ],
+ q(096) => [
+ q(0033),
+ q(0),
+ ],
+ q(100) => [
+ q(0034),
+ q(0),
+ ],
+ q(104) => [
+ q(0151),
+ q(0),
+ ],
+ q(108) => [
+ q(0036),
+ q(0),
+ ],
+ q(112) => [
+ q(0021),
+ q(0),
+ ],
+ q(116) => [
+ q(0037),
+ q(0),
+ ],
+ q(120) => [
+ q(0038),
+ q(0),
+ ],
+ q(124) => [
+ q(0039),
+ q(0),
+ ],
+ q(132) => [
+ q(0040),
+ q(0),
+ ],
+ q(136) => [
+ q(0041),
+ q(0),
+ ],
+ q(140) => [
+ q(0042),
+ q(0),
+ ],
+ q(144) => [
+ q(0207),
+ q(0),
+ ],
+ q(148) => [
+ q(0043),
+ q(0),
+ ],
+ q(152) => [
+ q(0044),
+ q(0),
+ ],
+ q(156) => [
+ q(0045),
+ q(0),
+ ],
+ q(158) => [
+ q(0215),
+ q(1),
+ ],
+ q(162) => [
+ q(0046),
+ q(0),
+ ],
+ q(166) => [
+ q(0047),
+ q(0),
+ ],
+ q(170) => [
+ q(0048),
+ q(0),
+ ],
+ q(174) => [
+ q(0049),
+ q(0),
+ ],
+ q(175) => [
+ q(0141),
+ q(0),
+ ],
+ q(178) => [
+ q(0050),
+ q(0),
+ ],
+ q(180) => [
+ q(0051),
+ q(1),
+ ],
+ q(184) => [
+ q(0052),
+ q(0),
+ ],
+ q(188) => [
+ q(0053),
+ q(0),
+ ],
+ q(191) => [
+ q(0055),
+ q(0),
+ ],
+ q(192) => [
+ q(0056),
+ q(0),
+ ],
+ q(196) => [
+ q(0057),
+ q(0),
+ ],
+ q(203) => [
+ q(0058),
+ q(0),
+ ],
+ q(204) => [
+ q(0024),
+ q(0),
+ ],
+ q(208) => [
+ q(0059),
+ q(0),
+ ],
+ q(212) => [
+ q(0061),
+ q(0),
+ ],
+ q(214) => [
+ q(0062),
+ q(0),
+ ],
+ q(218) => [
+ q(0063),
+ q(0),
+ ],
+ q(222) => [
+ q(0065),
+ q(0),
+ ],
+ q(226) => [
+ q(0066),
+ q(0),
+ ],
+ q(231) => [
+ q(0069),
+ q(0),
+ ],
+ q(232) => [
+ q(0067),
+ q(0),
+ ],
+ q(233) => [
+ q(0068),
+ q(0),
+ ],
+ q(234) => [
+ q(0071),
+ q(1),
+ ],
+ q(238) => [
+ q(0070),
+ q(0),
+ ],
+ q(242) => [
+ q(0072),
+ q(0),
+ ],
+ q(246) => [
+ q(0073),
+ q(0),
+ ],
+ q(248) => [
+ q(0002),
+ q(0),
+ ],
+ q(249) => [
+ q(0276),
+ q(0),
+ ],
+ q(250) => [
+ q(0074),
+ q(0),
+ ],
+ q(254) => [
+ q(0075),
+ q(0),
+ ],
+ q(258) => [
+ q(0076),
+ q(0),
+ ],
+ q(260) => [
+ q(0077),
+ q(1),
+ ],
+ q(262) => [
+ q(0060),
+ q(0),
+ ],
+ q(266) => [
+ q(0078),
+ q(0),
+ ],
+ q(268) => [
+ q(0080),
+ q(0),
+ ],
+ q(270) => [
+ q(0079),
+ q(0),
+ ],
+ q(275) => [
+ q(0169),
+ q(1),
+ ],
+ q(276) => [
+ q(0081),
+ q(0),
+ ],
+ q(288) => [
+ q(0082),
+ q(0),
+ ],
+ q(292) => [
+ q(0083),
+ q(0),
+ ],
+ q(296) => [
+ q(0115),
+ q(0),
+ ],
+ q(300) => [
+ q(0084),
+ q(0),
+ ],
+ q(304) => [
+ q(0085),
+ q(0),
+ ],
+ q(308) => [
+ q(0086),
+ q(0),
+ ],
+ q(312) => [
+ q(0087),
+ q(0),
+ ],
+ q(316) => [
+ q(0088),
+ q(0),
+ ],
+ q(320) => [
+ q(0089),
+ q(0),
+ ],
+ q(324) => [
+ q(0091),
+ q(0),
+ ],
+ q(328) => [
+ q(0093),
+ q(0),
+ ],
+ q(332) => [
+ q(0094),
+ q(0),
+ ],
+ q(334) => [
+ q(0095),
+ q(0),
+ ],
+ q(336) => [
+ q(0096),
+ q(1),
+ ],
+ q(340) => [
+ q(0097),
+ q(0),
+ ],
+ q(344) => [
+ q(0098),
+ q(1),
+ ],
+ q(348) => [
+ q(0099),
+ q(0),
+ ],
+ q(352) => [
+ q(0100),
+ q(0),
+ ],
+ q(356) => [
+ q(0101),
+ q(0),
+ ],
+ q(360) => [
+ q(0102),
+ q(0),
+ ],
+ q(364) => [
+ q(0103),
+ q(1),
+ ],
+ q(368) => [
+ q(0104),
+ q(0),
+ ],
+ q(372) => [
+ q(0105),
+ q(0),
+ ],
+ q(376) => [
+ q(0107),
+ q(0),
+ ],
+ q(380) => [
+ q(0108),
+ q(0),
+ ],
+ q(384) => [
+ q(0054),
+ q(0),
+ ],
+ q(388) => [
+ q(0109),
+ q(0),
+ ],
+ q(392) => [
+ q(0110),
+ q(0),
+ ],
+ q(398) => [
+ q(0113),
+ q(0),
+ ],
+ q(400) => [
+ q(0112),
+ q(0),
+ ],
+ q(404) => [
+ q(0114),
+ q(0),
+ ],
+ q(408) => [
+ q(0116),
+ q(1),
+ ],
+ q(410) => [
+ q(0117),
+ q(1),
+ ],
+ q(414) => [
+ q(0118),
+ q(0),
+ ],
+ q(417) => [
+ q(0119),
+ q(0),
+ ],
+ q(418) => [
+ q(0120),
+ q(0),
+ ],
+ q(422) => [
+ q(0122),
+ q(0),
+ ],
+ q(426) => [
+ q(0123),
+ q(0),
+ ],
+ q(428) => [
+ q(0121),
+ q(0),
+ ],
+ q(430) => [
+ q(0124),
+ q(0),
+ ],
+ q(434) => [
+ q(0125),
+ q(0),
+ ],
+ q(438) => [
+ q(0126),
+ q(0),
+ ],
+ q(440) => [
+ q(0127),
+ q(0),
+ ],
+ q(442) => [
+ q(0128),
+ q(0),
+ ],
+ q(446) => [
+ q(0129),
+ q(1),
+ ],
+ q(450) => [
+ q(0131),
+ q(0),
+ ],
+ q(454) => [
+ q(0132),
+ q(0),
+ ],
+ q(458) => [
+ q(0133),
+ q(0),
+ ],
+ q(462) => [
+ q(0134),
+ q(0),
+ ],
+ q(466) => [
+ q(0135),
+ q(0),
+ ],
+ q(470) => [
+ q(0136),
+ q(0),
+ ],
+ q(474) => [
+ q(0138),
+ q(0),
+ ],
+ q(478) => [
+ q(0139),
+ q(0),
+ ],
+ q(480) => [
+ q(0140),
+ q(0),
+ ],
+ q(484) => [
+ q(0142),
+ q(0),
+ ],
+ q(492) => [
+ q(0145),
+ q(0),
+ ],
+ q(496) => [
+ q(0146),
+ q(0),
+ ],
+ q(498) => [
+ q(0144),
+ q(1),
+ ],
+ q(499) => [
+ q(0147),
+ q(0),
+ ],
+ q(500) => [
+ q(0148),
+ q(0),
+ ],
+ q(504) => [
+ q(0149),
+ q(0),
+ ],
+ q(508) => [
+ q(0150),
+ q(0),
+ ],
+ q(512) => [
+ q(0166),
+ q(0),
+ ],
+ q(516) => [
+ q(0152),
+ q(0),
+ ],
+ q(520) => [
+ q(0153),
+ q(0),
+ ],
+ q(524) => [
+ q(0154),
+ q(0),
+ ],
+ q(528) => [
+ q(0155),
+ q(0),
+ ],
+ q(530) => [
+ q(0156),
+ q(0),
+ ],
+ q(533) => [
+ q(0013),
+ q(0),
+ ],
+ q(540) => [
+ q(0157),
+ q(0),
+ ],
+ q(548) => [
+ q(0237),
+ q(0),
+ ],
+ q(554) => [
+ q(0158),
+ q(0),
+ ],
+ q(558) => [
+ q(0159),
+ q(0),
+ ],
+ q(562) => [
+ q(0160),
+ q(0),
+ ],
+ q(566) => [
+ q(0161),
+ q(0),
+ ],
+ q(570) => [
+ q(0162),
+ q(0),
+ ],
+ q(574) => [
+ q(0163),
+ q(0),
+ ],
+ q(578) => [
+ q(0165),
+ q(0),
+ ],
+ q(580) => [
+ q(0164),
+ q(0),
+ ],
+ q(581) => [
+ q(0234),
+ q(0),
+ ],
+ q(583) => [
+ q(0143),
+ q(1),
+ ],
+ q(584) => [
+ q(0137),
+ q(0),
+ ],
+ q(585) => [
+ q(0168),
+ q(0),
+ ],
+ q(586) => [
+ q(0167),
+ q(0),
+ ],
+ q(591) => [
+ q(0170),
+ q(0),
+ ],
+ q(598) => [
+ q(0171),
+ q(0),
+ ],
+ q(600) => [
+ q(0172),
+ q(0),
+ ],
+ q(604) => [
+ q(0173),
+ q(0),
+ ],
+ q(608) => [
+ q(0174),
+ q(0),
+ ],
+ q(612) => [
+ q(0175),
+ q(0),
+ ],
+ q(616) => [
+ q(0176),
+ q(0),
+ ],
+ q(620) => [
+ q(0177),
+ q(0),
+ ],
+ q(624) => [
+ q(0092),
+ q(0),
+ ],
+ q(626) => [
+ q(0219),
+ q(0),
+ ],
+ q(630) => [
+ q(0178),
+ q(0),
+ ],
+ q(634) => [
+ q(0179),
+ q(0),
+ ],
+ q(638) => [
+ q(0180),
+ q(0),
+ ],
+ q(642) => [
+ q(0181),
+ q(0),
+ ],
+ q(643) => [
+ q(0182),
+ q(0),
+ ],
+ q(646) => [
+ q(0183),
+ q(0),
+ ],
+ q(652) => [
+ q(0184),
+ q(1),
+ ],
+ q(654) => [
+ q(0185),
+ q(1),
+ ],
+ q(659) => [
+ q(0186),
+ q(0),
+ ],
+ q(660) => [
+ q(0008),
+ q(0),
+ ],
+ q(662) => [
+ q(0187),
+ q(0),
+ ],
+ q(663) => [
+ q(0188),
+ q(1),
+ ],
+ q(666) => [
+ q(0189),
+ q(0),
+ ],
+ q(670) => [
+ q(0190),
+ q(0),
+ ],
+ q(674) => [
+ q(0192),
+ q(0),
+ ],
+ q(678) => [
+ q(0193),
+ q(0),
+ ],
+ q(682) => [
+ q(0194),
+ q(0),
+ ],
+ q(686) => [
+ q(0195),
+ q(0),
+ ],
+ q(688) => [
+ q(0196),
+ q(0),
+ ],
+ q(690) => [
+ q(0197),
+ q(0),
+ ],
+ q(694) => [
+ q(0198),
+ q(0),
+ ],
+ q(702) => [
+ q(0199),
+ q(0),
+ ],
+ q(703) => [
+ q(0200),
+ q(0),
+ ],
+ q(704) => [
+ q(0239),
+ q(0),
+ ],
+ q(705) => [
+ q(0201),
+ q(0),
+ ],
+ q(706) => [
+ q(0203),
+ q(0),
+ ],
+ q(710) => [
+ q(0204),
+ q(0),
+ ],
+ q(716) => [
+ q(0246),
+ q(0),
+ ],
+ q(724) => [
+ q(0206),
+ q(0),
+ ],
+ q(732) => [
+ q(0243),
+ q(0),
+ ],
+ q(736) => [
+ q(0208),
+ q(0),
+ ],
+ q(740) => [
+ q(0209),
+ q(0),
+ ],
+ q(744) => [
+ q(0210),
+ q(1),
+ ],
+ q(748) => [
+ q(0211),
+ q(0),
+ ],
+ q(752) => [
+ q(0212),
+ q(0),
+ ],
+ q(756) => [
+ q(0213),
+ q(0),
+ ],
+ q(760) => [
+ q(0214),
+ q(0),
+ ],
+ q(762) => [
+ q(0216),
+ q(0),
+ ],
+ q(764) => [
+ q(0218),
+ q(0),
+ ],
+ q(768) => [
+ q(0220),
+ q(0),
+ ],
+ q(772) => [
+ q(0221),
+ q(0),
+ ],
+ q(776) => [
+ q(0222),
+ q(0),
+ ],
+ q(780) => [
+ q(0223),
+ q(0),
+ ],
+ q(784) => [
+ q(0231),
+ q(0),
+ ],
+ q(788) => [
+ q(0224),
+ q(0),
+ ],
+ q(792) => [
+ q(0225),
+ q(0),
+ ],
+ q(795) => [
+ q(0226),
+ q(0),
+ ],
+ q(796) => [
+ q(0227),
+ q(0),
+ ],
+ q(798) => [
+ q(0228),
+ q(0),
+ ],
+ q(800) => [
+ q(0229),
+ q(0),
+ ],
+ q(804) => [
+ q(0230),
+ q(0),
+ ],
+ q(807) => [
+ q(0130),
+ q(1),
+ ],
+ q(818) => [
+ q(0064),
+ q(0),
+ ],
+ q(826) => [
+ q(0232),
+ q(1),
+ ],
+ q(830) => [
+ q(0247),
+ q(0),
+ ],
+ q(831) => [
+ q(0090),
+ q(0),
+ ],
+ q(832) => [
+ q(0111),
+ q(0),
+ ],
+ q(833) => [
+ q(0106),
+ q(0),
+ ],
+ q(834) => [
+ q(0217),
+ q(1),
+ ],
+ q(840) => [
+ q(0233),
+ q(1),
+ ],
+ q(850) => [
+ q(0241),
+ q(1),
+ ],
+ q(854) => [
+ q(0035),
+ q(0),
+ ],
+ q(858) => [
+ q(0235),
+ q(0),
+ ],
+ q(860) => [
+ q(0236),
+ q(0),
+ ],
+ q(862) => [
+ q(0238),
+ q(1),
+ ],
+ q(876) => [
+ q(0242),
+ q(1),
+ ],
+ q(882) => [
+ q(0191),
+ q(0),
+ ],
+ q(887) => [
+ q(0244),
+ q(0),
+ ],
+ q(894) => [
+ q(0245),
+ q(0),
+ ],
+ },
+};
+
+$Locale::Codes::Data{'country'}{'id2code'} = {
+ q(alpha2) => {
+ q(0001) => q(af),
+ q(0002) => q(ax),
+ q(0003) => q(al),
+ q(0004) => q(dz),
+ q(0005) => q(as),
+ q(0006) => q(ad),
+ q(0007) => q(ao),
+ q(0008) => q(ai),
+ q(0009) => q(aq),
+ q(0010) => q(ag),
+ q(0011) => q(ar),
+ q(0012) => q(am),
+ q(0013) => q(aw),
+ q(0014) => q(au),
+ q(0015) => q(at),
+ q(0016) => q(az),
+ q(0017) => q(bs),
+ q(0018) => q(bh),
+ q(0019) => q(bd),
+ q(0020) => q(bb),
+ q(0021) => q(by),
+ q(0022) => q(be),
+ q(0023) => q(bz),
+ q(0024) => q(bj),
+ q(0025) => q(bm),
+ q(0026) => q(bt),
+ q(0027) => q(bo),
+ q(0028) => q(ba),
+ q(0029) => q(bw),
+ q(0030) => q(bv),
+ q(0031) => q(br),
+ q(0032) => q(io),
+ q(0033) => q(bn),
+ q(0034) => q(bg),
+ q(0035) => q(bf),
+ q(0036) => q(bi),
+ q(0037) => q(kh),
+ q(0038) => q(cm),
+ q(0039) => q(ca),
+ q(0040) => q(cv),
+ q(0041) => q(ky),
+ q(0042) => q(cf),
+ q(0043) => q(td),
+ q(0044) => q(cl),
+ q(0045) => q(cn),
+ q(0046) => q(cx),
+ q(0047) => q(cc),
+ q(0048) => q(co),
+ q(0049) => q(km),
+ q(0050) => q(cg),
+ q(0051) => q(cd),
+ q(0052) => q(ck),
+ q(0053) => q(cr),
+ q(0054) => q(ci),
+ q(0055) => q(hr),
+ q(0056) => q(cu),
+ q(0057) => q(cy),
+ q(0058) => q(cz),
+ q(0059) => q(dk),
+ q(0060) => q(dj),
+ q(0061) => q(dm),
+ q(0062) => q(do),
+ q(0063) => q(ec),
+ q(0064) => q(eg),
+ q(0065) => q(sv),
+ q(0066) => q(gq),
+ q(0067) => q(er),
+ q(0068) => q(ee),
+ q(0069) => q(et),
+ q(0070) => q(fk),
+ q(0071) => q(fo),
+ q(0072) => q(fj),
+ q(0073) => q(fi),
+ q(0074) => q(fr),
+ q(0075) => q(gf),
+ q(0076) => q(pf),
+ q(0077) => q(tf),
+ q(0078) => q(ga),
+ q(0079) => q(gm),
+ q(0080) => q(ge),
+ q(0081) => q(de),
+ q(0082) => q(gh),
+ q(0083) => q(gi),
+ q(0084) => q(gr),
+ q(0085) => q(gl),
+ q(0086) => q(gd),
+ q(0087) => q(gp),
+ q(0088) => q(gu),
+ q(0089) => q(gt),
+ q(0090) => q(gg),
+ q(0091) => q(gn),
+ q(0092) => q(gw),
+ q(0093) => q(gy),
+ q(0094) => q(ht),
+ q(0095) => q(hm),
+ q(0096) => q(va),
+ q(0097) => q(hn),
+ q(0098) => q(hk),
+ q(0099) => q(hu),
+ q(0100) => q(is),
+ q(0101) => q(in),
+ q(0102) => q(id),
+ q(0103) => q(ir),
+ q(0104) => q(iq),
+ q(0105) => q(ie),
+ q(0106) => q(im),
+ q(0107) => q(il),
+ q(0108) => q(it),
+ q(0109) => q(jm),
+ q(0110) => q(jp),
+ q(0111) => q(je),
+ q(0112) => q(jo),
+ q(0113) => q(kz),
+ q(0114) => q(ke),
+ q(0115) => q(ki),
+ q(0116) => q(kp),
+ q(0117) => q(kr),
+ q(0118) => q(kw),
+ q(0119) => q(kg),
+ q(0120) => q(la),
+ q(0121) => q(lv),
+ q(0122) => q(lb),
+ q(0123) => q(ls),
+ q(0124) => q(lr),
+ q(0125) => q(ly),
+ q(0126) => q(li),
+ q(0127) => q(lt),
+ q(0128) => q(lu),
+ q(0129) => q(mo),
+ q(0130) => q(mk),
+ q(0131) => q(mg),
+ q(0132) => q(mw),
+ q(0133) => q(my),
+ q(0134) => q(mv),
+ q(0135) => q(ml),
+ q(0136) => q(mt),
+ q(0137) => q(mh),
+ q(0138) => q(mq),
+ q(0139) => q(mr),
+ q(0140) => q(mu),
+ q(0141) => q(yt),
+ q(0142) => q(mx),
+ q(0143) => q(fm),
+ q(0144) => q(md),
+ q(0145) => q(mc),
+ q(0146) => q(mn),
+ q(0147) => q(me),
+ q(0148) => q(ms),
+ q(0149) => q(ma),
+ q(0150) => q(mz),
+ q(0151) => q(mm),
+ q(0152) => q(na),
+ q(0153) => q(nr),
+ q(0154) => q(np),
+ q(0155) => q(nl),
+ q(0156) => q(an),
+ q(0157) => q(nc),
+ q(0158) => q(nz),
+ q(0159) => q(ni),
+ q(0160) => q(ne),
+ q(0161) => q(ng),
+ q(0162) => q(nu),
+ q(0163) => q(nf),
+ q(0164) => q(mp),
+ q(0165) => q(no),
+ q(0166) => q(om),
+ q(0167) => q(pk),
+ q(0168) => q(pw),
+ q(0169) => q(ps),
+ q(0170) => q(pa),
+ q(0171) => q(pg),
+ q(0172) => q(py),
+ q(0173) => q(pe),
+ q(0174) => q(ph),
+ q(0175) => q(pn),
+ q(0176) => q(pl),
+ q(0177) => q(pt),
+ q(0178) => q(pr),
+ q(0179) => q(qa),
+ q(0180) => q(re),
+ q(0181) => q(ro),
+ q(0182) => q(ru),
+ q(0183) => q(rw),
+ q(0184) => q(bl),
+ q(0185) => q(sh),
+ q(0186) => q(kn),
+ q(0187) => q(lc),
+ q(0188) => q(mf),
+ q(0189) => q(pm),
+ q(0190) => q(vc),
+ q(0191) => q(ws),
+ q(0192) => q(sm),
+ q(0193) => q(st),
+ q(0194) => q(sa),
+ q(0195) => q(sn),
+ q(0196) => q(rs),
+ q(0197) => q(sc),
+ q(0198) => q(sl),
+ q(0199) => q(sg),
+ q(0200) => q(sk),
+ q(0201) => q(si),
+ q(0202) => q(sb),
+ q(0203) => q(so),
+ q(0204) => q(za),
+ q(0205) => q(gs),
+ q(0206) => q(es),
+ q(0207) => q(lk),
+ q(0208) => q(sd),
+ q(0209) => q(sr),
+ q(0210) => q(sj),
+ q(0211) => q(sz),
+ q(0212) => q(se),
+ q(0213) => q(ch),
+ q(0214) => q(sy),
+ q(0215) => q(tw),
+ q(0216) => q(tj),
+ q(0217) => q(tz),
+ q(0218) => q(th),
+ q(0219) => q(tl),
+ q(0220) => q(tg),
+ q(0221) => q(tk),
+ q(0222) => q(to),
+ q(0223) => q(tt),
+ q(0224) => q(tn),
+ q(0225) => q(tr),
+ q(0226) => q(tm),
+ q(0227) => q(tc),
+ q(0228) => q(tv),
+ q(0229) => q(ug),
+ q(0230) => q(ua),
+ q(0231) => q(ae),
+ q(0232) => q(gb),
+ q(0233) => q(us),
+ q(0234) => q(um),
+ q(0235) => q(uy),
+ q(0236) => q(uz),
+ q(0237) => q(vu),
+ q(0238) => q(ve),
+ q(0239) => q(vn),
+ q(0240) => q(vg),
+ q(0241) => q(vi),
+ q(0242) => q(wf),
+ q(0243) => q(eh),
+ q(0244) => q(ye),
+ q(0245) => q(zm),
+ q(0246) => q(zw),
+ q(0276) => q(fx),
+ },
+ q(alpha3) => {
+ q(0001) => q(afg),
+ q(0002) => q(ala),
+ q(0003) => q(alb),
+ q(0004) => q(dza),
+ q(0005) => q(asm),
+ q(0006) => q(and),
+ q(0007) => q(ago),
+ q(0008) => q(aia),
+ q(0009) => q(ata),
+ q(0010) => q(atg),
+ q(0011) => q(arg),
+ q(0012) => q(arm),
+ q(0013) => q(abw),
+ q(0014) => q(aus),
+ q(0015) => q(aut),
+ q(0016) => q(aze),
+ q(0017) => q(bhs),
+ q(0018) => q(bhr),
+ q(0019) => q(bgd),
+ q(0020) => q(brb),
+ q(0021) => q(blr),
+ q(0022) => q(bel),
+ q(0023) => q(blz),
+ q(0024) => q(ben),
+ q(0025) => q(bmu),
+ q(0026) => q(btn),
+ q(0027) => q(bol),
+ q(0028) => q(bih),
+ q(0029) => q(bwa),
+ q(0030) => q(bvt),
+ q(0031) => q(bra),
+ q(0032) => q(iot),
+ q(0033) => q(brn),
+ q(0034) => q(bgr),
+ q(0035) => q(bfa),
+ q(0036) => q(bdi),
+ q(0037) => q(khm),
+ q(0038) => q(cmr),
+ q(0039) => q(can),
+ q(0040) => q(cpv),
+ q(0041) => q(cym),
+ q(0042) => q(caf),
+ q(0043) => q(tcd),
+ q(0044) => q(chl),
+ q(0045) => q(chn),
+ q(0046) => q(cxr),
+ q(0047) => q(cck),
+ q(0048) => q(col),
+ q(0049) => q(com),
+ q(0050) => q(cog),
+ q(0051) => q(cod),
+ q(0052) => q(cok),
+ q(0053) => q(cri),
+ q(0054) => q(civ),
+ q(0055) => q(hrv),
+ q(0056) => q(cub),
+ q(0057) => q(cyp),
+ q(0058) => q(cze),
+ q(0059) => q(dnk),
+ q(0060) => q(dji),
+ q(0061) => q(dma),
+ q(0062) => q(dom),
+ q(0063) => q(ecu),
+ q(0064) => q(egy),
+ q(0065) => q(slv),
+ q(0066) => q(gnq),
+ q(0067) => q(eri),
+ q(0068) => q(est),
+ q(0069) => q(eth),
+ q(0070) => q(flk),
+ q(0071) => q(fro),
+ q(0072) => q(fji),
+ q(0073) => q(fin),
+ q(0074) => q(fra),
+ q(0075) => q(guf),
+ q(0076) => q(pyf),
+ q(0077) => q(atf),
+ q(0078) => q(gab),
+ q(0079) => q(gmb),
+ q(0080) => q(geo),
+ q(0081) => q(deu),
+ q(0082) => q(gha),
+ q(0083) => q(gib),
+ q(0084) => q(grc),
+ q(0085) => q(grl),
+ q(0086) => q(grd),
+ q(0087) => q(glp),
+ q(0088) => q(gum),
+ q(0089) => q(gtm),
+ q(0090) => q(ggy),
+ q(0091) => q(gin),
+ q(0092) => q(gnb),
+ q(0093) => q(guy),
+ q(0094) => q(hti),
+ q(0095) => q(hmd),
+ q(0096) => q(vat),
+ q(0097) => q(hnd),
+ q(0098) => q(hkg),
+ q(0099) => q(hun),
+ q(0100) => q(isl),
+ q(0101) => q(ind),
+ q(0102) => q(idn),
+ q(0103) => q(irn),
+ q(0104) => q(irq),
+ q(0105) => q(irl),
+ q(0106) => q(imn),
+ q(0107) => q(isr),
+ q(0108) => q(ita),
+ q(0109) => q(jam),
+ q(0110) => q(jpn),
+ q(0111) => q(jey),
+ q(0112) => q(jor),
+ q(0113) => q(kaz),
+ q(0114) => q(ken),
+ q(0115) => q(kir),
+ q(0116) => q(prk),
+ q(0117) => q(kor),
+ q(0118) => q(kwt),
+ q(0119) => q(kgz),
+ q(0120) => q(lao),
+ q(0121) => q(lva),
+ q(0122) => q(lbn),
+ q(0123) => q(lso),
+ q(0124) => q(lbr),
+ q(0125) => q(lby),
+ q(0126) => q(lie),
+ q(0127) => q(ltu),
+ q(0128) => q(lux),
+ q(0129) => q(mac),
+ q(0130) => q(mkd),
+ q(0131) => q(mdg),
+ q(0132) => q(mwi),
+ q(0133) => q(mys),
+ q(0134) => q(mdv),
+ q(0135) => q(mli),
+ q(0136) => q(mlt),
+ q(0137) => q(mhl),
+ q(0138) => q(mtq),
+ q(0139) => q(mrt),
+ q(0140) => q(mus),
+ q(0141) => q(myt),
+ q(0142) => q(mex),
+ q(0143) => q(fsm),
+ q(0144) => q(mda),
+ q(0145) => q(mco),
+ q(0146) => q(mng),
+ q(0147) => q(mne),
+ q(0148) => q(msr),
+ q(0149) => q(mar),
+ q(0150) => q(moz),
+ q(0151) => q(mmr),
+ q(0152) => q(nam),
+ q(0153) => q(nru),
+ q(0154) => q(npl),
+ q(0155) => q(nld),
+ q(0156) => q(ant),
+ q(0157) => q(ncl),
+ q(0158) => q(nzl),
+ q(0159) => q(nic),
+ q(0160) => q(ner),
+ q(0161) => q(nga),
+ q(0162) => q(niu),
+ q(0163) => q(nfk),
+ q(0164) => q(mnp),
+ q(0165) => q(nor),
+ q(0166) => q(omn),
+ q(0167) => q(pak),
+ q(0168) => q(plw),
+ q(0169) => q(pse),
+ q(0170) => q(pan),
+ q(0171) => q(png),
+ q(0172) => q(pry),
+ q(0173) => q(per),
+ q(0174) => q(phl),
+ q(0175) => q(pcn),
+ q(0176) => q(pol),
+ q(0177) => q(prt),
+ q(0178) => q(pri),
+ q(0179) => q(qat),
+ q(0180) => q(reu),
+ q(0181) => q(rou),
+ q(0182) => q(rus),
+ q(0183) => q(rwa),
+ q(0184) => q(blm),
+ q(0185) => q(shn),
+ q(0186) => q(kna),
+ q(0187) => q(lca),
+ q(0188) => q(maf),
+ q(0189) => q(spm),
+ q(0190) => q(vct),
+ q(0191) => q(wsm),
+ q(0192) => q(smr),
+ q(0193) => q(stp),
+ q(0194) => q(sau),
+ q(0195) => q(sen),
+ q(0196) => q(srb),
+ q(0197) => q(syc),
+ q(0198) => q(sle),
+ q(0199) => q(sgp),
+ q(0200) => q(svk),
+ q(0201) => q(svn),
+ q(0202) => q(slb),
+ q(0203) => q(som),
+ q(0204) => q(zaf),
+ q(0206) => q(esp),
+ q(0207) => q(lka),
+ q(0208) => q(sdn),
+ q(0209) => q(sur),
+ q(0210) => q(sjm),
+ q(0211) => q(swz),
+ q(0212) => q(swe),
+ q(0213) => q(che),
+ q(0214) => q(syr),
+ q(0215) => q(twn),
+ q(0216) => q(tjk),
+ q(0217) => q(tza),
+ q(0218) => q(tha),
+ q(0219) => q(tls),
+ q(0220) => q(tgo),
+ q(0221) => q(tkl),
+ q(0222) => q(ton),
+ q(0223) => q(tto),
+ q(0224) => q(tun),
+ q(0225) => q(tur),
+ q(0226) => q(tkm),
+ q(0227) => q(tca),
+ q(0228) => q(tuv),
+ q(0229) => q(uga),
+ q(0230) => q(ukr),
+ q(0231) => q(are),
+ q(0232) => q(gbr),
+ q(0233) => q(usa),
+ q(0234) => q(umi),
+ q(0235) => q(ury),
+ q(0236) => q(uzb),
+ q(0237) => q(vut),
+ q(0238) => q(ven),
+ q(0239) => q(vnm),
+ q(0240) => q(vgb),
+ q(0241) => q(vir),
+ q(0242) => q(wlf),
+ q(0243) => q(esh),
+ q(0244) => q(yem),
+ q(0245) => q(zmb),
+ q(0246) => q(zwe),
+ q(0276) => q(fxx),
+ },
+ q(dom) => {
+ q(0001) => q(AF),
+ q(0002) => q(AX),
+ q(0003) => q(AL),
+ q(0004) => q(DZ),
+ q(0005) => q(AS),
+ q(0006) => q(AD),
+ q(0007) => q(AO),
+ q(0008) => q(AI),
+ q(0009) => q(AQ),
+ q(0010) => q(AG),
+ q(0011) => q(AR),
+ q(0012) => q(AM),
+ q(0013) => q(AW),
+ q(0014) => q(AU),
+ q(0015) => q(AT),
+ q(0016) => q(AZ),
+ q(0017) => q(BS),
+ q(0018) => q(BH),
+ q(0019) => q(BD),
+ q(0020) => q(BB),
+ q(0021) => q(BY),
+ q(0022) => q(BE),
+ q(0023) => q(BZ),
+ q(0024) => q(BJ),
+ q(0025) => q(BM),
+ q(0026) => q(BT),
+ q(0027) => q(BO),
+ q(0028) => q(BA),
+ q(0029) => q(BW),
+ q(0030) => q(BV),
+ q(0031) => q(BR),
+ q(0032) => q(IO),
+ q(0033) => q(BN),
+ q(0034) => q(BG),
+ q(0035) => q(BF),
+ q(0036) => q(BI),
+ q(0037) => q(KH),
+ q(0038) => q(CM),
+ q(0039) => q(CA),
+ q(0040) => q(CV),
+ q(0041) => q(KY),
+ q(0042) => q(CF),
+ q(0043) => q(TD),
+ q(0044) => q(CL),
+ q(0045) => q(CN),
+ q(0046) => q(CX),
+ q(0047) => q(CC),
+ q(0048) => q(CO),
+ q(0049) => q(KM),
+ q(0050) => q(CG),
+ q(0051) => q(CD),
+ q(0052) => q(CK),
+ q(0053) => q(CR),
+ q(0054) => q(CI),
+ q(0055) => q(HR),
+ q(0056) => q(CU),
+ q(0057) => q(CY),
+ q(0058) => q(CZ),
+ q(0059) => q(DK),
+ q(0060) => q(DJ),
+ q(0061) => q(DM),
+ q(0062) => q(DO),
+ q(0063) => q(EC),
+ q(0064) => q(EG),
+ q(0065) => q(SV),
+ q(0066) => q(GQ),
+ q(0067) => q(ER),
+ q(0068) => q(EE),
+ q(0069) => q(ET),
+ q(0070) => q(FK),
+ q(0071) => q(FO),
+ q(0072) => q(FJ),
+ q(0073) => q(FI),
+ q(0074) => q(FR),
+ q(0075) => q(GF),
+ q(0076) => q(PF),
+ q(0077) => q(TF),
+ q(0078) => q(GA),
+ q(0079) => q(GM),
+ q(0080) => q(GE),
+ q(0081) => q(DE),
+ q(0082) => q(GH),
+ q(0083) => q(GI),
+ q(0084) => q(GR),
+ q(0085) => q(GL),
+ q(0086) => q(GD),
+ q(0087) => q(GP),
+ q(0088) => q(GU),
+ q(0089) => q(GT),
+ q(0090) => q(GG),
+ q(0091) => q(GN),
+ q(0092) => q(GW),
+ q(0093) => q(GY),
+ q(0094) => q(HT),
+ q(0095) => q(HM),
+ q(0096) => q(VA),
+ q(0097) => q(HN),
+ q(0098) => q(HK),
+ q(0099) => q(HU),
+ q(0100) => q(IS),
+ q(0101) => q(IN),
+ q(0102) => q(ID),
+ q(0103) => q(IR),
+ q(0104) => q(IQ),
+ q(0105) => q(IE),
+ q(0106) => q(IM),
+ q(0107) => q(IL),
+ q(0108) => q(IT),
+ q(0109) => q(JM),
+ q(0110) => q(JP),
+ q(0111) => q(JE),
+ q(0112) => q(JO),
+ q(0113) => q(KZ),
+ q(0114) => q(KE),
+ q(0115) => q(KI),
+ q(0116) => q(KP),
+ q(0117) => q(KR),
+ q(0118) => q(KW),
+ q(0119) => q(KG),
+ q(0120) => q(LA),
+ q(0121) => q(LV),
+ q(0122) => q(LB),
+ q(0123) => q(LS),
+ q(0124) => q(LR),
+ q(0125) => q(LY),
+ q(0126) => q(LI),
+ q(0127) => q(LT),
+ q(0128) => q(LU),
+ q(0129) => q(MO),
+ q(0130) => q(MK),
+ q(0131) => q(MG),
+ q(0132) => q(MW),
+ q(0133) => q(MY),
+ q(0134) => q(MV),
+ q(0135) => q(ML),
+ q(0136) => q(MT),
+ q(0137) => q(MH),
+ q(0138) => q(MQ),
+ q(0139) => q(MR),
+ q(0140) => q(MU),
+ q(0141) => q(YT),
+ q(0142) => q(MX),
+ q(0143) => q(FM),
+ q(0144) => q(MD),
+ q(0145) => q(MC),
+ q(0146) => q(MN),
+ q(0147) => q(ME),
+ q(0148) => q(MS),
+ q(0149) => q(MA),
+ q(0150) => q(MZ),
+ q(0151) => q(MM),
+ q(0152) => q(NA),
+ q(0153) => q(NR),
+ q(0154) => q(NP),
+ q(0155) => q(NL),
+ q(0156) => q(AN),
+ q(0157) => q(NC),
+ q(0158) => q(NZ),
+ q(0159) => q(NI),
+ q(0160) => q(NE),
+ q(0161) => q(NG),
+ q(0162) => q(NU),
+ q(0163) => q(NF),
+ q(0164) => q(MP),
+ q(0165) => q(NO),
+ q(0166) => q(OM),
+ q(0167) => q(PK),
+ q(0168) => q(PW),
+ q(0169) => q(PS),
+ q(0170) => q(PA),
+ q(0171) => q(PG),
+ q(0172) => q(PY),
+ q(0173) => q(PE),
+ q(0174) => q(PH),
+ q(0175) => q(PN),
+ q(0176) => q(PL),
+ q(0177) => q(PT),
+ q(0178) => q(PR),
+ q(0179) => q(QA),
+ q(0180) => q(RE),
+ q(0181) => q(RO),
+ q(0182) => q(RU),
+ q(0183) => q(RW),
+ q(0184) => q(BL),
+ q(0185) => q(SH),
+ q(0186) => q(KN),
+ q(0187) => q(LC),
+ q(0188) => q(MF),
+ q(0189) => q(PM),
+ q(0190) => q(VC),
+ q(0191) => q(WS),
+ q(0192) => q(SM),
+ q(0193) => q(ST),
+ q(0194) => q(SA),
+ q(0195) => q(SN),
+ q(0196) => q(RS),
+ q(0197) => q(SC),
+ q(0198) => q(SL),
+ q(0199) => q(SG),
+ q(0200) => q(SK),
+ q(0201) => q(SI),
+ q(0202) => q(SB),
+ q(0203) => q(SO),
+ q(0204) => q(ZA),
+ q(0205) => q(GS),
+ q(0206) => q(ES),
+ q(0207) => q(LK),
+ q(0208) => q(SD),
+ q(0209) => q(SR),
+ q(0210) => q(SJ),
+ q(0211) => q(SZ),
+ q(0212) => q(SE),
+ q(0213) => q(CH),
+ q(0214) => q(SY),
+ q(0215) => q(TW),
+ q(0216) => q(TJ),
+ q(0217) => q(TZ),
+ q(0218) => q(TH),
+ q(0219) => q(TL),
+ q(0220) => q(TG),
+ q(0221) => q(TK),
+ q(0222) => q(TO),
+ q(0223) => q(TT),
+ q(0224) => q(TN),
+ q(0225) => q(TR),
+ q(0226) => q(TM),
+ q(0227) => q(TC),
+ q(0228) => q(TV),
+ q(0229) => q(UG),
+ q(0230) => q(UA),
+ q(0231) => q(AE),
+ q(0232) => q(UK),
+ q(0233) => q(US),
+ q(0234) => q(UM),
+ q(0235) => q(UY),
+ q(0236) => q(UZ),
+ q(0237) => q(VU),
+ q(0238) => q(VE),
+ q(0239) => q(VN),
+ q(0240) => q(VG),
+ q(0241) => q(VI),
+ q(0242) => q(WF),
+ q(0243) => q(EH),
+ q(0244) => q(YE),
+ q(0245) => q(ZM),
+ q(0246) => q(ZW),
+ q(0272) => q(AC),
+ q(0273) => q(EU),
+ q(0274) => q(SU),
+ q(0275) => q(TP),
+ q(0276) => q(FX),
+ },
+ q(fips) => {
+ q(0001) => q(AF),
+ q(0003) => q(AL),
+ q(0004) => q(AG),
+ q(0005) => q(AQ),
+ q(0006) => q(AN),
+ q(0007) => q(AO),
+ q(0008) => q(AV),
+ q(0009) => q(AY),
+ q(0010) => q(AC),
+ q(0011) => q(AR),
+ q(0012) => q(AM),
+ q(0013) => q(AA),
+ q(0014) => q(AS),
+ q(0015) => q(AU),
+ q(0016) => q(AJ),
+ q(0017) => q(BF),
+ q(0018) => q(BA),
+ q(0019) => q(BG),
+ q(0020) => q(BB),
+ q(0021) => q(BO),
+ q(0022) => q(BE),
+ q(0023) => q(BH),
+ q(0024) => q(BN),
+ q(0025) => q(BD),
+ q(0026) => q(BT),
+ q(0027) => q(BL),
+ q(0028) => q(BK),
+ q(0029) => q(BC),
+ q(0030) => q(BV),
+ q(0031) => q(BR),
+ q(0032) => q(IO),
+ q(0033) => q(BX),
+ q(0034) => q(BU),
+ q(0035) => q(UV),
+ q(0036) => q(BY),
+ q(0037) => q(CB),
+ q(0038) => q(CM),
+ q(0039) => q(CA),
+ q(0040) => q(CV),
+ q(0041) => q(CJ),
+ q(0042) => q(CT),
+ q(0043) => q(CD),
+ q(0044) => q(CI),
+ q(0045) => q(CH),
+ q(0046) => q(KT),
+ q(0047) => q(CK),
+ q(0048) => q(CO),
+ q(0049) => q(CN),
+ q(0050) => q(CF),
+ q(0051) => q(CG),
+ q(0052) => q(CW),
+ q(0053) => q(CS),
+ q(0054) => q(IV),
+ q(0055) => q(HR),
+ q(0056) => q(CU),
+ q(0057) => q(CY),
+ q(0058) => q(EZ),
+ q(0059) => q(DA),
+ q(0060) => q(DJ),
+ q(0061) => q(DO),
+ q(0062) => q(DR),
+ q(0063) => q(EC),
+ q(0064) => q(EG),
+ q(0065) => q(ES),
+ q(0066) => q(EK),
+ q(0067) => q(ER),
+ q(0068) => q(EN),
+ q(0069) => q(ET),
+ q(0070) => q(FK),
+ q(0071) => q(FO),
+ q(0072) => q(FJ),
+ q(0073) => q(FI),
+ q(0074) => q(FR),
+ q(0075) => q(FG),
+ q(0076) => q(FP),
+ q(0077) => q(FS),
+ q(0078) => q(GB),
+ q(0079) => q(GA),
+ q(0080) => q(GG),
+ q(0081) => q(GM),
+ q(0082) => q(GH),
+ q(0083) => q(GI),
+ q(0084) => q(GR),
+ q(0085) => q(GL),
+ q(0086) => q(GJ),
+ q(0087) => q(GP),
+ q(0088) => q(GQ),
+ q(0089) => q(GT),
+ q(0090) => q(GK),
+ q(0091) => q(GV),
+ q(0092) => q(PU),
+ q(0093) => q(GY),
+ q(0094) => q(HA),
+ q(0095) => q(HM),
+ q(0096) => q(VT),
+ q(0097) => q(HO),
+ q(0098) => q(HK),
+ q(0099) => q(HU),
+ q(0100) => q(IC),
+ q(0101) => q(IN),
+ q(0102) => q(ID),
+ q(0103) => q(IR),
+ q(0104) => q(IZ),
+ q(0105) => q(EI),
+ q(0106) => q(IM),
+ q(0107) => q(IS),
+ q(0108) => q(IT),
+ q(0109) => q(JM),
+ q(0110) => q(JA),
+ q(0111) => q(JE),
+ q(0112) => q(JO),
+ q(0113) => q(KZ),
+ q(0114) => q(KE),
+ q(0115) => q(KR),
+ q(0116) => q(KN),
+ q(0117) => q(KS),
+ q(0118) => q(KU),
+ q(0119) => q(KG),
+ q(0120) => q(LA),
+ q(0121) => q(LG),
+ q(0122) => q(LE),
+ q(0123) => q(LT),
+ q(0124) => q(LI),
+ q(0125) => q(LY),
+ q(0126) => q(LS),
+ q(0127) => q(LH),
+ q(0128) => q(LU),
+ q(0129) => q(MC),
+ q(0130) => q(MK),
+ q(0131) => q(MA),
+ q(0132) => q(MI),
+ q(0133) => q(MY),
+ q(0134) => q(MV),
+ q(0135) => q(ML),
+ q(0136) => q(MT),
+ q(0137) => q(RM),
+ q(0138) => q(MB),
+ q(0139) => q(MR),
+ q(0140) => q(MP),
+ q(0141) => q(MF),
+ q(0142) => q(MX),
+ q(0143) => q(FM),
+ q(0144) => q(MD),
+ q(0145) => q(MN),
+ q(0146) => q(MG),
+ q(0147) => q(MJ),
+ q(0148) => q(MH),
+ q(0149) => q(MO),
+ q(0150) => q(MZ),
+ q(0151) => q(BM),
+ q(0152) => q(WA),
+ q(0153) => q(NR),
+ q(0154) => q(NP),
+ q(0155) => q(NL),
+ q(0156) => q(NT),
+ q(0157) => q(NC),
+ q(0158) => q(NZ),
+ q(0159) => q(NU),
+ q(0160) => q(NG),
+ q(0161) => q(NI),
+ q(0162) => q(NE),
+ q(0163) => q(NF),
+ q(0164) => q(CQ),
+ q(0165) => q(NO),
+ q(0166) => q(MU),
+ q(0167) => q(PK),
+ q(0168) => q(PS),
+ q(0170) => q(PM),
+ q(0171) => q(PP),
+ q(0172) => q(PA),
+ q(0173) => q(PE),
+ q(0174) => q(RP),
+ q(0175) => q(PC),
+ q(0176) => q(PL),
+ q(0177) => q(PO),
+ q(0178) => q(RQ),
+ q(0179) => q(QA),
+ q(0180) => q(RE),
+ q(0181) => q(RO),
+ q(0182) => q(RS),
+ q(0183) => q(RW),
+ q(0184) => q(TB),
+ q(0185) => q(SH),
+ q(0186) => q(SC),
+ q(0187) => q(ST),
+ q(0188) => q(RN),
+ q(0189) => q(SB),
+ q(0190) => q(VC),
+ q(0191) => q(WS),
+ q(0192) => q(SM),
+ q(0193) => q(TP),
+ q(0194) => q(SA),
+ q(0195) => q(SG),
+ q(0196) => q(RI),
+ q(0197) => q(SE),
+ q(0198) => q(SL),
+ q(0199) => q(SN),
+ q(0200) => q(LO),
+ q(0201) => q(SI),
+ q(0202) => q(BP),
+ q(0203) => q(SO),
+ q(0204) => q(SF),
+ q(0205) => q(SX),
+ q(0206) => q(SP),
+ q(0207) => q(CE),
+ q(0208) => q(SU),
+ q(0209) => q(NS),
+ q(0211) => q(WZ),
+ q(0212) => q(SW),
+ q(0213) => q(SZ),
+ q(0214) => q(SY),
+ q(0215) => q(TW),
+ q(0216) => q(TI),
+ q(0217) => q(TZ),
+ q(0218) => q(TH),
+ q(0219) => q(TT),
+ q(0220) => q(TO),
+ q(0221) => q(TL),
+ q(0222) => q(TN),
+ q(0223) => q(TD),
+ q(0224) => q(TS),
+ q(0225) => q(TU),
+ q(0226) => q(TX),
+ q(0227) => q(TK),
+ q(0228) => q(TV),
+ q(0229) => q(UG),
+ q(0230) => q(UP),
+ q(0231) => q(AE),
+ q(0232) => q(UK),
+ q(0233) => q(US),
+ q(0235) => q(UY),
+ q(0236) => q(UZ),
+ q(0237) => q(NH),
+ q(0238) => q(VE),
+ q(0239) => q(VM),
+ q(0240) => q(VI),
+ q(0241) => q(VQ),
+ q(0242) => q(WF),
+ q(0243) => q(WI),
+ q(0244) => q(YM),
+ q(0245) => q(ZA),
+ q(0246) => q(ZI),
+ q(0248) => q(YI),
+ q(0249) => q(AT),
+ q(0250) => q(FQ),
+ q(0251) => q(BS),
+ q(0252) => q(IP),
+ q(0253) => q(CR),
+ q(0254) => q(EU),
+ q(0255) => q(GZ),
+ q(0256) => q(GO),
+ q(0257) => q(HQ),
+ q(0258) => q(JN),
+ q(0259) => q(DQ),
+ q(0260) => q(JQ),
+ q(0261) => q(JU),
+ q(0262) => q(KQ),
+ q(0263) => q(MQ),
+ q(0264) => q(BQ),
+ q(0265) => q(LQ),
+ q(0266) => q(PF),
+ q(0267) => q(PG),
+ q(0268) => q(SV),
+ q(0269) => q(TE),
+ q(0270) => q(WQ),
+ q(0271) => q(WE),
+ q(0277) => q(KV),
+ },
+ q(num) => {
+ q(0001) => q(004),
+ q(0002) => q(248),
+ q(0003) => q(008),
+ q(0004) => q(012),
+ q(0005) => q(016),
+ q(0006) => q(020),
+ q(0007) => q(024),
+ q(0008) => q(660),
+ q(0009) => q(010),
+ q(0010) => q(028),
+ q(0011) => q(032),
+ q(0012) => q(051),
+ q(0013) => q(533),
+ q(0014) => q(036),
+ q(0015) => q(040),
+ q(0016) => q(031),
+ q(0017) => q(044),
+ q(0018) => q(048),
+ q(0019) => q(050),
+ q(0020) => q(052),
+ q(0021) => q(112),
+ q(0022) => q(056),
+ q(0023) => q(084),
+ q(0024) => q(204),
+ q(0025) => q(060),
+ q(0026) => q(064),
+ q(0027) => q(068),
+ q(0028) => q(070),
+ q(0029) => q(072),
+ q(0030) => q(074),
+ q(0031) => q(076),
+ q(0032) => q(086),
+ q(0033) => q(096),
+ q(0034) => q(100),
+ q(0035) => q(854),
+ q(0036) => q(108),
+ q(0037) => q(116),
+ q(0038) => q(120),
+ q(0039) => q(124),
+ q(0040) => q(132),
+ q(0041) => q(136),
+ q(0042) => q(140),
+ q(0043) => q(148),
+ q(0044) => q(152),
+ q(0045) => q(156),
+ q(0046) => q(162),
+ q(0047) => q(166),
+ q(0048) => q(170),
+ q(0049) => q(174),
+ q(0050) => q(178),
+ q(0051) => q(180),
+ q(0052) => q(184),
+ q(0053) => q(188),
+ q(0054) => q(384),
+ q(0055) => q(191),
+ q(0056) => q(192),
+ q(0057) => q(196),
+ q(0058) => q(203),
+ q(0059) => q(208),
+ q(0060) => q(262),
+ q(0061) => q(212),
+ q(0062) => q(214),
+ q(0063) => q(218),
+ q(0064) => q(818),
+ q(0065) => q(222),
+ q(0066) => q(226),
+ q(0067) => q(232),
+ q(0068) => q(233),
+ q(0069) => q(231),
+ q(0070) => q(238),
+ q(0071) => q(234),
+ q(0072) => q(242),
+ q(0073) => q(246),
+ q(0074) => q(250),
+ q(0075) => q(254),
+ q(0076) => q(258),
+ q(0077) => q(260),
+ q(0078) => q(266),
+ q(0079) => q(270),
+ q(0080) => q(268),
+ q(0081) => q(276),
+ q(0082) => q(288),
+ q(0083) => q(292),
+ q(0084) => q(300),
+ q(0085) => q(304),
+ q(0086) => q(308),
+ q(0087) => q(312),
+ q(0088) => q(316),
+ q(0089) => q(320),
+ q(0090) => q(831),
+ q(0091) => q(324),
+ q(0092) => q(624),
+ q(0093) => q(328),
+ q(0094) => q(332),
+ q(0095) => q(334),
+ q(0096) => q(336),
+ q(0097) => q(340),
+ q(0098) => q(344),
+ q(0099) => q(348),
+ q(0100) => q(352),
+ q(0101) => q(356),
+ q(0102) => q(360),
+ q(0103) => q(364),
+ q(0104) => q(368),
+ q(0105) => q(372),
+ q(0106) => q(833),
+ q(0107) => q(376),
+ q(0108) => q(380),
+ q(0109) => q(388),
+ q(0110) => q(392),
+ q(0111) => q(832),
+ q(0112) => q(400),
+ q(0113) => q(398),
+ q(0114) => q(404),
+ q(0115) => q(296),
+ q(0116) => q(408),
+ q(0117) => q(410),
+ q(0118) => q(414),
+ q(0119) => q(417),
+ q(0120) => q(418),
+ q(0121) => q(428),
+ q(0122) => q(422),
+ q(0123) => q(426),
+ q(0124) => q(430),
+ q(0125) => q(434),
+ q(0126) => q(438),
+ q(0127) => q(440),
+ q(0128) => q(442),
+ q(0129) => q(446),
+ q(0130) => q(807),
+ q(0131) => q(450),
+ q(0132) => q(454),
+ q(0133) => q(458),
+ q(0134) => q(462),
+ q(0135) => q(466),
+ q(0136) => q(470),
+ q(0137) => q(584),
+ q(0138) => q(474),
+ q(0139) => q(478),
+ q(0140) => q(480),
+ q(0141) => q(175),
+ q(0142) => q(484),
+ q(0143) => q(583),
+ q(0144) => q(498),
+ q(0145) => q(492),
+ q(0146) => q(496),
+ q(0147) => q(499),
+ q(0148) => q(500),
+ q(0149) => q(504),
+ q(0150) => q(508),
+ q(0151) => q(104),
+ q(0152) => q(516),
+ q(0153) => q(520),
+ q(0154) => q(524),
+ q(0155) => q(528),
+ q(0156) => q(530),
+ q(0157) => q(540),
+ q(0158) => q(554),
+ q(0159) => q(558),
+ q(0160) => q(562),
+ q(0161) => q(566),
+ q(0162) => q(570),
+ q(0163) => q(574),
+ q(0164) => q(580),
+ q(0165) => q(578),
+ q(0166) => q(512),
+ q(0167) => q(586),
+ q(0168) => q(585),
+ q(0169) => q(275),
+ q(0170) => q(591),
+ q(0171) => q(598),
+ q(0172) => q(600),
+ q(0173) => q(604),
+ q(0174) => q(608),
+ q(0175) => q(612),
+ q(0176) => q(616),
+ q(0177) => q(620),
+ q(0178) => q(630),
+ q(0179) => q(634),
+ q(0180) => q(638),
+ q(0181) => q(642),
+ q(0182) => q(643),
+ q(0183) => q(646),
+ q(0184) => q(652),
+ q(0185) => q(654),
+ q(0186) => q(659),
+ q(0187) => q(662),
+ q(0188) => q(663),
+ q(0189) => q(666),
+ q(0190) => q(670),
+ q(0191) => q(882),
+ q(0192) => q(674),
+ q(0193) => q(678),
+ q(0194) => q(682),
+ q(0195) => q(686),
+ q(0196) => q(688),
+ q(0197) => q(690),
+ q(0198) => q(694),
+ q(0199) => q(702),
+ q(0200) => q(703),
+ q(0201) => q(705),
+ q(0202) => q(090),
+ q(0203) => q(706),
+ q(0204) => q(710),
+ q(0206) => q(724),
+ q(0207) => q(144),
+ q(0208) => q(736),
+ q(0209) => q(740),
+ q(0210) => q(744),
+ q(0211) => q(748),
+ q(0212) => q(752),
+ q(0213) => q(756),
+ q(0214) => q(760),
+ q(0215) => q(158),
+ q(0216) => q(762),
+ q(0217) => q(834),
+ q(0218) => q(764),
+ q(0219) => q(626),
+ q(0220) => q(768),
+ q(0221) => q(772),
+ q(0222) => q(776),
+ q(0223) => q(780),
+ q(0224) => q(788),
+ q(0225) => q(792),
+ q(0226) => q(795),
+ q(0227) => q(796),
+ q(0228) => q(798),
+ q(0229) => q(800),
+ q(0230) => q(804),
+ q(0231) => q(784),
+ q(0232) => q(826),
+ q(0233) => q(840),
+ q(0234) => q(581),
+ q(0235) => q(858),
+ q(0236) => q(860),
+ q(0237) => q(548),
+ q(0238) => q(862),
+ q(0239) => q(704),
+ q(0240) => q(092),
+ q(0241) => q(850),
+ q(0242) => q(876),
+ q(0243) => q(732),
+ q(0244) => q(887),
+ q(0245) => q(894),
+ q(0246) => q(716),
+ q(0247) => q(830),
+ q(0276) => q(249),
+ },
+};
+
+1;
--- /dev/null
+package Locale::Codes::Currency;
+
+# This file was automatically generated. Any changes to this file will
+# be lost the next time 'get_codes' is run.
+# Generated on: Mon Apr 5 15:43:34 EDT 2010
+
+=pod
+
+=head1 NAME
+
+Locale::Codes::Currency - currency codes for the Locale::Currency module
+
+=head1 SYNOPSIS
+
+This module contains data used by the Locale::Currency module. It is
+not intended to be used directly, and contains no calleable routines.
+
+=head1 AUTHOR
+
+See Locale::Codes for full author history.
+
+Currently maintained by Sullivan Beck (sbeck@cpan.org).
+
+=head1 COPYRIGHT
+
+ Copyright (c) 1997-2001 Canon Research Centre Europe (CRE).
+ Copyright (c) 2001-2010 Neil Bowers
+ Copyright (c) 2010-2010 Sullivan Beck
+
+This module is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
+
+use strict;
+use warnings;
+require 5.002;
+
+use vars qw($VERSION);
+$VERSION='3.12';
+
+$Locale::Codes::Data{'currency'}{'id'} = '0180';
+
+$Locale::Codes::Data{'currency'}{'id2names'} = {
+ q(0001) => [
+ q(Afghani),
+ ],
+ q(0002) => [
+ q(Euro),
+ ],
+ q(0003) => [
+ q(Lek),
+ ],
+ q(0004) => [
+ q(Algerian Dinar),
+ ],
+ q(0005) => [
+ q(US Dollar),
+ ],
+ q(0006) => [
+ q(Kwanza),
+ ],
+ q(0007) => [
+ q(East Caribbean Dollar),
+ ],
+ q(0008) => [
+ q(Argentine Peso),
+ ],
+ q(0009) => [
+ q(Armenian Dram),
+ ],
+ q(0010) => [
+ q(Aruban Guilder),
+ ],
+ q(0011) => [
+ q(Australian Dollar),
+ ],
+ q(0012) => [
+ q(Azerbaijanian Manat),
+ ],
+ q(0013) => [
+ q(Bahamian Dollar),
+ ],
+ q(0014) => [
+ q(Bahraini Dinar),
+ ],
+ q(0015) => [
+ q(Taka),
+ ],
+ q(0016) => [
+ q(Barbados Dollar),
+ ],
+ q(0017) => [
+ q(Belarussian Ruble),
+ ],
+ q(0018) => [
+ q(Belize Dollar),
+ ],
+ q(0019) => [
+ q(CFA Franc BCEAO),
+ ],
+ q(0020) => [
+ q(Bermudian Dollar (customarily known as Bermuda Dollar)),
+ ],
+ q(0021) => [
+ q(Indian Rupee),
+ ],
+ q(0022) => [
+ q(Ngultrum),
+ ],
+ q(0023) => [
+ q(Boliviano),
+ ],
+ q(0024) => [
+ q(Mvdol),
+ ],
+ q(0025) => [
+ q(Convertible Marks),
+ ],
+ q(0026) => [
+ q(Pula),
+ ],
+ q(0027) => [
+ q(Norwegian Krone),
+ ],
+ q(0028) => [
+ q(Brazilian Real),
+ ],
+ q(0029) => [
+ q(Brunei Dollar),
+ ],
+ q(0030) => [
+ q(Bulgarian Lev),
+ ],
+ q(0031) => [
+ q(Burundi Franc),
+ ],
+ q(0032) => [
+ q(Riel),
+ ],
+ q(0033) => [
+ q(CFA Franc BEAC),
+ ],
+ q(0034) => [
+ q(Canadian Dollar),
+ ],
+ q(0035) => [
+ q(Cape Verde Escudo),
+ ],
+ q(0036) => [
+ q(Cayman Islands Dollar),
+ ],
+ q(0037) => [
+ q(Chilean Peso),
+ ],
+ q(0038) => [
+ q(Unidades de fomento),
+ ],
+ q(0039) => [
+ q(Yuan Renminbi),
+ ],
+ q(0040) => [
+ q(Colombian Peso),
+ ],
+ q(0041) => [
+ q(Unidad de Valor Real),
+ ],
+ q(0042) => [
+ q(Comoro Franc),
+ ],
+ q(0043) => [
+ q(Congolese Franc),
+ ],
+ q(0044) => [
+ q(New Zealand Dollar),
+ ],
+ q(0045) => [
+ q(Costa Rican Colon),
+ ],
+ q(0046) => [
+ q(Croatian Kuna),
+ ],
+ q(0047) => [
+ q(Cuban Peso),
+ ],
+ q(0048) => [
+ q(Peso Convertible),
+ ],
+ q(0049) => [
+ q(Czech Koruna),
+ ],
+ q(0050) => [
+ q(Danish Krone),
+ ],
+ q(0051) => [
+ q(Djibouti Franc),
+ ],
+ q(0052) => [
+ q(Dominican Peso),
+ ],
+ q(0053) => [
+ q(Egyptian Pound),
+ ],
+ q(0054) => [
+ q(El Salvador Colon),
+ ],
+ q(0055) => [
+ q(Nakfa),
+ ],
+ q(0056) => [
+ q(Kroon),
+ ],
+ q(0057) => [
+ q(Ethiopian Birr),
+ ],
+ q(0058) => [
+ q(Falkland Islands Pound),
+ ],
+ q(0059) => [
+ q(Fiji Dollar),
+ ],
+ q(0060) => [
+ q(CFP Franc),
+ ],
+ q(0061) => [
+ q(Dalasi),
+ ],
+ q(0062) => [
+ q(Lari),
+ ],
+ q(0063) => [
+ q(Cedi),
+ ],
+ q(0064) => [
+ q(Gibraltar Pound),
+ ],
+ q(0065) => [
+ q(Quetzal),
+ ],
+ q(0066) => [
+ q(Pound Sterling),
+ ],
+ q(0067) => [
+ q(Guinea Franc),
+ ],
+ q(0068) => [
+ q(Guinea-Bissau Peso),
+ ],
+ q(0069) => [
+ q(Guyana Dollar),
+ ],
+ q(0070) => [
+ q(Gourde),
+ ],
+ q(0071) => [
+ q(Lempira),
+ ],
+ q(0072) => [
+ q(Hong Kong Dollar),
+ ],
+ q(0073) => [
+ q(Forint),
+ ],
+ q(0074) => [
+ q(Iceland Krona),
+ ],
+ q(0075) => [
+ q(Rupiah),
+ ],
+ q(0076) => [
+ q(Iranian Rial),
+ ],
+ q(0077) => [
+ q(Iraqi Dinar),
+ ],
+ q(0078) => [
+ q(New Israeli Sheqel),
+ ],
+ q(0079) => [
+ q(Jamaican Dollar),
+ ],
+ q(0080) => [
+ q(Yen),
+ ],
+ q(0081) => [
+ q(Jordanian Dinar),
+ ],
+ q(0082) => [
+ q(Tenge),
+ ],
+ q(0083) => [
+ q(Kenyan Shilling),
+ ],
+ q(0084) => [
+ q(North Korean Won),
+ ],
+ q(0085) => [
+ q(Won),
+ ],
+ q(0086) => [
+ q(Kuwaiti Dinar),
+ ],
+ q(0087) => [
+ q(Som),
+ ],
+ q(0088) => [
+ q(Kip),
+ ],
+ q(0089) => [
+ q(Latvian Lats),
+ ],
+ q(0090) => [
+ q(Lebanese Pound),
+ ],
+ q(0091) => [
+ q(Rand),
+ ],
+ q(0092) => [
+ q(Loti),
+ ],
+ q(0093) => [
+ q(Liberian Dollar),
+ ],
+ q(0094) => [
+ q(Libyan Dinar),
+ ],
+ q(0095) => [
+ q(Swiss Franc),
+ ],
+ q(0096) => [
+ q(Lithuanian Litas),
+ ],
+ q(0097) => [
+ q(Pataca),
+ ],
+ q(0098) => [
+ q(Denar),
+ ],
+ q(0099) => [
+ q(Malagasy Ariary),
+ ],
+ q(0100) => [
+ q(Kwacha),
+ ],
+ q(0101) => [
+ q(Malaysian Ringgit),
+ ],
+ q(0102) => [
+ q(Rufiyaa),
+ ],
+ q(0103) => [
+ q(Ouguiya),
+ ],
+ q(0104) => [
+ q(Mauritius Rupee),
+ ],
+ q(0105) => [
+ q(Mexican Peso),
+ ],
+ q(0106) => [
+ q(Mexican Unidad de Inversion (UDI)),
+ ],
+ q(0107) => [
+ q(Moldovan Leu),
+ ],
+ q(0108) => [
+ q(Tugrik),
+ ],
+ q(0109) => [
+ q(Moroccan Dirham),
+ ],
+ q(0110) => [
+ q(Metical),
+ ],
+ q(0111) => [
+ q(Kyat),
+ ],
+ q(0112) => [
+ q(Namibia Dollar),
+ ],
+ q(0113) => [
+ q(Nepalese Rupee),
+ ],
+ q(0114) => [
+ q(Netherlands Antillian Guilder),
+ ],
+ q(0115) => [
+ q(Cordoba Oro),
+ ],
+ q(0116) => [
+ q(Naira),
+ ],
+ q(0117) => [
+ q(Rial Omani),
+ ],
+ q(0118) => [
+ q(Pakistan Rupee),
+ ],
+ q(0119) => [
+ q(Balboa),
+ ],
+ q(0120) => [
+ q(Kina),
+ ],
+ q(0121) => [
+ q(Guarani),
+ ],
+ q(0122) => [
+ q(Nuevo Sol),
+ ],
+ q(0123) => [
+ q(Philippine Peso),
+ ],
+ q(0124) => [
+ q(Zloty),
+ ],
+ q(0125) => [
+ q(Qatari Rial),
+ ],
+ q(0126) => [
+ q(New Leu),
+ ],
+ q(0127) => [
+ q(Russian Ruble),
+ ],
+ q(0128) => [
+ q(Rwanda Franc),
+ ],
+ q(0129) => [
+ q(Saint Helena Pound),
+ ],
+ q(0130) => [
+ q(Tala),
+ ],
+ q(0131) => [
+ q(Dobra),
+ ],
+ q(0132) => [
+ q(Saudi Riyal),
+ ],
+ q(0133) => [
+ q(Serbian Dinar),
+ ],
+ q(0134) => [
+ q(Seychelles Rupee),
+ ],
+ q(0135) => [
+ q(Leone),
+ ],
+ q(0136) => [
+ q(Singapore Dollar),
+ ],
+ q(0137) => [
+ q(Solomon Islands Dollar),
+ ],
+ q(0138) => [
+ q(Somali Shilling),
+ ],
+ q(0139) => [
+ q(Sri Lanka Rupee),
+ ],
+ q(0140) => [
+ q(Sudanese Pound),
+ ],
+ q(0141) => [
+ q(Surinam Dollar),
+ ],
+ q(0142) => [
+ q(Lilangeni),
+ ],
+ q(0143) => [
+ q(Swedish Krona),
+ ],
+ q(0144) => [
+ q(WIR Franc),
+ ],
+ q(0145) => [
+ q(WIR Euro),
+ ],
+ q(0146) => [
+ q(Syrian Pound),
+ ],
+ q(0147) => [
+ q(New Taiwan Dollar),
+ ],
+ q(0148) => [
+ q(Somoni),
+ ],
+ q(0149) => [
+ q(Tanzanian Shilling),
+ ],
+ q(0150) => [
+ q(Baht),
+ ],
+ q(0151) => [
+ q(Pa'anga),
+ ],
+ q(0152) => [
+ q(Trinidad and Tobago Dollar),
+ ],
+ q(0153) => [
+ q(Tunisian Dinar),
+ ],
+ q(0154) => [
+ q(Turkish Lira),
+ ],
+ q(0155) => [
+ q(Manat),
+ ],
+ q(0156) => [
+ q(Uganda Shilling),
+ ],
+ q(0157) => [
+ q(Hryvnia),
+ ],
+ q(0158) => [
+ q(UAE Dirham),
+ ],
+ q(0159) => [
+ q(US Dollar (Same day)),
+ ],
+ q(0160) => [
+ q(US Dollar (Next day)),
+ ],
+ q(0161) => [
+ q(Peso Uruguayo),
+ ],
+ q(0162) => [
+ q(Uruguay Peso en Unidades Indexadas),
+ ],
+ q(0163) => [
+ q(Uzbekistan Sum),
+ ],
+ q(0164) => [
+ q(Vatu),
+ ],
+ q(0165) => [
+ q(Bolivar Fuerte),
+ ],
+ q(0166) => [
+ q(Dong),
+ ],
+ q(0167) => [
+ q(Yemeni Rial),
+ ],
+ q(0168) => [
+ q(Zambian Kwacha),
+ ],
+ q(0169) => [
+ q(Zimbabwe Dollar),
+ ],
+ q(0170) => [
+ q(Gold),
+ ],
+ q(0171) => [
+ q(Bond Markets Units European Composite Unit (EURCO)),
+ ],
+ q(0172) => [
+ q(European Monetary Unit (E.M.U.-6)),
+ ],
+ q(0173) => [
+ q(European Unit of Account 9(E.U.A.-9)),
+ ],
+ q(0174) => [
+ q(European Unit of Account 17(E.U.A.-17)),
+ ],
+ q(0175) => [
+ q(SDR),
+ ],
+ q(0176) => [
+ q(Palladium),
+ ],
+ q(0177) => [
+ q(Platinum),
+ ],
+ q(0178) => [
+ q(Silver),
+ ],
+ q(0179) => [
+ q(UIC-Franc),
+ ],
+};
+
+$Locale::Codes::Data{'currency'}{'alias2id'} = {
+ q(afghani) => [
+ q(0001),
+ q(0),
+ ],
+ q(algerian dinar) => [
+ q(0004),
+ q(0),
+ ],
+ q(argentine peso) => [
+ q(0008),
+ q(0),
+ ],
+ q(armenian dram) => [
+ q(0009),
+ q(0),
+ ],
+ q(aruban guilder) => [
+ q(0010),
+ q(0),
+ ],
+ q(australian dollar) => [
+ q(0011),
+ q(0),
+ ],
+ q(azerbaijanian manat) => [
+ q(0012),
+ q(0),
+ ],
+ q(bahamian dollar) => [
+ q(0013),
+ q(0),
+ ],
+ q(bahraini dinar) => [
+ q(0014),
+ q(0),
+ ],
+ q(baht) => [
+ q(0150),
+ q(0),
+ ],
+ q(balboa) => [
+ q(0119),
+ q(0),
+ ],
+ q(barbados dollar) => [
+ q(0016),
+ q(0),
+ ],
+ q(belarussian ruble) => [
+ q(0017),
+ q(0),
+ ],
+ q(belize dollar) => [
+ q(0018),
+ q(0),
+ ],
+ q(bermudian dollar (customarily known as bermuda dollar)) => [
+ q(0020),
+ q(0),
+ ],
+ q(bolivar fuerte) => [
+ q(0165),
+ q(0),
+ ],
+ q(boliviano) => [
+ q(0023),
+ q(0),
+ ],
+ q(bond markets units european composite unit (eurco)) => [
+ q(0171),
+ q(0),
+ ],
+ q(brazilian real) => [
+ q(0028),
+ q(0),
+ ],
+ q(brunei dollar) => [
+ q(0029),
+ q(0),
+ ],
+ q(bulgarian lev) => [
+ q(0030),
+ q(0),
+ ],
+ q(burundi franc) => [
+ q(0031),
+ q(0),
+ ],
+ q(canadian dollar) => [
+ q(0034),
+ q(0),
+ ],
+ q(cape verde escudo) => [
+ q(0035),
+ q(0),
+ ],
+ q(cayman islands dollar) => [
+ q(0036),
+ q(0),
+ ],
+ q(cedi) => [
+ q(0063),
+ q(0),
+ ],
+ q(cfa franc bceao) => [
+ q(0019),
+ q(0),
+ ],
+ q(cfa franc beac) => [
+ q(0033),
+ q(0),
+ ],
+ q(cfp franc) => [
+ q(0060),
+ q(0),
+ ],
+ q(chilean peso) => [
+ q(0037),
+ q(0),
+ ],
+ q(colombian peso) => [
+ q(0040),
+ q(0),
+ ],
+ q(comoro franc) => [
+ q(0042),
+ q(0),
+ ],
+ q(congolese franc) => [
+ q(0043),
+ q(0),
+ ],
+ q(convertible marks) => [
+ q(0025),
+ q(0),
+ ],
+ q(cordoba oro) => [
+ q(0115),
+ q(0),
+ ],
+ q(costa rican colon) => [
+ q(0045),
+ q(0),
+ ],
+ q(croatian kuna) => [
+ q(0046),
+ q(0),
+ ],
+ q(cuban peso) => [
+ q(0047),
+ q(0),
+ ],
+ q(czech koruna) => [
+ q(0049),
+ q(0),
+ ],
+ q(dalasi) => [
+ q(0061),
+ q(0),
+ ],
+ q(danish krone) => [
+ q(0050),
+ q(0),
+ ],
+ q(denar) => [
+ q(0098),
+ q(0),
+ ],
+ q(djibouti franc) => [
+ q(0051),
+ q(0),
+ ],
+ q(dobra) => [
+ q(0131),
+ q(0),
+ ],
+ q(dominican peso) => [
+ q(0052),
+ q(0),
+ ],
+ q(dong) => [
+ q(0166),
+ q(0),
+ ],
+ q(east caribbean dollar) => [
+ q(0007),
+ q(0),
+ ],
+ q(egyptian pound) => [
+ q(0053),
+ q(0),
+ ],
+ q(el salvador colon) => [
+ q(0054),
+ q(0),
+ ],
+ q(ethiopian birr) => [
+ q(0057),
+ q(0),
+ ],
+ q(euro) => [
+ q(0002),
+ q(0),
+ ],
+ q(european monetary unit (e.m.u.-6)) => [
+ q(0172),
+ q(0),
+ ],
+ q(european unit of account 17(e.u.a.-17)) => [
+ q(0174),
+ q(0),
+ ],
+ q(european unit of account 9(e.u.a.-9)) => [
+ q(0173),
+ q(0),
+ ],
+ q(falkland islands pound) => [
+ q(0058),
+ q(0),
+ ],
+ q(fiji dollar) => [
+ q(0059),
+ q(0),
+ ],
+ q(forint) => [
+ q(0073),
+ q(0),
+ ],
+ q(gibraltar pound) => [
+ q(0064),
+ q(0),
+ ],
+ q(gold) => [
+ q(0170),
+ q(0),
+ ],
+ q(gourde) => [
+ q(0070),
+ q(0),
+ ],
+ q(guarani) => [
+ q(0121),
+ q(0),
+ ],
+ q(guinea franc) => [
+ q(0067),
+ q(0),
+ ],
+ q(guinea-bissau peso) => [
+ q(0068),
+ q(0),
+ ],
+ q(guyana dollar) => [
+ q(0069),
+ q(0),
+ ],
+ q(hong kong dollar) => [
+ q(0072),
+ q(0),
+ ],
+ q(hryvnia) => [
+ q(0157),
+ q(0),
+ ],
+ q(iceland krona) => [
+ q(0074),
+ q(0),
+ ],
+ q(indian rupee) => [
+ q(0021),
+ q(0),
+ ],
+ q(iranian rial) => [
+ q(0076),
+ q(0),
+ ],
+ q(iraqi dinar) => [
+ q(0077),
+ q(0),
+ ],
+ q(jamaican dollar) => [
+ q(0079),
+ q(0),
+ ],
+ q(jordanian dinar) => [
+ q(0081),
+ q(0),
+ ],
+ q(kenyan shilling) => [
+ q(0083),
+ q(0),
+ ],
+ q(kina) => [
+ q(0120),
+ q(0),
+ ],
+ q(kip) => [
+ q(0088),
+ q(0),
+ ],
+ q(kroon) => [
+ q(0056),
+ q(0),
+ ],
+ q(kuwaiti dinar) => [
+ q(0086),
+ q(0),
+ ],
+ q(kwacha) => [
+ q(0100),
+ q(0),
+ ],
+ q(kwanza) => [
+ q(0006),
+ q(0),
+ ],
+ q(kyat) => [
+ q(0111),
+ q(0),
+ ],
+ q(lari) => [
+ q(0062),
+ q(0),
+ ],
+ q(latvian lats) => [
+ q(0089),
+ q(0),
+ ],
+ q(lebanese pound) => [
+ q(0090),
+ q(0),
+ ],
+ q(lek) => [
+ q(0003),
+ q(0),
+ ],
+ q(lempira) => [
+ q(0071),
+ q(0),
+ ],
+ q(leone) => [
+ q(0135),
+ q(0),
+ ],
+ q(liberian dollar) => [
+ q(0093),
+ q(0),
+ ],
+ q(libyan dinar) => [
+ q(0094),
+ q(0),
+ ],
+ q(lilangeni) => [
+ q(0142),
+ q(0),
+ ],
+ q(lithuanian litas) => [
+ q(0096),
+ q(0),
+ ],
+ q(loti) => [
+ q(0092),
+ q(0),
+ ],
+ q(malagasy ariary) => [
+ q(0099),
+ q(0),
+ ],
+ q(malaysian ringgit) => [
+ q(0101),
+ q(0),
+ ],
+ q(manat) => [
+ q(0155),
+ q(0),
+ ],
+ q(mauritius rupee) => [
+ q(0104),
+ q(0),
+ ],
+ q(metical) => [
+ q(0110),
+ q(0),
+ ],
+ q(mexican peso) => [
+ q(0105),
+ q(0),
+ ],
+ q(mexican unidad de inversion (udi)) => [
+ q(0106),
+ q(0),
+ ],
+ q(moldovan leu) => [
+ q(0107),
+ q(0),
+ ],
+ q(moroccan dirham) => [
+ q(0109),
+ q(0),
+ ],
+ q(mvdol) => [
+ q(0024),
+ q(0),
+ ],
+ q(naira) => [
+ q(0116),
+ q(0),
+ ],
+ q(nakfa) => [
+ q(0055),
+ q(0),
+ ],
+ q(namibia dollar) => [
+ q(0112),
+ q(0),
+ ],
+ q(nepalese rupee) => [
+ q(0113),
+ q(0),
+ ],
+ q(netherlands antillian guilder) => [
+ q(0114),
+ q(0),
+ ],
+ q(new israeli sheqel) => [
+ q(0078),
+ q(0),
+ ],
+ q(new leu) => [
+ q(0126),
+ q(0),
+ ],
+ q(new taiwan dollar) => [
+ q(0147),
+ q(0),
+ ],
+ q(new zealand dollar) => [
+ q(0044),
+ q(0),
+ ],
+ q(ngultrum) => [
+ q(0022),
+ q(0),
+ ],
+ q(north korean won) => [
+ q(0084),
+ q(0),
+ ],
+ q(norwegian krone) => [
+ q(0027),
+ q(0),
+ ],
+ q(nuevo sol) => [
+ q(0122),
+ q(0),
+ ],
+ q(ouguiya) => [
+ q(0103),
+ q(0),
+ ],
+ q(pa'anga) => [
+ q(0151),
+ q(0),
+ ],
+ q(pakistan rupee) => [
+ q(0118),
+ q(0),
+ ],
+ q(palladium) => [
+ q(0176),
+ q(0),
+ ],
+ q(pataca) => [
+ q(0097),
+ q(0),
+ ],
+ q(peso convertible) => [
+ q(0048),
+ q(0),
+ ],
+ q(peso uruguayo) => [
+ q(0161),
+ q(0),
+ ],
+ q(philippine peso) => [
+ q(0123),
+ q(0),
+ ],
+ q(platinum) => [
+ q(0177),
+ q(0),
+ ],
+ q(pound sterling) => [
+ q(0066),
+ q(0),
+ ],
+ q(pula) => [
+ q(0026),
+ q(0),
+ ],
+ q(qatari rial) => [
+ q(0125),
+ q(0),
+ ],
+ q(quetzal) => [
+ q(0065),
+ q(0),
+ ],
+ q(rand) => [
+ q(0091),
+ q(0),
+ ],
+ q(rial omani) => [
+ q(0117),
+ q(0),
+ ],
+ q(riel) => [
+ q(0032),
+ q(0),
+ ],
+ q(rufiyaa) => [
+ q(0102),
+ q(0),
+ ],
+ q(rupiah) => [
+ q(0075),
+ q(0),
+ ],
+ q(russian ruble) => [
+ q(0127),
+ q(0),
+ ],
+ q(rwanda franc) => [
+ q(0128),
+ q(0),
+ ],
+ q(saint helena pound) => [
+ q(0129),
+ q(0),
+ ],
+ q(saudi riyal) => [
+ q(0132),
+ q(0),
+ ],
+ q(sdr) => [
+ q(0175),
+ q(0),
+ ],
+ q(serbian dinar) => [
+ q(0133),
+ q(0),
+ ],
+ q(seychelles rupee) => [
+ q(0134),
+ q(0),
+ ],
+ q(silver) => [
+ q(0178),
+ q(0),
+ ],
+ q(singapore dollar) => [
+ q(0136),
+ q(0),
+ ],
+ q(solomon islands dollar) => [
+ q(0137),
+ q(0),
+ ],
+ q(som) => [
+ q(0087),
+ q(0),
+ ],
+ q(somali shilling) => [
+ q(0138),
+ q(0),
+ ],
+ q(somoni) => [
+ q(0148),
+ q(0),
+ ],
+ q(sri lanka rupee) => [
+ q(0139),
+ q(0),
+ ],
+ q(sudanese pound) => [
+ q(0140),
+ q(0),
+ ],
+ q(surinam dollar) => [
+ q(0141),
+ q(0),
+ ],
+ q(swedish krona) => [
+ q(0143),
+ q(0),
+ ],
+ q(swiss franc) => [
+ q(0095),
+ q(0),
+ ],
+ q(syrian pound) => [
+ q(0146),
+ q(0),
+ ],
+ q(taka) => [
+ q(0015),
+ q(0),
+ ],
+ q(tala) => [
+ q(0130),
+ q(0),
+ ],
+ q(tanzanian shilling) => [
+ q(0149),
+ q(0),
+ ],
+ q(tenge) => [
+ q(0082),
+ q(0),
+ ],
+ q(trinidad and tobago dollar) => [
+ q(0152),
+ q(0),
+ ],
+ q(tugrik) => [
+ q(0108),
+ q(0),
+ ],
+ q(tunisian dinar) => [
+ q(0153),
+ q(0),
+ ],
+ q(turkish lira) => [
+ q(0154),
+ q(0),
+ ],
+ q(uae dirham) => [
+ q(0158),
+ q(0),
+ ],
+ q(uganda shilling) => [
+ q(0156),
+ q(0),
+ ],
+ q(uic-franc) => [
+ q(0179),
+ q(0),
+ ],
+ q(unidad de valor real) => [
+ q(0041),
+ q(0),
+ ],
+ q(unidades de fomento) => [
+ q(0038),
+ q(0),
+ ],
+ q(uruguay peso en unidades indexadas) => [
+ q(0162),
+ q(0),
+ ],
+ q(us dollar) => [
+ q(0005),
+ q(0),
+ ],
+ q(us dollar (next day)) => [
+ q(0160),
+ q(0),
+ ],
+ q(us dollar (same day)) => [
+ q(0159),
+ q(0),
+ ],
+ q(uzbekistan sum) => [
+ q(0163),
+ q(0),
+ ],
+ q(vatu) => [
+ q(0164),
+ q(0),
+ ],
+ q(wir euro) => [
+ q(0145),
+ q(0),
+ ],
+ q(wir franc) => [
+ q(0144),
+ q(0),
+ ],
+ q(won) => [
+ q(0085),
+ q(0),
+ ],
+ q(yemeni rial) => [
+ q(0167),
+ q(0),
+ ],
+ q(yen) => [
+ q(0080),
+ q(0),
+ ],
+ q(yuan renminbi) => [
+ q(0039),
+ q(0),
+ ],
+ q(zambian kwacha) => [
+ q(0168),
+ q(0),
+ ],
+ q(zimbabwe dollar) => [
+ q(0169),
+ q(0),
+ ],
+ q(zloty) => [
+ q(0124),
+ q(0),
+ ],
+};
+
+$Locale::Codes::Data{'currency'}{'code2id'} = {
+ q(alpha) => {
+ q(AED) => [
+ q(0158),
+ q(0),
+ ],
+ q(AFN) => [
+ q(0001),
+ q(0),
+ ],
+ q(ALL) => [
+ q(0003),
+ q(0),
+ ],
+ q(AMD) => [
+ q(0009),
+ q(0),
+ ],
+ q(ANG) => [
+ q(0114),
+ q(0),
+ ],
+ q(AOA) => [
+ q(0006),
+ q(0),
+ ],
+ q(ARS) => [
+ q(0008),
+ q(0),
+ ],
+ q(AUD) => [
+ q(0011),
+ q(0),
+ ],
+ q(AWG) => [
+ q(0010),
+ q(0),
+ ],
+ q(AZN) => [
+ q(0012),
+ q(0),
+ ],
+ q(BAM) => [
+ q(0025),
+ q(0),
+ ],
+ q(BBD) => [
+ q(0016),
+ q(0),
+ ],
+ q(BDT) => [
+ q(0015),
+ q(0),
+ ],
+ q(BGN) => [
+ q(0030),
+ q(0),
+ ],
+ q(BHD) => [
+ q(0014),
+ q(0),
+ ],
+ q(BIF) => [
+ q(0031),
+ q(0),
+ ],
+ q(BMD) => [
+ q(0020),
+ q(0),
+ ],
+ q(BND) => [
+ q(0029),
+ q(0),
+ ],
+ q(BOB) => [
+ q(0023),
+ q(0),
+ ],
+ q(BOV) => [
+ q(0024),
+ q(0),
+ ],
+ q(BRL) => [
+ q(0028),
+ q(0),
+ ],
+ q(BSD) => [
+ q(0013),
+ q(0),
+ ],
+ q(BTN) => [
+ q(0022),
+ q(0),
+ ],
+ q(BWP) => [
+ q(0026),
+ q(0),
+ ],
+ q(BYR) => [
+ q(0017),
+ q(0),
+ ],
+ q(BZD) => [
+ q(0018),
+ q(0),
+ ],
+ q(CAD) => [
+ q(0034),
+ q(0),
+ ],
+ q(CDF) => [
+ q(0043),
+ q(0),
+ ],
+ q(CHE) => [
+ q(0145),
+ q(0),
+ ],
+ q(CHF) => [
+ q(0095),
+ q(0),
+ ],
+ q(CHW) => [
+ q(0144),
+ q(0),
+ ],
+ q(CLF) => [
+ q(0038),
+ q(0),
+ ],
+ q(CLP) => [
+ q(0037),
+ q(0),
+ ],
+ q(CNY) => [
+ q(0039),
+ q(0),
+ ],
+ q(COP) => [
+ q(0040),
+ q(0),
+ ],
+ q(COU) => [
+ q(0041),
+ q(0),
+ ],
+ q(CRC) => [
+ q(0045),
+ q(0),
+ ],
+ q(CUC) => [
+ q(0048),
+ q(0),
+ ],
+ q(CUP) => [
+ q(0047),
+ q(0),
+ ],
+ q(CVE) => [
+ q(0035),
+ q(0),
+ ],
+ q(CZK) => [
+ q(0049),
+ q(0),
+ ],
+ q(DJF) => [
+ q(0051),
+ q(0),
+ ],
+ q(DKK) => [
+ q(0050),
+ q(0),
+ ],
+ q(DOP) => [
+ q(0052),
+ q(0),
+ ],
+ q(DZD) => [
+ q(0004),
+ q(0),
+ ],
+ q(EEK) => [
+ q(0056),
+ q(0),
+ ],
+ q(EGP) => [
+ q(0053),
+ q(0),
+ ],
+ q(ERN) => [
+ q(0055),
+ q(0),
+ ],
+ q(ETB) => [
+ q(0057),
+ q(0),
+ ],
+ q(EUR) => [
+ q(0002),
+ q(0),
+ ],
+ q(FJD) => [
+ q(0059),
+ q(0),
+ ],
+ q(FKP) => [
+ q(0058),
+ q(0),
+ ],
+ q(GBP) => [
+ q(0066),
+ q(0),
+ ],
+ q(GEL) => [
+ q(0062),
+ q(0),
+ ],
+ q(GHS) => [
+ q(0063),
+ q(0),
+ ],
+ q(GIP) => [
+ q(0064),
+ q(0),
+ ],
+ q(GMD) => [
+ q(0061),
+ q(0),
+ ],
+ q(GNF) => [
+ q(0067),
+ q(0),
+ ],
+ q(GTQ) => [
+ q(0065),
+ q(0),
+ ],
+ q(GWP) => [
+ q(0068),
+ q(0),
+ ],
+ q(GYD) => [
+ q(0069),
+ q(0),
+ ],
+ q(HKD) => [
+ q(0072),
+ q(0),
+ ],
+ q(HNL) => [
+ q(0071),
+ q(0),
+ ],
+ q(HRK) => [
+ q(0046),
+ q(0),
+ ],
+ q(HTG) => [
+ q(0070),
+ q(0),
+ ],
+ q(HUF) => [
+ q(0073),
+ q(0),
+ ],
+ q(IDR) => [
+ q(0075),
+ q(0),
+ ],
+ q(ILS) => [
+ q(0078),
+ q(0),
+ ],
+ q(INR) => [
+ q(0021),
+ q(0),
+ ],
+ q(IQD) => [
+ q(0077),
+ q(0),
+ ],
+ q(IRR) => [
+ q(0076),
+ q(0),
+ ],
+ q(ISK) => [
+ q(0074),
+ q(0),
+ ],
+ q(JMD) => [
+ q(0079),
+ q(0),
+ ],
+ q(JOD) => [
+ q(0081),
+ q(0),
+ ],
+ q(JPY) => [
+ q(0080),
+ q(0),
+ ],
+ q(KES) => [
+ q(0083),
+ q(0),
+ ],
+ q(KGS) => [
+ q(0087),
+ q(0),
+ ],
+ q(KHR) => [
+ q(0032),
+ q(0),
+ ],
+ q(KMF) => [
+ q(0042),
+ q(0),
+ ],
+ q(KPW) => [
+ q(0084),
+ q(0),
+ ],
+ q(KRW) => [
+ q(0085),
+ q(0),
+ ],
+ q(KWD) => [
+ q(0086),
+ q(0),
+ ],
+ q(KYD) => [
+ q(0036),
+ q(0),
+ ],
+ q(KZT) => [
+ q(0082),
+ q(0),
+ ],
+ q(LAK) => [
+ q(0088),
+ q(0),
+ ],
+ q(LBP) => [
+ q(0090),
+ q(0),
+ ],
+ q(LKR) => [
+ q(0139),
+ q(0),
+ ],
+ q(LRD) => [
+ q(0093),
+ q(0),
+ ],
+ q(LSL) => [
+ q(0092),
+ q(0),
+ ],
+ q(LTL) => [
+ q(0096),
+ q(0),
+ ],
+ q(LVL) => [
+ q(0089),
+ q(0),
+ ],
+ q(LYD) => [
+ q(0094),
+ q(0),
+ ],
+ q(MAD) => [
+ q(0109),
+ q(0),
+ ],
+ q(MDL) => [
+ q(0107),
+ q(0),
+ ],
+ q(MGA) => [
+ q(0099),
+ q(0),
+ ],
+ q(MKD) => [
+ q(0098),
+ q(0),
+ ],
+ q(MMK) => [
+ q(0111),
+ q(0),
+ ],
+ q(MNT) => [
+ q(0108),
+ q(0),
+ ],
+ q(MOP) => [
+ q(0097),
+ q(0),
+ ],
+ q(MRO) => [
+ q(0103),
+ q(0),
+ ],
+ q(MUR) => [
+ q(0104),
+ q(0),
+ ],
+ q(MVR) => [
+ q(0102),
+ q(0),
+ ],
+ q(MWK) => [
+ q(0100),
+ q(0),
+ ],
+ q(MXN) => [
+ q(0105),
+ q(0),
+ ],
+ q(MXV) => [
+ q(0106),
+ q(0),
+ ],
+ q(MYR) => [
+ q(0101),
+ q(0),
+ ],
+ q(MZN) => [
+ q(0110),
+ q(0),
+ ],
+ q(NAD) => [
+ q(0112),
+ q(0),
+ ],
+ q(NGN) => [
+ q(0116),
+ q(0),
+ ],
+ q(NIO) => [
+ q(0115),
+ q(0),
+ ],
+ q(NOK) => [
+ q(0027),
+ q(0),
+ ],
+ q(NPR) => [
+ q(0113),
+ q(0),
+ ],
+ q(NZD) => [
+ q(0044),
+ q(0),
+ ],
+ q(OMR) => [
+ q(0117),
+ q(0),
+ ],
+ q(PAB) => [
+ q(0119),
+ q(0),
+ ],
+ q(PEN) => [
+ q(0122),
+ q(0),
+ ],
+ q(PGK) => [
+ q(0120),
+ q(0),
+ ],
+ q(PHP) => [
+ q(0123),
+ q(0),
+ ],
+ q(PKR) => [
+ q(0118),
+ q(0),
+ ],
+ q(PLN) => [
+ q(0124),
+ q(0),
+ ],
+ q(PYG) => [
+ q(0121),
+ q(0),
+ ],
+ q(QAR) => [
+ q(0125),
+ q(0),
+ ],
+ q(RON) => [
+ q(0126),
+ q(0),
+ ],
+ q(RSD) => [
+ q(0133),
+ q(0),
+ ],
+ q(RUB) => [
+ q(0127),
+ q(0),
+ ],
+ q(RWF) => [
+ q(0128),
+ q(0),
+ ],
+ q(SAR) => [
+ q(0132),
+ q(0),
+ ],
+ q(SBD) => [
+ q(0137),
+ q(0),
+ ],
+ q(SCR) => [
+ q(0134),
+ q(0),
+ ],
+ q(SDG) => [
+ q(0140),
+ q(0),
+ ],
+ q(SEK) => [
+ q(0143),
+ q(0),
+ ],
+ q(SGD) => [
+ q(0136),
+ q(0),
+ ],
+ q(SHP) => [
+ q(0129),
+ q(0),
+ ],
+ q(SLL) => [
+ q(0135),
+ q(0),
+ ],
+ q(SOS) => [
+ q(0138),
+ q(0),
+ ],
+ q(SRD) => [
+ q(0141),
+ q(0),
+ ],
+ q(STD) => [
+ q(0131),
+ q(0),
+ ],
+ q(SVC) => [
+ q(0054),
+ q(0),
+ ],
+ q(SYP) => [
+ q(0146),
+ q(0),
+ ],
+ q(SZL) => [
+ q(0142),
+ q(0),
+ ],
+ q(THB) => [
+ q(0150),
+ q(0),
+ ],
+ q(TJS) => [
+ q(0148),
+ q(0),
+ ],
+ q(TMT) => [
+ q(0155),
+ q(0),
+ ],
+ q(TND) => [
+ q(0153),
+ q(0),
+ ],
+ q(TOP) => [
+ q(0151),
+ q(0),
+ ],
+ q(TRY) => [
+ q(0154),
+ q(0),
+ ],
+ q(TTD) => [
+ q(0152),
+ q(0),
+ ],
+ q(TWD) => [
+ q(0147),
+ q(0),
+ ],
+ q(TZS) => [
+ q(0149),
+ q(0),
+ ],
+ q(UAH) => [
+ q(0157),
+ q(0),
+ ],
+ q(UGX) => [
+ q(0156),
+ q(0),
+ ],
+ q(USD) => [
+ q(0005),
+ q(0),
+ ],
+ q(USN) => [
+ q(0160),
+ q(0),
+ ],
+ q(USS) => [
+ q(0159),
+ q(0),
+ ],
+ q(UYI) => [
+ q(0162),
+ q(0),
+ ],
+ q(UYU) => [
+ q(0161),
+ q(0),
+ ],
+ q(UZS) => [
+ q(0163),
+ q(0),
+ ],
+ q(VEF) => [
+ q(0165),
+ q(0),
+ ],
+ q(VND) => [
+ q(0166),
+ q(0),
+ ],
+ q(VUV) => [
+ q(0164),
+ q(0),
+ ],
+ q(WST) => [
+ q(0130),
+ q(0),
+ ],
+ q(XAF) => [
+ q(0033),
+ q(0),
+ ],
+ q(XAG) => [
+ q(0178),
+ q(0),
+ ],
+ q(XAU) => [
+ q(0170),
+ q(0),
+ ],
+ q(XBA) => [
+ q(0171),
+ q(0),
+ ],
+ q(XBB) => [
+ q(0172),
+ q(0),
+ ],
+ q(XBC) => [
+ q(0173),
+ q(0),
+ ],
+ q(XBD) => [
+ q(0174),
+ q(0),
+ ],
+ q(XCD) => [
+ q(0007),
+ q(0),
+ ],
+ q(XDR) => [
+ q(0175),
+ q(0),
+ ],
+ q(XFU) => [
+ q(0179),
+ q(0),
+ ],
+ q(XOF) => [
+ q(0019),
+ q(0),
+ ],
+ q(XPD) => [
+ q(0176),
+ q(0),
+ ],
+ q(XPF) => [
+ q(0060),
+ q(0),
+ ],
+ q(XPT) => [
+ q(0177),
+ q(0),
+ ],
+ q(YER) => [
+ q(0167),
+ q(0),
+ ],
+ q(ZAR) => [
+ q(0091),
+ q(0),
+ ],
+ q(ZMK) => [
+ q(0168),
+ q(0),
+ ],
+ q(ZWL) => [
+ q(0169),
+ q(0),
+ ],
+ },
+ q(num) => {
+ q(008) => [
+ q(0003),
+ q(0),
+ ],
+ q(012) => [
+ q(0004),
+ q(0),
+ ],
+ q(032) => [
+ q(0008),
+ q(0),
+ ],
+ q(036) => [
+ q(0011),
+ q(0),
+ ],
+ q(044) => [
+ q(0013),
+ q(0),
+ ],
+ q(048) => [
+ q(0014),
+ q(0),
+ ],
+ q(050) => [
+ q(0015),
+ q(0),
+ ],
+ q(051) => [
+ q(0009),
+ q(0),
+ ],
+ q(052) => [
+ q(0016),
+ q(0),
+ ],
+ q(060) => [
+ q(0020),
+ q(0),
+ ],
+ q(064) => [
+ q(0022),
+ q(0),
+ ],
+ q(068) => [
+ q(0023),
+ q(0),
+ ],
+ q(072) => [
+ q(0026),
+ q(0),
+ ],
+ q(084) => [
+ q(0018),
+ q(0),
+ ],
+ q(090) => [
+ q(0137),
+ q(0),
+ ],
+ q(096) => [
+ q(0029),
+ q(0),
+ ],
+ q(104) => [
+ q(0111),
+ q(0),
+ ],
+ q(108) => [
+ q(0031),
+ q(0),
+ ],
+ q(116) => [
+ q(0032),
+ q(0),
+ ],
+ q(124) => [
+ q(0034),
+ q(0),
+ ],
+ q(132) => [
+ q(0035),
+ q(0),
+ ],
+ q(136) => [
+ q(0036),
+ q(0),
+ ],
+ q(144) => [
+ q(0139),
+ q(0),
+ ],
+ q(152) => [
+ q(0037),
+ q(0),
+ ],
+ q(156) => [
+ q(0039),
+ q(0),
+ ],
+ q(170) => [
+ q(0040),
+ q(0),
+ ],
+ q(174) => [
+ q(0042),
+ q(0),
+ ],
+ q(188) => [
+ q(0045),
+ q(0),
+ ],
+ q(191) => [
+ q(0046),
+ q(0),
+ ],
+ q(192) => [
+ q(0047),
+ q(0),
+ ],
+ q(203) => [
+ q(0049),
+ q(0),
+ ],
+ q(208) => [
+ q(0050),
+ q(0),
+ ],
+ q(214) => [
+ q(0052),
+ q(0),
+ ],
+ q(222) => [
+ q(0054),
+ q(0),
+ ],
+ q(230) => [
+ q(0057),
+ q(0),
+ ],
+ q(232) => [
+ q(0055),
+ q(0),
+ ],
+ q(233) => [
+ q(0056),
+ q(0),
+ ],
+ q(238) => [
+ q(0058),
+ q(0),
+ ],
+ q(242) => [
+ q(0059),
+ q(0),
+ ],
+ q(262) => [
+ q(0051),
+ q(0),
+ ],
+ q(270) => [
+ q(0061),
+ q(0),
+ ],
+ q(292) => [
+ q(0064),
+ q(0),
+ ],
+ q(320) => [
+ q(0065),
+ q(0),
+ ],
+ q(324) => [
+ q(0067),
+ q(0),
+ ],
+ q(328) => [
+ q(0069),
+ q(0),
+ ],
+ q(332) => [
+ q(0070),
+ q(0),
+ ],
+ q(340) => [
+ q(0071),
+ q(0),
+ ],
+ q(344) => [
+ q(0072),
+ q(0),
+ ],
+ q(348) => [
+ q(0073),
+ q(0),
+ ],
+ q(352) => [
+ q(0074),
+ q(0),
+ ],
+ q(356) => [
+ q(0021),
+ q(0),
+ ],
+ q(360) => [
+ q(0075),
+ q(0),
+ ],
+ q(364) => [
+ q(0076),
+ q(0),
+ ],
+ q(368) => [
+ q(0077),
+ q(0),
+ ],
+ q(376) => [
+ q(0078),
+ q(0),
+ ],
+ q(388) => [
+ q(0079),
+ q(0),
+ ],
+ q(392) => [
+ q(0080),
+ q(0),
+ ],
+ q(398) => [
+ q(0082),
+ q(0),
+ ],
+ q(400) => [
+ q(0081),
+ q(0),
+ ],
+ q(404) => [
+ q(0083),
+ q(0),
+ ],
+ q(408) => [
+ q(0084),
+ q(0),
+ ],
+ q(410) => [
+ q(0085),
+ q(0),
+ ],
+ q(414) => [
+ q(0086),
+ q(0),
+ ],
+ q(417) => [
+ q(0087),
+ q(0),
+ ],
+ q(418) => [
+ q(0088),
+ q(0),
+ ],
+ q(422) => [
+ q(0090),
+ q(0),
+ ],
+ q(426) => [
+ q(0092),
+ q(0),
+ ],
+ q(428) => [
+ q(0089),
+ q(0),
+ ],
+ q(430) => [
+ q(0093),
+ q(0),
+ ],
+ q(434) => [
+ q(0094),
+ q(0),
+ ],
+ q(440) => [
+ q(0096),
+ q(0),
+ ],
+ q(446) => [
+ q(0097),
+ q(0),
+ ],
+ q(454) => [
+ q(0100),
+ q(0),
+ ],
+ q(458) => [
+ q(0101),
+ q(0),
+ ],
+ q(462) => [
+ q(0102),
+ q(0),
+ ],
+ q(478) => [
+ q(0103),
+ q(0),
+ ],
+ q(480) => [
+ q(0104),
+ q(0),
+ ],
+ q(484) => [
+ q(0105),
+ q(0),
+ ],
+ q(496) => [
+ q(0108),
+ q(0),
+ ],
+ q(498) => [
+ q(0107),
+ q(0),
+ ],
+ q(504) => [
+ q(0109),
+ q(0),
+ ],
+ q(512) => [
+ q(0117),
+ q(0),
+ ],
+ q(516) => [
+ q(0112),
+ q(0),
+ ],
+ q(524) => [
+ q(0113),
+ q(0),
+ ],
+ q(532) => [
+ q(0114),
+ q(0),
+ ],
+ q(533) => [
+ q(0010),
+ q(0),
+ ],
+ q(548) => [
+ q(0164),
+ q(0),
+ ],
+ q(554) => [
+ q(0044),
+ q(0),
+ ],
+ q(558) => [
+ q(0115),
+ q(0),
+ ],
+ q(566) => [
+ q(0116),
+ q(0),
+ ],
+ q(578) => [
+ q(0027),
+ q(0),
+ ],
+ q(586) => [
+ q(0118),
+ q(0),
+ ],
+ q(590) => [
+ q(0119),
+ q(0),
+ ],
+ q(598) => [
+ q(0120),
+ q(0),
+ ],
+ q(600) => [
+ q(0121),
+ q(0),
+ ],
+ q(604) => [
+ q(0122),
+ q(0),
+ ],
+ q(608) => [
+ q(0123),
+ q(0),
+ ],
+ q(624) => [
+ q(0068),
+ q(0),
+ ],
+ q(634) => [
+ q(0125),
+ q(0),
+ ],
+ q(643) => [
+ q(0127),
+ q(0),
+ ],
+ q(646) => [
+ q(0128),
+ q(0),
+ ],
+ q(654) => [
+ q(0129),
+ q(0),
+ ],
+ q(678) => [
+ q(0131),
+ q(0),
+ ],
+ q(682) => [
+ q(0132),
+ q(0),
+ ],
+ q(690) => [
+ q(0134),
+ q(0),
+ ],
+ q(694) => [
+ q(0135),
+ q(0),
+ ],
+ q(702) => [
+ q(0136),
+ q(0),
+ ],
+ q(704) => [
+ q(0166),
+ q(0),
+ ],
+ q(706) => [
+ q(0138),
+ q(0),
+ ],
+ q(710) => [
+ q(0091),
+ q(0),
+ ],
+ q(748) => [
+ q(0142),
+ q(0),
+ ],
+ q(752) => [
+ q(0143),
+ q(0),
+ ],
+ q(756) => [
+ q(0095),
+ q(0),
+ ],
+ q(760) => [
+ q(0146),
+ q(0),
+ ],
+ q(764) => [
+ q(0150),
+ q(0),
+ ],
+ q(776) => [
+ q(0151),
+ q(0),
+ ],
+ q(780) => [
+ q(0152),
+ q(0),
+ ],
+ q(784) => [
+ q(0158),
+ q(0),
+ ],
+ q(788) => [
+ q(0153),
+ q(0),
+ ],
+ q(800) => [
+ q(0156),
+ q(0),
+ ],
+ q(807) => [
+ q(0098),
+ q(0),
+ ],
+ q(818) => [
+ q(0053),
+ q(0),
+ ],
+ q(826) => [
+ q(0066),
+ q(0),
+ ],
+ q(834) => [
+ q(0149),
+ q(0),
+ ],
+ q(840) => [
+ q(0005),
+ q(0),
+ ],
+ q(858) => [
+ q(0161),
+ q(0),
+ ],
+ q(860) => [
+ q(0163),
+ q(0),
+ ],
+ q(882) => [
+ q(0130),
+ q(0),
+ ],
+ q(886) => [
+ q(0167),
+ q(0),
+ ],
+ q(894) => [
+ q(0168),
+ q(0),
+ ],
+ q(901) => [
+ q(0147),
+ q(0),
+ ],
+ q(931) => [
+ q(0048),
+ q(0),
+ ],
+ q(932) => [
+ q(0169),
+ q(0),
+ ],
+ q(934) => [
+ q(0155),
+ q(0),
+ ],
+ q(936) => [
+ q(0063),
+ q(0),
+ ],
+ q(937) => [
+ q(0165),
+ q(0),
+ ],
+ q(938) => [
+ q(0140),
+ q(0),
+ ],
+ q(940) => [
+ q(0162),
+ q(0),
+ ],
+ q(941) => [
+ q(0133),
+ q(0),
+ ],
+ q(943) => [
+ q(0110),
+ q(0),
+ ],
+ q(944) => [
+ q(0012),
+ q(0),
+ ],
+ q(946) => [
+ q(0126),
+ q(0),
+ ],
+ q(947) => [
+ q(0145),
+ q(0),
+ ],
+ q(948) => [
+ q(0144),
+ q(0),
+ ],
+ q(949) => [
+ q(0154),
+ q(0),
+ ],
+ q(950) => [
+ q(0033),
+ q(0),
+ ],
+ q(951) => [
+ q(0007),
+ q(0),
+ ],
+ q(952) => [
+ q(0019),
+ q(0),
+ ],
+ q(953) => [
+ q(0060),
+ q(0),
+ ],
+ q(955) => [
+ q(0171),
+ q(0),
+ ],
+ q(956) => [
+ q(0172),
+ q(0),
+ ],
+ q(957) => [
+ q(0173),
+ q(0),
+ ],
+ q(958) => [
+ q(0174),
+ q(0),
+ ],
+ q(959) => [
+ q(0170),
+ q(0),
+ ],
+ q(960) => [
+ q(0175),
+ q(0),
+ ],
+ q(961) => [
+ q(0178),
+ q(0),
+ ],
+ q(962) => [
+ q(0177),
+ q(0),
+ ],
+ q(964) => [
+ q(0176),
+ q(0),
+ ],
+ q(968) => [
+ q(0141),
+ q(0),
+ ],
+ q(969) => [
+ q(0099),
+ q(0),
+ ],
+ q(970) => [
+ q(0041),
+ q(0),
+ ],
+ q(971) => [
+ q(0001),
+ q(0),
+ ],
+ q(972) => [
+ q(0148),
+ q(0),
+ ],
+ q(973) => [
+ q(0006),
+ q(0),
+ ],
+ q(974) => [
+ q(0017),
+ q(0),
+ ],
+ q(975) => [
+ q(0030),
+ q(0),
+ ],
+ q(976) => [
+ q(0043),
+ q(0),
+ ],
+ q(977) => [
+ q(0025),
+ q(0),
+ ],
+ q(978) => [
+ q(0002),
+ q(0),
+ ],
+ q(979) => [
+ q(0106),
+ q(0),
+ ],
+ q(980) => [
+ q(0157),
+ q(0),
+ ],
+ q(981) => [
+ q(0062),
+ q(0),
+ ],
+ q(984) => [
+ q(0024),
+ q(0),
+ ],
+ q(985) => [
+ q(0124),
+ q(0),
+ ],
+ q(986) => [
+ q(0028),
+ q(0),
+ ],
+ q(990) => [
+ q(0038),
+ q(0),
+ ],
+ q(997) => [
+ q(0160),
+ q(0),
+ ],
+ q(998) => [
+ q(0159),
+ q(0),
+ ],
+ },
+};
+
+$Locale::Codes::Data{'currency'}{'id2code'} = {
+ q(alpha) => {
+ q(0001) => q(AFN),
+ q(0002) => q(EUR),
+ q(0003) => q(ALL),
+ q(0004) => q(DZD),
+ q(0005) => q(USD),
+ q(0006) => q(AOA),
+ q(0007) => q(XCD),
+ q(0008) => q(ARS),
+ q(0009) => q(AMD),
+ q(0010) => q(AWG),
+ q(0011) => q(AUD),
+ q(0012) => q(AZN),
+ q(0013) => q(BSD),
+ q(0014) => q(BHD),
+ q(0015) => q(BDT),
+ q(0016) => q(BBD),
+ q(0017) => q(BYR),
+ q(0018) => q(BZD),
+ q(0019) => q(XOF),
+ q(0020) => q(BMD),
+ q(0021) => q(INR),
+ q(0022) => q(BTN),
+ q(0023) => q(BOB),
+ q(0024) => q(BOV),
+ q(0025) => q(BAM),
+ q(0026) => q(BWP),
+ q(0027) => q(NOK),
+ q(0028) => q(BRL),
+ q(0029) => q(BND),
+ q(0030) => q(BGN),
+ q(0031) => q(BIF),
+ q(0032) => q(KHR),
+ q(0033) => q(XAF),
+ q(0034) => q(CAD),
+ q(0035) => q(CVE),
+ q(0036) => q(KYD),
+ q(0037) => q(CLP),
+ q(0038) => q(CLF),
+ q(0039) => q(CNY),
+ q(0040) => q(COP),
+ q(0041) => q(COU),
+ q(0042) => q(KMF),
+ q(0043) => q(CDF),
+ q(0044) => q(NZD),
+ q(0045) => q(CRC),
+ q(0046) => q(HRK),
+ q(0047) => q(CUP),
+ q(0048) => q(CUC),
+ q(0049) => q(CZK),
+ q(0050) => q(DKK),
+ q(0051) => q(DJF),
+ q(0052) => q(DOP),
+ q(0053) => q(EGP),
+ q(0054) => q(SVC),
+ q(0055) => q(ERN),
+ q(0056) => q(EEK),
+ q(0057) => q(ETB),
+ q(0058) => q(FKP),
+ q(0059) => q(FJD),
+ q(0060) => q(XPF),
+ q(0061) => q(GMD),
+ q(0062) => q(GEL),
+ q(0063) => q(GHS),
+ q(0064) => q(GIP),
+ q(0065) => q(GTQ),
+ q(0066) => q(GBP),
+ q(0067) => q(GNF),
+ q(0068) => q(GWP),
+ q(0069) => q(GYD),
+ q(0070) => q(HTG),
+ q(0071) => q(HNL),
+ q(0072) => q(HKD),
+ q(0073) => q(HUF),
+ q(0074) => q(ISK),
+ q(0075) => q(IDR),
+ q(0076) => q(IRR),
+ q(0077) => q(IQD),
+ q(0078) => q(ILS),
+ q(0079) => q(JMD),
+ q(0080) => q(JPY),
+ q(0081) => q(JOD),
+ q(0082) => q(KZT),
+ q(0083) => q(KES),
+ q(0084) => q(KPW),
+ q(0085) => q(KRW),
+ q(0086) => q(KWD),
+ q(0087) => q(KGS),
+ q(0088) => q(LAK),
+ q(0089) => q(LVL),
+ q(0090) => q(LBP),
+ q(0091) => q(ZAR),
+ q(0092) => q(LSL),
+ q(0093) => q(LRD),
+ q(0094) => q(LYD),
+ q(0095) => q(CHF),
+ q(0096) => q(LTL),
+ q(0097) => q(MOP),
+ q(0098) => q(MKD),
+ q(0099) => q(MGA),
+ q(0100) => q(MWK),
+ q(0101) => q(MYR),
+ q(0102) => q(MVR),
+ q(0103) => q(MRO),
+ q(0104) => q(MUR),
+ q(0105) => q(MXN),
+ q(0106) => q(MXV),
+ q(0107) => q(MDL),
+ q(0108) => q(MNT),
+ q(0109) => q(MAD),
+ q(0110) => q(MZN),
+ q(0111) => q(MMK),
+ q(0112) => q(NAD),
+ q(0113) => q(NPR),
+ q(0114) => q(ANG),
+ q(0115) => q(NIO),
+ q(0116) => q(NGN),
+ q(0117) => q(OMR),
+ q(0118) => q(PKR),
+ q(0119) => q(PAB),
+ q(0120) => q(PGK),
+ q(0121) => q(PYG),
+ q(0122) => q(PEN),
+ q(0123) => q(PHP),
+ q(0124) => q(PLN),
+ q(0125) => q(QAR),
+ q(0126) => q(RON),
+ q(0127) => q(RUB),
+ q(0128) => q(RWF),
+ q(0129) => q(SHP),
+ q(0130) => q(WST),
+ q(0131) => q(STD),
+ q(0132) => q(SAR),
+ q(0133) => q(RSD),
+ q(0134) => q(SCR),
+ q(0135) => q(SLL),
+ q(0136) => q(SGD),
+ q(0137) => q(SBD),
+ q(0138) => q(SOS),
+ q(0139) => q(LKR),
+ q(0140) => q(SDG),
+ q(0141) => q(SRD),
+ q(0142) => q(SZL),
+ q(0143) => q(SEK),
+ q(0144) => q(CHW),
+ q(0145) => q(CHE),
+ q(0146) => q(SYP),
+ q(0147) => q(TWD),
+ q(0148) => q(TJS),
+ q(0149) => q(TZS),
+ q(0150) => q(THB),
+ q(0151) => q(TOP),
+ q(0152) => q(TTD),
+ q(0153) => q(TND),
+ q(0154) => q(TRY),
+ q(0155) => q(TMT),
+ q(0156) => q(UGX),
+ q(0157) => q(UAH),
+ q(0158) => q(AED),
+ q(0159) => q(USS),
+ q(0160) => q(USN),
+ q(0161) => q(UYU),
+ q(0162) => q(UYI),
+ q(0163) => q(UZS),
+ q(0164) => q(VUV),
+ q(0165) => q(VEF),
+ q(0166) => q(VND),
+ q(0167) => q(YER),
+ q(0168) => q(ZMK),
+ q(0169) => q(ZWL),
+ q(0170) => q(XAU),
+ q(0171) => q(XBA),
+ q(0172) => q(XBB),
+ q(0173) => q(XBC),
+ q(0174) => q(XBD),
+ q(0175) => q(XDR),
+ q(0176) => q(XPD),
+ q(0177) => q(XPT),
+ q(0178) => q(XAG),
+ q(0179) => q(XFU),
+ },
+ q(num) => {
+ q(0001) => q(971),
+ q(0002) => q(978),
+ q(0003) => q(008),
+ q(0004) => q(012),
+ q(0005) => q(840),
+ q(0006) => q(973),
+ q(0007) => q(951),
+ q(0008) => q(032),
+ q(0009) => q(051),
+ q(0010) => q(533),
+ q(0011) => q(036),
+ q(0012) => q(944),
+ q(0013) => q(044),
+ q(0014) => q(048),
+ q(0015) => q(050),
+ q(0016) => q(052),
+ q(0017) => q(974),
+ q(0018) => q(084),
+ q(0019) => q(952),
+ q(0020) => q(060),
+ q(0021) => q(356),
+ q(0022) => q(064),
+ q(0023) => q(068),
+ q(0024) => q(984),
+ q(0025) => q(977),
+ q(0026) => q(072),
+ q(0027) => q(578),
+ q(0028) => q(986),
+ q(0029) => q(096),
+ q(0030) => q(975),
+ q(0031) => q(108),
+ q(0032) => q(116),
+ q(0033) => q(950),
+ q(0034) => q(124),
+ q(0035) => q(132),
+ q(0036) => q(136),
+ q(0037) => q(152),
+ q(0038) => q(990),
+ q(0039) => q(156),
+ q(0040) => q(170),
+ q(0041) => q(970),
+ q(0042) => q(174),
+ q(0043) => q(976),
+ q(0044) => q(554),
+ q(0045) => q(188),
+ q(0046) => q(191),
+ q(0047) => q(192),
+ q(0048) => q(931),
+ q(0049) => q(203),
+ q(0050) => q(208),
+ q(0051) => q(262),
+ q(0052) => q(214),
+ q(0053) => q(818),
+ q(0054) => q(222),
+ q(0055) => q(232),
+ q(0056) => q(233),
+ q(0057) => q(230),
+ q(0058) => q(238),
+ q(0059) => q(242),
+ q(0060) => q(953),
+ q(0061) => q(270),
+ q(0062) => q(981),
+ q(0063) => q(936),
+ q(0064) => q(292),
+ q(0065) => q(320),
+ q(0066) => q(826),
+ q(0067) => q(324),
+ q(0068) => q(624),
+ q(0069) => q(328),
+ q(0070) => q(332),
+ q(0071) => q(340),
+ q(0072) => q(344),
+ q(0073) => q(348),
+ q(0074) => q(352),
+ q(0075) => q(360),
+ q(0076) => q(364),
+ q(0077) => q(368),
+ q(0078) => q(376),
+ q(0079) => q(388),
+ q(0080) => q(392),
+ q(0081) => q(400),
+ q(0082) => q(398),
+ q(0083) => q(404),
+ q(0084) => q(408),
+ q(0085) => q(410),
+ q(0086) => q(414),
+ q(0087) => q(417),
+ q(0088) => q(418),
+ q(0089) => q(428),
+ q(0090) => q(422),
+ q(0091) => q(710),
+ q(0092) => q(426),
+ q(0093) => q(430),
+ q(0094) => q(434),
+ q(0095) => q(756),
+ q(0096) => q(440),
+ q(0097) => q(446),
+ q(0098) => q(807),
+ q(0099) => q(969),
+ q(0100) => q(454),
+ q(0101) => q(458),
+ q(0102) => q(462),
+ q(0103) => q(478),
+ q(0104) => q(480),
+ q(0105) => q(484),
+ q(0106) => q(979),
+ q(0107) => q(498),
+ q(0108) => q(496),
+ q(0109) => q(504),
+ q(0110) => q(943),
+ q(0111) => q(104),
+ q(0112) => q(516),
+ q(0113) => q(524),
+ q(0114) => q(532),
+ q(0115) => q(558),
+ q(0116) => q(566),
+ q(0117) => q(512),
+ q(0118) => q(586),
+ q(0119) => q(590),
+ q(0120) => q(598),
+ q(0121) => q(600),
+ q(0122) => q(604),
+ q(0123) => q(608),
+ q(0124) => q(985),
+ q(0125) => q(634),
+ q(0126) => q(946),
+ q(0127) => q(643),
+ q(0128) => q(646),
+ q(0129) => q(654),
+ q(0130) => q(882),
+ q(0131) => q(678),
+ q(0132) => q(682),
+ q(0133) => q(941),
+ q(0134) => q(690),
+ q(0135) => q(694),
+ q(0136) => q(702),
+ q(0137) => q(090),
+ q(0138) => q(706),
+ q(0139) => q(144),
+ q(0140) => q(938),
+ q(0141) => q(968),
+ q(0142) => q(748),
+ q(0143) => q(752),
+ q(0144) => q(948),
+ q(0145) => q(947),
+ q(0146) => q(760),
+ q(0147) => q(901),
+ q(0148) => q(972),
+ q(0149) => q(834),
+ q(0150) => q(764),
+ q(0151) => q(776),
+ q(0152) => q(780),
+ q(0153) => q(788),
+ q(0154) => q(949),
+ q(0155) => q(934),
+ q(0156) => q(800),
+ q(0157) => q(980),
+ q(0158) => q(784),
+ q(0159) => q(998),
+ q(0160) => q(997),
+ q(0161) => q(858),
+ q(0162) => q(940),
+ q(0163) => q(860),
+ q(0164) => q(548),
+ q(0165) => q(937),
+ q(0166) => q(704),
+ q(0167) => q(886),
+ q(0168) => q(894),
+ q(0169) => q(932),
+ q(0170) => q(959),
+ q(0171) => q(955),
+ q(0172) => q(956),
+ q(0173) => q(957),
+ q(0174) => q(958),
+ q(0175) => q(960),
+ q(0176) => q(964),
+ q(0177) => q(962),
+ q(0178) => q(961),
+ },
+};
+
+1;
--- /dev/null
+package Locale::Codes::Language;
+
+# This file was automatically generated. Any changes to this file will
+# be lost the next time 'get_codes' is run.
+# Generated on: Mon Apr 5 15:43:17 EDT 2010
+
+=pod
+
+=head1 NAME
+
+Locale::Codes::Language - language codes for the Locale::Language module
+
+=head1 SYNOPSIS
+
+This module contains data used by the Locale::Language module. It is
+not intended to be used directly, and contains no calleable routines.
+
+=head1 AUTHOR
+
+See Locale::Codes for full author history.
+
+Currently maintained by Sullivan Beck (sbeck@cpan.org).
+
+=head1 COPYRIGHT
+
+ Copyright (c) 1997-2001 Canon Research Centre Europe (CRE).
+ Copyright (c) 2001-2010 Neil Bowers
+ Copyright (c) 2010-2010 Sullivan Beck
+
+This module is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
+
+use strict;
+use warnings;
+require 5.002;
+
+use vars qw($VERSION);
+$VERSION='3.12';
+
+$Locale::Codes::Data{'language'}{'id'} = '0486';
+
+$Locale::Codes::Data{'language'}{'id2names'} = {
+ q(0001) => [
+ q(Afar),
+ ],
+ q(0002) => [
+ q(Abkhazian),
+ ],
+ q(0003) => [
+ q(Achinese),
+ ],
+ q(0004) => [
+ q(Acoli),
+ ],
+ q(0005) => [
+ q(Adangme),
+ ],
+ q(0006) => [
+ q(Adyghe),
+ q(Adygei),
+ ],
+ q(0007) => [
+ q(Afro-Asiatic languages),
+ ],
+ q(0008) => [
+ q(Afrihili),
+ ],
+ q(0009) => [
+ q(Afrikaans),
+ ],
+ q(0010) => [
+ q(Ainu),
+ ],
+ q(0011) => [
+ q(Akan),
+ ],
+ q(0012) => [
+ q(Akkadian),
+ ],
+ q(0013) => [
+ q(Albanian),
+ ],
+ q(0014) => [
+ q(Aleut),
+ ],
+ q(0015) => [
+ q(Algonquian languages),
+ ],
+ q(0016) => [
+ q(Southern Altai),
+ ],
+ q(0017) => [
+ q(Amharic),
+ ],
+ q(0018) => [
+ q(English, Old (ca.450-1100)),
+ ],
+ q(0019) => [
+ q(Angika),
+ ],
+ q(0020) => [
+ q(Apache languages),
+ ],
+ q(0021) => [
+ q(Arabic),
+ ],
+ q(0022) => [
+ q(Official Aramaic (700-300 BCE)),
+ q(Imperial Aramaic (700-300 BCE)),
+ ],
+ q(0023) => [
+ q(Aragonese),
+ ],
+ q(0024) => [
+ q(Armenian),
+ ],
+ q(0025) => [
+ q(Mapudungun),
+ q(Mapuche),
+ ],
+ q(0026) => [
+ q(Arapaho),
+ ],
+ q(0027) => [
+ q(Artificial languages),
+ ],
+ q(0028) => [
+ q(Arawak),
+ ],
+ q(0029) => [
+ q(Assamese),
+ ],
+ q(0030) => [
+ q(Asturian),
+ q(Bable),
+ q(Leonese),
+ q(Asturleonese),
+ ],
+ q(0031) => [
+ q(Athapascan languages),
+ ],
+ q(0032) => [
+ q(Australian languages),
+ ],
+ q(0033) => [
+ q(Avaric),
+ ],
+ q(0034) => [
+ q(Avestan),
+ ],
+ q(0035) => [
+ q(Awadhi),
+ ],
+ q(0036) => [
+ q(Aymara),
+ ],
+ q(0037) => [
+ q(Azerbaijani),
+ ],
+ q(0038) => [
+ q(Banda languages),
+ ],
+ q(0039) => [
+ q(Bamileke languages),
+ ],
+ q(0040) => [
+ q(Bashkir),
+ ],
+ q(0041) => [
+ q(Baluchi),
+ ],
+ q(0042) => [
+ q(Bambara),
+ ],
+ q(0043) => [
+ q(Balinese),
+ ],
+ q(0044) => [
+ q(Basque),
+ ],
+ q(0045) => [
+ q(Basa),
+ ],
+ q(0046) => [
+ q(Baltic languages),
+ ],
+ q(0047) => [
+ q(Beja),
+ q(Bedawiyet),
+ ],
+ q(0048) => [
+ q(Belarusian),
+ ],
+ q(0049) => [
+ q(Bemba),
+ ],
+ q(0050) => [
+ q(Bengali),
+ ],
+ q(0051) => [
+ q(Berber languages),
+ ],
+ q(0052) => [
+ q(Bhojpuri),
+ ],
+ q(0053) => [
+ q(Bihari languages),
+ ],
+ q(0054) => [
+ q(Bikol),
+ ],
+ q(0055) => [
+ q(Bini),
+ q(Edo),
+ ],
+ q(0056) => [
+ q(Bislama),
+ ],
+ q(0057) => [
+ q(Siksika),
+ ],
+ q(0058) => [
+ q(Bantu (Other)),
+ ],
+ q(0059) => [
+ q(Bosnian),
+ ],
+ q(0060) => [
+ q(Braj),
+ ],
+ q(0061) => [
+ q(Breton),
+ ],
+ q(0062) => [
+ q(Batak languages),
+ ],
+ q(0063) => [
+ q(Buriat),
+ ],
+ q(0064) => [
+ q(Buginese),
+ ],
+ q(0065) => [
+ q(Bulgarian),
+ ],
+ q(0066) => [
+ q(Burmese),
+ ],
+ q(0067) => [
+ q(Blin),
+ q(Bilin),
+ ],
+ q(0068) => [
+ q(Caddo),
+ ],
+ q(0069) => [
+ q(Central American Indian languages),
+ ],
+ q(0070) => [
+ q(Galibi Carib),
+ ],
+ q(0071) => [
+ q(Catalan),
+ q(Valencian),
+ ],
+ q(0072) => [
+ q(Caucasian languages),
+ ],
+ q(0073) => [
+ q(Cebuano),
+ ],
+ q(0074) => [
+ q(Celtic languages),
+ ],
+ q(0075) => [
+ q(Chamorro),
+ ],
+ q(0076) => [
+ q(Chibcha),
+ ],
+ q(0077) => [
+ q(Chechen),
+ ],
+ q(0078) => [
+ q(Chagatai),
+ ],
+ q(0079) => [
+ q(Chinese),
+ ],
+ q(0080) => [
+ q(Chuukese),
+ ],
+ q(0081) => [
+ q(Mari),
+ ],
+ q(0082) => [
+ q(Chinook jargon),
+ ],
+ q(0083) => [
+ q(Choctaw),
+ ],
+ q(0084) => [
+ q(Chipewyan),
+ q(Dene Suline),
+ ],
+ q(0085) => [
+ q(Cherokee),
+ ],
+ q(0086) => [
+ q(Church Slavic),
+ q(Old Slavonic),
+ q(Church Slavonic),
+ q(Old Bulgarian),
+ q(Old Church Slavonic),
+ ],
+ q(0087) => [
+ q(Chuvash),
+ ],
+ q(0088) => [
+ q(Cheyenne),
+ ],
+ q(0089) => [
+ q(Chamic languages),
+ ],
+ q(0090) => [
+ q(Coptic),
+ ],
+ q(0091) => [
+ q(Cornish),
+ ],
+ q(0092) => [
+ q(Corsican),
+ ],
+ q(0093) => [
+ q(Creoles and pidgins, English based),
+ ],
+ q(0094) => [
+ q(Creoles and pidgins, French-based ),
+ ],
+ q(0095) => [
+ q(Creoles and pidgins, Portuguese-based ),
+ ],
+ q(0096) => [
+ q(Cree),
+ ],
+ q(0097) => [
+ q(Crimean Tatar),
+ q(Crimean Turkish),
+ ],
+ q(0098) => [
+ q(Creoles and pidgins ),
+ ],
+ q(0099) => [
+ q(Kashubian),
+ ],
+ q(0100) => [
+ q(Cushitic languages),
+ ],
+ q(0101) => [
+ q(Czech),
+ ],
+ q(0102) => [
+ q(Dakota),
+ ],
+ q(0103) => [
+ q(Danish),
+ ],
+ q(0104) => [
+ q(Dargwa),
+ ],
+ q(0105) => [
+ q(Land Dayak languages),
+ ],
+ q(0106) => [
+ q(Delaware),
+ ],
+ q(0107) => [
+ q(Slave (Athapascan)),
+ ],
+ q(0108) => [
+ q(Dogrib),
+ ],
+ q(0109) => [
+ q(Dinka),
+ ],
+ q(0110) => [
+ q(Divehi),
+ q(Dhivehi),
+ q(Maldivian),
+ ],
+ q(0111) => [
+ q(Dogri),
+ ],
+ q(0112) => [
+ q(Dravidian languages),
+ ],
+ q(0113) => [
+ q(Lower Sorbian),
+ ],
+ q(0114) => [
+ q(Duala),
+ ],
+ q(0115) => [
+ q(Dutch, Middle (ca.1050-1350)),
+ ],
+ q(0116) => [
+ q(Dutch),
+ q(Flemish),
+ ],
+ q(0117) => [
+ q(Dyula),
+ ],
+ q(0118) => [
+ q(Dzongkha),
+ ],
+ q(0119) => [
+ q(Efik),
+ ],
+ q(0120) => [
+ q(Egyptian (Ancient)),
+ ],
+ q(0121) => [
+ q(Ekajuk),
+ ],
+ q(0122) => [
+ q(Elamite),
+ ],
+ q(0123) => [
+ q(English),
+ ],
+ q(0124) => [
+ q(English, Middle (1100-1500)),
+ ],
+ q(0125) => [
+ q(Esperanto),
+ ],
+ q(0126) => [
+ q(Estonian),
+ ],
+ q(0127) => [
+ q(Ewe),
+ ],
+ q(0128) => [
+ q(Ewondo),
+ ],
+ q(0129) => [
+ q(Fang),
+ ],
+ q(0130) => [
+ q(Faroese),
+ ],
+ q(0131) => [
+ q(Fanti),
+ ],
+ q(0132) => [
+ q(Fijian),
+ ],
+ q(0133) => [
+ q(Filipino),
+ q(Pilipino),
+ ],
+ q(0134) => [
+ q(Finnish),
+ ],
+ q(0135) => [
+ q(Finno-Ugrian languages),
+ ],
+ q(0136) => [
+ q(Fon),
+ ],
+ q(0137) => [
+ q(French),
+ ],
+ q(0138) => [
+ q(French, Middle (ca.1400-1600)),
+ ],
+ q(0139) => [
+ q(French, Old (842-ca.1400)),
+ ],
+ q(0140) => [
+ q(Northern Frisian),
+ ],
+ q(0141) => [
+ q(Eastern Frisian),
+ ],
+ q(0142) => [
+ q(Western Frisian),
+ ],
+ q(0143) => [
+ q(Fulah),
+ ],
+ q(0144) => [
+ q(Friulian),
+ ],
+ q(0145) => [
+ q(Ga),
+ ],
+ q(0146) => [
+ q(Gayo),
+ ],
+ q(0147) => [
+ q(Gbaya),
+ ],
+ q(0148) => [
+ q(Germanic languages),
+ ],
+ q(0149) => [
+ q(Georgian),
+ ],
+ q(0150) => [
+ q(German),
+ ],
+ q(0151) => [
+ q(Geez),
+ ],
+ q(0152) => [
+ q(Gilbertese),
+ ],
+ q(0153) => [
+ q(Gaelic),
+ q(Scottish Gaelic),
+ ],
+ q(0154) => [
+ q(Irish),
+ ],
+ q(0155) => [
+ q(Galician),
+ ],
+ q(0156) => [
+ q(Manx),
+ ],
+ q(0157) => [
+ q(German, Middle High (ca.1050-1500)),
+ ],
+ q(0158) => [
+ q(German, Old High (ca.750-1050)),
+ ],
+ q(0159) => [
+ q(Gondi),
+ ],
+ q(0160) => [
+ q(Gorontalo),
+ ],
+ q(0161) => [
+ q(Gothic),
+ ],
+ q(0162) => [
+ q(Grebo),
+ ],
+ q(0163) => [
+ q(Greek, Ancient (to 1453)),
+ ],
+ q(0164) => [
+ q(Greek, Modern (1453-)),
+ q(Greek),
+ ],
+ q(0165) => [
+ q(Guarani),
+ ],
+ q(0166) => [
+ q(Swiss German),
+ q(Alemannic),
+ q(Alsatian),
+ ],
+ q(0167) => [
+ q(Gujarati),
+ ],
+ q(0168) => [
+ q(Gwich'in),
+ ],
+ q(0169) => [
+ q(Haida),
+ ],
+ q(0170) => [
+ q(Haitian),
+ q(Haitian Creole),
+ ],
+ q(0171) => [
+ q(Hausa),
+ ],
+ q(0172) => [
+ q(Hawaiian),
+ ],
+ q(0173) => [
+ q(Hebrew),
+ ],
+ q(0174) => [
+ q(Herero),
+ ],
+ q(0175) => [
+ q(Hiligaynon),
+ ],
+ q(0176) => [
+ q(Himachali languages),
+ q(Western Pahari languages),
+ ],
+ q(0177) => [
+ q(Hindi),
+ ],
+ q(0178) => [
+ q(Hittite),
+ ],
+ q(0179) => [
+ q(Hmong),
+ q(Mong),
+ ],
+ q(0180) => [
+ q(Hiri Motu),
+ ],
+ q(0181) => [
+ q(Croatian),
+ ],
+ q(0182) => [
+ q(Upper Sorbian),
+ ],
+ q(0183) => [
+ q(Hungarian),
+ ],
+ q(0184) => [
+ q(Hupa),
+ ],
+ q(0185) => [
+ q(Iban),
+ ],
+ q(0186) => [
+ q(Igbo),
+ ],
+ q(0187) => [
+ q(Icelandic),
+ ],
+ q(0188) => [
+ q(Ido),
+ ],
+ q(0189) => [
+ q(Sichuan Yi),
+ q(Nuosu),
+ ],
+ q(0190) => [
+ q(Ijo languages),
+ ],
+ q(0191) => [
+ q(Inuktitut),
+ ],
+ q(0192) => [
+ q(Interlingue),
+ q(Occidental),
+ ],
+ q(0193) => [
+ q(Iloko),
+ ],
+ q(0194) => [
+ q(Interlingua (International Auxiliary Language Association)),
+ ],
+ q(0195) => [
+ q(Indic languages),
+ ],
+ q(0196) => [
+ q(Indonesian),
+ ],
+ q(0197) => [
+ q(Indo-European languages),
+ ],
+ q(0198) => [
+ q(Ingush),
+ ],
+ q(0199) => [
+ q(Inupiaq),
+ ],
+ q(0200) => [
+ q(Iranian languages),
+ ],
+ q(0201) => [
+ q(Iroquoian languages),
+ ],
+ q(0202) => [
+ q(Italian),
+ ],
+ q(0203) => [
+ q(Javanese),
+ ],
+ q(0204) => [
+ q(Lojban),
+ ],
+ q(0205) => [
+ q(Japanese),
+ ],
+ q(0206) => [
+ q(Judeo-Persian),
+ ],
+ q(0207) => [
+ q(Judeo-Arabic),
+ ],
+ q(0208) => [
+ q(Kara-Kalpak),
+ ],
+ q(0209) => [
+ q(Kabyle),
+ ],
+ q(0210) => [
+ q(Kachin),
+ q(Jingpho),
+ ],
+ q(0211) => [
+ q(Kalaallisut),
+ q(Greenlandic),
+ ],
+ q(0212) => [
+ q(Kamba),
+ ],
+ q(0213) => [
+ q(Kannada),
+ ],
+ q(0214) => [
+ q(Karen languages),
+ ],
+ q(0215) => [
+ q(Kashmiri),
+ ],
+ q(0216) => [
+ q(Kanuri),
+ ],
+ q(0217) => [
+ q(Kawi),
+ ],
+ q(0218) => [
+ q(Kazakh),
+ ],
+ q(0219) => [
+ q(Kabardian),
+ ],
+ q(0220) => [
+ q(Khasi),
+ ],
+ q(0221) => [
+ q(Khoisan languages),
+ ],
+ q(0222) => [
+ q(Central Khmer),
+ ],
+ q(0223) => [
+ q(Khotanese),
+ q(Sakan),
+ ],
+ q(0224) => [
+ q(Kikuyu),
+ q(Gikuyu),
+ ],
+ q(0225) => [
+ q(Kinyarwanda),
+ ],
+ q(0226) => [
+ q(Kirghiz),
+ q(Kyrgyz),
+ ],
+ q(0227) => [
+ q(Kimbundu),
+ ],
+ q(0228) => [
+ q(Konkani),
+ ],
+ q(0229) => [
+ q(Komi),
+ ],
+ q(0230) => [
+ q(Kongo),
+ ],
+ q(0231) => [
+ q(Korean),
+ ],
+ q(0232) => [
+ q(Kosraean),
+ ],
+ q(0233) => [
+ q(Kpelle),
+ ],
+ q(0234) => [
+ q(Karachay-Balkar),
+ ],
+ q(0235) => [
+ q(Karelian),
+ ],
+ q(0236) => [
+ q(Kru languages),
+ ],
+ q(0237) => [
+ q(Kurukh),
+ ],
+ q(0238) => [
+ q(Kuanyama),
+ q(Kwanyama),
+ ],
+ q(0239) => [
+ q(Kumyk),
+ ],
+ q(0240) => [
+ q(Kurdish),
+ ],
+ q(0241) => [
+ q(Kutenai),
+ ],
+ q(0242) => [
+ q(Ladino),
+ ],
+ q(0243) => [
+ q(Lahnda),
+ ],
+ q(0244) => [
+ q(Lamba),
+ ],
+ q(0245) => [
+ q(Lao),
+ ],
+ q(0246) => [
+ q(Latin),
+ ],
+ q(0247) => [
+ q(Latvian),
+ ],
+ q(0248) => [
+ q(Lezghian),
+ ],
+ q(0249) => [
+ q(Limburgan),
+ q(Limburger),
+ q(Limburgish),
+ ],
+ q(0250) => [
+ q(Lingala),
+ ],
+ q(0251) => [
+ q(Lithuanian),
+ ],
+ q(0252) => [
+ q(Mongo),
+ ],
+ q(0253) => [
+ q(Lozi),
+ ],
+ q(0254) => [
+ q(Luxembourgish),
+ q(Letzeburgesch),
+ ],
+ q(0255) => [
+ q(Luba-Lulua),
+ ],
+ q(0256) => [
+ q(Luba-Katanga),
+ ],
+ q(0257) => [
+ q(Ganda),
+ ],
+ q(0258) => [
+ q(Luiseno),
+ ],
+ q(0259) => [
+ q(Lunda),
+ ],
+ q(0260) => [
+ q(Luo (Kenya and Tanzania)),
+ ],
+ q(0261) => [
+ q(Lushai),
+ ],
+ q(0262) => [
+ q(Macedonian),
+ ],
+ q(0263) => [
+ q(Madurese),
+ ],
+ q(0264) => [
+ q(Magahi),
+ ],
+ q(0265) => [
+ q(Marshallese),
+ ],
+ q(0266) => [
+ q(Maithili),
+ ],
+ q(0267) => [
+ q(Makasar),
+ ],
+ q(0268) => [
+ q(Malayalam),
+ ],
+ q(0269) => [
+ q(Mandingo),
+ ],
+ q(0270) => [
+ q(Maori),
+ ],
+ q(0271) => [
+ q(Austronesian languages),
+ ],
+ q(0272) => [
+ q(Marathi),
+ ],
+ q(0273) => [
+ q(Masai),
+ ],
+ q(0274) => [
+ q(Malay),
+ ],
+ q(0275) => [
+ q(Moksha),
+ ],
+ q(0276) => [
+ q(Mandar),
+ ],
+ q(0277) => [
+ q(Mende),
+ ],
+ q(0278) => [
+ q(Irish, Middle (900-1200)),
+ ],
+ q(0279) => [
+ q(Mi'kmaq),
+ q(Micmac),
+ ],
+ q(0280) => [
+ q(Minangkabau),
+ ],
+ q(0281) => [
+ q(Uncoded languages),
+ ],
+ q(0282) => [
+ q(Mon-Khmer languages),
+ ],
+ q(0283) => [
+ q(Malagasy),
+ ],
+ q(0284) => [
+ q(Maltese),
+ ],
+ q(0285) => [
+ q(Manchu),
+ ],
+ q(0286) => [
+ q(Manipuri),
+ ],
+ q(0287) => [
+ q(Manobo languages),
+ ],
+ q(0288) => [
+ q(Mohawk),
+ ],
+ q(0289) => [
+ q(Mongolian),
+ ],
+ q(0290) => [
+ q(Mossi),
+ ],
+ q(0291) => [
+ q(Multiple languages),
+ ],
+ q(0292) => [
+ q(Munda languages),
+ ],
+ q(0293) => [
+ q(Creek),
+ ],
+ q(0294) => [
+ q(Mirandese),
+ ],
+ q(0295) => [
+ q(Marwari),
+ ],
+ q(0296) => [
+ q(Mayan languages),
+ ],
+ q(0297) => [
+ q(Erzya),
+ ],
+ q(0298) => [
+ q(Nahuatl languages),
+ ],
+ q(0299) => [
+ q(North American Indian languages),
+ ],
+ q(0300) => [
+ q(Neapolitan),
+ ],
+ q(0301) => [
+ q(Nauru),
+ ],
+ q(0302) => [
+ q(Navajo),
+ q(Navaho),
+ ],
+ q(0303) => [
+ q(Ndebele, South),
+ q(South Ndebele),
+ ],
+ q(0304) => [
+ q(Ndebele, North),
+ q(North Ndebele),
+ ],
+ q(0305) => [
+ q(Ndonga),
+ ],
+ q(0306) => [
+ q(Low German),
+ q(Low Saxon),
+ q(German, Low),
+ q(Saxon, Low),
+ ],
+ q(0307) => [
+ q(Nepali),
+ ],
+ q(0308) => [
+ q(Nepal Bhasa),
+ q(Newari),
+ ],
+ q(0309) => [
+ q(Nias),
+ ],
+ q(0310) => [
+ q(Niger-Kordofanian languages),
+ ],
+ q(0311) => [
+ q(Niuean),
+ ],
+ q(0312) => [
+ q(Norwegian Nynorsk),
+ q(Nynorsk, Norwegian),
+ ],
+ q(0313) => [
+ q(Bokmal, Norwegian),
+ q(Norwegian Bokmal),
+ ],
+ q(0314) => [
+ q(Nogai),
+ ],
+ q(0315) => [
+ q(Norse, Old),
+ ],
+ q(0316) => [
+ q(Norwegian),
+ ],
+ q(0317) => [
+ q(N'Ko),
+ ],
+ q(0318) => [
+ q(Pedi),
+ q(Sepedi),
+ q(Northern Sotho),
+ ],
+ q(0319) => [
+ q(Nubian languages),
+ ],
+ q(0320) => [
+ q(Classical Newari),
+ q(Old Newari),
+ q(Classical Nepal Bhasa),
+ ],
+ q(0321) => [
+ q(Chichewa),
+ q(Chewa),
+ q(Nyanja),
+ ],
+ q(0322) => [
+ q(Nyamwezi),
+ ],
+ q(0323) => [
+ q(Nyankole),
+ ],
+ q(0324) => [
+ q(Nyoro),
+ ],
+ q(0325) => [
+ q(Nzima),
+ ],
+ q(0326) => [
+ q(Occitan (post 1500)),
+ q(Provencal),
+ ],
+ q(0327) => [
+ q(Ojibwa),
+ ],
+ q(0328) => [
+ q(Oriya),
+ ],
+ q(0329) => [
+ q(Oromo),
+ ],
+ q(0330) => [
+ q(Osage),
+ ],
+ q(0331) => [
+ q(Ossetian),
+ q(Ossetic),
+ ],
+ q(0332) => [
+ q(Turkish, Ottoman (1500-1928)),
+ ],
+ q(0333) => [
+ q(Otomian languages),
+ ],
+ q(0334) => [
+ q(Papuan languages),
+ ],
+ q(0335) => [
+ q(Pangasinan),
+ ],
+ q(0336) => [
+ q(Pahlavi),
+ ],
+ q(0337) => [
+ q(Pampanga),
+ q(Kapampangan),
+ ],
+ q(0338) => [
+ q(Panjabi),
+ q(Punjabi),
+ ],
+ q(0339) => [
+ q(Papiamento),
+ ],
+ q(0340) => [
+ q(Palauan),
+ ],
+ q(0341) => [
+ q(Persian, Old (ca.600-400 B.C.)),
+ ],
+ q(0342) => [
+ q(Persian),
+ ],
+ q(0343) => [
+ q(Philippine languages),
+ ],
+ q(0344) => [
+ q(Phoenician),
+ ],
+ q(0345) => [
+ q(Pali),
+ ],
+ q(0346) => [
+ q(Polish),
+ ],
+ q(0347) => [
+ q(Pohnpeian),
+ ],
+ q(0348) => [
+ q(Portuguese),
+ ],
+ q(0349) => [
+ q(Prakrit languages),
+ ],
+ q(0350) => [
+ q(Provencal, Old (to 1500)),
+ ],
+ q(0351) => [
+ q(Pushto),
+ q(Pashto),
+ ],
+ q(0352) => [
+ q(Reserved for local use),
+ ],
+ q(0353) => [
+ q(Quechua),
+ ],
+ q(0354) => [
+ q(Rajasthani),
+ ],
+ q(0355) => [
+ q(Rapanui),
+ ],
+ q(0356) => [
+ q(Rarotongan),
+ q(Cook Islands Maori),
+ ],
+ q(0357) => [
+ q(Romance languages),
+ ],
+ q(0358) => [
+ q(Romansh),
+ ],
+ q(0359) => [
+ q(Romany),
+ ],
+ q(0360) => [
+ q(Romanian),
+ q(Moldavian),
+ q(Moldovan),
+ ],
+ q(0361) => [
+ q(Rundi),
+ ],
+ q(0362) => [
+ q(Aromanian),
+ q(Arumanian),
+ q(Macedo-Romanian),
+ ],
+ q(0363) => [
+ q(Russian),
+ ],
+ q(0364) => [
+ q(Sandawe),
+ ],
+ q(0365) => [
+ q(Sango),
+ ],
+ q(0366) => [
+ q(Yakut),
+ ],
+ q(0367) => [
+ q(South American Indian (Other)),
+ ],
+ q(0368) => [
+ q(Salishan languages),
+ ],
+ q(0369) => [
+ q(Samaritan Aramaic),
+ ],
+ q(0370) => [
+ q(Sanskrit),
+ ],
+ q(0371) => [
+ q(Sasak),
+ ],
+ q(0372) => [
+ q(Santali),
+ ],
+ q(0373) => [
+ q(Sicilian),
+ ],
+ q(0374) => [
+ q(Scots),
+ ],
+ q(0375) => [
+ q(Selkup),
+ ],
+ q(0376) => [
+ q(Semitic languages),
+ ],
+ q(0377) => [
+ q(Irish, Old (to 900)),
+ ],
+ q(0378) => [
+ q(Sign Languages),
+ ],
+ q(0379) => [
+ q(Shan),
+ ],
+ q(0380) => [
+ q(Sidamo),
+ ],
+ q(0381) => [
+ q(Sinhala),
+ q(Sinhalese),
+ ],
+ q(0382) => [
+ q(Siouan languages),
+ ],
+ q(0383) => [
+ q(Sino-Tibetan languages),
+ ],
+ q(0384) => [
+ q(Slavic languages),
+ ],
+ q(0385) => [
+ q(Slovak),
+ ],
+ q(0386) => [
+ q(Slovenian),
+ ],
+ q(0387) => [
+ q(Southern Sami),
+ ],
+ q(0388) => [
+ q(Northern Sami),
+ ],
+ q(0389) => [
+ q(Sami languages),
+ ],
+ q(0390) => [
+ q(Lule Sami),
+ ],
+ q(0391) => [
+ q(Inari Sami),
+ ],
+ q(0392) => [
+ q(Samoan),
+ ],
+ q(0393) => [
+ q(Skolt Sami),
+ ],
+ q(0394) => [
+ q(Shona),
+ ],
+ q(0395) => [
+ q(Sindhi),
+ ],
+ q(0396) => [
+ q(Soninke),
+ ],
+ q(0397) => [
+ q(Sogdian),
+ ],
+ q(0398) => [
+ q(Somali),
+ ],
+ q(0399) => [
+ q(Songhai languages),
+ ],
+ q(0400) => [
+ q(Sotho, Southern),
+ ],
+ q(0401) => [
+ q(Spanish),
+ q(Castilian),
+ ],
+ q(0402) => [
+ q(Sardinian),
+ ],
+ q(0403) => [
+ q(Sranan Tongo),
+ ],
+ q(0404) => [
+ q(Serbian),
+ ],
+ q(0405) => [
+ q(Serer),
+ ],
+ q(0406) => [
+ q(Nilo-Saharan languages),
+ ],
+ q(0407) => [
+ q(Swati),
+ ],
+ q(0408) => [
+ q(Sukuma),
+ ],
+ q(0409) => [
+ q(Sundanese),
+ ],
+ q(0410) => [
+ q(Susu),
+ ],
+ q(0411) => [
+ q(Sumerian),
+ ],
+ q(0412) => [
+ q(Swahili),
+ ],
+ q(0413) => [
+ q(Swedish),
+ ],
+ q(0414) => [
+ q(Classical Syriac),
+ ],
+ q(0415) => [
+ q(Syriac),
+ ],
+ q(0416) => [
+ q(Tahitian),
+ ],
+ q(0417) => [
+ q(Tai languages),
+ ],
+ q(0418) => [
+ q(Tamil),
+ ],
+ q(0419) => [
+ q(Tatar),
+ ],
+ q(0420) => [
+ q(Telugu),
+ ],
+ q(0421) => [
+ q(Timne),
+ ],
+ q(0422) => [
+ q(Tereno),
+ ],
+ q(0423) => [
+ q(Tetum),
+ ],
+ q(0424) => [
+ q(Tajik),
+ ],
+ q(0425) => [
+ q(Tagalog),
+ ],
+ q(0426) => [
+ q(Thai),
+ ],
+ q(0427) => [
+ q(Tibetan),
+ ],
+ q(0428) => [
+ q(Tigre),
+ ],
+ q(0429) => [
+ q(Tigrinya),
+ ],
+ q(0430) => [
+ q(Tiv),
+ ],
+ q(0431) => [
+ q(Tokelau),
+ ],
+ q(0432) => [
+ q(Klingon),
+ q(tlhIngan-Hol),
+ ],
+ q(0433) => [
+ q(Tlingit),
+ ],
+ q(0434) => [
+ q(Tamashek),
+ ],
+ q(0435) => [
+ q(Tonga (Nyasa)),
+ ],
+ q(0436) => [
+ q(Tonga (Tonga Islands)),
+ q(Tonga),
+ ],
+ q(0437) => [
+ q(Tok Pisin),
+ ],
+ q(0438) => [
+ q(Tsimshian),
+ ],
+ q(0439) => [
+ q(Tswana),
+ ],
+ q(0440) => [
+ q(Tsonga),
+ ],
+ q(0441) => [
+ q(Turkmen),
+ ],
+ q(0442) => [
+ q(Tumbuka),
+ ],
+ q(0443) => [
+ q(Tupi languages),
+ ],
+ q(0444) => [
+ q(Turkish),
+ ],
+ q(0445) => [
+ q(Altaic languages),
+ ],
+ q(0446) => [
+ q(Tuvalu),
+ ],
+ q(0447) => [
+ q(Twi),
+ ],
+ q(0448) => [
+ q(Tuvinian),
+ ],
+ q(0449) => [
+ q(Udmurt),
+ ],
+ q(0450) => [
+ q(Ugaritic),
+ ],
+ q(0451) => [
+ q(Uighur),
+ q(Uyghur),
+ ],
+ q(0452) => [
+ q(Ukrainian),
+ ],
+ q(0453) => [
+ q(Umbundu),
+ ],
+ q(0454) => [
+ q(Undetermined),
+ ],
+ q(0455) => [
+ q(Urdu),
+ ],
+ q(0456) => [
+ q(Uzbek),
+ ],
+ q(0457) => [
+ q(Vai),
+ ],
+ q(0458) => [
+ q(Venda),
+ ],
+ q(0459) => [
+ q(Vietnamese),
+ ],
+ q(0460) => [
+ q(Volapuk),
+ ],
+ q(0461) => [
+ q(Votic),
+ ],
+ q(0462) => [
+ q(Wakashan languages),
+ ],
+ q(0463) => [
+ q(Walamo),
+ ],
+ q(0464) => [
+ q(Waray),
+ ],
+ q(0465) => [
+ q(Washo),
+ ],
+ q(0466) => [
+ q(Welsh),
+ ],
+ q(0467) => [
+ q(Sorbian languages),
+ ],
+ q(0468) => [
+ q(Walloon),
+ ],
+ q(0469) => [
+ q(Wolof),
+ ],
+ q(0470) => [
+ q(Kalmyk),
+ q(Oirat),
+ ],
+ q(0471) => [
+ q(Xhosa),
+ ],
+ q(0472) => [
+ q(Yao),
+ ],
+ q(0473) => [
+ q(Yapese),
+ ],
+ q(0474) => [
+ q(Yiddish),
+ ],
+ q(0475) => [
+ q(Yoruba),
+ ],
+ q(0476) => [
+ q(Yupik languages),
+ ],
+ q(0477) => [
+ q(Zapotec),
+ ],
+ q(0478) => [
+ q(Blissymbols),
+ q(Blissymbolics),
+ q(Bliss),
+ ],
+ q(0479) => [
+ q(Zenaga),
+ ],
+ q(0480) => [
+ q(Zhuang),
+ q(Chuang),
+ ],
+ q(0481) => [
+ q(Zande languages),
+ ],
+ q(0482) => [
+ q(Zulu),
+ ],
+ q(0483) => [
+ q(Zuni),
+ ],
+ q(0484) => [
+ q(No linguistic content),
+ q(Not applicable),
+ ],
+ q(0485) => [
+ q(Zaza),
+ q(Dimili),
+ q(Dimli),
+ q(Kirdki),
+ q(Kirmanjki),
+ q(Zazaki),
+ ],
+};
+
+$Locale::Codes::Data{'language'}{'alias2id'} = {
+ q(abkhazian) => [
+ q(0002),
+ q(0),
+ ],
+ q(achinese) => [
+ q(0003),
+ q(0),
+ ],
+ q(acoli) => [
+ q(0004),
+ q(0),
+ ],
+ q(adangme) => [
+ q(0005),
+ q(0),
+ ],
+ q(adygei) => [
+ q(0006),
+ q(1),
+ ],
+ q(adyghe) => [
+ q(0006),
+ q(0),
+ ],
+ q(afar) => [
+ q(0001),
+ q(0),
+ ],
+ q(afrihili) => [
+ q(0008),
+ q(0),
+ ],
+ q(afrikaans) => [
+ q(0009),
+ q(0),
+ ],
+ q(afro-asiatic languages) => [
+ q(0007),
+ q(0),
+ ],
+ q(ainu) => [
+ q(0010),
+ q(0),
+ ],
+ q(akan) => [
+ q(0011),
+ q(0),
+ ],
+ q(akkadian) => [
+ q(0012),
+ q(0),
+ ],
+ q(albanian) => [
+ q(0013),
+ q(0),
+ ],
+ q(alemannic) => [
+ q(0166),
+ q(1),
+ ],
+ q(aleut) => [
+ q(0014),
+ q(0),
+ ],
+ q(algonquian languages) => [
+ q(0015),
+ q(0),
+ ],
+ q(alsatian) => [
+ q(0166),
+ q(2),
+ ],
+ q(altaic languages) => [
+ q(0445),
+ q(0),
+ ],
+ q(amharic) => [
+ q(0017),
+ q(0),
+ ],
+ q(angika) => [
+ q(0019),
+ q(0),
+ ],
+ q(apache languages) => [
+ q(0020),
+ q(0),
+ ],
+ q(arabic) => [
+ q(0021),
+ q(0),
+ ],
+ q(aragonese) => [
+ q(0023),
+ q(0),
+ ],
+ q(arapaho) => [
+ q(0026),
+ q(0),
+ ],
+ q(arawak) => [
+ q(0028),
+ q(0),
+ ],
+ q(armenian) => [
+ q(0024),
+ q(0),
+ ],
+ q(aromanian) => [
+ q(0362),
+ q(0),
+ ],
+ q(artificial languages) => [
+ q(0027),
+ q(0),
+ ],
+ q(arumanian) => [
+ q(0362),
+ q(1),
+ ],
+ q(assamese) => [
+ q(0029),
+ q(0),
+ ],
+ q(asturian) => [
+ q(0030),
+ q(0),
+ ],
+ q(asturleonese) => [
+ q(0030),
+ q(3),
+ ],
+ q(athapascan languages) => [
+ q(0031),
+ q(0),
+ ],
+ q(australian languages) => [
+ q(0032),
+ q(0),
+ ],
+ q(austronesian languages) => [
+ q(0271),
+ q(0),
+ ],
+ q(avaric) => [
+ q(0033),
+ q(0),
+ ],
+ q(avestan) => [
+ q(0034),
+ q(0),
+ ],
+ q(awadhi) => [
+ q(0035),
+ q(0),
+ ],
+ q(aymara) => [
+ q(0036),
+ q(0),
+ ],
+ q(azerbaijani) => [
+ q(0037),
+ q(0),
+ ],
+ q(bable) => [
+ q(0030),
+ q(1),
+ ],
+ q(balinese) => [
+ q(0043),
+ q(0),
+ ],
+ q(baltic languages) => [
+ q(0046),
+ q(0),
+ ],
+ q(baluchi) => [
+ q(0041),
+ q(0),
+ ],
+ q(bambara) => [
+ q(0042),
+ q(0),
+ ],
+ q(bamileke languages) => [
+ q(0039),
+ q(0),
+ ],
+ q(banda languages) => [
+ q(0038),
+ q(0),
+ ],
+ q(bantu (other)) => [
+ q(0058),
+ q(0),
+ ],
+ q(basa) => [
+ q(0045),
+ q(0),
+ ],
+ q(bashkir) => [
+ q(0040),
+ q(0),
+ ],
+ q(basque) => [
+ q(0044),
+ q(0),
+ ],
+ q(batak languages) => [
+ q(0062),
+ q(0),
+ ],
+ q(bedawiyet) => [
+ q(0047),
+ q(1),
+ ],
+ q(beja) => [
+ q(0047),
+ q(0),
+ ],
+ q(belarusian) => [
+ q(0048),
+ q(0),
+ ],
+ q(bemba) => [
+ q(0049),
+ q(0),
+ ],
+ q(bengali) => [
+ q(0050),
+ q(0),
+ ],
+ q(berber languages) => [
+ q(0051),
+ q(0),
+ ],
+ q(bhojpuri) => [
+ q(0052),
+ q(0),
+ ],
+ q(bihari languages) => [
+ q(0053),
+ q(0),
+ ],
+ q(bikol) => [
+ q(0054),
+ q(0),
+ ],
+ q(bilin) => [
+ q(0067),
+ q(1),
+ ],
+ q(bini) => [
+ q(0055),
+ q(0),
+ ],
+ q(bislama) => [
+ q(0056),
+ q(0),
+ ],
+ q(blin) => [
+ q(0067),
+ q(0),
+ ],
+ q(bliss) => [
+ q(0478),
+ q(2),
+ ],
+ q(blissymbolics) => [
+ q(0478),
+ q(1),
+ ],
+ q(blissymbols) => [
+ q(0478),
+ q(0),
+ ],
+ q(bokmal, norwegian) => [
+ q(0313),
+ q(0),
+ ],
+ q(bosnian) => [
+ q(0059),
+ q(0),
+ ],
+ q(braj) => [
+ q(0060),
+ q(0),
+ ],
+ q(breton) => [
+ q(0061),
+ q(0),
+ ],
+ q(buginese) => [
+ q(0064),
+ q(0),
+ ],
+ q(bulgarian) => [
+ q(0065),
+ q(0),
+ ],
+ q(buriat) => [
+ q(0063),
+ q(0),
+ ],
+ q(burmese) => [
+ q(0066),
+ q(0),
+ ],
+ q(caddo) => [
+ q(0068),
+ q(0),
+ ],
+ q(castilian) => [
+ q(0401),
+ q(1),
+ ],
+ q(catalan) => [
+ q(0071),
+ q(0),
+ ],
+ q(caucasian languages) => [
+ q(0072),
+ q(0),
+ ],
+ q(cebuano) => [
+ q(0073),
+ q(0),
+ ],
+ q(celtic languages) => [
+ q(0074),
+ q(0),
+ ],
+ q(central american indian languages) => [
+ q(0069),
+ q(0),
+ ],
+ q(central khmer) => [
+ q(0222),
+ q(0),
+ ],
+ q(chagatai) => [
+ q(0078),
+ q(0),
+ ],
+ q(chamic languages) => [
+ q(0089),
+ q(0),
+ ],
+ q(chamorro) => [
+ q(0075),
+ q(0),
+ ],
+ q(chechen) => [
+ q(0077),
+ q(0),
+ ],
+ q(cherokee) => [
+ q(0085),
+ q(0),
+ ],
+ q(chewa) => [
+ q(0321),
+ q(1),
+ ],
+ q(cheyenne) => [
+ q(0088),
+ q(0),
+ ],
+ q(chibcha) => [
+ q(0076),
+ q(0),
+ ],
+ q(chichewa) => [
+ q(0321),
+ q(0),
+ ],
+ q(chinese) => [
+ q(0079),
+ q(0),
+ ],
+ q(chinook jargon) => [
+ q(0082),
+ q(0),
+ ],
+ q(chipewyan) => [
+ q(0084),
+ q(0),
+ ],
+ q(choctaw) => [
+ q(0083),
+ q(0),
+ ],
+ q(chuang) => [
+ q(0480),
+ q(1),
+ ],
+ q(church slavic) => [
+ q(0086),
+ q(0),
+ ],
+ q(church slavonic) => [
+ q(0086),
+ q(2),
+ ],
+ q(chuukese) => [
+ q(0080),
+ q(0),
+ ],
+ q(chuvash) => [
+ q(0087),
+ q(0),
+ ],
+ q(classical nepal bhasa) => [
+ q(0320),
+ q(2),
+ ],
+ q(classical newari) => [
+ q(0320),
+ q(0),
+ ],
+ q(classical syriac) => [
+ q(0414),
+ q(0),
+ ],
+ q(cook islands maori) => [
+ q(0356),
+ q(1),
+ ],
+ q(coptic) => [
+ q(0090),
+ q(0),
+ ],
+ q(cornish) => [
+ q(0091),
+ q(0),
+ ],
+ q(corsican) => [
+ q(0092),
+ q(0),
+ ],
+ q(cree) => [
+ q(0096),
+ q(0),
+ ],
+ q(creek) => [
+ q(0293),
+ q(0),
+ ],
+ q(creoles and pidgins ) => [
+ q(0098),
+ q(0),
+ ],
+ q(creoles and pidgins, english based) => [
+ q(0093),
+ q(0),
+ ],
+ q(creoles and pidgins, french-based ) => [
+ q(0094),
+ q(0),
+ ],
+ q(creoles and pidgins, portuguese-based ) => [
+ q(0095),
+ q(0),
+ ],
+ q(crimean tatar) => [
+ q(0097),
+ q(0),
+ ],
+ q(crimean turkish) => [
+ q(0097),
+ q(1),
+ ],
+ q(croatian) => [
+ q(0181),
+ q(0),
+ ],
+ q(cushitic languages) => [
+ q(0100),
+ q(0),
+ ],
+ q(czech) => [
+ q(0101),
+ q(0),
+ ],
+ q(dakota) => [
+ q(0102),
+ q(0),
+ ],
+ q(danish) => [
+ q(0103),
+ q(0),
+ ],
+ q(dargwa) => [
+ q(0104),
+ q(0),
+ ],
+ q(delaware) => [
+ q(0106),
+ q(0),
+ ],
+ q(dene suline) => [
+ q(0084),
+ q(1),
+ ],
+ q(dhivehi) => [
+ q(0110),
+ q(1),
+ ],
+ q(dimili) => [
+ q(0485),
+ q(1),
+ ],
+ q(dimli) => [
+ q(0485),
+ q(2),
+ ],
+ q(dinka) => [
+ q(0109),
+ q(0),
+ ],
+ q(divehi) => [
+ q(0110),
+ q(0),
+ ],
+ q(dogri) => [
+ q(0111),
+ q(0),
+ ],
+ q(dogrib) => [
+ q(0108),
+ q(0),
+ ],
+ q(dravidian languages) => [
+ q(0112),
+ q(0),
+ ],
+ q(duala) => [
+ q(0114),
+ q(0),
+ ],
+ q(dutch) => [
+ q(0116),
+ q(0),
+ ],
+ q(dutch, middle (ca.1050-1350)) => [
+ q(0115),
+ q(0),
+ ],
+ q(dyula) => [
+ q(0117),
+ q(0),
+ ],
+ q(dzongkha) => [
+ q(0118),
+ q(0),
+ ],
+ q(eastern frisian) => [
+ q(0141),
+ q(0),
+ ],
+ q(edo) => [
+ q(0055),
+ q(1),
+ ],
+ q(efik) => [
+ q(0119),
+ q(0),
+ ],
+ q(egyptian (ancient)) => [
+ q(0120),
+ q(0),
+ ],
+ q(ekajuk) => [
+ q(0121),
+ q(0),
+ ],
+ q(elamite) => [
+ q(0122),
+ q(0),
+ ],
+ q(english) => [
+ q(0123),
+ q(0),
+ ],
+ q(english, middle (1100-1500)) => [
+ q(0124),
+ q(0),
+ ],
+ q(english, old (ca.450-1100)) => [
+ q(0018),
+ q(0),
+ ],
+ q(erzya) => [
+ q(0297),
+ q(0),
+ ],
+ q(esperanto) => [
+ q(0125),
+ q(0),
+ ],
+ q(estonian) => [
+ q(0126),
+ q(0),
+ ],
+ q(ewe) => [
+ q(0127),
+ q(0),
+ ],
+ q(ewondo) => [
+ q(0128),
+ q(0),
+ ],
+ q(fang) => [
+ q(0129),
+ q(0),
+ ],
+ q(fanti) => [
+ q(0131),
+ q(0),
+ ],
+ q(faroese) => [
+ q(0130),
+ q(0),
+ ],
+ q(fijian) => [
+ q(0132),
+ q(0),
+ ],
+ q(filipino) => [
+ q(0133),
+ q(0),
+ ],
+ q(finnish) => [
+ q(0134),
+ q(0),
+ ],
+ q(finno-ugrian languages) => [
+ q(0135),
+ q(0),
+ ],
+ q(flemish) => [
+ q(0116),
+ q(1),
+ ],
+ q(fon) => [
+ q(0136),
+ q(0),
+ ],
+ q(french) => [
+ q(0137),
+ q(0),
+ ],
+ q(french, middle (ca.1400-1600)) => [
+ q(0138),
+ q(0),
+ ],
+ q(french, old (842-ca.1400)) => [
+ q(0139),
+ q(0),
+ ],
+ q(friulian) => [
+ q(0144),
+ q(0),
+ ],
+ q(fulah) => [
+ q(0143),
+ q(0),
+ ],
+ q(ga) => [
+ q(0145),
+ q(0),
+ ],
+ q(gaelic) => [
+ q(0153),
+ q(0),
+ ],
+ q(galibi carib) => [
+ q(0070),
+ q(0),
+ ],
+ q(galician) => [
+ q(0155),
+ q(0),
+ ],
+ q(ganda) => [
+ q(0257),
+ q(0),
+ ],
+ q(gayo) => [
+ q(0146),
+ q(0),
+ ],
+ q(gbaya) => [
+ q(0147),
+ q(0),
+ ],
+ q(geez) => [
+ q(0151),
+ q(0),
+ ],
+ q(georgian) => [
+ q(0149),
+ q(0),
+ ],
+ q(german) => [
+ q(0150),
+ q(0),
+ ],
+ q(german, low) => [
+ q(0306),
+ q(2),
+ ],
+ q(german, middle high (ca.1050-1500)) => [
+ q(0157),
+ q(0),
+ ],
+ q(german, old high (ca.750-1050)) => [
+ q(0158),
+ q(0),
+ ],
+ q(germanic languages) => [
+ q(0148),
+ q(0),
+ ],
+ q(gikuyu) => [
+ q(0224),
+ q(1),
+ ],
+ q(gilbertese) => [
+ q(0152),
+ q(0),
+ ],
+ q(gondi) => [
+ q(0159),
+ q(0),
+ ],
+ q(gorontalo) => [
+ q(0160),
+ q(0),
+ ],
+ q(gothic) => [
+ q(0161),
+ q(0),
+ ],
+ q(grebo) => [
+ q(0162),
+ q(0),
+ ],
+ q(greek) => [
+ q(0164),
+ q(1),
+ ],
+ q(greek, ancient (to 1453)) => [
+ q(0163),
+ q(0),
+ ],
+ q(greek, modern (1453-)) => [
+ q(0164),
+ q(0),
+ ],
+ q(greenlandic) => [
+ q(0211),
+ q(1),
+ ],
+ q(guarani) => [
+ q(0165),
+ q(0),
+ ],
+ q(gujarati) => [
+ q(0167),
+ q(0),
+ ],
+ q(gwich'in) => [
+ q(0168),
+ q(0),
+ ],
+ q(haida) => [
+ q(0169),
+ q(0),
+ ],
+ q(haitian) => [
+ q(0170),
+ q(0),
+ ],
+ q(haitian creole) => [
+ q(0170),
+ q(1),
+ ],
+ q(hausa) => [
+ q(0171),
+ q(0),
+ ],
+ q(hawaiian) => [
+ q(0172),
+ q(0),
+ ],
+ q(hebrew) => [
+ q(0173),
+ q(0),
+ ],
+ q(herero) => [
+ q(0174),
+ q(0),
+ ],
+ q(hiligaynon) => [
+ q(0175),
+ q(0),
+ ],
+ q(himachali languages) => [
+ q(0176),
+ q(0),
+ ],
+ q(hindi) => [
+ q(0177),
+ q(0),
+ ],
+ q(hiri motu) => [
+ q(0180),
+ q(0),
+ ],
+ q(hittite) => [
+ q(0178),
+ q(0),
+ ],
+ q(hmong) => [
+ q(0179),
+ q(0),
+ ],
+ q(hungarian) => [
+ q(0183),
+ q(0),
+ ],
+ q(hupa) => [
+ q(0184),
+ q(0),
+ ],
+ q(iban) => [
+ q(0185),
+ q(0),
+ ],
+ q(icelandic) => [
+ q(0187),
+ q(0),
+ ],
+ q(ido) => [
+ q(0188),
+ q(0),
+ ],
+ q(igbo) => [
+ q(0186),
+ q(0),
+ ],
+ q(ijo languages) => [
+ q(0190),
+ q(0),
+ ],
+ q(iloko) => [
+ q(0193),
+ q(0),
+ ],
+ q(imperial aramaic (700-300 bce)) => [
+ q(0022),
+ q(1),
+ ],
+ q(inari sami) => [
+ q(0391),
+ q(0),
+ ],
+ q(indic languages) => [
+ q(0195),
+ q(0),
+ ],
+ q(indo-european languages) => [
+ q(0197),
+ q(0),
+ ],
+ q(indonesian) => [
+ q(0196),
+ q(0),
+ ],
+ q(ingush) => [
+ q(0198),
+ q(0),
+ ],
+ q(interlingua (international auxiliary language association)) => [
+ q(0194),
+ q(0),
+ ],
+ q(interlingue) => [
+ q(0192),
+ q(0),
+ ],
+ q(inuktitut) => [
+ q(0191),
+ q(0),
+ ],
+ q(inupiaq) => [
+ q(0199),
+ q(0),
+ ],
+ q(iranian languages) => [
+ q(0200),
+ q(0),
+ ],
+ q(irish) => [
+ q(0154),
+ q(0),
+ ],
+ q(irish, middle (900-1200)) => [
+ q(0278),
+ q(0),
+ ],
+ q(irish, old (to 900)) => [
+ q(0377),
+ q(0),
+ ],
+ q(iroquoian languages) => [
+ q(0201),
+ q(0),
+ ],
+ q(italian) => [
+ q(0202),
+ q(0),
+ ],
+ q(japanese) => [
+ q(0205),
+ q(0),
+ ],
+ q(javanese) => [
+ q(0203),
+ q(0),
+ ],
+ q(jingpho) => [
+ q(0210),
+ q(1),
+ ],
+ q(judeo-arabic) => [
+ q(0207),
+ q(0),
+ ],
+ q(judeo-persian) => [
+ q(0206),
+ q(0),
+ ],
+ q(kabardian) => [
+ q(0219),
+ q(0),
+ ],
+ q(kabyle) => [
+ q(0209),
+ q(0),
+ ],
+ q(kachin) => [
+ q(0210),
+ q(0),
+ ],
+ q(kalaallisut) => [
+ q(0211),
+ q(0),
+ ],
+ q(kalmyk) => [
+ q(0470),
+ q(0),
+ ],
+ q(kamba) => [
+ q(0212),
+ q(0),
+ ],
+ q(kannada) => [
+ q(0213),
+ q(0),
+ ],
+ q(kanuri) => [
+ q(0216),
+ q(0),
+ ],
+ q(kapampangan) => [
+ q(0337),
+ q(1),
+ ],
+ q(kara-kalpak) => [
+ q(0208),
+ q(0),
+ ],
+ q(karachay-balkar) => [
+ q(0234),
+ q(0),
+ ],
+ q(karelian) => [
+ q(0235),
+ q(0),
+ ],
+ q(karen languages) => [
+ q(0214),
+ q(0),
+ ],
+ q(kashmiri) => [
+ q(0215),
+ q(0),
+ ],
+ q(kashubian) => [
+ q(0099),
+ q(0),
+ ],
+ q(kawi) => [
+ q(0217),
+ q(0),
+ ],
+ q(kazakh) => [
+ q(0218),
+ q(0),
+ ],
+ q(khasi) => [
+ q(0220),
+ q(0),
+ ],
+ q(khoisan languages) => [
+ q(0221),
+ q(0),
+ ],
+ q(khotanese) => [
+ q(0223),
+ q(0),
+ ],
+ q(kikuyu) => [
+ q(0224),
+ q(0),
+ ],
+ q(kimbundu) => [
+ q(0227),
+ q(0),
+ ],
+ q(kinyarwanda) => [
+ q(0225),
+ q(0),
+ ],
+ q(kirdki) => [
+ q(0485),
+ q(3),
+ ],
+ q(kirghiz) => [
+ q(0226),
+ q(0),
+ ],
+ q(kirmanjki) => [
+ q(0485),
+ q(4),
+ ],
+ q(klingon) => [
+ q(0432),
+ q(0),
+ ],
+ q(komi) => [
+ q(0229),
+ q(0),
+ ],
+ q(kongo) => [
+ q(0230),
+ q(0),
+ ],
+ q(konkani) => [
+ q(0228),
+ q(0),
+ ],
+ q(korean) => [
+ q(0231),
+ q(0),
+ ],
+ q(kosraean) => [
+ q(0232),
+ q(0),
+ ],
+ q(kpelle) => [
+ q(0233),
+ q(0),
+ ],
+ q(kru languages) => [
+ q(0236),
+ q(0),
+ ],
+ q(kuanyama) => [
+ q(0238),
+ q(0),
+ ],
+ q(kumyk) => [
+ q(0239),
+ q(0),
+ ],
+ q(kurdish) => [
+ q(0240),
+ q(0),
+ ],
+ q(kurukh) => [
+ q(0237),
+ q(0),
+ ],
+ q(kutenai) => [
+ q(0241),
+ q(0),
+ ],
+ q(kwanyama) => [
+ q(0238),
+ q(1),
+ ],
+ q(kyrgyz) => [
+ q(0226),
+ q(1),
+ ],
+ q(ladino) => [
+ q(0242),
+ q(0),
+ ],
+ q(lahnda) => [
+ q(0243),
+ q(0),
+ ],
+ q(lamba) => [
+ q(0244),
+ q(0),
+ ],
+ q(land dayak languages) => [
+ q(0105),
+ q(0),
+ ],
+ q(lao) => [
+ q(0245),
+ q(0),
+ ],
+ q(latin) => [
+ q(0246),
+ q(0),
+ ],
+ q(latvian) => [
+ q(0247),
+ q(0),
+ ],
+ q(leonese) => [
+ q(0030),
+ q(2),
+ ],
+ q(letzeburgesch) => [
+ q(0254),
+ q(1),
+ ],
+ q(lezghian) => [
+ q(0248),
+ q(0),
+ ],
+ q(limburgan) => [
+ q(0249),
+ q(0),
+ ],
+ q(limburger) => [
+ q(0249),
+ q(1),
+ ],
+ q(limburgish) => [
+ q(0249),
+ q(2),
+ ],
+ q(lingala) => [
+ q(0250),
+ q(0),
+ ],
+ q(lithuanian) => [
+ q(0251),
+ q(0),
+ ],
+ q(lojban) => [
+ q(0204),
+ q(0),
+ ],
+ q(low german) => [
+ q(0306),
+ q(0),
+ ],
+ q(low saxon) => [
+ q(0306),
+ q(1),
+ ],
+ q(lower sorbian) => [
+ q(0113),
+ q(0),
+ ],
+ q(lozi) => [
+ q(0253),
+ q(0),
+ ],
+ q(luba-katanga) => [
+ q(0256),
+ q(0),
+ ],
+ q(luba-lulua) => [
+ q(0255),
+ q(0),
+ ],
+ q(luiseno) => [
+ q(0258),
+ q(0),
+ ],
+ q(lule sami) => [
+ q(0390),
+ q(0),
+ ],
+ q(lunda) => [
+ q(0259),
+ q(0),
+ ],
+ q(luo (kenya and tanzania)) => [
+ q(0260),
+ q(0),
+ ],
+ q(lushai) => [
+ q(0261),
+ q(0),
+ ],
+ q(luxembourgish) => [
+ q(0254),
+ q(0),
+ ],
+ q(macedo-romanian) => [
+ q(0362),
+ q(2),
+ ],
+ q(macedonian) => [
+ q(0262),
+ q(0),
+ ],
+ q(madurese) => [
+ q(0263),
+ q(0),
+ ],
+ q(magahi) => [
+ q(0264),
+ q(0),
+ ],
+ q(maithili) => [
+ q(0266),
+ q(0),
+ ],
+ q(makasar) => [
+ q(0267),
+ q(0),
+ ],
+ q(malagasy) => [
+ q(0283),
+ q(0),
+ ],
+ q(malay) => [
+ q(0274),
+ q(0),
+ ],
+ q(malayalam) => [
+ q(0268),
+ q(0),
+ ],
+ q(maldivian) => [
+ q(0110),
+ q(2),
+ ],
+ q(maltese) => [
+ q(0284),
+ q(0),
+ ],
+ q(manchu) => [
+ q(0285),
+ q(0),
+ ],
+ q(mandar) => [
+ q(0276),
+ q(0),
+ ],
+ q(mandingo) => [
+ q(0269),
+ q(0),
+ ],
+ q(manipuri) => [
+ q(0286),
+ q(0),
+ ],
+ q(manobo languages) => [
+ q(0287),
+ q(0),
+ ],
+ q(manx) => [
+ q(0156),
+ q(0),
+ ],
+ q(maori) => [
+ q(0270),
+ q(0),
+ ],
+ q(mapuche) => [
+ q(0025),
+ q(1),
+ ],
+ q(mapudungun) => [
+ q(0025),
+ q(0),
+ ],
+ q(marathi) => [
+ q(0272),
+ q(0),
+ ],
+ q(mari) => [
+ q(0081),
+ q(0),
+ ],
+ q(marshallese) => [
+ q(0265),
+ q(0),
+ ],
+ q(marwari) => [
+ q(0295),
+ q(0),
+ ],
+ q(masai) => [
+ q(0273),
+ q(0),
+ ],
+ q(mayan languages) => [
+ q(0296),
+ q(0),
+ ],
+ q(mende) => [
+ q(0277),
+ q(0),
+ ],
+ q(mi'kmaq) => [
+ q(0279),
+ q(0),
+ ],
+ q(micmac) => [
+ q(0279),
+ q(1),
+ ],
+ q(minangkabau) => [
+ q(0280),
+ q(0),
+ ],
+ q(mirandese) => [
+ q(0294),
+ q(0),
+ ],
+ q(mohawk) => [
+ q(0288),
+ q(0),
+ ],
+ q(moksha) => [
+ q(0275),
+ q(0),
+ ],
+ q(moldavian) => [
+ q(0360),
+ q(1),
+ ],
+ q(moldovan) => [
+ q(0360),
+ q(2),
+ ],
+ q(mon-khmer languages) => [
+ q(0282),
+ q(0),
+ ],
+ q(mong) => [
+ q(0179),
+ q(1),
+ ],
+ q(mongo) => [
+ q(0252),
+ q(0),
+ ],
+ q(mongolian) => [
+ q(0289),
+ q(0),
+ ],
+ q(mossi) => [
+ q(0290),
+ q(0),
+ ],
+ q(multiple languages) => [
+ q(0291),
+ q(0),
+ ],
+ q(munda languages) => [
+ q(0292),
+ q(0),
+ ],
+ q(n'ko) => [
+ q(0317),
+ q(0),
+ ],
+ q(nahuatl languages) => [
+ q(0298),
+ q(0),
+ ],
+ q(nauru) => [
+ q(0301),
+ q(0),
+ ],
+ q(navaho) => [
+ q(0302),
+ q(1),
+ ],
+ q(navajo) => [
+ q(0302),
+ q(0),
+ ],
+ q(ndebele, north) => [
+ q(0304),
+ q(0),
+ ],
+ q(ndebele, south) => [
+ q(0303),
+ q(0),
+ ],
+ q(ndonga) => [
+ q(0305),
+ q(0),
+ ],
+ q(neapolitan) => [
+ q(0300),
+ q(0),
+ ],
+ q(nepal bhasa) => [
+ q(0308),
+ q(0),
+ ],
+ q(nepali) => [
+ q(0307),
+ q(0),
+ ],
+ q(newari) => [
+ q(0308),
+ q(1),
+ ],
+ q(nias) => [
+ q(0309),
+ q(0),
+ ],
+ q(niger-kordofanian languages) => [
+ q(0310),
+ q(0),
+ ],
+ q(nilo-saharan languages) => [
+ q(0406),
+ q(0),
+ ],
+ q(niuean) => [
+ q(0311),
+ q(0),
+ ],
+ q(no linguistic content) => [
+ q(0484),
+ q(0),
+ ],
+ q(nogai) => [
+ q(0314),
+ q(0),
+ ],
+ q(norse, old) => [
+ q(0315),
+ q(0),
+ ],
+ q(north american indian languages) => [
+ q(0299),
+ q(0),
+ ],
+ q(north ndebele) => [
+ q(0304),
+ q(1),
+ ],
+ q(northern frisian) => [
+ q(0140),
+ q(0),
+ ],
+ q(northern sami) => [
+ q(0388),
+ q(0),
+ ],
+ q(northern sotho) => [
+ q(0318),
+ q(2),
+ ],
+ q(norwegian) => [
+ q(0316),
+ q(0),
+ ],
+ q(norwegian bokmal) => [
+ q(0313),
+ q(1),
+ ],
+ q(norwegian nynorsk) => [
+ q(0312),
+ q(0),
+ ],
+ q(not applicable) => [
+ q(0484),
+ q(1),
+ ],
+ q(nubian languages) => [
+ q(0319),
+ q(0),
+ ],
+ q(nuosu) => [
+ q(0189),
+ q(1),
+ ],
+ q(nyamwezi) => [
+ q(0322),
+ q(0),
+ ],
+ q(nyanja) => [
+ q(0321),
+ q(2),
+ ],
+ q(nyankole) => [
+ q(0323),
+ q(0),
+ ],
+ q(nynorsk, norwegian) => [
+ q(0312),
+ q(1),
+ ],
+ q(nyoro) => [
+ q(0324),
+ q(0),
+ ],
+ q(nzima) => [
+ q(0325),
+ q(0),
+ ],
+ q(occidental) => [
+ q(0192),
+ q(1),
+ ],
+ q(occitan (post 1500)) => [
+ q(0326),
+ q(0),
+ ],
+ q(official aramaic (700-300 bce)) => [
+ q(0022),
+ q(0),
+ ],
+ q(oirat) => [
+ q(0470),
+ q(1),
+ ],
+ q(ojibwa) => [
+ q(0327),
+ q(0),
+ ],
+ q(old bulgarian) => [
+ q(0086),
+ q(3),
+ ],
+ q(old church slavonic) => [
+ q(0086),
+ q(4),
+ ],
+ q(old newari) => [
+ q(0320),
+ q(1),
+ ],
+ q(old slavonic) => [
+ q(0086),
+ q(1),
+ ],
+ q(oriya) => [
+ q(0328),
+ q(0),
+ ],
+ q(oromo) => [
+ q(0329),
+ q(0),
+ ],
+ q(osage) => [
+ q(0330),
+ q(0),
+ ],
+ q(ossetian) => [
+ q(0331),
+ q(0),
+ ],
+ q(ossetic) => [
+ q(0331),
+ q(1),
+ ],
+ q(otomian languages) => [
+ q(0333),
+ q(0),
+ ],
+ q(pahlavi) => [
+ q(0336),
+ q(0),
+ ],
+ q(palauan) => [
+ q(0340),
+ q(0),
+ ],
+ q(pali) => [
+ q(0345),
+ q(0),
+ ],
+ q(pampanga) => [
+ q(0337),
+ q(0),
+ ],
+ q(pangasinan) => [
+ q(0335),
+ q(0),
+ ],
+ q(panjabi) => [
+ q(0338),
+ q(0),
+ ],
+ q(papiamento) => [
+ q(0339),
+ q(0),
+ ],
+ q(papuan languages) => [
+ q(0334),
+ q(0),
+ ],
+ q(pashto) => [
+ q(0351),
+ q(1),
+ ],
+ q(pedi) => [
+ q(0318),
+ q(0),
+ ],
+ q(persian) => [
+ q(0342),
+ q(0),
+ ],
+ q(persian, old (ca.600-400 b.c.)) => [
+ q(0341),
+ q(0),
+ ],
+ q(philippine languages) => [
+ q(0343),
+ q(0),
+ ],
+ q(phoenician) => [
+ q(0344),
+ q(0),
+ ],
+ q(pilipino) => [
+ q(0133),
+ q(1),
+ ],
+ q(pohnpeian) => [
+ q(0347),
+ q(0),
+ ],
+ q(polish) => [
+ q(0346),
+ q(0),
+ ],
+ q(portuguese) => [
+ q(0348),
+ q(0),
+ ],
+ q(prakrit languages) => [
+ q(0349),
+ q(0),
+ ],
+ q(provencal) => [
+ q(0326),
+ q(1),
+ ],
+ q(provencal, old (to 1500)) => [
+ q(0350),
+ q(0),
+ ],
+ q(punjabi) => [
+ q(0338),
+ q(1),
+ ],
+ q(pushto) => [
+ q(0351),
+ q(0),
+ ],
+ q(quechua) => [
+ q(0353),
+ q(0),
+ ],
+ q(rajasthani) => [
+ q(0354),
+ q(0),
+ ],
+ q(rapanui) => [
+ q(0355),
+ q(0),
+ ],
+ q(rarotongan) => [
+ q(0356),
+ q(0),
+ ],
+ q(reserved for local use) => [
+ q(0352),
+ q(0),
+ ],
+ q(romance languages) => [
+ q(0357),
+ q(0),
+ ],
+ q(romanian) => [
+ q(0360),
+ q(0),
+ ],
+ q(romansh) => [
+ q(0358),
+ q(0),
+ ],
+ q(romany) => [
+ q(0359),
+ q(0),
+ ],
+ q(rundi) => [
+ q(0361),
+ q(0),
+ ],
+ q(russian) => [
+ q(0363),
+ q(0),
+ ],
+ q(sakan) => [
+ q(0223),
+ q(1),
+ ],
+ q(salishan languages) => [
+ q(0368),
+ q(0),
+ ],
+ q(samaritan aramaic) => [
+ q(0369),
+ q(0),
+ ],
+ q(sami languages) => [
+ q(0389),
+ q(0),
+ ],
+ q(samoan) => [
+ q(0392),
+ q(0),
+ ],
+ q(sandawe) => [
+ q(0364),
+ q(0),
+ ],
+ q(sango) => [
+ q(0365),
+ q(0),
+ ],
+ q(sanskrit) => [
+ q(0370),
+ q(0),
+ ],
+ q(santali) => [
+ q(0372),
+ q(0),
+ ],
+ q(sardinian) => [
+ q(0402),
+ q(0),
+ ],
+ q(sasak) => [
+ q(0371),
+ q(0),
+ ],
+ q(saxon, low) => [
+ q(0306),
+ q(3),
+ ],
+ q(scots) => [
+ q(0374),
+ q(0),
+ ],
+ q(scottish gaelic) => [
+ q(0153),
+ q(1),
+ ],
+ q(selkup) => [
+ q(0375),
+ q(0),
+ ],
+ q(semitic languages) => [
+ q(0376),
+ q(0),
+ ],
+ q(sepedi) => [
+ q(0318),
+ q(1),
+ ],
+ q(serbian) => [
+ q(0404),
+ q(0),
+ ],
+ q(serer) => [
+ q(0405),
+ q(0),
+ ],
+ q(shan) => [
+ q(0379),
+ q(0),
+ ],
+ q(shona) => [
+ q(0394),
+ q(0),
+ ],
+ q(sichuan yi) => [
+ q(0189),
+ q(0),
+ ],
+ q(sicilian) => [
+ q(0373),
+ q(0),
+ ],
+ q(sidamo) => [
+ q(0380),
+ q(0),
+ ],
+ q(sign languages) => [
+ q(0378),
+ q(0),
+ ],
+ q(siksika) => [
+ q(0057),
+ q(0),
+ ],
+ q(sindhi) => [
+ q(0395),
+ q(0),
+ ],
+ q(sinhala) => [
+ q(0381),
+ q(0),
+ ],
+ q(sinhalese) => [
+ q(0381),
+ q(1),
+ ],
+ q(sino-tibetan languages) => [
+ q(0383),
+ q(0),
+ ],
+ q(siouan languages) => [
+ q(0382),
+ q(0),
+ ],
+ q(skolt sami) => [
+ q(0393),
+ q(0),
+ ],
+ q(slave (athapascan)) => [
+ q(0107),
+ q(0),
+ ],
+ q(slavic languages) => [
+ q(0384),
+ q(0),
+ ],
+ q(slovak) => [
+ q(0385),
+ q(0),
+ ],
+ q(slovenian) => [
+ q(0386),
+ q(0),
+ ],
+ q(sogdian) => [
+ q(0397),
+ q(0),
+ ],
+ q(somali) => [
+ q(0398),
+ q(0),
+ ],
+ q(songhai languages) => [
+ q(0399),
+ q(0),
+ ],
+ q(soninke) => [
+ q(0396),
+ q(0),
+ ],
+ q(sorbian languages) => [
+ q(0467),
+ q(0),
+ ],
+ q(sotho, southern) => [
+ q(0400),
+ q(0),
+ ],
+ q(south american indian (other)) => [
+ q(0367),
+ q(0),
+ ],
+ q(south ndebele) => [
+ q(0303),
+ q(1),
+ ],
+ q(southern altai) => [
+ q(0016),
+ q(0),
+ ],
+ q(southern sami) => [
+ q(0387),
+ q(0),
+ ],
+ q(spanish) => [
+ q(0401),
+ q(0),
+ ],
+ q(sranan tongo) => [
+ q(0403),
+ q(0),
+ ],
+ q(sukuma) => [
+ q(0408),
+ q(0),
+ ],
+ q(sumerian) => [
+ q(0411),
+ q(0),
+ ],
+ q(sundanese) => [
+ q(0409),
+ q(0),
+ ],
+ q(susu) => [
+ q(0410),
+ q(0),
+ ],
+ q(swahili) => [
+ q(0412),
+ q(0),
+ ],
+ q(swati) => [
+ q(0407),
+ q(0),
+ ],
+ q(swedish) => [
+ q(0413),
+ q(0),
+ ],
+ q(swiss german) => [
+ q(0166),
+ q(0),
+ ],
+ q(syriac) => [
+ q(0415),
+ q(0),
+ ],
+ q(tagalog) => [
+ q(0425),
+ q(0),
+ ],
+ q(tahitian) => [
+ q(0416),
+ q(0),
+ ],
+ q(tai languages) => [
+ q(0417),
+ q(0),
+ ],
+ q(tajik) => [
+ q(0424),
+ q(0),
+ ],
+ q(tamashek) => [
+ q(0434),
+ q(0),
+ ],
+ q(tamil) => [
+ q(0418),
+ q(0),
+ ],
+ q(tatar) => [
+ q(0419),
+ q(0),
+ ],
+ q(telugu) => [
+ q(0420),
+ q(0),
+ ],
+ q(tereno) => [
+ q(0422),
+ q(0),
+ ],
+ q(tetum) => [
+ q(0423),
+ q(0),
+ ],
+ q(thai) => [
+ q(0426),
+ q(0),
+ ],
+ q(tibetan) => [
+ q(0427),
+ q(0),
+ ],
+ q(tigre) => [
+ q(0428),
+ q(0),
+ ],
+ q(tigrinya) => [
+ q(0429),
+ q(0),
+ ],
+ q(timne) => [
+ q(0421),
+ q(0),
+ ],
+ q(tiv) => [
+ q(0430),
+ q(0),
+ ],
+ q(tlhingan-hol) => [
+ q(0432),
+ q(1),
+ ],
+ q(tlingit) => [
+ q(0433),
+ q(0),
+ ],
+ q(tok pisin) => [
+ q(0437),
+ q(0),
+ ],
+ q(tokelau) => [
+ q(0431),
+ q(0),
+ ],
+ q(tonga) => [
+ q(0436),
+ q(1),
+ ],
+ q(tonga (nyasa)) => [
+ q(0435),
+ q(0),
+ ],
+ q(tonga (tonga islands)) => [
+ q(0436),
+ q(0),
+ ],
+ q(tsimshian) => [
+ q(0438),
+ q(0),
+ ],
+ q(tsonga) => [
+ q(0440),
+ q(0),
+ ],
+ q(tswana) => [
+ q(0439),
+ q(0),
+ ],
+ q(tumbuka) => [
+ q(0442),
+ q(0),
+ ],
+ q(tupi languages) => [
+ q(0443),
+ q(0),
+ ],
+ q(turkish) => [
+ q(0444),
+ q(0),
+ ],
+ q(turkish, ottoman (1500-1928)) => [
+ q(0332),
+ q(0),
+ ],
+ q(turkmen) => [
+ q(0441),
+ q(0),
+ ],
+ q(tuvalu) => [
+ q(0446),
+ q(0),
+ ],
+ q(tuvinian) => [
+ q(0448),
+ q(0),
+ ],
+ q(twi) => [
+ q(0447),
+ q(0),
+ ],
+ q(udmurt) => [
+ q(0449),
+ q(0),
+ ],
+ q(ugaritic) => [
+ q(0450),
+ q(0),
+ ],
+ q(uighur) => [
+ q(0451),
+ q(0),
+ ],
+ q(ukrainian) => [
+ q(0452),
+ q(0),
+ ],
+ q(umbundu) => [
+ q(0453),
+ q(0),
+ ],
+ q(uncoded languages) => [
+ q(0281),
+ q(0),
+ ],
+ q(undetermined) => [
+ q(0454),
+ q(0),
+ ],
+ q(upper sorbian) => [
+ q(0182),
+ q(0),
+ ],
+ q(urdu) => [
+ q(0455),
+ q(0),
+ ],
+ q(uyghur) => [
+ q(0451),
+ q(1),
+ ],
+ q(uzbek) => [
+ q(0456),
+ q(0),
+ ],
+ q(vai) => [
+ q(0457),
+ q(0),
+ ],
+ q(valencian) => [
+ q(0071),
+ q(1),
+ ],
+ q(venda) => [
+ q(0458),
+ q(0),
+ ],
+ q(vietnamese) => [
+ q(0459),
+ q(0),
+ ],
+ q(volapuk) => [
+ q(0460),
+ q(0),
+ ],
+ q(votic) => [
+ q(0461),
+ q(0),
+ ],
+ q(wakashan languages) => [
+ q(0462),
+ q(0),
+ ],
+ q(walamo) => [
+ q(0463),
+ q(0),
+ ],
+ q(walloon) => [
+ q(0468),
+ q(0),
+ ],
+ q(waray) => [
+ q(0464),
+ q(0),
+ ],
+ q(washo) => [
+ q(0465),
+ q(0),
+ ],
+ q(welsh) => [
+ q(0466),
+ q(0),
+ ],
+ q(western frisian) => [
+ q(0142),
+ q(0),
+ ],
+ q(western pahari languages) => [
+ q(0176),
+ q(1),
+ ],
+ q(wolof) => [
+ q(0469),
+ q(0),
+ ],
+ q(xhosa) => [
+ q(0471),
+ q(0),
+ ],
+ q(yakut) => [
+ q(0366),
+ q(0),
+ ],
+ q(yao) => [
+ q(0472),
+ q(0),
+ ],
+ q(yapese) => [
+ q(0473),
+ q(0),
+ ],
+ q(yiddish) => [
+ q(0474),
+ q(0),
+ ],
+ q(yoruba) => [
+ q(0475),
+ q(0),
+ ],
+ q(yupik languages) => [
+ q(0476),
+ q(0),
+ ],
+ q(zande languages) => [
+ q(0481),
+ q(0),
+ ],
+ q(zapotec) => [
+ q(0477),
+ q(0),
+ ],
+ q(zaza) => [
+ q(0485),
+ q(0),
+ ],
+ q(zazaki) => [
+ q(0485),
+ q(5),
+ ],
+ q(zenaga) => [
+ q(0479),
+ q(0),
+ ],
+ q(zhuang) => [
+ q(0480),
+ q(0),
+ ],
+ q(zulu) => [
+ q(0482),
+ q(0),
+ ],
+ q(zuni) => [
+ q(0483),
+ q(0),
+ ],
+};
+
+$Locale::Codes::Data{'language'}{'code2id'} = {
+ q(alpha2) => {
+ q(aa) => [
+ q(0001),
+ q(0),
+ ],
+ q(ab) => [
+ q(0002),
+ q(0),
+ ],
+ q(ae) => [
+ q(0034),
+ q(0),
+ ],
+ q(af) => [
+ q(0009),
+ q(0),
+ ],
+ q(ak) => [
+ q(0011),
+ q(0),
+ ],
+ q(am) => [
+ q(0017),
+ q(0),
+ ],
+ q(an) => [
+ q(0023),
+ q(0),
+ ],
+ q(ar) => [
+ q(0021),
+ q(0),
+ ],
+ q(as) => [
+ q(0029),
+ q(0),
+ ],
+ q(av) => [
+ q(0033),
+ q(0),
+ ],
+ q(ay) => [
+ q(0036),
+ q(0),
+ ],
+ q(az) => [
+ q(0037),
+ q(0),
+ ],
+ q(ba) => [
+ q(0040),
+ q(0),
+ ],
+ q(be) => [
+ q(0048),
+ q(0),
+ ],
+ q(bg) => [
+ q(0065),
+ q(0),
+ ],
+ q(bh) => [
+ q(0053),
+ q(0),
+ ],
+ q(bi) => [
+ q(0056),
+ q(0),
+ ],
+ q(bm) => [
+ q(0042),
+ q(0),
+ ],
+ q(bn) => [
+ q(0050),
+ q(0),
+ ],
+ q(bo) => [
+ q(0427),
+ q(0),
+ ],
+ q(br) => [
+ q(0061),
+ q(0),
+ ],
+ q(bs) => [
+ q(0059),
+ q(0),
+ ],
+ q(ca) => [
+ q(0071),
+ q(0),
+ ],
+ q(ce) => [
+ q(0077),
+ q(0),
+ ],
+ q(ch) => [
+ q(0075),
+ q(0),
+ ],
+ q(co) => [
+ q(0092),
+ q(0),
+ ],
+ q(cr) => [
+ q(0096),
+ q(0),
+ ],
+ q(cs) => [
+ q(0101),
+ q(0),
+ ],
+ q(cu) => [
+ q(0086),
+ q(0),
+ ],
+ q(cv) => [
+ q(0087),
+ q(0),
+ ],
+ q(cy) => [
+ q(0466),
+ q(0),
+ ],
+ q(da) => [
+ q(0103),
+ q(0),
+ ],
+ q(de) => [
+ q(0150),
+ q(0),
+ ],
+ q(dv) => [
+ q(0110),
+ q(0),
+ ],
+ q(dz) => [
+ q(0118),
+ q(0),
+ ],
+ q(ee) => [
+ q(0127),
+ q(0),
+ ],
+ q(el) => [
+ q(0164),
+ q(0),
+ ],
+ q(en) => [
+ q(0123),
+ q(0),
+ ],
+ q(eo) => [
+ q(0125),
+ q(0),
+ ],
+ q(es) => [
+ q(0401),
+ q(0),
+ ],
+ q(et) => [
+ q(0126),
+ q(0),
+ ],
+ q(eu) => [
+ q(0044),
+ q(0),
+ ],
+ q(fa) => [
+ q(0342),
+ q(0),
+ ],
+ q(ff) => [
+ q(0143),
+ q(0),
+ ],
+ q(fi) => [
+ q(0134),
+ q(0),
+ ],
+ q(fj) => [
+ q(0132),
+ q(0),
+ ],
+ q(fo) => [
+ q(0130),
+ q(0),
+ ],
+ q(fr) => [
+ q(0137),
+ q(0),
+ ],
+ q(fy) => [
+ q(0142),
+ q(0),
+ ],
+ q(ga) => [
+ q(0154),
+ q(0),
+ ],
+ q(gd) => [
+ q(0153),
+ q(0),
+ ],
+ q(gl) => [
+ q(0155),
+ q(0),
+ ],
+ q(gn) => [
+ q(0165),
+ q(0),
+ ],
+ q(gu) => [
+ q(0167),
+ q(0),
+ ],
+ q(gv) => [
+ q(0156),
+ q(0),
+ ],
+ q(ha) => [
+ q(0171),
+ q(0),
+ ],
+ q(he) => [
+ q(0173),
+ q(0),
+ ],
+ q(hi) => [
+ q(0177),
+ q(0),
+ ],
+ q(ho) => [
+ q(0180),
+ q(0),
+ ],
+ q(hr) => [
+ q(0181),
+ q(0),
+ ],
+ q(ht) => [
+ q(0170),
+ q(0),
+ ],
+ q(hu) => [
+ q(0183),
+ q(0),
+ ],
+ q(hy) => [
+ q(0024),
+ q(0),
+ ],
+ q(hz) => [
+ q(0174),
+ q(0),
+ ],
+ q(ia) => [
+ q(0194),
+ q(0),
+ ],
+ q(id) => [
+ q(0196),
+ q(0),
+ ],
+ q(ie) => [
+ q(0192),
+ q(0),
+ ],
+ q(ig) => [
+ q(0186),
+ q(0),
+ ],
+ q(ii) => [
+ q(0189),
+ q(0),
+ ],
+ q(ik) => [
+ q(0199),
+ q(0),
+ ],
+ q(io) => [
+ q(0188),
+ q(0),
+ ],
+ q(is) => [
+ q(0187),
+ q(0),
+ ],
+ q(it) => [
+ q(0202),
+ q(0),
+ ],
+ q(iu) => [
+ q(0191),
+ q(0),
+ ],
+ q(ja) => [
+ q(0205),
+ q(0),
+ ],
+ q(jv) => [
+ q(0203),
+ q(0),
+ ],
+ q(ka) => [
+ q(0149),
+ q(0),
+ ],
+ q(kg) => [
+ q(0230),
+ q(0),
+ ],
+ q(ki) => [
+ q(0224),
+ q(0),
+ ],
+ q(kj) => [
+ q(0238),
+ q(0),
+ ],
+ q(kk) => [
+ q(0218),
+ q(0),
+ ],
+ q(kl) => [
+ q(0211),
+ q(0),
+ ],
+ q(km) => [
+ q(0222),
+ q(0),
+ ],
+ q(kn) => [
+ q(0213),
+ q(0),
+ ],
+ q(ko) => [
+ q(0231),
+ q(0),
+ ],
+ q(kr) => [
+ q(0216),
+ q(0),
+ ],
+ q(ks) => [
+ q(0215),
+ q(0),
+ ],
+ q(ku) => [
+ q(0240),
+ q(0),
+ ],
+ q(kv) => [
+ q(0229),
+ q(0),
+ ],
+ q(kw) => [
+ q(0091),
+ q(0),
+ ],
+ q(ky) => [
+ q(0226),
+ q(0),
+ ],
+ q(la) => [
+ q(0246),
+ q(0),
+ ],
+ q(lb) => [
+ q(0254),
+ q(0),
+ ],
+ q(lg) => [
+ q(0257),
+ q(0),
+ ],
+ q(li) => [
+ q(0249),
+ q(0),
+ ],
+ q(ln) => [
+ q(0250),
+ q(0),
+ ],
+ q(lo) => [
+ q(0245),
+ q(0),
+ ],
+ q(lt) => [
+ q(0251),
+ q(0),
+ ],
+ q(lu) => [
+ q(0256),
+ q(0),
+ ],
+ q(lv) => [
+ q(0247),
+ q(0),
+ ],
+ q(mg) => [
+ q(0283),
+ q(0),
+ ],
+ q(mh) => [
+ q(0265),
+ q(0),
+ ],
+ q(mi) => [
+ q(0270),
+ q(0),
+ ],
+ q(mk) => [
+ q(0262),
+ q(0),
+ ],
+ q(ml) => [
+ q(0268),
+ q(0),
+ ],
+ q(mn) => [
+ q(0289),
+ q(0),
+ ],
+ q(mr) => [
+ q(0272),
+ q(0),
+ ],
+ q(ms) => [
+ q(0274),
+ q(0),
+ ],
+ q(mt) => [
+ q(0284),
+ q(0),
+ ],
+ q(my) => [
+ q(0066),
+ q(0),
+ ],
+ q(na) => [
+ q(0301),
+ q(0),
+ ],
+ q(nb) => [
+ q(0313),
+ q(0),
+ ],
+ q(nd) => [
+ q(0304),
+ q(0),
+ ],
+ q(ne) => [
+ q(0307),
+ q(0),
+ ],
+ q(ng) => [
+ q(0305),
+ q(0),
+ ],
+ q(nl) => [
+ q(0116),
+ q(0),
+ ],
+ q(nn) => [
+ q(0312),
+ q(0),
+ ],
+ q(no) => [
+ q(0316),
+ q(0),
+ ],
+ q(nr) => [
+ q(0303),
+ q(0),
+ ],
+ q(nv) => [
+ q(0302),
+ q(0),
+ ],
+ q(ny) => [
+ q(0321),
+ q(0),
+ ],
+ q(oc) => [
+ q(0326),
+ q(0),
+ ],
+ q(oj) => [
+ q(0327),
+ q(0),
+ ],
+ q(om) => [
+ q(0329),
+ q(0),
+ ],
+ q(or) => [
+ q(0328),
+ q(0),
+ ],
+ q(os) => [
+ q(0331),
+ q(0),
+ ],
+ q(pa) => [
+ q(0338),
+ q(0),
+ ],
+ q(pi) => [
+ q(0345),
+ q(0),
+ ],
+ q(pl) => [
+ q(0346),
+ q(0),
+ ],
+ q(ps) => [
+ q(0351),
+ q(0),
+ ],
+ q(pt) => [
+ q(0348),
+ q(0),
+ ],
+ q(qu) => [
+ q(0353),
+ q(0),
+ ],
+ q(rm) => [
+ q(0358),
+ q(0),
+ ],
+ q(rn) => [
+ q(0361),
+ q(0),
+ ],
+ q(ro) => [
+ q(0360),
+ q(0),
+ ],
+ q(ru) => [
+ q(0363),
+ q(0),
+ ],
+ q(rw) => [
+ q(0225),
+ q(0),
+ ],
+ q(sa) => [
+ q(0370),
+ q(0),
+ ],
+ q(sc) => [
+ q(0402),
+ q(0),
+ ],
+ q(sd) => [
+ q(0395),
+ q(0),
+ ],
+ q(se) => [
+ q(0388),
+ q(0),
+ ],
+ q(sg) => [
+ q(0365),
+ q(0),
+ ],
+ q(si) => [
+ q(0381),
+ q(0),
+ ],
+ q(sk) => [
+ q(0385),
+ q(0),
+ ],
+ q(sl) => [
+ q(0386),
+ q(0),
+ ],
+ q(sm) => [
+ q(0392),
+ q(0),
+ ],
+ q(sn) => [
+ q(0394),
+ q(0),
+ ],
+ q(so) => [
+ q(0398),
+ q(0),
+ ],
+ q(sq) => [
+ q(0013),
+ q(0),
+ ],
+ q(sr) => [
+ q(0404),
+ q(0),
+ ],
+ q(ss) => [
+ q(0407),
+ q(0),
+ ],
+ q(st) => [
+ q(0400),
+ q(0),
+ ],
+ q(su) => [
+ q(0409),
+ q(0),
+ ],
+ q(sv) => [
+ q(0413),
+ q(0),
+ ],
+ q(sw) => [
+ q(0412),
+ q(0),
+ ],
+ q(ta) => [
+ q(0418),
+ q(0),
+ ],
+ q(te) => [
+ q(0420),
+ q(0),
+ ],
+ q(tg) => [
+ q(0424),
+ q(0),
+ ],
+ q(th) => [
+ q(0426),
+ q(0),
+ ],
+ q(ti) => [
+ q(0429),
+ q(0),
+ ],
+ q(tk) => [
+ q(0441),
+ q(0),
+ ],
+ q(tl) => [
+ q(0425),
+ q(0),
+ ],
+ q(tn) => [
+ q(0439),
+ q(0),
+ ],
+ q(to) => [
+ q(0436),
+ q(0),
+ ],
+ q(tr) => [
+ q(0444),
+ q(0),
+ ],
+ q(ts) => [
+ q(0440),
+ q(0),
+ ],
+ q(tt) => [
+ q(0419),
+ q(0),
+ ],
+ q(tw) => [
+ q(0447),
+ q(0),
+ ],
+ q(ty) => [
+ q(0416),
+ q(0),
+ ],
+ q(ug) => [
+ q(0451),
+ q(0),
+ ],
+ q(uk) => [
+ q(0452),
+ q(0),
+ ],
+ q(ur) => [
+ q(0455),
+ q(0),
+ ],
+ q(uz) => [
+ q(0456),
+ q(0),
+ ],
+ q(ve) => [
+ q(0458),
+ q(0),
+ ],
+ q(vi) => [
+ q(0459),
+ q(0),
+ ],
+ q(vo) => [
+ q(0460),
+ q(0),
+ ],
+ q(wa) => [
+ q(0468),
+ q(0),
+ ],
+ q(wo) => [
+ q(0469),
+ q(0),
+ ],
+ q(xh) => [
+ q(0471),
+ q(0),
+ ],
+ q(yi) => [
+ q(0474),
+ q(0),
+ ],
+ q(yo) => [
+ q(0475),
+ q(0),
+ ],
+ q(za) => [
+ q(0480),
+ q(0),
+ ],
+ q(zh) => [
+ q(0079),
+ q(0),
+ ],
+ q(zu) => [
+ q(0482),
+ q(0),
+ ],
+ },
+ q(alpha3) => {
+ q(aar) => [
+ q(0001),
+ q(0),
+ ],
+ q(abk) => [
+ q(0002),
+ q(0),
+ ],
+ q(ace) => [
+ q(0003),
+ q(0),
+ ],
+ q(ach) => [
+ q(0004),
+ q(0),
+ ],
+ q(ada) => [
+ q(0005),
+ q(0),
+ ],
+ q(ady) => [
+ q(0006),
+ q(0),
+ ],
+ q(afa) => [
+ q(0007),
+ q(0),
+ ],
+ q(afh) => [
+ q(0008),
+ q(0),
+ ],
+ q(afr) => [
+ q(0009),
+ q(0),
+ ],
+ q(ain) => [
+ q(0010),
+ q(0),
+ ],
+ q(aka) => [
+ q(0011),
+ q(0),
+ ],
+ q(akk) => [
+ q(0012),
+ q(0),
+ ],
+ q(alb) => [
+ q(0013),
+ q(0),
+ ],
+ q(ale) => [
+ q(0014),
+ q(0),
+ ],
+ q(alg) => [
+ q(0015),
+ q(0),
+ ],
+ q(alt) => [
+ q(0016),
+ q(0),
+ ],
+ q(amh) => [
+ q(0017),
+ q(0),
+ ],
+ q(ang) => [
+ q(0018),
+ q(0),
+ ],
+ q(anp) => [
+ q(0019),
+ q(0),
+ ],
+ q(apa) => [
+ q(0020),
+ q(0),
+ ],
+ q(ara) => [
+ q(0021),
+ q(0),
+ ],
+ q(arc) => [
+ q(0022),
+ q(0),
+ ],
+ q(arg) => [
+ q(0023),
+ q(0),
+ ],
+ q(arm) => [
+ q(0024),
+ q(0),
+ ],
+ q(arn) => [
+ q(0025),
+ q(0),
+ ],
+ q(arp) => [
+ q(0026),
+ q(0),
+ ],
+ q(art) => [
+ q(0027),
+ q(0),
+ ],
+ q(arw) => [
+ q(0028),
+ q(0),
+ ],
+ q(asm) => [
+ q(0029),
+ q(0),
+ ],
+ q(ast) => [
+ q(0030),
+ q(0),
+ ],
+ q(ath) => [
+ q(0031),
+ q(0),
+ ],
+ q(aus) => [
+ q(0032),
+ q(0),
+ ],
+ q(ava) => [
+ q(0033),
+ q(0),
+ ],
+ q(ave) => [
+ q(0034),
+ q(0),
+ ],
+ q(awa) => [
+ q(0035),
+ q(0),
+ ],
+ q(aym) => [
+ q(0036),
+ q(0),
+ ],
+ q(aze) => [
+ q(0037),
+ q(0),
+ ],
+ q(bad) => [
+ q(0038),
+ q(0),
+ ],
+ q(bai) => [
+ q(0039),
+ q(0),
+ ],
+ q(bak) => [
+ q(0040),
+ q(0),
+ ],
+ q(bal) => [
+ q(0041),
+ q(0),
+ ],
+ q(bam) => [
+ q(0042),
+ q(0),
+ ],
+ q(ban) => [
+ q(0043),
+ q(0),
+ ],
+ q(baq) => [
+ q(0044),
+ q(0),
+ ],
+ q(bas) => [
+ q(0045),
+ q(0),
+ ],
+ q(bat) => [
+ q(0046),
+ q(0),
+ ],
+ q(bej) => [
+ q(0047),
+ q(0),
+ ],
+ q(bel) => [
+ q(0048),
+ q(0),
+ ],
+ q(bem) => [
+ q(0049),
+ q(0),
+ ],
+ q(ben) => [
+ q(0050),
+ q(0),
+ ],
+ q(ber) => [
+ q(0051),
+ q(0),
+ ],
+ q(bho) => [
+ q(0052),
+ q(0),
+ ],
+ q(bih) => [
+ q(0053),
+ q(0),
+ ],
+ q(bik) => [
+ q(0054),
+ q(0),
+ ],
+ q(bin) => [
+ q(0055),
+ q(0),
+ ],
+ q(bis) => [
+ q(0056),
+ q(0),
+ ],
+ q(bla) => [
+ q(0057),
+ q(0),
+ ],
+ q(bnt) => [
+ q(0058),
+ q(0),
+ ],
+ q(bos) => [
+ q(0059),
+ q(0),
+ ],
+ q(bra) => [
+ q(0060),
+ q(0),
+ ],
+ q(bre) => [
+ q(0061),
+ q(0),
+ ],
+ q(btk) => [
+ q(0062),
+ q(0),
+ ],
+ q(bua) => [
+ q(0063),
+ q(0),
+ ],
+ q(bug) => [
+ q(0064),
+ q(0),
+ ],
+ q(bul) => [
+ q(0065),
+ q(0),
+ ],
+ q(bur) => [
+ q(0066),
+ q(0),
+ ],
+ q(byn) => [
+ q(0067),
+ q(0),
+ ],
+ q(cad) => [
+ q(0068),
+ q(0),
+ ],
+ q(cai) => [
+ q(0069),
+ q(0),
+ ],
+ q(car) => [
+ q(0070),
+ q(0),
+ ],
+ q(cat) => [
+ q(0071),
+ q(0),
+ ],
+ q(cau) => [
+ q(0072),
+ q(0),
+ ],
+ q(ceb) => [
+ q(0073),
+ q(0),
+ ],
+ q(cel) => [
+ q(0074),
+ q(0),
+ ],
+ q(cha) => [
+ q(0075),
+ q(0),
+ ],
+ q(chb) => [
+ q(0076),
+ q(0),
+ ],
+ q(che) => [
+ q(0077),
+ q(0),
+ ],
+ q(chg) => [
+ q(0078),
+ q(0),
+ ],
+ q(chi) => [
+ q(0079),
+ q(0),
+ ],
+ q(chk) => [
+ q(0080),
+ q(0),
+ ],
+ q(chm) => [
+ q(0081),
+ q(0),
+ ],
+ q(chn) => [
+ q(0082),
+ q(0),
+ ],
+ q(cho) => [
+ q(0083),
+ q(0),
+ ],
+ q(chp) => [
+ q(0084),
+ q(0),
+ ],
+ q(chr) => [
+ q(0085),
+ q(0),
+ ],
+ q(chu) => [
+ q(0086),
+ q(0),
+ ],
+ q(chv) => [
+ q(0087),
+ q(0),
+ ],
+ q(chy) => [
+ q(0088),
+ q(0),
+ ],
+ q(cmc) => [
+ q(0089),
+ q(0),
+ ],
+ q(cop) => [
+ q(0090),
+ q(0),
+ ],
+ q(cor) => [
+ q(0091),
+ q(0),
+ ],
+ q(cos) => [
+ q(0092),
+ q(0),
+ ],
+ q(cpe) => [
+ q(0093),
+ q(0),
+ ],
+ q(cpf) => [
+ q(0094),
+ q(0),
+ ],
+ q(cpp) => [
+ q(0095),
+ q(0),
+ ],
+ q(cre) => [
+ q(0096),
+ q(0),
+ ],
+ q(crh) => [
+ q(0097),
+ q(0),
+ ],
+ q(crp) => [
+ q(0098),
+ q(0),
+ ],
+ q(csb) => [
+ q(0099),
+ q(0),
+ ],
+ q(cus) => [
+ q(0100),
+ q(0),
+ ],
+ q(cze) => [
+ q(0101),
+ q(0),
+ ],
+ q(dak) => [
+ q(0102),
+ q(0),
+ ],
+ q(dan) => [
+ q(0103),
+ q(0),
+ ],
+ q(dar) => [
+ q(0104),
+ q(0),
+ ],
+ q(day) => [
+ q(0105),
+ q(0),
+ ],
+ q(del) => [
+ q(0106),
+ q(0),
+ ],
+ q(den) => [
+ q(0107),
+ q(0),
+ ],
+ q(dgr) => [
+ q(0108),
+ q(0),
+ ],
+ q(din) => [
+ q(0109),
+ q(0),
+ ],
+ q(div) => [
+ q(0110),
+ q(0),
+ ],
+ q(doi) => [
+ q(0111),
+ q(0),
+ ],
+ q(dra) => [
+ q(0112),
+ q(0),
+ ],
+ q(dsb) => [
+ q(0113),
+ q(0),
+ ],
+ q(dua) => [
+ q(0114),
+ q(0),
+ ],
+ q(dum) => [
+ q(0115),
+ q(0),
+ ],
+ q(dut) => [
+ q(0116),
+ q(0),
+ ],
+ q(dyu) => [
+ q(0117),
+ q(0),
+ ],
+ q(dzo) => [
+ q(0118),
+ q(0),
+ ],
+ q(efi) => [
+ q(0119),
+ q(0),
+ ],
+ q(egy) => [
+ q(0120),
+ q(0),
+ ],
+ q(eka) => [
+ q(0121),
+ q(0),
+ ],
+ q(elx) => [
+ q(0122),
+ q(0),
+ ],
+ q(eng) => [
+ q(0123),
+ q(0),
+ ],
+ q(enm) => [
+ q(0124),
+ q(0),
+ ],
+ q(epo) => [
+ q(0125),
+ q(0),
+ ],
+ q(est) => [
+ q(0126),
+ q(0),
+ ],
+ q(ewe) => [
+ q(0127),
+ q(0),
+ ],
+ q(ewo) => [
+ q(0128),
+ q(0),
+ ],
+ q(fan) => [
+ q(0129),
+ q(0),
+ ],
+ q(fao) => [
+ q(0130),
+ q(0),
+ ],
+ q(fat) => [
+ q(0131),
+ q(0),
+ ],
+ q(fij) => [
+ q(0132),
+ q(0),
+ ],
+ q(fil) => [
+ q(0133),
+ q(0),
+ ],
+ q(fin) => [
+ q(0134),
+ q(0),
+ ],
+ q(fiu) => [
+ q(0135),
+ q(0),
+ ],
+ q(fon) => [
+ q(0136),
+ q(0),
+ ],
+ q(fre) => [
+ q(0137),
+ q(0),
+ ],
+ q(frm) => [
+ q(0138),
+ q(0),
+ ],
+ q(fro) => [
+ q(0139),
+ q(0),
+ ],
+ q(frr) => [
+ q(0140),
+ q(0),
+ ],
+ q(frs) => [
+ q(0141),
+ q(0),
+ ],
+ q(fry) => [
+ q(0142),
+ q(0),
+ ],
+ q(ful) => [
+ q(0143),
+ q(0),
+ ],
+ q(fur) => [
+ q(0144),
+ q(0),
+ ],
+ q(gaa) => [
+ q(0145),
+ q(0),
+ ],
+ q(gay) => [
+ q(0146),
+ q(0),
+ ],
+ q(gba) => [
+ q(0147),
+ q(0),
+ ],
+ q(gem) => [
+ q(0148),
+ q(0),
+ ],
+ q(geo) => [
+ q(0149),
+ q(0),
+ ],
+ q(ger) => [
+ q(0150),
+ q(0),
+ ],
+ q(gez) => [
+ q(0151),
+ q(0),
+ ],
+ q(gil) => [
+ q(0152),
+ q(0),
+ ],
+ q(gla) => [
+ q(0153),
+ q(0),
+ ],
+ q(gle) => [
+ q(0154),
+ q(0),
+ ],
+ q(glg) => [
+ q(0155),
+ q(0),
+ ],
+ q(glv) => [
+ q(0156),
+ q(0),
+ ],
+ q(gmh) => [
+ q(0157),
+ q(0),
+ ],
+ q(goh) => [
+ q(0158),
+ q(0),
+ ],
+ q(gon) => [
+ q(0159),
+ q(0),
+ ],
+ q(gor) => [
+ q(0160),
+ q(0),
+ ],
+ q(got) => [
+ q(0161),
+ q(0),
+ ],
+ q(grb) => [
+ q(0162),
+ q(0),
+ ],
+ q(grc) => [
+ q(0163),
+ q(0),
+ ],
+ q(gre) => [
+ q(0164),
+ q(0),
+ ],
+ q(grn) => [
+ q(0165),
+ q(0),
+ ],
+ q(gsw) => [
+ q(0166),
+ q(0),
+ ],
+ q(guj) => [
+ q(0167),
+ q(0),
+ ],
+ q(gwi) => [
+ q(0168),
+ q(0),
+ ],
+ q(hai) => [
+ q(0169),
+ q(0),
+ ],
+ q(hat) => [
+ q(0170),
+ q(0),
+ ],
+ q(hau) => [
+ q(0171),
+ q(0),
+ ],
+ q(haw) => [
+ q(0172),
+ q(0),
+ ],
+ q(heb) => [
+ q(0173),
+ q(0),
+ ],
+ q(her) => [
+ q(0174),
+ q(0),
+ ],
+ q(hil) => [
+ q(0175),
+ q(0),
+ ],
+ q(him) => [
+ q(0176),
+ q(0),
+ ],
+ q(hin) => [
+ q(0177),
+ q(0),
+ ],
+ q(hit) => [
+ q(0178),
+ q(0),
+ ],
+ q(hmn) => [
+ q(0179),
+ q(0),
+ ],
+ q(hmo) => [
+ q(0180),
+ q(0),
+ ],
+ q(hrv) => [
+ q(0181),
+ q(0),
+ ],
+ q(hsb) => [
+ q(0182),
+ q(0),
+ ],
+ q(hun) => [
+ q(0183),
+ q(0),
+ ],
+ q(hup) => [
+ q(0184),
+ q(0),
+ ],
+ q(iba) => [
+ q(0185),
+ q(0),
+ ],
+ q(ibo) => [
+ q(0186),
+ q(0),
+ ],
+ q(ice) => [
+ q(0187),
+ q(0),
+ ],
+ q(ido) => [
+ q(0188),
+ q(0),
+ ],
+ q(iii) => [
+ q(0189),
+ q(0),
+ ],
+ q(ijo) => [
+ q(0190),
+ q(0),
+ ],
+ q(iku) => [
+ q(0191),
+ q(0),
+ ],
+ q(ile) => [
+ q(0192),
+ q(0),
+ ],
+ q(ilo) => [
+ q(0193),
+ q(0),
+ ],
+ q(ina) => [
+ q(0194),
+ q(0),
+ ],
+ q(inc) => [
+ q(0195),
+ q(0),
+ ],
+ q(ind) => [
+ q(0196),
+ q(0),
+ ],
+ q(ine) => [
+ q(0197),
+ q(0),
+ ],
+ q(inh) => [
+ q(0198),
+ q(0),
+ ],
+ q(ipk) => [
+ q(0199),
+ q(0),
+ ],
+ q(ira) => [
+ q(0200),
+ q(0),
+ ],
+ q(iro) => [
+ q(0201),
+ q(0),
+ ],
+ q(ita) => [
+ q(0202),
+ q(0),
+ ],
+ q(jav) => [
+ q(0203),
+ q(0),
+ ],
+ q(jbo) => [
+ q(0204),
+ q(0),
+ ],
+ q(jpn) => [
+ q(0205),
+ q(0),
+ ],
+ q(jpr) => [
+ q(0206),
+ q(0),
+ ],
+ q(jrb) => [
+ q(0207),
+ q(0),
+ ],
+ q(kaa) => [
+ q(0208),
+ q(0),
+ ],
+ q(kab) => [
+ q(0209),
+ q(0),
+ ],
+ q(kac) => [
+ q(0210),
+ q(0),
+ ],
+ q(kal) => [
+ q(0211),
+ q(0),
+ ],
+ q(kam) => [
+ q(0212),
+ q(0),
+ ],
+ q(kan) => [
+ q(0213),
+ q(0),
+ ],
+ q(kar) => [
+ q(0214),
+ q(0),
+ ],
+ q(kas) => [
+ q(0215),
+ q(0),
+ ],
+ q(kau) => [
+ q(0216),
+ q(0),
+ ],
+ q(kaw) => [
+ q(0217),
+ q(0),
+ ],
+ q(kaz) => [
+ q(0218),
+ q(0),
+ ],
+ q(kbd) => [
+ q(0219),
+ q(0),
+ ],
+ q(kha) => [
+ q(0220),
+ q(0),
+ ],
+ q(khi) => [
+ q(0221),
+ q(0),
+ ],
+ q(khm) => [
+ q(0222),
+ q(0),
+ ],
+ q(kho) => [
+ q(0223),
+ q(0),
+ ],
+ q(kik) => [
+ q(0224),
+ q(0),
+ ],
+ q(kin) => [
+ q(0225),
+ q(0),
+ ],
+ q(kir) => [
+ q(0226),
+ q(0),
+ ],
+ q(kmb) => [
+ q(0227),
+ q(0),
+ ],
+ q(kok) => [
+ q(0228),
+ q(0),
+ ],
+ q(kom) => [
+ q(0229),
+ q(0),
+ ],
+ q(kon) => [
+ q(0230),
+ q(0),
+ ],
+ q(kor) => [
+ q(0231),
+ q(0),
+ ],
+ q(kos) => [
+ q(0232),
+ q(0),
+ ],
+ q(kpe) => [
+ q(0233),
+ q(0),
+ ],
+ q(krc) => [
+ q(0234),
+ q(0),
+ ],
+ q(krl) => [
+ q(0235),
+ q(0),
+ ],
+ q(kro) => [
+ q(0236),
+ q(0),
+ ],
+ q(kru) => [
+ q(0237),
+ q(0),
+ ],
+ q(kua) => [
+ q(0238),
+ q(0),
+ ],
+ q(kum) => [
+ q(0239),
+ q(0),
+ ],
+ q(kur) => [
+ q(0240),
+ q(0),
+ ],
+ q(kut) => [
+ q(0241),
+ q(0),
+ ],
+ q(lad) => [
+ q(0242),
+ q(0),
+ ],
+ q(lah) => [
+ q(0243),
+ q(0),
+ ],
+ q(lam) => [
+ q(0244),
+ q(0),
+ ],
+ q(lao) => [
+ q(0245),
+ q(0),
+ ],
+ q(lat) => [
+ q(0246),
+ q(0),
+ ],
+ q(lav) => [
+ q(0247),
+ q(0),
+ ],
+ q(lez) => [
+ q(0248),
+ q(0),
+ ],
+ q(lim) => [
+ q(0249),
+ q(0),
+ ],
+ q(lin) => [
+ q(0250),
+ q(0),
+ ],
+ q(lit) => [
+ q(0251),
+ q(0),
+ ],
+ q(lol) => [
+ q(0252),
+ q(0),
+ ],
+ q(loz) => [
+ q(0253),
+ q(0),
+ ],
+ q(ltz) => [
+ q(0254),
+ q(0),
+ ],
+ q(lua) => [
+ q(0255),
+ q(0),
+ ],
+ q(lub) => [
+ q(0256),
+ q(0),
+ ],
+ q(lug) => [
+ q(0257),
+ q(0),
+ ],
+ q(lui) => [
+ q(0258),
+ q(0),
+ ],
+ q(lun) => [
+ q(0259),
+ q(0),
+ ],
+ q(luo) => [
+ q(0260),
+ q(0),
+ ],
+ q(lus) => [
+ q(0261),
+ q(0),
+ ],
+ q(mac) => [
+ q(0262),
+ q(0),
+ ],
+ q(mad) => [
+ q(0263),
+ q(0),
+ ],
+ q(mag) => [
+ q(0264),
+ q(0),
+ ],
+ q(mah) => [
+ q(0265),
+ q(0),
+ ],
+ q(mai) => [
+ q(0266),
+ q(0),
+ ],
+ q(mak) => [
+ q(0267),
+ q(0),
+ ],
+ q(mal) => [
+ q(0268),
+ q(0),
+ ],
+ q(man) => [
+ q(0269),
+ q(0),
+ ],
+ q(mao) => [
+ q(0270),
+ q(0),
+ ],
+ q(map) => [
+ q(0271),
+ q(0),
+ ],
+ q(mar) => [
+ q(0272),
+ q(0),
+ ],
+ q(mas) => [
+ q(0273),
+ q(0),
+ ],
+ q(may) => [
+ q(0274),
+ q(0),
+ ],
+ q(mdf) => [
+ q(0275),
+ q(0),
+ ],
+ q(mdr) => [
+ q(0276),
+ q(0),
+ ],
+ q(men) => [
+ q(0277),
+ q(0),
+ ],
+ q(mga) => [
+ q(0278),
+ q(0),
+ ],
+ q(mic) => [
+ q(0279),
+ q(0),
+ ],
+ q(min) => [
+ q(0280),
+ q(0),
+ ],
+ q(mis) => [
+ q(0281),
+ q(0),
+ ],
+ q(mkh) => [
+ q(0282),
+ q(0),
+ ],
+ q(mlg) => [
+ q(0283),
+ q(0),
+ ],
+ q(mlt) => [
+ q(0284),
+ q(0),
+ ],
+ q(mnc) => [
+ q(0285),
+ q(0),
+ ],
+ q(mni) => [
+ q(0286),
+ q(0),
+ ],
+ q(mno) => [
+ q(0287),
+ q(0),
+ ],
+ q(moh) => [
+ q(0288),
+ q(0),
+ ],
+ q(mon) => [
+ q(0289),
+ q(0),
+ ],
+ q(mos) => [
+ q(0290),
+ q(0),
+ ],
+ q(mul) => [
+ q(0291),
+ q(0),
+ ],
+ q(mun) => [
+ q(0292),
+ q(0),
+ ],
+ q(mus) => [
+ q(0293),
+ q(0),
+ ],
+ q(mwl) => [
+ q(0294),
+ q(0),
+ ],
+ q(mwr) => [
+ q(0295),
+ q(0),
+ ],
+ q(myn) => [
+ q(0296),
+ q(0),
+ ],
+ q(myv) => [
+ q(0297),
+ q(0),
+ ],
+ q(nah) => [
+ q(0298),
+ q(0),
+ ],
+ q(nai) => [
+ q(0299),
+ q(0),
+ ],
+ q(nap) => [
+ q(0300),
+ q(0),
+ ],
+ q(nau) => [
+ q(0301),
+ q(0),
+ ],
+ q(nav) => [
+ q(0302),
+ q(0),
+ ],
+ q(nbl) => [
+ q(0303),
+ q(0),
+ ],
+ q(nde) => [
+ q(0304),
+ q(0),
+ ],
+ q(ndo) => [
+ q(0305),
+ q(0),
+ ],
+ q(nds) => [
+ q(0306),
+ q(0),
+ ],
+ q(nep) => [
+ q(0307),
+ q(0),
+ ],
+ q(new) => [
+ q(0308),
+ q(0),
+ ],
+ q(nia) => [
+ q(0309),
+ q(0),
+ ],
+ q(nic) => [
+ q(0310),
+ q(0),
+ ],
+ q(niu) => [
+ q(0311),
+ q(0),
+ ],
+ q(nno) => [
+ q(0312),
+ q(0),
+ ],
+ q(nob) => [
+ q(0313),
+ q(0),
+ ],
+ q(nog) => [
+ q(0314),
+ q(0),
+ ],
+ q(non) => [
+ q(0315),
+ q(0),
+ ],
+ q(nor) => [
+ q(0316),
+ q(0),
+ ],
+ q(nqo) => [
+ q(0317),
+ q(0),
+ ],
+ q(nso) => [
+ q(0318),
+ q(0),
+ ],
+ q(nub) => [
+ q(0319),
+ q(0),
+ ],
+ q(nwc) => [
+ q(0320),
+ q(0),
+ ],
+ q(nya) => [
+ q(0321),
+ q(0),
+ ],
+ q(nym) => [
+ q(0322),
+ q(0),
+ ],
+ q(nyn) => [
+ q(0323),
+ q(0),
+ ],
+ q(nyo) => [
+ q(0324),
+ q(0),
+ ],
+ q(nzi) => [
+ q(0325),
+ q(0),
+ ],
+ q(oci) => [
+ q(0326),
+ q(0),
+ ],
+ q(oji) => [
+ q(0327),
+ q(0),
+ ],
+ q(ori) => [
+ q(0328),
+ q(0),
+ ],
+ q(orm) => [
+ q(0329),
+ q(0),
+ ],
+ q(osa) => [
+ q(0330),
+ q(0),
+ ],
+ q(oss) => [
+ q(0331),
+ q(0),
+ ],
+ q(ota) => [
+ q(0332),
+ q(0),
+ ],
+ q(oto) => [
+ q(0333),
+ q(0),
+ ],
+ q(paa) => [
+ q(0334),
+ q(0),
+ ],
+ q(pag) => [
+ q(0335),
+ q(0),
+ ],
+ q(pal) => [
+ q(0336),
+ q(0),
+ ],
+ q(pam) => [
+ q(0337),
+ q(0),
+ ],
+ q(pan) => [
+ q(0338),
+ q(0),
+ ],
+ q(pap) => [
+ q(0339),
+ q(0),
+ ],
+ q(pau) => [
+ q(0340),
+ q(0),
+ ],
+ q(peo) => [
+ q(0341),
+ q(0),
+ ],
+ q(per) => [
+ q(0342),
+ q(0),
+ ],
+ q(phi) => [
+ q(0343),
+ q(0),
+ ],
+ q(phn) => [
+ q(0344),
+ q(0),
+ ],
+ q(pli) => [
+ q(0345),
+ q(0),
+ ],
+ q(pol) => [
+ q(0346),
+ q(0),
+ ],
+ q(pon) => [
+ q(0347),
+ q(0),
+ ],
+ q(por) => [
+ q(0348),
+ q(0),
+ ],
+ q(pra) => [
+ q(0349),
+ q(0),
+ ],
+ q(pro) => [
+ q(0350),
+ q(0),
+ ],
+ q(pus) => [
+ q(0351),
+ q(0),
+ ],
+ q(qtz) => [
+ q(0352),
+ q(0),
+ ],
+ q(que) => [
+ q(0353),
+ q(0),
+ ],
+ q(raj) => [
+ q(0354),
+ q(0),
+ ],
+ q(rap) => [
+ q(0355),
+ q(0),
+ ],
+ q(rar) => [
+ q(0356),
+ q(0),
+ ],
+ q(roa) => [
+ q(0357),
+ q(0),
+ ],
+ q(roh) => [
+ q(0358),
+ q(0),
+ ],
+ q(rom) => [
+ q(0359),
+ q(0),
+ ],
+ q(rum) => [
+ q(0360),
+ q(0),
+ ],
+ q(run) => [
+ q(0361),
+ q(0),
+ ],
+ q(rup) => [
+ q(0362),
+ q(0),
+ ],
+ q(rus) => [
+ q(0363),
+ q(0),
+ ],
+ q(sad) => [
+ q(0364),
+ q(0),
+ ],
+ q(sag) => [
+ q(0365),
+ q(0),
+ ],
+ q(sah) => [
+ q(0366),
+ q(0),
+ ],
+ q(sai) => [
+ q(0367),
+ q(0),
+ ],
+ q(sal) => [
+ q(0368),
+ q(0),
+ ],
+ q(sam) => [
+ q(0369),
+ q(0),
+ ],
+ q(san) => [
+ q(0370),
+ q(0),
+ ],
+ q(sas) => [
+ q(0371),
+ q(0),
+ ],
+ q(sat) => [
+ q(0372),
+ q(0),
+ ],
+ q(scn) => [
+ q(0373),
+ q(0),
+ ],
+ q(sco) => [
+ q(0374),
+ q(0),
+ ],
+ q(sel) => [
+ q(0375),
+ q(0),
+ ],
+ q(sem) => [
+ q(0376),
+ q(0),
+ ],
+ q(sga) => [
+ q(0377),
+ q(0),
+ ],
+ q(sgn) => [
+ q(0378),
+ q(0),
+ ],
+ q(shn) => [
+ q(0379),
+ q(0),
+ ],
+ q(sid) => [
+ q(0380),
+ q(0),
+ ],
+ q(sin) => [
+ q(0381),
+ q(0),
+ ],
+ q(sio) => [
+ q(0382),
+ q(0),
+ ],
+ q(sit) => [
+ q(0383),
+ q(0),
+ ],
+ q(sla) => [
+ q(0384),
+ q(0),
+ ],
+ q(slo) => [
+ q(0385),
+ q(0),
+ ],
+ q(slv) => [
+ q(0386),
+ q(0),
+ ],
+ q(sma) => [
+ q(0387),
+ q(0),
+ ],
+ q(sme) => [
+ q(0388),
+ q(0),
+ ],
+ q(smi) => [
+ q(0389),
+ q(0),
+ ],
+ q(smj) => [
+ q(0390),
+ q(0),
+ ],
+ q(smn) => [
+ q(0391),
+ q(0),
+ ],
+ q(smo) => [
+ q(0392),
+ q(0),
+ ],
+ q(sms) => [
+ q(0393),
+ q(0),
+ ],
+ q(sna) => [
+ q(0394),
+ q(0),
+ ],
+ q(snd) => [
+ q(0395),
+ q(0),
+ ],
+ q(snk) => [
+ q(0396),
+ q(0),
+ ],
+ q(sog) => [
+ q(0397),
+ q(0),
+ ],
+ q(som) => [
+ q(0398),
+ q(0),
+ ],
+ q(son) => [
+ q(0399),
+ q(0),
+ ],
+ q(sot) => [
+ q(0400),
+ q(0),
+ ],
+ q(spa) => [
+ q(0401),
+ q(0),
+ ],
+ q(srd) => [
+ q(0402),
+ q(0),
+ ],
+ q(srn) => [
+ q(0403),
+ q(0),
+ ],
+ q(srp) => [
+ q(0404),
+ q(0),
+ ],
+ q(srr) => [
+ q(0405),
+ q(0),
+ ],
+ q(ssa) => [
+ q(0406),
+ q(0),
+ ],
+ q(ssw) => [
+ q(0407),
+ q(0),
+ ],
+ q(suk) => [
+ q(0408),
+ q(0),
+ ],
+ q(sun) => [
+ q(0409),
+ q(0),
+ ],
+ q(sus) => [
+ q(0410),
+ q(0),
+ ],
+ q(sux) => [
+ q(0411),
+ q(0),
+ ],
+ q(swa) => [
+ q(0412),
+ q(0),
+ ],
+ q(swe) => [
+ q(0413),
+ q(0),
+ ],
+ q(syc) => [
+ q(0414),
+ q(0),
+ ],
+ q(syr) => [
+ q(0415),
+ q(0),
+ ],
+ q(tah) => [
+ q(0416),
+ q(0),
+ ],
+ q(tai) => [
+ q(0417),
+ q(0),
+ ],
+ q(tam) => [
+ q(0418),
+ q(0),
+ ],
+ q(tat) => [
+ q(0419),
+ q(0),
+ ],
+ q(tel) => [
+ q(0420),
+ q(0),
+ ],
+ q(tem) => [
+ q(0421),
+ q(0),
+ ],
+ q(ter) => [
+ q(0422),
+ q(0),
+ ],
+ q(tet) => [
+ q(0423),
+ q(0),
+ ],
+ q(tgk) => [
+ q(0424),
+ q(0),
+ ],
+ q(tgl) => [
+ q(0425),
+ q(0),
+ ],
+ q(tha) => [
+ q(0426),
+ q(0),
+ ],
+ q(tib) => [
+ q(0427),
+ q(0),
+ ],
+ q(tig) => [
+ q(0428),
+ q(0),
+ ],
+ q(tir) => [
+ q(0429),
+ q(0),
+ ],
+ q(tiv) => [
+ q(0430),
+ q(0),
+ ],
+ q(tkl) => [
+ q(0431),
+ q(0),
+ ],
+ q(tlh) => [
+ q(0432),
+ q(0),
+ ],
+ q(tli) => [
+ q(0433),
+ q(0),
+ ],
+ q(tmh) => [
+ q(0434),
+ q(0),
+ ],
+ q(tog) => [
+ q(0435),
+ q(0),
+ ],
+ q(ton) => [
+ q(0436),
+ q(0),
+ ],
+ q(tpi) => [
+ q(0437),
+ q(0),
+ ],
+ q(tsi) => [
+ q(0438),
+ q(0),
+ ],
+ q(tsn) => [
+ q(0439),
+ q(0),
+ ],
+ q(tso) => [
+ q(0440),
+ q(0),
+ ],
+ q(tuk) => [
+ q(0441),
+ q(0),
+ ],
+ q(tum) => [
+ q(0442),
+ q(0),
+ ],
+ q(tup) => [
+ q(0443),
+ q(0),
+ ],
+ q(tur) => [
+ q(0444),
+ q(0),
+ ],
+ q(tut) => [
+ q(0445),
+ q(0),
+ ],
+ q(tvl) => [
+ q(0446),
+ q(0),
+ ],
+ q(twi) => [
+ q(0447),
+ q(0),
+ ],
+ q(tyv) => [
+ q(0448),
+ q(0),
+ ],
+ q(udm) => [
+ q(0449),
+ q(0),
+ ],
+ q(uga) => [
+ q(0450),
+ q(0),
+ ],
+ q(uig) => [
+ q(0451),
+ q(0),
+ ],
+ q(ukr) => [
+ q(0452),
+ q(0),
+ ],
+ q(umb) => [
+ q(0453),
+ q(0),
+ ],
+ q(und) => [
+ q(0454),
+ q(0),
+ ],
+ q(urd) => [
+ q(0455),
+ q(0),
+ ],
+ q(uzb) => [
+ q(0456),
+ q(0),
+ ],
+ q(vai) => [
+ q(0457),
+ q(0),
+ ],
+ q(ven) => [
+ q(0458),
+ q(0),
+ ],
+ q(vie) => [
+ q(0459),
+ q(0),
+ ],
+ q(vol) => [
+ q(0460),
+ q(0),
+ ],
+ q(vot) => [
+ q(0461),
+ q(0),
+ ],
+ q(wak) => [
+ q(0462),
+ q(0),
+ ],
+ q(wal) => [
+ q(0463),
+ q(0),
+ ],
+ q(war) => [
+ q(0464),
+ q(0),
+ ],
+ q(was) => [
+ q(0465),
+ q(0),
+ ],
+ q(wel) => [
+ q(0466),
+ q(0),
+ ],
+ q(wen) => [
+ q(0467),
+ q(0),
+ ],
+ q(wln) => [
+ q(0468),
+ q(0),
+ ],
+ q(wol) => [
+ q(0469),
+ q(0),
+ ],
+ q(xal) => [
+ q(0470),
+ q(0),
+ ],
+ q(xho) => [
+ q(0471),
+ q(0),
+ ],
+ q(yao) => [
+ q(0472),
+ q(0),
+ ],
+ q(yap) => [
+ q(0473),
+ q(0),
+ ],
+ q(yid) => [
+ q(0474),
+ q(0),
+ ],
+ q(yor) => [
+ q(0475),
+ q(0),
+ ],
+ q(ypk) => [
+ q(0476),
+ q(0),
+ ],
+ q(zap) => [
+ q(0477),
+ q(0),
+ ],
+ q(zbl) => [
+ q(0478),
+ q(0),
+ ],
+ q(zen) => [
+ q(0479),
+ q(0),
+ ],
+ q(zha) => [
+ q(0480),
+ q(0),
+ ],
+ q(znd) => [
+ q(0481),
+ q(0),
+ ],
+ q(zul) => [
+ q(0482),
+ q(0),
+ ],
+ q(zun) => [
+ q(0483),
+ q(0),
+ ],
+ q(zxx) => [
+ q(0484),
+ q(0),
+ ],
+ q(zza) => [
+ q(0485),
+ q(0),
+ ],
+ },
+ q(term) => {
+ q(bod) => [
+ q(0427),
+ q(0),
+ ],
+ q(ces) => [
+ q(0101),
+ q(0),
+ ],
+ q(cym) => [
+ q(0466),
+ q(0),
+ ],
+ q(deu) => [
+ q(0150),
+ q(0),
+ ],
+ q(ell) => [
+ q(0164),
+ q(0),
+ ],
+ q(eus) => [
+ q(0044),
+ q(0),
+ ],
+ q(fas) => [
+ q(0342),
+ q(0),
+ ],
+ q(fra) => [
+ q(0137),
+ q(0),
+ ],
+ q(hye) => [
+ q(0024),
+ q(0),
+ ],
+ q(isl) => [
+ q(0187),
+ q(0),
+ ],
+ q(kat) => [
+ q(0149),
+ q(0),
+ ],
+ q(mkd) => [
+ q(0262),
+ q(0),
+ ],
+ q(mri) => [
+ q(0270),
+ q(0),
+ ],
+ q(msa) => [
+ q(0274),
+ q(0),
+ ],
+ q(mya) => [
+ q(0066),
+ q(0),
+ ],
+ q(nld) => [
+ q(0116),
+ q(0),
+ ],
+ q(ron) => [
+ q(0360),
+ q(0),
+ ],
+ q(slk) => [
+ q(0385),
+ q(0),
+ ],
+ q(sqi) => [
+ q(0013),
+ q(0),
+ ],
+ q(zho) => [
+ q(0079),
+ q(0),
+ ],
+ },
+};
+
+$Locale::Codes::Data{'language'}{'id2code'} = {
+ q(alpha2) => {
+ q(0001) => q(aa),
+ q(0002) => q(ab),
+ q(0009) => q(af),
+ q(0011) => q(ak),
+ q(0013) => q(sq),
+ q(0017) => q(am),
+ q(0021) => q(ar),
+ q(0023) => q(an),
+ q(0024) => q(hy),
+ q(0029) => q(as),
+ q(0033) => q(av),
+ q(0034) => q(ae),
+ q(0036) => q(ay),
+ q(0037) => q(az),
+ q(0040) => q(ba),
+ q(0042) => q(bm),
+ q(0044) => q(eu),
+ q(0048) => q(be),
+ q(0050) => q(bn),
+ q(0053) => q(bh),
+ q(0056) => q(bi),
+ q(0059) => q(bs),
+ q(0061) => q(br),
+ q(0065) => q(bg),
+ q(0066) => q(my),
+ q(0071) => q(ca),
+ q(0075) => q(ch),
+ q(0077) => q(ce),
+ q(0079) => q(zh),
+ q(0086) => q(cu),
+ q(0087) => q(cv),
+ q(0091) => q(kw),
+ q(0092) => q(co),
+ q(0096) => q(cr),
+ q(0101) => q(cs),
+ q(0103) => q(da),
+ q(0110) => q(dv),
+ q(0116) => q(nl),
+ q(0118) => q(dz),
+ q(0123) => q(en),
+ q(0125) => q(eo),
+ q(0126) => q(et),
+ q(0127) => q(ee),
+ q(0130) => q(fo),
+ q(0132) => q(fj),
+ q(0134) => q(fi),
+ q(0137) => q(fr),
+ q(0142) => q(fy),
+ q(0143) => q(ff),
+ q(0149) => q(ka),
+ q(0150) => q(de),
+ q(0153) => q(gd),
+ q(0154) => q(ga),
+ q(0155) => q(gl),
+ q(0156) => q(gv),
+ q(0164) => q(el),
+ q(0165) => q(gn),
+ q(0167) => q(gu),
+ q(0170) => q(ht),
+ q(0171) => q(ha),
+ q(0173) => q(he),
+ q(0174) => q(hz),
+ q(0177) => q(hi),
+ q(0180) => q(ho),
+ q(0181) => q(hr),
+ q(0183) => q(hu),
+ q(0186) => q(ig),
+ q(0187) => q(is),
+ q(0188) => q(io),
+ q(0189) => q(ii),
+ q(0191) => q(iu),
+ q(0192) => q(ie),
+ q(0194) => q(ia),
+ q(0196) => q(id),
+ q(0199) => q(ik),
+ q(0202) => q(it),
+ q(0203) => q(jv),
+ q(0205) => q(ja),
+ q(0211) => q(kl),
+ q(0213) => q(kn),
+ q(0215) => q(ks),
+ q(0216) => q(kr),
+ q(0218) => q(kk),
+ q(0222) => q(km),
+ q(0224) => q(ki),
+ q(0225) => q(rw),
+ q(0226) => q(ky),
+ q(0229) => q(kv),
+ q(0230) => q(kg),
+ q(0231) => q(ko),
+ q(0238) => q(kj),
+ q(0240) => q(ku),
+ q(0245) => q(lo),
+ q(0246) => q(la),
+ q(0247) => q(lv),
+ q(0249) => q(li),
+ q(0250) => q(ln),
+ q(0251) => q(lt),
+ q(0254) => q(lb),
+ q(0256) => q(lu),
+ q(0257) => q(lg),
+ q(0262) => q(mk),
+ q(0265) => q(mh),
+ q(0268) => q(ml),
+ q(0270) => q(mi),
+ q(0272) => q(mr),
+ q(0274) => q(ms),
+ q(0283) => q(mg),
+ q(0284) => q(mt),
+ q(0289) => q(mn),
+ q(0301) => q(na),
+ q(0302) => q(nv),
+ q(0303) => q(nr),
+ q(0304) => q(nd),
+ q(0305) => q(ng),
+ q(0307) => q(ne),
+ q(0312) => q(nn),
+ q(0313) => q(nb),
+ q(0316) => q(no),
+ q(0321) => q(ny),
+ q(0326) => q(oc),
+ q(0327) => q(oj),
+ q(0328) => q(or),
+ q(0329) => q(om),
+ q(0331) => q(os),
+ q(0338) => q(pa),
+ q(0342) => q(fa),
+ q(0345) => q(pi),
+ q(0346) => q(pl),
+ q(0348) => q(pt),
+ q(0351) => q(ps),
+ q(0353) => q(qu),
+ q(0358) => q(rm),
+ q(0360) => q(ro),
+ q(0361) => q(rn),
+ q(0363) => q(ru),
+ q(0365) => q(sg),
+ q(0370) => q(sa),
+ q(0381) => q(si),
+ q(0385) => q(sk),
+ q(0386) => q(sl),
+ q(0388) => q(se),
+ q(0392) => q(sm),
+ q(0394) => q(sn),
+ q(0395) => q(sd),
+ q(0398) => q(so),
+ q(0400) => q(st),
+ q(0401) => q(es),
+ q(0402) => q(sc),
+ q(0404) => q(sr),
+ q(0407) => q(ss),
+ q(0409) => q(su),
+ q(0412) => q(sw),
+ q(0413) => q(sv),
+ q(0416) => q(ty),
+ q(0418) => q(ta),
+ q(0419) => q(tt),
+ q(0420) => q(te),
+ q(0424) => q(tg),
+ q(0425) => q(tl),
+ q(0426) => q(th),
+ q(0427) => q(bo),
+ q(0429) => q(ti),
+ q(0436) => q(to),
+ q(0439) => q(tn),
+ q(0440) => q(ts),
+ q(0441) => q(tk),
+ q(0444) => q(tr),
+ q(0447) => q(tw),
+ q(0451) => q(ug),
+ q(0452) => q(uk),
+ q(0455) => q(ur),
+ q(0456) => q(uz),
+ q(0458) => q(ve),
+ q(0459) => q(vi),
+ q(0460) => q(vo),
+ q(0466) => q(cy),
+ q(0468) => q(wa),
+ q(0469) => q(wo),
+ q(0471) => q(xh),
+ q(0474) => q(yi),
+ q(0475) => q(yo),
+ q(0480) => q(za),
+ q(0482) => q(zu),
+ },
+ q(alpha3) => {
+ q(0001) => q(aar),
+ q(0002) => q(abk),
+ q(0003) => q(ace),
+ q(0004) => q(ach),
+ q(0005) => q(ada),
+ q(0006) => q(ady),
+ q(0007) => q(afa),
+ q(0008) => q(afh),
+ q(0009) => q(afr),
+ q(0010) => q(ain),
+ q(0011) => q(aka),
+ q(0012) => q(akk),
+ q(0013) => q(alb),
+ q(0014) => q(ale),
+ q(0015) => q(alg),
+ q(0016) => q(alt),
+ q(0017) => q(amh),
+ q(0018) => q(ang),
+ q(0019) => q(anp),
+ q(0020) => q(apa),
+ q(0021) => q(ara),
+ q(0022) => q(arc),
+ q(0023) => q(arg),
+ q(0024) => q(arm),
+ q(0025) => q(arn),
+ q(0026) => q(arp),
+ q(0027) => q(art),
+ q(0028) => q(arw),
+ q(0029) => q(asm),
+ q(0030) => q(ast),
+ q(0031) => q(ath),
+ q(0032) => q(aus),
+ q(0033) => q(ava),
+ q(0034) => q(ave),
+ q(0035) => q(awa),
+ q(0036) => q(aym),
+ q(0037) => q(aze),
+ q(0038) => q(bad),
+ q(0039) => q(bai),
+ q(0040) => q(bak),
+ q(0041) => q(bal),
+ q(0042) => q(bam),
+ q(0043) => q(ban),
+ q(0044) => q(baq),
+ q(0045) => q(bas),
+ q(0046) => q(bat),
+ q(0047) => q(bej),
+ q(0048) => q(bel),
+ q(0049) => q(bem),
+ q(0050) => q(ben),
+ q(0051) => q(ber),
+ q(0052) => q(bho),
+ q(0053) => q(bih),
+ q(0054) => q(bik),
+ q(0055) => q(bin),
+ q(0056) => q(bis),
+ q(0057) => q(bla),
+ q(0058) => q(bnt),
+ q(0059) => q(bos),
+ q(0060) => q(bra),
+ q(0061) => q(bre),
+ q(0062) => q(btk),
+ q(0063) => q(bua),
+ q(0064) => q(bug),
+ q(0065) => q(bul),
+ q(0066) => q(bur),
+ q(0067) => q(byn),
+ q(0068) => q(cad),
+ q(0069) => q(cai),
+ q(0070) => q(car),
+ q(0071) => q(cat),
+ q(0072) => q(cau),
+ q(0073) => q(ceb),
+ q(0074) => q(cel),
+ q(0075) => q(cha),
+ q(0076) => q(chb),
+ q(0077) => q(che),
+ q(0078) => q(chg),
+ q(0079) => q(chi),
+ q(0080) => q(chk),
+ q(0081) => q(chm),
+ q(0082) => q(chn),
+ q(0083) => q(cho),
+ q(0084) => q(chp),
+ q(0085) => q(chr),
+ q(0086) => q(chu),
+ q(0087) => q(chv),
+ q(0088) => q(chy),
+ q(0089) => q(cmc),
+ q(0090) => q(cop),
+ q(0091) => q(cor),
+ q(0092) => q(cos),
+ q(0093) => q(cpe),
+ q(0094) => q(cpf),
+ q(0095) => q(cpp),
+ q(0096) => q(cre),
+ q(0097) => q(crh),
+ q(0098) => q(crp),
+ q(0099) => q(csb),
+ q(0100) => q(cus),
+ q(0101) => q(cze),
+ q(0102) => q(dak),
+ q(0103) => q(dan),
+ q(0104) => q(dar),
+ q(0105) => q(day),
+ q(0106) => q(del),
+ q(0107) => q(den),
+ q(0108) => q(dgr),
+ q(0109) => q(din),
+ q(0110) => q(div),
+ q(0111) => q(doi),
+ q(0112) => q(dra),
+ q(0113) => q(dsb),
+ q(0114) => q(dua),
+ q(0115) => q(dum),
+ q(0116) => q(dut),
+ q(0117) => q(dyu),
+ q(0118) => q(dzo),
+ q(0119) => q(efi),
+ q(0120) => q(egy),
+ q(0121) => q(eka),
+ q(0122) => q(elx),
+ q(0123) => q(eng),
+ q(0124) => q(enm),
+ q(0125) => q(epo),
+ q(0126) => q(est),
+ q(0127) => q(ewe),
+ q(0128) => q(ewo),
+ q(0129) => q(fan),
+ q(0130) => q(fao),
+ q(0131) => q(fat),
+ q(0132) => q(fij),
+ q(0133) => q(fil),
+ q(0134) => q(fin),
+ q(0135) => q(fiu),
+ q(0136) => q(fon),
+ q(0137) => q(fre),
+ q(0138) => q(frm),
+ q(0139) => q(fro),
+ q(0140) => q(frr),
+ q(0141) => q(frs),
+ q(0142) => q(fry),
+ q(0143) => q(ful),
+ q(0144) => q(fur),
+ q(0145) => q(gaa),
+ q(0146) => q(gay),
+ q(0147) => q(gba),
+ q(0148) => q(gem),
+ q(0149) => q(geo),
+ q(0150) => q(ger),
+ q(0151) => q(gez),
+ q(0152) => q(gil),
+ q(0153) => q(gla),
+ q(0154) => q(gle),
+ q(0155) => q(glg),
+ q(0156) => q(glv),
+ q(0157) => q(gmh),
+ q(0158) => q(goh),
+ q(0159) => q(gon),
+ q(0160) => q(gor),
+ q(0161) => q(got),
+ q(0162) => q(grb),
+ q(0163) => q(grc),
+ q(0164) => q(gre),
+ q(0165) => q(grn),
+ q(0166) => q(gsw),
+ q(0167) => q(guj),
+ q(0168) => q(gwi),
+ q(0169) => q(hai),
+ q(0170) => q(hat),
+ q(0171) => q(hau),
+ q(0172) => q(haw),
+ q(0173) => q(heb),
+ q(0174) => q(her),
+ q(0175) => q(hil),
+ q(0176) => q(him),
+ q(0177) => q(hin),
+ q(0178) => q(hit),
+ q(0179) => q(hmn),
+ q(0180) => q(hmo),
+ q(0181) => q(hrv),
+ q(0182) => q(hsb),
+ q(0183) => q(hun),
+ q(0184) => q(hup),
+ q(0185) => q(iba),
+ q(0186) => q(ibo),
+ q(0187) => q(ice),
+ q(0188) => q(ido),
+ q(0189) => q(iii),
+ q(0190) => q(ijo),
+ q(0191) => q(iku),
+ q(0192) => q(ile),
+ q(0193) => q(ilo),
+ q(0194) => q(ina),
+ q(0195) => q(inc),
+ q(0196) => q(ind),
+ q(0197) => q(ine),
+ q(0198) => q(inh),
+ q(0199) => q(ipk),
+ q(0200) => q(ira),
+ q(0201) => q(iro),
+ q(0202) => q(ita),
+ q(0203) => q(jav),
+ q(0204) => q(jbo),
+ q(0205) => q(jpn),
+ q(0206) => q(jpr),
+ q(0207) => q(jrb),
+ q(0208) => q(kaa),
+ q(0209) => q(kab),
+ q(0210) => q(kac),
+ q(0211) => q(kal),
+ q(0212) => q(kam),
+ q(0213) => q(kan),
+ q(0214) => q(kar),
+ q(0215) => q(kas),
+ q(0216) => q(kau),
+ q(0217) => q(kaw),
+ q(0218) => q(kaz),
+ q(0219) => q(kbd),
+ q(0220) => q(kha),
+ q(0221) => q(khi),
+ q(0222) => q(khm),
+ q(0223) => q(kho),
+ q(0224) => q(kik),
+ q(0225) => q(kin),
+ q(0226) => q(kir),
+ q(0227) => q(kmb),
+ q(0228) => q(kok),
+ q(0229) => q(kom),
+ q(0230) => q(kon),
+ q(0231) => q(kor),
+ q(0232) => q(kos),
+ q(0233) => q(kpe),
+ q(0234) => q(krc),
+ q(0235) => q(krl),
+ q(0236) => q(kro),
+ q(0237) => q(kru),
+ q(0238) => q(kua),
+ q(0239) => q(kum),
+ q(0240) => q(kur),
+ q(0241) => q(kut),
+ q(0242) => q(lad),
+ q(0243) => q(lah),
+ q(0244) => q(lam),
+ q(0245) => q(lao),
+ q(0246) => q(lat),
+ q(0247) => q(lav),
+ q(0248) => q(lez),
+ q(0249) => q(lim),
+ q(0250) => q(lin),
+ q(0251) => q(lit),
+ q(0252) => q(lol),
+ q(0253) => q(loz),
+ q(0254) => q(ltz),
+ q(0255) => q(lua),
+ q(0256) => q(lub),
+ q(0257) => q(lug),
+ q(0258) => q(lui),
+ q(0259) => q(lun),
+ q(0260) => q(luo),
+ q(0261) => q(lus),
+ q(0262) => q(mac),
+ q(0263) => q(mad),
+ q(0264) => q(mag),
+ q(0265) => q(mah),
+ q(0266) => q(mai),
+ q(0267) => q(mak),
+ q(0268) => q(mal),
+ q(0269) => q(man),
+ q(0270) => q(mao),
+ q(0271) => q(map),
+ q(0272) => q(mar),
+ q(0273) => q(mas),
+ q(0274) => q(may),
+ q(0275) => q(mdf),
+ q(0276) => q(mdr),
+ q(0277) => q(men),
+ q(0278) => q(mga),
+ q(0279) => q(mic),
+ q(0280) => q(min),
+ q(0281) => q(mis),
+ q(0282) => q(mkh),
+ q(0283) => q(mlg),
+ q(0284) => q(mlt),
+ q(0285) => q(mnc),
+ q(0286) => q(mni),
+ q(0287) => q(mno),
+ q(0288) => q(moh),
+ q(0289) => q(mon),
+ q(0290) => q(mos),
+ q(0291) => q(mul),
+ q(0292) => q(mun),
+ q(0293) => q(mus),
+ q(0294) => q(mwl),
+ q(0295) => q(mwr),
+ q(0296) => q(myn),
+ q(0297) => q(myv),
+ q(0298) => q(nah),
+ q(0299) => q(nai),
+ q(0300) => q(nap),
+ q(0301) => q(nau),
+ q(0302) => q(nav),
+ q(0303) => q(nbl),
+ q(0304) => q(nde),
+ q(0305) => q(ndo),
+ q(0306) => q(nds),
+ q(0307) => q(nep),
+ q(0308) => q(new),
+ q(0309) => q(nia),
+ q(0310) => q(nic),
+ q(0311) => q(niu),
+ q(0312) => q(nno),
+ q(0313) => q(nob),
+ q(0314) => q(nog),
+ q(0315) => q(non),
+ q(0316) => q(nor),
+ q(0317) => q(nqo),
+ q(0318) => q(nso),
+ q(0319) => q(nub),
+ q(0320) => q(nwc),
+ q(0321) => q(nya),
+ q(0322) => q(nym),
+ q(0323) => q(nyn),
+ q(0324) => q(nyo),
+ q(0325) => q(nzi),
+ q(0326) => q(oci),
+ q(0327) => q(oji),
+ q(0328) => q(ori),
+ q(0329) => q(orm),
+ q(0330) => q(osa),
+ q(0331) => q(oss),
+ q(0332) => q(ota),
+ q(0333) => q(oto),
+ q(0334) => q(paa),
+ q(0335) => q(pag),
+ q(0336) => q(pal),
+ q(0337) => q(pam),
+ q(0338) => q(pan),
+ q(0339) => q(pap),
+ q(0340) => q(pau),
+ q(0341) => q(peo),
+ q(0342) => q(per),
+ q(0343) => q(phi),
+ q(0344) => q(phn),
+ q(0345) => q(pli),
+ q(0346) => q(pol),
+ q(0347) => q(pon),
+ q(0348) => q(por),
+ q(0349) => q(pra),
+ q(0350) => q(pro),
+ q(0351) => q(pus),
+ q(0352) => q(qtz),
+ q(0353) => q(que),
+ q(0354) => q(raj),
+ q(0355) => q(rap),
+ q(0356) => q(rar),
+ q(0357) => q(roa),
+ q(0358) => q(roh),
+ q(0359) => q(rom),
+ q(0360) => q(rum),
+ q(0361) => q(run),
+ q(0362) => q(rup),
+ q(0363) => q(rus),
+ q(0364) => q(sad),
+ q(0365) => q(sag),
+ q(0366) => q(sah),
+ q(0367) => q(sai),
+ q(0368) => q(sal),
+ q(0369) => q(sam),
+ q(0370) => q(san),
+ q(0371) => q(sas),
+ q(0372) => q(sat),
+ q(0373) => q(scn),
+ q(0374) => q(sco),
+ q(0375) => q(sel),
+ q(0376) => q(sem),
+ q(0377) => q(sga),
+ q(0378) => q(sgn),
+ q(0379) => q(shn),
+ q(0380) => q(sid),
+ q(0381) => q(sin),
+ q(0382) => q(sio),
+ q(0383) => q(sit),
+ q(0384) => q(sla),
+ q(0385) => q(slo),
+ q(0386) => q(slv),
+ q(0387) => q(sma),
+ q(0388) => q(sme),
+ q(0389) => q(smi),
+ q(0390) => q(smj),
+ q(0391) => q(smn),
+ q(0392) => q(smo),
+ q(0393) => q(sms),
+ q(0394) => q(sna),
+ q(0395) => q(snd),
+ q(0396) => q(snk),
+ q(0397) => q(sog),
+ q(0398) => q(som),
+ q(0399) => q(son),
+ q(0400) => q(sot),
+ q(0401) => q(spa),
+ q(0402) => q(srd),
+ q(0403) => q(srn),
+ q(0404) => q(srp),
+ q(0405) => q(srr),
+ q(0406) => q(ssa),
+ q(0407) => q(ssw),
+ q(0408) => q(suk),
+ q(0409) => q(sun),
+ q(0410) => q(sus),
+ q(0411) => q(sux),
+ q(0412) => q(swa),
+ q(0413) => q(swe),
+ q(0414) => q(syc),
+ q(0415) => q(syr),
+ q(0416) => q(tah),
+ q(0417) => q(tai),
+ q(0418) => q(tam),
+ q(0419) => q(tat),
+ q(0420) => q(tel),
+ q(0421) => q(tem),
+ q(0422) => q(ter),
+ q(0423) => q(tet),
+ q(0424) => q(tgk),
+ q(0425) => q(tgl),
+ q(0426) => q(tha),
+ q(0427) => q(tib),
+ q(0428) => q(tig),
+ q(0429) => q(tir),
+ q(0430) => q(tiv),
+ q(0431) => q(tkl),
+ q(0432) => q(tlh),
+ q(0433) => q(tli),
+ q(0434) => q(tmh),
+ q(0435) => q(tog),
+ q(0436) => q(ton),
+ q(0437) => q(tpi),
+ q(0438) => q(tsi),
+ q(0439) => q(tsn),
+ q(0440) => q(tso),
+ q(0441) => q(tuk),
+ q(0442) => q(tum),
+ q(0443) => q(tup),
+ q(0444) => q(tur),
+ q(0445) => q(tut),
+ q(0446) => q(tvl),
+ q(0447) => q(twi),
+ q(0448) => q(tyv),
+ q(0449) => q(udm),
+ q(0450) => q(uga),
+ q(0451) => q(uig),
+ q(0452) => q(ukr),
+ q(0453) => q(umb),
+ q(0454) => q(und),
+ q(0455) => q(urd),
+ q(0456) => q(uzb),
+ q(0457) => q(vai),
+ q(0458) => q(ven),
+ q(0459) => q(vie),
+ q(0460) => q(vol),
+ q(0461) => q(vot),
+ q(0462) => q(wak),
+ q(0463) => q(wal),
+ q(0464) => q(war),
+ q(0465) => q(was),
+ q(0466) => q(wel),
+ q(0467) => q(wen),
+ q(0468) => q(wln),
+ q(0469) => q(wol),
+ q(0470) => q(xal),
+ q(0471) => q(xho),
+ q(0472) => q(yao),
+ q(0473) => q(yap),
+ q(0474) => q(yid),
+ q(0475) => q(yor),
+ q(0476) => q(ypk),
+ q(0477) => q(zap),
+ q(0478) => q(zbl),
+ q(0479) => q(zen),
+ q(0480) => q(zha),
+ q(0481) => q(znd),
+ q(0482) => q(zul),
+ q(0483) => q(zun),
+ q(0484) => q(zxx),
+ q(0485) => q(zza),
+ },
+ q(term) => {
+ q(0013) => q(sqi),
+ q(0024) => q(hye),
+ q(0044) => q(eus),
+ q(0066) => q(mya),
+ q(0079) => q(zho),
+ q(0101) => q(ces),
+ q(0116) => q(nld),
+ q(0137) => q(fra),
+ q(0149) => q(kat),
+ q(0150) => q(deu),
+ q(0164) => q(ell),
+ q(0187) => q(isl),
+ q(0262) => q(mkd),
+ q(0270) => q(mri),
+ q(0274) => q(msa),
+ q(0342) => q(fas),
+ q(0360) => q(ron),
+ q(0385) => q(slk),
+ q(0427) => q(bod),
+ q(0466) => q(cym),
+ },
+};
+
+1;
--- /dev/null
+package Locale::Codes::Script;
+
+# This file was automatically generated. Any changes to this file will
+# be lost the next time 'get_codes' is run.
+# Generated on: Tue Apr 6 08:17:27 EDT 2010
+
+=pod
+
+=head1 NAME
+
+Locale::Codes::Script - script codes for the Locale::Script module
+
+=head1 SYNOPSIS
+
+This module contains data used by the Locale::Script module. It is
+not intended to be used directly, and contains no calleable routines.
+
+=head1 AUTHOR
+
+See Locale::Codes for full author history.
+
+Currently maintained by Sullivan Beck (sbeck@cpan.org).
+
+=head1 COPYRIGHT
+
+ Copyright (c) 1997-2001 Canon Research Centre Europe (CRE).
+ Copyright (c) 2001-2010 Neil Bowers
+ Copyright (c) 2010-2010 Sullivan Beck
+
+This module is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
+
+use strict;
+use warnings;
+require 5.002;
+
+use vars qw($VERSION);
+$VERSION='3.12';
+
+$Locale::Codes::Data{'script'}{'id'} = '0144';
+
+$Locale::Codes::Data{'script'}{'id2names'} = {
+ q(0001) => [
+ q(Arabic),
+ ],
+ q(0002) => [
+ q(Imperial Aramaic),
+ ],
+ q(0003) => [
+ q(Armenian),
+ ],
+ q(0004) => [
+ q(Avestan),
+ ],
+ q(0005) => [
+ q(Balinese),
+ ],
+ q(0006) => [
+ q(Bamum),
+ ],
+ q(0007) => [
+ q(Bassa Vah),
+ ],
+ q(0008) => [
+ q(Batak),
+ ],
+ q(0009) => [
+ q(Bengali),
+ ],
+ q(0010) => [
+ q(Blissymbols),
+ ],
+ q(0011) => [
+ q(Bopomofo),
+ ],
+ q(0012) => [
+ q(Brahmi),
+ ],
+ q(0013) => [
+ q(Braille),
+ ],
+ q(0014) => [
+ q(Buginese),
+ ],
+ q(0015) => [
+ q(Buhid),
+ ],
+ q(0016) => [
+ q(Chakma),
+ ],
+ q(0017) => [
+ q(Unified Canadian Aboriginal Syllabics),
+ ],
+ q(0018) => [
+ q(Carian),
+ ],
+ q(0019) => [
+ q(Cham),
+ ],
+ q(0020) => [
+ q(Cherokee),
+ ],
+ q(0021) => [
+ q(Cirth),
+ ],
+ q(0022) => [
+ q(Coptic),
+ ],
+ q(0023) => [
+ q(Cypriot),
+ ],
+ q(0024) => [
+ q(Cyrillic),
+ ],
+ q(0025) => [
+ q(Cyrillic (Old Church Slavonic variant)),
+ ],
+ q(0026) => [
+ q(Devanagari (Nagari)),
+ ],
+ q(0027) => [
+ q(Deseret (Mormon)),
+ ],
+ q(0028) => [
+ q(Egyptian demotic),
+ ],
+ q(0029) => [
+ q(Egyptian hieratic),
+ ],
+ q(0030) => [
+ q(Egyptian hieroglyphs),
+ ],
+ q(0031) => [
+ q(Ethiopic (Geez)),
+ ],
+ q(0032) => [
+ q(Georgian (Mkhedruli)),
+ ],
+ q(0033) => [
+ q(Khutsuri (Asomtavruli and Nuskhuri)),
+ ],
+ q(0034) => [
+ q(Glagolitic),
+ ],
+ q(0035) => [
+ q(Gothic),
+ ],
+ q(0036) => [
+ q(Grantha),
+ ],
+ q(0037) => [
+ q(Greek),
+ ],
+ q(0038) => [
+ q(Gujarati),
+ ],
+ q(0039) => [
+ q(Gurmukhi),
+ ],
+ q(0040) => [
+ q(Hangul (Hangul, Hangeul)),
+ ],
+ q(0041) => [
+ q(Han (Hanzi, Kanji, Hanja)),
+ ],
+ q(0042) => [
+ q(Hanunoo (Hanunoo)),
+ ],
+ q(0043) => [
+ q(Han (Simplified variant)),
+ ],
+ q(0044) => [
+ q(Han (Traditional variant)),
+ ],
+ q(0045) => [
+ q(Hebrew),
+ ],
+ q(0046) => [
+ q(Hiragana),
+ ],
+ q(0047) => [
+ q(Pahawh Hmong),
+ ],
+ q(0048) => [
+ q((alias for Hiragana + Katakana)),
+ ],
+ q(0049) => [
+ q(Old Hungarian),
+ ],
+ q(0050) => [
+ q(Indus (Harappan)),
+ ],
+ q(0051) => [
+ q(Old Italic (Etruscan, Oscan, etc.)),
+ ],
+ q(0052) => [
+ q(Javanese),
+ ],
+ q(0053) => [
+ q(Japanese (alias for Han + Hiragana + Katakana)),
+ ],
+ q(0054) => [
+ q(Kayah Li),
+ ],
+ q(0055) => [
+ q(Katakana),
+ ],
+ q(0056) => [
+ q(Kharoshthi),
+ ],
+ q(0057) => [
+ q(Khmer),
+ ],
+ q(0058) => [
+ q(Kannada),
+ ],
+ q(0059) => [
+ q(Korean (alias for Hangul + Han)),
+ ],
+ q(0060) => [
+ q(Kpelle),
+ ],
+ q(0061) => [
+ q(Kaithi),
+ ],
+ q(0062) => [
+ q(Tai Tham (Lanna)),
+ ],
+ q(0063) => [
+ q(Lao),
+ ],
+ q(0064) => [
+ q(Latin (Fraktur variant)),
+ ],
+ q(0065) => [
+ q(Latin (Gaelic variant)),
+ ],
+ q(0066) => [
+ q(Latin),
+ ],
+ q(0067) => [
+ q(Lepcha (Rong)),
+ ],
+ q(0068) => [
+ q(Limbu),
+ ],
+ q(0069) => [
+ q(Linear A),
+ ],
+ q(0070) => [
+ q(Linear B),
+ ],
+ q(0071) => [
+ q(Lisu (Fraser)),
+ ],
+ q(0072) => [
+ q(Loma),
+ ],
+ q(0073) => [
+ q(Lycian),
+ ],
+ q(0074) => [
+ q(Lydian),
+ ],
+ q(0075) => [
+ q(Mandaic, Mandaean),
+ ],
+ q(0076) => [
+ q(Manichaean),
+ ],
+ q(0077) => [
+ q(Mayan hieroglyphs),
+ ],
+ q(0078) => [
+ q(Mende),
+ ],
+ q(0079) => [
+ q(Meroitic Cursive),
+ ],
+ q(0080) => [
+ q(Meroitic Hieroglyphs),
+ ],
+ q(0081) => [
+ q(Malayalam),
+ ],
+ q(0082) => [
+ q(Moon (Moon code, Moon script, Moon type)),
+ ],
+ q(0083) => [
+ q(Mongolian),
+ ],
+ q(0084) => [
+ q(Meitei Mayek (Meithei, Meetei)),
+ ],
+ q(0085) => [
+ q(Myanmar (Burmese)),
+ ],
+ q(0086) => [
+ q(Old North Arabian (Ancient North Arabian)),
+ ],
+ q(0087) => [
+ q(Nabataean),
+ ],
+ q(0088) => [
+ q(Nakhi Geba ('Na-'Khi Ggo-baw, Naxi Geba)),
+ ],
+ q(0089) => [
+ q(N'Ko),
+ ],
+ q(0090) => [
+ q(Ogham),
+ ],
+ q(0091) => [
+ q(Ol Chiki (Ol Cemet, Ol, Santali)),
+ ],
+ q(0092) => [
+ q(Old Turkic, Orkhon Runic),
+ ],
+ q(0093) => [
+ q(Oriya),
+ ],
+ q(0094) => [
+ q(Osmanya),
+ ],
+ q(0095) => [
+ q(Palmyrene),
+ ],
+ q(0096) => [
+ q(Old Permic),
+ ],
+ q(0097) => [
+ q(Phags-pa),
+ ],
+ q(0098) => [
+ q(Inscriptional Pahlavi),
+ ],
+ q(0099) => [
+ q(Psalter Pahlavi),
+ ],
+ q(0100) => [
+ q(Book Pahlavi),
+ ],
+ q(0101) => [
+ q(Phoenician),
+ ],
+ q(0102) => [
+ q(Miao (Pollard)),
+ ],
+ q(0103) => [
+ q(Inscriptional Parthian),
+ ],
+ q(0104) => [
+ q(Reserved for private use (start)),
+ ],
+ q(0105) => [
+ q(Reserved for private use (end)),
+ ],
+ q(0106) => [
+ q(Rejang (Redjang, Kaganga)),
+ ],
+ q(0107) => [
+ q(Rongorongo),
+ ],
+ q(0108) => [
+ q(Runic),
+ ],
+ q(0109) => [
+ q(Samaritan),
+ ],
+ q(0110) => [
+ q(Sarati),
+ ],
+ q(0111) => [
+ q(Old South Arabian),
+ ],
+ q(0112) => [
+ q(Saurashtra),
+ ],
+ q(0113) => [
+ q(SignWriting),
+ ],
+ q(0114) => [
+ q(Shavian (Shaw)),
+ ],
+ q(0115) => [
+ q(Sinhala),
+ ],
+ q(0116) => [
+ q(Sundanese),
+ ],
+ q(0117) => [
+ q(Syloti Nagri),
+ ],
+ q(0118) => [
+ q(Syriac),
+ ],
+ q(0119) => [
+ q(Syriac (Estrangelo variant)),
+ ],
+ q(0120) => [
+ q(Syriac (Western variant)),
+ ],
+ q(0121) => [
+ q(Syriac (Eastern variant)),
+ ],
+ q(0122) => [
+ q(Tagbanwa),
+ ],
+ q(0123) => [
+ q(Tai Le),
+ ],
+ q(0124) => [
+ q(New Tai Lue),
+ ],
+ q(0125) => [
+ q(Tamil),
+ ],
+ q(0126) => [
+ q(Tai Viet),
+ ],
+ q(0127) => [
+ q(Telugu),
+ ],
+ q(0128) => [
+ q(Tengwar),
+ ],
+ q(0129) => [
+ q(Tifinagh (Berber)),
+ ],
+ q(0130) => [
+ q(Tagalog (Baybayin, Alibata)),
+ ],
+ q(0131) => [
+ q(Thaana),
+ ],
+ q(0132) => [
+ q(Thai),
+ ],
+ q(0133) => [
+ q(Tibetan),
+ ],
+ q(0134) => [
+ q(Ugaritic),
+ ],
+ q(0135) => [
+ q(Vai),
+ ],
+ q(0136) => [
+ q(Visible Speech),
+ ],
+ q(0137) => [
+ q(Warang Citi (Varang Kshiti)),
+ ],
+ q(0138) => [
+ q(Old Persian),
+ ],
+ q(0139) => [
+ q(Cuneiform, Sumero-Akkadian),
+ ],
+ q(0140) => [
+ q(Yi),
+ ],
+ q(0141) => [
+ q(Code for inherited script),
+ ],
+ q(0142) => [
+ q(Mathematical notation),
+ ],
+ q(0143) => [
+ q(Symbols),
+ ],
+};
+
+$Locale::Codes::Data{'script'}{'alias2id'} = {
+ q((alias for hiragana + katakana)) => [
+ q(0048),
+ q(0),
+ ],
+ q(arabic) => [
+ q(0001),
+ q(0),
+ ],
+ q(armenian) => [
+ q(0003),
+ q(0),
+ ],
+ q(avestan) => [
+ q(0004),
+ q(0),
+ ],
+ q(balinese) => [
+ q(0005),
+ q(0),
+ ],
+ q(bamum) => [
+ q(0006),
+ q(0),
+ ],
+ q(bassa vah) => [
+ q(0007),
+ q(0),
+ ],
+ q(batak) => [
+ q(0008),
+ q(0),
+ ],
+ q(bengali) => [
+ q(0009),
+ q(0),
+ ],
+ q(blissymbols) => [
+ q(0010),
+ q(0),
+ ],
+ q(book pahlavi) => [
+ q(0100),
+ q(0),
+ ],
+ q(bopomofo) => [
+ q(0011),
+ q(0),
+ ],
+ q(brahmi) => [
+ q(0012),
+ q(0),
+ ],
+ q(braille) => [
+ q(0013),
+ q(0),
+ ],
+ q(buginese) => [
+ q(0014),
+ q(0),
+ ],
+ q(buhid) => [
+ q(0015),
+ q(0),
+ ],
+ q(carian) => [
+ q(0018),
+ q(0),
+ ],
+ q(chakma) => [
+ q(0016),
+ q(0),
+ ],
+ q(cham) => [
+ q(0019),
+ q(0),
+ ],
+ q(cherokee) => [
+ q(0020),
+ q(0),
+ ],
+ q(cirth) => [
+ q(0021),
+ q(0),
+ ],
+ q(code for inherited script) => [
+ q(0141),
+ q(0),
+ ],
+ q(coptic) => [
+ q(0022),
+ q(0),
+ ],
+ q(cuneiform, sumero-akkadian) => [
+ q(0139),
+ q(0),
+ ],
+ q(cypriot) => [
+ q(0023),
+ q(0),
+ ],
+ q(cyrillic) => [
+ q(0024),
+ q(0),
+ ],
+ q(cyrillic (old church slavonic variant)) => [
+ q(0025),
+ q(0),
+ ],
+ q(deseret (mormon)) => [
+ q(0027),
+ q(0),
+ ],
+ q(devanagari (nagari)) => [
+ q(0026),
+ q(0),
+ ],
+ q(egyptian demotic) => [
+ q(0028),
+ q(0),
+ ],
+ q(egyptian hieratic) => [
+ q(0029),
+ q(0),
+ ],
+ q(egyptian hieroglyphs) => [
+ q(0030),
+ q(0),
+ ],
+ q(ethiopic (geez)) => [
+ q(0031),
+ q(0),
+ ],
+ q(georgian (mkhedruli)) => [
+ q(0032),
+ q(0),
+ ],
+ q(glagolitic) => [
+ q(0034),
+ q(0),
+ ],
+ q(gothic) => [
+ q(0035),
+ q(0),
+ ],
+ q(grantha) => [
+ q(0036),
+ q(0),
+ ],
+ q(greek) => [
+ q(0037),
+ q(0),
+ ],
+ q(gujarati) => [
+ q(0038),
+ q(0),
+ ],
+ q(gurmukhi) => [
+ q(0039),
+ q(0),
+ ],
+ q(han (hanzi, kanji, hanja)) => [
+ q(0041),
+ q(0),
+ ],
+ q(han (simplified variant)) => [
+ q(0043),
+ q(0),
+ ],
+ q(han (traditional variant)) => [
+ q(0044),
+ q(0),
+ ],
+ q(hangul (hangul, hangeul)) => [
+ q(0040),
+ q(0),
+ ],
+ q(hanunoo (hanunoo)) => [
+ q(0042),
+ q(0),
+ ],
+ q(hebrew) => [
+ q(0045),
+ q(0),
+ ],
+ q(hiragana) => [
+ q(0046),
+ q(0),
+ ],
+ q(imperial aramaic) => [
+ q(0002),
+ q(0),
+ ],
+ q(indus (harappan)) => [
+ q(0050),
+ q(0),
+ ],
+ q(inscriptional pahlavi) => [
+ q(0098),
+ q(0),
+ ],
+ q(inscriptional parthian) => [
+ q(0103),
+ q(0),
+ ],
+ q(japanese (alias for han + hiragana + katakana)) => [
+ q(0053),
+ q(0),
+ ],
+ q(javanese) => [
+ q(0052),
+ q(0),
+ ],
+ q(kaithi) => [
+ q(0061),
+ q(0),
+ ],
+ q(kannada) => [
+ q(0058),
+ q(0),
+ ],
+ q(katakana) => [
+ q(0055),
+ q(0),
+ ],
+ q(kayah li) => [
+ q(0054),
+ q(0),
+ ],
+ q(kharoshthi) => [
+ q(0056),
+ q(0),
+ ],
+ q(khmer) => [
+ q(0057),
+ q(0),
+ ],
+ q(khutsuri (asomtavruli and nuskhuri)) => [
+ q(0033),
+ q(0),
+ ],
+ q(korean (alias for hangul + han)) => [
+ q(0059),
+ q(0),
+ ],
+ q(kpelle) => [
+ q(0060),
+ q(0),
+ ],
+ q(lao) => [
+ q(0063),
+ q(0),
+ ],
+ q(latin) => [
+ q(0066),
+ q(0),
+ ],
+ q(latin (fraktur variant)) => [
+ q(0064),
+ q(0),
+ ],
+ q(latin (gaelic variant)) => [
+ q(0065),
+ q(0),
+ ],
+ q(lepcha (rong)) => [
+ q(0067),
+ q(0),
+ ],
+ q(limbu) => [
+ q(0068),
+ q(0),
+ ],
+ q(linear a) => [
+ q(0069),
+ q(0),
+ ],
+ q(linear b) => [
+ q(0070),
+ q(0),
+ ],
+ q(lisu (fraser)) => [
+ q(0071),
+ q(0),
+ ],
+ q(loma) => [
+ q(0072),
+ q(0),
+ ],
+ q(lycian) => [
+ q(0073),
+ q(0),
+ ],
+ q(lydian) => [
+ q(0074),
+ q(0),
+ ],
+ q(malayalam) => [
+ q(0081),
+ q(0),
+ ],
+ q(mandaic, mandaean) => [
+ q(0075),
+ q(0),
+ ],
+ q(manichaean) => [
+ q(0076),
+ q(0),
+ ],
+ q(mathematical notation) => [
+ q(0142),
+ q(0),
+ ],
+ q(mayan hieroglyphs) => [
+ q(0077),
+ q(0),
+ ],
+ q(meitei mayek (meithei, meetei)) => [
+ q(0084),
+ q(0),
+ ],
+ q(mende) => [
+ q(0078),
+ q(0),
+ ],
+ q(meroitic cursive) => [
+ q(0079),
+ q(0),
+ ],
+ q(meroitic hieroglyphs) => [
+ q(0080),
+ q(0),
+ ],
+ q(miao (pollard)) => [
+ q(0102),
+ q(0),
+ ],
+ q(mongolian) => [
+ q(0083),
+ q(0),
+ ],
+ q(moon (moon code, moon script, moon type)) => [
+ q(0082),
+ q(0),
+ ],
+ q(myanmar (burmese)) => [
+ q(0085),
+ q(0),
+ ],
+ q(n'ko) => [
+ q(0089),
+ q(0),
+ ],
+ q(nabataean) => [
+ q(0087),
+ q(0),
+ ],
+ q(nakhi geba ('na-'khi ggo-baw, naxi geba)) => [
+ q(0088),
+ q(0),
+ ],
+ q(new tai lue) => [
+ q(0124),
+ q(0),
+ ],
+ q(ogham) => [
+ q(0090),
+ q(0),
+ ],
+ q(ol chiki (ol cemet, ol, santali)) => [
+ q(0091),
+ q(0),
+ ],
+ q(old hungarian) => [
+ q(0049),
+ q(0),
+ ],
+ q(old italic (etruscan, oscan, etc.)) => [
+ q(0051),
+ q(0),
+ ],
+ q(old north arabian (ancient north arabian)) => [
+ q(0086),
+ q(0),
+ ],
+ q(old permic) => [
+ q(0096),
+ q(0),
+ ],
+ q(old persian) => [
+ q(0138),
+ q(0),
+ ],
+ q(old south arabian) => [
+ q(0111),
+ q(0),
+ ],
+ q(old turkic, orkhon runic) => [
+ q(0092),
+ q(0),
+ ],
+ q(oriya) => [
+ q(0093),
+ q(0),
+ ],
+ q(osmanya) => [
+ q(0094),
+ q(0),
+ ],
+ q(pahawh hmong) => [
+ q(0047),
+ q(0),
+ ],
+ q(palmyrene) => [
+ q(0095),
+ q(0),
+ ],
+ q(phags-pa) => [
+ q(0097),
+ q(0),
+ ],
+ q(phoenician) => [
+ q(0101),
+ q(0),
+ ],
+ q(psalter pahlavi) => [
+ q(0099),
+ q(0),
+ ],
+ q(rejang (redjang, kaganga)) => [
+ q(0106),
+ q(0),
+ ],
+ q(reserved for private use (end)) => [
+ q(0105),
+ q(0),
+ ],
+ q(reserved for private use (start)) => [
+ q(0104),
+ q(0),
+ ],
+ q(rongorongo) => [
+ q(0107),
+ q(0),
+ ],
+ q(runic) => [
+ q(0108),
+ q(0),
+ ],
+ q(samaritan) => [
+ q(0109),
+ q(0),
+ ],
+ q(sarati) => [
+ q(0110),
+ q(0),
+ ],
+ q(saurashtra) => [
+ q(0112),
+ q(0),
+ ],
+ q(shavian (shaw)) => [
+ q(0114),
+ q(0),
+ ],
+ q(signwriting) => [
+ q(0113),
+ q(0),
+ ],
+ q(sinhala) => [
+ q(0115),
+ q(0),
+ ],
+ q(sundanese) => [
+ q(0116),
+ q(0),
+ ],
+ q(syloti nagri) => [
+ q(0117),
+ q(0),
+ ],
+ q(symbols) => [
+ q(0143),
+ q(0),
+ ],
+ q(syriac) => [
+ q(0118),
+ q(0),
+ ],
+ q(syriac (eastern variant)) => [
+ q(0121),
+ q(0),
+ ],
+ q(syriac (estrangelo variant)) => [
+ q(0119),
+ q(0),
+ ],
+ q(syriac (western variant)) => [
+ q(0120),
+ q(0),
+ ],
+ q(tagalog (baybayin, alibata)) => [
+ q(0130),
+ q(0),
+ ],
+ q(tagbanwa) => [
+ q(0122),
+ q(0),
+ ],
+ q(tai le) => [
+ q(0123),
+ q(0),
+ ],
+ q(tai tham (lanna)) => [
+ q(0062),
+ q(0),
+ ],
+ q(tai viet) => [
+ q(0126),
+ q(0),
+ ],
+ q(tamil) => [
+ q(0125),
+ q(0),
+ ],
+ q(telugu) => [
+ q(0127),
+ q(0),
+ ],
+ q(tengwar) => [
+ q(0128),
+ q(0),
+ ],
+ q(thaana) => [
+ q(0131),
+ q(0),
+ ],
+ q(thai) => [
+ q(0132),
+ q(0),
+ ],
+ q(tibetan) => [
+ q(0133),
+ q(0),
+ ],
+ q(tifinagh (berber)) => [
+ q(0129),
+ q(0),
+ ],
+ q(ugaritic) => [
+ q(0134),
+ q(0),
+ ],
+ q(unified canadian aboriginal syllabics) => [
+ q(0017),
+ q(0),
+ ],
+ q(vai) => [
+ q(0135),
+ q(0),
+ ],
+ q(visible speech) => [
+ q(0136),
+ q(0),
+ ],
+ q(warang citi (varang kshiti)) => [
+ q(0137),
+ q(0),
+ ],
+ q(yi) => [
+ q(0140),
+ q(0),
+ ],
+};
+
+$Locale::Codes::Data{'script'}{'code2id'} = {
+ q(alpha) => {
+ q(Arab) => [
+ q(0001),
+ q(0),
+ ],
+ q(Armi) => [
+ q(0002),
+ q(0),
+ ],
+ q(Armn) => [
+ q(0003),
+ q(0),
+ ],
+ q(Avst) => [
+ q(0004),
+ q(0),
+ ],
+ q(Bali) => [
+ q(0005),
+ q(0),
+ ],
+ q(Bamu) => [
+ q(0006),
+ q(0),
+ ],
+ q(Bass) => [
+ q(0007),
+ q(0),
+ ],
+ q(Batk) => [
+ q(0008),
+ q(0),
+ ],
+ q(Beng) => [
+ q(0009),
+ q(0),
+ ],
+ q(Blis) => [
+ q(0010),
+ q(0),
+ ],
+ q(Bopo) => [
+ q(0011),
+ q(0),
+ ],
+ q(Brah) => [
+ q(0012),
+ q(0),
+ ],
+ q(Brai) => [
+ q(0013),
+ q(0),
+ ],
+ q(Bugi) => [
+ q(0014),
+ q(0),
+ ],
+ q(Buhd) => [
+ q(0015),
+ q(0),
+ ],
+ q(Cakm) => [
+ q(0016),
+ q(0),
+ ],
+ q(Cans) => [
+ q(0017),
+ q(0),
+ ],
+ q(Cari) => [
+ q(0018),
+ q(0),
+ ],
+ q(Cham) => [
+ q(0019),
+ q(0),
+ ],
+ q(Cher) => [
+ q(0020),
+ q(0),
+ ],
+ q(Cirt) => [
+ q(0021),
+ q(0),
+ ],
+ q(Copt) => [
+ q(0022),
+ q(0),
+ ],
+ q(Cprt) => [
+ q(0023),
+ q(0),
+ ],
+ q(Cyrl) => [
+ q(0024),
+ q(0),
+ ],
+ q(Cyrs) => [
+ q(0025),
+ q(0),
+ ],
+ q(Deva) => [
+ q(0026),
+ q(0),
+ ],
+ q(Dsrt) => [
+ q(0027),
+ q(0),
+ ],
+ q(Egyd) => [
+ q(0028),
+ q(0),
+ ],
+ q(Egyh) => [
+ q(0029),
+ q(0),
+ ],
+ q(Egyp) => [
+ q(0030),
+ q(0),
+ ],
+ q(Ethi) => [
+ q(0031),
+ q(0),
+ ],
+ q(Geok) => [
+ q(0033),
+ q(0),
+ ],
+ q(Geor) => [
+ q(0032),
+ q(0),
+ ],
+ q(Glag) => [
+ q(0034),
+ q(0),
+ ],
+ q(Goth) => [
+ q(0035),
+ q(0),
+ ],
+ q(Gran) => [
+ q(0036),
+ q(0),
+ ],
+ q(Grek) => [
+ q(0037),
+ q(0),
+ ],
+ q(Gujr) => [
+ q(0038),
+ q(0),
+ ],
+ q(Guru) => [
+ q(0039),
+ q(0),
+ ],
+ q(Hang) => [
+ q(0040),
+ q(0),
+ ],
+ q(Hani) => [
+ q(0041),
+ q(0),
+ ],
+ q(Hano) => [
+ q(0042),
+ q(0),
+ ],
+ q(Hans) => [
+ q(0043),
+ q(0),
+ ],
+ q(Hant) => [
+ q(0044),
+ q(0),
+ ],
+ q(Hebr) => [
+ q(0045),
+ q(0),
+ ],
+ q(Hira) => [
+ q(0046),
+ q(0),
+ ],
+ q(Hmng) => [
+ q(0047),
+ q(0),
+ ],
+ q(Hrkt) => [
+ q(0048),
+ q(0),
+ ],
+ q(Hung) => [
+ q(0049),
+ q(0),
+ ],
+ q(Inds) => [
+ q(0050),
+ q(0),
+ ],
+ q(Ital) => [
+ q(0051),
+ q(0),
+ ],
+ q(Java) => [
+ q(0052),
+ q(0),
+ ],
+ q(Jpan) => [
+ q(0053),
+ q(0),
+ ],
+ q(Kali) => [
+ q(0054),
+ q(0),
+ ],
+ q(Kana) => [
+ q(0055),
+ q(0),
+ ],
+ q(Khar) => [
+ q(0056),
+ q(0),
+ ],
+ q(Khmr) => [
+ q(0057),
+ q(0),
+ ],
+ q(Knda) => [
+ q(0058),
+ q(0),
+ ],
+ q(Kore) => [
+ q(0059),
+ q(0),
+ ],
+ q(Kpel) => [
+ q(0060),
+ q(0),
+ ],
+ q(Kthi) => [
+ q(0061),
+ q(0),
+ ],
+ q(Lana) => [
+ q(0062),
+ q(0),
+ ],
+ q(Laoo) => [
+ q(0063),
+ q(0),
+ ],
+ q(Latf) => [
+ q(0064),
+ q(0),
+ ],
+ q(Latg) => [
+ q(0065),
+ q(0),
+ ],
+ q(Latn) => [
+ q(0066),
+ q(0),
+ ],
+ q(Lepc) => [
+ q(0067),
+ q(0),
+ ],
+ q(Limb) => [
+ q(0068),
+ q(0),
+ ],
+ q(Lina) => [
+ q(0069),
+ q(0),
+ ],
+ q(Linb) => [
+ q(0070),
+ q(0),
+ ],
+ q(Lisu) => [
+ q(0071),
+ q(0),
+ ],
+ q(Loma) => [
+ q(0072),
+ q(0),
+ ],
+ q(Lyci) => [
+ q(0073),
+ q(0),
+ ],
+ q(Lydi) => [
+ q(0074),
+ q(0),
+ ],
+ q(Mand) => [
+ q(0075),
+ q(0),
+ ],
+ q(Mani) => [
+ q(0076),
+ q(0),
+ ],
+ q(Maya) => [
+ q(0077),
+ q(0),
+ ],
+ q(Mend) => [
+ q(0078),
+ q(0),
+ ],
+ q(Merc) => [
+ q(0079),
+ q(0),
+ ],
+ q(Mero) => [
+ q(0080),
+ q(0),
+ ],
+ q(Mlym) => [
+ q(0081),
+ q(0),
+ ],
+ q(Mong) => [
+ q(0083),
+ q(0),
+ ],
+ q(Moon) => [
+ q(0082),
+ q(0),
+ ],
+ q(Mtei) => [
+ q(0084),
+ q(0),
+ ],
+ q(Mymr) => [
+ q(0085),
+ q(0),
+ ],
+ q(Narb) => [
+ q(0086),
+ q(0),
+ ],
+ q(Nbat) => [
+ q(0087),
+ q(0),
+ ],
+ q(Nkgb) => [
+ q(0088),
+ q(0),
+ ],
+ q(Nkoo) => [
+ q(0089),
+ q(0),
+ ],
+ q(Ogam) => [
+ q(0090),
+ q(0),
+ ],
+ q(Olck) => [
+ q(0091),
+ q(0),
+ ],
+ q(Orkh) => [
+ q(0092),
+ q(0),
+ ],
+ q(Orya) => [
+ q(0093),
+ q(0),
+ ],
+ q(Osma) => [
+ q(0094),
+ q(0),
+ ],
+ q(Palm) => [
+ q(0095),
+ q(0),
+ ],
+ q(Perm) => [
+ q(0096),
+ q(0),
+ ],
+ q(Phag) => [
+ q(0097),
+ q(0),
+ ],
+ q(Phli) => [
+ q(0098),
+ q(0),
+ ],
+ q(Phlp) => [
+ q(0099),
+ q(0),
+ ],
+ q(Phlv) => [
+ q(0100),
+ q(0),
+ ],
+ q(Phnx) => [
+ q(0101),
+ q(0),
+ ],
+ q(Plrd) => [
+ q(0102),
+ q(0),
+ ],
+ q(Prti) => [
+ q(0103),
+ q(0),
+ ],
+ q(Qaaa) => [
+ q(0104),
+ q(0),
+ ],
+ q(Qabx) => [
+ q(0105),
+ q(0),
+ ],
+ q(Rjng) => [
+ q(0106),
+ q(0),
+ ],
+ q(Roro) => [
+ q(0107),
+ q(0),
+ ],
+ q(Runr) => [
+ q(0108),
+ q(0),
+ ],
+ q(Samr) => [
+ q(0109),
+ q(0),
+ ],
+ q(Sara) => [
+ q(0110),
+ q(0),
+ ],
+ q(Sarb) => [
+ q(0111),
+ q(0),
+ ],
+ q(Saur) => [
+ q(0112),
+ q(0),
+ ],
+ q(Sgnw) => [
+ q(0113),
+ q(0),
+ ],
+ q(Shaw) => [
+ q(0114),
+ q(0),
+ ],
+ q(Sinh) => [
+ q(0115),
+ q(0),
+ ],
+ q(Sund) => [
+ q(0116),
+ q(0),
+ ],
+ q(Sylo) => [
+ q(0117),
+ q(0),
+ ],
+ q(Syrc) => [
+ q(0118),
+ q(0),
+ ],
+ q(Syre) => [
+ q(0119),
+ q(0),
+ ],
+ q(Syrj) => [
+ q(0120),
+ q(0),
+ ],
+ q(Syrn) => [
+ q(0121),
+ q(0),
+ ],
+ q(Tagb) => [
+ q(0122),
+ q(0),
+ ],
+ q(Tale) => [
+ q(0123),
+ q(0),
+ ],
+ q(Talu) => [
+ q(0124),
+ q(0),
+ ],
+ q(Taml) => [
+ q(0125),
+ q(0),
+ ],
+ q(Tavt) => [
+ q(0126),
+ q(0),
+ ],
+ q(Telu) => [
+ q(0127),
+ q(0),
+ ],
+ q(Teng) => [
+ q(0128),
+ q(0),
+ ],
+ q(Tfng) => [
+ q(0129),
+ q(0),
+ ],
+ q(Tglg) => [
+ q(0130),
+ q(0),
+ ],
+ q(Thaa) => [
+ q(0131),
+ q(0),
+ ],
+ q(Thai) => [
+ q(0132),
+ q(0),
+ ],
+ q(Tibt) => [
+ q(0133),
+ q(0),
+ ],
+ q(Ugar) => [
+ q(0134),
+ q(0),
+ ],
+ q(Vaii) => [
+ q(0135),
+ q(0),
+ ],
+ q(Visp) => [
+ q(0136),
+ q(0),
+ ],
+ q(Wara) => [
+ q(0137),
+ q(0),
+ ],
+ q(Xpeo) => [
+ q(0138),
+ q(0),
+ ],
+ q(Xsux) => [
+ q(0139),
+ q(0),
+ ],
+ q(Yiii) => [
+ q(0140),
+ q(0),
+ ],
+ q(Zinh) => [
+ q(0141),
+ q(0),
+ ],
+ q(Zmth) => [
+ q(0142),
+ q(0),
+ ],
+ q(Zsym) => [
+ q(0143),
+ q(0),
+ ],
+ },
+ q(num) => {
+ q(020) => [
+ q(0139),
+ q(0),
+ ],
+ q(030) => [
+ q(0138),
+ q(0),
+ ],
+ q(040) => [
+ q(0134),
+ q(0),
+ ],
+ q(050) => [
+ q(0030),
+ q(0),
+ ],
+ q(060) => [
+ q(0029),
+ q(0),
+ ],
+ q(070) => [
+ q(0028),
+ q(0),
+ ],
+ q(090) => [
+ q(0077),
+ q(0),
+ ],
+ q(095) => [
+ q(0113),
+ q(0),
+ ],
+ q(100) => [
+ q(0080),
+ q(0),
+ ],
+ q(101) => [
+ q(0079),
+ q(0),
+ ],
+ q(105) => [
+ q(0111),
+ q(0),
+ ],
+ q(106) => [
+ q(0086),
+ q(0),
+ ],
+ q(115) => [
+ q(0101),
+ q(0),
+ ],
+ q(116) => [
+ q(0074),
+ q(0),
+ ],
+ q(120) => [
+ q(0129),
+ q(0),
+ ],
+ q(123) => [
+ q(0109),
+ q(0),
+ ],
+ q(124) => [
+ q(0002),
+ q(0),
+ ],
+ q(125) => [
+ q(0045),
+ q(0),
+ ],
+ q(126) => [
+ q(0095),
+ q(0),
+ ],
+ q(130) => [
+ q(0103),
+ q(0),
+ ],
+ q(131) => [
+ q(0098),
+ q(0),
+ ],
+ q(132) => [
+ q(0099),
+ q(0),
+ ],
+ q(133) => [
+ q(0100),
+ q(0),
+ ],
+ q(134) => [
+ q(0004),
+ q(0),
+ ],
+ q(135) => [
+ q(0118),
+ q(0),
+ ],
+ q(136) => [
+ q(0121),
+ q(0),
+ ],
+ q(137) => [
+ q(0120),
+ q(0),
+ ],
+ q(138) => [
+ q(0119),
+ q(0),
+ ],
+ q(139) => [
+ q(0076),
+ q(0),
+ ],
+ q(140) => [
+ q(0075),
+ q(0),
+ ],
+ q(145) => [
+ q(0083),
+ q(0),
+ ],
+ q(159) => [
+ q(0087),
+ q(0),
+ ],
+ q(160) => [
+ q(0001),
+ q(0),
+ ],
+ q(165) => [
+ q(0089),
+ q(0),
+ ],
+ q(170) => [
+ q(0131),
+ q(0),
+ ],
+ q(175) => [
+ q(0092),
+ q(0),
+ ],
+ q(176) => [
+ q(0049),
+ q(0),
+ ],
+ q(200) => [
+ q(0037),
+ q(0),
+ ],
+ q(201) => [
+ q(0018),
+ q(0),
+ ],
+ q(202) => [
+ q(0073),
+ q(0),
+ ],
+ q(204) => [
+ q(0022),
+ q(0),
+ ],
+ q(206) => [
+ q(0035),
+ q(0),
+ ],
+ q(210) => [
+ q(0051),
+ q(0),
+ ],
+ q(211) => [
+ q(0108),
+ q(0),
+ ],
+ q(212) => [
+ q(0090),
+ q(0),
+ ],
+ q(215) => [
+ q(0066),
+ q(0),
+ ],
+ q(216) => [
+ q(0065),
+ q(0),
+ ],
+ q(217) => [
+ q(0064),
+ q(0),
+ ],
+ q(218) => [
+ q(0082),
+ q(0),
+ ],
+ q(220) => [
+ q(0024),
+ q(0),
+ ],
+ q(221) => [
+ q(0025),
+ q(0),
+ ],
+ q(225) => [
+ q(0034),
+ q(0),
+ ],
+ q(227) => [
+ q(0096),
+ q(0),
+ ],
+ q(230) => [
+ q(0003),
+ q(0),
+ ],
+ q(240) => [
+ q(0032),
+ q(0),
+ ],
+ q(241) => [
+ q(0033),
+ q(0),
+ ],
+ q(250) => [
+ q(0027),
+ q(0),
+ ],
+ q(259) => [
+ q(0007),
+ q(0),
+ ],
+ q(260) => [
+ q(0094),
+ q(0),
+ ],
+ q(261) => [
+ q(0091),
+ q(0),
+ ],
+ q(262) => [
+ q(0137),
+ q(0),
+ ],
+ q(280) => [
+ q(0136),
+ q(0),
+ ],
+ q(281) => [
+ q(0114),
+ q(0),
+ ],
+ q(282) => [
+ q(0102),
+ q(0),
+ ],
+ q(285) => [
+ q(0011),
+ q(0),
+ ],
+ q(286) => [
+ q(0040),
+ q(0),
+ ],
+ q(287) => [
+ q(0059),
+ q(0),
+ ],
+ q(290) => [
+ q(0128),
+ q(0),
+ ],
+ q(291) => [
+ q(0021),
+ q(0),
+ ],
+ q(292) => [
+ q(0110),
+ q(0),
+ ],
+ q(300) => [
+ q(0012),
+ q(0),
+ ],
+ q(305) => [
+ q(0056),
+ q(0),
+ ],
+ q(310) => [
+ q(0039),
+ q(0),
+ ],
+ q(315) => [
+ q(0026),
+ q(0),
+ ],
+ q(316) => [
+ q(0117),
+ q(0),
+ ],
+ q(317) => [
+ q(0061),
+ q(0),
+ ],
+ q(320) => [
+ q(0038),
+ q(0),
+ ],
+ q(325) => [
+ q(0009),
+ q(0),
+ ],
+ q(327) => [
+ q(0093),
+ q(0),
+ ],
+ q(330) => [
+ q(0133),
+ q(0),
+ ],
+ q(331) => [
+ q(0097),
+ q(0),
+ ],
+ q(335) => [
+ q(0067),
+ q(0),
+ ],
+ q(336) => [
+ q(0068),
+ q(0),
+ ],
+ q(337) => [
+ q(0084),
+ q(0),
+ ],
+ q(340) => [
+ q(0127),
+ q(0),
+ ],
+ q(343) => [
+ q(0036),
+ q(0),
+ ],
+ q(344) => [
+ q(0112),
+ q(0),
+ ],
+ q(345) => [
+ q(0058),
+ q(0),
+ ],
+ q(346) => [
+ q(0125),
+ q(0),
+ ],
+ q(347) => [
+ q(0081),
+ q(0),
+ ],
+ q(348) => [
+ q(0115),
+ q(0),
+ ],
+ q(349) => [
+ q(0016),
+ q(0),
+ ],
+ q(350) => [
+ q(0085),
+ q(0),
+ ],
+ q(351) => [
+ q(0062),
+ q(0),
+ ],
+ q(352) => [
+ q(0132),
+ q(0),
+ ],
+ q(353) => [
+ q(0123),
+ q(0),
+ ],
+ q(354) => [
+ q(0124),
+ q(0),
+ ],
+ q(355) => [
+ q(0057),
+ q(0),
+ ],
+ q(356) => [
+ q(0063),
+ q(0),
+ ],
+ q(357) => [
+ q(0054),
+ q(0),
+ ],
+ q(358) => [
+ q(0019),
+ q(0),
+ ],
+ q(359) => [
+ q(0126),
+ q(0),
+ ],
+ q(360) => [
+ q(0005),
+ q(0),
+ ],
+ q(361) => [
+ q(0052),
+ q(0),
+ ],
+ q(362) => [
+ q(0116),
+ q(0),
+ ],
+ q(363) => [
+ q(0106),
+ q(0),
+ ],
+ q(365) => [
+ q(0008),
+ q(0),
+ ],
+ q(367) => [
+ q(0014),
+ q(0),
+ ],
+ q(370) => [
+ q(0130),
+ q(0),
+ ],
+ q(371) => [
+ q(0042),
+ q(0),
+ ],
+ q(372) => [
+ q(0015),
+ q(0),
+ ],
+ q(373) => [
+ q(0122),
+ q(0),
+ ],
+ q(399) => [
+ q(0071),
+ q(0),
+ ],
+ q(400) => [
+ q(0069),
+ q(0),
+ ],
+ q(401) => [
+ q(0070),
+ q(0),
+ ],
+ q(403) => [
+ q(0023),
+ q(0),
+ ],
+ q(410) => [
+ q(0046),
+ q(0),
+ ],
+ q(411) => [
+ q(0055),
+ q(0),
+ ],
+ q(412) => [
+ q(0048),
+ q(0),
+ ],
+ q(413) => [
+ q(0053),
+ q(0),
+ ],
+ q(420) => [
+ q(0088),
+ q(0),
+ ],
+ q(430) => [
+ q(0031),
+ q(0),
+ ],
+ q(435) => [
+ q(0006),
+ q(0),
+ ],
+ q(436) => [
+ q(0060),
+ q(0),
+ ],
+ q(437) => [
+ q(0072),
+ q(0),
+ ],
+ q(438) => [
+ q(0078),
+ q(0),
+ ],
+ q(440) => [
+ q(0017),
+ q(0),
+ ],
+ q(445) => [
+ q(0020),
+ q(0),
+ ],
+ q(450) => [
+ q(0047),
+ q(0),
+ ],
+ q(460) => [
+ q(0140),
+ q(0),
+ ],
+ q(470) => [
+ q(0135),
+ q(0),
+ ],
+ q(500) => [
+ q(0041),
+ q(0),
+ ],
+ q(501) => [
+ q(0043),
+ q(0),
+ ],
+ q(502) => [
+ q(0044),
+ q(0),
+ ],
+ q(550) => [
+ q(0010),
+ q(0),
+ ],
+ q(570) => [
+ q(0013),
+ q(0),
+ ],
+ q(610) => [
+ q(0050),
+ q(0),
+ ],
+ q(620) => [
+ q(0107),
+ q(0),
+ ],
+ q(900) => [
+ q(0104),
+ q(0),
+ ],
+ q(949) => [
+ q(0105),
+ q(0),
+ ],
+ q(994) => [
+ q(0141),
+ q(0),
+ ],
+ q(995) => [
+ q(0142),
+ q(0),
+ ],
+ q(996) => [
+ q(0143),
+ q(0),
+ ],
+ },
+};
+
+$Locale::Codes::Data{'script'}{'id2code'} = {
+ q(alpha) => {
+ q(0001) => q(Arab),
+ q(0002) => q(Armi),
+ q(0003) => q(Armn),
+ q(0004) => q(Avst),
+ q(0005) => q(Bali),
+ q(0006) => q(Bamu),
+ q(0007) => q(Bass),
+ q(0008) => q(Batk),
+ q(0009) => q(Beng),
+ q(0010) => q(Blis),
+ q(0011) => q(Bopo),
+ q(0012) => q(Brah),
+ q(0013) => q(Brai),
+ q(0014) => q(Bugi),
+ q(0015) => q(Buhd),
+ q(0016) => q(Cakm),
+ q(0017) => q(Cans),
+ q(0018) => q(Cari),
+ q(0019) => q(Cham),
+ q(0020) => q(Cher),
+ q(0021) => q(Cirt),
+ q(0022) => q(Copt),
+ q(0023) => q(Cprt),
+ q(0024) => q(Cyrl),
+ q(0025) => q(Cyrs),
+ q(0026) => q(Deva),
+ q(0027) => q(Dsrt),
+ q(0028) => q(Egyd),
+ q(0029) => q(Egyh),
+ q(0030) => q(Egyp),
+ q(0031) => q(Ethi),
+ q(0032) => q(Geor),
+ q(0033) => q(Geok),
+ q(0034) => q(Glag),
+ q(0035) => q(Goth),
+ q(0036) => q(Gran),
+ q(0037) => q(Grek),
+ q(0038) => q(Gujr),
+ q(0039) => q(Guru),
+ q(0040) => q(Hang),
+ q(0041) => q(Hani),
+ q(0042) => q(Hano),
+ q(0043) => q(Hans),
+ q(0044) => q(Hant),
+ q(0045) => q(Hebr),
+ q(0046) => q(Hira),
+ q(0047) => q(Hmng),
+ q(0048) => q(Hrkt),
+ q(0049) => q(Hung),
+ q(0050) => q(Inds),
+ q(0051) => q(Ital),
+ q(0052) => q(Java),
+ q(0053) => q(Jpan),
+ q(0054) => q(Kali),
+ q(0055) => q(Kana),
+ q(0056) => q(Khar),
+ q(0057) => q(Khmr),
+ q(0058) => q(Knda),
+ q(0059) => q(Kore),
+ q(0060) => q(Kpel),
+ q(0061) => q(Kthi),
+ q(0062) => q(Lana),
+ q(0063) => q(Laoo),
+ q(0064) => q(Latf),
+ q(0065) => q(Latg),
+ q(0066) => q(Latn),
+ q(0067) => q(Lepc),
+ q(0068) => q(Limb),
+ q(0069) => q(Lina),
+ q(0070) => q(Linb),
+ q(0071) => q(Lisu),
+ q(0072) => q(Loma),
+ q(0073) => q(Lyci),
+ q(0074) => q(Lydi),
+ q(0075) => q(Mand),
+ q(0076) => q(Mani),
+ q(0077) => q(Maya),
+ q(0078) => q(Mend),
+ q(0079) => q(Merc),
+ q(0080) => q(Mero),
+ q(0081) => q(Mlym),
+ q(0082) => q(Moon),
+ q(0083) => q(Mong),
+ q(0084) => q(Mtei),
+ q(0085) => q(Mymr),
+ q(0086) => q(Narb),
+ q(0087) => q(Nbat),
+ q(0088) => q(Nkgb),
+ q(0089) => q(Nkoo),
+ q(0090) => q(Ogam),
+ q(0091) => q(Olck),
+ q(0092) => q(Orkh),
+ q(0093) => q(Orya),
+ q(0094) => q(Osma),
+ q(0095) => q(Palm),
+ q(0096) => q(Perm),
+ q(0097) => q(Phag),
+ q(0098) => q(Phli),
+ q(0099) => q(Phlp),
+ q(0100) => q(Phlv),
+ q(0101) => q(Phnx),
+ q(0102) => q(Plrd),
+ q(0103) => q(Prti),
+ q(0104) => q(Qaaa),
+ q(0105) => q(Qabx),
+ q(0106) => q(Rjng),
+ q(0107) => q(Roro),
+ q(0108) => q(Runr),
+ q(0109) => q(Samr),
+ q(0110) => q(Sara),
+ q(0111) => q(Sarb),
+ q(0112) => q(Saur),
+ q(0113) => q(Sgnw),
+ q(0114) => q(Shaw),
+ q(0115) => q(Sinh),
+ q(0116) => q(Sund),
+ q(0117) => q(Sylo),
+ q(0118) => q(Syrc),
+ q(0119) => q(Syre),
+ q(0120) => q(Syrj),
+ q(0121) => q(Syrn),
+ q(0122) => q(Tagb),
+ q(0123) => q(Tale),
+ q(0124) => q(Talu),
+ q(0125) => q(Taml),
+ q(0126) => q(Tavt),
+ q(0127) => q(Telu),
+ q(0128) => q(Teng),
+ q(0129) => q(Tfng),
+ q(0130) => q(Tglg),
+ q(0131) => q(Thaa),
+ q(0132) => q(Thai),
+ q(0133) => q(Tibt),
+ q(0134) => q(Ugar),
+ q(0135) => q(Vaii),
+ q(0136) => q(Visp),
+ q(0137) => q(Wara),
+ q(0138) => q(Xpeo),
+ q(0139) => q(Xsux),
+ q(0140) => q(Yiii),
+ q(0141) => q(Zinh),
+ q(0142) => q(Zmth),
+ q(0143) => q(Zsym),
+ },
+ q(num) => {
+ q(0001) => q(160),
+ q(0002) => q(124),
+ q(0003) => q(230),
+ q(0004) => q(134),
+ q(0005) => q(360),
+ q(0006) => q(435),
+ q(0007) => q(259),
+ q(0008) => q(365),
+ q(0009) => q(325),
+ q(0010) => q(550),
+ q(0011) => q(285),
+ q(0012) => q(300),
+ q(0013) => q(570),
+ q(0014) => q(367),
+ q(0015) => q(372),
+ q(0016) => q(349),
+ q(0017) => q(440),
+ q(0018) => q(201),
+ q(0019) => q(358),
+ q(0020) => q(445),
+ q(0021) => q(291),
+ q(0022) => q(204),
+ q(0023) => q(403),
+ q(0024) => q(220),
+ q(0025) => q(221),
+ q(0026) => q(315),
+ q(0027) => q(250),
+ q(0028) => q(070),
+ q(0029) => q(060),
+ q(0030) => q(050),
+ q(0031) => q(430),
+ q(0032) => q(240),
+ q(0033) => q(241),
+ q(0034) => q(225),
+ q(0035) => q(206),
+ q(0036) => q(343),
+ q(0037) => q(200),
+ q(0038) => q(320),
+ q(0039) => q(310),
+ q(0040) => q(286),
+ q(0041) => q(500),
+ q(0042) => q(371),
+ q(0043) => q(501),
+ q(0044) => q(502),
+ q(0045) => q(125),
+ q(0046) => q(410),
+ q(0047) => q(450),
+ q(0048) => q(412),
+ q(0049) => q(176),
+ q(0050) => q(610),
+ q(0051) => q(210),
+ q(0052) => q(361),
+ q(0053) => q(413),
+ q(0054) => q(357),
+ q(0055) => q(411),
+ q(0056) => q(305),
+ q(0057) => q(355),
+ q(0058) => q(345),
+ q(0059) => q(287),
+ q(0060) => q(436),
+ q(0061) => q(317),
+ q(0062) => q(351),
+ q(0063) => q(356),
+ q(0064) => q(217),
+ q(0065) => q(216),
+ q(0066) => q(215),
+ q(0067) => q(335),
+ q(0068) => q(336),
+ q(0069) => q(400),
+ q(0070) => q(401),
+ q(0071) => q(399),
+ q(0072) => q(437),
+ q(0073) => q(202),
+ q(0074) => q(116),
+ q(0075) => q(140),
+ q(0076) => q(139),
+ q(0077) => q(090),
+ q(0078) => q(438),
+ q(0079) => q(101),
+ q(0080) => q(100),
+ q(0081) => q(347),
+ q(0082) => q(218),
+ q(0083) => q(145),
+ q(0084) => q(337),
+ q(0085) => q(350),
+ q(0086) => q(106),
+ q(0087) => q(159),
+ q(0088) => q(420),
+ q(0089) => q(165),
+ q(0090) => q(212),
+ q(0091) => q(261),
+ q(0092) => q(175),
+ q(0093) => q(327),
+ q(0094) => q(260),
+ q(0095) => q(126),
+ q(0096) => q(227),
+ q(0097) => q(331),
+ q(0098) => q(131),
+ q(0099) => q(132),
+ q(0100) => q(133),
+ q(0101) => q(115),
+ q(0102) => q(282),
+ q(0103) => q(130),
+ q(0104) => q(900),
+ q(0105) => q(949),
+ q(0106) => q(363),
+ q(0107) => q(620),
+ q(0108) => q(211),
+ q(0109) => q(123),
+ q(0110) => q(292),
+ q(0111) => q(105),
+ q(0112) => q(344),
+ q(0113) => q(095),
+ q(0114) => q(281),
+ q(0115) => q(348),
+ q(0116) => q(362),
+ q(0117) => q(316),
+ q(0118) => q(135),
+ q(0119) => q(138),
+ q(0120) => q(137),
+ q(0121) => q(136),
+ q(0122) => q(373),
+ q(0123) => q(353),
+ q(0124) => q(354),
+ q(0125) => q(346),
+ q(0126) => q(359),
+ q(0127) => q(340),
+ q(0128) => q(290),
+ q(0129) => q(120),
+ q(0130) => q(370),
+ q(0131) => q(170),
+ q(0132) => q(352),
+ q(0133) => q(330),
+ q(0134) => q(040),
+ q(0135) => q(470),
+ q(0136) => q(280),
+ q(0137) => q(262),
+ q(0138) => q(030),
+ q(0139) => q(020),
+ q(0140) => q(460),
+ q(0141) => q(994),
+ q(0142) => q(995),
+ q(0143) => q(996),
+ },
+};
+
+1;
-#
-# Locale::Constants - defined constants for identifying codesets
-#
-# $Id: Constants.pm,v 2.7 2004/06/10 21:19:34 neilb Exp $
-#
-
package Locale::Constants;
+# Copyright (C) 2001 Canon Research Centre Europe (CRE).
+# Copyright (C) 2002-2009 Neil Bowers
+# Copyright (c) 2010-2010 Sullivan Beck
+# This program is free software; you can redistribute it and/or modify it
+# under the same terms as Perl itself.
+
use strict;
+use warnings;
require Exporter;
#-----------------------------------------------------------------------
# Public Global Variables
#-----------------------------------------------------------------------
+
use vars qw($VERSION @ISA @EXPORT);
-$VERSION = sprintf("%d.%02d", q$Revision: 2.7 $ =~ /(\d+)\.(\d+)/);
-@ISA = qw(Exporter);
-@EXPORT = qw(LOCALE_CODE_ALPHA_2 LOCALE_CODE_ALPHA_3 LOCALE_CODE_NUMERIC
- LOCALE_CODE_DEFAULT);
+
+$VERSION='3.12';
+@ISA = qw(Exporter);
+@EXPORT = qw(LOCALE_CODE_ALPHA_2
+ LOCALE_CODE_ALPHA_3
+ LOCALE_CODE_NUMERIC
+ LOCALE_CODE_FIPS
+ LOCALE_CODE_DOM
+ LOCALE_CODE_DEFAULT
+
+ LOCALE_LANG_ALPHA_2
+ LOCALE_LANG_ALPHA_3
+ LOCALE_LANG_TERM
+ LOCALE_LANG_DEFAULT
+
+ LOCALE_CURR_ALPHA
+ LOCALE_CURR_NUMERIC
+ LOCALE_CURR_DEFAULT
+
+ LOCALE_SCRIPT_ALPHA
+ LOCALE_SCRIPT_NUMERIC
+ LOCALE_SCRIPT_DEFAULT
+ );
#-----------------------------------------------------------------------
# Constants
#-----------------------------------------------------------------------
-use constant LOCALE_CODE_ALPHA_2 => 1;
-use constant LOCALE_CODE_ALPHA_3 => 2;
-use constant LOCALE_CODE_NUMERIC => 3;
-use constant LOCALE_CODE_DEFAULT => LOCALE_CODE_ALPHA_2;
+use constant LOCALE_CODE_ALPHA_2 => 1;
+use constant LOCALE_CODE_ALPHA_3 => 2;
+use constant LOCALE_CODE_NUMERIC => 3;
+use constant LOCALE_CODE_FIPS => 4;
+use constant LOCALE_CODE_DOM => 5;
-1;
+use constant LOCALE_CODE_DEFAULT => LOCALE_CODE_ALPHA_2;
+use constant LOCALE_LANG_ALPHA_2 => 1;
+use constant LOCALE_LANG_ALPHA_3 => 2;
+use constant LOCALE_LANG_TERM => 3;
+
+use constant LOCALE_LANG_DEFAULT => LOCALE_LANG_ALPHA_2;
+
+use constant LOCALE_CURR_ALPHA => 1;
+use constant LOCALE_CURR_NUMERIC => 2;
+
+use constant LOCALE_CURR_DEFAULT => LOCALE_CURR_ALPHA;
+
+use constant LOCALE_SCRIPT_ALPHA => 1;
+use constant LOCALE_SCRIPT_NUMERIC => 2;
+
+use constant LOCALE_SCRIPT_DEFAULT => LOCALE_SCRIPT_ALPHA;
+
+1;
+# Local Variables:
+# mode: cperl
+# indent-tabs-mode: nil
+# cperl-indent-level: 3
+# cperl-continued-statement-offset: 2
+# cperl-continued-brace-offset: 0
+# cperl-brace-offset: 0
+# cperl-brace-imaginary-offset: 0
+# cperl-label-offset: -2
+# End:
+=pod
=head1 NAME
Locale::Constants - constants for Locale codes
-=head1 SYNOPSIS
-
- use Locale::Constants;
-
- $codeset = LOCALE_CODE_ALPHA_2;
-
=head1 DESCRIPTION
-B<Locale::Constants> defines symbols which are used in
-the four modules from the Locale-Codes distribution:
-
- Locale::Language
- Locale::Country
- Locale::Currency
- Locale::Script
-
-B<Note:> at the moment only Locale::Country and Locale::Script
-support more than one code set.
+B<Locale::Constants> defines symbols which are used in the other
+modules from the Locale-Codes distribution.
-The symbols defined are used to specify which codes you
-want to be used:
+You shouldn't have to C<use> this module directly yourself - it is
+used by the other Locale modules, which in turn export the symbols.
- LOCALE_CODE_ALPHA_2
- LOCALE_CODE_ALPHA_3
- LOCALE_CODE_NUMERIC
-
-You shouldn't have to C<use> this module directly yourself -
-it is used by the three Locale modules, which in turn export
-the symbols.
+The constants are documented in each of the Locale modules.
=head1 KNOWN BUGS AND LIMITATIONS
-None at the moment.
+None known.
=head1 SEE ALSO
-=over 4
-
-=item Locale::Language
-
-Codes for identification of languages.
-
-=item Locale::Country
-
-Codes for identification of countries.
-
-=item Locale::Script
-
-Codes for identification of scripts.
-
-=item Locale::Currency
-
-Codes for identification of currencies and funds.
-
-=back
+Locale::Codes
=head1 AUTHOR
-Neil Bowers E<lt>neil@bowers.comE<gt>
+See Locale::Codes for full author history.
-=head1 COPYRIGHT
+Currently maintained by Sullivan Beck (sbeck@cpan.org).
-Copyright (C) 2002-2004, Neil Bowers.
+=head1 COPYRIGHT
-Copyright (C) 2001, Canon Research Centre Europe (CRE).
+ Copyright (c) 1997-2001 Canon Research Centre Europe (CRE).
+ Copyright (c) 2001-2010 Neil Bowers
+ Copyright (c) 2010-2010 Sullivan Beck
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
-#
-# Locale::Country - ISO codes for country identification (ISO 3166)
-#
-# $Id: Country.pm,v 2.7 2004/06/10 21:19:34 neilb Exp $
-#
-
package Locale::Country;
+# Copyright (C) 2001 Canon Research Centre Europe (CRE).
+# Copyright (C) 2002-2009 Neil Bowers
+# Copyright (c) 2010-2010 Sullivan Beck
+# This program is free software; you can redistribute it and/or modify it
+# under the same terms as Perl itself.
+
use strict;
+use warnings;
require 5.002;
require Exporter;
use Carp;
+use Locale::Codes;
use Locale::Constants;
+use Locale::Codes::Country;
+#=======================================================================
+# Public Global Variables
+#=======================================================================
-#-----------------------------------------------------------------------
-# Public Global Variables
-#-----------------------------------------------------------------------
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-$VERSION = sprintf("%d.%02d", q$Revision: 2.7 $ =~ /(\d+)\.(\d+)/);
+
+$VERSION='3.12';
@ISA = qw(Exporter);
-@EXPORT = qw(code2country country2code
- all_country_codes all_country_names
- country_code2code
- LOCALE_CODE_ALPHA_2 LOCALE_CODE_ALPHA_3 LOCALE_CODE_NUMERIC);
+@EXPORT = qw(code2country
+ country2code
+ all_country_codes
+ all_country_names
+ country_code2code
+ LOCALE_CODE_ALPHA_2
+ LOCALE_CODE_ALPHA_3
+ LOCALE_CODE_NUMERIC
+ LOCALE_CODE_FIPS
+ LOCALE_CODE_DOM
+ );
+
+sub _code {
+ my($code,$codeset) = @_;
+ $code = "" if (! $code);
+
+ $codeset = LOCALE_CODE_DEFAULT if (! defined($codeset) || $codeset eq "");
+
+ if ($codeset =~ /^\d+$/) {
+ if ($codeset == LOCALE_CODE_ALPHA_2) {
+ $codeset = "alpha2";
+ } elsif ($codeset == LOCALE_CODE_ALPHA_3) {
+ $codeset = "alpha3";
+ } elsif ($codeset == LOCALE_CODE_NUMERIC) {
+ $codeset = "num";
+ } elsif ($codeset == LOCALE_CODE_FIPS) {
+ $codeset = "fips";
+ } elsif ($codeset == LOCALE_CODE_DOM) {
+ $codeset = "dom";
+ } else {
+ return (1);
+ }
+ }
+
+ if ($codeset eq "alpha2" ||
+ $codeset eq "alpha3") {
+ $code = lc($code);
+ } elsif ($codeset eq "num") {
+ if (defined($code) && $code ne "") {
+ return (1) unless ($code =~ /^\d+$/);
+ $code = sprintf("%.3d", $code);
+ }
+ } elsif ($codeset eq "fips" ||
+ $codeset eq "dom") {
+ $code = uc($code);
+ } else {
+ return (1);
+ }
+
+ return (0,$code,$codeset);
+}
-#-----------------------------------------------------------------------
-# Private Global Variables
-#-----------------------------------------------------------------------
-my $CODES = [];
-my $COUNTRIES = [];
+#=======================================================================
+#
+# code2country ( CODE [,CODESET] )
+#
+#=======================================================================
+
+sub code2country {
+ my($err,$code,$codeset) = _code(@_);
+ return undef if ($err ||
+ ! defined $code);
+ return Locale::Codes::_code2name("country",$code,$codeset);
+}
#=======================================================================
#
-# code2country ( CODE [, CODESET ] )
+# country2code ( COUNTRY [,CODESET] )
#
#=======================================================================
-sub code2country
-{
- my $code = shift;
- my $codeset = @_ > 0 ? shift : LOCALE_CODE_DEFAULT;
-
-
- return undef unless defined $code;
-
- #-------------------------------------------------------------------
- # Make sure the code is in the right form before we use it
- # to look up the corresponding country.
- # We have to sprintf because the codes are given as 3-digits,
- # with leading 0's. Eg 052 for Barbados.
- #-------------------------------------------------------------------
- if ($codeset == LOCALE_CODE_NUMERIC)
- {
- return undef if ($code =~ /\D/);
- $code = sprintf("%.3d", $code);
- }
- else
- {
- $code = lc($code);
- }
-
- if (exists $CODES->[$codeset]->{$code})
- {
- return $CODES->[$codeset]->{$code};
- }
- else
- {
- #---------------------------------------------------------------
- # no such country code!
- #---------------------------------------------------------------
- return undef;
- }
-}
+sub country2code {
+ my($country,$codeset) = @_;
+ my($err,$tmp);
+ ($err,$tmp,$codeset) = _code("",$codeset);
+ return undef if ($err ||
+ ! defined $country);
+
+ return Locale::Codes::_name2code("country",$country,$codeset);
+}
#=======================================================================
#
-# country2code ( NAME [, CODESET ] )
+# country_code2code ( CODE,CODESET_IN,CODESET_OUT )
#
#=======================================================================
-sub country2code
-{
- my $country = shift;
- my $codeset = @_ > 0 ? shift : LOCALE_CODE_DEFAULT;
-
-
- return undef unless defined $country;
- $country = lc($country);
- if (exists $COUNTRIES->[$codeset]->{$country})
- {
- return $COUNTRIES->[$codeset]->{$country};
- }
- else
- {
- #---------------------------------------------------------------
- # no such country!
- #---------------------------------------------------------------
- return undef;
- }
-}
+sub country_code2code {
+ (@_ == 3) or croak "country_code2code() takes 3 arguments!";
+ my($code,$inset,$outset) = @_;
+ my($err,$tmp);
+ ($err,$code,$inset) = _code($code,$inset);
+ return undef if ($err);
+ ($err,$tmp,$outset) = _code("",$outset);
+ return undef if ($err);
+
+ return Locale::Codes::_code2code("country",$code,$inset,$outset);
+}
#=======================================================================
#
-# country_code2code ( NAME [, CODESET ] )
+# all_country_codes ( [CODESET] )
#
#=======================================================================
-sub country_code2code
-{
- (@_ == 3) or croak "country_code2code() takes 3 arguments!";
-
- my $code = shift;
- my $inset = shift;
- my $outset = shift;
- my $outcode;
- my $country;
-
-
- return undef if $inset == $outset;
- $country = code2country($code, $inset);
- return undef if not defined $country;
- $outcode = country2code($country, $outset);
- return $outcode;
+
+sub all_country_codes {
+ my($codeset) = @_;
+ my($err,$tmp);
+ ($err,$tmp,$codeset) = _code("",$codeset);
+ return undef if ($err);
+
+ return Locale::Codes::_all_codes("country",$codeset);
}
#=======================================================================
#
-# all_country_codes ( [ CODESET ] )
+# all_country_names ( [CODESET] )
#
#=======================================================================
-sub all_country_codes
-{
- my $codeset = @_ > 0 ? shift : LOCALE_CODE_DEFAULT;
- return keys %{ $CODES->[$codeset] };
-}
+sub all_country_names {
+ my($codeset) = @_;
+ my($err,$tmp);
+ ($err,$tmp,$codeset) = _code("",$codeset);
+ return undef if ($err);
+ return Locale::Codes::_all_names("country",$codeset);
+}
#=======================================================================
#
-# all_country_names ( [ CODESET ] )
+# rename_country ( CODE,NAME [,CODESET] )
#
#=======================================================================
-sub all_country_names
-{
- my $codeset = @_ > 0 ? shift : LOCALE_CODE_DEFAULT;
- return values %{ $CODES->[$codeset] };
-}
+sub rename_country {
+ my($code,$new_name,@args) = @_;
+ my $nowarn = 0;
+ $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
+ my $codeset = shift(@args);
+ my $err;
+ ($err,$code,$codeset) = _code($code,$codeset);
+ return Locale::Codes::_rename("country",$code,$new_name,$codeset,$nowarn);
+}
#=======================================================================
#
-# alias_code ( ALIAS => CODE [ , CODESET ] )
+# add_country ( CODE,NAME [,CODESET] )
#
-# Add an alias for an existing code. If the CODESET isn't specified,
-# then we use the default (currently the alpha-2 codeset).
+#=======================================================================
+
+sub add_country {
+ my($code,$name,@args) = @_;
+ my $nowarn = 0;
+ $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
+ my $codeset = shift(@args);
+ my $err;
+ ($err,$code,$codeset) = _code($code,$codeset);
+
+ return Locale::Codes::_add_code("country",$code,$name,$codeset,$nowarn);
+}
+
+#=======================================================================
#
-# Locale::Country::alias_code('uk' => 'gb');
+# delete_country ( CODE [,CODESET] )
#
#=======================================================================
-sub alias_code
-{
- my $alias = shift;
- my $real = shift;
- my $codeset = @_ > 0 ? shift : LOCALE_CODE_DEFAULT;
- my $country;
+sub delete_country {
+ my($code,@args) = @_;
+ my $nowarn = 0;
+ $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
+ my $codeset = shift(@args);
+ my $err;
+ ($err,$code,$codeset) = _code($code,$codeset);
+ return Locale::Codes::_delete_code("country",$code,$codeset,$nowarn);
+}
- if (not exists $CODES->[$codeset]->{$real})
- {
- carp "attempt to alias \"$alias\" to unknown country code \"$real\"\n";
- return undef;
- }
- $country = $CODES->[$codeset]->{$real};
- $CODES->[$codeset]->{$alias} = $country;
- $COUNTRIES->[$codeset]->{"\L$country"} = $alias;
+#=======================================================================
+#
+# add_country_alias ( NAME,NEW_NAME )
+#
+#=======================================================================
- return $alias;
+sub add_country_alias {
+ my($name,$new_name,$nowarn) = @_;
+ $nowarn = (defined($nowarn) && $nowarn eq "nowarn" ? 1 : 0);
+
+ return Locale::Codes::_add_alias("country",$name,$new_name,$nowarn);
}
-# old name of function for backwards compatibility
-*_alias_code = *alias_code;
+#=======================================================================
+#
+# delete_country_alias ( NAME )
+#
+#=======================================================================
+
+sub delete_country_alias {
+ my($name,$nowarn) = @_;
+ $nowarn = (defined($nowarn) && $nowarn eq "nowarn" ? 1 : 0);
+ return Locale::Codes::_delete_alias("country",$name,$nowarn);
+}
#=======================================================================
#
-# rename_country
-#
-# change the official name for a country, eg:
-# gb => 'Great Britain'
-# rather than the standard 'United Kingdom'. The original is retained
-# as an alias, but the new name will be returned if you lookup the
-# name from code.
+# rename_country_code ( CODE,NEW_CODE [,CODESET] )
#
#=======================================================================
-sub rename_country
-{
- my $code = shift;
- my $new_name = shift;
- my $codeset = @_ > 0 ? shift : _code2codeset($code);
- my $country;
- my $c;
-
-
- if (not defined $codeset)
- {
- carp "rename_country(): unknown country code \"$code\"\n";
- return 0;
- }
-
- $country = $CODES->[$codeset]->{$code};
-
- foreach my $cset (LOCALE_CODE_ALPHA_2,
- LOCALE_CODE_ALPHA_3,
- LOCALE_CODE_NUMERIC)
- {
- if ($cset == $codeset)
- {
- $c = $code;
- }
- else
- {
- $c = country_code2code($code, $codeset, $cset);
- }
-
- $CODES->[$cset]->{$c} = $new_name;
- $COUNTRIES->[$cset]->{"\L$new_name"} = $c;
- }
-
- return 1;
-}
+sub rename_country_code {
+ my($code,$new_code,@args) = @_;
+ my $nowarn = 0;
+ $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
+ my $codeset = shift(@args);
+ my $err;
+ ($err,$code,$codeset) = _code($code,$codeset);
+ ($err,$new_code,$codeset) = _code($new_code,$codeset) if (! $err);
+
+ return Locale::Codes::_rename_code("country",$code,$new_code,$codeset,$nowarn);
+}
#=======================================================================
#
-# _code2codeset
-#
-# given a country code in an unknown codeset, return the codeset
-# it is from, or undef.
+# add_country_code_alias ( CODE,NEW_CODE [,CODESET] )
#
#=======================================================================
-sub _code2codeset
-{
- my $code = shift;
-
- foreach my $codeset (LOCALE_CODE_ALPHA_2, LOCALE_CODE_ALPHA_3,
- LOCALE_CODE_NUMERIC)
- {
- return $codeset if (exists $CODES->[$codeset]->{$code})
- }
+sub add_country_code_alias {
+ my($code,$new_code,@args) = @_;
+ my $nowarn = 0;
+ $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
+ my $codeset = shift(@args);
+ my $err;
+ ($err,$code,$codeset) = _code($code,$codeset);
+ ($err,$new_code,$codeset) = _code($new_code,$codeset) if (! $err);
- return undef;
+ return Locale::Codes::_add_code_alias("country",$code,$new_code,$codeset,$nowarn);
}
+#=======================================================================
+#
+# delete_country_code_alias ( CODE [,CODESET] )
+#
+#=======================================================================
+
+sub delete_country_code_alias {
+ my($code,@args) = @_;
+ my $nowarn = 0;
+ $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
+ my $codeset = shift(@args);
+ my $err;
+ ($err,$code,$codeset) = _code($code,$codeset);
+
+ return Locale::Codes::_delete_code_alias("country",$code,$codeset,$nowarn);
+}
#=======================================================================
#
-# initialisation code - stuff the DATA into the ALPHA2 hash
+# Old function for backward compatibility
#
#=======================================================================
-{
- my ($alpha2, $alpha3, $numeric);
- my ($country, @countries);
- local $_;
-
-
- while (<DATA>)
- {
- next unless /\S/;
- chop;
- ($alpha2, $alpha3, $numeric, @countries) = split(/:/, $_);
-
- $CODES->[LOCALE_CODE_ALPHA_2]->{$alpha2} = $countries[0];
- foreach $country (@countries)
- {
- $COUNTRIES->[LOCALE_CODE_ALPHA_2]->{"\L$country"} = $alpha2;
- }
-
- if ($alpha3)
- {
- $CODES->[LOCALE_CODE_ALPHA_3]->{$alpha3} = $countries[0];
- foreach $country (@countries)
- {
- $COUNTRIES->[LOCALE_CODE_ALPHA_3]->{"\L$country"} = $alpha3;
- }
- }
-
- if ($numeric)
- {
- $CODES->[LOCALE_CODE_NUMERIC]->{$numeric} = $countries[0];
- foreach $country (@countries)
- {
- $COUNTRIES->[LOCALE_CODE_NUMERIC]->{"\L$country"} = $numeric;
- }
- }
-
- }
-
- close(DATA);
+
+sub alias_code {
+ my($alias,$code,@args) = @_;
+ my $success = rename_country_code($code,$alias,@args);
+ return 0 if (! $success);
+ return $alias;
}
1;
-
-__DATA__
-ad:and:020:Andorra
-ae:are:784:United Arab Emirates
-af:afg:004:Afghanistan
-ag:atg:028:Antigua and Barbuda
-ai:aia:660:Anguilla
-al:alb:008:Albania
-am:arm:051:Armenia
-an:ant:530:Netherlands Antilles
-ao:ago:024:Angola
-aq:ata:010:Antarctica
-ar:arg:032:Argentina
-as:asm:016:American Samoa
-at:aut:040:Austria
-au:aus:036:Australia
-aw:abw:533:Aruba
-ax:ala:248:Aland Islands
-az:aze:031:Azerbaijan
-ba:bih:070:Bosnia and Herzegovina
-bb:brb:052:Barbados
-bd:bgd:050:Bangladesh
-be:bel:056:Belgium
-bf:bfa:854:Burkina Faso
-bg:bgr:100:Bulgaria
-bh:bhr:048:Bahrain
-bi:bdi:108:Burundi
-bj:ben:204:Benin
-bm:bmu:060:Bermuda
-bn:brn:096:Brunei Darussalam
-bo:bol:068:Bolivia
-br:bra:076:Brazil
-bs:bhs:044:Bahamas
-bt:btn:064:Bhutan
-bv:bvt:074:Bouvet Island
-bw:bwa:072:Botswana
-by:blr:112:Belarus
-bz:blz:084:Belize
-ca:can:124:Canada
-cc:cck:166:Cocos (Keeling) Islands
-cd:cod:180:Congo, The Democratic Republic of the:Zaire:Congo, Democratic Republic of the
-cf:caf:140:Central African Republic
-cg:cog:178:Congo:Congo, Republic of the
-ch:che:756:Switzerland
-ci:civ:384:Cote D'Ivoire
-ck:cok:184:Cook Islands
-cl:chl:152:Chile
-cm:cmr:120:Cameroon
-cn:chn:156:China
-co:col:170:Colombia
-cr:cri:188:Costa Rica
-cs:scg:891:Serbia and Montenegro:Yugoslavia
-cu:cub:192:Cuba
-cv:cpv:132:Cape Verde
-cx:cxr:162:Christmas Island
-cy:cyp:196:Cyprus
-cz:cze:203:Czech Republic
-de:deu:276:Germany
-dj:dji:262:Djibouti
-dk:dnk:208:Denmark
-dm:dma:212:Dominica
-do:dom:214:Dominican Republic
-dz:dza:012:Algeria
-ec:ecu:218:Ecuador
-ee:est:233:Estonia
-eg:egy:818:Egypt
-eh:esh:732:Western Sahara
-er:eri:232:Eritrea
-es:esp:724:Spain
-et:eth:231:Ethiopia
-fi:fin:246:Finland
-fj:fji:242:Fiji
-fk:flk:238:Falkland Islands (Malvinas):Falkland Islands (Islas Malvinas)
-fm:fsm:583:Micronesia, Federated States of
-fo:fro:234:Faroe Islands
-fr:fra:250:France
-fx:fxx:249:France, Metropolitan
-ga:gab:266:Gabon
-gb:gbr:826:United Kingdom:Great Britain
-gd:grd:308:Grenada
-ge:geo:268:Georgia
-gf:guf:254:French Guiana
-gh:gha:288:Ghana
-gi:gib:292:Gibraltar
-gl:grl:304:Greenland
-gm:gmb:270:Gambia
-gn:gin:324:Guinea
-gp:glp:312:Guadeloupe
-gq:gnq:226:Equatorial Guinea
-gr:grc:300:Greece
-gs:sgs:239:South Georgia and the South Sandwich Islands
-gt:gtm:320:Guatemala
-gu:gum:316:Guam
-gw:gnb:624:Guinea-Bissau
-gy:guy:328:Guyana
-hk:hkg:344:Hong Kong
-hm:hmd:334:Heard Island and McDonald Islands
-hn:hnd:340:Honduras
-hr:hrv:191:Croatia
-ht:hti:332:Haiti
-hu:hun:348:Hungary
-id:idn:360:Indonesia
-ie:irl:372:Ireland
-il:isr:376:Israel
-in:ind:356:India
-io:iot:086:British Indian Ocean Territory
-iq:irq:368:Iraq
-ir:irn:364:Iran, Islamic Republic of:Iran
-is:isl:352:Iceland
-it:ita:380:Italy
-jm:jam:388:Jamaica
-jo:jor:400:Jordan
-jp:jpn:392:Japan
-ke:ken:404:Kenya
-kg:kgz:417:Kyrgyzstan
-kh:khm:116:Cambodia
-ki:kir:296:Kiribati
-km:com:174:Comoros
-kn:kna:659:Saint Kitts and Nevis
-kp:prk:408:Korea, Democratic People's Republic of:Korea, North:North Korea
-kr:kor:410:Korea, Republic of:Korea, South:South Korea
-kw:kwt:414:Kuwait
-ky:cym:136:Cayman Islands
-kz:kaz:398:Kazakhstan:Kazakstan
-la:lao:418:Lao People's Democratic Republic
-lb:lbn:422:Lebanon
-lc:lca:662:Saint Lucia
-li:lie:438:Liechtenstein
-lk:lka:144:Sri Lanka
-lr:lbr:430:Liberia
-ls:lso:426:Lesotho
-lt:ltu:440:Lithuania
-lu:lux:442:Luxembourg
-lv:lva:428:Latvia
-ly:lby:434:Libyan Arab Jamahiriya:Libya
-ma:mar:504:Morocco
-mc:mco:492:Monaco
-md:mda:498:Moldova, Republic of:Moldova
-mg:mdg:450:Madagascar
-mh:mhl:584:Marshall Islands
-mk:mkd:807:Macedonia, the Former Yugoslav Republic of:Macedonia, Former Yugoslav Republic of:Macedonia
-ml:mli:466:Mali
-mm:mmr:104:Myanmar:Burma
-mn:mng:496:Mongolia
-mo:mac:446:Macao:Macau
-mp:mnp:580:Northern Mariana Islands
-mq:mtq:474:Martinique
-mr:mrt:478:Mauritania
-ms:msr:500:Montserrat
-mt:mlt:470:Malta
-mu:mus:480:Mauritius
-mv:mdv:462:Maldives
-mw:mwi:454:Malawi
-mx:mex:484:Mexico
-my:mys:458:Malaysia
-mz:moz:508:Mozambique
-na:nam:516:Namibia
-nc:ncl:540:New Caledonia
-ne:ner:562:Niger
-nf:nfk:574:Norfolk Island
-ng:nga:566:Nigeria
-ni:nic:558:Nicaragua
-nl:nld:528:Netherlands
-no:nor:578:Norway
-np:npl:524:Nepal
-nr:nru:520:Nauru
-nu:niu:570:Niue
-nz:nzl:554:New Zealand
-om:omn:512:Oman
-pa:pan:591:Panama
-pe:per:604:Peru
-pf:pyf:258:French Polynesia
-pg:png:598:Papua New Guinea
-ph:phl:608:Philippines
-pk:pak:586:Pakistan
-pl:pol:616:Poland
-pm:spm:666:Saint Pierre and Miquelon
-pn:pcn:612:Pitcairn:Pitcairn Island
-pr:pri:630:Puerto Rico
-ps:pse:275:Palestinian Territory, Occupied
-pt:prt:620:Portugal
-pw:plw:585:Palau
-py:pry:600:Paraguay
-qa:qat:634:Qatar
-re:reu:638:Reunion
-ro:rou:642:Romania
-ru:rus:643:Russian Federation:Russia
-rw:rwa:646:Rwanda
-sa:sau:682:Saudi Arabia
-sb:slb:090:Solomon Islands
-sc:syc:690:Seychelles
-sd:sdn:736:Sudan
-se:swe:752:Sweden
-sg:sgp:702:Singapore
-sh:shn:654:Saint Helena
-si:svn:705:Slovenia
-sj:sjm:744:Svalbard and Jan Mayen:Jan Mayen:Svalbard
-sk:svk:703:Slovakia
-sl:sle:694:Sierra Leone
-sm:smr:674:San Marino
-sn:sen:686:Senegal
-so:som:706:Somalia
-sr:sur:740:Suriname
-st:stp:678:Sao Tome and Principe
-sv:slv:222:El Salvador
-sy:syr:760:Syrian Arab Republic:Syria
-sz:swz:748:Swaziland
-tc:tca:796:Turks and Caicos Islands
-td:tcd:148:Chad
-tf:atf:260:French Southern Territories:French Southern and Antarctic Lands
-tg:tgo:768:Togo
-th:tha:764:Thailand
-tj:tjk:762:Tajikistan
-tk:tkl:772:Tokelau
-tm:tkm:795:Turkmenistan
-tn:tun:788:Tunisia
-to:ton:776:Tonga
-tl:tls:626:Timor-Leste:East Timor
-tr:tur:792:Turkey
-tt:tto:780:Trinidad and Tobago
-tv:tuv:798:Tuvalu
-tw:twn:158:Taiwan, Province of China:Taiwan
-tz:tza:834:Tanzania, United Republic of:Tanzania
-ua:ukr:804:Ukraine
-ug:uga:800:Uganda
-um:umi:581:United States Minor Outlying Islands
-us:usa:840:United States:USA:United States of America
-uy:ury:858:Uruguay
-uz:uzb:860:Uzbekistan
-va:vat:336:Holy See (Vatican City State):Holy See (Vatican City)
-vc:vct:670:Saint Vincent and the Grenadines
-ve:ven:862:Venezuela
-vg:vgb:092:Virgin Islands, British:British Virgin Islands
-vi:vir:850:Virgin Islands, U.S.
-vn:vnm:704:Vietnam
-vu:vut:548:Vanuatu
-wf:wlf:876:Wallis and Futuna
-ws:wsm:882:Samoa
-ye:yem:887:Yemen
-yt:myt:175:Mayotte
-za:zaf:710:South Africa
-zm:zmb:894:Zambia
-zw:zwe:716:Zimbabwe
+# Local Variables:
+# mode: cperl
+# indent-tabs-mode: nil
+# cperl-indent-level: 3
+# cperl-continued-statement-offset: 2
+# cperl-continued-brace-offset: 0
+# cperl-brace-offset: 0
+# cperl-brace-imaginary-offset: 0
+# cperl-label-offset: -2
+# End:
+=pod
=head1 NAME
-Locale::Country - ISO codes for country identification (ISO 3166)
+Locale::Country - standard codes for country identification
=head1 SYNOPSIS
- use Locale::Country;
-
- $country = code2country('jp'); # $country gets 'Japan'
- $code = country2code('Norway'); # $code gets 'no'
-
- @codes = all_country_codes();
- @names = all_country_names();
-
- # semi-private routines
- Locale::Country::alias_code('uk' => 'gb');
- Locale::Country::rename_country('gb' => 'Great Britain');
+ use Locale::Country;
+ $country = code2country('jp' [,CODESET]); # $country gets 'Japan'
+ $code = country2code('Norway' [,CODESET]); # $code gets 'no'
-=head1 DESCRIPTION
-
-The C<Locale::Country> module provides access to the ISO
-codes for identifying countries, as defined in ISO 3166-1.
-You can either access the codes via the L<conversion routines>
-(described below), or with the two functions which return lists
-of all country codes or all country names.
-
-There are three different code sets you can use for identifying
-countries:
-
-=over 4
-
-=item B<alpha-2>
-
-Two letter codes, such as 'tv' for Tuvalu.
-This code set is identified with the symbol C<LOCALE_CODE_ALPHA_2>.
+ @codes = all_country_codes( [CODESET]);
+ @names = all_country_names();
-=item B<alpha-3>
+ # semi-private routines
+ Locale::Country::alias_code('uk' => 'gb');
+ Locale::Country::rename_country('gb' => 'Great Britain');
-Three letter codes, such as 'brb' for Barbados.
-This code set is identified with the symbol C<LOCALE_CODE_ALPHA_3>.
+=head1 DESCRIPTION
-=item B<numeric>
+The C<Locale::Country> module provides access to several code sets
+that can be used for identifying countries, such as those defined in
+ISO 3166-1.
-Numeric codes, such as 064 for Bhutan.
-This code set is identified with the symbol C<LOCALE_CODE_NUMERIC>.
+Most of the routines take an optional additional argument which
+specifies the code set to use. If not specified, the default ISO
+3166-1 two-letter codes will be used.
-=back
+=head1 SUPPORTED CODE SETS
-All of the routines take an optional additional argument
-which specifies the code set to use.
-If not specified, it defaults to the two-letter codes.
-This is partly for backwards compatibility (previous versions
-of this module only supported the alpha-2 codes), and
-partly because they are the most widely used codes.
+There are several different code sets you can use for identifying
+countries. The ones currently supported are:
-The alpha-2 and alpha-3 codes are not case-dependent,
-so you can use 'BO', 'Bo', 'bO' or 'bo' for Bolivia.
-When a code is returned by one of the functions in
-this module, it will always be lower-case.
+=over 4
-As of version 2.00, Locale::Country supports variant
-names for countries. So, for example, the country code for "United States"
-is "us", so country2code('United States') returns 'us'.
-Now the following will also return 'us':
+=item B<alpha-2>
- country2code('United States of America')
- country2code('USA')
+This is the set of two-letter (lowercase) codes from ISO 3166-1, such
+as 'tv' for Tuvalu.
+This code set is identified with the symbol C<LOCALE_CODE_ALPHA_2>.
-=head1 CONVERSION ROUTINES
+This is the default code set.
-There are three conversion routines: C<code2country()>, C<country2code()>,
-and C<country_code2code()>.
+=item B<alpha-3>
-=over 4
+This is the set of three-letter (lowercase) codes from ISO 3166-1,
+such as 'brb' for Barbados. These codes are actually defined and
+maintained by the U.N. Statistics division.
-=item code2country( CODE, [ CODESET ] )
+This code set is identified with the symbol C<LOCALE_CODE_ALPHA_3>.
-This function takes a country code and returns a string
-which contains the name of the country identified.
-If the code is not a valid country code, as defined by ISO 3166,
-then C<undef> will be returned:
+=item B<numeric>
- $country = code2country('fi');
+This is the set of three-digit numeric codes from ISO 3166-1, such as
+064 for Bhutan. These codes are actually defined and maintained by the
+U.N. Statistics division.
-=item country2code( STRING, [ CODESET ] )
+If a 2-digit code is entered, it is converted to 3 digits by prepending
+a 0.
-This function takes a country name and returns the corresponding
-country code, if such exists.
-If the argument could not be identified as a country name,
-then C<undef> will be returned:
+This code set is identified with the symbol C<LOCALE_CODE_NUMERIC>.
- $code = country2code('Norway', LOCALE_CODE_ALPHA_3);
- # $code will now be 'nor'
+=item B<fips-10>
-The case of the country name is not important.
-See the section L<KNOWN BUGS AND LIMITATIONS> below.
+The FIPS 10 data are two-letter (uppercase) codes assigned by the
+National Geospatial-Intelligence Agency.
-=item country_code2code( CODE, CODESET, CODESET )
+This code set is identified with the symbol C<LOCALE_CODE_FIPS>.
-This function takes a country code from one code set,
-and returns the corresponding code from another code set.
+=item B<dom>
- $alpha2 = country_code2code('fin',
- LOCALE_CODE_ALPHA_3, LOCALE_CODE_ALPHA_2);
- # $alpha2 will now be 'fi'
+The IANA is responsible for assigning two-letter (uppercase) top-level
+domain names to each country.
-If the code passed is not a valid country code in
-the first code set, or if there isn't a code for the
-corresponding country in the second code set,
-then C<undef> will be returned.
+This code set is identified with the symbol C<LOCALE_CODE_DOM>.
=back
-
-=head1 QUERY ROUTINES
-
-There are two function which can be used to obtain a list of all codes,
-or all country names:
+=head1 ROUTINES
=over 4
-=item C<all_country_codes( [ CODESET ] )>
-
-Returns a list of all two-letter country codes.
-The codes are guaranteed to be all lower-case,
-and not in any particular order.
-
-=item C<all_country_names( [ CODESET ] )>
-
-Returns a list of all country names for which there is a corresponding
-country code in the specified code set.
-The names are capitalised, and not returned in any particular order.
-
-Not all countries have alpha-3 and numeric codes -
-some just have an alpha-2 code,
-so you'll get a different number of countries
-depending on which code set you specify.
-
-=back
+=item B<code2country ( CODE [,CODESET] )>
+=item B<country2code ( NAME [,CODESET] )>
-=head1 SEMI-PRIVATE ROUTINES
+=item B<country_code2code ( CODE ,CODESET ,CODESET2 )>
-Locale::Country provides two semi-private routines for modifying
-the internal data.
-Given their status, they aren't exported by default,
-and so need to be called by prefixing the function name with the
-package name.
+=item B<all_country_codes ( [CODESET] )>
-=head2 alias_code
+=item B<all_country_names ( [CODESET] )>
-Define a new code as an alias for an existing code:
+=item B<Locale::Country::rename_country ( CODE ,NEW_NAME [,CODESET] )>
- Locale::Country::alias_code( ALIAS => CODE [, CODESET ] )
+=item B<Locale::Country::add_country ( CODE ,NAME [,CODESET] )>
-This feature was added as a mechanism for handling
-a "uk" code. The ISO standard says that the two-letter code for
-"United Kingdom" is "gb", whereas domain names are all .uk.
+=item B<Locale::Country::delete_country ( CODE [,CODESET] )>
-By default the module does not understand "uk", since it is implementing
-an ISO standard. If you would like 'uk' to work as the two-letter
-code for United Kingdom, use the following:
+=item B<Locale::Country::add_country_alias ( NAME ,NEW_NAME )>
- Locale::Country::alias_code('uk' => 'gb');
+=item B<Locale::Country::delete_country_alias ( NAME )>
-With this code, both "uk" and "gb" are valid codes for United Kingdom,
-with the reverse lookup returning "uk" rather than the usual "gb".
+=item B<Locale::Country::rename_country_code ( CODE ,NEW_CODE [,CODESET] )>
-B<Note:> this function was previously called _alias_code,
-but the leading underscore has been dropped.
-The old name will be supported for all 2.X releases for
-backwards compatibility.
+=item B<Locale::Country::add_country_code_alias ( CODE ,NEW_CODE [,CODESET] )>
-=head2 rename_country
+=item B<Locale::Country::delete_country_code_alias ( CODE [,CODESET] )>
-If the official country name just isn't good enough for you,
-you can rename a country. For example, the official country
-name for code 'gb' is 'United Kingdom'.
-If you want to change that, you might call:
+These routines are all documented in the Locale::Codes man page.
- Locale::Country::rename_country('gb' => 'Great Britain');
+=item B<alias_code ( ALIAS, CODE [,CODESET] )>
-This means that calling code2country('gb') will now return
-'Great Britain' instead of 'United Kingdom'.
-The original country name is retained as an alias,
-so for the above example, country2code('United Kingdom')
-will still return 'gb'.
+Version 2.07 included 2 functions for modifying the internal data:
+rename_country and alias_code. Both of these could be used only to
+modify the internal data for country codes.
+As of 3.10, the internal data for all types of codes can be modified.
-=head1 EXAMPLES
+The alias_code function is preserved for backwards compatibility, but
+the following two are identical:
-The following example illustrates use of the C<code2country()> function.
-The user is prompted for a country code, and then told the corresponding
-country name:
+ alias_code(ALIAS,CODE [,CODESET]);
+ rename_country_code(CODE,ALIAS [,CODESET]);
- $| = 1; # turn off buffering
-
- print "Enter country code: ";
- chop($code = <STDIN>);
- $country = code2country($code, LOCALE_CODE_ALPHA_2);
- if (defined $country)
- {
- print "$code = $country\n";
- }
- else
- {
- print "'$code' is not a valid country code!\n";
- }
+and the latter should be used for consistency.
-=head1 DOMAIN NAMES
+The alias_code function is deprecated (though there is no currently no
+plan to remove it).
-Most top-level domain names are based on these codes,
-but there are certain codes which aren't.
-If you are using this module to identify country from hostname,
-your best bet is to preprocess the country code.
+B<Note:> this function was previously called _alias_code, but the
+leading underscore has been dropped. The old name was supported for
+all 2.X releases, but has been dropped as of 3.00.
-For example, B<edu>, B<com>, B<gov> and friends would map to B<us>;
-B<uk> would map to B<gb>. Any others?
+=back
-=head1 KNOWN BUGS AND LIMITATIONS
+=head1 SEE ALSO
=over 4
-=item *
-
-When using C<country2code()>, the country name must currently appear
-exactly as it does in the source of the module. The module now supports
-a small number of variants.
-
-Possible extensions to this are: an interface for getting at the
-list of variant names, and regular expression matches.
-
-=item *
+=item B<Locale::Codes>
-In the current implementation, all data is read in when the
-module is loaded, and then held in memory.
-A lazy implementation would be more memory friendly.
+=item B<Locale::Constants>
-=item *
+=item B<Locale::SubCountry>
-Support for country names in different languages.
+ISO codes for country sub-divisions (states, counties, provinces,
+etc), as defined in ISO 3166-2. This module is not part of the
+Locale-Codes distribution, but is available from CPAN in
+CPAN/modules/by-module/Locale/
-=back
-
-=head1 SEE ALSO
-
-=over 4
-
-=item Locale::Language
+=item B<http://www.iso.org/iso/country_codes>
-ISO two letter codes for identification of language (ISO 639).
+Official home page for the ISO 3166 maintenance agency.
-=item Locale::Script
+Unfortunately, they do not make the actual ISO available for free,
+so I cannot check the alpha-3 and numerical codes here.
-ISO codes for identification of scripts (ISO 15924).
+=item B<http://www.iso.org/iso/list-en1-semic-3.txt>
-=item Locale::Currency
+The source of ISO 3166-1 two-letter codes used by this
+module.
-ISO three letter codes for identification of currencies
-and funds (ISO 4217).
+=item B<http://unstats.un.org/unsd/methods/m49/m49alpha.htm>
-=item Locale::SubCountry
+The source of the official ISO 3166-1 three-letter codes and
+three-digit codes.
-ISO codes for country sub-divisions (states, counties, provinces, etc),
-as defined in ISO 3166-2.
-This module is not part of the Locale-Codes distribution,
-but is available from CPAN in CPAN/modules/by-module/Locale/
+For some reason, this table is incomplete! Several countries are
+missing from it, and I cannot find them anywhere on the UN site. I
+get as much of the data from here as I can.
-=item ISO 3166-1
+=item B<http://earth-info.nga.mil/gns/html/digraphs.htm>
-The ISO standard which defines these codes.
+The official list of the FIPS 10 codes.
-=item http://www.iso.org/iso/en/prods-services/iso3166ma/index.html
+=item B<http://www.iana.org/domains/>
-Official home page for the ISO 3166 maintenance agency.
+Official source of the top-level domain names.
-=item http://www.egt.ie/standards/iso3166/iso3166-1-en.html
+=item B<https://www.cia.gov/library/publications/the-world-factbook/appendix/print_appendix-d.html>
-Another useful, but not official, home page.
+Although not the official source of any of the data, the World
+Factbook maintained by the CIA is a great source of the data,
+especially since I can't get the official data from the ISO. Since
+it's maintained by the CIA, and since it's updated every two weeks, I
+use this as the source for some missing data.
-=item http://www.cia.gov/cia/publications/factbook/docs/app-d-1.html
+=item B<http://www.statoids.com/wab.html>
-An appendix in the CIA world fact book which lists country codes
-as defined by ISO 3166, FIPS 10-4, and internet domain names.
+Another unofficial source of data. Currently, it is not used to get
+data, but the notes and explanatory material were very useful for
+understanding discrepancies between the sources.
=back
-
=head1 AUTHOR
-Neil Bowers E<lt>neil@bowers.comE<gt>
+See Locale::Codes for full author history.
-=head1 COPYRIGHT
+Currently maintained by Sullivan Beck (sbeck@cpan.org).
-Copyright (C) 2002-2004, Neil Bowers.
+=head1 COPYRIGHT
-Copyright (c) 1997-2001 Canon Research Centre Europe (CRE).
+ Copyright (c) 1997-2001 Canon Research Centre Europe (CRE).
+ Copyright (c) 2001-2010 Neil Bowers
+ Copyright (c) 2010-2010 Sullivan Beck
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut
-
-#
-# Locale::Currency - ISO three letter codes for currency identification
-# (ISO 4217)
-#
-# $Id: Currency.pm,v 2.7 2004/06/10 21:19:34 neilb Exp $
-#
-
package Locale::Currency;
+# Copyright (C) 2001 Canon Research Centre Europe (CRE).
+# Copyright (C) 2002-2009 Neil Bowers
+# Copyright (c) 2010-2010 Sullivan Beck
+# This program is free software; you can redistribute it and/or modify it
+# under the same terms as Perl itself.
+
use strict;
+use warnings;
require 5.002;
require Exporter;
+use Carp;
+use Locale::Codes;
+use Locale::Constants;
+use Locale::Codes::Currency;
-#-----------------------------------------------------------------------
-# Public Global Variables
-#-----------------------------------------------------------------------
-use vars qw($VERSION @ISA @EXPORT);
-$VERSION = sprintf("%d.%02d", q$Revision: 2.7 $ =~ /(\d+)\.(\d+)/);
-@ISA = qw(Exporter);
-@EXPORT = qw(&code2currency ¤cy2code
- &all_currency_codes &all_currency_names );
+#=======================================================================
+# Public Global Variables
+#=======================================================================
-#-----------------------------------------------------------------------
-# Private Global Variables
-#-----------------------------------------------------------------------
-my %CODES = ();
-my %CURRENCIES = ();
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+
+$VERSION='3.12';
+@ISA = qw(Exporter);
+@EXPORT = qw(code2currency
+ currency2code
+ all_currency_codes
+ all_currency_names
+ currency_code2code
+ LOCALE_CURR_ALPHA
+ LOCALE_CURR_NUMERIC
+ );
+
+sub _code {
+ my($code,$codeset) = @_;
+ $code = "" if (! $code);
+
+ $codeset = LOCALE_CURR_DEFAULT if (! defined($codeset) || $codeset eq "");
+
+ if ($codeset =~ /^\d+$/) {
+ if ($codeset == LOCALE_CURR_ALPHA) {
+ $codeset = "alpha";
+ } elsif ($codeset == LOCALE_CURR_NUMERIC) {
+ $codeset = "num";
+ } else {
+ return (1);
+ }
+ }
+
+ if ($codeset eq "alpha") {
+ $code = uc($code);
+ } elsif ($codeset eq "num") {
+ if (defined($code) && $code ne "") {
+ return (1) unless ($code =~ /^\d+$/);
+ $code = sprintf("%.3d", $code);
+ }
+ } else {
+ return (1);
+ }
+
+ return (0,$code,$codeset);
+}
+#=======================================================================
+#
+# code2currency ( CODE [,CODESET] )
+#
+#=======================================================================
+
+sub code2currency {
+ my($err,$code,$codeset) = _code(@_);
+ return undef if ($err ||
+ ! defined $code);
+
+ return Locale::Codes::_code2name("currency",$code,$codeset);
+}
#=======================================================================
#
-# code2currency( CODE )
+# currency2code ( CURRENCY [,CODESET] )
#
#=======================================================================
-sub code2currency
-{
- my $code = shift;
-
-
- return undef unless defined $code;
- $code = lc($code);
- if (exists $CODES{$code})
- {
- return $CODES{$code};
- }
- else
- {
- #---------------------------------------------------------------
- # no such currency code!
- #---------------------------------------------------------------
- return undef;
- }
+
+sub currency2code {
+ my($currency,$codeset) = @_;
+ my($err,$tmp);
+ ($err,$tmp,$codeset) = _code("",$codeset);
+ return undef if ($err ||
+ ! defined $currency);
+
+ return Locale::Codes::_name2code("currency",$currency,$codeset);
}
+#=======================================================================
+#
+# currency_code2code ( CODE,CODESET_IN,CODESET_OUT )
+#
+#=======================================================================
+
+sub currency_code2code {
+ (@_ == 3) or croak "currency_code2code() takes 3 arguments!";
+ my($code,$inset,$outset) = @_;
+ my($err,$tmp);
+ ($err,$code,$inset) = _code($code,$inset);
+ return undef if ($err);
+ ($err,$tmp,$outset) = _code("",$outset);
+ return undef if ($err);
+
+ return Locale::Codes::_code2code("currency",$code,$inset,$outset);
+}
#=======================================================================
#
-# currency2code ( CURRENCY )
+# all_currency_codes ( [CODESET] )
#
#=======================================================================
-sub currency2code
-{
- my $curr = shift;
-
-
- return undef unless defined $curr;
- $curr = lc($curr);
- if (exists $CURRENCIES{$curr})
- {
- return $CURRENCIES{$curr};
- }
- else
- {
- #---------------------------------------------------------------
- # no such currency!
- #---------------------------------------------------------------
- return undef;
- }
+
+sub all_currency_codes {
+ my($codeset) = @_;
+ my($err,$tmp);
+ ($err,$tmp,$codeset) = _code("",$codeset);
+ return undef if ($err);
+
+ return Locale::Codes::_all_codes("currency",$codeset);
}
#=======================================================================
#
-# all_currency_codes()
+# all_currency_names ( [CODESET] )
#
#=======================================================================
-sub all_currency_codes
-{
- return keys %CODES;
+
+sub all_currency_names {
+ my($codeset) = @_;
+ my($err,$tmp);
+ ($err,$tmp,$codeset) = _code("",$codeset);
+ return undef if ($err);
+
+ return Locale::Codes::_all_names("currency",$codeset);
}
+#=======================================================================
+#
+# rename_currency ( CODE,NAME [,CODESET] )
+#
+#=======================================================================
+
+sub rename_currency {
+ my($code,$new_name,@args) = @_;
+ my $nowarn = 0;
+ $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
+ my $codeset = shift(@args);
+ my $err;
+ ($err,$code,$codeset) = _code($code,$codeset);
+
+ return Locale::Codes::_rename("currency",$code,$new_name,$codeset,$nowarn);
+}
#=======================================================================
#
-# all_currency_names()
+# add_currency ( CODE,NAME [,CODESET] )
#
#=======================================================================
-sub all_currency_names
-{
- return values %CODES;
+
+sub add_currency {
+ my($code,$name,@args) = @_;
+ my $nowarn = 0;
+ $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
+ my $codeset = shift(@args);
+ my $err;
+ ($err,$code,$codeset) = _code($code,$codeset);
+
+ return Locale::Codes::_add_code("currency",$code,$name,$codeset,$nowarn);
}
+#=======================================================================
+#
+# delete_currency ( CODE [,CODESET] )
+#
+#=======================================================================
+
+sub delete_currency {
+ my($code,@args) = @_;
+ my $nowarn = 0;
+ $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
+ my $codeset = shift(@args);
+ my $err;
+ ($err,$code,$codeset) = _code($code,$codeset);
+
+ return Locale::Codes::_delete_code("currency",$code,$codeset,$nowarn);
+}
#=======================================================================
-# initialisation code - stuff the DATA into the CODES hash
+#
+# add_currency_alias ( NAME,NEW_NAME )
+#
#=======================================================================
-{
- my $code;
- my $currency;
- local $_;
-
-
- while (<DATA>)
- {
- next unless /\S/;
- chop;
- ($code, $currency) = split(/:/, $_, 2);
- $CODES{$code} = $currency;
- $CURRENCIES{"\L$currency"} = $code;
- }
-
- close(DATA);
+
+sub add_currency_alias {
+ my($name,$new_name,$nowarn) = @_;
+ $nowarn = (defined($nowarn) && $nowarn eq "nowarn" ? 1 : 0);
+
+ return Locale::Codes::_add_alias("currency",$name,$new_name,$nowarn);
}
-1;
+#=======================================================================
+#
+# delete_currency_alias ( NAME )
+#
+#=======================================================================
+
+sub delete_currency_alias {
+ my($name,$nowarn) = @_;
+ $nowarn = (defined($nowarn) && $nowarn eq "nowarn" ? 1 : 0);
+
+ return Locale::Codes::_delete_alias("currency",$name,$nowarn);
+}
+
+#=======================================================================
+#
+# rename_currency_code ( CODE,NEW_CODE [,CODESET] )
+#
+#=======================================================================
-__DATA__
-adp:Andorran Peseta
-aed:UAE Dirham
-afa:Afghani
-all:Lek
-amd:Armenian Dram
-ang:Netherlands Antillean Guilder
-aoa:Kwanza
-aon:New Kwanza
-aor:Kwanza Reajustado
-ars:Argentine Peso
-ats:Schilling
-aud:Australian Dollar
-awg:Aruban Guilder
-azm:Azerbaijanian Manat
-
-bam:Convertible Marks
-bbd:Barbados Dollar
-bdt:Taka
-bef:Belgian Franc
-bgl:Lev
-bgn:Bulgarian Lev
-bhd:Bahraini Dinar
-bhd:Dinar
-bif:Burundi Franc
-bmd:Bermudian Dollar
-bnd:Brunei Dollar
-bob:Boliviano
-bov:MVDol
-brl:Brazilian Real
-bsd:Bahamian Dollar
-btn:Ngultrum
-bwp:Pula
-byb:Belarussian Ruble
-byr:Belarussian Ruble
-bzd:Belize Dollar
-
-cad:Canadian Dollar
-cdf:Franc Congolais
-chf:Swiss Franc
-clf:Unidades de Formento
-clp:Chilean Peso
-cny:Yuan Renminbi
-cop:Colombian Peso
-crc:Costa Rican Colon
-cup:Cuban Peso
-cve:Cape Verde Escudo
-cyp:Cyprus Pound
-czk:Czech Koruna
-
-dem:German Mark
-djf:Djibouti Franc
-dkk:Danish Krone
-dop:Dominican Peso
-dzd:Algerian Dinar
-
-ecs:Sucre
-ecv:Unidad de Valor Constante (UVC)
-eek:Kroon
-egp:Egyptian Pound
-ern:Nakfa
-esp:Spanish Peseta
-etb:Ethiopian Birr
-eur:Euro
-
-fim:Markka
-fjd:Fiji Dollar
-fkp:Falkland Islands Pound
-frf:French Franc
-
-gbp:Pound Sterling
-gel:Lari
-ghc:Cedi
-gip:Gibraltar Pound
-gmd:Dalasi
-gnf:Guinea Franc
-grd:Drachma
-gtq:Quetzal
-gwp:Guinea-Bissau Peso
-gyd:Guyana Dollar
-
-hkd:Hong Kong Dollar
-hnl:Lempira
-hrk:Kuna
-htg:Gourde
-huf:Forint
-
-idr:Rupiah
-iep:Irish Pound
-ils:Shekel
-inr:Indian Rupee
-iqd:Iraqi Dinar
-irr:Iranian Rial
-isk:Iceland Krona
-itl:Italian Lira
-
-jmd:Jamaican Dollar
-jod:Jordanian Dinar
-jpy:Yen
-
-kes:Kenyan Shilling
-kgs:Som
-khr:Riel
-kmf:Comoro Franc
-kpw:North Korean Won
-krw:Won
-kwd:Kuwaiti Dinar
-kyd:Cayman Islands Dollar
-kzt:Tenge
-
-lak:Kip
-lbp:Lebanese Pound
-lkr:Sri Lanka Rupee
-lrd:Liberian Dollar
-lsl:Loti
-ltl:Lithuanian Litas
-luf:Luxembourg Franc
-lvl:Latvian Lats
-lyd:Libyan Dinar
-
-mad:Moroccan Dirham
-mdl:Moldovan Leu
-mgf:Malagasy Franc
-mkd:Denar
-mmk:Kyat
-mnt:Tugrik
-mop:Pataca
-mro:Ouguiya
-mtl:Maltese Lira
-mur:Mauritius Rupee
-mvr:Rufiyaa
-mwk:Kwacha
-mxn:Mexican Nuevo Peso
-myr:Malaysian Ringgit
-mzm:Metical
-
-nad:Namibia Dollar
-ngn:Naira
-nio:Cordoba Oro
-nlg:Netherlands Guilder
-nok:Norwegian Krone
-npr:Nepalese Rupee
-nzd:New Zealand Dollar
-
-omr:Rial Omani
-
-pab:Balboa
-pen:Nuevo Sol
-pgk:Kina
-php:Philippine Peso
-pkr:Pakistan Rupee
-pln:Zloty
-pte:Portuguese Escudo
-pyg:Guarani
-
-qar:Qatari Rial
-
-rol:Leu
-rub:Russian Ruble
-rur:Russian Ruble
-rwf:Rwanda Franc
-
-sar:Saudi Riyal
-sbd:Solomon Islands Dollar
-scr:Seychelles Rupee
-sdd:Sudanese Dinar
-sek:Swedish Krona
-sgd:Singapore Dollar
-shp:St. Helena Pound
-sit:Tolar
-skk:Slovak Koruna
-sll:Leone
-sos:Somali Shilling
-srg:Surinam Guilder
-std:Dobra
-svc:El Salvador Colon
-syp:Syrian Pound
-szl:Lilangeni
-
-thb:Baht
-tjr:Tajik Ruble
-tmm:Manat
-tnd:Tunisian Dollar
-top:Pa'anga
-tpe:Timor Escudo
-trl:Turkish Lira
-ttd:Trinidad and Tobago Dollar
-twd:New Taiwan Dollar
-tzs:Tanzanian Shilling
-
-uah:Hryvnia
-uak:Karbovanets
-ugx:Uganda Shilling
-usd:US Dollar
-usn:US Dollar (Next day)
-uss:US Dollar (Same day)
-uyu:Peso Uruguayo
-uzs:Uzbekistan Sum
-
-veb:Bolivar
-vnd:Dong
-vuv:Vatu
-
-wst:Tala
-
-xaf:CFA Franc BEAC
-xag:Silver
-xau:Gold
-xba:European Composite Unit
-xbb:European Monetary Unit
-xbc:European Unit of Account 9
-xb5:European Unit of Account 17
-xcd:East Caribbean Dollar
-xdr:SDR
-xeu:ECU (until 1998-12-31)
-xfu:UIC-Franc
-xfo:Gold-Franc
-xof:CFA Franc BCEAO
-xpd:Palladium
-xpf:CFP Franc
-xpt:Platinum
-
-yer:Yemeni Rial
-yum:New Dinar
-
-zal:Financial Rand
-zar:Rand
-zmk:Kwacha
-zrn:New Zaire
-zwd:Zimbabwe Dollar
+sub rename_currency_code {
+ my($code,$new_code,@args) = @_;
+ my $nowarn = 0;
+ $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
+ my $codeset = shift(@args);
+ my $err;
+ ($err,$code,$codeset) = _code($code,$codeset);
+ ($err,$new_code,$codeset) = _code($new_code,$codeset) if (! $err);
+
+ return Locale::Codes::_rename_code("currency",$code,$new_code,$codeset,$nowarn);
+}
+
+#=======================================================================
+#
+# add_currency_code_alias ( CODE,NEW_CODE [,CODESET] )
+#
+#=======================================================================
+
+sub add_currency_code_alias {
+ my($code,$new_code,@args) = @_;
+ my $nowarn = 0;
+ $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
+ my $codeset = shift(@args);
+ my $err;
+ ($err,$code,$codeset) = _code($code,$codeset);
+ ($err,$new_code,$codeset) = _code($new_code,$codeset) if (! $err);
+
+ return Locale::Codes::_add_code_alias("currency",$code,$new_code,$codeset,$nowarn);
+}
+
+#=======================================================================
+#
+# delete_currency_code_alias ( CODE [,CODESET] )
+#
+#=======================================================================
+
+sub delete_currency_code_alias {
+ my($code,@args) = @_;
+ my $nowarn = 0;
+ $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
+ my $codeset = shift(@args);
+ my $err;
+ ($err,$code,$codeset) = _code($code,$codeset);
+
+ return Locale::Codes::_delete_code_alias("currency",$code,$codeset,$nowarn);
+}
+
+1;
+# Local Variables:
+# mode: cperl
+# indent-tabs-mode: nil
+# cperl-indent-level: 3
+# cperl-continued-statement-offset: 2
+# cperl-continued-brace-offset: 0
+# cperl-brace-offset: 0
+# cperl-brace-imaginary-offset: 0
+# cperl-label-offset: -2
+# End:
+=pod
=head1 NAME
-Locale::Currency - ISO three letter codes for currency identification (ISO 4217)
+Locale::Currency - standard codes for currency identification
=head1 SYNOPSIS
=head1 DESCRIPTION
-The C<Locale::Currency> module provides access to the ISO three-letter
-codes for identifying currencies and funds, as defined in ISO 4217.
-You can either access the codes via the L<conversion routines>
-(described below),
-or with the two functions which return lists of all currency codes or
-all currency names.
+The C<Locale::Currency> module provides access to standard codes used
+for identifying currencies and funds, such as those defined in ISO 4217.
-There are two special codes defined by the standard which aren't
-understood by this module:
+Most of the routines take an optional additional argument which
+specifies the code set to use. If not specified, the default ISO
+4217 three-letter codes will be used.
-=over 4
-
-=item XTS
-
-Specifically reserved for testing purposes.
-
-=item XXX
-
-For transactions where no currency is involved.
-
-=back
+=head1 SUPPORTED CODE SETS
-
-=head1 CONVERSION ROUTINES
-
-There are two conversion routines: C<code2currency()> and C<currency2code()>.
+There are several different code sets you can use for identifying
+currencies. The ones currently supported are:
=over 4
-=item code2currency()
+=item B<alpha>
-This function takes a three letter currency code and returns a string
-which contains the name of the currency identified. If the code is
-not a valid currency code, as defined by ISO 4217, then C<undef>
-will be returned.
+This is a set of three-letter (uppercase) codes from ISO 4217 such
+as EUR for Euro.
- $curr = code2currency($code);
+Two of the codes specified by the standard (XTS which is reserved
+for testing purposes and XXX which is for transactions where no
+currency is involved) are omitted.
-=item currency2code()
+This code set is identified with the symbol C<LOCALE_CURR_ALPHA>.
-This function takes a currency name and returns the corresponding
-three letter currency code, if such exists.
-If the argument could not be identified as a currency name,
-then C<undef> will be returned.
+This is the default code set.
- $code = currency2code('French Franc');
+=item B<num>
-The case of the currency name is not important.
-See the section L<KNOWN BUGS AND LIMITATIONS> below.
-
-=back
+This is the set of three-digit numeric codes from ISO 4217.
+This code set is identified with the symbol C<LOCALE_CURR_NUMERIC>.
-=head1 QUERY ROUTINES
+=back
-There are two function which can be used to obtain a list of all
-currency codes, or all currency names:
+=head1 ROUTINES
=over 4
-=item C<all_currency_codes()>
+=item B<code2currency ( CODE [,CODESET] )>
-Returns a list of all three-letter currency codes.
-The codes are guaranteed to be all lower-case,
-and not in any particular order.
+=item B<currency2code ( NAME [,CODESET] )>
-=item C<all_currency_names()>
+=item B<currency_code2code ( CODE ,CODESET ,CODESET2 )>
-Returns a list of all currency names for which there is a corresponding
-three-letter currency code. The names are capitalised, and not returned
-in any particular order.
+=item B<all_currency_codes ( [CODESET] )>
-=back
+=item B<all_currency_names ( [CODESET] )>
+=item B<Locale::Currency::rename_currency ( CODE ,NEW_NAME [,CODESET] )>
-=head1 EXAMPLES
+=item B<Locale::Currency::add_currency ( CODE ,NAME [,CODESET] )>
-The following example illustrates use of the C<code2currency()> function.
-The user is prompted for a currency code, and then told the corresponding
-currency name:
+=item B<Locale::Currency::delete_currency ( CODE [,CODESET] )>
- $| = 1; # turn off buffering
+=item B<Locale::Currency::add_currency_alias ( NAME ,NEW_NAME )>
- print "Enter currency code: ";
- chop($code = <STDIN>);
- $curr = code2currency($code);
- if (defined $curr)
- {
- print "$code = $curr\n";
- }
- else
- {
- print "'$code' is not a valid currency code!\n";
- }
+=item B<Locale::Currency::delete_currency_alias ( NAME )>
-=head1 KNOWN BUGS AND LIMITATIONS
+=item B<Locale::Currency::rename_currency_code ( CODE ,NEW_CODE [,CODESET] )>
-=over 4
+=item B<Locale::Currency::add_currency_code_alias ( CODE ,NEW_CODE [,CODESET] )>
-=item *
+=item B<Locale::Currency::delete_currency_code_alias ( CODE [,CODESET] )>
-In the current implementation, all data is read in when the
-module is loaded, and then held in memory.
-A lazy implementation would be more memory friendly.
-
-=item *
-
-This module also includes the special codes which are
-not for a currency, such as Gold, Platinum, etc.
-This might cause a problem if you're using this module
-to display a list of currencies.
-Let Neil know if this does cause a problem, and we can
-do something about it.
-
-=item *
-
-ISO 4217 also defines a numeric code for each currency.
-Currency codes are not currently supported by this module,
-in the same way Locale::Country supports multiple codesets.
-
-=item *
-
-There are three cases where there is more than one
-code for the same currency name.
-Kwacha has two codes: mwk for Malawi, and zmk for Zambia.
-The Russian Ruble has two codes: rub and rur.
-The Belarussian Ruble has two codes: byr and byb.
-The currency2code() function only returns one code, so
-you might not get back the code you expected.
+These routines are all documented in the Locale::Codes man page.
=back
=over 4
-=item Locale::Country
-
-ISO codes for identification of country (ISO 3166).
+=item B<Locale::Codes>
-=item Locale::Script
+=item B<Locale::Constants>
-ISO codes for identification of written scripts (ISO 15924).
+=item B<http://www.iso.org/iso/support/currency_codes_list-1.htm>
-=item ISO 4217:1995
-
-Code for the representation of currencies and funds.
-
-=item http://www.bsi-global.com/iso4217currency
-
-Official web page for the ISO 4217 maintenance agency.
-This has the latest list of codes, in MS Word format. Boo.
+The ISO 4217 data.
=back
=head1 AUTHOR
-Michael Hennecke E<lt>hennecke@rz.uni-karlsruhe.deE<gt>
-and
-Neil Bowers E<lt>neil@bowers.comE<gt>
+See Locale::Codes for full author history.
-=head1 COPYRIGHT
+Currently maintained by Sullivan Beck (sbeck@cpan.org).
-Copyright (C) 2002-2004, Neil Bowers.
+=head1 COPYRIGHT
-Copyright (c) 2001 Michael Hennecke and
-Canon Research Centre Europe (CRE).
+ Copyright (c) 1997-2001 Canon Research Centre Europe (CRE).
+ Copyright (c) 2001 Michael Hennecke
+ Copyright (c) 2001-2010 Neil Bowers
+ Copyright (c) 2010-2010 Sullivan Beck
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut
-
-#
-# Locale::Language - ISO two letter codes for language identification (ISO 639)
-#
-# $Id: Language.pm,v 2.7 2004/06/10 21:19:34 neilb Exp $
-#
-
package Locale::Language;
+# Copyright (C) 2001 Canon Research Centre Europe (CRE).
+# Copyright (C) 2002-2009 Neil Bowers
+# Copyright (c) 2010-2010 Sullivan Beck
+# This program is free software; you can redistribute it and/or modify it
+# under the same terms as Perl itself.
+
use strict;
+use warnings;
require 5.002;
require Exporter;
+use Carp;
+use Locale::Codes;
+use Locale::Constants;
+use Locale::Codes::Language;
-#-----------------------------------------------------------------------
-# Public Global Variables
-#-----------------------------------------------------------------------
-use vars qw($VERSION @ISA @EXPORT);
-$VERSION = sprintf("%d.%02d", q$Revision: 2.7 $ =~ /(\d+)\.(\d+)/);
-@ISA = qw(Exporter);
-@EXPORT = qw(&code2language &language2code
- &all_language_codes &all_language_names );
+#=======================================================================
+# Public Global Variables
+#=======================================================================
-#-----------------------------------------------------------------------
-# Private Global Variables
-#-----------------------------------------------------------------------
-my %CODES = ();
-my %LANGUAGES = ();
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+
+$VERSION='3.12';
+@ISA = qw(Exporter);
+@EXPORT = qw(code2language
+ language2code
+ all_language_codes
+ all_language_names
+ language_code2code
+ LOCALE_LANG_ALPHA_2
+ LOCALE_LANG_ALPHA_3
+ LOCALE_LANG_TERM
+ );
+
+sub _code {
+ my($code,$codeset) = @_;
+ $code = "" if (! $code);
+
+ $codeset = LOCALE_LANG_DEFAULT if (! defined($codeset) || $codeset eq "");
+
+ if ($codeset =~ /^\d+$/) {
+ if ($codeset == LOCALE_LANG_ALPHA_2) {
+ $codeset = "alpha2";
+ } elsif ($codeset == LOCALE_LANG_ALPHA_3) {
+ $codeset = "alpha3";
+ } elsif ($codeset == LOCALE_LANG_TERM) {
+ $codeset = "term";
+ } else {
+ return (1);
+ }
+ }
+
+ if ($codeset eq "alpha2" ||
+ $codeset eq "alpha3" ||
+ $codeset eq "term") {
+ $code = lc($code);
+ } else {
+ return (1);
+ }
+
+ return (0,$code,$codeset);
+}
+#=======================================================================
+#
+# code2language ( CODE [,CODESET] )
+#
+#=======================================================================
+
+sub code2language {
+ my($err,$code,$codeset) = _code(@_);
+ return undef if ($err ||
+ ! defined $code);
+
+ return Locale::Codes::_code2name("language",$code,$codeset);
+}
#=======================================================================
#
-# code2language ( CODE )
+# language2code ( LANGUAGE [,CODESET] )
#
#=======================================================================
-sub code2language
-{
- my $code = shift;
-
-
- return undef unless defined $code;
- $code = lc($code);
- if (exists $CODES{$code})
- {
- return $CODES{$code};
- }
- else
- {
- #---------------------------------------------------------------
- # no such language code!
- #---------------------------------------------------------------
- return undef;
- }
+
+sub language2code {
+ my($language,$codeset) = @_;
+ my($err,$tmp);
+ ($err,$tmp,$codeset) = _code("",$codeset);
+ return undef if ($err ||
+ ! defined $language);
+
+ return Locale::Codes::_name2code("language",$language,$codeset);
}
+#=======================================================================
+#
+# language_code2code ( CODE,CODESET_IN,CODESET_OUT )
+#
+#=======================================================================
+
+sub language_code2code {
+ (@_ == 3) or croak "language_code2code() takes 3 arguments!";
+ my($code,$inset,$outset) = @_;
+ my($err,$tmp);
+ ($err,$code,$inset) = _code($code,$inset);
+ return undef if ($err);
+ ($err,$tmp,$outset) = _code("",$outset);
+ return undef if ($err);
+
+ return Locale::Codes::_code2code("language",$code,$inset,$outset);
+}
#=======================================================================
#
-# language2code ( LANGUAGE )
+# all_language_codes ( [CODESET] )
#
#=======================================================================
-sub language2code
-{
- my $lang = shift;
-
-
- return undef unless defined $lang;
- $lang = lc($lang);
- if (exists $LANGUAGES{$lang})
- {
- return $LANGUAGES{$lang};
- }
- else
- {
- #---------------------------------------------------------------
- # no such language!
- #---------------------------------------------------------------
- return undef;
- }
+
+sub all_language_codes {
+ my($codeset) = @_;
+ my($err,$tmp);
+ ($err,$tmp,$codeset) = _code("",$codeset);
+ return undef if ($err);
+
+ return Locale::Codes::_all_codes("language",$codeset);
}
#=======================================================================
#
-# all_language_codes()
+# all_language_names ( [CODESET] )
#
#=======================================================================
-sub all_language_codes
-{
- return keys %CODES;
+
+sub all_language_names {
+ my($codeset) = @_;
+ my($err,$tmp);
+ ($err,$tmp,$codeset) = _code("",$codeset);
+ return undef if ($err);
+
+ return Locale::Codes::_all_names("language",$codeset);
}
+#=======================================================================
+#
+# rename_language ( CODE,NAME [,CODESET] )
+#
+#=======================================================================
+
+sub rename_language {
+ my($code,$new_name,@args) = @_;
+ my $nowarn = 0;
+ $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
+ my $codeset = shift(@args);
+ my $err;
+ ($err,$code,$codeset) = _code($code,$codeset);
+
+ return Locale::Codes::_rename("language",$code,$new_name,$codeset,$nowarn);
+}
#=======================================================================
#
-# all_language_names()
+# add_language ( CODE,NAME [,CODESET] )
#
#=======================================================================
-sub all_language_names
-{
- return values %CODES;
+
+sub add_language {
+ my($code,$name,@args) = @_;
+ my $nowarn = 0;
+ $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
+ my $codeset = shift(@args);
+ my $err;
+ ($err,$code,$codeset) = _code($code,$codeset);
+
+ return Locale::Codes::_add_code("language",$code,$name,$codeset,$nowarn);
}
+#=======================================================================
+#
+# delete_language ( CODE [,CODESET] )
+#
+#=======================================================================
+
+sub delete_language {
+ my($code,@args) = @_;
+ my $nowarn = 0;
+ $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
+ my $codeset = shift(@args);
+ my $err;
+ ($err,$code,$codeset) = _code($code,$codeset);
+
+ return Locale::Codes::_delete_code("language",$code,$codeset,$nowarn);
+}
#=======================================================================
-# initialisation code - stuff the DATA into the CODES hash
+#
+# add_language_alias ( NAME,NEW_NAME )
+#
#=======================================================================
-{
- my $code;
- my $language;
- local $_;
-
-
- while (<DATA>)
- {
- next unless /\S/;
- chop;
- ($code, $language) = split(/:/, $_, 2);
- $CODES{$code} = $language;
- $LANGUAGES{"\L$language"} = $code;
- }
-
- close(DATA);
+
+sub add_language_alias {
+ my($name,$new_name,$nowarn) = @_;
+ $nowarn = (defined($nowarn) && $nowarn eq "nowarn" ? 1 : 0);
+
+ return Locale::Codes::_add_alias("language",$name,$new_name,$nowarn);
}
-1;
+#=======================================================================
+#
+# delete_language_alias ( NAME )
+#
+#=======================================================================
+
+sub delete_language_alias {
+ my($name,$nowarn) = @_;
+ $nowarn = (defined($nowarn) && $nowarn eq "nowarn" ? 1 : 0);
+
+ return Locale::Codes::_delete_alias("language",$name,$nowarn);
+}
+
+#=======================================================================
+#
+# rename_language_code ( CODE,NEW_CODE [,CODESET] )
+#
+#=======================================================================
-__DATA__
-aa:Afar
-ab:Abkhazian
-ae:Avestan
-af:Afrikaans
-am:Amharic
-ar:Arabic
-as:Assamese
-ay:Aymara
-az:Azerbaijani
-
-ba:Bashkir
-be:Belarusian
-bg:Bulgarian
-bh:Bihari
-bi:Bislama
-bn:Bengali
-bo:Tibetan
-br:Breton
-bs:Bosnian
-
-ca:Catalan
-ce:Chechen
-ch:Chamorro
-co:Corsican
-cs:Czech
-cu:Church Slavic
-cv:Chuvash
-cy:Welsh
-
-da:Danish
-de:German
-dz:Dzongkha
-
-el:Greek
-en:English
-eo:Esperanto
-es:Spanish
-et:Estonian
-eu:Basque
-
-fa:Persian
-fi:Finnish
-fj:Fijian
-fo:Faeroese
-fr:French
-fy:Frisian
-
-ga:Irish
-gd:Gaelic (Scots)
-gl:Gallegan
-gn:Guarani
-gu:Gujarati
-gv:Manx
-
-ha:Hausa
-he:Hebrew
-hi:Hindi
-ho:Hiri Motu
-hr:Croatian
-hu:Hungarian
-hy:Armenian
-hz:Herero
-
-ia:Interlingua
-id:Indonesian
-ie:Interlingue
-ik:Inupiaq
-is:Icelandic
-it:Italian
-iu:Inuktitut
-
-ja:Japanese
-jw:Javanese
-
-ka:Georgian
-ki:Kikuyu
-kj:Kuanyama
-kk:Kazakh
-kl:Kalaallisut
-km:Khmer
-kn:Kannada
-ko:Korean
-ks:Kashmiri
-ku:Kurdish
-kv:Komi
-kw:Cornish
-ky:Kirghiz
-
-la:Latin
-lb:Letzeburgesch
-ln:Lingala
-lo:Lao
-lt:Lithuanian
-lv:Latvian
-
-mg:Malagasy
-mh:Marshall
-mi:Maori
-mk:Macedonian
-ml:Malayalam
-mn:Mongolian
-mo:Moldavian
-mr:Marathi
-ms:Malay
-mt:Maltese
-my:Burmese
-
-na:Nauru
-nb:Norwegian Bokmal
-nd:Ndebele, North
-ne:Nepali
-ng:Ndonga
-nl:Dutch
-nn:Norwegian Nynorsk
-no:Norwegian
-nr:Ndebele, South
-nv:Navajo
-ny:Chichewa; Nyanja
-
-oc:Occitan (post 1500)
-om:Oromo
-or:Oriya
-os:Ossetian; Ossetic
-
-pa:Panjabi
-pi:Pali
-pl:Polish
-ps:Pushto
-pt:Portuguese
-
-qu:Quechua
-
-rm:Rhaeto-Romance
-rn:Rundi
-ro:Romanian
-ru:Russian
-rw:Kinyarwanda
-
-sa:Sanskrit
-sc:Sardinian
-sd:Sindhi
-se:Sami
-sg:Sango
-si:Sinhalese
-sk:Slovak
-sl:Slovenian
-sm:Samoan
-sn:Shona
-so:Somali
-sq:Albanian
-sr:Serbian
-ss:Swati
-st:Sotho
-su:Sundanese
-sv:Swedish
-sw:Swahili
-
-ta:Tamil
-te:Telugu
-tg:Tajik
-th:Thai
-ti:Tigrinya
-tk:Turkmen
-tl:Tagalog
-tn:Tswana
-to:Tonga
-tr:Turkish
-ts:Tsonga
-tt:Tatar
-tw:Twi
-
-ug:Uighur
-uk:Ukrainian
-ur:Urdu
-uz:Uzbek
-
-vi:Vietnamese
-vo:Volapuk
-
-wo:Wolof
-
-xh:Xhosa
-
-yi:Yiddish
-yo:Yoruba
-
-za:Zhuang
-zh:Chinese
-zu:Zulu
+sub rename_language_code {
+ my($code,$new_code,@args) = @_;
+ my $nowarn = 0;
+ $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
+ my $codeset = shift(@args);
+ my $err;
+ ($err,$code,$codeset) = _code($code,$codeset);
+ ($err,$new_code,$codeset) = _code($new_code,$codeset) if (! $err);
+
+ return Locale::Codes::_rename_code("language",$code,$new_code,$codeset,$nowarn);
+}
+
+#=======================================================================
+#
+# add_language_code_alias ( CODE,NEW_CODE [,CODESET] )
+#
+#=======================================================================
+
+sub add_language_code_alias {
+ my($code,$new_code,@args) = @_;
+ my $nowarn = 0;
+ $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
+ my $codeset = shift(@args);
+ my $err;
+ ($err,$code,$codeset) = _code($code,$codeset);
+ ($err,$new_code,$codeset) = _code($new_code,$codeset) if (! $err);
+
+ return Locale::Codes::_add_code_alias("language",$code,$new_code,$codeset,$nowarn);
+}
+
+#=======================================================================
+#
+# delete_language_code_alias ( CODE [,CODESET] )
+#
+#=======================================================================
+
+sub delete_language_code_alias {
+ my($code,@args) = @_;
+ my $nowarn = 0;
+ $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
+ my $codeset = shift(@args);
+ my $err;
+ ($err,$code,$codeset) = _code($code,$codeset);
+
+ return Locale::Codes::_delete_code_alias("language",$code,$codeset,$nowarn);
+}
+
+1;
+# Local Variables:
+# mode: cperl
+# indent-tabs-mode: nil
+# cperl-indent-level: 3
+# cperl-continued-statement-offset: 2
+# cperl-continued-brace-offset: 0
+# cperl-brace-offset: 0
+# cperl-brace-imaginary-offset: 0
+# cperl-label-offset: -2
+# End:
+=pod
=head1 NAME
-Locale::Language - ISO two letter codes for language identification (ISO 639)
+Locale::Language - standard codes for language identification
=head1 SYNOPSIS
- use Locale::Language;
-
- $lang = code2language('en'); # $lang gets 'English'
- $code = language2code('French'); # $code gets 'fr'
-
- @codes = all_language_codes();
- @names = all_language_names();
+ use Locale::Language;
+ $lang = code2language('en'); # $lang gets 'English'
+ $code = language2code('French'); # $code gets 'fr'
+
+ @codes = all_language_codes();
+ @names = all_language_names();
=head1 DESCRIPTION
-The C<Locale::Language> module provides access to the ISO two-letter
-codes for identifying languages, as defined in ISO 639. You can either
-access the codes via the L<conversion routines> (described below),
-or via the two functions which return lists of all language codes or
-all language names.
+The C<Locale::Language> module provides access to standard codes used
+for identifying languages, such as those as defined in ISO 639.
+Most of the routines take an optional additional argument which
+specifies the code set to use. If not specified, the default ISO
+639 two-letter codes will be used.
-=head1 CONVERSION ROUTINES
+=head1 SUPPORTED CODE SETS
-There are two conversion routines: C<code2language()> and C<language2code()>.
+There are several different code sets you can use for identifying
+languages. The ones currently supported are:
=over 4
-=item code2language()
+=item B<alpha-2>
-This function takes a two letter language code and returns a string
-which contains the name of the language identified. If the code is
-not a valid language code, as defined by ISO 639, then C<undef>
-will be returned.
+This is the set of two-letter (lowercase) codes from ISO 639, such
+as 'he' for Hebrew.
- $lang = code2language($code);
+This code set is identified with the symbol C<LOCALE_LANG_ALPHA_2>.
-=item language2code()
+This is the default code set.
-This function takes a language name and returns the corresponding
-two letter language code, if such exists.
-If the argument could not be identified as a language name,
-then C<undef> will be returned.
+=item B<alpha-3>
- $code = language2code('French');
+This is the set of three-letter (lowercase) bibliographic codes from
+ISO 639, such as 'heb' for Hebrew.
-The case of the language name is not important.
-See the section L<KNOWN BUGS AND LIMITATIONS> below.
+This code set is identified with the symbol C<LOCALE_LANG_ALPHA_3>.
-=back
+=item B<term>
+This is the set of three-letter (lowercase) terminologic codes from
+ISO 639.
-=head1 QUERY ROUTINES
+This code set is identified with the symbol C<LOCALE_LANG_TERM>.
-There are two function which can be used to obtain a list of all
-language codes, or all language names:
+=back
+
+=head1 ROUTINES
=over 4
-=item C<all_language_codes()>
+=item B<code2language ( CODE [,CODESET] )>
-Returns a list of all two-letter language codes.
-The codes are guaranteed to be all lower-case,
-and not in any particular order.
+=item B<language2code ( NAME [,CODESET] )>
-=item C<all_language_names()>
+=item B<language_code2code ( CODE ,CODESET ,CODESET2 )>
-Returns a list of all language names for which there is a corresponding
-two-letter language code. The names are capitalised, and not returned
-in any particular order.
+=item B<all_language_codes ( [CODESET] )>
-=back
+=item B<all_language_names ( [CODESET] )>
+=item B<Locale::Language::rename_language ( CODE ,NEW_NAME [,CODESET] )>
-=head1 EXAMPLES
+=item B<Locale::Language::add_language ( CODE ,NAME [,CODESET] )>
-The following example illustrates use of the C<code2language()> function.
-The user is prompted for a language code, and then told the corresponding
-language name:
+=item B<Locale::Language::delete_language ( CODE [,CODESET] )>
- $| = 1; # turn off buffering
-
- print "Enter language code: ";
- chop($code = <STDIN>);
- $lang = code2language($code);
- if (defined $lang)
- {
- print "$code = $lang\n";
- }
- else
- {
- print "'$code' is not a valid language code!\n";
- }
+=item B<Locale::Language::add_language_alias ( NAME ,NEW_NAME )>
-=head1 KNOWN BUGS AND LIMITATIONS
+=item B<Locale::Language::delete_language_alias ( NAME )>
-=over 4
-
-=item *
+=item B<Locale::Language::rename_language_code ( CODE ,NEW_CODE [,CODESET] )>
-In the current implementation, all data is read in when the
-module is loaded, and then held in memory.
-A lazy implementation would be more memory friendly.
+=item B<Locale::Language::add_language_code_alias ( CODE ,NEW_CODE [,CODESET] )>
-=item *
+=item B<Locale::Language::delete_language_code_alias ( CODE [,CODESET] )>
-Currently just supports the two letter language codes -
-there are also three-letter codes, and numbers.
-Would these be of any use to anyone?
+These routines are all documented in the Locale::Codes man page.
=back
=over 4
-=item Locale::Country
-
-ISO codes for identification of country (ISO 3166).
-Supports 2-letter, 3-letter, and numeric country codes.
-
-=item Locale::Script
+=item B<Locale::Codes>
-ISO codes for identification of written scripts (ISO 15924).
+=item B<Locale::Constants>
-=item Locale::Currency
+=item B<http://www.loc.gov/standards/iso639-2/>
-ISO three letter codes for identification of currencies and funds (ISO 4217).
-
-=item ISO 639:1988 (E/F)
-
-Code for the representation of names of languages.
-
-=item http://lcweb.loc.gov/standards/iso639-2/langhome.html
-
-Home page for ISO 639-2.
+Source of the ISO 639 codes.
=back
-
=head1 AUTHOR
-Neil Bowers E<lt>neil@bowers.comE<gt>
+See Locale::Codes for full author history.
-=head1 COPYRIGHT
+Currently maintained by Sullivan Beck (sbeck@cpan.org).
-Copyright (C) 2002-2004, Neil Bowers.
+=head1 COPYRIGHT
-Copyright (c) 1997-2001 Canon Research Centre Europe (CRE).
+ Copyright (c) 1997-2001 Canon Research Centre Europe (CRE).
+ Copyright (c) 2001-2010 Neil Bowers
+ Copyright (c) 2010-2010 Sullivan Beck
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut
-
-#
-# Locale::Script - ISO codes for script identification (ISO 15924)
-#
-# $Id: Script.pm,v 2.7 2004/06/10 21:19:34 neilb Exp $
-#
-
package Locale::Script;
+# Copyright (C) 2001 Canon Research Centre Europe (CRE).
+# Copyright (C) 2002-2009 Neil Bowers
+# Copyright (c) 2010-2010 Sullivan Beck
+# This program is free software; you can redistribute it and/or modify it
+# under the same terms as Perl itself.
+
use strict;
+use warnings;
require 5.002;
require Exporter;
use Carp;
+use Locale::Codes;
use Locale::Constants;
+use Locale::Codes::Script;
+#=======================================================================
+# Public Global Variables
+#=======================================================================
-#-----------------------------------------------------------------------
-# Public Global Variables
-#-----------------------------------------------------------------------
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-$VERSION = sprintf("%d.%02d", q$Revision: 2.7 $ =~ /(\d+)\.(\d+)/);
+
+$VERSION='3.12';
@ISA = qw(Exporter);
-@EXPORT = qw(code2script script2code
- all_script_codes all_script_names
- script_code2code
- LOCALE_CODE_ALPHA_2 LOCALE_CODE_ALPHA_3 LOCALE_CODE_NUMERIC);
+@EXPORT = qw(code2script
+ script2code
+ all_script_codes
+ all_script_names
+ script_code2code
+ LOCALE_SCRIPT_ALPHA
+ LOCALE_SCRIPT_NUMERIC
+ );
+
+sub _code {
+ my($code,$codeset) = @_;
+ $code = "" if (! $code);
+
+ $codeset = LOCALE_SCRIPT_DEFAULT if (! defined($codeset) || $codeset eq "");
+
+ if ($codeset =~ /^\d+$/) {
+ if ($codeset == LOCALE_SCRIPT_ALPHA) {
+ $codeset = "alpha";
+ } elsif ($codeset == LOCALE_SCRIPT_NUMERIC) {
+ $codeset = "num";
+ } else {
+ return (1);
+ }
+ }
+
+ if ($codeset eq "alpha") {
+ $code = ucfirst(lc($code));
+ } elsif ($codeset eq "num") {
+ if (defined($code) && $code ne "") {
+ return (1) unless ($code =~ /^\d+$/);
+ $code = sprintf("%.3d", $code);
+ }
+ } else {
+ return (1);
+ }
+
+ return (0,$code,$codeset);
+}
+
+#=======================================================================
+#
+# code2script ( CODE [,CODESET] )
+#
+#=======================================================================
-#-----------------------------------------------------------------------
-# Private Global Variables
-#-----------------------------------------------------------------------
-my $CODES = [];
-my $COUNTRIES = [];
+sub code2script {
+ my($err,$code,$codeset) = _code(@_);
+ return undef if ($err ||
+ ! defined $code);
+ return Locale::Codes::_code2name("script",$code,$codeset);
+}
#=======================================================================
#
-# code2script ( CODE [, CODESET ] )
+# script2code ( SCRIPT [,CODESET] )
#
#=======================================================================
-sub code2script
-{
- my $code = shift;
- my $codeset = @_ > 0 ? shift : LOCALE_CODE_DEFAULT;
-
-
- return undef unless defined $code;
-
- #-------------------------------------------------------------------
- # Make sure the code is in the right form before we use it
- # to look up the corresponding script.
- # We have to sprintf because the codes are given as 3-digits,
- # with leading 0's. Eg 070 for Egyptian demotic.
- #-------------------------------------------------------------------
- if ($codeset == LOCALE_CODE_NUMERIC)
- {
- return undef if ($code =~ /\D/);
- $code = sprintf("%.3d", $code);
- }
- else
- {
- $code = lc($code);
- }
-
- if (exists $CODES->[$codeset]->{$code})
- {
- return $CODES->[$codeset]->{$code};
- }
- else
- {
- #---------------------------------------------------------------
- # no such script code!
- #---------------------------------------------------------------
- return undef;
- }
+
+sub script2code {
+ my($script,$codeset) = @_;
+ my($err,$tmp);
+ ($err,$tmp,$codeset) = _code("",$codeset);
+ return undef if ($err ||
+ ! defined $script);
+
+ return Locale::Codes::_name2code("script",$script,$codeset);
}
+#=======================================================================
+#
+# script_code2code ( CODE,CODESET_IN,CODESET_OUT )
+#
+#=======================================================================
+
+sub script_code2code {
+ (@_ == 3) or croak "script_code2code() takes 3 arguments!";
+ my($code,$inset,$outset) = @_;
+ my($err,$tmp);
+ ($err,$code,$inset) = _code($code,$inset);
+ return undef if ($err);
+ ($err,$tmp,$outset) = _code("",$outset);
+ return undef if ($err);
+
+ return Locale::Codes::_code2code("script",$code,$inset,$outset);
+}
#=======================================================================
#
-# script2code ( SCRIPT [, CODESET ] )
+# all_script_codes ( [CODESET] )
#
#=======================================================================
-sub script2code
-{
- my $script = shift;
- my $codeset = @_ > 0 ? shift : LOCALE_CODE_DEFAULT;
-
-
- return undef unless defined $script;
- $script = lc($script);
- if (exists $COUNTRIES->[$codeset]->{$script})
- {
- return $COUNTRIES->[$codeset]->{$script};
- }
- else
- {
- #---------------------------------------------------------------
- # no such script!
- #---------------------------------------------------------------
- return undef;
- }
+
+sub all_script_codes {
+ my($codeset) = @_;
+ my($err,$tmp);
+ ($err,$tmp,$codeset) = _code("",$codeset);
+ return undef if ($err);
+
+ return Locale::Codes::_all_codes("script",$codeset);
}
#=======================================================================
#
-# script_code2code ( CODE, IN-CODESET, OUT-CODESET )
+# all_script_names ( [CODESET] )
#
#=======================================================================
-sub script_code2code
-{
- (@_ == 3) or croak "script_code2code() takes 3 arguments!";
-
- my $code = shift;
- my $inset = shift;
- my $outset = shift;
- my $outcode;
- my $script;
-
-
- return undef if $inset == $outset;
- $script = code2script($code, $inset);
- return undef if not defined $script;
- $outcode = script2code($script, $outset);
- return $outcode;
+
+sub all_script_names {
+ my($codeset) = @_;
+ my($err,$tmp);
+ ($err,$tmp,$codeset) = _code("",$codeset);
+ return undef if ($err);
+
+ return Locale::Codes::_all_names("script",$codeset);
}
+#=======================================================================
+#
+# rename_script ( CODE,NAME [,CODESET] )
+#
+#=======================================================================
+
+sub rename_script {
+ my($code,$new_name,@args) = @_;
+ my $nowarn = 0;
+ $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
+ my $codeset = shift(@args);
+ my $err;
+ ($err,$code,$codeset) = _code($code,$codeset);
+
+ return Locale::Codes::_rename("script",$code,$new_name,$codeset,$nowarn);
+}
#=======================================================================
#
-# all_script_codes()
+# add_script ( CODE,NAME [,CODESET] )
#
#=======================================================================
-sub all_script_codes
-{
- my $codeset = @_ > 0 ? shift : LOCALE_CODE_DEFAULT;
- return keys %{ $CODES->[$codeset] };
+sub add_script {
+ my($code,$name,@args) = @_;
+ my $nowarn = 0;
+ $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
+ my $codeset = shift(@args);
+ my $err;
+ ($err,$code,$codeset) = _code($code,$codeset);
+
+ return Locale::Codes::_add_code("script",$code,$name,$codeset,$nowarn);
}
+#=======================================================================
+#
+# delete_script ( CODE [,CODESET] )
+#
+#=======================================================================
+
+sub delete_script {
+ my($code,@args) = @_;
+ my $nowarn = 0;
+ $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
+ my $codeset = shift(@args);
+ my $err;
+ ($err,$code,$codeset) = _code($code,$codeset);
+
+ return Locale::Codes::_delete_code("script",$code,$codeset,$nowarn);
+}
#=======================================================================
#
-# all_script_names()
+# add_script_alias ( NAME,NEW_NAME )
#
#=======================================================================
-sub all_script_names
-{
- my $codeset = @_ > 0 ? shift : LOCALE_CODE_DEFAULT;
- return values %{ $CODES->[$codeset] };
+sub add_script_alias {
+ my($name,$new_name,$nowarn) = @_;
+ $nowarn = (defined($nowarn) && $nowarn eq "nowarn" ? 1 : 0);
+
+ return Locale::Codes::_add_alias("script",$name,$new_name,$nowarn);
}
+#=======================================================================
+#
+# delete_script_alias ( NAME )
+#
+#=======================================================================
+
+sub delete_script_alias {
+ my($name,$nowarn) = @_;
+ $nowarn = (defined($nowarn) && $nowarn eq "nowarn" ? 1 : 0);
+
+ return Locale::Codes::_delete_alias("script",$name,$nowarn);
+}
#=======================================================================
#
-# initialisation code - stuff the DATA into the ALPHA2 hash
+# rename_script_code ( CODE,NEW_CODE [,CODESET] )
#
#=======================================================================
-{
- my ($alpha2, $alpha3, $numeric);
- my $script;
- local $_;
+sub rename_script_code {
+ my($code,$new_code,@args) = @_;
+ my $nowarn = 0;
+ $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
+ my $codeset = shift(@args);
+ my $err;
+ ($err,$code,$codeset) = _code($code,$codeset);
+ ($err,$new_code,$codeset) = _code($new_code,$codeset) if (! $err);
- while (<DATA>)
- {
- next unless /\S/;
- chop;
- ($alpha2, $alpha3, $numeric, $script) = split(/:/, $_, 4);
+ return Locale::Codes::_rename_code("script",$code,$new_code,$codeset,$nowarn);
+}
- $CODES->[LOCALE_CODE_ALPHA_2]->{$alpha2} = $script;
- $COUNTRIES->[LOCALE_CODE_ALPHA_2]->{"\L$script"} = $alpha2;
+#=======================================================================
+#
+# add_script_code_alias ( CODE,NEW_CODE [,CODESET] )
+#
+#=======================================================================
- if ($alpha3)
- {
- $CODES->[LOCALE_CODE_ALPHA_3]->{$alpha3} = $script;
- $COUNTRIES->[LOCALE_CODE_ALPHA_3]->{"\L$script"} = $alpha3;
- }
+sub add_script_code_alias {
+ my($code,$new_code,@args) = @_;
+ my $nowarn = 0;
+ $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
+ my $codeset = shift(@args);
+ my $err;
+ ($err,$code,$codeset) = _code($code,$codeset);
+ ($err,$new_code,$codeset) = _code($new_code,$codeset) if (! $err);
- if ($numeric)
- {
- $CODES->[LOCALE_CODE_NUMERIC]->{$numeric} = $script;
- $COUNTRIES->[LOCALE_CODE_NUMERIC]->{"\L$script"} = $numeric;
- }
+ return Locale::Codes::_add_code_alias("script",$code,$new_code,$codeset,$nowarn);
+}
- }
+#=======================================================================
+#
+# delete_script_code_alias ( CODE [,CODESET] )
+#
+#=======================================================================
+
+sub delete_script_code_alias {
+ my($code,@args) = @_;
+ my $nowarn = 0;
+ $nowarn = 1, pop(@args) if ($args[$#args] eq "nowarn");
+ my $codeset = shift(@args);
+ my $err;
+ ($err,$code,$codeset) = _code($code,$codeset);
- close(DATA);
+ return Locale::Codes::_delete_code_alias("script",$code,$codeset,$nowarn);
}
1;
-
-__DATA__
-am:ama:130:Aramaic
-ar:ara:160:Arabic
-av:ave:151:Avestan
-bh:bhm:300:Brahmi (Ashoka)
-bi:bid:372:Buhid
-bn:ben:325:Bengali
-bo:bod:330:Tibetan
-bp:bpm:285:Bopomofo
-br:brl:570:Braille
-bt:btk:365:Batak
-bu:bug:367:Buginese (Makassar)
-by:bys:550:Blissymbols
-ca:cam:358:Cham
-ch:chu:221:Old Church Slavonic
-ci:cir:291:Cirth
-cm:cmn:402:Cypro-Minoan
-co:cop:205:Coptic
-cp:cpr:403:Cypriote syllabary
-cy:cyr:220:Cyrillic
-ds:dsr:250:Deserel (Mormon)
-dv:dvn:315:Devanagari (Nagari)
-ed:egd:070:Egyptian demotic
-eg:egy:050:Egyptian hieroglyphs
-eh:egh:060:Egyptian hieratic
-el:ell:200:Greek
-eo:eos:210:Etruscan and Oscan
-et:eth:430:Ethiopic
-gl:glg:225:Glagolitic
-gm:gmu:310:Gurmukhi
-gt:gth:206:Gothic
-gu:guj:320:Gujarati
-ha:han:500:Han ideographs
-he:heb:125:Hebrew
-hg:hgl:420:Hangul
-hm:hmo:450:Pahawh Hmong
-ho:hoo:371:Hanunoo
-hr:hrg:410:Hiragana
-hu:hun:176:Old Hungarian runic
-hv:hvn:175:Kok Turki runic
-hy:hye:230:Armenian
-iv:ivl:610:Indus Valley
-ja:jap:930:(alias for Han + Hiragana + Katakana)
-jl:jlg:445:Cherokee syllabary
-jw:jwi:360:Javanese
-ka:kam:241:Georgian (Mxedruli)
-kh:khn:931:(alias for Hangul + Han)
-kk:kkn:411:Katakana
-km:khm:354:Khmer
-kn:kan:345:Kannada
-kr:krn:357:Karenni (Kayah Li)
-ks:kst:305:Kharoshthi
-kx:kax:240:Georgian (Xucuri)
-la:lat:217:Latin
-lf:laf:215:Latin (Fraktur variant)
-lg:lag:216:Latin (Gaelic variant)
-lo:lao:356:Lao
-lp:lpc:335:Lepcha (Rong)
-md:mda:140:Mandaean
-me:mer:100:Meroitic
-mh:may:090:Mayan hieroglyphs
-ml:mlm:347:Malayalam
-mn:mon:145:Mongolian
-my:mya:350:Burmese
-na:naa:400:Linear A
-nb:nbb:401:Linear B
-og:ogm:212:Ogham
-or:ory:327:Oriya
-os:osm:260:Osmanya
-ph:phx:115:Phoenician
-ph:pah:150:Pahlavi
-pl:pld:282:Pollard Phonetic
-pq:pqd:295:Klingon plQaD
-pr:prm:227:Old Permic
-ps:pst:600:Phaistos Disk
-rn:rnr:211:Runic (Germanic)
-rr:rro:620:Rongo-rongo
-sa:sar:110:South Arabian
-si:sin:348:Sinhala
-sj:syj:137:Syriac (Jacobite variant)
-sl:slb:440:Unified Canadian Aboriginal Syllabics
-sn:syn:136:Syriac (Nestorian variant)
-sw:sww:281:Shavian (Shaw)
-sy:syr:135:Syriac (Estrangelo)
-ta:tam:346:Tamil
-tb:tbw:373:Tagbanwa
-te:tel:340:Telugu
-tf:tfn:120:Tifnagh
-tg:tag:370:Tagalog
-th:tha:352:Thai
-tn:tna:170:Thaana
-tw:twr:290:Tengwar
-va:vai:470:Vai
-vs:vsp:280:Visible Speech
-xa:xas:000:Cuneiform, Sumero-Akkadian
-xf:xfa:105:Cuneiform, Old Persian
-xk:xkn:412:(alias for Hiragana + Katakana)
-xu:xug:106:Cuneiform, Ugaritic
-yi:yii:460:Yi
-zx:zxx:997:Unwritten language
-zy:zyy:998:Undetermined script
-zz:zzz:999:Uncoded script
+# Local Variables:
+# mode: cperl
+# indent-tabs-mode: nil
+# cperl-indent-level: 3
+# cperl-continued-statement-offset: 2
+# cperl-continued-brace-offset: 0
+# cperl-brace-offset: 0
+# cperl-brace-imaginary-offset: 0
+# cperl-label-offset: -2
+# End:
+=pod
=head1 NAME
-Locale::Script - ISO codes for script identification (ISO 15924)
+Locale::Script - standard codes for script identification
=head1 SYNOPSIS
- use Locale::Script;
- use Locale::Constants;
-
- $script = code2script('ph'); # 'Phoenician'
- $code = script2code('Tibetan'); # 'bo'
- $code3 = script2code('Tibetan',
- LOCALE_CODE_ALPHA_3); # 'bod'
- $codeN = script2code('Tibetan',
- LOCALE_CODE_ALPHA_NUMERIC); # 330
-
- @codes = all_script_codes();
- @scripts = all_script_names();
-
+ use Locale::Script;
-=head1 DESCRIPTION
-
-The C<Locale::Script> module provides access to the ISO
-codes for identifying scripts, as defined in ISO 15924.
-For example, Egyptian hieroglyphs are denoted by the two-letter
-code 'eg', the three-letter code 'egy', and the numeric code 050.
-
-You can either access the codes via the conversion routines
-(described below), or with the two functions which return lists
-of all script codes or all script names.
-
-There are three different code sets you can use for identifying
-scripts:
-
-=over 4
-
-=item B<alpha-2>
-
-Two letter codes, such as 'bo' for Tibetan.
-This code set is identified with the symbol C<LOCALE_CODE_ALPHA_2>.
-
-=item B<alpha-3>
-
-Three letter codes, such as 'ell' for Greek.
-This code set is identified with the symbol C<LOCALE_CODE_ALPHA_3>.
-
-=item B<numeric>
-
-Numeric codes, such as 410 for Hiragana.
-This code set is identified with the symbol C<LOCALE_CODE_NUMERIC>.
-
-=back
-
-All of the routines take an optional additional argument
-which specifies the code set to use.
-If not specified, it defaults to the two-letter codes.
-This is partly for backwards compatibility (previous versions
-of Locale modules only supported the alpha-2 codes), and
-partly because they are the most widely used codes.
-
-The alpha-2 and alpha-3 codes are not case-dependent,
-so you can use 'BO', 'Bo', 'bO' or 'bo' for Tibetan.
-When a code is returned by one of the functions in
-this module, it will always be lower-case.
-
-=head2 SPECIAL CODES
-
-The standard defines various special codes.
-
-=over 4
-
-=item *
-
-The standard reserves codes in the ranges B<qa> - B<qt>,
-B<qaa> - B<qat>, and B<900> - B<919>, for private use.
-
-=item *
-
-B<zx>, B<zxx>, and B<997>, are the codes for unwritten languages.
-
-=item *
-
-B<zy>, B<zyy>, and B<998>, are the codes for an undetermined script.
+ $script = code2script('phnx'); # 'Phoenician'
+ $code = script2code('Phoenician'); # 'Phnx'
+ $code = script2code('Phoenician',
+ LOCALE_CODE_NUMERIC); # 115
-=item *
+ @codes = all_script_codes();
+ @scripts = all_script_names();
-B<zz>, B<zzz>, and B<999>, are the codes for an uncoded script.
-
-=back
+=head1 DESCRIPTION
-The private codes are not recognised by Locale::Script,
-but the others are.
+The C<Locale::Script> module provides access to standards codes used
+for identifying scripts, such as those defined in ISO 15924.
+Most of the routines take an optional additional argument which
+specifies the code set to use. If not specified, the default ISO
+15924 four-letter codes will be used.
-=head1 CONVERSION ROUTINES
+=head1 SUPPORTED CODE SETS
-There are three conversion routines: C<code2script()>, C<script2code()>,
-and C<script_code2code()>.
+There are several different code sets you can use for identifying
+scripts. The ones currently supported are:
=over 4
-=item code2script( CODE, [ CODESET ] )
-
-This function takes a script code and returns a string
-which contains the name of the script identified.
-If the code is not a valid script code, as defined by ISO 15924,
-then C<undef> will be returned:
+=item B<alpha>
- $script = code2script('cy'); # Cyrillic
+This is a set of four-letter (capitalized) codes from ISO 15924
+such as 'Phnx' for Phoenician.
-=item script2code( STRING, [ CODESET ] )
+This code set is identified with the symbol C<LOCALE_SCRIPT_ALPHA>.
-This function takes a script name and returns the corresponding
-script code, if such exists.
-If the argument could not be identified as a script name,
-then C<undef> will be returned:
+The Zxxx, Zyyy, and Zzzz codes are not used.
- $code = script2code('Gothic', LOCALE_CODE_ALPHA_3);
- # $code will now be 'gth'
+This is the default code set.
-The case of the script name is not important.
-See the section L<KNOWN BUGS AND LIMITATIONS> below.
-
-=item script_code2code( CODE, CODESET, CODESET )
-
-This function takes a script code from one code set,
-and returns the corresponding code from another code set.
+=item B<numeric>
- $alpha2 = script_code2code('jwi',
- LOCALE_CODE_ALPHA_3 => LOCALE_CODE_ALPHA_2);
- # $alpha2 will now be 'jw' (Javanese)
+This is a set of three-digit numeric codes from ISO 15924 such as 115
+for Phoenician.
-If the code passed is not a valid script code in
-the first code set, or if there isn't a code for the
-corresponding script in the second code set,
-then C<undef> will be returned.
+This code set is identified with the symbol C<LOCALE_SCRIPT_NUMERIC>.
=back
-
-=head1 QUERY ROUTINES
-
-There are two function which can be used to obtain a list of all codes,
-or all script names:
+=head1 ROUTINES
=over 4
-=item C<all_script_codes ( [ CODESET ] )>
+=item B<code2script ( CODE [,CODESET] )>
-Returns a list of all two-letter script codes.
-The codes are guaranteed to be all lower-case,
-and not in any particular order.
+=item B<script2code ( NAME [,CODESET] )>
-=item C<all_script_names ( [ CODESET ] )>
+=item B<script_code2code ( CODE ,CODESET ,CODESET2 )>
-Returns a list of all script names for which there is a corresponding
-script code in the specified code set.
-The names are capitalised, and not returned in any particular order.
-
-=back
+=item B<all_script_codes ( [CODESET] )>
+=item B<all_script_names ( [CODESET] )>
-=head1 EXAMPLES
+=item B<Locale::Script::rename_script ( CODE ,NEW_NAME [,CODESET] )>
-The following example illustrates use of the C<code2script()> function.
-The user is prompted for a script code, and then told the corresponding
-script name:
+=item B<Locale::Script::add_script ( CODE ,NAME [,CODESET] )>
- $| = 1; # turn off buffering
-
- print "Enter script code: ";
- chop($code = <STDIN>);
- $script = code2script($code, LOCALE_CODE_ALPHA_2);
- if (defined $script)
- {
- print "$code = $script\n";
- }
- else
- {
- print "'$code' is not a valid script code!\n";
- }
+=item B<Locale::Script::delete_script ( CODE [,CODESET] )>
+=item B<Locale::Script::add_script_alias ( NAME ,NEW_NAME )>
-=head1 KNOWN BUGS AND LIMITATIONS
-
-=over 4
-
-=item *
+=item B<Locale::Script::delete_script_alias ( NAME )>
-When using C<script2code()>, the script name must currently appear
-exactly as it does in the source of the module. For example,
+=item B<Locale::Script::rename_script_code ( CODE ,NEW_CODE [,CODESET] )>
- script2code('Egyptian hieroglyphs')
+=item B<Locale::Script::add_script_code_alias ( CODE ,NEW_CODE [,CODESET] )>
-will return B<eg>, as expected. But the following will all return C<undef>:
+=item B<Locale::Script::delete_script_code_alias ( CODE [,CODESET] )>
- script2code('hieroglyphs')
- script2code('Egyptian Hieroglypics')
-
-If there's need for it, a future version could have variants
-for script names.
-
-=item *
-
-In the current implementation, all data is read in when the
-module is loaded, and then held in memory.
-A lazy implementation would be more memory friendly.
+These routines are all documented in the Locale::Codes man page.
=back
=over 4
-=item Locale::Language
-
-ISO two letter codes for identification of language (ISO 639).
-
-=item Locale::Currency
-
-ISO three letter codes for identification of currencies
-and funds (ISO 4217).
-
-=item Locale::Country
+=item B<Locale::Codes>
-ISO three letter codes for identification of countries (ISO 3166)
+=item B<Locale::Constants>
-=item ISO 15924
-
-The ISO standard which defines these codes.
-
-=item http://www.evertype.com/standards/iso15924/
+=item B<http://www.unicode.org/iso15924/>
Home page for ISO 15924.
-
=back
-
=head1 AUTHOR
-Neil Bowers E<lt>neil@bowers.comE<gt>
+See Locale::Codes for full author history.
+
+Currently maintained by Sullivan Beck (sbeck@cpan.org).
=head1 COPYRIGHT
-Copyright (c) 2002-2004 Neil Bowers.
+ Copyright (c) 1997-2001 Canon Research Centre Europe (CRE).
+ Copyright (c) 2001-2010 Neil Bowers
+ Copyright (c) 2010-2010 Sullivan Beck
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut
-
--- /dev/null
+#!/usr/bin/perl -w
+
+require 5.002;
+
+$runtests=shift(@ARGV);
+if ( -f "t/testfunc.pl" ) {
+ require "t/testfunc.pl";
+ $dir="./lib";
+ $tdir="t";
+} elsif ( -f "testfunc.pl" ) {
+ require "testfunc.pl";
+ $dir="../lib";
+ $tdir=".";
+} else {
+ die "ERROR: cannot find testfunc.pl\n";
+}
+
+unshift(@INC,$dir);
+use Locale::Country;
+
+%type = ( "LOCALE_CODE_ALPHA_2" => LOCALE_CODE_ALPHA_2,
+ "LOCALE_CODE_ALPHA_3" => LOCALE_CODE_ALPHA_3,
+ "LOCALE_CODE_NUMERIC" => LOCALE_CODE_NUMERIC,
+ );
+
+sub test {
+ my(@test) = @_;
+
+ if ($test[0] eq "alias_code") {
+ shift(@test);
+ $test[2] = $type{$test[2]}
+ if (@test == 3 && $test[2] && exists $type{$test[2]});
+ return Locale::Country::alias_code(@test,"nowarn");
+
+ } elsif ($test[0] eq "country2code") {
+ shift(@test);
+ $test[1] = $type{$test[1]} if (@test == 2 && $test[1] && exists $type{$test[1]});
+ return country2code(@test);
+
+ } else {
+ $test[1] = $type{$test[1]}
+ if (@test == 2 && $test[1] && exists $type{$test[1]});
+ return code2country(@test);
+ }
+}
+
+$tests = "
+
+gb
+ ~
+ United Kingdom
+
+uk
+ ~
+ _undef_
+
+country2code
+United Kingdom
+ ~
+ gb
+
+alias_code uk gb LOCALE_CODE_FOO ~ 0
+
+alias_code uk x1 ~ 0
+
+alias_code us gb ~ 0
+
+alias_code uk gb LOCALE_CODE_ALPHA_3 ~ 0
+
+gb
+ ~
+ United Kingdom
+
+uk
+ ~
+ _undef_
+
+country2code
+United Kingdom
+ ~
+ gb
+
+alias_code uk gb ~ uk
+
+gb
+ ~
+ United Kingdom
+
+uk
+ ~
+ United Kingdom
+
+country2code
+United Kingdom
+ ~
+ uk
+
+";
+
+print "alias_code...\n";
+test_Func(\&test,$tests,$runtests);
+
+1;
+# Local Variables:
+# mode: cperl
+# indent-tabs-mode: nil
+# cperl-indent-level: 3
+# cperl-continued-statement-offset: 2
+# cperl-continued-brace-offset: 0
+# cperl-brace-offset: 0
+# cperl-brace-imaginary-offset: 0
+# cperl-label-offset: -2
+# End:
+++ /dev/null
-#!./perl
-#
-# all.t - tests for all_* routines in
-# Locale::Country
-# Locale::Language
-# Locale::Currency
-# Locale::Script
-#
-# There are four tests. We get a list of all codes, convert to
-# language/country/currency, # convert back to code,
-# and check that they're the same. Then we do the same,
-# starting with list of languages/countries/currencies.
-#
-
-use Locale::Country;
-use Locale::Language;
-use Locale::Currency;
-use Locale::Script;
-
-print "1..20\n";
-
-my $code;
-my $language;
-my $country;
-my $ok;
-my $reverse;
-my $currency;
-my $script;
-
-
-#-----------------------------------------------------------------------
-# Old API - without codeset specified, default to ALPHA_2
-#-----------------------------------------------------------------------
-$ok = 1;
-foreach $code (all_country_codes())
-{
- $country = code2country($code);
- if (!defined $country)
- {
- $ok = 0;
- last;
- }
- $reverse = country2code($country);
- if (!defined $reverse)
- {
- $ok = 0;
- last;
- }
- if ($reverse ne $code)
- {
- $ok = 0;
- last;
- }
-}
-print ($ok ? "ok 1\n" : "not ok 1\n");
-
-#-----------------------------------------------------------------------
-# code to country, back to code, for ALPHA2
-#-----------------------------------------------------------------------
-$ok = 1;
-foreach $code (all_country_codes(LOCALE_CODE_ALPHA_2))
-{
- $country = code2country($code, LOCALE_CODE_ALPHA_2);
- if (!defined $country)
- {
- $ok = 0;
- last;
- }
- $reverse = country2code($country, LOCALE_CODE_ALPHA_2);
- if (!defined $reverse)
- {
- $ok = 0;
- last;
- }
- if ($reverse ne $code)
- {
- $ok = 0;
- last;
- }
-}
-print ($ok ? "ok 2\n" : "not ok 2\n");
-
-#-----------------------------------------------------------------------
-# code to country, back to code, for ALPHA3
-#-----------------------------------------------------------------------
-$ok = 1;
-foreach $code (all_country_codes(LOCALE_CODE_ALPHA_3))
-{
- $country = code2country($code, LOCALE_CODE_ALPHA_3);
- if (!defined $country)
- {
- $ok = 0;
- last;
- }
- $reverse = country2code($country, LOCALE_CODE_ALPHA_3);
- if (!defined $reverse)
- {
- $ok = 0;
- last;
- }
- if ($reverse ne $code)
- {
- $ok = 0;
- last;
- }
-}
-print ($ok ? "ok 3\n" : "not ok 3\n");
-
-#-----------------------------------------------------------------------
-# code to country, back to code, for NUMERIC
-#-----------------------------------------------------------------------
-$ok = 1;
-foreach $code (all_country_codes(LOCALE_CODE_NUMERIC))
-{
- $country = code2country($code, LOCALE_CODE_NUMERIC);
- if (!defined $country)
- {
- $ok = 0;
- last;
- }
- $reverse = country2code($country, LOCALE_CODE_NUMERIC);
- if (!defined $reverse)
- {
- $ok = 0;
- last;
- }
- if ($reverse ne $code)
- {
- $ok = 0;
- last;
- }
-}
-print ($ok ? "ok 4\n" : "not ok 4\n");
-
-
-#-----------------------------------------------------------------------
-# Old API - country to code, back to country, using default of ALPHA_2
-#-----------------------------------------------------------------------
-$ok = 1;
-foreach $country (all_country_names())
-{
- $code = country2code($country);
- if (!defined $code)
- {
- $ok = 0;
- last;
- }
- $reverse = code2country($code);
- if (!defined $reverse)
- {
- $ok = 0;
- last;
- }
- if ($reverse ne $country)
- {
- $ok = 0;
- last;
- }
-}
-print ($ok ? "ok 5\n" : "not ok 5\n");
-
-#-----------------------------------------------------------------------
-# country to code, back to country, using LOCALE_CODE_ALPHA_2
-#-----------------------------------------------------------------------
-$ok = 1;
-foreach $country (all_country_names())
-{
- $code = country2code($country, LOCALE_CODE_ALPHA_2);
- if (!defined $code)
- {
- $ok = 0;
- last;
- }
- $reverse = code2country($code, LOCALE_CODE_ALPHA_2);
- if (!defined $reverse)
- {
- $ok = 0;
- last;
- }
- if ($reverse ne $country)
- {
- $ok = 0;
- last;
- }
-}
-print ($ok ? "ok 6\n" : "not ok 6\n");
-
-#-----------------------------------------------------------------------
-# country to code, back to country, using LOCALE_CODE_ALPHA_3
-#-----------------------------------------------------------------------
-$ok = 1;
-foreach $country (all_country_names())
-{
- $code = country2code($country, LOCALE_CODE_ALPHA_3);
- if (!defined $code)
- {
- next if ($country eq 'Antarctica'
- || $country eq 'Bouvet Island'
- || $country eq 'Cocos (Keeling) Islands'
- || $country eq 'Christmas Island'
- || $country eq 'France, Metropolitan'
- || $country eq 'South Georgia and the South Sandwich Islands'
- || $country eq 'Heard Island and McDonald Islands'
- || $country eq 'British Indian Ocean Territory'
- || $country eq 'French Southern Territories'
- || $country eq 'United States Minor Outlying Islands'
- || $country eq 'Mayotte'
- || $country eq 'Zaire');
- $ok = 0;
- last;
- }
- $reverse = code2country($code, LOCALE_CODE_ALPHA_3);
- if (!defined $reverse)
- {
- $ok = 0;
- last;
- }
- if ($reverse ne $country)
- {
- $ok = 0;
- last;
- }
-}
-print ($ok ? "ok 7\n" : "not ok 7\n");
-
-#-----------------------------------------------------------------------
-# country to code, back to country, using LOCALE_CODE_NUMERIC
-#-----------------------------------------------------------------------
-$ok = 1;
-foreach $country (all_country_names())
-{
- $code = country2code($country, LOCALE_CODE_NUMERIC);
- if (!defined $code)
- {
- next if ($country eq 'Antarctica'
- || $country eq 'Bouvet Island'
- || $country eq 'Cocos (Keeling) Islands'
- || $country eq 'Christmas Island'
- || $country eq 'France, Metropolitan'
- || $country eq 'South Georgia and the South Sandwich Islands'
- || $country eq 'Heard Island and McDonald Islands'
- || $country eq 'British Indian Ocean Territory'
- || $country eq 'French Southern Territories'
- || $country eq 'United States Minor Outlying Islands'
- || $country eq 'Mayotte'
- || $country eq 'Zaire');
- $ok = 0;
- last;
- }
- $reverse = code2country($code, LOCALE_CODE_NUMERIC);
- if (!defined $reverse)
- {
- $ok = 0;
- last;
- }
- if ($reverse ne $country)
- {
- $ok = 0;
- last;
- }
-}
-print ($ok ? "ok 8\n" : "not ok 8\n");
-
-
-$ok = 1;
-foreach $code (all_language_codes())
-{
- $language = code2language($code);
- if (!defined $language)
- {
- $ok = 0;
- last;
- }
- $reverse = language2code($language);
- if (!defined $reverse)
- {
- $ok = 0;
- last;
- }
- if ($reverse ne $code)
- {
- $ok = 0;
- last;
- }
-}
-print ($ok ? "ok 9\n" : "not ok 9\n");
-
-
-$ok = 1;
-foreach $language (all_language_names())
-{
- $code = language2code($language);
- if (!defined $code)
- {
- $ok = 0;
- last;
- }
- $reverse = code2language($code);
- if (!defined $reverse)
- {
- $ok = 0;
- last;
- }
- if ($reverse ne $language)
- {
- $ok = 0;
- last;
- }
-}
-print ($ok ? "ok 10\n" : "not ok 10\n");
-
-$ok = 1;
-foreach $code (all_currency_codes())
-{
- $currency = code2currency($code);
- if (!defined $currency)
- {
- $ok = 0;
- last;
- }
- $reverse = currency2code($currency);
- if (!defined $reverse)
- {
- $ok = 0;
- last;
- }
- #
- # three special cases:
- # The Kwacha has two codes - used in Zambia and Malawi
- # The Russian Ruble has two codes - rub and rur
- # The Belarussian Ruble has two codes - byb and byr
- if ($reverse ne $code
- && $code ne 'mwk' && $code ne 'zmk'
- && $code ne 'byr' && $code ne 'byb'
- && $code ne 'rub' && $code ne 'rur')
- {
- $ok = 0;
- last;
- }
-}
-print ($ok ? "ok 11\n" : "not ok 11\n");
-
-$ok = 1;
-foreach $currency (all_currency_names())
-{
- $code = currency2code($currency);
- if (!defined $code)
- {
- $ok = 0;
- last;
- }
- $reverse = code2currency($code);
- if (!defined $reverse)
- {
- $ok = 0;
- last;
- }
- if ($reverse ne $currency)
- {
- $ok = 0;
- last;
- }
-}
-print ($ok ? "ok 12\n" : "not ok 12\n");
-
-#=======================================================================
-#
-# Locale::Script tests
-#
-#=======================================================================
-
-#-----------------------------------------------------------------------
-# Old API - without codeset specified, default to ALPHA_2
-#-----------------------------------------------------------------------
-$ok = 1;
-foreach $code (all_script_codes())
-{
- $script = code2script($code);
- if (!defined $script)
- {
- $ok = 0;
- last;
- }
- $reverse = script2code($script);
- if (!defined $reverse)
- {
- $ok = 0;
- last;
- }
- if ($reverse ne $code)
- {
- $ok = 0;
- last;
- }
-}
-print ($ok ? "ok 13\n" : "not ok 13\n");
-
-#-----------------------------------------------------------------------
-# code to script, back to code, for ALPHA2
-#-----------------------------------------------------------------------
-$ok = 1;
-foreach $code (all_script_codes(LOCALE_CODE_ALPHA_2))
-{
- $script = code2script($code, LOCALE_CODE_ALPHA_2);
- if (!defined $script)
- {
- $ok = 0;
- last;
- }
- $reverse = script2code($script, LOCALE_CODE_ALPHA_2);
- if (!defined $reverse)
- {
- $ok = 0;
- last;
- }
- if ($reverse ne $code)
- {
- $ok = 0;
- last;
- }
-}
-print ($ok ? "ok 14\n" : "not ok 14\n");
-
-#-----------------------------------------------------------------------
-# code to script, back to code, for ALPHA3
-#-----------------------------------------------------------------------
-$ok = 1;
-foreach $code (all_script_codes(LOCALE_CODE_ALPHA_3))
-{
- $script = code2script($code, LOCALE_CODE_ALPHA_3);
- if (!defined $script)
- {
- $ok = 0;
- last;
- }
- $reverse = script2code($script, LOCALE_CODE_ALPHA_3);
- if (!defined $reverse)
- {
- $ok = 0;
- last;
- }
- if ($reverse ne $code)
- {
- $ok = 0;
- last;
- }
-}
-print ($ok ? "ok 15\n" : "not ok 15\n");
-
-#-----------------------------------------------------------------------
-# code to script, back to code, for NUMERIC
-#-----------------------------------------------------------------------
-$ok = 1;
-foreach $code (all_script_codes(LOCALE_CODE_NUMERIC))
-{
- $script = code2script($code, LOCALE_CODE_NUMERIC);
- if (!defined $script)
- {
- $ok = 0;
- last;
- }
- $reverse = script2code($script, LOCALE_CODE_NUMERIC);
- if (!defined $reverse)
- {
- $ok = 0;
- last;
- }
- if ($reverse ne $code)
- {
- $ok = 0;
- last;
- }
-}
-print ($ok ? "ok 16\n" : "not ok 16\n");
-
-
-#-----------------------------------------------------------------------
-# Old API - script to code, back to script, using default of ALPHA_2
-#-----------------------------------------------------------------------
-$ok = 1;
-foreach $script (all_script_names())
-{
- $code = script2code($script);
- if (!defined $code)
- {
- $ok = 0;
- last;
- }
- $reverse = code2script($code);
- if (!defined $reverse)
- {
- $ok = 0;
- last;
- }
- if ($reverse ne $script)
- {
- $ok = 0;
- last;
- }
-}
-print ($ok ? "ok 17\n" : "not ok 17\n");
-
-#-----------------------------------------------------------------------
-# script to code, back to script, using LOCALE_CODE_ALPHA_2
-#-----------------------------------------------------------------------
-$ok = 1;
-foreach $script (all_script_names())
-{
- $code = script2code($script, LOCALE_CODE_ALPHA_2);
- if (!defined $code)
- {
- $ok = 0;
- last;
- }
- $reverse = code2script($code, LOCALE_CODE_ALPHA_2);
- if (!defined $reverse)
- {
- $ok = 0;
- last;
- }
- if ($reverse ne $script)
- {
- $ok = 0;
- last;
- }
-}
-print ($ok ? "ok 18\n" : "not ok 18\n");
-
-#-----------------------------------------------------------------------
-# script to code, back to script, using LOCALE_CODE_ALPHA_3
-#-----------------------------------------------------------------------
-$ok = 1;
-foreach $script (all_script_names())
-{
- $code = script2code($script, LOCALE_CODE_ALPHA_3);
- if (!defined $code)
- {
- $ok = 0;
- last;
- }
- $reverse = code2script($code, LOCALE_CODE_ALPHA_3);
- if (!defined $reverse)
- {
- $ok = 0;
- last;
- }
- if ($reverse ne $script)
- {
- $ok = 0;
- last;
- }
-}
-print ($ok ? "ok 19\n" : "not ok 19\n");
-
-#-----------------------------------------------------------------------
-# script to code, back to script, using LOCALE_CODE_NUMERIC
-#-----------------------------------------------------------------------
-$ok = 1;
-foreach $script (all_script_names())
-{
- $code = script2code($script, LOCALE_CODE_NUMERIC);
- if (!defined $code)
- {
- $ok = 0;
- last;
- }
- $reverse = code2script($code, LOCALE_CODE_NUMERIC);
- if (!defined $reverse)
- {
- $ok = 0;
- last;
- }
- if ($reverse ne $script)
- {
- $ok = 0;
- last;
- }
-}
-print ($ok ? "ok 20\n" : "not ok 20\n");
-
--- /dev/null
+#!/usr/bin/perl -w
+
+require 5.002;
+
+$runtests=shift(@ARGV);
+if ( -f "t/testfunc.pl" ) {
+ require "t/testfunc.pl";
+ $dir="./lib";
+ $tdir="t";
+} elsif ( -f "testfunc.pl" ) {
+ require "testfunc.pl";
+ $dir="../lib";
+ $tdir=".";
+} else {
+ die "ERROR: cannot find testfunc.pl\n";
+}
+
+unshift(@INC,$dir);
+use Locale::Country;
+
+%type = ( "LOCALE_CODE_ALPHA_2" => LOCALE_CODE_ALPHA_2,
+ "LOCALE_CODE_ALPHA_3" => LOCALE_CODE_ALPHA_3,
+ "LOCALE_CODE_NUMERIC" => LOCALE_CODE_NUMERIC,
+ );
+
+sub test {
+ my(@test) = @_;
+ $test[1] = $type{$test[1]} if (@test == 2 && $test[1] && exists $type{$test[1]});
+ return code2country(@test);
+}
+
+$tests = "
+
+~ _undef_
+
+_undef_ ~ _undef_
+
+zz ~ _undef_
+
+zz LOCALE_CODE_ALPHA_2 ~ _undef_
+
+zz LOCALE_CODE_ALPHA_3 ~ _undef_
+
+zz LOCALE_CODE_NUMERIC ~ _undef_
+
+ja ~ _undef_
+
+uk ~ _undef_
+
+BO
+ ~
+ Bolivia, Plurinational State of
+
+BO
+LOCALE_CODE_ALPHA_2
+ ~
+ Bolivia, Plurinational State of
+
+bol
+LOCALE_CODE_ALPHA_3
+ ~
+ Bolivia (Plurinational State of)
+
+pk ~ Pakistan
+
+sn ~ Senegal
+
+us
+ ~
+ United States
+
+ad ~ Andorra
+
+ad LOCALE_CODE_ALPHA_2 ~ Andorra
+
+and LOCALE_CODE_ALPHA_3 ~ Andorra
+
+020 LOCALE_CODE_NUMERIC ~ Andorra
+
+48 LOCALE_CODE_NUMERIC ~ Bahrain
+
+zw ~ Zimbabwe
+
+gb
+ ~
+ United Kingdom
+
+kz ~ Kazakhstan
+
+mo ~ Macao
+
+tl LOCALE_CODE_ALPHA_2 ~ Timor-Leste
+
+tls LOCALE_CODE_ALPHA_3 ~ Timor-Leste
+
+626 LOCALE_CODE_NUMERIC ~ Timor-Leste
+
+BO LOCALE_CODE_ALPHA_3 ~ _undef_
+
+BO LOCALE_CODE_NUMERIC ~ _undef_
+
+ax
+ ~
+ Aland Islands
+
+ala
+LOCALE_CODE_ALPHA_3
+ ~
+ Aland Islands
+
+248
+LOCALE_CODE_NUMERIC
+ ~
+ Aland Islands
+
+scg
+LOCALE_CODE_ALPHA_3
+ ~
+ _undef_
+
+891
+LOCALE_CODE_NUMERIC
+ ~
+ _undef_
+
+rou LOCALE_CODE_ALPHA_3 ~ Romania
+
+";
+
+print "code2country...\n";
+test_Func(\&test,$tests,$runtests);
+
+1;
+# Local Variables:
+# mode: cperl
+# indent-tabs-mode: nil
+# cperl-indent-level: 3
+# cperl-continued-statement-offset: 2
+# cperl-continued-brace-offset: 0
+# cperl-brace-offset: 0
+# cperl-brace-imaginary-offset: 0
+# cperl-label-offset: -2
+# End:
+
--- /dev/null
+#!/usr/bin/perl -w
+
+require 5.002;
+
+$runtests=shift(@ARGV);
+if ( -f "t/testfunc.pl" ) {
+ require "t/testfunc.pl";
+ $dir="./lib";
+ $tdir="t";
+} elsif ( -f "testfunc.pl" ) {
+ require "testfunc.pl";
+ $dir="../lib";
+ $tdir=".";
+} else {
+ die "ERROR: cannot find testfunc.pl\n";
+}
+
+unshift(@INC,$dir);
+use Locale::Currency;
+
+%type = ( "LOCALE_CODE_ALPHA" => LOCALE_CODE_ALPHA,
+ "LOCALE_CODE_NUMERIC" => LOCALE_CODE_NUMERIC,
+ );
+
+sub test {
+ my(@test) = @_;
+ $test[1] = $type{$test[1]}
+ if (@test == 2 && $test[1] && exists $type{$test[1]});
+ return code2currency(@test);
+}
+
+$tests = "
+
+ukp ~ _undef_
+
+zz ~ _undef_
+
+zzz ~ _undef_
+
+zzzz ~ _undef_
+
+~ _undef_
+
+_undef_ ~ _undef_
+
+BOB
+ ~
+ Boliviano
+
+all
+ ~
+ Lek
+
+bnd
+ ~
+ Brunei Dollar
+
+bob
+ ~
+ Boliviano
+
+byr
+ ~
+ Belarussian Ruble
+
+chf
+ ~
+ Swiss Franc
+
+cop
+ ~
+ Colombian Peso
+
+dkk
+ ~
+ Danish Krone
+
+fjd
+ ~
+ Fiji Dollar
+
+idr
+ ~
+ Rupiah
+
+mmk
+ ~
+ Kyat
+
+mvr
+ ~
+ Rufiyaa
+
+mwk
+ ~
+ Kwacha
+
+rub
+ ~
+ Russian Ruble
+
+zmk
+ ~
+ Zambian Kwacha
+
+zwl
+ ~
+ Zimbabwe Dollar
+
+";
+
+print "code2currency...\n";
+test_Func(\&test,$tests,$runtests);
+
+1;
+# Local Variables:
+# mode: cperl
+# indent-tabs-mode: nil
+# cperl-indent-level: 3
+# cperl-continued-statement-offset: 2
+# cperl-continued-brace-offset: 0
+# cperl-brace-offset: 0
+# cperl-brace-imaginary-offset: 0
+# cperl-label-offset: -2
+# End:
--- /dev/null
+#!/usr/bin/perl -w
+
+require 5.002;
+
+$runtests=shift(@ARGV);
+if ( -f "t/testfunc.pl" ) {
+ require "t/testfunc.pl";
+ $dir="./lib";
+ $tdir="t";
+} elsif ( -f "testfunc.pl" ) {
+ require "testfunc.pl";
+ $dir="../lib";
+ $tdir=".";
+} else {
+ die "ERROR: cannot find testfunc.pl\n";
+}
+
+unshift(@INC,$dir);
+use Locale::Language;
+
+%type = ( "LOCALE_CODE_ALPHA_2" => LOCALE_CODE_ALPHA_2,
+ "LOCALE_CODE_ALPHA_3" => LOCALE_CODE_ALPHA_3,
+ "LOCALE_CODE_TERM" => LOCALE_CODE_TERM,
+ );
+
+sub test {
+ my(@test) = @_;
+ $test[1] = $type{$test[1]}
+ if (@test == 2 && $test[1] && exists $type{$test[1]});
+ return code2language(@test);
+}
+
+$tests = "
+
+in ~ _undef_
+
+iw ~ _undef_
+
+ji ~ _undef_
+
+jp ~ _undef_
+
+sh ~ _undef_
+
+zz ~ _undef_
+
+~ _undef_
+
+_undef_ ~ _undef_
+
+DA
+ ~
+ Danish
+
+aa
+ ~
+ Afar
+
+ae
+ ~
+ Avestan
+
+bs
+ ~
+ Bosnian
+
+ce
+ ~
+ Chechen
+
+ch
+ ~
+ Chamorro
+
+cu
+ ~
+ Church Slavic
+
+cv
+ ~
+ Chuvash
+
+en
+ ~
+ English
+
+eo
+ ~
+ Esperanto
+
+fi
+ ~
+ Finnish
+
+gv
+ ~
+ Manx
+
+he
+ ~
+ Hebrew
+
+ho
+ ~
+ Hiri Motu
+
+hz
+ ~
+ Herero
+
+id
+ ~
+ Indonesian
+
+iu
+ ~
+ Inuktitut
+
+ki
+ ~
+ Kikuyu
+
+kj
+ ~
+ Kuanyama
+
+kv
+ ~
+ Komi
+
+kw
+ ~
+ Cornish
+
+lb
+ ~
+ Luxembourgish
+
+mh
+ ~
+ Marshallese
+
+nb
+ ~
+ Bokmal, Norwegian
+
+nd
+ ~
+ Ndebele, North
+
+ng
+ ~
+ Ndonga
+
+nn
+ ~
+ Norwegian Nynorsk
+
+nr
+ ~
+ Ndebele, South
+
+nv
+ ~
+ Navajo
+
+ny
+ ~
+ Chichewa
+
+oc
+ ~
+ Occitan (post 1500)
+
+os
+ ~
+ Ossetian
+
+pi
+ ~
+ Pali
+
+sc
+ ~
+ Sardinian
+
+se
+ ~
+ Northern Sami
+
+ug
+ ~
+ Uighur
+
+yi
+ ~
+ Yiddish
+
+za
+ ~
+ Zhuang
+
+zu
+ ~
+ Zulu
+
+";
+
+print "code2language...\n";
+test_Func(\&test,$tests,$runtests);
+
+1;
+# Local Variables:
+# mode: cperl
+# indent-tabs-mode: nil
+# cperl-indent-level: 3
+# cperl-continued-statement-offset: 2
+# cperl-continued-brace-offset: 0
+# cperl-brace-offset: 0
+# cperl-brace-imaginary-offset: 0
+# cperl-label-offset: -2
+# End:
--- /dev/null
+#!/usr/bin/perl -w
+
+require 5.002;
+
+$runtests=shift(@ARGV);
+if ( -f "t/testfunc.pl" ) {
+ require "t/testfunc.pl";
+ $dir="./lib";
+ $tdir="t";
+} elsif ( -f "testfunc.pl" ) {
+ require "testfunc.pl";
+ $dir="../lib";
+ $tdir=".";
+} else {
+ die "ERROR: cannot find testfunc.pl\n";
+}
+
+unshift(@INC,$dir);
+use Locale::Script;
+
+%type = ( "LOCALE_SCRIPT_ALPHA" => LOCALE_SCRIPT_ALPHA,
+ "LOCALE_SCRIPT_NUMERIC" => LOCALE_SCRIPT_NUMERIC,
+ );
+
+sub test {
+ my(@test) = @_;
+ $test[1] = $type{$test[1]}
+ if (@test == 2 && $test[1] && exists $type{$test[1]});
+ return code2script(@test);
+}
+
+$tests = "
+
+~ _undef_
+
+Phnx ~ Phoenician
+
+phnx ~ Phoenician
+
+115 LOCALE_SCRIPT_NUMERIC ~ Phoenician
+
+";
+
+print "code2script...\n";
+test_Func(\&test,$tests,$runtests);
+
+1;
+# Local Variables:
+# mode: cperl
+# indent-tabs-mode: nil
+# cperl-indent-level: 3
+# cperl-continued-statement-offset: 2
+# cperl-continued-brace-offset: 0
+# cperl-brace-offset: 0
+# cperl-brace-imaginary-offset: 0
+# cperl-label-offset: -2
+# End:
+++ /dev/null
-#!./perl
-#
-# constants.t - tests for Locale::Constants
-#
-
-use Locale::Constants;
-
-print "1..3\n";
-
-if (defined LOCALE_CODE_ALPHA_2
- && defined LOCALE_CODE_ALPHA_3
- && defined LOCALE_CODE_NUMERIC)
-{
- print "ok 1\n";
-}
-else
-{
- print "not ok 1\n";
-}
-
-if (LOCALE_CODE_ALPHA_2 != LOCALE_CODE_ALPHA_3
- && LOCALE_CODE_ALPHA_2 != LOCALE_CODE_NUMERIC
- && LOCALE_CODE_ALPHA_3 != LOCALE_CODE_NUMERIC)
-{
- print "ok 2\n";
-}
-else
-{
- print "not ok 2\n";
-}
-
-if (defined LOCALE_CODE_DEFAULT
- && (LOCALE_CODE_DEFAULT == LOCALE_CODE_ALPHA_2
- || LOCALE_CODE_DEFAULT == LOCALE_CODE_ALPHA_3
- || LOCALE_CODE_DEFAULT == LOCALE_CODE_NUMERIC))
-{
- print "ok 3\n";
-}
-else
-{
- print "not ok 3\n";
-}
-
-exit 0;
-#!./perl
-#
-# country.t - tests for Locale::Country
-#
+#!/usr/bin/perl -w
+
+require 5.002;
+
+$runtests=shift(@ARGV);
+if ( -f "t/testfunc.pl" ) {
+ require "t/testfunc.pl";
+ $dir="./lib";
+ $tdir="t";
+} elsif ( -f "testfunc.pl" ) {
+ require "testfunc.pl";
+ $dir="../lib";
+ $tdir=".";
+} else {
+ die "ERROR: cannot find testfunc.pl\n";
+}
+unshift(@INC,$dir);
use Locale::Country;
-#-----------------------------------------------------------------------
-# This is an array of tests specs. Each spec is [TEST, OK_TO_DIE]
-# Each TEST is eval'd as an expression.
-# If it evaluates to FALSE, then "not ok N" is printed for the test,
-# otherwise "ok N". If the eval dies, then the OK_TO_DIE flag is checked.
-# If it is true (1), the test is treated as passing, otherwise it failed.
-#-----------------------------------------------------------------------
-@TESTS =
-(
- #================================================
- # TESTS FOR code2country
- #================================================
-
- #---- selection of examples which should all result in undef -----------
- ['!defined code2country()', 0], # no argument
- ['!defined code2country(undef)', 0], # undef argument
- ['!defined code2country("zz")', 0], # illegal code
- ['!defined code2country("zz", LOCALE_CODE_ALPHA_2)', 0], # illegal code
- ['!defined code2country("zz", LOCALE_CODE_ALPHA_3)', 0], # illegal code
- ['!defined code2country("zz", LOCALE_CODE_NUMERIC)', 0], # illegal code
- ['!defined code2country("ja")', 0], # should be jp for country
- ['!defined code2country("uk")', 0], # should be jp for country
-
- #---- some successful examples -----------------------------------------
- ['code2country("BO") eq "Bolivia"', 0],
- ['code2country("BO", LOCALE_CODE_ALPHA_2) eq "Bolivia"', 0],
- ['code2country("bol", LOCALE_CODE_ALPHA_3) eq "Bolivia"', 0],
- ['code2country("pk") eq "Pakistan"', 0],
- ['code2country("sn") eq "Senegal"', 0],
- ['code2country("us") eq "United States"', 0],
- ['code2country("ad") eq "Andorra"', 0], # first in DATA segment
- ['code2country("ad", LOCALE_CODE_ALPHA_2) eq "Andorra"', 0],
- ['code2country("and", LOCALE_CODE_ALPHA_3) eq "Andorra"', 0],
- ['code2country("020", LOCALE_CODE_NUMERIC) eq "Andorra"', 0],
- ['code2country(48, LOCALE_CODE_NUMERIC) eq "Bahrain"', 0],
- ['code2country("zw") eq "Zimbabwe"', 0], # last in DATA segment
- ['code2country("gb") eq "United Kingdom"', 0], # United Kingdom is "gb", not "uk"
-
- #-- tests added after changes in the standard 2002-05-20 ------
- ['code2country("kz") eq "Kazakhstan"', 0],
- ['country2code("kazakhstan") eq "kz"', 0],
- ['country2code("kazakstan") eq "kz"', 0],
-
- ['code2country("mo") eq "Macao"', 0],
- ['country2code("macao") eq "mo"', 0],
- ['country2code("macau") eq "mo"', 0],
-
- ['code2country("tl", LOCALE_CODE_ALPHA_2) eq "Timor-Leste"', 0],
- ['code2country("tls", LOCALE_CODE_ALPHA_3) eq "Timor-Leste"', 0],
- ['code2country("626", LOCALE_CODE_NUMERIC) eq "Timor-Leste"', 0],
-
- #================================================
- # TESTS FOR country2code
- #================================================
-
- #---- selection of examples which should all result in undef -----------
- ['!defined code2country("BO", LOCALE_CODE_ALPHA_3)', 0],
- ['!defined code2country("BO", LOCALE_CODE_NUMERIC)', 0],
- ['!defined country2code()', 0], # no argument
- ['!defined country2code(undef)', 0], # undef argument
- ['!defined country2code("Banana")', 0], # illegal country name
-
- #---- some successful examples -----------------------------------------
- ['country2code("japan") eq "jp"', 0],
- ['country2code("japan") ne "ja"', 0],
- ['country2code("Japan") eq "jp"', 0],
- ['country2code("United States") eq "us"', 0],
- ['country2code("United Kingdom") eq "gb"', 0],
- ['country2code("Andorra") eq "ad"', 0], # first in DATA
- ['country2code("Zimbabwe") eq "zw"', 0], # last in DATA
- ['country2code("Iran") eq "ir"', 0], # alias
- ['country2code("North Korea") eq "kp"', 0], # alias
- ['country2code("South Korea") eq "kr"', 0], # alias
- ['country2code("Libya") eq "ly"', 0], # alias
- ['country2code("Syria") eq "sy"', 0], # alias
- ['country2code("Svalbard") eq "sj"', 0], # alias
- ['country2code("Jan Mayen") eq "sj"', 0], # alias
- ['country2code("USA") eq "us"', 0], # alias
- ['country2code("United States of America") eq "us"', 0], # alias
- ['country2code("Great Britain") eq "gb"', 0], # alias
-
- #================================================
- # TESTS FOR country_code2code
- #================================================
-
- #---- selection of examples which should all result in undef -----------
- ['!defined country_code2code("bo", LOCALE_CODE_ALPHA_3, LOCALE_CODE_ALPHA_3)', 0],
- ['!defined country_code2code("zz", LOCALE_CODE_ALPHA_2, LOCALE_CODE_ALPHA_3)', 0],
- ['!defined country_code2code("zz", LOCALE_CODE_ALPHA_3, LOCALE_CODE_ALPHA_3)', 0],
- ['!defined country_code2code("zz", LOCALE_CODE_ALPHA_2)', 1],
- ['!defined country_code2code("bo", LOCALE_CODE_ALPHA_2)', 1],
- ['!defined country_code2code()', 1], # no argument
- ['!defined country_code2code(undef)', 1], # undef argument
-
- #---- some successful examples -----------------------------------------
- ['country_code2code("BO", LOCALE_CODE_ALPHA_2, LOCALE_CODE_ALPHA_3) eq "bol"', 0],
- ['country_code2code("bol", LOCALE_CODE_ALPHA_3, LOCALE_CODE_ALPHA_2) eq "bo"', 0],
- ['country_code2code("zwe", LOCALE_CODE_ALPHA_3, LOCALE_CODE_ALPHA_2) eq "zw"', 0],
- ['country_code2code("858", LOCALE_CODE_NUMERIC, LOCALE_CODE_ALPHA_3) eq "ury"', 0],
- ['country_code2code(858, LOCALE_CODE_NUMERIC, LOCALE_CODE_ALPHA_3) eq "ury"', 0],
- ['country_code2code("tr", LOCALE_CODE_ALPHA_2, LOCALE_CODE_NUMERIC) eq "792"', 0],
-
- #-- tests added for 2.07 release
- ['country2code("Burma") eq "mm"', 0], # alias
- ['country2code("French Southern and Antarctic Lands") eq "tf"', 0], # alias
- ['code2country("ax") eq "Aland Islands"', 0],
- ['country2code("Aland Islands") eq "ax"', 0],
- ['code2country("ala", LOCALE_CODE_ALPHA_3) eq "Aland Islands"', 0],
- ['code2country("248", LOCALE_CODE_NUMERIC) eq "Aland Islands"', 0],
-
- ['country2code("Yugoslavia") eq "cs"', 0], # alias (old name)
- ['country2code("Serbia and Montenegro") eq "cs"', 0], # new name
- ['code2country("scg", LOCALE_CODE_ALPHA_3) eq "Serbia and Montenegro"', 0],
- ['code2country("891", LOCALE_CODE_NUMERIC) eq "Serbia and Montenegro"', 0],
-
- ['country2code("East Timor") eq "tl"', 0], # alias (provisional name)
- ['code2country("rou", LOCALE_CODE_ALPHA_3) eq "Romania"', 0],
-
- ['country2code("Zaire") eq "cd"', 0], # alias (old name)
- ['country2code("Congo, The Democratic Republic of the") eq "cd"', 0], # new name
- ['country2code("Congo, The Democratic Republic of the", LOCALE_CODE_ALPHA_3) eq "cod"', 0], # new name
- ['country2code("Congo, The Democratic Republic of the", LOCALE_CODE_NUMERIC) eq "180"', 0], # new name
-
-);
-
-print "1..", int(@TESTS), "\n";
-
-$testid = 1;
-foreach $test (@TESTS)
-{
- eval "print (($test->[0]) ? \"ok $testid\\n\" : \"not ok $testid\\n\" )";
- if ($@)
- {
- if (!$test->[1])
- {
- print "not ok $testid\n";
- }
- else
- {
- print "ok $testid\n";
- }
- }
- ++$testid;
+%type = ( "LOCALE_CODE_ALPHA_2" => LOCALE_CODE_ALPHA_2,
+ "LOCALE_CODE_ALPHA_3" => LOCALE_CODE_ALPHA_3,
+ "LOCALE_CODE_NUMERIC" => LOCALE_CODE_NUMERIC,
+ "LOCALE_CODE_FIPS" => LOCALE_CODE_FIPS,
+ );
+
+sub test {
+ my(@test) = @_;
+
+ if ($test[0] eq "rename_country") {
+ shift(@test);
+ $test[2] = $type{$test[2]}
+ if (@test == 3 && $test[2] && exists $type{$test[2]});
+ return Locale::Country::rename_country(@test,"nowarn");
+
+ } elsif ($test[0] eq "add_country") {
+ shift(@test);
+ $test[2] = $type{$test[2]}
+ if (@test == 3 && $test[2] && exists $type{$test[2]});
+ return Locale::Country::add_country(@test,"nowarn");
+
+ } elsif ($test[0] eq "delete_country") {
+ shift(@test);
+ $test[1] = $type{$test[1]}
+ if (@test == 2 && $test[1] && exists $type{$test[1]});
+ return Locale::Country::delete_country(@test,"nowarn");
+
+ } elsif ($test[0] eq "add_country_alias") {
+ shift(@test);
+ return Locale::Country::add_country_alias(@test,"nowarn");
+
+ } elsif ($test[0] eq "delete_country_alias") {
+ shift(@test);
+ return Locale::Country::delete_country_alias(@test,"nowarn");
+
+ } elsif ($test[0] eq "rename_country_code") {
+ shift(@test);
+ $test[2] = $type{$test[2]}
+ if (@test == 3 && $test[2] && exists $type{$test[2]});
+ return Locale::Country::rename_country_code(@test,"nowarn");
+
+ } elsif ($test[0] eq "add_country_code_alias") {
+ shift(@test);
+ $test[2] = $type{$test[2]}
+ if (@test == 3 && $test[2] && exists $type{$test[2]});
+ return Locale::Country::add_country_code_alias(@test,"nowarn");
+
+ } elsif ($test[0] eq "delete_country_code_alias") {
+ shift(@test);
+ $test[1] = $type{$test[1]}
+ if (@test == 2 && $test[1] && exists $type{$test[1]});
+ return Locale::Country::delete_country_code_alias(@test,"nowarn");
+
+ } elsif ($test[0] eq "country2code") {
+ shift(@test);
+ $test[1] = $type{$test[1]}
+ if (@test == 2 && $test[1] && exists $type{$test[1]});
+ return country2code(@test);
+
+ } else {
+ shift(@test) if ($test[0] eq "code2country");
+ $test[1] = $type{$test[1]}
+ if (@test == 2 && $test[1] && exists $type{$test[1]});
+ return code2country(@test);
+ }
}
-exit 0;
+$tests = "
+
+###################################
+# Test rename_country
+
+gb
+ ~
+ United Kingdom
+
+rename_country x1 NewName ~ 0
+
+rename_country gb NewName LOCALE_CODE_FOO ~ 0
+
+rename_country gb Macao ~ 0
+
+rename_country gb NewName LOCALE_CODE_ALPHA_3 ~ 0
+
+gb
+ ~
+ United Kingdom
+
+rename_country gb NewName ~ 1
+
+gb
+ ~
+ NewName
+
+###################################
+# Test add_country
+
+xx ~ _undef_
+
+add_country xx Bolivia ~ 0
+
+add_country fi Xxxxx ~ 0
+
+add_country xx Xxxxx ~ 1
+
+xx ~ Xxxxx
+
+###################################
+# Test add_country_alias
+
+add_country_alias FooBar NewName ~ 0
+
+add_country_alias Australia Angola ~ 0
+
+country2code Australia ~ au
+
+country2code DownUnder ~ _undef_
+
+add_country_alias Australia DownUnder ~ 1
+
+country2code DownUnder ~ au
+
+###################################
+# Test delete_country_alias
+
+country2code uk ~ gb
+
+delete_country_alias Foobar ~ 0
+
+delete_country_alias UK ~ 1
+
+country2code uk ~ _undef_
+
+delete_country_alias Angola ~ 0
+
+###################################
+# Test delete_country
+
+country2code Angola ~ ao
+
+country2code Angola LOCALE_CODE_ALPHA_3 ~ ago
+
+delete_country ao ~ 1
+
+country2code Angola ~ _undef_
+
+country2code Angola LOCALE_CODE_ALPHA_3 ~ ago
+
+###################################
+# Test rename_country_code
+
+code2country zz ~ _undef_
+
+code2country ar ~ Argentina
+
+country2code Argentina ~ ar
+
+rename_country_code ar us ~ 0
+
+rename_country_code ar zz ~ 1
+
+rename_country_code us ar ~ 0
+
+code2country zz ~ Argentina
+
+code2country ar ~ Argentina
+
+country2code Argentina ~ zz
+
+rename_country_code zz ar ~ 1
+
+code2country zz ~ Argentina
+
+code2country ar ~ Argentina
+
+country2code Argentina ~ ar
+
+###################################
+# Test add_country_code_alias and
+# delete_country_code_alias
+
+code2country bm ~ Bermuda
+
+code2country yy ~ _undef_
+
+country2code Bermuda ~ bm
+
+add_country_code_alias bm us ~ 0
+
+add_country_code_alias bm zz ~ 0
+
+add_country_code_alias bm yy ~ 1
+
+code2country bm ~ Bermuda
+
+code2country yy ~ Bermuda
+
+country2code Bermuda ~ bm
+
+delete_country_code_alias us ~ 0
+
+delete_country_code_alias ww ~ 0
+
+delete_country_code_alias yy ~ 1
+
+code2country bm ~ Bermuda
+
+code2country yy ~ _undef_
+
+country2code Bermuda ~ bm
+
+";
+
+print "country (semi-private)...\n";
+test_Func(\&test,$tests,$runtests);
+
+1;
+# Local Variables:
+# mode: cperl
+# indent-tabs-mode: nil
+# cperl-indent-level: 3
+# cperl-continued-statement-offset: 2
+# cperl-continued-brace-offset: 0
+# cperl-brace-offset: 0
+# cperl-brace-imaginary-offset: 0
+# cperl-label-offset: -2
+# End:
--- /dev/null
+#!/usr/bin/perl -w
+
+require 5.002;
+
+$runtests=shift(@ARGV);
+if ( -f "t/testfunc.pl" ) {
+ require "t/testfunc.pl";
+ $dir="./lib";
+ $tdir="t";
+} elsif ( -f "testfunc.pl" ) {
+ require "testfunc.pl";
+ $dir="../lib";
+ $tdir=".";
+} else {
+ die "ERROR: cannot find testfunc.pl\n";
+}
+
+unshift(@INC,$dir);
+use Locale::Country;
+
+%type = ( "LOCALE_CODE_ALPHA_2" => LOCALE_CODE_ALPHA_2,
+ "LOCALE_CODE_ALPHA_3" => LOCALE_CODE_ALPHA_3,
+ "LOCALE_CODE_NUMERIC" => LOCALE_CODE_NUMERIC,
+ );
+
+sub test {
+ my(@test) = @_;
+ $test[1] = $type{$test[1]} if (@test == 2 && $test[1] && exists $type{$test[1]});
+ return country2code(@test);
+}
+
+$tests = "
+
+kazakhstan
+ ~
+ kz
+
+kazakstan
+ ~
+ kz
+
+macao
+ ~
+ mo
+
+macau
+ ~
+ mo
+
+
+~ _undef_
+
+_undef_
+ ~
+ _undef_
+
+Banana
+ ~
+ _undef_
+
+japan
+ ~
+ jp
+
+Japan
+ ~
+ jp
+
+United States
+ ~
+ us
+
+United Kingdom
+ ~
+ gb
+
+Andorra
+ ~
+ ad
+
+Zimbabwe
+ ~
+ zw
+
+Iran
+ ~
+ ir
+
+North Korea
+ ~
+ kp
+
+South Korea
+ ~
+ kr
+
+Libya
+ ~
+ ly
+
+Syria
+ ~
+ sy
+
+Svalbard
+ ~
+ _undef_
+
+Jan Mayen
+ ~
+ _undef_
+
+USA
+ ~
+ us
+
+United States of America
+ ~
+ us
+
+Great Britain
+ ~
+ gb
+
+Burma
+ ~
+ mm
+
+French Southern and Antarctic Lands
+ ~
+ tf
+
+Aland Islands
+ ~
+ ax
+
+Yugoslavia
+ ~
+ _undef_
+
+Serbia and Montenegro
+ ~
+ _undef_
+
+East Timor
+ ~
+ tl
+
+Zaire
+ ~
+ _undef_
+
+Congo, The Democratic Republic of the
+ ~
+ cd
+
+Congo, The Democratic Republic of the
+LOCALE_CODE_ALPHA_3
+ ~
+ cod
+
+Congo, The Democratic Republic of the
+LOCALE_CODE_NUMERIC
+ ~
+ 180
+
+";
+
+print "country2code...\n";
+test_Func(\&test,$tests,$runtests);
+
+1;
+# Local Variables:
+# mode: cperl
+# indent-tabs-mode: nil
+# cperl-indent-level: 3
+# cperl-continued-statement-offset: 2
+# cperl-continued-brace-offset: 0
+# cperl-brace-offset: 0
+# cperl-brace-imaginary-offset: 0
+# cperl-label-offset: -2
+# End:
+
--- /dev/null
+#!/usr/bin/perl -w
+
+require 5.002;
+
+$runtests=shift(@ARGV);
+if ( -f "t/testfunc.pl" ) {
+ require "t/testfunc.pl";
+ $dir="./lib";
+ $tdir="t";
+} elsif ( -f "testfunc.pl" ) {
+ require "testfunc.pl";
+ $dir="../lib";
+ $tdir=".";
+} else {
+ die "ERROR: cannot find testfunc.pl\n";
+}
+
+unshift(@INC,$dir);
+use Locale::Country;
+use Locale::Constants;
+
+%type = ( "LOCALE_CODE_ALPHA_2" => LOCALE_CODE_ALPHA_2,
+ "LOCALE_CODE_ALPHA_3" => LOCALE_CODE_ALPHA_3,
+ "LOCALE_CODE_NUMERIC" => LOCALE_CODE_NUMERIC,
+ );
+
+sub test {
+ my($code,$type_in,$type_out) = @_;
+ $type_in = $type{$type_in} if ($type_in && exists $type{$type_in});
+ $type_out = $type{$type_out} if ($type_out && exists $type{$type_out});
+
+ return country_code2code($code,$type_in,$type_out);
+}
+
+$tests = "
+
+bo LOCALE_CODE_ALPHA_2 LOCALE_CODE_ALPHA_2 ~ bo
+
+bo LOCALE_CODE_ALPHA_3 LOCALE_CODE_ALPHA_3 ~ _undef_
+
+zz LOCALE_CODE_ALPHA_2 LOCALE_CODE_ALPHA_3 ~ _undef_
+
+zz LOCALE_CODE_ALPHA_3 LOCALE_CODE_ALPHA_3 ~ _undef_
+
+zz LOCALE_CODE_ALPHA_2 0 ~ _undef_
+
+bo LOCALE_CODE_ALPHA_2 0 ~ _undef_
+
+_blank_ 0 0 ~ _undef_
+
+BO LOCALE_CODE_ALPHA_2 LOCALE_CODE_ALPHA_3 ~ bol
+
+bol LOCALE_CODE_ALPHA_3 LOCALE_CODE_ALPHA_2 ~ bo
+
+zwe LOCALE_CODE_ALPHA_3 LOCALE_CODE_ALPHA_2 ~ zw
+
+858 LOCALE_CODE_NUMERIC LOCALE_CODE_ALPHA_3 ~ ury
+
+858 LOCALE_CODE_NUMERIC LOCALE_CODE_ALPHA_3 ~ ury
+
+tr LOCALE_CODE_ALPHA_2 LOCALE_CODE_NUMERIC ~ 792
+
+";
+
+print "country_code2code...\n";
+test_Func(\&test,$tests,$runtests);
+
+1;
+# Local Variables:
+# mode: cperl
+# indent-tabs-mode: nil
+# cperl-indent-level: 3
+# cperl-continued-statement-offset: 2
+# cperl-continued-brace-offset: 0
+# cperl-brace-offset: 0
+# cperl-brace-imaginary-offset: 0
+# cperl-label-offset: -2
+# End:
+++ /dev/null
-#!./perl
-#
-# currency.t - tests for Locale::Currency
-#
-use Locale::Currency;
-
-#-----------------------------------------------------------------------
-# This is an array of tests. Each test is eval'd as an expression.
-# If it evaluates to FALSE, then "not ok N" is printed for the test,
-# otherwise "ok N".
-#-----------------------------------------------------------------------
-@TESTS =
-(
- #================================================
- # TESTS FOR code2currency
- #================================================
-
- #---- selection of examples which should all result in undef -----------
- '!defined code2currency()', # no argument => undef returned
- '!defined code2currency(undef)', # undef arg => undef returned
- '!defined code2currency("zz")', # illegal code => undef
- '!defined code2currency("zzzz")', # illegal code => undef
- '!defined code2currency("zzz")', # illegal code => undef
- '!defined code2currency("ukp")', # gbp for sterling, not ukp
-
- #---- misc tests -------------------------------------------------------
- 'code2currency("all") eq "Lek"',
- 'code2currency("ats") eq "Schilling"',
- 'code2currency("bob") eq "Boliviano"',
- 'code2currency("bnd") eq "Brunei Dollar"',
- 'code2currency("cop") eq "Colombian Peso"',
- 'code2currency("dkk") eq "Danish Krone"',
- 'code2currency("fjd") eq "Fiji Dollar"',
- 'code2currency("idr") eq "Rupiah"',
- 'code2currency("chf") eq "Swiss Franc"',
- 'code2currency("mvr") eq "Rufiyaa"',
- 'code2currency("mmk") eq "Kyat"',
- 'code2currency("mwk") eq "Kwacha"', # two different codes for Kwacha
- 'code2currency("zmk") eq "Kwacha"', # used in Zambia and Malawi
- 'code2currency("byr") eq "Belarussian Ruble"', # 2 codes for belarussian ruble
- 'code2currency("byb") eq "Belarussian Ruble"', #
- 'code2currency("rub") eq "Russian Ruble"', # 2 codes for russian ruble
- 'code2currency("rur") eq "Russian Ruble"', #
-
- #---- some successful examples -----------------------------------------
- 'code2currency("BOB") eq "Boliviano"',
- 'code2currency("adp") eq "Andorran Peseta"', # first in DATA segment
- 'code2currency("zwd") eq "Zimbabwe Dollar"', # last in DATA segment
-
- #================================================
- # TESTS FOR currency2code
- #================================================
-
- #---- selection of examples which should all result in undef -----------
- '!defined currency2code()', # no argument => undef returned
- '!defined currency2code(undef)', # undef arg => undef returned
- '!defined currency2code("")', # empty string => undef returned
- '!defined currency2code("Banana")', # illegal curr name => undef
-
- #---- some successful examples -----------------------------------------
- 'currency2code("Kroon") eq "eek"',
- 'currency2code("Markka") eq "fim"',
- 'currency2code("Riel") eq "khr"',
- 'currency2code("PULA") eq "bwp"',
- 'currency2code("Andorran Peseta") eq "adp"', # first in DATA segment
- 'currency2code("Zimbabwe Dollar") eq "zwd"', # last in DATA segment
- 'currency2code("Canadian Dollar") eq "cad"', # last in DATA segment
-);
-
-print "1..", int(@TESTS), "\n";
-
-$testid = 1;
-foreach $test (@TESTS)
-{
- eval "print (($test) ? \"ok $testid\\n\" : \"not ok $testid\\n\" )";
- print "not ok $testid\n" if $@;
- ++$testid;
-}
-
-exit 0;
--- /dev/null
+#!/usr/bin/perl -w
+
+require 5.002;
+
+$runtests=shift(@ARGV);
+if ( -f "t/testfunc.pl" ) {
+ require "t/testfunc.pl";
+ $dir="./lib";
+ $tdir="t";
+} elsif ( -f "testfunc.pl" ) {
+ require "testfunc.pl";
+ $dir="../lib";
+ $tdir=".";
+} else {
+ die "ERROR: cannot find testfunc.pl\n";
+}
+
+unshift(@INC,$dir);
+use Locale::Currency;
+
+%type = ( "LOCALE_CODE_ALPHA" => LOCALE_CODE_ALPHA,
+ "LOCALE_CODE_NUMERIC" => LOCALE_CODE_NUMERIC,
+ );
+
+sub test {
+ my(@test) = @_;
+ $test[1] = $type{$test[1]}
+ if (@test == 2 && $test[1] && exists $type{$test[1]});
+ return currency2code(@test);
+}
+
+$tests = "
+
+_blank_ ~ _undef_
+
+Banana ~ _undef_
+
+~ _undef_
+
+_undef_ ~ _undef_
+
+
+Canadian Dollar
+ ~
+ CAD
+
+Kroon
+ ~
+ EEK
+
+PULA
+ ~
+ BWP
+
+Riel
+ ~
+ KHR
+
+Zimbabwe Dollar
+ ~
+ ZWL
+
+";
+
+print "currency2code...\n";
+test_Func(\&test,$tests,$runtests);
+
+1;
+# Local Variables:
+# mode: cperl
+# indent-tabs-mode: nil
+# cperl-indent-level: 3
+# cperl-continued-statement-offset: 2
+# cperl-continued-brace-offset: 0
+# cperl-brace-offset: 0
+# cperl-brace-imaginary-offset: 0
+# cperl-label-offset: -2
+# End:
-#!./perl
-#
-# language.t - tests for Locale::Language
-#
-
-BEGIN {
- chdir 't' if -d 't';
- #@INC = '../lib';
+#!/usr/bin/perl -w
+
+require 5.002;
+
+$runtests=shift(@ARGV);
+if ( -f "t/testfunc.pl" ) {
+ require "t/testfunc.pl";
+ $dir="./lib";
+ $tdir="t";
+} elsif ( -f "testfunc.pl" ) {
+ require "testfunc.pl";
+ $dir="../lib";
+ $tdir=".";
+} else {
+ die "ERROR: cannot find testfunc.pl\n";
}
+unshift(@INC,$dir);
use Locale::Language;
-no utf8; # we contain Latin-1
-
-#-----------------------------------------------------------------------
-# This is an array of tests. Each test is eval'd as an expression.
-# If it evaluates to FALSE, then "not ok N" is printed for the test,
-# otherwise "ok N".
-#-----------------------------------------------------------------------
-@TESTS =
-(
- #================================================
- # TESTS FOR code2language
- #================================================
-
- #---- selection of examples which should all result in undef -----------
- '!defined code2language()', # no argument => undef returned
- '!defined code2language(undef)', # undef arg => undef returned
- '!defined code2language("zz")', # illegal code => undef
- '!defined code2language("jp")', # ja for lang, jp for country
-
- #---- test recent changes ----------------------------------------------
- 'code2language("ae") eq "Avestan"',
- 'code2language("bs") eq "Bosnian"',
- 'code2language("ch") eq "Chamorro"',
- 'code2language("ce") eq "Chechen"',
- 'code2language("cu") eq "Church Slavic"',
- 'code2language("cv") eq "Chuvash"',
- 'code2language("hz") eq "Herero"',
- 'code2language("ho") eq "Hiri Motu"',
- 'code2language("ki") eq "Kikuyu"',
- 'code2language("kj") eq "Kuanyama"',
- 'code2language("kv") eq "Komi"',
- 'code2language("mh") eq "Marshall"',
- 'code2language("nv") eq "Navajo"',
- 'code2language("nr") eq "Ndebele, South"',
- 'code2language("nd") eq "Ndebele, North"',
- 'code2language("ng") eq "Ndonga"',
- 'code2language("nn") eq "Norwegian Nynorsk"',
- 'code2language("nb") eq "Norwegian Bokmal"',
- 'code2language("ny") eq "Chichewa; Nyanja"',
- 'code2language("oc") eq "Occitan (post 1500)"',
- 'code2language("os") eq "Ossetian; Ossetic"',
- 'code2language("pi") eq "Pali"',
- '!defined code2language("sh")', # Serbo-Croatian withdrawn
- 'code2language("se") eq "Sami"',
- 'code2language("sc") eq "Sardinian"',
- 'code2language("kw") eq "Cornish"',
- 'code2language("gv") eq "Manx"',
- 'code2language("lb") eq "Letzeburgesch"',
- 'code2language("he") eq "Hebrew"',
- '!defined code2language("iw")', # Hebrew withdrawn
- 'code2language("id") eq "Indonesian"',
- '!defined code2language("in")', # Indonesian withdrawn
- 'code2language("iu") eq "Inuktitut"',
- 'code2language("ug") eq "Uighur"',
- '!defined code2language("ji")', # Yiddish withdrawn
- 'code2language("yi") eq "Yiddish"',
- 'code2language("za") eq "Zhuang"',
-
- #---- some successful examples -----------------------------------------
- 'code2language("DA") eq "Danish"',
- 'code2language("eo") eq "Esperanto"',
- 'code2language("fi") eq "Finnish"',
- 'code2language("en") eq "English"',
- 'code2language("aa") eq "Afar"', # first in DATA segment
- 'code2language("zu") eq "Zulu"', # last in DATA segment
-
- #================================================
- # TESTS FOR language2code
- #================================================
-
- #---- selection of examples which should all result in undef -----------
- '!defined language2code()', # no argument => undef returned
- '!defined language2code(undef)', # undef arg => undef returned
- '!defined language2code("Banana")', # illegal lang name => undef
-
- #---- some successful examples -----------------------------------------
- 'language2code("Japanese") eq "ja"',
- 'language2code("japanese") eq "ja"',
- 'language2code("japanese") ne "jp"',
- 'language2code("French") eq "fr"',
- 'language2code("Greek") eq "el"',
- 'language2code("english") eq "en"',
- 'language2code("ESTONIAN") eq "et"',
- 'language2code("Afar") eq "aa"', # first in DATA segment
- 'language2code("Zulu") eq "zu"', # last in DATA segment
-);
-
-print "1..", int(@TESTS), "\n";
-
-$testid = 1;
-foreach $test (@TESTS)
-{
- eval "print (($test) ? \"ok $testid\\n\" : \"not ok $testid\\n\" )";
- print "not ok $testid\n" if $@;
- ++$testid;
+%type = ( "LOCALE_LANG_ALPHA_2" => LOCALE_LANG_ALPHA_2,
+ "LOCALE_LANG_ALPHA_3" => LOCALE_LANG_ALPHA_3,
+ "LOCALE_LANG_TERM" => LOCALE_LANG_TERM,
+ );
+
+sub test {
+ my(@test) = @_;
+
+ if ($test[0] eq "rename_language") {
+ shift(@test);
+ $test[2] = $type{$test[2]}
+ if (@test == 3 && $test[2] && exists $type{$test[2]});
+ return Locale::Language::rename_language(@test,"nowarn");
+
+ } elsif ($test[0] eq "add_language") {
+ shift(@test);
+ $test[2] = $type{$test[2]}
+ if (@test == 3 && $test[2] && exists $type{$test[2]});
+ return Locale::Language::add_language(@test,"nowarn");
+
+ } elsif ($test[0] eq "delete_language") {
+ shift(@test);
+ $test[1] = $type{$test[1]}
+ if (@test == 2 && $test[1] && exists $type{$test[1]});
+ return Locale::Language::delete_language(@test,"nowarn");
+
+ } elsif ($test[0] eq "add_language_alias") {
+ shift(@test);
+ return Locale::Language::add_language_alias(@test,"nowarn");
+
+ } elsif ($test[0] eq "delete_language_alias") {
+ shift(@test);
+ return Locale::Language::delete_language_alias(@test,"nowarn");
+
+ } elsif ($test[0] eq "language2code") {
+ shift(@test);
+ $test[1] = $type{$test[1]}
+ if (@test == 2 && $test[1] && exists $type{$test[1]});
+ return language2code(@test);
+
+ } else {
+ $test[1] = $type{$test[1]}
+ if (@test == 2 && $test[1] && exists $type{$test[1]});
+ return code2language(@test);
+ }
}
-exit 0;
+$tests = "
+
+zu ~ Zulu
+
+rename_language zu NewName LOCALE_LANG_FOO ~ 0
+
+rename_language zu English LOCALE_LANG_ALPHA_2 ~ 0
+
+rename_language zu NewName LOCALE_LANG_ALPHA_3 ~ 0
+
+zu ~ Zulu
+
+rename_language zu NewName LOCALE_LANG_ALPHA_2 ~ 1
+
+zu ~ NewName
+
+";
+
+print "language (semi-private)...\n";
+test_Func(\&test,$tests,$runtests);
+
+1;
+# Local Variables:
+# mode: cperl
+# indent-tabs-mode: nil
+# cperl-indent-level: 3
+# cperl-continued-statement-offset: 2
+# cperl-continued-brace-offset: 0
+# cperl-brace-offset: 0
+# cperl-brace-imaginary-offset: 0
+# cperl-label-offset: -2
+# End:
--- /dev/null
+#!/usr/bin/perl -w
+
+require 5.002;
+
+$runtests=shift(@ARGV);
+if ( -f "t/testfunc.pl" ) {
+ require "t/testfunc.pl";
+ $dir="./lib";
+ $tdir="t";
+} elsif ( -f "testfunc.pl" ) {
+ require "testfunc.pl";
+ $dir="../lib";
+ $tdir=".";
+} else {
+ die "ERROR: cannot find testfunc.pl\n";
+}
+
+unshift(@INC,$dir);
+use Locale::Language;
+
+%type = ( "LOCALE_CODE_ALPHA_2" => LOCALE_CODE_ALPHA_2,
+ "LOCALE_CODE_ALPHA_3" => LOCALE_CODE_ALPHA_3,
+ "LOCALE_CODE_TERM" => LOCALE_CODE_TERM,
+ );
+
+sub test {
+ my(@test) = @_;
+ $test[1] = $type{$test[1]}
+ if (@test == 2 && $test[1] && exists $type{$test[1]});
+ return language2code(@test);
+}
+
+$tests = "
+
+Banana ~ _undef_
+
+~ _undef_
+
+_undef_ ~ _undef_
+
+Afar
+ ~
+ aa
+
+ESTONIAN
+ ~
+ et
+
+French
+ ~
+ fr
+
+Greek
+ ~
+ el
+
+Japanese
+ ~
+ ja
+
+Zulu
+ ~
+ zu
+
+english
+ ~
+ en
+
+japanese
+ ~
+ ja
+
+";
+
+print "language2code...\n";
+test_Func(\&test,$tests,$runtests);
+
+1;
+# Local Variables:
+# mode: cperl
+# indent-tabs-mode: nil
+# cperl-indent-level: 3
+# cperl-continued-statement-offset: 2
+# cperl-continued-brace-offset: 0
+# cperl-brace-offset: 0
+# cperl-brace-imaginary-offset: 0
+# cperl-label-offset: -2
+# End:
+++ /dev/null
-#!./perl
-#
-# rename.t - tests for Locale::Country with "uk" aliases to "gb"
-#
-
-use Locale::Country;
-
-local $SIG{__WARN__} = sub { }; # muffle warnings from carp
-
-Locale::Country::rename_country('gb' => 'Great Britain');
-
-#-----------------------------------------------------------------------
-# This is an array of tests. Each test is eval'd as an expression.
-# If it evaluates to FALSE, then "not ok N" is printed for the test,
-# otherwise "ok N".
-#-----------------------------------------------------------------------
-@TESTS =
-(
- #================================================
- # TESTS FOR code2country
- #================================================
-
- #---- selection of examples which should all result in undef -----------
- '!defined code2country()', # no argument
- '!defined code2country(undef)', # undef argument
- '!defined code2country("zz")', # illegal code
- '!defined code2country("ja")', # should be jp for country
- '!defined code2country("uk")', # code for United Kingdom is 'gb'
-
- #---- this call should return 0, since code doesn't exist --------------
- '!Locale::Country::rename_country("ukz", "United Karz")',
-
- #---- some successful examples -----------------------------------------
- 'code2country("BO") eq "Bolivia"',
- 'code2country("pk") eq "Pakistan"',
- 'code2country("sn") eq "Senegal"',
- 'code2country("us") eq "United States"',
- 'code2country("ad") eq "Andorra"', # first in DATA segment
- 'code2country("zw") eq "Zimbabwe"', # last in DATA segment
- 'code2country("gb") eq "Great Britain"', # normally "United Kingdom"
-
- #================================================
- # TESTS FOR country2code
- #================================================
-
- #---- selection of examples which should all result in undef -----------
- '!defined country2code()', # no argument
- '!defined country2code(undef)', # undef argument
- '!defined country2code("Banana")', # illegal country name
-
- #---- some successful examples -----------------------------------------
- 'country2code("japan") eq "jp"',
- 'country2code("japan") ne "ja"',
- 'country2code("Japan") eq "jp"',
- 'country2code("United States") eq "us"',
-
- 'country2code("Great Britain") eq "gb"',
- 'country2code("Great Britain", LOCALE_CODE_ALPHA_3) eq "gbr"',
- 'country2code("Great Britain", LOCALE_CODE_NUMERIC) eq "826"',
-
- 'country2code("United Kingdom") eq "gb"',
- 'country2code("United Kingdom", LOCALE_CODE_ALPHA_3) eq "gbr"',
- 'country2code("United Kingdom", LOCALE_CODE_NUMERIC) eq "826"',
-
- 'country2code("Andorra") eq "ad"', # first in DATA segment
- 'country2code("Zimbabwe") eq "zw"', # last in DATA segment
-);
-
-print "1..", int(@TESTS), "\n";
-
-$testid = 1;
-foreach $test (@TESTS)
-{
- eval "print (($test) ? \"ok $testid\\n\" : \"not ok $testid\\n\" )";
- print "not ok $testid\n" if $@;
- ++$testid;
-}
-
-exit 0;
+++ /dev/null
-#!./perl
-#
-# script.t - tests for Locale::Script
-#
-
-use Locale::Script;
-
-#-----------------------------------------------------------------------
-# This is an array of tests specs. Each spec is [TEST, OK_TO_DIE]
-# Each TEST is eval'd as an expression.
-# If it evaluates to FALSE, then "not ok N" is printed for the test,
-# otherwise "ok N". If the eval dies, then the OK_TO_DIE flag is checked.
-# If it is true (1), the test is treated as passing, otherwise it failed.
-#-----------------------------------------------------------------------
-@TESTS =
-(
- #================================================
- # TESTS FOR code2script
- #================================================
-
- #---- selection of examples which should all result in undef -----------
- ['!defined code2script()', 0], # no argument
- ['!defined code2script(undef)', 0], # undef argument
- ['!defined code2script("aa")', 0], # illegal code
- ['!defined code2script("aa", LOCALE_CODE_ALPHA_2)', 0], # illegal code
- ['!defined code2script("aa", LOCALE_CODE_ALPHA_3)', 0], # illegal code
- ['!defined code2script("aa", LOCALE_CODE_NUMERIC)', 0], # illegal code
-
- #---- some successful examples -----------------------------------------
- ['code2script("BO") eq "Tibetan"', 0],
- ['code2script("Bo") eq "Tibetan"', 0],
- ['code2script("bo") eq "Tibetan"', 0],
- ['code2script("bo", LOCALE_CODE_ALPHA_2) eq "Tibetan"', 0],
- ['code2script("bod", LOCALE_CODE_ALPHA_3) eq "Tibetan"', 0],
- ['code2script("330", LOCALE_CODE_NUMERIC) eq "Tibetan"', 0],
-
- ['code2script("yi", LOCALE_CODE_ALPHA_2) eq "Yi"', 0], # last in DATA
- ['code2script("Yii", LOCALE_CODE_ALPHA_3) eq "Yi"', 0],
- ['code2script("460", LOCALE_CODE_NUMERIC) eq "Yi"', 0],
-
- ['code2script("am") eq "Aramaic"', 0], # first in DATA segment
-
-
- #================================================
- # TESTS FOR script2code
- #================================================
-
- #---- selection of examples which should all result in undef -----------
- ['!defined code2script("BO", LOCALE_CODE_ALPHA_3)', 0],
- ['!defined code2script("BO", LOCALE_CODE_NUMERIC)', 0],
- ['!defined script2code()', 0], # no argument
- ['!defined script2code(undef)', 0], # undef argument
- ['!defined script2code("Banana")', 0], # illegal script name
-
- #---- some successful examples -----------------------------------------
- ['script2code("meroitic") eq "me"', 0],
- ['script2code("burmese") eq "my"', 0],
- ['script2code("Pahlavi") eq "ph"', 0],
- ['script2code("Vai", LOCALE_CODE_ALPHA_3) eq "vai"', 0],
- ['script2code("Tamil", LOCALE_CODE_NUMERIC) eq "346"', 0],
- ['script2code("Latin") eq "la"', 0],
- ['script2code("Latin", LOCALE_CODE_ALPHA_3) eq "lat"', 0],
-
- #================================================
- # TESTS FOR script_code2code
- #================================================
-
- #---- selection of examples which should all result in undef -----------
- ['!defined script_code2code("bo", LOCALE_CODE_ALPHA_3, LOCALE_CODE_ALPHA_3)', 0],
- ['!defined script_code2code("aa", LOCALE_CODE_ALPHA_2, LOCALE_CODE_ALPHA_3)', 0],
- ['!defined script_code2code("aa", LOCALE_CODE_ALPHA_3, LOCALE_CODE_ALPHA_3)', 0],
- ['!defined script_code2code("aa", LOCALE_CODE_ALPHA_2)', 1],
- ['!defined script_code2code()', 1], # no argument
- ['!defined script_code2code(undef)', 1], # undef argument
-
- #---- some successful examples -----------------------------------------
- ['script_code2code("BO", LOCALE_CODE_ALPHA_2, LOCALE_CODE_ALPHA_3) eq "bod"', 0],
- ['script_code2code("bod", LOCALE_CODE_ALPHA_3, LOCALE_CODE_ALPHA_2) eq "bo"', 0],
- ['script_code2code("Phx", LOCALE_CODE_ALPHA_3, LOCALE_CODE_ALPHA_2) eq "ph"', 0],
- ['script_code2code("295", LOCALE_CODE_NUMERIC, LOCALE_CODE_ALPHA_3) eq "pqd"', 0],
- ['script_code2code(170, LOCALE_CODE_NUMERIC, LOCALE_CODE_ALPHA_3) eq "tna"', 0],
- ['script_code2code("rr", LOCALE_CODE_ALPHA_2, LOCALE_CODE_NUMERIC) eq "620"', 0],
-
-);
-
-print "1..", int(@TESTS), "\n";
-
-$testid = 1;
-foreach $test (@TESTS)
-{
- eval "print (($test->[0]) ? \"ok $testid\\n\" : \"not ok $testid\\n\" )";
- if ($@)
- {
- if (!$test->[1])
- {
- print "not ok $testid\n";
- }
- else
- {
- print "ok $testid\n";
- }
- }
- ++$testid;
-}
-
-exit 0;
--- /dev/null
+#!/usr/bin/perl -w
+
+require 5.002;
+
+$runtests=shift(@ARGV);
+if ( -f "t/testfunc.pl" ) {
+ require "t/testfunc.pl";
+ $dir="./lib";
+ $tdir="t";
+} elsif ( -f "testfunc.pl" ) {
+ require "testfunc.pl";
+ $dir="../lib";
+ $tdir=".";
+} else {
+ die "ERROR: cannot find testfunc.pl\n";
+}
+
+unshift(@INC,$dir);
+use Locale::Script;
+
+%type = ( "LOCALE_SCRIPT_ALPHA" => LOCALE_SCRIPT_ALPHA,
+ "LOCALE_SCRIPT_NUMERIC" => LOCALE_SCRIPT_NUMERIC,
+ );
+
+sub test {
+ my(@test) = @_;
+ $test[1] = $type{$test[1]}
+ if (@test == 2 && $test[1] && exists $type{$test[1]});
+ return script2code(@test);
+}
+
+$tests = "
+
+~ _undef_
+
+Phoenician ~ Phnx
+
+Phoenician LOCALE_SCRIPT_NUMERIC ~ 115
+
+";
+
+print "script2code...\n";
+test_Func(\&test,$tests,$runtests);
+
+1;
+# Local Variables:
+# mode: cperl
+# indent-tabs-mode: nil
+# cperl-indent-level: 3
+# cperl-continued-statement-offset: 2
+# cperl-continued-brace-offset: 0
+# cperl-brace-offset: 0
+# cperl-brace-imaginary-offset: 0
+# cperl-label-offset: -2
+# End:
--- /dev/null
+#!/usr/bin/perl -w
+# Copyright (c) 1996-2010 Sullivan Beck. All rights reserved.
+# This program is free software; you can redistribute it and/or modify it
+# under the same terms as Perl itself.
+
+# SB_TEST.PL
+###############################################################################
+# HISTORY
+#
+# 1996-??-?? Wrote initial version for Date::Manip module
+#
+# 1996-2001 Numerous changes
+#
+# 2001-03-29 Rewrote to make it easier to drop in for any module.
+#
+# 2001-06-19 Modifications to make space delimited stuff work better.
+#
+# 2001-08-23 Added support for undef args.
+#
+# 2007-08-14 Better support for undef/blank args.
+#
+# 2008-01-02 Better handling of $runtests.
+#
+# 2008-01-24 Better handling of undef/blank args when arguements are
+# entered as lists instead of strings.
+#
+# 2008-01-25 Created a global $testnum variable to store the test number
+# in.
+#
+# 2008-11-05 Slightly better handling of blank/undef in returned values.
+#
+# 2009-09-01 Added "-l" value to $runtests.
+#
+# 2009-09-30 Much better support for references.
+#
+# 2010-02-05 Fixed bug in passing tests as lists
+#
+# 2010-04-05 Renamed to testfunc.pl to avoid being called in a core module
+
+###############################################################################
+
+use Storable qw(dclone);
+
+# Usage: test_Func($funcref,$tests,$runtests,@extra)=@_;
+#
+# This takes a series of tests, runs them, compares the output of the tests
+# with expected output, and reports any differences. Each test consists of
+# several parts:
+# a function passed in as a reference ($funcref)
+# a series of arguments to be passed to the function
+# the expected output from the function call
+#
+# Tests may be passed in in two methods: as a string, or as a reference.
+#
+# Using the string case, $tests is a newline delimited string. Each test
+# takes one or more lines of the string. Tests are separated from each
+# other by a blank line.
+#
+# Arguments and return value(s) may be written as a single line:
+# ARG1 ARG2 ... ARGn ~ VAL1 VAL2 ... VALm
+# or as multiple lines:
+# ARG1
+# ARG2
+# ...
+# ARGn
+# ~
+# VAL1
+# VAL2
+# ...
+# VALm
+#
+# If any of the arguments OR values have spaces in them, only the multiline
+# form may be used.
+#
+# If there is exactly one return value, the separating tilde is
+# optional:
+# ARG1 ARG2 ... ARGn VAL1
+# or:
+# ARG1
+# ARG2
+# ...
+# ARGn
+# VAL
+#
+# It is valid to have a function with no arguments or with no return
+# value (or both). The "~" must be used:
+#
+# ARG1 ARG2 ... ARGn ~
+#
+# ~ VAL1 VAL2 ... VALm
+#
+# ~
+#
+# Leading and trailing space is ignored in the multi-line format.
+#
+# If desired, any of the ARGs or VALs may be the word "_undef_" which
+# will be strictly interpreted as the perl undef value. The word "_blank_"
+# may also be used to designate a defined but empty string.
+#
+# They may also be (in the multiline format) of the form:
+#
+# \ STRING : a string reference
+#
+# [] LIST : a list reference (where LIST is a
+# comma separated list)
+#
+# [SEP] LIST : a list reference (where SEP is a
+# single character separator)
+#
+# {} HASH : a hash reference (where HASH is
+# a comma separated list)
+#
+# {SEP} HASH : a hash reference (where SEP is a
+# single character separator)
+#
+# Alternately, the tests can be passed in as a list reference:
+# $tests = [
+# [
+# [ @ARGS1 ],
+# [ @VALS1 ]
+# ],
+# [
+# [ @ARGS2 ],
+# [ @VALS2 ]
+# ], ...
+# ]
+#
+# @extra are extra arguments which are added to the function call.
+#
+# There are several ways to run the tests, depending on the value of
+# $runtests.
+#
+# If $runtests is 0, the tests are run in a non-interactive way suitable
+# for running as part of a "make test".
+#
+# If $runtests is a positive number, it runs runs all tests starting at
+# that value in a way suitable for running interactively.
+#
+# If $runtests is a negative number, it runs all tests starting at that
+# value, but providing feedback at each test.
+#
+# If $runtests is a string "=N" (where N is a number), it runs only
+# that test.
+#
+# If $runtests is the string "-l", it lists the tests and the expected
+# output without running any.
+
+sub test_Func {
+ my($funcref,$tests,$runtests,@extra)=@_;
+ my(@tests);
+
+ $runtests = 0 if (! $runtests);
+ my($starttest,$feedback,$endtest,$runtest);
+ if ($runtests eq "0" or $runtests eq "-0") {
+ $starttest = 1;
+ $feedback = 1;
+ $endtest = 0;
+ $runtest = 1;
+ } elsif ($runtests =~ /^\d+$/){
+ $starttest = $runtests;
+ $feedback = 0;
+ $endtest = 0;
+ $runtest = 1;
+ } elsif ($runtests =~ /^-(\d+)$/) {
+ $starttest = $1;
+ $feedback = 1;
+ $endtest = 0;
+ $runtest = 1;
+ } elsif ($runtests =~ /^=(\d+)$/) {
+ $starttest = $1;
+ $feedback = 1;
+ $endtest = $1;
+ $runtest = 1;
+ } elsif ($runtests eq "-l") {
+ $starttest = 1;
+ $feedback = 1;
+ $endtest = 0;
+ $runtest = 0;
+ } else {
+ die "ERROR: unknown argument(s): $runtests";
+ }
+
+ my($tests_as_list) = 0;
+ if (ref($tests) eq "ARRAY") {
+ @tests = @$tests;
+ $tests_as_list = 1;
+
+ } else {
+ # Separate tests.
+
+ my($comment)="#";
+ my(@lines)=split(/\n/,$tests);
+ my(@test);
+ while (@lines) {
+ my $line = shift(@lines);
+ $line =~ s/^\s*//;
+ $line =~ s/\s*$//;
+ next if ($line =~ /^$comment/);
+
+ if ($line ne "") {
+ push(@test,$line);
+ next;
+ }
+
+ if (@test) {
+ push(@tests,[ @test ]);
+ @test=();
+ }
+ }
+ if (@test) {
+ push(@tests,[ @test ]);
+ }
+
+ # Get arg/val lists for each test.
+
+ foreach my $test (@tests) {
+ my(@tmp)=@$test;
+ my(@arg,@val);
+
+ # single line test
+ @tmp = split(/\s+/,$tmp[0]) if ($#tmp == 0);
+
+ my($sep)=-1;
+ my($i);
+ for ($i=0; $i<=$#tmp; $i++) {
+ if ($tmp[$i] eq "~") {
+ $sep=$i;
+ last;
+ }
+ }
+
+ if ($sep<0) {
+ @val=pop(@tmp);
+ @arg=@tmp;
+ } else {
+ @arg=@tmp[0..($sep-1)];
+ @val=@tmp[($sep+1)..$#tmp];
+ }
+ $test = [ [@arg],[@val] ];
+ }
+ }
+
+ my($ntest)=$#tests + 1;
+ print "1..$ntest\n" if ($feedback && $runtest);
+
+ my(@t);
+ if ($endtest) {
+ @t = ($starttest..$endtest);
+ } else {
+ @t = ($starttest..$ntest);
+ }
+
+ foreach my $t (@t) {
+ $::testnum = $t;
+
+ my (@arg);
+ if ($tests_as_list) {
+ @arg = @{ $tests[$t-1][0] };
+ } else {
+ my $arg = dclone($tests[$t-1][0]);
+ @arg = @$arg;
+ print_to_vals(\@arg);
+ }
+
+ my $argprt = dclone(\@arg);
+ my @argprt = @$argprt;
+ vals_to_print(\@argprt);
+
+ my $exp = dclone($tests[$t-1][1]);
+ my @exp = @$exp;
+ print_to_vals(\@exp);
+ vals_to_print(\@exp);
+
+ # Run the test
+
+ my ($ans,@ans);
+ if ($runtest) {
+ @ans = &$funcref(@arg,@extra);
+ }
+ vals_to_print(\@ans);
+
+ # Compare the results
+
+ foreach my $arg (@arg) {
+ $arg = "_undef_" if (! defined $arg);
+ $arg = "_blank_" if ($arg eq "");
+ }
+ $arg = join("\n ",@argprt,@extra);
+ $ans = join("\n ",@ans);
+ $exp = join("\n ",@exp);
+
+ if (! $runtest) {
+ print "########################\n";
+ print "Test = $t\n";
+ print "Args = $arg\n";
+ print "Expected = $exp\n";
+ } elsif ($ans ne $exp) {
+ print "not ok $t\n";
+ warn "########################\n";
+ warn "Args = $arg\n";
+ warn "Expected = $exp\n";
+ warn "Got = $ans\n";
+ warn "########################\n";
+ } else {
+ print "ok $t\n" if ($feedback);
+ }
+ }
+}
+
+# The following is similar but it takes input from an input file and
+# sends output to an output file.
+#
+# $files is a reference to a list of tests. If one of the tests is named
+# "foobar", the input is from "foobar.in", output is to "foobar.out", and
+# the expected output is in "foobar.exp".
+#
+# The function stored in $funcref is called as:
+# &$funcref($in,$out,@extra)
+# where $in is the name of the input file, $out is the name of the output
+# file, and @extra are any additional arguments that are required.
+#
+# The function should return 0 on success, or an error message.
+
+sub test_File {
+ my($funcref,$files,$runtests,@extra)=@_;
+ my(@files)=@$files;
+
+ $runtests=0 if (! $runtests);
+
+ my($ntest)=$#files + 1;
+ print "1..$ntest\n" if (! $runtests);
+
+ my(@t);
+ if ($runtests > 0) {
+ @t = ($runtests..$ntest);
+ } elsif ($runtests < 0) {
+ @t = (-$runtests);
+ } else {
+ @t = (1..$ntest);
+ }
+
+ foreach my $t (@t) {
+ $::testnum = $t;
+ my $test = $files[$t-1];
+ my $expf = "$test.exp";
+ my $outf = "$test.out";
+
+ if (! -f $test || ! -f $expf) {
+ print "not ok $t\n";
+ warn "Test: $test: missing input/outpuf information\n";
+ next;
+ }
+
+ my $err = &$funcref($test,$outf,@extra);
+ if ($err) {
+ print "not ok $t\n";
+ warn "Test: $test: $err\n";
+ next;
+ }
+
+ local *FH;
+ open(FH,$expf) || do {
+ print "not ok $t\n";
+ warn "Test: $test: $!\n";
+ next;
+ };
+ my @exp = <FH>;
+ close(FH);
+ my $exp = join("",@exp);
+ open(FH,$outf) || do {
+ print "not ok $t\n";
+ warn "Test: $test: $!\n";
+ next;
+ };
+ my @out = <FH>;
+ close(FH);
+ my $out = join("",@out);
+
+ if ($out ne $exp) {
+ print "not ok $t\n";
+ warn "Test: $test: output differs from expected value\n";
+ next;
+ }
+
+ print "ok $t\n" if (! $runtests);
+ }
+}
+
+# Converts a printable version of arguments to actual arguments
+sub print_to_vals {
+ my($listref) = @_;
+
+ foreach my $arg (@$listref) {
+ next if (! defined($arg));
+ if ($arg eq "_undef_") {
+ $arg = undef;
+
+ } elsif ($arg eq "_blank_") {
+ $arg = "";
+
+ } elsif ($arg =~ /^\\\s*(.*)/) {
+ $str = $1;
+ $arg = \$str;
+
+ } elsif ($arg =~ /^\[(.?)\]\s*(.*)/) {
+ my($sep,$str) = ($1,$2);
+ $sep = "," if (! $sep);
+ my @list = split(/\Q$sep\E/,$str);
+ foreach my $e (@list) {
+ $e = "" if ($e eq "_blank_");
+ $e = undef if ($e eq "_undef_");
+ }
+ $arg = \@list;
+
+ } elsif ($arg =~ /^\{(.?)\}\s*(.*)/) {
+ my($sep,$str) = ($1,$2);
+ $sep = "," if (! $sep);
+ my %hash = split(/\Q$sep\E/,$str);
+ foreach my $key (keys %hash) {
+ my $val = $hash{$key};
+ $hash{$key} = undef if ($val eq "_undef_");
+ $hash{$key} = "" if ($val eq "_blank_");
+ }
+ $arg = \%hash;
+ }
+ }
+}
+
+# Converts arguments to a printable version.
+sub vals_to_print {
+ my($listref) = @_;
+
+ foreach my $arg (@$listref) {
+ if (! defined $arg) {
+ $arg = "_undef_";
+
+ } elsif (! ref($arg)) {
+ $arg = "_blank_" if ($arg eq "");
+
+ } else {
+ my $ref = ref($arg);
+ if ($ref eq "SCALAR") {
+ $arg = "\\ $$arg";
+
+ } elsif ($ref eq "ARRAY") {
+ my @list = @$arg;
+ foreach my $e (@list) {
+ $e = "_undef_", next if (! defined($e));
+ $e = "_blank_" if ($e eq "");
+ }
+ $arg = join(" ","[",join(", ",@list),"]");
+
+ } elsif ($ref eq "HASH") {
+ %hash = %$arg;
+ foreach my $key (keys %hash) {
+ my $val = $hash{$key};
+ $hash{$key} = "_undef_", next if (! defined($val));
+ $hash{$key} = "_blank_" if ($val eq "_blank_");
+ }
+ $arg = join(" ","{",
+ join(", ",map { "$_ => $hash{$_}" }
+ (sort keys %hash)), "}");
+ $arg =~ s/ +/ /g;
+ }
+ }
+ }
+}
+
+1;
+# Local Variables:
+# mode: cperl
+# indent-tabs-mode: nil
+# cperl-indent-level: 3
+# cperl-continued-statement-offset: 2
+# cperl-continued-brace-offset: 0
+# cperl-brace-offset: 0
+# cperl-brace-imaginary-offset: 0
+# cperl-label-offset: -2
+# End:
+
+++ /dev/null
-#!./perl
-#
-# uk.t - tests for Locale::Country with "uk" aliases to "gb"
-#
-
-use Locale::Country;
-
-Locale::Country::alias_code('uk' => 'gb');
-
-#-----------------------------------------------------------------------
-# This is an array of tests. Each test is eval'd as an expression.
-# If it evaluates to FALSE, then "not ok N" is printed for the test,
-# otherwise "ok N".
-#-----------------------------------------------------------------------
-@TESTS =
-(
- #================================================
- # TESTS FOR code2country
- #================================================
-
- #---- selection of examples which should all result in undef -----------
- '!defined code2country()', # no argument
- '!defined code2country(undef)', # undef argument
- '!defined code2country("zz")', # illegal code
- '!defined code2country("ja")', # should be jp for country
-
- #---- some successful examples -----------------------------------------
- 'code2country("BO") eq "Bolivia"',
- 'code2country("pk") eq "Pakistan"',
- 'code2country("sn") eq "Senegal"',
- 'code2country("us") eq "United States"',
- 'code2country("ad") eq "Andorra"', # first in DATA segment
- 'code2country("zw") eq "Zimbabwe"', # last in DATA segment
- 'code2country("uk") eq "United Kingdom"', # normally "gb"
-
- #================================================
- # TESTS FOR country2code
- #================================================
-
- #---- selection of examples which should all result in undef -----------
- '!defined country2code()', # no argument
- '!defined country2code(undef)', # undef argument
- '!defined country2code("Banana")', # illegal country name
-
- #---- some successful examples -----------------------------------------
- 'country2code("japan") eq "jp"',
- 'country2code("japan") ne "ja"',
- 'country2code("Japan") eq "jp"',
- 'country2code("United States") eq "us"',
- 'country2code("United Kingdom") eq "uk"',
- 'country2code("Andorra") eq "ad"', # first in DATA segment
- 'country2code("Zimbabwe") eq "zw"', # last in DATA segment
-);
-
-print "1..", int(@TESTS), "\n";
-
-$testid = 1;
-foreach $test (@TESTS)
-{
- eval "print (($test) ? \"ok $testid\\n\" : \"not ok $testid\\n\" )";
- print "not ok $testid\n" if $@;
- ++$testid;
-}
-
-exit 0;
@ISA = qw(Exporter);
@EXPORT = qw(encode_base64 decode_base64);
-$VERSION = '3.08';
+$VERSION = '3.09';
require XSLoader;
XSLoader::load('MIME::Base64', $VERSION);
-/* $Id$
+/*
Copyright 1997-2004 Gisle Aas
PREINIT:
char *str; /* string to encode */
SSize_t len; /* length of the string */
- char *eol; /* the end-of-line sequence to use */
+ const char*eol;/* the end-of-line sequence to use */
STRLEN eollen; /* length of the EOL sequence */
char *r; /* result string */
STRLEN rlen; /* length of result string */
/* encode */
for (chunk=0; len > 0; len -= 3, chunk++) {
if (chunk == (MAX_LINE/4)) {
- char *c = eol;
- char *e = eol + eollen;
+ const char *c = eol;
+ const char *e = eol + eollen;
while (c < e)
*r++ = *c++;
chunk = 0;
}
if (rlen) {
/* append eol to the result string */
- char *c = eol;
- char *e = eol + eollen;
+ const char *c = eol;
+ const char *e = eol + eollen;
while (c < e)
*r++ = *c++;
}
PROTOTYPE: $;$$
PREINIT:
- char *eol;
+ const char *eol;
STRLEN eol_len;
int binary;
STRLEN sv_len;
if (p_len) {
/* output plain text (with line breaks) */
if (eol_len) {
- STRLEN max_last_line = (p == end || *p == '\n')
- ? MAX_LINE /* .......\n */
- : ((p + 1) == end || *(p + 1) == '\n')
- ? MAX_LINE - 3 /* ....=XX\n */
- : MAX_LINE - 4; /* ...=XX=\n */
- while (p_len + linelen > max_last_line) {
+ while (p_len > MAX_LINE - 1 - linelen) {
STRLEN len = MAX_LINE - 1 - linelen;
- if (len > p_len)
- len = p_len;
sv_catpvn(RETVAL, p_beg, len);
p_beg += len;
p_len -= len;
break;
}
else if (*p == '\n' && eol_len && !binary) {
- sv_catpvn(RETVAL, eol, eol_len);
- p++;
+ if (linelen == 1 && SvCUR(RETVAL) > eol_len + 1 && SvEND(RETVAL)[-eol_len - 2] == '=') {
+ /* fixup useless soft linebreak */
+ SvEND(RETVAL)[-eol_len - 2] = SvEND(RETVAL)[-1];
+ SvCUR_set(RETVAL, SvCUR(RETVAL) - 1);
+ }
+ else {
+ sv_catpvn(RETVAL, eol, eol_len);
+ }
+ p++;
linelen = 0;
}
else {
/* output escaped char (with line breaks) */
assert(p < end);
- if (eol_len && linelen > MAX_LINE - 4) {
+ if (eol_len && linelen > MAX_LINE - 4 && !(linelen == MAX_LINE - 3 && p + 1 < end && p[1] == '\n' && !binary)) {
sv_catpvn(RETVAL, "=", 1);
sv_catpvn(RETVAL, eol, eol_len);
linelen = 0;
+2010-01-25 Gisle Aas <gisle@ActiveState.com>
+
+ Release 3.09
+
+ The Quoted-Printable encoder would sometimes output lines
+ that were 77 characters long. The max line length should be 76.
+ [RT#53919]
+
+
+
2009-06-09 Gisle Aas <gisle@ActiveState.com>
Release 3.08
@ISA = qw(Exporter);
@EXPORT = qw(encode_qp decode_qp);
-$VERSION = "3.08";
+$VERSION = "3.09";
use MIME::Base64; # will load XS version of {en,de}code_qp()
["$x70!23" => "$x70!23=\n"],
["$x70!234" => "$x70!234=\n"],
["$x70!2345" => "$x70!2345=\n"],
- ["$x70!23456" => "$x70!23456=\n"],
+ ["$x70!23456" => "$x70!2345=\n6=\n"],
["$x70!234567" => "$x70!2345=\n67=\n"],
["$x70!23456=" => "$x70!2345=\n6=3D=\n"],
["$x70!23\n" => "$x70!23\n"],
["$x70!2===xxx" => "$x70!2=3D=\n=3D=3Dxxx=\n"],
["$x70!23===xx" => "$x70!23=\n=3D=3D=3Dxx=\n"],
["$x70!234===x" => "$x70!234=\n=3D=3D=3Dx=\n"],
+ ["$x70!2=" => "$x70!2=3D=\n"],
+ ["$x70!23=" => "$x70!23=\n=3D=\n"],
+ ["$x70!234=" => "$x70!234=\n=3D=\n"],
+ ["$x70!2345=" => "$x70!2345=\n=3D=\n"],
+ ["$x70!23456=" => "$x70!2345=\n6=3D=\n"],
["$x70!2=\n" => "$x70!2=3D\n"],
- ["$x70!23=\n" => "$x70!23=\n=3D\n"],
+ ["$x70!23=\n" => "$x70!23=3D\n"],
["$x70!234=\n" => "$x70!234=\n=3D\n"],
["$x70!2345=\n" => "$x70!2345=\n=3D\n"],
["$x70!23456=\n" => "$x70!2345=\n6=3D\n"],
["$x70!23" => "$x70!23=\n"],
["$x70!234" => "$x70!234=\n"],
["$x70!2345" => "$x70!2345=\n"],
- ["$x70!23456" => "$x70!23456=\n"],
+ ["$x70!23456" => "$x70!2345=\n6=\n"],
["$x70!234567" => "$x70!2345=\n67=\n"],
["$x70!23456=" => "$x70!2345=\n6=7E=\n"],
["$x70!23\n" => "$x70!23\n"],
exit 0;
}
-if (! -w $ENV{TMP}) {
- print "1..0\n";
- exit 0;
-}
-
print "1..4\n";
$file = "md$$";
Revision history for Perl extension Module::Build.
+0.3603 - Mon Jan 18 22:28:59 EST 2010
+
+(Oops, I released the last one before I realized this should have been
+fixed along with it.)
+
+ Bug fixes:
+
+ - Module::Build::Compat would croak on distibutions that set requires
+ 'perl' to a dotted decimal like '5.6.2'. We now skip that key
+ since it doesn't go into PREREQ_PM and we numify it properly for
+ 'use 5.006002' in the generated Makefile.PL (RT#53409)
+ [David Golden, adapted from patch by G. Allen Morris III]
+
+0.3602 - Mon Jan 18 22:09:54 EST 2010
+
+ Bug fixes:
+
+ - Fix failures in t/properties/needs_compiler.t when $ENV{CC} is set
+ (RT#53296) [David Golden, adapted from patch by Jens Rehsack]
+
+0.3601 - Mon Dec 21 14:39:33 EST 2009
+
+ Bug fixes:
+
+ - When the currently running Module::Build is not the same as the one
+ that created the Build file, there is now a warning rather than a fatal
+ error. This helps installation of dependency chains where a dependency
+ might configure_requires a new Module::Build after Build.PL was already
+ run for an earlier distribution. [David Golden, on advice of Matt Trout]
+
+ Other:
+
+ - t/bundle_inc.t fails in odd ways. This test of an experimental feature
+ should not prevent users from installing Module::Build, so this test
+ now skips unless $ENV{MB_TEST_EXPERIMENTAL} is true
+
0.36 - Sun Dec 20 15:02:38 EST 2009
No changes from 0.35_15 other than the version number.
use vars qw($VERSION @ISA);
@ISA = qw(Module::Build::Base);
-$VERSION = '0.36';
+$VERSION = '0.3603';
$VERSION = eval $VERSION;
# Okay, this is the brute-force method of finding out what kind of
Suppresses the check upon startup that the version of Module::Build
we're now running under is the same version that was initially invoked
when building the distribution (i.e. when the C<Build.PL> script was
-first run). Use with caution.
+first run). As of 0.3601, a mismatch results in a warning instead of
+a fatal error, so this option effectively just suppresses the warning.
=item debug
use strict;
use vars qw($VERSION);
-$VERSION = '0.36';
+$VERSION = '0.3603';
$VERSION = eval $VERSION;
BEGIN { require 5.00503 }
unless ($self->allow_mb_mismatch) {
my $mb_version = $Module::Build::VERSION;
- die(" * ERROR: Configuration was initially created with Module::Build version '$self->{properties}{mb_version}',\n".
- " but we are now using version '$mb_version'. Please re-run the Build.PL or Makefile.PL script,\n".
- " or use --allow_mb_mismatch 1 to skip this version check.\n")
- if $mb_version ne $self->{properties}{mb_version};
+ if ( $mb_version ne $self->{properties}{mb_version} ) {
+ $self->log_warn(<<"MISMATCH");
+* WARNING: Configuration was initially created with Module::Build
+ version '$self->{properties}{mb_version}' but we are now using version '$mb_version'.
+ If errors occur, you must re-run the Build.PL or Makefile.PL script.
+MISMATCH
+ }
}
$self->{invoked_action} = $self->{action} ||= 'build';
use strict;
use vars qw($VERSION);
-$VERSION = '0.36';
+$VERSION = '0.3603';
use File::Basename ();
use File::Spec;
use Config;
use Module::Build;
use Module::Build::ModuleInfo;
+use Module::Build::Version;
use Data::Dumper;
my %convert_installdirs = (
# validate formats
for my $p ( $req, $breq ) {
for my $k (keys %$p) {
+ next if $k eq 'perl';
die "Prereq '$p->{$k}' for '$k' is not supported by Module::Build::Compat\n"
unless _simple_prereq($p->{$k});
}
# Makefile.PL
my $requires = $build->requires;
if ( my $minimum_perl = $requires->{perl} ) {
- print {$fh} "require $minimum_perl;\n";
+ my $min_ver = Module::Build::Version->new($minimum_perl)->numify;
+ print {$fh} "require $min_ver;\n";
}
# If a *bundled* custom subclass is being used, make sure we add its
use strict;
use vars qw($VERSION);
-$VERSION = '0.36';
+$VERSION = '0.3603';
$VERSION = eval $VERSION;
use Config;
package Module::Build::Cookbook;
use strict;
use vars qw($VERSION);
-$VERSION = '0.36';
+$VERSION = '0.3603';
=head1 NAME
package Module::Build::Dumper;
use strict;
use vars qw($VERSION);
-$VERSION = '0.36';
+$VERSION = '0.3603';
# This is just a split-out of a wrapper function to do Data::Dumper
# stuff "the right way". See:
use strict;
use vars qw($VERSION);
-$VERSION = '0.36';
+$VERSION = '0.3603';
$VERSION = eval $VERSION;
use File::Spec;
use strict;
use vars qw($VERSION);
-$VERSION = '0.36';
+$VERSION = '0.3603';
$VERSION = eval $VERSION;
use Data::Dumper;
use IO::File;
use vars qw($VERSION);
use IO::File;
-$VERSION = '0.36';
+$VERSION = '0.3603';
$VERSION = eval $VERSION;
# This code is mostly borrowed from ExtUtils::MM_Unix 6.10_03, with a
use strict;
use vars qw($VERSION);
-$VERSION = '0.36';
+$VERSION = '0.3603';
$VERSION = eval $VERSION;
use Module::Build::Base;
use strict;
use vars qw($VERSION);
-$VERSION = '0.36';
+$VERSION = '0.3603';
$VERSION = eval $VERSION;
use Module::Build::Base;
use strict;
use vars qw($VERSION);
-$VERSION = '0.36';
+$VERSION = '0.3603';
$VERSION = eval $VERSION;
use Module::Build::Base;
use strict;
use vars qw($VERSION);
-$VERSION = '0.36';
+$VERSION = '0.3603';
$VERSION = eval $VERSION;
use Module::Build::Base;
use strict;
use vars qw($VERSION);
-$VERSION = '0.36';
+$VERSION = '0.3603';
$VERSION = eval $VERSION;
use Module::Build::Base;
use vars qw(@ISA);
use strict;
use vars qw($VERSION);
-$VERSION = '0.36';
+$VERSION = '0.3603';
$VERSION = eval $VERSION;
use Module::Build::Base;
use strict;
use vars qw($VERSION);
-$VERSION = '0.36';
+$VERSION = '0.3603';
$VERSION = eval $VERSION;
use Module::Build::Base;
use strict;
use vars qw($VERSION);
-$VERSION = '0.36';
+$VERSION = '0.3603';
$VERSION = eval $VERSION;
use Module::Build::Base;
use Config;
use strict;
use vars qw($VERSION);
-$VERSION = '0.36';
+$VERSION = '0.3603';
$VERSION = eval $VERSION;
use Module::Build::Base;
use strict;
use vars qw($VERSION);
-$VERSION = '0.36';
+$VERSION = '0.3603';
$VERSION = eval $VERSION;
use Config;
use strict;
use vars qw($VERSION);
-$VERSION = '0.36';
+$VERSION = '0.3603';
$VERSION = eval $VERSION;
use Module::Build::Platform::Unix;
use strict;
use vars qw($VERSION);
-$VERSION = '0.36';
+$VERSION = '0.360301'; # patched in bleadperl
$VERSION = eval $VERSION;
use Module::Build::Platform::Unix;
}
# Copied from ExtUtils::MM_Cygwin::maybe_command()
-# If our path begins with F</cygdrive/> then we use C<ExtUtils::MM_Win32>
+# If our path begins with F</cygdrive/> then we use M::B::Platform::Windows
# to determine if it may be a command. Otherwise we use the tests
-# from C<ExtUtils::MM_Unix>.
+# from M::B::Platform::Unix.
sub _maybe_command {
my ($self, $file) = @_;
if ($file =~ m{^/cygdrive/}i) {
- require Module::Build::Platform::Win32;
- return Module::Build::Platform::Win32->_maybe_command($file);
+ require Module::Build::Platform::Windows;
+ return Module::Build::Platform::Windows->_maybe_command($file);
}
return $self->SUPER::_maybe_command($file);
use strict;
use vars qw($VERSION);
-$VERSION = '0.36';
+$VERSION = '0.3603';
$VERSION = eval $VERSION;
use Module::Build::Platform::Unix;
use strict;
use vars qw($VERSION);
-$VERSION = '0.36';
+$VERSION = '0.3603';
$VERSION = eval $VERSION;
use Module::Build::Platform::Unix;
use strict;
use vars qw($VERSION);
-$VERSION = '0.36';
+$VERSION = '0.3603';
$VERSION = eval $VERSION;
use vars qw(@ISA);
package inc::latest;
use strict;
use vars qw($VERSION);
-$VERSION = '0.36';
+$VERSION = '0.3603';
$VERSION = eval $VERSION;
use Carp;
package inc::latest::private;
use strict;
use vars qw($VERSION);
-$VERSION = '0.36';
+$VERSION = '0.3603';
$VERSION = eval $VERSION;
use File::Spec;
is $mb->args('dee'), 'goo';
is $mb->destdir, 'yo';
my %runtime = $mb->runtime_params;
- is_deeply \%runtime,
+ is_deeply \%runtime,
{
verbose => 1,
destdir => 'yo',
if ( $ENV{PERL_CORE} ) {
plan skip_all => 'bundle_inc tests will never succeed in PERL_CORE';
}
+elsif ( ! $ENV{MB_TEST_EXPERIMENTAL} ) {
+ plan skip_all => '$ENV{MB_TEST_EXPERIMENTAL} is not set';
+}
elsif ( ! MBTest::check_EUI() ) {
plan skip_all => 'ExtUtils::Installed takes too long on your system';
}
# Test with requires and PL_files
my $distname = $dist->name;
-$dist->change_build_pl({
+$dist->change_build_pl({
module_name => $distname,
license => 'perl',
requires => {
######################
-$dist->change_build_pl({
+$dist->change_build_pl({
module_name => $distname,
license => 'perl',
});
});
foreach my $style ('passthrough', 'small') {
create_makefile_pl($style, $foo_builder);
-
+
# Should fail with "can't find Foo/Builder.pm"
my $result;
my ($stdout, $stderr ) = stdout_stderr_of (sub {
ok ! $result, "Makefile.PL failed";
like $stderr, qr{Foo/Builder.pm}, "custom builder wasn't found";
}
-
+
# Now make sure it can actually work.
my $bar_builder;
stdout_stderr_of( sub {
skip "Needs ExtUtils::Install 1.32 or later", 2 * @cases
if ExtUtils::Install->VERSION < 1.32;
+ skip "Needs upstream patch at http://rt.cpan.org/Public/Bug/Display.html?id=55288", 2 * @cases
+ if $^O eq 'VMS';
+
for my $c (@cases) {
- my @make_args = @{$c->{args}};
+ my @make_args = @{$c->{args}};
if ($is_vms_mms) { # VMS MMK/MMS macros use different syntax.
$make_args[0] = '/macro=("' . join('","',@make_args) . '")';
pop @make_args while scalar(@make_args) > 1;
my $b2 = Module::Build->current;
ok $b2->install_base, "install_base set";
unlike $b2->install_base, qr/^~/, "Tildes should be expanded";
-
+
stdout_stderr_of( sub { $mb->do_system(@make, 'realclean'); } );
ok ! -e $makefile, "$makefile shouldn't exist";
$opts{PL_files} ||= {};
foreach my $type (@makefile_types) {
- # Create M::B instance
+ # Create M::B instance
my $mb;
stdout_stderr_of( sub {
$mb = Module::Build->new_from_context;
test_makefile_creation($mb);
test_makefile_prereq_pm( _merge_prereqs($opts{requires}, $opts{build_requires}) );
test_makefile_pl_files( $opts{PL_files} ) if $type eq 'traditional';
-
+
my ($output,$success);
# Capture output to keep our STDOUT clean
$output = stdout_stderr_of( sub {
});
ok $success, "make test ran without error";
like uc $output, qr{DONE\.|SUCCESS}, "make test output indicated success";
-
+
$output = stdout_stderr_of( sub {
$success = $mb->do_system(@make, 'realclean');
});
# Try again with some Makefile.PL arguments
test_makefile_creation($mb, [], 'INSTALLDIRS=vendor', 'realclean');
-
+
# Try again using distclean
test_makefile_creation($mb, [], '', 'distclean');
sub test_makefile_creation {
my ($build, $preargs, $postargs, $cleanup) = @_;
-
+
my ($output, $result);
# capture output to avoid polluting our test output
$output = stdout_stderr_of( sub {
}
ok $result, $label;
ok -e $makefile, "$makefile exists";
-
+
if ($cleanup) {
# default to 'realclean' unless we recognize the clean method
$cleanup = 'realclean' unless $cleanup =~ /^(dist|real)clean$/;
}
sub find_params_in_makefile {
- my $fh = IO::File->new( $makefile, 'r' )
+ my $fh = IO::File->new( $makefile, 'r' )
or die "Can't read $makefile: $!";
local($/) = "\n";
my %test_config;
foreach my $type (keys %$defaults) {
my $prefix = shift @prefixes || [qw(foo bar)];
- $test_config{$type} = catdir(File::Spec->rootdir, @$prefix,
+ $test_config{$type} = catdir(File::Spec->rootdir, @$prefix,
@{$defaults->{$type}});
}
# Poke at the innards of MB to change the default install locations.
my $old = $mb->install_sets->{site};
$mb->install_sets->{site} = \%test_config;
- $mb->config(siteprefixexp => catdir(File::Spec->rootdir,
+ $mb->config(siteprefixexp => catdir(File::Spec->rootdir,
'wierd', 'prefix'));
my $prefix = catdir('another', 'prefix');
use lib 't/lib';
use MBTest;
-my @unix_splits =
+my @unix_splits =
(
{ q{one t'wo th'ree f"o\"ur " "five" } => [ 'one', 'two three', 'fo"ur ', 'five' ] },
{ q{ foo bar } => [ 'foo', 'bar' ] },
{ qq{one\\\ntwo} => [ "one\ntwo" ] }, # TODO
);
-my @win_splits =
+my @win_splits =
(
{ 'a" "b\\c" "d' => [ 'a b\c d' ] },
{ '"a b\\c d"' => [ 'a b\c d' ] },
{
# Make sure copy_if_modified() can handle spaces in filenames
-
+
my @tmp;
push @tmp, MBTest->tmpdir for (0 .. 1);
-
+
my $filename = 'file with spaces.txt';
-
+
my $file = File::Spec->catfile($tmp[0], $filename);
my $fh = IO::File->new($file, '>') or die "Can't create $file: $!";
print $fh "Foo\n";
$fh->close;
ok -e $file;
-
-
+
+
my $file2 = $mb->copy_if_modified(from => $file, to_dir => $tmp[1]);
ok $file2;
ok -e $file2;
# Try some dir_contains() combinations
my $first = File::Spec->catdir('', 'one', 'two');
my $second = File::Spec->catdir('', 'one', 'two', 'three');
-
+
ok( Module::Build->dir_contains($first, $second) );
}
sub ACTION_bar { die "barey" }
sub ACTION_baz { die "bazey" }
- # guess we can have extra pod later
+ # guess we can have extra pod later
=over
sub ACTION_baz { die "bazey" }
sub ACTION_batz { die "batzey" }
- # guess we can have extra pod later
+ # guess we can have extra pod later
# Though, I do wonder whether we should allow them to mix...
# maybe everything should have to be head2?
bar => "\n=head3 bears\n\nBe careful with bears.\n",
baz => "\n=head4 What's a baz\\?\n",
);
-
+
foreach my $action (qw(foo bar baz)) {
my $doc = $mb->get_action_docs($action);
ok($doc, "got doc for '$action'");
{
eval {$mb->dispatch('install', destdir => $destdir)};
is $@, '';
-
+
my @libdir = strip_volume( $mb->install_destination('lib') );
my $install_to = File::Spec->catfile($destdir, @libdir, $dist->name ) . '.pm';
file_exists($install_to);
-
+
local @INC = (@INC, File::Spec->catdir($destdir, @libdir));
eval "require @{[$dist->name]}";
is $@, '';
-
+
# Make sure there's a packlist installed
my $archdir = $mb->install_destination('arch');
my @dirs = strip_volume($archdir);
{
# Test the ConfigData stuff
-
+
$mb->config_data(foo => 'bar');
$mb->features(baz => 1);
$mb->auto_features(auto_foo => {requires => {'File::Spec' => 0}});
eval {$mb->dispatch('install', destdir => $destdir)};
is $@, '';
-
+
my @libdir = strip_volume( $mb->install_destination('lib') );
local @INC = (@INC, File::Spec->catdir($destdir, @libdir));
eval "require @{[$dist->name]}::ConfigData";
is $mb->feature('auto_foo'), 1;
-
+
SKIP: {
skip $@, 5 if @_;
my $libdir = File::Spec->catdir('', 'foo', 'lib');
eval {$mb->run_perl_script('Build.PL', [], ['--install_path', "lib=$libdir"])};
is $@, '';
-
+
my $cmd = 'Build';
$cmd .= ".COM" if $^O eq 'VMS';
eval {$mb->run_perl_script($cmd, [], ['install', '--destdir', $destdir])};
eval {$mb->run_perl_script($cmd, [], ['install', '--destdir', $destdir,
'--install_base', $basedir])};
is $@, '';
-
+
$install_to = File::Spec->catfile($destdir, $libdir, $dist->name ) . '.pm';
is -e $install_to, 1, "Look for file at $install_to";
-
+
eval {$mb->dispatch('realclean')};
is $@, '';
}
$expect = lc($expect) if $^O eq 'VMS';
is $pods->{$expect}, $expect;
-
+
my $pms = $mb->_find_file_by_type('awefawef', 'lib');
ok $pms;
is keys %$pms, 0;
-
+
$pms = $mb->_find_file_by_type('pod', 'awefawef');
ok $pms;
is keys %$pms, 0;
ok ! $mb->contains_pod($from), "$from should not contain POD";
next;
}
-
+
my $to = File::Spec->catfile('blib', ($from =~ /^[\.\/\[]*lib/ ? 'libdoc' : 'bindoc'), $v);
ok $mb->contains_pod($from), "$from should contain POD";
ok -e $to, "Created $to manpage";
my $provides; # Used a bunch of times below
-my $pod_text = <<'---';
+my $pod_text = <<'---';
=pod
=head1 NAME
-Simple - A simple module
+Simple - A simple module
=head1 AUTHOR
ok( -e "lib/Simple.pm", "Creating Simple.pm" );
my $mb = Module::Build->new_from_context;
$mb->do_create_readme;
-like( slurp("README"), qr/NAME/,
+like( slurp("README"), qr/NAME/,
"Generating README from .pm");
-is( $mb->dist_author->[0], 'Simple Simon <simon@simple.sim>',
+is( $mb->dist_author->[0], 'Simple Simon <simon@simple.sim>',
"Extracting AUTHOR from .pm");
-is( $mb->dist_abstract, "A simple module",
+is( $mb->dist_abstract, "A simple module",
"Extracting abstract from .pm");
# .pm File with pod in separate file
$mb = Module::Build->new_from_context;
$mb->do_create_readme;
like( slurp("README"), qr/NAME/, "Generating README from .pod");
-is( $mb->dist_author->[0], 'Simple Simon <simon@simple.sim>',
+is( $mb->dist_author->[0], 'Simple Simon <simon@simple.sim>',
"Extracting AUTHOR from .pod");
-is( $mb->dist_abstract, "A simple module",
+is( $mb->dist_abstract, "A simple module",
"Extracting abstract from .pod");
-# .pm File with pod and separate pod file
+# .pm File with pod and separate pod file
#
$dist->change_file( 'lib/Simple.pm', <<'---' );
{
package IO::StringBased;
-
+
sub TIEHANDLE {
my ($class, $string) = @_;
return bless {
data => [ map "$_\n", split /\n/, $string],
}, $class;
}
-
+
sub READLINE {
shift @{ shift()->{data} };
}
my $pp = Module::Build::PodParser->new(fh => \*FH);
ok $pp, 'object created';
-
+
is_deeply $pp->get_author, [], 'author';
is $pp->get_abstract, 'Perl extension for blah blah blah', 'abstract';
}
# falsify compiler and test error handling
#--------------------------------------------------------------------------#
+# clear $ENV{CC} so we are sure to fail to find our fake compiler :-)
+local $ENV{CC};
+
my $err = stderr_of( sub {
$mb = $dist->new_from_context( config => { cc => "adfasdfadjdjk" } )
});
my $share_list = Module::Build->rscan_dir('blib/lib/auto/share', sub {-f});
+SKIP:
+{
+
+skip 'filename case not necessarily preserved', 1 if $^O eq 'VMS';
+
is_deeply(
[ sort @$share_list ], [
'blib/lib/auto/share/dist/Simple-Share/foo.txt',
"share_dir files copied to blib"
);
+}
+
#--------------------------------------------------------------------------#
# test installing
#--------------------------------------------------------------------------#
"$temp_install/lib/perl5/auto/share", sub {-f}
);
+SKIP:
+{
+
+skip 'filename case not necessarily preserved', 1 if $^O eq 'VMS';
+
is_deeply(
[ sort @$share_list ], [
"$temp_install/lib/perl5/auto/share/dist/Simple-Share/foo.txt",
"share_dir files correctly installed"
);
+}
+
#--------------------------------------------------------------------------#
# test with File::ShareDir
#--------------------------------------------------------------------------#
my $dist = DistGen->new(dir => MBTest->tmpdir);
$dist->add_file('bin/foo', undent(<<' ---'));
#!/usr/bin/perl
-
+
package bin::foo;
$VERSION = 0.01;
$dist->add_file('t/special_ext.st', <<'---' );
-#!perl
+#!perl
use Test::More tests => 2;
ok(1, 'first test in special_ext');
ok(1, 'second test in special_ext');
$::x = 0;
my $mb = Module::Build->subclass(
code => q#
- sub ACTION_testspecial {
+ sub ACTION_testspecial {
$::x++;
shift->generic_test(type => 'special');
}
my $dist = DistGen->new()->chdir_in;
$dist->add_file('t/special_ext.st', <<'---');
-#!perl
+#!perl
use Test::More tests => 2;
ok(1, 'first test in special_ext');
ok(1, 'second test in special_ext');
---
$dist->add_file('t/another_ext.at', <<'---');
-#!perl
+#!perl
use Test::More tests => 2;
ok(1, 'first test in another_ext');
ok(1, 'second test in another_ext');
---
$dist->add_file('t/foo.txt', <<'---');
-#!perl
+#!perl
use Test::More tests => 1;
ok 0, "don't run this non-test file";
die "don't run this non-test file";
my $mb = Module::Build->subclass(
code => q#
- sub ACTION_testspecial {
+ sub ACTION_testspecial {
shift->generic_test(type => 'special');
}
- sub ACTION_testanother {
+ sub ACTION_testanother {
shift->generic_test(type => 'another');
}
#
$dist->revert;
$dist->add_file('t/foo/special.st', <<'---');
-#!perl
+#!perl
use Test::More tests => 2;
ok(1, 'first test in special_ext');
ok(1, 'second test in special_ext');
my $mb = Module::Build->subclass(
code => q#
- sub ACTION_testspecial {
+ sub ACTION_testspecial {
shift->generic_test(type => 'special');
}
- sub ACTION_testanother {
+ sub ACTION_testanother {
shift->generic_test(type => 'another');
}
#
is( run_sample( $p => '~/foo' )->$p(), "$home/foo" );
is( run_sample( $p => '~/ foo')->$p(), "$home/ foo" );
-
+
is( run_sample( $p => '~/fo o')->$p(), "$home/fo o" );
is( run_sample( $p => 'foo~' )->$p(), 'foo~' );
my @info = eval { getpwuid $> };
skip "No home directory for tilde-expansion tests", 1 if $@;
my ($me, $home) = @info[0,7];
-
+
my $expected = "$home/foo";
if ($^O eq 'VMS') {
$FIND_VERSION $ERROR $CHECK_INC_HASH];
use Exporter;
@ISA = qw[Exporter];
- $VERSION = '0.34';
+ $VERSION = '0.38';
$VERBOSE = 0;
$DEPRECATED = 0;
$FIND_VERSION = 1;
### Update from JPeacock: apparently qv() and version->new
### are different things, and we *must* use version->new
### here, or things like #30056 might start happening
- $href->{uptodate} =
+
+ ### We have to wrap this in an eval as version-0.82 raises
+ ### exceptions and not warnings now *sigh*
+
+ eval {
+
+ $href->{uptodate} =
version->new( $args->{version} ) <= version->new( $href->{version} )
? 1
: 0;
+
+ };
}
if ( $DEPRECATED and version->new($]) >= version->new('5.011') ) {
my $str = shift or return;
my $verbose = shift or 0;
+ ### skip lines which doesn't contain VERSION
+ return unless $str =~ /VERSION/;
+
### skip commented out lines, they won't eval to anything.
return if $str =~ /^\s*#/;
$| = 1;
+BEGIN {
+ if ($^O eq 'VMS') {
+ print "1..0 # needs upstream patch from https://rt.cpan.org/Ticket/Display.html?id=55121";
+ exit 0;
+ }
+}
+
use Test::More tests => 4;
BEGIN {
# ChangeLog for Pod::Simple dist
#---------------------------------------------------------------------------
+2009-04-27
+ * Release 3.14
+
+ Removed explicit loading of UNIVERSAL. RJBS.
+
+ Reversed the change applied in release 3.09 to fix RT #12239. POD
+ tag found inside a complex POD tag (e.g., "C<<< I<foo> >>>") is
+ again parsed as a tag embedded in a tag instead of text and
+ entities. The previous interpretation of `perldoc perlpod` was
+ mistaken. (RT #55602 from Christopher J. Madsen).
+
2009-12-17 David E. Wheeler <david@justatheory.org>
* Release 3.13
-=head1 Pod::Simple version 3.13
+=head1 Pod::Simple version 3.14
Pod::Simple is a Perl library for parsing text in the Pod ("plain old
documentation") markup language that is typically used for writing
);
@ISA = ('Pod::Simple::BlackBox');
-$VERSION = '3.13';
+$VERSION = '3.14';
@Known_formatting_codes = qw(I B C L E F S X Z);
%Known_formatting_codes = map(($_=>1), @Known_formatting_codes);
use strict;
use Carp ();
use vars qw($VERSION );
-$VERSION = '3.13';
+$VERSION = '3.14';
#use constant DEBUG => 7;
BEGIN {
require Pod::Simple;
if(defined $1) {
if(defined $2) {
DEBUG > 3 and print "Found complex start-text code \"$1\"\n";
- # signal that we're looking for simple unless we're in complex.
- if ($stack[-1]) {
- # We're in complex already. It's just stuff.
- DEBUG > 4 and print " It's just stuff.\n";
- push @{ $lineage[-1] }, $1;
- } else {
- # length of the necessary complex end-code string
- push @stack, length($2) + 1;
- push @lineage, [ substr($1,0,1), {}, ]; # new node object
- push @{ $lineage[-2] }, $lineage[-1];
- }
+ push @stack, length($2) + 1;
+ # length of the necessary complex end-code string
} else {
DEBUG > 3 and print "Found simple start-text code \"$1\"\n";
- if ($stack[-1]) {
- # We're in complex already. It's just stuff.
- DEBUG > 4 and print " It's just stuff.\n";
- push @{ $lineage[-1] }, $1;
- } else {
- # signal that we're looking for simple.
- push @stack, 0;
- push @lineage, [ substr($1,0,1), {}, ]; # new node object
- push @{ $lineage[-2] }, $lineage[-1];
- }
+ push @stack, 0; # signal that we're looking for simple
}
+ push @lineage, [ substr($1,0,1), {}, ]; # new node object
+ push @{ $lineage[-2] }, $lineage[-1];
+
} elsif(defined $4) {
DEBUG > 3 and print "Found apparent complex end-text code \"$3$4\"\n";
# This is where it gets messy...
sub _stringify_lol { # the real recursor
my($lol, $to) = @_;
- use UNIVERSAL ();
for(my $i = 2; $i < @$lol; ++$i) {
if( ref($lol->[$i] || '') and UNIVERSAL::isa($lol->[$i], 'ARRAY') ) {
_stringify_lol( $lol->[$i], $to); # recurse!
use Pod::Simple::Methody ();
use Pod::Simple ();
use vars qw( @ISA $VERSION );
-$VERSION = '3.13';
+$VERSION = '3.14';
@ISA = ('Pod::Simple::Methody');
BEGIN { *DEBUG = defined(&Pod::Simple::DEBUG)
? \&Pod::Simple::DEBUG
package Pod::Simple::Debug;
use strict;
use vars qw($VERSION );
-$VERSION = '3.13';
+$VERSION = '3.14';
sub import {
my($value,$variable);
require 5;
package Pod::Simple::DumpAsText;
-$VERSION = '3.13';
+$VERSION = '3.14';
use Pod::Simple ();
BEGIN {@ISA = ('Pod::Simple')}
require 5;
package Pod::Simple::DumpAsXML;
-$VERSION = '3.13';
+$VERSION = '3.14';
use Pod::Simple ();
BEGIN {@ISA = ('Pod::Simple')}
$Doctype_decl $Content_decl
);
@ISA = ('Pod::Simple::PullParser');
-$VERSION = '3.13';
+$VERSION = '3.14';
-use UNIVERSAL ();
BEGIN {
if(defined &DEBUG) { } # no-op
elsif( defined &Pod::Simple::DEBUG ) { *DEBUG = \&Pod::Simple::DEBUG }
use vars qw( $VERSION $HTML_RENDER_CLASS $HTML_EXTENSION
$CSS $JAVASCRIPT $SLEEPY $SEARCH_CLASS @ISA
);
-$VERSION = '3.13';
+$VERSION = '3.14';
@ISA = (); # Yup, we're NOT a subclass of Pod::Simple::HTML!
# TODO: nocontents stylesheets. Strike some of the color variations?
use Pod::Simple::HTML ();
BEGIN {*esc = \&Pod::Simple::HTML::esc }
use File::Spec ();
-use UNIVERSAL ();
- # "Isn't the Universe an amazing place? I wouldn't live anywhere else!"
use Pod::Simple::Search;
$SEARCH_CLASS ||= 'Pod::Simple::Search';
package Pod::Simple::LinkSection;
# Based somewhat dimly on Array::Autojoin
use vars qw($VERSION );
-$VERSION = '3.13';
+$VERSION = '3.14';
use strict;
use Pod::Simple::BlackBox;
use vars qw($VERSION );
-$VERSION = '3.13';
+$VERSION = '3.14';
use overload( # So it'll stringify nice
'""' => \&Pod::Simple::BlackBox::stringify_lol,
use strict;
use Pod::Simple ();
use vars qw(@ISA $VERSION);
-$VERSION = '3.13';
+$VERSION = '3.14';
@ISA = ('Pod::Simple');
# Yes, we could use named variables, but I want this to be impose
require 5;
package Pod::Simple::Progress;
-$VERSION = '3.13';
+$VERSION = '3.14';
use strict;
# Objects of this class are used for noting progress of an
require 5;
package Pod::Simple::PullParser;
-$VERSION = '3.13';
+$VERSION = '3.14';
use Pod::Simple ();
BEGIN {@ISA = ('Pod::Simple')}
return shift @{$self->{'token_buffer'}}; # that's an undef if empty
}
-use UNIVERSAL ();
sub unget_token {
my $self = shift;
DEBUG and print "Ungetting ", scalar(@_), " tokens: ",
use strict;
use vars qw(@ISA $VERSION);
@ISA = ('Pod::Simple::PullParserToken');
-$VERSION = '3.13';
+$VERSION = '3.14';
sub new { # Class->new(tagname);
my $class = shift;
use strict;
use vars qw(@ISA $VERSION);
@ISA = ('Pod::Simple::PullParserToken');
-$VERSION = '3.13';
+$VERSION = '3.14';
sub new { # Class->new(tagname, optional_attrhash);
my $class = shift;
use strict;
use vars qw(@ISA $VERSION);
@ISA = ('Pod::Simple::PullParserToken');
-$VERSION = '3.13';
+$VERSION = '3.14';
sub new { # Class->new(text);
my $class = shift;
package Pod::Simple::PullParserToken;
# Base class for tokens gotten from Pod::Simple::PullParser's $parser->get_token
@ISA = ();
-$VERSION = '3.13';
+$VERSION = '3.14';
use strict;
sub new { # Class->new('type', stuff...); ## Overridden in derived classes anyway
use strict;
use vars qw($VERSION @ISA %Escape $WRAP %Tagmap);
-$VERSION = '3.13';
+$VERSION = '3.14';
use Pod::Simple::PullParser ();
BEGIN {@ISA = ('Pod::Simple::PullParser')}
use strict;
use vars qw($VERSION $MAX_VERSION_WITHIN $SLEEPY);
-$VERSION = '3.13'; ## Current version of this package
+$VERSION = '3.14'; ## Current version of this package
BEGIN { *DEBUG = sub () {0} unless defined &DEBUG; } # set DEBUG level
use Carp ();
use Carp ();
use Pod::Simple ();
use vars qw( $ATTR_PAD @ISA $VERSION $SORT_ATTRS);
-$VERSION = '3.13';
+$VERSION = '3.14';
BEGIN {
@ISA = ('Pod::Simple');
*DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG;
use Pod::Simple::Methody ();
use Pod::Simple ();
use vars qw( @ISA $VERSION $FREAKYMODE);
-$VERSION = '3.13';
+$VERSION = '3.14';
@ISA = ('Pod::Simple::Methody');
BEGIN { *DEBUG = defined(&Pod::Simple::DEBUG)
? \&Pod::Simple::DEBUG
use Carp ();
use Pod::Simple ();
use vars qw( @ISA $VERSION );
-$VERSION = '3.13';
+$VERSION = '3.14';
@ISA = ('Pod::Simple');
sub new {
use Symbol ('gensym');
use Carp ();
use vars qw($VERSION );
-$VERSION = '3.13';
+$VERSION = '3.14';
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
require 5;
package Pod::Simple::Transcode;
use vars qw($VERSION );
-$VERSION = '3.13';
+$VERSION = '3.14';
BEGIN {
if(defined &DEBUG) {;} # Okay
package Pod::Simple::TranscodeDumb;
use strict;
use vars qw($VERSION %Supported);
-$VERSION = '3.13';
+$VERSION = '3.14';
# This module basically pretends it knows how to transcode, except
# only for null-transcodings! We use this when Encode isn't
# available.
use Pod::Simple;
require Encode;
use vars qw($VERSION );
-$VERSION = '3.13';
+$VERSION = '3.14';
sub is_dumb {0}
sub is_smart {1}
package Pod::Simple::XHTML;
use strict;
use vars qw( $VERSION @ISA $HAS_HTML_ENTITIES );
-$VERSION = '3.13';
+$VERSION = '3.14';
use Carp ();
use Pod::Simple::Methody ();
@ISA = ('Pod::Simple::Methody');
use Carp ();
use Pod::Simple ();
use vars qw( $ATTR_PAD @ISA $VERSION $SORT_ATTRS);
-$VERSION = '3.13';
+$VERSION = '3.14';
BEGIN {
@ISA = ('Pod::Simple');
*DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG;
use strict;
use Test;
-BEGIN { plan tests => 21 };
+BEGIN { plan tests => 23 };
#use Pod::Simple::Debug (5);
print "# Without any nesting, but with Z's, and odder whitespace...\n";
ok( Pod::Simple::XMLOutStream->_out("=pod\n\nF<< aZ<> >>C<<< Z<>b >>>I<<<< c >>>>B<< d \t >>X<<\ne >>\n"),
- '<Document><Para><F>aZ<></F><C>Z<>b</C><I>c</I><B>d</B><X>e</X></Para></Document>'
+ '<Document><Para><F>a</F><C>b</C><I>c</I><B>d</B><X>e</X></Para></Document>'
);
print "# With nesting and Z's, and odder whitespace...\n";
ok( Pod::Simple::XMLOutStream->_out("=pod\n\nF<< aZ<> >>C<<< Z<>bZ<>B<< d \t >>X<<\ne >> >>>I<<<< c >>>>\n"),
- "<Document><Para><F>aZ<></F><C>Z<>bZ<>B<< d >>X<< e >></C><I>c</I></Para></Document>"
+ "<Document><Para><F>a</F><C>b<B>d</B><X>e</X></C><I>c</I></Para></Document>"
);
-print "# Regression https://rt.cpan.org/Ticket/Display.html?id=12239\n";
+print "# Regression https://rt.cpan.org/Ticket/Display.html?id=55602 (vs 12239)\n";
ok( Pod::Simple::XMLOutStream->_out("=pod\n\nC<<< foo->bar >>>\n"),
'<Document><Para><C>foo->bar</C></Para></Document>'
);
ok( Pod::Simple::XMLOutStream->_out("=pod\n\nC<<< C<foo> >>>\n"),
- '<Document><Para><C>C<foo></C></Para></Document>'
+ '<Document><Para><C><C>foo</C></C></Para></Document>'
);
ok( Pod::Simple::XMLOutStream->_out("=pod\n\nC<<< C<<foo>> >>>\n"),
+ '<Document><Para><C><C><foo</C>></C></Para></Document>'
+);
+ok( Pod::Simple::XMLOutStream->_out("=pod\n\nC<<< CZ<><<foo>> >>>\n"),
+ '<Document><Para><C>C<<foo>></C></Para></Document>'
+);
+ok( Pod::Simple::XMLOutStream->_out("=pod\n\nC<<< CE<lt><foo>> >>>\n"),
'<Document><Para><C>C<<foo>></C></Para></Document>'
);
ok( $x->_out(qq{=pod\n\nL<< Perl B<<< Error E<77>essages >>>|perldiag >>\n}),
- '<Document><Para><L content-implicit="yes" section="Perl B<<< Error E<77>essages" type="pod">"Perl B<<< Error E<77>essages"</L>>|perldiag >></Para></Document>',
+ '<Document><Para><L to="perldiag" type="pod">Perl <B>Error Messages</B></L></Para></Document>'
);
ok( $x->_out(qq{=pod\n\nL<< Perl\nB<<< Error\nE<77>essages >>>|perldiag >>\n}),
- '<Document><Para><L content-implicit="yes" section="Perl B<<< Error E<77>essages" type="pod">"Perl B<<< Error E<77>essages"</L>>|perldiag >></Para></Document>'
+ '<Document><Para><L to="perldiag" type="pod">Perl <B>Error Messages</B></L></Para></Document>'
);
ok( $x->_out(qq{=pod\n\nL<< Perl\nB<<< Error\t E<77>essages >>>|perldiag >>\n}),
- '<Document><Para><L content-implicit="yes" section="Perl B<<< Error E<77>essages" type="pod">"Perl B<<< Error E<77>essages"</L>>|perldiag >></Para></Document>'
+ '<Document><Para><L to="perldiag" type="pod">Perl <B>Error Messages</B></L></Para></Document>'
);
ok( $x->_out(qq{=pod\n\nL<< SWITCH B<<< E<115>tatements >>>|perlsyn/"Basic I<<<< BLOCKs >>>> and Switch StatementE<115>" >>\n}),
- '<Document><Para><L content-implicit="yes" section="SWITCH B<<< E<115>tatements" type="pod">"SWITCH B<<< E<115>tatements"</L>>|perlsyn/"Basic <I>BLOCKs</I> and Switch Statements" >></Para></Document>'
+ '<Document><Para><L section="Basic BLOCKs and Switch Statements" to="perlsyn" type="pod">SWITCH <B>statements</B></L></Para></Document>'
);
ok( $x->_out(qq{=pod\n\nL<< SWITCH B<<< E<115>tatements >>>|perlsyn/Basic I<<<< BLOCKs >>>> and Switch StatementE<115> >>\n}),
- '<Document><Para><L content-implicit="yes" section="SWITCH B<<< E<115>tatements" type="pod">"SWITCH B<<< E<115>tatements"</L>>|perlsyn/Basic <I>BLOCKs</I> and Switch Statements >></Para></Document>'
+ '<Document><Para><L section="Basic BLOCKs and Switch Statements" to="perlsyn" type="pod">SWITCH <B>statements</B></L></Para></Document>'
);
ok( $x->_out(qq{=pod\n\nL<<< the F<< various >> attributes|/"Member Data" >>>\n}),
- '<Document><Para><L section="Member Data" type="pod">the F<< various >> attributes</L></Para></Document>'
+ '<Document><Para><L section="Member Data" type="pod">the <F>various</F> attributes</L></Para></Document>'
);
ok( $x->_out(qq{=pod\n\nL<<< the F<< various >> attributes|/Member Data >>>\n}),
- '<Document><Para><L section="Member Data" type="pod">the F<< various >> attributes</L></Para></Document>'
+ '<Document><Para><L section="Member Data" type="pod">the <F>various</F> attributes</L></Para></Document>'
);
ok( $x->_out(qq{=pod\n\nL<<< the F<< various >> attributes|"Member Data" >>>\n}),
- '<Document><Para><L section="Member Data" type="pod">the F<< various >> attributes</L></Para></Document>'
+ '<Document><Para><L section="Member Data" type="pod">the <F>various</F> attributes</L></Para></Document>'
);
###########################################################################
ok( $x->_out(qq{=pod\n\nI like L<< Perl B<<< Error E<77>essages >>>|perldiag >>.\n}),
- '<Document><Para>I like <L content-implicit="yes" section="Perl B<<< Error E<77>essages" type="pod">"Perl B<<< Error E<77>essages"</L>>|perldiag >>.</Para></Document>'
+ '<Document><Para>I like <L to="perldiag" type="pod">Perl <B>Error Messages</B></L>.</Para></Document>'
);
ok( $x->_out(qq{=pod\n\nI like L<< Perl\nB<<< Error\nE<77>essages >>>|perldiag >>.\n}),
- '<Document><Para>I like <L content-implicit="yes" section="Perl B<<< Error E<77>essages" type="pod">"Perl B<<< Error E<77>essages"</L>>|perldiag >>.</Para></Document>'
+ '<Document><Para>I like <L to="perldiag" type="pod">Perl <B>Error Messages</B></L>.</Para></Document>'
);
ok( $x->_out(qq{=pod\n\nI like L<< Perl\nB<<< Error\t E<77>essages >>>|perldiag >>.\n}),
- '<Document><Para>I like <L content-implicit="yes" section="Perl B<<< Error E<77>essages" type="pod">"Perl B<<< Error E<77>essages"</L>>|perldiag >>.</Para></Document>'
+ '<Document><Para>I like <L to="perldiag" type="pod">Perl <B>Error Messages</B></L>.</Para></Document>'
);
ok( $x->_out(qq{=pod\n\nI like L<< SWITCH B<<< E<115>tatements >>>|perlsyn/"Basic I<<<< BLOCKs >>>> and Switch StatementE<115>" >>.\n}),
- '<Document><Para>I like <L content-implicit="yes" section="SWITCH B<<< E<115>tatements" type="pod">"SWITCH B<<< E<115>tatements"</L>>|perlsyn/"Basic <I>BLOCKs</I> and Switch Statements" >>.</Para></Document>'
+ '<Document><Para>I like <L section="Basic BLOCKs and Switch Statements" to="perlsyn" type="pod">SWITCH <B>statements</B></L>.</Para></Document>'
);
ok( $x->_out(qq{=pod\n\nI like L<< SWITCH B<<< E<115>tatements >>>|perlsyn/Basic I<<<< BLOCKs >>>> and Switch StatementE<115> >>.\n}),
- '<Document><Para>I like <L content-implicit="yes" section="SWITCH B<<< E<115>tatements" type="pod">"SWITCH B<<< E<115>tatements"</L>>|perlsyn/Basic <I>BLOCKs</I> and Switch Statements >>.</Para></Document>'
+ '<Document><Para>I like <L section="Basic BLOCKs and Switch Statements" to="perlsyn" type="pod">SWITCH <B>statements</B></L>.</Para></Document>'
);
ok( $x->_out(qq{=pod\n\nI like L<<< the F<< various >> attributes|/"Member Data" >>>.\n}),
- '<Document><Para>I like <L section="Member Data" type="pod">the F<< various >> attributes</L>.</Para></Document>'
+ '<Document><Para>I like <L section="Member Data" type="pod">the <F>various</F> attributes</L>.</Para></Document>'
);
ok( $x->_out(qq{=pod\n\nI like L<<< the F<< various >> attributes|/Member Data >>>.\n}),
- '<Document><Para>I like <L section="Member Data" type="pod">the F<< various >> attributes</L>.</Para></Document>'
+ '<Document><Para>I like <L section="Member Data" type="pod">the <F>various</F> attributes</L>.</Para></Document>'
);
ok( $x->_out(qq{=pod\n\nI like L<<< the F<< various >> attributes|"Member Data" >>>.\n}),
- '<Document><Para>I like <L section="Member Data" type="pod">the F<< various >> attributes</L>.</Para></Document>'
+ '<Document><Para>I like <L section="Member Data" type="pod">the <F>various</F> attributes</L>.</Para></Document>'
);
ok( $x->_out(qq{=pod\n\nI like L<<< B<text>s|http://text.com >>>.\n}),
-'<Document><Para>I like <L to="http://text.com" type="url">B<text>s</L>.</Para></Document>'
+'<Document><Para>I like <L to="http://text.com" type="url"><B>text</B>s</L>.</Para></Document>'
);
ok( $x->_out(qq{=pod\n\nI like L<<< text|https://text.com/1/2 >>>.\n}),
'<Document><Para>I like <L to="https://text.com/1/2" type="url">text</L>.</Para></Document>'
);
ok( $x->_out(qq{=pod\n\nI like L<<< I<text>|http://text.com >>>.\n}),
-'<Document><Para>I like <L to="http://text.com" type="url">I<text></L>.</Para></Document>'
+'<Document><Para>I like <L to="http://text.com" type="url"><I>text</I></L>.</Para></Document>'
);
ok( $x->_out(qq{=pod\n\nI like L<<< C<text>|http://text.com >>>.\n}),
-'<Document><Para>I like <L to="http://text.com" type="url">C<text></L>.</Para></Document>'
+'<Document><Para>I like <L to="http://text.com" type="url"><C>text</C></L>.</Para></Document>'
);
ok( $x->_out(qq{=pod\n\nI like L<<< I<tI<eI<xI<t>>>>|mailto:earlE<64>text.com >>>.\n}),
-'<Document><Para>I like <L to="mailto:earlE<64>text.com" type="url">I<tI<eI<xI<t>>>></L>.</Para></Document>'
+'<Document><Para>I like <L to="mailto:earl@text.com" type="url"><I>t<I>e<I>x<I>t</I></I></I></I></L>.</Para></Document>'
);
ok( $x->_out(qq{=pod\n\nI like L<<< textZ<>|http://text.com >>>.\n}),
-'<Document><Para>I like <L to="http://text.com" type="url">textZ<></L>.</Para></Document>'
+'<Document><Para>I like <L to="http://text.com" type="url">text</L>.</Para></Document>'
);
# RT#25679
ok(
$x->_out(<<END
-=head1 The Tk::mega manpage showed me how C<< S< > foo >> is being rendered
+=head1 The Tk::mega manpage showed me how C<< SE<lt> > foo >> is being rendered
Both pod2text and pod2man S< > lose the rest of the line
return '' if ref($_[0]) ne ref($_[1]); # unequal referentiality
return $_[0] eq $_[1] unless ref $_[0];
# So it's a ref:
- use UNIVERSAL;
if(UNIVERSAL::isa($_[0], 'ARRAY')) {
return '' unless @{$_[0]} == @{$_[1]};
for(my $i = 0; $i < @{$_[0]}; $i++) {
$VERSION = '0.72_01';
$VERSION = eval $VERSION;
+use if $] >= 5.011, 'deprecate';
+
sub new { bless \my $foo, shift }
sub DESTROY { }
use Test::More;
# NB. For PERL_CORE to be set, taint mode must not be enabled
-my $macrosall = $ENV{PERL_CORE} ? File::Spec->catfile(qw(.. ext Sys-Syslog macros.all))
- : 'macros.all';
+my $macrosall = 'macros.all';
open(MACROS, $macrosall) or plan skip_all => "can't read '$macrosall': $!";
my @names = map {chomp;$_} <MACROS>;
close(MACROS);
use Time::Seconds;
use Carp;
use Time::Local;
-use UNIVERSAL qw(isa);
+#use UNIVERSAL qw(isa); # Commented out for Perl 5.12.0 by JRV to avoid a deprecation warning
our @ISA = qw(Exporter DynaLoader);
':override' => 'internal',
);
-our $VERSION = '1.15';
+our $VERSION = '1.15_01';
bootstrap Time::Piece $VERSION;
package Time::Seconds;
use strict;
use vars qw/@EXPORT @EXPORT_OK @ISA/;
-use UNIVERSAL qw(isa);
+# use UNIVERSAL qw(isa); # Commented out for Perl 5.12.0 by JRV to avoid a deprecation warning.
@ISA = 'Exporter';
-$VERSION = '2.2.2';
+$VERSION = '2.3.1';
use Carp qw(croak);
use Pod::Simple ();
-use POSIX qw(strftime);
@ISA = qw(Pod::Simple);
-$VERSION = '2.22';
+$VERSION = '2.23';
# Set the debugging level. If someone has inserted a debug function into this
# class already, use that. Otherwise, use any Pod::Simple debug function
# If we have a command handler, we need to accumulate the contents of the
# tag before calling it. Turn off IN_NAME for any command other than
- # <Para> so that IN_NAME isn't still set for the first heading after the
- # NAME heading.
+ # <Para> and the formatting codes so that IN_NAME isn't still set for the
+ # first heading after the NAME heading.
if ($self->can ("cmd_$method")) {
DEBUG > 2 and print "<$element> starts saving a tag\n";
- $$self{IN_NAME} = 0 if ($element ne 'Para');
+ $$self{IN_NAME} = 0 if ($element ne 'Para' && length ($element) > 1);
# How we're going to format embedded text blocks depends on the tag
# and also depends on our parent tags. Thankfully, inside tags that
# several places in the following regex.
my $index = '(?: \[.*\] | \{.*\} )?';
+ # If in NAME section, just return an ASCII quoted string to avoid
+ # confusing tools like whatis.
+ return qq{"$_"} if $$self{IN_NAME};
+
# Check for things that we don't want to quote, and if we find any of
# them, return the string with just a font change and no quoting.
m{
for (@output) {
my ($type, $entry) = @$_;
$entry =~ s/\"/\"\"/g;
+ $entry =~ s/\\/\\\\/g;
$self->output (".IX $type " . '"' . $entry . '"' . "\n");
}
}
} else {
$time = time;
}
- return strftime ('%Y-%m-%d', localtime $time);
+
+ # Can't use POSIX::strftime(), which uses Fcntl, because MakeMaker
+ # uses this and it has to work in the core which can't load dynamic
+ # libraries.
+ my ($year, $month, $day) = (localtime $time)[5,4,3];
+ return sprintf ("%04d-%02d-%02d", $year + 1900, $month + 1, $day);
}
# Print out the preamble and the title. The meaning of the arguments to .TH
# All of the formatting codes that aren't handled internally by the parser,
# other than L<> and X<>.
-sub cmd_b { return '\f(BS' . $_[2] . '\f(BE' }
-sub cmd_i { return '\f(IS' . $_[2] . '\f(IE' }
-sub cmd_f { return '\f(IS' . $_[2] . '\f(IE' }
+sub cmd_b { return $_[0]->{IN_NAME} ? $_[2] : '\f(BS' . $_[2] . '\f(BE' }
+sub cmd_i { return $_[0]->{IN_NAME} ? $_[2] : '\f(IS' . $_[2] . '\f(IE' }
+sub cmd_f { return $_[0]->{IN_NAME} ? $_[2] : '\f(IS' . $_[2] . '\f(IE' }
sub cmd_c { return $_[0]->quote_literal ($_[2]) }
# Index entries are just added to the pending entries.
# a URL.
sub cmd_l {
my ($self, $attrs, $text) = @_;
- return $$attrs{type} eq 'url' ? "<$text>" : $text;
+ if ($$attrs{type} eq 'url') {
+ if (not defined($$attrs{to}) or $$attrs{to} eq $text) {
+ return "<$text>";
+ } else {
+ return "$text <$$attrs{to}>";
+ }
+ } else {
+ return $text;
+ }
}
##############################################################################
# Pod::ParseLink -- Parse an L<> formatting code in POD text.
#
-# Copyright 2001, 2008 by Russ Allbery <rra@stanford.edu>
+# Copyright 2001, 2008, 2009 by Russ Allbery <rra@stanford.edu>
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.
@ISA = qw(Exporter);
@EXPORT = qw(parselink);
-$VERSION = '1.09';
+$VERSION = '1.10';
##############################################################################
# Implementation
sub parselink {
my ($link) = @_;
$link =~ s/\s+/ /g;
+ my $text;
+ if ($link =~ /\|/) {
+ ($text, $link) = split (/\|/, $link, 2);
+ }
if ($link =~ /\A\w+:[^:\s]\S*\Z/) {
- return (undef, $link, $link, undef, 'url');
- } else {
- my $text;
- if ($link =~ /\|/) {
- ($text, $link) = split (/\|/, $link, 2);
+ my $inferred;
+ if (defined ($text) && length ($text) > 0) {
+ return ($text, $text, $link, undef, 'url');
+ } else {
+ return ($text, $link, $link, undef, 'url');
}
+ } else {
my ($name, $section) = _parse_section ($link);
- my $inferred = $text || _infer_text ($name, $section);
+ my $inferred;
+ if (defined ($text) && length ($text) > 0) {
+ $inferred = $text;
+ } else {
+ $inferred = _infer_text ($name, $section);
+ }
my $type = ($name && $name =~ /\(\S*\)/) ? 'man' : 'pod';
return ($text, $inferred, $name, $section, $type);
}
=head1 COPYRIGHT AND LICENSE
-Copyright 2001, 2008 Russ Allbery <rra@stanford.edu>.
+Copyright 2001, 2008, 2009 Russ Allbery <rra@stanford.edu>.
This program is free software; you may redistribute it and/or modify it
under the same terms as Perl itself.
# Pod::Text -- Convert POD data to formatted ASCII text.
#
-# Copyright 1999, 2000, 2001, 2002, 2004, 2006, 2008
+# Copyright 1999, 2000, 2001, 2002, 2004, 2006, 2008, 2009
# Russ Allbery <rra@stanford.edu>
#
# This program is free software; you may redistribute it and/or modify it
# We have to export pod2text for backward compatibility.
@EXPORT = qw(pod2text);
-$VERSION = '3.13';
+$VERSION = '3.14';
##############################################################################
# Initialization
# Text blocks
##############################################################################
+# Intended for subclasses to override, this method returns text with any
+# non-printing formatting codes stripped out so that length() correctly
+# returns the length of the text. For basic Pod::Text, it does nothing.
+sub strip_format {
+ my ($self, $string) = @_;
+ return $string;
+}
+
# This method is called whenever an =item command is complete (in other words,
# we've seen its associated paragraph or know for certain that it doesn't have
# one). It gets the paragraph associated with the item as an argument. If
my $indent = $$self{INDENTS}[-1];
$indent = $$self{opt_indent} unless defined $indent;
my $margin = ' ' x $$self{opt_margin};
- my $fits = ($$self{MARGIN} - $indent >= length ($tag) + 1);
+ my $tag_length = length ($self->strip_format ($tag));
+ my $fits = ($$self{MARGIN} - $indent >= $tag_length + 1);
# If the tag doesn't fit, or if we have no associated text, print out the
# tag separately. Otherwise, put the tag in the margin of the paragraph.
$space =~ s/^$margin /$margin:/ if $$self{opt_alt};
$text = $self->reformat ($text);
$text =~ s/^$margin /$margin:/ if ($$self{opt_alt} && $indent > 0);
- my $tagspace = ' ' x length $tag;
+ my $tagspace = ' ' x $tag_length;
$text =~ s/^($space)$tagspace/$1$tag/ or warn "Bizarre space in item";
$self->output ($text);
}
# a URL.
sub cmd_l {
my ($self, $attrs, $text) = @_;
- return $$attrs{type} eq 'url' ? "<$text>" : $text;
+ if ($$attrs{type} eq 'url') {
+ if (not defined($$attrs{to}) or $$attrs{to} eq $text) {
+ return "<$text>";
+ } else {
+ return "$text <$$attrs{to}>";
+ }
+ } else {
+ return $text;
+ }
}
##############################################################################
=head1 COPYRIGHT AND LICENSE
-Copyright 1999, 2000, 2001, 2002, 2004, 2006, 2008 Russ Allbery
+Copyright 1999, 2000, 2001, 2002, 2004, 2006, 2008, 2009 Russ Allbery
<rra@stanford.edu>.
This program is free software; you may redistribute it and/or modify it
# Pod::Text::Color -- Convert POD data to formatted color ASCII text
#
-# Copyright 1999, 2001, 2004, 2006, 2008 Russ Allbery <rra@stanford.edu>
+# Copyright 1999, 2001, 2004, 2006, 2008, 2009 Russ Allbery <rra@stanford.edu>
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.
@ISA = qw(Pod::Text);
-$VERSION = '2.05';
+$VERSION = '2.06';
##############################################################################
# Overrides
$self->output ($code);
}
+# Strip all of the formatting from a provided string, returning the stripped
+# version. We will eventually want to use colorstrip() from Term::ANSIColor,
+# but it's fairly new so avoid the tight dependency.
+sub strip_format {
+ my ($self, $text) = @_;
+ $text =~ s/\e\[[\d;]*m//g;
+ return $text;
+}
+
# We unfortunately have to override the wrapping code here, since the normal
# wrapping code gets really confused by all the escape sequences.
sub wrap {
=head1 COPYRIGHT AND LICENSE
-Copyright 1999, 2001, 2004, 2006, 2008 Russ Allbery <rra@stanford.edu>.
+Copyright 1999, 2001, 2004, 2006, 2008, 2009 Russ Allbery <rra@stanford.edu>.
This program is free software; you may redistribute it and/or modify it
under the same terms as Perl itself.
@ISA = qw(Pod::Text);
-$VERSION = '2.03';
+$VERSION = '2.04';
##############################################################################
# Overrides
$self->output ($code);
}
+# Strip all of the formatting from a provided string, returning the stripped
+# version.
+sub strip_format {
+ my ($self, $text) = @_;
+ $text =~ s/(.)[\b]\1/$1/g;
+ $text =~ s/_[\b]//g;
+ return $text;
+}
+
# We unfortunately have to override the wrapping code here, since the normal
# wrapping code gets really confused by all the backspaces.
sub wrap {
}
##############################################################################
-# Utility functions
-##############################################################################
-
-# Strip all of the formatting from a provided string, returning the stripped
-# version.
-sub strip_format {
- my ($self, $text) = @_;
- $text =~ s/(.)[\b]\1/$1/g;
- $text =~ s/_[\b]//g;
- return $text;
-}
-
-##############################################################################
# Module return value and documentation
##############################################################################
=head1 COPYRIGHT AND LICENSE
Copyright 2000 by Joe Smith <Joe.Smith@inwap.com>.
-Copyright 2001, 2004 by Russ Allbery <rra@stanford.edu>.
+Copyright 2001, 2004, 2008 by Russ Allbery <rra@stanford.edu>.
This program is free software; you may redistribute it and/or modify it
under the same terms as Perl itself.
# Pod::Text::Termcap -- Convert POD data to ASCII text with format escapes.
#
-# Copyright 1999, 2001, 2002, 2004, 2006, 2008 Russ Allbery <rra@stanford.edu>
+# Copyright 1999, 2001, 2002, 2004, 2006, 2008, 2009
+# Russ Allbery <rra@stanford.edu>
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.
@ISA = qw(Pod::Text);
-$VERSION = '2.05';
+$VERSION = '2.06';
##############################################################################
# Overrides
$self->output ($$self{BOLD} . $code . $$self{NORM});
}
+# Strip all of the formatting from a provided string, returning the stripped
+# version.
+sub strip_format {
+ my ($self, $text) = @_;
+ $text =~ s/\Q$$self{BOLD}//g;
+ $text =~ s/\Q$$self{UNDL}//g;
+ $text =~ s/\Q$$self{NORM}//g;
+ return $text;
+}
+
# Override the wrapping code to igore the special sequences.
sub wrap {
my $self = shift;
=head1 COPYRIGHT AND LICENSE
-Copyright 1999, 2001, 2002, 2004, 2006, 2008 Russ Allbery
+Copyright 1999, 2001, 2002, 2004, 2006, 2008, 2009 Russ Allbery
<rra@stanford.edu>.
This program is free software; you may redistribute it and/or modify it
#
# basic.t -- Basic tests for podlators.
#
-# Copyright 2001, 2002, 2004, 2006 by Russ Allbery <rra@stanford.edu>
+# Copyright 2001, 2002, 2004, 2006, 2009 by Russ Allbery <rra@stanford.edu>
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.
chdir 't' if -d 't';
if ($ENV{PERL_CORE}) {
@INC = '../lib';
- } else {
- unshift (@INC, '../blib/lib');
}
unshift (@INC, '../blib/lib');
$| = 1;
- print "1..11\n";
}
-END {
- print "not ok 1\n" unless $loaded;
-}
+use strict;
-use Pod::Man;
-use Pod::Text;
-use Pod::Text::Overstrike;
-use Pod::Text::Termcap;
+use Test::More tests => 15;
+
+BEGIN {
+ use_ok ('Pod::Man');
+ use_ok ('Pod::Text');
+ use_ok ('Pod::Text::Overstrike');
+ use_ok ('Pod::Text::Termcap');
+}
# Find the path to the test source files. This requires some fiddling when
# these tests are run as part of Perl core.
}
}
-$loaded = 1;
-print "ok 1\n";
-
# Hard-code a few values to try to get reproducible results.
$ENV{COLUMNS} = 80;
$ENV{TERM} = 'xterm';
'Pod::Text::Termcap' => 'cap');
# Set default options to match those of pod2man and pod2text.
-%options = (sentence => 0);
+our %options = (sentence => 0);
-my $n = 2;
-for (sort keys %translators) {
- if ($_ eq 'Pod::Text::Color') {
- eval { require Term::ANSIColor };
- if ($@) {
- print "ok $n # skip\n";
- $n++;
- print "ok $n # skip\n";
- $n++;
- next;
+for my $module (sort keys %translators) {
+ SKIP: {
+ if ($module eq 'Pod::Text::Color') {
+ eval { require Term::ANSIColor };
+ skip 'Term::ANSIColor not found', 3 if $@;
+ require_ok ('Pod::Text::Color');
}
- require Pod::Text::Color;
- }
- my $parser = $_->new (%options);
- print (($parser && ref ($parser) eq $_) ? "ok $n\n" : "not ok $n\n");
- $n++;
+ my $parser = $module->new (%options);
+ isa_ok ($parser, $module, 'Parser object');
- # For Pod::Man, strip out the autogenerated header up to the .TH title
- # line. That means that we don't check those things; oh well. The header
- # changes with each version change or touch of the input file.
- open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n";
- $parser->parse_from_file (source_path ('basic.pod'), \*OUT);
- close OUT;
- if ($_ eq 'Pod::Man') {
- open (TMP, 'out.tmp') or die "Cannot open out.tmp: $!\n";
- open (OUTPUT, "> out.$translators{$_}")
- or die "Cannot create out.$translators{$_}: $!\n";
- local $_;
- while (<TMP>) { last if /^\.nh/ }
- print OUTPUT while <TMP>;
- close OUTPUT;
- close TMP;
- unlink 'out.tmp';
- } else {
- rename ('out.tmp', "out.$translators{$_}")
- or die "Cannot rename out.tmp: $!\n";
- }
- {
- local $/;
- open (MASTER, source_path ("basic.$translators{$_}"))
- or die "Cannot open basic.$translators{$_}: $!\n";
- open (OUTPUT, "out.$translators{$_}")
- or die "Cannot open out.$translators{$_}: $!\n";
- my $master = <MASTER>;
- my $output = <OUTPUT>;
- close MASTER;
- close OUTPUT;
+ # For Pod::Man, strip out the autogenerated header up to the .TH title
+ # line. That means that we don't check those things; oh well. The
+ # header changes with each version change or touch of the input file.
+ open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n";
+ $parser->parse_from_file (source_path ('basic.pod'), \*OUT);
+ close OUT;
+ if ($module eq 'Pod::Man') {
+ open (TMP, 'out.tmp') or die "Cannot open out.tmp: $!\n";
+ open (OUTPUT, "> out.$translators{$module}")
+ or die "Cannot create out.$translators{$module}: $!\n";
+ local $_;
+ while (<TMP>) { last if /^\.nh/ }
+ print OUTPUT while <TMP>;
+ close OUTPUT;
+ close TMP;
+ 1 while unlink 'out.tmp';
+ } else {
+ rename ('out.tmp', "out.$translators{$module}")
+ or die "Cannot rename out.tmp: $!\n";
+ }
+
+ # Slurp the output and expected output and compare them.
+ my ($master, $output);
+ {
+ local $/;
+ open (MASTER, source_path ("basic.$translators{$module}"))
+ or die "Cannot open basic.$translators{$module}: $!\n";
+ open (OUTPUT, "out.$translators{$module}")
+ or die "Cannot open out.$translators{$module}: $!\n";
+ $master = <MASTER>;
+ $output = <OUTPUT>;
+ close MASTER;
+ close OUTPUT;
+ }
# OS/390 is EBCDIC, which uses a different character for ESC
# apparently. Try to convert so that the test still works.
- if ($^O eq 'os390' && $_ eq 'Pod::Text::Termcap') {
+ if ($^O eq 'os390' and $module eq 'Pod::Text::Termcap') {
$output =~ tr/\033/\047/;
}
-
- if ($master eq $output) {
- print "ok $n\n";
- unlink "out.$translators{$_}";
+ if (ok ($master eq $output, "$module output is correct")) {
+ 1 while unlink "out.$translators{$module}";
} else {
- print "not ok $n\n";
- print "# Non-matching output left in out.$translators{$_}\n";
+ diag ("Non-matching output left in out.$translators{$module}\n");
}
}
- $n++;
}
#
# color.t -- Additional specialized tests for Pod::Text::Color.
#
-# Copyright 2002, 2004, 2006 by Russ Allbery <rra@stanford.edu>
+# Copyright 2002, 2004, 2006, 2009 by Russ Allbery <rra@stanford.edu>
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.
chdir 't' if -d 't';
if ($ENV{PERL_CORE}) {
@INC = '../lib';
- } else {
- unshift (@INC, '../blib/lib');
}
unshift (@INC, '../blib/lib');
$| = 1;
- print "1..2\n";
}
-END {
- print "not ok 1\n" unless $loaded;
-}
+use strict;
+
+use Test::More;
+# Skip this test if Term::ANSIColor isn't available.
eval { require Term::ANSIColor };
if ($@) {
- for (1..2) {
- print "ok $_ # skip\n";
- }
- $loaded = 1;
- exit;
+ plan skip_all => 'Term::ANSIColor required for Pod::Text::Color';
+} else {
+ plan tests => 4;
}
-require Pod::Text::Color;
+require_ok ('Pod::Text::Color');
-$loaded = 1;
-print "ok 1\n";
-
-my $parser = Pod::Text::Color->new or die "Cannot create parser\n";
-my $n = 2;
+# Load tests from the data section below, write the POD to a temporary file,
+# convert it, and compare to the expected output.
+my $parser = Pod::Text::Color->new;
+isa_ok ($parser, 'Pod::Text::Color', 'Parser object');
+my $n = 1;
while (<DATA>) {
next until $_ eq "###\n";
open (TMP, '> tmp.pod') or die "Cannot create tmp.pod: $!\n";
$output = <TMP>;
}
close TMP;
- unlink ('tmp.pod', 'out.tmp');
+ 1 while unlink ('tmp.pod', 'out.tmp');
my $expected = '';
while (<DATA>) {
last if $_ eq "###\n";
$expected .= $_;
}
- if ($output eq $expected) {
- print "ok $n\n";
- } else {
- print "not ok $n\n";
- print "Expected\n========\n$expected\nOutput\n======\n$output\n";
- }
+ is ($output, $expected, "Output correct for test $n");
$n++;
}
# Below the marker are bits of POD and corresponding expected output. This is
-# used to test specific features or problems with Pod::Text::Termcap. The
-# input and output are separated by lines containing only ###.
+# used to test specific features or problems with Pod::Text::Color. The input
+# and output are separated by lines containing only ###.
__DATA__
\e[1m\e[33mDo\e[0m\e[0m \e[33m\e[1mnot\e[0m\e[0m \e[1m\e[33minclude\e[0m\e[0m \e[1m\e[33mformatting codes when\e[0m\e[0m \e[1m\e[33mwrapping\e[0m\e[0m.
###
+
+###
+=head1 TAG WIDTH
+
+=over 10
+
+=item 12345678
+
+A
+
+=item B<12345678>
+
+B
+
+=item 1
+
+C
+
+=item B<1>
+
+D
+
+=back
+###
+\e[1mTAG WIDTH\e[0m
+ 12345678 A
+
+ \e[1m12345678\e[0m B
+
+ 1 C
+
+ \e[1m1\e[0m D
+
+###
--- /dev/null
+#!/usr/bin/perl -w
+
+# In order for MakeMaker to build in the core, nothing can use
+# Fcntl which includes POSIX. devise_date()'s use of strftime()
+# was replaced. This tests that it's identical.
+
+use strict;
+
+use Test::More tests => 1;
+
+use Pod::Man;
+use POSIX qw(strftime);
+
+my $parser = Pod::Man->new;
+is $parser->devise_date, strftime("%Y-%m-%d", localtime);
#
# filehandle.t -- Test the parse_from_filehandle interface.
#
-# Copyright 2006 by Russ Allbery <rra@stanford.edu>
+# Copyright 2006, 2009 by Russ Allbery <rra@stanford.edu>
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.
chdir 't' if -d 't';
if ($ENV{PERL_CORE}) {
@INC = '../lib';
- } else {
- unshift (@INC, '../blib/lib');
}
unshift (@INC, '../blib/lib');
$| = 1;
- print "1..3\n";
}
-END {
- print "not ok 1\n" unless $loaded;
-}
+use strict;
-use Pod::Man;
-use Pod::Text;
+use Test::More tests => 6;
-$loaded = 1;
-print "ok 1\n";
+BEGIN {
+ use_ok ('Pod::Man');
+ use_ok ('Pod::Text');
+}
-my $man = Pod::Man->new or die "Cannot create parser\n";
-my $text = Pod::Text->new or die "Cannot create parser\n";
-my $n = 2;
+my $man = Pod::Man->new;
+isa_ok ($man, 'Pod::Man', 'Pod::Man parser object');
+my $text = Pod::Text->new;
+isa_ok ($text, 'Pod::Text', 'Pod::Text parser object');
while (<DATA>) {
next until $_ eq "###\n";
open (TMP, '> tmp.pod') or die "Cannot create tmp.pod: $!\n";
print TMP $_;
}
close TMP;
+
+ # Test Pod::Man output.
open (IN, '< tmp.pod') or die "Cannot open tmp.pod: $!\n";
open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n";
$man->parse_from_filehandle (\*IN, \*OUT);
last if $_ eq "###\n";
$expected .= $_;
}
- if ($output eq $expected) {
- print "ok $n\n";
- } else {
- print "not ok $n\n";
- print "Expected\n========\n$expected\nOutput\n======\n$output\n";
- }
- $n++;
+ is ($output, $expected, 'Pod::Man output is correct');
+
+ # Test Pod::Text output.
open (IN, '< tmp.pod') or die "Cannot open tmp.pod: $!\n";
open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n";
$text->parse_from_filehandle (\*IN, \*OUT);
$output = <OUT>;
}
close OUT;
- unlink ('tmp.pod', 'out.tmp');
+ 1 while unlink ('tmp.pod', 'out.tmp');
$expected = '';
while (<DATA>) {
last if $_ eq "###\n";
$expected .= $_;
}
- if ($output eq $expected) {
- print "ok $n\n";
- } else {
- print "not ok $n\n";
- print "Expected\n========\n$expected\nOutput\n======\n$output\n";
- }
- $n++;
+ is ($output, $expected, 'Pod::Text output is correct');
}
# Below the marker are bits of POD, corresponding expected nroff output, and
--- /dev/null
+#!/usr/bin/perl -w
+#
+# man-options.t -- Additional tests for Pod::Man options.
+#
+# Copyright 2002, 2004, 2006, 2008, 2009 Russ Allbery <rra@stanford.edu>
+#
+# This program is free software; you may redistribute it and/or modify it
+# under the same terms as Perl itself.
+
+BEGIN {
+ chdir 't' if -d 't';
+ if ($ENV{PERL_CORE}) {
+ @INC = '../lib';
+ }
+ unshift (@INC, '../blib/lib');
+ $| = 1;
+}
+
+use strict;
+
+use Test::More tests => 7;
+BEGIN { use_ok ('Pod::Man') }
+
+my $n = 1;
+while (<DATA>) {
+ my %options;
+ next until $_ eq "###\n";
+ while (<DATA>) {
+ last if $_ eq "###\n";
+ my ($option, $value) = split (' ', $_, 2);
+ chomp $value;
+ $options{$option} = $value;
+ }
+ open (TMP, '> tmp.pod') or die "Cannot create tmp.pod: $!\n";
+ print TMP "=head1 NAME\n\ntest - Test man page\n";
+ close TMP;
+ my $parser = Pod::Man->new (%options);
+ isa_ok ($parser, 'Pod::Man', 'Parser object');
+ open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n";
+ $parser->parse_from_file ('tmp.pod', \*OUT);
+ close OUT;
+ open (TMP, 'out.tmp') or die "Cannot open out.tmp: $!\n";
+ my $heading;
+ while (<TMP>) {
+ if (/^\.TH/) {
+ $heading = $_;
+ last;
+ }
+ }
+ close TMP;
+ unlink ('tmp.pod', 'out.tmp');
+ my $expected = '';
+ while (<DATA>) {
+ last if $_ eq "###\n";
+ $expected .= $_;
+ }
+ is ($heading, $expected, "Heading is correct for test $n");
+ $n++;
+}
+
+# Below the marker are sets of options and the corresponding expected .TH line
+# from the man page. This is used to test specific features or problems with
+# Pod::Man. The options and output are separated by lines containing only
+# ###.
+
+__DATA__
+
+###
+date 2009-01-17
+release 1.0
+###
+.TH TMP 1 "2009-01-17" "1.0" "User Contributed Perl Documentation"
+###
+
+###
+date 2009-01-17
+name TEST
+section 8
+release 2.0-beta
+###
+.TH TEST 8 "2009-01-17" "2.0-beta" "User Contributed Perl Documentation"
+###
+
+###
+date 2009-01-17
+release 1.0
+center Testing Documentation
+###
+.TH TMP 1 "2009-01-17" "1.0" "Testing Documentation"
+###
#
# man-options.t -- Additional tests for Pod::Man options.
#
-# Copyright 2002, 2004, 2006, 2008 Russ Allbery <rra@stanford.edu>
+# Copyright 2002, 2004, 2006, 2008, 2009 Russ Allbery <rra@stanford.edu>
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.
chdir 't' if -d 't';
if ($ENV{PERL_CORE}) {
@INC = '../lib';
- } else {
- unshift (@INC, '../blib/lib');
}
unshift (@INC, '../blib/lib');
$| = 1;
- print "1..7\n";
}
-END {
- print "not ok 1\n" unless $loaded;
-}
+use strict;
-use Pod::Man;
+use Test::More tests => 10;
+BEGIN { use_ok ('Pod::Man') }
# Redirect stderr to a file.
sub stderr_save {
close OLDERR;
}
-$loaded = 1;
-print "ok 1\n";
-
-my $n = 2;
+my $n = 1;
while (<DATA>) {
my %options;
next until $_ eq "###\n";
print TMP $_;
}
close TMP;
- my $parser = Pod::Man->new (%options) or die "Cannot create parser\n";
+ my $parser = Pod::Man->new (%options);
+ isa_ok ($parser, 'Pod::Man', 'Parser object');
open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n";
stderr_save;
$parser->parse_from_file ('tmp.pod', \*OUT);
$output = <TMP>;
}
close TMP;
- unlink ('tmp.pod', 'out.tmp');
+ 1 while unlink ('tmp.pod', 'out.tmp');
my $expected = '';
while (<DATA>) {
last if $_ eq "###\n";
$expected .= $_;
}
- if ($output eq $expected) {
- print "ok $n\n";
- } else {
- print "not ok $n\n";
- print "Expected\n========\n$expected\nOutput\n======\n$output\n";
- }
- $n++;
+ is ($output, $expected, "Output correct for test $n");
open (ERR, 'out.err') or die "Cannot open out.err: $!\n";
my $errors;
{
$errors = <ERR>;
}
close ERR;
- unlink ('out.err');
+ 1 while unlink ('out.err');
$expected = '';
while (<DATA>) {
last if $_ eq "###\n";
$expected .= $_;
}
- if ($errors eq $expected) {
- print "ok $n\n";
- } else {
- print "not ok $n\n";
- print "Expected errors:\n ${expected}Errors:\n $errors";
- }
+ is ($errors, $expected, "Errors are correct for test $n");
$n++;
}
-# Below the marker are bits of POD and corresponding expected text output.
-# This is used to test specific features or problems with Pod::Man. The
-# input and output are separated by lines containing only ###.
+# Below the marker are bits of POD and corresponding expected text output and
+# error output. This is used to test specific features or problems with
+# Pod::Man. The options, input, output, and errors are separated by lines
+# containing only ###.
__DATA__
#
# man-options.t -- Additional tests for Pod::Man options.
#
-# Copyright 2002, 2004, 2006, 2008 Russ Allbery <rra@stanford.edu>
+# Copyright 2002, 2004, 2006, 2008, 2009 Russ Allbery <rra@stanford.edu>
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.
chdir 't' if -d 't';
if ($ENV{PERL_CORE}) {
@INC = '../lib';
- } else {
- unshift (@INC, '../blib/lib');
}
unshift (@INC, '../blib/lib');
$| = 1;
- print "1..5\n";
-
- # UTF-8 support requires Perl 5.8 or later.
- if ($] < 5.008) {
- my $n;
- for $n (1..5) {
- print "ok $n # skip -- Perl 5.8 required for UTF-8 support\n";
- }
- exit;
- }
}
-END {
- print "not ok 1\n" unless $loaded;
-}
+use strict;
-use Pod::Man;
+use Test::More;
-$loaded = 1;
-print "ok 1\n";
+# UTF-8 support requires Perl 5.8 or later.
+BEGIN {
+ if ($] < 5.008) {
+ plan skip_all => 'Perl 5.8 required for UTF-8 support';
+ } else {
+ plan tests => 7;
+ }
+}
+BEGIN { use_ok ('Pod::Man') }
-my $n = 2;
+# Force UTF-8 on all relevant file handles. Do this inside eval in case the
+# encoding parameter doesn't work.
eval { binmode (\*DATA, ':encoding(utf-8)') };
eval { binmode (\*STDOUT, ':encoding(utf-8)') };
+my $builder = Test::More->builder;
+eval { binmode ($builder->output, ':encoding(utf-8)') };
+eval { binmode ($builder->failure_output, ':encoding(utf-8)') };
+
+my $n = 1;
while (<DATA>) {
my %options;
next until $_ eq "###\n";
print TMP $_;
}
close TMP;
- my $parser = Pod::Man->new (%options) or die "Cannot create parser\n";
+ my $parser = Pod::Man->new (%options);
+ isa_ok ($parser, 'Pod::Man', 'Parser object');
open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n";
$parser->parse_from_file ('tmp.pod', \*OUT);
close OUT;
$output = <TMP>;
}
close TMP;
- unlink ('tmp.pod', 'out.tmp');
- if (($options{utf8} && !$accents) || (!$options{utf8} && $accents)) {
- print "ok $n\n";
+ 1 while unlink ('tmp.pod', 'out.tmp');
+ if ($options{utf8}) {
+ ok (!$accents, "Saw no accent definitions for test $n");
} else {
- print "not ok $n\n";
- print ($accents ? "Saw accents\n" : "Saw no accents\n");
- print ($options{utf8} ? "Wanted no accents\n" : "Wanted accents\n");
+ ok ($accents, "Saw accent definitions for test $n");
}
- $n++;
my $expected = '';
while (<DATA>) {
last if $_ eq "###\n";
$expected .= $_;
}
- if ($output eq $expected) {
- print "ok $n\n";
- } else {
- print "not ok $n\n";
- print "Expected\n========\n$expected\nOutput\n======\n$output\n";
- }
+ is ($output, $expected, "Output correct for test $n");
$n++;
}
#
# man.t -- Additional specialized tests for Pod::Man.
#
-# Copyright 2002, 2003, 2004, 2006, 2007, 2008
+# Copyright 2002, 2003, 2004, 2006, 2007, 2008, 2009
# Russ Allbery <rra@stanford.edu>
#
# This program is free software; you may redistribute it and/or modify it
chdir 't' if -d 't';
if ($ENV{PERL_CORE}) {
@INC = '../lib';
- } else {
- unshift (@INC, '../blib/lib');
}
unshift (@INC, '../blib/lib');
$| = 1;
- print "1..25\n";
}
-END {
- print "not ok 1\n" unless $loaded;
-}
-
-use Pod::Man;
+use strict;
-$loaded = 1;
-print "ok 1\n";
+use Test::More tests => 30;
+BEGIN { use_ok ('Pod::Man') }
# Test whether we can use binmode to set encoding.
my $have_encoding = (eval { require PerlIO::encoding; 1 } and not $@);
-my $parser = Pod::Man->new or die "Cannot create parser\n";
-my $n = 2;
+my $parser = Pod::Man->new;
+isa_ok ($parser, 'Pod::Man', 'Parser object');
+my $n = 1;
while (<DATA>) {
next until $_ eq "###\n";
open (TMP, '> tmp.pod') or die "Cannot create tmp.pod: $!\n";
$output = <OUT>;
}
close OUT;
- unlink ('tmp.pod', 'out.tmp');
+ 1 while unlink ('tmp.pod', 'out.tmp');
my $expected = '';
while (<DATA>) {
last if $_ eq "###\n";
$expected .= $_;
}
- if ($output eq $expected) {
- print "ok $n\n";
- } else {
- print "not ok $n\n";
- print "Expected\n========\n$expected\nOutput\n======\n$output\n";
- }
+ is ($output, $expected, "Output correct for test $n");
$n++;
}
###
=head1 NAME
-gcc - GNU project C and C++ compiler
+gcc - GNU project C<C> and C++ compiler
=head1 C++ NOTES
Other mentions of C++.
###
.SH "NAME"
-gcc \- GNU project C and C++ compiler
+gcc \- GNU project "C" and C++ compiler
.SH "\*(C+ NOTES"
.IX Header " NOTES"
Other mentions of \*(C+.
.PP
More text.
###
+
+###
+=head1 NAME
+
+test - C<test>
+###
+.SH "NAME"
+test \- "test"
+###
+
+###
+=head1 INDEX
+
+Index entry matching a whitespace escape.X<\n>
+###
+.SH "INDEX"
+.IX Header "INDEX"
+Index entry matching a whitespace escape.
+.IX Xref "\\n"
+###
+
+###
+=head1 LINK TO URL
+
+This is a L<link|http://www.example.com/> to a URL.
+###
+.SH "LINK TO URL"
+.IX Header "LINK TO URL"
+This is a link <http://www.example.com/> to a \s-1URL\s0.
+###
+
+###
+=head1 NAME
+
+test - B<test> I<italics> F<file>
+###
+.SH "NAME"
+test \- test italics file
+###
--- /dev/null
+#!/usr/bin/perl -w
+#
+# overstrike.t -- Additional specialized tests for Pod::Text::Overstrike.
+#
+# Copyright 2002, 2004, 2006, 2009 by Russ Allbery <rra@stanford.edu>
+#
+# This program is free software; you may redistribute it and/or modify it
+# under the same terms as Perl itself.
+
+BEGIN {
+ chdir 't' if -d 't';
+ if ($ENV{PERL_CORE}) {
+ @INC = '../lib';
+ }
+ unshift (@INC, '../blib/lib');
+ $| = 1;
+}
+
+use strict;
+
+use Test::More tests => 4;
+BEGIN { use_ok ('Pod::Text::Overstrike') }
+
+my $parser = Pod::Text::Overstrike->new;
+isa_ok ($parser, 'Pod::Text::Overstrike', 'Parser module');
+my $n = 1;
+while (<DATA>) {
+ next until $_ eq "###\n";
+ open (TMP, '> tmp.pod') or die "Cannot create tmp.pod: $!\n";
+ while (<DATA>) {
+ last if $_ eq "###\n";
+ print TMP $_;
+ }
+ close TMP;
+ open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n";
+ $parser->parse_from_file ('tmp.pod', \*OUT);
+ close OUT;
+ open (TMP, 'out.tmp') or die "Cannot open out.tmp: $!\n";
+ my $output;
+ {
+ local $/;
+ $output = <TMP>;
+ }
+ close TMP;
+ 1 while unlink ('tmp.pod', 'out.tmp');
+ my $expected = '';
+ while (<DATA>) {
+ last if $_ eq "###\n";
+ $expected .= $_;
+ }
+ is ($output, $expected, "Output correct for test $n");
+ $n++;
+}
+
+# Below the marker are bits of POD and corresponding expected output. This is
+# used to test specific features or problems with Pod::Text::Termcap. The
+# input and output are separated by lines containing only ###.
+
+__DATA__
+
+###
+=head1 WRAPPING
+
+B<I<Do>> I<B<not>> B<I<include>> B<I<formatting codes when>> B<I<wrapping>>.
+###
+W\bWR\bRA\bAP\bPP\bPI\bIN\bNG\bG
+ D\bDo\bo _\bn_\bo_\bt i\bin\bnc\bcl\blu\bud\bde\be f\bfo\bor\brm\bma\bat\btt\bti\bin\bng\bg \b c\bco\bod\bde\bes\bs \b w\bwh\bhe\ben\bn w\bwr\bra\bap\bpp\bpi\bin\bng\bg.
+
+###
+
+###
+=head1 TAG WIDTH
+
+=over 10
+
+=item 12345678
+
+A
+
+=item B<12345678>
+
+B
+
+=item 1
+
+C
+
+=item B<1>
+
+D
+
+=back
+###
+T\bTA\bAG\bG \b W\bWI\bID\bDT\bTH\bH
+ 12345678 A
+
+ 1\b12\b23\b34\b45\b56\b67\b78\b8 B
+
+ 1 C
+
+ 1\b1 D
+
+###
#
# parselink.t -- Tests for Pod::ParseLink.
#
-# Copyright 2001 by Russ Allbery <rra@stanford.edu>
+# Copyright 2001, 2009 by Russ Allbery <rra@stanford.edu>
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.
# The format of each entry in this array is the L<> text followed by the
-# five-element parse returned by parselink. When adding a new test, also
-# increment the test count in the BEGIN block below. We don't use any of the
-# fancy test modules intentionally for backward compatibility to older
-# versions of Perl.
-@TESTS = (
+# five-element parse returned by parselink.
+our @TESTS = (
[ 'foo',
undef, 'foo', 'foo', undef, 'pod' ],
[ 'news:yld72axzc8.fsf@windlord.stanford.edu',
undef, 'news:yld72axzc8.fsf@windlord.stanford.edu',
- 'news:yld72axzc8.fsf@windlord.stanford.edu', undef, 'url' ]
+ 'news:yld72axzc8.fsf@windlord.stanford.edu', undef, 'url' ],
+
+ [ 'link|http://www.perl.org/',
+ 'link', 'link', 'http://www.perl.org/', undef, 'url' ],
+
+ [ '0|http://www.perl.org/',
+ '0', '0', 'http://www.perl.org/', undef, 'url' ],
+
+ [ '0|Pod::Parser',
+ '0', '0', 'Pod::Parser', undef, 'pod' ],
);
BEGIN {
chdir 't' if -d 't';
unshift (@INC, '../blib/lib');
$| = 1;
- print "1..25\n";
}
-END {
- print "not ok 1\n" unless $loaded;
-}
+use strict;
-use Pod::ParseLink;
-$loaded = 1;
-print "ok 1\n";
+use Test::More tests => 28;
+BEGIN { use_ok ('Pod::ParseLink') }
# Used for reporting test failures.
my @names = qw(text inferred name section type);
-my $n = 2;
for (@TESTS) {
my @expected = @$_;
my $link = shift @expected;
my @results = parselink ($link);
- my $okay = 1;
- for (0..4) {
- # Make sure to check undef explicitly; we don't want undef to match
- # the empty string because they're semantically different.
- unless ((!defined ($results[$_]) && !defined ($expected[$_]))
- || (defined ($results[$_]) && defined ($expected[$_])
- && $results[$_] eq $expected[$_])) {
- print "not ok $n\n" if $okay;
- print "# Incorrect $names[$_]:\n";
- print "# expected: $expected[$_]\n";
- print "# seen: $results[$_]\n";
- $okay = 0;
- }
- }
- print "ok $n\n" if $okay;
- $n++;
+ my $pretty = $link;
+ $pretty =~ s/\n/\\n/g;
+ is_deeply (\@results, \@expected, $pretty);
}
#
# pod-parser.t -- Tests for backward compatibility with Pod::Parser.
#
-# Copyright 2006, 2008 by Russ Allbery <rra@stanford.edu>
+# Copyright 2006, 2008, 2009 by Russ Allbery <rra@stanford.edu>
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.
chdir 't' if -d 't';
if ($ENV{PERL_CORE}) {
@INC = '../lib';
- } else {
- unshift (@INC, '../blib/lib');
}
unshift (@INC, '../blib/lib');
$| = 1;
- print "1..4\n";
}
-my $loaded;
-
-END {
- print "not ok 1\n" unless $loaded;
-}
-
-use Pod::Man;
-use Pod::Text;
use strict;
-$loaded = 1;
-print "ok 1\n";
+use Test::More tests => 7;
+BEGIN {
+ use_ok ('Pod::Man');
+ use_ok ('Pod::Text');
+}
-my $parser = Pod::Man->new or die "Cannot create parser\n";
+my $parser = Pod::Man->new;
+isa_ok ($parser, 'Pod::Man', 'Pod::Man parser object');
open (TMP, '> tmp.pod') or die "Cannot create tmp.pod: $!\n";
print TMP "Some random B<text>.\n";
close TMP;
$output = <OUT>;
}
close OUT;
-if ($output eq "Some random \\fBtext\\fR.\n") {
- print "ok 2\n";
-} else {
- print "not ok 2\n";
- print "Expected\n========\nSome random \\fBtext\\fR.\n\n";
- print "Output\n======\n$output\n";
-}
+is ($output, "Some random \\fBtext\\fR.\n", 'Pod::Man -cutting output');
-$parser = Pod::Text->new or die "Cannot create parser\n";
+$parser = Pod::Text->new;
+isa_ok ($parser, 'Pod::Text', 'Pod::Text parser object');
open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n";
$parser->parse_from_file ({ -cutting => 0 }, 'tmp.pod', \*OUT);
close OUT;
$output = <OUT>;
}
close OUT;
-if ($output eq " Some random text.\n\n") {
- print "ok 3\n";
-} else {
- print "not ok 3\n";
- print "Expected\n========\n Some random text.\n\n\n";
- print "Output\n======\n$output\n";
-}
+is ($output, " Some random text.\n\n", 'Pod::Text -cutting output');
# Test the pod2text function, particularly with only one argument.
open (TMP, '> tmp.pod') or die "Cannot create tmp.pod: $!\n";
$output = <OUT>;
}
close OUT;
-if ($output eq " Some random text.\n\n") {
- print "ok 4\n";
-} else {
- print "not ok 4\n";
- print "Expected\n========\n Some random text.\n\n\n";
- print "Output\n======\n$output\n";
-}
+is ($output, " Some random text.\n\n", 'Pod::Text pod2text function');
-unlink ('tmp.pod', 'out.tmp');
+1 while unlink ('tmp.pod', 'out.tmp');
exit 0;
-#!/usr/bin/perl
+#!/usr/bin/perl -w
#
-# t/pod-spelling.t -- Test POD spelling.
+# Check for spelling errors in POD documentation
#
-# Copyright 2008 Russ Allbery <rra@stanford.edu>
+# Checks all POD files in the tree for spelling problems using Pod::Spell and
+# either aspell or ispell. aspell is preferred. This test is disabled unless
+# RRA_MAINTAINER_TESTS is set, since spelling dictionaries vary too much
+# between environments.
+#
+# Copyright 2008, 2009 Russ Allbery <rra@stanford.edu>
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.
-# Called to skip all tests with a reason.
-sub skip_all {
- print "1..0 # Skipped: @_\n";
- exit;
-}
+use strict;
+use Test::More;
-# Skip all spelling tests unless flagged to run maintainer tests.
-skip_all "Spelling tests only run for maintainer"
+# Skip all spelling tests unless the maintainer environment variable is set.
+plan skip_all => 'Spelling tests only run for maintainer'
unless $ENV{RRA_MAINTAINER_TESTS};
-# Make sure we have prerequisites. hunspell is currently not supported due to
-# lack of support for contractions.
+# Load required Perl modules.
eval 'use Test::Pod 1.00';
-skip_all "Test::Pod 1.00 required for testing POD" if $@;
+plan skip_all => 'Test::Pod 1.00 required for testing POD' if $@;
eval 'use Pod::Spell';
-skip_all "Pod::Spell required to test POD spelling" if $@;
+plan skip_all => 'Pod::Spell required to test POD spelling' if $@;
+
+# Locate a spell-checker. hunspell is not currently supported due to its lack
+# of support for contractions (at least in the version in Debian).
my @spell;
my %options = (aspell => [ qw(-d en_US --home-dir=./ list) ],
ispell => [ qw(-d american -l -p /dev/null) ]);
last SEARCH if @spell;
}
}
-skip_all "aspell or ispell required to test POD spelling" unless @spell;
+plan skip_all => 'aspell or ispell required to test POD spelling'
+ unless @spell;
-# Run the test, one for each POD file.
+# Prerequisites are satisfied, so we're going to do some testing. Figure out
+# what POD files we have and from that develop our plan.
$| = 1;
my @pod = all_pod_files ();
-my $count = scalar @pod;
-print "1..$count\n";
-my $n = 1;
+plan tests => scalar @pod;
+
+# Finally, do the checks.
for my $pod (@pod) {
my $child = open (CHILD, '-|');
if (not defined $child) {
die "Cannot fork: $!\n";
} elsif ($child == 0) {
- my $pid = open (SPELL, '|-', @spell)
- or die "Cannot run @spell: $!\n";
+ my $pid = open (SPELL, '|-', @spell) or die "Cannot run @spell: $!\n";
open (POD, '<', $pod) or die "Cannot open $pod: $!\n";
my $parser = Pod::Spell->new;
$parser->parse_from_filehandle (\*POD, \*SPELL);
} else {
my @words = <CHILD>;
close CHILD;
- if ($? != 0) {
- print "ok $n # skip - @spell failed: $?\n";
- } elsif (@words) {
+ SKIP: {
+ skip "@spell failed for $pod", 1 unless $? == 0;
for (@words) {
s/^\s+//;
s/\s+$//;
}
- print "not ok $n\n";
- print " - Misspelled words found in $pod\n";
- print " @words\n";
- } else {
- print "ok $n\n";
+ is ("@words", '', $pod);
}
- $n++;
}
}
-#!/usr/bin/perl
+#!/usr/bin/perl -w
#
-# t/pod.t -- Test POD formatting.
+# Test POD formatting.
+#
+# Copyright 2009 Russ Allbery <rra@stanford.edu>
+#
+# This program is free software; you may redistribute it and/or modify it
+# under the same terms as Perl itself.
+use strict;
+use Test::More;
eval 'use Test::Pod 1.00';
-if ($@) {
- print "1..1\n";
- print "ok 1 # skip - Test::Pod 1.00 required for testing POD\n";
- exit;
-}
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
all_pod_files_ok ();
#
# termcap.t -- Additional specialized tests for Pod::Text::Termcap.
#
-# Copyright 2002, 2004, 2006 by Russ Allbery <rra@stanford.edu>
+# Copyright 2002, 2004, 2006, 2009 by Russ Allbery <rra@stanford.edu>
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.
chdir 't' if -d 't';
if ($ENV{PERL_CORE}) {
@INC = '../lib';
- } else {
- unshift (@INC, '../blib/lib');
}
unshift (@INC, '../blib/lib');
$| = 1;
- print "1..2\n";
}
-END {
- print "not ok 1\n" unless $loaded;
-}
+use strict;
+
+use Test::More tests => 4;
+BEGIN { use_ok ('Pod::Text::Termcap') }
# Hard-code a few values to try to get reproducible results.
$ENV{COLUMNS} = 80;
$ENV{TERM} = 'xterm';
$ENV{TERMCAP} = 'xterm:co=80:do=^J:md=\E[1m:us=\E[4m:me=\E[m';
-use Pod::Text::Termcap;
-
-$loaded = 1;
-print "ok 1\n";
-
-my $parser = Pod::Text::Termcap->new or die "Cannot create parser\n";
-my $n = 2;
+my $parser = Pod::Text::Termcap->new;
+isa_ok ($parser, 'Pod::Text::Termcap', 'Parser module');
+my $n = 1;
while (<DATA>) {
next until $_ eq "###\n";
open (TMP, '> tmp.pod') or die "Cannot create tmp.pod: $!\n";
$output = <TMP>;
}
close TMP;
- unlink ('tmp.pod', 'out.tmp');
+ 1 while unlink ('tmp.pod', 'out.tmp');
my $expected = '';
while (<DATA>) {
last if $_ eq "###\n";
$expected .= $_;
}
- if ($output eq $expected) {
- print "ok $n\n";
- } else {
- print "not ok $n\n";
- print "Expected\n========\n$expected\nOutput\n======\n$output\n";
- }
+ is ($output, $expected, "Output correct for test $n");
$n++;
}
\e[1m\e[4mDo\e[m\e[m \e[4m\e[1mnot\e[m\e[m \e[1m\e[4minclude\e[m\e[m \e[1m\e[4mformatting codes when\e[m\e[m \e[1m\e[4mwrapping\e[m\e[m.
###
+
+###
+=head1 TAG WIDTH
+
+=over 10
+
+=item 12345678
+
+A
+
+=item B<12345678>
+
+B
+
+=item 1
+
+C
+
+=item B<1>
+
+D
+
+=back
+###
+\e[1mTAG WIDTH\e[m
+ 12345678 A
+
+ \e[1m12345678\e[m B
+
+ 1 C
+
+ \e[1m1\e[m D
+
+###
#
# text-encoding.t -- Test Pod::Text with various weird encoding combinations.
#
-# Copyright 2002, 2004, 2006, 2007, 2008 by Russ Allbery <rra@stanford.edu>
+# Copyright 2002, 2004, 2006, 2007, 2008, 2009
+# Russ Allbery <rra@stanford.edu>
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.
chdir 't' if -d 't';
if ($ENV{PERL_CORE}) {
@INC = '../lib';
- } else {
- unshift (@INC, '../blib/lib');
}
unshift (@INC, '../blib/lib');
$| = 1;
- print "1..4\n";
-
- # PerlIO encoding support requires Perl 5.8 or later.
- if ($] < 5.008) {
- my $n;
- for $n (1..4) {
- print "ok $n # skip -- Perl 5.8 required for UTF-8 support\n";
- }
- exit;
- }
}
-END {
- print "not ok 1\n" unless $loaded;
-}
+use strict;
-use Pod::Text;
+use Test::More;
-$loaded = 1;
-print "ok 1\n";
+# UTF-8 support requires Perl 5.8 or later.
+BEGIN {
+ if ($] < 5.008) {
+ plan skip_all => 'Perl 5.8 required for encoding support';
+ } else {
+ plan tests => 7;
+ }
+}
+BEGIN { use_ok ('Pod::Text') }
-my $n = 2;
eval { binmode (\*DATA, ':raw') };
eval { binmode (\*STDOUT, ':raw') };
+my $builder = Test::More->builder;
+eval { binmode ($builder->output, ':raw') };
+eval { binmode ($builder->failure_output, ':raw') };
+
+my $n = 1;
while (<DATA>) {
my %opts;
- $opts{utf8} = 1 if $n == 4;
- my $parser = Pod::Text->new (%opts) or die "Cannot create parser\n";
+ $opts{utf8} = 1 if $n == 3;
next until $_ eq "###\n";
+ my $parser = Pod::Text->new (%opts);
+ isa_ok ($parser, 'Pod::Text', 'Parser object');
open (TMP, '> tmp.pod') or die "Cannot create tmp.pod: $!\n";
eval { binmode (\*TMP, ':raw') };
while (<DATA>) {
$output = <TMP>;
}
close TMP;
- unlink ('tmp.pod', 'out.tmp');
+ 1 while unlink ('tmp.pod', 'out.tmp');
my $expected = '';
while (<DATA>) {
last if $_ eq "###\n";
$expected .= $_;
}
- if ($output eq $expected) {
- print "ok $n\n";
- } else {
- print "not ok $n\n";
- print "Expected\n========\n$expected\nOutput\n======\n$output\n";
- }
+ is ($output, $expected, "Output correct for test $n");
$n++;
}
#
# text-options.t -- Additional tests for Pod::Text options.
#
-# Copyright 2002, 2004, 2006, 2008 by Russ Allbery <rra@stanford.edu>
+# Copyright 2002, 2004, 2006, 2008, 2009 by Russ Allbery <rra@stanford.edu>
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.
chdir 't' if -d 't';
if ($ENV{PERL_CORE}) {
@INC = '../lib';
- } else {
- unshift (@INC, '../blib/lib');
}
unshift (@INC, '../blib/lib');
$| = 1;
- print "1..13\n";
}
-END {
- print "not ok 1\n" unless $loaded;
-}
+use strict;
-use Pod::Text;
+use Test::More tests => 19;
+BEGIN { use_ok ('Pod::Text') }
# Redirect stderr to a file.
sub stderr_save {
close OLDERR;
}
-$loaded = 1;
-print "ok 1\n";
-
-my $n = 2;
+my $n = 1;
while (<DATA>) {
my %options;
next until $_ eq "###\n";
print TMP $_;
}
close TMP;
- my $parser = Pod::Text->new (%options) or die "Cannot create parser\n";
+ my $parser = Pod::Text->new (%options);
+ isa_ok ($parser, 'Pod::Text', 'Parser object');
open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n";
stderr_save;
$parser->parse_from_file ('tmp.pod', \*OUT);
last if $_ eq "###\n";
$expected .= $_;
}
- if ($output eq $expected) {
- print "ok $n\n";
- } else {
- print "not ok $n\n";
- print "Expected\n========\n$expected\nOutput\n======\n$output\n";
- }
- $n++;
+ is ($output, $expected, "Ouput correct for test $n");
open (ERR, 'out.err') or die "Cannot open out.err: $!\n";
my $errors;
{
$errors = <ERR>;
}
close ERR;
- unlink ('out.err');
+ 1 while unlink ('out.err');
$expected = '';
while (<DATA>) {
last if $_ eq "###\n";
$expected .= $_;
}
- if ($errors eq $expected) {
- print "ok $n\n";
- } else {
- print "not ok $n\n";
- print "Expected errors:\n ${expected}Errors:\n $errors";
- }
+ is ($errors, $expected, "Errors correct for test $n");
$n++;
}
# Below the marker are bits of POD and corresponding expected text output.
# This is used to test specific features or problems with Pod::Text. The
-# input and output are separated by lines containing only ###.
+# options, input, output, and errors are separated by lines containing only
+# ###.
__DATA__
#
# text-utf8.t -- Test Pod::Text with UTF-8 input.
#
-# Copyright 2002, 2004, 2006, 2007, 2008 by Russ Allbery <rra@stanford.edu>
+# Copyright 2002, 2004, 2006, 2007, 2008, 2009
+# Russ Allbery <rra@stanford.edu>
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.
chdir 't' if -d 't';
if ($ENV{PERL_CORE}) {
@INC = '../lib';
- } else {
- unshift (@INC, '../blib/lib');
}
unshift (@INC, '../blib/lib');
$| = 1;
- print "1..3\n";
-
- # UTF-8 support requires Perl 5.8 or later.
- if ($] < 5.008) {
- my $n;
- for $n (1..3) {
- print "ok $n # skip -- Perl 5.8 required for UTF-8 support\n";
- }
- exit;
- }
}
-END {
- print "not ok 1\n" unless $loaded;
-}
+use strict;
-use Pod::Text;
+use Test::More;
-$loaded = 1;
-print "ok 1\n";
+# UTF-8 support requires Perl 5.8 or later.
+BEGIN {
+ if ($] < 5.008) {
+ plan skip_all => 'Perl 5.8 required for UTF-8 support';
+ } else {
+ plan tests => 4;
+ }
+}
+BEGIN { use_ok ('Pod::Text') }
-my $parser = Pod::Text->new or die "Cannot create parser\n";
-my $n = 2;
+my $parser = Pod::Text->new;
+isa_ok ($parser, 'Pod::Text', 'Parser object');
+my $n = 1;
eval { binmode (\*DATA, ':encoding(utf-8)') };
eval { binmode (\*STDOUT, ':encoding(utf-8)') };
+my $builder = Test::More->builder;
+eval { binmode ($builder->output, ':encoding(utf-8)') };
+eval { binmode ($builder->failure_output, ':encoding(utf-8)') };
while (<DATA>) {
next until $_ eq "###\n";
open (TMP, '> tmp.pod') or die "Cannot create tmp.pod: $!\n";
$output = <TMP>;
}
close TMP;
- unlink ('tmp.pod', 'out.tmp');
+ 1 while unlink ('tmp.pod', 'out.tmp');
my $expected = '';
while (<DATA>) {
last if $_ eq "###\n";
$expected .= $_;
}
- if ($output eq $expected) {
- print "ok $n\n";
- } else {
- print "not ok $n\n";
- print "Expected\n========\n$expected\nOutput\n======\n$output\n";
- }
+ is ($output, $expected, "Output correct for test $n");
$n++;
}
chdir 't' if -d 't';
if ($ENV{PERL_CORE}) {
@INC = '../lib';
- } else {
- unshift (@INC, '../blib/lib');
}
unshift (@INC, '../blib/lib');
$| = 1;
- print "1..6\n";
}
-END {
- print "not ok 1\n" unless $loaded;
-}
+use strict;
-use Pod::Text;
use Pod::Simple;
+use Test::More tests => 8;
+BEGIN { use_ok ('Pod::Text') }
-$loaded = 1;
-print "ok 1\n";
-
-my $parser = Pod::Text->new or die "Cannot create parser\n";
-my $n = 2;
+my $parser = Pod::Text->new;
+isa_ok ($parser, 'Pod::Text', 'Parser object');
+my $n = 1;
while (<DATA>) {
next until $_ eq "###\n";
open (TMP, '> tmp.pod') or die "Cannot create tmp.pod: $!\n";
$output = <TMP>;
}
close TMP;
- unlink ('tmp.pod', 'out.tmp');
+ 1 while unlink ('tmp.pod', 'out.tmp');
my $expected = '';
while (<DATA>) {
last if $_ eq "###\n";
$expected .= $_;
}
- if ($output eq $expected) {
- print "ok $n\n";
- } elsif ($n == 4 && $Pod::Simple::VERSION < 3.06) {
- print "ok $n # skip Pod::Simple S<> parsing bug\n";
- } else {
- print "not ok $n\n";
- print "Expected\n========\n$expected\nOutput\n======\n$output\n";
- }
+ is ($output, $expected, "Output correct for test $n");
$n++;
}
line3
###
+
+###
+=head1 LINK TO URL
+
+This is a L<link|http://www.example.com/> to a URL.
+###
+LINK TO URL
+ This is a link <http://www.example.com/> to a URL.
+
+###
PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED),
($] < 5.009 ? 'PMf_SKIPWHITE' : 'RXf_SKIPWHITE'),
($] < 5.011 ? 'CVf_LOCKED' : ());
-$VERSION = 0.93;
+$VERSION = 0.97;
use strict;
use vars qw/$AUTOLOAD/;
use warnings ();
}
}
-sub scan_for_constants {
- my ($self) = @_;
- my %ret;
-
- B::walksymtable(\%::, sub {
- my ($gv) = @_;
-
- my $cv = $gv->CV;
- return if !$cv || class($cv) ne 'CV';
-
- my $const = $cv->const_sv;
- return if !$const || class($const) eq 'SPECIAL';
-
- $ret{ 0 + $const->object_2svref } = $gv->NAME;
- }, sub { 1 });
-
- return \%ret;
-}
-
# Initialise the contextual information, either from
# defaults provided with the ambient_pragmas method,
# or from perl's own defaults otherwise.
$self->{'curcop'} = $op;
my @text;
push @text, $self->cop_subs($op);
- push @text, $op->label . ": " if $op->label;
my $stash = $op->stashpv;
if ($stash ne $self->{'curstash'}) {
push @text, "package $stash;\n";
' "' . $op->file, qq'"\n';
}
+ push @text, $op->label . ": " if $op->label;
+
return join("", @text);
}
my($op, $cx, $name) = @_;
my $kid;
if ($op->flags & OPf_KIDS) {
+ $kid = $op->first;
if (not $name) {
# this deals with 'boolkeys' right now
return $self->deparse($kid,$cx);
}
- $kid = $op->first;
my $builtinname = $name;
$builtinname =~ /^CORE::/ or $builtinname = "CORE::$name";
if (defined prototype($builtinname)
if (class($sv) eq "NULL") {
return 'undef';
}
- if ($cx) {
- unless ($self->{'inlined_constants'}) {
- $self->{'inlined_constants'} = $self->scan_for_constants;
- }
- my $const = $self->{'inlined_constants'}->{ 0 + $sv->object_2svref };
- return $const if $const;
- }
# convert a version object into the "v1.2.3" string in its V magic
if ($sv->FLAGS & SVs_RMG) {
for (my $mg = $sv->MAGIC; $mg; $mg = $mg->MOREMAGIC) {
}
# handle special case of split(), and split(' ') that compiles to /\s+/
+ # Under 5.10, the reflags may be undef if the split regexp isn't a constant
$kid = $op->first;
if ( $kid->flags & OPf_SPECIAL
and ( $] < 5.009 ? $kid->pmflags & PMf_SKIPWHITE()
- : $kid->reflags & RXf_SKIPWHITE() ) ) {
+ : ($kid->reflags || 0) & RXf_SKIPWHITE() ) ) {
$exprs[0] = "' '";
}
require feature;
feature->import(':5.10');
}
-use Test::More tests => 83;
+use Test::More tests => 89;
use Config ();
use B::Deparse;
'???';
!1;
####
-# TODO ? $Config::Config{useithreads} && "doesn't work with threads"
+# TODO constant deparsing has been backed out for 5.12
+# XXXTODO ? $Config::Config{useithreads} && "doesn't work with threads"
# 61 tests that shouldn't be constant folded
# It might be fundamentally impossible to make this work on ithreads, in which
# case the TODO should become a SKIP
if (do { foo(); GLIPP }) { x(); }
if (do { ++$a; GLIPP }) { x(); }
####
+# TODO constant deparsing has been backed out for 5.12
# 62 tests for deparsing constants
warn PI;
####
+# TODO constant deparsing has been backed out for 5.12
# 63 tests for deparsing imported constants
warn O_TRUNC;
####
+# TODO constant deparsing has been backed out for 5.12
# 64 tests for deparsing re-exported constants
warn O_CREAT;
####
+# TODO constant deparsing has been backed out for 5.12
# 65 tests for deparsing imported constants that got deleted from the original namespace
warn O_APPEND;
####
-# TODO ? $Config::Config{useithreads} && "doesn't work with threads"
+# TODO constant deparsing has been backed out for 5.12
+# XXXTODO ? $Config::Config{useithreads} && "doesn't work with threads"
# 66 tests for deparsing constants which got turned into full typeglobs
# It might be fundamentally impossible to make this work on ithreads, in which
# case the TODO should become a SKIP
eval '@Fcntl::O_EXCL = qw/affe tiger/;';
warn O_EXCL;
####
+# TODO constant deparsing has been backed out for 5.12
# 67 tests for deparsing of blessed constant with overloaded numification
warn OVERLOADED_NUMIFICATION;
####
@a = reverse @a;
@b = reverse @b;
();
+####
+my($r, $s, @a);
+@a = split(/foo/, $s, 0);
+$r = qr/foo/;
+@a = split(/$r/, $s, 0);
+();
+####
+{
+ package Foo;
+ label: print 123;
+}
+####
+shift;
+>>>>
+shift();
+####
+shift @_;
+####
+pop;
+>>>>
+pop();
+####
+pop @_;
=over 8
+=item 2.126 (Apr 15 2010)
+
+Fix Data::Dumper's Fix Terse(1) + Indent(2):
+perl-RT #73604: When $Data::Dumper::Terse is true, the indentation is thrown
+off. It appears to be acting as if the $VAR1 = is still there.
+
=item 2.125 (Aug 8 2009)
CPAN distribution fixes (meta information for META.yml).
package Data::Dumper;
-$VERSION = '2.125'; # Don't forget to set version and release date in POD!
+$VERSION = '2.126'; # Don't forget to set version and release date in POD!
#$| = 1;
my $valstr;
{
local($s->{apad}) = $s->{apad};
- $s->{apad} .= ' ' x (length($name) + 3) if $s->{indent} >= 2;
+ $s->{apad} .= ' ' x (length($name) + 3) if $s->{indent} >= 2 and !$s->{terse};
$valstr = $s->_dump($val, $name);
}
=head1 VERSION
-Version 2.125 (Aug 8 2009)
+Version 2.126 (Apr 15 2010)
=head1 SEE ALSO
sv_catpvn(name, tmpbuf, nchars);
}
- if (indent >= 2) {
+ if (indent >= 2 && !terse) {
SV * const tmpsv = sv_x(aTHX_ NULL, " ", 1, SvCUR(name)+3);
newapad = newSVsv(apad);
sv_catsv(newapad, tmpsv);
freezer, toaster, purity, deepcopy, quotekeys,
bless, maxdepth, sortkeys);
- if (indent >= 2)
+ if (indent >= 2 && !terse)
SvREFCNT_dec(newapad);
postlen = av_len(postav);
--- /dev/null
+#!perl
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+
+use Data::Dumper;
+
+my $hash = { foo => 42 };
+
+for my $useperl (0..1) {
+ my $dumper = Data::Dumper->new([$hash]);
+ $dumper->Terse(1);
+ $dumper->Indent(2);
+ $dumper->Useperl($useperl);
+
+ is $dumper->Dump, <<'WANT', "Terse(1), Indent(2), Useperl($useperl)";
+{
+ 'foo' => 42
+}
+WANT
+}
# $ENV{PERL5LIB} will be set with this, but (by default) it's a relative
# path.
$ENV{PERL5LIB} = join $Config{path_sep}, map {
- File::Spec->rel2abs($_) } split $Config{path_sep}, $ENV{PERL5LIB};
+ File::Spec->rel2abs($_) } split quotemeta($Config{path_sep}), $ENV{PERL5LIB};
@INC = map { File::Spec->rel2abs($_) } @INC;
} else {
my $lib = 'blib/lib';
+2.31_01 Fri Apr 30 2010
+ - [rt.cpan.org #56740] Format Perl versions >= 5.6.0 as X.Y.Z (schwern)
+ - Functional interface amended to make calling conventions consistent
+ (bingos)
+ - Documented all functions and all hash structures (bingos)
+ - Fixed functions with edge-case involving querying for Module::CoreList
+ itself. Pointed out by Ilmari.
+ - Added removed_from() and removed_from_by_date() functions
+ for querying which release a module was removed from core. (bingos)
+ - Amended corelist utility to use new removed from functions when
+ stating when a module entered core ( and when it left it ). (bingos)
+ - Added tests to the testsuite to cover the edge-cases and new funcs. (bingos)
+
+2.31 Sun Mar 20 2010
+ - Updated for 5.13.0
+
+2.27 Sun Mar 14 2010
+ - Updated for 5.12.0
+
+2.26 Sat Feb 20 2010
+ - Updated for 5.11.5
+
+2.25 Wed Jan 20 2010
+ - Updated for 5.11.4
+
+2.24 Mon Dec 21 2009
+ - Updated for 5.11.3
+
2.23 Fri Nov 20 2009
- Updated for 5.11.2
--- #YAML:1.0
name: Module-CoreList
-version: 2.23
+version: 2.31
abstract: ~
license: perl
author: ~
(
'NAME' => 'Module::CoreList',
'VERSION_FROM' => 'lib/Module/CoreList.pm',
+ 'ABSTRACT_FROM' => 'lib/Module/CoreList.pm',
'PREREQ_PM' => {
'Test::More' => '0',
},
my %Opts;
-GetOptions(\%Opts, qw[ help|?! man! v|version:f a! d ] );
+GetOptions(\%Opts, qw[ help|?! man! v|version:s a! d ] );
pod2usage(1) if $Opts{help};
pod2usage(-verbose=>2) if $Opts{man};
if(exists $Opts{v} ){
if( !$Opts{v} ) {
print "\nModule::CoreList has info on the following perl versions:\n";
- print "$_\n" for sort keys %Module::CoreList::version;
+ print format_perl_version($_)."\n" for sort keys %Module::CoreList::version;
print "\n";
exit 0;
}
- $Opts{v} = numify_version( $Opts{v} );
- my $version_hash = Module::CoreList->find_version($Opts{v});
+ my $num_v = numify_version( $Opts{v} );
+ my $version_hash = Module::CoreList->find_version($num_v);
+
if( !$version_hash ) {
- print "\nModule::CoreList has no info on perl v$Opts{v}\n\n";
+ print "\nModule::CoreList has no info on perl $Opts{v}\n\n";
exit 1;
}
if ( !@ARGV ) {
- print "\nThe following modules were in perl v$Opts{v} CORE\n";
- print "$_ ", $version_hash->{$_} || " ","\n"
- for sort keys %$version_hash;
+ print "\nThe following modules were in perl $Opts{v} CORE\n";
+ my $max_mod_len = max_mod_len($version_hash);
+ for my $mod ( sort keys %$version_hash ) {
+ printf "%-${max_mod_len}s %s\n", $mod, $version_hash->{$mod} || "";
+ }
print "\n";
exit 0;
}
my($mod,$ver) = @_;
if ( $Opts{v} ) {
- my $version_hash = Module::CoreList->find_version($Opts{v});
+ my $numeric_v = numify_version($Opts{v});
+ my $version_hash = Module::CoreList->find_version($numeric_v);
if ($version_hash) {
print $mod, " ", $version_hash->{$mod} || 'undef', "\n";
return;
my $msg = $mod;
$msg .= " $ver" if $ver;
+ my $rem = $Opts{d}
+ ? Module::CoreList->removed_from_by_date($mod)
+ : Module::CoreList->removed_from($mod);
+
if( defined $ret ) {
$msg .= " was ";
$msg .= "first " unless $ver;
- $msg .= "released with perl $ret"
+ $msg .= "released with perl " . format_perl_version($ret);
+ $msg .= " and removed from " . format_perl_version($rem) if $rem;
} else {
$msg .= " was not in CORE (or so I think)";
}
print "\n",$msg,"\n";
if(defined $ret and exists $Opts{a} and $Opts{a}){
- for my $v(
- sort keys %Module::CoreList::version ){
-
- printf " %-10s %-10s\n",
- $v,
- $Module::CoreList::version{$v}{$mod}
- || 'undef'
- if exists $Module::CoreList::version{$v}{$mod};
- }
- print "\n";
+ display_a($mod);
+ }
+}
+
+
+sub max_mod_len {
+ my $versions = shift;
+ my $max = 0;
+ for my $mod (keys %$versions) {
+ $max = max($max, length $mod);
+ }
+
+ return $max;
+}
+
+sub max {
+ my($this, $that) = @_;
+ return $this if $this > $that;
+ return $that;
+}
+
+sub display_a {
+ my $mod = shift;
+
+ for my $v (grep !/000$/, sort keys %Module::CoreList::version ) {
+ next unless exists $Module::CoreList::version{$v}{$mod};
+
+ my $mod_v = $Module::CoreList::version{$v}{$mod} || 'undef';
+ printf " %-10s %-10s\n", format_perl_version($v), $mod_v;
+ }
+ print "\n";
+}
+
+
+{
+ my $have_version_pm;
+ sub have_version_pm {
+ return $have_version_pm if defined $have_version_pm;
+ return $have_version_pm = eval { require version; 1 };
}
}
+
+sub format_perl_version {
+ my $v = shift;
+ return $v if $v < 5.006 or !have_version_pm;
+ return version->new($v)->normal;
+}
+
+
sub numify_version {
my $ver = shift;
if ($ver =~ /\..+\./) {
- eval { require version ; 1 }
+ have_version_pm()
or die "You need to install version.pm to use dotted version numbers\n";
$ver = version->new($ver)->numify;
}
use strict;
use vars qw/$VERSION %released %version %families %upstream
%bug_tracker %deprecated/;
-$VERSION = '2.24';
+$VERSION = '2.33';
=head1 NAME
=head1 DESCRIPTION
-Module::CoreList contains the hash of hashes
-%Module::CoreList::version, that is keyed on perl version as indicated
+Module::CoreList provides information on which core and dual-life modules shipped
+with each version of L<perl>.
+
+It provides a number of mechanisms for querying this information.
+
+There is a utility called L<corelist> provided with this module
+which is a convenient way of querying from the command-line.
+
+There is a functional programming API available for programmers to query
+information.
+
+Programmers may also query the contained hash structures to find relevant
+information.
+
+=head1 FUNCTIONS API
+
+These are the functions that are available, they may either be called as functions or class methods:
+
+ Module::CoreList::first_release('File::Spec'); # as a function
+
+ Module::CoreList->first_release('File::Spec'); # class method
+
+=over
+
+=item C<first_release( MODULE )>
+
+Behaviour since version 2.11
+
+Requires a MODULE name as an argument, returns the perl version when that module first
+appeared in core as ordered by perl version number or undef if that module is not in core.
+
+=item C<first_release_by_date( MODULE )>
+
+Requires a MODULE name as an argument, returns the perl version when that module first
+appeared in core as ordered by release date or undef if that module is not in core.
+
+=item C<find_modules( REGEX, [ LIST OF PERLS ] )>
+
+Takes a regex as an argument, returns a list of modules that match the regex given.
+If only a regex is provided applies to all modules in all perl versions. Optionally
+you may provide a list of perl versions to limit the regex search.
+
+=item C<find_version( PERL_VERSION )>
+
+Takes a perl version as an argument. Returns that perl version if it exists or C<undef>
+otherwise.
+
+=item C<is_deprecated( MODULE, PERL_VERSION )>
+
+Available in version 2.22 and above.
+
+Returns true if MODULE is marked as deprecated in PERL_VERSION. If PERL_VERSION is
+omitted, it defaults to the current version of Perl.
+
+=item C<removed_from( MODULE )>
+
+Available in version 2.32 and above
+
+Takes a module name as an argument, returns the first perl version where that module
+was removed from core. Returns undef if the given module was never in core or remains
+in core.
+
+=item C<removed_from_by_date( MODULE )>
+
+Available in version 2.32 and above
+
+Takes a module name as an argument, returns the first perl version by release date where that module
+was removed from core. Returns undef if the given module was never in core or remains
+in core.
+
+=back
+
+=head1 DATA STRUCTURES
+
+These are the hash data structures that are available:
+
+=over
+
+=item C<%Module::CoreList::version>
+
+A hash of hashes that is keyed on perl version as indicated
in $]. The second level hash is module => version pairs.
Note, it is possible for the version of a module to be unspecified,
-whereby the value is undef, so use C<exists $version{$foo}{$bar}> if
+whereby the value is C<undef>, so use C<exists $version{$foo}{$bar}> if
that's what you're testing for.
-It also contains %Module::CoreList::released hash, which has ISO
+Starting with 2.10, the special module name C<Unicode> refers to the version of
+the Unicode Character Database bundled with Perl.
+
+=item C<%Module::CoreList::released>
+
+Keyed on perl version this contains ISO
formatted versions of the release dates, as gleaned from L<perlhist>.
-New, in 1.96 is also the %Module::CoreList::families hash, which
+=item C<%Module::CoreList::families>
+
+New, in 1.96, a hash that
clusters known perl releases by their major versions.
-Starting with 2.10, the special module name C<Unicode> refers to the version of
-the Unicode Character Database bundled with Perl.
+=item C<%Module::CoreList::deprecated>
-Since 2.11, Module::CoreList::first_release() returns the first release
-in the order of perl version numbers. If you want to get the earliest
-perl release instead, use Module::CoreList::first_release_by_date().
+A hash of hashes keyed on perl version and on module name.
+If a module is defined it indicates that that module is
+deprecated in that perl version and is scheduled for removal
+from core at some future point.
-New in 2.22, Module::CoreList::is_deprecated(MODULE,PERL_VERSION) returns true
-if MODULE is marked as deprecated in PERL_VERSION. If PERL_VERSION is
-omitted, it defaults to the current version of Perl.
+=item C<%Module::CoreList::upstream>
+
+A hash that contains information on where patches should be directed
+for each core module.
+
+UPSTREAM indicates where patches should go. C<undef> implies
+that this hasn't been discussed for the module at hand.
+C<blead> indicates that the copy of the module in the blead
+sources is to be considered canonical, C<cpan> means that the
+module on CPAN is to be patched first. C<first-come> means
+that blead can be patched freely if it is in sync with the
+latest release on CPAN.
+
+=item C<%Module::CoreList::bug_tracker>
+
+A hash that contains information on the appropriate bug tracker
+for each core module.
+
+BUGS is an email or url to post bug reports. For modules with
+UPSTREAM => 'blead', use perl5-porters@perl.org. rt.cpan.org
+appears to automatically provide a URL for CPAN modules; any value
+given here overrides the default:
+http://rt.cpan.org/Public/Dist/Display.html?Name=$ModuleName
+
+=back
=head1 CAVEATS
-Module::CoreList currently covers the 5.000, 5.001, 5.002, 5.003_07, 5.004,
-5.004_05, 5.005, 5.005_03, 5.005_04, 5.6.0, 5.6.1, 5.6.2, 5.7.3, 5.8.0, 5.8.1,
-5.8.2, 5.8.3, 5.8.4, 5.8.5, 5.8.6, 5.8.7, 5.8.8, 5.8.9, 5.9.0, 5.9.1, 5.9.2, 5.9.3,
-5.9.4, 5.9.5, 5.10.0, 5.10.1, 5.11.0, 5.11.1, 5.11.2 and 5.11.3 releases of perl.
+Module::CoreList currently covers the 5.000, 5.001, 5.002, 5.003_07,
+5.004, 5.004_05, 5.005, 5.005_03, 5.005_04, 5.6.0, 5.6.1, 5.6.2, 5.7.3,
+5.8.0, 5.8.1, 5.8.2, 5.8.3, 5.8.4, 5.8.5, 5.8.6, 5.8.7, 5.8.8, 5.8.9,
+5.9.0, 5.9.1, 5.9.2, 5.9.3, 5.9.4, 5.9.5, 5.10.0, 5.10.1, 5.11.0, 5.11.1,
+5.11.2, 5.11.3, 5.11.4, 5.11.5, 5.12.0, 5.12.1 and 5.13.0 releases of perl.
=head1 HISTORY
sub first_release_raw {
- my ($discard, $module, $version) = @_;
+ my $module = shift;
+ $module = shift if $module->isa(__PACKAGE__)
+ and scalar @_ and $_[0] =~ m#\A[a-zA-Z_][0-9a-zA-Z_]*(?:(::|')[0-9a-zA-Z_]+)*\z#;
+ my $version = shift;
my @perls = $version
? grep { exists $version{$_}{ $module } &&
}
sub find_modules {
- my $discard = shift;
my $regex = shift;
+ $regex = shift if $regex->isa(__PACKAGE__);
my @perls = @_;
@perls = keys %version unless @perls;
}
sub find_version {
- my ($class, $v) = @_;
+ my $v = shift;
+ $v = shift if $v->isa(__PACKAGE__);
return $version{$v} if defined $version{$v};
return undef;
}
sub is_deprecated {
- my ($module, $perl_version) = @_;
+ my $module = shift;
+ $module = shift if $module->isa(__PACKAGE__)
+ and scalar @_ and $_[0] =~ m#\A[a-zA-Z_][0-9a-zA-Z_]*(?:(::|')[0-9a-zA-Z_]+)*\z#;
+ my $perl_version = shift;
$perl_version ||= $];
return unless $module && exists $deprecated{$perl_version}{$module};
return $deprecated{$perl_version}{$module};
}
+sub removed_from {
+ my @perls = &removed_raw;
+ return shift @perls;
+}
+
+sub removed_from_by_date {
+ my @perls = sort { $released{$a} cmp $released{$b} } &removed_raw;
+ return shift @perls;
+}
+
+sub removed_raw {
+ my $mod = shift;
+ $mod = shift if $mod->isa(__PACKAGE__)
+ and scalar @_ and $_[0] =~ m#\A[a-zA-Z_][0-9a-zA-Z_]*(?:(::|')[0-9a-zA-Z_]+)*\z#;
+ return unless my @perls = sort { $a cmp $b } first_release_raw($mod);
+ my $last = pop @perls;
+ my @removed = grep { $_ > $last } sort { $a cmp $b } keys %version;
+ return @removed;
+}
+
# When things escaped.
# NB. If you put version numbers with trailing zeroes here, you
# should also add an alias for the numerical ($]) version; see
5.011001 => '2009-10-20',
5.011002 => '2009-11-20',
5.011003 => '2009-12-20',
+ 5.011004 => '2010-01-20',
+ 5.011005 => '2010-02-20',
+ 5.012000 => '2010-04-12',
+ 5.013000 => '2010-04-20',
+ 5.012001 => '2010-05-16',
);
for my $version ( sort { $a <=> $b } keys %released ) {
'warnings' => '1.08',
'warnings::register' => '1.01',
},
-);
-
-%deprecated = (
- 5.011 => {
- 'Class::ISA' => '1',
- 'Pod::Plainer' => '1',
- 'Shell' => '1',
- 'Switch' => '1',
- },
- 5.011001 => {
- 'Class::ISA' => '1',
- 'Pod::Plainer' => '1',
- 'Shell' => '1',
- 'Switch' => '1',
- },
- 5.011002 => {
- 'Class::ISA' => '1',
- 'Pod::Plainer' => '1',
- 'Shell' => '1',
- 'Switch' => '1',
- },
- 5.011003 => {
- 'Class::ISA' => '1',
- 'Pod::Plainer' => '1',
- 'Shell' => '1',
- 'Switch' => '1',
- },
-);
-
-%upstream = (
- 'App::Cpan' => 'cpan',
- 'App::Prove' => undef,
- 'App::Prove::State' => undef,
- 'App::Prove::State::Result'=> undef,
- 'App::Prove::State::Result::Test'=> undef,
- 'Archive::Extract' => 'cpan',
- 'Archive::Tar' => 'cpan',
- 'Archive::Tar::Constant'=> 'cpan',
- 'Archive::Tar::File' => 'cpan',
- 'Attribute::Handlers' => 'blead',
- 'AutoLoader' => 'cpan',
- 'AutoSplit' => 'cpan',
- 'B::Concise' => undef,
- 'B::Debug' => undef,
- 'B::Deparse' => 'blead',
- 'B::Lint' => undef,
- 'B::Lint::Debug' => undef,
- 'CGI' => 'cpan',
- 'CGI::Apache' => 'cpan',
- 'CGI::Carp' => 'cpan',
- 'CGI::Cookie' => 'cpan',
- 'CGI::Fast' => 'cpan',
- 'CGI::Pretty' => 'cpan',
- 'CGI::Push' => 'cpan',
- 'CGI::Switch' => 'cpan',
- 'CGI::Util' => 'cpan',
- 'CPAN' => 'cpan',
- 'CPAN::Author' => 'cpan',
- 'CPAN::Bundle' => 'cpan',
- 'CPAN::CacheMgr' => 'cpan',
- 'CPAN::Complete' => 'cpan',
- 'CPAN::Debug' => 'cpan',
- 'CPAN::DeferredCode' => 'cpan',
- 'CPAN::Distribution' => 'cpan',
- 'CPAN::Distroprefs' => 'cpan',
- 'CPAN::Distrostatus' => 'cpan',
- 'CPAN::Exception::RecursiveDependency'=> 'cpan',
- 'CPAN::Exception::blocked_urllist'=> 'cpan',
- 'CPAN::Exception::yaml_not_installed'=> 'cpan',
- 'CPAN::FTP' => 'cpan',
- 'CPAN::FTP::netrc' => 'cpan',
- 'CPAN::FirstTime' => 'cpan',
- 'CPAN::HandleConfig' => 'cpan',
- 'CPAN::Index' => 'cpan',
- 'CPAN::InfoObj' => 'cpan',
- 'CPAN::Kwalify' => 'cpan',
- 'CPAN::LWP::UserAgent' => 'cpan',
- 'CPAN::Mirrors' => 'cpan',
- 'CPAN::Module' => 'cpan',
- 'CPAN::Nox' => 'cpan',
- 'CPAN::Prompt' => 'cpan',
- 'CPAN::Queue' => 'cpan',
- 'CPAN::Shell' => 'cpan',
- 'CPAN::Tarzip' => 'cpan',
- 'CPAN::URL' => 'cpan',
- 'CPAN::Version' => 'cpan',
- 'CPANPLUS' => 'cpan',
- 'CPANPLUS::Backend' => 'cpan',
- 'CPANPLUS::Backend::RV' => 'cpan',
- 'CPANPLUS::Config' => 'cpan',
- 'CPANPLUS::Configure' => 'cpan',
- 'CPANPLUS::Configure::Setup'=> 'cpan',
- 'CPANPLUS::Dist' => 'cpan',
- 'CPANPLUS::Dist::Autobundle'=> 'cpan',
- 'CPANPLUS::Dist::Base' => 'cpan',
- 'CPANPLUS::Dist::Build' => 'cpan',
- 'CPANPLUS::Dist::Build::Constants'=> 'cpan',
- 'CPANPLUS::Dist::MM' => 'cpan',
- 'CPANPLUS::Dist::Sample'=> 'cpan',
- 'CPANPLUS::Error' => 'cpan',
- 'CPANPLUS::Internals' => 'cpan',
- 'CPANPLUS::Internals::Constants'=> 'cpan',
- 'CPANPLUS::Internals::Constants::Report'=> 'cpan',
- 'CPANPLUS::Internals::Extract'=> 'cpan',
- 'CPANPLUS::Internals::Fetch'=> 'cpan',
- 'CPANPLUS::Internals::Report'=> 'cpan',
- 'CPANPLUS::Internals::Search'=> 'cpan',
- 'CPANPLUS::Internals::Source'=> 'cpan',
- 'CPANPLUS::Internals::Source::Memory'=> 'cpan',
- 'CPANPLUS::Internals::Source::SQLite'=> 'cpan',
- 'CPANPLUS::Internals::Source::SQLite::Tie'=> 'cpan',
- 'CPANPLUS::Internals::Utils'=> 'cpan',
- 'CPANPLUS::Internals::Utils::Autoflush'=> 'cpan',
- 'CPANPLUS::Module' => 'cpan',
- 'CPANPLUS::Module::Author'=> 'cpan',
- 'CPANPLUS::Module::Author::Fake'=> 'cpan',
- 'CPANPLUS::Module::Checksums'=> 'cpan',
- 'CPANPLUS::Module::Fake'=> 'cpan',
- 'CPANPLUS::Module::Signature'=> 'cpan',
- 'CPANPLUS::Selfupdate' => 'cpan',
- 'CPANPLUS::Shell' => 'cpan',
- 'CPANPLUS::Shell::Classic'=> 'cpan',
- 'CPANPLUS::Shell::Default'=> 'cpan',
- 'CPANPLUS::Shell::Default::Plugins::CustomSource'=> 'cpan',
- 'CPANPLUS::Shell::Default::Plugins::Remote'=> 'cpan',
- 'CPANPLUS::Shell::Default::Plugins::Source'=> 'cpan',
- 'Class::ISA' => 'cpan',
- 'Compress::Raw::Bzip2' => undef,
- 'Compress::Raw::Zlib' => undef,
- 'Compress::Zlib' => 'cpan',
- 'Cwd' => 'cpan',
- 'DB_File' => undef,
- 'Devel::InnerPackage' => undef,
- 'Devel::PPPort' => 'cpan',
- 'Digest' => undef,
- 'Digest::MD5' => undef,
- 'Digest::SHA' => undef,
- 'Digest::base' => undef,
- 'Digest::file' => undef,
- 'Encode' => undef,
- 'Encode::Alias' => undef,
- 'Encode::Byte' => undef,
- 'Encode::CJKConstants' => undef,
- 'Encode::CN' => undef,
- 'Encode::CN::HZ' => undef,
- 'Encode::Config' => undef,
- 'Encode::EBCDIC' => undef,
- 'Encode::Encoder' => undef,
- 'Encode::Encoding' => undef,
- 'Encode::GSM0338' => undef,
- 'Encode::Guess' => undef,
- 'Encode::JP' => undef,
- 'Encode::JP::H2Z' => undef,
- 'Encode::JP::JIS7' => undef,
- 'Encode::KR' => undef,
- 'Encode::KR::2022_KR' => undef,
- 'Encode::MIME::Header' => undef,
- 'Encode::MIME::Header::ISO_2022_JP'=> undef,
- 'Encode::MIME::Name' => undef,
- 'Encode::Symbol' => undef,
- 'Encode::TW' => undef,
- 'Encode::Unicode' => undef,
- 'Encode::Unicode::UTF7' => undef,
- 'Exporter' => 'blead',
- 'Exporter::Heavy' => 'blead',
- 'ExtUtils::CBuilder' => 'cpan',
- 'ExtUtils::CBuilder::Base'=> 'cpan',
- 'ExtUtils::CBuilder::Platform::Unix'=> 'cpan',
- 'ExtUtils::CBuilder::Platform::VMS'=> 'cpan',
- 'ExtUtils::CBuilder::Platform::Windows'=> 'cpan',
- 'ExtUtils::CBuilder::Platform::Windows::BCC'=> 'cpan',
- 'ExtUtils::CBuilder::Platform::Windows::GCC'=> 'cpan',
- 'ExtUtils::CBuilder::Platform::Windows::MSVC'=> 'cpan',
- 'ExtUtils::CBuilder::Platform::aix'=> 'cpan',
- 'ExtUtils::CBuilder::Platform::cygwin'=> 'cpan',
- 'ExtUtils::CBuilder::Platform::darwin'=> 'cpan',
- 'ExtUtils::CBuilder::Platform::dec_osf'=> 'cpan',
- 'ExtUtils::CBuilder::Platform::os2'=> 'cpan',
- 'ExtUtils::Command' => undef,
- 'ExtUtils::Command::MM' => 'first-come',
- 'ExtUtils::Constant' => undef,
- 'ExtUtils::Constant::Base'=> undef,
- 'ExtUtils::Constant::ProxySubs'=> undef,
- 'ExtUtils::Constant::Utils'=> undef,
- 'ExtUtils::Constant::XS'=> undef,
- 'ExtUtils::Install' => 'blead',
- 'ExtUtils::Installed' => 'blead',
- 'ExtUtils::Liblist' => 'first-come',
- 'ExtUtils::Liblist::Kid'=> 'first-come',
- 'ExtUtils::MM' => 'first-come',
- 'ExtUtils::MM_AIX' => 'first-come',
- 'ExtUtils::MM_Any' => 'first-come',
- 'ExtUtils::MM_BeOS' => 'first-come',
- 'ExtUtils::MM_Cygwin' => 'first-come',
- 'ExtUtils::MM_DOS' => 'first-come',
- 'ExtUtils::MM_Darwin' => 'first-come',
- 'ExtUtils::MM_MacOS' => 'first-come',
- 'ExtUtils::MM_NW5' => 'first-come',
- 'ExtUtils::MM_OS2' => 'first-come',
- 'ExtUtils::MM_QNX' => 'first-come',
- 'ExtUtils::MM_UWIN' => 'first-come',
- 'ExtUtils::MM_Unix' => 'first-come',
+ 5.011004 => {
+ 'AnyDBM_File' => '1.00',
+ 'App::Cpan' => '1.5701',
+ 'App::Prove' => '3.17',
+ 'App::Prove::State' => '3.17',
+ 'App::Prove::State::Result'=> '3.17',
+ 'App::Prove::State::Result::Test'=> '3.17',
+ 'Archive::Extract' => '0.38',
+ 'Archive::Tar' => '1.54',
+ 'Archive::Tar::Constant'=> '0.02',
+ 'Archive::Tar::File' => '0.02',
+ 'Attribute::Handlers' => '0.87',
+ 'AutoLoader' => '5.70',
+ 'AutoSplit' => '1.06',
+ 'B' => '1.23',
+ 'B::Concise' => '0.78',
+ 'B::Debug' => '1.11',
+ 'B::Deparse' => '0.94',
+ 'B::Lint' => '1.11_01',
+ 'B::Lint::Debug' => '0.01',
+ 'B::Showlex' => '1.02',
+ 'B::Terse' => '1.05',
+ 'B::Xref' => '1.02',
+ 'Benchmark' => '1.11',
+ 'CGI' => '3.48',
+ 'CGI::Apache' => '1.01',
+ 'CGI::Carp' => '3.45',
+ 'CGI::Cookie' => '1.29',
+ 'CGI::Fast' => '1.07',
+ 'CGI::Pretty' => '3.46',
+ 'CGI::Push' => '1.04',
+ 'CGI::Switch' => '1.01',
+ 'CGI::Util' => '3.48',
+ 'CPAN' => '1.94_54',
+ 'CPAN::Author' => '5.5',
+ 'CPAN::Bundle' => '5.5',
+ 'CPAN::CacheMgr' => '5.5',
+ 'CPAN::Complete' => '5.5',
+ 'CPAN::Debug' => '5.5',
+ 'CPAN::DeferredCode' => '5.50',
+ 'CPAN::Distribution' => '1.94',
+ 'CPAN::Distroprefs' => '6',
+ 'CPAN::Distrostatus' => '5.5',
+ 'CPAN::Exception::RecursiveDependency'=> '5.5',
+ 'CPAN::Exception::blocked_urllist'=> '1.0',
+ 'CPAN::Exception::yaml_not_installed'=> '5.5',
+ 'CPAN::FTP' => '5.5004',
+ 'CPAN::FTP::netrc' => '1.00',
+ 'CPAN::FirstTime' => '5.53',
+ 'CPAN::HandleConfig' => '5.5',
+ 'CPAN::Index' => '1.94',
+ 'CPAN::InfoObj' => '5.5',
+ 'CPAN::Kwalify' => '5.50',
+ 'CPAN::LWP::UserAgent' => '1.94',
+ 'CPAN::Mirrors' => '1.77',
+ 'CPAN::Module' => '5.5',
+ 'CPAN::Nox' => '5.50',
+ 'CPAN::Prompt' => '5.5',
+ 'CPAN::Queue' => '5.5',
+ 'CPAN::Shell' => '5.5',
+ 'CPAN::Tarzip' => '5.501',
+ 'CPAN::URL' => '5.5',
+ 'CPAN::Version' => '5.5',
+ 'CPANPLUS' => '0.90',
+ 'CPANPLUS::Backend' => undef,
+ 'CPANPLUS::Backend::RV' => undef,
+ 'CPANPLUS::Config' => undef,
+ 'CPANPLUS::Configure' => undef,
+ 'CPANPLUS::Configure::Setup'=> undef,
+ 'CPANPLUS::Dist' => undef,
+ 'CPANPLUS::Dist::Autobundle'=> undef,
+ 'CPANPLUS::Dist::Base' => undef,
+ 'CPANPLUS::Dist::Build' => '0.44',
+ 'CPANPLUS::Dist::Build::Constants'=> '0.44',
+ 'CPANPLUS::Dist::MM' => undef,
+ 'CPANPLUS::Dist::Sample'=> undef,
+ 'CPANPLUS::Error' => undef,
+ 'CPANPLUS::Internals' => '0.90',
+ 'CPANPLUS::Internals::Constants'=> undef,
+ 'CPANPLUS::Internals::Constants::Report'=> undef,
+ 'CPANPLUS::Internals::Extract'=> undef,
+ 'CPANPLUS::Internals::Fetch'=> undef,
+ 'CPANPLUS::Internals::Report'=> undef,
+ 'CPANPLUS::Internals::Search'=> undef,
+ 'CPANPLUS::Internals::Source'=> undef,
+ 'CPANPLUS::Internals::Source::Memory'=> undef,
+ 'CPANPLUS::Internals::Source::SQLite'=> undef,
+ 'CPANPLUS::Internals::Source::SQLite::Tie'=> undef,
+ 'CPANPLUS::Internals::Utils'=> undef,
+ 'CPANPLUS::Internals::Utils::Autoflush'=> undef,
+ 'CPANPLUS::Module' => undef,
+ 'CPANPLUS::Module::Author'=> undef,
+ 'CPANPLUS::Module::Author::Fake'=> undef,
+ 'CPANPLUS::Module::Checksums'=> undef,
+ 'CPANPLUS::Module::Fake'=> undef,
+ 'CPANPLUS::Module::Signature'=> undef,
+ 'CPANPLUS::Selfupdate' => undef,
+ 'CPANPLUS::Shell' => undef,
+ 'CPANPLUS::Shell::Classic'=> '0.0562',
+ 'CPANPLUS::Shell::Default'=> '0.90',
+ 'CPANPLUS::Shell::Default::Plugins::CustomSource'=> undef,
+ 'CPANPLUS::Shell::Default::Plugins::Remote'=> undef,
+ 'CPANPLUS::Shell::Default::Plugins::Source'=> undef,
+ 'Carp' => '1.15',
+ 'Carp::Heavy' => '1.15',
+ 'Class::ISA' => '0.36',
+ 'Class::Struct' => '0.63',
+ 'Compress::Raw::Bzip2' => '2.024',
+ 'Compress::Raw::Zlib' => '2.024',
+ 'Compress::Zlib' => '2.024',
+ 'Config' => undef,
+ 'Config::Extensions' => '0.01',
+ 'Cwd' => '3.31',
+ 'DB' => '1.02',
+ 'DBM_Filter' => '0.03',
+ 'DBM_Filter::compress' => '0.02',
+ 'DBM_Filter::encode' => '0.02',
+ 'DBM_Filter::int32' => '0.02',
+ 'DBM_Filter::null' => '0.02',
+ 'DBM_Filter::utf8' => '0.02',
+ 'DB_File' => '1.820',
+ 'Data::Dumper' => '2.125',
+ 'Devel::DProf' => '20080331.00',
+ 'Devel::DProf::dprof::V'=> undef,
+ 'Devel::InnerPackage' => '0.3',
+ 'Devel::PPPort' => '3.19',
+ 'Devel::Peek' => '1.04',
+ 'Devel::SelfStubber' => '1.03',
+ 'Digest' => '1.16',
+ 'Digest::MD5' => '2.39',
+ 'Digest::SHA' => '5.47',
+ 'Digest::base' => '1.16',
+ 'Digest::file' => '1.16',
+ 'DirHandle' => '1.03',
+ 'Dumpvalue' => '1.13',
+ 'DynaLoader' => '1.10',
+ 'Encode' => '2.39',
+ 'Encode::Alias' => '2.12',
+ 'Encode::Byte' => '2.04',
+ 'Encode::CJKConstants' => '2.02',
+ 'Encode::CN' => '2.03',
+ 'Encode::CN::HZ' => '2.05',
+ 'Encode::Config' => '2.05',
+ 'Encode::EBCDIC' => '2.02',
+ 'Encode::Encoder' => '2.01',
+ 'Encode::Encoding' => '2.05',
+ 'Encode::GSM0338' => '2.01',
+ 'Encode::Guess' => '2.03',
+ 'Encode::JP' => '2.04',
+ 'Encode::JP::H2Z' => '2.02',
+ 'Encode::JP::JIS7' => '2.04',
+ 'Encode::KR' => '2.03',
+ 'Encode::KR::2022_KR' => '2.02',
+ 'Encode::MIME::Header' => '2.11',
+ 'Encode::MIME::Header::ISO_2022_JP'=> '1.03',
+ 'Encode::MIME::Name' => '1.01',
+ 'Encode::Symbol' => '2.02',
+ 'Encode::TW' => '2.03',
+ 'Encode::Unicode' => '2.07',
+ 'Encode::Unicode::UTF7' => '2.04',
+ 'English' => '1.04',
+ 'Env' => '1.01',
+ 'Errno' => '1.11',
+ 'Exporter' => '5.64_01',
+ 'Exporter::Heavy' => '5.64_01',
+ 'ExtUtils::CBuilder' => '0.27',
+ 'ExtUtils::CBuilder::Base'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::Unix'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::VMS'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::Windows'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::Windows::BCC'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::Windows::GCC'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::Windows::MSVC'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::aix'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::cygwin'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::darwin'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::dec_osf'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::os2'=> '0.27',
+ 'ExtUtils::Command' => '1.16',
+ 'ExtUtils::Command::MM' => '6.56',
+ 'ExtUtils::Constant' => '0.22',
+ 'ExtUtils::Constant::Base'=> '0.04',
+ 'ExtUtils::Constant::ProxySubs'=> '0.06',
+ 'ExtUtils::Constant::Utils'=> '0.02',
+ 'ExtUtils::Constant::XS'=> '0.03',
+ 'ExtUtils::Embed' => '1.28',
+ 'ExtUtils::Install' => '1.55',
+ 'ExtUtils::Installed' => '1.999_001',
+ 'ExtUtils::Liblist' => '6.56',
+ 'ExtUtils::Liblist::Kid'=> '6.56',
+ 'ExtUtils::MM' => '6.56',
+ 'ExtUtils::MM_AIX' => '6.56',
+ 'ExtUtils::MM_Any' => '6.56',
+ 'ExtUtils::MM_BeOS' => '6.56',
+ 'ExtUtils::MM_Cygwin' => '6.56',
+ 'ExtUtils::MM_DOS' => '6.56',
+ 'ExtUtils::MM_Darwin' => '6.56',
+ 'ExtUtils::MM_MacOS' => '6.56',
+ 'ExtUtils::MM_NW5' => '6.56',
+ 'ExtUtils::MM_OS2' => '6.56',
+ 'ExtUtils::MM_QNX' => '6.56',
+ 'ExtUtils::MM_UWIN' => '6.56',
+ 'ExtUtils::MM_Unix' => '6.56',
+ 'ExtUtils::MM_VMS' => '6.56',
+ 'ExtUtils::MM_VOS' => '6.56',
+ 'ExtUtils::MM_Win32' => '6.56',
+ 'ExtUtils::MM_Win95' => '6.56',
+ 'ExtUtils::MY' => '6.56',
+ 'ExtUtils::MakeMaker' => '6.56',
+ 'ExtUtils::MakeMaker::Config'=> '6.56',
+ 'ExtUtils::Manifest' => '1.57',
+ 'ExtUtils::Miniperl' => undef,
+ 'ExtUtils::Mkbootstrap' => '6.56',
+ 'ExtUtils::Mksymlists' => '6.56',
+ 'ExtUtils::Packlist' => '1.44',
+ 'ExtUtils::ParseXS' => '2.21',
+ 'ExtUtils::XSSymSet' => '1.1',
+ 'ExtUtils::testlib' => '6.56',
+ 'Fatal' => '2.06_01',
+ 'Fcntl' => '1.06',
+ 'File::Basename' => '2.78',
+ 'File::CheckTree' => '4.4',
+ 'File::Compare' => '1.1006',
+ 'File::Copy' => '2.17',
+ 'File::DosGlob' => '1.01',
+ 'File::Fetch' => '0.24',
+ 'File::Find' => '1.15',
+ 'File::Glob' => '1.07',
+ 'File::GlobMapper' => '1.000',
+ 'File::Path' => '2.08_01',
+ 'File::Spec' => '3.31',
+ 'File::Spec::Cygwin' => '3.30',
+ 'File::Spec::Epoc' => '3.30',
+ 'File::Spec::Functions' => '3.30',
+ 'File::Spec::Mac' => '3.30',
+ 'File::Spec::OS2' => '3.30',
+ 'File::Spec::Unix' => '3.30',
+ 'File::Spec::VMS' => '3.30',
+ 'File::Spec::Win32' => '3.30',
+ 'File::Temp' => '0.22',
+ 'File::stat' => '1.02',
+ 'FileCache' => '1.08',
+ 'FileHandle' => '2.02',
+ 'Filespec' => '1.12',
+ 'Filter::Simple' => '0.84',
+ 'Filter::Util::Call' => '1.08',
+ 'FindBin' => '1.50',
+ 'GDBM_File' => '1.10',
+ 'Getopt::Long' => '2.38',
+ 'Getopt::Std' => '1.06',
+ 'Hash::Util' => '0.07',
+ 'Hash::Util::FieldHash' => '1.04',
+ 'I18N::Collate' => '1.01',
+ 'I18N::LangTags' => '0.35',
+ 'I18N::LangTags::Detect'=> '1.04',
+ 'I18N::LangTags::List' => '0.35',
+ 'I18N::Langinfo' => '0.03',
+ 'IO' => '1.25_02',
+ 'IO::Compress::Adapter::Bzip2'=> '2.024',
+ 'IO::Compress::Adapter::Deflate'=> '2.024',
+ 'IO::Compress::Adapter::Identity'=> '2.024',
+ 'IO::Compress::Base' => '2.024',
+ 'IO::Compress::Base::Common'=> '2.024',
+ 'IO::Compress::Bzip2' => '2.024',
+ 'IO::Compress::Deflate' => '2.024',
+ 'IO::Compress::Gzip' => '2.024',
+ 'IO::Compress::Gzip::Constants'=> '2.024',
+ 'IO::Compress::RawDeflate'=> '2.024',
+ 'IO::Compress::Zip' => '2.024',
+ 'IO::Compress::Zip::Constants'=> '2.024',
+ 'IO::Compress::Zlib::Constants'=> '2.024',
+ 'IO::Compress::Zlib::Extra'=> '2.024',
+ 'IO::Dir' => '1.07',
+ 'IO::File' => '1.14',
+ 'IO::Handle' => '1.28',
+ 'IO::Pipe' => '1.13',
+ 'IO::Poll' => '0.07',
+ 'IO::Seekable' => '1.10',
+ 'IO::Select' => '1.17',
+ 'IO::Socket' => '1.31',
+ 'IO::Socket::INET' => '1.31',
+ 'IO::Socket::UNIX' => '1.23',
+ 'IO::Uncompress::Adapter::Bunzip2'=> '2.024',
+ 'IO::Uncompress::Adapter::Identity'=> '2.024',
+ 'IO::Uncompress::Adapter::Inflate'=> '2.024',
+ 'IO::Uncompress::AnyInflate'=> '2.024',
+ 'IO::Uncompress::AnyUncompress'=> '2.024',
+ 'IO::Uncompress::Base' => '2.024',
+ 'IO::Uncompress::Bunzip2'=> '2.024',
+ 'IO::Uncompress::Gunzip'=> '2.024',
+ 'IO::Uncompress::Inflate'=> '2.024',
+ 'IO::Uncompress::RawInflate'=> '2.024',
+ 'IO::Uncompress::Unzip' => '2.024',
+ 'IO::Zlib' => '1.10',
+ 'IPC::Cmd' => '0.54',
+ 'IPC::Msg' => '2.01',
+ 'IPC::Open2' => '1.03',
+ 'IPC::Open3' => '1.05',
+ 'IPC::Semaphore' => '2.01',
+ 'IPC::SharedMem' => '2.01',
+ 'IPC::SysV' => '2.01',
+ 'List::Util' => '1.22',
+ 'List::Util::PP' => '1.22',
+ 'List::Util::XS' => '1.22',
+ 'Locale::Constants' => '2.07',
+ 'Locale::Country' => '2.07',
+ 'Locale::Currency' => '2.07',
+ 'Locale::Language' => '2.07',
+ 'Locale::Maketext' => '1.14',
+ 'Locale::Maketext::Guts'=> '1.13',
+ 'Locale::Maketext::GutsLoader'=> '1.13',
+ 'Locale::Maketext::Simple'=> '0.21',
+ 'Locale::Script' => '2.07',
+ 'Log::Message' => '0.02',
+ 'Log::Message::Config' => '0.01',
+ 'Log::Message::Handlers'=> undef,
+ 'Log::Message::Item' => undef,
+ 'Log::Message::Simple' => '0.06',
+ 'MIME::Base64' => '3.08',
+ 'MIME::QuotedPrint' => '3.08',
+ 'Math::BigFloat' => '1.60',
+ 'Math::BigFloat::Trace' => '0.01',
+ 'Math::BigInt' => '1.89_01',
+ 'Math::BigInt::Calc' => '0.52',
+ 'Math::BigInt::CalcEmu' => '0.05',
+ 'Math::BigInt::FastCalc'=> '0.19',
+ 'Math::BigInt::Trace' => '0.01',
+ 'Math::BigRat' => '0.24',
+ 'Math::Complex' => '1.56',
+ 'Math::Trig' => '1.2',
+ 'Memoize' => '1.01_03',
+ 'Memoize::AnyDBM_File' => '0.65',
+ 'Memoize::Expire' => '1.00',
+ 'Memoize::ExpireFile' => '1.01',
+ 'Memoize::ExpireTest' => '0.65',
+ 'Memoize::NDBM_File' => '0.65',
+ 'Memoize::SDBM_File' => '0.65',
+ 'Memoize::Storable' => '0.65',
+ 'Module::Build' => '0.3603',
+ 'Module::Build::Base' => '0.3603',
+ 'Module::Build::Compat' => '0.3603',
+ 'Module::Build::Config' => '0.3603',
+ 'Module::Build::ConfigData'=> undef,
+ 'Module::Build::Cookbook'=> '0.3603',
+ 'Module::Build::Dumper' => '0.3603',
+ 'Module::Build::ModuleInfo'=> '0.3603',
+ 'Module::Build::Notes' => '0.3603',
+ 'Module::Build::PPMMaker'=> '0.3603',
+ 'Module::Build::Platform::Amiga'=> '0.3603',
+ 'Module::Build::Platform::Default'=> '0.3603',
+ 'Module::Build::Platform::EBCDIC'=> '0.3603',
+ 'Module::Build::Platform::MPEiX'=> '0.3603',
+ 'Module::Build::Platform::MacOS'=> '0.3603',
+ 'Module::Build::Platform::RiscOS'=> '0.3603',
+ 'Module::Build::Platform::Unix'=> '0.3603',
+ 'Module::Build::Platform::VMS'=> '0.3603',
+ 'Module::Build::Platform::VOS'=> '0.3603',
+ 'Module::Build::Platform::Windows'=> '0.3603',
+ 'Module::Build::Platform::aix'=> '0.3603',
+ 'Module::Build::Platform::cygwin'=> '0.3603',
+ 'Module::Build::Platform::darwin'=> '0.3603',
+ 'Module::Build::Platform::os2'=> '0.3603',
+ 'Module::Build::PodParser'=> '0.3603',
+ 'Module::Build::Version'=> '0.77',
+ 'Module::Build::YAML' => '1.40',
+ 'Module::CoreList' => '2.25',
+ 'Module::Load' => '0.16',
+ 'Module::Load::Conditional'=> '0.34',
+ 'Module::Loaded' => '0.06',
+ 'Module::Pluggable' => '3.9',
+ 'Module::Pluggable::Object'=> '3.9',
+ 'Moped::Msg' => '0.01',
+ 'NDBM_File' => '1.08',
+ 'NEXT' => '0.64',
+ 'Net::Cmd' => '2.29',
+ 'Net::Config' => '1.11',
+ 'Net::Domain' => '2.20',
+ 'Net::FTP' => '2.77',
+ 'Net::FTP::A' => '1.18',
+ 'Net::FTP::E' => '0.01',
+ 'Net::FTP::I' => '1.12',
+ 'Net::FTP::L' => '0.01',
+ 'Net::FTP::dataconn' => '0.11',
+ 'Net::NNTP' => '2.24',
+ 'Net::Netrc' => '2.12',
+ 'Net::POP3' => '2.29',
+ 'Net::Ping' => '2.36',
+ 'Net::SMTP' => '2.31',
+ 'Net::Time' => '2.10',
+ 'Net::hostent' => '1.01',
+ 'Net::netent' => '1.00',
+ 'Net::protoent' => '1.00',
+ 'Net::servent' => '1.01',
+ 'O' => '1.01',
+ 'ODBM_File' => '1.07',
+ 'Object::Accessor' => '0.36',
+ 'Opcode' => '1.15',
+ 'POSIX' => '1.19',
+ 'Package::Constants' => '0.02',
+ 'Params::Check' => '0.26',
+ 'Parse::CPAN::Meta' => '1.40',
+ 'PerlIO' => '1.06',
+ 'PerlIO::encoding' => '0.12',
+ 'PerlIO::scalar' => '0.07',
+ 'PerlIO::via' => '0.09',
+ 'PerlIO::via::QuotedPrint'=> '0.06',
+ 'Pod::Checker' => '1.45',
+ 'Pod::Escapes' => '1.04',
+ 'Pod::Find' => '1.35',
+ 'Pod::Functions' => '1.03',
+ 'Pod::Html' => '1.09',
+ 'Pod::InputObjects' => '1.31',
+ 'Pod::LaTeX' => '0.58',
+ 'Pod::Man' => '2.22',
+ 'Pod::ParseLink' => '1.09',
+ 'Pod::ParseUtils' => '1.36',
+ 'Pod::Parser' => '1.37',
+ 'Pod::Perldoc' => '3.15_01',
+ 'Pod::Perldoc::BaseTo' => undef,
+ 'Pod::Perldoc::GetOptsOO'=> undef,
+ 'Pod::Perldoc::ToChecker'=> undef,
+ 'Pod::Perldoc::ToMan' => undef,
+ 'Pod::Perldoc::ToNroff' => undef,
+ 'Pod::Perldoc::ToPod' => undef,
+ 'Pod::Perldoc::ToRtf' => undef,
+ 'Pod::Perldoc::ToText' => undef,
+ 'Pod::Perldoc::ToTk' => undef,
+ 'Pod::Perldoc::ToXml' => undef,
+ 'Pod::PlainText' => '2.04',
+ 'Pod::Plainer' => '1.01',
+ 'Pod::Select' => '1.36',
+ 'Pod::Simple' => '3.13',
+ 'Pod::Simple::BlackBox' => '3.13',
+ 'Pod::Simple::Checker' => '3.13',
+ 'Pod::Simple::Debug' => '3.13',
+ 'Pod::Simple::DumpAsText'=> '3.13',
+ 'Pod::Simple::DumpAsXML'=> '3.13',
+ 'Pod::Simple::HTML' => '3.13',
+ 'Pod::Simple::HTMLBatch'=> '3.13',
+ 'Pod::Simple::HTMLLegacy'=> '5.01',
+ 'Pod::Simple::LinkSection'=> '3.13',
+ 'Pod::Simple::Methody' => '3.13',
+ 'Pod::Simple::Progress' => '3.13',
+ 'Pod::Simple::PullParser'=> '3.13',
+ 'Pod::Simple::PullParserEndToken'=> '3.13',
+ 'Pod::Simple::PullParserStartToken'=> '3.13',
+ 'Pod::Simple::PullParserTextToken'=> '3.13',
+ 'Pod::Simple::PullParserToken'=> '3.13',
+ 'Pod::Simple::RTF' => '3.13',
+ 'Pod::Simple::Search' => '3.13',
+ 'Pod::Simple::SimpleTree'=> '3.13',
+ 'Pod::Simple::Text' => '3.13',
+ 'Pod::Simple::TextContent'=> '3.13',
+ 'Pod::Simple::TiedOutFH'=> '3.13',
+ 'Pod::Simple::Transcode'=> '3.13',
+ 'Pod::Simple::TranscodeDumb'=> '3.13',
+ 'Pod::Simple::TranscodeSmart'=> '3.13',
+ 'Pod::Simple::XHTML' => '3.13',
+ 'Pod::Simple::XMLOutStream'=> '3.13',
+ 'Pod::Text' => '3.13',
+ 'Pod::Text::Color' => '2.05',
+ 'Pod::Text::Overstrike' => '2.03',
+ 'Pod::Text::Termcap' => '2.05',
+ 'Pod::Usage' => '1.36',
+ 'SDBM_File' => '1.06',
+ 'Safe' => '2.21',
+ 'Scalar::Util' => '1.22',
+ 'Scalar::Util::PP' => '1.22',
+ 'Search::Dict' => '1.02',
+ 'SelectSaver' => '1.02',
+ 'SelfLoader' => '1.17',
+ 'Shell' => '0.72_01',
+ 'Socket' => '1.85',
+ 'Storable' => '2.22',
+ 'Switch' => '2.16',
+ 'Symbol' => '1.07',
+ 'Sys::Hostname' => '1.11',
+ 'Sys::Syslog' => '0.27',
+ 'Sys::Syslog::win32::Win32'=> undef,
+ 'TAP::Base' => '3.17',
+ 'TAP::Formatter::Base' => '3.17',
+ 'TAP::Formatter::Color' => '3.17',
+ 'TAP::Formatter::Console'=> '3.17',
+ 'TAP::Formatter::Console::ParallelSession'=> '3.17',
+ 'TAP::Formatter::Console::Session'=> '3.17',
+ 'TAP::Formatter::File' => '3.17',
+ 'TAP::Formatter::File::Session'=> '3.17',
+ 'TAP::Formatter::Session'=> '3.17',
+ 'TAP::Harness' => '3.17',
+ 'TAP::Object' => '3.17',
+ 'TAP::Parser' => '3.17',
+ 'TAP::Parser::Aggregator'=> '3.17',
+ 'TAP::Parser::Grammar' => '3.17',
+ 'TAP::Parser::Iterator' => '3.17',
+ 'TAP::Parser::Iterator::Array'=> '3.17',
+ 'TAP::Parser::Iterator::Process'=> '3.17',
+ 'TAP::Parser::Iterator::Stream'=> '3.17',
+ 'TAP::Parser::IteratorFactory'=> '3.17',
+ 'TAP::Parser::Multiplexer'=> '3.17',
+ 'TAP::Parser::Result' => '3.17',
+ 'TAP::Parser::Result::Bailout'=> '3.17',
+ 'TAP::Parser::Result::Comment'=> '3.17',
+ 'TAP::Parser::Result::Plan'=> '3.17',
+ 'TAP::Parser::Result::Pragma'=> '3.17',
+ 'TAP::Parser::Result::Test'=> '3.17',
+ 'TAP::Parser::Result::Unknown'=> '3.17',
+ 'TAP::Parser::Result::Version'=> '3.17',
+ 'TAP::Parser::Result::YAML'=> '3.17',
+ 'TAP::Parser::ResultFactory'=> '3.17',
+ 'TAP::Parser::Scheduler'=> '3.17',
+ 'TAP::Parser::Scheduler::Job'=> '3.17',
+ 'TAP::Parser::Scheduler::Spinner'=> '3.17',
+ 'TAP::Parser::Source' => '3.17',
+ 'TAP::Parser::Source::Perl'=> '3.17',
+ 'TAP::Parser::Utils' => '3.17',
+ 'TAP::Parser::YAMLish::Reader'=> '3.17',
+ 'TAP::Parser::YAMLish::Writer'=> '3.17',
+ 'Term::ANSIColor' => '2.02',
+ 'Term::Cap' => '1.12',
+ 'Term::Complete' => '1.402',
+ 'Term::ReadLine' => '1.05',
+ 'Term::UI' => '0.20',
+ 'Term::UI::History' => undef,
+ 'Test' => '1.25_02',
+ 'Test::Builder' => '0.94',
+ 'Test::Builder::Module' => '0.94',
+ 'Test::Builder::Tester' => '1.18',
+ 'Test::Builder::Tester::Color'=> '1.18',
+ 'Test::Harness' => '3.17',
+ 'Test::More' => '0.94',
+ 'Test::Simple' => '0.94',
+ 'Text::Abbrev' => '1.01',
+ 'Text::Balanced' => '2.02',
+ 'Text::ParseWords' => '3.27',
+ 'Text::Soundex' => '3.03_01',
+ 'Text::Tabs' => '2009.0305',
+ 'Text::Wrap' => '2009.0305',
+ 'Thread' => '3.02',
+ 'Thread::Queue' => '2.11',
+ 'Thread::Semaphore' => '2.09',
+ 'Tie::Array' => '1.03',
+ 'Tie::File' => '0.97_02',
+ 'Tie::Handle' => '4.2',
+ 'Tie::Hash' => '1.03',
+ 'Tie::Hash::NamedCapture'=> '0.06',
+ 'Tie::Memoize' => '1.1',
+ 'Tie::RefHash' => '1.38',
+ 'Tie::Scalar' => '1.01',
+ 'Tie::StdHandle' => '4.2',
+ 'Tie::SubstrHash' => '1.00',
+ 'Time::HiRes' => '1.9719',
+ 'Time::Local' => '1.1901_01',
+ 'Time::Piece' => '1.15',
+ 'Time::Piece::Seconds' => undef,
+ 'Time::Seconds' => undef,
+ 'Time::gmtime' => '1.03',
+ 'Time::localtime' => '1.02',
+ 'Time::tm' => '1.00',
+ 'UNIVERSAL' => '1.06',
+ 'Unicode' => '5.2.0',
+ 'Unicode::Collate' => '0.52_01',
+ 'Unicode::Normalize' => '1.03',
+ 'Unicode::UCD' => '0.27',
+ 'User::grent' => '1.01',
+ 'User::pwent' => '1.00',
+ 'VMS::DCLsym' => '1.03',
+ 'VMS::Stdio' => '2.4',
+ 'Win32' => '0.39',
+ 'Win32API::File' => '0.1101',
+ 'Win32API::File::ExtUtils::Myconst2perl'=> '1',
+ 'Win32CORE' => '0.02',
+ 'XS::APItest' => '0.17',
+ 'XS::APItest::KeywordRPN'=> '0.003',
+ 'XS::Typemap' => '0.03',
+ 'XSLoader' => '0.10',
+ 'XSLoader::XSLoader' => '0.10',
+ 'attributes' => '0.12',
+ 'autodie' => '2.06_01',
+ 'autodie::exception' => '2.06_01',
+ 'autodie::exception::system'=> '2.06_01',
+ 'autodie::hints' => '2.06_01',
+ 'autouse' => '1.06',
+ 'base' => '2.15',
+ 'bigint' => '0.23',
+ 'bignum' => '0.23',
+ 'bigrat' => '0.23',
+ 'blib' => '1.04',
+ 'bytes' => '1.03',
+ 'charnames' => '1.07',
+ 'constant' => '1.20',
+ 'deprecate' => '0.01',
+ 'diagnostics' => '1.19',
+ 'encoding' => '2.6_01',
+ 'encoding::warnings' => '0.11',
+ 'feature' => '1.15',
+ 'fields' => '2.15',
+ 'filetest' => '1.02',
+ 'if' => '0.05',
+ 'inc::latest' => '0.3603',
+ 'integer' => '1.00',
+ 'less' => '0.03',
+ 'lib' => '0.62',
+ 'locale' => '1.00',
+ 'mro' => '1.02',
+ 'open' => '1.07',
+ 'ops' => '1.02',
+ 'overload' => '1.10',
+ 'overload::numbers' => undef,
+ 'overloading' => '0.01',
+ 'parent' => '0.223',
+ 're' => '0.11',
+ 'sigtrap' => '1.04',
+ 'sort' => '2.01',
+ 'strict' => '1.04',
+ 'subs' => '1.00',
+ 'threads' => '1.75',
+ 'threads::shared' => '1.32',
+ 'utf8' => '1.07',
+ 'vars' => '1.01',
+ 'version' => '0.81',
+ 'vmsish' => '1.02',
+ 'warnings' => '1.09',
+ 'warnings::register' => '1.01',
+ },
+ 5.011005 => {
+ 'AnyDBM_File' => '1.00',
+ 'App::Cpan' => '1.5701',
+ 'App::Prove' => '3.17',
+ 'App::Prove::State' => '3.17',
+ 'App::Prove::State::Result'=> '3.17',
+ 'App::Prove::State::Result::Test'=> '3.17',
+ 'Archive::Extract' => '0.38',
+ 'Archive::Tar' => '1.54',
+ 'Archive::Tar::Constant'=> '0.02',
+ 'Archive::Tar::File' => '0.02',
+ 'Attribute::Handlers' => '0.87',
+ 'AutoLoader' => '5.70',
+ 'AutoSplit' => '1.06',
+ 'B' => '1.23',
+ 'B::Concise' => '0.78',
+ 'B::Debug' => '1.12',
+ 'B::Deparse' => '0.94',
+ 'B::Lint' => '1.11_01',
+ 'B::Lint::Debug' => '0.01',
+ 'B::Showlex' => '1.02',
+ 'B::Terse' => '1.05',
+ 'B::Xref' => '1.02',
+ 'Benchmark' => '1.11',
+ 'CGI' => '3.48',
+ 'CGI::Apache' => '1.01',
+ 'CGI::Carp' => '3.45',
+ 'CGI::Cookie' => '1.29',
+ 'CGI::Fast' => '1.07',
+ 'CGI::Pretty' => '3.46',
+ 'CGI::Push' => '1.04',
+ 'CGI::Switch' => '1.01',
+ 'CGI::Util' => '3.48',
+ 'CPAN' => '1.94_56',
+ 'CPAN::Author' => '5.5',
+ 'CPAN::Bundle' => '5.5',
+ 'CPAN::CacheMgr' => '5.5',
+ 'CPAN::Complete' => '5.5',
+ 'CPAN::Debug' => '5.5001',
+ 'CPAN::DeferredCode' => '5.50',
+ 'CPAN::Distribution' => '1.9456',
+ 'CPAN::Distroprefs' => '6',
+ 'CPAN::Distrostatus' => '5.5',
+ 'CPAN::Exception::RecursiveDependency'=> '5.5',
+ 'CPAN::Exception::blocked_urllist'=> '1.0',
+ 'CPAN::Exception::yaml_not_installed'=> '5.5',
+ 'CPAN::FTP' => '5.5004',
+ 'CPAN::FTP::netrc' => '1.00',
+ 'CPAN::FirstTime' => '5.5301',
+ 'CPAN::HandleConfig' => '5.5001',
+ 'CPAN::Index' => '1.94',
+ 'CPAN::InfoObj' => '5.5',
+ 'CPAN::Kwalify' => '5.50',
+ 'CPAN::LWP::UserAgent' => '1.94',
+ 'CPAN::Mirrors' => '1.77',
+ 'CPAN::Module' => '5.5',
+ 'CPAN::Nox' => '5.50',
+ 'CPAN::Prompt' => '5.5',
+ 'CPAN::Queue' => '5.5',
+ 'CPAN::Shell' => '5.5001',
+ 'CPAN::Tarzip' => '5.5011',
+ 'CPAN::URL' => '5.5',
+ 'CPAN::Version' => '5.5',
+ 'CPANPLUS' => '0.90',
+ 'CPANPLUS::Backend' => undef,
+ 'CPANPLUS::Backend::RV' => undef,
+ 'CPANPLUS::Config' => undef,
+ 'CPANPLUS::Configure' => undef,
+ 'CPANPLUS::Configure::Setup'=> undef,
+ 'CPANPLUS::Dist' => undef,
+ 'CPANPLUS::Dist::Autobundle'=> undef,
+ 'CPANPLUS::Dist::Base' => undef,
+ 'CPANPLUS::Dist::Build' => '0.46',
+ 'CPANPLUS::Dist::Build::Constants'=> '0.46',
+ 'CPANPLUS::Dist::MM' => undef,
+ 'CPANPLUS::Dist::Sample'=> undef,
+ 'CPANPLUS::Error' => undef,
+ 'CPANPLUS::Internals' => '0.90',
+ 'CPANPLUS::Internals::Constants'=> undef,
+ 'CPANPLUS::Internals::Constants::Report'=> undef,
+ 'CPANPLUS::Internals::Extract'=> undef,
+ 'CPANPLUS::Internals::Fetch'=> undef,
+ 'CPANPLUS::Internals::Report'=> undef,
+ 'CPANPLUS::Internals::Search'=> undef,
+ 'CPANPLUS::Internals::Source'=> undef,
+ 'CPANPLUS::Internals::Source::Memory'=> undef,
+ 'CPANPLUS::Internals::Source::SQLite'=> undef,
+ 'CPANPLUS::Internals::Source::SQLite::Tie'=> undef,
+ 'CPANPLUS::Internals::Utils'=> undef,
+ 'CPANPLUS::Internals::Utils::Autoflush'=> undef,
+ 'CPANPLUS::Module' => undef,
+ 'CPANPLUS::Module::Author'=> undef,
+ 'CPANPLUS::Module::Author::Fake'=> undef,
+ 'CPANPLUS::Module::Checksums'=> undef,
+ 'CPANPLUS::Module::Fake'=> undef,
+ 'CPANPLUS::Module::Signature'=> undef,
+ 'CPANPLUS::Selfupdate' => undef,
+ 'CPANPLUS::Shell' => undef,
+ 'CPANPLUS::Shell::Classic'=> '0.0562',
+ 'CPANPLUS::Shell::Default'=> '0.90',
+ 'CPANPLUS::Shell::Default::Plugins::CustomSource'=> undef,
+ 'CPANPLUS::Shell::Default::Plugins::Remote'=> undef,
+ 'CPANPLUS::Shell::Default::Plugins::Source'=> undef,
+ 'Carp' => '1.15',
+ 'Carp::Heavy' => '1.15',
+ 'Class::ISA' => '0.36',
+ 'Class::Struct' => '0.63',
+ 'Compress::Raw::Bzip2' => '2.024',
+ 'Compress::Raw::Zlib' => '2.024',
+ 'Compress::Zlib' => '2.024',
+ 'Config' => undef,
+ 'Config::Extensions' => '0.01',
+ 'Cwd' => '3.31',
+ 'DB' => '1.02',
+ 'DBM_Filter' => '0.03',
+ 'DBM_Filter::compress' => '0.02',
+ 'DBM_Filter::encode' => '0.02',
+ 'DBM_Filter::int32' => '0.02',
+ 'DBM_Filter::null' => '0.02',
+ 'DBM_Filter::utf8' => '0.02',
+ 'DB_File' => '1.820',
+ 'Data::Dumper' => '2.125',
+ 'Devel::DProf' => '20080331.00',
+ 'Devel::DProf::V' => undef,
+ 'Devel::DProf::dprof::V'=> undef,
+ 'Devel::InnerPackage' => '0.3',
+ 'Devel::PPPort' => '3.19',
+ 'Devel::Peek' => '1.04',
+ 'Devel::SelfStubber' => '1.03',
+ 'Digest' => '1.16',
+ 'Digest::MD5' => '2.39',
+ 'Digest::SHA' => '5.47',
+ 'Digest::base' => '1.16',
+ 'Digest::file' => '1.16',
+ 'DirHandle' => '1.03',
+ 'Dumpvalue' => '1.13',
+ 'DynaLoader' => '1.10',
+ 'Encode' => '2.39',
+ 'Encode::Alias' => '2.12',
+ 'Encode::Byte' => '2.04',
+ 'Encode::CJKConstants' => '2.02',
+ 'Encode::CN' => '2.03',
+ 'Encode::CN::HZ' => '2.05',
+ 'Encode::Config' => '2.05',
+ 'Encode::EBCDIC' => '2.02',
+ 'Encode::Encoder' => '2.01',
+ 'Encode::Encoding' => '2.05',
+ 'Encode::GSM0338' => '2.01',
+ 'Encode::Guess' => '2.03',
+ 'Encode::JP' => '2.04',
+ 'Encode::JP::H2Z' => '2.02',
+ 'Encode::JP::JIS7' => '2.04',
+ 'Encode::KR' => '2.03',
+ 'Encode::KR::2022_KR' => '2.02',
+ 'Encode::MIME::Header' => '2.11',
+ 'Encode::MIME::Header::ISO_2022_JP'=> '1.03',
+ 'Encode::MIME::Name' => '1.01',
+ 'Encode::Symbol' => '2.02',
+ 'Encode::TW' => '2.03',
+ 'Encode::Unicode' => '2.07',
+ 'Encode::Unicode::UTF7' => '2.04',
+ 'English' => '1.04',
+ 'Env' => '1.01',
+ 'Errno' => '1.11',
+ 'Exporter' => '5.64_01',
+ 'Exporter::Heavy' => '5.64_01',
+ 'ExtUtils::CBuilder' => '0.27',
+ 'ExtUtils::CBuilder::Base'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::Unix'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::VMS'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::Windows'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::Windows::BCC'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::Windows::GCC'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::Windows::MSVC'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::aix'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::cygwin'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::darwin'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::dec_osf'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::os2'=> '0.27',
+ 'ExtUtils::Command' => '1.16',
+ 'ExtUtils::Command::MM' => '6.56',
+ 'ExtUtils::Constant' => '0.22',
+ 'ExtUtils::Constant::Base'=> '0.04',
+ 'ExtUtils::Constant::ProxySubs'=> '0.06',
+ 'ExtUtils::Constant::Utils'=> '0.02',
+ 'ExtUtils::Constant::XS'=> '0.03',
+ 'ExtUtils::Embed' => '1.28',
+ 'ExtUtils::Install' => '1.55',
+ 'ExtUtils::Installed' => '1.999_001',
+ 'ExtUtils::Liblist' => '6.56',
+ 'ExtUtils::Liblist::Kid'=> '6.56',
+ 'ExtUtils::MM' => '6.56',
+ 'ExtUtils::MM_AIX' => '6.56',
+ 'ExtUtils::MM_Any' => '6.56',
+ 'ExtUtils::MM_BeOS' => '6.56',
+ 'ExtUtils::MM_Cygwin' => '6.56',
+ 'ExtUtils::MM_DOS' => '6.56',
+ 'ExtUtils::MM_Darwin' => '6.56',
+ 'ExtUtils::MM_MacOS' => '6.56',
+ 'ExtUtils::MM_NW5' => '6.56',
+ 'ExtUtils::MM_OS2' => '6.56',
+ 'ExtUtils::MM_QNX' => '6.56',
+ 'ExtUtils::MM_UWIN' => '6.56',
+ 'ExtUtils::MM_Unix' => '6.56',
+ 'ExtUtils::MM_VMS' => '6.56',
+ 'ExtUtils::MM_VOS' => '6.56',
+ 'ExtUtils::MM_Win32' => '6.56',
+ 'ExtUtils::MM_Win95' => '6.56',
+ 'ExtUtils::MY' => '6.56',
+ 'ExtUtils::MakeMaker' => '6.56',
+ 'ExtUtils::MakeMaker::Config'=> '6.56',
+ 'ExtUtils::Manifest' => '1.57',
+ 'ExtUtils::Miniperl' => undef,
+ 'ExtUtils::Mkbootstrap' => '6.56',
+ 'ExtUtils::Mksymlists' => '6.56',
+ 'ExtUtils::Packlist' => '1.44',
+ 'ExtUtils::ParseXS' => '2.21',
+ 'ExtUtils::XSSymSet' => '1.1',
+ 'ExtUtils::testlib' => '6.56',
+ 'Fatal' => '2.06_01',
+ 'Fcntl' => '1.06',
+ 'File::Basename' => '2.78',
+ 'File::CheckTree' => '4.4',
+ 'File::Compare' => '1.1006',
+ 'File::Copy' => '2.17',
+ 'File::DosGlob' => '1.01',
+ 'File::Fetch' => '0.24',
+ 'File::Find' => '1.15',
+ 'File::Glob' => '1.07',
+ 'File::GlobMapper' => '1.000',
+ 'File::Path' => '2.08_01',
+ 'File::Spec' => '3.31',
+ 'File::Spec::Cygwin' => '3.30',
+ 'File::Spec::Epoc' => '3.30',
+ 'File::Spec::Functions' => '3.30',
+ 'File::Spec::Mac' => '3.30',
+ 'File::Spec::OS2' => '3.30',
+ 'File::Spec::Unix' => '3.30',
+ 'File::Spec::VMS' => '3.30',
+ 'File::Spec::Win32' => '3.30',
+ 'File::Temp' => '0.22',
+ 'File::stat' => '1.02',
+ 'FileCache' => '1.08',
+ 'FileHandle' => '2.02',
+ 'Filespec' => '1.12',
+ 'Filter::Simple' => '0.84',
+ 'Filter::Util::Call' => '1.08',
+ 'FindBin' => '1.50',
+ 'GDBM_File' => '1.10',
+ 'Getopt::Long' => '2.38',
+ 'Getopt::Std' => '1.06',
+ 'Hash::Util' => '0.07',
+ 'Hash::Util::FieldHash' => '1.04',
+ 'I18N::Collate' => '1.01',
+ 'I18N::LangTags' => '0.35',
+ 'I18N::LangTags::Detect'=> '1.04',
+ 'I18N::LangTags::List' => '0.35',
+ 'I18N::Langinfo' => '0.03',
+ 'IO' => '1.25_02',
+ 'IO::Compress::Adapter::Bzip2'=> '2.024',
+ 'IO::Compress::Adapter::Deflate'=> '2.024',
+ 'IO::Compress::Adapter::Identity'=> '2.024',
+ 'IO::Compress::Base' => '2.024',
+ 'IO::Compress::Base::Common'=> '2.024',
+ 'IO::Compress::Bzip2' => '2.024',
+ 'IO::Compress::Deflate' => '2.024',
+ 'IO::Compress::Gzip' => '2.024',
+ 'IO::Compress::Gzip::Constants'=> '2.024',
+ 'IO::Compress::RawDeflate'=> '2.024',
+ 'IO::Compress::Zip' => '2.024',
+ 'IO::Compress::Zip::Constants'=> '2.024',
+ 'IO::Compress::Zlib::Constants'=> '2.024',
+ 'IO::Compress::Zlib::Extra'=> '2.024',
+ 'IO::Dir' => '1.07',
+ 'IO::File' => '1.14',
+ 'IO::Handle' => '1.28',
+ 'IO::Pipe' => '1.13',
+ 'IO::Poll' => '0.07',
+ 'IO::Seekable' => '1.10',
+ 'IO::Select' => '1.17',
+ 'IO::Socket' => '1.31',
+ 'IO::Socket::INET' => '1.31',
+ 'IO::Socket::UNIX' => '1.23',
+ 'IO::Uncompress::Adapter::Bunzip2'=> '2.024',
+ 'IO::Uncompress::Adapter::Identity'=> '2.024',
+ 'IO::Uncompress::Adapter::Inflate'=> '2.024',
+ 'IO::Uncompress::AnyInflate'=> '2.024',
+ 'IO::Uncompress::AnyUncompress'=> '2.024',
+ 'IO::Uncompress::Base' => '2.024',
+ 'IO::Uncompress::Bunzip2'=> '2.024',
+ 'IO::Uncompress::Gunzip'=> '2.024',
+ 'IO::Uncompress::Inflate'=> '2.024',
+ 'IO::Uncompress::RawInflate'=> '2.024',
+ 'IO::Uncompress::Unzip' => '2.024',
+ 'IO::Zlib' => '1.10',
+ 'IPC::Cmd' => '0.54',
+ 'IPC::Msg' => '2.01',
+ 'IPC::Open2' => '1.03',
+ 'IPC::Open3' => '1.05',
+ 'IPC::Semaphore' => '2.01',
+ 'IPC::SharedMem' => '2.01',
+ 'IPC::SysV' => '2.01',
+ 'List::Util' => '1.22',
+ 'List::Util::PP' => '1.22',
+ 'List::Util::XS' => '1.22',
+ 'Locale::Constants' => '2.07',
+ 'Locale::Country' => '2.07',
+ 'Locale::Currency' => '2.07',
+ 'Locale::Language' => '2.07',
+ 'Locale::Maketext' => '1.14',
+ 'Locale::Maketext::Guts'=> '1.13',
+ 'Locale::Maketext::GutsLoader'=> '1.13',
+ 'Locale::Maketext::Simple'=> '0.21',
+ 'Locale::Script' => '2.07',
+ 'Log::Message' => '0.02',
+ 'Log::Message::Config' => '0.01',
+ 'Log::Message::Handlers'=> undef,
+ 'Log::Message::Item' => undef,
+ 'Log::Message::Simple' => '0.06',
+ 'MIME::Base64' => '3.08',
+ 'MIME::QuotedPrint' => '3.08',
+ 'Math::BigFloat' => '1.60',
+ 'Math::BigFloat::Trace' => '0.01',
+ 'Math::BigInt' => '1.89_01',
+ 'Math::BigInt::Calc' => '0.52',
+ 'Math::BigInt::CalcEmu' => '0.05',
+ 'Math::BigInt::FastCalc'=> '0.19',
+ 'Math::BigInt::Trace' => '0.01',
+ 'Math::BigRat' => '0.24',
+ 'Math::Complex' => '1.56',
+ 'Math::Trig' => '1.2',
+ 'Memoize' => '1.01_03',
+ 'Memoize::AnyDBM_File' => '0.65',
+ 'Memoize::Expire' => '1.00',
+ 'Memoize::ExpireFile' => '1.01',
+ 'Memoize::ExpireTest' => '0.65',
+ 'Memoize::NDBM_File' => '0.65',
+ 'Memoize::SDBM_File' => '0.65',
+ 'Memoize::Storable' => '0.65',
+ 'Module::Build' => '0.3603',
+ 'Module::Build::Base' => '0.3603',
+ 'Module::Build::Compat' => '0.3603',
+ 'Module::Build::Config' => '0.3603',
+ 'Module::Build::ConfigData'=> undef,
+ 'Module::Build::Cookbook'=> '0.3603',
+ 'Module::Build::Dumper' => '0.3603',
+ 'Module::Build::ModuleInfo'=> '0.3603',
+ 'Module::Build::Notes' => '0.3603',
+ 'Module::Build::PPMMaker'=> '0.3603',
+ 'Module::Build::Platform::Amiga'=> '0.3603',
+ 'Module::Build::Platform::Default'=> '0.3603',
+ 'Module::Build::Platform::EBCDIC'=> '0.3603',
+ 'Module::Build::Platform::MPEiX'=> '0.3603',
+ 'Module::Build::Platform::MacOS'=> '0.3603',
+ 'Module::Build::Platform::RiscOS'=> '0.3603',
+ 'Module::Build::Platform::Unix'=> '0.3603',
+ 'Module::Build::Platform::VMS'=> '0.3603',
+ 'Module::Build::Platform::VOS'=> '0.3603',
+ 'Module::Build::Platform::Windows'=> '0.3603',
+ 'Module::Build::Platform::aix'=> '0.3603',
+ 'Module::Build::Platform::cygwin'=> '0.3603',
+ 'Module::Build::Platform::darwin'=> '0.3603',
+ 'Module::Build::Platform::os2'=> '0.3603',
+ 'Module::Build::PodParser'=> '0.3603',
+ 'Module::Build::Version'=> '0.77',
+ 'Module::Build::YAML' => '1.40',
+ 'Module::CoreList' => '2.26',
+ 'Module::Load' => '0.16',
+ 'Module::Load::Conditional'=> '0.34',
+ 'Module::Loaded' => '0.06',
+ 'Module::Pluggable' => '3.9',
+ 'Module::Pluggable::Object'=> '3.9',
+ 'Moped::Msg' => '0.01',
+ 'NDBM_File' => '1.08',
+ 'NEXT' => '0.64',
+ 'Net::Cmd' => '2.29',
+ 'Net::Config' => '1.11',
+ 'Net::Domain' => '2.20',
+ 'Net::FTP' => '2.77',
+ 'Net::FTP::A' => '1.18',
+ 'Net::FTP::E' => '0.01',
+ 'Net::FTP::I' => '1.12',
+ 'Net::FTP::L' => '0.01',
+ 'Net::FTP::dataconn' => '0.11',
+ 'Net::NNTP' => '2.24',
+ 'Net::Netrc' => '2.12',
+ 'Net::POP3' => '2.29',
+ 'Net::Ping' => '2.36',
+ 'Net::SMTP' => '2.31',
+ 'Net::Time' => '2.10',
+ 'Net::hostent' => '1.01',
+ 'Net::netent' => '1.00',
+ 'Net::protoent' => '1.00',
+ 'Net::servent' => '1.01',
+ 'O' => '1.01',
+ 'ODBM_File' => '1.07',
+ 'Object::Accessor' => '0.36',
+ 'Opcode' => '1.15',
+ 'POSIX' => '1.19',
+ 'Package::Constants' => '0.02',
+ 'Params::Check' => '0.26',
+ 'Parse::CPAN::Meta' => '1.40',
+ 'PerlIO' => '1.06',
+ 'PerlIO::encoding' => '0.12',
+ 'PerlIO::scalar' => '0.07',
+ 'PerlIO::via' => '0.09',
+ 'PerlIO::via::QuotedPrint'=> '0.06',
+ 'Pod::Checker' => '1.45',
+ 'Pod::Escapes' => '1.04',
+ 'Pod::Find' => '1.35',
+ 'Pod::Functions' => '1.03',
+ 'Pod::Html' => '1.09',
+ 'Pod::InputObjects' => '1.31',
+ 'Pod::LaTeX' => '0.58',
+ 'Pod::Man' => '2.23',
+ 'Pod::ParseLink' => '1.10',
+ 'Pod::ParseUtils' => '1.36',
+ 'Pod::Parser' => '1.37',
+ 'Pod::Perldoc' => '3.15_02',
+ 'Pod::Perldoc::BaseTo' => undef,
+ 'Pod::Perldoc::GetOptsOO'=> undef,
+ 'Pod::Perldoc::ToChecker'=> undef,
+ 'Pod::Perldoc::ToMan' => undef,
+ 'Pod::Perldoc::ToNroff' => undef,
+ 'Pod::Perldoc::ToPod' => undef,
+ 'Pod::Perldoc::ToRtf' => undef,
+ 'Pod::Perldoc::ToText' => undef,
+ 'Pod::Perldoc::ToTk' => undef,
+ 'Pod::Perldoc::ToXml' => undef,
+ 'Pod::PlainText' => '2.04',
+ 'Pod::Plainer' => '1.02',
+ 'Pod::Select' => '1.36',
+ 'Pod::Simple' => '3.13',
+ 'Pod::Simple::BlackBox' => '3.13',
+ 'Pod::Simple::Checker' => '3.13',
+ 'Pod::Simple::Debug' => '3.13',
+ 'Pod::Simple::DumpAsText'=> '3.13',
+ 'Pod::Simple::DumpAsXML'=> '3.13',
+ 'Pod::Simple::HTML' => '3.13',
+ 'Pod::Simple::HTMLBatch'=> '3.13',
+ 'Pod::Simple::HTMLLegacy'=> '5.01',
+ 'Pod::Simple::LinkSection'=> '3.13',
+ 'Pod::Simple::Methody' => '3.13',
+ 'Pod::Simple::Progress' => '3.13',
+ 'Pod::Simple::PullParser'=> '3.13',
+ 'Pod::Simple::PullParserEndToken'=> '3.13',
+ 'Pod::Simple::PullParserStartToken'=> '3.13',
+ 'Pod::Simple::PullParserTextToken'=> '3.13',
+ 'Pod::Simple::PullParserToken'=> '3.13',
+ 'Pod::Simple::RTF' => '3.13',
+ 'Pod::Simple::Search' => '3.13',
+ 'Pod::Simple::SimpleTree'=> '3.13',
+ 'Pod::Simple::Text' => '3.13',
+ 'Pod::Simple::TextContent'=> '3.13',
+ 'Pod::Simple::TiedOutFH'=> '3.13',
+ 'Pod::Simple::Transcode'=> '3.13',
+ 'Pod::Simple::TranscodeDumb'=> '3.13',
+ 'Pod::Simple::TranscodeSmart'=> '3.13',
+ 'Pod::Simple::XHTML' => '3.13',
+ 'Pod::Simple::XMLOutStream'=> '3.13',
+ 'Pod::Text' => '3.14',
+ 'Pod::Text::Color' => '2.06',
+ 'Pod::Text::Overstrike' => '2.04',
+ 'Pod::Text::Termcap' => '2.06',
+ 'Pod::Usage' => '1.36',
+ 'SDBM_File' => '1.06',
+ 'Safe' => '2.22',
+ 'Scalar::Util' => '1.22',
+ 'Scalar::Util::PP' => '1.22',
+ 'Search::Dict' => '1.02',
+ 'SelectSaver' => '1.02',
+ 'SelfLoader' => '1.17',
+ 'Shell' => '0.72_01',
+ 'Socket' => '1.86',
+ 'Storable' => '2.22',
+ 'Switch' => '2.16',
+ 'Symbol' => '1.07',
+ 'Sys::Hostname' => '1.11',
+ 'Sys::Syslog' => '0.27',
+ 'Sys::Syslog::win32::Win32'=> undef,
+ 'TAP::Base' => '3.17',
+ 'TAP::Formatter::Base' => '3.17',
+ 'TAP::Formatter::Color' => '3.17',
+ 'TAP::Formatter::Console'=> '3.17',
+ 'TAP::Formatter::Console::ParallelSession'=> '3.17',
+ 'TAP::Formatter::Console::Session'=> '3.17',
+ 'TAP::Formatter::File' => '3.17',
+ 'TAP::Formatter::File::Session'=> '3.17',
+ 'TAP::Formatter::Session'=> '3.17',
+ 'TAP::Harness' => '3.17',
+ 'TAP::Object' => '3.17',
+ 'TAP::Parser' => '3.17',
+ 'TAP::Parser::Aggregator'=> '3.17',
+ 'TAP::Parser::Grammar' => '3.17',
+ 'TAP::Parser::Iterator' => '3.17',
+ 'TAP::Parser::Iterator::Array'=> '3.17',
+ 'TAP::Parser::Iterator::Process'=> '3.17',
+ 'TAP::Parser::Iterator::Stream'=> '3.17',
+ 'TAP::Parser::IteratorFactory'=> '3.17',
+ 'TAP::Parser::Multiplexer'=> '3.17',
+ 'TAP::Parser::Result' => '3.17',
+ 'TAP::Parser::Result::Bailout'=> '3.17',
+ 'TAP::Parser::Result::Comment'=> '3.17',
+ 'TAP::Parser::Result::Plan'=> '3.17',
+ 'TAP::Parser::Result::Pragma'=> '3.17',
+ 'TAP::Parser::Result::Test'=> '3.17',
+ 'TAP::Parser::Result::Unknown'=> '3.17',
+ 'TAP::Parser::Result::Version'=> '3.17',
+ 'TAP::Parser::Result::YAML'=> '3.17',
+ 'TAP::Parser::ResultFactory'=> '3.17',
+ 'TAP::Parser::Scheduler'=> '3.17',
+ 'TAP::Parser::Scheduler::Job'=> '3.17',
+ 'TAP::Parser::Scheduler::Spinner'=> '3.17',
+ 'TAP::Parser::Source' => '3.17',
+ 'TAP::Parser::Source::Perl'=> '3.17',
+ 'TAP::Parser::Utils' => '3.17',
+ 'TAP::Parser::YAMLish::Reader'=> '3.17',
+ 'TAP::Parser::YAMLish::Writer'=> '3.17',
+ 'Term::ANSIColor' => '2.02',
+ 'Term::Cap' => '1.12',
+ 'Term::Complete' => '1.402',
+ 'Term::ReadLine' => '1.05',
+ 'Term::UI' => '0.20',
+ 'Term::UI::History' => undef,
+ 'Test' => '1.25_02',
+ 'Test::Builder' => '0.94',
+ 'Test::Builder::Module' => '0.94',
+ 'Test::Builder::Tester' => '1.18',
+ 'Test::Builder::Tester::Color'=> '1.18',
+ 'Test::Harness' => '3.17',
+ 'Test::More' => '0.94',
+ 'Test::Simple' => '0.94',
+ 'Text::Abbrev' => '1.01',
+ 'Text::Balanced' => '2.02',
+ 'Text::ParseWords' => '3.27',
+ 'Text::Soundex' => '3.03_01',
+ 'Text::Tabs' => '2009.0305',
+ 'Text::Wrap' => '2009.0305',
+ 'Thread' => '3.02',
+ 'Thread::Queue' => '2.11',
+ 'Thread::Semaphore' => '2.09',
+ 'Tie::Array' => '1.03',
+ 'Tie::File' => '0.97_02',
+ 'Tie::Handle' => '4.2',
+ 'Tie::Hash' => '1.03',
+ 'Tie::Hash::NamedCapture'=> '0.06',
+ 'Tie::Memoize' => '1.1',
+ 'Tie::RefHash' => '1.38',
+ 'Tie::Scalar' => '1.01',
+ 'Tie::StdHandle' => '4.2',
+ 'Tie::SubstrHash' => '1.00',
+ 'Time::HiRes' => '1.9719',
+ 'Time::Local' => '1.1901_01',
+ 'Time::Piece' => '1.15',
+ 'Time::Piece::Seconds' => undef,
+ 'Time::Seconds' => undef,
+ 'Time::gmtime' => '1.03',
+ 'Time::localtime' => '1.02',
+ 'Time::tm' => '1.00',
+ 'UNIVERSAL' => '1.06',
+ 'Unicode' => '5.2.0',
+ 'Unicode::Collate' => '0.52_01',
+ 'Unicode::Normalize' => '1.03',
+ 'Unicode::UCD' => '0.27',
+ 'User::grent' => '1.01',
+ 'User::pwent' => '1.00',
+ 'VMS::DCLsym' => '1.03',
+ 'VMS::Stdio' => '2.4',
+ 'Win32' => '0.39',
+ 'Win32API::File' => '0.1101',
+ 'Win32API::File::ExtUtils::Myconst2perl'=> '1',
+ 'Win32CORE' => '0.02',
+ 'XS::APItest' => '0.17',
+ 'XS::APItest::KeywordRPN'=> '0.003',
+ 'XS::Typemap' => '0.03',
+ 'XSLoader' => '0.10',
+ 'XSLoader::XSLoader' => '0.10',
+ 'attributes' => '0.12',
+ 'autodie' => '2.06_01',
+ 'autodie::exception' => '2.06_01',
+ 'autodie::exception::system'=> '2.06_01',
+ 'autodie::hints' => '2.06_01',
+ 'autouse' => '1.06',
+ 'base' => '2.15',
+ 'bigint' => '0.23',
+ 'bignum' => '0.23',
+ 'bigrat' => '0.23',
+ 'blib' => '1.04',
+ 'bytes' => '1.03',
+ 'charnames' => '1.07',
+ 'constant' => '1.20',
+ 'deprecate' => '0.01',
+ 'diagnostics' => '1.19',
+ 'encoding' => '2.6_01',
+ 'encoding::warnings' => '0.11',
+ 'feature' => '1.15',
+ 'fields' => '2.15',
+ 'filetest' => '1.02',
+ 'if' => '0.05',
+ 'inc::latest' => '0.3603',
+ 'integer' => '1.00',
+ 'less' => '0.03',
+ 'lib' => '0.62',
+ 'locale' => '1.00',
+ 'mro' => '1.02',
+ 'open' => '1.07',
+ 'ops' => '1.02',
+ 'overload' => '1.10',
+ 'overload::numbers' => undef,
+ 'overloading' => '0.01',
+ 'parent' => '0.223',
+ 're' => '0.11',
+ 'sigtrap' => '1.04',
+ 'sort' => '2.01',
+ 'strict' => '1.04',
+ 'subs' => '1.00',
+ 'threads' => '1.75',
+ 'threads::shared' => '1.32',
+ 'utf8' => '1.07',
+ 'vars' => '1.01',
+ 'version' => '0.82',
+ 'vmsish' => '1.02',
+ 'warnings' => '1.09',
+ 'warnings::register' => '1.01',
+ },
+ 5.012000 => {
+ 'AnyDBM_File' => '1.00',
+ 'App::Cpan' => '1.5701',
+ 'App::Prove' => '3.17',
+ 'App::Prove::State' => '3.17',
+ 'App::Prove::State::Result'=> '3.17',
+ 'App::Prove::State::Result::Test'=> '3.17',
+ 'Archive::Extract' => '0.38',
+ 'Archive::Tar' => '1.54',
+ 'Archive::Tar::Constant'=> '0.02',
+ 'Archive::Tar::File' => '0.02',
+ 'Attribute::Handlers' => '0.87',
+ 'AutoLoader' => '5.70',
+ 'AutoSplit' => '1.06',
+ 'B' => '1.23',
+ 'B::Concise' => '0.78',
+ 'B::Debug' => '1.12',
+ 'B::Deparse' => '0.96',
+ 'B::Lint' => '1.11_01',
+ 'B::Lint::Debug' => '0.01',
+ 'B::Showlex' => '1.02',
+ 'B::Terse' => '1.05',
+ 'B::Xref' => '1.02',
+ 'Benchmark' => '1.11',
+ 'CGI' => '3.48',
+ 'CGI::Apache' => '1.01',
+ 'CGI::Carp' => '3.45',
+ 'CGI::Cookie' => '1.29',
+ 'CGI::Fast' => '1.07',
+ 'CGI::Pretty' => '3.46',
+ 'CGI::Push' => '1.04',
+ 'CGI::Switch' => '1.01',
+ 'CGI::Util' => '3.48',
+ 'CPAN' => '1.94_56',
+ 'CPAN::Author' => '5.5',
+ 'CPAN::Bundle' => '5.5',
+ 'CPAN::CacheMgr' => '5.5',
+ 'CPAN::Complete' => '5.5',
+ 'CPAN::Debug' => '5.5001',
+ 'CPAN::DeferredCode' => '5.50',
+ 'CPAN::Distribution' => '1.9456_01',
+ 'CPAN::Distroprefs' => '6',
+ 'CPAN::Distrostatus' => '5.5',
+ 'CPAN::Exception::RecursiveDependency'=> '5.5',
+ 'CPAN::Exception::blocked_urllist'=> '1.0',
+ 'CPAN::Exception::yaml_not_installed'=> '5.5',
+ 'CPAN::FTP' => '5.5004',
+ 'CPAN::FTP::netrc' => '1.00',
+ 'CPAN::FirstTime' => '5.5301',
+ 'CPAN::HandleConfig' => '5.5001',
+ 'CPAN::Index' => '1.94',
+ 'CPAN::InfoObj' => '5.5',
+ 'CPAN::Kwalify' => '5.50',
+ 'CPAN::LWP::UserAgent' => '1.94',
+ 'CPAN::Mirrors' => '1.77',
+ 'CPAN::Module' => '5.5',
+ 'CPAN::Nox' => '5.50',
+ 'CPAN::Prompt' => '5.5',
+ 'CPAN::Queue' => '5.5',
+ 'CPAN::Shell' => '5.5001',
+ 'CPAN::Tarzip' => '5.5011',
+ 'CPAN::URL' => '5.5',
+ 'CPAN::Version' => '5.5',
+ 'CPANPLUS' => '0.90',
+ 'CPANPLUS::Backend' => undef,
+ 'CPANPLUS::Backend::RV' => undef,
+ 'CPANPLUS::Config' => undef,
+ 'CPANPLUS::Configure' => undef,
+ 'CPANPLUS::Configure::Setup'=> undef,
+ 'CPANPLUS::Dist' => undef,
+ 'CPANPLUS::Dist::Autobundle'=> undef,
+ 'CPANPLUS::Dist::Base' => undef,
+ 'CPANPLUS::Dist::Build' => '0.46',
+ 'CPANPLUS::Dist::Build::Constants'=> '0.46',
+ 'CPANPLUS::Dist::MM' => undef,
+ 'CPANPLUS::Dist::Sample'=> undef,
+ 'CPANPLUS::Error' => undef,
+ 'CPANPLUS::Internals' => '0.90',
+ 'CPANPLUS::Internals::Constants'=> undef,
+ 'CPANPLUS::Internals::Constants::Report'=> undef,
+ 'CPANPLUS::Internals::Extract'=> undef,
+ 'CPANPLUS::Internals::Fetch'=> undef,
+ 'CPANPLUS::Internals::Report'=> undef,
+ 'CPANPLUS::Internals::Search'=> undef,
+ 'CPANPLUS::Internals::Source'=> undef,
+ 'CPANPLUS::Internals::Source::Memory'=> undef,
+ 'CPANPLUS::Internals::Source::SQLite'=> undef,
+ 'CPANPLUS::Internals::Source::SQLite::Tie'=> undef,
+ 'CPANPLUS::Internals::Utils'=> undef,
+ 'CPANPLUS::Internals::Utils::Autoflush'=> undef,
+ 'CPANPLUS::Module' => undef,
+ 'CPANPLUS::Module::Author'=> undef,
+ 'CPANPLUS::Module::Author::Fake'=> undef,
+ 'CPANPLUS::Module::Checksums'=> undef,
+ 'CPANPLUS::Module::Fake'=> undef,
+ 'CPANPLUS::Module::Signature'=> undef,
+ 'CPANPLUS::Selfupdate' => undef,
+ 'CPANPLUS::Shell' => undef,
+ 'CPANPLUS::Shell::Classic'=> '0.0562',
+ 'CPANPLUS::Shell::Default'=> '0.90',
+ 'CPANPLUS::Shell::Default::Plugins::CustomSource'=> undef,
+ 'CPANPLUS::Shell::Default::Plugins::Remote'=> undef,
+ 'CPANPLUS::Shell::Default::Plugins::Source'=> undef,
+ 'Carp' => '1.15',
+ 'Carp::Heavy' => '1.15',
+ 'Class::ISA' => '0.36',
+ 'Class::Struct' => '0.63',
+ 'Compress::Raw::Bzip2' => '2.024',
+ 'Compress::Raw::Zlib' => '2.024',
+ 'Compress::Zlib' => '2.024',
+ 'Config' => undef,
+ 'Config::Extensions' => '0.01',
+ 'Cwd' => '3.31',
+ 'DB' => '1.02',
+ 'DBM_Filter' => '0.03',
+ 'DBM_Filter::compress' => '0.02',
+ 'DBM_Filter::encode' => '0.02',
+ 'DBM_Filter::int32' => '0.02',
+ 'DBM_Filter::null' => '0.02',
+ 'DBM_Filter::utf8' => '0.02',
+ 'DB_File' => '1.820',
+ 'Data::Dumper' => '2.125',
+ 'Devel::DProf' => '20080331.00',
+ 'Devel::DProf::dprof::V'=> undef,
+ 'Devel::InnerPackage' => '0.3',
+ 'Devel::PPPort' => '3.19',
+ 'Devel::Peek' => '1.04',
+ 'Devel::SelfStubber' => '1.03',
+ 'Digest' => '1.16',
+ 'Digest::MD5' => '2.39',
+ 'Digest::SHA' => '5.47',
+ 'Digest::base' => '1.16',
+ 'Digest::file' => '1.16',
+ 'DirHandle' => '1.03',
+ 'Dumpvalue' => '1.13',
+ 'DynaLoader' => '1.10',
+ 'Encode' => '2.39',
+ 'Encode::Alias' => '2.12',
+ 'Encode::Byte' => '2.04',
+ 'Encode::CJKConstants' => '2.02',
+ 'Encode::CN' => '2.03',
+ 'Encode::CN::HZ' => '2.05',
+ 'Encode::Config' => '2.05',
+ 'Encode::EBCDIC' => '2.02',
+ 'Encode::Encoder' => '2.01',
+ 'Encode::Encoding' => '2.05',
+ 'Encode::GSM0338' => '2.01',
+ 'Encode::Guess' => '2.03',
+ 'Encode::JP' => '2.04',
+ 'Encode::JP::H2Z' => '2.02',
+ 'Encode::JP::JIS7' => '2.04',
+ 'Encode::KR' => '2.03',
+ 'Encode::KR::2022_KR' => '2.02',
+ 'Encode::MIME::Header' => '2.11',
+ 'Encode::MIME::Header::ISO_2022_JP'=> '1.03',
+ 'Encode::MIME::Name' => '1.01',
+ 'Encode::Symbol' => '2.02',
+ 'Encode::TW' => '2.03',
+ 'Encode::Unicode' => '2.07',
+ 'Encode::Unicode::UTF7' => '2.04',
+ 'English' => '1.04',
+ 'Env' => '1.01',
+ 'Errno' => '1.11',
+ 'Exporter' => '5.64_01',
+ 'Exporter::Heavy' => '5.64_01',
+ 'ExtUtils::CBuilder' => '0.27',
+ 'ExtUtils::CBuilder::Base'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::Unix'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::VMS'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::Windows'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::Windows::BCC'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::Windows::GCC'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::Windows::MSVC'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::aix'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::cygwin'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::darwin'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::dec_osf'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::os2'=> '0.27',
+ 'ExtUtils::Command' => '1.16',
+ 'ExtUtils::Command::MM' => '6.56',
+ 'ExtUtils::Constant' => '0.22',
+ 'ExtUtils::Constant::Base'=> '0.04',
+ 'ExtUtils::Constant::ProxySubs'=> '0.06',
+ 'ExtUtils::Constant::Utils'=> '0.02',
+ 'ExtUtils::Constant::XS'=> '0.03',
+ 'ExtUtils::Embed' => '1.28',
+ 'ExtUtils::Install' => '1.55',
+ 'ExtUtils::Installed' => '1.999_001',
+ 'ExtUtils::Liblist' => '6.56',
+ 'ExtUtils::Liblist::Kid'=> '6.56',
+ 'ExtUtils::MM' => '6.56',
+ 'ExtUtils::MM_AIX' => '6.56',
+ 'ExtUtils::MM_Any' => '6.56',
+ 'ExtUtils::MM_BeOS' => '6.56',
+ 'ExtUtils::MM_Cygwin' => '6.56',
+ 'ExtUtils::MM_DOS' => '6.56',
+ 'ExtUtils::MM_Darwin' => '6.56',
+ 'ExtUtils::MM_MacOS' => '6.56',
+ 'ExtUtils::MM_NW5' => '6.56',
+ 'ExtUtils::MM_OS2' => '6.56',
+ 'ExtUtils::MM_QNX' => '6.56',
+ 'ExtUtils::MM_UWIN' => '6.56',
+ 'ExtUtils::MM_Unix' => '6.56',
+ 'ExtUtils::MM_VMS' => '6.56',
+ 'ExtUtils::MM_VOS' => '6.56',
+ 'ExtUtils::MM_Win32' => '6.56',
+ 'ExtUtils::MM_Win95' => '6.56',
+ 'ExtUtils::MY' => '6.56',
+ 'ExtUtils::MakeMaker' => '6.56',
+ 'ExtUtils::MakeMaker::Config'=> '6.56',
+ 'ExtUtils::Manifest' => '1.57',
+ 'ExtUtils::Miniperl' => undef,
+ 'ExtUtils::Mkbootstrap' => '6.56',
+ 'ExtUtils::Mksymlists' => '6.56',
+ 'ExtUtils::Packlist' => '1.44',
+ 'ExtUtils::ParseXS' => '2.21',
+ 'ExtUtils::XSSymSet' => '1.1',
+ 'ExtUtils::testlib' => '6.56',
+ 'Fatal' => '2.06_01',
+ 'Fcntl' => '1.06',
+ 'File::Basename' => '2.78',
+ 'File::CheckTree' => '4.4',
+ 'File::Compare' => '1.1006',
+ 'File::Copy' => '2.17',
+ 'File::DosGlob' => '1.01',
+ 'File::Fetch' => '0.24',
+ 'File::Find' => '1.15',
+ 'File::Glob' => '1.07',
+ 'File::GlobMapper' => '1.000',
+ 'File::Path' => '2.08_01',
+ 'File::Spec' => '3.31',
+ 'File::Spec::Cygwin' => '3.30',
+ 'File::Spec::Epoc' => '3.30',
+ 'File::Spec::Functions' => '3.30',
+ 'File::Spec::Mac' => '3.30',
+ 'File::Spec::OS2' => '3.30',
+ 'File::Spec::Unix' => '3.30',
+ 'File::Spec::VMS' => '3.30',
+ 'File::Spec::Win32' => '3.30',
+ 'File::Temp' => '0.22',
+ 'File::stat' => '1.02',
+ 'FileCache' => '1.08',
+ 'FileHandle' => '2.02',
+ 'Filespec' => '1.12',
+ 'Filter::Simple' => '0.84',
+ 'Filter::Util::Call' => '1.08',
+ 'FindBin' => '1.50',
+ 'GDBM_File' => '1.10',
+ 'Getopt::Long' => '2.38',
+ 'Getopt::Std' => '1.06',
+ 'Hash::Util' => '0.07',
+ 'Hash::Util::FieldHash' => '1.04',
+ 'I18N::Collate' => '1.01',
+ 'I18N::LangTags' => '0.35',
+ 'I18N::LangTags::Detect'=> '1.04',
+ 'I18N::LangTags::List' => '0.35',
+ 'I18N::Langinfo' => '0.03',
+ 'IO' => '1.25_02',
+ 'IO::Compress::Adapter::Bzip2'=> '2.024',
+ 'IO::Compress::Adapter::Deflate'=> '2.024',
+ 'IO::Compress::Adapter::Identity'=> '2.024',
+ 'IO::Compress::Base' => '2.024',
+ 'IO::Compress::Base::Common'=> '2.024',
+ 'IO::Compress::Bzip2' => '2.024',
+ 'IO::Compress::Deflate' => '2.024',
+ 'IO::Compress::Gzip' => '2.024',
+ 'IO::Compress::Gzip::Constants'=> '2.024',
+ 'IO::Compress::RawDeflate'=> '2.024',
+ 'IO::Compress::Zip' => '2.024',
+ 'IO::Compress::Zip::Constants'=> '2.024',
+ 'IO::Compress::Zlib::Constants'=> '2.024',
+ 'IO::Compress::Zlib::Extra'=> '2.024',
+ 'IO::Dir' => '1.07',
+ 'IO::File' => '1.14',
+ 'IO::Handle' => '1.28',
+ 'IO::Pipe' => '1.13',
+ 'IO::Poll' => '0.07',
+ 'IO::Seekable' => '1.10',
+ 'IO::Select' => '1.17',
+ 'IO::Socket' => '1.31',
+ 'IO::Socket::INET' => '1.31',
+ 'IO::Socket::UNIX' => '1.23',
+ 'IO::Uncompress::Adapter::Bunzip2'=> '2.024',
+ 'IO::Uncompress::Adapter::Identity'=> '2.024',
+ 'IO::Uncompress::Adapter::Inflate'=> '2.024',
+ 'IO::Uncompress::AnyInflate'=> '2.024',
+ 'IO::Uncompress::AnyUncompress'=> '2.024',
+ 'IO::Uncompress::Base' => '2.024',
+ 'IO::Uncompress::Bunzip2'=> '2.024',
+ 'IO::Uncompress::Gunzip'=> '2.024',
+ 'IO::Uncompress::Inflate'=> '2.024',
+ 'IO::Uncompress::RawInflate'=> '2.024',
+ 'IO::Uncompress::Unzip' => '2.024',
+ 'IO::Zlib' => '1.10',
+ 'IPC::Cmd' => '0.54',
+ 'IPC::Msg' => '2.01',
+ 'IPC::Open2' => '1.03',
+ 'IPC::Open3' => '1.05',
+ 'IPC::Semaphore' => '2.01',
+ 'IPC::SharedMem' => '2.01',
+ 'IPC::SysV' => '2.01',
+ 'List::Util' => '1.22',
+ 'List::Util::PP' => '1.22',
+ 'List::Util::XS' => '1.22',
+ 'Locale::Constants' => '2.07',
+ 'Locale::Country' => '2.07',
+ 'Locale::Currency' => '2.07',
+ 'Locale::Language' => '2.07',
+ 'Locale::Maketext' => '1.14',
+ 'Locale::Maketext::Guts'=> '1.13',
+ 'Locale::Maketext::GutsLoader'=> '1.13',
+ 'Locale::Maketext::Simple'=> '0.21',
+ 'Locale::Script' => '2.07',
+ 'Log::Message' => '0.02',
+ 'Log::Message::Config' => '0.01',
+ 'Log::Message::Handlers'=> undef,
+ 'Log::Message::Item' => undef,
+ 'Log::Message::Simple' => '0.06',
+ 'MIME::Base64' => '3.08',
+ 'MIME::QuotedPrint' => '3.08',
+ 'Math::BigFloat' => '1.60',
+ 'Math::BigFloat::Trace' => '0.01',
+ 'Math::BigInt' => '1.89_01',
+ 'Math::BigInt::Calc' => '0.52',
+ 'Math::BigInt::CalcEmu' => '0.05',
+ 'Math::BigInt::FastCalc'=> '0.19',
+ 'Math::BigInt::Trace' => '0.01',
+ 'Math::BigRat' => '0.24',
+ 'Math::Complex' => '1.56',
+ 'Math::Trig' => '1.2',
+ 'Memoize' => '1.01_03',
+ 'Memoize::AnyDBM_File' => '0.65',
+ 'Memoize::Expire' => '1.00',
+ 'Memoize::ExpireFile' => '1.01',
+ 'Memoize::ExpireTest' => '0.65',
+ 'Memoize::NDBM_File' => '0.65',
+ 'Memoize::SDBM_File' => '0.65',
+ 'Memoize::Storable' => '0.65',
+ 'Module::Build' => '0.3603',
+ 'Module::Build::Base' => '0.3603',
+ 'Module::Build::Compat' => '0.3603',
+ 'Module::Build::Config' => '0.3603',
+ 'Module::Build::ConfigData'=> undef,
+ 'Module::Build::Cookbook'=> '0.3603',
+ 'Module::Build::Dumper' => '0.3603',
+ 'Module::Build::ModuleInfo'=> '0.3603',
+ 'Module::Build::Notes' => '0.3603',
+ 'Module::Build::PPMMaker'=> '0.3603',
+ 'Module::Build::Platform::Amiga'=> '0.3603',
+ 'Module::Build::Platform::Default'=> '0.3603',
+ 'Module::Build::Platform::EBCDIC'=> '0.3603',
+ 'Module::Build::Platform::MPEiX'=> '0.3603',
+ 'Module::Build::Platform::MacOS'=> '0.3603',
+ 'Module::Build::Platform::RiscOS'=> '0.3603',
+ 'Module::Build::Platform::Unix'=> '0.3603',
+ 'Module::Build::Platform::VMS'=> '0.3603',
+ 'Module::Build::Platform::VOS'=> '0.3603',
+ 'Module::Build::Platform::Windows'=> '0.3603',
+ 'Module::Build::Platform::aix'=> '0.3603',
+ 'Module::Build::Platform::cygwin'=> '0.3603',
+ 'Module::Build::Platform::darwin'=> '0.3603',
+ 'Module::Build::Platform::os2'=> '0.3603',
+ 'Module::Build::PodParser'=> '0.3603',
+ 'Module::Build::Version'=> '0.77',
+ 'Module::Build::YAML' => '1.40',
+ 'Module::CoreList' => '2.29',
+ 'Module::Load' => '0.16',
+ 'Module::Load::Conditional'=> '0.34',
+ 'Module::Loaded' => '0.06',
+ 'Module::Pluggable' => '3.9',
+ 'Module::Pluggable::Object'=> '3.9',
+ 'Moped::Msg' => '0.01',
+ 'NDBM_File' => '1.08',
+ 'NEXT' => '0.64',
+ 'Net::Cmd' => '2.29',
+ 'Net::Config' => '1.11',
+ 'Net::Domain' => '2.20',
+ 'Net::FTP' => '2.77',
+ 'Net::FTP::A' => '1.18',
+ 'Net::FTP::E' => '0.01',
+ 'Net::FTP::I' => '1.12',
+ 'Net::FTP::L' => '0.01',
+ 'Net::FTP::dataconn' => '0.11',
+ 'Net::NNTP' => '2.24',
+ 'Net::Netrc' => '2.12',
+ 'Net::POP3' => '2.29',
+ 'Net::Ping' => '2.36',
+ 'Net::SMTP' => '2.31',
+ 'Net::Time' => '2.10',
+ 'Net::hostent' => '1.01',
+ 'Net::netent' => '1.00',
+ 'Net::protoent' => '1.00',
+ 'Net::servent' => '1.01',
+ 'O' => '1.01',
+ 'ODBM_File' => '1.07',
+ 'Object::Accessor' => '0.36',
+ 'Opcode' => '1.15',
+ 'POSIX' => '1.19',
+ 'Package::Constants' => '0.02',
+ 'Params::Check' => '0.26',
+ 'Parse::CPAN::Meta' => '1.40',
+ 'PerlIO' => '1.06',
+ 'PerlIO::encoding' => '0.12',
+ 'PerlIO::scalar' => '0.07',
+ 'PerlIO::via' => '0.09',
+ 'PerlIO::via::QuotedPrint'=> '0.06',
+ 'Pod::Checker' => '1.45',
+ 'Pod::Escapes' => '1.04',
+ 'Pod::Find' => '1.35',
+ 'Pod::Functions' => '1.03',
+ 'Pod::Html' => '1.09',
+ 'Pod::InputObjects' => '1.31',
+ 'Pod::LaTeX' => '0.58',
+ 'Pod::Man' => '2.23',
+ 'Pod::ParseLink' => '1.10',
+ 'Pod::ParseUtils' => '1.36',
+ 'Pod::Parser' => '1.37',
+ 'Pod::Perldoc' => '3.15_02',
+ 'Pod::Perldoc::BaseTo' => undef,
+ 'Pod::Perldoc::GetOptsOO'=> undef,
+ 'Pod::Perldoc::ToChecker'=> undef,
+ 'Pod::Perldoc::ToMan' => undef,
+ 'Pod::Perldoc::ToNroff' => undef,
+ 'Pod::Perldoc::ToPod' => undef,
+ 'Pod::Perldoc::ToRtf' => undef,
+ 'Pod::Perldoc::ToText' => undef,
+ 'Pod::Perldoc::ToTk' => undef,
+ 'Pod::Perldoc::ToXml' => undef,
+ 'Pod::PlainText' => '2.04',
+ 'Pod::Plainer' => '1.02',
+ 'Pod::Select' => '1.36',
+ 'Pod::Simple' => '3.13',
+ 'Pod::Simple::BlackBox' => '3.13',
+ 'Pod::Simple::Checker' => '3.13',
+ 'Pod::Simple::Debug' => '3.13',
+ 'Pod::Simple::DumpAsText'=> '3.13',
+ 'Pod::Simple::DumpAsXML'=> '3.13',
+ 'Pod::Simple::HTML' => '3.13',
+ 'Pod::Simple::HTMLBatch'=> '3.13',
+ 'Pod::Simple::HTMLLegacy'=> '5.01',
+ 'Pod::Simple::LinkSection'=> '3.13',
+ 'Pod::Simple::Methody' => '3.13',
+ 'Pod::Simple::Progress' => '3.13',
+ 'Pod::Simple::PullParser'=> '3.13',
+ 'Pod::Simple::PullParserEndToken'=> '3.13',
+ 'Pod::Simple::PullParserStartToken'=> '3.13',
+ 'Pod::Simple::PullParserTextToken'=> '3.13',
+ 'Pod::Simple::PullParserToken'=> '3.13',
+ 'Pod::Simple::RTF' => '3.13',
+ 'Pod::Simple::Search' => '3.13',
+ 'Pod::Simple::SimpleTree'=> '3.13',
+ 'Pod::Simple::Text' => '3.13',
+ 'Pod::Simple::TextContent'=> '3.13',
+ 'Pod::Simple::TiedOutFH'=> '3.13',
+ 'Pod::Simple::Transcode'=> '3.13',
+ 'Pod::Simple::TranscodeDumb'=> '3.13',
+ 'Pod::Simple::TranscodeSmart'=> '3.13',
+ 'Pod::Simple::XHTML' => '3.13',
+ 'Pod::Simple::XMLOutStream'=> '3.13',
+ 'Pod::Text' => '3.14',
+ 'Pod::Text::Color' => '2.06',
+ 'Pod::Text::Overstrike' => '2.04',
+ 'Pod::Text::Termcap' => '2.06',
+ 'Pod::Usage' => '1.36',
+ 'SDBM_File' => '1.06',
+ 'Safe' => '2.25',
+ 'Scalar::Util' => '1.22',
+ 'Scalar::Util::PP' => '1.22',
+ 'Search::Dict' => '1.02',
+ 'SelectSaver' => '1.02',
+ 'SelfLoader' => '1.17',
+ 'Shell' => '0.72_01',
+ 'Socket' => '1.87',
+ 'Storable' => '2.22',
+ 'Switch' => '2.16',
+ 'Symbol' => '1.07',
+ 'Sys::Hostname' => '1.11',
+ 'Sys::Syslog' => '0.27',
+ 'Sys::Syslog::win32::Win32'=> undef,
+ 'TAP::Base' => '3.17',
+ 'TAP::Formatter::Base' => '3.17',
+ 'TAP::Formatter::Color' => '3.17',
+ 'TAP::Formatter::Console'=> '3.17',
+ 'TAP::Formatter::Console::ParallelSession'=> '3.17',
+ 'TAP::Formatter::Console::Session'=> '3.17',
+ 'TAP::Formatter::File' => '3.17',
+ 'TAP::Formatter::File::Session'=> '3.17',
+ 'TAP::Formatter::Session'=> '3.17',
+ 'TAP::Harness' => '3.17',
+ 'TAP::Object' => '3.17',
+ 'TAP::Parser' => '3.17',
+ 'TAP::Parser::Aggregator'=> '3.17',
+ 'TAP::Parser::Grammar' => '3.17',
+ 'TAP::Parser::Iterator' => '3.17',
+ 'TAP::Parser::Iterator::Array'=> '3.17',
+ 'TAP::Parser::Iterator::Process'=> '3.17',
+ 'TAP::Parser::Iterator::Stream'=> '3.17',
+ 'TAP::Parser::IteratorFactory'=> '3.17',
+ 'TAP::Parser::Multiplexer'=> '3.17',
+ 'TAP::Parser::Result' => '3.17',
+ 'TAP::Parser::Result::Bailout'=> '3.17',
+ 'TAP::Parser::Result::Comment'=> '3.17',
+ 'TAP::Parser::Result::Plan'=> '3.17',
+ 'TAP::Parser::Result::Pragma'=> '3.17',
+ 'TAP::Parser::Result::Test'=> '3.17',
+ 'TAP::Parser::Result::Unknown'=> '3.17',
+ 'TAP::Parser::Result::Version'=> '3.17',
+ 'TAP::Parser::Result::YAML'=> '3.17',
+ 'TAP::Parser::ResultFactory'=> '3.17',
+ 'TAP::Parser::Scheduler'=> '3.17',
+ 'TAP::Parser::Scheduler::Job'=> '3.17',
+ 'TAP::Parser::Scheduler::Spinner'=> '3.17',
+ 'TAP::Parser::Source' => '3.17',
+ 'TAP::Parser::Source::Perl'=> '3.17',
+ 'TAP::Parser::Utils' => '3.17',
+ 'TAP::Parser::YAMLish::Reader'=> '3.17',
+ 'TAP::Parser::YAMLish::Writer'=> '3.17',
+ 'Term::ANSIColor' => '2.02',
+ 'Term::Cap' => '1.12',
+ 'Term::Complete' => '1.402',
+ 'Term::ReadLine' => '1.05',
+ 'Term::UI' => '0.20',
+ 'Term::UI::History' => undef,
+ 'Test' => '1.25_02',
+ 'Test::Builder' => '0.94',
+ 'Test::Builder::Module' => '0.94',
+ 'Test::Builder::Tester' => '1.18',
+ 'Test::Builder::Tester::Color'=> '1.18',
+ 'Test::Harness' => '3.17',
+ 'Test::More' => '0.94',
+ 'Test::Simple' => '0.94',
+ 'Text::Abbrev' => '1.01',
+ 'Text::Balanced' => '2.02',
+ 'Text::ParseWords' => '3.27',
+ 'Text::Soundex' => '3.03_01',
+ 'Text::Tabs' => '2009.0305',
+ 'Text::Wrap' => '2009.0305',
+ 'Thread' => '3.02',
+ 'Thread::Queue' => '2.11',
+ 'Thread::Semaphore' => '2.09',
+ 'Tie::Array' => '1.03',
+ 'Tie::File' => '0.97_02',
+ 'Tie::Handle' => '4.2',
+ 'Tie::Hash' => '1.03',
+ 'Tie::Hash::NamedCapture'=> '0.06',
+ 'Tie::Memoize' => '1.1',
+ 'Tie::RefHash' => '1.38',
+ 'Tie::Scalar' => '1.02',
+ 'Tie::StdHandle' => '4.2',
+ 'Tie::SubstrHash' => '1.00',
+ 'Time::HiRes' => '1.9719',
+ 'Time::Local' => '1.1901_01',
+ 'Time::Piece' => '1.15_01',
+ 'Time::Piece::Seconds' => undef,
+ 'Time::Seconds' => undef,
+ 'Time::gmtime' => '1.03',
+ 'Time::localtime' => '1.02',
+ 'Time::tm' => '1.00',
+ 'UNIVERSAL' => '1.06',
+ 'Unicode' => '5.2.0',
+ 'Unicode::Collate' => '0.52_01',
+ 'Unicode::Normalize' => '1.03',
+ 'Unicode::UCD' => '0.27',
+ 'User::grent' => '1.01',
+ 'User::pwent' => '1.00',
+ 'VMS::DCLsym' => '1.03',
+ 'VMS::Stdio' => '2.4',
+ 'Win32' => '0.39',
+ 'Win32API::File' => '0.1101',
+ 'Win32API::File::ExtUtils::Myconst2perl'=> '1',
+ 'Win32CORE' => '0.02',
+ 'XS::APItest' => '0.17',
+ 'XS::APItest::KeywordRPN'=> '0.003',
+ 'XS::Typemap' => '0.03',
+ 'XSLoader' => '0.10',
+ 'XSLoader::XSLoader' => '0.10',
+ 'attributes' => '0.12',
+ 'autodie' => '2.06_01',
+ 'autodie::exception' => '2.06_01',
+ 'autodie::exception::system'=> '2.06_01',
+ 'autodie::hints' => '2.06_01',
+ 'autouse' => '1.06',
+ 'base' => '2.15',
+ 'bigint' => '0.23',
+ 'bignum' => '0.23',
+ 'bigrat' => '0.23',
+ 'blib' => '1.04',
+ 'bytes' => '1.04',
+ 'charnames' => '1.07',
+ 'constant' => '1.20',
+ 'deprecate' => '0.01',
+ 'diagnostics' => '1.19',
+ 'encoding' => '2.6_01',
+ 'encoding::warnings' => '0.11',
+ 'feature' => '1.16',
+ 'fields' => '2.15',
+ 'filetest' => '1.02',
+ 'if' => '0.05',
+ 'inc::latest' => '0.3603',
+ 'integer' => '1.00',
+ 'less' => '0.03',
+ 'lib' => '0.62',
+ 'locale' => '1.00',
+ 'mro' => '1.02',
+ 'open' => '1.07',
+ 'ops' => '1.02',
+ 'overload' => '1.10',
+ 'overload::numbers' => undef,
+ 'overloading' => '0.01',
+ 'parent' => '0.223',
+ 're' => '0.11',
+ 'sigtrap' => '1.04',
+ 'sort' => '2.01',
+ 'strict' => '1.04',
+ 'subs' => '1.00',
+ 'threads' => '1.75',
+ 'threads::shared' => '1.32',
+ 'utf8' => '1.08',
+ 'vars' => '1.01',
+ 'version' => '0.82',
+ 'vmsish' => '1.02',
+ 'warnings' => '1.09',
+ 'warnings::register' => '1.01',
+ },
+ 5.013000 => {
+ 'AnyDBM_File' => '1.00',
+ 'App::Cpan' => '1.5701',
+ 'App::Prove' => '3.17',
+ 'App::Prove::State' => '3.17',
+ 'App::Prove::State::Result'=> '3.17',
+ 'App::Prove::State::Result::Test'=> '3.17',
+ 'Archive::Extract' => '0.38',
+ 'Archive::Tar' => '1.54',
+ 'Archive::Tar::Constant'=> '0.02',
+ 'Archive::Tar::File' => '0.02',
+ 'Attribute::Handlers' => '0.87',
+ 'AutoLoader' => '5.70',
+ 'AutoSplit' => '1.06',
+ 'B' => '1.23',
+ 'B::Concise' => '0.78',
+ 'B::Debug' => '1.12',
+ 'B::Deparse' => '0.96',
+ 'B::Lint' => '1.11_01',
+ 'B::Lint::Debug' => '0.01',
+ 'B::Showlex' => '1.02',
+ 'B::Terse' => '1.05',
+ 'B::Xref' => '1.02',
+ 'Benchmark' => '1.11',
+ 'CGI' => '3.49',
+ 'CGI::Apache' => '1.01',
+ 'CGI::Carp' => '3.45',
+ 'CGI::Cookie' => '1.29',
+ 'CGI::Fast' => '1.08',
+ 'CGI::Pretty' => '3.46',
+ 'CGI::Push' => '1.04',
+ 'CGI::Switch' => '1.01',
+ 'CGI::Util' => '3.48',
+ 'CPAN' => '1.94_56',
+ 'CPAN::Author' => '5.5',
+ 'CPAN::Bundle' => '5.5',
+ 'CPAN::CacheMgr' => '5.5',
+ 'CPAN::Complete' => '5.5',
+ 'CPAN::Debug' => '5.5001',
+ 'CPAN::DeferredCode' => '5.50',
+ 'CPAN::Distribution' => '1.9456_01',
+ 'CPAN::Distroprefs' => '6',
+ 'CPAN::Distrostatus' => '5.5',
+ 'CPAN::Exception::RecursiveDependency'=> '5.5',
+ 'CPAN::Exception::blocked_urllist'=> '1.0',
+ 'CPAN::Exception::yaml_not_installed'=> '5.5',
+ 'CPAN::FTP' => '5.5004',
+ 'CPAN::FTP::netrc' => '1.00',
+ 'CPAN::FirstTime' => '5.5301',
+ 'CPAN::HandleConfig' => '5.5001',
+ 'CPAN::Index' => '1.94',
+ 'CPAN::InfoObj' => '5.5',
+ 'CPAN::Kwalify' => '5.50',
+ 'CPAN::LWP::UserAgent' => '1.94',
+ 'CPAN::Mirrors' => '1.77',
+ 'CPAN::Module' => '5.5',
+ 'CPAN::Nox' => '5.50',
+ 'CPAN::Prompt' => '5.5',
+ 'CPAN::Queue' => '5.5',
+ 'CPAN::Shell' => '5.5001',
+ 'CPAN::Tarzip' => '5.5011',
+ 'CPAN::URL' => '5.5',
+ 'CPAN::Version' => '5.5',
+ 'CPANPLUS' => '0.90',
+ 'CPANPLUS::Backend' => undef,
+ 'CPANPLUS::Backend::RV' => undef,
+ 'CPANPLUS::Config' => undef,
+ 'CPANPLUS::Configure' => undef,
+ 'CPANPLUS::Configure::Setup'=> undef,
+ 'CPANPLUS::Dist' => undef,
+ 'CPANPLUS::Dist::Autobundle'=> undef,
+ 'CPANPLUS::Dist::Base' => undef,
+ 'CPANPLUS::Dist::Build' => '0.46',
+ 'CPANPLUS::Dist::Build::Constants'=> '0.46',
+ 'CPANPLUS::Dist::MM' => undef,
+ 'CPANPLUS::Dist::Sample'=> undef,
+ 'CPANPLUS::Error' => undef,
+ 'CPANPLUS::Internals' => '0.90',
+ 'CPANPLUS::Internals::Constants'=> undef,
+ 'CPANPLUS::Internals::Constants::Report'=> undef,
+ 'CPANPLUS::Internals::Extract'=> undef,
+ 'CPANPLUS::Internals::Fetch'=> undef,
+ 'CPANPLUS::Internals::Report'=> undef,
+ 'CPANPLUS::Internals::Search'=> undef,
+ 'CPANPLUS::Internals::Source'=> undef,
+ 'CPANPLUS::Internals::Source::Memory'=> undef,
+ 'CPANPLUS::Internals::Source::SQLite'=> undef,
+ 'CPANPLUS::Internals::Source::SQLite::Tie'=> undef,
+ 'CPANPLUS::Internals::Utils'=> undef,
+ 'CPANPLUS::Internals::Utils::Autoflush'=> undef,
+ 'CPANPLUS::Module' => undef,
+ 'CPANPLUS::Module::Author'=> undef,
+ 'CPANPLUS::Module::Author::Fake'=> undef,
+ 'CPANPLUS::Module::Checksums'=> undef,
+ 'CPANPLUS::Module::Fake'=> undef,
+ 'CPANPLUS::Module::Signature'=> undef,
+ 'CPANPLUS::Selfupdate' => undef,
+ 'CPANPLUS::Shell' => undef,
+ 'CPANPLUS::Shell::Classic'=> '0.0562',
+ 'CPANPLUS::Shell::Default'=> '0.90',
+ 'CPANPLUS::Shell::Default::Plugins::CustomSource'=> undef,
+ 'CPANPLUS::Shell::Default::Plugins::Remote'=> undef,
+ 'CPANPLUS::Shell::Default::Plugins::Source'=> undef,
+ 'Carp' => '1.15',
+ 'Carp::Heavy' => '1.15',
+ 'Class::ISA' => '0.36',
+ 'Class::Struct' => '0.63',
+ 'Compress::Raw::Bzip2' => '2.024',
+ 'Compress::Raw::Zlib' => '2.024',
+ 'Compress::Zlib' => '2.024',
+ 'Config' => undef,
+ 'Config::Extensions' => '0.01',
+ 'Cwd' => '3.31',
+ 'DB' => '1.02',
+ 'DBM_Filter' => '0.03',
+ 'DBM_Filter::compress' => '0.02',
+ 'DBM_Filter::encode' => '0.02',
+ 'DBM_Filter::int32' => '0.02',
+ 'DBM_Filter::null' => '0.02',
+ 'DBM_Filter::utf8' => '0.02',
+ 'DB_File' => '1.820',
+ 'Data::Dumper' => '2.126',
+ 'Devel::DProf' => '20080331.00',
+ 'Devel::DProf::dprof::V'=> undef,
+ 'Devel::InnerPackage' => '0.3',
+ 'Devel::PPPort' => '3.19',
+ 'Devel::Peek' => '1.04',
+ 'Devel::SelfStubber' => '1.03',
+ 'Digest' => '1.16',
+ 'Digest::MD5' => '2.39',
+ 'Digest::SHA' => '5.47',
+ 'Digest::base' => '1.16',
+ 'Digest::file' => '1.16',
+ 'DirHandle' => '1.03',
+ 'Dumpvalue' => '1.13',
+ 'DynaLoader' => '1.10',
+ 'Encode' => '2.39',
+ 'Encode::Alias' => '2.12',
+ 'Encode::Byte' => '2.04',
+ 'Encode::CJKConstants' => '2.02',
+ 'Encode::CN' => '2.03',
+ 'Encode::CN::HZ' => '2.05',
+ 'Encode::Config' => '2.05',
+ 'Encode::EBCDIC' => '2.02',
+ 'Encode::Encoder' => '2.01',
+ 'Encode::Encoding' => '2.05',
+ 'Encode::GSM0338' => '2.01',
+ 'Encode::Guess' => '2.03',
+ 'Encode::JP' => '2.04',
+ 'Encode::JP::H2Z' => '2.02',
+ 'Encode::JP::JIS7' => '2.04',
+ 'Encode::KR' => '2.03',
+ 'Encode::KR::2022_KR' => '2.02',
+ 'Encode::MIME::Header' => '2.11',
+ 'Encode::MIME::Header::ISO_2022_JP'=> '1.03',
+ 'Encode::MIME::Name' => '1.01',
+ 'Encode::Symbol' => '2.02',
+ 'Encode::TW' => '2.03',
+ 'Encode::Unicode' => '2.07',
+ 'Encode::Unicode::UTF7' => '2.04',
+ 'English' => '1.04',
+ 'Env' => '1.01',
+ 'Errno' => '1.11',
+ 'Exporter' => '5.64_01',
+ 'Exporter::Heavy' => '5.64_01',
+ 'ExtUtils::CBuilder' => '0.27',
+ 'ExtUtils::CBuilder::Base'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::Unix'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::VMS'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::Windows'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::Windows::BCC'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::Windows::GCC'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::Windows::MSVC'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::aix'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::cygwin'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::darwin'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::dec_osf'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::os2'=> '0.27',
+ 'ExtUtils::Command' => '1.16',
+ 'ExtUtils::Command::MM' => '6.56',
+ 'ExtUtils::Constant' => '0.22',
+ 'ExtUtils::Constant::Base'=> '0.04',
+ 'ExtUtils::Constant::ProxySubs'=> '0.06',
+ 'ExtUtils::Constant::Utils'=> '0.02',
+ 'ExtUtils::Constant::XS'=> '0.03',
+ 'ExtUtils::Embed' => '1.28',
+ 'ExtUtils::Install' => '1.55',
+ 'ExtUtils::Installed' => '1.999_001',
+ 'ExtUtils::Liblist' => '6.56',
+ 'ExtUtils::Liblist::Kid'=> '6.56',
+ 'ExtUtils::MM' => '6.56',
+ 'ExtUtils::MM_AIX' => '6.56',
+ 'ExtUtils::MM_Any' => '6.56',
+ 'ExtUtils::MM_BeOS' => '6.56',
+ 'ExtUtils::MM_Cygwin' => '6.56',
+ 'ExtUtils::MM_DOS' => '6.56',
+ 'ExtUtils::MM_Darwin' => '6.56',
+ 'ExtUtils::MM_MacOS' => '6.56',
+ 'ExtUtils::MM_NW5' => '6.56',
+ 'ExtUtils::MM_OS2' => '6.56',
+ 'ExtUtils::MM_QNX' => '6.56',
+ 'ExtUtils::MM_UWIN' => '6.56',
+ 'ExtUtils::MM_Unix' => '6.5601',
+ 'ExtUtils::MM_VMS' => '6.56',
+ 'ExtUtils::MM_VOS' => '6.56',
+ 'ExtUtils::MM_Win32' => '6.56',
+ 'ExtUtils::MM_Win95' => '6.56',
+ 'ExtUtils::MY' => '6.56',
+ 'ExtUtils::MakeMaker' => '6.5601',
+ 'ExtUtils::MakeMaker::Config'=> '6.56',
+ 'ExtUtils::Manifest' => '1.57',
+ 'ExtUtils::Miniperl' => undef,
+ 'ExtUtils::Mkbootstrap' => '6.56',
+ 'ExtUtils::Mksymlists' => '6.56',
+ 'ExtUtils::Packlist' => '1.44',
+ 'ExtUtils::ParseXS' => '2.21',
+ 'ExtUtils::XSSymSet' => '1.1',
+ 'ExtUtils::testlib' => '6.56',
+ 'Fatal' => '2.06_01',
+ 'Fcntl' => '1.06',
+ 'File::Basename' => '2.78',
+ 'File::CheckTree' => '4.4',
+ 'File::Compare' => '1.1006',
+ 'File::Copy' => '2.18',
+ 'File::DosGlob' => '1.01',
+ 'File::Fetch' => '0.24',
+ 'File::Find' => '1.15',
+ 'File::Glob' => '1.07',
+ 'File::GlobMapper' => '1.000',
+ 'File::Path' => '2.08_01',
+ 'File::Spec' => '3.31',
+ 'File::Spec::Cygwin' => '3.30',
+ 'File::Spec::Epoc' => '3.30',
+ 'File::Spec::Functions' => '3.30',
+ 'File::Spec::Mac' => '3.30',
+ 'File::Spec::OS2' => '3.30',
+ 'File::Spec::Unix' => '3.30',
+ 'File::Spec::VMS' => '3.30',
+ 'File::Spec::Win32' => '3.30',
+ 'File::Temp' => '0.22',
+ 'File::stat' => '1.02',
+ 'FileCache' => '1.08',
+ 'FileHandle' => '2.02',
+ 'Filespec' => '1.12',
+ 'Filter::Simple' => '0.84',
+ 'Filter::Util::Call' => '1.08',
+ 'FindBin' => '1.50',
+ 'GDBM_File' => '1.10',
+ 'Getopt::Long' => '2.38',
+ 'Getopt::Std' => '1.06',
+ 'Hash::Util' => '0.07',
+ 'Hash::Util::FieldHash' => '1.04',
+ 'I18N::Collate' => '1.01',
+ 'I18N::LangTags' => '0.35',
+ 'I18N::LangTags::Detect'=> '1.04',
+ 'I18N::LangTags::List' => '0.35',
+ 'I18N::Langinfo' => '0.03',
+ 'IO' => '1.25_02',
+ 'IO::Compress::Adapter::Bzip2'=> '2.024',
+ 'IO::Compress::Adapter::Deflate'=> '2.024',
+ 'IO::Compress::Adapter::Identity'=> '2.024',
+ 'IO::Compress::Base' => '2.024',
+ 'IO::Compress::Base::Common'=> '2.024',
+ 'IO::Compress::Bzip2' => '2.024',
+ 'IO::Compress::Deflate' => '2.024',
+ 'IO::Compress::Gzip' => '2.024',
+ 'IO::Compress::Gzip::Constants'=> '2.024',
+ 'IO::Compress::RawDeflate'=> '2.024',
+ 'IO::Compress::Zip' => '2.024',
+ 'IO::Compress::Zip::Constants'=> '2.024',
+ 'IO::Compress::Zlib::Constants'=> '2.024',
+ 'IO::Compress::Zlib::Extra'=> '2.024',
+ 'IO::Dir' => '1.07',
+ 'IO::File' => '1.14',
+ 'IO::Handle' => '1.28',
+ 'IO::Pipe' => '1.13',
+ 'IO::Poll' => '0.07',
+ 'IO::Seekable' => '1.10',
+ 'IO::Select' => '1.17',
+ 'IO::Socket' => '1.31',
+ 'IO::Socket::INET' => '1.31',
+ 'IO::Socket::UNIX' => '1.23',
+ 'IO::Uncompress::Adapter::Bunzip2'=> '2.024',
+ 'IO::Uncompress::Adapter::Identity'=> '2.024',
+ 'IO::Uncompress::Adapter::Inflate'=> '2.024',
+ 'IO::Uncompress::AnyInflate'=> '2.024',
+ 'IO::Uncompress::AnyUncompress'=> '2.024',
+ 'IO::Uncompress::Base' => '2.024',
+ 'IO::Uncompress::Bunzip2'=> '2.024',
+ 'IO::Uncompress::Gunzip'=> '2.024',
+ 'IO::Uncompress::Inflate'=> '2.024',
+ 'IO::Uncompress::RawInflate'=> '2.024',
+ 'IO::Uncompress::Unzip' => '2.024',
+ 'IO::Zlib' => '1.10',
+ 'IPC::Cmd' => '0.54',
+ 'IPC::Msg' => '2.01',
+ 'IPC::Open2' => '1.03',
+ 'IPC::Open3' => '1.06',
+ 'IPC::Semaphore' => '2.01',
+ 'IPC::SharedMem' => '2.01',
+ 'IPC::SysV' => '2.01',
+ 'List::Util' => '1.22',
+ 'List::Util::PP' => '1.22',
+ 'List::Util::XS' => '1.22',
+ 'Locale::Constants' => '2.07',
+ 'Locale::Country' => '2.07',
+ 'Locale::Currency' => '2.07',
+ 'Locale::Language' => '2.07',
+ 'Locale::Maketext' => '1.14',
+ 'Locale::Maketext::Guts'=> '1.13',
+ 'Locale::Maketext::GutsLoader'=> '1.13',
+ 'Locale::Maketext::Simple'=> '0.21',
+ 'Locale::Script' => '2.07',
+ 'Log::Message' => '0.02',
+ 'Log::Message::Config' => '0.01',
+ 'Log::Message::Handlers'=> undef,
+ 'Log::Message::Item' => undef,
+ 'Log::Message::Simple' => '0.06',
+ 'MIME::Base64' => '3.09',
+ 'MIME::QuotedPrint' => '3.09',
+ 'Math::BigFloat' => '1.60',
+ 'Math::BigFloat::Trace' => '0.01',
+ 'Math::BigInt' => '1.89_01',
+ 'Math::BigInt::Calc' => '0.52',
+ 'Math::BigInt::CalcEmu' => '0.05',
+ 'Math::BigInt::FastCalc'=> '0.19',
+ 'Math::BigInt::Trace' => '0.01',
+ 'Math::BigRat' => '0.24',
+ 'Math::Complex' => '1.56',
+ 'Math::Trig' => '1.2',
+ 'Memoize' => '1.01_03',
+ 'Memoize::AnyDBM_File' => '0.65',
+ 'Memoize::Expire' => '1.00',
+ 'Memoize::ExpireFile' => '1.01',
+ 'Memoize::ExpireTest' => '0.65',
+ 'Memoize::NDBM_File' => '0.65',
+ 'Memoize::SDBM_File' => '0.65',
+ 'Memoize::Storable' => '0.65',
+ 'Module::Build' => '0.3603',
+ 'Module::Build::Base' => '0.3603',
+ 'Module::Build::Compat' => '0.3603',
+ 'Module::Build::Config' => '0.3603',
+ 'Module::Build::ConfigData'=> undef,
+ 'Module::Build::Cookbook'=> '0.3603',
+ 'Module::Build::Dumper' => '0.3603',
+ 'Module::Build::ModuleInfo'=> '0.3603',
+ 'Module::Build::Notes' => '0.3603',
+ 'Module::Build::PPMMaker'=> '0.3603',
+ 'Module::Build::Platform::Amiga'=> '0.3603',
+ 'Module::Build::Platform::Default'=> '0.3603',
+ 'Module::Build::Platform::EBCDIC'=> '0.3603',
+ 'Module::Build::Platform::MPEiX'=> '0.3603',
+ 'Module::Build::Platform::MacOS'=> '0.3603',
+ 'Module::Build::Platform::RiscOS'=> '0.3603',
+ 'Module::Build::Platform::Unix'=> '0.3603',
+ 'Module::Build::Platform::VMS'=> '0.3603',
+ 'Module::Build::Platform::VOS'=> '0.3603',
+ 'Module::Build::Platform::Windows'=> '0.3603',
+ 'Module::Build::Platform::aix'=> '0.3603',
+ 'Module::Build::Platform::cygwin'=> '0.3603',
+ 'Module::Build::Platform::darwin'=> '0.3603',
+ 'Module::Build::Platform::os2'=> '0.3603',
+ 'Module::Build::PodParser'=> '0.3603',
+ 'Module::Build::Version'=> '0.77',
+ 'Module::Build::YAML' => '1.40',
+ 'Module::CoreList' => '2.31',
+ 'Module::Load' => '0.16',
+ 'Module::Load::Conditional'=> '0.34',
+ 'Module::Loaded' => '0.06',
+ 'Module::Pluggable' => '3.9',
+ 'Module::Pluggable::Object'=> '3.9',
+ 'Moped::Msg' => '0.01',
+ 'NDBM_File' => '1.08',
+ 'NEXT' => '0.64',
+ 'Net::Cmd' => '2.29',
+ 'Net::Config' => '1.11',
+ 'Net::Domain' => '2.20',
+ 'Net::FTP' => '2.77',
+ 'Net::FTP::A' => '1.18',
+ 'Net::FTP::E' => '0.01',
+ 'Net::FTP::I' => '1.12',
+ 'Net::FTP::L' => '0.01',
+ 'Net::FTP::dataconn' => '0.11',
+ 'Net::NNTP' => '2.24',
+ 'Net::Netrc' => '2.12',
+ 'Net::POP3' => '2.29',
+ 'Net::Ping' => '2.36',
+ 'Net::SMTP' => '2.31',
+ 'Net::Time' => '2.10',
+ 'Net::hostent' => '1.01',
+ 'Net::netent' => '1.00',
+ 'Net::protoent' => '1.00',
+ 'Net::servent' => '1.01',
+ 'O' => '1.01',
+ 'ODBM_File' => '1.07',
+ 'Object::Accessor' => '0.36',
+ 'Opcode' => '1.15',
+ 'POSIX' => '1.19',
+ 'Package::Constants' => '0.02',
+ 'Params::Check' => '0.26',
+ 'Parse::CPAN::Meta' => '1.40',
+ 'PerlIO' => '1.06',
+ 'PerlIO::encoding' => '0.12',
+ 'PerlIO::scalar' => '0.07',
+ 'PerlIO::via' => '0.09',
+ 'PerlIO::via::QuotedPrint'=> '0.06',
+ 'Pod::Checker' => '1.45',
+ 'Pod::Escapes' => '1.04',
+ 'Pod::Find' => '1.35',
+ 'Pod::Functions' => '1.04',
+ 'Pod::Html' => '1.09',
+ 'Pod::InputObjects' => '1.31',
+ 'Pod::LaTeX' => '0.58',
+ 'Pod::Man' => '2.23',
+ 'Pod::ParseLink' => '1.10',
+ 'Pod::ParseUtils' => '1.36',
+ 'Pod::Parser' => '1.37',
+ 'Pod::Perldoc' => '3.15_02',
+ 'Pod::Perldoc::BaseTo' => undef,
+ 'Pod::Perldoc::GetOptsOO'=> undef,
+ 'Pod::Perldoc::ToChecker'=> undef,
+ 'Pod::Perldoc::ToMan' => undef,
+ 'Pod::Perldoc::ToNroff' => undef,
+ 'Pod::Perldoc::ToPod' => undef,
+ 'Pod::Perldoc::ToRtf' => undef,
+ 'Pod::Perldoc::ToText' => undef,
+ 'Pod::Perldoc::ToTk' => undef,
+ 'Pod::Perldoc::ToXml' => undef,
+ 'Pod::PlainText' => '2.04',
+ 'Pod::Plainer' => '1.02',
+ 'Pod::Select' => '1.36',
+ 'Pod::Simple' => '3.13',
+ 'Pod::Simple::BlackBox' => '3.13',
+ 'Pod::Simple::Checker' => '3.13',
+ 'Pod::Simple::Debug' => '3.13',
+ 'Pod::Simple::DumpAsText'=> '3.13',
+ 'Pod::Simple::DumpAsXML'=> '3.13',
+ 'Pod::Simple::HTML' => '3.13',
+ 'Pod::Simple::HTMLBatch'=> '3.13',
+ 'Pod::Simple::HTMLLegacy'=> '5.01',
+ 'Pod::Simple::LinkSection'=> '3.13',
+ 'Pod::Simple::Methody' => '3.13',
+ 'Pod::Simple::Progress' => '3.13',
+ 'Pod::Simple::PullParser'=> '3.13',
+ 'Pod::Simple::PullParserEndToken'=> '3.13',
+ 'Pod::Simple::PullParserStartToken'=> '3.13',
+ 'Pod::Simple::PullParserTextToken'=> '3.13',
+ 'Pod::Simple::PullParserToken'=> '3.13',
+ 'Pod::Simple::RTF' => '3.13',
+ 'Pod::Simple::Search' => '3.13',
+ 'Pod::Simple::SimpleTree'=> '3.13',
+ 'Pod::Simple::Text' => '3.13',
+ 'Pod::Simple::TextContent'=> '3.13',
+ 'Pod::Simple::TiedOutFH'=> '3.13',
+ 'Pod::Simple::Transcode'=> '3.13',
+ 'Pod::Simple::TranscodeDumb'=> '3.13',
+ 'Pod::Simple::TranscodeSmart'=> '3.13',
+ 'Pod::Simple::XHTML' => '3.13',
+ 'Pod::Simple::XMLOutStream'=> '3.13',
+ 'Pod::Text' => '3.14',
+ 'Pod::Text::Color' => '2.06',
+ 'Pod::Text::Overstrike' => '2.04',
+ 'Pod::Text::Termcap' => '2.06',
+ 'Pod::Usage' => '1.36',
+ 'SDBM_File' => '1.06',
+ 'Safe' => '2.25',
+ 'Scalar::Util' => '1.22',
+ 'Scalar::Util::PP' => '1.22',
+ 'Search::Dict' => '1.02',
+ 'SelectSaver' => '1.02',
+ 'SelfLoader' => '1.17',
+ 'Shell' => '0.72_01',
+ 'Socket' => '1.87',
+ 'Storable' => '2.22',
+ 'Switch' => '2.16',
+ 'Symbol' => '1.07',
+ 'Sys::Hostname' => '1.11',
+ 'Sys::Syslog' => '0.27',
+ 'Sys::Syslog::win32::Win32'=> undef,
+ 'TAP::Base' => '3.17',
+ 'TAP::Formatter::Base' => '3.17',
+ 'TAP::Formatter::Color' => '3.17',
+ 'TAP::Formatter::Console'=> '3.17',
+ 'TAP::Formatter::Console::ParallelSession'=> '3.17',
+ 'TAP::Formatter::Console::Session'=> '3.17',
+ 'TAP::Formatter::File' => '3.17',
+ 'TAP::Formatter::File::Session'=> '3.17',
+ 'TAP::Formatter::Session'=> '3.17',
+ 'TAP::Harness' => '3.17',
+ 'TAP::Object' => '3.17',
+ 'TAP::Parser' => '3.17',
+ 'TAP::Parser::Aggregator'=> '3.17',
+ 'TAP::Parser::Grammar' => '3.17',
+ 'TAP::Parser::Iterator' => '3.17',
+ 'TAP::Parser::Iterator::Array'=> '3.17',
+ 'TAP::Parser::Iterator::Process'=> '3.17',
+ 'TAP::Parser::Iterator::Stream'=> '3.17',
+ 'TAP::Parser::IteratorFactory'=> '3.17',
+ 'TAP::Parser::Multiplexer'=> '3.17',
+ 'TAP::Parser::Result' => '3.17',
+ 'TAP::Parser::Result::Bailout'=> '3.17',
+ 'TAP::Parser::Result::Comment'=> '3.17',
+ 'TAP::Parser::Result::Plan'=> '3.17',
+ 'TAP::Parser::Result::Pragma'=> '3.17',
+ 'TAP::Parser::Result::Test'=> '3.17',
+ 'TAP::Parser::Result::Unknown'=> '3.17',
+ 'TAP::Parser::Result::Version'=> '3.17',
+ 'TAP::Parser::Result::YAML'=> '3.17',
+ 'TAP::Parser::ResultFactory'=> '3.17',
+ 'TAP::Parser::Scheduler'=> '3.17',
+ 'TAP::Parser::Scheduler::Job'=> '3.17',
+ 'TAP::Parser::Scheduler::Spinner'=> '3.17',
+ 'TAP::Parser::Source' => '3.17',
+ 'TAP::Parser::Source::Perl'=> '3.17',
+ 'TAP::Parser::Utils' => '3.17',
+ 'TAP::Parser::YAMLish::Reader'=> '3.17',
+ 'TAP::Parser::YAMLish::Writer'=> '3.17',
+ 'Term::ANSIColor' => '2.02',
+ 'Term::Cap' => '1.12',
+ 'Term::Complete' => '1.402',
+ 'Term::ReadLine' => '1.05',
+ 'Term::UI' => '0.20',
+ 'Term::UI::History' => undef,
+ 'Test' => '1.25_02',
+ 'Test::Builder' => '0.94',
+ 'Test::Builder::Module' => '0.94',
+ 'Test::Builder::Tester' => '1.18',
+ 'Test::Builder::Tester::Color'=> '1.18',
+ 'Test::Harness' => '3.17',
+ 'Test::More' => '0.94',
+ 'Test::Simple' => '0.94',
+ 'Text::Abbrev' => '1.01',
+ 'Text::Balanced' => '2.02',
+ 'Text::ParseWords' => '3.27',
+ 'Text::Soundex' => '3.03_01',
+ 'Text::Tabs' => '2009.0305',
+ 'Text::Wrap' => '2009.0305',
+ 'Thread' => '3.02',
+ 'Thread::Queue' => '2.11',
+ 'Thread::Semaphore' => '2.09',
+ 'Tie::Array' => '1.03',
+ 'Tie::File' => '0.97_02',
+ 'Tie::Handle' => '4.2',
+ 'Tie::Hash' => '1.03',
+ 'Tie::Hash::NamedCapture'=> '0.06',
+ 'Tie::Memoize' => '1.1',
+ 'Tie::RefHash' => '1.38',
+ 'Tie::Scalar' => '1.02',
+ 'Tie::StdHandle' => '4.2',
+ 'Tie::SubstrHash' => '1.00',
+ 'Time::HiRes' => '1.9719',
+ 'Time::Local' => '1.1901_01',
+ 'Time::Piece' => '1.15_01',
+ 'Time::Piece::Seconds' => undef,
+ 'Time::Seconds' => undef,
+ 'Time::gmtime' => '1.03',
+ 'Time::localtime' => '1.02',
+ 'Time::tm' => '1.00',
+ 'UNIVERSAL' => '1.06',
+ 'Unicode' => '5.2.0',
+ 'Unicode::Collate' => '0.52_01',
+ 'Unicode::Normalize' => '1.03',
+ 'Unicode::UCD' => '0.27',
+ 'User::grent' => '1.01',
+ 'User::pwent' => '1.00',
+ 'VMS::DCLsym' => '1.03',
+ 'VMS::Stdio' => '2.4',
+ 'Win32' => '0.39',
+ 'Win32API::File' => '0.1101',
+ 'Win32API::File::ExtUtils::Myconst2perl'=> '1',
+ 'Win32CORE' => '0.02',
+ 'XS::APItest' => '0.18',
+ 'XS::APItest::KeywordRPN'=> '0.004',
+ 'XS::Typemap' => '0.03',
+ 'XSLoader' => '0.10',
+ 'XSLoader::XSLoader' => '0.10',
+ 'attributes' => '0.12',
+ 'autodie' => '2.06_01',
+ 'autodie::exception' => '2.06_01',
+ 'autodie::exception::system'=> '2.06_01',
+ 'autodie::hints' => '2.06_01',
+ 'autouse' => '1.06',
+ 'base' => '2.15',
+ 'bigint' => '0.23',
+ 'bignum' => '0.23',
+ 'bigrat' => '0.23',
+ 'blib' => '1.04',
+ 'bytes' => '1.04',
+ 'charnames' => '1.07',
+ 'constant' => '1.20',
+ 'deprecate' => '0.01',
+ 'diagnostics' => '1.19',
+ 'encoding' => '2.6_01',
+ 'encoding::warnings' => '0.11',
+ 'feature' => '1.17',
+ 'fields' => '2.15',
+ 'filetest' => '1.02',
+ 'if' => '0.05',
+ 'inc::latest' => '0.3603',
+ 'integer' => '1.00',
+ 'less' => '0.03',
+ 'lib' => '0.62',
+ 'locale' => '1.00',
+ 'mro' => '1.02',
+ 'open' => '1.07',
+ 'ops' => '1.02',
+ 'overload' => '1.10',
+ 'overload::numbers' => undef,
+ 'overloading' => '0.01',
+ 'parent' => '0.223',
+ 're' => '0.11',
+ 'sigtrap' => '1.04',
+ 'sort' => '2.01',
+ 'strict' => '1.04',
+ 'subs' => '1.00',
+ 'threads' => '1.77_01',
+ 'threads::shared' => '1.33',
+ 'utf8' => '1.08',
+ 'vars' => '1.01',
+ 'version' => '0.82',
+ 'vmsish' => '1.02',
+ 'warnings' => '1.09',
+ 'warnings::register' => '1.01',
+ },
+ 5.012001 => {
+ 'AnyDBM_File' => '1.00',
+ 'App::Cpan' => '1.5701',
+ 'App::Prove' => '3.17',
+ 'App::Prove::State' => '3.17',
+ 'App::Prove::State::Result'=> '3.17',
+ 'App::Prove::State::Result::Test'=> '3.17',
+ 'Archive::Extract' => '0.38',
+ 'Archive::Tar' => '1.54',
+ 'Archive::Tar::Constant'=> '0.02',
+ 'Archive::Tar::File' => '0.02',
+ 'Attribute::Handlers' => '0.87',
+ 'AutoLoader' => '5.70',
+ 'AutoSplit' => '1.06',
+ 'B' => '1.23',
+ 'B::Concise' => '0.78',
+ 'B::Debug' => '1.12',
+ 'B::Deparse' => '0.97',
+ 'B::Lint' => '1.11_01',
+ 'B::Lint::Debug' => '0.01',
+ 'B::Showlex' => '1.02',
+ 'B::Terse' => '1.05',
+ 'B::Xref' => '1.02',
+ 'Benchmark' => '1.11',
+ 'CGI' => '3.49',
+ 'CGI::Apache' => '1.01',
+ 'CGI::Carp' => '3.45',
+ 'CGI::Cookie' => '1.29',
+ 'CGI::Fast' => '1.08',
+ 'CGI::Pretty' => '3.46',
+ 'CGI::Push' => '1.04',
+ 'CGI::Switch' => '1.01',
+ 'CGI::Util' => '3.48',
+ 'CPAN' => '1.94_56',
+ 'CPAN::Author' => '5.5',
+ 'CPAN::Bundle' => '5.5',
+ 'CPAN::CacheMgr' => '5.5',
+ 'CPAN::Complete' => '5.5',
+ 'CPAN::Debug' => '5.5001',
+ 'CPAN::DeferredCode' => '5.50',
+ 'CPAN::Distribution' => '1.9456_01',
+ 'CPAN::Distroprefs' => '6',
+ 'CPAN::Distrostatus' => '5.5',
+ 'CPAN::Exception::RecursiveDependency'=> '5.5',
+ 'CPAN::Exception::blocked_urllist'=> '1.0',
+ 'CPAN::Exception::yaml_not_installed'=> '5.5',
+ 'CPAN::FTP' => '5.5004',
+ 'CPAN::FTP::netrc' => '1.00',
+ 'CPAN::FirstTime' => '5.5301',
+ 'CPAN::HandleConfig' => '5.5001',
+ 'CPAN::Index' => '1.94',
+ 'CPAN::InfoObj' => '5.5',
+ 'CPAN::Kwalify' => '5.50',
+ 'CPAN::LWP::UserAgent' => '1.94',
+ 'CPAN::Mirrors' => '1.77',
+ 'CPAN::Module' => '5.5',
+ 'CPAN::Nox' => '5.50',
+ 'CPAN::Prompt' => '5.5',
+ 'CPAN::Queue' => '5.5',
+ 'CPAN::Shell' => '5.5001',
+ 'CPAN::Tarzip' => '5.5011',
+ 'CPAN::URL' => '5.5',
+ 'CPAN::Version' => '5.5',
+ 'CPANPLUS' => '0.90',
+ 'CPANPLUS::Backend' => undef,
+ 'CPANPLUS::Backend::RV' => undef,
+ 'CPANPLUS::Config' => undef,
+ 'CPANPLUS::Configure' => undef,
+ 'CPANPLUS::Configure::Setup'=> undef,
+ 'CPANPLUS::Dist' => undef,
+ 'CPANPLUS::Dist::Autobundle'=> undef,
+ 'CPANPLUS::Dist::Base' => undef,
+ 'CPANPLUS::Dist::Build' => '0.46',
+ 'CPANPLUS::Dist::Build::Constants'=> '0.46',
+ 'CPANPLUS::Dist::MM' => undef,
+ 'CPANPLUS::Dist::Sample'=> undef,
+ 'CPANPLUS::Error' => undef,
+ 'CPANPLUS::Internals' => '0.90',
+ 'CPANPLUS::Internals::Constants'=> undef,
+ 'CPANPLUS::Internals::Constants::Report'=> undef,
+ 'CPANPLUS::Internals::Extract'=> undef,
+ 'CPANPLUS::Internals::Fetch'=> undef,
+ 'CPANPLUS::Internals::Report'=> undef,
+ 'CPANPLUS::Internals::Search'=> undef,
+ 'CPANPLUS::Internals::Source'=> undef,
+ 'CPANPLUS::Internals::Source::Memory'=> undef,
+ 'CPANPLUS::Internals::Source::SQLite'=> undef,
+ 'CPANPLUS::Internals::Source::SQLite::Tie'=> undef,
+ 'CPANPLUS::Internals::Utils'=> undef,
+ 'CPANPLUS::Internals::Utils::Autoflush'=> undef,
+ 'CPANPLUS::Module' => undef,
+ 'CPANPLUS::Module::Author'=> undef,
+ 'CPANPLUS::Module::Author::Fake'=> undef,
+ 'CPANPLUS::Module::Checksums'=> undef,
+ 'CPANPLUS::Module::Fake'=> undef,
+ 'CPANPLUS::Module::Signature'=> undef,
+ 'CPANPLUS::Selfupdate' => undef,
+ 'CPANPLUS::Shell' => undef,
+ 'CPANPLUS::Shell::Classic'=> '0.0562',
+ 'CPANPLUS::Shell::Default'=> '0.90',
+ 'CPANPLUS::Shell::Default::Plugins::CustomSource'=> undef,
+ 'CPANPLUS::Shell::Default::Plugins::Remote'=> undef,
+ 'CPANPLUS::Shell::Default::Plugins::Source'=> undef,
+ 'Carp' => '1.16',
+ 'Carp::Heavy' => '1.16',
+ 'Class::ISA' => '0.36',
+ 'Class::Struct' => '0.63',
+ 'Compress::Raw::Bzip2' => '2.024',
+ 'Compress::Raw::Zlib' => '2.024',
+ 'Compress::Zlib' => '2.024',
+ 'Config' => undef,
+ 'Config::Extensions' => '0.01',
+ 'Cwd' => '3.31',
+ 'DB' => '1.02',
+ 'DBM_Filter' => '0.03',
+ 'DBM_Filter::compress' => '0.02',
+ 'DBM_Filter::encode' => '0.02',
+ 'DBM_Filter::int32' => '0.02',
+ 'DBM_Filter::null' => '0.02',
+ 'DBM_Filter::utf8' => '0.02',
+ 'DB_File' => '1.820',
+ 'Data::Dumper' => '2.125',
+ 'Devel::DProf' => '20080331.00',
+ 'Devel::DProf::dprof::V'=> undef,
+ 'Devel::InnerPackage' => '0.3',
+ 'Devel::PPPort' => '3.19',
+ 'Devel::Peek' => '1.04',
+ 'Devel::SelfStubber' => '1.03',
+ 'Digest' => '1.16',
+ 'Digest::MD5' => '2.39',
+ 'Digest::SHA' => '5.47',
+ 'Digest::base' => '1.16',
+ 'Digest::file' => '1.16',
+ 'DirHandle' => '1.03',
+ 'Dumpvalue' => '1.13',
+ 'DynaLoader' => '1.10',
+ 'Encode' => '2.39',
+ 'Encode::Alias' => '2.12',
+ 'Encode::Byte' => '2.04',
+ 'Encode::CJKConstants' => '2.02',
+ 'Encode::CN' => '2.03',
+ 'Encode::CN::HZ' => '2.05',
+ 'Encode::Config' => '2.05',
+ 'Encode::EBCDIC' => '2.02',
+ 'Encode::Encoder' => '2.01',
+ 'Encode::Encoding' => '2.05',
+ 'Encode::GSM0338' => '2.01',
+ 'Encode::Guess' => '2.03',
+ 'Encode::JP' => '2.04',
+ 'Encode::JP::H2Z' => '2.02',
+ 'Encode::JP::JIS7' => '2.04',
+ 'Encode::KR' => '2.03',
+ 'Encode::KR::2022_KR' => '2.02',
+ 'Encode::MIME::Header' => '2.11',
+ 'Encode::MIME::Header::ISO_2022_JP'=> '1.03',
+ 'Encode::MIME::Name' => '1.01',
+ 'Encode::Symbol' => '2.02',
+ 'Encode::TW' => '2.03',
+ 'Encode::Unicode' => '2.07',
+ 'Encode::Unicode::UTF7' => '2.04',
+ 'English' => '1.04',
+ 'Env' => '1.01',
+ 'Errno' => '1.11',
+ 'Exporter' => '5.64_01',
+ 'Exporter::Heavy' => '5.64_01',
+ 'ExtUtils::CBuilder' => '0.27',
+ 'ExtUtils::CBuilder::Base'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::Unix'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::VMS'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::Windows'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::Windows::BCC'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::Windows::GCC'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::Windows::MSVC'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::aix'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::cygwin'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::darwin'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::dec_osf'=> '0.27',
+ 'ExtUtils::CBuilder::Platform::os2'=> '0.27',
+ 'ExtUtils::Command' => '1.16',
+ 'ExtUtils::Command::MM' => '6.56',
+ 'ExtUtils::Constant' => '0.22',
+ 'ExtUtils::Constant::Base'=> '0.04',
+ 'ExtUtils::Constant::ProxySubs'=> '0.06',
+ 'ExtUtils::Constant::Utils'=> '0.02',
+ 'ExtUtils::Constant::XS'=> '0.03',
+ 'ExtUtils::Embed' => '1.28',
+ 'ExtUtils::Install' => '1.55',
+ 'ExtUtils::Installed' => '1.999_001',
+ 'ExtUtils::Liblist' => '6.56',
+ 'ExtUtils::Liblist::Kid'=> '6.56',
+ 'ExtUtils::MM' => '6.56',
+ 'ExtUtils::MM_AIX' => '6.56',
+ 'ExtUtils::MM_Any' => '6.56',
+ 'ExtUtils::MM_BeOS' => '6.56',
+ 'ExtUtils::MM_Cygwin' => '6.56',
+ 'ExtUtils::MM_DOS' => '6.56',
+ 'ExtUtils::MM_Darwin' => '6.56',
+ 'ExtUtils::MM_MacOS' => '6.56',
+ 'ExtUtils::MM_NW5' => '6.56',
+ 'ExtUtils::MM_OS2' => '6.56',
+ 'ExtUtils::MM_QNX' => '6.56',
+ 'ExtUtils::MM_UWIN' => '6.56',
+ 'ExtUtils::MM_Unix' => '6.56',
+ 'ExtUtils::MM_VMS' => '6.56',
+ 'ExtUtils::MM_VOS' => '6.56',
+ 'ExtUtils::MM_Win32' => '6.56',
+ 'ExtUtils::MM_Win95' => '6.56',
+ 'ExtUtils::MY' => '6.56',
+ 'ExtUtils::MakeMaker' => '6.56',
+ 'ExtUtils::MakeMaker::Config'=> '6.56',
+ 'ExtUtils::Manifest' => '1.57',
+ 'ExtUtils::Miniperl' => undef,
+ 'ExtUtils::Mkbootstrap' => '6.56',
+ 'ExtUtils::Mksymlists' => '6.56',
+ 'ExtUtils::Packlist' => '1.44',
+ 'ExtUtils::ParseXS' => '2.21',
+ 'ExtUtils::XSSymSet' => '1.1',
+ 'ExtUtils::testlib' => '6.56',
+ 'Fatal' => '2.06_01',
+ 'Fcntl' => '1.06',
+ 'File::Basename' => '2.78',
+ 'File::CheckTree' => '4.4',
+ 'File::Compare' => '1.1006',
+ 'File::Copy' => '2.18',
+ 'File::DosGlob' => '1.01',
+ 'File::Fetch' => '0.24',
+ 'File::Find' => '1.15',
+ 'File::Glob' => '1.07',
+ 'File::GlobMapper' => '1.000',
+ 'File::Path' => '2.08_01',
+ 'File::Spec' => '3.31',
+ 'File::Spec::Cygwin' => '3.30',
+ 'File::Spec::Epoc' => '3.30',
+ 'File::Spec::Functions' => '3.30',
+ 'File::Spec::Mac' => '3.30',
+ 'File::Spec::OS2' => '3.30',
+ 'File::Spec::Unix' => '3.30',
+ 'File::Spec::VMS' => '3.30',
+ 'File::Spec::Win32' => '3.30',
+ 'File::Temp' => '0.22',
+ 'File::stat' => '1.02',
+ 'FileCache' => '1.08',
+ 'FileHandle' => '2.02',
+ 'Filespec' => '1.12',
+ 'Filter::Simple' => '0.84',
+ 'Filter::Util::Call' => '1.08',
+ 'FindBin' => '1.50',
+ 'GDBM_File' => '1.10',
+ 'Getopt::Long' => '2.38',
+ 'Getopt::Std' => '1.06',
+ 'Hash::Util' => '0.07',
+ 'Hash::Util::FieldHash' => '1.04',
+ 'I18N::Collate' => '1.01',
+ 'I18N::LangTags' => '0.35',
+ 'I18N::LangTags::Detect'=> '1.04',
+ 'I18N::LangTags::List' => '0.35',
+ 'I18N::Langinfo' => '0.03',
+ 'IO' => '1.25_02',
+ 'IO::Compress::Adapter::Bzip2'=> '2.024',
+ 'IO::Compress::Adapter::Deflate'=> '2.024',
+ 'IO::Compress::Adapter::Identity'=> '2.024',
+ 'IO::Compress::Base' => '2.024',
+ 'IO::Compress::Base::Common'=> '2.024',
+ 'IO::Compress::Bzip2' => '2.024',
+ 'IO::Compress::Deflate' => '2.024',
+ 'IO::Compress::Gzip' => '2.024',
+ 'IO::Compress::Gzip::Constants'=> '2.024',
+ 'IO::Compress::RawDeflate'=> '2.024',
+ 'IO::Compress::Zip' => '2.024',
+ 'IO::Compress::Zip::Constants'=> '2.024',
+ 'IO::Compress::Zlib::Constants'=> '2.024',
+ 'IO::Compress::Zlib::Extra'=> '2.024',
+ 'IO::Dir' => '1.07',
+ 'IO::File' => '1.14',
+ 'IO::Handle' => '1.28',
+ 'IO::Pipe' => '1.13',
+ 'IO::Poll' => '0.07',
+ 'IO::Seekable' => '1.10',
+ 'IO::Select' => '1.17',
+ 'IO::Socket' => '1.31',
+ 'IO::Socket::INET' => '1.31',
+ 'IO::Socket::UNIX' => '1.23',
+ 'IO::Uncompress::Adapter::Bunzip2'=> '2.024',
+ 'IO::Uncompress::Adapter::Identity'=> '2.024',
+ 'IO::Uncompress::Adapter::Inflate'=> '2.024',
+ 'IO::Uncompress::AnyInflate'=> '2.024',
+ 'IO::Uncompress::AnyUncompress'=> '2.024',
+ 'IO::Uncompress::Base' => '2.024',
+ 'IO::Uncompress::Bunzip2'=> '2.024',
+ 'IO::Uncompress::Gunzip'=> '2.024',
+ 'IO::Uncompress::Inflate'=> '2.024',
+ 'IO::Uncompress::RawInflate'=> '2.024',
+ 'IO::Uncompress::Unzip' => '2.024',
+ 'IO::Zlib' => '1.10',
+ 'IPC::Cmd' => '0.54',
+ 'IPC::Msg' => '2.01',
+ 'IPC::Open2' => '1.03',
+ 'IPC::Open3' => '1.05',
+ 'IPC::Semaphore' => '2.01',
+ 'IPC::SharedMem' => '2.01',
+ 'IPC::SysV' => '2.01',
+ 'List::Util' => '1.22',
+ 'List::Util::PP' => '1.22',
+ 'List::Util::XS' => '1.22',
+ 'Locale::Constants' => '2.07',
+ 'Locale::Country' => '2.07',
+ 'Locale::Currency' => '2.07',
+ 'Locale::Language' => '2.07',
+ 'Locale::Maketext' => '1.14',
+ 'Locale::Maketext::Guts'=> '1.13',
+ 'Locale::Maketext::GutsLoader'=> '1.13',
+ 'Locale::Maketext::Simple'=> '0.21',
+ 'Locale::Script' => '2.07',
+ 'Log::Message' => '0.02',
+ 'Log::Message::Config' => '0.01',
+ 'Log::Message::Handlers'=> undef,
+ 'Log::Message::Item' => undef,
+ 'Log::Message::Simple' => '0.06',
+ 'MIME::Base64' => '3.08',
+ 'MIME::QuotedPrint' => '3.08',
+ 'Math::BigFloat' => '1.60',
+ 'Math::BigFloat::Trace' => '0.01',
+ 'Math::BigInt' => '1.89_01',
+ 'Math::BigInt::Calc' => '0.52',
+ 'Math::BigInt::CalcEmu' => '0.05',
+ 'Math::BigInt::FastCalc'=> '0.19',
+ 'Math::BigInt::Trace' => '0.01',
+ 'Math::BigRat' => '0.24',
+ 'Math::Complex' => '1.56',
+ 'Math::Trig' => '1.2',
+ 'Memoize' => '1.01_03',
+ 'Memoize::AnyDBM_File' => '0.65',
+ 'Memoize::Expire' => '1.00',
+ 'Memoize::ExpireFile' => '1.01',
+ 'Memoize::ExpireTest' => '0.65',
+ 'Memoize::NDBM_File' => '0.65',
+ 'Memoize::SDBM_File' => '0.65',
+ 'Memoize::Storable' => '0.65',
+ 'Module::Build' => '0.3603',
+ 'Module::Build::Base' => '0.3603',
+ 'Module::Build::Compat' => '0.3603',
+ 'Module::Build::Config' => '0.3603',
+ 'Module::Build::ConfigData'=> undef,
+ 'Module::Build::Cookbook'=> '0.3603',
+ 'Module::Build::Dumper' => '0.3603',
+ 'Module::Build::ModuleInfo'=> '0.3603',
+ 'Module::Build::Notes' => '0.3603',
+ 'Module::Build::PPMMaker'=> '0.3603',
+ 'Module::Build::Platform::Amiga'=> '0.3603',
+ 'Module::Build::Platform::Default'=> '0.3603',
+ 'Module::Build::Platform::EBCDIC'=> '0.3603',
+ 'Module::Build::Platform::MPEiX'=> '0.3603',
+ 'Module::Build::Platform::MacOS'=> '0.3603',
+ 'Module::Build::Platform::RiscOS'=> '0.3603',
+ 'Module::Build::Platform::Unix'=> '0.3603',
+ 'Module::Build::Platform::VMS'=> '0.3603',
+ 'Module::Build::Platform::VOS'=> '0.3603',
+ 'Module::Build::Platform::Windows'=> '0.3603',
+ 'Module::Build::Platform::aix'=> '0.3603',
+ 'Module::Build::Platform::cygwin'=> '0.3603',
+ 'Module::Build::Platform::darwin'=> '0.3603',
+ 'Module::Build::Platform::os2'=> '0.3603',
+ 'Module::Build::PodParser'=> '0.3603',
+ 'Module::Build::Version'=> '0.77',
+ 'Module::Build::YAML' => '1.40',
+ 'Module::CoreList' => '2.32',
+ 'Module::Load' => '0.16',
+ 'Module::Load::Conditional'=> '0.34',
+ 'Module::Loaded' => '0.06',
+ 'Module::Pluggable' => '3.9',
+ 'Module::Pluggable::Object'=> '3.9',
+ 'Moped::Msg' => '0.01',
+ 'NDBM_File' => '1.08',
+ 'NEXT' => '0.64',
+ 'Net::Cmd' => '2.29',
+ 'Net::Config' => '1.11',
+ 'Net::Domain' => '2.20',
+ 'Net::FTP' => '2.77',
+ 'Net::FTP::A' => '1.18',
+ 'Net::FTP::E' => '0.01',
+ 'Net::FTP::I' => '1.12',
+ 'Net::FTP::L' => '0.01',
+ 'Net::FTP::dataconn' => '0.11',
+ 'Net::NNTP' => '2.24',
+ 'Net::Netrc' => '2.12',
+ 'Net::POP3' => '2.29',
+ 'Net::Ping' => '2.36',
+ 'Net::SMTP' => '2.31',
+ 'Net::Time' => '2.10',
+ 'Net::hostent' => '1.01',
+ 'Net::netent' => '1.00',
+ 'Net::protoent' => '1.00',
+ 'Net::servent' => '1.01',
+ 'O' => '1.01',
+ 'ODBM_File' => '1.07',
+ 'Object::Accessor' => '0.36',
+ 'Opcode' => '1.15',
+ 'POSIX' => '1.19',
+ 'Package::Constants' => '0.02',
+ 'Params::Check' => '0.26',
+ 'Parse::CPAN::Meta' => '1.40',
+ 'PerlIO' => '1.06',
+ 'PerlIO::encoding' => '0.12',
+ 'PerlIO::scalar' => '0.07',
+ 'PerlIO::via' => '0.09',
+ 'PerlIO::via::QuotedPrint'=> '0.06',
+ 'Pod::Checker' => '1.45',
+ 'Pod::Escapes' => '1.04',
+ 'Pod::Find' => '1.35',
+ 'Pod::Functions' => '1.04',
+ 'Pod::Html' => '1.09',
+ 'Pod::InputObjects' => '1.31',
+ 'Pod::LaTeX' => '0.58',
+ 'Pod::Man' => '2.23',
+ 'Pod::ParseLink' => '1.10',
+ 'Pod::ParseUtils' => '1.36',
+ 'Pod::Parser' => '1.37',
+ 'Pod::Perldoc' => '3.15_02',
+ 'Pod::Perldoc::BaseTo' => undef,
+ 'Pod::Perldoc::GetOptsOO'=> undef,
+ 'Pod::Perldoc::ToChecker'=> undef,
+ 'Pod::Perldoc::ToMan' => undef,
+ 'Pod::Perldoc::ToNroff' => undef,
+ 'Pod::Perldoc::ToPod' => undef,
+ 'Pod::Perldoc::ToRtf' => undef,
+ 'Pod::Perldoc::ToText' => undef,
+ 'Pod::Perldoc::ToTk' => undef,
+ 'Pod::Perldoc::ToXml' => undef,
+ 'Pod::PlainText' => '2.04',
+ 'Pod::Plainer' => '1.02',
+ 'Pod::Select' => '1.36',
+ 'Pod::Simple' => '3.14',
+ 'Pod::Simple::BlackBox' => '3.14',
+ 'Pod::Simple::Checker' => '3.14',
+ 'Pod::Simple::Debug' => '3.14',
+ 'Pod::Simple::DumpAsText'=> '3.14',
+ 'Pod::Simple::DumpAsXML'=> '3.14',
+ 'Pod::Simple::HTML' => '3.14',
+ 'Pod::Simple::HTMLBatch'=> '3.14',
+ 'Pod::Simple::HTMLLegacy'=> '5.01',
+ 'Pod::Simple::LinkSection'=> '3.14',
+ 'Pod::Simple::Methody' => '3.14',
+ 'Pod::Simple::Progress' => '3.14',
+ 'Pod::Simple::PullParser'=> '3.14',
+ 'Pod::Simple::PullParserEndToken'=> '3.14',
+ 'Pod::Simple::PullParserStartToken'=> '3.14',
+ 'Pod::Simple::PullParserTextToken'=> '3.14',
+ 'Pod::Simple::PullParserToken'=> '3.14',
+ 'Pod::Simple::RTF' => '3.14',
+ 'Pod::Simple::Search' => '3.14',
+ 'Pod::Simple::SimpleTree'=> '3.14',
+ 'Pod::Simple::Text' => '3.14',
+ 'Pod::Simple::TextContent'=> '3.14',
+ 'Pod::Simple::TiedOutFH'=> '3.14',
+ 'Pod::Simple::Transcode'=> '3.14',
+ 'Pod::Simple::TranscodeDumb'=> '3.14',
+ 'Pod::Simple::TranscodeSmart'=> '3.14',
+ 'Pod::Simple::XHTML' => '3.14',
+ 'Pod::Simple::XMLOutStream'=> '3.14',
+ 'Pod::Text' => '3.14',
+ 'Pod::Text::Color' => '2.06',
+ 'Pod::Text::Overstrike' => '2.04',
+ 'Pod::Text::Termcap' => '2.06',
+ 'Pod::Usage' => '1.36',
+ 'SDBM_File' => '1.06',
+ 'Safe' => '2.27',
+ 'Scalar::Util' => '1.22',
+ 'Scalar::Util::PP' => '1.22',
+ 'Search::Dict' => '1.02',
+ 'SelectSaver' => '1.02',
+ 'SelfLoader' => '1.17',
+ 'Shell' => '0.72_01',
+ 'Socket' => '1.87',
+ 'Storable' => '2.22',
+ 'Switch' => '2.16',
+ 'Symbol' => '1.07',
+ 'Sys::Hostname' => '1.11',
+ 'Sys::Syslog' => '0.27',
+ 'Sys::Syslog::win32::Win32'=> undef,
+ 'TAP::Base' => '3.17',
+ 'TAP::Formatter::Base' => '3.17',
+ 'TAP::Formatter::Color' => '3.17',
+ 'TAP::Formatter::Console'=> '3.17',
+ 'TAP::Formatter::Console::ParallelSession'=> '3.17',
+ 'TAP::Formatter::Console::Session'=> '3.17',
+ 'TAP::Formatter::File' => '3.17',
+ 'TAP::Formatter::File::Session'=> '3.17',
+ 'TAP::Formatter::Session'=> '3.17',
+ 'TAP::Harness' => '3.17',
+ 'TAP::Object' => '3.17',
+ 'TAP::Parser' => '3.17',
+ 'TAP::Parser::Aggregator'=> '3.17',
+ 'TAP::Parser::Grammar' => '3.17',
+ 'TAP::Parser::Iterator' => '3.17',
+ 'TAP::Parser::Iterator::Array'=> '3.17',
+ 'TAP::Parser::Iterator::Process'=> '3.17',
+ 'TAP::Parser::Iterator::Stream'=> '3.17',
+ 'TAP::Parser::IteratorFactory'=> '3.17',
+ 'TAP::Parser::Multiplexer'=> '3.17',
+ 'TAP::Parser::Result' => '3.17',
+ 'TAP::Parser::Result::Bailout'=> '3.17',
+ 'TAP::Parser::Result::Comment'=> '3.17',
+ 'TAP::Parser::Result::Plan'=> '3.17',
+ 'TAP::Parser::Result::Pragma'=> '3.17',
+ 'TAP::Parser::Result::Test'=> '3.17',
+ 'TAP::Parser::Result::Unknown'=> '3.17',
+ 'TAP::Parser::Result::Version'=> '3.17',
+ 'TAP::Parser::Result::YAML'=> '3.17',
+ 'TAP::Parser::ResultFactory'=> '3.17',
+ 'TAP::Parser::Scheduler'=> '3.17',
+ 'TAP::Parser::Scheduler::Job'=> '3.17',
+ 'TAP::Parser::Scheduler::Spinner'=> '3.17',
+ 'TAP::Parser::Source' => '3.17',
+ 'TAP::Parser::Source::Perl'=> '3.17',
+ 'TAP::Parser::Utils' => '3.17',
+ 'TAP::Parser::YAMLish::Reader'=> '3.17',
+ 'TAP::Parser::YAMLish::Writer'=> '3.17',
+ 'Term::ANSIColor' => '2.02',
+ 'Term::Cap' => '1.12',
+ 'Term::Complete' => '1.402',
+ 'Term::ReadLine' => '1.05',
+ 'Term::UI' => '0.20',
+ 'Term::UI::History' => undef,
+ 'Test' => '1.25_02',
+ 'Test::Builder' => '0.94',
+ 'Test::Builder::Module' => '0.94',
+ 'Test::Builder::Tester' => '1.18',
+ 'Test::Builder::Tester::Color'=> '1.18',
+ 'Test::Harness' => '3.17',
+ 'Test::More' => '0.94',
+ 'Test::Simple' => '0.94',
+ 'Text::Abbrev' => '1.01',
+ 'Text::Balanced' => '2.02',
+ 'Text::ParseWords' => '3.27',
+ 'Text::Soundex' => '3.03_01',
+ 'Text::Tabs' => '2009.0305',
+ 'Text::Wrap' => '2009.0305',
+ 'Thread' => '3.02',
+ 'Thread::Queue' => '2.11',
+ 'Thread::Semaphore' => '2.09',
+ 'Tie::Array' => '1.03',
+ 'Tie::File' => '0.97_02',
+ 'Tie::Handle' => '4.2',
+ 'Tie::Hash' => '1.03',
+ 'Tie::Hash::NamedCapture'=> '0.06',
+ 'Tie::Memoize' => '1.1',
+ 'Tie::RefHash' => '1.38',
+ 'Tie::Scalar' => '1.02',
+ 'Tie::StdHandle' => '4.2',
+ 'Tie::SubstrHash' => '1.00',
+ 'Time::HiRes' => '1.9719',
+ 'Time::Local' => '1.1901_01',
+ 'Time::Piece' => '1.15_01',
+ 'Time::Piece::Seconds' => undef,
+ 'Time::Seconds' => undef,
+ 'Time::gmtime' => '1.03',
+ 'Time::localtime' => '1.02',
+ 'Time::tm' => '1.00',
+ 'UNIVERSAL' => '1.06',
+ 'Unicode' => '5.2.0',
+ 'Unicode::Collate' => '0.52_01',
+ 'Unicode::Normalize' => '1.03',
+ 'Unicode::UCD' => '0.27',
+ 'User::grent' => '1.01',
+ 'User::pwent' => '1.00',
+ 'VMS::DCLsym' => '1.03',
+ 'VMS::Stdio' => '2.4',
+ 'Win32' => '0.39',
+ 'Win32API::File' => '0.1101',
+ 'Win32API::File::ExtUtils::Myconst2perl'=> '1',
+ 'Win32CORE' => '0.02',
+ 'XS::APItest' => '0.17',
+ 'XS::APItest::KeywordRPN'=> '0.003',
+ 'XS::Typemap' => '0.03',
+ 'XSLoader' => '0.10',
+ 'XSLoader::XSLoader' => '0.10',
+ 'attributes' => '0.12',
+ 'autodie' => '2.06_01',
+ 'autodie::exception' => '2.06_01',
+ 'autodie::exception::system'=> '2.06_01',
+ 'autodie::hints' => '2.06_01',
+ 'autouse' => '1.06',
+ 'base' => '2.15',
+ 'bigint' => '0.23',
+ 'bignum' => '0.23',
+ 'bigrat' => '0.23',
+ 'blib' => '1.04',
+ 'bytes' => '1.04',
+ 'charnames' => '1.07',
+ 'constant' => '1.20',
+ 'deprecate' => '0.01',
+ 'diagnostics' => '1.19',
+ 'encoding' => '2.6_01',
+ 'encoding::warnings' => '0.11',
+ 'feature' => '1.16',
+ 'fields' => '2.15',
+ 'filetest' => '1.02',
+ 'if' => '0.05',
+ 'inc::latest' => '0.3603',
+ 'integer' => '1.00',
+ 'less' => '0.03',
+ 'lib' => '0.62',
+ 'locale' => '1.00',
+ 'mro' => '1.02',
+ 'open' => '1.07',
+ 'ops' => '1.02',
+ 'overload' => '1.10',
+ 'overload::numbers' => undef,
+ 'overloading' => '0.01',
+ 'parent' => '0.223',
+ 're' => '0.11',
+ 'sigtrap' => '1.04',
+ 'sort' => '2.01',
+ 'strict' => '1.04',
+ 'subs' => '1.00',
+ 'threads' => '1.75',
+ 'threads::shared' => '1.32',
+ 'utf8' => '1.08',
+ 'vars' => '1.01',
+ 'version' => '0.82',
+ 'vmsish' => '1.02',
+ 'warnings' => '1.09',
+ 'warnings::register' => '1.01',
+ },
+);
+
+%deprecated = (
+ 5.011 => {
+ 'Class::ISA' => '1',
+ 'Pod::Plainer' => '1',
+ 'Shell' => '1',
+ 'Switch' => '1',
+ },
+ 5.011001 => {
+ 'Class::ISA' => '1',
+ 'Pod::Plainer' => '1',
+ 'Shell' => '1',
+ 'Switch' => '1',
+ },
+ 5.011002 => {
+ 'Class::ISA' => '1',
+ 'Pod::Plainer' => '1',
+ 'Shell' => '1',
+ 'Switch' => '1',
+ },
+ 5.011003 => {
+ 'Class::ISA' => '1',
+ 'Pod::Plainer' => '1',
+ 'Shell' => '1',
+ 'Switch' => '1',
+ },
+ 5.011004 => {
+ 'Class::ISA' => '1',
+ 'Pod::Plainer' => '1',
+ 'Shell' => '1',
+ 'Switch' => '1',
+ },
+ 5.011005 => {
+ 'Class::ISA' => '1',
+ 'Pod::Plainer' => '1',
+ 'Shell' => '1',
+ 'Switch' => '1',
+ },
+ 5.012000 => {
+ 'Class::ISA' => '1',
+ 'Pod::Plainer' => '1',
+ 'Shell' => '1',
+ 'Switch' => '1',
+ },
+ 5.013000 => {
+ 'Class::ISA' => '1',
+ 'Pod::Plainer' => '1',
+ 'Shell' => '1',
+ 'Switch' => '1',
+ },
+ 5.013000 => {
+ 'Class::ISA' => '1',
+ 'Pod::Plainer' => '1',
+ 'Shell' => '1',
+ 'Switch' => '1',
+ },
+ 5.012001 => {
+ 'Class::ISA' => '1',
+ 'Pod::Plainer' => '1',
+ 'Shell' => '1',
+ 'Switch' => '1',
+ },
+);
+
+%upstream = (
+ 'App::Cpan' => 'cpan',
+ 'App::Prove' => undef,
+ 'App::Prove::State' => undef,
+ 'App::Prove::State::Result'=> undef,
+ 'App::Prove::State::Result::Test'=> undef,
+ 'Archive::Extract' => 'cpan',
+ 'Archive::Tar' => 'cpan',
+ 'Archive::Tar::Constant'=> 'cpan',
+ 'Archive::Tar::File' => 'cpan',
+ 'Attribute::Handlers' => 'blead',
+ 'AutoLoader' => 'cpan',
+ 'AutoSplit' => 'cpan',
+ 'B::Concise' => undef,
+ 'B::Debug' => undef,
+ 'B::Deparse' => 'blead',
+ 'B::Lint' => undef,
+ 'B::Lint::Debug' => undef,
+ 'CGI' => 'cpan',
+ 'CGI::Apache' => 'cpan',
+ 'CGI::Carp' => 'cpan',
+ 'CGI::Cookie' => 'cpan',
+ 'CGI::Fast' => 'cpan',
+ 'CGI::Pretty' => 'cpan',
+ 'CGI::Push' => 'cpan',
+ 'CGI::Switch' => 'cpan',
+ 'CGI::Util' => 'cpan',
+ 'CPAN' => 'cpan',
+ 'CPAN::Author' => 'cpan',
+ 'CPAN::Bundle' => 'cpan',
+ 'CPAN::CacheMgr' => 'cpan',
+ 'CPAN::Complete' => 'cpan',
+ 'CPAN::Debug' => 'cpan',
+ 'CPAN::DeferredCode' => 'cpan',
+ 'CPAN::Distribution' => 'cpan',
+ 'CPAN::Distroprefs' => 'cpan',
+ 'CPAN::Distrostatus' => 'cpan',
+ 'CPAN::Exception::RecursiveDependency'=> 'cpan',
+ 'CPAN::Exception::blocked_urllist'=> 'cpan',
+ 'CPAN::Exception::yaml_not_installed'=> 'cpan',
+ 'CPAN::FTP' => 'cpan',
+ 'CPAN::FTP::netrc' => 'cpan',
+ 'CPAN::FirstTime' => 'cpan',
+ 'CPAN::HandleConfig' => 'cpan',
+ 'CPAN::Index' => 'cpan',
+ 'CPAN::InfoObj' => 'cpan',
+ 'CPAN::Kwalify' => 'cpan',
+ 'CPAN::LWP::UserAgent' => 'cpan',
+ 'CPAN::Mirrors' => 'cpan',
+ 'CPAN::Module' => 'cpan',
+ 'CPAN::Nox' => 'cpan',
+ 'CPAN::Prompt' => 'cpan',
+ 'CPAN::Queue' => 'cpan',
+ 'CPAN::Shell' => 'cpan',
+ 'CPAN::Tarzip' => 'cpan',
+ 'CPAN::URL' => 'cpan',
+ 'CPAN::Version' => 'cpan',
+ 'CPANPLUS' => 'cpan',
+ 'CPANPLUS::Backend' => 'cpan',
+ 'CPANPLUS::Backend::RV' => 'cpan',
+ 'CPANPLUS::Config' => 'cpan',
+ 'CPANPLUS::Configure' => 'cpan',
+ 'CPANPLUS::Configure::Setup'=> 'cpan',
+ 'CPANPLUS::Dist' => 'cpan',
+ 'CPANPLUS::Dist::Autobundle'=> 'cpan',
+ 'CPANPLUS::Dist::Base' => 'cpan',
+ 'CPANPLUS::Dist::Build' => 'cpan',
+ 'CPANPLUS::Dist::Build::Constants'=> 'cpan',
+ 'CPANPLUS::Dist::MM' => 'cpan',
+ 'CPANPLUS::Dist::Sample'=> 'cpan',
+ 'CPANPLUS::Error' => 'cpan',
+ 'CPANPLUS::Internals' => 'cpan',
+ 'CPANPLUS::Internals::Constants'=> 'cpan',
+ 'CPANPLUS::Internals::Constants::Report'=> 'cpan',
+ 'CPANPLUS::Internals::Extract'=> 'cpan',
+ 'CPANPLUS::Internals::Fetch'=> 'cpan',
+ 'CPANPLUS::Internals::Report'=> 'cpan',
+ 'CPANPLUS::Internals::Search'=> 'cpan',
+ 'CPANPLUS::Internals::Source'=> 'cpan',
+ 'CPANPLUS::Internals::Source::Memory'=> 'cpan',
+ 'CPANPLUS::Internals::Source::SQLite'=> 'cpan',
+ 'CPANPLUS::Internals::Source::SQLite::Tie'=> 'cpan',
+ 'CPANPLUS::Internals::Utils'=> 'cpan',
+ 'CPANPLUS::Internals::Utils::Autoflush'=> 'cpan',
+ 'CPANPLUS::Module' => 'cpan',
+ 'CPANPLUS::Module::Author'=> 'cpan',
+ 'CPANPLUS::Module::Author::Fake'=> 'cpan',
+ 'CPANPLUS::Module::Checksums'=> 'cpan',
+ 'CPANPLUS::Module::Fake'=> 'cpan',
+ 'CPANPLUS::Module::Signature'=> 'cpan',
+ 'CPANPLUS::Selfupdate' => 'cpan',
+ 'CPANPLUS::Shell' => 'cpan',
+ 'CPANPLUS::Shell::Classic'=> 'cpan',
+ 'CPANPLUS::Shell::Default'=> 'cpan',
+ 'CPANPLUS::Shell::Default::Plugins::CustomSource'=> 'cpan',
+ 'CPANPLUS::Shell::Default::Plugins::Remote'=> 'cpan',
+ 'CPANPLUS::Shell::Default::Plugins::Source'=> 'cpan',
+ 'Class::ISA' => 'cpan',
+ 'Compress::Raw::Bzip2' => undef,
+ 'Compress::Raw::Zlib' => undef,
+ 'Compress::Zlib' => 'cpan',
+ 'Cwd' => 'cpan',
+ 'DB_File' => undef,
+ 'Devel::InnerPackage' => 'cpan',
+ 'Devel::PPPort' => 'cpan',
+ 'Digest' => undef,
+ 'Digest::MD5' => undef,
+ 'Digest::SHA' => undef,
+ 'Digest::base' => undef,
+ 'Digest::file' => undef,
+ 'Encode' => undef,
+ 'Encode::Alias' => undef,
+ 'Encode::Byte' => undef,
+ 'Encode::CJKConstants' => undef,
+ 'Encode::CN' => undef,
+ 'Encode::CN::HZ' => undef,
+ 'Encode::Config' => undef,
+ 'Encode::EBCDIC' => undef,
+ 'Encode::Encoder' => undef,
+ 'Encode::Encoding' => undef,
+ 'Encode::GSM0338' => undef,
+ 'Encode::Guess' => undef,
+ 'Encode::JP' => undef,
+ 'Encode::JP::H2Z' => undef,
+ 'Encode::JP::JIS7' => undef,
+ 'Encode::KR' => undef,
+ 'Encode::KR::2022_KR' => undef,
+ 'Encode::MIME::Header' => undef,
+ 'Encode::MIME::Header::ISO_2022_JP'=> undef,
+ 'Encode::MIME::Name' => undef,
+ 'Encode::Symbol' => undef,
+ 'Encode::TW' => undef,
+ 'Encode::Unicode' => undef,
+ 'Encode::Unicode::UTF7' => undef,
+ 'Exporter' => 'blead',
+ 'Exporter::Heavy' => 'blead',
+ 'ExtUtils::CBuilder' => 'cpan',
+ 'ExtUtils::CBuilder::Base'=> 'cpan',
+ 'ExtUtils::CBuilder::Platform::Unix'=> 'cpan',
+ 'ExtUtils::CBuilder::Platform::VMS'=> 'cpan',
+ 'ExtUtils::CBuilder::Platform::Windows'=> 'cpan',
+ 'ExtUtils::CBuilder::Platform::Windows::BCC'=> 'cpan',
+ 'ExtUtils::CBuilder::Platform::Windows::GCC'=> 'cpan',
+ 'ExtUtils::CBuilder::Platform::Windows::MSVC'=> 'cpan',
+ 'ExtUtils::CBuilder::Platform::aix'=> 'cpan',
+ 'ExtUtils::CBuilder::Platform::cygwin'=> 'cpan',
+ 'ExtUtils::CBuilder::Platform::darwin'=> 'cpan',
+ 'ExtUtils::CBuilder::Platform::dec_osf'=> 'cpan',
+ 'ExtUtils::CBuilder::Platform::os2'=> 'cpan',
+ 'ExtUtils::Command' => undef,
+ 'ExtUtils::Command::MM' => 'first-come',
+ 'ExtUtils::Constant' => undef,
+ 'ExtUtils::Constant::Base'=> undef,
+ 'ExtUtils::Constant::ProxySubs'=> undef,
+ 'ExtUtils::Constant::Utils'=> undef,
+ 'ExtUtils::Constant::XS'=> undef,
+ 'ExtUtils::Install' => 'blead',
+ 'ExtUtils::Installed' => 'blead',
+ 'ExtUtils::Liblist' => 'first-come',
+ 'ExtUtils::Liblist::Kid'=> 'first-come',
+ 'ExtUtils::MM' => 'first-come',
+ 'ExtUtils::MM_AIX' => 'first-come',
+ 'ExtUtils::MM_Any' => 'first-come',
+ 'ExtUtils::MM_BeOS' => 'first-come',
+ 'ExtUtils::MM_Cygwin' => 'first-come',
+ 'ExtUtils::MM_DOS' => 'first-come',
+ 'ExtUtils::MM_Darwin' => 'first-come',
+ 'ExtUtils::MM_MacOS' => 'first-come',
+ 'ExtUtils::MM_NW5' => 'first-come',
+ 'ExtUtils::MM_OS2' => 'first-come',
+ 'ExtUtils::MM_QNX' => 'first-come',
+ 'ExtUtils::MM_UWIN' => 'first-come',
+ 'ExtUtils::MM_Unix' => 'first-come',
'ExtUtils::MM_VMS' => 'first-come',
'ExtUtils::MM_VOS' => 'first-come',
'ExtUtils::MM_Win32' => 'first-come',
'Log::Message::Handlers'=> 'cpan',
'Log::Message::Item' => 'cpan',
'Log::Message::Simple' => 'cpan',
- 'MIME::Base64' => undef,
- 'MIME::QuotedPrint' => undef,
+ 'MIME::Base64' => 'cpan',
+ 'MIME::QuotedPrint' => 'cpan',
'Math::BigFloat' => undef,
'Math::BigFloat::Trace' => undef,
'Math::BigInt' => undef,
'Module::Load' => 'cpan',
'Module::Load::Conditional'=> 'cpan',
'Module::Loaded' => 'cpan',
- 'Module::Pluggable' => undef,
- 'Module::Pluggable::Object'=> undef,
+ 'Module::Pluggable' => 'cpan',
+ 'Module::Pluggable::Object'=> 'cpan',
'NEXT' => 'cpan',
'Net::Cmd' => undef,
'Net::Config' => undef,
'Memoize::NDBM_File' => undef,
'Memoize::SDBM_File' => undef,
'Memoize::Storable' => undef,
- 'Module::Build' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build',
- 'Module::Build::Base' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build',
- 'Module::Build::Compat' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build',
- 'Module::Build::Config' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build',
- 'Module::Build::Cookbook'=> 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build',
- 'Module::Build::Dumper' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build',
- 'Module::Build::ModuleInfo'=> 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build',
- 'Module::Build::Notes' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build',
- 'Module::Build::PPMMaker'=> 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build',
- 'Module::Build::Platform::Amiga'=> 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build',
- 'Module::Build::Platform::Default'=> 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build',
- 'Module::Build::Platform::EBCDIC'=> 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build',
- 'Module::Build::Platform::MPEiX'=> 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build',
- 'Module::Build::Platform::MacOS'=> 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build',
- 'Module::Build::Platform::RiscOS'=> 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build',
- 'Module::Build::Platform::Unix'=> 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build',
- 'Module::Build::Platform::VMS'=> 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build',
- 'Module::Build::Platform::VOS'=> 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build',
- 'Module::Build::Platform::Windows'=> 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build',
- 'Module::Build::Platform::aix'=> 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build',
- 'Module::Build::Platform::cygwin'=> 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build',
- 'Module::Build::Platform::darwin'=> 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build',
- 'Module::Build::Platform::os2'=> 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build',
- 'Module::Build::PodParser'=> 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build',
- 'Module::Build::Version'=> 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build',
- 'Module::Build::YAML' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build',
+ 'Module::Build' => undef,
+ 'Module::Build::Base' => undef,
+ 'Module::Build::Compat' => undef,
+ 'Module::Build::Config' => undef,
+ 'Module::Build::Cookbook'=> undef,
+ 'Module::Build::Dumper' => undef,
+ 'Module::Build::ModuleInfo'=> undef,
+ 'Module::Build::Notes' => undef,
+ 'Module::Build::PPMMaker'=> undef,
+ 'Module::Build::Platform::Amiga'=> undef,
+ 'Module::Build::Platform::Default'=> undef,
+ 'Module::Build::Platform::EBCDIC'=> undef,
+ 'Module::Build::Platform::MPEiX'=> undef,
+ 'Module::Build::Platform::MacOS'=> undef,
+ 'Module::Build::Platform::RiscOS'=> undef,
+ 'Module::Build::Platform::Unix'=> undef,
+ 'Module::Build::Platform::VMS'=> undef,
+ 'Module::Build::Platform::VOS'=> undef,
+ 'Module::Build::Platform::Windows'=> undef,
+ 'Module::Build::Platform::aix'=> undef,
+ 'Module::Build::Platform::cygwin'=> undef,
+ 'Module::Build::Platform::darwin'=> undef,
+ 'Module::Build::Platform::os2'=> undef,
+ 'Module::Build::PodParser'=> undef,
+ 'Module::Build::Version'=> undef,
+ 'Module::Build::YAML' => undef,
'Module::CoreList' => undef,
'Module::Load' => undef,
'Module::Load::Conditional'=> undef,
'encoding::warnings' => undef,
'fields' => undef,
'if' => undef,
- 'inc::latest' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build',
+ 'inc::latest' => undef,
'lib' => undef,
'parent' => undef,
'threads' => undef,
$released{'5.000'} = $released{5};
$released{'5.010000'} = $released{5.01};
$released{'5.011000'} = $released{5.011};
+$released{'5.012000'} = $released{5.012};
+$released{'5.013000'} = $released{5.013};
$version{'5.000'} = $version{5};
$version{'5.010000'} = $version{5.01};
$version{'5.011000'} = $version{5.011};
+$version{'5.012000'} = $version{5.012};
+$version{'5.013000'} = $version{5.013};
$deprecated{'5.011000'} = $deprecated{5.011};
+$deprecated{'5.012000'} = $deprecated{5.012};
+$deprecated{'5.013000'} = $deprecated{5.013};
1;
__END__
#!perl -w
use strict;
use Module::CoreList;
-use Test::More tests => 13;
+use Test::More tests => 24;
BEGIN { require_ok('Module::CoreList'); }
is(Module::CoreList->first_release('File::Spec', 0.82), 5.006_001,
"File::Spec reached 0.82 with 5.006_001");
+is(Module::CoreList::first_release_by_date('File::Spec'), 5.005,
+ "File::Spec was first bundled in 5.005");
+
+is(Module::CoreList::first_release('File::Spec'), 5.00405,
+ "File::Spec was released in perl with lowest version number 5.00405");
+
+is(Module::CoreList::first_release('File::Spec', 0.82), 5.006_001,
+ "File::Spec reached 0.82 with 5.006_001");
+
is_deeply([ sort keys %Module::CoreList::released ],
[ sort keys %Module::CoreList::version ],
"have a note of everythings release");
}
is( $consistent, 1,
"families seem consistent (descendants have same modules as ancestors)" );
+
+# Check the function API for consistency
+
+is(Module::CoreList->first_release_by_date('Module::CoreList'), 5.009002,
+ "Module::CoreList was first bundled in 5.009002");
+
+is(Module::CoreList->first_release('Module::CoreList'), 5.008009,
+ "Module::CoreList was released in perl with lowest version number 5.008009");
+
+is(Module::CoreList->first_release('Module::CoreList', 2.18), 5.010001,
+ "Module::CoreList reached 2.18 with 5.010001");
+
+is(Module::CoreList::first_release_by_date('Module::CoreList'), 5.009002,
+ "Module::CoreList was first bundled in 5.009002");
+
+is(Module::CoreList::first_release('Module::CoreList'), 5.008009,
+ "Module::CoreList was released in perl with lowest version number 5.008009");
+
+is(Module::CoreList::first_release('Module::CoreList', 2.18), 5.010001,
+ "Module::CoreList reached 2.18 with 5.010001");
+
+is(Module::CoreList->removed_from('CPANPLUS::inc'), 5.010001,
+ "CPANPLUS::inc was removed from 5.010001");
+
+is(Module::CoreList::removed_from('CPANPLUS::inc'), 5.010001,
+ "CPANPLUS::inc was removed from 5.010001");
+
#!perl -w
use strict;
use Module::CoreList;
-use Test::More tests => 5;
+use Test::More tests => 6;
BEGIN { require_ok('Module::CoreList'); }
is_deeply([ Module::CoreList->find_modules(qr/Test::H.*::.*s/, 5.006001, 5.007003) ],
[ qw(Test::Harness::Assert Test::Harness::Straps) ],
'qr/Test::H.*::.*s/ at 5.006001 and 5.007003');
+
+is_deeply([ Module::CoreList::find_modules(qr/Module::CoreList/) ], [ qw(Module::CoreList) ],
+ 'Module::CoreList functional' );
use vars qw($VERSION @Pagers $Bindir $Pod2man
$Temp_Files_Created $Temp_File_Lifetime
);
-$VERSION = '3.15_01';
+$VERSION = '3.15_02';
#..........................................................................
BEGIN { # Make a DEBUG constant very first thing...
Usage: $me [-h] [-V] [-r] [-i] [-D] [-t] [-u] [-m] [-n nroffer_program] [-l] [-T] [-d output_filename] [-o output_format] [-M FormatterModuleNameToUse] [-w formatter_option:option_value] [-L translation_code] [-F] [-X] PageName|ModuleName|ProgramName
$me -f PerlFunc
$me -q FAQKeywords
- $me -A PerlVar
+ $me -v PerlVar
The -h option prints more help. Also try "perldoc perldoc" to get
acquainted with the system. [Perldoc v$VERSION]
+++ /dev/null
-package Pod::Plainer;
-use 5.006;
-use strict;
-use warnings;
-use if $] >= 5.011, 'deprecate';
-use Pod::Parser;
-our @ISA = qw(Pod::Parser);
-our $VERSION = '1.01';
-
-our %E = qw( < lt > gt );
-
-sub escape_ltgt {
- (undef, my $text) = @_;
- $text =~ s/([<>])/E<$E{$1}>/g;
- $text
-}
-
-sub simple_delimiters {
- (undef, my $seq) = @_;
- $seq -> left_delimiter( '<' );
- $seq -> right_delimiter( '>' );
- $seq;
-}
-
-sub textblock {
- my($parser,$text,$line) = @_;
- print {$parser->output_handle()}
- $parser->parse_text(
- { -expand_text => q(escape_ltgt),
- -expand_seq => q(simple_delimiters) },
- $text, $line ) -> raw_text();
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-Pod::Plainer - Perl extension for converting Pod to old-style Pod.
-
-=head1 SYNOPSIS
-
- use Pod::Plainer;
-
- my $parser = Pod::Plainer -> new ();
- $parser -> parse_from_filehandle(\*STDIN);
-
-=head1 DESCRIPTION
-
-Pod::Plainer uses Pod::Parser which takes Pod with the (new)
-'CE<lt>E<lt> .. E<gt>E<gt>' constructs
-and returns the old(er) style with just 'CE<lt>E<gt>';
-'<' and '>' are replaced by 'EE<lt>ltE<gt>' and 'EE<lt>gtE<gt>'.
-
-This can be used to pre-process Pod before using tools which do not
-recognise the new style Pods.
-
-=head2 METHODS
-
-=over
-
-=item escape_ltgt
-
-Replace '<' and '>' by 'EE<lt>ltE<gt>' and 'EE<lt>gtE<gt>'.
-
-=item simple_delimiters
-
-Replace delimiters by 'E<lt>' and 'E<gt>'.
-
-=item textblock
-
-Redefine C<textblock> from L<Pod::Parser> to use C<escape_ltgt>
-and C<simple_delimiters>.
-
-=back
-
-=head2 EXPORT
-
-None by default.
-
-=head1 AUTHOR
-
-Robin Barker, rmb1@npl.co.uk
-
-=head1 SEE ALSO
-
-See L<Pod::Parser>.
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2009 by Robin Barker
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself, either Perl version 5.10.1 or,
-at your option, any later version of Perl 5 you may have available.
-
-=cut
-
-$Id: Plainer.pm 250 2009-09-20 18:02:00Z rmb1 $
+++ /dev/null
-#!./perl
-
-use Pod::Plainer;
-my $parser = Pod::Plainer->new();
-my $header = "=pod\n\n";
-my $input = 'plnr_in.pod';
-my $output = 'plnr_out.pod';
-
-my $test = 0;
-print "1..7\n";
-while( <DATA> ) {
- my $expected = $header.<DATA>;
-
- open(IN, '>', $input) or die $!;
- print IN $header, $_;
- close IN or die $!;
-
- open IN, '<', $input or die $!;
- open OUT, '>', $output or die $!;
- $parser->parse_from_filehandle(\*IN,\*OUT);
-
- open OUT, '<', $output or die $!;
- my $returned; { local $/; $returned = <OUT>; }
-
- unless( $returned eq $expected ) {
- print map { s/^/\#/mg; $_; }
- map {+$_} # to avoid readonly values
- "EXPECTED:\n", $expected, "GOT:\n", $returned;
- print "not ";
- }
- printf "ok %d\n", ++$test;
- close OUT;
- close IN;
-}
-
-END {
- 1 while unlink $input;
- 1 while unlink $output;
-}
-
-# $Id: plainer.t 247 2009-09-15 18:33:34Z rmb1 $
-
-__END__
-=head <> now reads in records
-=head E<lt>E<gt> now reads in records
-=item C<-T> and C<-B> not implemented on filehandles
-=item C<-T> and C<-B> not implemented on filehandles
-e.g. C<< Foo->bar() >> or C<< $obj->bar() >>
-e.g. C<Foo-E<gt>bar()> or C<$obj-E<gt>bar()>
-The C<< => >> operator is mostly just a more visually distinctive
-The C<=E<gt>> operator is mostly just a more visually distinctive
-C<uv < 0x80> in which case you can use C<*s = uv>.
-C<uv E<lt> 0x80> in which case you can use C<*s = uv>.
-C<time ^ ($$ + ($$ << 15))>), but that isn't necessary any more.
-C<time ^ ($$ + ($$ E<lt>E<lt> 15))>), but that isn't necessary any more.
-The bitwise operation C<<< >> >>>
-The bitwise operation C<E<gt>E<gt>>
+2.27 Thu Apr 29 2010
+ - Wrap coderefs returned by reval() and rdo()
+ - Add even more version::vxs routines to the default share
+
+2.26 Mon Mar 9 2010
+ - Restore compatibility with perls < 5.8.9
+
+2.25 Sun Mar 7 2010
+ - More security fixes by Nick Cleaton
+
+2.24 Sat Mar 6 2010
+ - Clean the stashes from the Safe compartment after evaluation of code.
+ (Nick Cleaton, Tim Bunce, Rafael Garcia-Suarez)
+ - Add methods wrap_code_ref and wrap_code_refs_within (Tim Bunce)
+ - Share SWASHGET in perls < 5.10 (R.G-S)
+ - Add more version::vxs routines to the default share (Tatsuhiko Miyagawa)
+
+2.23 Mon Feb 22 2010
+ - Install Safe in "site" instead of "perl" for perls > 5.10
+ - [perl #72942] Can't perform unicode operations in Safe compartment
+ (Tim Bunce)
+ - Add some symbols from version::vxs to the default share
+
+2.22 Thu Feb 11 2010
+ fix [perl #72700]: An exception thrown from a closure was getting lost.
+ (Tim Bunce)
+
+2.21 Thu Jan 14 2010
+ fix [perl #72068]: An anonymous sub created by the Safe container will have
+ bogus arguments passed to it.
+
2.20 Tue Dec 1 2009
fix [rt.cpan.org #51574] Safe.pm sort {} bug accessing $a and $b with
-Dusethreads (Tim Bunce)
t/safeops.t
t/safesort.t
t/safeuniversal.t
+t/safeutf8.t
+t/safewrap.t
META.yml Module meta-data (added by MakeMaker)
--- #YAML:1.0
-name: Safe
-version: 2.20
-abstract: ~
-license: ~
-author: ~
-generated_by: ExtUtils::MakeMaker version 6.42
-distribution_type: module
-requires:
+name: Safe
+version: 2.27
+abstract: ~
+author: []
+license: unknown
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+build_requires:
+ ExtUtils::MakeMaker: 0
+requires: {}
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.56
meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.3.html
- version: 1.3
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
WriteMakefile(
NAME => 'Safe',
VERSION_FROM => 'Safe.pm',
- INSTALLDIRS => 'perl',
+ INSTALLDIRS => ($] < 5.011 ? 'perl' : 'site'),
($core || $] >= 5.011) ? () : (INST_LIB => '$(INST_ARCHLIB)'),
);
use 5.003_11;
use strict;
use Scalar::Util qw(reftype);
-use Config qw(%Config);
-use constant is_usethreads => $Config{usethreads};
-$Safe::VERSION = "2.20";
+$Safe::VERSION = "2.27";
# *** Don't declare any lexicals above this point ***
#
# see any lexicals in scope (apart from __ExPr__ which is unavoidable)
sub lexless_anon_sub {
- # $_[0] is package;
- # $_[1] is strict flag;
+ # $_[0] is package;
+ # $_[1] is strict flag;
my $__ExPr__ = $_[2]; # must be a lexical to create the closure that
- # can be used to pass the value into the safe
- # world
+ # can be used to pass the value into the safe
+ # world
# Create anon sub ref in root of compartment.
# Uses a closure (on $__ExPr__) to pass in the code to be executed.
# (eval on one line to keep line numbers as expected by caller)
eval sprintf
'package %s; %s strict; sub { @_=(); eval q[my $__ExPr__;] . $__ExPr__; }',
- $_[0], $_[1] ? 'use' : 'no';
+ $_[0], $_[1] ? 'use' : 'no';
}
use Carp;
use Carp::Heavy;
} }
+use B ();
+BEGIN {
+ no strict 'refs';
+ if (defined &B::sub_generation) {
+ *sub_generation = \&B::sub_generation;
+ }
+ else {
+ # fake sub generation changing for perls < 5.8.9
+ my $sg; *sub_generation = sub { ++$sg };
+ }
+}
+
use Opcode 1.01, qw(
opset opset_to_ops opmask_add
empty_opset full_opset invert_opset verify_opset
*ops_to_opset = \&opset; # Temporary alias for old Penguins
+# Regular expressions and other unicode-aware code may need to call
+# utf8->SWASHNEW (via perl's utf8.c). That will fail unless we share the
+# SWASHNEW method.
+# Sadly we can't just add utf8::SWASHNEW to $default_share because perl's
+# utf8.c code does a fetchmethod on SWASHNEW to check if utf8.pm is loaded,
+# and sharing makes it look like the method exists.
+# The simplest and most robust fix is to ensure the utf8 module is loaded when
+# Safe is loaded. Then we can add utf8::SWASHNEW to $default_share.
+require utf8;
+# we must ensure that utf8_heavy.pl, where SWASHNEW is defined, is loaded
+# but without depending on knowledge of that implementation detail.
+# This code (//i on a unicode string) ensures utf8 is fully loaded
+# and also loads the ToFold SWASH.
+# (Swashes are cached internally by perl in PL_utf8_* variables
+# independent of being inside/outside of Safe. So once loaded they can be)
+do { my $a = pack('U',0xC4); my $b = chr 0xE4; utf8::upgrade $b; $a =~ /$b/i };
+# now we can safely include utf8::SWASHNEW in $default_share defined below.
my $default_root = 0;
# share *_ and functions defined in universal.c
&utf8::downgrade
&utf8::native_to_unicode
&utf8::unicode_to_native
+ &utf8::SWASHNEW
$version::VERSION
$version::CLASS
+ $version::STRICT
+ $version::LAX
@version::ISA
-], ($] >= 5.008001 && qw[
+], ($] < 5.010 && qw[
+ &utf8::SWASHGET
+]), ($] >= 5.008001 && qw[
&Regexp::DESTROY
]), ($] >= 5.010 && qw[
&re::is_regexp
&version::noop
&version::is_alpha
&version::qv
+ &version::vxs::declare
+ &version::vxs::qv
+ &version::vxs::_VERSION
+ &version::vxs::stringify
+ &version::vxs::new
+ &version::vxs::parse
]), ($] >= 5.011 && qw[
&re::regexp_pattern
])];
bless $obj, $class;
if (defined($root)) {
- croak "Can't use \"$root\" as root name"
- if $root =~ /^main\b/ or $root !~ /^\w[:\w]*$/;
- $obj->{Root} = $root;
- $obj->{Erase} = 0;
+ croak "Can't use \"$root\" as root name"
+ if $root =~ /^main\b/ or $root !~ /^\w[:\w]*$/;
+ $obj->{Root} = $root;
+ $obj->{Erase} = 0;
}
else {
- $obj->{Root} = "Safe::Root".$default_root++;
- $obj->{Erase} = 1;
+ $obj->{Root} = "Safe::Root".$default_root++;
+ $obj->{Erase} = 1;
}
# use permit/deny methods instead till interface issues resolved
# the whole glob *_ rather than $_ and @_ separately, otherwise
# @_ in non default packages within the compartment don't work.
$obj->share_from('main', $default_share);
+
Opcode::_safe_pkg_prep($obj->{Root}) if($Opcode::VERSION > 1.04);
+
return $obj;
}
my ($stem, $leaf);
no strict 'refs';
- $pkg = "main::$pkg\::"; # expand to full symbol table name
+ $pkg = "main::$pkg\::"; # expand to full symbol table name
($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/;
# The 'my $foo' is needed! Without it you get an
#warn "erase($pkg) stem=$stem, leaf=$leaf";
#warn " stem_symtab hash ".scalar(%$stem_symtab)."\n";
- # ", join(', ', %$stem_symtab),"\n";
+ # ", join(', ', %$stem_symtab),"\n";
# delete $stem_symtab->{$leaf};
}
-
sub share {
my($obj, @vars) = @_;
$obj->share_from(scalar(caller), \@vars);
}
+
sub share_from {
my $obj = shift;
my $pkg = shift;
no strict 'refs';
# Check that 'from' package actually exists
croak("Package \"$pkg\" does not exist")
- unless keys %{"$pkg\::"};
+ unless keys %{"$pkg\::"};
my $arg;
foreach $arg (@$vars) {
- # catch some $safe->share($var) errors:
- my ($var, $type);
- $type = $1 if ($var = $arg) =~ s/^(\W)//;
- # warn "share_from $pkg $type $var";
- for (1..2) { # assign twice to avoid any 'used once' warnings
- *{$root."::$var"} = (!$type) ? \&{$pkg."::$var"}
- : ($type eq '&') ? \&{$pkg."::$var"}
- : ($type eq '$') ? \${$pkg."::$var"}
- : ($type eq '@') ? \@{$pkg."::$var"}
- : ($type eq '%') ? \%{$pkg."::$var"}
- : ($type eq '*') ? *{$pkg."::$var"}
- : croak(qq(Can't share "$type$var" of unknown type));
- }
+ # catch some $safe->share($var) errors:
+ my ($var, $type);
+ $type = $1 if ($var = $arg) =~ s/^(\W)//;
+ # warn "share_from $pkg $type $var";
+ for (1..2) { # assign twice to avoid any 'used once' warnings
+ *{$root."::$var"} = (!$type) ? \&{$pkg."::$var"}
+ : ($type eq '&') ? \&{$pkg."::$var"}
+ : ($type eq '$') ? \${$pkg."::$var"}
+ : ($type eq '@') ? \@{$pkg."::$var"}
+ : ($type eq '%') ? \%{$pkg."::$var"}
+ : ($type eq '*') ? *{$pkg."::$var"}
+ : croak(qq(Can't share "$type$var" of unknown type));
+ }
}
$obj->share_record($pkg, $vars) unless $no_record or !$vars;
}
+
sub share_record {
my $obj = shift;
my $pkg = shift;
# Record shares using keys of $obj->{Shares}. See reinit.
@{$shares}{@$vars} = ($pkg) x @$vars if @$vars;
}
+
+
sub share_redo {
my $obj = shift;
my $shares = \%{$obj->{Shares} ||= {}};
my($var, $pkg);
while(($var, $pkg) = each %$shares) {
- # warn "share_redo $pkg\:: $var";
- $obj->share_from($pkg, [ $var ], 1);
+ # warn "share_redo $pkg\:: $var";
+ $obj->share_from($pkg, [ $var ], 1);
}
}
+
+
sub share_forget {
delete shift->{Shares};
}
+
sub varglob {
my ($obj, $var) = @_;
no strict 'refs';
return *{$obj->root()."::$var"};
}
+sub _clean_stash {
+ my ($root, $saved_refs) = @_;
+ $saved_refs ||= [];
+ no strict 'refs';
+ foreach my $hook (qw(DESTROY AUTOLOAD), grep /^\(/, keys %$root) {
+ push @$saved_refs, \*{$root.$hook};
+ delete ${$root}{$hook};
+ }
+
+ for (grep /::$/, keys %$root) {
+ next if \%{$root.$_} eq \%$root;
+ _clean_stash($root.$_, $saved_refs);
+ }
+}
sub reval {
my ($obj, $expr, $strict) = @_;
my $root = $obj->{Root};
my $evalsub = lexless_anon_sub($root, $strict, $expr);
- my @ret = (wantarray)
- ? Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub)
- : scalar Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub);
+ # propagate context
+ my $sg = sub_generation();
+ my @subret = (wantarray)
+ ? Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub)
+ : scalar Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub);
+ _clean_stash($root.'::') if $sg != sub_generation();
+ $obj->wrap_code_refs_within(@subret);
+ return (wantarray) ? @subret : $subret[0];
+}
- # RT#60374: Safe.pm sort {} bug with -Dusethreads
- # If the Safe eval returns a code ref in a perl compiled with usethreads
- # then wrap code ref with _safe_call_sv so that, when called, the
- # execution will happen with the compartment fully 'in effect'.
- # Needed to fix sort blocks that reference $a & $b and
- # possibly other subtle issues.
- if (is_usethreads()) {
- for my $ret (@ret) { # edit (via alias) any CODE refs
- next unless (reftype($ret)||'') eq 'CODE';
- my $sub = $ret; # avoid closure problems
- $ret = sub { Opcode::_safe_call_sv($root, $obj->{Mask}, $sub) };
+
+sub wrap_code_refs_within {
+ my $obj = shift;
+
+ $obj->_find_code_refs('wrap_code_ref', @_);
+}
+
+
+sub _find_code_refs {
+ my $obj = shift;
+ my $visitor = shift;
+
+ for my $item (@_) {
+ my $reftype = $item && reftype $item
+ or next;
+ if ($reftype eq 'ARRAY') {
+ $obj->_find_code_refs($visitor, @$item);
+ }
+ elsif ($reftype eq 'HASH') {
+ $obj->_find_code_refs($visitor, values %$item);
+ }
+ # XXX GLOBs?
+ elsif ($reftype eq 'CODE') {
+ $item = $obj->$visitor($item);
}
}
+}
+
+
+sub wrap_code_ref {
+ my ($obj, $sub) = @_;
+
+ # wrap code ref $sub with _safe_call_sv so that, when called, the
+ # execution will happen with the compartment fully 'in effect'.
+
+ croak "Not a CODE reference"
+ if reftype $sub ne 'CODE';
+
+ my $ret = sub {
+ my @args = @_; # lexical to close over
+ my $sub_with_args = sub { $sub->(@args) };
+
+ my @subret;
+ my $error;
+ do {
+ local $@; # needed due to perl_call_sv(sv, G_EVAL|G_KEEPERR)
+ my $sg = sub_generation();
+ @subret = (wantarray)
+ ? Opcode::_safe_call_sv($obj->{Root}, $obj->{Mask}, $sub_with_args)
+ : scalar Opcode::_safe_call_sv($obj->{Root}, $obj->{Mask}, $sub_with_args);
+ $error = $@;
+ _clean_stash($obj->{Root}.'::') if $sg != sub_generation();
+ };
+ if ($error) { # rethrow exception
+ $error =~ s/\t\(in cleanup\) //; # prefix added by G_KEEPERR
+ die $error;
+ }
+ return (wantarray) ? @subret : $subret[0];
+ };
- return (wantarray) ? @ret : $ret[0];
+ return $ret;
}
+
sub rdo {
my ($obj, $file) = @_;
my $root = $obj->{Root};
+ my $sg = sub_generation();
my $evalsub = eval
- sprintf('package %s; sub { @_ = (); do $file }', $root);
- return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub);
+ sprintf('package %s; sub { @_ = (); do $file }', $root);
+ my @subret = (wantarray)
+ ? Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub)
+ : scalar Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub);
+ _clean_stash($root.'::') if $sg != sub_generation();
+ $obj->wrap_code_refs_within(@subret);
+ return (wantarray) ? @subret : $subret[0];
}
Your mileage will vary. If in any doubt B<do not use it>.
-=head2 RECENT CHANGES
-
-The interface to the Safe module has changed quite dramatically since
-version 1 (as supplied with Perl5.002). Study these pages carefully if
-you have code written to use Safe version 1 because you will need to
-makes changes.
-
-
-=head2 Methods in class Safe
+=head1 METHODS
To create a new compartment, use
is implicit in each case.
-=over 8
-
-=item permit (OP, ...)
+=head2 permit (OP, ...)
Permit the listed operators to be used when compiling code in the
compartment (in I<addition> to any operators already permitted).
You can list opcodes by names, or use a tag name; see
L<Opcode/"Predefined Opcode Tags">.
-=item permit_only (OP, ...)
+=head2 permit_only (OP, ...)
Permit I<only> the listed operators to be used when compiling code in
the compartment (I<no> other operators are permitted).
-=item deny (OP, ...)
+=head2 deny (OP, ...)
Deny the listed operators from being used when compiling code in the
compartment (other operators may still be permitted).
-=item deny_only (OP, ...)
+=head2 deny_only (OP, ...)
Deny I<only> the listed operators from being used when compiling code
-in the compartment (I<all> other operators will be permitted).
+in the compartment (I<all> other operators will be permitted, so you probably
+don't want to use this method).
-=item trap (OP, ...)
+=head2 trap (OP, ...)
-=item untrap (OP, ...)
+=head2 untrap (OP, ...)
The trap and untrap methods are synonyms for deny and permit
respectfully.
-=item share (NAME, ...)
+=head2 share (NAME, ...)
This shares the variable(s) in the argument list with the compartment.
This is almost identical to exporting variables using the L<Exporter>
including scalar, array, hash, sub and filehandle).
Each NAME is assumed to be in the calling package. See share_from
-for an alternative method (which share uses).
+for an alternative method (which C<share> uses).
-=item share_from (PACKAGE, ARRAYREF)
+=head2 share_from (PACKAGE, ARRAYREF)
This method is similar to share() but allows you to explicitly name the
package that symbols should be shared from. The symbol names (including
$safe->share_from('main', [ '$foo', '%bar', 'func' ]);
+Names can include package names, which are relative to the specified PACKAGE.
+So these two calls have the same effect:
+
+ $safe->share_from('Scalar::Util', [ 'reftype' ]);
+ $safe->share_from('main', [ 'Scalar::Util::reftype' ]);
-=item varglob (VARNAME)
+=head2 varglob (VARNAME)
This returns a glob reference for the symbol table entry of VARNAME in
the package of the compartment. VARNAME must be the B<name> of a
-variable without any leading type marker. For example,
+variable without any leading type marker. For example:
+
+ ${$cpt->varglob('foo')} = "Hello world";
+
+has the same effect as:
$cpt = new Safe 'Root';
$Root::foo = "Hello world";
- # Equivalent version which doesn't need to know $cpt's package name:
- ${$cpt->varglob('foo')} = "Hello world";
+but avoids the need to know $cpt's package name.
-=item reval (STRING, STRICT)
+
+=head2 reval (STRING, STRICT)
This evaluates STRING as perl code inside the compartment.
subroutines and B<eval()>. The context (list or scalar) is determined
by the caller as usual.
-This behaviour differs from the beta distribution of the Safe extension
-where earlier versions of perl made it hard to mimic the return
-behaviour of the eval() command and the context was always scalar.
+If the return value of reval() is (or contains) any code reference,
+those code references are wrapped to be themselves executed always
+in the compartment. See L</wrap_code_refs_within>.
The formerly undocumented STRICT argument sets strictness: if true
'use strict;' is used, otherwise it uses 'no strict;'. B<Note>: if
A similar effect applies to I<all> runtime symbol lookups in code
called from a compartment but not compiled within it.
-
-
-=item rdo (FILENAME)
+=head2 rdo (FILENAME)
This evaluates the contents of file FILENAME inside the compartment.
See above documentation on the B<reval> method for further details.
-=item root (NAMESPACE)
+=head2 root (NAMESPACE)
This method returns the name of the package that is the root of the
compartment's namespace.
where the root module could be used to change the namespace. That
functionality has been withdrawn pending deeper consideration.
-=item mask (MASK)
+=head2 mask (MASK)
This is a get-or-set method for the compartment's operator mask.
With the MASK argument present, it sets the operator mask for the
compartment (equivalent to calling the deny_only method).
-=back
+=head2 wrap_code_ref (CODEREF)
+Returns a reference to an anonymous subroutine that, when executed, will call
+CODEREF with the Safe compartment 'in effect'. In other words, with the
+package namespace adjusted and the opmask enabled.
-=head2 Some Safety Issues
+Note that the opmask doesn't affect the already compiled code, it only affects
+any I<further> compilation that the already compiled code may try to perform.
-This section is currently just an outline of some of the things code in
-a compartment might do (intentionally or unintentionally) which can
-have an effect outside the compartment.
+This is particularly useful when applied to code references returned from reval().
+
+(It also provides a kind of workaround for RT#60374: "Safe.pm sort {} bug with
+-Dusethreads". See L<http://rt.perl.org/rt3//Public/Bug/Display.html?id=60374>
+for I<much> more detail.)
+
+=head2 wrap_code_refs_within (...)
+
+Wraps any CODE references found within the arguments by replacing each with the
+result of calling L</wrap_code_ref> on the CODE reference. Any ARRAY or HASH
+references in the arguments are inspected recursively.
+
+Returns nothing.
+
+=head1 RISKS
+
+This section is just an outline of some of the things code in a compartment
+might do (intentionally or unintentionally) which can have an effect outside
+the compartment.
=over 8
=back
-=head2 AUTHOR
+=head1 AUTHOR
Originally designed and implemented by Malcolm Beattie.
}
use Safe 1.00;
-use Test::More tests => 4;
+use Test::More tests => 10;
my $safe = Safe->new('PLPerl');
$safe->permit_only(qw(:default sort));
-my $func = $safe->reval(<<'EOS');
+# check basic argument passing and context for anon-subs
+my $func = $safe->reval(q{ sub { @_ } });
+is_deeply [ $func->() ], [ ];
+is_deeply [ $func->("foo") ], [ "foo" ];
+
+my $func1 = $safe->reval(<<'EOS');
# uses quotes in { "$a" <=> $b } to avoid the optimizer replacing the block
# with a hardwired comparison
- { package Pkg; sub p_sort { return sort { "$a" <=> $b } qw(2 1 3); } }
- sub l_sort { return sort { "$a" <=> $b } qw(2 1 3); }
+ { package Pkg; sub p_sort { return sort { "$a" <=> $b } @_; } }
+ sub l_sort { return sort { "$a" <=> $b } @_; }
- return sub { return join(",",l_sort()), join(",",Pkg::p_sort()) }
+ return sub { return join(",",l_sort(@_)), join(",",Pkg::p_sort(@_)) }
EOS
is $@, '', 'reval should not fail';
is ref $func, 'CODE', 'reval should return a CODE ref';
-my ($l_sorted, $p_sorted) = $func->();
+my ($l_sorted, $p_sorted) = $func1->(3,1,2);
is $l_sorted, "1,2,3";
is $p_sorted, "1,2,3";
+
+# check other aspects of closures created inside Safe
+
+my $die_func = $safe->reval(q{ sub { die @_ if @_; 1 } });
+
+# check $@ not affected by successful call
+$@ = 42;
+$die_func->();
+is $@, 42, 'successful closure call should not alter $@';
+
+{
+ my $warns = 0;
+ local $SIG{__WARN__} = sub { $warns++ };
+ local $TODO = $] >= 5.013 ? "Doesn't die in 5.13" : undef;
+ ok !eval { $die_func->("died\n"); 1 }, 'should die';
+ is $@, "died\n", '$@ should be set correctly';
+ local $TODO = "Shouldn't warn";
+ is $warns, 0;
+}
--- /dev/null
+#!perl -w
+$|=1;
+BEGIN {
+ require Config; import Config;
+ if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
+ print "1..0\n";
+ exit 0;
+ }
+}
+
+use Test::More tests => 7;
+
+use Safe 1.00;
+use Opcode qw(full_opset);
+
+pass;
+
+my $safe = Safe->new('PLPerl');
+$safe->deny_only();
+
+# Expression that triggers require utf8 and call to SWASHNEW.
+# Fails with "Undefined subroutine PLPerl::utf8::SWASHNEW called"
+# if SWASHNEW is not shared, else returns true if unicode logic is working.
+my $trigger = q{ my $a = pack('U',0xC4); my $b = chr 0xE4; utf8::upgrade $b; $a =~ /$b/i };
+
+ok $safe->reval( $trigger ), 'trigger expression should return true';
+is $@, '', 'trigger expression should not die';
+
+# return a closure
+my $sub = $safe->reval(q{sub { warn pack('U',0xC4) }});
+
+# define code outside Safe that'll be triggered from inside
+my @warns;
+$SIG{__WARN__} = sub {
+ my $msg = shift;
+ # this regex requires a different SWASH digit data for \d)
+ # than the one used above and by the trigger code in Safe.pm
+ $msg =~ s/\(eval \d+\)/XXX/i; # uses IsDigit SWASH
+ push @warns, $msg;
+};
+
+is eval { $sub->() }, 1, 'warn should return 1';
+is $@, '', '__WARN__ hook should not die';
+is @warns, 1, 'should only be 1 warning';
+like $warns[0], qr/at XXX line/, 'warning should have been edited';
+
--- /dev/null
+#!perl -w
+
+$|=1;
+BEGIN {
+ require Config; import Config;
+ if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
+ print "1..0\n";
+ exit 0;
+ }
+}
+
+use strict;
+use Safe 1.00;
+use Test::More tests => 9;
+
+my $safe = Safe->new('PLPerl');
+$safe->permit_only(qw(:default sort));
+
+# eval within an eval: the outer eval is compiled into the sub, the inner is
+# compiled (by the outer) at runtime and so is subject to runtime opmask
+my $sub1 = sub { eval " eval '1+1' " };
+is $sub1->(), 2;
+
+my $sub1w = $safe->wrap_code_ref($sub1);
+is ref $sub1w, 'CODE';
+is eval { $sub1w->() }, undef;
+like $@, qr/eval .* trapped by operation mask/;
+
+is $sub1->(), 2, 'original ref should be unaffected';
+
+# setup args for wrap_code_refs_within including nested data
+my @args = (42, [[ 0, { sub => $sub1 }, 2 ]], 24);
+is $args[1][0][1]{sub}, $sub1;
+
+$safe->wrap_code_refs_within(@args);
+my $sub1w2 = $args[1][0][1]{sub};
+isnt $sub1w2, $sub1;
+is eval { $sub1w2->() }, undef;
+like $@, qr/eval .* trapped by operation mask/;
=head1 BUGS
-You can't store GLOB, FORMLINE, etc.... If you can define semantics
+You can't store GLOB, FORMLINE, REGEXP, etc.... If you can define semantics
for those operations, feel free to enhance Storable so that it can
deal with them.
ok 5, $a_fetches == 0;
ok 6, $$ref2 eq $$ref;
ok 7, $$ref2 == 8;
-# I don't understand why it's 3 and not 2
-ok 8, $a_fetches == 3;
+# a bug in 5.12 and earlier caused an extra FETCH
+ok 8, $a_fetches == 2 || $a_fetches == 3 ;
+++ /dev/null
-Revision history for Perl extension Switch.
-
-0.01 Wed Dec 15 05:58:01 1999
- - original version; created by h2xs 1.18
-
-
-
-2.00 Mon Jan 8 17:12:20 2001
-
- - Complete revamp (including syntactic and semantic changes)
- in line with proposed Perl 6 semantics.
-
-
-2.01 Tue Jan 9 07:19:02 2001
-
- - Fixed infinite loop problem under 5.6.0 caused by change
- in goto semantics between 5.00503 and 5.6.0
- (thanks Scott!)
-
-
-
-2.02 Thu Apr 26 12:01:06 2001
-
- - Fixed unwarranted whitespace squeezing before quotelikes
- (thanks Ray)
-
- - Fixed pernicious bug that cause switch to fail to recognize
- certain complex switch values
-
-
-2.03 Tue May 15 09:34:11 2001
-
- - Fixed bug in 'fallthrough' specifications.
-
- - Silenced gratuitous warnings for undefined values as
- switch or case values
-
-
-2.04 Mon Jul 30 13:17:35 2001
-
- - Suppressed 'undef value' warning under -w (thanks Michael)
-
- - Added support for Perl 6 given..when syntax
-
-
-2.05 Mon Sep 3 08:13:25 2001
-
- - Changed licence for inclusion in core distribution
-
- - Added new test file for non-fallthrough and nested switches
-
-
-2.06 Wed Nov 14 16:18:54 2001
-
- - Fixed parsing of ternary operators in Switch'ed source code
- (at the expense of no longer correctly parsing ?...? regexes)
- (thanks Mark)
-
- - Fixed the parsing of embedded POD (thanks Brent)
-
- - Fixed bug encountered when -s or -m file test used (thanks Jochen)
-
-
-2.07 Wed May 15 15:19:28 2002
-
- - Corified tests
-
- - Updated "Perl6" syntax to reflect current design
- (as far as possible -- can't eliminate need to parenthesize
- variables, since they're ambiguous in Perl 5)
-
-
-2.09 Wed Jun 12 22:13:30 2002
-
- - Removed spurious debugging statement
-
-
-2.10 Mon Dec 29 2003
-
- - Introduce the "default" keyword for the Perl 6 syntax
- - Raise the limitation on source file length to 1 million characters
-
-2.11 Wed Nov 22 2006
-
- - Fix documentation issues
- - Fix installation directory for perls >= 5.7.3 (Slaven Rezic)
-
-2.12 Mon Dec 11 2006
-
- - Fix bug in parsing POD at end of document (Valentin Guignon)
-
-2.13 Sun Feb 25 2007
-
- - Fix bug in parsing division statements (Wolfgang Laun)
-
-2.14 Mon Dec 29 2008
-
- - Make Switch.pm skip POD like perl does
- Patch provided by Daniel Klein <danielklein--airpost.net>
- (bleadperl commit 39bcdda02ea582e7bdf8b0cf2e7186e89c6baea9)
-
- - Fix line numbering issues with POD filtered by Switch.pm
- Patch provided by Daniel Klein <danielklein--airpost.net>
- (bleadperl commit 6a9befb105d93024902eb178dab77655333f1829)
-
- - Switch.pm doesn't appear to support plain arrays and hashes in case().
- (bleadperl commit cd3d9d47255d3080961ba7b58c9a145c7b45b905)
-
- - Let us direct Switch questions to P5P.
- (bleadperl commit b62fb10ea98565ce5572416500e1e3517cb17d33)
-
- - POD nits from Frank Wiegand <frank.wiegand@gmail.com>
- (bleadperl commit 3b46207fed7bf69caa32c27c04bd239cfb64cb53)
-
-2.15 Tue Oct 20 2009
- - Deprecate shipping Switch.pm in the core distribution.
- (Nicholas Clark)
-
-2.16 Fri Oct 23 2009
- - For Perl 5.11+, install into 'site', not 'perl'
-
+++ /dev/null
-Changes
-MANIFEST
-Makefile.PL
-README
-Switch.pm
-t/given.t
-t/nested.t
-t/switch.t
-META.yml Module meta-data (added by MakeMaker)
+++ /dev/null
---- #YAML:1.0
-name: Switch
-version: 2.16
-abstract: ~
-license: ~
-author: ~
-generated_by: ExtUtils::MakeMaker version 6.42
-distribution_type: module
-requires:
- Filter::Util::Call: 0
- Text::Balanced: 0
-meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.3.html
- version: 1.3
+++ /dev/null
-use ExtUtils::MakeMaker;
-WriteMakefile(
- NAME => q[Switch],
- VERSION_FROM => q[Switch.pm],
- PREREQ_PM => { 'Filter::Util::Call' => 0, 'Text::Balanced' => 0 },
- INSTALLDIRS => ($] >= 5.00703 && $] < 5.011) ? 'perl' : 'site',
-);
+++ /dev/null
-==============================================================================
- Release of version 2.16 of Switch
-==============================================================================
-
-
-NAME
- Switch - A switch statement for Perl
-
-DESCRIPTION
-
- Switch.pm provides the syntax and semantics for an explicit case
- mechanism for Perl. The syntax is minimal, introducing only the
- keywords C<switch> and C<case> and conforming to the general pattern
- of existing Perl control structures. The semantics are particularly
- rich, allowing any one (or more) of nearly 30 forms of matching to
- be used when comparing a switch value with its various cases.
-
-AUTHOR
- Damian Conway (damian@conway.org)
- Maintained by Rafael Garcia-Suarez (rgarciasuarez@gmail.com)
- and the Perl 5 porters (perl5-porters@gmail.com)
-
-COPYRIGHT
- Copyright (c) 1997-2008, Damian Conway. All Rights Reserved.
- This module is free software. It may be used, redistributed
- and/or modified under the same terms as Perl itself.
+++ /dev/null
-package Switch;
-
-use strict;
-use vars qw($VERSION);
-use Carp;
-
-use if $] >= 5.011, 'deprecate';
-
-$VERSION = '2.16';
-
-
-# LOAD FILTERING MODULE...
-use Filter::Util::Call;
-
-sub __();
-
-# CATCH ATTEMPTS TO CALL case OUTSIDE THE SCOPE OF ANY switch
-
-$::_S_W_I_T_C_H = sub { croak "case/when statement not in switch/given block" };
-
-my $offset;
-my $fallthrough;
-my ($Perl5, $Perl6) = (0,0);
-
-sub import
-{
- $fallthrough = grep /\bfallthrough\b/, @_;
- $offset = (caller)[2]+1;
- filter_add({}) unless @_>1 && $_[1] eq 'noimport';
- my $pkg = caller;
- no strict 'refs';
- for ( qw( on_defined on_exists ) )
- {
- *{"${pkg}::$_"} = \&$_;
- }
- *{"${pkg}::__"} = \&__ if grep /__/, @_;
- $Perl6 = 1 if grep(/Perl\s*6/i, @_);
- $Perl5 = 1 if grep(/Perl\s*5/i, @_) || !grep(/Perl\s*6/i, @_);
- 1;
-}
-
-sub unimport
-{
- filter_del()
-}
-
-sub filter
-{
- my($self) = @_ ;
- local $Switch::file = (caller)[1];
-
- my $status = 1;
- $status = filter_read(1_000_000);
- return $status if $status<0;
- $_ = filter_blocks($_,$offset);
- $_ = "# line $offset\n" . $_ if $offset; undef $offset;
- return $status;
-}
-
-use Text::Balanced ':ALL';
-
-sub line
-{
- my ($pretext,$offset) = @_;
- ($pretext=~tr/\n/\n/)+($offset||0);
-}
-
-sub is_block
-{
- local $SIG{__WARN__}=sub{die$@};
- local $^W=1;
- my $ishash = defined eval 'my $hr='.$_[0];
- undef $@;
- return !$ishash;
-}
-
-my $pod_or_DATA = qr/ ^=[A-Za-z] .*? ^=cut (?![A-Za-z]) .*? $
- | ^__(DATA|END)__\n.*
- /smx;
-
-my $casecounter = 1;
-sub filter_blocks
-{
- my ($source, $line) = @_;
- return $source unless $Perl5 && $source =~ /case|switch/
- || $Perl6 && $source =~ /when|given|default/;
- pos $source = 0;
- my $text = "";
- component: while (pos $source < length $source)
- {
- if ($source =~ m/(\G\s*use\s+Switch\b)/gc)
- {
- $text .= q{use Switch 'noimport'};
- next component;
- }
- my @pos = Text::Balanced::_match_quotelike(\$source,qr/\s*/,1,0);
- if (defined $pos[0])
- {
- my $pre = substr($source,$pos[0],$pos[1]); # matched prefix
- my $iEol;
- if( substr($source,$pos[4],$pos[5]) eq '/' && # 1st delimiter
- substr($source,$pos[2],$pos[3]) eq '' && # no op like 'm'
- index( substr($source,$pos[16],$pos[17]), 'x' ) == -1 && # no //x
- ($iEol = index( $source, "\n", $pos[4] )) > 0 &&
- $iEol < $pos[8] ){ # embedded newlines
- # If this is a pattern, it isn't compatible with Switch. Backup past 1st '/'.
- pos( $source ) = $pos[6];
- $text .= $pre . substr($source,$pos[2],$pos[6]-$pos[2]);
- } else {
- $text .= $pre . substr($source,$pos[2],$pos[18]-$pos[2]);
- }
- next component;
- }
- if ($source =~ m/(\G\s*$pod_or_DATA)/gc) {
- $text .= $1;
- next component;
- }
- @pos = Text::Balanced::_match_variable(\$source,qr/\s*/);
- if (defined $pos[0])
- {
- $text .= " " if $pos[0] < $pos[2];
- $text .= substr($source,$pos[0],$pos[4]-$pos[0]);
- next component;
- }
-
- if ($Perl5 && $source =~ m/\G(\n*)(\s*)(switch)\b(?=\s*[(])/gc
- || $Perl6 && $source =~ m/\G(\n*)(\s*)(given)\b(?=\s*[(])/gc
- || $Perl6 && $source =~ m/\G(\n*)(\s*)(given)\b(.*)(?=\{)/gc)
- {
- my $keyword = $3;
- my $arg = $4;
- $text .= $1.$2.'S_W_I_T_C_H: while (1) ';
- unless ($arg) {
- @pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/\(/,qr/\)/,qr/[[{(<]/,qr/[]})>]/,undef)
- or do {
- die "Bad $keyword statement (problem in the parentheses?) near $Switch::file line ", line(substr($source,0,pos $source),$line), "\n";
- };
- $arg = filter_blocks(substr($source,$pos[0],$pos[4]-$pos[0]),line(substr($source,0,$pos[0]),$line));
- }
- $arg =~ s {^\s*[(]\s*%} { ( \\\%} ||
- $arg =~ s {^\s*[(]\s*m\b} { ( qr} ||
- $arg =~ s {^\s*[(]\s*/} { ( qr/} ||
- $arg =~ s {^\s*[(]\s*qw} { ( \\qw};
- @pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/\{/,qr/\}/,qr/\{/,qr/\}/,undef)
- or do {
- die "Bad $keyword statement (problem in the code block?) near $Switch::file line ", line(substr($source,0, pos $source), $line), "\n";
- };
- my $code = filter_blocks(substr($source,$pos[0],$pos[4]-$pos[0]),line(substr($source,0,$pos[0]),$line));
- $code =~ s/{/{ local \$::_S_W_I_T_C_H; Switch::switch $arg;/;
- $text .= $code . 'continue {last}';
- next component;
- }
- elsif ($Perl5 && $source =~ m/\G(\s*)(case\b)(?!\s*=>)/gc
- || $Perl6 && $source =~ m/\G(\s*)(when\b)(?!\s*=>)/gc
- || $Perl6 && $source =~ m/\G(\s*)(default\b)(?=\s*\{)/gc)
- {
- my $keyword = $2;
- $text .= $1 . ($keyword eq "default"
- ? "if (1)"
- : "if (Switch::case");
-
- if ($keyword eq "default") {
- # Nothing to do
- }
- elsif (@pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/\{/,qr/\}/,qr/\{/,qr/\}/,undef)) {
- my $code = substr($source,$pos[0],$pos[4]-$pos[0]);
- $text .= " " if $pos[0] < $pos[2];
- $text .= "sub " if is_block $code;
- $text .= filter_blocks($code,line(substr($source,0,$pos[0]),$line)) . ")";
- }
- elsif (@pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/[[(]/,qr/[])]/,qr/[[({]/,qr/[])}]/,undef)) {
- my $code = filter_blocks(substr($source,$pos[0],$pos[4]-$pos[0]),line(substr($source,0,$pos[0]),$line));
- $code =~ s {^\s*[(]\s*%} { ( \\\%} ||
- $code =~ s {^\s*[(]\s*m\b} { ( qr} ||
- $code =~ s {^\s*[(]\s*/} { ( qr/} ||
- $code =~ s {^\s*[(]\s*qw} { ( \\qw};
- $text .= " " if $pos[0] < $pos[2];
- $text .= "$code)";
- }
- elsif ($Perl6 && do{@pos = Text::Balanced::_match_variable(\$source,qr/\s*/)}) {
- my $code = filter_blocks(substr($source,$pos[0],$pos[4]-$pos[0]),line(substr($source,0,$pos[0]),$line));
- $code =~ s {^\s*%} { \%} ||
- $code =~ s {^\s*@} { \@};
- $text .= " " if $pos[0] < $pos[2];
- $text .= "$code)";
- }
- elsif ( @pos = Text::Balanced::_match_quotelike(\$source,qr/\s*/,1,0)) {
- my $code = substr($source,$pos[2],$pos[18]-$pos[2]);
- $code = filter_blocks($code,line(substr($source,0,$pos[2]),$line));
- $code =~ s {^\s*m} { qr} ||
- $code =~ s {^\s*/} { qr/} ||
- $code =~ s {^\s*qw} { \\qw};
- $text .= " " if $pos[0] < $pos[2];
- $text .= "$code)";
- }
- elsif ($Perl5 && $source =~ m/\G\s*(([^\$\@{])[^\$\@{]*)(?=\s*{)/gc
- || $Perl6 && $source =~ m/\G\s*([^;{]*)()/gc) {
- my $code = filter_blocks($1,line(substr($source,0,pos $source),$line));
- $text .= ' \\' if $2 eq '%';
- $text .= " $code)";
- }
- else {
- die "Bad $keyword statement (invalid $keyword value?) near $Switch::file line ", line(substr($source,0,pos $source), $line), "\n";
- }
-
- die "Missing opening brace or semi-colon after 'when' value near $Switch::file line ", line(substr($source,0,pos $source), $line), "\n"
- unless !$Perl6 || $source =~ m/\G(\s*)(?=;|\{)/gc;
-
- do{@pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/\{/,qr/\}/,qr/\{/,qr/\}/,undef)}
- or do {
- if ($source =~ m/\G\s*(?=([};]|\Z))/gc) {
- $casecounter++;
- next component;
- }
- die "Bad $keyword statement (problem in the code block?) near $Switch::file line ", line(substr($source,0,pos $source),$line), "\n";
- };
- my $code = filter_blocks(substr($source,$pos[0],$pos[4]-$pos[0]),line(substr($source,0,$pos[0]),$line));
- $code =~ s/}(?=\s*\Z)/;last S_W_I_T_C_H }/
- unless $fallthrough;
- $text .= "{ while (1) $code continue { goto C_A_S_E_$casecounter } last S_W_I_T_C_H; C_A_S_E_$casecounter: }";
- $casecounter++;
- next component;
- }
-
- $source =~ m/\G(\s*(-[sm]\s+|\w+|#.*\n|\W))/gc;
- $text .= $1;
- }
- $text;
-}
-
-
-
-sub in
-{
- my ($x,$y) = @_;
- my @numy;
- for my $nextx ( @$x )
- {
- my $numx = ref($nextx) || defined $nextx && (~$nextx&$nextx) eq 0;
- for my $j ( 0..$#$y )
- {
- my $nexty = $y->[$j];
- push @numy, ref($nexty) || defined $nexty && (~$nexty&$nexty) eq 0
- if @numy <= $j;
- return 1 if $numx && $numy[$j] && $nextx==$nexty
- || $nextx eq $nexty;
-
- }
- }
- return "";
-}
-
-sub on_exists
-{
- my $ref = @_==1 && ref($_[0]) eq 'HASH' ? $_[0] : { @_ };
- [ keys %$ref ]
-}
-
-sub on_defined
-{
- my $ref = @_==1 && ref($_[0]) eq 'HASH' ? $_[0] : { @_ };
- [ grep { defined $ref->{$_} } keys %$ref ]
-}
-
-sub switch(;$)
-{
- my ($s_val) = @_ ? $_[0] : $_;
- my $s_ref = ref $s_val;
-
- if ($s_ref eq 'CODE')
- {
- $::_S_W_I_T_C_H =
- sub { my $c_val = $_[0];
- return $s_val == $c_val if ref $c_val eq 'CODE';
- return $s_val->(@$c_val) if ref $c_val eq 'ARRAY';
- return $s_val->($c_val);
- };
- }
- elsif ($s_ref eq "" && defined $s_val && (~$s_val&$s_val) eq 0) # NUMERIC SCALAR
- {
- $::_S_W_I_T_C_H =
- sub { my $c_val = $_[0];
- my $c_ref = ref $c_val;
- return $s_val == $c_val if $c_ref eq ""
- && defined $c_val
- && (~$c_val&$c_val) eq 0;
- return $s_val eq $c_val if $c_ref eq "";
- return in([$s_val],$c_val) if $c_ref eq 'ARRAY';
- return $c_val->($s_val) if $c_ref eq 'CODE';
- return $c_val->call($s_val) if $c_ref eq 'Switch';
- return scalar $s_val=~/$c_val/
- if $c_ref eq 'Regexp';
- return scalar $c_val->{$s_val}
- if $c_ref eq 'HASH';
- return;
- };
- }
- elsif ($s_ref eq "") # STRING SCALAR
- {
- $::_S_W_I_T_C_H =
- sub { my $c_val = $_[0];
- my $c_ref = ref $c_val;
- return $s_val eq $c_val if $c_ref eq "";
- return in([$s_val],$c_val) if $c_ref eq 'ARRAY';
- return $c_val->($s_val) if $c_ref eq 'CODE';
- return $c_val->call($s_val) if $c_ref eq 'Switch';
- return scalar $s_val=~/$c_val/
- if $c_ref eq 'Regexp';
- return scalar $c_val->{$s_val}
- if $c_ref eq 'HASH';
- return;
- };
- }
- elsif ($s_ref eq 'ARRAY')
- {
- $::_S_W_I_T_C_H =
- sub { my $c_val = $_[0];
- my $c_ref = ref $c_val;
- return in($s_val,[$c_val]) if $c_ref eq "";
- return in($s_val,$c_val) if $c_ref eq 'ARRAY';
- return $c_val->(@$s_val) if $c_ref eq 'CODE';
- return $c_val->call(@$s_val)
- if $c_ref eq 'Switch';
- return scalar grep {$_=~/$c_val/} @$s_val
- if $c_ref eq 'Regexp';
- return scalar grep {$c_val->{$_}} @$s_val
- if $c_ref eq 'HASH';
- return;
- };
- }
- elsif ($s_ref eq 'Regexp')
- {
- $::_S_W_I_T_C_H =
- sub { my $c_val = $_[0];
- my $c_ref = ref $c_val;
- return $c_val=~/s_val/ if $c_ref eq "";
- return scalar grep {$_=~/s_val/} @$c_val
- if $c_ref eq 'ARRAY';
- return $c_val->($s_val) if $c_ref eq 'CODE';
- return $c_val->call($s_val) if $c_ref eq 'Switch';
- return $s_val eq $c_val if $c_ref eq 'Regexp';
- return grep {$_=~/$s_val/ && $c_val->{$_}} keys %$c_val
- if $c_ref eq 'HASH';
- return;
- };
- }
- elsif ($s_ref eq 'HASH')
- {
- $::_S_W_I_T_C_H =
- sub { my $c_val = $_[0];
- my $c_ref = ref $c_val;
- return $s_val->{$c_val} if $c_ref eq "";
- return scalar grep {$s_val->{$_}} @$c_val
- if $c_ref eq 'ARRAY';
- return $c_val->($s_val) if $c_ref eq 'CODE';
- return $c_val->call($s_val) if $c_ref eq 'Switch';
- return grep {$_=~/$c_val/ && $s_val->{"$_"}} keys %$s_val
- if $c_ref eq 'Regexp';
- return $s_val==$c_val if $c_ref eq 'HASH';
- return;
- };
- }
- elsif ($s_ref eq 'Switch')
- {
- $::_S_W_I_T_C_H =
- sub { my $c_val = $_[0];
- return $s_val == $c_val if ref $c_val eq 'Switch';
- return $s_val->call(@$c_val)
- if ref $c_val eq 'ARRAY';
- return $s_val->call($c_val);
- };
- }
- else
- {
- croak "Cannot switch on $s_ref";
- }
- return 1;
-}
-
-sub case($) { local $SIG{__WARN__} = \&carp;
- $::_S_W_I_T_C_H->(@_); }
-
-# IMPLEMENT __
-
-my $placeholder = bless { arity=>1, impl=>sub{$_[1+$_[0]]} };
-
-sub __() { $placeholder }
-
-sub __arg($)
-{
- my $index = $_[0]+1;
- bless { arity=>0, impl=>sub{$_[$index]} };
-}
-
-sub hosub(&@)
-{
- # WRITE THIS
-}
-
-sub call
-{
- my ($self,@args) = @_;
- return $self->{impl}->(0,@args);
-}
-
-sub meta_bop(&)
-{
- my ($op) = @_;
- sub
- {
- my ($left, $right, $reversed) = @_;
- ($right,$left) = @_ if $reversed;
-
- my $rop = ref $right eq 'Switch'
- ? $right
- : bless { arity=>0, impl=>sub{$right} };
-
- my $lop = ref $left eq 'Switch'
- ? $left
- : bless { arity=>0, impl=>sub{$left} };
-
- my $arity = $lop->{arity} + $rop->{arity};
-
- return bless {
- arity => $arity,
- impl => sub { my $start = shift;
- return $op->($lop->{impl}->($start,@_),
- $rop->{impl}->($start+$lop->{arity},@_));
- }
- };
- };
-}
-
-sub meta_uop(&)
-{
- my ($op) = @_;
- sub
- {
- my ($left) = @_;
-
- my $lop = ref $left eq 'Switch'
- ? $left
- : bless { arity=>0, impl=>sub{$left} };
-
- my $arity = $lop->{arity};
-
- return bless {
- arity => $arity,
- impl => sub { $op->($lop->{impl}->(@_)) }
- };
- };
-}
-
-
-use overload
- "+" => meta_bop {$_[0] + $_[1]},
- "-" => meta_bop {$_[0] - $_[1]},
- "*" => meta_bop {$_[0] * $_[1]},
- "/" => meta_bop {$_[0] / $_[1]},
- "%" => meta_bop {$_[0] % $_[1]},
- "**" => meta_bop {$_[0] ** $_[1]},
- "<<" => meta_bop {$_[0] << $_[1]},
- ">>" => meta_bop {$_[0] >> $_[1]},
- "x" => meta_bop {$_[0] x $_[1]},
- "." => meta_bop {$_[0] . $_[1]},
- "<" => meta_bop {$_[0] < $_[1]},
- "<=" => meta_bop {$_[0] <= $_[1]},
- ">" => meta_bop {$_[0] > $_[1]},
- ">=" => meta_bop {$_[0] >= $_[1]},
- "==" => meta_bop {$_[0] == $_[1]},
- "!=" => meta_bop {$_[0] != $_[1]},
- "<=>" => meta_bop {$_[0] <=> $_[1]},
- "lt" => meta_bop {$_[0] lt $_[1]},
- "le" => meta_bop {$_[0] le $_[1]},
- "gt" => meta_bop {$_[0] gt $_[1]},
- "ge" => meta_bop {$_[0] ge $_[1]},
- "eq" => meta_bop {$_[0] eq $_[1]},
- "ne" => meta_bop {$_[0] ne $_[1]},
- "cmp" => meta_bop {$_[0] cmp $_[1]},
- "\&" => meta_bop {$_[0] & $_[1]},
- "^" => meta_bop {$_[0] ^ $_[1]},
- "|" => meta_bop {$_[0] | $_[1]},
- "atan2" => meta_bop {atan2 $_[0], $_[1]},
-
- "neg" => meta_uop {-$_[0]},
- "!" => meta_uop {!$_[0]},
- "~" => meta_uop {~$_[0]},
- "cos" => meta_uop {cos $_[0]},
- "sin" => meta_uop {sin $_[0]},
- "exp" => meta_uop {exp $_[0]},
- "abs" => meta_uop {abs $_[0]},
- "log" => meta_uop {log $_[0]},
- "sqrt" => meta_uop {sqrt $_[0]},
- "bool" => sub { croak "Can't use && or || in expression containing __" },
-
- # "&()" => sub { $_[0]->{impl} },
-
- # "||" => meta_bop {$_[0] || $_[1]},
- # "&&" => meta_bop {$_[0] && $_[1]},
- # fallback => 1,
- ;
-1;
-
-__END__
-
-
-=head1 NAME
-
-Switch - A switch statement for Perl
-
-=head1 SYNOPSIS
-
- use Switch;
-
- switch ($val) {
- case 1 { print "number 1" }
- case "a" { print "string a" }
- case [1..10,42] { print "number in list" }
- case (\@array) { print "number in list" }
- case /\w+/ { print "pattern" }
- case qr/\w+/ { print "pattern" }
- case (\%hash) { print "entry in hash" }
- case (\&sub) { print "arg to subroutine" }
- else { print "previous case not true" }
- }
-
-=head1 BACKGROUND
-
-[Skip ahead to L<"DESCRIPTION"> if you don't care about the whys
-and wherefores of this control structure]
-
-In seeking to devise a "Swiss Army" case mechanism suitable for Perl,
-it is useful to generalize this notion of distributed conditional
-testing as far as possible. Specifically, the concept of "matching"
-between the switch value and the various case values need not be
-restricted to numeric (or string or referential) equality, as it is in other
-languages. Indeed, as Table 1 illustrates, Perl
-offers at least eighteen different ways in which two values could
-generate a match.
-
- Table 1: Matching a switch value ($s) with a case value ($c)
-
- Switch Case Type of Match Implied Matching Code
- Value Value
- ====== ===== ===================== =============
-
- number same numeric or referential match if $s == $c;
- or ref equality
-
- object method result of method call match if $s->$c();
- ref name match if defined $s->$c();
- or ref
-
- other other string equality match if $s eq $c;
- non-ref non-ref
- scalar scalar
-
- string regexp pattern match match if $s =~ /$c/;
-
- array scalar array entry existence match if 0<=$c && $c<@$s;
- ref array entry definition match if defined $s->[$c];
- array entry truth match if $s->[$c];
-
- array array array intersection match if intersects(@$s, @$c);
- ref ref (apply this table to
- all pairs of elements
- $s->[$i] and
- $c->[$j])
-
- array regexp array grep match if grep /$c/, @$s;
- ref
-
- hash scalar hash entry existence match if exists $s->{$c};
- ref hash entry definition match if defined $s->{$c};
- hash entry truth match if $s->{$c};
-
- hash regexp hash grep match if grep /$c/, keys %$s;
- ref
-
- sub scalar return value defn match if defined $s->($c);
- ref return value truth match if $s->($c);
-
- sub array return value defn match if defined $s->(@$c);
- ref ref return value truth match if $s->(@$c);
-
-
-In reality, Table 1 covers 31 alternatives, because only the equality and
-intersection tests are commutative; in all other cases, the roles of
-the C<$s> and C<$c> variables could be reversed to produce a
-different test. For example, instead of testing a single hash for
-the existence of a series of keys (C<match if exists $s-E<gt>{$c}>),
-one could test for the existence of a single key in a series of hashes
-(C<match if exists $c-E<gt>{$s}>).
-
-=head1 DESCRIPTION
-
-The Switch.pm module implements a generalized case mechanism that covers
-most (but not all) of the numerous possible combinations of switch and case
-values described above.
-
-The module augments the standard Perl syntax with two new control
-statements: C<switch> and C<case>. The C<switch> statement takes a
-single scalar argument of any type, specified in parentheses.
-C<switch> stores this value as the
-current switch value in a (localized) control variable.
-The value is followed by a block which may contain one or more
-Perl statements (including the C<case> statement described below).
-The block is unconditionally executed once the switch value has
-been cached.
-
-A C<case> statement takes a single scalar argument (in mandatory
-parentheses if it's a variable; otherwise the parens are optional) and
-selects the appropriate type of matching between that argument and the
-current switch value. The type of matching used is determined by the
-respective types of the switch value and the C<case> argument, as
-specified in Table 1. If the match is successful, the mandatory
-block associated with the C<case> statement is executed.
-
-In most other respects, the C<case> statement is semantically identical
-to an C<if> statement. For example, it can be followed by an C<else>
-clause, and can be used as a postfix statement qualifier.
-
-However, when a C<case> block has been executed control is automatically
-transferred to the statement after the immediately enclosing C<switch>
-block, rather than to the next statement within the block. In other
-words, the success of any C<case> statement prevents other cases in the
-same scope from executing. But see L<"Allowing fall-through"> below.
-
-Together these two new statements provide a fully generalized case
-mechanism:
-
- use Switch;
-
- # AND LATER...
-
- %special = ( woohoo => 1, d'oh => 1 );
-
- while (<>) {
- chomp;
- switch ($_) {
- case (%special) { print "homer\n"; } # if $special{$_}
- case /[a-z]/i { print "alpha\n"; } # if $_ =~ /a-z/i
- case [1..9] { print "small num\n"; } # if $_ in [1..9]
- case { $_[0] >= 10 } { print "big num\n"; } # if $_ >= 10
- print "must be punctuation\n" case /\W/; # if $_ ~= /\W/
- }
- }
-
-Note that C<switch>es can be nested within C<case> (or any other) blocks,
-and a series of C<case> statements can try different types of matches
--- hash membership, pattern match, array intersection, simple equality,
-etc. -- against the same switch value.
-
-The use of intersection tests against an array reference is particularly
-useful for aggregating integral cases:
-
- sub classify_digit
- {
- switch ($_[0]) { case 0 { return 'zero' }
- case [2,4,6,8] { return 'even' }
- case [1,3,5,7,9] { return 'odd' }
- case /[A-F]/i { return 'hex' }
- }
- }
-
-
-=head2 Allowing fall-through
-
-Fall-though (trying another case after one has already succeeded)
-is usually a Bad Idea in a switch statement. However, this
-is Perl, not a police state, so there I<is> a way to do it, if you must.
-
-If a C<case> block executes an untargeted C<next>, control is
-immediately transferred to the statement I<after> the C<case> statement
-(i.e. usually another case), rather than out of the surrounding
-C<switch> block.
-
-For example:
-
- switch ($val) {
- case 1 { handle_num_1(); next } # and try next case...
- case "1" { handle_str_1(); next } # and try next case...
- case [0..9] { handle_num_any(); } # and we're done
- case /\d/ { handle_dig_any(); next } # and try next case...
- case /.*/ { handle_str_any(); next } # and try next case...
- }
-
-If $val held the number C<1>, the above C<switch> block would call the
-first three C<handle_...> subroutines, jumping to the next case test
-each time it encountered a C<next>. After the third C<case> block
-was executed, control would jump to the end of the enclosing
-C<switch> block.
-
-On the other hand, if $val held C<10>, then only the last two C<handle_...>
-subroutines would be called.
-
-Note that this mechanism allows the notion of I<conditional fall-through>.
-For example:
-
- switch ($val) {
- case [0..9] { handle_num_any(); next if $val < 7; }
- case /\d/ { handle_dig_any(); }
- }
-
-If an untargeted C<last> statement is executed in a case block, this
-immediately transfers control out of the enclosing C<switch> block
-(in other words, there is an implicit C<last> at the end of each
-normal C<case> block). Thus the previous example could also have been
-written:
-
- switch ($val) {
- case [0..9] { handle_num_any(); last if $val >= 7; next; }
- case /\d/ { handle_dig_any(); }
- }
-
-
-=head2 Automating fall-through
-
-In situations where case fall-through should be the norm, rather than an
-exception, an endless succession of terminal C<next>s is tedious and ugly.
-Hence, it is possible to reverse the default behaviour by specifying
-the string "fallthrough" when importing the module. For example, the
-following code is equivalent to the first example in L<"Allowing fall-through">:
-
- use Switch 'fallthrough';
-
- switch ($val) {
- case 1 { handle_num_1(); }
- case "1" { handle_str_1(); }
- case [0..9] { handle_num_any(); last }
- case /\d/ { handle_dig_any(); }
- case /.*/ { handle_str_any(); }
- }
-
-Note the explicit use of a C<last> to preserve the non-fall-through
-behaviour of the third case.
-
-
-
-=head2 Alternative syntax
-
-Perl 6 will provide a built-in switch statement with essentially the
-same semantics as those offered by Switch.pm, but with a different
-pair of keywords. In Perl 6 C<switch> will be spelled C<given>, and
-C<case> will be pronounced C<when>. In addition, the C<when> statement
-will not require switch or case values to be parenthesized.
-
-This future syntax is also (largely) available via the Switch.pm module, by
-importing it with the argument C<"Perl6">. For example:
-
- use Switch 'Perl6';
-
- given ($val) {
- when 1 { handle_num_1(); }
- when ($str1) { handle_str_1(); }
- when [0..9] { handle_num_any(); last }
- when /\d/ { handle_dig_any(); }
- when /.*/ { handle_str_any(); }
- default { handle anything else; }
- }
-
-Note that scalars still need to be parenthesized, since they would be
-ambiguous in Perl 5.
-
-Note too that you can mix and match both syntaxes by importing the module
-with:
-
- use Switch 'Perl5', 'Perl6';
-
-
-=head2 Higher-order Operations
-
-One situation in which C<switch> and C<case> do not provide a good
-substitute for a cascaded C<if>, is where a switch value needs to
-be tested against a series of conditions. For example:
-
- sub beverage {
- switch (shift) {
- case { $_[0] < 10 } { return 'milk' }
- case { $_[0] < 20 } { return 'coke' }
- case { $_[0] < 30 } { return 'beer' }
- case { $_[0] < 40 } { return 'wine' }
- case { $_[0] < 50 } { return 'malt' }
- case { $_[0] < 60 } { return 'Moet' }
- else { return 'milk' }
- }
- }
-
-(This is equivalent to writing C<case (sub { $_[0] < 10 })>, etc.; C<$_[0]>
-is the argument to the anonymous subroutine.)
-
-The need to specify each condition as a subroutine block is tiresome. To
-overcome this, when importing Switch.pm, a special "placeholder"
-subroutine named C<__> [sic] may also be imported. This subroutine
-converts (almost) any expression in which it appears to a reference to a
-higher-order function. That is, the expression:
-
- use Switch '__';
-
- __ < 2
-
-is equivalent to:
-
- sub { $_[0] < 2 }
-
-With C<__>, the previous ugly case statements can be rewritten:
-
- case __ < 10 { return 'milk' }
- case __ < 20 { return 'coke' }
- case __ < 30 { return 'beer' }
- case __ < 40 { return 'wine' }
- case __ < 50 { return 'malt' }
- case __ < 60 { return 'Moet' }
- else { return 'milk' }
-
-The C<__> subroutine makes extensive use of operator overloading to
-perform its magic. All operations involving __ are overloaded to
-produce an anonymous subroutine that implements a lazy version
-of the original operation.
-
-The only problem is that operator overloading does not allow the
-boolean operators C<&&> and C<||> to be overloaded. So a case statement
-like this:
-
- case 0 <= __ && __ < 10 { return 'digit' }
-
-doesn't act as expected, because when it is
-executed, it constructs two higher order subroutines
-and then treats the two resulting references as arguments to C<&&>:
-
- sub { 0 <= $_[0] } && sub { $_[0] < 10 }
-
-This boolean expression is inevitably true, since both references are
-non-false. Fortunately, the overloaded C<'bool'> operator catches this
-situation and flags it as an error.
-
-=head1 DEPENDENCIES
-
-The module is implemented using Filter::Util::Call and Text::Balanced
-and requires both these modules to be installed.
-
-=head1 AUTHOR
-
-Damian Conway (damian@conway.org). This module is now maintained by Rafael
-Garcia-Suarez (rgarciasuarez@gmail.com) and more generally by the Perl 5
-Porters (perl5-porters@perl.org), as part of the Perl core.
-
-=head1 BUGS
-
-There are undoubtedly serious bugs lurking somewhere in code this funky :-)
-Bug reports and other feedback are most welcome.
-
-=head1 LIMITATIONS
-
-Due to the heuristic nature of Switch.pm's source parsing, the presence of
-regexes with embedded newlines that are specified with raw C</.../>
-delimiters and don't have a modifier C<//x> are indistinguishable from
-code chunks beginning with the division operator C</>. As a workaround
-you must use C<m/.../> or C<m?...?> for such patterns. Also, the presence
-of regexes specified with raw C<?...?> delimiters may cause mysterious
-errors. The workaround is to use C<m?...?> instead.
-
-Due to the way source filters work in Perl, you can't use Switch inside
-an string C<eval>.
-
-If your source file is longer then 1 million characters and you have a
-switch statement that crosses the 1 million (or 2 million, etc.)
-character boundary you will get mysterious errors. The workaround is to
-use smaller source files.
-
-=head1 COPYRIGHT
-
- Copyright (c) 1997-2008, Damian Conway. All Rights Reserved.
- This module is free software. It may be used, redistributed
- and/or modified under the same terms as Perl itself.
+++ /dev/null
-use Carp;
-use Switch qw(Perl6 __ fallthrough);
-
-my($C,$M);sub ok{$C++;$M.=$_[0]?"ok $C\n":"not ok $C (line ".(caller)[2].")\n"}
-END{print"1..$C\n$M"}
-
-# NON-when THINGS;
-
-$when->{when} = { when => "when" };
-
-*when = \&when;
-
-# PREMATURE when
-
-eval { when 1 { ok(0) }; ok(0) } || ok(1);
-
-# H.O. FUNCS
-
-given __ > 2 {
-
- when 1 { ok(0) } else { ok(1) }
- when 2 { ok(0) } else { ok(1) }
- when 3 { ok(1) } else { ok(0) }
-}
-
-given (3) {
-
- eval { when __ <= 1 || __ > 2 { ok(0) } } || ok(1);
- when __ <= 2 { ok(0) };
- when __ <= 3 { ok(1) };
-}
-
-# POSSIBLE ARGS: NUMERIC, STRING, ARRAY, HASH, REGEX, CODE
-
-# 1. NUMERIC SWITCH
-
-for (1..3)
-{
- given ($_) {
- # SELF
- when ($_) { ok(1) } else { ok(0) }
-
- # NUMERIC
- when 1 { ok ($_==1) } else { ok($_!=1) }
- when (1) { ok ($_==1) } else { ok($_!=1) }
- when 3 { ok ($_==3) } else { ok($_!=3) }
- when (4) { ok (0) } else { ok(1) }
- when (2) { ok ($_==2) } else { ok($_!=2) }
-
- # STRING
- when ('a') { ok (0) } else { ok(1) }
- when 'a' { ok (0) } else { ok(1) }
- when ('3') { ok ($_ == 3) } else { ok($_ != 3) }
- when ('3.0') { ok (0) } else { ok(1) }
-
- # ARRAY
- when ([10,5,1]) { ok ($_==1) } else { ok($_!=1) }
- when [10,5,1] { ok ($_==1) } else { ok($_!=1) }
- when (['a','b']) { ok (0) } else { ok(1) }
- when (['a','b',3]) { ok ($_==3) } else { ok ($_!=3) }
- when (['a','b',2.0]) { ok ($_==2) } else { ok ($_!=2) }
- when ([]) { ok (0) } else { ok(1) }
-
- # HASH
- when ({}) { ok (0) } else { ok (1) }
- when {} { ok (0) } else { ok (1) }
- when {1,1} { ok ($_==1) } else { ok($_!=1) }
- when ({1=>1, 2=>0}) { ok ($_==1) } else { ok($_!=1) }
-
- # SUB/BLOCK
- when (sub {$_[0]==2}) { ok ($_==2) } else { ok($_!=2) }
- when {$_[0]==2} { ok ($_==2) } else { ok($_!=2) }
- when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
- when {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH
- }
-}
-
-
-# 2. STRING SWITCH
-
-for ('a'..'c','1')
-{
- given ($_) {
- # SELF
- when ($_) { ok(1) } else { ok(0) }
-
- # NUMERIC
- when (1) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
- when (1.0) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
-
- # STRING
- when ('a') { ok ($_ eq 'a') } else { ok($_ ne 'a') }
- when ('b') { ok ($_ eq 'b') } else { ok($_ ne 'b') }
- when ('c') { ok ($_ eq 'c') } else { ok($_ ne 'c') }
- when ('1') { ok ($_ eq '1') } else { ok($_ ne '1') }
- when ('d') { ok (0) } else { ok (1) }
-
- # ARRAY
- when (['a','1']) { ok ($_ eq 'a' || $_ eq '1') }
- else { ok ($_ ne 'a' && $_ ne '1') }
- when (['z','2']) { ok (0) } else { ok(1) }
- when ([]) { ok (0) } else { ok(1) }
-
- # HASH
- when ({}) { ok (0) } else { ok (1) }
- when ({a=>'a', 1=>1, 2=>0}) { ok ($_ eq 'a' || $_ eq '1') }
- else { ok ($_ ne 'a' && $_ ne '1') }
-
- # SUB/BLOCK
- when (sub{$_[0] eq 'a' }) { ok ($_ eq 'a') }
- else { ok($_ ne 'a') }
- when {$_[0] eq 'a'} { ok ($_ eq 'a') } else { ok($_ ne 'a') }
- when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
- when {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH
- }
-}
-
-
-# 3. ARRAY SWITCH
-
-my $iteration = 0;
-for ([],[1,'a'],[2,'b'])
-{
- given ($_) {
- $iteration++;
- # SELF
- when ($_) { ok(1) }
-
- # NUMERIC
- when (1) { ok ($iteration==2) } else { ok ($iteration!=2) }
- when (1.0) { ok ($iteration==2) } else { ok ($iteration!=2) }
-
- # STRING
- when ('a') { ok ($iteration==2) } else { ok ($iteration!=2) }
- when ('b') { ok ($iteration==3) } else { ok ($iteration!=3) }
- when ('1') { ok ($iteration==2) } else { ok ($iteration!=2) }
-
- # ARRAY
- when (['a',2]) { ok ($iteration>=2) } else { ok ($iteration<2) }
- when ([1,'a']) { ok ($iteration==2) } else { ok($iteration!=2) }
- when ([]) { ok (0) } else { ok(1) }
- when ([7..100]) { ok (0) } else { ok(1) }
-
- # HASH
- when ({}) { ok (0) } else { ok (1) }
- when ({a=>'a', 1=>1, 2=>0}) { ok ($iteration==2) }
- else { ok ($iteration!=2) }
-
- # SUB/BLOCK
- when {scalar grep /a/, @_} { ok ($iteration==2) }
- else { ok ($iteration!=2) }
- when (sub {scalar grep /a/, @_ }) { ok ($iteration==2) }
- else { ok ($iteration!=2) }
- when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
- when {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH
- }
-}
-
-
-# 4. HASH SWITCH
-
-$iteration = 0;
-for ({},{a=>1,b=>0})
-{
- given ($_) {
- $iteration++;
-
- # SELF
- when ($_) { ok(1) } else { ok(0) }
-
- # NUMERIC
- when (1) { ok (0) } else { ok (1) }
- when (1.0) { ok (0) } else { ok (1) }
-
- # STRING
- when ('a') { ok ($iteration==2) } else { ok ($iteration!=2) }
- when ('b') { ok (0) } else { ok (1) }
- when ('c') { ok (0) } else { ok (1) }
-
- # ARRAY
- when (['a',2]) { ok ($iteration==2) }
- else { ok ($iteration!=2) }
- when (['b','a']) { ok ($iteration==2) }
- else { ok ($iteration!=2) }
- when (['b','c']) { ok (0) } else { ok (1) }
- when ([]) { ok (0) } else { ok(1) }
- when ([7..100]) { ok (0) } else { ok(1) }
-
- # HASH
- when ({}) { ok (0) } else { ok (1) }
- when ({a=>'a', 1=>1, 2=>0}) { ok (0) } else { ok (1) }
-
- # SUB/BLOCK
- when {$_[0]{a}} { ok ($iteration==2) }
- else { ok ($iteration!=2) }
- when (sub {$_[0]{a}}) { ok ($iteration==2) }
- else { ok ($iteration!=2) }
- when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
- when {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH
- }
-}
-
-
-# 5. CODE SWITCH
-
-$iteration = 0;
-for ( sub {1},
- sub { return 0 unless @_;
- my ($data) = @_;
- my $type = ref $data;
- return $type eq 'HASH' && $data->{a}
- || $type eq 'Regexp' && 'a' =~ /$data/
- || $type eq "" && $data eq '1';
- },
- sub {0} )
-{
- given ($_) {
- $iteration++;
- # SELF
- when ($_) { ok(1) } else { ok(0) }
-
- # NUMERIC
- when (1) { ok ($iteration<=2) } else { ok ($iteration>2) }
- when (1.0) { ok ($iteration<=2) } else { ok ($iteration>2) }
- when (1.1) { ok ($iteration==1) } else { ok ($iteration!=1) }
-
- # STRING
- when ('a') { ok ($iteration==1) } else { ok ($iteration!=1) }
- when ('b') { ok ($iteration==1) } else { ok ($iteration!=1) }
- when ('c') { ok ($iteration==1) } else { ok ($iteration!=1) }
- when ('1') { ok ($iteration<=2) } else { ok ($iteration>2) }
-
- # ARRAY
- when ([1, 'a']) { ok ($iteration<=2) }
- else { ok ($iteration>2) }
- when (['b','a']) { ok ($iteration==1) }
- else { ok ($iteration!=1) }
- when (['b','c']) { ok ($iteration==1) }
- else { ok ($iteration!=1) }
- when ([]) { ok ($iteration==1) } else { ok($iteration!=1) }
- when ([7..100]) { ok ($iteration==1) }
- else { ok($iteration!=1) }
-
- # HASH
- when ({}) { ok ($iteration==1) } else { ok ($iteration!=1) }
- when ({a=>'a', 1=>1, 2=>0}) { ok ($iteration<=2) }
- else { ok ($iteration>2) }
-
- # SUB/BLOCK
- when {$_[0]->{a}} { ok (0) } else { ok (1) }
- when (sub {$_[0]{a}}) { ok (0) } else { ok (1) }
- when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
- when {1} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
- }
-}
-
-
-# NESTED SWITCHES
-
-for my $count (1..3)
-{
- given ([9,"a",11]) {
- when (qr/\d/) {
- given ($count) {
- when (1) { ok($count==1) }
- else { ok($count!=1) }
- when ([5,6]) { ok(0) } else { ok(1) }
- }
- }
- ok(1) when 11;
- }
-}
+++ /dev/null
-use Switch;
-
-print "1..4\n";
-
-my $count = 1;
-for my $count (1..3, 'four')
-{
- switch ([$count])
- {
-
-=pod
-
-=head1 Test
-
-We also test if Switch is POD-friendly here
-
-=cut
-
- case qr/\d/ {
- switch ($count) {
- case 1 { print "ok 1\n" }
- case [2,3] { print "ok $count\n" }
- }
- }
- case 'four' { print "ok 4\n" }
- }
-}
-
-__END__
-
-=head1 Another test
-
-Still friendly???
-
-=cut
+++ /dev/null
-use Carp;
-use Switch qw(__ fallthrough);
-
-my($C,$M);sub ok{$C++;$M.=$_[0]?"ok $C\n":"not ok $C (line ".(caller)[2].")\n"}
-END{print"1..$C\n$M"}
-
-# NON-case THINGS;
-
-$case->{case} = { case => "case" };
-
-*case = \&case;
-
-# PREMATURE case
-
-eval { case 1 { ok(0) }; ok(0) } || ok(1);
-
-# H.O. FUNCS
-
-switch (__ > 2) {
-
- case 1 { ok(0) } else { ok(1) }
- case 2 { ok(0) } else { ok(1) }
- case 3 { ok(1) } else { ok(0) }
-}
-
-switch (3) {
-
- eval { case __ <= 1 || __ > 2 { ok(0) } } || ok(1);
- case __ <= 2 { ok(0) };
- case __ <= 3 { ok(1) };
-}
-
-# POSSIBLE ARGS: NUMERIC, STRING, ARRAY, HASH, REGEX, CODE
-
-# 1. NUMERIC SWITCH
-
-for (1..3)
-{
- switch ($_) {
- # SELF
- case ($_) { ok(1) } else { ok(0) }
-
- # NUMERIC
- case (1) { ok ($_==1) } else { ok($_!=1) }
- case 1 { ok ($_==1) } else { ok($_!=1) }
- case (3) { ok ($_==3) } else { ok($_!=3) }
- case (4) { ok (0) } else { ok(1) }
- case (2) { ok ($_==2) } else { ok($_!=2) }
-
- # STRING
- case ('a') { ok (0) } else { ok(1) }
- case 'a' { ok (0) } else { ok(1) }
- case ('3') { ok ($_ == 3) } else { ok($_ != 3) }
- case ('3.0') { ok (0) } else { ok(1) }
-
- # ARRAY
- case ([10,5,1]) { ok ($_==1) } else { ok($_!=1) }
- case [10,5,1] { ok ($_==1) } else { ok($_!=1) }
- case (['a','b']) { ok (0) } else { ok(1) }
- case (['a','b',3]) { ok ($_==3) } else { ok ($_!=3) }
- case (['a','b',2.0]) { ok ($_==2) } else { ok ($_!=2) }
- case ([]) { ok (0) } else { ok(1) }
-
- # HASH
- case ({}) { ok (0) } else { ok (1) }
- case {} { ok (0) } else { ok (1) }
- case {1,1} { ok ($_==1) } else { ok($_!=1) }
- case ({1=>1, 2=>0}) { ok ($_==1) } else { ok($_!=1) }
-
- # SUB/BLOCK
- case (sub {$_[0]==2}) { ok ($_==2) } else { ok($_!=2) }
- case {$_[0]==2} { ok ($_==2) } else { ok($_!=2) }
- case {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
- case {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH
- }
-}
-
-
-# 2. STRING SWITCH
-
-for ('a'..'c','1')
-{
- switch ($_) {
- # SELF
- case ($_) { ok(1) } else { ok(0) }
-
- # NUMERIC
- case (1) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
- case (1.0) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
-
- # STRING
- case ('a') { ok ($_ eq 'a') } else { ok($_ ne 'a') }
- case ('b') { ok ($_ eq 'b') } else { ok($_ ne 'b') }
- case ('c') { ok ($_ eq 'c') } else { ok($_ ne 'c') }
- case ('1') { ok ($_ eq '1') } else { ok($_ ne '1') }
- case ('d') { ok (0) } else { ok (1) }
-
- # ARRAY
- case (['a','1']) { ok ($_ eq 'a' || $_ eq '1') }
- else { ok ($_ ne 'a' && $_ ne '1') }
- case (['z','2']) { ok (0) } else { ok(1) }
- case ([]) { ok (0) } else { ok(1) }
-
- # HASH
- case ({}) { ok (0) } else { ok (1) }
- case ({a=>'a', 1=>1, 2=>0}) { ok ($_ eq 'a' || $_ eq '1') }
- else { ok ($_ ne 'a' && $_ ne '1') }
-
- # SUB/BLOCK
- case (sub{$_[0] eq 'a' }) { ok ($_ eq 'a') }
- else { ok($_ ne 'a') }
- case {$_[0] eq 'a'} { ok ($_ eq 'a') } else { ok($_ ne 'a') }
- case {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
- case {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH
- }
-}
-
-
-# 3. ARRAY SWITCH
-
-my $iteration = 0;
-for ([],[1,'a'],[2,'b'])
-{
- switch ($_) {
- $iteration++;
- # SELF
- case ($_) { ok(1) }
-
- # NUMERIC
- case (1) { ok ($iteration==2) } else { ok ($iteration!=2) }
- case (1.0) { ok ($iteration==2) } else { ok ($iteration!=2) }
-
- # STRING
- case ('a') { ok ($iteration==2) } else { ok ($iteration!=2) }
- case ('b') { ok ($iteration==3) } else { ok ($iteration!=3) }
- case ('1') { ok ($iteration==2) } else { ok ($iteration!=2) }
-
- # ARRAY
- case (['a',2]) { ok ($iteration>=2) } else { ok ($iteration<2) }
- case ([1,'a']) { ok ($iteration==2) } else { ok($iteration!=2) }
- case ([]) { ok (0) } else { ok(1) }
- case ([7..100]) { ok (0) } else { ok(1) }
-
- # HASH
- case ({}) { ok (0) } else { ok (1) }
- case ({a=>'a', 1=>1, 2=>0}) { ok ($iteration==2) }
- else { ok ($iteration!=2) }
-
- # SUB/BLOCK
- case {scalar grep /a/, @_} { ok ($iteration==2) }
- else { ok ($iteration!=2) }
- case (sub {scalar grep /a/, @_ }) { ok ($iteration==2) }
- else { ok ($iteration!=2) }
- case {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
- case {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH
- }
-}
-
-
-# 4. HASH SWITCH
-
-$iteration = 0;
-for ({},{a=>1,b=>0})
-{
- switch ($_) {
- $iteration++;
-
- # SELF
- case ($_) { ok(1) } else { ok(0) }
-
- # NUMERIC
- case (1) { ok (0) } else { ok (1) }
- case (1.0) { ok (0) } else { ok (1) }
-
- # STRING
- case ('a') { ok ($iteration==2) } else { ok ($iteration!=2) }
- case ('b') { ok (0) } else { ok (1) }
- case ('c') { ok (0) } else { ok (1) }
-
- # ARRAY
- case (['a',2]) { ok ($iteration==2) }
- else { ok ($iteration!=2) }
- case (['b','a']) { ok ($iteration==2) }
- else { ok ($iteration!=2) }
- case (['b','c']) { ok (0) } else { ok (1) }
- case ([]) { ok (0) } else { ok(1) }
- case ([7..100]) { ok (0) } else { ok(1) }
-
- # HASH
- case ({}) { ok (0) } else { ok (1) }
- case ({a=>'a', 1=>1, 2=>0}) { ok (0) } else { ok (1) }
-
- # SUB/BLOCK
- case {$_[0]{a}} { ok ($iteration==2) }
- else { ok ($iteration!=2) }
- case (sub {$_[0]{a}}) { ok ($iteration==2) }
- else { ok ($iteration!=2) }
- case {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
- case {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH
- }
-}
-
-
-# 5. CODE SWITCH
-
-$iteration = 0;
-for ( sub {1},
- sub { return 0 unless @_;
- my ($data) = @_;
- my $type = ref $data;
- return $type eq 'HASH' && $data->{a}
- || $type eq 'Regexp' && 'a' =~ /$data/
- || $type eq "" && $data eq '1';
- },
- sub {0} )
-{
- switch ($_) {
- $iteration++;
- # SELF
- case ($_) { ok(1) } else { ok(0) }
-
- # NUMERIC
- case (1) { ok ($iteration<=2) } else { ok ($iteration>2) }
- case (1.0) { ok ($iteration<=2) } else { ok ($iteration>2) }
- case (1.1) { ok ($iteration==1) } else { ok ($iteration!=1) }
-
- # STRING
- case ('a') { ok ($iteration==1) } else { ok ($iteration!=1) }
- case ('b') { ok ($iteration==1) } else { ok ($iteration!=1) }
- case ('c') { ok ($iteration==1) } else { ok ($iteration!=1) }
- case ('1') { ok ($iteration<=2) } else { ok ($iteration>2) }
-
- # ARRAY
- case ([1, 'a']) { ok ($iteration<=2) }
- else { ok ($iteration>2) }
- case (['b','a']) { ok ($iteration==1) }
- else { ok ($iteration!=1) }
- case (['b','c']) { ok ($iteration==1) }
- else { ok ($iteration!=1) }
- case ([]) { ok ($iteration==1) } else { ok($iteration!=1) }
- case ([7..100]) { ok ($iteration==1) }
- else { ok($iteration!=1) }
-
- # HASH
- case ({}) { ok ($iteration==1) } else { ok ($iteration!=1) }
- case ({a=>'a', 1=>1, 2=>0}) { ok ($iteration<=2) }
- else { ok ($iteration>2) }
-
- # SUB/BLOCK
- case {$_[0]->{a}} { ok (0) } else { ok (1) }
- case (sub {$_[0]{a}}) { ok (0) } else { ok (1) }
- case {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
- case {1} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
- }
-}
-
-
-# NESTED SWITCHES
-
-for my $count (1..3)
-{
- switch ([9,"a",11]) {
- case (qr/\d/) {
- switch ($count) {
- case (1) { ok($count==1) }
- else { ok($count!=1) }
- case ([5,6]) { ok(0) } else { ok(1) }
- }
- }
- ok(1) case (11);
- }
-}
'Time::HiRes'=> q| ::can_ok( 'Time::HiRes' => 'usleep' ) |, # 5.7.3
);
-plan tests => keys(%modules) * 4 + 5;
+plan tests => keys(%modules) * 3 + 5;
# Try to load the module
use_ok( 'XSLoader' );
SKIP: {
skip "$module not available", 4 if $extensions !~ /\b$module\b/;
- eval qq{ package $module; XSLoader::load('$module', "qunckkk"); };
- like( $@, "/^$module object version \\S+ does not match bootstrap parameter (?:qunckkk|0)/",
+ eval qq{ package $module; XSLoader::load('$module', "12345678"); };
+ like( $@, "/^$module object version \\S+ does not match bootstrap parameter (?:12345678|0)/",
"calling XSLoader::load() with a XS module and an incorrect version" );
- like( $warnings, "/^\$|^Version string 'qunckkk' contains invalid data; ignoring: 'qunckkk'/",
- "in Perl 5.10, DynaLoader warns about the incorrect version string" );
eval qq{ package $module; XSLoader::load('$module'); };
is( $@, '', "XSLoader::load($module)");
use Scalar::Util qw(reftype refaddr blessed);
-our $VERSION = '1.32';
+our $VERSION = '1.33';
my $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
=head1 VERSION
-This document describes threads::shared version 1.32
+This document describes threads::shared version 1.33
=head1 SYNOPSIS
mentioned limitation. See F<examples/class.pl> (in the CPAN distribution of
this module) for how to create a class that supports object sharing.
-Does not support C<splice> on arrays!
+Does not support C<splice> on arrays. Does not support explicitly changing
+array lengths via $#array -- use C<push> and C<pop> instead.
Taking references to the elements of shared arrays and hashes does not
autovivify the elements, and neither does slicing a shared array/hash over
L<http://www.cpanforum.com/dist/threads-shared>
Annotated POD for L<threads::shared>:
-L<http://annocpan.org/~JDHEDDEN/threads-shared-1.32/shared.pm>
+L<http://annocpan.org/~JDHEDDEN/threads-shared-1.33/shared.pm>
Source repository:
L<http://code.google.com/p/threads-shared/>
{
dTHXc;
SV *saggregate = S_sharedsv_from_obj(aTHX_ mg->mg_obj);
- SV** svp;
+ SV** svp = NULL;
ENTER_LOCK;
- if (SvTYPE(saggregate) == SVt_PVAV) {
- assert ( mg->mg_ptr == 0 );
- SHARED_CONTEXT;
- svp = av_fetch((AV*) saggregate, mg->mg_len, 0);
- } else {
- char *key = mg->mg_ptr;
- I32 len = mg->mg_len;
- assert ( mg->mg_ptr != 0 );
- if (mg->mg_len == HEf_SVKEY) {
- STRLEN slen;
- key = SvPV((SV *)mg->mg_ptr, slen);
- len = slen;
- if (SvUTF8((SV *)mg->mg_ptr)) {
- len = -len;
+ if (saggregate) { /* During global destruction, underlying
+ aggregate may no longer exist */
+ if (SvTYPE(saggregate) == SVt_PVAV) {
+ assert ( mg->mg_ptr == 0 );
+ SHARED_CONTEXT;
+ svp = av_fetch((AV*) saggregate, mg->mg_len, 0);
+ } else {
+ char *key = mg->mg_ptr;
+ I32 len = mg->mg_len;
+ assert ( mg->mg_ptr != 0 );
+ if (mg->mg_len == HEf_SVKEY) {
+ STRLEN slen;
+ key = SvPV((SV *)mg->mg_ptr, slen);
+ len = slen;
+ if (SvUTF8((SV *)mg->mg_ptr)) {
+ len = -len;
+ }
}
+ SHARED_CONTEXT;
+ svp = hv_fetch((HV*) saggregate, key, len, 0);
}
- SHARED_CONTEXT;
- svp = hv_fetch((HV*) saggregate, key, len, 0);
+ CALLER_CONTEXT;
}
- CALLER_CONTEXT;
if (svp) {
/* Exists in the array */
if (SvROK(*svp)) {
dTHXc;
MAGIC *shmg;
SV *saggregate = S_sharedsv_from_obj(aTHX_ mg->mg_obj);
+
+ /* Object may not exist during global destruction */
+ if (! saggregate) {
+ return (0);
+ }
+
ENTER_LOCK;
sharedsv_elem_mg_FETCH(aTHX_ sv, mg);
if ((shmg = mg_find(sv, PERL_MAGIC_shared_scalar)))
BEGIN {
$| = 1;
- print("1..33\n"); ### Number of tests that will be run ###
+ print("1..34\n"); ### Number of tests that will be run ###
};
use threads;
ok(30, ! defined($thrx), 'No object');
$thrx = threads->object(undef);
ok(31, ! defined($thrx), 'No object');
-$thrx = threads->object(0);
-ok(32, ! defined($thrx), 'No object');
threads->import('stringify');
$thr1 = threads->create(sub {});
-ok(33, "$thr1" eq $thr1->tid(), 'Stringify');
+ok(32, "$thr1" eq $thr1->tid(), 'Stringify');
$thr1->join();
+# ->object($tid) works like ->self() when $tid is thread's TID
+$thrx = threads->object(threads->tid());
+ok(33, defined($thrx), 'Main thread object');
+ok(34, 0 == $thrx->tid(), "Check so that tid for threads work for main thread");
+
exit(0);
# EOF
ok(! defined($rc), 'Exited: threads->exit()');
-run_perl(prog => 'use threads 1.75;' .
+run_perl(prog => 'use threads 1.77;' .
'threads->exit(86);' .
'exit(99);',
nolib => ($ENV{PERL_CORE}) ? 0 : 1,
ok(! defined($rc), 'Exited: $thr->set_thread_exit_only');
-run_perl(prog => 'use threads 1.75 qw(exit thread_only);' .
+run_perl(prog => 'use threads 1.77 qw(exit thread_only);' .
'threads->create(sub { exit(99); })->join();' .
'exit(86);',
nolib => ($ENV{PERL_CORE}) ? 0 : 1,
is($?>>8, 86, "'use threads 'exit' => 'thread_only'");
}
-my $out = run_perl(prog => 'use threads 1.75;' .
+my $out = run_perl(prog => 'use threads 1.77;' .
'threads->create(sub {' .
' exit(99);' .
'});' .
like($out, '1 finished and unjoined', "exit(status) in thread");
-$out = run_perl(prog => 'use threads 1.75 qw(exit thread_only);' .
+$out = run_perl(prog => 'use threads 1.77 qw(exit thread_only);' .
'threads->create(sub {' .
' threads->set_thread_exit_only(0);' .
' exit(99);' .
like($out, '1 finished and unjoined', "set_thread_exit_only(0)");
-run_perl(prog => 'use threads 1.75;' .
+run_perl(prog => 'use threads 1.77;' .
'threads->create(sub {' .
' $SIG{__WARN__} = sub { exit(99); };' .
' die();' .
}
$| = 1;
- print("1..34\n"); ### Number of tests that will be run ###
+ print("1..35\n"); ### Number of tests that will be run ###
};
print("ok 1 - Loaded\n");
# bugid #24165
-run_perl(prog => 'use threads 1.75;' .
+run_perl(prog => 'use threads 1.77;' .
'sub a{threads->create(shift)} $t = a sub{};' .
'$t->tid; $t->join; $t->tid',
nolib => ($ENV{PERL_CORE}) ? 0 : 1,
"counts of calls to DESTROY");
}
+# Bug 73330 - Apply magic to arg to ->object()
+{
+ my @tids :shared;
+
+ my $thr = threads->create(sub {
+ lock(@tids);
+ push(@tids, threads->tid());
+ cond_signal(@tids);
+ });
+
+ {
+ lock(@tids);
+ cond_wait(@tids) while (! @tids);
+ }
+
+ ok(threads->object($_), 'Got threads object') foreach (@tids);
+
+ $thr->join();
+}
+
exit(0);
# EOF
use strict;
use warnings;
-our $VERSION = '1.75';
+our $VERSION = '1.77_01';
my $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
=head1 VERSION
-This document describes threads version 1.75
+This document describes threads version 1.77
=head1 SYNOPSIS
=item threads->object($tid)
This will return the I<threads> object for the I<active> thread associated
-with the specified thread ID. Returns C<undef> if there is no thread
-associated with the TID, if the thread is joined or detached, if no TID is
-specified or if the specified TID is undef.
+with the specified thread ID. If C<$tid> is the value for the current thread,
+then this call works the same as C<-E<gt>self()>. Otherwise, returns C<undef>
+if there is no thread associated with the TID, if the thread is joined or
+detached, if no TID is specified or if the specified TID is undef.
=item threads->yield()
If the above does not work, or is not adequate for your application, then file
a bug report on L<http://rt.cpan.org/Public/> against the problematic module.
+=item Memory consumption
+
+On most systems, frequent and continual creation and destruction of threads
+can lead to ever-increasing growth in the memory footprint of the Perl
+interpreter. While it is simple to just launch threads and then
+C<-E<gt>join()> or C<-E<gt>detach()> them, for long-lived applications, it is
+better to maintain a pool of threads, and to reuse them for the work needed,
+using L<queues|Thread::Queue> to notify threads of pending work. The CPAN
+distribution of this module contains a simple example
+(F<examples/pool_reuse.pl>) illustrating the creation, use and monitoring of a
+pool of I<reusable> threads.
+
=item Current working directory
On all platforms except MSWin32, the setting for the current working directory
version of the object (e.g., using L<Data::Dumper> or L<Storable>), and then
reconstituting it in the joining thread. If you're using Perl 5.10.0 or
later, and if the class supports L<shared objects|threads::shared/"OBJECTS">,
-you can pass them via L<shared queues| Thread::Queue>.
+you can pass them via L<shared queues|Thread::Queue>.
=item END blocks in threads
L<http://www.cpanforum.com/dist/threads>
Annotated POD for L<threads>:
-L<http://annocpan.org/~JDHEDDEN/threads-1.75/threads.pm>
+L<http://annocpan.org/~JDHEDDEN/threads-1.77/threads.pm>
Source repository:
L<http://code.google.com/p/threads-shared/>
/* Values for 'state' member */
#define PERL_ITHR_DETACHED 1 /* Thread has been detached */
-#define PERL_ITHR_JOINED 2 /* Thread has been joined */
+#define PERL_ITHR_JOINED 2 /* Thread is being / has been joined */
#define PERL_ITHR_FINISHED 4 /* Thread has finished execution */
#define PERL_ITHR_THREAD_EXIT_ONLY 8 /* exit() only exits current thread */
#define PERL_ITHR_NONVIABLE 16 /* Thread creation failed */
ithread_object(...)
PREINIT:
char *classname;
+ SV *arg;
UV tid;
ithread *thread;
int state;
}
classname = (char *)SvPV_nolen(ST(0));
- if ((items < 2) || ! SvOK(ST(1))) {
+ /* Turn $tid from PVLV to SV if needed (bug #73330) */
+ arg = ST(1);
+ SvGETMAGIC(arg);
+
+ if ((items < 2) || ! SvOK(arg)) {
XSRETURN_UNDEF;
}
/* threads->object($tid) */
- tid = SvUV(ST(1));
+ tid = SvUV(arg);
- /* Walk through threads list */
- MUTEX_LOCK(&MY_POOL.create_destruct_mutex);
- for (thread = MY_POOL.main_thread.next;
- thread != &MY_POOL.main_thread;
- thread = thread->next)
- {
- /* Look for TID */
- if (thread->tid == tid) {
- /* Ignore if detached or joined */
- MUTEX_LOCK(&thread->mutex);
- state = thread->state;
- MUTEX_UNLOCK(&thread->mutex);
- if (! (state & PERL_ITHR_UNCALLABLE)) {
- /* Put object on stack */
- ST(0) = sv_2mortal(S_ithread_to_SV(aTHX_ Nullsv, thread, classname, TRUE));
- have_obj = 1;
+ /* If current thread wants its own object, then behave the same as
+ ->self() */
+ thread = S_ithread_get(aTHX);
+ if (thread->tid == tid) {
+ ST(0) = sv_2mortal(S_ithread_to_SV(aTHX_ Nullsv, thread, classname, TRUE));
+ have_obj = 1;
+
+ } else {
+ /* Walk through threads list */
+ MUTEX_LOCK(&MY_POOL.create_destruct_mutex);
+ for (thread = MY_POOL.main_thread.next;
+ thread != &MY_POOL.main_thread;
+ thread = thread->next)
+ {
+ /* Look for TID */
+ if (thread->tid == tid) {
+ /* Ignore if detached or joined */
+ MUTEX_LOCK(&thread->mutex);
+ state = thread->state;
+ MUTEX_UNLOCK(&thread->mutex);
+ if (! (state & PERL_ITHR_UNCALLABLE)) {
+ /* Put object on stack */
+ ST(0) = sv_2mortal(S_ithread_to_SV(aTHX_ Nullsv, thread, classname, TRUE));
+ have_obj = 1;
+ }
+ break;
}
- break;
}
+ MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex);
}
- MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex);
if (! have_obj) {
XSRETURN_UNDEF;
goto say_false;
}
#endif /* USE_STDIO */
- name = SvOK(*svp) ? savesvpv (*svp) : savepvs ("");
+ name = (SvOK(*svp) || SvGMAGICAL(*svp)) ?
+ savesvpv (*svp) : savepvs ("");
SAVEFREEPV(name);
}
else {
}
}
}
+ PERL_ASYNC_CHECK();
break;
}
#endif
tot--;
}
}
+ PERL_ASYNC_CHECK();
break;
#endif
case OP_UNLINK:
return (mode & statbufp->st_mode) ? TRUE : FALSE;
#else /* ! DOSISH */
+# ifdef __CYGWIN__
+ if (ingroup(544,effective)) { /* member of Administrators */
+# else
if ((effective ? PL_euid : PL_uid) == 0) { /* root is special */
+# endif
if (mode == S_IXUSR) {
if (statbufp->st_mode & 0111 || S_ISDIR(statbufp->st_mode))
return TRUE;
maxnest, dumpops, pvlim); /* MG is already +1 */
continue;
}
+ else if (mg->mg_len == -1 && mg->mg_type == PERL_MAGIC_utf8);
else
- PerlIO_puts(file, " ???? - please notify IZ");
+ PerlIO_puts(
+ file,
+ " ???? - " __FILE__
+ " does not know how to handle this MG_LEN"
+ );
PerlIO_putc(file, '\n');
}
if (mg->mg_type == PERL_MAGIC_utf8) {
s = SvPVX_const(d);
#ifdef DEBUG_LEAKING_SCALARS
- Perl_dump_indent(aTHX_ level, file, "ALLOCATED at %s:%d %s %s%s\n",
+ Perl_dump_indent(aTHX_ level, file,
+ "ALLOCATED at %s:%d %s %s%s; serial %"UVuf"\n",
sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
sv->sv_debug_line,
sv->sv_debug_inpad ? "for" : "by",
sv->sv_debug_optype ? PL_op_name[sv->sv_debug_optype]: "(none)",
- sv->sv_debug_cloned ? " (cloned)" : "");
+ sv->sv_debug_cloned ? " (cloned)" : "",
+ sv->sv_debug_serial
+ );
#endif
Perl_dump_indent(aTHX_ level, file, "SV = ");
if (type < SVt_LAST) {
DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n"));
do {
- PERL_ASYNC_CHECK();
if (PL_debug) {
if (PL_watchaddr && (*PL_watchaddr != PL_watchok))
PerlIO_printf(Perl_debug_log,
+++ /dev/null
-;;; cperl-mode.el --- Perl code editing commands for Emacs
-
-;; Copyright (C) 1985, 86, 87, 91, 92, 93, 94, 95, 96, 97, 98, 99,
-;; 2000, 2003, 2005, 2006
-;; Free Software Foundation, Inc.
-
-;; Author: Ilya Zakharevich and Bob Olson
-;; Maintainer: Ilya Zakharevich <ilyaz@cpan.org>
-;; Keywords: languages, Perl
-
-;; This file is part of GNU Emacs.
-
-;;; This code started from the following message of long time ago
-;;; (IZ), but Bob does not maintain this mode any more:
-
-;;; From: olson@mcs.anl.gov (Bob Olson)
-;;; Newsgroups: comp.lang.perl
-;;; Subject: cperl-mode: Another perl mode for Gnuemacs
-;;; Date: 14 Aug 91 15:20:01 GMT
-
-;; Copyright (C) Ilya Zakharevich and Bob Olson
-
-;; This file may be distributed
-;; either under the same terms as GNU Emacs, or under the same terms
-;; as Perl. You should have received a copy of Perl Artistic license
-;; along with the Perl distribution.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Corrections made by Ilya Zakharevich ilyaz@cpan.org
-;;; XEmacs changes by Peter Arius arius@informatik.uni-erlangen.de
-
-;;; Commentary:
-
-;; $Id: cperl-mode.el,v 5.23 2007/02/15 11:34:23 vera Exp vera $
-
-;;; If your Emacs does not default to `cperl-mode' on Perl files:
-;;; To use this mode put the following into
-;;; your .emacs file:
-
-;; (autoload 'perl-mode "cperl-mode" "alternate mode for editing Perl programs" t)
-
-;; You can either fine-tune the bells and whistles of this mode or
-;; bulk enable them by putting
-
-;; (setq cperl-hairy t)
-
-;; 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', `cperl-praise', `cperl-speed'. <<<<<<
-
-;; Additional useful commands to put into your .emacs file (before
-;; RMS Emacs 20.3):
-
-;; (setq auto-mode-alist
-;; (append '(("\\.\\([pP][Llm]\\|al\\)$" . perl-mode)) auto-mode-alist ))
-;; (setq interpreter-mode-alist (append interpreter-mode-alist
-;; '(("miniperl" . perl-mode))))
-
-;; The mode information (on C-h m) provides some customization help.
-;; If you use font-lock feature of this mode, it is advisable to use
-;; either lazy-lock-mode or fast-lock-mode. I prefer lazy-lock.
-
-;; Faces used now: three faces for first-class and second-class keywords
-;; and control flow words, one for each: comments, string, labels,
-;; functions definitions and packages, arrays, hashes, and variable
-;; definitions. If you do not see all these faces, your font-lock does
-;; not define them, so you need to define them manually.
-;; Maybe you have an obsolete font-lock from 19.28 or earlier. Upgrade.
-
-;; If you have a grayscale monitor, and do not have the variable
-;; font-lock-display-type bound to 'grayscale, insert
-
-;; (setq font-lock-display-type 'grayscale)
-
-;; into your .emacs file (this is relevant before RMS Emacs 20).
-
-;; This mode supports font-lock, imenu and mode-compile. In the
-;; hairy version font-lock is on, but you should activate imenu
-;; yourself (note that mode-compile is not standard yet). Well, you
-;; can use imenu from keyboard anyway (M-x imenu), but it is better
-;; to bind it like that:
-
-;; (define-key global-map [M-S-down-mouse-3] 'imenu)
-
-;;; Font lock bugs as of v4.32:
-
-;; The following kinds of Perl code erroneously start strings:
-;; \$` \$' \$"
-;; $opt::s $opt_s $opt{s} (s => ...) /\s+.../
-;; likewise with m, tr, y, q, qX instead of s
-
-;;; In fact the version of font-lock that this version supports can be
-;;; much newer than the version you actually have. This means that a
-;;; lot of faces can be set up, but are not visible on your screen
-;;; since the coloring rules for this faces are not defined.
-
-;;; Updates: ========================================
-
-;;; Made less hairy by default: parentheses not electric,
-;;; linefeed not magic. Bug with abbrev-mode corrected.
-
-;;;; After 1.4:
-;;; Better indentation:
-;;; subs inside braces should work now,
-;;; Toplevel braces obey customization.
-;;; indent-for-comment knows about bad cases, cperl-indent-for-comment
-;;; moves cursor to a correct place.
-;;; cperl-indent-exp written from the scratch! Slow... (quadratic!) :-(
-;;; (50 secs on DB::DB (sub of 430 lines), 486/66)
-;;; Minor documentation fixes.
-;;; Imenu understands packages as prefixes (including nested).
-;;; Hairy options can be switched off one-by-one by setting to null.
-;;; Names of functions and variables changed to conform to `cperl-' style.
-
-;;;; After 1.5:
-;;; Some bugs with indentation of labels (and embedded subs) corrected.
-;;; `cperl-indent-region' done (slow :-()).
-;;; `cperl-fill-paragraph' done.
-;;; Better package support for `imenu'.
-;;; Progress indicator for indentation (with `imenu' loaded).
-;;; `Cperl-set' was busted, now setting the individual hairy option
-;;; should be better.
-
-;;;; After 1.6:
-;;; `cperl-set-style' done.
-;;; `cperl-check-syntax' done.
-;;; Menu done.
-;;; New config variables `cperl-close-paren-offset' and `cperl-comment-column'.
-;;; Bugs with `cperl-auto-newline' corrected.
-;;; `cperl-electric-lbrace' can work with `cperl-auto-newline' in situation
-;;; like $hash{.
-
-;;;; 1.7 XEmacs (arius@informatik.uni-erlangen.de):
-;;; - use `next-command-event', if `next-command-events' does not exist
-;;; - use `find-face' as def. of `is-face'
-;;; - corrected def. of `x-color-defined-p'
-;;; - added const defs for font-lock-comment-face,
-;;; font-lock-keyword-face and font-lock-function-name-face
-;;; - added def. of font-lock-variable-name-face
-;;; - added (require 'easymenu) inside an `eval-when-compile'
-;;; - replaced 4-argument `substitute-key-definition' with ordinary
-;;; `define-key's
-;;; - replaced `mark-active' in menu definition by `cperl-use-region-p'.
-;;; Todo (at least):
-;;; - use emacs-vers.el (http://www.cs.utah.edu/~eeide/emacs/emacs-vers.el.gz)
-;;; for portable code?
-;;; - should `cperl-mode' do a
-;;; (if (featurep 'easymenu) (easy-menu-add cperl-menu))
-;;; or should this be left to the user's `cperl-mode-hook'?
-
-;;; Some bugs introduced by the above fix corrected (IZ ;-).
-;;; Some bugs under XEmacs introduced by the correction corrected.
-
-;;; Some more can remain since there are two many different variants.
-;;; Please feedback!
-
-;;; We do not support fontification of arrays and hashes under
-;;; obsolete font-lock any more. Upgrade.
-
-;;;; after 1.8 Minor bug with parentheses.
-;;;; after 1.9 Improvements from Joe Marzot.
-;;;; after 1.10
-;;; Does not need easymenu to compile under XEmacs.
-;;; `vc-insert-headers' should work better.
-;;; Should work with 19.29 and 19.12.
-;;; Small improvements to fontification.
-;;; Expansion of keywords does not depend on C-? being backspace.
-
-;;; after 1.10+
-;;; 19.29 and 19.12 supported.
-;;; `cperl-font-lock-enhanced' deprecated. Use font-lock-extra.el.
-;;; Support for font-lock-extra.el.
-
-;;;; After 1.11:
-;;; Tools submenu.
-;;; Support for perl5-info.
-;;; `imenu-go-find-at-position' in Tools requires imenu-go.el (see hints above)
-;;; Imenu entries do not work with stock imenu.el. Patch sent to maintainers.
-;;; Fontifies `require a if b;', __DATA__.
-;;; Arglist for auto-fill-mode was incorrect.
-
-;;;; After 1.12:
-;;; `cperl-lineup-step' and `cperl-lineup' added: lineup constructions
-;;; vertically.
-;;; `cperl-do-auto-fill' updated for 19.29 style.
-;;; `cperl-info-on-command' now has a default.
-;;; Workaround for broken C-h on XEmacs.
-;;; VC strings escaped.
-;;; C-h f now may prompt for function name instead of going on,
-;;; controlled by `cperl-info-on-command-no-prompt'.
-
-;;;; After 1.13:
-;;; Msb buffer list includes perl files
-;;; Indent-for-comment uses indent-to
-;;; Can write tag files using etags.
-
-;;;; After 1.14:
-;;; Recognizes (tries to ;-) {...} which are not blocks during indentation.
-;;; `cperl-close-paren-offset' affects ?\] too (and ?\} if not block)
-;;; Bug with auto-filling comments started with "##" corrected.
-
-;;;; Very slow now: on DB::DB 0.91, 486/66:
-
-;;;Function Name Call Count Elapsed Time Average Time
-;;;======================================== ========== ============ ============
-;;;cperl-block-p 469 3.7799999999 0.0080597014
-;;;cperl-get-state 505 163.39000000 0.3235445544
-;;;cperl-comment-indent 12 0.0299999999 0.0024999999
-;;;cperl-backward-to-noncomment 939 4.4599999999 0.0047497337
-;;;cperl-calculate-indent 505 172.22000000 0.3410297029
-;;;cperl-indent-line 505 172.88000000 0.3423366336
-;;;cperl-use-region-p 40 0.0299999999 0.0007499999
-;;;cperl-indent-exp 1 177.97000000 177.97000000
-;;;cperl-to-comment-or-eol 1453 3.9800000000 0.0027391603
-;;;cperl-backward-to-start-of-continued-exp 9 0.0300000000 0.0033333333
-;;;cperl-indent-region 1 177.94000000 177.94000000
-
-;;;; After 1.15:
-;;; Takes into account white space after opening parentheses during indent.
-;;; May highlight pods and here-documents: see `cperl-pod-here-scan',
-;;; `cperl-pod-here-fontify', `cperl-pod-face'. Does not use this info
-;;; for indentation so far.
-;;; Fontification updated to 19.30 style.
-;;; The change 19.29->30 did not add all the required functionality,
-;;; but broke "font-lock-extra.el". Get "choose-color.el" from
-;;; http://ilyaz.org/software/emacs
-
-;;;; After 1.16:
-;;; else # comment
-;;; recognized as a start of a block.
-;;; Two different font-lock-levels provided.
-;;; `cperl-pod-head-face' introduced. Used for highlighting.
-;;; `imenu' marks pods, +Packages moved to the head.
-
-;;;; After 1.17:
-;;; Scan for pods highlights here-docs too.
-;;; Note that the tag of here-doc may be rehighlighted later by lazy-lock.
-;;; Only one here-doc-tag per line is supported, and one in comment
-;;; or a string may break fontification.
-;;; POD headers were supposed to fill one line only.
-
-;;;; After 1.18:
-;;; `font-lock-keywords' were set in 19.30 style _always_. Current scheme
-;;; may break under XEmacs.
-;;; `cperl-calculate-indent' dis suppose that `parse-start' was defined.
-;;; `fontified' tag is added to fontified text as well as `lazy-lock' (for
-;;; compatibility with older lazy-lock.el) (older one overfontifies
-;;; something nevertheless :-().
-;;; Will not indent something inside pod and here-documents.
-;;; Fontifies the package name after import/no/bootstrap.
-;;; Added new entry to menu with meta-info about the mode.
-
-;;;; After 1.19:
-;;; Prefontification works much better with 19.29. Should be checked
-;;; with 19.30 as well.
-;;; Some misprints in docs corrected.
-;;; Now $a{-text} and -text => "blah" are fontified as strings too.
-;;; Now the pod search is much stricter, so it can help you to find
-;;; pod sections which are broken because of whitespace before =blah
-;;; - just observe the fontification.
-
-;;;; After 1.20
-;;; Anonymous subs are indented with respect to the level of
-;;; indentation of `sub' now.
-;;; {} is recognized as hash after `bless' and `return'.
-;;; Anonymous subs are split by `cperl-linefeed' as well.
-;;; Electric parens embrace a region if present.
-;;; To make `cperl-auto-newline' useful,
-;;; `cperl-auto-newline-after-colon' is introduced.
-;;; `cperl-electric-parens' is now t or nul. The old meaning is moved to
-;;; `cperl-electric-parens-string'.
-;;; `cperl-toggle-auto-newline' introduced, put on C-c C-a.
-;;; `cperl-toggle-abbrev' introduced, put on C-c C-k.
-;;; `cperl-toggle-electric' introduced, put on C-c C-e.
-;;; Beginning-of-defun-regexp was not anchored.
-
-;;;; After 1.21
-;;; Auto-newline grants `cperl-extra-newline-before-brace' if "{" is typed
-;;; after ")".
-;;; {} is recognized as expression after `tr' and friends.
-
-;;;; After 1.22
-;;; Entry Hierarchy added to imenu. Very primitive so far.
-;;; One needs newer `imenu-go'.el. A patch to `imenu' is needed as well.
-;;; Writes its own TAGS files.
-;;; Class viewer based on TAGS files. Does not trace @ISA so far.
-;;; 19.31: Problems with scan for PODs corrected.
-;;; First POD header correctly fontified.
-;;; I needed (setq imenu-use-keymap-menu t) to get good imenu in 19.31.
-;;; Apparently it makes a lot of hierarchy code obsolete...
-
-;;;; After 1.23
-;;; Tags filler now scans *.xs as well.
-;;; The info from *.xs scan is used by the hierarchy viewer.
-;;; Hierarchy viewer documented.
-;;; Bug in 19.31 imenu documented.
-
-;;;; After 1.24
-;;; New location for info-files mentioned,
-;;; Electric-; should work better.
-;;; Minor bugs with POD marking.
-
-;;;; After 1.25 (probably not...)
-;;; `cperl-info-page' introduced.
-;;; To make `uncomment-region' working, `comment-region' would
-;;; not insert extra space.
-;;; Here documents delimiters better recognized
-;;; (empty one, and non-alphanums in quotes handled). May be wrong with 1<<14?
-;;; `cperl-db' added, used in menu.
-;;; imenu scan removes text-properties, for better debugging
-;;; - but the bug is in 19.31 imenu.
-;;; formats highlighted by font-lock and prescan, embedded comments
-;;; are not treated.
-;;; POD/friends scan merged in one pass.
-;;; Syntax class is not used for analyzing the code, only char-syntax
-;;; may be checked against _ or'ed with w.
-;;; Syntax class of `:' changed to be _.
-;;; `cperl-find-bad-style' added.
-
-;;;; After 1.25
-;;; When search for here-documents, we ignore commented << in simplest cases.
-;;; `cperl-get-help' added, available on C-h v and from menu.
-;;; Auto-help added. Default with `cperl-hairy', switchable on/off
-;;; with startup variable `cperl-lazy-help-time' and from
-;;; menu. Requires `run-with-idle-timer'.
-;;; Highlighting of @abc{@efg} was wrong - interchanged two regexps.
-
-;;;; After 1.27
-;;; Indentation: At toplevel after a label - fixed.
-;;; 1.27 was put to archives in binary mode ===> DOSish :-(
-
-;;;; After 1.28
-;;; Thanks to Martin Buchholz <mrb@Eng.Sun.COM>: misprints in
-;;; comments and docstrings corrected, XEmacs support cleaned up.
-;;; The closing parenths would enclose the region into matching
-;;; parens under the same conditions as the opening ones.
-;;; 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',
-;;; `cperl-shrink-wrap-info-frame'.
-;;; 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!
-;;; Some support for correct indent after here-docs and friends (may
-;;; be superseeded by eminent change to Emacs internals).
-;;; Should work with older Emaxen as well ( `-style stuff removed).
-
-;;;; After 1.32
-
-;;; Started to add support for `syntax-table' property (should work
-;;; with patched Emaxen), controlled by
-;;; `cperl-use-syntax-table-text-property'. Currently recognized:
-;;; All quote-like operators: m, s, y, tr, qq, qw, qx, q,
-;;; // in most frequent context:
-;;; after block or
-;;; ~ { ( = | & + - * ! , ;
-;;; or
-;;; while if unless until and or not xor split grep map
-;;; Here-documents, formats, PODs,
-;;; ${...}
-;;; 'abc$'
-;;; sub a ($); sub a ($) {}
-;;; (provide 'cperl-mode) was missing!
-;;; `cperl-after-expr-p' is now much smarter after `}'.
-;;; `cperl-praise' added to mini-docs.
-;;; Utilities try to support subs-with-prototypes.
-
-;;;; After 1.32.1
-;;; `cperl-after-expr-p' is now much smarter after "() {}" and "word {}":
-;;; if word is "else, map, grep".
-;;; Updated for new values of syntax-table constants.
-;;; Uses `help-char' (at last!) (disabled, does not work?!)
-;;; A couple of regexps where missing _ in character classes.
-;;; -s could be considered as start of regexp, 1../blah/ was not,
-;;; as was not /blah/ at start of file.
-
-;;;; After 1.32.2
-;;; "\C-hv" was wrongly "\C-hf"
-;;; C-hv was not working on `[index()]' because of [] in skip-chars-*.
-;;; `__PACKAGE__' supported.
-;;; Thanks for Greg Badros: `cperl-lazy-unstall' is more complete,
-;;; `cperl-get-help' is made compatible with `query-replace'.
-
-;;;; As of Apr 15, development version of 19.34 supports
-;;;; `syntax-table' text properties. Try setting
-;;;; `cperl-use-syntax-table-text-property'.
-
-;;;; After 1.32.3
-;;; We scan for s{}[] as well (in simplest situations).
-;;; We scan for $blah'foo as well.
-;;; The default is to use `syntax-table' text property if Emacs is good enough.
-;;; `cperl-lineup' is put on C-M-| (=C-M-S-\\).
-;;; Start of `cperl-beautify-regexp'.
-
-;;;; After 1.32.4
-;;; `cperl-tags-hier-init' did not work in text-mode.
-;;; `cperl-noscan-files-regexp' had a misprint.
-;;; Generation of Class Hierarchy was broken due to a bug in `x-popup-menu'
-;;; in 19.34.
-
-;;;; After 1.33:
-;;; my,local highlight vars after {} too.
-;;; TAGS could not be created before imenu was loaded.
-;;; `cperl-indent-left-aligned-comments' created.
-;;; Logic of `cperl-indent-exp' changed a little bit, should be more
-;;; robust w.r.t. multiline strings.
-;;; Recognition of blah'foo takes into account strings.
-;;; Added '.al' to the list of Perl extensions.
-;;; Class hierarchy is "mostly" sorted (need to rethink algorthm
-;;; of pruning one-root-branch subtrees to get yet better sorting.)
-;;; Regeneration of TAGS was busted.
-;;; Can use `syntax-table' property when generating TAGS
-;;; (governed by `cperl-use-syntax-table-text-property-for-tags').
-
-;;;; After 1.35:
-;;; Can process several =pod/=cut sections one after another.
-;;; Knows of `extproc' when under `emx', indents with `__END__' and `__DATA__'.
-;;; `cperl-under-as-char' implemented (XEmacs people like broken behaviour).
-;;; Beautifier for regexps fixed.
-;;; `cperl-beautify-level', `cperl-contract-level' coded
-;;;
-;;;; Emacs's 20.2 problems:
-;;; `imenu.el' has bugs, `imenu-add-to-menubar' does not work.
-;;; Couple of others problems with 20.2 were reported, my ability to check/fix
-;;; them is very reduced now.
-
-;;;; After 1.36:
-;;; 'C-M-|' in XEmacs fixed
-
-;;;; After 1.37:
-;;; &&s was not recognized as start of regular expression;
-;;; Will "preprocess" the contents of //e part of s///e too;
-;;; What to do with s# blah # foo #e ?
-;;; Should handle s;blah;foo;; better.
-;;; Now the only known problems with regular expression recognition:
-;;;;;;; s<foo>/bar/ - different delimiters (end ignored)
-;;;;;;; s/foo/\\bar/ - backslash at start of subst (made into one chunk)
-;;;;;;; s/foo// - empty subst (made into one chunk + '/')
-;;;;;;; s/foo/(bar)/ - start-group at start of subst (internal group will not match backwards)
-
-;;;; After 1.38:
-;;; We highlight closing / of s/blah/foo/e;
-;;; This handles s# blah # foo #e too;
-;;; s//blah/, s///, s/blah// works again, and s#blah## too, the algorithm
-;;; is much simpler now;
-;;; Next round of changes: s\\\ works, s<blah>/foo/,
-;;; comments between the first and the second part allowed
-;;; Another problem discovered:
-;;;;;;; s[foo] <blah>e - e part delimited by different <> (will not match)
-;;; `cperl-find-pods-heres' somehow maybe called when string-face is undefined
-;;; - put a stupid workaround for 20.1
-
-;;;; After 1.39:
-;;; Could indent here-docs for comments;
-;;; These problems fixed:
-;;;;;;; s/foo/\\bar/ - backslash at start of subst (made into two chunk)
-;;;;;;; s[foo] <blah>e - "e" part delimited by "different" <> (will match)
-;;; Matching brackets honor prefices, may expand abbreviations;
-;;; When expanding abbrevs, will remove last char only after
-;;; self-inserted whitespace;
-;;; More convenient "Refress hard constructs" in menu;
-;;; `cperl-add-tags-recurse', `cperl-add-tags-recurse-noxs'
-;;; added (for -batch mode);
-;;; Better handling of errors when scanning for Perl constructs;
-;;;;;;; Possible "problem" with class hierarchy in Perl distribution
-;;;;;;; directory: ./ext duplicates ./lib;
-;;; Write relative paths for generated TAGS;
-
-;;;; After 1.40:
-;;; s /// may be separated by "\n\f" too;
-;;; `s #blah' recognized as a comment;
-;;; Would highlight s/abc//s wrong;
-;;; Debugging code in `cperl-electric-keywords' was leaking a message;
-
-;;;; After 1.41:
-;;; RMS changes for 20.3 merged
-
-;;;; 2.0.1.0: RMS mode (has 3 misprints)
-
-;;;; After 2.0:
-;;; RMS whitespace changes for 20.3 merged
-
-;;;; After 2.1:
-;;; History updated
-
-;;;; After 2.2:
-;;; Merge `c-style-alist' since `c-mode' is no more. (Somebody who
-;;; uses the styles should check that they work OK!)
-;;; All the variable warnings go away, some undef functions too.
-
-;;;; After 2.3:
-;;; Added `cperl-perldoc' (thanks to Anthony Foiani <afoiani@uswest.com>)
-;;; Added `cperl-pod-to-manpage' (thanks to Nick Roberts <Nick.Roberts@src.bae.co.uk>)
-;;; All the function warnings go away.
-
-;;;; After 2.4:
-;;; `Perl doc', `Regexp' submenus created (latter to allow short displays).
-;;; `cperl-clobber-lisp-bindings' added.
-;;; $a->y() is not y///.
-;;; `cperl-after-block-p' was missing a `save-excursion' => wrong results.
-;;; `cperl-val' was defined too late.
-;;; `cperl-init-faces' was failing.
-;;; Init faces when loading `ps-print'.
-
-;;;; After 2.4:
-;;; `cperl-toggle-autohelp' implemented.
-;;; `while SPACE LESS' was buggy.
-;;; `-text' in `[-text => 1]' was not highlighted.
-;;; `cperl-after-block-p' was FALSE after `sub f {}'.
-
-;;;; After 2.5:
-;;; `foreachmy', `formy' expanded too.
-;;; Expand `=pod-directive'.
-;;; `cperl-linefeed' behaves reasonable in POD-directive lines.
-;;; `cperl-electric-keyword' prints a message, governed by
-;;; `cperl-message-electric-keyword'.
-
-;;;; After 2.6:
-;;; Typing `}' was not checking for being block or not.
-;;; Beautifying levels in RE: Did not know about lookbehind;
-;;; finding *which* level was not intuitive;
-;;; `cperl-beautify-levels' added.
-;;; Allow here-docs contain `=head1' and friends (at least for keywords).
-
-;;;; After 2.7:
-;;; Fix for broken `font-lock-unfontify-region-function'. Should
-;;; preserve `syntax-table' properties even with `lazy-lock'.
-
-;;;; After 2.8:
-;;; Some more compile time warnings crept in.
-;;; `cperl-indent-region-fix-else' implemented.
-;;; `cperl-fix-line-spacing' implemented.
-;;; `cperl-invert-if-unless' implemented (C-c C-t and in Menu).
-;;; Upgraded hints to mention 20.2's goods/bads.
-;;; Started to use `cperl-extra-newline-before-brace-multiline',
-;;; `cperl-break-one-line-blocks-when-indent',
-;;; `cperl-fix-hanging-brace-when-indent', `cperl-merge-trailing-else'.
-
-;;;; After 2.9:
-;;; Workaround for another `font-lock's `syntax-table' text-property bug.
-;;; `zerop' could be applied to nil.
-;;; At last, may work with `font-lock' without setting `cperl-font-lock'.
-;;; (We expect that starting from 19.33, `font-lock' supports keywords
-;;; being a function - what is a correct version?)
-;;; Rename `cperl-indent-region-fix-else' to
-;;; `cperl-indent-region-fix-constructs'.
-;;; `cperl-fix-line-spacing' could be triggered inside strings, would not
-;;; know what to do with BLOCKs of map/printf/etc.
-;;; `cperl-merge-trailing-else' and `cperl-fix-line-spacing' handle
-;;; `continue' too.
-;;; Indentation after {BLOCK} knows about map/printf/etc.
-;;; Finally: treat after-comma lines as continuation lines.
-
-;;;; After 2.10:
-;;; `continue' made electric.
-;;; Electric `do' inserts `do/while'.
-;;; Some extra compile-time warnings crept in.
-;;; `font-lock' of 19.33 could not handle font-lock-keywords being a function
-;;; returning a symbol.
-
-;;;; After 2.11:
-;;; Changes to make syntaxification to be autoredone via `font-lock'.
-;;; Switched on by `cperl-syntaxify-by-font-lock', off by default so far.
-
-;;;; After 2.12:
-;;; Remove some commented out chunks.
-;;; Styles are slightly updated (a lot of work is needed, especially
-;;; with new `cperl-fix-line-spacing').
-
-;;;; After 2.13:
-;;; Old value of style is memorized when choosing a new style, may be
-;;; restored from the same menu.
-;;; Mode-documentation added to micro-docs.
-;;; `cperl-praise' updated.
-;;; `cperl-toggle-construct-fix' added on C-c C-w and menu.
-;;; `auto-fill-mode' added on C-c C-f and menu.
-;;; `PerlStyle' style added.
-;;; Message for termination of scan corrected.
-
-;;;; After 2.14:
-
-;;; Did not work with -q
-
-;;;; After 2.15:
-
-;;; `cperl-speed' hints added.
-;;; Minor style fixes.
-
-;;;; After 2.15:
-;;; Make backspace electric after expansion of `else/continue' too.
-
-;;;; After 2.16:
-;;; Starting to merge changes to RMS emacs version.
-
-;;;; After 2.17:
-;;; Merged custom stuff and darn `font-lock-constant-face'.
-
-;;;; After 2.18:
-;;; Bumped the version to 3.1
-
-;;;; After 3.1:
-;;; Fixed customization to honor cperl-hairy.
-;;; Created customization groups. Sent to RMS to include into 2.3.
-
-;;;; After 3.2:
-;;; Interaction of `font-lock-hot-pass' and `cperl-syntaxify-by-font-lock'.
-;;; (`cperl-after-block-and-statement-beg'):
-;;; (`cperl-after-block-p'):
-;;; (`cperl-after-expr-p'): It is BLOCK if we reach lim when backup sexp.
-;;; (`cperl-indent-region'): Make a marker for END - text added/removed.
-;;; (`cperl-style-alist', `cperl-styles-entries')
-;;; Include `cperl-merge-trailing-else' where the value is clear.
-
-;;;; After 3.3:
-;;; (`cperl-tips'):
-;;; (`cperl-problems'): Improvements to docs.
-
-;;;; After 3.4:
-;;; (`cperl-mode'): Make lazy syntaxification possible.
-;;; (`cperl-find-pods-heres'): Safe a position in buffer where it is safe to
-;;; restart syntaxification.
-;;; (`cperl-syntaxify-by-font-lock'): Set to t, should be safe now.
-
-;;;; After 3.5:
-;;; (`cperl-syntaxify-by-font-lock'): Better default, customizes to
-;;; `message' too.
-
-;;;; After 3.6:
-;;; (`cperl-find-pods-heres'): changed so that -d ?foo? is a RE.
-;;; (`cperl-array-face'): changed name from `font-lock-emphasized-face'.
-;;; (`cperl-hash-face'): changed name from `font-lock-other-emphasized-face'.
-;;; Use `defface' to define these two extra faces.
-
-;;;; After 3.7:
-;;; Can use linear algorithm for indentation if Emacs supports it:
-;;; indenting DB::DB (800+ lines) improved from 69 sec to 11 sec
-;;; (73 vs 15 with imenu).
-;;; (`cperl-emacs-can-parse'): New state.
-;;; (`cperl-indent-line'): Corrected to use global state.
-;;; (`cperl-calculate-indent'): Likewise.
-;;; (`cperl-fix-line-spacing'): Likewise (not used yet).
-
-;;;; After 3.8:
-;;; (`cperl-choose-color'): Converted to a function (to be compilable in text-mode).
-
-;;;; After 3.9:
-;;; (`cperl-dark-background '): Disable without window-system.
-
-;;;; After 3.10:
-;;; Do `defface' only if window-system.
-
-;;;; After 3.11:
-;;; (`cperl-fix-line-spacing'): sped up to bail out early.
-;;; (`cperl-indent-region'): Disable hooks during the call (how to call them later?).
-
-;;; Now indents 820-line-long function in 6.5 sec (including syntaxification) the first time
-;;; (when buffer has few properties), 7.1 sec the second time.
-
-;;;Function Name Call Count Elapsed Time Average Time
-;;;========================================= ========== ============ ============
-;;;cperl-indent-exp 1 10.039999999 10.039999999
-;;;cperl-indent-region 1 10.0 10.0
-;;;cperl-indent-line 821 6.2100000000 0.0075639464
-;;;cperl-calculate-indent 821 5.0199999999 0.0061144945
-;;;cperl-backward-to-noncomment 2856 2.0500000000 0.0007177871
-;;;cperl-fontify-syntaxically 2 1.78 0.8900000000
-;;;cperl-find-pods-heres 2 1.78 0.8900000000
-;;;cperl-update-syntaxification 1 1.78 1.78
-;;;cperl-fix-line-spacing 769 1.4800000000 0.0019245773
-;;;cperl-after-block-and-statement-beg 163 1.4100000000 0.0086503067
-;;;cperl-block-p 775 1.1800000000 0.0015225806
-;;;cperl-to-comment-or-eol 3652 1.1200000000 0.0003066812
-;;;cperl-after-block-p 165 1.0500000000 0.0063636363
-;;;cperl-commentify 141 0.22 0.0015602836
-;;;cperl-get-state 813 0.16 0.0001968019
-;;;cperl-backward-to-start-of-continued-exp 26 0.12 0.0046153846
-;;;cperl-delay-update-hook 2107 0.0899999999 4.271...e-05
-;;;cperl-protect-defun-start 141 0.0700000000 0.0004964539
-;;;cperl-after-label 407 0.0599999999 0.0001474201
-;;;cperl-forward-re 139 0.0299999999 0.0002158273
-;;;cperl-comment-indent 26 0.0299999999 0.0011538461
-;;;cperl-use-region-p 8 0.0 0.0
-;;;cperl-lazy-hook 15 0.0 0.0
-;;;cperl-after-expr-p 8 0.0 0.0
-;;;cperl-font-lock-unfontify-region-function 1 0.0 0.0
-
-;;;Function Name Call Count Elapsed Time Average Time
-;;;========================================= ========== ============ ============
-;;;cperl-fix-line-spacing 769 1.4500000000 0.0018855656
-;;;cperl-indent-line 13 0.3100000000 0.0238461538
-;;;cperl-after-block-and-statement-beg 69 0.2700000000 0.0039130434
-;;;cperl-after-block-p 69 0.2099999999 0.0030434782
-;;;cperl-calculate-indent 13 0.1000000000 0.0076923076
-;;;cperl-backward-to-noncomment 177 0.0700000000 0.0003954802
-;;;cperl-get-state 13 0.0 0.0
-;;;cperl-to-comment-or-eol 179 0.0 0.0
-;;;cperl-get-help-defer 1 0.0 0.0
-;;;cperl-lazy-hook 11 0.0 0.0
-;;;cperl-after-expr-p 2 0.0 0.0
-;;;cperl-block-p 13 0.0 0.0
-;;;cperl-after-label 5 0.0 0.0
-
-;;;; After 3.12:
-;;; (`cperl-find-pods-heres'): do not warn on `=cut' if doing a chunk only.
-
-;;;; After 3.13:
-;;; (`cperl-mode'): load pseudo-faces on `cperl-find-pods-heres' (for 19.30).
-;;; (`x-color-defined-p'): was not compiling on XEmacs
-;;; (`cperl-find-pods-heres'): 1 << 6 was OK, but 1<<6 was considered as HERE
-;;; <file/glob> made into a string.
-
-;;;; After 3.14:
-;;; (`cperl-find-pods-heres'): Postpone addition of faces after syntactic step
-;;; Recognition of <FH> was wrong.
-;;; (`cperl-clobber-lisp-bindings'): if set, C-c variants are the old ones
-;;; (`cperl-unwind-to-safe'): New function.
-;;; (`cperl-fontify-syntaxically'): Use `cperl-unwind-to-safe' to start at reasonable position.
-
-;;;; After 3.15:
-;;; (`cperl-forward-re'): Highlight the trailing / in s/foo// as string.
-;;; Highlight the starting // in s//foo/ as function-name.
-
-;;;; After 3.16:
-;;; (`cperl-find-pods-heres'): Highlight `gem' in s///gem as a keyword.
-
-;;;; After 4.0:
-;;; (`cperl-find-pods-heres'): `qr' added
-;;; (`cperl-electric-keyword'): Likewise
-;;; (`cperl-electric-else'): Likewise
-;;; (`cperl-to-comment-or-eol'): Likewise
-;;; (`cperl-make-regexp-x'): Likewise
-;;; (`cperl-init-faces'): Likewise, and `lock' (as overridable?).
-;;; (`cperl-find-pods-heres'): Knows that split// is null-RE.
-;;; Highlights separators in 3-parts expressions
-;;; as labels.
-
-;;;; After 4.1:
-;;; (`cperl-find-pods-heres'): <> was considered as a glob
-;;; (`cperl-syntaxify-unwind'): New configuration variable
-;;; (`cperl-fontify-m-as-s'): New configuration variable
-
-;;;; After 4.2:
-;;; (`cperl-find-pods-heres'): of the last line being `=head1' fixed.
-
-;;; Handling of a long construct is still buggy if only the part of
-;;; construct touches the updated region (we unwind to the start of
-;;; long construct, but the end may have residual properties).
-
-;;; (`cperl-unwind-to-safe'): would not go to beginning of buffer.
-;;; (`cperl-electric-pod'): check for after-expr was performed
-;;; inside of POD too.
-
-;;;; After 4.3:
-;;; (`cperl-backward-to-noncomment'): better treatment of PODs and HEREs.
-
-;;; Indent-line works good, but indent-region does not - at toplevel...
-;;; (`cperl-unwind-to-safe'): Signature changed.
-;;; (`x-color-defined-p'): was defmacro'ed with a tick. Remove another def.
-;;; (`cperl-clobber-mode-lists'): New configuration variable.
-;;; (`cperl-array-face'): One of definitions was garbled.
-
-;;;; After 4.4:
-;;; (`cperl-not-bad-style-regexp'): Updated.
-;;; (`cperl-make-regexp-x'): Misprint in a message.
-;;; (`cperl-find-pods-heres'): $a-1 ? foo : bar; was a regexp.
-;;; `<< (' was considered a start of POD.
-;;; Init: `cperl-is-face' was busted.
-;;; (`cperl-make-face'): New macros.
-;;; (`cperl-force-face'): New macros.
-;;; (`cperl-init-faces'): Corrected to use new macros;
-;;; `if' for copying `reference-face' to
-;;; `constant-face' was backward.
-;;; (`font-lock-other-type-face'): Done via `defface' too.
-
-;;;; After 4.5:
-;;; (`cperl-init-faces-weak'): use `cperl-force-face'.
-;;; (`cperl-after-block-p'): After END/BEGIN we are a block.
-;;; (`cperl-mode'): `font-lock-unfontify-region-function'
-;;; was set to a wrong function.
-;;; (`cperl-comment-indent'): Commenting __END__ was not working.
-;;; (`cperl-indent-for-comment'): Likewise.
-;;; (Indenting is still misbehaving at toplevel.)
-
-;;;; After 4.5:
-;;; (`cperl-unwind-to-safe'): Signature changed, unwinds end too.
-;;; (`cperl-find-pods-heres'): mark qq[]-etc sections as syntax-type=string
-;;; (`cperl-fontify-syntaxically'): Unwinds start and end to go out of
-;;; long strings (not very successful).
-
-;;; >>>> CPerl should be usable in write mode too now <<<<
-
-;;; (`cperl-syntaxify-by-font-lock'): Better default - off in text-mode.
-;;; (`cperl-tips'): Updated docs.
-;;; (`cperl-problems'): Updated docs.
-
-;;;; After 4.6:
-;;; (`cperl-calculate-indent'): Did not consider `,' as continuation mark for statements.
-;;; (`cperl-write-tags'): Correct for XEmacs's `visit-tags-table-buffer'.
-
-;;;; After 4.7:
-;;; (`cperl-calculate-indent'): Avoid parse-data optimization at toplevel.
-;;; Should indent correctly at toplevel too.
-;;; (`cperl-tags-hier-init'): Gross hack to pretend we work (are we?).
-;;; (`cperl-find-pods-heres'): Was not processing sub protos after a comment ine.
-;;; Was treating $a++ <= 5 as a glob.
-
-;;;; After 4.8:
-;;; (toplevel): require custom unprotected => failure on 19.28.
-;;; (`cperl-xemacs-p') defined when compile too
-;;; (`cperl-tags-hier-init'): Another try to work around XEmacs problems
-;;; Better progress messages.
-;;; (`cperl-find-tags'): Was writing line/pos in a wrong order,
-;;; pos off by 1 and not at beg-of-line.
-;;; (`cperl-etags-snarf-tag'): New macro
-;;; (`cperl-etags-goto-tag-location'): New macro
-;;; (`cperl-write-tags'): When removing old TAGS info was not
-;;; relativizing filename
-
-;;;; After 4.9:
-;;; (`cperl-version'): New variable. New menu entry
-
-;;;; After 4.10:
-;;; (`cperl-tips'): Updated.
-;;; (`cperl-non-problems'): Updated.
-;;; random: References to future 20.3 removed.
-
-;;;; After 4.11:
-;;; (`perl-font-lock-keywords'): Would not highlight `sub foo($$);'.
-;;; Docstrings: Menu was described as `CPerl' instead of `Perl'
-
-;;;; After 4.12:
-;;; (`cperl-toggle-construct-fix'): Was toggling to t instead of 1.
-;;; (`cperl-ps-print-init'): Associate `cperl-array-face', `cperl-hash-face'
-;;; remove `font-lock-emphasized-face'.
-;;; remove `font-lock-other-emphasized-face'.
-;;; remove `font-lock-reference-face'.
-;;; remove `font-lock-keyword-face'.
-;;; Use `eval-after-load'.
-;;; (`cperl-init-faces'): remove init `font-lock-other-emphasized-face'.
-;;; remove init `font-lock-emphasized-face'.
-;;; remove init `font-lock-keyword-face'.
-;;; (`cperl-tips-faces'): New variable and an entry into Mini-docs.
-;;; (`cperl-indent-region'): Do not indent whitespace lines
-;;; (`cperl-indent-exp'): Was not processing else-blocks.
-;;; (`cperl-calculate-indent'): Remove another parse-data optimization
-;;; at toplevel: would indent correctly.
-;;; (`cperl-get-state'): NOP line removed.
-
-;;;; After 4.13:
-;;; (`cperl-ps-print-init'): Remove not-CPerl-related faces.
-;;; (`cperl-ps-print'): New function and menu entry.
-;;; (`cperl-ps-print-face-properties'): New configuration variable.
-;;; (`cperl-invalid-face'): New configuration variable.
-;;; (`cperl-nonoverridable-face'): New face. Renamed from
-;;; `font-lock-other-type-face'.
-;;; (`perl-font-lock-keywords'): Highlight trailing whitespace
-;;; (`cperl-contract-levels'): Documentation corrected.
-;;; (`cperl-contract-level'): Likewise.
-
-;;;; After 4.14:
-;;; (`cperl-ps-print'): `ps-print-face-extension-alist' was not in old Emaxen,
-;;; same with `ps-extend-face-list'
-;;; (`cperl-ps-extend-face-list'): New macro.
-
-;;;; After 4.15:
-;;; (`cperl-init-faces'): Interpolate `cperl-invalid-face'.
-;;; (`cperl-forward-re'): Emit a meaningful error instead of a cryptic
-;;; one for uncomplete REx near end-of-buffer.
-;;; (`cperl-find-pods-heres'): Tolerate unfinished REx at end-of-buffer.
-
-;;;; After 4.16:
-;;; (`cperl-find-pods-heres'): `unwind-protect' was left commented.
-
-;;;; After 4.17:
-;;; (`cperl-invalid-face'): Change to ''underline.
-
-;;;; After 4.18:
-;;; (`cperl-find-pods-heres'): / and ? after : start a REx.
-;;; (`cperl-after-expr-p'): Skip labels when checking
-;;; (`cperl-calculate-indent'): Correct for labels when calculating
-;;; indentation of continuations.
-;;; Docstring updated.
-
-;;;; After 4.19:
-;;; Minor (mostly spelling) corrections from 20.3.3 merged.
-
-;;;; After 4.20:
-;;; (`cperl-tips'): Another workaround added. Sent to RMS for 20.4.
-
-;;;; After 4.21:
-;;; (`cperl-praise'): Mention linear-time indent.
-;;; (`cperl-find-pods-heres'): @if ? a : b was considered a REx.
-
-;;;; After 4.22:
-;;; (`cperl-after-expr-p'): Make true after __END__.
-;;; (`cperl-electric-pod'): "SYNOPSIS" was misspelled.
-
-;;;; After 4.23:
-;;; (`cperl-beautify-regexp-piece'): Was not allowing for *? after a class.
-;;; Allow for POSIX char-classes.
-;;; Remove trailing whitespace when
-;;; adding new linebreak.
-;;; Add a level counter to stop shallow.
-;;; Indents unprocessed groups rigidly.
-;;; (`cperl-beautify-regexp'): Add an optional count argument to go that
-;;; many levels deep.
-;;; (`cperl-beautify-level'): Likewise
-;;; Menu: Add new entries to Regexp menu to do one level
-;;; (`cperl-contract-level'): Was entering an infinite loop
-;;; (`cperl-find-pods-heres'): Typo (double quoting).
-;;; Was detecting < $file > as FH instead of glob.
-;;; Support for comments in RExen (except
-;;; for m#\#comment#x), governed by
-;;; `cperl-regexp-scan'.
-;;; (`cperl-regexp-scan'): New customization variable.
-;;; (`cperl-forward-re'): Improve logic of resetting syntax table.
-
-;;;; After 4.23 and: After 4.24:
-;;; (`cperl-contract-levels'): Restore position.
-;;; (`cperl-beautify-level'): Likewise.
-;;; (`cperl-beautify-regexp'): Likewise.
-;;; (`cperl-commentify'): Rudimental support for length=1 runs
-;;; (`cperl-find-pods-heres'): Process 1-char long REx comments too /a#/x
-;;; Processes REx-comments in #-delimited RExen.
-;;; MAJOR BUG CORRECTED: after a misparse
-;;; a body of a subroutine could be corrupted!!!
-;;; One might need to reeval the function body
-;;; to fix things. (A similar bug was
-;;; present in `cperl-indent-region' eons ago.)
-;;; To reproduce:
-;; (defun foo () (let ((a '(t))) (insert (format "%s" a)) (setcar a 'BUG) t))
-;; (foo)
-;; (foo)
-;;; C-x C-e the above three lines (at end-of-line). First evaluation
-;;; of `foo' inserts (t), second one inserts (BUG) ?!
-;;;
-;;; In CPerl it was triggered by inserting then deleting `/' at start of
-;;; / a (?# asdf {[(}asdf )ef,/;
-
-;;;; After 4.25:
-;;; (`cperl-commentify'): Was recognizing length=2 "strings" as length=1.
-;;; (`imenu-example--create-perl-index'):
-;;; Was not enforcing syntaxification-to-the-end.
-;;; (`cperl-invert-if-unless'): Allow `for', `foreach'.
-;;; (`cperl-find-pods-heres'): Quote `cperl-nonoverridable-face'.
-;;; Mark qw(), m()x as indentable.
-;;; (`cperl-init-faces'): Highlight `sysopen' too.
-;;; Highlight $var in `for my $var' too.
-;;; (`cperl-invert-if-unless'): Was leaving whitespace at end.
-;;; (`cperl-linefeed'): Was splitting $var{$foo} if point after `{'.
-;;; (`cperl-calculate-indent'): Remove old commented out code.
-;;; Support (primitive) indentation of qw(), m()x.
-
-
-;;;; After 4.26:
-;;; (`cperl-problems'): Mention `fill-paragraph' on comment. \"" and
-;;; q [] with intervening newlines.
-;;; (`cperl-autoindent-on-semi'): New customization variable.
-;;; (`cperl-electric-semi'): Use `cperl-autoindent-on-semi'.
-;;; (`cperl-tips'): Mention how to make CPerl the default mode.
-;;; (`cperl-mode'): Support `outline-minor-mode'
-;;; (Thanks to Mark A. Hershberger).
-;;; (`cperl-outline-level'): New function.
-;;; (`cperl-highlight-variables-indiscriminately'): New customization var.
-;;; (`cperl-init-faces'): Use `cperl-highlight-variables-indiscriminately'.
-;;; (Thanks to Sean Kamath <kamath@pogo.wv.tek.com>).
-;;; (`cperl-after-block-p'): Support CHECK and INIT.
-;;; (`cperl-init-faces'): Likewise and "our".
-;;; (Thanks to Doug MacEachern <dougm@covalent.net>).
-;;; (`cperl-short-docs'): Likewise and "our".
-
-
-;;;; After 4.27:
-;;; (`cperl-find-pods-heres'): Recognize \"" as a string.
-;;; Mark whitespace and comments between q and []
-;;; as `syntax-type' => `prestring'.
-;;; Allow whitespace between << and "FOO".
-;;; (`cperl-problems'): Remove \"" and q [] with intervening newlines.
-;;; Mention multiple <<EOF as unsupported.
-;;; (`cperl-highlight-variables-indiscriminately'): Doc misprint fixed.
-;;; (`cperl-indent-parens-as-block'): New configuration variable.
-;;; (`cperl-calculate-indent'): Merge cases of indenting non-BLOCK groups.
-;;; Use `cperl-indent-parens-as-block'.
-;;; (`cperl-find-pods-heres'): Test for =cut without empty line instead of
-;;; complaining about no =cut.
-;;; (`cperl-electric-pod'): Change the REx for POD from "\n\n=" to "^\n=".
-;;; (`cperl-find-pods-heres'): Likewise.
-;;; (`cperl-electric-pod'): Change `forward-sexp' to `forward-word':
-;;; POD could've been marked as comment already.
-;;; (`cperl-unwind-to-safe'): Unwind before start of POD too.
-
-;;;; After 4.28:
-;;; (`cperl-forward-re'): Throw an error at proper moment REx unfinished.
-
-;;;; After 4.29:
-;;; (`x-color-defined-p'): Make an extra case to peacify the warning.
-;;; Toplevel: `defvar' to peacify the warnings.
-;;; (`cperl-find-pods-heres'): Could access `font-lock-comment-face' in -nw.
-;;;; No -nw-compile time warnings now.
-;;; (`cperl-find-tags'): TAGS file had too short substring-to-search.
-;;; Be less verbose in non-interactive mode
-;;; (`imenu-example--create-perl-index'): Set index-marker after name
-;;; (`cperl-outline-regexp'): New variable.
-;;; (`cperl-outline-level'): Made compatible with `cperl-outline-regexp'.
-;;; (`cperl-mode'): Made use `cperl-outline-regexp'.
-
-;;;; After 4.30:
-;;; (`cperl-find-pods-heres'): =cut the last thing, no blank line, was error.
-;;; (`cperl-outline-level'): Make start-of-file same level as `package'.
-
-;;;; After 4.31:
-;;; (`cperl-electric-pod'): `head1' and `over' electric only if empty.
-;;; (`cperl-unreadable-ok'): New variable.
-;;; (`cperl-find-tags'): Use `cperl-unreadable-ok', do not fail
-;;; on an unreadable file
-;;; (`cperl-write-tags'): Use `cperl-unreadable-ok', do not fail
-;;; on an unreadable directory
-
-;;;; After 4.32:
-;;; Syncronized with v1.60 from Emacs 21.3.
-;;; Mostly docstring and formatting changes, and:
-
-;;; (`cperl-noscan-files-regexp'): Do not scan CVS subdirs
-;;; (`cperl-problems'): Note that newer XEmacsen may syntaxify too
-;;; (`imenu-example--create-perl-index'):
-;;; Renamed to `cperl-imenu--create-perl-index'
-;;; (`cperl-mode'): Replace `make-variable-buffer-local' by `make-local-variable'
-;;; (`cperl-setup-tmp-buf'): Likewise
-;;; (`cperl-fix-line-spacing'): Fix a misprint of "t" for "\t"
-;;; (`cperl-next-bad-style'): Fix misprints in character literals
-
-;;;; After 4.33:
-;;; (`cperl-font-lock-keywords'): +etc: Aliased to perl-font-lock-keywords.
-
-;;;; After 4.34:
-;;; Further updates of whitespace and spelling w.r.t. RMS version.
-;;; (`cperl-font-lock-keywords'): +etc: Avoid warnings when aliasing.
-;;; (`cperl-mode'): Use `normal-auto-fill-function' if present.
-;;; (`cperl-use-major-mode'): New variable
-;;; (`cperl-can-font-lock'): New variable; replaces `window-system'
-;;; (`cperl-tags-hier-init'): use `display-popup-menus-p' (if present)
-;;; to choose `x-popup-menu' vs `tmm-prompt'
-
-;;;; 4.35 has the following differences from version 1.40+ of RMS Emacs:
-
-;;; New variables `cperl-use-major-mode', `cperl-can-font-lock';
-;;; `cperl-use-major-mode' is (effectively) 'cperl-mode in RMS.
-;;; `cperl-under-as-char' is nil in RMS.
-;;; Minor differences in docstrings, and `cperl-non-problems'.
-;;; Backward compatibility addressed: (`); (function (lambda ...)); font-lock;
-;;; (:italic t bold t) vs (:slant italic :weight bold) in faces;
-;;; `normal-auto-fill-function'.
-;;; RMS version has wrong logic in `cperl-calculate-indent': $a = { } is
-;;; wrongly indented if the closing brace is on a separate line.
-;;; Different choice of ordering if's for is-x-REx and (eq (char-after b) ?\#)
-;;; in `cperl-find-pods-heres'. [Cosmetic]
-
-;;;; After 4.35:
-;;; (`cperl-find-pods-heres'): If no end of HERE-doc found, mark to the end
-;;; of buffer. This enables recognition of end
-;;; of HERE-doc "as one types".
-;;; Require "\n" after trailing tag of HERE-doc.
-;;; \( made non-quoting outside of string/comment
-;;; (gdj-contributed).
-;;; Likewise for \$.
-;;; Remove `here-doc-group' text property at start
-;;; (makes this property reliable).
-;;; Text property `first-format-line' ==> t.
-;;; Do not recognize $opt_s and $opt::s as s///.
-;;; (`cperl-perldoc'): Use case-sensitive search (contributed).
-;;; (`cperl-fix-line-spacing'): Allow "_" in $vars of foreach etc. when
-;;; underscore isn't a word char (gdj-contributed).
-;;; (`defun-prompt-regexp'): Allow prototypes.
-;;; (`cperl-vc-header-alist'): Extract numeric version from the Id.
-;;; Toplevel: Put toggle-autohelp into the mode menu.
-;;; Better docs for toggle/set/unset autohelp.
-;;; (`cperl-electric-backspace-untabify'): New customization variable
-;;; (`cperl-after-expr-p'): Works after here-docs, formats, and PODs too
-;;; (affects many electric constructs).
-;;; (`cperl-calculate-indent'): Takes into account `first-format-line' ==>
-;;; works after format.
-;;; (`cperl-short-docs'): Make it work with ... too.
-;;; "array context" ==> "list context"
-;;; (`cperl-electric-keyword'): make $if (etc: "$@%&*") non-electric
-;;; '(' after keyword would insert a doubled paren
-;;; (`cperl-electric-paren'): documented affected by `cperl-electric-parens'
-;;; (`cperl-electric-rparen'): Likewise
-;;; (`cperl-build-manpage'): New function by Nick Roberts
-;;; (`cperl-perldoc'): Make it work in XEmacs too
-
-;;;; After 4.36:
-;;; (`cperl-find-pods-heres'): Recognize s => 1 and {s} (as a key or varname),
-;;; { s:: } and { s::bar::baz } as varnames.
-;;; (`cperl-after-expr-p'): Updates syntaxification before checks
-;;; (`cperl-calculate-indent'): Likewise
-;;; Fix wrong indent of blocks starting with POD
-;;; (`cperl-after-block-p'): Optional argument for checking for a pre-block
-;;; Recognize `continue' blocks too.
-;;; (`cperl-electric-brace'): use `cperl-after-block-p' for detection;
-;;; Now works for else/continue/sub blocks
-;;; (`cperl-short-docs'): Minor edits; make messages fit 80-column screen
-
-;;;; After 5.0:
-;;; `cperl-add-tags-recurse-noxs-fullpath': new function (for -batch mode)
-
-;;;; After 5.1:
-;;;;;; Major edit. Summary of most visible changes:
-
-;;;;;; a) Multiple <<HERE per line allowed.
-;;;;;; b) Handles multiline subroutine declaration headers (with comments).
-;;;;;; (The exception is `cperl-etags' - but it is not used in the rest
-;;;;;; of the mode.)
-;;;;;; c) Fontifies multiline my/our declarations (even with comments,
-;;;;;; and with legacy `font-lock').
-;;;;;; d) Major speedup of syntaxification, both immediate and postponed
-;;;;;; (3.5x to 15x [for different CPUs and versions of Emacs] on the
-;;;;;; huge real-life document I tested).
-;;;;;; e) New bindings, edits to imenu.
-;;;;;; f) "_" is made into word-char during fontification/syntaxification;
-;;;;;; some attempts to recognize non-word "_" during other operations too.
-;;;;;; g) Detect bug in Emacs with `looking-at' inside `narrow' and bulk out.
-;;;;;; h) autoload some more perldoc-related stuff
-;;;;;; i) Some new convenience features: ISpell POD/HEREDOCs, narrow-to-HEREDOC
-;;;;;; j) Attempt to incorporate XEmacs edits which reached me
-
-;;;; Fine-grained changelog:
-;;; `cperl-hook-after-change': New configuration variable
-;;; `cperl-vc-sccs-header': Likewise
-;;; `cperl-vc-sccs-header': Likewise
-;;; `cperl-vc-header-alist': Default via two preceding variables
-;;; `cperl-invalid-face': Remove double quoting under XEmacs
-;;; (still needed under 21.2)
-;;; `cperl-tips': Update URLs for resources
-;;; `cperl-problems': Likewise
-;;; `cperl-praise': Mention new features
-;;; New C-c key bindings: for `cperl-find-bad-style',
-;;; `cperl-pod-spell', `cperl-here-doc-spell', `cperl-narrow-to-here-doc',
-;;; `cperl-perdoc', `cperl-perldoc-at-point'
-;;; CPerl Mode menu changes: "Fix style by spaces", "Imenu on Perl Info"
-;;; moved, new submenu of Tools with Ispell entries and narrowing.
-;;; `cperl-after-sub-regexp': New defsubst
-;;; `cperl-imenu--function-name-regexp-perl': Use `cperl-after-sub-regexp',
-;;; Allows heads up to head4
-;;; Allow "package;"
-;;; `defun-prompt-regexp': Use `cperl-after-sub-regexp',
-;;; `paren-backwards-message': ??? Something for XEmacs???
-;;; `cperl-mode': Never auto-switch abbrev-mode off
-;;; Try to allow '_' be non-word char
-;;; Do not use `font-lock-unfontify-region-function' on XEmacs
-;;; Reset syntax cache on mode start
-;;; Support multiline facification (even
-;;; on legacy `font-lock')
-;;; `cperl-facemenu-add-face-function': ??? Some contributed code ???
-;;; `cperl-after-change-function': Since `font-lock' and `lazy-lock'
-;;; refuse to inform us whether the fontification is due to lazy
-;;; calling or due to edit to a buffer, install our own hook
-;;; (controlled by `cperl-hook-after-change')
-;;; `cperl-electric-pod': =cut may have been recognized as start
-;;; `cperl-block-p': Moved, updated for attributes
-;;; `cperl-calculate-indent': Try to allow '_' be non-word char
-;;; Support subs with attributes
-;;; `cperl-where-am-i': Queit (?) a warning
-;;; `cperl-cached-syntax-table' New function
-;;; `cperl-forward-re': Use `cperl-cached-syntax-table'
-;;; `cperl-unwind-to-safe': Recognize `syntax-type' property
-;;; changing in a middle of line
-;;; `cperl-find-sub-attrs': New function
-;;; `cperl-find-pods-heres': Allow many <<EOP per line
-;;; Allow subs with attributes
-;;; Major speedups (3.5x..15x on a real-life
-;;; test file nph-proxy.pl)
-;;; Recognize "extproc " (OS/2)
-;;; case-folded and only at start
-;;; /x on s///x with empty replacement was
-;;; not recognized
-;;; Better comments
-;;; `cperl-after-block-p': Remarks on diff with `cperl-block-p'
-;;; Allow subs with attributes, labels
-;;; Do not confuse "else::foo" with "else"
-;;; Minor optimizations...
-;;; `cperl-after-expr-p': Try to allow '_' be non-word char
-;;; `cperl-fill-paragraph': Try to detect a major bug in Emacs
-;;; with `looking-at' inside `narrow' and bulk out if found
-;;; `cperl-imenu--create-perl-index': Updates for new
-;;; `cperl-imenu--function-name-regexp-perl'
-;;; `cperl-outline-level': Likewise
-;;; `cperl-init-faces': Allow multiline subroutine headers
-;;; and my/our declarations, and ones with comments
-;;; Allow subroutine attributes
-;;; `cperl-imenu-on-info': Better docstring.
-;;; `cperl-etags' Rudimentary support for attributes
-;;; Support for packages and "package;"
-;;; `cperl-add-tags-recurse-noxs': Better (?) docstring
-;;; `cperl-add-tags-recurse-noxs-fullpath': Likewise
-;;; `cperl-tags-hier-init': Misprint for `fboundp' fixed
-;;; `cperl-not-bad-style-regexp': Try to allow '_' be non-word char
-;;; `cperl-perldoc': Add autoload
-;;; `cperl-perldoc-at-point': Likewise
-;;; `cperl-here-doc-spell': New function
-;;; `cperl-pod-spell': Likewise
-;;; `cperl-map-pods-heres': Likewise
-;;; `cperl-get-here-doc-region': Likewise
-;;; `cperl-font-lock-fontify-region-function': Likewise (backward compatibility
-;;; for legacy `font-lock')
-;;; `cperl-font-lock-unfontify-region-function': Fix style
-;;; `cperl-fontify-syntaxically': Recognize and optimize away
-;;; deferred calls with no-change. Governed by `cperl-hook-after-change'
-;;; `cperl-fontify-update': Recognize that syntaxification region
-;;; can be larger than fontification one.
-;;; XXXX we leave `cperl-postpone' property, so this is quadratic...
-;;; `cperl-fontify-update-bad': Temporary placeholder until
-;;; it is clear how to implement `cperl-fontify-update'.
-;;; `cperl-time-fontification': New function
-;;; `attrib-group': New text attribute
-;;; `multiline': New value: `syntax-type' text attribute
-
-;;;; After 5.2:
-;;; `cperl-emulate-lazy-lock': New function
-;;; `cperl-fontify-syntaxically': Would skip large regions
-;;; Add `cperl-time-fontification', `cperl-emulate-lazy-lock' to menu
-;;; Some globals were declared, but uninitialized
-
-;;;; After 5.3, 5.4:
-;;; `cperl-facemenu-add-face-function': Add docs, fix U<>
-;;; Copyright message updated.
-;;; `cperl-init-faces': Work around a bug in `font-lock'. May slow
-;;; facification down a bit.
-;;; Misprint for my|our|local for old `font-lock'
-;;; "our" was not fontified same as "my|local"
-;;; Highlight variables after "my" etc even in
-;;; a middle of an expression
-;;; Do not facify multiple variables after my etc
-;;; unless parentheses are present
-
-;;; After 5.5, 5.6
-;;; `cperl-fontify-syntaxically': after-change hook could reset
-;;; `cperl-syntax-done-to' to a middle of line; unwind to BOL.
-
-;;; After 5.7:
-;;; `cperl-init-faces': Allow highlighting of local ($/)
-;;; `cperl-problems-old-emaxen': New variable (for the purpose of DOCSTRING).
-;;; `cperl-problems': Remove fixed problems.
-;;; `cperl-find-pods-heres': Recognize #-comments in m##x too
-;;; Recognize charclasses (unless delimiter is \).
-;;; `cperl-fontify-syntaxically': Unwinding to safe was done in wrong order
-;;; `cperl-regexp-scan': Update docs
-;;; `cperl-beautify-regexp-piece': use information got from regexp scan
-
-;;; After 5.8:
-;;; Major user visible changes:
-;;; Recognition and fontification of character classes in RExen.
-;;; Variable indentation of RExen according to groups
-;;;
-;;; `cperl-find-pods-heres': Recognize POSIX classes in REx charclasses
-;;; Fontify REx charclasses in variable-name face
-;;; Fontify POSIX charclasses in "type" face
-;;; Fontify unmatched "]" in function-name face
-;;; Mark first-char of HERE-doc as `front-sticky'
-;;; Reset `front-sticky' property when needed
-;;; `cperl-calculate-indent': Indents //x -RExen accordning to parens level
-;;; `cperl-to-comment-or-eol': Recognize ends of `syntax-type' constructs
-;;; `cperl-backward-to-noncomment': Recognize stringy `syntax-type' constructs
-;;; Support `narrow'ed buffers.
-;;; `cperl-praise': Remove a reservation
-;;; `cperl-make-indent': New function
-;;; `cperl-indent-for-comment': Use `cperl-make-indent'
-;;; `cperl-indent-line': Likewise
-;;; `cperl-lineup': Likewise
-;;; `cperl-beautify-regexp-piece': Likewise
-;;; `cperl-contract-level': Likewise
-;;; `cperl-toggle-set-debug-unwind': New function
-;;; New menu entry for this
-;;; `fill-paragraph-function': Use when `boundp'
-;;; `cperl-calculate-indent': Take into account groups when indenting RExen
-;;; `cperl-to-comment-or-eol': Recognize # which end a string
-;;; `cperl-modify-syntax-type': Make only syntax-table property non-sticky
-;;; `cperl-fill-paragraph': Return t: needed for `fill-paragraph-function'
-;;; `cperl-fontify-syntaxically': More clear debugging message
-;;; `cperl-pod2man-build-command': XEmacs portability: check `Man-filter-list'
-;;; `cperl-init-faces': More complicated highlight even on XEmacs (new)
-;;; Merge cosmetic changes from XEmacs
-
-;;; After 5.9:
-;;; `cperl-1+': Moved to before the first use
-;;; `cperl-1-': Likewise
-
-;;; After 5.10:
-
-;;; This code may lock Emacs hard!!! Use on your own risk!
-
-;;; `cperl-font-locking': New internal variable
-;;; `cperl-beginning-of-property': New function
-;;; `cperl-calculate-indent': Use `cperl-beginning-of-property'
-;;; instead of `previous-single-property-change'
-;;; `cperl-unwind-to-safe': Likewise
-;;; `cperl-after-expr-p': Likewise
-;;; `cperl-get-here-doc-region': Likewise
-;;; `cperl-font-lock-fontify-region-function': Likewise
-;;; `cperl-to-comment-or-eol': Do not call `cperl-update-syntaxification'
-;;; recursively
-;;; Bound `next-single-property-change'
-;;; via `point-max'
-;;; `cperl-unwind-to-safe': Bound likewise
-;;; `cperl-font-lock-fontify-region-function': Likewise
-;;; `cperl-find-pods-heres': Mark as recursive for `cperl-to-comment-or-eol'
-;;; Initialization of
-;;; `cperl-font-lock-multiline-start' could be missed if the "main"
-;;; fontification did not run due to the keyword being already fontified.
-;;; `cperl-pod-spell': Return t from do-one-chunk function
-;;; `cperl-map-pods-heres': Stop when the worker returns nil
-;;; Call `cperl-update-syntaxification'
-;;; `cperl-get-here-doc-region': Call `cperl-update-syntaxification'
-;;; `cperl-get-here-doc-delim': Remove unused function
-
-;;; After 5.11:
-
-;;; The possible lockup of Emacs (introduced in 5.10) fixed
-
-;;; `cperl-unwind-to-safe': `cperl-beginning-of-property' won't return nil
-;;; `cperl-syntaxify-for-menu': New customization variable
-;;; `cperl-select-this-pod-or-here-doc': New function
-;;; `cperl-get-here-doc-region': Extra argument
-;;; Do not adjust pos by 1
-
-;;; New menu entries (Perl/Tools): selection of current POD or HERE-DOC section
-;;; (Debugging CPerl:) backtrace on fontification
-
-;;; After 5.12:
-;;; `cperl-cached-syntax-table': use `car-safe'
-;;; `cperl-forward-re': Remove spurious argument SET-ST
-;;; Add documentation
-;;; `cperl-forward-group-in-re': New function
-;;; `cperl-find-pods-heres': Find and highlight (?{}) blocks in RExen
-;;; (XXXX Temporary (?) hack is to syntax-mark them as comment)
-
-;;; After 5.13:
-;;; `cperl-string-syntax-table': Make { and } not-grouping
-;;; (Sometimes they ARE grouping in RExen, but matching them would only
-;;; confuse in many situations when they are not)
-;;; `beginning-of-buffer': Replaced two occurences with goto-char...
-;;; `cperl-calculate-indent': `char-after' could be nil...
-;;; `cperl-find-pods-heres': REx can start after "[" too
-;;; Hightlight (??{}) in RExen too
-;;; `cperl-maybe-white-and-comment-rex': New constant
-;;; `cperl-white-and-comment-rex': Likewise
-;;; XXXX Not very efficient, but hard to make
-;;; better while keeping 1 group
-
-;;; After 5.13:
-;;; `cperl-find-pods-heres': $foo << identifier() is not a HERE-DOC
-;;; Likewise for 1 << identifier
-
-;;; After 5.14:
-;;; `cperl-find-pods-heres': Different logic for $foo .= <<EOF etc
-;;; Error-less condition-case could fail
-;;; `cperl-font-lock-fontify-region-function': Likewise
-;;; `cperl-init-faces': Likewise
-
-;;; After 5.15:
-;;; `cperl-find-pods-heres': Support property REx-part2
-;;; `cperl-calculate-indent': Likewise
-;;; Don't special-case REx with non-empty 1st line
-;;; `cperl-find-pods-heres': In RExen, highlight non-literal backslashes
-;;; Invert highlighting of charclasses:
-;;; now the envelop is highlighted
-;;; Highlight many others 0-length builtins
-;;; `cperl-praise': Mention indenting and highlight in RExen
-
-;;; After 5.15:
-;;; `cperl-find-pods-heres': Highlight capturing parens in REx
-
-;;; After 5.16:
-;;; `cperl-find-pods-heres': Highlight '|' for alternation
-;;; Initialize `font-lock-warning-face' if not present
-;;; `cperl-find-pods-heres': Use `font-lock-warning-face' instead of
-;;; `font-lock-function-name-face'
-;;; `cperl-look-at-leading-count': Likewise
-;;; `cperl-find-pods-heres': localize `font-lock-variable-name-face'
-;;; `font-lock-keyword-face' (needed for
-;;; batch processing) etc
-;;; Use `font-lock-builtin-face' for builtin in REx
-;;; Now `font-lock-variable-name-face'
-;;; is used for interpolated variables
-;;; Use "talking aliases" for faces inside REx
-;;; Highlight parts of REx (except in charclasses)
-;;; according to the syntax and/or semantic
-;;; Syntax-mark a {}-part of (?{}) as "comment"
-;;; (it was the ()-part)
-;;; Better logic to distinguish what is what in REx
-;;; `cperl-tips-faces': Document REx highlighting
-;;; `cperl-praise': Mention REx syntax highlight etc.
-
-;;; After 5.17:
-;;; `cperl-find-sub-attrs': Would not always manage to print error message
-;;; `cperl-find-pods-heres': localize `font-lock-constant-face'
-
-;;; After 5.18:
-;;; `cperl-find-pods-heres': Misprint in REx for parsing REx
-;;; Very minor optimization
-;;; `my-cperl-REx-modifiers-face' got quoted
-;;; Recognize "print $foo <<END" as HERE-doc
-;;; Put `REx-interpolated' text attribute if needed
-;;; `cperl-invert-if-unless-modifiers': New function
-;;; `cperl-backward-to-start-of-expr': Likewise
-;;; `cperl-forward-to-end-of-expr': Likewise
-;;; `cperl-invert-if-unless': Works in "the opposite way" too
-;;; Cursor position on return is on the switch-word
-;;; Indents comments better
-;;; `REx-interpolated': New text attribute
-;;; `cperl-next-interpolated-REx': New function
-;;; `cperl-next-interpolated-REx-0': Likewise
-;;; `cperl-next-interpolated-REx-1': Likewise
-;;; "\C-c\C-x", "\C-c\C-y", "\C-c\C-v": New keybinding for these functions
-;;; Perl/Regexp menu: 3 new entries for `cperl-next-interpolated-REx'
-;;; `cperl-praise': Mention finded interpolated RExen
-
-;;; After 5.19:
-;;; `cperl-init-faces': Highlight %$foo, @$foo too
-;;; `cperl-short-docs': Better docs for system, exec
-;;; `cperl-find-pods-heres': Better detect << after print {FH} <<EOF etc.
-;;; Would not find HERE-doc ended by EOF without NL
-;;; `cperl-short-docs': Correct not-doubled \-escapes
-;;; start block: Put some `defvar' for stuff gone from XEmacs
-
-;;; After 5.20:
-;;; initial comment: Extend copyright, fix email address
-;;; `cperl-indent-comment-at-column-0': New customization variable
-;;; `cperl-comment-indent': Indentation after $#a would increasy by 1
-;;; `cperl-mode': Make `defun-prompt-regexp' grok BEGIN/END etc
-;;; `cperl-find-pods-heres': Mark CODE of s///e as `syntax-type' `multiline'
-;;; `cperl-at-end-of-expr': Would fail if @BAR=12 follows after ";"
-;;; `cperl-init-faces': If `cperl-highlight-variables-indiscriminately'
-;;; highlight $ in $foo too (UNTESTED)
-;;; `cperl-set-style': Docstring missed some available styles
-;;; toplevel: Menubar/Perl/Indent-Styles had FSF, now K&R
-;;; Change "Current" to "Memorize Current"
-;;; `cperl-indent-wrt-brace': New customization variable; the default is
-;;; as for pre-5.2 version
-;;; `cperl-styles-entries': Keep `cperl-extra-newline-before-brace-multiline'
-;;; `cperl-style-alist': Likewise
-;;; `cperl-fix-line-spacing': Support `cperl-merge-trailing-else' being nil,
-;;; and `cperl-extra-newline-before-brace' etc
-;;; being t
-;;; `cperl-indent-exp': Plans B and C to find continuation blocks even
-;;; if `cperl-extra-newline-before-brace' is t
-
-;;; After 5.21:
-;;; Improve some docstrings concerning indentation.
-;;; `cperl-indent-rules-alist': New variable
-;;; `cperl-sniff-for-indent': New function name
-;; (separated from `cperl-calculate-indent')
-;;; `cperl-calculate-indent': Separated the sniffer and the indenter;
-;;; uses `cperl-sniff-for-indent' now
-;;; `cperl-comment-indent': Test for `cperl-indent-comment-at-column-0'
-;;; was inverted;
-;;; Support `comment-column' = 0
-
-;;; After 5.22:
-;;; `cperl-where-am-i': Remove function
-;;; `cperl-backward-to-noncomment': Would go too far when skipping POD/HEREs
-;;; `cperl-sniff-for-indent': [string] and [comment] were inverted
-;;; When looking for label, skip s:m:y:tr
-;;; `cperl-indent-line': Likewise.
-;;; `cperl-mode': `font-lock-multiline' was assumed auto-local
-;;; `cperl-windowed-init': Wrong `ps-print' handling
-;;; (both thanks to Chong Yidong)
-;;; `cperl-look-at-leading-count': Could fail with unfinished RExen
-;;; `cperl-find-pods-heres': If the second part of s()[] is missing,
-;;; could try to highlight delimiters...
-
-;;; Code:
-\f
-(if (fboundp 'eval-when-compile)
- (eval-when-compile
- (condition-case nil
- (require 'custom)
- (error nil))
- (condition-case nil
- (require 'man)
- (error nil))
- (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
- (defvar cperl-can-font-lock
- (or cperl-xemacs-p
- (and (boundp 'emacs-major-version)
- (or window-system
- (> emacs-major-version 20)))))
- (if cperl-can-font-lock
- (require 'font-lock))
- (defvar msb-menu-cond)
- (defvar gud-perldb-history)
- (defvar font-lock-background-mode) ; not in Emacs
- (defvar font-lock-display-type) ; ditto
- (defvar paren-backwards-message) ; Not in newer XEmacs?
- (defvar vc-rcs-header) ; likewise?
- (defvar vc-sccs-header) ; likewise?
- (or (fboundp 'defgroup)
- (defmacro defgroup (name val doc &rest arr)
- nil))
- (or (fboundp 'custom-declare-variable)
- (defmacro defcustom (name val doc &rest arr)
- (` (defvar (, name) (, val) (, doc)))))
- (or (and (fboundp 'custom-declare-variable)
- (string< "19.31" emacs-version)) ; Checked with 19.30: defface does not work
- (defmacro defface (&rest arr)
- nil))
- ;; Avoid warning (tmp definitions)
- (or (fboundp 'x-color-defined-p)
- (defmacro x-color-defined-p (col)
- (cond ((fboundp 'color-defined-p) (` (color-defined-p (, col))))
- ;; XEmacs >= 19.12
- ((fboundp 'valid-color-name-p) (` (valid-color-name-p (, col))))
- ;; XEmacs 19.11
- ((fboundp 'x-valid-color-name-p) (` (x-valid-color-name-p (, col))))
- (t '(error "Cannot implement color-defined-p")))))
- (defmacro cperl-is-face (arg) ; Takes quoted arg
- (cond ((fboundp 'find-face)
- (` (find-face (, arg))))
- (;;(and (fboundp 'face-list)
- ;; (face-list))
- (fboundp 'face-list)
- (` (member (, arg) (and (fboundp 'face-list)
- (face-list)))))
- (t
- (` (boundp (, arg))))))
- (defmacro cperl-make-face (arg descr) ; Takes unquoted arg
- (cond ((fboundp 'make-face)
- (` (make-face (quote (, arg)))))
- (t
- (` (defvar (, arg) (quote (, arg)) (, descr))))))
- (defmacro cperl-force-face (arg descr) ; Takes unquoted arg
- (` (progn
- (or (cperl-is-face (quote (, arg)))
- (cperl-make-face (, arg) (, descr)))
- (or (boundp (quote (, arg))) ; We use unquoted variants too
- (defvar (, arg) (quote (, arg)) (, descr))))))
- (if cperl-xemacs-p
- (defmacro cperl-etags-snarf-tag (file line)
- (` (progn
- (beginning-of-line 2)
- (list (, file) (, line)))))
- (defmacro cperl-etags-snarf-tag (file line)
- (` (etags-snarf-tag))))
- (if cperl-xemacs-p
- (defmacro cperl-etags-goto-tag-location (elt)
- (`;;(progn
- ;; (switch-to-buffer (get-file-buffer (elt (, elt) 0)))
- ;; (set-buffer (get-file-buffer (elt (, elt) 0)))
- ;; Probably will not work due to some save-excursion???
- ;; Or save-file-position?
- ;; (message "Did I get to line %s?" (elt (, elt) 1))
- (goto-line (string-to-int (elt (, elt) 1)))))
- ;;)
- (defmacro cperl-etags-goto-tag-location (elt)
- (` (etags-goto-tag-location (, elt)))))))
-
-(defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
-
-(defvar cperl-can-font-lock
- (or cperl-xemacs-p
- (and (boundp 'emacs-major-version)
- (or window-system
- (> emacs-major-version 20)))))
-
-(condition-case nil
- (require 'custom)
- (error nil)) ; Already fixed by eval-when-compile
-
-(defun cperl-choose-color (&rest list)
- (let (answer)
- (while list
- (or answer
- (if (or (x-color-defined-p (car list))
- (null (cdr list)))
- (setq answer (car list))))
- (setq list (cdr list)))
- answer))
-
-\f
-(defgroup cperl nil
- "Major mode for editing Perl code."
- :prefix "cperl-"
- :group 'languages)
-
-(defgroup cperl-indentation-details nil
- "Indentation."
- :prefix "cperl-"
- :group 'cperl)
-
-(defgroup cperl-affected-by-hairy nil
- "Variables affected by `cperl-hairy'."
- :prefix "cperl-"
- :group 'cperl)
-
-(defgroup cperl-autoinsert-details nil
- "Auto-insert tuneup."
- :prefix "cperl-"
- :group 'cperl)
-
-(defgroup cperl-faces nil
- "Fontification colors."
- :prefix "cperl-"
- :group 'cperl)
-
-(defgroup cperl-speed nil
- "Speed vs. validity tuneup."
- :prefix "cperl-"
- :group 'cperl)
-
-(defgroup cperl-help-system nil
- "Help system tuneup."
- :prefix "cperl-"
- :group 'cperl)
-
-\f
-(defcustom cperl-extra-newline-before-brace nil
- "*Non-nil means that if, elsif, while, until, else, for, foreach
-and do constructs look like:
-
- if ()
- {
- }
-
-instead of:
-
- if () {
- }"
- :type 'boolean
- :group 'cperl-autoinsert-details)
-
-(defcustom cperl-extra-newline-before-brace-multiline
- cperl-extra-newline-before-brace
- "*Non-nil means the same as `cperl-extra-newline-before-brace', but
-for constructs with multiline if/unless/while/until/for/foreach condition."
- :type 'boolean
- :group 'cperl-autoinsert-details)
-
-(defcustom cperl-indent-level 2
- "*Indentation of CPerl statements with respect to containing block."
- :type 'integer
- :group 'cperl-indentation-details)
-
-(defcustom cperl-lineup-step nil
- "*`cperl-lineup' will always lineup at multiple of this number.
-If nil, the value of `cperl-indent-level' will be used."
- :type '(choice (const nil) integer)
- :group 'cperl-indentation-details)
-
-(defcustom cperl-brace-imaginary-offset 0
- "*Imagined indentation of a Perl open brace that actually follows a statement.
-An open brace following other text is treated as if it were this far
-to the right of the start of its line."
- :type 'integer
- :group 'cperl-indentation-details)
-
-(defcustom cperl-brace-offset 0
- "*Extra indentation for braces, compared with other text in same context."
- :type 'integer
- :group 'cperl-indentation-details)
-(defcustom cperl-label-offset -2
- "*Offset of CPerl label lines relative to usual indentation."
- :type 'integer
- :group 'cperl-indentation-details)
-(defcustom cperl-min-label-indent 1
- "*Minimal offset of CPerl label lines."
- :type 'integer
- :group 'cperl-indentation-details)
-(defcustom cperl-continued-statement-offset 2
- "*Extra indent for lines not starting new statements."
- :type 'integer
- :group 'cperl-indentation-details)
-(defcustom cperl-continued-brace-offset 0
- "*Extra indent for substatements that start with open-braces.
-This is in addition to cperl-continued-statement-offset."
- :type 'integer
- :group 'cperl-indentation-details)
-(defcustom cperl-close-paren-offset -1
- "*Extra indent for substatements that start with close-parenthesis."
- :type 'integer
- :group 'cperl-indentation-details)
-
-(defcustom cperl-indent-wrt-brace t
- "*Non-nil means indent statements in if/etc block relative brace, not if/etc.
-Versions 5.2 ... 5.20 behaved as if this were `nil'."
- :type 'boolean
- :group 'cperl-indentation-details)
-
-(defcustom cperl-auto-newline nil
- "*Non-nil means automatically newline before and after braces,
-and after colons and semicolons, inserted in CPerl code. The following
-\\[cperl-electric-backspace] will remove the inserted whitespace.
-Insertion after colons requires both this variable and
-`cperl-auto-newline-after-colon' set."
- :type 'boolean
- :group 'cperl-autoinsert-details)
-
-(defcustom cperl-autoindent-on-semi nil
- "*Non-nil means automatically indent after insertion of (semi)colon.
-Active if `cperl-auto-newline' is false."
- :type 'boolean
- :group 'cperl-autoinsert-details)
-
-(defcustom cperl-auto-newline-after-colon nil
- "*Non-nil means automatically newline even after colons.
-Subject to `cperl-auto-newline' setting."
- :type 'boolean
- :group 'cperl-autoinsert-details)
-
-(defcustom cperl-tab-always-indent t
- "*Non-nil means TAB in CPerl mode should always reindent the current line,
-regardless of where in the line point is when the TAB command is used."
- :type 'boolean
- :group 'cperl-indentation-details)
-
-(defcustom cperl-font-lock nil
- "*Non-nil (and non-null) means CPerl buffers will use `font-lock-mode'.
-Can be overwritten by `cperl-hairy' if nil."
- :type '(choice (const null) boolean)
- :group 'cperl-affected-by-hairy)
-
-(defcustom cperl-electric-lbrace-space nil
- "*Non-nil (and non-null) means { after $ should be preceded by ` '.
-Can be overwritten by `cperl-hairy' if nil."
- :type '(choice (const null) boolean)
- :group 'cperl-affected-by-hairy)
-
-(defcustom cperl-electric-parens-string "({[]})<"
- "*String of parentheses that should be electric in CPerl.
-Closing ones are electric only if the region is highlighted."
- :type 'string
- :group 'cperl-affected-by-hairy)
-
-(defcustom cperl-electric-parens nil
- "*Non-nil (and non-null) means parentheses should be electric in CPerl.
-Can be overwritten by `cperl-hairy' if nil."
- :type '(choice (const null) boolean)
- :group 'cperl-affected-by-hairy)
-
-(defvar zmacs-regions) ; Avoid warning
-
-(defcustom cperl-electric-parens-mark
- (and window-system
- (or (and (boundp 'transient-mark-mode) ; For Emacs
- transient-mark-mode)
- (and (boundp 'zmacs-regions) ; For XEmacs
- zmacs-regions)))
- "*Not-nil means that electric parens look for active mark.
-Default is yes if there is visual feedback on mark."
- :type 'boolean
- :group 'cperl-autoinsert-details)
-
-(defcustom cperl-electric-linefeed nil
- "*If true, LFD should be hairy in CPerl, otherwise C-c LFD is hairy.
-In any case these two mean plain and hairy linefeeds together.
-Can be overwritten by `cperl-hairy' if nil."
- :type '(choice (const null) boolean)
- :group 'cperl-affected-by-hairy)
-
-(defcustom cperl-electric-keywords nil
- "*Not-nil (and non-null) means keywords are electric in CPerl.
-Can be overwritten by `cperl-hairy' if nil."
- :type '(choice (const null) boolean)
- :group 'cperl-affected-by-hairy)
-
-(defcustom cperl-electric-backspace-untabify t
- "*Not-nil means electric-backspace will untabify in CPerl."
- :type 'boolean
- :group 'cperl-autoinsert-details)
-
-(defcustom cperl-hairy nil
- "*Not-nil means most of the bells and whistles are enabled in CPerl.
-Affects: `cperl-font-lock', `cperl-electric-lbrace-space',
-`cperl-electric-parens', `cperl-electric-linefeed', `cperl-electric-keywords',
-`cperl-info-on-command-no-prompt', `cperl-clobber-lisp-bindings',
-`cperl-lazy-help-time'."
- :type 'boolean
- :group 'cperl-affected-by-hairy)
-
-(defcustom cperl-comment-column 32
- "*Column to put comments in CPerl (use \\[cperl-indent] to lineup with code)."
- :type 'integer
- :group 'cperl-indentation-details)
-
-(defcustom cperl-indent-comment-at-column-0 nil
- "*Non-nil means that comment started at column 0 should be indentable."
- :type 'boolean
- :group 'cperl-indentation-details)
-
-(defcustom cperl-vc-sccs-header '("($sccs) = ('%W\%' =~ /(\\d+(\\.\\d+)+)/) ;")
- "*Special version of `vc-sccs-header' that is used in CPerl mode buffers."
- :type '(repeat string)
- :group 'cperl)
-
-(defcustom cperl-vc-rcs-header '("($rcs) = (' $Id\$ ' =~ /(\\d+(\\.\\d+)+)/);")
- "*Special version of `vc-rcs-header' that is used in CPerl mode buffers."
- :type '(repeat string)
- :group 'cperl)
-
-;; This became obsolete...
-(defcustom cperl-vc-header-alist '()
- "*What to use as `vc-header-alist' in CPerl.
-Obsolete, with newer Emacsen use `cperl-vc-rcs-header' or
-`cperl-vc-sccs-header' instead. If this list is empty, `vc-header-alist'
-will be reconstructed basing on these two variables."
- :type '(repeat (list symbol string))
- :group 'cperl)
-
-(defcustom cperl-clobber-mode-lists
- (not
- (and
- (boundp 'interpreter-mode-alist)
- (assoc "miniperl" interpreter-mode-alist)
- (assoc "\\.\\([pP][Llm]\\|al\\)$" auto-mode-alist)))
- "*Whether to install us into `interpreter-' and `extension' mode lists."
- :type 'boolean
- :group 'cperl)
-
-(defcustom cperl-info-on-command-no-prompt nil
- "*Not-nil (and non-null) means not to prompt on C-h f.
-The opposite behaviour is always available if prefixed with C-c.
-Can be overwritten by `cperl-hairy' if nil."
- :type '(choice (const null) boolean)
- :group 'cperl-affected-by-hairy)
-
-(defcustom cperl-clobber-lisp-bindings nil
- "*Not-nil (and non-null) means not overwrite C-h f.
-The function is available on \\[cperl-info-on-command], \\[cperl-get-help].
-Can be overwritten by `cperl-hairy' if nil."
- :type '(choice (const null) boolean)
- :group 'cperl-affected-by-hairy)
-
-(defcustom cperl-lazy-help-time nil
- "*Not-nil (and non-null) means to show lazy help after given idle time.
-Can be overwritten by `cperl-hairy' to be 5 sec if nil."
- :type '(choice (const null) (const nil) integer)
- :group 'cperl-affected-by-hairy)
-
-(defcustom cperl-pod-face 'font-lock-comment-face
- "*The result of evaluation of this expression is used for POD highlighting."
- :type 'face
- :group 'cperl-faces)
-
-(defcustom cperl-pod-head-face 'font-lock-variable-name-face
- "*The result of evaluation of this expression is used for POD highlighting.
-Font for POD headers."
- :type 'face
- :group 'cperl-faces)
-
-(defcustom cperl-here-face 'font-lock-string-face
- "*The result of evaluation of this expression is used for here-docs highlighting."
- :type 'face
- :group 'cperl-faces)
-
-;;; Some double-evaluation happened with font-locks... Needed with 21.2...
-(defvar cperl-singly-quote-face cperl-xemacs-p)
-
-(defcustom cperl-invalid-face ; Does not customize with '' on XEmacs
- (if cperl-singly-quote-face
- 'underline ''underline) ; On older Emacsen was evaluated by `font-lock'
- (if cperl-singly-quote-face
- "*This face is used for highlighting trailing whitespace."
- "*The result of evaluation of this expression highlights trailing whitespace.")
- :type 'face
- :group 'cperl-faces)
-
-(defcustom cperl-pod-here-fontify '(featurep 'font-lock)
- "*Not-nil after evaluation means to highlight POD and here-docs sections."
- :type 'boolean
- :group 'cperl-faces)
-
-(defcustom cperl-fontify-m-as-s t
- "*Not-nil means highlight 1arg regular expressions operators same as 2arg."
- :type 'boolean
- :group 'cperl-faces)
-
-(defcustom cperl-highlight-variables-indiscriminately nil
- "*Non-nil means perform additional highlighting on variables.
-Currently only changes how scalar variables are highlighted.
-Note that that variable is only read at initialization time for
-the variable `perl-font-lock-keywords-2', so changing it after you've
-entered CPerl mode the first time will have no effect."
- :type 'boolean
- :group 'cperl)
-
-(defcustom cperl-pod-here-scan t
- "*Not-nil means look for POD and here-docs sections during startup.
-You can always make lookup from menu or using \\[cperl-find-pods-heres]."
- :type 'boolean
- :group 'cperl-speed)
-
-(defcustom cperl-regexp-scan t
- "*Not-nil means make marking of regular expression more thorough.
-Effective only with `cperl-pod-here-scan'."
- :type 'boolean
- :group 'cperl-speed)
-
-(defcustom cperl-hook-after-change t
- "*Not-nil means install hook to know which regions of buffer are changed.
-May significantly speed up delayed fontification. Changes take effect
-after reload."
- :type 'boolean
- :group 'cperl-speed)
-
-(defcustom cperl-imenu-addback nil
- "*Not-nil means add backreferences to generated `imenu's.
-May require patched `imenu' and `imenu-go'. Obsolete."
- :type 'boolean
- :group 'cperl-help-system)
-
-(defcustom cperl-max-help-size 66
- "*Non-nil means shrink-wrapping of info-buffer allowed up to these percents."
- :type '(choice integer (const nil))
- :group 'cperl-help-system)
-
-(defcustom cperl-shrink-wrap-info-frame t
- "*Non-nil means shrink-wrapping of info-buffer-frame allowed."
- :type 'boolean
- :group 'cperl-help-system)
-
-(defcustom cperl-info-page "perl"
- "*Name of the info page containing perl docs.
-Older version of this page was called `perl5', newer `perl'."
- :type 'string
- :group 'cperl-help-system)
-
-(defcustom cperl-use-syntax-table-text-property
- (boundp 'parse-sexp-lookup-properties)
- "*Non-nil means CPerl sets up and uses `syntax-table' text property."
- :type 'boolean
- :group 'cperl-speed)
-
-(defcustom cperl-use-syntax-table-text-property-for-tags
- cperl-use-syntax-table-text-property
- "*Non-nil means: set up and use `syntax-table' text property generating TAGS."
- :type 'boolean
- :group 'cperl-speed)
-
-(defcustom cperl-scan-files-regexp "\\.\\([pP][Llm]\\|xs\\)$"
- "*Regexp to match files to scan when generating TAGS."
- :type 'regexp
- :group 'cperl)
-
-(defcustom cperl-noscan-files-regexp
- "/\\(\\.\\.?\\|SCCS\\|RCS\\|CVS\\|blib\\)$"
- "*Regexp to match files/dirs to skip when generating TAGS."
- :type 'regexp
- :group 'cperl)
-
-(defcustom cperl-regexp-indent-step nil
- "*Indentation used when beautifying regexps.
-If nil, the value of `cperl-indent-level' will be used."
- :type '(choice integer (const nil))
- :group 'cperl-indentation-details)
-
-(defcustom cperl-indent-left-aligned-comments t
- "*Non-nil means that the comment starting in leftmost column should indent."
- :type 'boolean
- :group 'cperl-indentation-details)
-
-(defcustom cperl-under-as-char t
- "*Non-nil means that the _ (underline) should be treated as word char."
- :type 'boolean
- :group 'cperl)
-
-(defcustom cperl-extra-perl-args ""
- "*Extra arguments to use when starting Perl.
-Currently used with `cperl-check-syntax' only."
- :type 'string
- :group 'cperl)
-
-(defcustom cperl-message-electric-keyword t
- "*Non-nil means that the `cperl-electric-keyword' prints a help message."
- :type 'boolean
- :group 'cperl-help-system)
-
-(defcustom cperl-indent-region-fix-constructs 1
- "*Amount of space to insert between `}' and `else' or `elsif'
-in `cperl-indent-region'. Set to nil to leave as is. Values other
-than 1 and nil will probably not work."
- :type '(choice (const nil) (const 1))
- :group 'cperl-indentation-details)
-
-(defcustom cperl-break-one-line-blocks-when-indent t
- "*Non-nil means that one-line if/unless/while/until/for/foreach BLOCKs
-need to be reformatted into multiline ones when indenting a region."
- :type 'boolean
- :group 'cperl-indentation-details)
-
-(defcustom cperl-fix-hanging-brace-when-indent t
- "*Non-nil means that BLOCK-end `}' may be put on a separate line
-when indenting a region.
-Braces followed by else/elsif/while/until are excepted."
- :type 'boolean
- :group 'cperl-indentation-details)
-
-(defcustom cperl-merge-trailing-else t
- "*Non-nil means that BLOCK-end `}' followed by else/elsif/continue
-may be merged to be on the same line when indenting a region."
- :type 'boolean
- :group 'cperl-indentation-details)
-
-(defcustom cperl-indent-parens-as-block nil
- "*Non-nil means that non-block ()-, {}- and []-groups are indented as blocks,
-but for trailing \",\" inside the group, which won't increase indentation.
-One should tune up `cperl-close-paren-offset' as well."
- :type 'boolean
- :group 'cperl-indentation-details)
-
-(defcustom cperl-syntaxify-by-font-lock
- (and cperl-can-font-lock
- (boundp 'parse-sexp-lookup-properties))
- "*Non-nil means that CPerl uses `font-lock's routines for syntaxification."
- :type '(choice (const message) boolean)
- :group 'cperl-speed)
-
-(defcustom cperl-syntaxify-unwind
- t
- "*Non-nil means that CPerl unwinds to a start of a long construction
-when syntaxifying a chunk of buffer."
- :type 'boolean
- :group 'cperl-speed)
-
-(defcustom cperl-syntaxify-for-menu
- t
- "*Non-nil means that CPerl syntaxifies up to the point before showing menu.
-This way enabling/disabling of menu items is more correct."
- :type 'boolean
- :group 'cperl-speed)
-
-(defcustom cperl-ps-print-face-properties
- '((font-lock-keyword-face nil nil bold shadow)
- (font-lock-variable-name-face nil nil bold)
- (font-lock-function-name-face nil nil bold italic box)
- (font-lock-constant-face nil "LightGray" bold)
- (cperl-array-face nil "LightGray" bold underline)
- (cperl-hash-face nil "LightGray" bold italic underline)
- (font-lock-comment-face nil "LightGray" italic)
- (font-lock-string-face nil nil italic underline)
- (cperl-nonoverridable-face nil nil italic underline)
- (font-lock-type-face nil nil underline)
- (font-lock-warning-face nil "LightGray" bold italic box)
- (underline nil "LightGray" strikeout))
- "List given as an argument to `ps-extend-face-list' in `cperl-ps-print'."
- :type '(repeat (cons symbol
- (cons (choice (const nil) string)
- (cons (choice (const nil) string)
- (repeat symbol)))))
- :group 'cperl-faces)
-
-(if cperl-can-font-lock
- (progn
- (defvar cperl-dark-background
- (cperl-choose-color "navy" "os2blue" "darkgreen"))
- (defvar cperl-dark-foreground
- (cperl-choose-color "orchid1" "orange"))
-
- (defface cperl-nonoverridable-face
- (` ((((class grayscale) (background light))
- (:background "Gray90" :italic t :underline t))
- (((class grayscale) (background dark))
- (:foreground "Gray80" :italic t :underline t :bold t))
- (((class color) (background light))
- (:foreground "chartreuse3"))
- (((class color) (background dark))
- (:foreground (, cperl-dark-foreground)))
- (t (:bold t :underline t))))
- "Font Lock mode face used to highlight array names."
- :group 'cperl-faces)
-
- (defface cperl-array-face
- (` ((((class grayscale) (background light))
- (:background "Gray90" :bold t))
- (((class grayscale) (background dark))
- (:foreground "Gray80" :bold t))
- (((class color) (background light))
- (:foreground "Blue" :background "lightyellow2" :bold t))
- (((class color) (background dark))
- (:foreground "yellow" :background (, cperl-dark-background) :bold t))
- (t (:bold t))))
- "Font Lock mode face used to highlight array names."
- :group 'cperl-faces)
-
- (defface cperl-hash-face
- (` ((((class grayscale) (background light))
- (:background "Gray90" :bold t :italic t))
- (((class grayscale) (background dark))
- (:foreground "Gray80" :bold t :italic t))
- (((class color) (background light))
- (:foreground "Red" :background "lightyellow2" :bold t :italic t))
- (((class color) (background dark))
- (:foreground "Red" :background (, cperl-dark-background) :bold t :italic t))
- (t (:bold t :italic t))))
- "Font Lock mode face used to highlight hash names."
- :group 'cperl-faces)))
-
-\f
-
-;;; Short extra-docs.
-
-(defvar cperl-tips 'please-ignore-this-line
- "Get maybe newer version of this package from
- http://ilyaz.org/software/emacs
-Subdirectory `cperl-mode' may contain yet newer development releases and/or
-patches to related files.
-
-For best results apply to an older Emacs the patches from
- ftp://ftp.math.ohio-state.edu/pub/users/ilya/cperl-mode/patches
-\(this upgrades syntax-parsing abilities of RMS Emaxen v19.34 and
-v20.2 up to the level of RMS Emacs v20.3 - a must for a good Perl
-mode.) As of beginning of 2003, XEmacs may provide a similar ability.
-
-Get support packages choose-color.el (or font-lock-extra.el before
-19.30), imenu-go.el from the same place. \(Look for other files there
-too... ;-). Get a patch for imenu.el in 19.29. Note that for 19.30 and
-later you should use choose-color.el *instead* of font-lock-extra.el
-\(and you will not get smart highlighting in C :-().
-
-Note that to enable Compile choices in the menu you need to install
-mode-compile.el.
-
-If your Emacs does not default to `cperl-mode' on Perl files, and you
-want it to: put the following into your .emacs file:
-
- (autoload 'perl-mode \"cperl-mode\" \"alternate mode for editing Perl programs\" t)
-
-or
-
- (defalias 'perl-mode 'cperl-mode)
-
-Get perl5-info from
- $CPAN/doc/manual/info/perl5-old/perl5-info.tar.gz
-Also, one can generate a newer documentation running `pod2texi' converter
- $CPAN/doc/manual/info/perl5/pod2texi-0.1.tar.gz
-
-If you use imenu-go, run imenu on perl5-info buffer (you can do it
-from Perl menu). If many files are related, generate TAGS files from
-Tools/Tags submenu in Perl menu.
-
-If some class structure is too complicated, use Tools/Hierarchy-view
-from Perl menu, or hierarchic view of imenu. The second one uses the
-current buffer only, the first one requires generation of TAGS from
-Perl/Tools/Tags menu beforehand.
-
-Run Perl/Tools/Insert-spaces-if-needed to fix your lazy typing.
-
-Switch auto-help on/off with Perl/Tools/Auto-help.
-
-Though with contemporary Emaxen CPerl mode should maintain the correct
-parsing of Perl even when editing, sometimes it may be lost. Fix this by
-
- M-x norm RET
-
-or
-
- \\[normal-mode]
-
-In cases of more severe confusion sometimes it is helpful to do
-
- M-x load-l RET cperl-mode RET
- M-x norm RET
-
-or
-
- \\[load-library] cperl-mode RET
- \\[normal-mode]
-
-Before reporting (non-)problems look in the problem section of online
-micro-docs on what I know about CPerl problems.")
-
-(defvar cperl-problems 'please-ignore-this-line
- "Description of problems in CPerl mode.
-Some faces will not be shown on some versions of Emacs unless you
-install choose-color.el, available from
- http://ilyaz.org/software/emacs
-
-`fill-paragraph' on a comment may leave the point behind the
-paragraph. It also triggers a bug in some versions of Emacs (CPerl tries
-to detect it and bulk out).
-
-See documentation of a variable `cperl-problems-old-emaxen' for the
-problems which disappear if you upgrade Emacs to a reasonably new
-version (20.3 for RMS Emacs, and those of 2004 for XEmacs).")
-
-(defvar cperl-problems-old-emaxen 'please-ignore-this-line
- "Description of problems in CPerl mode specific for older Emacs versions.
-
-Emacs had a _very_ restricted syntax parsing engine until RMS's Emacs
-20.1. Most problems below are corrected starting from this version of
-Emacs, and all of them should be fixed in RMS's version 20.3. (Or apply
-patches to Emacs 19.33/34 - see tips.) XEmacs was very backward in
-this respect (until 2003).
-
-Note that even with newer Emacsen in some very rare cases the details
-of interaction of `font-lock' and syntaxification may be not cleaned
-up yet. You may get slightly different colors basing on the order of
-fontification and syntaxification. Say, the initial faces is correct,
-but editing the buffer breaks this.
-
-Even with older Emacsen CPerl mode tries to corrects some Emacs
-misunderstandings, however, for efficiency reasons the degree of
-correction is different for different operations. The partially
-corrected problems are: POD sections, here-documents, regexps. The
-operations are: highlighting, indentation, electric keywords, electric
-braces.
-
-This may be confusing, since the regexp s#//#/#\; may be highlighted
-as a comment, but it will be recognized as a regexp by the indentation
-code. Or the opposite case, when a POD section is highlighted, but
-may break the indentation of the following code (though indentation
-should work if the balance of delimiters is not broken by POD).
-
-The main trick (to make $ a \"backslash\") makes constructions like
-${aaa} look like unbalanced braces. The only trick I can think of is
-to insert it as $ {aaa} (legal in perl5, not in perl4).
-
-Similar problems arise in regexps, when /(\\s|$)/ should be rewritten
-as /($|\\s)/. Note that such a transposition is not always possible.
-
-The solution is to upgrade your Emacs or patch an older one. Note
-that RMS's 20.2 has some bugs related to `syntax-table' text
-properties. Patches are available on the main CPerl download site,
-and on CPAN.
-
-If these bugs cannot be fixed on your machine (say, you have an inferior
-environment and cannot recompile), you may still disable all the fancy stuff
-via `cperl-use-syntax-table-text-property'.")
-
-(defvar cperl-non-problems 'please-ignore-this-line
-"As you know from `problems' section, Perl syntax is too hard for CPerl on
-older Emacsen. Here is what you can do if you cannot upgrade, or if
-you want to switch off these capabilities on RMS Emacs 20.2 (+patches) or 20.3
-or better. Please skip this docs if you run a capable Emacs already.
-
-Most of the time, if you write your own code, you may find an equivalent
-\(and almost as readable) expression (what is discussed below is usually
-not relevant on newer Emacsen, since they can do it automatically).
-
-Try to help CPerl: add comments with embedded quotes to fix CPerl
-misunderstandings about the end of quotation:
-
-$a='500$'; # ';
-
-You won't need it too often. The reason: $ \"quotes\" the following
-character (this saves a life a lot of times in CPerl), thus due to
-Emacs parsing rules it does not consider tick (i.e., ' ) after a
-dollar as a closing one, but as a usual character. This is usually
-correct, but not in the above context.
-
-Even with older Emacsen the indentation code is pretty wise. The only
-drawback is that it relied on Emacs parsing to find matching
-parentheses. And Emacs *could not* match parentheses in Perl 100%
-correctly. So
- 1 if s#//#/#;
-would not break indentation, but
- 1 if ( s#//#/# );
-would. Upgrade.
-
-By similar reasons
- s\"abc\"def\";
-could confuse CPerl a lot.
-
-If you still get wrong indentation in situation that you think the
-code should be able to parse, try:
-
-a) Check what Emacs thinks about balance of your parentheses.
-b) Supply the code to me (IZ).
-
-Pods were treated _very_ rudimentally. Here-documents were not
-treated at all (except highlighting and inhibiting indentation). Upgrade.
-
-To speed up coloring the following compromises exist:
- a) sub in $mypackage::sub may be highlighted.
- b) -z in [a-z] may be highlighted.
- c) if your regexp contains a keyword (like \"s\"), it may be highlighted.
-
-
-Imenu in 19.31 is broken. Set `imenu-use-keymap-menu' to t, and remove
-`car' before `imenu-choose-buffer-index' in `imenu'.
-`imenu-add-to-menubar' in 20.2 is broken.
-A lot of things on XEmacs may be broken too, judging by bug reports I
-receive. Note that some releases of XEmacs are better than the others
-as far as bugs reports I see are concerned.")
-
-(defvar cperl-praise 'please-ignore-this-line
- "Advantages of CPerl mode.
-
-0) It uses the newest `syntax-table' property ;-);
-
-1) It does 99% of Perl syntax correct (as opposed to 80-90% in Perl
-mode - but the latter number may have improved too in last years) even
-with old Emaxen which do not support `syntax-table' property.
-
-When using `syntax-table' property for syntax assist hints, it should
-handle 99.995% of lines correct - or somesuch. It automatically
-updates syntax assist hints when you edit your script.
-
-2) It is generally believed to be \"the most user-friendly Emacs
-package\" whatever it may mean (I doubt that the people who say similar
-things tried _all_ the rest of Emacs ;-), but this was not a lonely
-voice);
-
-3) Everything is customizable, one-by-one or in a big sweep;
-
-4) It has many easily-accessable \"tools\":
- a) Can run program, check syntax, start debugger;
- b) Can lineup vertically \"middles\" of rows, like `=' in
- a = b;
- cc = d;
- c) Can insert spaces where this impoves readability (in one
- interactive sweep over the buffer);
- d) Has support for imenu, including:
- 1) Separate unordered list of \"interesting places\";
- 2) Separate TOC of POD sections;
- 3) Separate list of packages;
- 4) Hierarchical view of methods in (sub)packages;
- 5) and functions (by the full name - with package);
- e) Has an interface to INFO docs for Perl; The interface is
- very flexible, including shrink-wrapping of
- documentation buffer/frame;
- f) Has a builtin list of one-line explanations for perl constructs.
- g) Can show these explanations if you stay long enough at the
- corresponding place (or on demand);
- h) Has an enhanced fontification (using 3 or 4 additional faces
- comparing to font-lock - basically, different
- namespaces in Perl have different colors);
- i) Can construct TAGS basing on its knowledge of Perl syntax,
- the standard menu has 6 different way to generate
- TAGS (if \"by directory\", .xs files - with C-language
- bindings - are included in the scan);
- j) Can build a hierarchical view of classes (via imenu) basing
- on generated TAGS file;
- k) Has electric parentheses, electric newlines, uses Abbrev
- for electric logical constructs
- while () {}
- with different styles of expansion (context sensitive
- to be not so bothering). Electric parentheses behave
- \"as they should\" in a presence of a visible region.
- l) Changes msb.el \"on the fly\" to insert a group \"Perl files\";
- m) Can convert from
- if (A) { B }
- to
- B if A;
-
- n) Highlights (by user-choice) either 3-delimiters constructs
- (such as tr/a/b/), or regular expressions and `y/tr';
- o) Highlights trailing whitespace;
- p) Is able to manipulate Perl Regular Expressions to ease
- conversion to a more readable form.
- q) Can ispell POD sections and HERE-DOCs.
- r) Understands comments and character classes inside regular
- expressions; can find matching () and [] in a regular expression.
- s) Allows indentation of //x-style regular expressions;
- t) Highlights different symbols in regular expressions according
- to their function; much less problems with backslashitis;
- u) Allows to find regular expressions which contain interpolated parts.
-
-5) The indentation engine was very smart, but most of tricks may be
-not needed anymore with the support for `syntax-table' property. Has
-progress indicator for indentation (with `imenu' loaded).
-
-6) Indent-region improves inline-comments as well; also corrects
-whitespace *inside* the conditional/loop constructs.
-
-7) Fill-paragraph correctly handles multi-line comments;
-
-8) Can switch to different indentation styles by one command, and restore
-the settings present before the switch.
-
-9) When doing indentation of control constructs, may correct
-line-breaks/spacing between elements of the construct.
-
-10) Uses a linear-time algorith for indentation of regions (on Emaxen with
-capable syntax engines).
-
-11) Syntax-highlight, indentation, sexp-recognition inside regular expressions.
-")
-
-(defvar cperl-speed 'please-ignore-this-line
- "This is an incomplete compendium of what is available in other parts
-of CPerl documentation. (Please inform me if I skept anything.)
-
-There is a perception that CPerl is slower than alternatives. This part
-of documentation is designed to overcome this misconception.
-
-*By default* CPerl tries to enable the most comfortable settings.
-From most points of view, correctly working package is infinitely more
-comfortable than a non-correctly working one, thus by default CPerl
-prefers correctness over speed. Below is the guide how to change
-settings if your preferences are different.
-
-A) Speed of loading the file. When loading file, CPerl may perform a
-scan which indicates places which cannot be parsed by primitive Emacs
-syntax-parsing routines, and marks them up so that either
-
- A1) CPerl may work around these deficiencies (for big chunks, mostly
- PODs and HERE-documents), or
- A2) On capable Emaxen CPerl will use improved syntax-handlings
- which reads mark-up hints directly.
-
- The scan in case A2 is much more comprehensive, thus may be slower.
-
- User can disable syntax-engine-helping scan of A2 by setting
- `cperl-use-syntax-table-text-property'
- variable to nil (if it is set to t).
-
- One can disable the scan altogether (both A1 and A2) by setting
- `cperl-pod-here-scan'
- to nil.
-
-B) Speed of editing operations.
-
- One can add a (minor) speedup to editing operations by setting
- `cperl-use-syntax-table-text-property'
- variable to nil (if it is set to t). This will disable
- syntax-engine-helping scan, thus will make many more Perl
- constructs be wrongly recognized by CPerl, thus may lead to
- wrongly matched parentheses, wrong indentation, etc.
-
- One can unset `cperl-syntaxify-unwind'. This might speed up editing
- of, say, long POD sections.")
-
-(defvar cperl-tips-faces 'please-ignore-this-line
- "CPerl mode uses following faces for highlighting:
-
- `cperl-array-face' Array names
- `cperl-hash-face' Hash names
- `font-lock-comment-face' Comments, PODs and whatever is considered
- syntaxically to be not code
- `font-lock-constant-face' HERE-doc delimiters, labels, delimiters of
- 2-arg operators s/y/tr/ or of RExen,
- `font-lock-warning-face' Special-cased m// and s//foo/,
- `font-lock-function-name-face' _ as a target of a file tests, file tests,
- subroutine names at the moment of definition
- (except those conflicting with Perl operators),
- package names (when recognized), format names
- `font-lock-keyword-face' Control flow switch constructs, declarators
- `cperl-nonoverridable-face' Non-overridable keywords, modifiers of RExen
- `font-lock-string-face' Strings, qw() constructs, RExen, POD sections,
- literal parts and the terminator of formats
- and whatever is syntaxically considered
- as string literals
- `font-lock-type-face' Overridable keywords
- `font-lock-variable-name-face' Variable declarations, indirect array and
- hash names, POD headers/item names
- `cperl-invalid-face' Trailing whitespace
-
-Note that in several situations the highlighting tries to inform about
-possible confusion, such as different colors for function names in
-declarations depending on what they (do not) override, or special cases
-m// and s/// which do not do what one would expect them to do.
-
-Help with best setup of these faces for printout requested (for each of
-the faces: please specify bold, italic, underline, shadow and box.)
-
-In regular expressions (except character classes):
- `font-lock-string-face' \"Normal\" stuff and non-0-length constructs
- `font-lock-constant-face': Delimiters
- `font-lock-warning-face' Special-cased m// and s//foo/,
- Mismatched closing delimiters, parens
- we couldn't match, misplaced quantifiers,
- unrecognized escape sequences
- `cperl-nonoverridable-face' Modifiers, as gism in m/REx/gism
- `font-lock-type-face' POSIX classes inside charclasses,
- escape sequences with arguments (\x \23 \p \N)
- and others match-a-char escape sequences
- `font-lock-keyword-face' Capturing parens, and |
- `font-lock-function-name-face' Special symbols: $ ^ . [ ] [^ ] (?{ }) (??{ })
- `font-lock-builtin-face' \"Remaining\" 0-length constructs, executable
- parts of a REx, not-capturing parens
- `font-lock-variable-name-face' Interpolated constructs, embedded code
- `font-lock-comment-face' Embedded comments
-
-")
-
-\f
-
-;;; Portability stuff:
-
-(defmacro cperl-define-key (emacs-key definition &optional xemacs-key)
- (` (define-key cperl-mode-map
- (, (if xemacs-key
- (` (if cperl-xemacs-p (, xemacs-key) (, emacs-key)))
- emacs-key))
- (, definition))))
-
-(defvar cperl-del-back-ch
- (car (append (where-is-internal 'delete-backward-char)
- (where-is-internal 'backward-delete-char-untabify)))
- "Character generated by key bound to `delete-backward-char'.")
-
-(and (vectorp cperl-del-back-ch) (= (length cperl-del-back-ch) 1)
- (setq cperl-del-back-ch (aref cperl-del-back-ch 0)))
-
-(defun cperl-mark-active () (mark)) ; Avoid undefined warning
-(if cperl-xemacs-p
- (progn
- ;; "Active regions" are on: use region only if active
- ;; "Active regions" are off: use region unconditionally
- (defun cperl-use-region-p ()
- (if zmacs-regions (mark) t)))
- (defun cperl-use-region-p ()
- (if transient-mark-mode mark-active t))
- (defun cperl-mark-active () mark-active))
-
-(defsubst cperl-enable-font-lock ()
- cperl-can-font-lock)
-
-(defun cperl-putback-char (c) ; Emacs 19
- (set 'unread-command-events (list c))) ; Avoid undefined warning
-
-(if (boundp 'unread-command-events)
- (if cperl-xemacs-p
- (defun cperl-putback-char (c) ; XEmacs >= 19.12
- (setq unread-command-events (list (eval '(character-to-event c))))))
- (defun cperl-putback-char (c) ; XEmacs <= 19.11
- (set 'unread-command-event (eval '(character-to-event c))))) ; Avoid warnings
-
-(or (fboundp 'uncomment-region)
- (defun uncomment-region (beg end)
- (interactive "r")
- (comment-region beg end -1)))
-
-(defvar cperl-do-not-fontify
- (if (string< emacs-version "19.30")
- 'fontified
- 'lazy-lock)
- "Text property which inhibits refontification.")
-
-(defsubst cperl-put-do-not-fontify (from to &optional post)
- ;; If POST, do not do it with postponed fontification
- (if (and post cperl-syntaxify-by-font-lock)
- nil
- (put-text-property (max (point-min) (1- from))
- to cperl-do-not-fontify t)))
-
-(defcustom cperl-mode-hook nil
- "Hook run by CPerl mode."
- :type 'hook
- :group 'cperl)
-
-(defvar cperl-syntax-state nil)
-(defvar cperl-syntax-done-to nil)
-(defvar cperl-emacs-can-parse (> (length (save-excursion
- (parse-partial-sexp (point) (point)))) 9))
-\f
-;; Make customization possible "in reverse"
-(defsubst cperl-val (symbol &optional default hairy)
- (cond
- ((eq (symbol-value symbol) 'null) default)
- (cperl-hairy (or hairy t))
- (t (symbol-value symbol))))
-\f
-
-(defun cperl-make-indent (column &optional minimum keep)
- "Makes indent of the current line the requested amount.
-Unless KEEP, removes the old indentation. Works around a bug in ancient
-versions of Emacs."
- (let ((prop (get-text-property (point) 'syntax-type)))
- (or keep
- (delete-horizontal-space))
- (indent-to column minimum)
- ;; In old versions (e.g., 19.33) `indent-to' would not inherit properties
- (and prop
- (> (current-column) 0)
- (save-excursion
- (beginning-of-line)
- (or (get-text-property (point) 'syntax-type)
- (and (looking-at "\\=[ \t]")
- (put-text-property (point) (match-end 0)
- 'syntax-type prop)))))))
-
-;;; Probably it is too late to set these guys already, but it can help later:
-
-(and cperl-clobber-mode-lists
- (setq auto-mode-alist
- (append '(("\\.\\([pP][Llm]\\|al\\)$" . perl-mode)) auto-mode-alist ))
- (and (boundp 'interpreter-mode-alist)
- (setq interpreter-mode-alist (append interpreter-mode-alist
- '(("miniperl" . perl-mode))))))
-(if (fboundp 'eval-when-compile)
- (eval-when-compile
- (mapcar (lambda (p)
- (condition-case nil
- (require p)
- (error nil)))
- '(imenu easymenu etags timer man info))
- (if (fboundp 'ps-extend-face-list)
- (defmacro cperl-ps-extend-face-list (arg)
- (` (ps-extend-face-list (, arg))))
- (defmacro cperl-ps-extend-face-list (arg)
- (` (error "This version of Emacs has no `ps-extend-face-list'"))))
- ;; Calling `cperl-enable-font-lock' below doesn't compile on XEmacs,
- ;; macros instead of defsubsts don't work on Emacs, so we do the
- ;; expansion manually. Any other suggestions?
- (if cperl-can-font-lock
- (require 'font-lock))
- (require 'cl)))
-
-(defvar cperl-mode-abbrev-table nil
- "Abbrev table in use in CPerl mode buffers.")
-
-(add-hook 'edit-var-mode-alist '(perl-mode (regexp . "^cperl-")))
-
-(defvar cperl-mode-map () "Keymap used in CPerl mode.")
-
-(if cperl-mode-map nil
- (setq cperl-mode-map (make-sparse-keymap))
- (cperl-define-key "{" 'cperl-electric-lbrace)
- (cperl-define-key "[" 'cperl-electric-paren)
- (cperl-define-key "(" 'cperl-electric-paren)
- (cperl-define-key "<" 'cperl-electric-paren)
- (cperl-define-key "}" 'cperl-electric-brace)
- (cperl-define-key "]" 'cperl-electric-rparen)
- (cperl-define-key ")" 'cperl-electric-rparen)
- (cperl-define-key ";" 'cperl-electric-semi)
- (cperl-define-key ":" 'cperl-electric-terminator)
- (cperl-define-key "\C-j" 'newline-and-indent)
- (cperl-define-key "\C-c\C-j" 'cperl-linefeed)
- (cperl-define-key "\C-c\C-t" 'cperl-invert-if-unless)
- (cperl-define-key "\C-c\C-a" 'cperl-toggle-auto-newline)
- (cperl-define-key "\C-c\C-k" 'cperl-toggle-abbrev)
- (cperl-define-key "\C-c\C-w" 'cperl-toggle-construct-fix)
- (cperl-define-key "\C-c\C-f" 'auto-fill-mode)
- (cperl-define-key "\C-c\C-e" 'cperl-toggle-electric)
- (cperl-define-key "\C-c\C-b" 'cperl-find-bad-style)
- (cperl-define-key "\C-c\C-p" 'cperl-pod-spell)
- (cperl-define-key "\C-c\C-d" 'cperl-here-doc-spell)
- (cperl-define-key "\C-c\C-n" 'cperl-narrow-to-here-doc)
- (cperl-define-key "\C-c\C-v" 'cperl-next-interpolated-REx)
- (cperl-define-key "\C-c\C-x" 'cperl-next-interpolated-REx-0)
- (cperl-define-key "\C-c\C-y" 'cperl-next-interpolated-REx-1)
- (cperl-define-key "\C-c\C-ha" 'cperl-toggle-autohelp)
- (cperl-define-key "\C-c\C-hp" 'cperl-perldoc)
- (cperl-define-key "\C-c\C-hP" 'cperl-perldoc-at-point)
- (cperl-define-key "\e\C-q" 'cperl-indent-exp) ; Usually not bound
- (cperl-define-key [?\C-\M-\|] 'cperl-lineup
- [(control meta |)])
- ;;(cperl-define-key "\M-q" 'cperl-fill-paragraph)
- ;;(cperl-define-key "\e;" 'cperl-indent-for-comment)
- (cperl-define-key "\177" 'cperl-electric-backspace)
- (cperl-define-key "\t" 'cperl-indent-command)
- ;; don't clobber the backspace binding:
- (cperl-define-key "\C-c\C-hF" 'cperl-info-on-command
- [(control c) (control h) F])
- (if (cperl-val 'cperl-clobber-lisp-bindings)
- (progn
- (cperl-define-key "\C-hf"
- ;;(concat (char-to-string help-char) "f") ; does not work
- 'cperl-info-on-command
- [(control h) f])
- (cperl-define-key "\C-hv"
- ;;(concat (char-to-string help-char) "v") ; does not work
- 'cperl-get-help
- [(control h) v])
- (cperl-define-key "\C-c\C-hf"
- ;;(concat (char-to-string help-char) "f") ; does not work
- (key-binding "\C-hf")
- [(control c) (control h) f])
- (cperl-define-key "\C-c\C-hv"
- ;;(concat (char-to-string help-char) "v") ; does not work
- (key-binding "\C-hv")
- [(control c) (control h) v]))
- (cperl-define-key "\C-c\C-hf" 'cperl-info-on-current-command
- [(control c) (control h) f])
- (cperl-define-key "\C-c\C-hv"
- ;;(concat (char-to-string help-char) "v") ; does not work
- 'cperl-get-help
- [(control c) (control h) v]))
- (if (and cperl-xemacs-p
- (<= emacs-minor-version 11) (<= emacs-major-version 19))
- (progn
- ;; substitute-key-definition is usefulness-deenhanced...
- ;;;;;(cperl-define-key "\M-q" 'cperl-fill-paragraph)
- (cperl-define-key "\e;" 'cperl-indent-for-comment)
- (cperl-define-key "\e\C-\\" 'cperl-indent-region))
- (or (boundp 'fill-paragraph-function)
- (substitute-key-definition
- 'fill-paragraph 'cperl-fill-paragraph
- cperl-mode-map global-map))
- (substitute-key-definition
- 'indent-sexp 'cperl-indent-exp
- cperl-mode-map global-map)
- (substitute-key-definition
- 'indent-region 'cperl-indent-region
- cperl-mode-map global-map)
- (substitute-key-definition
- 'indent-for-comment 'cperl-indent-for-comment
- cperl-mode-map global-map)))
-
-(defvar cperl-menu)
-(defvar cperl-lazy-installed)
-(defvar cperl-old-style nil)
-(condition-case nil
- (progn
- (require 'easymenu)
- (easy-menu-define
- cperl-menu cperl-mode-map "Menu for CPerl mode"
- '("Perl"
- ["Beginning of function" beginning-of-defun t]
- ["End of function" end-of-defun t]
- ["Mark function" mark-defun t]
- ["Indent expression" cperl-indent-exp t]
- ["Fill paragraph/comment" cperl-fill-paragraph t]
- "----"
- ["Line up a construction" cperl-lineup (cperl-use-region-p)]
- ["Invert if/unless/while etc" cperl-invert-if-unless t]
- ("Regexp"
- ["Beautify" cperl-beautify-regexp
- cperl-use-syntax-table-text-property]
- ["Beautify one level deep" (cperl-beautify-regexp 1)
- cperl-use-syntax-table-text-property]
- ["Beautify a group" cperl-beautify-level
- cperl-use-syntax-table-text-property]
- ["Beautify a group one level deep" (cperl-beautify-level 1)
- cperl-use-syntax-table-text-property]
- ["Contract a group" cperl-contract-level
- cperl-use-syntax-table-text-property]
- ["Contract groups" cperl-contract-levels
- cperl-use-syntax-table-text-property]
- "----"
- ["Find next interpolated" cperl-next-interpolated-REx
- (next-single-property-change (point-min) 'REx-interpolated)]
- ["Find next interpolated (no //o)"
- cperl-next-interpolated-REx-0
- (or (text-property-any (point-min) (point-max) 'REx-interpolated t)
- (text-property-any (point-min) (point-max) 'REx-interpolated 1))]
- ["Find next interpolated (neither //o nor whole-REx)"
- cperl-next-interpolated-REx-1
- (text-property-any (point-min) (point-max) 'REx-interpolated t)])
- ["Insert spaces if needed to fix style" cperl-find-bad-style t]
- ["Refresh \"hard\" constructions" cperl-find-pods-heres t]
- "----"
- ["Indent region" cperl-indent-region (cperl-use-region-p)]
- ["Comment region" cperl-comment-region (cperl-use-region-p)]
- ["Uncomment region" cperl-uncomment-region (cperl-use-region-p)]
- "----"
- ["Run" mode-compile (fboundp 'mode-compile)]
- ["Kill" mode-compile-kill (and (fboundp 'mode-compile-kill)
- (get-buffer "*compilation*"))]
- ["Next error" next-error (get-buffer "*compilation*")]
- ["Check syntax" cperl-check-syntax (fboundp 'mode-compile)]
- "----"
- ["Debugger" cperl-db t]
- "----"
- ("Tools"
- ["Imenu" imenu (fboundp 'imenu)]
- ["Imenu on Perl Info" cperl-imenu-on-info (featurep 'imenu)]
- "----"
- ["Ispell PODs" cperl-pod-spell
- ;; Better not to update syntaxification here:
- ;; debugging syntaxificatio can be broken by this???
- (or
- (get-text-property (point-min) 'in-pod)
- (< (progn
- (and cperl-syntaxify-for-menu
- (cperl-update-syntaxification (point-max) (point-max)))
- (next-single-property-change (point-min) 'in-pod nil (point-max)))
- (point-max)))]
- ["Ispell HERE-DOCs" cperl-here-doc-spell
- (< (progn
- (and cperl-syntaxify-for-menu
- (cperl-update-syntaxification (point-max) (point-max)))
- (next-single-property-change (point-min) 'here-doc-group nil (point-max)))
- (point-max))]
- ["Narrow to this HERE-DOC" cperl-narrow-to-here-doc
- (eq 'here-doc (progn
- (and cperl-syntaxify-for-menu
- (cperl-update-syntaxification (point) (point)))
- (get-text-property (point) 'syntax-type)))]
- ["Select this HERE-DOC or POD section"
- cperl-select-this-pod-or-here-doc
- (memq (progn
- (and cperl-syntaxify-for-menu
- (cperl-update-syntaxification (point) (point)))
- (get-text-property (point) 'syntax-type))
- '(here-doc pod))]
- "----"
- ["CPerl pretty print (exprmntl)" cperl-ps-print
- (fboundp 'ps-extend-face-list)]
- "----"
- ["Syntaxify region" cperl-find-pods-heres-region
- (cperl-use-region-p)]
- ["Profile syntaxification" cperl-time-fontification t]
- ["Debug errors in delayed fontification" cperl-emulate-lazy-lock t]
- ["Debug unwind for syntactic scan" cperl-toggle-set-debug-unwind t]
- ["Debug backtrace on syntactic scan (BEWARE!!!)"
- (cperl-toggle-set-debug-unwind nil t) t]
- "----"
- ["Class Hierarchy from TAGS" cperl-tags-hier-init t]
- ;;["Update classes" (cperl-tags-hier-init t) tags-table-list]
- ("Tags"
-;;; ["Create tags for current file" cperl-etags t]
-;;; ["Add tags for current file" (cperl-etags t) t]
-;;; ["Create tags for Perl files in directory" (cperl-etags nil t) t]
-;;; ["Add tags for Perl files in directory" (cperl-etags t t) t]
-;;; ["Create tags for Perl files in (sub)directories"
-;;; (cperl-etags nil 'recursive) t]
-;;; ["Add tags for Perl files in (sub)directories"
-;;; (cperl-etags t 'recursive) t])
-;;;; cperl-write-tags (&optional file erase recurse dir inbuffer)
- ["Create tags for current file" (cperl-write-tags nil t) t]
- ["Add tags for current file" (cperl-write-tags) t]
- ["Create tags for Perl files in directory"
- (cperl-write-tags nil t nil t) t]
- ["Add tags for Perl files in directory"
- (cperl-write-tags nil nil nil t) t]
- ["Create tags for Perl files in (sub)directories"
- (cperl-write-tags nil t t t) t]
- ["Add tags for Perl files in (sub)directories"
- (cperl-write-tags nil nil t t) t]))
- ("Perl docs"
- ["Define word at point" imenu-go-find-at-position
- (fboundp 'imenu-go-find-at-position)]
- ["Help on function" cperl-info-on-command t]
- ["Help on function at point" cperl-info-on-current-command t]
- ["Help on symbol at point" cperl-get-help t]
- ["Perldoc" cperl-perldoc t]
- ["Perldoc on word at point" cperl-perldoc-at-point t]
- ["View manpage of POD in this file" cperl-build-manpage t]
- ["Auto-help on" cperl-lazy-install
- (and (fboundp 'run-with-idle-timer)
- (not cperl-lazy-installed))]
- ["Auto-help off" cperl-lazy-unstall
- (and (fboundp 'run-with-idle-timer)
- cperl-lazy-installed)])
- ("Toggle..."
- ["Auto newline" cperl-toggle-auto-newline t]
- ["Electric parens" cperl-toggle-electric t]
- ["Electric keywords" cperl-toggle-abbrev t]
- ["Fix whitespace on indent" cperl-toggle-construct-fix t]
- ["Auto-help on Perl constructs" cperl-toggle-autohelp t]
- ["Auto fill" auto-fill-mode t])
- ("Indent styles..."
- ["CPerl" (cperl-set-style "CPerl") t]
- ["PerlStyle" (cperl-set-style "PerlStyle") t]
- ["GNU" (cperl-set-style "GNU") t]
- ["C++" (cperl-set-style "C++") t]
- ["K&R" (cperl-set-style "K&R") t]
- ["BSD" (cperl-set-style "BSD") t]
- ["Whitesmith" (cperl-set-style "Whitesmith") t]
- ["Memorize Current" (cperl-set-style "Current") t]
- ["Memorized" (cperl-set-style-back) cperl-old-style])
- ("Micro-docs"
- ["Tips" (describe-variable 'cperl-tips) t]
- ["Problems" (describe-variable 'cperl-problems) t]
- ["Non-problems" (describe-variable 'cperl-non-problems) t]
- ["Speed" (describe-variable 'cperl-speed) t]
- ["Praise" (describe-variable 'cperl-praise) t]
- ["Faces" (describe-variable 'cperl-tips-faces) t]
- ["CPerl mode" (describe-function 'cperl-mode) t]
- ["CPerl version"
- (message "The version of master-file for this CPerl is %s"
- cperl-version) t]))))
- (error nil))
-
-(autoload 'c-macro-expand "cmacexp"
- "Display the result of expanding all C macros occurring in the region.
-The expansion is entirely correct because it uses the C preprocessor."
- t)
-
-;;; These two must be unwound, otherwise take exponential time
-(defconst cperl-maybe-white-and-comment-rex "[ \t\n]*\\(#[^\n]*\n[ \t\n]*\\)*"
-"Regular expression to match optional whitespace with interpspersed comments.
-Should contain exactly one group.")
-
-;;; This one is tricky to unwind; still very inefficient...
-(defconst cperl-white-and-comment-rex "\\([ \t\n]\\|#[^\n]*\n\\)+"
-"Regular expression to match whitespace with interpspersed comments.
-Should contain exactly one group.")
-
-
-;;; Is incorporated in `cperl-imenu--function-name-regexp-perl'
-;;; `cperl-outline-regexp', `defun-prompt-regexp'.
-;;; Details of groups in this may be used in several functions; see comments
-;;; near mentioned above variable(s)...
-;;; sub($$):lvalue{} sub:lvalue{} Both allowed...
-(defsubst cperl-after-sub-regexp (named attr) ; 9 groups without attr...
- "Match the text after `sub' in a subroutine declaration.
-If NAMED is nil, allows anonymous subroutines. Matches up to the first \":\"
-of attributes (if present), or end of the name or prototype (whatever is
-the last)."
- (concat ; Assume n groups before this...
- "\\(" ; n+1=name-group
- cperl-white-and-comment-rex ; n+2=pre-name
- "\\(::[a-zA-Z_0-9:']+\\|[a-zA-Z_'][a-zA-Z_0-9:']*\\)" ; n+3=name
- "\\)" ; END n+1=name-group
- (if named "" "?")
- "\\(" ; n+4=proto-group
- cperl-maybe-white-and-comment-rex ; n+5=pre-proto
- "\\(([^()]*)\\)" ; n+6=prototype
- "\\)?" ; END n+4=proto-group
- "\\(" ; n+7=attr-group
- cperl-maybe-white-and-comment-rex ; n+8=pre-attr
- "\\(" ; n+9=start-attr
- ":"
- (if attr (concat
- "\\("
- cperl-maybe-white-and-comment-rex ; whitespace-comments
- "\\(\\sw\\|_\\)+" ; attr-name
- ;; attr-arg (1 level of internal parens allowed!)
- "\\((\\(\\\\.\\|[^\\\\()]\\|([^\\\\()]*)\\)*)\\)?"
- "\\(" ; optional : (XXX allows trailing???)
- cperl-maybe-white-and-comment-rex ; whitespace-comments
- ":\\)?"
- "\\)+")
- "[^:]")
- "\\)"
- "\\)?" ; END n+6=proto-group
- ))
-
-;;; Details of groups in this are used in `cperl-imenu--create-perl-index'
-;;; and `cperl-outline-level'.
-;;;; Was: 2=sub|package; now 2=package-group, 5=package-name 8=sub-name (+3)
-(defvar cperl-imenu--function-name-regexp-perl
- (concat
- "^\\(" ; 1 = all
- "\\([ \t]*package" ; 2 = package-group
- "\\(" ; 3 = package-name-group
- cperl-white-and-comment-rex ; 4 = pre-package-name
- "\\([a-zA-Z_0-9:']+\\)\\)?\\)" ; 5 = package-name
- "\\|"
- "[ \t]*sub"
- (cperl-after-sub-regexp 'named nil) ; 8=name 11=proto 14=attr-start
- cperl-maybe-white-and-comment-rex ; 15=pre-block
- "\\|"
- "=head\\([1-4]\\)[ \t]+" ; 16=level
- "\\([^\n]+\\)$" ; 17=text
- "\\)"))
-
-(defvar cperl-outline-regexp
- (concat cperl-imenu--function-name-regexp-perl "\\|" "\\`"))
-
-(defvar cperl-mode-syntax-table nil
- "Syntax table in use in CPerl mode buffers.")
-
-(defvar cperl-string-syntax-table nil
- "Syntax table in use in CPerl mode string-like chunks.")
-
-(defsubst cperl-1- (p)
- (max (point-min) (1- p)))
-
-(defsubst cperl-1+ (p)
- (min (point-max) (1+ p)))
-
-(if cperl-mode-syntax-table
- ()
- (setq cperl-mode-syntax-table (make-syntax-table))
- (modify-syntax-entry ?\\ "\\" cperl-mode-syntax-table)
- (modify-syntax-entry ?/ "." cperl-mode-syntax-table)
- (modify-syntax-entry ?* "." cperl-mode-syntax-table)
- (modify-syntax-entry ?+ "." cperl-mode-syntax-table)
- (modify-syntax-entry ?- "." cperl-mode-syntax-table)
- (modify-syntax-entry ?= "." cperl-mode-syntax-table)
- (modify-syntax-entry ?% "." cperl-mode-syntax-table)
- (modify-syntax-entry ?< "." cperl-mode-syntax-table)
- (modify-syntax-entry ?> "." cperl-mode-syntax-table)
- (modify-syntax-entry ?& "." cperl-mode-syntax-table)
- (modify-syntax-entry ?$ "\\" cperl-mode-syntax-table)
- (modify-syntax-entry ?\n ">" cperl-mode-syntax-table)
- (modify-syntax-entry ?# "<" cperl-mode-syntax-table)
- (modify-syntax-entry ?' "\"" cperl-mode-syntax-table)
- (modify-syntax-entry ?` "\"" cperl-mode-syntax-table)
- (if cperl-under-as-char
- (modify-syntax-entry ?_ "w" cperl-mode-syntax-table))
- (modify-syntax-entry ?: "_" cperl-mode-syntax-table)
- (modify-syntax-entry ?| "." cperl-mode-syntax-table)
- (setq cperl-string-syntax-table (copy-syntax-table cperl-mode-syntax-table))
- (modify-syntax-entry ?$ "." cperl-string-syntax-table)
- (modify-syntax-entry ?\{ "." cperl-string-syntax-table)
- (modify-syntax-entry ?\} "." cperl-string-syntax-table)
- (modify-syntax-entry ?# "." cperl-string-syntax-table)) ; (?# comment )
-
-
-\f
-;; provide an alias for working with emacs 19. the perl-mode that comes
-;; with it is really bad, and this lets us seamlessly replace it.
-;;;###autoload
-(fset 'perl-mode 'cperl-mode)
-(defvar cperl-faces-init nil)
-;; Fix for msb.el
-(defvar cperl-msb-fixed nil)
-(defvar font-lock-syntactic-keywords)
-(defvar perl-font-lock-keywords)
-(defvar perl-font-lock-keywords-1)
-(defvar perl-font-lock-keywords-2)
-(defvar outline-level)
-(if (fboundp 'defvaralias)
- (let ((f 'defvaralias)) ; Some functions deduce stuff from the mode name...
- (funcall f 'cperl-font-lock-keywords 'perl-font-lock-keywords)
- (funcall f 'cperl-font-lock-keywords-1 'perl-font-lock-keywords-1)
- (funcall f 'cperl-font-lock-keywords-2 'perl-font-lock-keywords-2)))
-
-(defvar cperl-use-major-mode 'perl-mode)
-(defvar cperl-font-lock-multiline-start nil)
-(defvar cperl-font-lock-multiline nil)
-(defvar cperl-compilation-error-regexp-alist nil)
-(defvar cperl-font-locking nil)
-
-;;;###autoload
-(defun cperl-mode ()
- "Major mode for editing Perl code.
-Expression and list commands understand all C brackets.
-Tab indents for Perl code.
-Paragraphs are separated by blank lines only.
-Delete converts tabs to spaces as it moves back.
-
-Various characters in Perl almost always come in pairs: {}, (), [],
-sometimes <>. When the user types the first, she gets the second as
-well, with optional special formatting done on {}. (Disabled by
-default.) You can always quote (with \\[quoted-insert]) the left
-\"paren\" to avoid the expansion. The processing of < is special,
-since most the time you mean \"less\". CPerl mode tries to guess
-whether you want to type pair <>, and inserts is if it
-appropriate. You can set `cperl-electric-parens-string' to the string that
-contains the parenths from the above list you want to be electrical.
-Electricity of parenths is controlled by `cperl-electric-parens'.
-You may also set `cperl-electric-parens-mark' to have electric parens
-look for active mark and \"embrace\" a region if possible.'
-
-CPerl mode provides expansion of the Perl control constructs:
-
- if, else, elsif, unless, while, until, continue, do,
- for, foreach, formy and foreachmy.
-
-and POD directives (Disabled by default, see `cperl-electric-keywords'.)
-
-The user types the keyword immediately followed by a space, which
-causes the construct to be expanded, and the point is positioned where
-she is most likely to want to be. eg. when the user types a space
-following \"if\" the following appears in the buffer: if () { or if ()
-} { } and the cursor is between the parentheses. The user can then
-type some boolean expression within the parens. Having done that,
-typing \\[cperl-linefeed] places you - appropriately indented - on a
-new line between the braces (if you typed \\[cperl-linefeed] in a POD
-directive line, then appropriate number of new lines is inserted).
-
-If CPerl decides that you want to insert \"English\" style construct like
-
- bite if angry;
-
-it will not do any expansion. See also help on variable
-`cperl-extra-newline-before-brace'. (Note that one can switch the
-help message on expansion by setting `cperl-message-electric-keyword'
-to nil.)
-
-\\[cperl-linefeed] is a convenience replacement for typing carriage
-return. It places you in the next line with proper indentation, or if
-you type it inside the inline block of control construct, like
-
- foreach (@lines) {print; print}
-
-and you are on a boundary of a statement inside braces, it will
-transform the construct into a multiline and will place you into an
-appropriately indented blank line. If you need a usual
-`newline-and-indent' behaviour, it is on \\[newline-and-indent],
-see documentation on `cperl-electric-linefeed'.
-
-Use \\[cperl-invert-if-unless] to change a construction of the form
-
- if (A) { B }
-
-into
-
- B if A;
-
-\\{cperl-mode-map}
-
-Setting the variable `cperl-font-lock' to t switches on font-lock-mode
-\(even with older Emacsen), `cperl-electric-lbrace-space' to t switches
-on electric space between $ and {, `cperl-electric-parens-string' is
-the string that contains parentheses that should be electric in CPerl
-\(see also `cperl-electric-parens-mark' and `cperl-electric-parens'),
-setting `cperl-electric-keywords' enables electric expansion of
-control structures in CPerl. `cperl-electric-linefeed' governs which
-one of two linefeed behavior is preferable. You can enable all these
-options simultaneously (recommended mode of use) by setting
-`cperl-hairy' to t. In this case you can switch separate options off
-by setting them to `null'. Note that one may undo the extra
-whitespace inserted by semis and braces in `auto-newline'-mode by
-consequent \\[cperl-electric-backspace].
-
-If your site has perl5 documentation in info format, you can use commands
-\\[cperl-info-on-current-command] and \\[cperl-info-on-command] to access it.
-These keys run commands `cperl-info-on-current-command' and
-`cperl-info-on-command', which one is which is controlled by variable
-`cperl-info-on-command-no-prompt' and `cperl-clobber-lisp-bindings'
-\(in turn affected by `cperl-hairy').
-
-Even if you have no info-format documentation, short one-liner-style
-help is available on \\[cperl-get-help], and one can run perldoc or
-man via menu.
-
-It is possible to show this help automatically after some idle time.
-This is regulated by variable `cperl-lazy-help-time'. Default with
-`cperl-hairy' (if the value of `cperl-lazy-help-time' is nil) is 5
-secs idle time . It is also possible to switch this on/off from the
-menu, or via \\[cperl-toggle-autohelp]. Requires `run-with-idle-timer'.
-
-Use \\[cperl-lineup] to vertically lineup some construction - put the
-beginning of the region at the start of construction, and make region
-span the needed amount of lines.
-
-Variables `cperl-pod-here-scan', `cperl-pod-here-fontify',
-`cperl-pod-face', `cperl-pod-head-face' control processing of POD and
-here-docs sections. With capable Emaxen results of scan are used
-for indentation too, otherwise they are used for highlighting only.
-
-Variables controlling indentation style:
- `cperl-tab-always-indent'
- Non-nil means TAB in CPerl mode should always reindent the current line,
- regardless of where in the line point is when the TAB command is used.
- `cperl-indent-left-aligned-comments'
- Non-nil means that the comment starting in leftmost column should indent.
- `cperl-auto-newline'
- Non-nil means automatically newline before and after braces,
- and after colons and semicolons, inserted in Perl code. The following
- \\[cperl-electric-backspace] will remove the inserted whitespace.
- Insertion after colons requires both this variable and
- `cperl-auto-newline-after-colon' set.
- `cperl-auto-newline-after-colon'
- Non-nil means automatically newline even after colons.
- Subject to `cperl-auto-newline' setting.
- `cperl-indent-level'
- Indentation of Perl statements within surrounding block.
- The surrounding block's indentation is the indentation
- of the line on which the open-brace appears.
- `cperl-continued-statement-offset'
- Extra indentation given to a substatement, such as the
- then-clause of an if, or body of a while, or just a statement continuation.
- `cperl-continued-brace-offset'
- Extra indentation given to a brace that starts a substatement.
- This is in addition to `cperl-continued-statement-offset'.
- `cperl-brace-offset'
- Extra indentation for line if it starts with an open brace.
- `cperl-brace-imaginary-offset'
- An open brace following other text is treated as if it the line started
- this far to the right of the actual line indentation.
- `cperl-label-offset'
- Extra indentation for line that is a label.
- `cperl-min-label-indent'
- Minimal indentation for line that is a label.
-
-Settings for classic indent-styles: K&R BSD=C++ GNU PerlStyle=Whitesmith
- `cperl-indent-level' 5 4 2 4
- `cperl-brace-offset' 0 0 0 0
- `cperl-continued-brace-offset' -5 -4 0 0
- `cperl-label-offset' -5 -4 -2 -4
- `cperl-continued-statement-offset' 5 4 2 4
-
-CPerl knows several indentation styles, and may bulk set the
-corresponding variables. Use \\[cperl-set-style] to do this. Use
-\\[cperl-set-style-back] to restore the memorized preexisting values
-\(both available from menu). See examples in `cperl-style-examples'.
-
-Part of the indentation style is how different parts of if/elsif/else
-statements are broken into lines; in CPerl, this is reflected on how
-templates for these constructs are created (controlled by
-`cperl-extra-newline-before-brace'), and how reflow-logic should treat \"continuation\" blocks of else/elsif/continue, controlled by the same variable,
-and by `cperl-extra-newline-before-brace-multiline',
-`cperl-merge-trailing-else', `cperl-indent-region-fix-constructs'.
-
-If `cperl-indent-level' is 0, the statement after opening brace in
-column 0 is indented on
-`cperl-brace-offset'+`cperl-continued-statement-offset'.
-
-Turning on CPerl mode calls the hooks in the variable `cperl-mode-hook'
-with no args.
-
-DO NOT FORGET to read micro-docs (available from `Perl' menu)
-or as help on variables `cperl-tips', `cperl-problems',
-`cperl-non-problems', `cperl-praise', `cperl-speed'."
- (interactive)
- (kill-all-local-variables)
- (use-local-map cperl-mode-map)
- (if (cperl-val 'cperl-electric-linefeed)
- (progn
- (local-set-key "\C-J" 'cperl-linefeed)
- (local-set-key "\C-C\C-J" 'newline-and-indent)))
- (if (and
- (cperl-val 'cperl-clobber-lisp-bindings)
- (cperl-val 'cperl-info-on-command-no-prompt))
- (progn
- ;; don't clobber the backspace binding:
- (cperl-define-key "\C-hf" 'cperl-info-on-current-command [(control h) f])
- (cperl-define-key "\C-c\C-hf" 'cperl-info-on-command
- [(control c) (control h) f])))
- (setq major-mode cperl-use-major-mode)
- (setq mode-name "CPerl")
- (if (not cperl-mode-abbrev-table)
- (let ((prev-a-c abbrevs-changed))
- (define-abbrev-table 'cperl-mode-abbrev-table '(
- ("if" "if" cperl-electric-keyword 0)
- ("elsif" "elsif" cperl-electric-keyword 0)
- ("while" "while" cperl-electric-keyword 0)
- ("until" "until" cperl-electric-keyword 0)
- ("unless" "unless" cperl-electric-keyword 0)
- ("else" "else" cperl-electric-else 0)
- ("continue" "continue" cperl-electric-else 0)
- ("for" "for" cperl-electric-keyword 0)
- ("foreach" "foreach" cperl-electric-keyword 0)
- ("formy" "formy" cperl-electric-keyword 0)
- ("foreachmy" "foreachmy" cperl-electric-keyword 0)
- ("do" "do" cperl-electric-keyword 0)
- ("=pod" "=pod" cperl-electric-pod 0)
- ("=over" "=over" cperl-electric-pod 0)
- ("=head1" "=head1" cperl-electric-pod 0)
- ("=head2" "=head2" cperl-electric-pod 0)
- ("pod" "pod" cperl-electric-pod 0)
- ("over" "over" cperl-electric-pod 0)
- ("head1" "head1" cperl-electric-pod 0)
- ("head2" "head2" cperl-electric-pod 0)))
- (setq abbrevs-changed prev-a-c)))
- (setq local-abbrev-table cperl-mode-abbrev-table)
- (if (cperl-val 'cperl-electric-keywords)
- (abbrev-mode 1))
- (set-syntax-table cperl-mode-syntax-table)
- ;; Until Emacs is multi-threaded, we do not actually need it local:
- (make-local-variable 'cperl-font-lock-multiline-start)
- (make-local-variable 'cperl-font-locking)
- (make-local-variable 'outline-regexp)
- ;; (setq outline-regexp imenu-example--function-name-regexp-perl)
- (setq outline-regexp cperl-outline-regexp)
- (make-local-variable 'outline-level)
- (setq outline-level 'cperl-outline-level)
- (make-local-variable 'paragraph-start)
- (setq paragraph-start (concat "^$\\|" page-delimiter))
- (make-local-variable 'paragraph-separate)
- (setq paragraph-separate paragraph-start)
- (make-local-variable 'paragraph-ignore-fill-prefix)
- (setq paragraph-ignore-fill-prefix t)
- (if cperl-xemacs-p
- (progn
- (make-local-variable 'paren-backwards-message)
- (set 'paren-backwards-message t)))
- (make-local-variable 'indent-line-function)
- (setq indent-line-function 'cperl-indent-line)
- (make-local-variable 'require-final-newline)
- (setq require-final-newline t)
- (make-local-variable 'comment-start)
- (setq comment-start "# ")
- (make-local-variable 'comment-end)
- (setq comment-end "")
- (make-local-variable 'comment-column)
- (setq comment-column cperl-comment-column)
- (make-local-variable 'comment-start-skip)
- (setq comment-start-skip "#+ *")
- (make-local-variable 'defun-prompt-regexp)
-;;; "[ \t]*sub"
-;;; (cperl-after-sub-regexp 'named nil) ; 8=name 11=proto 14=attr-start
-;;; cperl-maybe-white-and-comment-rex ; 15=pre-block
- (setq defun-prompt-regexp
- (concat "[ \t]*\\(sub"
- (cperl-after-sub-regexp 'named 'attr-groups)
- "\\|" ; per toke.c
- "\\(BEGIN\\|CHECK\\|INIT\\|END\\|AUTOLOAD\\|DESTROY\\)"
- "\\)"
- cperl-maybe-white-and-comment-rex))
- (make-local-variable 'comment-indent-function)
- (setq comment-indent-function 'cperl-comment-indent)
- (and (boundp 'fill-paragraph-function)
- (progn
- (make-local-variable 'fill-paragraph-function)
- (set 'fill-paragraph-function 'cperl-fill-paragraph)))
- (make-local-variable 'parse-sexp-ignore-comments)
- (setq parse-sexp-ignore-comments t)
- (make-local-variable 'indent-region-function)
- (setq indent-region-function 'cperl-indent-region)
- ;;(setq auto-fill-function 'cperl-do-auto-fill) ; Need to switch on and off!
- (make-local-variable 'imenu-create-index-function)
- (setq imenu-create-index-function
- (function cperl-imenu--create-perl-index))
- (make-local-variable 'imenu-sort-function)
- (setq imenu-sort-function nil)
- (make-local-variable 'vc-rcs-header)
- (set 'vc-rcs-header cperl-vc-rcs-header)
- (make-local-variable 'vc-sccs-header)
- (set 'vc-sccs-header cperl-vc-sccs-header)
- ;; This one is obsolete...
- (make-local-variable 'vc-header-alist)
- (set 'vc-header-alist (or cperl-vc-header-alist ; Avoid warning
- (` ((SCCS (, (car cperl-vc-sccs-header)))
- (RCS (, (car cperl-vc-rcs-header)))))))
- (cond ((boundp 'compilation-error-regexp-alist-alist);; xemacs 20.x
- (make-local-variable 'compilation-error-regexp-alist-alist)
- (set 'compilation-error-regexp-alist-alist
- (cons (cons 'cperl cperl-compilation-error-regexp-alist)
- (symbol-value 'compilation-error-regexp-alist-alist)))
- (let ((f 'compilation-build-compilation-error-regexp-alist))
- (funcall f)))
- ((boundp 'compilation-error-regexp-alist);; xmeacs 19.x
- (make-local-variable 'compilation-error-regexp-alist)
- (set 'compilation-error-regexp-alist
- (cons cperl-compilation-error-regexp-alist
- (symbol-value 'compilation-error-regexp-alist)))))
- (make-local-variable 'font-lock-defaults)
- (setq font-lock-defaults
- (cond
- ((string< emacs-version "19.30")
- '(perl-font-lock-keywords-2 nil nil ((?_ . "w"))))
- ((string< emacs-version "19.33") ; Which one to use?
- '((perl-font-lock-keywords
- perl-font-lock-keywords-1
- perl-font-lock-keywords-2) nil nil ((?_ . "w"))))
- (t
- '((cperl-load-font-lock-keywords
- cperl-load-font-lock-keywords-1
- cperl-load-font-lock-keywords-2) nil nil ((?_ . "w"))))))
- (make-local-variable 'cperl-syntax-state)
- (setq cperl-syntax-state nil) ; reset syntaxification cache
- (if cperl-use-syntax-table-text-property
- (progn
- (make-local-variable 'parse-sexp-lookup-properties)
- ;; Do not introduce variable if not needed, we check it!
- (set 'parse-sexp-lookup-properties t)
- ;; Fix broken font-lock:
- (or (boundp 'font-lock-unfontify-region-function)
- (set 'font-lock-unfontify-region-function
- 'font-lock-default-unfontify-region))
- (unless cperl-xemacs-p ; Our: just a plug for wrong font-lock
- (make-local-variable 'font-lock-unfontify-region-function)
- (set 'font-lock-unfontify-region-function ; not present with old Emacs
- 'cperl-font-lock-unfontify-region-function))
- (make-local-variable 'cperl-syntax-done-to)
- (setq cperl-syntax-done-to nil) ; reset syntaxification cache
- ;; Another bug: unless font-lock-syntactic-keywords, font-lock
- ;; ignores syntax-table text-property. (t) is a hack
- ;; to make font-lock think that font-lock-syntactic-keywords
- ;; are defined
- (make-local-variable 'font-lock-syntactic-keywords)
- (setq font-lock-syntactic-keywords
- (if cperl-syntaxify-by-font-lock
- '(t (cperl-fontify-syntaxically))
- '(t)))))
- (if (boundp 'font-lock-multiline) ; Newer font-lock; use its facilities
- (progn
- (setq cperl-font-lock-multiline t) ; Not localized...
- (set (make-local-variable 'font-lock-multiline) t))
- (make-local-variable 'font-lock-fontify-region-function)
- (set 'font-lock-fontify-region-function ; not present with old Emacs
- 'cperl-font-lock-fontify-region-function))
- (make-local-variable 'font-lock-fontify-region-function)
- (set 'font-lock-fontify-region-function ; not present with old Emacs
- 'cperl-font-lock-fontify-region-function)
- (make-local-variable 'cperl-old-style)
- (if (boundp 'normal-auto-fill-function) ; 19.33 and later
- (set (make-local-variable 'normal-auto-fill-function)
- 'cperl-do-auto-fill) ; RMS has it as #'cperl-do-auto-fill ???
- (or (fboundp 'cperl-old-auto-fill-mode)
- (progn
- (fset 'cperl-old-auto-fill-mode (symbol-function 'auto-fill-mode))
- (defun auto-fill-mode (&optional arg)
- (interactive "P")
- (eval '(cperl-old-auto-fill-mode arg)) ; Avoid a warning
- (and auto-fill-function (memq major-mode '(perl-mode cperl-mode))
- (setq auto-fill-function 'cperl-do-auto-fill))))))
- (if (cperl-enable-font-lock)
- (if (cperl-val 'cperl-font-lock)
- (progn (or cperl-faces-init (cperl-init-faces))
- (font-lock-mode 1))))
- (set (make-local-variable 'facemenu-add-face-function)
- 'cperl-facemenu-add-face-function) ; XXXX What this guy is for???
- (and (boundp 'msb-menu-cond)
- (not cperl-msb-fixed)
- (cperl-msb-fix))
- (if (featurep 'easymenu)
- (easy-menu-add cperl-menu)) ; A NOP in RMS Emacs.
- (run-hooks 'cperl-mode-hook)
- (if cperl-hook-after-change
- (progn
- (make-local-hook 'after-change-functions)
- (add-hook 'after-change-functions 'cperl-after-change-function nil t)))
- ;; After hooks since fontification will break this
- (if cperl-pod-here-scan
- (or cperl-syntaxify-by-font-lock
- (progn (or cperl-faces-init (cperl-init-faces-weak))
- (cperl-find-pods-heres)))))
-\f
-;; Fix for perldb - make default reasonable
-(defun cperl-db ()
- (interactive)
- (require 'gud)
- (perldb (read-from-minibuffer "Run perldb (like this): "
- (if (consp gud-perldb-history)
- (car gud-perldb-history)
- (concat "perl " ;;(file-name-nondirectory
- ;; I have problems
- ;; in OS/2
- ;; otherwise
- (buffer-file-name)))
- nil nil
- '(gud-perldb-history . 1))))
-\f
-(defun cperl-msb-fix ()
- ;; Adds perl files to msb menu, supposes that msb is already loaded
- (setq cperl-msb-fixed t)
- (let* ((l (length msb-menu-cond))
- (last (nth (1- l) msb-menu-cond))
- (precdr (nthcdr (- l 2) msb-menu-cond)) ; cdr of this is last
- (handle (1- (nth 1 last))))
- (setcdr precdr (list
- (list
- '(memq major-mode '(cperl-mode perl-mode))
- handle
- "Perl Files (%d)")
- last))))
-\f
-;; This is used by indent-for-comment
-;; to decide how much to indent a comment in CPerl code
-;; based on its context. Do fallback if comment is found wrong.
-
-(defvar cperl-wrong-comment)
-(defvar cperl-st-cfence '(14)) ; Comment-fence
-(defvar cperl-st-sfence '(15)) ; String-fence
-(defvar cperl-st-punct '(1))
-(defvar cperl-st-word '(2))
-(defvar cperl-st-bra '(4 . ?\>))
-(defvar cperl-st-ket '(5 . ?\<))
-
-
-(defun cperl-comment-indent () ; called at point at supposed comment
- (let ((p (point)) (c (current-column)) was phony)
- (if (and (not cperl-indent-comment-at-column-0)
- (looking-at "^#"))
- 0 ; Existing comment at bol stays there.
- ;; Wrong comment found
- (save-excursion
- (setq was (cperl-to-comment-or-eol)
- phony (eq (get-text-property (point) 'syntax-table)
- cperl-st-cfence))
- (if phony
- (progn ; Too naive???
- (re-search-forward "#\\|$") ; Hmm, what about embedded #?
- (if (eq (preceding-char) ?\#)
- (forward-char -1))
- (setq was nil)))
- (if (= (point) p) ; Our caller found a correct place
- (progn
- (skip-chars-backward " \t")
- (setq was (current-column))
- (if (eq was 0)
- comment-column
- (max (1+ was) ; Else indent at comment column
- comment-column)))
- ;; No, the caller found a random place; we need to edit ourselves
- (if was nil
- (insert comment-start)
- (backward-char (length comment-start)))
- (setq cperl-wrong-comment t)
- (cperl-make-indent comment-column 1) ; Indent min 1
- c)))))
-
-;;;(defun cperl-comment-indent-fallback ()
-;;; "Is called if the standard comment-search procedure fails.
-;;;Point is at start of real comment."
-;;; (let ((c (current-column)) target cnt prevc)
-;;; (if (= c comment-column) nil
-;;; (setq cnt (skip-chars-backward "[ \t]"))
-;;; (setq target (max (1+ (setq prevc
-;;; (current-column))) ; Else indent at comment column
-;;; comment-column))
-;;; (if (= c comment-column) nil
-;;; (delete-backward-char cnt)
-;;; (while (< prevc target)
-;;; (insert "\t")
-;;; (setq prevc (current-column)))
-;;; (if (> prevc target) (progn (delete-char -1) (setq prevc (current-column))))
-;;; (while (< prevc target)
-;;; (insert " ")
-;;; (setq prevc (current-column)))))))
-
-(defun cperl-indent-for-comment ()
- "Substitute for `indent-for-comment' in CPerl."
- (interactive)
- (let (cperl-wrong-comment)
- (indent-for-comment)
- (if cperl-wrong-comment ; set by `cperl-comment-indent'
- (progn (cperl-to-comment-or-eol)
- (forward-char (length comment-start))))))
-
-(defun cperl-comment-region (b e arg)
- "Comment or uncomment each line in the region in CPerl mode.
-See `comment-region'."
- (interactive "r\np")
- (let ((comment-start "#"))
- (comment-region b e arg)))
-
-(defun cperl-uncomment-region (b e arg)
- "Uncomment or comment each line in the region in CPerl mode.
-See `comment-region'."
- (interactive "r\np")
- (let ((comment-start "#"))
- (comment-region b e (- arg))))
-
-(defvar cperl-brace-recursing nil)
-
-(defun cperl-electric-brace (arg &optional only-before)
- "Insert character and correct line's indentation.
-If ONLY-BEFORE and `cperl-auto-newline', will insert newline before the
-place (even in empty line), but not after. If after \")\" and the inserted
-char is \"{\", insert extra newline before only if
-`cperl-extra-newline-before-brace'."
- (interactive "P")
- (let (insertpos
- (other-end (if (and cperl-electric-parens-mark
- (cperl-mark-active)
- (< (mark) (point)))
- (mark)
- nil)))
- (if (and other-end
- (not cperl-brace-recursing)
- (cperl-val 'cperl-electric-parens)
- (>= (save-excursion (cperl-to-comment-or-eol) (point)) (point)))
- ;; Need to insert a matching pair
- (progn
- (save-excursion
- (setq insertpos (point-marker))
- (goto-char other-end)
- (setq last-command-char ?\{)
- (cperl-electric-lbrace arg insertpos))
- (forward-char 1))
- ;; Check whether we close something "usual" with `}'
- (if (and (eq last-command-char ?\})
- (not
- (condition-case nil
- (save-excursion
- (up-list (- (prefix-numeric-value arg)))
- ;;(cperl-after-block-p (point-min))
- (or (cperl-after-expr-p nil "{;)")
- ;; after sub, else, continue
- (cperl-after-block-p nil 'pre)))
- (error nil))))
- ;; Just insert the guy
- (self-insert-command (prefix-numeric-value arg))
- (if (and (not arg) ; No args, end (of empty line or auto)
- (eolp)
- (or (and (null only-before)
- (save-excursion
- (skip-chars-backward " \t")
- (bolp)))
- (and (eq last-command-char ?\{) ; Do not insert newline
- ;; if after ")" and `cperl-extra-newline-before-brace'
- ;; is nil, do not insert extra newline.
- (not cperl-extra-newline-before-brace)
- (save-excursion
- (skip-chars-backward " \t")
- (eq (preceding-char) ?\))))
- (if cperl-auto-newline
- (progn (cperl-indent-line) (newline) t) nil)))
- (progn
- (self-insert-command (prefix-numeric-value arg))
- (cperl-indent-line)
- (if cperl-auto-newline
- (setq insertpos (1- (point))))
- (if (and cperl-auto-newline (null only-before))
- (progn
- (newline)
- (cperl-indent-line)))
- (save-excursion
- (if insertpos (progn (goto-char insertpos)
- (search-forward (make-string
- 1 last-command-char))
- (setq insertpos (1- (point)))))
- (delete-char -1))))
- (if insertpos
- (save-excursion
- (goto-char insertpos)
- (self-insert-command (prefix-numeric-value arg)))
- (self-insert-command (prefix-numeric-value arg)))))))
-
-(defun cperl-electric-lbrace (arg &optional end)
- "Insert character, correct line's indentation, correct quoting by space."
- (interactive "P")
- (let ((cperl-brace-recursing t)
- (cperl-auto-newline cperl-auto-newline)
- (other-end (or end
- (if (and cperl-electric-parens-mark
- (cperl-mark-active)
- (> (mark) (point)))
- (save-excursion
- (goto-char (mark))
- (point-marker))
- nil)))
- pos after)
- (and (cperl-val 'cperl-electric-lbrace-space)
- (eq (preceding-char) ?$)
- (save-excursion
- (skip-chars-backward "$")
- (looking-at "\\(\\$\\$\\)*\\$\\([^\\$]\\|$\\)"))
- (insert ?\ ))
- ;; Check whether we are in comment
- (if (and
- (save-excursion
- (beginning-of-line)
- (not (looking-at "[ \t]*#")))
- (cperl-after-expr-p nil "{;)"))
- nil
- (setq cperl-auto-newline nil))
- (cperl-electric-brace arg)
- (and (cperl-val 'cperl-electric-parens)
- (eq last-command-char ?{)
- (memq last-command-char
- (append cperl-electric-parens-string nil))
- (or (if other-end (goto-char (marker-position other-end)))
- t)
- (setq last-command-char ?} pos (point))
- (progn (cperl-electric-brace arg t)
- (goto-char pos)))))
-
-(defun cperl-electric-paren (arg)
- "Insert an opening parenthesis or a matching pair of parentheses.
-See `cperl-electric-parens'."
- (interactive "P")
- (let ((beg (save-excursion (beginning-of-line) (point)))
- (other-end (if (and cperl-electric-parens-mark
- (cperl-mark-active)
- (> (mark) (point)))
- (save-excursion
- (goto-char (mark))
- (point-marker))
- nil)))
- (if (and (cperl-val 'cperl-electric-parens)
- (memq last-command-char
- (append cperl-electric-parens-string nil))
- (>= (save-excursion (cperl-to-comment-or-eol) (point)) (point))
- ;;(not (save-excursion (search-backward "#" beg t)))
- (if (eq last-command-char ?<)
- (progn
- (and abbrev-mode ; later it is too late, may be after `for'
- (expand-abbrev))
- (cperl-after-expr-p nil "{;(,:="))
- 1))
- (progn
- (self-insert-command (prefix-numeric-value arg))
- (if other-end (goto-char (marker-position other-end)))
- (insert (make-string
- (prefix-numeric-value arg)
- (cdr (assoc last-command-char '((?{ .?})
- (?[ . ?])
- (?( . ?))
- (?< . ?>))))))
- (forward-char (- (prefix-numeric-value arg))))
- (self-insert-command (prefix-numeric-value arg)))))
-
-(defun cperl-electric-rparen (arg)
- "Insert a matching pair of parentheses if marking is active.
-If not, or if we are not at the end of marking range, would self-insert.
-Affected by `cperl-electric-parens'."
- (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)
- nil))
- p)
- (if (and other-end
- (cperl-val 'cperl-electric-parens)
- (memq last-command-char '( ?\) ?\] ?\} ?\> ))
- (>= (save-excursion (cperl-to-comment-or-eol) (point)) (point))
- ;;(not (save-excursion (search-backward "#" beg t)))
- )
- (progn
- (self-insert-command (prefix-numeric-value arg))
- (setq p (point))
- (if other-end (goto-char other-end))
- (insert (make-string
- (prefix-numeric-value arg)
- (cdr (assoc last-command-char '((?\} . ?\{)
- (?\] . ?\[)
- (?\) . ?\()
- (?\> . ?\<))))))
- (goto-char (1+ p)))
- (self-insert-command (prefix-numeric-value arg)))))
-
-(defun cperl-electric-keyword ()
- "Insert a construction appropriate after a keyword.
-Help message may be switched off by setting `cperl-message-electric-keyword'
-to nil."
- (let ((beg (save-excursion (beginning-of-line) (point)))
- (dollar (and (eq last-command-char ?$)
- (eq this-command 'self-insert-command)))
- (delete (and (memq last-command-char '(?\ ?\n ?\t ?\f))
- (memq this-command '(self-insert-command newline))))
- my do)
- (and (save-excursion
- (condition-case nil
- (progn
- (backward-sexp 1)
- (setq do (looking-at "do\\>")))
- (error nil))
- (cperl-after-expr-p nil "{;:"))
- (save-excursion
- (not
- (re-search-backward
- "[#\"'`]\\|\\<q\\(\\|[wqxr]\\)\\>"
- beg t)))
- (save-excursion (or (not (re-search-backward "^=" nil t))
- (or
- (looking-at "=cut")
- (and cperl-use-syntax-table-text-property
- (not (eq (get-text-property (point)
- 'syntax-type)
- 'pod))))))
- (save-excursion (forward-sexp -1)
- (not (memq (following-char) (append "$@%&*" nil))))
- (progn
- (and (eq (preceding-char) ?y)
- (progn ; "foreachmy"
- (forward-char -2)
- (insert " ")
- (forward-char 2)
- (setq my t dollar t
- delete
- (memq this-command '(self-insert-command newline)))))
- (and dollar (insert " $"))
- (cperl-indent-line)
- ;;(insert " () {\n}")
- (cond
- (cperl-extra-newline-before-brace
- (insert (if do "\n" " ()\n"))
- (insert "{")
- (cperl-indent-line)
- (insert "\n")
- (cperl-indent-line)
- (insert "\n}")
- (and do (insert " while ();")))
- (t
- (insert (if do " {\n} while ();" " () {\n}"))))
- (or (looking-at "[ \t]\\|$") (insert " "))
- (cperl-indent-line)
- (if dollar (progn (search-backward "$")
- (if my
- (forward-char 1)
- (delete-char 1)))
- (search-backward ")")
- (if (eq last-command-char ?\()
- (progn ; Avoid "if (())"
- (delete-backward-char 1)
- (delete-backward-char -1))))
- (if delete
- (cperl-putback-char cperl-del-back-ch))
- (if cperl-message-electric-keyword
- (message "Precede char by C-q to avoid expansion"))))))
-
-(defun cperl-ensure-newlines (n &optional pos)
- "Make sure there are N newlines after the point."
- (or pos (setq pos (point)))
- (if (looking-at "\n")
- (forward-char 1)
- (insert "\n"))
- (if (> n 1)
- (cperl-ensure-newlines (1- n) pos)
- (goto-char pos)))
-
-(defun cperl-electric-pod ()
- "Insert a POD chunk appropriate after a =POD directive."
- (let ((delete (and (memq last-command-char '(?\ ?\n ?\t ?\f))
- (memq this-command '(self-insert-command newline))))
- head1 notlast name p really-delete over)
- (and (save-excursion
- (forward-word -1)
- (and
- (eq (preceding-char) ?=)
- (progn
- (setq head1 (looking-at "head1\\>[ \t]*$"))
- (setq over (and (looking-at "over\\>[ \t]*$")
- (not (looking-at "over[ \t]*\n\n\n*=item\\>"))))
- (forward-char -1)
- (bolp))
- (or
- (get-text-property (point) 'in-pod)
- (cperl-after-expr-p nil "{;:")
- (and (re-search-backward "\\(\\`\n?\\|^\n\\)=\\sw+" (point-min) t)
- (not (looking-at "\n*=cut"))
- (or (not cperl-use-syntax-table-text-property)
- (eq (get-text-property (point) 'syntax-type) 'pod))))))
- (progn
- (save-excursion
- (setq notlast (re-search-forward "^\n=" nil t)))
- (or notlast
- (progn
- (insert "\n\n=cut")
- (cperl-ensure-newlines 2)
- (forward-word -2)
- (if (and head1
- (not
- (save-excursion
- (forward-char -1)
- (re-search-backward "\\(\\`\n?\\|\n\n\\)=head1\\>"
- nil t)))) ; Only one
- (progn
- (forward-word 1)
- (setq name (file-name-sans-extension
- (file-name-nondirectory (buffer-file-name)))
- p (point))
- (insert " NAME\n\n" name
- " - \n\n=head1 SYNOPSIS\n\n\n\n"
- "=head1 DESCRIPTION")
- (cperl-ensure-newlines 4)
- (goto-char p)
- (forward-word 2)
- (end-of-line)
- (setq really-delete t))
- (forward-word 1))))
- (if over
- (progn
- (setq p (point))
- (insert "\n\n=item \n\n\n\n"
- "=back")
- (cperl-ensure-newlines 2)
- (goto-char p)
- (forward-word 1)
- (end-of-line)
- (setq really-delete t)))
- (if (and delete really-delete)
- (cperl-putback-char cperl-del-back-ch))))))
-
-(defun cperl-electric-else ()
- "Insert a construction appropriate after a keyword.
-Help message may be switched off by setting `cperl-message-electric-keyword'
-to nil."
- (let ((beg (save-excursion (beginning-of-line) (point))))
- (and (save-excursion
- (backward-sexp 1)
- (cperl-after-expr-p nil "{;:"))
- (save-excursion
- (not
- (re-search-backward
- "[#\"'`]\\|\\<q\\(\\|[wqxr]\\)\\>"
- beg t)))
- (save-excursion (or (not (re-search-backward "^=" nil t))
- (looking-at "=cut")
- (and cperl-use-syntax-table-text-property
- (not (eq (get-text-property (point)
- 'syntax-type)
- 'pod)))))
- (progn
- (cperl-indent-line)
- ;;(insert " {\n\n}")
- (cond
- (cperl-extra-newline-before-brace
- (insert "\n")
- (insert "{")
- (cperl-indent-line)
- (insert "\n\n}"))
- (t
- (insert " {\n\n}")))
- (or (looking-at "[ \t]\\|$") (insert " "))
- (cperl-indent-line)
- (forward-line -1)
- (cperl-indent-line)
- (cperl-putback-char cperl-del-back-ch)
- (setq this-command 'cperl-electric-else)
- (if cperl-message-electric-keyword
- (message "Precede char by C-q to avoid expansion"))))))
-
-(defun cperl-linefeed ()
- "Go to end of line, open a new line and indent appropriately.
-If in POD, insert appropriate lines."
- (interactive)
- (let ((beg (save-excursion (beginning-of-line) (point)))
- (end (save-excursion (end-of-line) (point)))
- (pos (point)) start over cut res)
- (if (and ; Check if we need to split:
- ; i.e., on a boundary and inside "{...}"
- (save-excursion (cperl-to-comment-or-eol)
- (>= (point) pos)) ; Not in a comment
- (or (save-excursion
- (skip-chars-backward " \t" beg)
- (forward-char -1)
- (looking-at "[;{]")) ; After { or ; + spaces
- (looking-at "[ \t]*}") ; Before }
- (re-search-forward "\\=[ \t]*;" end t)) ; Before spaces + ;
- (save-excursion
- (and
- (eq (car (parse-partial-sexp pos end -1)) -1)
- ; Leave the level of parens
- (looking-at "[,; \t]*\\($\\|#\\)") ; Comma to allow anon subr
- ; Are at end
- (cperl-after-block-p (point-min))
- (progn
- (backward-sexp 1)
- (setq start (point-marker))
- (<= start pos))))) ; Redundant? Are after the
- ; start of parens group.
- (progn
- (skip-chars-backward " \t")
- (or (memq (preceding-char) (append ";{" nil))
- (insert ";"))
- (insert "\n")
- (forward-line -1)
- (cperl-indent-line)
- (goto-char start)
- (or (looking-at "{[ \t]*$") ; If there is a statement
- ; before, move it to separate line
- (progn
- (forward-char 1)
- (insert "\n")
- (cperl-indent-line)))
- (forward-line 1) ; We are on the target line
- (cperl-indent-line)
- (beginning-of-line)
- (or (looking-at "[ \t]*}[,; \t]*$") ; If there is a statement
- ; after, move it to separate line
- (progn
- (end-of-line)
- (search-backward "}" beg)
- (skip-chars-backward " \t")
- (or (memq (preceding-char) (append ";{" nil))
- (insert ";"))
- (insert "\n")
- (cperl-indent-line)
- (forward-line -1)))
- (forward-line -1) ; We are on the line before target
- (end-of-line)
- (newline-and-indent))
- (end-of-line) ; else - no splitting
- (cond
- ((and (looking-at "\n[ \t]*{$")
- (save-excursion
- (skip-chars-backward " \t")
- (eq (preceding-char) ?\)))) ; Probably if () {} group
- ; with an extra newline.
- (forward-line 2)
- (cperl-indent-line))
- ((save-excursion ; In POD header
- (forward-paragraph -1)
- ;; (re-search-backward "\\(\\`\n?\\|\n\n\\)=head1\\b")
- ;; We are after \n now, so look for the rest
- (if (looking-at "\\(\\`\n?\\|\n\\)=\\sw+")
- (progn
- (setq cut (looking-at "\\(\\`\n?\\|\n\\)=cut\\>"))
- (setq over (looking-at "\\(\\`\n?\\|\n\\)=over\\>"))
- t)))
- (if (and over
- (progn
- (forward-paragraph -1)
- (forward-word 1)
- (setq pos (point))
- (setq cut (buffer-substring (point)
- (save-excursion
- (end-of-line)
- (point))))
- (delete-char (- (save-excursion (end-of-line) (point))
- (point)))
- (setq res (expand-abbrev))
- (save-excursion
- (goto-char pos)
- (insert cut))
- res))
- nil
- (cperl-ensure-newlines (if cut 2 4))
- (forward-line 2)))
- ((get-text-property (point) 'in-pod) ; In POD section
- (cperl-ensure-newlines 4)
- (forward-line 2))
- ((looking-at "\n[ \t]*$") ; Next line is empty - use it.
- (forward-line 1)
- (cperl-indent-line))
- (t
- (newline-and-indent))))))
-
-(defun cperl-electric-semi (arg)
- "Insert character and correct line's indentation."
- (interactive "P")
- (if cperl-auto-newline
- (cperl-electric-terminator arg)
- (self-insert-command (prefix-numeric-value arg))
- (if cperl-autoindent-on-semi
- (cperl-indent-line))))
-
-(defun cperl-electric-terminator (arg)
- "Insert character and correct line's indentation."
- (interactive "P")
- (let ((end (point))
- (auto (and cperl-auto-newline
- (or (not (eq last-command-char ?:))
- cperl-auto-newline-after-colon)))
- insertpos)
- (if (and ;;(not arg)
- (eolp)
- (not (save-excursion
- (beginning-of-line)
- (skip-chars-forward " \t")
- (or
- ;; Ignore in comment lines
- (= (following-char) ?#)
- ;; Colon is special only after a label
- ;; So quickly rule out most other uses of colon
- ;; and do no indentation for them.
- (and (eq last-command-char ?:)
- (save-excursion
- (forward-word 1)
- (skip-chars-forward " \t")
- (and (< (point) end)
- (progn (goto-char (- end 1))
- (not (looking-at ":"))))))
- (progn
- (beginning-of-defun)
- (let ((pps (parse-partial-sexp (point) end)))
- (or (nth 3 pps) (nth 4 pps) (nth 5 pps))))))))
- (progn
- (self-insert-command (prefix-numeric-value arg))
- ;;(forward-char -1)
- (if auto (setq insertpos (point-marker)))
- ;;(forward-char 1)
- (cperl-indent-line)
- (if auto
- (progn
- (newline)
- (cperl-indent-line)))
- (save-excursion
- (if insertpos (goto-char (1- (marker-position insertpos)))
- (forward-char -1))
- (delete-char 1))))
- (if insertpos
- (save-excursion
- (goto-char insertpos)
- (self-insert-command (prefix-numeric-value arg)))
- (self-insert-command (prefix-numeric-value arg)))))
-
-(defun cperl-electric-backspace (arg)
- "Backspace, or remove the whitespace around the point inserted by an electric
-key. Will untabivy if `cperl-electric-backspace-untabify' is non-nil."
- (interactive "p")
- (if (and cperl-auto-newline
- (memq last-command '(cperl-electric-semi
- cperl-electric-terminator
- cperl-electric-lbrace))
- (memq (preceding-char) '(?\ ?\t ?\n)))
- (let (p)
- (if (eq last-command 'cperl-electric-lbrace)
- (skip-chars-forward " \t\n"))
- (setq p (point))
- (skip-chars-backward " \t\n")
- (delete-region (point) p))
- (and (eq last-command 'cperl-electric-else)
- ;; We are removing the whitespace *inside* cperl-electric-else
- (setq this-command 'cperl-electric-else-really))
- (if (and cperl-auto-newline
- (eq last-command 'cperl-electric-else-really)
- (memq (preceding-char) '(?\ ?\t ?\n)))
- (let (p)
- (skip-chars-forward " \t\n")
- (setq p (point))
- (skip-chars-backward " \t\n")
- (delete-region (point) p))
- (if cperl-electric-backspace-untabify
- (backward-delete-char-untabify arg)
- (delete-backward-char arg)))))
-
-(defun cperl-inside-parens-p () ;; NOT USED????
- (condition-case ()
- (save-excursion
- (save-restriction
- (narrow-to-region (point)
- (progn (beginning-of-defun) (point)))
- (goto-char (point-max))
- (= (char-after (or (scan-lists (point) -1 1) (point-min))) ?\()))
- (error nil)))
-\f
-(defun cperl-indent-command (&optional whole-exp)
- "Indent current line as Perl code, or in some cases insert a tab character.
-If `cperl-tab-always-indent' is non-nil (the default), always indent current
-line. Otherwise, indent the current line only if point is at the left margin
-or in the line's indentation; otherwise insert a tab.
-
-A numeric argument, regardless of its value,
-means indent rigidly all the lines of the expression starting after point
-so that this line becomes properly indented.
-The relative indentation among the lines of the expression are preserved."
- (interactive "P")
- (cperl-update-syntaxification (point) (point))
- (if whole-exp
- ;; If arg, always indent this line as Perl
- ;; and shift remaining lines of expression the same amount.
- (let ((shift-amt (cperl-indent-line))
- beg end)
- (save-excursion
- (if cperl-tab-always-indent
- (beginning-of-line))
- (setq beg (point))
- (forward-sexp 1)
- (setq end (point))
- (goto-char beg)
- (forward-line 1)
- (setq beg (point)))
- (if (and shift-amt (> end beg))
- (indent-code-rigidly beg end shift-amt "#")))
- (if (and (not cperl-tab-always-indent)
- (save-excursion
- (skip-chars-backward " \t")
- (not (bolp))))
- (insert-tab)
- (cperl-indent-line))))
-
-(defun cperl-indent-line (&optional parse-data)
- "Indent current line as Perl code.
-Return the amount the indentation changed by."
- (let ((case-fold-search nil)
- (pos (- (point-max) (point)))
- indent i beg shift-amt)
- (setq indent (cperl-calculate-indent parse-data)
- i indent)
- (beginning-of-line)
- (setq beg (point))
- (cond ((or (eq indent nil) (eq indent t))
- (setq indent (current-indentation) i nil))
- ;;((eq indent t) ; Never?
- ;; (setq indent (cperl-calculate-indent-within-comment)))
- ;;((looking-at "[ \t]*#")
- ;; (setq indent 0))
- (t
- (skip-chars-forward " \t")
- (if (listp indent) (setq indent (car indent)))
- (cond ((and (looking-at "[A-Za-z_][A-Za-z_0-9]*:[^:]")
- (not (looking-at "[smy]:\\|tr:")))
- (and (> indent 0)
- (setq indent (max cperl-min-label-indent
- (+ indent cperl-label-offset)))))
- ((= (following-char) ?})
- (setq indent (- indent cperl-indent-level)))
- ((memq (following-char) '(?\) ?\])) ; To line up with opening paren.
- (setq indent (+ indent cperl-close-paren-offset)))
- ((= (following-char) ?{)
- (setq indent (+ indent cperl-brace-offset))))))
- (skip-chars-forward " \t")
- (setq shift-amt (and i (- indent (current-column))))
- (if (or (not shift-amt)
- (zerop shift-amt))
- (if (> (- (point-max) pos) (point))
- (goto-char (- (point-max) pos)))
- ;;;(delete-region beg (point))
- ;;;(indent-to indent)
- (cperl-make-indent indent)
- ;; If initial point was within line's indentation,
- ;; position after the indentation. Else stay at same point in text.
- (if (> (- (point-max) pos) (point))
- (goto-char (- (point-max) pos))))
- shift-amt))
-
-(defun cperl-after-label ()
- ;; Returns true if the point is after label. Does not do save-excursion.
- (and (eq (preceding-char) ?:)
- (memq (char-syntax (char-after (- (point) 2)))
- '(?w ?_))
- (progn
- (backward-sexp)
- (looking-at "[a-zA-Z_][a-zA-Z0-9_]*:[^:]"))))
-
-(defun cperl-get-state (&optional parse-start start-state)
- ;; returns list (START STATE DEPTH PRESTART),
- ;; START is a good place to start parsing, or equal to
- ;; PARSE-START if preset,
- ;; STATE is what is returned by `parse-partial-sexp'.
- ;; DEPTH is true is we are immediately after end of block
- ;; which contains START.
- ;; PRESTART is the position basing on which START was found.
- (save-excursion
- (let ((start-point (point)) depth state start prestart)
- (if (and parse-start
- (<= parse-start start-point))
- (goto-char parse-start)
- (beginning-of-defun)
- (setq start-state nil))
- (setq prestart (point))
- (if start-state nil
- ;; Try to go out, if sub is not on the outermost level
- (while (< (point) start-point)
- (setq start (point) parse-start start depth nil
- state (parse-partial-sexp start start-point -1))
- (if (> (car state) -1) nil
- ;; The current line could start like }}}, so the indentation
- ;; corresponds to a different level than what we reached
- (setq depth t)
- (beginning-of-line 2))) ; Go to the next line.
- (if start (goto-char start))) ; Not at the start of file
- (setq start (point))
- (or state (setq state (parse-partial-sexp start start-point -1 nil start-state)))
- (list start state depth prestart))))
-
-(defvar cperl-look-for-prop '((pod in-pod) (here-doc-delim here-doc-group)))
-
-(defun cperl-beginning-of-property (p prop &optional lim)
- "Given that P has a property PROP, find where the property starts.
-Will not look before LIM."
- ;;; XXXX What to do at point-max???
- (or (previous-single-property-change (cperl-1+ p) prop lim)
- (point-min))
-;;; (cond ((eq p (point-min))
-;;; p)
-;;; ((and lim (<= p lim))
-;;; p)
-;;; ((not (get-text-property (1- p) prop))
-;;; p)
-;;; (t (or (previous-single-property-change p look-prop lim)
-;;; (point-min))))
- )
-
-(defun cperl-sniff-for-indent (&optional parse-data) ; was parse-start
- ;; Old workhorse for calculation of indentation; the major problem
- ;; is that it mixes the sniffer logic to understand what the current line
- ;; MEANS with the logic to actually calculate where to indent it.
- ;; The latter part should be eventually moved to `cperl-calculate-indent';
- ;; actually, this is mostly done now...
- (cperl-update-syntaxification (point) (point))
- (let ((res (get-text-property (point) 'syntax-type)))
- (save-excursion
- (cond
- ((and (memq res '(pod here-doc here-doc-delim format))
- (not (get-text-property (point) 'indentable)))
- (vector res))
- ;; before start of POD - whitespace found since do not have 'pod!
- ((looking-at "[ \t]*\n=")
- (error "Spaces before POD section!"))
- ((and (not cperl-indent-left-aligned-comments)
- (looking-at "^#"))
- [comment-special:at-beginning-of-line])
- ((get-text-property (point) 'in-pod)
- [in-pod])
- (t
- (beginning-of-line)
- (let* ((indent-point (point))
- (char-after-pos (save-excursion
- (skip-chars-forward " \t")
- (point)))
- (char-after (char-after char-after-pos))
- (pre-indent-point (point))
- p prop look-prop is-block delim)
- (save-excursion ; Know we are not in POD, find appropriate pos before
- (cperl-backward-to-noncomment nil)
- (setq p (max (point-min) (1- (point)))
- prop (get-text-property p 'syntax-type)
- look-prop (or (nth 1 (assoc prop cperl-look-for-prop))
- 'syntax-type))
- (if (memq prop '(pod here-doc format here-doc-delim))
- (progn
- (goto-char (cperl-beginning-of-property p look-prop))
- (beginning-of-line)
- (setq pre-indent-point (point)))))
- (goto-char pre-indent-point) ; Orig line skipping preceeding pod/etc
- (let* ((case-fold-search nil)
- (s-s (cperl-get-state (car parse-data) (nth 1 parse-data)))
- (start (or (nth 2 parse-data) ; last complete sexp terminated
- (nth 0 s-s))) ; Good place to start parsing
- (state (nth 1 s-s))
- (containing-sexp (car (cdr state)))
- old-indent)
- (if (and
- ;;containing-sexp ;; We are buggy at toplevel :-(
- parse-data)
- (progn
- (setcar parse-data pre-indent-point)
- (setcar (cdr parse-data) state)
- (or (nth 2 parse-data)
- (setcar (cddr parse-data) start))
- ;; Before this point: end of statement
- (setq old-indent (nth 3 parse-data))))
- (cond ((get-text-property (point) 'indentable)
- ;; indent to "after" the surrounding open
- ;; (same offset as `cperl-beautify-regexp-piece'),
- ;; skip blanks if we do not close the expression.
- (setq delim ; We do not close the expression
- (get-text-property
- (cperl-1+ char-after-pos) 'indentable)
- p (1+ (cperl-beginning-of-property
- (point) 'indentable))
- is-block ; misused for: preceeding line in REx
- (save-excursion ; Find preceeding line
- (cperl-backward-to-noncomment p)
- (beginning-of-line)
- (if (<= (point) p)
- (progn ; get indent from the first line
- (goto-char p)
- (skip-chars-forward " \t")
- (if (memq (char-after (point))
- (append "#\n" nil))
- nil ; Can't use intentation of this line...
- (point)))
- (skip-chars-forward " \t")
- (point)))
- prop (parse-partial-sexp p char-after-pos))
- (cond ((not delim) ; End the REx, ignore is-block
- (vector 'indentable 'terminator p is-block))
- (is-block ; Indent w.r.t. preceeding line
- (vector 'indentable 'cont-line char-after-pos
- is-block char-after p))
- (t ; No preceeding line...
- (vector 'indentable 'first-line p))))
- ((get-text-property char-after-pos 'REx-part2)
- (vector 'REx-part2 (point)))
- ((nth 4 state)
- [comment])
- ((nth 3 state)
- [string])
- ;; XXXX Do we need to special-case this?
- ((null containing-sexp)
- ;; Line is at top level. May be data or function definition,
- ;; or may be function argument declaration.
- ;; Indent like the previous top level line
- ;; unless that ends in a closeparen without semicolon,
- ;; in which case this line is the first argument decl.
- (skip-chars-forward " \t")
- (cperl-backward-to-noncomment (or old-indent (point-min)))
- (setq state
- (or (bobp)
- (eq (point) old-indent) ; old-indent was at comment
- (eq (preceding-char) ?\;)
- ;; Had ?\) too
- (and (eq (preceding-char) ?\})
- (cperl-after-block-and-statement-beg
- (point-min))) ; Was start - too close
- (memq char-after (append ")]}" nil))
- (and (eq (preceding-char) ?\:) ; label
- (progn
- (forward-sexp -1)
- (skip-chars-backward " \t")
- (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[ \t]*:")))
- (get-text-property (point) 'first-format-line)))
-
- ;; Look at previous line that's at column 0
- ;; to determine whether we are in top-level decls
- ;; or function's arg decls. Set basic-indent accordingly.
- ;; Now add a little if this is a continuation line.
- (and state
- parse-data
- (not (eq char-after ?\C-j))
- (setcdr (cddr parse-data)
- (list pre-indent-point)))
- (vector 'toplevel start char-after state (nth 2 s-s)))
- ((not
- (or (setq is-block
- (and (setq delim (= (char-after containing-sexp) ?{))
- (save-excursion ; Is it a hash?
- (goto-char containing-sexp)
- (cperl-block-p))))
- cperl-indent-parens-as-block))
- ;; group is an expression, not a block:
- ;; indent to just after the surrounding open parens,
- ;; skip blanks if we do not close the expression.
- (goto-char (1+ containing-sexp))
- (or (memq char-after
- (append (if delim "}" ")]}") nil))
- (looking-at "[ \t]*\\(#\\|$\\)")
- (skip-chars-forward " \t"))
- (setq old-indent (point)) ; delim=is-brace
- (vector 'in-parens char-after (point) delim containing-sexp))
- (t
- ;; Statement level. Is it a continuation or a new statement?
- ;; Find previous non-comment character.
- (goto-char pre-indent-point) ; Skip one level of POD/etc
- (cperl-backward-to-noncomment containing-sexp)
- ;; Back up over label lines, since they don't
- ;; affect whether our line is a continuation.
- ;; (Had \, too)
- (while;;(or (eq (preceding-char) ?\,)
- (and (eq (preceding-char) ?:)
- (or;;(eq (char-after (- (point) 2)) ?\') ; ????
- (memq (char-syntax (char-after (- (point) 2)))
- '(?w ?_))))
- ;;)
- ;; This is always FALSE?
- (if (eq (preceding-char) ?\,)
- ;; Will go to beginning of line, essentially.
- ;; Will ignore embedded sexpr XXXX.
- (cperl-backward-to-start-of-continued-exp containing-sexp))
- (beginning-of-line)
- (cperl-backward-to-noncomment containing-sexp))
- ;; Now we get non-label preceeding the indent point
- (if (not (or (eq (1- (point)) containing-sexp)
- (memq (preceding-char)
- (append (if is-block " ;{" " ,;{") '(nil)))
- (and (eq (preceding-char) ?\})
- (cperl-after-block-and-statement-beg
- containing-sexp))
- (get-text-property (point) 'first-format-line)))
- ;; This line is continuation of preceding line's statement;
- ;; indent `cperl-continued-statement-offset' more than the
- ;; previous line of the statement.
- ;;
- ;; There might be a label on this line, just
- ;; consider it bad style and ignore it.
- (progn
- (cperl-backward-to-start-of-continued-exp containing-sexp)
- (vector 'continuation (point) char-after is-block delim))
- ;; This line starts a new statement.
- ;; Position following last unclosed open brace
- (goto-char containing-sexp)
- ;; Is line first statement after an open-brace?
- (or
- ;; If no, find that first statement and indent like
- ;; it. If the first statement begins with label, do
- ;; not believe when the indentation of the label is too
- ;; small.
- (save-excursion
- (forward-char 1)
- (let ((colon-line-end 0))
- (while
- (progn (skip-chars-forward " \t\n")
- ;; s: foo : bar :x is NOT label
- (and (looking-at "#\\|\\([a-zA-Z0-9_$]+\\):[^:]\\|=[a-zA-Z]")
- (not (looking-at "[sym]:\\|tr:"))))
- ;; Skip over comments and labels following openbrace.
- (cond ((= (following-char) ?\#)
- (forward-line 1))
- ((= (following-char) ?\=)
- (goto-char
- (or (next-single-property-change (point) 'in-pod)
- (point-max)))) ; do not loop if no syntaxification
- ;; label:
- (t
- (save-excursion (end-of-line)
- (setq colon-line-end (point)))
- (search-forward ":"))))
- ;; We are at beginning of code (NOT label or comment)
- ;; First, the following code counts
- ;; if it is before the line we want to indent.
- (and (< (point) indent-point)
- (vector 'have-prev-sibling (point) colon-line-end
- containing-sexp))))
- (progn
- ;; If no previous statement,
- ;; indent it relative to line brace is on.
-
- ;; For open-braces not the first thing in a line,
- ;; add in cperl-brace-imaginary-offset.
-
- ;; If first thing on a line: ?????
- ;; Move back over whitespace before the openbrace.
- (setq ; brace first thing on a line
- old-indent (progn (skip-chars-backward " \t") (bolp)))
- ;; Should we indent w.r.t. earlier than start?
- ;; Move to start of control group, possibly on a different line
- (or cperl-indent-wrt-brace
- (cperl-backward-to-noncomment (point-min)))
- ;; If the openbrace is preceded by a parenthesized exp,
- ;; move to the beginning of that;
- (if (eq (preceding-char) ?\))
- (progn
- (forward-sexp -1)
- (cperl-backward-to-noncomment (point-min))))
- ;; In the case it starts a subroutine, indent with
- ;; respect to `sub', not with respect to the
- ;; first thing on the line, say in the case of
- ;; anonymous sub in a hash.
- (if (and;; Is it a sub in group starting on this line?
- (cond ((get-text-property (point) 'attrib-group)
- (goto-char (cperl-beginning-of-property
- (point) 'attrib-group)))
- ((eq (preceding-char) ?b)
- (forward-sexp -1)
- (looking-at "sub\\>")))
- (setq p (nth 1 ; start of innermost containing list
- (parse-partial-sexp
- (save-excursion (beginning-of-line)
- (point))
- (point)))))
- (progn
- (goto-char (1+ p)) ; enclosing block on the same line
- (skip-chars-forward " \t")
- (vector 'code-start-in-block containing-sexp char-after
- (and delim (not is-block)) ; is a HASH
- old-indent ; brace first thing on a line
- t (point) ; have something before...
- )
- ;;(current-column)
- )
- ;; Get initial indentation of the line we are on.
- ;; If line starts with label, calculate label indentation
- (vector 'code-start-in-block containing-sexp char-after
- (and delim (not is-block)) ; is a HASH
- old-indent ; brace first thing on a line
- nil (point))))))))))))))) ; nothing interesting before
-
-(defvar cperl-indent-rules-alist
- '((pod nil) ; via `syntax-type' property
- (here-doc nil) ; via `syntax-type' property
- (here-doc-delim nil) ; via `syntax-type' property
- (format nil) ; via `syntax-type' property
- (in-pod nil) ; via `in-pod' property
- (comment-special:at-beginning-of-line nil)
- (string t)
- (comment nil))
- "Alist of indentation rules for CPerl mode.
-The values mean:
- nil: do not indent;
- number: add this amount of indentation.")
-
-(defun cperl-calculate-indent (&optional parse-data) ; was parse-start
- "Return appropriate indentation for current line as Perl code.
-In usual case returns an integer: the column to indent to.
-Returns nil if line starts inside a string, t if in a comment.
-
-Will not correct the indentation for labels, but will correct it for braces
-and closing parentheses and brackets."
- ;; This code is still a broken architecture: in some cases we need to
- ;; compensate for some modifications which `cperl-indent-line' will add later
- (save-excursion
- (let ((i (cperl-sniff-for-indent parse-data)) what p)
- (cond
- ;;((or (null i) (eq i t) (numberp i))
- ;; i)
- ((vectorp i)
- (setq what (assoc (elt i 0) cperl-indent-rules-alist))
- (cond
- (what (cadr what)) ; Load from table
- ;;
- ;; Indenters for regular expressions with //x and qw()
- ;;
- ((eq 'REx-part2 (elt i 0)) ;; [self start] start of /REP in s//REP/x
- (goto-char (elt i 1))
- (condition-case nil ; Use indentation of the 1st part
- (forward-sexp -1))
- (current-column))
- ((eq 'indentable (elt i 0)) ; Indenter for REGEXP qw() etc
- (cond ;;; [indentable terminator start-pos is-block]
- ((eq 'terminator (elt i 1)) ; Lone terminator of "indentable string"
- (goto-char (elt i 2)) ; After opening parens
- (1- (current-column)))
- ((eq 'first-line (elt i 1)); [indentable first-line start-pos]
- (goto-char (elt i 2))
- (+ (or cperl-regexp-indent-step cperl-indent-level)
- -1
- (current-column)))
- ((eq 'cont-line (elt i 1)); [indentable cont-line pos prev-pos first-char start-pos]
- ;; Indent as the level after closing parens
- (goto-char (elt i 2)) ; indent line
- (skip-chars-forward " \t)") ; Skip closing parens
- (setq p (point))
- (goto-char (elt i 3)) ; previous line
- (skip-chars-forward " \t)") ; Skip closing parens
- ;; Number of parens in between:
- (setq p (nth 0 (parse-partial-sexp (point) p))
- what (elt i 4)) ; First char on current line
- (goto-char (elt i 3)) ; previous line
- (+ (* p (or cperl-regexp-indent-step cperl-indent-level))
- (cond ((eq what ?\) )
- (- cperl-close-paren-offset)) ; compensate
- ((eq what ?\| )
- (- (or cperl-regexp-indent-step cperl-indent-level)))
- (t 0))
- (if (eq (following-char) ?\| )
- (or cperl-regexp-indent-step cperl-indent-level)
- 0)
- (current-column)))
- (t
- (error "Unrecognized value of indent: " i))))
- ;;
- ;; Indenter for stuff at toplevel
- ;;
- ((eq 'toplevel (elt i 0)) ;; [toplevel start char-after state immed-after-block]
- (+ (save-excursion ; To beg-of-defun, or end of last sexp
- (goto-char (elt i 1)) ; start = Good place to start parsing
- (- (current-indentation) ;
- (if (elt i 4) cperl-indent-level 0))) ; immed-after-block
- (if (eq (elt i 2) ?{) cperl-continued-brace-offset 0) ; char-after
- ;; Look at previous line that's at column 0
- ;; to determine whether we are in top-level decls
- ;; or function's arg decls. Set basic-indent accordingly.
- ;; Now add a little if this is a continuation line.
- (if (elt i 3) ; state (XXX What is the semantic???)
- 0
- cperl-continued-statement-offset)))
- ;;
- ;; Indenter for stuff in "parentheses" (or brackets, braces-as-hash)
- ;;
- ((eq 'in-parens (elt i 0))
- ;; in-parens char-after old-indent-point is-brace containing-sexp
-
- ;; group is an expression, not a block:
- ;; indent to just after the surrounding open parens,
- ;; skip blanks if we do not close the expression.
- (+ (progn
- (goto-char (elt i 2)) ; old-indent-point
- (current-column))
- (if (and (elt i 3) ; is-brace
- (eq (elt i 1) ?\})) ; char-after
- ;; Correct indentation of trailing ?\}
- (+ cperl-indent-level cperl-close-paren-offset)
- 0)))
- ;;
- ;; Indenter for continuation lines
- ;;
- ((eq 'continuation (elt i 0))
- ;; [continuation statement-start char-after is-block is-brace]
- (goto-char (elt i 1)) ; statement-start
- (+ (if (memq (elt i 2) (append "}])" nil)) ; char-after
- 0 ; Closing parenth
- cperl-continued-statement-offset)
- (if (or (elt i 3) ; is-block
- (not (elt i 4)) ; is-brace
- (not (eq (elt i 2) ?\}))) ; char-after
- 0
- ;; Now it is a hash reference
- (+ cperl-indent-level cperl-close-paren-offset))
- ;; Labels do not take :: ...
- (if (looking-at "\\(\\w\\|_\\)+[ \t]*:")
- (if (> (current-indentation) cperl-min-label-indent)
- (- (current-indentation) cperl-label-offset)
- ;; Do not move `parse-data', this should
- ;; be quick anyway (this comment comes
- ;; from different location):
- (cperl-calculate-indent))
- (current-column))
- (if (eq (elt i 2) ?\{) ; char-after
- cperl-continued-brace-offset 0)))
- ;;
- ;; Indenter for lines in a block which are not leading lines
- ;;
- ((eq 'have-prev-sibling (elt i 0))
- ;; [have-prev-sibling sibling-beg colon-line-end block-start]
- (goto-char (elt i 1)) ; sibling-beg
- (if (> (elt i 2) (point)) ; colon-line-end; have label before point
- (if (> (current-indentation)
- cperl-min-label-indent)
- (- (current-indentation) cperl-label-offset)
- ;; Do not believe: `max' was involved in calculation of indent
- (+ cperl-indent-level
- (save-excursion
- (goto-char (elt i 3)) ; block-start
- (current-indentation))))
- (current-column)))
- ;;
- ;; Indenter for the first line in a block
- ;;
- ((eq 'code-start-in-block (elt i 0))
- ;;[code-start-in-block before-brace char-after
- ;; is-a-HASH-ref brace-is-first-thing-on-a-line
- ;; group-starts-before-start-of-sub start-of-control-group]
- (goto-char (elt i 1))
- ;; For open brace in column zero, don't let statement
- ;; start there too. If cperl-indent-level=0,
- ;; use cperl-brace-offset + cperl-continued-statement-offset instead.
- (+ (if (and (bolp) (zerop cperl-indent-level))
- (+ cperl-brace-offset cperl-continued-statement-offset)
- cperl-indent-level)
- (if (and (elt i 3) ; is-a-HASH-ref
- (eq (elt i 2) ?\})) ; char-after: End of a hash reference
- (+ cperl-indent-level cperl-close-paren-offset)
- 0)
- ;; Unless openbrace is the first nonwhite thing on the line,
- ;; add the cperl-brace-imaginary-offset.
- (if (elt i 4) 0 ; brace-is-first-thing-on-a-line
- cperl-brace-imaginary-offset)
- (progn
- (goto-char (elt i 6)) ; start-of-control-group
- (if (elt i 5) ; group-starts-before-start-of-sub
- (current-column)
- ;; Get initial indentation of the line we are on.
- ;; If line starts with label, calculate label indentation
- (if (save-excursion
- (beginning-of-line)
- (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]"))
- (if (> (current-indentation) cperl-min-label-indent)
- (- (current-indentation) cperl-label-offset)
- ;; Do not move `parse-data', this should
- ;; be quick anyway:
- (cperl-calculate-indent))
- (current-indentation))))))
- (t
- (error "Unrecognized value of indent: " i))))
- (t
- (error (format "Got strange value of indent: " i)))))))
-
-(defun cperl-calculate-indent-within-comment ()
- "Return the indentation amount for line, assuming that
-the current line is to be regarded as part of a block comment."
- (let (end star-start)
- (save-excursion
- (beginning-of-line)
- (skip-chars-forward " \t")
- (setq end (point))
- (and (= (following-char) ?#)
- (forward-line -1)
- (cperl-to-comment-or-eol)
- (setq end (point)))
- (goto-char end)
- (current-column))))
-
-
-(defun cperl-to-comment-or-eol ()
- "Go to position before comment on the current line, or to end of line.
-Returns true if comment is found. In POD will not move the point."
- ;; If the line is inside other syntax groups (qq-style strings, HERE-docs)
- ;; then looks for literal # or end-of-line.
- (let (state stop-in cpoint (lim (progn (end-of-line) (point))) pr e)
- (or cperl-font-locking
- (cperl-update-syntaxification lim lim))
- (beginning-of-line)
- (if (setq pr (get-text-property (point) 'syntax-type))
- (setq e (next-single-property-change (point) 'syntax-type nil (point-max))))
- (if (or (eq pr 'pod)
- (if (or (not e) (> e lim)) ; deep inside a group
- (re-search-forward "\\=[ \t]*\\(#\\|$\\)" lim t)))
- (if (eq (preceding-char) ?\#) (progn (backward-char 1) t))
- ;; Else - need to do it the hard way
- (and (and e (<= e lim))
- (goto-char e))
- (while (not stop-in)
- (setq state (parse-partial-sexp (point) lim nil nil nil t))
- ; stop at comment
- ;; If fails (beginning-of-line inside sexp), then contains not-comment
- (if (nth 4 state) ; After `#';
- ; (nth 2 state) can be
- ; beginning of m,s,qq and so
- ; on
- (if (nth 2 state)
- (progn
- (setq cpoint (point))
- (goto-char (nth 2 state))
- (cond
- ((looking-at "\\(s\\|tr\\)\\>")
- (or (re-search-forward
- "\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*"
- lim 'move)
- (setq stop-in t)))
- ((looking-at "\\(m\\|q\\([qxwr]\\)?\\)\\>")
- (or (re-search-forward
- "\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#"
- lim 'move)
- (setq stop-in t)))
- (t ; It was fair comment
- (setq stop-in t) ; Finish
- (goto-char (1- cpoint)))))
- (setq stop-in t) ; Finish
- (forward-char -1))
- (setq stop-in t))) ; Finish
- (nth 4 state))))
-
-(defsubst cperl-modify-syntax-type (at how)
- (if (< at (point-max))
- (progn
- (put-text-property at (1+ at) 'syntax-table how)
- (put-text-property at (1+ at) 'rear-nonsticky '(syntax-table)))))
-
-(defun cperl-protect-defun-start (s e)
- ;; C code looks for "^\\s(" to skip comment backward in "hard" situations
- (save-excursion
- (goto-char s)
- (while (re-search-forward "^\\s(" e 'to-end)
- (put-text-property (1- (point)) (point) 'syntax-table cperl-st-punct))))
-
-(defun cperl-commentify (bb e string &optional noface)
- (if cperl-use-syntax-table-text-property
- (if (eq noface 'n) ; Only immediate
- nil
- ;; We suppose that e is _after_ the end of construction, as after eol.
- (setq string (if string cperl-st-sfence cperl-st-cfence))
- (if (> bb (- e 2))
- ;; one-char string/comment?!
- (cperl-modify-syntax-type bb cperl-st-punct)
- (cperl-modify-syntax-type bb string)
- (cperl-modify-syntax-type (1- e) string))
- (if (and (eq string cperl-st-sfence) (> (- e 2) bb))
- (put-text-property (1+ bb) (1- e)
- 'syntax-table cperl-string-syntax-table))
- (cperl-protect-defun-start bb e))
- ;; Fontify
- (or noface
- (not cperl-pod-here-fontify)
- (put-text-property bb e 'face (if string 'font-lock-string-face
- 'font-lock-comment-face)))))
-
-(defvar cperl-starters '(( ?\( . ?\) )
- ( ?\[ . ?\] )
- ( ?\{ . ?\} )
- ( ?\< . ?\> )))
-
-(defun cperl-cached-syntax-table (st)
- "Get a syntax table cached in ST, or create and cache into ST a syntax table.
-All the entries of the syntax table are \".\", except for a backslash, which
-is quoting."
- (if (car-safe st)
- (car st)
- (setcar st (make-syntax-table))
- (setq st (car st))
- (let ((i 0))
- (while (< i 256)
- (modify-syntax-entry i "." st)
- (setq i (1+ i))))
- (modify-syntax-entry ?\\ "\\" st)
- st))
-
-(defun cperl-forward-re (lim end is-2arg st-l err-l argument
- &optional ostart oend)
-"Find the end of a regular expression or a stringish construct (q[] etc).
-The point should be before the starting delimiter.
-
-Goes to LIM if none is found. If IS-2ARG is non-nil, assumes that it
-is s/// or tr/// like expression. If END is nil, generates an error
-message if needed. If SET-ST is non-nil, will use (or generate) a
-cached syntax table in ST-L. If ERR-L is non-nil, will store the
-error message in its CAR (unless it already contains some error
-message). ARGUMENT should be the name of the construct (used in error
-messages). OSTART, OEND may be set in recursive calls when processing
-the second argument of 2ARG construct.
-
-Works *before* syntax recognition is done. In IS-2ARG situation may
-modify syntax-type text property if the situation is too hard."
- (let (b starter ender st i i2 go-forward reset-st set-st)
- (skip-chars-forward " \t")
- ;; ender means matching-char matcher.
- (setq b (point)
- starter (if (eobp) 0 (char-after b))
- ender (cdr (assoc starter cperl-starters)))
- ;; What if starter == ?\\ ????
- (setq st (cperl-cached-syntax-table st-l))
- (setq set-st t)
- ;; Whether we have an intermediate point
- (setq i nil)
- ;; Prepare the syntax table:
- (if (not ender) ; m/blah/, s/x//, s/x/y/
- (modify-syntax-entry starter "$" st)
- (modify-syntax-entry starter (concat "(" (list ender)) st)
- (modify-syntax-entry ender (concat ")" (list starter)) st))
- (condition-case bb
- (progn
- ;; We use `$' syntax class to find matching stuff, but $$
- ;; is recognized the same as $, so we need to check this manually.
- (if (and (eq starter (char-after (cperl-1+ b)))
- (not ender))
- ;; $ has TeXish matching rules, so $$ equiv $...
- (forward-char 2)
- (setq reset-st (syntax-table))
- (set-syntax-table st)
- (forward-sexp 1)
- (if (<= (point) (1+ b))
- (error "Unfinished regular expression"))
- (set-syntax-table reset-st)
- (setq reset-st nil)
- ;; Now the problem is with m;blah;;
- (and (not ender)
- (eq (preceding-char)
- (char-after (- (point) 2)))
- (save-excursion
- (forward-char -2)
- (= 0 (% (skip-chars-backward "\\\\") 2)))
- (forward-char -1)))
- ;; Now we are after the first part.
- (and is-2arg ; Have trailing part
- (not ender)
- (eq (following-char) starter) ; Empty trailing part
- (progn
- (or (eq (char-syntax (following-char)) ?.)
- ;; Make trailing letter into punctuation
- (cperl-modify-syntax-type (point) cperl-st-punct))
- (setq is-2arg nil go-forward t))) ; Ignore the tail
- (if is-2arg ; Not number => have second part
- (progn
- (setq i (point) i2 i)
- (if ender
- (if (memq (following-char) '(?\ ?\t ?\n ?\f))
- (progn
- (if (looking-at "[ \t\n\f]+\\(#[^\n]*\n[ \t\n\f]*\\)+")
- (goto-char (match-end 0))
- (skip-chars-forward " \t\n\f"))
- (setq i2 (point))))
- (forward-char -1))
- (modify-syntax-entry starter (if (eq starter ?\\) "\\" ".") st)
- (if ender (modify-syntax-entry ender "." st))
- (setq set-st nil)
- (setq ender (cperl-forward-re lim end nil st-l err-l
- argument starter ender)
- ender (nth 2 ender)))))
- (error (goto-char lim)
- (setq set-st nil)
- (if reset-st
- (set-syntax-table reset-st))
- (or end
- (message
- "End of `%s%s%c ... %c' string/RE not found: %s"
- argument
- (if ostart (format "%c ... %c" ostart (or oend ostart)) "")
- starter (or ender starter) bb)
- (or (car err-l) (setcar err-l b)))))
- (if set-st
- (progn
- (modify-syntax-entry starter (if (eq starter ?\\) "\\" ".") st)
- (if ender (modify-syntax-entry ender "." st))))
- ;; i: have 2 args, after end of the first arg
- ;; i2: start of the second arg, if any (before delim iff `ender').
- ;; ender: the last arg bounded by parens-like chars, the second one of them
- ;; starter: the starting delimiter of the first arg
- ;; go-forward: has 2 args, and the second part is empty
- (list i i2 ender starter go-forward)))
-
-(defun cperl-forward-group-in-re (&optional st-l)
- "Find the end of a group in a REx.
-Return the error message (if any). Does not work if delimiter is `)'.
-Works before syntax recognition is done."
- ;; Works *before* syntax recognition is done
- (or st-l (setq st-l (list nil))) ; Avoid overwriting '()
- (let (st b reset-st)
- (condition-case b
- (progn
- (setq st (cperl-cached-syntax-table st-l))
- (modify-syntax-entry ?\( "()" st)
- (modify-syntax-entry ?\) ")(" st)
- (setq reset-st (syntax-table))
- (set-syntax-table st)
- (forward-sexp 1))
- (error (message
- "cperl-forward-group-in-re: error %s" b)))
- ;; now restore the initial state
- (if st
- (progn
- (modify-syntax-entry ?\( "." st)
- (modify-syntax-entry ?\) "." st)))
- (if reset-st
- (set-syntax-table reset-st))
- b))
-
-
-(defvar font-lock-string-face)
-;;(defvar font-lock-reference-face)
-(defvar font-lock-constant-face)
-(defsubst cperl-postpone-fontification (b e type val &optional now)
- ;; Do after syntactic fontification?
- (if cperl-syntaxify-by-font-lock
- (or now (put-text-property b e 'cperl-postpone (cons type val)))
- (put-text-property b e type val)))
-
-;;; Here is how the global structures (those which cannot be
-;;; recognized locally) are marked:
-;; a) PODs:
-;; Start-to-end is marked `in-pod' ==> t
-;; Each non-literal part is marked `syntax-type' ==> `pod'
-;; Each literal part is marked `syntax-type' ==> `in-pod'
-;; b) HEREs:
-;; Start-to-end is marked `here-doc-group' ==> t
-;; The body is marked `syntax-type' ==> `here-doc'
-;; The delimiter is marked `syntax-type' ==> `here-doc-delim'
-;; c) FORMATs:
-;; First line (to =) marked `first-format-line' ==> t
-;; After-this--to-end is marked `syntax-type' ==> `format'
-;; d) 'Q'uoted string:
-;; part between markers inclusive is marked `syntax-type' ==> `string'
-;; part between `q' and the first marker is marked `syntax-type' ==> `prestring'
-;; second part of s///e is marked `syntax-type' ==> `multiline'
-;; e) Attributes of subroutines: `attrib-group' ==> t
-;; (or 0 if declaration); up to `{' or ';': `syntax-type' => `sub-decl'.
-;; f) Multiline my/our declaration lists etc: `syntax-type' => `multiline'
-
-;;; In addition, some parts of RExes may be marked as `REx-interpolated'
-;;; (value: 0 in //o, 1 if "interpolated variable" is whole-REx, t otherwise).
-
-(defun cperl-unwind-to-safe (before &optional end)
- ;; if BEFORE, go to the previous start-of-line on each step of unwinding
- (let ((pos (point)) opos)
- (while (and pos (progn
- (beginning-of-line)
- (get-text-property (setq pos (point)) 'syntax-type)))
- (setq opos pos
- pos (cperl-beginning-of-property pos 'syntax-type))
- (if (eq pos (point-min))
- (setq pos nil))
- (if pos
- (if before
- (progn
- (goto-char (cperl-1- pos))
- (beginning-of-line)
- (setq pos (point)))
- (goto-char (setq pos (cperl-1- pos))))
- ;; Up to the start
- (goto-char (point-min))))
- ;; Skip empty lines
- (and (looking-at "\n*=")
- (/= 0 (skip-chars-backward "\n"))
- (forward-char))
- (setq pos (point))
- (if end
- ;; Do the same for end, going small steps
- (save-excursion
- (while (and end (get-text-property end 'syntax-type))
- (setq pos end
- end (next-single-property-change end 'syntax-type nil (point-max)))
- (if end (progn (goto-char end)
- (or (bolp) (forward-line 1))
- (setq end (point)))))
- (or end pos)))))
-
-;;; These are needed for byte-compile (at least with v19)
-(defvar cperl-nonoverridable-face)
-(defvar font-lock-variable-name-face)
-(defvar font-lock-function-name-face)
-(defvar font-lock-keyword-face)
-(defvar font-lock-builtin-face)
-(defvar font-lock-type-face)
-(defvar font-lock-comment-face)
-(defvar font-lock-warning-face)
-
-(defun cperl-find-sub-attrs (&optional st-l b-fname e-fname pos)
- "Syntaxically mark (and fontify) attributes of a subroutine.
-Should be called with the point before leading colon of an attribute."
- ;; Works *before* syntax recognition is done
- (or st-l (setq st-l (list nil))) ; Avoid overwriting '()
- (let (st b p reset-st after-first (start (point)) start1 end1)
- (condition-case b
- (while (looking-at
- (concat
- "\\(" ; 1=optional? colon
- ":" cperl-maybe-white-and-comment-rex ; 2=whitespace/comment?
- "\\)"
- (if after-first "?" "")
- ;; No space between name and paren allowed...
- "\\(\\sw+\\)" ; 3=name
- "\\((\\)?")) ; 4=optional paren
- (and (match-beginning 1)
- (cperl-postpone-fontification
- (match-beginning 0) (cperl-1+ (match-beginning 0))
- 'face font-lock-constant-face))
- (setq start1 (match-beginning 3) end1 (match-end 3))
- (cperl-postpone-fontification start1 end1
- 'face font-lock-constant-face)
- (goto-char end1) ; end or before `('
- (if (match-end 4) ; Have attribute arguments...
- (progn
- (if st nil
- (setq st (cperl-cached-syntax-table st-l))
- (modify-syntax-entry ?\( "()" st)
- (modify-syntax-entry ?\) ")(" st))
- (setq reset-st (syntax-table) p (point))
- (set-syntax-table st)
- (forward-sexp 1)
- (set-syntax-table reset-st)
- (setq reset-st nil)
- (cperl-commentify p (point) t))) ; mark as string
- (forward-comment (buffer-size))
- (setq after-first t))
- (error (message
- "L%d: attribute `%s': %s"
- (count-lines (point-min) (point))
- (and start1 end1 (buffer-substring start1 end1)) b)
- (setq start nil)))
- (and start
- (progn
- (put-text-property start (point)
- 'attrib-group (if (looking-at "{") t 0))
- (and pos
- (< 1 (count-lines (+ 3 pos) (point))) ; end of `sub'
- ;; Apparently, we do not need `multiline': faces added now
- (put-text-property (+ 3 pos) (cperl-1+ (point))
- 'syntax-type 'sub-decl))
- (and b-fname ; Fontify here: the following condition
- (cperl-postpone-fontification ; is too hard to determine by
- b-fname e-fname 'face ; a REx, so do it here
- (if (looking-at "{")
- font-lock-function-name-face
- font-lock-variable-name-face)))))
- ;; now restore the initial state
- (if st
- (progn
- (modify-syntax-entry ?\( "." st)
- (modify-syntax-entry ?\) "." st)))
- (if reset-st
- (set-syntax-table reset-st))))
-
-(defsubst cperl-look-at-leading-count (is-x-REx e)
- (if (and
- (< (point) e)
- (re-search-forward (concat "\\=" (if is-x-REx "[ \t\n]*" "") "[{?+*]")
- (1- e) t)) ; return nil on failure, no moving
- (if (eq ?\{ (preceding-char)) nil
- (cperl-postpone-fontification
- (1- (point)) (point)
- 'face font-lock-warning-face))))
-
-;;; Debugging this may require (setq max-specpdl-size 2000)...
-(defun cperl-find-pods-heres (&optional min max non-inter end ignore-max end-of-here-doc)
- "Scans the buffer for hard-to-parse Perl constructions.
-If `cperl-pod-here-fontify' is not-nil after evaluation, will fontify
-the sections using `cperl-pod-head-face', `cperl-pod-face',
-`cperl-here-face'."
- (interactive)
- (or min (setq min (point-min)
- cperl-syntax-state nil
- cperl-syntax-done-to min))
- (or max (setq max (point-max)))
- (let* ((cperl-pod-here-fontify (eval cperl-pod-here-fontify)) go tmpend
- face head-face here-face b e bb tag qtag b1 e1 argument i c tail tb
- is-REx is-x-REx REx-subgr-start REx-subgr-end was-subgr i2 hairy-RE
- (case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t)
- (modified (buffer-modified-p)) overshoot is-o-REx
- (after-change-functions nil)
- (cperl-font-locking t)
- (use-syntax-state (and cperl-syntax-state
- (>= min (car cperl-syntax-state))))
- (state-point (if use-syntax-state
- (car cperl-syntax-state)
- (point-min)))
- (state (if use-syntax-state
- (cdr cperl-syntax-state)))
- ;; (st-l '(nil)) (err-l '(nil)) ; Would overwrite - propagates from a function call to a function call!
- (st-l (list nil)) (err-l (list nil))
- ;; Somehow font-lock may be not loaded yet...
- ;; (e.g., when building TAGS via command-line call)
- (font-lock-string-face (if (boundp 'font-lock-string-face)
- font-lock-string-face
- 'font-lock-string-face))
- (my-cperl-delimiters-face (if (boundp 'font-lock-constant-face)
- font-lock-constant-face
- 'font-lock-constant-face))
- (my-cperl-REx-spec-char-face ; [] ^.$ and wrapper-of ({})
- (if (boundp 'font-lock-function-name-face)
- font-lock-function-name-face
- 'font-lock-function-name-face))
- (font-lock-variable-name-face ; interpolated vars and ({})-code
- (if (boundp 'font-lock-variable-name-face)
- font-lock-variable-name-face
- 'font-lock-variable-name-face))
- (font-lock-function-name-face ; used in `cperl-find-sub-attrs'
- (if (boundp 'font-lock-function-name-face)
- font-lock-function-name-face
- 'font-lock-function-name-face))
- (font-lock-constant-face ; used in `cperl-find-sub-attrs'
- (if (boundp 'font-lock-constant-face)
- font-lock-constant-face
- 'font-lock-constant-face))
- (my-cperl-REx-0length-face ; 0-length, (?:)etc, non-literal \
- (if (boundp 'font-lock-builtin-face)
- font-lock-builtin-face
- 'font-lock-builtin-face))
- (font-lock-comment-face
- (if (boundp 'font-lock-comment-face)
- font-lock-comment-face
- 'font-lock-comment-face))
- (font-lock-warning-face
- (if (boundp 'font-lock-warning-face)
- font-lock-warning-face
- 'font-lock-warning-face))
- (my-cperl-REx-ctl-face ; (|)
- (if (boundp 'font-lock-keyword-face)
- font-lock-keyword-face
- 'font-lock-keyword-face))
- (my-cperl-REx-modifiers-face ; //gims
- (if (boundp 'cperl-nonoverridable-face)
- cperl-nonoverridable-face
- 'cperl-nonoverridable-face))
- (my-cperl-REx-length1-face ; length=1 escaped chars, POSIX classes
- (if (boundp 'font-lock-type-face)
- font-lock-type-face
- 'font-lock-type-face))
- (stop-point (if ignore-max
- (point-max)
- max))
- (search
- (concat
- "\\(\\`\n?\\|^\n\\)=" ; POD
- "\\|"
- ;; One extra () before this:
- "<<" ; HERE-DOC
- "\\(" ; 1 + 1
- ;; First variant "BLAH" or just ``.
- "[ \t]*" ; Yes, whitespace is allowed!
- "\\([\"'`]\\)" ; 2 + 1 = 3
- "\\([^\"'`\n]*\\)" ; 3 + 1
- "\\3"
- "\\|"
- ;; Second variant: Identifier or \ID (same as 'ID') or empty
- "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 4 + 1, 5 + 1
- ;; Do not have <<= or << 30 or <<30 or << $blah.
- ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1
- "\\(\\)" ; To preserve count of pars :-( 6 + 1
- "\\)"
- "\\|"
- ;; 1+6 extra () before this:
- "^[ \t]*\\(format\\)[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$" ;FRMAT
- (if cperl-use-syntax-table-text-property
- (concat
- "\\|"
- ;; 1+6+2=9 extra () before this:
- "\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>" ; QUOTED CONSTRUCT
- "\\|"
- ;; 1+6+2+1=10 extra () before this:
- "\\([?/<]\\)" ; /blah/ or ?blah? or <file*glob>
- "\\|"
- ;; 1+6+2+1+1=11 extra () before this
- "\\<sub\\>" ; sub with proto/attr
- "\\("
- cperl-white-and-comment-rex
- "\\(::[a-zA-Z_:'0-9]*\\|[a-zA-Z_'][a-zA-Z_:'0-9]*\\)\\)?" ; name
- "\\("
- cperl-maybe-white-and-comment-rex
- "\\(([^()]*)\\|:[^:]\\)\\)" ; prototype or attribute start
- "\\|"
- ;; 1+6+2+1+1+6=17 extra () before this:
- "\\$\\(['{]\\)" ; $' or ${foo}
- "\\|"
- ;; 1+6+2+1+1+6+1=18 extra () before this (old pack'var syntax;
- ;; we do not support intervening comments...):
- "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'"
- ;; 1+6+2+1+1+6+1+1=19 extra () before this:
- "\\|"
- "__\\(END\\|DATA\\)__" ; __END__ or __DATA__
- ;; 1+6+2+1+1+6+1+1+1=20 extra () before this:
- "\\|"
- "\\\\\\(['`\"($]\\)") ; BACKWACKED something-hairy
- ""))))
- (unwind-protect
- (progn
- (save-excursion
- (or non-inter
- (message "Scanning for \"hard\" Perl constructions..."))
- ;;(message "find: %s --> %s" min max)
- (and cperl-pod-here-fontify
- ;; We had evals here, do not know why...
- (setq face cperl-pod-face
- head-face cperl-pod-head-face
- here-face cperl-here-face))
- (remove-text-properties min max
- '(syntax-type t in-pod t syntax-table t
- attrib-group t
- REx-interpolated t
- cperl-postpone t
- syntax-subtype t
- rear-nonsticky t
- front-sticky t
- here-doc-group t
- first-format-line t
- REx-part2 t
- indentable t))
- ;; Need to remove face as well...
- (goto-char min)
- (and (eq system-type 'emx)
- (eq (point) 1)
- (let ((case-fold-search t))
- (looking-at "extproc[ \t]")) ; Analogue of #!
- (cperl-commentify min
- (save-excursion (end-of-line) (point))
- nil))
- (while (and
- (< (point) max)
- (re-search-forward search max t))
- (setq tmpend nil) ; Valid for most cases
- (setq b (match-beginning 0)
- state (save-excursion (parse-partial-sexp
- state-point b nil nil state))
- state-point b)
- (cond
- ;; 1+6+2+1+1+6=17 extra () before this:
- ;; "\\$\\(['{]\\)"
- ((match-beginning 18) ; $' or ${foo}
- (if (eq (preceding-char) ?\') ; $'
- (progn
- (setq b (1- (point))
- state (parse-partial-sexp
- state-point (1- b) nil nil state)
- state-point (1- b))
- (if (nth 3 state) ; in string
- (cperl-modify-syntax-type (1- b) cperl-st-punct))
- (goto-char (1+ b)))
- ;; else: ${
- (setq bb (match-beginning 0))
- (cperl-modify-syntax-type bb cperl-st-punct)))
- ;; No processing in strings/comments beyond this point:
- ((or (nth 3 state) (nth 4 state))
- t) ; Do nothing in comment/string
- ((match-beginning 1) ; POD section
- ;; "\\(\\`\n?\\|^\n\\)="
- (setq b (match-beginning 0)
- state (parse-partial-sexp
- state-point b nil nil state)
- state-point b)
- (if (or (nth 3 state) (nth 4 state)
- (looking-at "cut\\>"))
- (if (or (nth 3 state) (nth 4 state) ignore-max)
- nil ; Doing a chunk only
- (message "=cut is not preceded by a POD section")
- (or (car err-l) (setcar err-l (point))))
- (beginning-of-line)
-
- (setq b (point)
- bb b
- tb (match-beginning 0)
- b1 nil) ; error condition
- ;; We do not search to max, since we may be called from
- ;; some hook of fontification, and max is random
- (or (re-search-forward "^\n=cut\\>" stop-point 'toend)
- (progn
- (goto-char b)
- (if (re-search-forward "\n=cut\\>" stop-point 'toend)
- (progn
- (message "=cut is not preceded by an empty line")
- (setq b1 t)
- (or (car err-l) (setcar err-l b))))))
- (beginning-of-line 2) ; An empty line after =cut is not POD!
- (setq e (point))
- (and (> e max)
- (progn
- (remove-text-properties
- max e '(syntax-type t in-pod t syntax-table t
- attrib-group t
- REx-interpolated t
- cperl-postpone t
- syntax-subtype t
- here-doc-group t
- rear-nonsticky t
- front-sticky t
- first-format-line t
- REx-part2 t
- indentable t))
- (setq tmpend tb)))
- (put-text-property b e 'in-pod t)
- (put-text-property b e 'syntax-type 'in-pod)
- (goto-char b)
- (while (re-search-forward "\n\n[ \t]" e t)
- ;; We start 'pod 1 char earlier to include the preceding line
- (beginning-of-line)
- (put-text-property (cperl-1- b) (point) 'syntax-type 'pod)
- (cperl-put-do-not-fontify b (point) t)
- ;; mark the non-literal parts as PODs
- (if cperl-pod-here-fontify
- (cperl-postpone-fontification b (point) 'face face t))
- (re-search-forward "\n\n[^ \t\f\n]" e 'toend)
- (beginning-of-line)
- (setq b (point)))
- (put-text-property (cperl-1- (point)) e 'syntax-type 'pod)
- (cperl-put-do-not-fontify (point) e t)
- (if cperl-pod-here-fontify
- (progn
- ;; mark the non-literal parts as PODs
- (cperl-postpone-fontification (point) e 'face face t)
- (goto-char bb)
- (if (looking-at
- "=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$")
- ;; mark the headers
- (cperl-postpone-fontification
- (match-beginning 1) (match-end 1)
- 'face head-face))
- (while (re-search-forward
- ;; One paragraph
- "^\n=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$"
- e 'toend)
- ;; mark the headers
- (cperl-postpone-fontification
- (match-beginning 1) (match-end 1)
- 'face head-face))))
- (cperl-commentify bb e nil)
- (goto-char e)
- (or (eq e (point-max))
- (forward-char -1)))) ; Prepare for immediate POD start.
- ;; Here document
- ;; We can do many here-per-line;
- ;; but multiline quote on the same line as <<HERE confuses us...
- ;; ;; One extra () before this:
- ;;"<<"
- ;; "\\(" ; 1 + 1
- ;; ;; First variant "BLAH" or just ``.
- ;; "[ \t]*" ; Yes, whitespace is allowed!
- ;; "\\([\"'`]\\)" ; 2 + 1
- ;; "\\([^\"'`\n]*\\)" ; 3 + 1
- ;; "\\3"
- ;; "\\|"
- ;; ;; Second variant: Identifier or \ID or empty
- ;; "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 4 + 1, 5 + 1
- ;; ;; Do not have <<= or << 30 or <<30 or << $blah.
- ;; ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1
- ;; "\\(\\)" ; To preserve count of pars :-( 6 + 1
- ;; "\\)"
- ((match-beginning 2) ; 1 + 1
- (setq b (point)
- tb (match-beginning 0)
- c (and ; not HERE-DOC
- (match-beginning 5)
- (save-match-data
- (or (looking-at "[ \t]*(") ; << function_call()
- (save-excursion ; 1 << func_name, or $foo << 10
- (condition-case nil
- (progn
- (goto-char tb)
- ;;; XXX What to do: foo <<bar ???
- ;;; XXX Need to support print {a} <<B ???
- (forward-sexp -1)
- (save-match-data
- ; $foo << b; $f .= <<B;
- ; ($f+1) << b; a($f) . <<B;
- ; foo 1, <<B; $x{a} <<b;
- (cond
- ((looking-at "[0-9$({]")
- (forward-sexp 1)
- (and
- (looking-at "[ \t]*<<")
- (condition-case nil
- ;; print $foo <<EOF
- (progn
- (forward-sexp -2)
- (not
- (looking-at "\\(printf?\\|system\\|exec\\|sort\\)\\>")))
- (error t)))))))
- (error nil))) ; func(<<EOF)
- (and (not (match-beginning 6)) ; Empty
- (looking-at
- "[ \t]*[=0-9$@%&(]"))))))
- (if c ; Not here-doc
- nil ; Skip it.
- (setq c (match-end 2)) ; 1 + 1
- (if (match-beginning 5) ;4 + 1
- (setq b1 (match-beginning 5) ; 4 + 1
- e1 (match-end 5)) ; 4 + 1
- (setq b1 (match-beginning 4) ; 3 + 1
- e1 (match-end 4))) ; 3 + 1
- (setq tag (buffer-substring b1 e1)
- qtag (regexp-quote tag))
- (cond (cperl-pod-here-fontify
- ;; Highlight the starting delimiter
- (cperl-postpone-fontification
- b1 e1 'face my-cperl-delimiters-face)
- (cperl-put-do-not-fontify b1 e1 t)))
- (forward-line)
- (setq i (point))
- (if end-of-here-doc
- (goto-char end-of-here-doc))
- (setq b (point))
- ;; We do not search to max, since we may be called from
- ;; some hook of fontification, and max is random
- (or (and (re-search-forward (concat "^" qtag "$")
- stop-point 'toend)
- ;;;(eq (following-char) ?\n) ; XXXX WHY???
- )
- (progn ; Pretend we matched at the end
- (goto-char (point-max))
- (re-search-forward "\\'")
- (message "End of here-document `%s' not found." tag)
- (or (car err-l) (setcar err-l b))))
- (if cperl-pod-here-fontify
- (progn
- ;; Highlight the ending delimiter
- (cperl-postpone-fontification
- (match-beginning 0) (match-end 0)
- 'face my-cperl-delimiters-face)
- (cperl-put-do-not-fontify b (match-end 0) t)
- ;; Highlight the HERE-DOC
- (cperl-postpone-fontification b (match-beginning 0)
- 'face here-face)))
- (setq e1 (cperl-1+ (match-end 0)))
- (put-text-property b (match-beginning 0)
- 'syntax-type 'here-doc)
- (put-text-property (match-beginning 0) e1
- 'syntax-type 'here-doc-delim)
- (put-text-property b e1 'here-doc-group t)
- ;; This makes insertion at the start of HERE-DOC update
- ;; the whole construct:
- (put-text-property b (cperl-1+ b) 'front-sticky '(syntax-type))
- (cperl-commentify b e1 nil)
- (cperl-put-do-not-fontify b (match-end 0) t)
- ;; Cache the syntax info...
- (setq cperl-syntax-state (cons state-point state))
- ;; ... and process the rest of the line...
- (setq overshoot
- (elt ; non-inter ignore-max
- (cperl-find-pods-heres c i t end t e1) 1))
- (if (and overshoot (> overshoot (point)))
- (goto-char overshoot)
- (setq overshoot e1))
- (if (> e1 max)
- (setq tmpend tb))))
- ;; format
- ((match-beginning 8)
- ;; 1+6=7 extra () before this:
- ;;"^[ \t]*\\(format\\)[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$"
- (setq b (point)
- name (if (match-beginning 8) ; 7 + 1
- (buffer-substring (match-beginning 8) ; 7 + 1
- (match-end 8)) ; 7 + 1
- "")
- tb (match-beginning 0))
- (setq argument nil)
- (put-text-property (save-excursion
- (beginning-of-line)
- (point))
- b 'first-format-line 't)
- (if cperl-pod-here-fontify
- (while (and (eq (forward-line) 0)
- (not (looking-at "^[.;]$")))
- (cond
- ((looking-at "^#")) ; Skip comments
- ((and argument ; Skip argument multi-lines
- (looking-at "^[ \t]*{"))
- (forward-sexp 1)
- (setq argument nil))
- (argument ; Skip argument lines
- (setq argument nil))
- (t ; Format line
- (setq b1 (point))
- (setq argument (looking-at "^[^\n]*[@^]"))
- (end-of-line)
- ;; Highlight the format line
- (cperl-postpone-fontification b1 (point)
- 'face font-lock-string-face)
- (cperl-commentify b1 (point) nil)
- (cperl-put-do-not-fontify b1 (point) t))))
- ;; We do not search to max, since we may be called from
- ;; some hook of fontification, and max is random
- (re-search-forward "^[.;]$" stop-point 'toend))
- (beginning-of-line)
- (if (looking-at "^\\.$") ; ";" is not supported yet
- (progn
- ;; Highlight the ending delimiter
- (cperl-postpone-fontification (point) (+ (point) 2)
- 'face font-lock-string-face)
- (cperl-commentify (point) (+ (point) 2) nil)
- (cperl-put-do-not-fontify (point) (+ (point) 2) t))
- (message "End of format `%s' not found." name)
- (or (car err-l) (setcar err-l b)))
- (forward-line)
- (if (> (point) max)
- (setq tmpend tb))
- (put-text-property b (point) 'syntax-type 'format))
- ;; qq-like String or Regexp:
- ((or (match-beginning 10) (match-beginning 11))
- ;; 1+6+2=9 extra () before this:
- ;; "\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>"
- ;; "\\|"
- ;; "\\([?/<]\\)" ; /blah/ or ?blah? or <file*glob>
- (setq b1 (if (match-beginning 10) 10 11)
- argument (buffer-substring
- (match-beginning b1) (match-end b1))
- b (point) ; end of qq etc
- i b
- c (char-after (match-beginning b1))
- bb (char-after (1- (match-beginning b1))) ; tmp holder
- ;; bb == "Not a stringy"
- bb (if (eq b1 10) ; user variables/whatever
- (and (memq bb (append "$@%*#_:-&>" nil)) ; $#y)
- (cond ((eq bb ?-) (eq c ?s)) ; -s file test
- ((eq bb ?\:) ; $opt::s
- (eq (char-after
- (- (match-beginning b1) 2))
- ?\:))
- ((eq bb ?\>) ; $foo->s
- (eq (char-after
- (- (match-beginning b1) 2))
- ?\-))
- ((eq bb ?\&)
- (not (eq (char-after ; &&m/blah/
- (- (match-beginning b1) 2))
- ?\&)))
- (t t)))
- ;; <file> or <$file>
- (and (eq c ?\<)
- ;; Do not stringify <FH>, <$fh> :
- (save-match-data
- (looking-at
- "\\$?\\([_a-zA-Z:][_a-zA-Z0-9:]*\\)?>"))))
- tb (match-beginning 0))
- (goto-char (match-beginning b1))
- (cperl-backward-to-noncomment (point-min))
- (or bb
- (if (eq b1 11) ; bare /blah/ or ?blah? or <foo>
- (setq argument ""
- b1 nil
- bb ; Not a regexp?
- (not
- ;; What is below: regexp-p?
- (and
- (or (memq (preceding-char)
- (append (if (memq c '(?\? ?\<))
- ;; $a++ ? 1 : 2
- "~{(=|&*!,;:["
- "~{(=|&+-*!,;:[") nil))
- (and (eq (preceding-char) ?\})
- (cperl-after-block-p (point-min)))
- (and (eq (char-syntax (preceding-char)) ?w)
- (progn
- (forward-sexp -1)
-;;; After these keywords `/' starts a RE. One should add all the
-;;; functions/builtins which expect an argument, but ...
- (if (eq (preceding-char) ?-)
- ;; -d ?foo? is a RE
- (looking-at "[a-zA-Z]\\>")
- (and
- (not (memq (preceding-char)
- '(?$ ?@ ?& ?%)))
- (looking-at
- "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\)\\>")))))
- (and (eq (preceding-char) ?.)
- (eq (char-after (- (point) 2)) ?.))
- (bobp))
- ;; m|blah| ? foo : bar;
- (not
- (and (eq c ?\?)
- cperl-use-syntax-table-text-property
- (not (bobp))
- (progn
- (forward-char -1)
- (looking-at "\\s|"))))))
- b (1- b))
- ;; s y tr m
- ;; Check for $a -> y
- (setq b1 (preceding-char)
- go (point))
- (if (and (eq b1 ?>)
- (eq (char-after (- go 2)) ?-))
- ;; Not a regexp
- (setq bb t))))
- (or bb
- (progn
- (goto-char b)
- (if (looking-at "[ \t\n\f]+\\(#[^\n]*\n[ \t\n\f]*\\)+")
- (goto-char (match-end 0))
- (skip-chars-forward " \t\n\f"))
- (cond ((and (eq (following-char) ?\})
- (eq b1 ?\{))
- ;; Check for $a[23]->{ s }, @{s} and *{s::foo}
- (goto-char (1- go))
- (skip-chars-backward " \t\n\f")
- (if (memq (preceding-char) (append "$@%&*" nil))
- (setq bb t) ; @{y}
- (condition-case nil
- (forward-sexp -1)
- (error nil)))
- (if (or bb
- (looking-at ; $foo -> {s}
- "[$@]\\$*\\([a-zA-Z0-9_:]+\\|[^{]\\)\\([ \t\n]*->\\)?[ \t\n]*{")
- (and ; $foo[12] -> {s}
- (memq (following-char) '(?\{ ?\[))
- (progn
- (forward-sexp 1)
- (looking-at "\\([ \t\n]*->\\)?[ \t\n]*{"))))
- (setq bb t)
- (goto-char b)))
- ((and (eq (following-char) ?=)
- (eq (char-after (1+ (point))) ?\>))
- ;; Check for { foo => 1, s => 2 }
- ;; Apparently s=> is never a substitution...
- (setq bb t))
- ((and (eq (following-char) ?:)
- (eq b1 ?\{) ; Check for $ { s::bar }
- (looking-at "::[a-zA-Z0-9_:]*[ \t\n\f]*}")
- (progn
- (goto-char (1- go))
- (skip-chars-backward " \t\n\f")
- (memq (preceding-char)
- (append "$@%&*" nil))))
- (setq bb t))
- ((eobp)
- (setq bb t)))))
- (if bb
- (goto-char i)
- ;; Skip whitespace and comments...
- (if (looking-at "[ \t\n\f]+\\(#[^\n]*\n[ \t\n\f]*\\)+")
- (goto-char (match-end 0))
- (skip-chars-forward " \t\n\f"))
- (if (> (point) b)
- (put-text-property b (point) 'syntax-type 'prestring))
- ;; qtag means two-arg matcher, may be reset to
- ;; 2 or 3 later if some special quoting is needed.
- ;; e1 means matching-char matcher.
- (setq b (point) ; before the first delimiter
- ;; has 2 args
- i2 (string-match "^\\([sy]\\|tr\\)$" argument)
- ;; We do not search to max, since we may be called from
- ;; some hook of fontification, and max is random
- i (cperl-forward-re stop-point end
- i2
- st-l err-l argument)
- ;; If `go', then it is considered as 1-arg, `b1' is nil
- ;; as in s/foo//x; the point is before final "slash"
- b1 (nth 1 i) ; start of the second part
- tag (nth 2 i) ; ender-char, true if second part
- ; is with matching chars []
- go (nth 4 i) ; There is a 1-char part after the end
- i (car i) ; intermediate point
- e1 (point) ; end
- ;; Before end of the second part if non-matching: ///
- tail (if (and i (not tag))
- (1- e1))
- e (if i i e1) ; end of the first part
- qtag nil ; need to preserve backslashitis
- is-x-REx nil is-o-REx nil); REx has //x //o modifiers
- ;; If s{} (), then b/b1 are at "{", "(", e1/i after ")", "}"
- ;; Commenting \\ is dangerous, what about ( ?
- (and i tail
- (eq (char-after i) ?\\)
- (setq qtag t))
- (and (if go (looking-at ".\\sw*x")
- (looking-at "\\sw*x")) ; qr//x
- (setq is-x-REx t))
- (and (if go (looking-at ".\\sw*o")
- (looking-at "\\sw*o")) ; //o
- (setq is-o-REx t))
- (if (null i)
- ;; Considered as 1arg form
- (progn
- (cperl-commentify b (point) t)
- (put-text-property b (point) 'syntax-type 'string)
- (if (or is-x-REx
- ;; ignore other text properties:
- (string-match "^qw$" argument))
- (put-text-property b (point) 'indentable t))
- (and go
- (setq e1 (cperl-1+ e1))
- (or (eobp)
- (forward-char 1))))
- (cperl-commentify b i t)
- (if (looking-at "\\sw*e") ; s///e
- (progn
- ;; Cache the syntax info...
- (setq cperl-syntax-state (cons state-point state))
- (and
- ;; silent:
- (car (cperl-find-pods-heres b1 (1- (point)) t end))
- ;; Error
- (goto-char (1+ max)))
- (if (and tag (eq (preceding-char) ?\>))
- (progn
- (cperl-modify-syntax-type (1- (point)) cperl-st-ket)
- (cperl-modify-syntax-type i cperl-st-bra)))
- (put-text-property b i 'syntax-type 'string)
- (put-text-property i (point) 'syntax-type 'multiline)
- (if is-x-REx
- (put-text-property b i 'indentable t)))
- (cperl-commentify b1 (point) t)
- (put-text-property b (point) 'syntax-type 'string)
- (if is-x-REx
- (put-text-property b i 'indentable t))
- (if qtag
- (cperl-modify-syntax-type (1+ i) cperl-st-punct))
- (setq tail nil)))
- ;; Now: tail: if the second part is non-matching without ///e
- (if (eq (char-syntax (following-char)) ?w)
- (progn
- (forward-word 1) ; skip modifiers s///s
- (if tail (cperl-commentify tail (point) t))
- (cperl-postpone-fontification
- e1 (point) 'face my-cperl-REx-modifiers-face)))
- ;; Check whether it is m// which means "previous match"
- ;; and highlight differently
- (setq is-REx
- (and (string-match "^\\([sm]?\\|qr\\)$" argument)
- (or (not (= (length argument) 0))
- (not (eq c ?\<)))))
- (if (and is-REx
- (eq e (+ 2 b))
- ;; split // *is* using zero-pattern
- (save-excursion
- (condition-case nil
- (progn
- (goto-char tb)
- (forward-sexp -1)
- (not (looking-at "split\\>")))
- (error t))))
- (cperl-postpone-fontification
- b e 'face font-lock-warning-face)
- (if (or i2 ; Has 2 args
- (and cperl-fontify-m-as-s
- (or
- (string-match "^\\(m\\|qr\\)$" argument)
- (and (eq 0 (length argument))
- (not (eq ?\< (char-after b)))))))
- (progn
- (cperl-postpone-fontification
- b (cperl-1+ b) 'face my-cperl-delimiters-face)
- (cperl-postpone-fontification
- (1- e) e 'face my-cperl-delimiters-face)))
- (if (and is-REx cperl-regexp-scan)
- ;; Process RExen: embedded comments, charclasses and ]
-;;;/\3333\xFg\x{FFF}a\ppp\PPP\qqq\C\99f(?{ foo })(??{ foo })/;
-;;;/a\.b[^a[:ff:]b]x$ab->$[|$,$ab->[cd]->[ef]|$ab[xy].|^${a,b}{c,d}/;
-;;;/(?<=foo)(?<!bar)(x)(?:$ab|\$\/)$|\\\b\x888\776\[\:$/xxx;
-;;;m?(\?\?{b,a})? + m/(??{aa})(?(?=xx)aa|bb)(?#aac)/;
-;;;m$(^ab[c]\$)$ + m+(^ab[c]\$\+)+ + m](^ab[c\]$|.+)] + m)(^ab[c]$|.+\));
-;;;m^a[\^b]c^ + m.a[^b]\.c.;
- (save-excursion
- (goto-char (1+ b))
- ;; First
- (cperl-look-at-leading-count is-x-REx e)
- (setq hairy-RE
- (concat
- (if is-x-REx
- (if (eq (char-after b) ?\#)
- "\\((\\?\\\\#\\)\\|\\(\\\\#\\)"
- "\\((\\?#\\)\\|\\(#\\)")
- ;; keep the same count: add a fake group
- (if (eq (char-after b) ?\#)
- "\\((\\?\\\\#\\)\\(\\)"
- "\\((\\?#\\)\\(\\)"))
- "\\|"
- "\\(\\[\\)" ; 3=[
- "\\|"
- "\\(]\\)" ; 4=]
- "\\|"
- ;; XXXX Will not be able to use it in s)))
- (if (eq (char-after b) ?\) )
- "\\())))\\)" ; Will never match
- (if (eq (char-after b) ?? )
- ;;"\\((\\\\\\?\\(\\\\\\?\\)?{\\)"
- "\\((\\\\\\?\\\\\\?{\\|()\\\\\\?{\\)"
- "\\((\\?\\??{\\)")) ; 5= (??{ (?{
- "\\|" ; 6= 0-length, 7: name, 8,9:code, 10:group
- "\\(" ;; XXXX 1-char variables, exc. |()\s
- "[$@]"
- "\\("
- "[_a-zA-Z:][_a-zA-Z0-9:]*"
- "\\|"
- "{[^{}]*}" ; only one-level allowed
- "\\|"
- "[^{(|) \t\r\n\f]"
- "\\)"
- "\\(" ;;8,9:code part of array/hash elt
- "\\(" "->" "\\)?"
- "\\[[^][]*\\]"
- "\\|"
- "{[^{}]*}"
- "\\)*"
- ;; XXXX: what if u is delim?
- "\\|"
- "[)^|$.*?+]"
- "\\|"
- "{[0-9]+}"
- "\\|"
- "{[0-9]+,[0-9]*}"
- "\\|"
- "\\\\[luLUEQbBAzZG]"
- "\\|"
- "(" ; Group opener
- "\\(" ; 10 group opener follower
- "\\?\\((\\?\\)" ; 11: in (?(?=C)A|B)
- "\\|"
- "\\?[:=!>?{]" ; "?" something
- "\\|"
- "\\?[-imsx]+[:)]" ; (?i) (?-s:.)
- "\\|"
- "\\?([0-9]+)" ; (?(1)foo|bar)
- "\\|"
- "\\?<[=!]"
- ;;;"\\|"
- ;;; "\\?"
- "\\)?"
- "\\)"
- "\\|"
- "\\\\\\(.\\)" ; 12=\SYMBOL
- ))
- (while
- (and (< (point) (1- e))
- (re-search-forward hairy-RE (1- e) 'to-end))
- (goto-char (match-beginning 0))
- (setq REx-subgr-start (point)
- was-subgr (following-char))
- (cond
- ((match-beginning 6) ; 0-length builtins, groups
- (goto-char (match-end 0))
- (if (match-beginning 11)
- (goto-char (match-beginning 11)))
- (if (>= (point) e)
- (goto-char (1- e)))
- (cperl-postpone-fontification
- (match-beginning 0) (point)
- 'face
- (cond
- ((eq was-subgr ?\) )
- (condition-case nil
- (save-excursion
- (forward-sexp -1)
- (if (> (point) b)
- (if (if (eq (char-after b) ?? )
- (looking-at "(\\\\\\?")
- (eq (char-after (1+ (point))) ?\?))
- my-cperl-REx-0length-face
- my-cperl-REx-ctl-face)
- font-lock-warning-face))
- (error font-lock-warning-face)))
- ((eq was-subgr ?\| )
- my-cperl-REx-ctl-face)
- ((eq was-subgr ?\$ )
- (if (> (point) (1+ REx-subgr-start))
- (progn
- (put-text-property
- (match-beginning 0) (point)
- 'REx-interpolated
- (if is-o-REx 0
- (if (and (eq (match-beginning 0)
- (1+ b))
- (eq (point)
- (1- e))) 1 t)))
- font-lock-variable-name-face)
- my-cperl-REx-spec-char-face))
- ((memq was-subgr (append "^." nil) )
- my-cperl-REx-spec-char-face)
- ((eq was-subgr ?\( )
- (if (not (match-beginning 10))
- my-cperl-REx-ctl-face
- my-cperl-REx-0length-face))
- (t my-cperl-REx-0length-face)))
- (if (and (memq was-subgr (append "(|" nil))
- (not (string-match "(\\?[-imsx]+)"
- (match-string 0))))
- (cperl-look-at-leading-count is-x-REx e))
- (setq was-subgr nil)) ; We do stuff here
- ((match-beginning 12) ; \SYMBOL
- (forward-char 2)
- (if (>= (point) e)
- (goto-char (1- e))
- ;; How many chars to not highlight:
- ;; 0-len special-alnums in other branch =>
- ;; Generic: \non-alnum (1), \alnum (1+face)
- ;; Is-delim: \non-alnum (1/spec-2) alnum-1 (=what hai)
- (setq REx-subgr-start (point)
- qtag (preceding-char))
- (cperl-postpone-fontification
- (- (point) 2) (- (point) 1) 'face
- (if (memq qtag
- (append "ghijkmoqvFHIJKMORTVY" nil))
- font-lock-warning-face
- my-cperl-REx-0length-face))
- (if (and (eq (char-after b) qtag)
- (memq qtag (append ".])^$|*?+" nil)))
- (progn
- (if (and cperl-use-syntax-table-text-property
- (eq qtag ?\) ))
- (put-text-property
- REx-subgr-start (1- (point))
- 'syntax-table cperl-st-punct))
- (cperl-postpone-fontification
- (1- (point)) (point) 'face
- ; \] can't appear below
- (if (memq qtag (append ".]^$" nil))
- 'my-cperl-REx-spec-char-face
- (if (memq qtag (append "*?+" nil))
- 'my-cperl-REx-0length-face
- 'my-cperl-REx-ctl-face))))) ; )|
- ;; Test for arguments:
- (cond
- ;; This is not pretty: the 5.8.7 logic:
- ;; \0numx -> octal (up to total 3 dig)
- ;; \DIGIT -> backref unless \0
- ;; \DIGITs -> backref if legal
- ;; otherwise up to 3 -> octal
- ;; Do not try to distinguish, we guess
- ((or (and (memq qtag (append "01234567" nil))
- (re-search-forward
- "\\=[01234567]?[01234567]?"
- (1- e) 'to-end))
- (and (memq qtag (append "89" nil))
- (re-search-forward
- "\\=[0123456789]*" (1- e) 'to-end))
- (and (eq qtag ?x)
- (re-search-forward
- "\\=[0-9a-fA-F][0-9a-fA-F]?\\|\\={[0-9a-fA-F]+}"
- (1- e) 'to-end))
- (and (memq qtag (append "pPN" nil))
- (re-search-forward "\\={[^{}]+}\\|."
- (1- e) 'to-end))
- (eq (char-syntax qtag) ?w))
- (cperl-postpone-fontification
- (1- REx-subgr-start) (point)
- 'face my-cperl-REx-length1-face))))
- (setq was-subgr nil)) ; We do stuff here
- ((match-beginning 3) ; [charclass]
- (forward-char 1)
- (if (eq (char-after b) ?^ )
- (and (eq (following-char) ?\\ )
- (eq (char-after (cperl-1+ (point)))
- ?^ )
- (forward-char 2))
- (and (eq (following-char) ?^ )
- (forward-char 1)))
- (setq argument b ; continue?
- tag nil ; list of POSIX classes
- qtag (point))
- (if (eq (char-after b) ?\] )
- (and (eq (following-char) ?\\ )
- (eq (char-after (cperl-1+ (point)))
- ?\] )
- (setq qtag (1+ qtag))
- (forward-char 2))
- (and (eq (following-char) ?\] )
- (forward-char 1)))
- ;; Apparently, I can't put \] into a charclass
- ;; in m]]: m][\\\]\]] produces [\\]]
-;;; POSIX? [:word:] [:^word:] only inside []
-;;; "\\=\\(\\\\.\\|[^][\\\\]\\|\\[:\\^?\sw+:]\\|\\[[^:]\\)*]")
- (while
- (and argument
- (re-search-forward
- (if (eq (char-after b) ?\] )
- "\\=\\(\\\\[^]]\\|[^]\\\\]\\)*\\\\]"
- "\\=\\(\\\\.\\|[^]\\\\]\\)*]")
- (1- e) 'toend))
- ;; Is this ] an end of POSIX class?
- (if (save-excursion
- (and
- (search-backward "[" argument t)
- (< REx-subgr-start (point))
- (not
- (and ; Should work with delim = \
- (eq (preceding-char) ?\\ )
- (= (% (skip-chars-backward
- "\\\\") 2) 0)))
- (looking-at
- (cond
- ((eq (char-after b) ?\] )
- "\\\\*\\[:\\^?\\sw+:\\\\\\]")
- ((eq (char-after b) ?\: )
- "\\\\*\\[\\\\:\\^?\\sw+\\\\:]")
- ((eq (char-after b) ?^ )
- "\\\\*\\[:\\(\\\\\\^\\)?\\sw+:\]")
- ((eq (char-syntax (char-after b))
- ?w)
- (concat
- "\\\\*\\[:\\(\\\\\\^\\)?\\(\\\\"
- (char-to-string (char-after b))
- "\\|\\sw\\)+:\]"))
- (t "\\\\*\\[:\\^?\\sw*:]")))
- (setq argument (point))))
- (setq tag (cons (cons argument (point))
- tag)
- argument (point)) ; continue
- (setq argument nil)))
- (and argument
- (message "Couldn't find end of charclass in a REx, pos=%s"
- REx-subgr-start))
- (if (and cperl-use-syntax-table-text-property
- (> (- (point) 2) REx-subgr-start))
- (put-text-property
- (1+ REx-subgr-start) (1- (point))
- 'syntax-table cperl-st-punct))
- (cperl-postpone-fontification
- REx-subgr-start qtag
- 'face my-cperl-REx-spec-char-face)
- (cperl-postpone-fontification
- (1- (point)) (point) 'face
- my-cperl-REx-spec-char-face)
- (if (eq (char-after b) ?\] )
- (cperl-postpone-fontification
- (- (point) 2) (1- (point))
- 'face my-cperl-REx-0length-face))
- (while tag
- (cperl-postpone-fontification
- (car (car tag)) (cdr (car tag))
- 'face my-cperl-REx-length1-face)
- (setq tag (cdr tag)))
- (setq was-subgr nil)) ; did facing already
- ;; Now rare stuff:
- ((and (match-beginning 2) ; #-comment
- (/= (match-beginning 2) (match-end 2)))
- (beginning-of-line 2)
- (if (> (point) e)
- (goto-char (1- e))))
- ((match-beginning 4) ; character "]"
- (setq was-subgr nil) ; We do stuff here
- (goto-char (match-end 0))
- (if cperl-use-syntax-table-text-property
- (put-text-property
- (1- (point)) (point)
- 'syntax-table cperl-st-punct))
- (cperl-postpone-fontification
- (1- (point)) (point)
- 'face font-lock-warning-face))
- ((match-beginning 5) ; before (?{}) (??{})
- (setq tag (match-end 0))
- (if (or (setq qtag
- (cperl-forward-group-in-re st-l))
- (and (>= (point) e)
- (setq qtag "no matching `)' found"))
- (and (not (eq (char-after (- (point) 2))
- ?\} ))
- (setq qtag "Can't find })")))
- (progn
- (goto-char (1- e))
- (message qtag))
- (cperl-postpone-fontification
- (1- tag) (1- (point))
- 'face font-lock-variable-name-face)
- (cperl-postpone-fontification
- REx-subgr-start (1- tag)
- 'face my-cperl-REx-spec-char-face)
- (cperl-postpone-fontification
- (1- (point)) (point)
- 'face my-cperl-REx-spec-char-face)
- (if cperl-use-syntax-table-text-property
- (progn
- (put-text-property
- (- (point) 2) (1- (point))
- 'syntax-table cperl-st-cfence)
- (put-text-property
- (+ REx-subgr-start 2)
- (+ REx-subgr-start 3)
- 'syntax-table cperl-st-cfence))))
- (setq was-subgr nil))
- (t ; (?#)-comment
- ;; Inside "(" and "\" arn't special in any way
- ;; Works also if the outside delimiters are ().
- (or;;(if (eq (char-after b) ?\) )
- ;;(re-search-forward
- ;; "[^\\\\]\\(\\\\\\\\\\)*\\\\)"
- ;; (1- e) 'toend)
- (search-forward ")" (1- e) 'toend)
- ;;)
- (message
- "Couldn't find end of (?#...)-comment in a REx, pos=%s"
- REx-subgr-start))))
- (if (>= (point) e)
- (goto-char (1- e)))
- (cond
- (was-subgr
- (setq REx-subgr-end (point))
- (cperl-commentify
- REx-subgr-start REx-subgr-end nil)
- (cperl-postpone-fontification
- REx-subgr-start REx-subgr-end
- 'face font-lock-comment-face))))))
- (if (and is-REx is-x-REx)
- (put-text-property (1+ b) (1- e)
- 'syntax-subtype 'x-REx)))
- (if (and i2 e1 b1 (> e1 b1))
- (progn ; No errors finding the second part...
- (cperl-postpone-fontification
- (1- e1) e1 'face my-cperl-delimiters-face)
- (if (assoc (char-after b) cperl-starters)
- (progn
- (cperl-postpone-fontification
- b1 (1+ b1) 'face my-cperl-delimiters-face)
- (put-text-property b1 (1+ b1)
- 'REx-part2 t)))))
- (if (> (point) max)
- (setq tmpend tb))))
- ((match-beginning 17) ; sub with prototype or attribute
- ;; 1+6+2+1+1=11 extra () before this (sub with proto/attr):
- ;;"\\<sub\\>\\(" ;12
- ;; cperl-white-and-comment-rex ;13
- ;; "\\([a-zA-Z_:'0-9]+\\)\\)?" ; name ;14
- ;;"\\(" cperl-maybe-white-and-comment-rex ;15,16
- ;; "\\(([^()]*)\\|:[^:]\\)\\)" ; 17:proto or attribute start
- (setq b1 (match-beginning 14) e1 (match-end 14))
- (if (memq (char-after (1- b))
- '(?\$ ?\@ ?\% ?\& ?\*))
- nil
- (goto-char b)
- (if (eq (char-after (match-beginning 17)) ?\( )
- (progn
- (cperl-commentify ; Prototypes; mark as string
- (match-beginning 17) (match-end 17) t)
- (goto-char (match-end 0))
- ;; Now look for attributes after prototype:
- (forward-comment (buffer-size))
- (and (looking-at ":[^:]")
- (cperl-find-sub-attrs st-l b1 e1 b)))
- ;; treat attributes without prototype
- (goto-char (match-beginning 17))
- (cperl-find-sub-attrs st-l b1 e1 b))))
- ;; 1+6+2+1+1+6+1=18 extra () before this:
- ;; "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'")
- ((match-beginning 19) ; old $abc'efg syntax
- (setq bb (match-end 0))
- ;;;(if (nth 3 state) nil ; in string
- (put-text-property (1- bb) bb 'syntax-table cperl-st-word)
- (goto-char bb))
- ;; 1+6+2+1+1+6+1+1=19 extra () before this:
- ;; "__\\(END\\|DATA\\)__"
- ((match-beginning 20) ; __END__, __DATA__
- (setq bb (match-end 0))
- ;; (put-text-property b (1+ bb) 'syntax-type 'pod) ; Cheat
- (cperl-commentify b bb nil)
- (setq end t))
- ;; "\\\\\\(['`\"($]\\)"
- ((match-beginning 21)
- ;; Trailing backslash; make non-quoting outside string/comment
- (setq bb (match-end 0))
- (goto-char b)
- (skip-chars-backward "\\\\")
- ;;;(setq i2 (= (% (skip-chars-backward "\\\\") 2) -1))
- (cperl-modify-syntax-type b cperl-st-punct)
- (goto-char bb))
- (t (error "Error in regexp of the sniffer")))
- (if (> (point) stop-point)
- (progn
- (if end
- (message "Garbage after __END__/__DATA__ ignored")
- (message "Unbalanced syntax found while scanning")
- (or (car err-l) (setcar err-l b)))
- (goto-char stop-point))))
- (setq cperl-syntax-state (cons state-point state)
- ;; Do not mark syntax as done past tmpend???
- cperl-syntax-done-to (or tmpend (max (point) max)))
- ;;(message "state-at=%s, done-to=%s" state-point cperl-syntax-done-to)
- )
- (if (car err-l) (goto-char (car err-l))
- (or non-inter
- (message "Scanning for \"hard\" Perl constructions... done"))))
- (and (buffer-modified-p)
- (not modified)
- (set-buffer-modified-p nil))
- (set-syntax-table cperl-mode-syntax-table))
- (list (car err-l) overshoot)))
-
-(defun cperl-find-pods-heres-region (min max)
- (interactive "r")
- (cperl-find-pods-heres min max))
-
-(defun cperl-backward-to-noncomment (lim)
- ;; Stops at lim or after non-whitespace that is not in comment
- ;; XXXX Wrongly understands end-of-multiline strings with # as comment
- (let (stop p pr)
- (while (and (not stop) (> (point) (or lim (point-min))))
- (skip-chars-backward " \t\n\f" lim)
- (setq p (point))
- (beginning-of-line)
- (if (memq (setq pr (get-text-property (point) 'syntax-type))
- '(pod here-doc here-doc-delim))
- (progn
- (cperl-unwind-to-safe nil)
- (setq pr (get-text-property (point) 'syntax-type))))
- (or (and (looking-at "^[ \t]*\\(#\\|$\\)")
- (not (memq pr '(string prestring))))
- (progn (cperl-to-comment-or-eol) (bolp))
- (progn
- (skip-chars-backward " \t")
- (if (< p (point)) (goto-char p))
- (setq stop t))))))
-
-;; Used only in `cperl-calculate-indent'...
-(defun cperl-block-p () ; Do not C-M-q ! One string contains ";" !
- ;; Positions is before ?\{. Checks whether it starts a block.
- ;; No save-excursion! This is more a distinguisher of a block/hash ref...
- (cperl-backward-to-noncomment (point-min))
- (or (memq (preceding-char) (append ";){}$@&%\C-@" nil)) ; Or label! \C-@ at bobp
- ; Label may be mixed up with `$blah :'
- (save-excursion (cperl-after-label))
- (get-text-property (cperl-1- (point)) 'attrib-group)
- (and (memq (char-syntax (preceding-char)) '(?w ?_))
- (progn
- (backward-sexp)
- ;; sub {BLK}, print {BLK} $data, but NOT `bless', `return', `tr'
- (or (and (looking-at "[a-zA-Z0-9_:]+[ \t\n\f]*[{#]") ; Method call syntax
- (not (looking-at "\\(bless\\|return\\|q[wqrx]?\\|tr\\|[smy]\\)\\>")))
- ;; sub bless::foo {}
- (progn
- (cperl-backward-to-noncomment (point-min))
- (and (eq (preceding-char) ?b)
- (progn
- (forward-sexp -1)
- (looking-at "sub[ \t\n\f#]")))))))))
-
-;;; What is the difference of (cperl-after-block-p lim t) and (cperl-block-p)?
-;;; No save-excursion; condition-case ... In (cperl-block-p) the block
-;;; may be a part of an in-statement construct, such as
-;;; ${something()}, print {FH} $data.
-;;; Moreover, one takes positive approach (looks for else,grep etc)
-;;; another negative (looks for bless,tr etc)
-(defun cperl-after-block-p (lim &optional pre-block)
- "Return true if the preceeding } (if PRE-BLOCK, following {) delimits a block.
-Would not look before LIM. Assumes that LIM is a good place to begin a
-statement. The kind of block we treat here is one after which a new
-statement would start; thus the block in ${func()} does not count."
- (save-excursion
- (condition-case nil
- (progn
- (or pre-block (forward-sexp -1))
- (cperl-backward-to-noncomment lim)
- (or (eq (point) lim)
- ;; if () {} // sub f () {} // sub f :a(') {}
- (eq (preceding-char) ?\) )
- ;; label: {}
- (save-excursion (cperl-after-label))
- ;; sub :attr {}
- (get-text-property (cperl-1- (point)) 'attrib-group)
- (if (memq (char-syntax (preceding-char)) '(?w ?_)) ; else {}
- (save-excursion
- (forward-sexp -1)
- ;; else {} but not else::func {}
- (or (and (looking-at "\\(else\\|continue\\|grep\\|map\\|BEGIN\\|END\\|CHECK\\|INIT\\)\\>")
- (not (looking-at "\\(\\sw\\|_\\)+::")))
- ;; sub f {}
- (progn
- (cperl-backward-to-noncomment lim)
- (and (eq (preceding-char) ?b)
- (progn
- (forward-sexp -1)
- (looking-at "sub[ \t\n\f#]"))))))
- ;; What preceeds is not word... XXXX Last statement in sub???
- (cperl-after-expr-p lim))))
- (error nil))))
-
-(defun cperl-after-expr-p (&optional lim chars test)
- "Return true if the position is good for start of expression.
-TEST is the expression to evaluate at the found position. If absent,
-CHARS is a string that contains good characters to have before us (however,
-`}' is treated \"smartly\" if it is not in the list)."
- (let ((lim (or lim (point-min)))
- stop p pr)
- (cperl-update-syntaxification (point) (point))
- (save-excursion
- (while (and (not stop) (> (point) lim))
- (skip-chars-backward " \t\n\f" lim)
- (setq p (point))
- (beginning-of-line)
- ;;(memq (setq pr (get-text-property (point) 'syntax-type))
- ;; '(pod here-doc here-doc-delim))
- (if (get-text-property (point) 'here-doc-group)
- (progn
- (goto-char
- (cperl-beginning-of-property (point) 'here-doc-group))
- (beginning-of-line 0)))
- (if (get-text-property (point) 'in-pod)
- (progn
- (goto-char
- (cperl-beginning-of-property (point) 'in-pod))
- (beginning-of-line 0)))
- (if (looking-at "^[ \t]*\\(#\\|$\\)") nil ; Only comment, skip
- ;; Else: last iteration, or a label
- (cperl-to-comment-or-eol) ; Will not move past "." after a format
- (skip-chars-backward " \t")
- (if (< p (point)) (goto-char p))
- (setq p (point))
- (if (and (eq (preceding-char) ?:)
- (progn
- (forward-char -1)
- (skip-chars-backward " \t\n\f" lim)
- (memq (char-syntax (preceding-char)) '(?w ?_))))
- (forward-sexp -1) ; Possibly label. Skip it
- (goto-char p)
- (setq stop t))))
- (or (bobp) ; ???? Needed
- (eq (point) lim)
- (looking-at "[ \t]*__\\(END\\|DATA\\)__") ; After this anything goes
- (progn
- (if test (eval test)
- (or (memq (preceding-char) (append (or chars "{;") nil))
- (and (eq (preceding-char) ?\})
- (cperl-after-block-p lim))
- (and (eq (following-char) ?.) ; in format: see comment above
- (eq (get-text-property (point) 'syntax-type)
- 'format)))))))))
-
-(defun cperl-backward-to-start-of-expr (&optional lim)
- (condition-case nil
- (progn
- (while (and (or (not lim)
- (> (point) lim))
- (not (cperl-after-expr-p lim)))
- (forward-sexp -1)
- ;; May be after $, @, $# etc of a variable
- (skip-chars-backward "$@%#")))
- (error nil)))
-
-(defun cperl-at-end-of-expr (&optional lim)
- ;; Since the SEXP approach below is very fragile, do some overengineering
- (or (looking-at (concat cperl-maybe-white-and-comment-rex "[;}]"))
- (condition-case nil
- (save-excursion
- ;; If nothing interesting after, does as (forward-sexp -1);
- ;; otherwise fails, or ends at a start of following sexp.
- ;; XXXX PROBLEMS: if what follows (after ";") @FOO, or ${bar}
- ;; may be stuck after @ or $; just put some stupid workaround now:
- (let ((p (point)))
- (forward-sexp 1)
- (forward-sexp -1)
- (while (memq (preceding-char) (append "%&@$*" nil))
- (forward-char -1))
- (or (< (point) p)
- (cperl-after-expr-p lim))))
- (error t))))
-
-(defun cperl-forward-to-end-of-expr (&optional lim)
- (let ((p (point))))
- (condition-case nil
- (progn
- (while (and (< (point) (or lim (point-max)))
- (not (cperl-at-end-of-expr)))
- (forward-sexp 1)))
- (error nil)))
-
-(defun cperl-backward-to-start-of-continued-exp (lim)
- (if (memq (preceding-char) (append ")]}\"'`" nil))
- (forward-sexp -1))
- (beginning-of-line)
- (if (<= (point) lim)
- (goto-char (1+ lim)))
- (skip-chars-forward " \t"))
-
-(defun cperl-after-block-and-statement-beg (lim)
- ;; We assume that we are after ?\}
- (and
- (cperl-after-block-p lim)
- (save-excursion
- (forward-sexp -1)
- (cperl-backward-to-noncomment (point-min))
- (or (bobp)
- (eq (point) lim)
- (not (= (char-syntax (preceding-char)) ?w))
- (progn
- (forward-sexp -1)
- (not
- (looking-at
- "\\(map\\|grep\\|printf?\\|system\\|exec\\|tr\\|s\\)\\>")))))))
-
-\f
-(defvar innerloop-done nil)
-(defvar last-depth nil)
-
-(defun cperl-indent-exp ()
- "Simple variant of indentation of continued-sexp.
-
-Will not indent comment if it starts at `comment-indent' or looks like
-continuation of the comment on the previous line.
-
-If `cperl-indent-region-fix-constructs', will improve spacing on
-conditional/loop constructs."
- (interactive)
- (save-excursion
- (let ((tmp-end (progn (end-of-line) (point))) top done)
- (save-excursion
- (beginning-of-line)
- (while (null done)
- (setq top (point))
- ;; Plan A: if line has an unfinished paren-group, go to end-of-group
- (while (= -1 (nth 0 (parse-partial-sexp (point) tmp-end -1)))
- (setq top (point))) ; Get the outermost parenths in line
- (goto-char top)
- (while (< (point) tmp-end)
- (parse-partial-sexp (point) tmp-end nil t) ; To start-sexp or eol
- (or (eolp) (forward-sexp 1)))
- (if (> (point) tmp-end) ; Yes, there an unfinished block
- nil
- (if (eq ?\) (preceding-char))
- (progn ;; Plan B: find by REGEXP block followup this line
- (setq top (point))
- (condition-case nil
- (progn
- (forward-sexp -2)
- (if (eq (following-char) ?$ ) ; for my $var (list)
- (progn
- (forward-sexp -1)
- (if (looking-at "\\(my\\|local\\|our\\)\\>")
- (forward-sexp -1))))
- (if (looking-at
- (concat "\\(\\elsif\\|if\\|unless\\|while\\|until"
- "\\|for\\(each\\)?\\>\\(\\("
- cperl-maybe-white-and-comment-rex
- "\\(my\\|local\\|our\\)\\)?"
- cperl-maybe-white-and-comment-rex
- "\\$[_a-zA-Z0-9]+\\)?\\)\\>"))
- (progn
- (goto-char top)
- (forward-sexp 1)
- (setq top (point)))))
- (error (setq done t)))
- (goto-char top))
- (if (looking-at ; Try Plan C: continuation block
- (concat cperl-maybe-white-and-comment-rex
- "\\<\\(else\\|elsif\|continue\\)\\>"))
- (progn
- (goto-char (match-end 0))
- (save-excursion
- (end-of-line)
- (setq tmp-end (point))))
- (setq done t))))
- (save-excursion
- (end-of-line)
- (setq tmp-end (point))))
- (goto-char tmp-end)
- (setq tmp-end (point-marker)))
- (if cperl-indent-region-fix-constructs
- (cperl-fix-line-spacing tmp-end))
- (cperl-indent-region (point) tmp-end))))
-
-(defun cperl-fix-line-spacing (&optional end parse-data)
- "Improve whitespace in a conditional/loop construct.
-Returns some position at the last line."
- (interactive)
- (or end
- (setq end (point-max)))
- (let ((ee (save-excursion (end-of-line) (point)))
- (cperl-indent-region-fix-constructs
- (or cperl-indent-region-fix-constructs 1))
- p pp ml have-brace ret)
- (save-excursion
- (beginning-of-line)
- (setq ret (point))
- ;; }? continue
- ;; blah; }
- (if (not
- (or (looking-at "[ \t]*\\(els\\(e\\|if\\)\\|continue\\|if\\|while\\|for\\(each\\)?\\|until\\)")
- (setq have-brace (save-excursion (search-forward "}" ee t)))))
- nil ; Do not need to do anything
- ;; Looking at:
- ;; }
- ;; else
- (if cperl-merge-trailing-else
- (if (looking-at
- "[ \t]*}[ \t]*\n[ \t\n]*\\(els\\(e\\|if\\)\\|continue\\)\\>")
- (progn
- (search-forward "}")
- (setq p (point))
- (skip-chars-forward " \t\n")
- (delete-region p (point))
- (insert (make-string cperl-indent-region-fix-constructs ?\ ))
- (beginning-of-line)))
- (if (looking-at "[ \t]*}[ \t]*\\(els\\(e\\|if\\)\\|continue\\)\\>")
- (save-excursion
- (search-forward "}")
- (delete-horizontal-space)
- (insert "\n")
- (setq ret (point))
- (if (cperl-indent-line parse-data)
- (progn
- (cperl-fix-line-spacing end parse-data)
- (setq ret (point)))))))
- ;; Looking at:
- ;; } else
- (if (looking-at "[ \t]*}\\(\t*\\|[ \t][ \t]+\\)\\<\\(els\\(e\\|if\\)\\|continue\\)\\>")
- (progn
- (search-forward "}")
- (delete-horizontal-space)
- (insert (make-string cperl-indent-region-fix-constructs ?\ ))
- (beginning-of-line)))
- ;; Looking at:
- ;; else {
- (if (looking-at
- "[ \t]*}?[ \t]*\\<\\(\\els\\(e\\|if\\)\\|continue\\|unless\\|if\\|while\\|for\\(each\\)?\\|until\\)\\>\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]")
- (progn
- (forward-word 1)
- (delete-horizontal-space)
- (insert (make-string cperl-indent-region-fix-constructs ?\ ))
- (beginning-of-line)))
- ;; Looking at:
- ;; foreach my $var
- (if (looking-at
- "[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\|our\\)\\(\t*\\|[ \t][ \t]+\\)[^ \t\n]")
- (progn
- (forward-word 2)
- (delete-horizontal-space)
- (insert (make-string cperl-indent-region-fix-constructs ?\ ))
- (beginning-of-line)))
- ;; Looking at:
- ;; foreach my $var (
- (if (looking-at
- "[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\|our\\)[ \t]*\\$[_a-zA-Z0-9]+\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]")
- (progn
- (forward-sexp 3)
- (delete-horizontal-space)
- (insert
- (make-string cperl-indent-region-fix-constructs ?\ ))
- (beginning-of-line)))
- ;; Looking at (with or without "}" at start, ending after "({"):
- ;; } foreach my $var () OR {
- (if (looking-at
- "[ \t]*\\(}[ \t]*\\)?\\<\\(\\els\\(e\\|if\\)\\|continue\\|if\\|unless\\|while\\|for\\(each\\)?\\(\\([ \t]+\\(my\\|local\\|our\\)\\)?[ \t]*\\$[_a-zA-Z0-9]+\\)?\\|until\\)\\>\\([ \t]*(\\|[ \t\n]*{\\)\\|[ \t]*{")
- (progn
- (setq ml (match-beginning 8)) ; "(" or "{" after control word
- (re-search-forward "[({]")
- (forward-char -1)
- (setq p (point))
- (if (eq (following-char) ?\( )
- (progn
- (forward-sexp 1)
- (setq pp (point))) ; past parenth-group
- ;; after `else' or nothing
- (if ml ; after `else'
- (skip-chars-backward " \t\n")
- (beginning-of-line))
- (setq pp nil))
- ;; Now after the sexp before the brace
- ;; Multiline expr should be special
- (setq ml (and pp (save-excursion (goto-char p)
- (search-forward "\n" pp t))))
- (if (and (or (not pp) (< pp end)) ; Do not go too far...
- (looking-at "[ \t\n]*{"))
- (progn
- (cond
- ((bolp) ; Were before `{', no if/else/etc
- nil)
- ((looking-at "\\(\t*\\| [ \t]+\\){") ; Not exactly 1 SPACE
- (delete-horizontal-space)
- (if (if ml
- cperl-extra-newline-before-brace-multiline
- cperl-extra-newline-before-brace)
- (progn
- (delete-horizontal-space)
- (insert "\n")
- (setq ret (point))
- (if (cperl-indent-line parse-data)
- (progn
- (cperl-fix-line-spacing end parse-data)
- (setq ret (point)))))
- (insert
- (make-string cperl-indent-region-fix-constructs ?\ ))))
- ((and (looking-at "[ \t]*\n")
- (not (if ml
- cperl-extra-newline-before-brace-multiline
- cperl-extra-newline-before-brace)))
- (setq pp (point))
- (skip-chars-forward " \t\n")
- (delete-region pp (point))
- (insert
- (make-string cperl-indent-region-fix-constructs ?\ )))
- ((and (looking-at "[\t ]*{")
- (if ml cperl-extra-newline-before-brace-multiline
- cperl-extra-newline-before-brace))
- (delete-horizontal-space)
- (insert "\n")
- (setq ret (point))
- (if (cperl-indent-line parse-data)
- (progn
- (cperl-fix-line-spacing end parse-data)
- (setq ret (point))))))
- ;; Now we are before `{'
- (if (looking-at "[ \t\n]*{[ \t]*[^ \t\n#]")
- (progn
- (skip-chars-forward " \t\n")
- (setq pp (point))
- (forward-sexp 1)
- (setq p (point))
- (goto-char pp)
- (setq ml (search-forward "\n" p t))
- (if (or cperl-break-one-line-blocks-when-indent ml)
- ;; not good: multi-line BLOCK
- (progn
- (goto-char (1+ pp))
- (delete-horizontal-space)
- (insert "\n")
- (setq ret (point))
- (if (cperl-indent-line parse-data)
- (setq ret (cperl-fix-line-spacing end parse-data)))))))))))
- (beginning-of-line)
- (setq p (point) pp (save-excursion (end-of-line) (point))) ; May be different from ee.
- ;; Now check whether there is a hanging `}'
- ;; Looking at:
- ;; } blah
- (if (and
- cperl-fix-hanging-brace-when-indent
- have-brace
- (not (looking-at "[ \t]*}[ \t]*\\(\\<\\(els\\(if\\|e\\)\\|continue\\|while\\|until\\)\\>\\|$\\|#\\)"))
- (condition-case nil
- (progn
- (up-list 1)
- (if (and (<= (point) pp)
- (eq (preceding-char) ?\} )
- (cperl-after-block-and-statement-beg (point-min)))
- t
- (goto-char p)
- nil))
- (error nil)))
- (progn
- (forward-char -1)
- (skip-chars-backward " \t")
- (if (bolp)
- ;; `}' was the first thing on the line, insert NL *after* it.
- (progn
- (cperl-indent-line parse-data)
- (search-forward "}")
- (delete-horizontal-space)
- (insert "\n"))
- (delete-horizontal-space)
- (or (eq (preceding-char) ?\;)
- (bolp)
- (and (eq (preceding-char) ?\} )
- (cperl-after-block-p (point-min)))
- (insert ";"))
- (insert "\n")
- (setq ret (point)))
- (if (cperl-indent-line parse-data)
- (setq ret (cperl-fix-line-spacing end parse-data)))
- (beginning-of-line)))))
- ret))
-
-(defvar cperl-update-start) ; Do not need to make them local
-(defvar cperl-update-end)
-(defun cperl-delay-update-hook (beg end old-len)
- (setq cperl-update-start (min beg (or cperl-update-start (point-max))))
- (setq cperl-update-end (max end (or cperl-update-end (point-min)))))
-
-(defun cperl-indent-region (start end)
- "Simple variant of indentation of region in CPerl mode.
-Should be slow. Will not indent comment if it starts at `comment-indent'
-or looks like continuation of the comment on the previous line.
-Indents all the lines whose first character is between START and END
-inclusive.
-
-If `cperl-indent-region-fix-constructs', will improve spacing on
-conditional/loop constructs."
- (interactive "r")
- (cperl-update-syntaxification end end)
- (save-excursion
- (let (cperl-update-start cperl-update-end (h-a-c after-change-functions))
- (let ((indent-info (if cperl-emacs-can-parse
- (list nil nil nil) ; Cannot use '(), since will modify
- nil))
- (pm 0) (imenu-scanning-message "Indenting... (%3d%%)")
- after-change-functions ; Speed it up!
- st comm old-comm-indent new-comm-indent p pp i empty)
- (if h-a-c (add-hook 'after-change-functions 'cperl-delay-update-hook))
- (goto-char start)
- (setq old-comm-indent (and (cperl-to-comment-or-eol)
- (current-column))
- new-comm-indent old-comm-indent)
- (goto-char start)
- (setq end (set-marker (make-marker) end)) ; indentation changes pos
- (or (bolp) (beginning-of-line 2))
- (or (fboundp 'imenu-progress-message)
- (message "Indenting... For feedback load `imenu'..."))
- (while (and (<= (point) end) (not (eobp))) ; bol to check start
- (and (fboundp 'imenu-progress-message)
- (imenu-progress-message
- pm (/ (* 100 (- (point) start)) (- end start -1))))
- (setq st (point))
- (if (or
- (setq empty (looking-at "[ \t]*\n"))
- (and (setq comm (looking-at "[ \t]*#"))
- (or (eq (current-indentation) (or old-comm-indent
- comment-column))
- (setq old-comm-indent nil))))
- (if (and old-comm-indent
- (not empty)
- (= (current-indentation) old-comm-indent)
- (not (eq (get-text-property (point) 'syntax-type) 'pod))
- (not (eq (get-text-property (point) 'syntax-table)
- cperl-st-cfence)))
- (let ((comment-column new-comm-indent))
- (indent-for-comment)))
- (progn
- (setq i (cperl-indent-line indent-info))
- (or comm
- (not i)
- (progn
- (if cperl-indent-region-fix-constructs
- (goto-char (cperl-fix-line-spacing end indent-info)))
- (if (setq old-comm-indent
- (and (cperl-to-comment-or-eol)
- (not (memq (get-text-property (point)
- 'syntax-type)
- '(pod here-doc)))
- (not (eq (get-text-property (point)
- 'syntax-table)
- cperl-st-cfence))
- (current-column)))
- (progn (indent-for-comment)
- (skip-chars-backward " \t")
- (skip-chars-backward "#")
- (setq new-comm-indent (current-column))))))))
- (beginning-of-line 2))
- (if (fboundp 'imenu-progress-message)
- (imenu-progress-message pm 100)
- (message nil)))
- ;; Now run the update hooks
- (and after-change-functions
- cperl-update-end
- (save-excursion
- (goto-char cperl-update-end)
- (insert " ")
- (delete-char -1)
- (goto-char cperl-update-start)
- (insert " ")
- (delete-char -1))))))
-
-;; Stolen from lisp-mode with a lot of improvements
-
-(defun cperl-fill-paragraph (&optional justify iteration)
- "Like \\[fill-paragraph], but handle CPerl comments.
-If any of the current line is a comment, fill the comment or the
-block of it that point is in, preserving the comment's initial
-indentation and initial hashes. Behaves usually outside of comment."
- (interactive "P")
- (let (;; Non-nil if the current line contains a comment.
- has-comment
- fill-paragraph-function ; do not recurse
- ;; If has-comment, the appropriate fill-prefix for the comment.
- comment-fill-prefix
- ;; Line that contains code and comment (or nil)
- start
- c spaces len dc (comment-column comment-column))
- ;; Figure out what kind of comment we are looking at.
- (save-excursion
- (beginning-of-line)
- (cond
-
- ;; A line with nothing but a comment on it?
- ((looking-at "[ \t]*#[# \t]*")
- (setq has-comment t
- comment-fill-prefix (buffer-substring (match-beginning 0)
- (match-end 0))))
-
- ;; A line with some code, followed by a comment? Remember that the
- ;; semi which starts the comment shouldn't be part of a string or
- ;; character.
- ((cperl-to-comment-or-eol)
- (setq has-comment t)
- (looking-at "#+[ \t]*")
- (setq start (point) c (current-column)
- comment-fill-prefix
- (concat (make-string (current-column) ?\ )
- (buffer-substring (match-beginning 0) (match-end 0)))
- spaces (progn (skip-chars-backward " \t")
- (buffer-substring (point) start))
- dc (- c (current-column)) len (- start (point))
- start (point-marker))
- (delete-char len)
- (insert (make-string dc ?-))))) ; Placeholder (to avoid splitting???)
- (if (not has-comment)
- (fill-paragraph justify) ; Do the usual thing outside of comment
- ;; Narrow to include only the comment, and then fill the region.
- (save-restriction
- (narrow-to-region
- ;; Find the first line we should include in the region to fill.
- (if start (progn (beginning-of-line) (point))
- (save-excursion
- (while (and (zerop (forward-line -1))
- (looking-at "^[ \t]*#+[ \t]*[^ \t\n#]")))
- ;; We may have gone to far. Go forward again.
- (or (looking-at "^[ \t]*#+[ \t]*[^ \t\n#]")
- (forward-line 1))
- (point)))
- ;; Find the beginning of the first line past the region to fill.
- (save-excursion
- (while (progn (forward-line 1)
- (looking-at "^[ \t]*#+[ \t]*[^ \t\n#]")))
- (point)))
- ;; Remove existing hashes
- (goto-char (point-min))
- (while (progn (forward-line 1) (< (point) (point-max)))
- (skip-chars-forward " \t")
- (if (looking-at "#+")
- (progn
- (if (and (eq (point) (match-beginning 0))
- (not (eq (point) (match-end 0)))) nil
- (error
- "Bug in Emacs: `looking-at' in `narrow-to-region': match-data is garbage"))
- (delete-char (- (match-end 0) (match-beginning 0))))))
-
- ;; Lines with only hashes on them can be paragraph boundaries.
- (let ((paragraph-start (concat paragraph-start "\\|^[ \t#]*$"))
- (paragraph-separate (concat paragraph-start "\\|^[ \t#]*$"))
- (fill-prefix comment-fill-prefix))
- (fill-paragraph justify)))
- (if (and start)
- (progn
- (goto-char start)
- (if (> dc 0)
- (progn (delete-char dc) (insert spaces)))
- (if (or (= (current-column) c) iteration) nil
- (setq comment-column c)
- (indent-for-comment)
- ;; Repeat once more, flagging as iteration
- (cperl-fill-paragraph justify t))))))
- t)
-
-(defun cperl-do-auto-fill ()
- ;; Break out if the line is short enough
- (if (> (save-excursion
- (end-of-line)
- (current-column))
- fill-column)
- (let ((c (save-excursion (beginning-of-line)
- (cperl-to-comment-or-eol) (point)))
- (s (memq (following-char) '(?\ ?\t))) marker)
- (if (>= c (point)) nil
- (setq marker (point-marker))
- (cperl-fill-paragraph)
- (goto-char marker)
- ;; Is not enough, sometimes marker is a start of line
- (if (bolp) (progn (re-search-forward "#+[ \t]*")
- (goto-char (match-end 0))))
- ;; Following space could have gone:
- (if (or (not s) (memq (following-char) '(?\ ?\t))) nil
- (insert " ")
- (backward-char 1))
- ;; Previous space could have gone:
- (or (memq (preceding-char) '(?\ ?\t)) (insert " "))))))
-
-(defun cperl-imenu-addback (lst &optional isback name)
- ;; We suppose that the lst is a DAG, unless the first element only
- ;; loops back, and ISBACK is set. Thus this function cannot be
- ;; applied twice without ISBACK set.
- (cond ((not cperl-imenu-addback) lst)
- (t
- (or name
- (setq name "+++BACK+++"))
- (mapcar (lambda (elt)
- (if (and (listp elt) (listp (cdr elt)))
- (progn
- ;; In the other order it goes up
- ;; one level only ;-(
- (setcdr elt (cons (cons name lst)
- (cdr elt)))
- (cperl-imenu-addback (cdr elt) t name))))
- (if isback (cdr lst) lst))
- lst)))
-
-(defun cperl-imenu--create-perl-index (&optional regexp)
- (require 'cl)
- (require 'imenu) ; May be called from TAGS creator
- (let ((index-alist '()) (index-pack-alist '()) (index-pod-alist '())
- (index-unsorted-alist '()) (i-s-f (default-value 'imenu-sort-function))
- (index-meth-alist '()) meth
- packages ends-ranges p marker is-proto
- (prev-pos 0) is-pack index index1 name (end-range 0) package)
- (goto-char (point-min))
- (if noninteractive
- (message "Scanning Perl for index")
- (imenu-progress-message prev-pos 0))
- (cperl-update-syntaxification (point-max) (point-max))
- ;; Search for the function
- (progn ;;save-match-data
- (while (re-search-forward
- (or regexp cperl-imenu--function-name-regexp-perl)
- nil t)
- (or noninteractive
- (imenu-progress-message prev-pos))
- ;; 2=package-group, 5=package-name 8=sub-name
- (cond
- ((and ; Skip some noise if building tags
- (match-beginning 5) ; package name
- ;;(eq (char-after (match-beginning 2)) ?p) ; package
- (not (save-match-data
- (looking-at "[ \t\n]*;")))) ; Plain text word 'package'
- nil)
- ((and
- (or (match-beginning 2)
- (match-beginning 8)) ; package or sub
- ;; Skip if quoted (will not skip multi-line ''-strings :-():
- (null (get-text-property (match-beginning 1) 'syntax-table))
- (null (get-text-property (match-beginning 1) 'syntax-type))
- (null (get-text-property (match-beginning 1) 'in-pod)))
- (setq is-pack (match-beginning 2))
- ;; (if (looking-at "([^()]*)[ \t\n\f]*")
- ;; (goto-char (match-end 0))) ; Messes what follows
- (setq meth nil
- p (point))
- (while (and ends-ranges (>= p (car ends-ranges)))
- ;; delete obsolete entries
- (setq ends-ranges (cdr ends-ranges) packages (cdr packages)))
- (setq package (or (car packages) "")
- end-range (or (car ends-ranges) 0))
- (if is-pack ; doing "package"
- (progn
- (if (match-beginning 5) ; named package
- (setq name (buffer-substring (match-beginning 5)
- (match-end 5))
- name (progn
- (set-text-properties 0 (length name) nil name)
- name)
- package (concat name "::")
- name (concat "package " name))
- ;; Support nameless packages
- (setq name "package;" package ""))
- (setq end-range
- (save-excursion
- (parse-partial-sexp (point) (point-max) -1) (point))
- ends-ranges (cons end-range ends-ranges)
- packages (cons package packages)))
- (setq is-proto
- (or (eq (following-char) ?\;)
- (eq 0 (get-text-property (point) 'attrib-group)))))
- ;; Skip this function name if it is a prototype declaration.
- (if (and is-proto (not is-pack)) nil
- (or is-pack
- (setq name
- (buffer-substring (match-beginning 8) (match-end 8)))
- (set-text-properties 0 (length name) nil name))
- (setq marker (make-marker))
- (set-marker marker (match-end (if is-pack 2 8)))
- (cond (is-pack nil)
- ((string-match "[:']" name)
- (setq meth t))
- ((> p end-range) nil)
- (t
- (setq name (concat package name) meth t)))
- (setq index (cons name marker))
- (if is-pack
- (push index index-pack-alist)
- (push index index-alist))
- (if meth (push index index-meth-alist))
- (push index index-unsorted-alist)))
- ((match-beginning 16) ; POD section
- (setq name (buffer-substring (match-beginning 17) (match-end 17))
- marker (make-marker))
- (set-marker marker (match-beginning 17))
- (set-text-properties 0 (length name) nil name)
- (setq name (concat (make-string
- (* 3 (- (char-after (match-beginning 16)) ?1))
- ?\ )
- name)
- index (cons name marker))
- (setq index1 (cons (concat "=" name) (cdr index)))
- (push index index-pod-alist)
- (push index1 index-unsorted-alist)))))
- (or noninteractive
- (imenu-progress-message prev-pos 100))
- (setq index-alist
- (if (default-value 'imenu-sort-function)
- (sort index-alist (default-value 'imenu-sort-function))
- (nreverse index-alist)))
- (and index-pod-alist
- (push (cons "+POD headers+..."
- (nreverse index-pod-alist))
- index-alist))
- (and (or index-pack-alist index-meth-alist)
- (let ((lst index-pack-alist) hier-list pack elt group name)
- ;; Remove "package ", reverse and uniquify.
- (while lst
- (setq elt (car lst) lst (cdr lst) name (substring (car elt) 8))
- (if (assoc name hier-list) nil
- (setq hier-list (cons (cons name (cdr elt)) hier-list))))
- (setq lst index-meth-alist)
- (while lst
- (setq elt (car lst) lst (cdr lst))
- (cond ((string-match "\\(::\\|'\\)[_a-zA-Z0-9]+$" (car elt))
- (setq pack (substring (car elt) 0 (match-beginning 0)))
- (if (setq group (assoc pack hier-list))
- (if (listp (cdr group))
- ;; Have some functions already
- (setcdr group
- (cons (cons (substring
- (car elt)
- (+ 2 (match-beginning 0)))
- (cdr elt))
- (cdr group)))
- (setcdr group (list (cons (substring
- (car elt)
- (+ 2 (match-beginning 0)))
- (cdr elt)))))
- (setq hier-list
- (cons (cons pack
- (list (cons (substring
- (car elt)
- (+ 2 (match-beginning 0)))
- (cdr elt))))
- hier-list))))))
- (push (cons "+Hierarchy+..."
- hier-list)
- index-alist)))
- (and index-pack-alist
- (push (cons "+Packages+..."
- (nreverse index-pack-alist))
- index-alist))
- (and (or index-pack-alist index-pod-alist
- (default-value 'imenu-sort-function))
- index-unsorted-alist
- (push (cons "+Unsorted List+..."
- (nreverse index-unsorted-alist))
- index-alist))
- (cperl-imenu-addback index-alist)))
-
-\f
-;; Suggested by Mark A. Hershberger
-(defun cperl-outline-level ()
- (looking-at outline-regexp)
- (cond ((not (match-beginning 1)) 0) ; beginning-of-file
-;;;; 2=package-group, 5=package-name 8=sub-name 16=head-level
- ((match-beginning 2) 0) ; package
- ((match-beginning 8) 1) ; sub
- ((match-beginning 16)
- (- (char-after (match-beginning 16)) ?0)) ; headN ==> N
- (t 5))) ; should not happen
-
-\f
-(defvar cperl-compilation-error-regexp-alist
- ;; This look like a paranoiac regexp: could anybody find a better one? (which WORKS).
- '(("^[^\n]* \\(file\\|at\\) \\([^ \t\n]+\\) [^\n]*line \\([0-9]+\\)[\\., \n]"
- 2 3))
- "Alist that specifies how to match errors in perl output.")
-
-(if (fboundp 'eval-after-load)
- (eval-after-load
- "mode-compile"
- '(setq perl-compilation-error-regexp-alist
- cperl-compilation-error-regexp-alist)))
-
-
-(defun cperl-windowed-init ()
- "Initialization under windowed version."
- (cond ((featurep 'ps-print)
- (or cperl-faces-init
- (progn
- (and (boundp 'font-lock-multiline)
- (setq cperl-font-lock-multiline t))
- (cperl-init-faces))))
- ((not cperl-faces-init)
- (add-hook 'font-lock-mode-hook
- (function
- (lambda ()
- (if (memq major-mode '(perl-mode cperl-mode))
- (progn
- (or cperl-faces-init (cperl-init-faces)))))))
- (if (fboundp 'eval-after-load)
- (eval-after-load
- "ps-print"
- '(or cperl-faces-init (cperl-init-faces)))))))
-
-(defun cperl-load-font-lock-keywords ()
- (or cperl-faces-init (cperl-init-faces))
- perl-font-lock-keywords)
-
-(defun cperl-load-font-lock-keywords-1 ()
- (or cperl-faces-init (cperl-init-faces))
- perl-font-lock-keywords-1)
-
-(defun cperl-load-font-lock-keywords-2 ()
- (or cperl-faces-init (cperl-init-faces))
- perl-font-lock-keywords-2)
-
-(defvar perl-font-lock-keywords-1 nil
- "Additional expressions to highlight in Perl mode. Minimal set.")
-(defvar perl-font-lock-keywords nil
- "Additional expressions to highlight in Perl mode. Default set.")
-(defvar perl-font-lock-keywords-2 nil
- "Additional expressions to highlight in Perl mode. Maximal set.")
-
-(defvar font-lock-background-mode)
-(defvar font-lock-display-type)
-(defun cperl-init-faces-weak ()
- ;; Allow `cperl-find-pods-heres' to run.
- (or (boundp 'font-lock-constant-face)
- (cperl-force-face font-lock-constant-face
- "Face for constant and label names"))
- (or (boundp 'font-lock-warning-face)
- (cperl-force-face font-lock-warning-face
- "Face for things which should stand out"))
- ;;(setq font-lock-constant-face 'font-lock-constant-face)
- )
-
-(defun cperl-init-faces ()
- (condition-case errs
- (progn
- (require 'font-lock)
- (and (fboundp 'font-lock-fontify-anchored-keywords)
- (featurep 'font-lock-extra)
- (message "You have an obsolete package `font-lock-extra'. Install `choose-color'."))
- (let (t-font-lock-keywords t-font-lock-keywords-1 font-lock-anchored)
- (if (fboundp 'font-lock-fontify-anchored-keywords)
- (setq font-lock-anchored t))
- (setq
- t-font-lock-keywords
- (list
- (list "[ \t]+$" 0 cperl-invalid-face t)
- (cons
- (concat
- "\\(^\\|[^$@%&\\]\\)\\<\\("
- (mapconcat
- 'identity
- '("if" "until" "while" "elsif" "else" "unless" "for"
- "foreach" "continue" "exit" "die" "last" "goto" "next"
- "redo" "return" "local" "exec" "sub" "do" "dump" "use" "our"
- "require" "package" "eval" "my" "BEGIN" "END" "CHECK" "INIT")
- "\\|") ; Flow control
- "\\)\\>") 2) ; was "\\)[ \n\t;():,\|&]"
- ; In what follows we use `type' style
- ; for overwritable builtins
- (list
- (concat
- "\\(^\\|[^$@%&\\]\\)\\<\\("
- ;; "CORE" "__FILE__" "__LINE__" "abs" "accept" "alarm"
- ;; "and" "atan2" "bind" "binmode" "bless" "caller"
- ;; "chdir" "chmod" "chown" "chr" "chroot" "close"
- ;; "closedir" "cmp" "connect" "continue" "cos" "crypt"
- ;; "dbmclose" "dbmopen" "die" "dump" "endgrent"
- ;; "endhostent" "endnetent" "endprotoent" "endpwent"
- ;; "endservent" "eof" "eq" "exec" "exit" "exp" "fcntl"
- ;; "fileno" "flock" "fork" "formline" "ge" "getc"
- ;; "getgrent" "getgrgid" "getgrnam" "gethostbyaddr"
- ;; "gethostbyname" "gethostent" "getlogin"
- ;; "getnetbyaddr" "getnetbyname" "getnetent"
- ;; "getpeername" "getpgrp" "getppid" "getpriority"
- ;; "getprotobyname" "getprotobynumber" "getprotoent"
- ;; "getpwent" "getpwnam" "getpwuid" "getservbyname"
- ;; "getservbyport" "getservent" "getsockname"
- ;; "getsockopt" "glob" "gmtime" "gt" "hex" "index" "int"
- ;; "ioctl" "join" "kill" "lc" "lcfirst" "le" "length"
- ;; "link" "listen" "localtime" "lock" "log" "lstat" "lt"
- ;; "mkdir" "msgctl" "msgget" "msgrcv" "msgsnd" "ne"
- ;; "not" "oct" "open" "opendir" "or" "ord" "pack" "pipe"
- ;; "quotemeta" "rand" "read" "readdir" "readline"
- ;; "readlink" "readpipe" "recv" "ref" "rename" "require"
- ;; "reset" "reverse" "rewinddir" "rindex" "rmdir" "seek"
- ;; "seekdir" "select" "semctl" "semget" "semop" "send"
- ;; "setgrent" "sethostent" "setnetent" "setpgrp"
- ;; "setpriority" "setprotoent" "setpwent" "setservent"
- ;; "setsockopt" "shmctl" "shmget" "shmread" "shmwrite"
- ;; "shutdown" "sin" "sleep" "socket" "socketpair"
- ;; "sprintf" "sqrt" "srand" "stat" "substr" "symlink"
- ;; "syscall" "sysopen" "sysread" "system" "syswrite" "tell"
- ;; "telldir" "time" "times" "truncate" "uc" "ucfirst"
- ;; "umask" "unlink" "unpack" "utime" "values" "vec"
- ;; "wait" "waitpid" "wantarray" "warn" "write" "x" "xor"
- "a\\(bs\\|ccept\\|tan2\\|larm\\|nd\\)\\|"
- "b\\(in\\(d\\|mode\\)\\|less\\)\\|"
- "c\\(h\\(r\\(\\|oot\\)\\|dir\\|mod\\|own\\)\\|aller\\|rypt\\|"
- "lose\\(\\|dir\\)\\|mp\\|o\\(s\\|n\\(tinue\\|nect\\)\\)\\)\\|"
- "CORE\\|d\\(ie\\|bm\\(close\\|open\\)\\|ump\\)\\|"
- "e\\(x\\(p\\|it\\|ec\\)\\|q\\|nd\\(p\\(rotoent\\|went\\)\\|"
- "hostent\\|servent\\|netent\\|grent\\)\\|of\\)\\|"
- "f\\(ileno\\|cntl\\|lock\\|or\\(k\\|mline\\)\\)\\|"
- "g\\(t\\|lob\\|mtime\\|e\\(\\|t\\(p\\(pid\\|r\\(iority\\|"
- "oto\\(byn\\(ame\\|umber\\)\\|ent\\)\\)\\|eername\\|w"
- "\\(uid\\|ent\\|nam\\)\\|grp\\)\\|host\\(by\\(addr\\|name\\)\\|"
- "ent\\)\\|s\\(erv\\(by\\(port\\|name\\)\\|ent\\)\\|"
- "ock\\(name\\|opt\\)\\)\\|c\\|login\\|net\\(by\\(addr\\|name\\)\\|"
- "ent\\)\\|gr\\(ent\\|nam\\|gid\\)\\)\\)\\)\\|"
- "hex\\|i\\(n\\(t\\|dex\\)\\|octl\\)\\|join\\|kill\\|"
- "l\\(i\\(sten\\|nk\\)\\|stat\\|c\\(\\|first\\)\\|t\\|e"
- "\\(\\|ngth\\)\\|o\\(c\\(altime\\|k\\)\\|g\\)\\)\\|m\\(sg\\(rcv\\|snd\\|"
- "ctl\\|get\\)\\|kdir\\)\\|n\\(e\\|ot\\)\\|o\\(pen\\(\\|dir\\)\\|"
- "r\\(\\|d\\)\\|ct\\)\\|p\\(ipe\\|ack\\)\\|quotemeta\\|"
- "r\\(index\\|and\\|mdir\\|e\\(quire\\|ad\\(pipe\\|\\|lin"
- "\\(k\\|e\\)\\|dir\\)\\|set\\|cv\\|verse\\|f\\|winddir\\|name"
- "\\)\\)\\|s\\(printf\\|qrt\\|rand\\|tat\\|ubstr\\|e\\(t\\(p\\(r"
- "\\(iority\\|otoent\\)\\|went\\|grp\\)\\|hostent\\|s\\(ervent\\|"
- "ockopt\\)\\|netent\\|grent\\)\\|ek\\(\\|dir\\)\\|lect\\|"
- "m\\(ctl\\|op\\|get\\)\\|nd\\)\\|h\\(utdown\\|m\\(read\\|ctl\\|"
- "write\\|get\\)\\)\\|y\\(s\\(read\\|call\\|open\\|tem\\|write\\)\\|"
- "mlink\\)\\|in\\|leep\\|ocket\\(pair\\|\\)\\)\\|t\\(runcate\\|"
- "ell\\(\\|dir\\)\\|ime\\(\\|s\\)\\)\\|u\\(c\\(\\|first\\)\\|"
- "time\\|mask\\|n\\(pack\\|link\\)\\)\\|v\\(alues\\|ec\\)\\|"
- "w\\(a\\(rn\\|it\\(pid\\|\\)\\|ntarray\\)\\|rite\\)\\|"
- "x\\(\\|or\\)\\|__\\(FILE__\\|LINE__\\|PACKAGE__\\)"
- "\\)\\>") 2 'font-lock-type-face)
- ;; In what follows we use `other' style
- ;; for nonoverwritable builtins
- ;; Somehow 's', 'm' are not auto-generated???
- (list
- (concat
- "\\(^\\|[^$@%&\\]\\)\\<\\("
- ;; "AUTOLOAD" "BEGIN" "CHECK" "DESTROY" "END" "INIT" "__END__" "chomp"
- ;; "chop" "defined" "delete" "do" "each" "else" "elsif"
- ;; "eval" "exists" "for" "foreach" "format" "goto"
- ;; "grep" "if" "keys" "last" "local" "map" "my" "next"
- ;; "no" "our" "package" "pop" "pos" "print" "printf" "push"
- ;; "q" "qq" "qw" "qx" "redo" "return" "scalar" "shift"
- ;; "sort" "splice" "split" "study" "sub" "tie" "tr"
- ;; "undef" "unless" "unshift" "untie" "until" "use"
- ;; "while" "y"
- "AUTOLOAD\\|BEGIN\\|CHECK\\|cho\\(p\\|mp\\)\\|d\\(e\\(fined\\|lete\\)\\|"
- "o\\)\\|DESTROY\\|e\\(ach\\|val\\|xists\\|ls\\(e\\|if\\)\\)\\|"
- "END\\|for\\(\\|each\\|mat\\)\\|g\\(rep\\|oto\\)\\|INIT\\|if\\|keys\\|"
- "l\\(ast\\|ocal\\)\\|m\\(ap\\|y\\)\\|n\\(ext\\|o\\)\\|our\\|"
- "p\\(ackage\\|rint\\(\\|f\\)\\|ush\\|o\\(p\\|s\\)\\)\\|"
- "q\\(\\|q\\|w\\|x\\|r\\)\\|re\\(turn\\|do\\)\\|s\\(pli\\(ce\\|t\\)\\|"
- "calar\\|tudy\\|ub\\|hift\\|ort\\)\\|t\\(r\\|ie\\)\\|"
- "u\\(se\\|n\\(shift\\|ti\\(l\\|e\\)\\|def\\|less\\)\\)\\|"
- "while\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually
- "\\|[sm]" ; Added manually
- "\\)\\>") 2 'cperl-nonoverridable-face)
- ;; (mapconcat 'identity
- ;; '("#endif" "#else" "#ifdef" "#ifndef" "#if"
- ;; "#include" "#define" "#undef")
- ;; "\\|")
- '("-[rwxoRWXOezsfdlpSbctugkTBMAC]\\>\\([ \t]+_\\>\\)?" 0
- font-lock-function-name-face keep) ; Not very good, triggers at "[a-z]"
- ;; This highlights declarations and definitions differenty.
- ;; We do not try to highlight in the case of attributes:
- ;; it is already done by `cperl-find-pods-heres'
- (list (concat "\\<sub"
- cperl-white-and-comment-rex ; whitespace/comments
- "\\([^ \n\t{;()]+\\)" ; 2=name (assume non-anonymous)
- "\\("
- cperl-maybe-white-and-comment-rex ;whitespace/comments?
- "([^()]*)\\)?" ; prototype
- cperl-maybe-white-and-comment-rex ; whitespace/comments?
- "[{;]")
- 2 (if cperl-font-lock-multiline
- '(if (eq (char-after (cperl-1- (match-end 0))) ?\{ )
- 'font-lock-function-name-face
- 'font-lock-variable-name-face)
- ;; need to manually set 'multiline' for older font-locks
- '(progn
- (if (< 1 (count-lines (match-beginning 0)
- (match-end 0)))
- (put-text-property
- (+ 3 (match-beginning 0)) (match-end 0)
- 'syntax-type 'multiline))
- (if (eq (char-after (cperl-1- (match-end 0))) ?\{ )
- 'font-lock-function-name-face
- 'font-lock-variable-name-face))))
- '("\\<\\(package\\|require\\|use\\|import\\|no\\|bootstrap\\)[ \t]+\\([a-zA-z_][a-zA-z_0-9:]*\\)[ \t;]" ; require A if B;
- 2 font-lock-function-name-face)
- '("^[ \t]*format[ \t]+\\([a-zA-z_][a-zA-z_0-9:]*\\)[ \t]*=[ \t]*$"
- 1 font-lock-function-name-face)
- (cond ((featurep 'font-lock-extra)
- '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
- (2 font-lock-string-face t)
- (0 '(restart 2 t)))) ; To highlight $a{bc}{ef}
- (font-lock-anchored
- '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
- (2 font-lock-string-face t)
- ("\\=[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
- nil nil
- (1 font-lock-string-face t))))
- (t '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
- 2 font-lock-string-face t)))
- '("[\[ \t{,(]\\(-?[a-zA-Z0-9_:]+\\)[ \t]*=>" 1
- font-lock-string-face t)
- '("^[ \t]*\\([a-zA-Z0-9_]+[ \t]*:\\)[ \t]*\\($\\|{\\|\\<\\(until\\|while\\|for\\(each\\)?\\|do\\)\\>\\)" 1
- font-lock-constant-face) ; labels
- '("\\<\\(continue\\|next\\|last\\|redo\\|goto\\)\\>[ \t]+\\([a-zA-Z0-9_:]+\\)" ; labels as targets
- 2 font-lock-constant-face)
- ;; Uncomment to get perl-mode-like vars
- ;;; '("[$*]{?\\(\\sw+\\)" 1 font-lock-variable-name-face)
- ;;; '("\\([@%]\\|\\$#\\)\\(\\sw+\\)"
- ;;; (2 (cons font-lock-variable-name-face '(underline))))
- (cond ((featurep 'font-lock-extra)
- '("^[ \t]*\\(my\\|local\\|our\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?"
- (3 font-lock-variable-name-face)
- (4 '(another 4 nil
- ("\\=[ \t]*,[ \t]*\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?"
- (1 font-lock-variable-name-face)
- (2 '(restart 2 nil) nil t)))
- nil t))) ; local variables, multiple
- (font-lock-anchored
- ;; 1=my_etc, 2=white? 3=(+white? 4=white? 5=var
- (` ((, (concat "\\<\\(my\\|local\\|our\\)"
- cperl-maybe-white-and-comment-rex
- "\\(("
- cperl-maybe-white-and-comment-rex
- "\\)?\\([$@%*]\\([a-zA-Z0-9_:]+\\|[^a-zA-Z0-9_]\\)\\)"))
- (5 (, (if cperl-font-lock-multiline
- 'font-lock-variable-name-face
- '(progn (setq cperl-font-lock-multiline-start
- (match-beginning 0))
- 'font-lock-variable-name-face))))
- ((, (concat "\\="
- cperl-maybe-white-and-comment-rex
- ","
- cperl-maybe-white-and-comment-rex
- "\\([$@%*]\\([a-zA-Z0-9_:]+\\|[^a-zA-Z0-9_]\\)\\)"))
- ;; Bug in font-lock: limit is used not only to limit
- ;; searches, but to set the "extend window for
- ;; facification" property. Thus we need to minimize.
- (, (if cperl-font-lock-multiline
- '(if (match-beginning 3)
- (save-excursion
- (goto-char (match-beginning 3))
- (condition-case nil
- (forward-sexp 1)
- (error
- (condition-case nil
- (forward-char 200)
- (error nil)))) ; typeahead
- (1- (point))) ; report limit
- (forward-char -2)) ; disable continued expr
- '(if (match-beginning 3)
- (point-max) ; No limit for continuation
- (forward-char -2)))) ; disable continued expr
- (, (if cperl-font-lock-multiline
- nil
- '(progn ; Do at end
- ;; "my" may be already fontified (POD),
- ;; so cperl-font-lock-multiline-start is nil
- (if (or (not cperl-font-lock-multiline-start)
- (> 2 (count-lines
- cperl-font-lock-multiline-start
- (point))))
- nil
- (put-text-property
- (1+ cperl-font-lock-multiline-start) (point)
- 'syntax-type 'multiline))
- (setq cperl-font-lock-multiline-start nil))))
- (3 font-lock-variable-name-face)))))
- (t '("^[ \t{}]*\\(my\\|local\\|our\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)"
- 3 font-lock-variable-name-face)))
- '("\\<for\\(each\\)?\\([ \t]+\\(my\\|local\\|our\\)\\)?[ \t]*\\(\\$[a-zA-Z_][a-zA-Z_0-9]*\\)[ \t]*("
- 4 font-lock-variable-name-face)))
- (setq
- t-font-lock-keywords-1
- (and (fboundp 'turn-on-font-lock) ; Check for newer font-lock
- ;; not yet as of XEmacs 19.12, works with 21.1.11
- (or
- (not cperl-xemacs-p)
- (string< "21.1.9" emacs-version)
- (and (string< "21.1.10" emacs-version)
- (string< emacs-version "21.1.2")))
- '(
- ("\\(\\([@%]\\|\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1
- (if (eq (char-after (match-beginning 2)) ?%)
- cperl-hash-face
- cperl-array-face)
- t) ; arrays and hashes
- ("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)"
- 1
- (if (= (- (match-end 2) (match-beginning 2)) 1)
- (if (eq (char-after (match-beginning 3)) ?{)
- cperl-hash-face
- cperl-array-face) ; arrays and hashes
- font-lock-variable-name-face) ; Just to put something
- t)
- ("\\(@\\|\\$#\\)\\(\\$+\\([a-zA-Z_:][a-zA-Z0-9_:]*\\|[^ \t\n]\\)\\)"
- (1 cperl-array-face)
- (2 font-lock-variable-name-face))
- ("\\(%\\)\\(\\$+\\([a-zA-Z_:][a-zA-Z0-9_:]*\\|[^ \t\n]\\)\\)"
- (1 cperl-hash-face)
- (2 font-lock-variable-name-face))
- ;;("\\([smy]\\|tr\\)\\([^a-z_A-Z0-9]\\)\\(\\([^\n\\]*||\\)\\)\\2")
- ;;; Too much noise from \s* @s[ and friends
- ;;("\\(\\<\\([msy]\\|tr\\)[ \t]*\\([^ \t\na-zA-Z0-9_]\\)\\|\\(/\\)\\)"
- ;;(3 font-lock-function-name-face t t)
- ;;(4
- ;; (if (cperl-slash-is-regexp)
- ;; font-lock-function-name-face 'default) nil t))
- )))
- (if cperl-highlight-variables-indiscriminately
- (setq t-font-lock-keywords-1
- (append t-font-lock-keywords-1
- (list '("\\([$*]{?\\sw+\\)" 1
- font-lock-variable-name-face)))))
- (setq perl-font-lock-keywords-1
- (if cperl-syntaxify-by-font-lock
- (cons 'cperl-fontify-update
- t-font-lock-keywords)
- t-font-lock-keywords)
- perl-font-lock-keywords perl-font-lock-keywords-1
- perl-font-lock-keywords-2 (append
- perl-font-lock-keywords-1
- t-font-lock-keywords-1)))
- (if (fboundp 'ps-print-buffer) (cperl-ps-print-init))
- (if (or (featurep 'choose-color) (featurep 'font-lock-extra))
- (eval ; Avoid a warning
- '(font-lock-require-faces
- (list
- ;; Color-light Color-dark Gray-light Gray-dark Mono
- (list 'font-lock-comment-face
- ["Firebrick" "OrangeRed" "DimGray" "Gray80"]
- nil
- [nil nil t t t]
- [nil nil t t t]
- nil)
- (list 'font-lock-string-face
- ["RosyBrown" "LightSalmon" "Gray50" "LightGray"]
- nil
- nil
- [nil nil t t t]
- nil)
- (list 'font-lock-function-name-face
- (vector
- "Blue" "LightSkyBlue" "Gray50" "LightGray"
- (cdr (assq 'background-color ; if mono
- (frame-parameters))))
- (vector
- nil nil nil nil
- (cdr (assq 'foreground-color ; if mono
- (frame-parameters))))
- [nil nil t t t]
- nil
- nil)
- (list 'font-lock-variable-name-face
- ["DarkGoldenrod" "LightGoldenrod" "DimGray" "Gray90"]
- nil
- [nil nil t t t]
- [nil nil t t t]
- nil)
- (list 'font-lock-type-face
- ["DarkOliveGreen" "PaleGreen" "DimGray" "Gray80"]
- nil
- [nil nil t t t]
- nil
- [nil nil t t t])
- (list 'font-lock-warning-face
- ["Pink" "Red" "Gray50" "LightGray"]
- ["gray20" "gray90"
- "gray80" "gray20"]
- [nil nil t t t]
- nil
- [nil nil t t t]
- )
- (list 'font-lock-constant-face
- ["CadetBlue" "Aquamarine" "Gray50" "LightGray"]
- nil
- [nil nil t t t]
- nil
- [nil nil t t t])
- (list 'cperl-nonoverridable-face
- ["chartreuse3" ("orchid1" "orange")
- nil "Gray80"]
- [nil nil "gray90"]
- [nil nil nil t t]
- [nil nil t t]
- [nil nil t t t])
- (list 'cperl-array-face
- ["blue" "yellow" nil "Gray80"]
- ["lightyellow2" ("navy" "os2blue" "darkgreen")
- "gray90"]
- t
- nil
- nil)
- (list 'cperl-hash-face
- ["red" "red" nil "Gray80"]
- ["lightyellow2" ("navy" "os2blue" "darkgreen")
- "gray90"]
- t
- t
- nil))))
- ;; Do it the dull way, without choose-color
- (defvar cperl-guessed-background nil
- "Display characteristics as guessed by cperl.")
- ;; (or (fboundp 'x-color-defined-p)
- ;; (defalias 'x-color-defined-p
- ;; (cond ((fboundp 'color-defined-p) 'color-defined-p)
- ;; ;; XEmacs >= 19.12
- ;; ((fboundp 'valid-color-name-p) 'valid-color-name-p)
- ;; ;; XEmacs 19.11
- ;; (t 'x-valid-color-name-p))))
- (cperl-force-face font-lock-constant-face
- "Face for constant and label names")
- (cperl-force-face font-lock-variable-name-face
- "Face for variable names")
- (cperl-force-face font-lock-type-face
- "Face for data types")
- (cperl-force-face cperl-nonoverridable-face
- "Face for data types from another group")
- (cperl-force-face font-lock-warning-face
- "Face for things which should stand out")
- (cperl-force-face font-lock-comment-face
- "Face for comments")
- (cperl-force-face font-lock-function-name-face
- "Face for function names")
- (cperl-force-face cperl-hash-face
- "Face for hashes")
- (cperl-force-face cperl-array-face
- "Face for arrays")
- ;;(defvar font-lock-constant-face 'font-lock-constant-face)
- ;;(defvar font-lock-variable-name-face 'font-lock-variable-name-face)
- ;;(or (boundp 'font-lock-type-face)
- ;; (defconst font-lock-type-face
- ;; 'font-lock-type-face
- ;; "Face to use for data types."))
- ;;(or (boundp 'cperl-nonoverridable-face)
- ;; (defconst cperl-nonoverridable-face
- ;; 'cperl-nonoverridable-face
- ;; "Face to use for data types from another group."))
- ;;(if (not cperl-xemacs-p) nil
- ;; (or (boundp 'font-lock-comment-face)
- ;; (defconst font-lock-comment-face
- ;; 'font-lock-comment-face
- ;; "Face to use for comments."))
- ;; (or (boundp 'font-lock-keyword-face)
- ;; (defconst font-lock-keyword-face
- ;; 'font-lock-keyword-face
- ;; "Face to use for keywords."))
- ;; (or (boundp 'font-lock-function-name-face)
- ;; (defconst font-lock-function-name-face
- ;; 'font-lock-function-name-face
- ;; "Face to use for function names.")))
- (if (and
- (not (cperl-is-face 'cperl-array-face))
- (cperl-is-face 'font-lock-emphasized-face))
- (copy-face 'font-lock-emphasized-face 'cperl-array-face))
- (if (and
- (not (cperl-is-face 'cperl-hash-face))
- (cperl-is-face 'font-lock-other-emphasized-face))
- (copy-face 'font-lock-other-emphasized-face
- 'cperl-hash-face))
- (if (and
- (not (cperl-is-face 'cperl-nonoverridable-face))
- (cperl-is-face 'font-lock-other-type-face))
- (copy-face 'font-lock-other-type-face
- 'cperl-nonoverridable-face))
- ;;(or (boundp 'cperl-hash-face)
- ;; (defconst cperl-hash-face
- ;; 'cperl-hash-face
- ;; "Face to use for hashes."))
- ;;(or (boundp 'cperl-array-face)
- ;; (defconst cperl-array-face
- ;; 'cperl-array-face
- ;; "Face to use for arrays."))
- ;; Here we try to guess background
- (let ((background
- (if (boundp 'font-lock-background-mode)
- font-lock-background-mode
- 'light))
- (face-list (and (fboundp 'face-list) (face-list))))
-;;;; (fset 'cperl-is-face
-;;;; (cond ((fboundp 'find-face)
-;;;; (symbol-function 'find-face))
-;;;; (face-list
-;;;; (function (lambda (face) (member face face-list))))
-;;;; (t
-;;;; (function (lambda (face) (boundp face))))))
- (defvar cperl-guessed-background
- (if (and (boundp 'font-lock-display-type)
- (eq font-lock-display-type 'grayscale))
- 'gray
- background)
- "Background as guessed by CPerl mode")
- (and (not (cperl-is-face 'font-lock-constant-face))
- (cperl-is-face 'font-lock-reference-face)
- (copy-face 'font-lock-reference-face 'font-lock-constant-face))
- (if (cperl-is-face 'font-lock-type-face) nil
- (copy-face 'default 'font-lock-type-face)
- (cond
- ((eq background 'light)
- (set-face-foreground 'font-lock-type-face
- (if (x-color-defined-p "seagreen")
- "seagreen"
- "sea green")))
- ((eq background 'dark)
- (set-face-foreground 'font-lock-type-face
- (if (x-color-defined-p "os2pink")
- "os2pink"
- "pink")))
- (t
- (set-face-background 'font-lock-type-face "gray90"))))
- (if (cperl-is-face 'cperl-nonoverridable-face)
- nil
- (copy-face 'font-lock-type-face 'cperl-nonoverridable-face)
- (cond
- ((eq background 'light)
- (set-face-foreground 'cperl-nonoverridable-face
- (if (x-color-defined-p "chartreuse3")
- "chartreuse3"
- "chartreuse")))
- ((eq background 'dark)
- (set-face-foreground 'cperl-nonoverridable-face
- (if (x-color-defined-p "orchid1")
- "orchid1"
- "orange")))))
-;;; (if (cperl-is-face 'font-lock-other-emphasized-face) nil
-;;; (copy-face 'bold-italic 'font-lock-other-emphasized-face)
-;;; (cond
-;;; ((eq background 'light)
-;;; (set-face-background 'font-lock-other-emphasized-face
-;;; (if (x-color-defined-p "lightyellow2")
-;;; "lightyellow2"
-;;; (if (x-color-defined-p "lightyellow")
-;;; "lightyellow"
-;;; "light yellow"))))
-;;; ((eq background 'dark)
-;;; (set-face-background 'font-lock-other-emphasized-face
-;;; (if (x-color-defined-p "navy")
-;;; "navy"
-;;; (if (x-color-defined-p "darkgreen")
-;;; "darkgreen"
-;;; "dark green"))))
-;;; (t (set-face-background 'font-lock-other-emphasized-face "gray90"))))
-;;; (if (cperl-is-face 'font-lock-emphasized-face) nil
-;;; (copy-face 'bold 'font-lock-emphasized-face)
-;;; (cond
-;;; ((eq background 'light)
-;;; (set-face-background 'font-lock-emphasized-face
-;;; (if (x-color-defined-p "lightyellow2")
-;;; "lightyellow2"
-;;; "lightyellow")))
-;;; ((eq background 'dark)
-;;; (set-face-background 'font-lock-emphasized-face
-;;; (if (x-color-defined-p "navy")
-;;; "navy"
-;;; (if (x-color-defined-p "darkgreen")
-;;; "darkgreen"
-;;; "dark green"))))
-;;; (t (set-face-background 'font-lock-emphasized-face "gray90"))))
- (if (cperl-is-face 'font-lock-variable-name-face) nil
- (copy-face 'italic 'font-lock-variable-name-face))
- (if (cperl-is-face 'font-lock-constant-face) nil
- (copy-face 'italic 'font-lock-constant-face))))
- (setq cperl-faces-init t))
- (error (message "cperl-init-faces (ignored): %s" errs))))
-
-
-(defun cperl-ps-print-init ()
- "Initialization of `ps-print' components for faces used in CPerl."
- (eval-after-load "ps-print"
- '(setq ps-bold-faces
- ;; font-lock-variable-name-face
- ;; font-lock-constant-face
- (append '(cperl-array-face
- cperl-hash-face)
- ps-bold-faces)
- ps-italic-faces
- ;; font-lock-constant-face
- (append '(cperl-nonoverridable-face
- cperl-hash-face)
- ps-italic-faces)
- ps-underlined-faces
- ;; font-lock-type-face
- (append '(cperl-array-face
- cperl-hash-face
- underline
- cperl-nonoverridable-face)
- ps-underlined-faces))))
-
-(defvar ps-print-face-extension-alist)
-
-(defun cperl-ps-print (&optional file)
- "Pretty-print in CPerl style.
-If optional argument FILE is an empty string, prints to printer, otherwise
-to the file FILE. If FILE is nil, prompts for a file name.
-
-Style of printout regulated by the variable `cperl-ps-print-face-properties'."
- (interactive)
- (or file
- (setq file (read-from-minibuffer
- "Print to file (if empty - to printer): "
- (concat (buffer-file-name) ".ps")
- nil nil 'file-name-history)))
- (or (> (length file) 0)
- (setq file nil))
- (require 'ps-print) ; To get ps-print-face-extension-alist
- (let ((ps-print-color-p t)
- (ps-print-face-extension-alist ps-print-face-extension-alist))
- (cperl-ps-extend-face-list cperl-ps-print-face-properties)
- (ps-print-buffer-with-faces file)))
-
-;;; (defun cperl-ps-print-init ()
-;;; "Initialization of `ps-print' components for faces used in CPerl."
-;;; ;; Guard against old versions
-;;; (defvar ps-underlined-faces nil)
-;;; (defvar ps-bold-faces nil)
-;;; (defvar ps-italic-faces nil)
-;;; (setq ps-bold-faces
-;;; (append '(font-lock-emphasized-face
-;;; cperl-array-face
-;;; font-lock-keyword-face
-;;; font-lock-variable-name-face
-;;; font-lock-constant-face
-;;; font-lock-reference-face
-;;; font-lock-other-emphasized-face
-;;; cperl-hash-face)
-;;; ps-bold-faces))
-;;; (setq ps-italic-faces
-;;; (append '(cperl-nonoverridable-face
-;;; font-lock-constant-face
-;;; font-lock-reference-face
-;;; font-lock-other-emphasized-face
-;;; cperl-hash-face)
-;;; ps-italic-faces))
-;;; (setq ps-underlined-faces
-;;; (append '(font-lock-emphasized-face
-;;; cperl-array-face
-;;; font-lock-other-emphasized-face
-;;; cperl-hash-face
-;;; cperl-nonoverridable-face font-lock-type-face)
-;;; ps-underlined-faces))
-;;; (cons 'font-lock-type-face ps-underlined-faces))
-
-
-(if (cperl-enable-font-lock) (cperl-windowed-init))
-
-(defconst cperl-styles-entries
- '(cperl-indent-level cperl-brace-offset cperl-continued-brace-offset
- cperl-label-offset cperl-extra-newline-before-brace
- cperl-extra-newline-before-brace-multiline
- cperl-merge-trailing-else
- cperl-continued-statement-offset))
-
-(defconst cperl-style-examples
-"##### Numbers etc are: cperl-indent-level cperl-brace-offset
-##### cperl-continued-brace-offset cperl-label-offset
-##### cperl-continued-statement-offset
-##### cperl-merge-trailing-else cperl-extra-newline-before-brace
-
-########### (Do not forget cperl-extra-newline-before-brace-multiline)
-
-### CPerl (=GNU - extra-newline-before-brace + merge-trailing-else) 2/0/0/-2/2/t/nil
-if (foo) {
- bar
- baz;
- label:
- {
- boon;
- }
-} else {
- stop;
-}
-
-### PerlStyle (=CPerl with 4 as indent) 4/0/0/-4/4/t/nil
-if (foo) {
- bar
- baz;
- label:
- {
- boon;
- }
-} else {
- stop;
-}
-
-### GNU 2/0/0/-2/2/nil/t
-if (foo)
- {
- bar
- baz;
- label:
- {
- boon;
- }
- }
-else
- {
- stop;
- }
-
-### C++ (=PerlStyle with braces aligned with control words) 4/0/-4/-4/4/nil/t
-if (foo)
-{
- bar
- baz;
- label:
- {
- boon;
- }
-}
-else
-{
- stop;
-}
-
-### BSD (=C++, but will not change preexisting merge-trailing-else
-### and extra-newline-before-brace ) 4/0/-4/-4/4
-if (foo)
-{
- bar
- baz;
- label:
- {
- boon;
- }
-}
-else
-{
- stop;
-}
-
-### K&R (=C++ with indent 5 - merge-trailing-else, but will not
-### change preexisting extra-newline-before-brace) 5/0/-5/-5/5/nil
-if (foo)
-{
- bar
- baz;
- label:
- {
- boon;
- }
-}
-else
-{
- stop;
-}
-
-### Whitesmith (=PerlStyle, but will not change preexisting
-### extra-newline-before-brace and merge-trailing-else) 4/0/0/-4/4
-if (foo)
- {
- bar
- baz;
- label:
- {
- boon;
- }
- }
-else
- {
- stop;
- }
-"
-"Examples of if/else with different indent styles (with v4.23).")
-
-(defconst cperl-style-alist
- '(("CPerl" ;; =GNU - extra-newline-before-brace + cperl-merge-trailing-else
- (cperl-indent-level . 2)
- (cperl-brace-offset . 0)
- (cperl-continued-brace-offset . 0)
- (cperl-label-offset . -2)
- (cperl-continued-statement-offset . 2)
- (cperl-extra-newline-before-brace . nil)
- (cperl-extra-newline-before-brace-multiline . nil)
- (cperl-merge-trailing-else . t))
-
- ("PerlStyle" ; CPerl with 4 as indent
- (cperl-indent-level . 4)
- (cperl-brace-offset . 0)
- (cperl-continued-brace-offset . 0)
- (cperl-label-offset . -4)
- (cperl-continued-statement-offset . 4)
- (cperl-extra-newline-before-brace . nil)
- (cperl-extra-newline-before-brace-multiline . nil)
- (cperl-merge-trailing-else . t))
-
- ("GNU"
- (cperl-indent-level . 2)
- (cperl-brace-offset . 0)
- (cperl-continued-brace-offset . 0)
- (cperl-label-offset . -2)
- (cperl-continued-statement-offset . 2)
- (cperl-extra-newline-before-brace . t)
- (cperl-extra-newline-before-brace-multiline . t)
- (cperl-merge-trailing-else . nil))
-
- ("K&R"
- (cperl-indent-level . 5)
- (cperl-brace-offset . 0)
- (cperl-continued-brace-offset . -5)
- (cperl-label-offset . -5)
- (cperl-continued-statement-offset . 5)
- ;;(cperl-extra-newline-before-brace . nil) ; ???
- ;;(cperl-extra-newline-before-brace-multiline . nil)
- (cperl-merge-trailing-else . nil))
-
- ("BSD"
- (cperl-indent-level . 4)
- (cperl-brace-offset . 0)
- (cperl-continued-brace-offset . -4)
- (cperl-label-offset . -4)
- (cperl-continued-statement-offset . 4)
- ;;(cperl-extra-newline-before-brace . nil) ; ???
- ;;(cperl-extra-newline-before-brace-multiline . nil)
- ;;(cperl-merge-trailing-else . nil) ; ???
- )
-
- ("C++"
- (cperl-indent-level . 4)
- (cperl-brace-offset . 0)
- (cperl-continued-brace-offset . -4)
- (cperl-label-offset . -4)
- (cperl-continued-statement-offset . 4)
- (cperl-extra-newline-before-brace . t)
- (cperl-extra-newline-before-brace-multiline . t)
- (cperl-merge-trailing-else . nil))
-
- ("Whitesmith"
- (cperl-indent-level . 4)
- (cperl-brace-offset . 0)
- (cperl-continued-brace-offset . 0)
- (cperl-label-offset . -4)
- (cperl-continued-statement-offset . 4)
- ;;(cperl-extra-newline-before-brace . nil) ; ???
- ;;(cperl-extra-newline-before-brace-multiline . nil)
- ;;(cperl-merge-trailing-else . nil) ; ???
- )
- ("Current"))
- "List of variables to set to get a particular indentation style.
-Should be used via `cperl-set-style' or via Perl menu.
-
-See examples in `cperl-style-examples'.")
-
-(defun cperl-set-style (style)
- "Set CPerl mode variables to use one of several different indentation styles.
-The arguments are a string representing the desired style.
-The list of styles is in `cperl-style-alist', available styles
-are CPerl, PerlStyle, GNU, K&R, BSD, C++ and Whitesmith.
-
-The current value of style is memorized (unless there is a memorized
-data already), may be restored by `cperl-set-style-back'.
-
-Chosing \"Current\" style will not change style, so this may be used for
-side-effect of memorizing only. Examples in `cperl-style-examples'."
- (interactive
- (let ((list (mapcar (function (lambda (elt) (list (car elt))))
- cperl-style-alist)))
- (list (completing-read "Enter style: " list nil 'insist))))
- (or cperl-old-style
- (setq cperl-old-style
- (mapcar (function
- (lambda (name)
- (cons name (eval name))))
- cperl-styles-entries)))
- (let ((style (cdr (assoc style cperl-style-alist))) setting str sym)
- (while style
- (setq setting (car style) style (cdr style))
- (set (car setting) (cdr setting)))))
-
-(defun cperl-set-style-back ()
- "Restore a style memorised by `cperl-set-style'."
- (interactive)
- (or cperl-old-style (error "The style was not changed"))
- (let (setting)
- (while cperl-old-style
- (setq setting (car cperl-old-style)
- cperl-old-style (cdr cperl-old-style))
- (set (car setting) (cdr setting)))))
-
-(defun cperl-check-syntax ()
- (interactive)
- (require 'mode-compile)
- (let ((perl-dbg-flags (concat cperl-extra-perl-args " -wc")))
- (eval '(mode-compile)))) ; Avoid a warning
-
-(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 (if type "perlvar" "perlfunc"))
- (set-buffer "*info*")
- (rename-buffer bname)
- (cond (oldbuf
- (set-buffer "*info-perl-tmp*")
- (rename-buffer "*info*")
- (set-buffer bname)))
- (make-local-variable 'window-min-height)
- (setq window-min-height 2)
- (current-buffer)))))
-
-(defun cperl-word-at-point (&optional p)
- "Return the word at point or at P."
- (save-excursion
- (if p (goto-char p))
- (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)
- "Show documentation for Perl command 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
- (format "Find doc for Perl function (default %s): "
- default))))
- (list (if (equal read "")
- default
- read))))
-
- (let ((buffer (current-buffer))
- (cmd-desc (concat "^" (regexp-quote command) "[^a-zA-Z_0-9]")) ; "tr///"
- 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]"))
- (setq isvar (string-match "^[$@%]" command)
- buf (cperl-info-buffer isvar)
- iniwin (selected-window)
- fr1 (window-frame iniwin))
- (set-buffer buf)
- (goto-char (point-min))
- (or isvar
- (progn (re-search-forward "^-X[ \t\n]")
- (forward-line -1)))
- (if (re-search-forward cmd-desc nil t)
- (progn
- ;; 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)
- (select-window iniwin)))
-
-(defun cperl-info-on-current-command ()
- "Show documentation for Perl command at point in other window."
- (interactive)
- (cperl-info-on-command (cperl-word-at-point)))
-
-(defun cperl-imenu-info-imenu-search ()
- (if (looking-at "^-X[ \t\n]") nil
- (re-search-backward
- "^\n\\([-a-zA-Z_]+\\)[ \t\n]")
- (forward-line 1)))
-
-(defun cperl-imenu-info-imenu-name ()
- (buffer-substring
- (match-beginning 1) (match-end 1)))
-
-(defun cperl-imenu-on-info ()
- "Shows imenu for Perl Info Buffer.
-Opens Perl Info buffer if needed."
- (interactive)
- (let* ((buffer (current-buffer))
- imenu-create-index-function
- imenu-prev-index-position-function
- imenu-extract-index-name-function
- (index-item (save-restriction
- (save-window-excursion
- (set-buffer (cperl-info-buffer nil))
- (setq imenu-create-index-function
- 'imenu-default-create-index-function
- imenu-prev-index-position-function
- 'cperl-imenu-info-imenu-search
- imenu-extract-index-name-function
- 'cperl-imenu-info-imenu-name)
- (imenu-choose-buffer-index)))))
- (and index-item
- (progn
- (push-mark)
- (pop-to-buffer "*info-perl*")
- (cond
- ((markerp (cdr index-item))
- (goto-char (marker-position (cdr index-item))))
- (t
- (goto-char (cdr index-item))))
- (set-window-start (selected-window) (point))
- (pop-to-buffer buffer)))))
-
-(defun cperl-lineup (beg end &optional step minshift)
- "Lineup construction in a region.
-Beginning of region should be at the start of a construction.
-All first occurrences of this construction in the lines that are
-partially contained in the region are lined up at the same column.
-
-MINSHIFT is the minimal amount of space to insert before the construction.
-STEP is the tabwidth to position constructions.
-If STEP is nil, `cperl-lineup-step' will be used
-\(or `cperl-indent-level', if `cperl-lineup-step' is `nil').
-Will not move the position at the start to the left."
- (interactive "r")
- (let (search col tcol seen b)
- (save-excursion
- (goto-char end)
- (end-of-line)
- (setq end (point-marker))
- (goto-char beg)
- (skip-chars-forward " \t\f")
- (setq beg (point-marker))
- (indent-region beg end nil)
- (goto-char beg)
- (setq col (current-column))
- (if (looking-at "[a-zA-Z0-9_]")
- (if (looking-at "\\<[a-zA-Z0-9_]+\\>")
- (setq search
- (concat "\\<"
- (regexp-quote
- (buffer-substring (match-beginning 0)
- (match-end 0))) "\\>"))
- (error "Cannot line up in a middle of the word"))
- (if (looking-at "$")
- (error "Cannot line up end of line"))
- (setq search (regexp-quote (char-to-string (following-char)))))
- (setq step (or step cperl-lineup-step cperl-indent-level))
- (or minshift (setq minshift 1))
- (while (progn
- (beginning-of-line 2)
- (and (< (point) end)
- (re-search-forward search end t)
- (goto-char (match-beginning 0))))
- (setq tcol (current-column) seen t)
- (if (> tcol col) (setq col tcol)))
- (or seen
- (error "The construction to line up occurred only once"))
- (goto-char beg)
- (setq col (+ col minshift))
- (if (/= (% col step) 0) (setq step (* step (1+ (/ col step)))))
- (while
- (progn
- (cperl-make-indent col)
- (beginning-of-line 2)
- (and (< (point) end)
- (re-search-forward search end t)
- (goto-char (match-beginning 0)))))))) ; No body
-
-(defun cperl-etags (&optional add all files) ;; NOT USED???
- "Run etags with appropriate options for Perl files.
-If optional argument ALL is `recursive', will process Perl files
-in subdirectories too."
- (interactive)
- (let ((cmd "etags")
- (args '("-l" "none" "-r"
- ;; 1=fullname 2=package? 3=name 4=proto? 5=attrs? (VERY APPROX!)
- "/\\<sub[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)\\)[ \\t]*\\(([^()]*)[ \t]*\\)?\\([ \t]*:[^#{;]*\\)?\\([{#]\\|$\\)/\\3/"
- "-r"
- "/\\<package[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)\\)[ \\t]*\\([#;]\\|$\\)/\\1/"
- "-r"
- "/\\<\\(package\\)[ \\t]*;/\\1;/"))
- res)
- (if add (setq args (cons "-a" args)))
- (or files (setq files (list buffer-file-name)))
- (cond
- ((eq all 'recursive)
- ;;(error "Not implemented: recursive")
- (setq args (append (list "-e"
- "sub wanted {push @ARGV, $File::Find::name if /\\.[pP][Llm]$/}
- use File::Find;
- find(\\&wanted, '.');
- exec @ARGV;"
- cmd) args)
- cmd "perl"))
- (all
- ;;(error "Not implemented: all")
- (setq args (append (list "-e"
- "push @ARGV, <*.PL *.pl *.pm>;
- exec @ARGV;"
- cmd) args)
- cmd "perl"))
- (t
- (setq args (append args files))))
- (setq res (apply 'call-process cmd nil nil nil args))
- (or (eq res 0)
- (message "etags returned \"%s\"" res))))
-
-(defun cperl-toggle-auto-newline ()
- "Toggle the state of `cperl-auto-newline'."
- (interactive)
- (setq cperl-auto-newline (not cperl-auto-newline))
- (message "Newlines will %sbe auto-inserted now."
- (if cperl-auto-newline "" "not ")))
-
-(defun cperl-toggle-abbrev ()
- "Toggle the state of automatic keyword expansion in CPerl mode."
- (interactive)
- (abbrev-mode (if abbrev-mode 0 1))
- (message "Perl control structure will %sbe auto-inserted now."
- (if abbrev-mode "" "not ")))
-
-
-(defun cperl-toggle-electric ()
- "Toggle the state of parentheses doubling in CPerl mode."
- (interactive)
- (setq cperl-electric-parens (if (cperl-val 'cperl-electric-parens) 'null t))
- (message "Parentheses will %sbe auto-doubled now."
- (if (cperl-val 'cperl-electric-parens) "" "not ")))
-
-(defun cperl-toggle-autohelp ()
- "Toggle the state of Auto-Help on Perl constructs (put in the message area).
-Delay of auto-help controlled by `cperl-lazy-help-time'."
- (interactive)
- (if (fboundp 'run-with-idle-timer)
- (progn
- (if cperl-lazy-installed
- (cperl-lazy-unstall)
- (cperl-lazy-install))
- (message "Perl help messages will %sbe automatically shown now."
- (if cperl-lazy-installed "" "not ")))
- (message "Cannot automatically show Perl help messages - run-with-idle-timer missing.")))
-
-(defun cperl-toggle-construct-fix ()
- "Toggle whether `indent-region'/`indent-sexp' fix whitespace too."
- (interactive)
- (setq cperl-indent-region-fix-constructs
- (if cperl-indent-region-fix-constructs
- nil
- 1))
- (message "indent-region/indent-sexp will %sbe automatically fix whitespace."
- (if cperl-indent-region-fix-constructs "" "not ")))
-
-(defun cperl-toggle-set-debug-unwind (arg &optional backtrace)
- "Toggle (or, with numeric argument, set) debugging state of syntaxification.
-Nonpositive numeric argument disables debugging messages. The message
-summarizes which regions it was decided to rescan for syntactic constructs.
-
-The message looks like this:
-
- Syxify req=123..138 actual=101..146 done-to: 112=>146 statepos: 73=>117
-
-Numbers are character positions in the buffer. REQ provides the range to
-rescan requested by `font-lock'. ACTUAL is the range actually resyntaxified;
-for correct operation it should start and end outside any special syntactic
-construct. DONE-TO and STATEPOS indicate changes to internal caches maintained
-by CPerl."
- (interactive "P")
- (or arg
- (setq arg (if (eq cperl-syntaxify-by-font-lock
- (if backtrace 'backtrace 'message)) 0 1)))
- (setq arg (if (> arg 0) (if backtrace 'backtrace 'message) t))
- (setq cperl-syntaxify-by-font-lock arg)
- (message "Debugging messages of syntax unwind %sabled."
- (if (eq arg t) "dis" "en")))
-
-;;;; Tags file creation.
-
-(defvar cperl-tmp-buffer " *cperl-tmp*")
-
-(defun cperl-setup-tmp-buf ()
- (set-buffer (get-buffer-create cperl-tmp-buffer))
- (set-syntax-table cperl-mode-syntax-table)
- (buffer-disable-undo)
- (auto-fill-mode 0)
- (if cperl-use-syntax-table-text-property-for-tags
- (progn
- (make-local-variable 'parse-sexp-lookup-properties)
- ;; Do not introduce variable if not needed, we check it!
- (set 'parse-sexp-lookup-properties t))))
-
-(defun cperl-xsub-scan ()
- (require 'cl)
- (require 'imenu)
- (let ((index-alist '())
- (prev-pos 0) index index1 name package prefix)
- (goto-char (point-min))
- (if noninteractive
- (message "Scanning XSUB for index")
- (imenu-progress-message prev-pos 0))
- ;; Search for the function
- (progn ;;save-match-data
- (while (re-search-forward
- "^\\([ \t]*MODULE\\>[^\n]*\\<PACKAGE[ \t]*=[ \t]*\\([a-zA-Z_][a-zA-Z_0-9:]*\\)\\>\\|\\([a-zA-Z_][a-zA-Z_0-9]*\\)(\\|[ \t]*BOOT:\\)"
- nil t)
- (or noninteractive
- (imenu-progress-message prev-pos))
- (cond
- ((match-beginning 2) ; SECTION
- (setq package (buffer-substring (match-beginning 2) (match-end 2)))
- (goto-char (match-beginning 0))
- (skip-chars-forward " \t")
- (forward-char 1)
- (if (looking-at "[^\n]*\\<PREFIX[ \t]*=[ \t]*\\([a-zA-Z_][a-zA-Z_0-9]*\\)\\>")
- (setq prefix (buffer-substring (match-beginning 1) (match-end 1)))
- (setq prefix nil)))
- ((not package) nil) ; C language section
- ((match-beginning 3) ; XSUB
- (goto-char (1+ (match-beginning 3)))
- (setq index (imenu-example--name-and-position))
- (setq name (buffer-substring (match-beginning 3) (match-end 3)))
- (if (and prefix (string-match (concat "^" prefix) name))
- (setq name (substring name (length prefix))))
- (cond ((string-match "::" name) nil)
- (t
- (setq index1 (cons (concat package "::" name) (cdr index)))
- (push index1 index-alist)))
- (setcar index name)
- (push index index-alist))
- (t ; BOOT: section
- ;; (beginning-of-line)
- (setq index (imenu-example--name-and-position))
- (setcar index (concat package "::BOOT:"))
- (push index index-alist)))))
- (or noninteractive
- (imenu-progress-message prev-pos 100))
- index-alist))
-
-(defvar cperl-unreadable-ok nil)
-
-(defun cperl-find-tags (ifile xs topdir)
- (let ((b (get-buffer cperl-tmp-buffer)) ind lst elt pos ret rel
- (cperl-pod-here-fontify nil) f file)
- (save-excursion
- (if b (set-buffer b)
- (cperl-setup-tmp-buf))
- (erase-buffer)
- (condition-case err
- (setq file (car (insert-file-contents ifile)))
- (error (if cperl-unreadable-ok nil
- (if (y-or-n-p
- (format "File %s unreadable. Continue? " ifile))
- (setq cperl-unreadable-ok t)
- (error "Aborting: unreadable file %s" ifile)))))
- (if (not file)
- (message "Unreadable file %s" ifile)
- (message "Scanning file %s ..." file)
- (if (and cperl-use-syntax-table-text-property-for-tags
- (not xs))
- (condition-case err ; after __END__ may have garbage
- (cperl-find-pods-heres nil nil noninteractive)
- (error (message "While scanning for syntax: %s" err))))
- (if xs
- (setq lst (cperl-xsub-scan))
- (setq ind (cperl-imenu--create-perl-index))
- (setq lst (cdr (assoc "+Unsorted List+..." ind))))
- (setq lst
- (mapcar
- (function
- (lambda (elt)
- (cond ((string-match "^[_a-zA-Z]" (car elt))
- (goto-char (cdr elt))
- (beginning-of-line) ; pos should be of the start of the line
- (list (car elt)
- (point)
- (1+ (count-lines 1 (point))) ; 1+ since at beg-o-l
- (buffer-substring (progn
- (goto-char (cdr elt))
- ;; After name now...
- (or (eolp) (forward-char 1))
- (point))
- (progn
- (beginning-of-line)
- (point))))))))
- lst))
- (erase-buffer)
- (while lst
- (setq elt (car lst) lst (cdr lst))
- (if elt
- (progn
- (insert (elt elt 3)
- 127
- (if (string-match "^package " (car elt))
- (substring (car elt) 8)
- (car elt) )
- 1
- (number-to-string (elt elt 2)) ; Line
- ","
- (number-to-string (1- (elt elt 1))) ; Char pos 0-based
- "\n")
- (if (and (string-match "^[_a-zA-Z]+::" (car elt))
- (string-match "^sub[ \t]+\\([_a-zA-Z]+\\)[^:_a-zA-Z]"
- (elt elt 3)))
- ;; Need to insert the name without package as well
- (setq lst (cons (cons (substring (elt elt 3)
- (match-beginning 1)
- (match-end 1))
- (cdr elt))
- lst))))))
- (setq pos (point))
- (goto-char 1)
- (setq rel file)
- ;; On case-preserving filesystems (EMX on OS/2) case might be encoded in properties
- (set-text-properties 0 (length rel) nil rel)
- (and (equal topdir (substring rel 0 (length topdir)))
- (setq rel (substring file (length topdir))))
- (insert "\f\n" rel "," (number-to-string (1- pos)) "\n")
- (setq ret (buffer-substring 1 (point-max)))
- (erase-buffer)
- (or noninteractive
- (message "Scanning file %s finished" file))
- ret))))
-
-(defun cperl-add-tags-recurse-noxs ()
- "Add to TAGS data for \"pure\" Perl files in the current directory and kids.
-Use as
- emacs -batch -q -no-site-file -l emacs/cperl-mode.el \
- -f cperl-add-tags-recurse-noxs
-"
- (cperl-write-tags nil nil t t nil t))
-
-(defun cperl-add-tags-recurse-noxs-fullpath ()
- "Add to TAGS data for \"pure\" Perl in the current directory and kids.
-Writes down fullpath, so TAGS is relocatable (but if the build directory
-is relocated, the file TAGS inside it breaks). Use as
- emacs -batch -q -no-site-file -l emacs/cperl-mode.el \
- -f cperl-add-tags-recurse-noxs-fullpath
-"
- (cperl-write-tags nil nil t t nil t ""))
-
-(defun cperl-add-tags-recurse ()
- "Add to TAGS file data for Perl files in the current directory and kids.
-Use as
- emacs -batch -q -no-site-file -l emacs/cperl-mode.el \
- -f cperl-add-tags-recurse
-"
- (cperl-write-tags nil nil t t))
-
-(defun cperl-write-tags (&optional file erase recurse dir inbuffer noxs topdir)
- ;; If INBUFFER, do not select buffer, and do not save
- ;; If ERASE is `ignore', do not erase, and do not try to delete old info.
- (require 'etags)
- (if file nil
- (setq file (if dir default-directory (buffer-file-name)))
- (if (and (not dir) (buffer-modified-p)) (error "Save buffer first!")))
- (or topdir
- (setq topdir default-directory))
- (let ((tags-file-name "TAGS")
- (case-fold-search (eq system-type 'emx))
- xs rel tm)
- (save-excursion
- (cond (inbuffer nil) ; Already there
- ((file-exists-p tags-file-name)
- (if cperl-xemacs-p
- (visit-tags-table-buffer)
- (visit-tags-table-buffer tags-file-name)))
- (t (set-buffer (find-file-noselect tags-file-name))))
- (cond
- (dir
- (cond ((eq erase 'ignore))
- (erase
- (erase-buffer)
- (setq erase 'ignore)))
- (let ((files
- (condition-case err
- (directory-files file t
- (if recurse nil cperl-scan-files-regexp)
- t)
- (error
- (if cperl-unreadable-ok nil
- (if (y-or-n-p
- (format "Directory %s unreadable. Continue? " file))
- (setq cperl-unreadable-ok t
- tm nil) ; Return empty list
- (error "Aborting: unreadable directory %s" file)))))))
- (mapcar (function
- (lambda (file)
- (cond
- ((string-match cperl-noscan-files-regexp file)
- nil)
- ((not (file-directory-p file))
- (if (string-match cperl-scan-files-regexp file)
- (cperl-write-tags file erase recurse nil t noxs topdir)))
- ((not recurse) nil)
- (t (cperl-write-tags file erase recurse t t noxs topdir)))))
- files)))
- (t
- (setq xs (string-match "\\.xs$" file))
- (if (not (and xs noxs))
- (progn
- (cond ((eq erase 'ignore) (goto-char (point-max)))
- (erase (erase-buffer))
- (t
- (goto-char 1)
- (setq rel file)
- ;; On case-preserving filesystems (EMX on OS/2) case might be encoded in properties
- (set-text-properties 0 (length rel) nil rel)
- (and (equal topdir (substring rel 0 (length topdir)))
- (setq rel (substring file (length topdir))))
- (if (search-forward (concat "\f\n" rel ",") nil t)
- (progn
- (search-backward "\f\n")
- (delete-region (point)
- (save-excursion
- (forward-char 1)
- (if (search-forward "\f\n"
- nil 'toend)
- (- (point) 2)
- (point-max)))))
- (goto-char (point-max)))))
- (insert (cperl-find-tags file xs topdir))))))
- (if inbuffer nil ; Delegate to the caller
- (save-buffer 0) ; No backup
- (if (fboundp 'initialize-new-tags-table) ; Do we need something special in XEmacs?
- (initialize-new-tags-table))))))
-
-(defvar cperl-tags-hier-regexp-list
- (concat
- "^\\("
- "\\(package\\)\\>"
- "\\|"
- "sub\\>[^\n]+::"
- "\\|"
- "[a-zA-Z_][a-zA-Z_0-9:]*(\C-?[^\n]+::" ; XSUB?
- "\\|"
- "[ \t]*BOOT:\C-?[^\n]+::" ; BOOT section
- "\\)"))
-
-(defvar cperl-hierarchy '(() ())
- "Global hierarchy of classes.")
-
-(defun cperl-tags-hier-fill ()
- ;; Suppose we are in a tag table cooked by cperl.
- (goto-char 1)
- (let (type pack name pos line chunk ord cons1 file str info fileind)
- (while (re-search-forward cperl-tags-hier-regexp-list nil t)
- (setq pos (match-beginning 0)
- pack (match-beginning 2))
- (beginning-of-line)
- (if (looking-at (concat
- "\\([^\n]+\\)"
- "\C-?"
- "\\([^\n]+\\)"
- "\C-a"
- "\\([0-9]+\\)"
- ","
- "\\([0-9]+\\)"))
- (progn
- (setq ;;str (buffer-substring (match-beginning 1) (match-end 1))
- name (buffer-substring (match-beginning 2) (match-end 2))
- ;;pos (buffer-substring (match-beginning 3) (match-end 3))
- line (buffer-substring (match-beginning 3) (match-end 3))
- ord (if pack 1 0)
- file (file-of-tag)
- fileind (format "%s:%s" file line)
- ;; Moves to beginning of the next line:
- info (cperl-etags-snarf-tag file line))
- ;; Move back
- (forward-char -1)
- ;; Make new member of hierarchy name ==> file ==> pos if needed
- (if (setq cons1 (assoc name (nth ord cperl-hierarchy)))
- ;; Name known
- (setcdr cons1 (cons (cons fileind (vector file info))
- (cdr cons1)))
- ;; First occurrence of the name, start alist
- (setq cons1 (cons name (list (cons fileind (vector file info)))))
- (if pack
- (setcar (cdr cperl-hierarchy)
- (cons cons1 (nth 1 cperl-hierarchy)))
- (setcar cperl-hierarchy
- (cons cons1 (car cperl-hierarchy)))))))
- (end-of-line))))
-
-(defun cperl-tags-hier-init (&optional update)
- "Show hierarchical menu of classes and methods.
-Finds info about classes by a scan of loaded TAGS files.
-Supposes that the TAGS files contain fully qualified function names.
-One may build such TAGS files from CPerl mode menu."
- (interactive)
- (require 'etags)
- (require 'imenu)
- (if (or update (null (nth 2 cperl-hierarchy)))
- (let ((remover (function (lambda (elt) ; (name (file1...) (file2..))
- (or (nthcdr 2 elt)
- ;; Only in one file
- (setcdr elt (cdr (nth 1 elt)))))))
- pack name cons1 to l1 l2 l3 l4 b)
- ;; (setq cperl-hierarchy '(() () ())) ; Would write into '() later!
- (setq cperl-hierarchy (list l1 l2 l3))
- (if cperl-xemacs-p ; Not checked
- (progn
- (or tags-file-name
- ;; Does this work in XEmacs?
- (call-interactively 'visit-tags-table))
- (message "Updating list of classes...")
- (set-buffer (get-file-buffer tags-file-name))
- (cperl-tags-hier-fill))
- (or tags-table-list
- (call-interactively 'visit-tags-table))
- (mapcar
- (function
- (lambda (tagsfile)
- (message "Updating list of classes... %s" tagsfile)
- (set-buffer (get-file-buffer tagsfile))
- (cperl-tags-hier-fill)))
- tags-table-list)
- (message "Updating list of classes... postprocessing..."))
- (mapcar remover (car cperl-hierarchy))
- (mapcar remover (nth 1 cperl-hierarchy))
- (setq to (list nil (cons "Packages: " (nth 1 cperl-hierarchy))
- (cons "Methods: " (car cperl-hierarchy))))
- (cperl-tags-treeify to 1)
- (setcar (nthcdr 2 cperl-hierarchy)
- (cperl-menu-to-keymap (cons '("+++UPDATE+++" . -999) (cdr to))))
- (message "Updating list of classes: done, requesting display...")
- ;;(cperl-imenu-addback (nth 2 cperl-hierarchy))
- ))
- (or (nth 2 cperl-hierarchy)
- (error "No items found"))
- (setq update
-;;; (imenu-choose-buffer-index "Packages: " (nth 2 cperl-hierarchy))
- (if (if (fboundp 'display-popup-menus-p)
- (let ((f 'display-popup-menus-p))
- (funcall f))
- window-system)
- (x-popup-menu t (nth 2 cperl-hierarchy))
- (require 'tmm)
- (tmm-prompt (nth 2 cperl-hierarchy))))
- (if (and update (listp update))
- (progn (while (cdr update) (setq update (cdr update)))
- (setq update (car update)))) ; Get the last from the list
- (if (vectorp update)
- (progn
- (find-file (elt update 0))
- (cperl-etags-goto-tag-location (elt update 1))))
- (if (eq update -999) (cperl-tags-hier-init t)))
-
-(defun cperl-tags-treeify (to level)
- ;; cadr of `to' is read-write. On start it is a cons
- (let* ((regexp (concat "^\\(" (mapconcat
- 'identity
- (make-list level "[_a-zA-Z0-9]+")
- "::")
- "\\)\\(::\\)?"))
- (packages (cdr (nth 1 to)))
- (methods (cdr (nth 2 to)))
- l1 head tail cons1 cons2 ord writeto packs recurse
- root-packages root-functions ms many_ms same_name ps
- (move-deeper
- (function
- (lambda (elt)
- (cond ((and (string-match regexp (car elt))
- (or (eq ord 1) (match-end 2)))
- (setq head (substring (car elt) 0 (match-end 1))
- tail (if (match-end 2) (substring (car elt)
- (match-end 2)))
- recurse t)
- (if (setq cons1 (assoc head writeto)) nil
- ;; Need to init new head
- (setcdr writeto (cons (list head (list "Packages: ")
- (list "Methods: "))
- (cdr writeto)))
- (setq cons1 (nth 1 writeto)))
- (setq cons2 (nth ord cons1)) ; Either packs or meths
- (setcdr cons2 (cons elt (cdr cons2))))
- ((eq ord 2)
- (setq root-functions (cons elt root-functions)))
- (t
- (setq root-packages (cons elt root-packages))))))))
- (setcdr to l1) ; Init to dynamic space
- (setq writeto to)
- (setq ord 1)
- (mapcar move-deeper packages)
- (setq ord 2)
- (mapcar move-deeper methods)
- (if recurse
- (mapcar (function (lambda (elt)
- (cperl-tags-treeify elt (1+ level))))
- (cdr to)))
- ;;Now clean up leaders with one child only
- (mapcar (function (lambda (elt)
- (if (not (and (listp (cdr elt))
- (eq (length elt) 2))) nil
- (setcar elt (car (nth 1 elt)))
- (setcdr elt (cdr (nth 1 elt))))))
- (cdr to))
- ;; Sort the roots of subtrees
- (if (default-value 'imenu-sort-function)
- (setcdr to
- (sort (cdr to) (default-value 'imenu-sort-function))))
- ;; Now add back functions removed from display
- (mapcar (function (lambda (elt)
- (setcdr to (cons elt (cdr to)))))
- (if (default-value 'imenu-sort-function)
- (nreverse
- (sort root-functions (default-value 'imenu-sort-function)))
- root-functions))
- ;; Now add back packages removed from display
- (mapcar (function (lambda (elt)
- (setcdr to (cons (cons (concat "package " (car elt))
- (cdr elt))
- (cdr to)))))
- (if (default-value 'imenu-sort-function)
- (nreverse
- (sort root-packages (default-value 'imenu-sort-function)))
- root-packages))))
-
-;;;(x-popup-menu t
-;;; '(keymap "Name1"
-;;; ("Ret1" "aa")
-;;; ("Head1" "ab"
-;;; keymap "Name2"
-;;; ("Tail1" "x") ("Tail2" "y"))))
-
-(defun cperl-list-fold (list name limit)
- (let (list1 list2 elt1 (num 0))
- (if (<= (length list) limit) list
- (setq list1 nil list2 nil)
- (while list
- (setq num (1+ num)
- elt1 (car list)
- list (cdr list))
- (if (<= num imenu-max-items)
- (setq list2 (cons elt1 list2))
- (setq list1 (cons (cons name
- (nreverse list2))
- list1)
- list2 (list elt1)
- num 1)))
- (nreverse (cons (cons name
- (nreverse list2))
- list1)))))
-
-(defun cperl-menu-to-keymap (menu &optional name)
- (let (list)
- (cons 'keymap
- (mapcar
- (function
- (lambda (elt)
- (cond ((listp (cdr elt))
- (setq list (cperl-list-fold
- (cdr elt) (car elt) imenu-max-items))
- (cons nil
- (cons (car elt)
- (cperl-menu-to-keymap list))))
- (t
- (list (cdr elt) (car elt) t))))) ; t is needed in 19.34
- (cperl-list-fold menu "Root" imenu-max-items)))))
-
-\f
-(defvar cperl-bad-style-regexp
- (mapconcat 'identity
- '("[^-\n\t <>=+!.&|(*/'`\"#^][-=+<>!|&^]" ; char sign
- "[-<>=+^&|]+[^- \t\n=+<>~]") ; sign+ char
- "\\|")
- "Finds places such that insertion of a whitespace may help a lot.")
-
-(defvar cperl-not-bad-style-regexp
- (mapconcat
- 'identity
- '("[^-\t <>=+]\\(--\\|\\+\\+\\)" ; var-- var++
- "[a-zA-Z0-9_][|&][a-zA-Z0-9_$]" ; abc|def abc&def are often used.
- "&[(a-zA-Z0-9_$]" ; &subroutine &(var->field)
- "<\\$?\\sw+\\(\\.\\(\\sw\\|_\\)+\\)?>" ; <IN> <stdin.h>
- "-[a-zA-Z][ \t]+[_$\"'`a-zA-Z]" ; -f file, -t STDIN
- "-[0-9]" ; -5
- "\\+\\+" ; ++var
- "--" ; --var
- ".->" ; a->b
- "->" ; a SPACE ->b
- "\\[-" ; a[-1]
- "\\\\[&$@*\\\\]" ; \&func
- "^=" ; =head
- "\\$." ; $|
- "<<[a-zA-Z_'\"`]" ; <<FOO, <<'FOO'
- "||"
- "&&"
- "[CBIXSLFZ]<\\(\\sw\\|\\s \\|\\s_\\|[\n]\\)*>" ; C<code like text>
- "-[a-zA-Z_0-9]+[ \t]*=>" ; -option => value
- ;; Unaddressed trouble spots: = -abc, f(56, -abc) --- specialcased below
- ;;"[*/+-|&<.]+="
- )
- "\\|")
- "If matches at the start of match found by `my-bad-c-style-regexp',
-insertion of a whitespace will not help.")
-
-(defvar found-bad)
-
-(defun cperl-find-bad-style ()
- "Find places in the buffer where insertion of a whitespace may help.
-Prompts user for insertion of spaces.
-Currently it is tuned to C and Perl syntax."
- (interactive)
- (let (found-bad (p (point)))
- (setq last-nonmenu-event 13) ; To disable popup
- (goto-char (point-min))
- (map-y-or-n-p "Insert space here? "
- (lambda (arg) (insert " "))
- 'cperl-next-bad-style
- '("location" "locations" "insert a space into")
- '((?\C-r (lambda (arg)
- (let ((buffer-quit-function
- 'exit-recursive-edit))
- (message "Exit with Esc Esc")
- (recursive-edit)
- t)) ; Consider acted upon
- "edit, exit with Esc Esc")
- (?e (lambda (arg)
- (let ((buffer-quit-function
- 'exit-recursive-edit))
- (message "Exit with Esc Esc")
- (recursive-edit)
- t)) ; Consider acted upon
- "edit, exit with Esc Esc"))
- t)
- (if found-bad (goto-char found-bad)
- (goto-char p)
- (message "No appropriate place found"))))
-
-(defun cperl-next-bad-style ()
- (let (p (not-found t) (point (point)) found)
- (while (and not-found
- (re-search-forward cperl-bad-style-regexp nil 'to-end))
- (setq p (point))
- (goto-char (match-beginning 0))
- (if (or
- (looking-at cperl-not-bad-style-regexp)
- ;; Check for a < -b and friends
- (and (eq (following-char) ?\-)
- (save-excursion
- (skip-chars-backward " \t\n")
- (memq (preceding-char) '(?\= ?\> ?\< ?\, ?\( ?\[ ?\{))))
- ;; Now check for syntax type
- (save-match-data
- (setq found (point))
- (beginning-of-defun)
- (let ((pps (parse-partial-sexp (point) found)))
- (or (nth 3 pps) (nth 4 pps) (nth 5 pps)))))
- (goto-char (match-end 0))
- (goto-char (1- p))
- (setq not-found nil
- found-bad found)))
- (not not-found)))
-
-\f
-;;; Getting help
-(defvar cperl-have-help-regexp
- ;;(concat "\\("
- (mapconcat
- 'identity
- '("[$@%*&][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="
- "#!")
- ;;"\\)\\|\\("
- "\\|")
- ;;"\\)"
- ;;)
- "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.
-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-match-data ; May be called "inside" query-replace
- (save-excursion
- (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) (min (+ 5 (point)) (point-max))))))))))
-
-;;; Stolen from perl-descr.el by Johan Vromans:
-
-(defvar cperl-doc-buffer " *perl-doc*"
- "Where the documentation can be found.")
-
-(defun cperl-describe-perl-symbol (val)
- "Display the documentation of symbol at point, a Perl operator."
- (let ((enable-recursive-minibuffers t)
- args-file regexp)
- (cond
- ((string-match "^[&*][a-zA-Z_]" val)
- (setq val (concat (substring val 0 1) "NAME")))
- ((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))))))
- ((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>")))
- (setq regexp (concat "^"
- "\\([^a-zA-Z0-9_:]+[ \t]+\\)?"
- (regexp-quote val)
- "\\([ \t([/]\\|$\\)"))
-
- ;; get the buffer with the documentation text
- (cperl-switch-to-doc-buffer)
-
- ;; lookup in the doc
- (goto-char (point-min))
- (let ((case-fold-search nil))
- (list
- (if (re-search-forward regexp (point-max) t)
- (save-excursion
- (beginning-of-line 1)
- (let ((lnstart (point)))
- (end-of-line)
- (message "%s" (buffer-substring lnstart (point)))))
- (if cperl-message-on-help-error
- (message "No definition for %s" val)))))))
-
-(defvar cperl-short-docs 'please-ignore-this-line
- ;; Perl4 version was written by Johan Vromans (jvromans@squirrel.nl)
- "# based on '@(#)@ perl-descr.el 1.9 - describe-perl-symbol' [Perl 5]
-... Range (list context); flip/flop [no flop when flip] (scalar context).
-! ... 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. Default is %.15g or close.
-$$ 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:
-
-$1 Match of the 1st set of parentheses in the last match (auto-local).
-$2 Match of the 2nd set of parentheses in the last match (auto-local).
-$3 Match of the 3rd set of parentheses in the last match (auto-local).
-$4 Match of the 4th set of parentheses in the last match (auto-local).
-$5 Match of the 5th set of parentheses in the last match (auto-local).
-$6 Match of the 6th set of parentheses in the last match (auto-local).
-$7 Match of the 7th set of parentheses in the last match (auto-local).
-$8 Match of the 8th set of parentheses in the last match (auto-local).
-$9 Match of the 9th set of parentheses in the last match (auto-local).
-$& The string matched by the last pattern match (auto-local).
-$' The string after what was matched by the last match (auto-local).
-$` The string before what was matched by the last match (auto-local).
-
-$( The real gid of this process.
-$) The effective gid of this process.
-$* Deprecated: Set to 1 to do multiline matching within a string.
-$+ The last bracket matched by the last search pattern.
-$, 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 Name of the file containing the current perl script (read/write).
-$: 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.
-$? The status returned by the last ``, pipe close or `system'.
-$@ The perl error message from the last eval or do @var{EXPR} command.
-$ARGV The name of the current file used with <> .
-$[ Deprecated: The index of the first element/char in an array/string.
-$\\ The output record separator for the print operator.
-$] The perl version string as displayed with perl -v.
-$^ The name of the current top-of-page format.
-$^A The current value of the write() accumulator for format() lines.
-$^D The value of the perl debug (-D) flags.
-$^E Information about the last system error other than that provided by $!.
-$^F The highest system file descriptor, ordinarily 2.
-$^H The current set of syntax checks enabled by `use strict'.
-$^I The value of the in-place edit extension (perl -i option).
-$^L What formats output to perform a formfeed. Default is \f.
-$^M A buffer for emergency memory allocation when running out of memory.
-$^O The operating system name under which this copy of Perl was built.
-$^P Internal debugging flag.
-$^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.
-$| Auto-flush after write/print on current output channel? Default 0.
-$~ The name of the current report format.
-... % ... 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 Glob: all objects refered by NAME. *NAM1 = *NAM2 aliases NAM1 to NAM2.
-&NAME(arg0, ...) Subroutine call. Arguments go to @_.
-... + ... Addition. +EXPR Makes EXPR into scalar context.
-++ Auto-increment (magical on strings). ++EXPR EXPR++
-... += ... Addition assignment.
-, Comma operator.
-... - ... 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.
--M Age in days since script started.
--O File is owned by real uid.
--R File is readable by real uid.
--S File is a socket .
--T File is a text file.
--W File is writable by real uid.
--X File is executable by real uid.
--b File is a block special file.
--c File is a character special file.
--d File is a directory.
--e File exists .
--f File is a plain file.
--g File has setgid bit set.
--k File has sticky bit set.
--l File is a symbolic link.
--o File is owned by effective uid.
--p File is a named pipe (FIFO).
--r File is readable by effective uid.
--s File has non-zero size.
--t Tests if filehandle (STDIN by default) is opened to a tty.
--u File has setuid bit set.
--w File is writable by effective uid.
--x File is executable by effective uid.
--z File has zero size.
-. Concatenate strings.
-.. Range (list context); flip/flop (scalar context) operator.
-.= Concatenate assignment strings
-... / ... Division. /PATTERN/ioxsmg Pattern match
-... /= ... Division assignment.
-/PATTERN/ioxsmg Pattern match.
-... < ... Numeric less than. <pattern> Glob. See <NAME>, <> as well.
-<NAME> Reads line from filehandle NAME (a bareword or 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.
-... ? ... : ... 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; result of split() unless in list context.
-\\ Creates reference to what follows, like \$var, or quotes non-\w in strings.
-\\0 Octal char, e.g. \\033.
-\\E Case modification terminator. See \\Q, \\L, and \\U.
-\\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 the next character. See also \\L and \\u, lcfirst.
-\\n Newline character (octal 012 on most systems).
-\\r Return character (octal 015 on most systems).
-\\t Tab character (octal 011).
-\\u Upcase the next character. See also \\U and \\l, ucfirst.
-\\x Hex character, e.g. \\x1b.
-... ^ ... Bitwise exclusive or.
-__END__ Ends program source.
-__DATA__ Ends program source.
-__FILE__ Current (source) filename.
-__LINE__ Current line in current source.
-__PACKAGE__ Current package.
-ARGV Default multi-file input filehandle. <ARGV> is a synonym for <>.
-ARGVOUT Output filehandle with -i flag.
-BEGIN { ... } Immediately executed (during compilation) piece of code.
-END { ... } Pseudo-subroutine executed after the script finishes.
-CHECK { ... } Pseudo-subroutine executed after the script is compiled.
-INIT { ... } Pseudo-subroutine executed before the script starts running.
-DATA Input filehandle for what follows after __END__ or __DATA__.
-accept(NEWSOCKET,GENERICSOCKET)
-alarm(SECONDS)
-atan2(X,Y)
-bind(SOCKET,NAME)
-binmode(FILEHANDLE)
-caller[(LEVEL)]
-chdir(EXPR)
-chmod(LIST)
-chop[(LIST|VAR)]
-chown(LIST)
-chroot(FILENAME)
-close(FILEHANDLE)
-closedir(DIRHANDLE)
-... cmp ... String compare.
-connect(SOCKET,NAME)
-continue of { block } continue { block }. Is executed after `next' or at end.
-cos(EXPR)
-crypt(PLAINTEXT,SALT)
-dbmclose(%HASH)
-dbmopen(%HASH,DBNAME,MODE)
-defined(EXPR)
-delete($HASH{KEY})
-die(LIST)
-do { ... }|SUBR while|until EXPR executes at least once
-do(EXPR|SUBR([LIST])) (with while|until executes at least once)
-dump LABEL
-each(%HASH)
-endgrent
-endhostent
-endnetent
-endprotoent
-endpwent
-endservent
-eof[([FILEHANDLE])]
-... eq ... String equality.
-eval(EXPR) or eval { BLOCK }
-exec([TRUENAME] ARGV0, ARGVs) or exec(SHELL_COMMAND_LINE)
-exit(EXPR)
-exp(EXPR)
-fcntl(FILEHANDLE,FUNCTION,SCALAR)
-fileno(FILEHANDLE)
-flock(FILEHANDLE,OPERATION)
-for (EXPR;EXPR;EXPR) { ... }
-foreach [VAR] (@ARRAY) { ... }
-fork
-... ge ... String greater than or equal.
-getc[(FILEHANDLE)]
-getgrent
-getgrgid(GID)
-getgrnam(NAME)
-gethostbyaddr(ADDR,ADDRTYPE)
-gethostbyname(NAME)
-gethostent
-getlogin
-getnetbyaddr(ADDR,ADDRTYPE)
-getnetbyname(NAME)
-getnetent
-getpeername(SOCKET)
-getpgrp(PID)
-getppid
-getpriority(WHICH,WHO)
-getprotobyname(NAME)
-getprotobynumber(NUMBER)
-getprotoent
-getpwent
-getpwnam(NAME)
-getpwuid(UID)
-getservbyname(NAME,PROTO)
-getservbyport(PORT,PROTO)
-getservent
-getsockname(SOCKET)
-getsockopt(SOCKET,LEVEL,OPTNAME)
-gmtime(EXPR)
-goto LABEL
-... 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(%HASH)
-kill(LIST)
-last [LABEL]
-... le ... String less than or equal.
-length(EXPR)
-link(OLDFILE,NEWFILE)
-listen(SOCKET,QUEUESIZE)
-local(LIST)
-localtime(EXPR)
-log(EXPR)
-lstat(EXPR|FILEHANDLE|VAR)
-... lt ... String less than.
-m/PATTERN/iogsmx
-mkdir(FILENAME,MODE)
-msgctl(ID,CMD,ARG)
-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).
-our VAR or our (VAR1,...) Lexically enable a global variable ($V, @A, or %H).
-... ne ... String inequality.
-next [LABEL]
-oct(EXPR)
-open(FILEHANDLE[,EXPR])
-opendir(DIRHANDLE,EXPR)
-ord(EXPR) ASCII value of the first char of the string.
-pack(TEMPLATE,LIST)
-package NAME Introduces package context.
-pipe(READHANDLE,WRITEHANDLE) Create a pair of filehandles on ends of a pipe.
-pop(ARRAY)
-print [FILEHANDLE] [(LIST)]
-printf [FILEHANDLE] (FORMAT,LIST)
-push(ARRAY,LIST)
-q/STRING/ Synonym for 'STRING'
-qq/STRING/ Synonym for \"STRING\"
-qx/STRING/ Synonym for `STRING`
-rand[(EXPR)]
-read(FILEHANDLE,SCALAR,LENGTH[,OFFSET])
-readdir(DIRHANDLE)
-readlink(EXPR)
-recv(SOCKET,SCALAR,LEN,FLAGS)
-redo [LABEL]
-rename(OLDNAME,NEWNAME)
-require [FILENAME | PERL_VERSION]
-reset[(EXPR)]
-return(LIST)
-reverse(LIST)
-rewinddir(DIRHANDLE)
-rindex(STR,SUBSTR[,OFFSET])
-rmdir(FILENAME)
-s/PATTERN/REPLACEMENT/gieoxsm
-scalar(EXPR)
-seek(FILEHANDLE,POSITION,WHENCE)
-seekdir(DIRHANDLE,POS)
-select(FILEHANDLE | RBITS,WBITS,EBITS,TIMEOUT)
-semctl(ID,SEMNUM,CMD,ARG)
-semget(KEY,NSEMS,SIZE,FLAGS)
-semop(KEY,...)
-send(SOCKET,MSG,FLAGS[,TO])
-setgrent
-sethostent(STAYOPEN)
-setnetent(STAYOPEN)
-setpgrp(PID,PGRP)
-setpriority(WHICH,WHO,PRIORITY)
-setprotoent(STAYOPEN)
-setpwent
-setservent(STAYOPEN)
-setsockopt(SOCKET,LEVEL,OPTNAME,OPTVAL)
-shift[(ARRAY)]
-shmctl(ID,CMD,ARG)
-shmget(KEY,SIZE,FLAGS)
-shmread(ID,VAR,POS,SIZE)
-shmwrite(ID,STRING,POS,SIZE)
-shutdown(SOCKET,HOW)
-sin(EXPR)
-sleep[(EXPR)]
-socket(SOCKET,DOMAIN,TYPE,PROTOCOL)
-socketpair(SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL)
-sort [SUBROUTINE] (LIST)
-splice(ARRAY,OFFSET[,LENGTH[,LIST]])
-split[(/PATTERN/[,EXPR[,LIMIT]])]
-sprintf(FORMAT,LIST)
-sqrt(EXPR)
-srand(EXPR)
-stat(EXPR|FILEHANDLE|VAR)
-study[(SCALAR)]
-sub [NAME [(format)]] { BODY } sub NAME [(format)]; sub [(format)] {...}
-substr(EXPR,OFFSET[,LEN])
-symlink(OLDFILE,NEWFILE)
-syscall(LIST)
-sysread(FILEHANDLE,SCALAR,LENGTH[,OFFSET])
-system([TRUENAME] ARGV0 [,ARGV]) or system(SHELL_COMMAND_LINE)
-syswrite(FILEHANDLE,SCALAR,LENGTH[,OFFSET])
-tell[(FILEHANDLE)]
-telldir(DIRHANDLE)
-time
-times
-tr/SEARCHLIST/REPLACEMENTLIST/cds
-truncate(FILE|EXPR,LENGTH)
-umask[(EXPR)]
-undef[(EXPR)]
-unless (EXPR) { ... } [ else { ... } ] or EXPR unless EXPR
-unlink(LIST)
-unpack(TEMPLATE,EXPR)
-unshift(ARRAY,LIST)
-until (EXPR) { ... } EXPR until EXPR
-utime(LIST)
-values(%HASH)
-vec(EXPR,OFFSET,BITS)
-wait
-waitpid(PID,FLAGS)
-wantarray Returns true if the sub/eval is called in list context.
-warn(LIST)
-while (EXPR) { ... } EXPR while EXPR
-write[(EXPR|FILEHANDLE)]
-... x ... Repeat string or array.
-x= ... Repetition assignment.
-y/SEARCHLIST/REPLACEMENTLIST/
-... | ... 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 [LIST] Strips $/ off LIST/$_. Returns count. Special if $/ eq ''!
-chr Converts a number to char with the same ordinal.
-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 [NAME] = Start of output format. Ended by a single dot (.) on a line.
-formline PICTURE, LIST Backdoor into \"format\" processing.
-glob EXPR Synonym of <EXPR>.
-lc [ EXPR ] Returns lowercased EXPR.
-lcfirst [ EXPR ] Returns EXPR with lower-cased first letter.
-grep EXPR,LIST or grep {BLOCK} LIST Filters LIST via EXPR/BLOCK.
-map EXPR, LIST or map {BLOCK} LIST Applies EXPR/BLOCK to elts of LIST.
-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 regexp metacharacters.
-qw/WORD1 .../ Synonym of split('', 'WORD1 ...')
-readline FH Synonym of <FH>.
-readpipe CMD Synonym of `CMD`.
-ref [ EXPR ] Type of EXPR when dereferenced.
-sysopen FH, FILENAME, MODE [, PERM] (MODE is numeric, see Fcntl.)
-tie VAR, PACKAGE, LIST Hide an object behind a simple Perl variable.
-tied Returns internal object for a tied data.
-uc [ EXPR ] Returns upcased EXPR.
-ucfirst [ EXPR ] Returns EXPR with upcased first letter.
-untie VAR Unlink an object from a simple Perl variable.
-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 ()
- "Go to the perl documentation buffer and insert the documentation."
- (interactive)
- (let ((buf (get-buffer-create cperl-doc-buffer)))
- (if (interactive-p)
- (switch-to-buffer-other-window buf)
- (set-buffer buf))
- (if (= (buffer-size) 0)
- (progn
- (insert (documentation-property 'cperl-short-docs
- 'variable-documentation))
- (setq buffer-read-only t)))))
-
-(defun cperl-beautify-regexp-piece (b e embed level)
- ;; b is before the starting delimiter, e before the ending
- ;; e should be a marker, may be changed, but remains "correct".
- ;; EMBED is nil iff we process the whole REx.
- ;; The REx is guaranteed to have //x
- ;; LEVEL shows how many levels deep to go
- ;; position at enter and at leave is not defined
- (let (s c tmp (m (make-marker)) (m1 (make-marker)) c1 spaces inline code pos)
- (if (not embed)
- (goto-char (1+ b))
- (goto-char b)
- (cond ((looking-at "(\\?\\\\#") ; (?#) wrongly commented when //x-ing
- (forward-char 2)
- (delete-char 1)
- (forward-char 1))
- ((looking-at "(\\?[^a-zA-Z]")
- (forward-char 3))
- ((looking-at "(\\?") ; (?i)
- (forward-char 2))
- (t
- (forward-char 1))))
- (setq c (if embed (current-indentation) (1- (current-column)))
- c1 (+ c (or cperl-regexp-indent-step cperl-indent-level)))
- (or (looking-at "[ \t]*[\n#]")
- (progn
- (insert "\n")))
- (goto-char e)
- (beginning-of-line)
- (if (re-search-forward "[^ \t]" e t)
- (progn ; Something before the ending delimiter
- (goto-char e)
- (delete-horizontal-space)
- (insert "\n")
- (cperl-make-indent c)
- (set-marker e (point))))
- (goto-char b)
- (end-of-line 2)
- (while (< (point) (marker-position e))
- (beginning-of-line)
- (setq s (point)
- inline t)
- (skip-chars-forward " \t")
- (delete-region s (point))
- (cperl-make-indent c1)
- (while (and
- inline
- (looking-at
- (concat "\\([a-zA-Z0-9]+[^*+{?]\\)" ; 1 word
- "\\|" ; Embedded variable
- "\\$\\([a-zA-Z0-9_]+\\([[{]\\)?\\|[^\n \t)|]\\)" ; 2 3
- "\\|" ; $ ^
- "[$^]"
- "\\|" ; simple-code simple-code*?
- "\\(\\\\.\\|[^][()#|*+?\n]\\)\\([*+{?]\\??\\)?" ; 4 5
- "\\|" ; Class
- "\\(\\[\\)" ; 6
- "\\|" ; Grouping
- "\\((\\(\\?\\)?\\)" ; 7 8
- "\\|" ; |
- "\\(|\\)"))) ; 9
- (goto-char (match-end 0))
- (setq spaces t)
- (cond ((match-beginning 1) ; Alphanum word + junk
- (forward-char -1))
- ((or (match-beginning 3) ; $ab[12]
- (and (match-beginning 5) ; X* X+ X{2,3}
- (eq (preceding-char) ?\{)))
- (forward-char -1)
- (forward-sexp 1))
- ((and ; [], already syntaxified
- (match-beginning 6)
- cperl-regexp-scan
- cperl-use-syntax-table-text-property)
- (forward-char -1)
- (forward-sexp 1)
- (or (eq (preceding-char) ?\])
- (error "[]-group not terminated"))
- (re-search-forward
- "\\=\\([*+?]\\|{[0-9]+\\(,[0-9]*\\)?}\\)\\??" e t))
- ((match-beginning 6) ; []
- (setq tmp (point))
- (if (looking-at "\\^?\\]")
- (goto-char (match-end 0)))
- ;; XXXX POSIX classes?!
- (while (and (not pos)
- (re-search-forward "\\[:\\|\\]" e t))
- (if (eq (preceding-char) ?:)
- (or (re-search-forward ":\\]" e t)
- (error "[:POSIX:]-group in []-group not terminated"))
- (setq pos t)))
- (or (eq (preceding-char) ?\])
- (error "[]-group not terminated"))
- (re-search-forward
- "\\=\\([*+?]\\|{[0-9]+\\(,[0-9]*\\)?}\\)\\??" e t))
- ((match-beginning 7) ; ()
- (goto-char (match-beginning 0))
- (setq pos (current-column))
- (or (eq pos c1)
- (progn
- (delete-horizontal-space)
- (insert "\n")
- (cperl-make-indent c1)))
- (setq tmp (point))
- (forward-sexp 1)
- ;; (or (forward-sexp 1)
- ;; (progn
- ;; (goto-char tmp)
- ;; (error "()-group not terminated")))
- (set-marker m (1- (point)))
- (set-marker m1 (point))
- (if (= level 1)
- (if (progn ; indent rigidly if multiline
- ;; In fact does not make a lot of sense, since
- ;; the starting position can be already lost due
- ;; to insertion of "\n" and " "
- (goto-char tmp)
- (search-forward "\n" m1 t))
- (indent-rigidly (point) m1 (- c1 pos)))
- (setq level (1- level))
- (cond
- ((not (match-beginning 8))
- (cperl-beautify-regexp-piece tmp m t level))
- ((eq (char-after (+ 2 tmp)) ?\{) ; Code
- t)
- ((eq (char-after (+ 2 tmp)) ?\() ; Conditional
- (goto-char (+ 2 tmp))
- (forward-sexp 1)
- (cperl-beautify-regexp-piece (point) m t level))
- ((eq (char-after (+ 2 tmp)) ?<) ; Lookbehind
- (goto-char (+ 3 tmp))
- (cperl-beautify-regexp-piece (point) m t level))
- (t
- (cperl-beautify-regexp-piece tmp m t level))))
- (goto-char m1)
- (cond ((looking-at "[*+?]\\??")
- (goto-char (match-end 0)))
- ((eq (following-char) ?\{)
- (forward-sexp 1)
- (if (eq (following-char) ?\?)
- (forward-char))))
- (skip-chars-forward " \t")
- (setq spaces nil)
- (if (looking-at "[#\n]")
- (progn
- (or (eolp) (indent-for-comment))
- (beginning-of-line 2))
- (delete-horizontal-space)
- (insert "\n"))
- (end-of-line)
- (setq inline nil))
- ((match-beginning 9) ; |
- (forward-char -1)
- (setq tmp (point))
- (beginning-of-line)
- (if (re-search-forward "[^ \t]" tmp t)
- (progn
- (goto-char tmp)
- (delete-horizontal-space)
- (insert "\n"))
- ;; first at line
- (delete-region (point) tmp))
- (cperl-make-indent c)
- (forward-char 1)
- (skip-chars-forward " \t")
- (setq spaces nil)
- (if (looking-at "[#\n]")
- (beginning-of-line 2)
- (delete-horizontal-space)
- (insert "\n"))
- (end-of-line)
- (setq inline nil)))
- (or (looking-at "[ \t\n]")
- (not spaces)
- (insert " "))
- (skip-chars-forward " \t"))
- (or (looking-at "[#\n]")
- (error "Unknown code `%s' in a regexp"
- (buffer-substring (point) (1+ (point)))))
- (and inline (end-of-line 2)))
- ;; Special-case the last line of group
- (if (and (>= (point) (marker-position e))
- (/= (current-indentation) c))
- (progn
- (beginning-of-line)
- (cperl-make-indent c)))))
-
-(defun cperl-make-regexp-x ()
- ;; Returns position of the start
- ;; XXX this is called too often! Need to cache the result!
- (save-excursion
- (or cperl-use-syntax-table-text-property
- (error "I need to have a regexp marked!"))
- ;; Find the start
- (if (looking-at "\\s|")
- nil ; good already
- (if (looking-at "\\([smy]\\|qr\\)\\s|")
- (forward-char 1)
- (re-search-backward "\\s|"))) ; Assume it is scanned already.
- ;;(forward-char 1)
- (let ((b (point)) (e (make-marker)) have-x delim (c (current-column))
- (sub-p (eq (preceding-char) ?s)) s)
- (forward-sexp 1)
- (set-marker e (1- (point)))
- (setq delim (preceding-char))
- (if (and sub-p (eq delim (char-after (- (point) 2))))
- (error "Possible s/blah// - do not know how to deal with"))
- (if sub-p (forward-sexp 1))
- (if (looking-at "\\sw*x")
- (setq have-x t)
- (insert "x"))
- ;; Protect fragile " ", "#"
- (if have-x nil
- (goto-char (1+ b))
- (while (re-search-forward "\\(\\=\\|[^\\\\]\\)\\(\\\\\\\\\\)*[ \t\n#]" e t) ; Need to include (?#) too?
- (forward-char -1)
- (insert "\\")
- (forward-char 1)))
- b)))
-
-(defun cperl-beautify-regexp (&optional deep)
- "Do it. (Experimental, may change semantics, recheck the result.)
-We suppose that the regexp is scanned already."
- (interactive "P")
- (setq deep (if deep (prefix-numeric-value deep) -1))
- (save-excursion
- (goto-char (cperl-make-regexp-x))
- (let ((b (point)) (e (make-marker)))
- (forward-sexp 1)
- (set-marker e (1- (point)))
- (cperl-beautify-regexp-piece b e nil deep))))
-
-(defun cperl-regext-to-level-start ()
- "Goto start of an enclosing group in regexp.
-We suppose that the regexp is scanned already."
- (interactive)
- (let ((limit (cperl-make-regexp-x)) done)
- (while (not done)
- (or (eq (following-char) ?\()
- (search-backward "(" (1+ limit) t)
- (error "Cannot find `(' which starts a group"))
- (setq done
- (save-excursion
- (skip-chars-backward "\\")
- (looking-at "\\(\\\\\\\\\\)*(")))
- (or done (forward-char -1)))))
-
-(defun cperl-contract-level ()
- "Find an enclosing group in regexp and contract it.
-\(Experimental, may change semantics, recheck the result.)
-We suppose that the regexp is scanned already."
- (interactive)
- ;; (save-excursion ; Can't, breaks `cperl-contract-levels'
- (cperl-regext-to-level-start)
- (let ((b (point)) (e (make-marker)) c)
- (forward-sexp 1)
- (set-marker e (1- (point)))
- (goto-char b)
- (while (re-search-forward "\\(#\\)\\|\n" e 'to-end)
- (cond
- ((match-beginning 1) ; #-comment
- (or c (setq c (current-indentation)))
- (beginning-of-line 2) ; Skip
- (cperl-make-indent c))
- (t
- (delete-char -1)
- (just-one-space))))))
-
-(defun cperl-contract-levels ()
- "Find an enclosing group in regexp and contract all the kids.
-\(Experimental, may change semantics, recheck the result.)
-We suppose that the regexp is scanned already."
- (interactive)
- (save-excursion
- (condition-case nil
- (cperl-regext-to-level-start)
- (error ; We are outside outermost group
- (goto-char (cperl-make-regexp-x))))
- (let ((b (point)) (e (make-marker)) s c)
- (forward-sexp 1)
- (set-marker e (1- (point)))
- (goto-char (1+ b))
- (while (re-search-forward "\\(\\\\\\\\\\)\\|(" e t)
- (cond
- ((match-beginning 1) ; Skip
- nil)
- (t ; Group
- (cperl-contract-level)))))))
-
-(defun cperl-beautify-level (&optional deep)
- "Find an enclosing group in regexp and beautify it.
-\(Experimental, may change semantics, recheck the result.)
-We suppose that the regexp is scanned already."
- (interactive "P")
- (setq deep (if deep (prefix-numeric-value deep) -1))
- (save-excursion
- (cperl-regext-to-level-start)
- (let ((b (point)) (e (make-marker)))
- (forward-sexp 1)
- (set-marker e (1- (point)))
- (cperl-beautify-regexp-piece b e nil deep))))
-
-(defun cperl-invert-if-unless-modifiers ()
- "Change `B if A;' into `if (A) {B}' etc if possible.
-\(Unfinished.)"
- (interactive) ;
- (let (A B pre-B post-B pre-if post-if pre-A post-A if-string
- (w-rex "\\<\\(if\\|unless\\|while\\|until\\|for\\|foreach\\)\\>"))
- (and (= (char-syntax (preceding-char)) ?w)
- (forward-sexp -1))
- (setq pre-if (point))
- (cperl-backward-to-start-of-expr)
- (setq pre-B (point))
- (forward-sexp 1) ; otherwise forward-to-end-of-expr is NOP
- (cperl-forward-to-end-of-expr)
- (setq post-A (point))
- (goto-char pre-if)
- (or (looking-at w-rex)
- ;; Find the position
- (progn (goto-char post-A)
- (while (and
- (not (looking-at w-rex))
- (> (point) pre-B))
- (forward-sexp -1))
- (setq pre-if (point))))
- (or (looking-at w-rex)
- (error "Can't find `if', `unless', `while', `until', `for' or `foreach'"))
- ;; 1 B 2 ... 3 B-com ... 4 if 5 ... if-com 6 ... 7 A 8
- (setq if-string (buffer-substring (match-beginning 0) (match-end 0)))
- ;; First, simple part: find code boundaries
- (forward-sexp 1)
- (setq post-if (point))
- (forward-sexp -2)
- (forward-sexp 1)
- (setq post-B (point))
- (cperl-backward-to-start-of-expr)
- (setq pre-B (point))
- (setq B (buffer-substring pre-B post-B))
- (goto-char pre-if)
- (forward-sexp 2)
- (forward-sexp -1)
- ;; May be after $, @, $# etc of a variable
- (skip-chars-backward "$@%#")
- (setq pre-A (point))
- (cperl-forward-to-end-of-expr)
- (setq post-A (point))
- (setq A (buffer-substring pre-A post-A))
- ;; Now modify (from end, to not break the stuff)
- (skip-chars-forward " \t;")
- (delete-region pre-A (point)) ; we move to pre-A
- (insert "\n" B ";\n}")
- (and (looking-at "[ \t]*#") (cperl-indent-for-comment))
- (delete-region pre-if post-if)
- (delete-region pre-B post-B)
- (goto-char pre-B)
- (insert if-string " (" A ") {")
- (setq post-B (point))
- (if (looking-at "[ \t]+$")
- (delete-horizontal-space)
- (if (looking-at "[ \t]*#")
- (cperl-indent-for-comment)
- (just-one-space)))
- (forward-line 1)
- (if (looking-at "[ \t]*$")
- (progn ; delete line
- (delete-horizontal-space)
- (delete-region (point) (1+ (point)))))
- (cperl-indent-line)
- (goto-char (1- post-B))
- (forward-sexp 1)
- (cperl-indent-line)
- (goto-char pre-B)))
-
-(defun cperl-invert-if-unless ()
- "Change `if (A) {B}' into `B if A;' etc (or visa versa) if possible.
-If the cursor is not on the leading keyword of the BLOCK flavor of
-construct, will assume it is the STATEMENT flavor, so will try to find
-the appropriate statement modifier."
- (interactive)
- (and (= (char-syntax (preceding-char)) ?w)
- (forward-sexp -1))
- (if (looking-at "\\<\\(if\\|unless\\|while\\|until\\|for\\|foreach\\)\\>")
- (let ((pre-if (point))
- pre-A post-A pre-B post-B A B state p end-B-code is-block B-comment
- (if-string (buffer-substring (match-beginning 0) (match-end 0))))
- (forward-sexp 2)
- (setq post-A (point))
- (forward-sexp -1)
- (setq pre-A (point))
- (setq is-block (and (eq (following-char) ?\( )
- (save-excursion
- (condition-case nil
- (progn
- (forward-sexp 2)
- (forward-sexp -1)
- (eq (following-char) ?\{ ))
- (error nil)))))
- (if is-block
- (progn
- (goto-char post-A)
- (forward-sexp 1)
- (setq post-B (point))
- (forward-sexp -1)
- (setq pre-B (point))
- (if (and (eq (following-char) ?\{ )
- (progn
- (cperl-backward-to-noncomment post-A)
- (eq (preceding-char) ?\) )))
- (if (condition-case nil
- (progn
- (goto-char post-B)
- (forward-sexp 1)
- (forward-sexp -1)
- (looking-at "\\<els\\(e\\|if\\)\\>"))
- (error nil))
- (error
- "`%s' (EXPR) {BLOCK} with `else'/`elsif'" if-string)
- (goto-char (1- post-B))
- (cperl-backward-to-noncomment pre-B)
- (if (eq (preceding-char) ?\;)
- (forward-char -1))
- (setq end-B-code (point))
- (goto-char pre-B)
- (while (re-search-forward "\\<\\(for\\|foreach\\|if\\|unless\\|while\\|until\\)\\>\\|;" end-B-code t)
- (setq p (match-beginning 0)
- A (buffer-substring p (match-end 0))
- state (parse-partial-sexp pre-B p))
- (or (nth 3 state)
- (nth 4 state)
- (nth 5 state)
- (error "`%s' inside `%s' BLOCK" A if-string))
- (goto-char (match-end 0)))
- ;; Finally got it
- (goto-char (1+ pre-B))
- (skip-chars-forward " \t\n")
- (setq B (buffer-substring (point) end-B-code))
- (goto-char end-B-code)
- (or (looking-at ";?[ \t\n]*}")
- (progn
- (skip-chars-forward "; \t\n")
- (setq B-comment
- (buffer-substring (point) (1- post-B)))))
- (and (equal B "")
- (setq B "1"))
- (goto-char (1- post-A))
- (cperl-backward-to-noncomment pre-A)
- (or (looking-at "[ \t\n]*)")
- (goto-char (1- post-A)))
- (setq p (point))
- (goto-char (1+ pre-A))
- (skip-chars-forward " \t\n")
- (setq A (buffer-substring (point) p))
- (delete-region pre-B post-B)
- (delete-region pre-A post-A)
- (goto-char pre-if)
- (insert B " ")
- (and B-comment (insert B-comment " "))
- (just-one-space)
- (forward-word 1)
- (setq pre-A (point))
- (insert " " A ";")
- (delete-horizontal-space)
- (setq post-B (point))
- (if (looking-at "#")
- (indent-for-comment))
- (goto-char post-B)
- (forward-char -1)
- (delete-horizontal-space)
- (goto-char pre-A)
- (just-one-space)
- (goto-char pre-if)
- (setq pre-A (set-marker (make-marker) pre-A))
- (while (<= (point) (marker-position pre-A))
- (cperl-indent-line)
- (forward-line 1))
- (goto-char (marker-position pre-A))
- (if B-comment
- (progn
- (forward-line -1)
- (indent-for-comment)
- (goto-char (marker-position pre-A)))))
- (error "`%s' (EXPR) not with an {BLOCK}" if-string)))
- ;; (error "`%s' not with an (EXPR)" if-string)
- (forward-sexp -1)
- (cperl-invert-if-unless-modifiers)))
- ;;(error "Not at `if', `unless', `while', `until', `for' or `foreach'")
- (cperl-invert-if-unless-modifiers)))
-
-;;; By Anthony Foiani <afoiani@uswest.com>
-;;; Getting help on modules in C-h f ?
-;;; This is a modified version of `man'.
-;;; Need to teach it how to lookup functions
-;;;###autoload
-(defun cperl-perldoc (word)
- "Run `perldoc' on WORD."
- (interactive
- (list (let* ((default-entry (cperl-word-at-point))
- (input (read-string
- (format "perldoc entry%s: "
- (if (string= default-entry "")
- ""
- (format " (default %s)" default-entry))))))
- (if (string= input "")
- (if (string= default-entry "")
- (error "No perldoc args given")
- default-entry)
- input))))
- (require 'man)
- (let* ((case-fold-search nil)
- (is-func (and
- (string-match "^[a-z]+$" word)
- (string-match (concat "^" word "\\>")
- (documentation-property
- 'cperl-short-docs
- 'variable-documentation))))
- (manual-program (if is-func "perldoc -f" "perldoc")))
- (cond
- (cperl-xemacs-p
- (let ((Manual-program "perldoc")
- (Manual-switches (if is-func (list "-f"))))
- (manual-entry word)))
- (t
- (Man-getpage-in-background word)))))
-
-;;;###autoload
-(defun cperl-perldoc-at-point ()
- "Run a `perldoc' on the word around point."
- (interactive)
- (cperl-perldoc (cperl-word-at-point)))
-
-(defcustom pod2man-program "pod2man"
- "*File name for `pod2man'."
- :type 'file
- :group 'cperl)
-
-;;; By Nick Roberts <Nick.Roberts@src.bae.co.uk> (with changes)
-(defun cperl-pod-to-manpage ()
- "Create a virtual manpage in Emacs from the Perl Online Documentation."
- (interactive)
- (require 'man)
- (let* ((pod2man-args (concat buffer-file-name " | nroff -man "))
- (bufname (concat "Man " buffer-file-name))
- (buffer (generate-new-buffer bufname)))
- (save-excursion
- (set-buffer buffer)
- (let ((process-environment (copy-sequence process-environment)))
- ;; Prevent any attempt to use display terminal fanciness.
- (setenv "TERM" "dumb")
- (set-process-sentinel
- (start-process pod2man-program buffer "sh" "-c"
- (format (cperl-pod2man-build-command) pod2man-args))
- 'Man-bgproc-sentinel)))))
-
-;;; Updated version by him too
-(defun cperl-build-manpage ()
- "Create a virtual manpage in Emacs from the POD in the file."
- (interactive)
- (require 'man)
- (cond
- (cperl-xemacs-p
- (let ((Manual-program "perldoc"))
- (manual-entry buffer-file-name)))
- (t
- (let* ((manual-program "perldoc"))
- (Man-getpage-in-background buffer-file-name)))))
-
-(defun cperl-pod2man-build-command ()
- "Builds the entire background manpage and cleaning command."
- (let ((command (concat pod2man-program " %s 2>/dev/null"))
- (flist (and (boundp 'Man-filter-list) Man-filter-list)))
- (while (and flist (car flist))
- (let ((pcom (car (car flist)))
- (pargs (cdr (car flist))))
- (setq command
- (concat command " | " pcom " "
- (mapconcat '(lambda (phrase)
- (if (not (stringp phrase))
- (error "Malformed Man-filter-list"))
- phrase)
- pargs " ")))
- (setq flist (cdr flist))))
- command))
-
-
-(defun cperl-next-interpolated-REx-1 ()
- "Move point to next REx which has interpolated parts without //o.
-Skips RExes consisting of one interpolated variable.
-
-Note that skipped RExen are not performance hits."
- (interactive "")
- (cperl-next-interpolated-REx 1))
-
-(defun cperl-next-interpolated-REx-0 ()
- "Move point to next REx which has interpolated parts without //o."
- (interactive "")
- (cperl-next-interpolated-REx 0))
-
-(defun cperl-next-interpolated-REx (&optional skip beg limit)
- "Move point to next REx which has interpolated parts.
-SKIP is a list of possible types to skip, BEG and LIMIT are the starting
-point and the limit of search (default to point and end of buffer).
-
-SKIP may be a number, then it behaves as list of numbers up to SKIP; this
-semantic may be used as a numeric argument.
-
-Types are 0 for / $rex /o (interpolated once), 1 for /$rex/ (if $rex is
-a result of qr//, this is not a performance hit), t for the rest."
- (interactive "P")
- (if (numberp skip) (setq skip (list 0 skip)))
- (or beg (setq beg (point)))
- (or limit (setq limit (point-max))) ; needed for n-s-p-c
- (let (pp)
- (and (eq (get-text-property beg 'syntax-type) 'string)
- (setq beg (next-single-property-change beg 'syntax-type nil limit)))
- (cperl-map-pods-heres
- (function (lambda (s e p)
- (if (memq (get-text-property s 'REx-interpolated) skip)
- t
- (setq pp s)
- nil))) ; nil stops
- 'REx-interpolated beg limit)
- (if pp (goto-char pp)
- (message "No more interpolated REx"))))
-
-;;; Initial version contributed by Trey Belew
-(defun cperl-here-doc-spell (&optional beg end)
- "Spell-check HERE-documents in the Perl buffer.
-If a region is highlighted, restricts to the region."
- (interactive "")
- (cperl-pod-spell t beg end))
-
-(defun cperl-pod-spell (&optional do-heres beg end)
- "Spell-check POD documentation.
-If invoked with prefix argument, will do HERE-DOCs instead.
-If a region is highlighted, restricts to the region."
- (interactive "P")
- (save-excursion
- (let (beg end)
- (if (cperl-mark-active)
- (setq beg (min (mark) (point))
- end (max (mark) (point)))
- (setq beg (point-min)
- end (point-max)))
- (cperl-map-pods-heres (function
- (lambda (s e p)
- (if do-heres
- (setq e (save-excursion
- (goto-char e)
- (forward-line -1)
- (point))))
- (ispell-region s e)
- t))
- (if do-heres 'here-doc-group 'in-pod)
- beg end))))
-
-(defun cperl-map-pods-heres (func &optional prop s end)
- "Executes a function over regions of pods or here-documents.
-PROP is the text-property to search for; default to `in-pod'. Stop when
-function returns nil."
- (let (pos posend has-prop (cont t))
- (or prop (setq prop 'in-pod))
- (or s (setq s (point-min)))
- (or end (setq end (point-max)))
- (cperl-update-syntaxification end end)
- (save-excursion
- (goto-char (setq pos s))
- (while (and cont (< pos end))
- (setq has-prop (get-text-property pos prop))
- (setq posend (next-single-property-change pos prop nil end))
- (and has-prop
- (setq cont (funcall func pos posend prop)))
- (setq pos posend)))))
-
-;;; Based on code by Masatake YAMATO:
-(defun cperl-get-here-doc-region (&optional pos pod)
- "Return HERE document region around the point.
-Return nil if the point is not in a HERE document region. If POD is non-nil,
-will return a POD section if point is in a POD section."
- (or pos (setq pos (point)))
- (cperl-update-syntaxification pos pos)
- (if (or (eq 'here-doc (get-text-property pos 'syntax-type))
- (and pod
- (eq 'pod (get-text-property pos 'syntax-type))))
- (let ((b (cperl-beginning-of-property pos 'syntax-type))
- (e (next-single-property-change pos 'syntax-type)))
- (cons b (or e (point-max))))))
-
-(defun cperl-narrow-to-here-doc (&optional pos)
- "Narrows editing region to the HERE-DOC at POS.
-POS defaults to the point."
- (interactive "d")
- (or pos (setq pos (point)))
- (let ((p (cperl-get-here-doc-region pos)))
- (or p (error "Not inside a HERE document"))
- (narrow-to-region (car p) (cdr p))
- (message
- "When you are finished with narrow editing, type C-x n w")))
-
-(defun cperl-select-this-pod-or-here-doc (&optional pos)
- "Select the HERE-DOC (or POD section) at POS.
-POS defaults to the point."
- (interactive "d")
- (let ((p (cperl-get-here-doc-region pos t)))
- (if p
- (progn
- (goto-char (car p))
- (push-mark (cdr p) nil t)) ; Message, activate in transient-mode
- (message "I do not think POS is in POD or a HERE-doc..."))))
-
-(defun cperl-facemenu-add-face-function (face end)
- "A callback to process user-initiated font-change requests.
-Translates `bold', `italic', and `bold-italic' requests to insertion of
-corresponding POD directives, and `underline' to C<> POD directive.
-
-Such requests are usually bound to M-o LETTER."
- (or (get-text-property (point) 'in-pod)
- (error "Faces can only be set within POD"))
- (setq facemenu-end-add-face (if (eq face 'bold-italic) ">>" ">"))
- (cdr (or (assq face '((bold . "B<")
- (italic . "I<")
- (bold-italic . "B<I<")
- (underline . "C<")))
- (error "Face %s not configured for cperl-mode"
- face))))
-\f
-(defun cperl-time-fontification (&optional l step lim)
- "Times how long it takes to do incremental fontification in a region.
-L is the line to start at, STEP is the number of lines to skip when
-doing next incremental fontification, LIM is the maximal number of
-incremental fontification to perform. Messages are accumulated in
-*Messages* buffer.
-
-May be used for pinpointing which construct slows down buffer fontification:
-start with default arguments, then refine the slowdown regions."
- (interactive "nLine to start at: \nnStep to do incremental fontification: ")
- (or l (setq l 1))
- (or step (setq step 500))
- (or lim (setq lim 40))
- (let* ((timems (function (lambda ()
- (let ((tt (current-time)))
- (+ (* 1000 (nth 1 tt)) (/ (nth 2 tt) 1000))))))
- (tt (funcall timems)) (c 0) delta tot)
- (goto-line l)
- (cperl-mode)
- (setq tot (- (- tt (setq tt (funcall timems)))))
- (message "cperl-mode at %s: %s" l tot)
- (while (and (< c lim) (not (eobp)))
- (forward-line step)
- (setq l (+ l step))
- (setq c (1+ c))
- (cperl-update-syntaxification (point) (point))
- (setq delta (- (- tt (setq tt (funcall timems)))) tot (+ tot delta))
- (message "to %s:%6s,%7s" l delta tot))
- tot))
-
-(defun cperl-emulate-lazy-lock (&optional window-size)
- "Emulate `lazy-lock' without `condition-case', so `debug-on-error' works.
-Start fontifying the buffer from the start (or end) using the given
-WINDOW-SIZE (units is lines). Negative WINDOW-SIZE starts at end, and
-goes backwards; default is -50. This function is not CPerl-specific; it
-may be used to debug problems with delayed incremental fontification."
- (interactive
- "nSize of window for incremental fontification, negative goes backwards: ")
- (or window-size (setq window-size -50))
- (let ((pos (if (> window-size 0)
- (point-min)
- (point-max)))
- p)
- (goto-char pos)
- (normal-mode)
- ;; Why needed??? With older font-locks???
- (set (make-local-variable 'font-lock-cache-position) (make-marker))
- (while (if (> window-size 0)
- (< pos (point-max))
- (> pos (point-min)))
- (setq p (progn
- (forward-line window-size)
- (point)))
- (font-lock-fontify-region (min p pos) (max p pos))
- (setq pos p))))
-
-\f
-(defun cperl-lazy-install ()) ; Avoid a warning
-(defun cperl-lazy-unstall ()) ; Avoid a warning
-
-(if (fboundp 'run-with-idle-timer)
- (progn
- (defvar cperl-help-shown nil
- "Non-nil means that the help was already shown now.")
-
- (defvar cperl-lazy-installed nil
- "Non-nil means that the lazy-help handlers are installed now.")
-
- (defun cperl-lazy-install ()
- "Switches on Auto-Help on Perl constructs (put in the message area).
-Delay of auto-help controlled by `cperl-lazy-help-time'."
- (interactive)
- (make-variable-buffer-local 'cperl-help-shown)
- (if (and (cperl-val 'cperl-lazy-help-time)
- (not cperl-lazy-installed))
- (progn
- (add-hook 'post-command-hook 'cperl-lazy-hook)
- (run-with-idle-timer
- (cperl-val 'cperl-lazy-help-time 1000000 5)
- t
- 'cperl-get-help-defer)
- (setq cperl-lazy-installed t))))
-
- (defun cperl-lazy-unstall ()
- "Switches off Auto-Help on Perl constructs (put in the message area).
-Delay of auto-help controlled by `cperl-lazy-help-time'."
- (interactive)
- (remove-hook 'post-command-hook 'cperl-lazy-hook)
- (cancel-function-timers 'cperl-get-help-defer)
- (setq cperl-lazy-installed nil))
-
- (defun cperl-lazy-hook ()
- (setq cperl-help-shown nil))
-
- (defun cperl-get-help-defer ()
- (if (not (memq major-mode '(perl-mode cperl-mode))) nil
- (let ((cperl-message-on-help-error nil) (cperl-help-from-timer t))
- (cperl-get-help)
- (setq cperl-help-shown t))))
- (cperl-lazy-install)))
-
-
-;;; Plug for wrong font-lock:
-
-(defun cperl-font-lock-unfontify-region-function (beg end)
- (let* ((modified (buffer-modified-p)) (buffer-undo-list t)
- (inhibit-read-only t) (inhibit-point-motion-hooks t)
- before-change-functions after-change-functions
- deactivate-mark buffer-file-name buffer-file-truename)
- (remove-text-properties beg end '(face nil))
- (if (and (not modified) (buffer-modified-p))
- (set-buffer-modified-p nil))))
-
-(defun cperl-font-lock-fontify-region-function (beg end loudly)
- "Extends the region to safe positions, then calls the default function.
-Newer `font-lock's can do it themselves.
-We unwind only as far as needed for fontification. Syntaxification may
-do extra unwind via `cperl-unwind-to-safe'."
- (save-excursion
- (goto-char beg)
- (while (and beg
- (progn
- (beginning-of-line)
- (eq (get-text-property (setq beg (point)) 'syntax-type)
- 'multiline)))
- (if (setq beg (cperl-beginning-of-property beg 'syntax-type))
- (goto-char beg)))
- (setq beg (point))
- (goto-char end)
- (while (and end
- (progn
- (or (bolp) (condition-case nil
- (forward-line 1)
- (error nil)))
- (eq (get-text-property (setq end (point)) 'syntax-type)
- 'multiline)))
- (setq end (next-single-property-change end 'syntax-type nil (point-max)))
- (goto-char end))
- (setq end (point)))
- (font-lock-default-fontify-region beg end loudly))
-
-(defvar cperl-d-l nil)
-(defun cperl-fontify-syntaxically (end)
- ;; Some vars for debugging only
- ;; (message "Syntaxifying...")
- (let ((dbg (point)) (iend end) (idone cperl-syntax-done-to)
- (istate (car cperl-syntax-state))
- start from-start edebug-backtrace-buffer)
- (if (eq cperl-syntaxify-by-font-lock 'backtrace)
- (progn
- (require 'edebug)
- (let ((f 'edebug-backtrace))
- (funcall f)))) ; Avoid compile-time warning
- (or cperl-syntax-done-to
- (setq cperl-syntax-done-to (point-min)
- from-start t))
- (setq start (if (and cperl-hook-after-change
- (not from-start))
- cperl-syntax-done-to ; Fontify without change; ignore start
- ;; Need to forget what is after `start'
- (min cperl-syntax-done-to (point))))
- (goto-char start)
- (beginning-of-line)
- (setq start (point))
- (and cperl-syntaxify-unwind
- (setq end (cperl-unwind-to-safe t end)
- start (point)))
- (and (> end start)
- (setq cperl-syntax-done-to start) ; In case what follows fails
- (cperl-find-pods-heres start end t nil t))
- (if (memq cperl-syntaxify-by-font-lock '(backtrace message))
- (message "Syxify req=%s..%s actual=%s..%s done-to: %s=>%s statepos: %s=>%s"
- dbg iend start end idone cperl-syntax-done-to
- istate (car cperl-syntax-state))) ; For debugging
- nil)) ; Do not iterate
-
-(defun cperl-fontify-update (end)
- (let ((pos (point-min)) prop posend)
- (setq end (point-max))
- (while (< pos end)
- (setq prop (get-text-property pos 'cperl-postpone)
- posend (next-single-property-change pos 'cperl-postpone nil end))
- (and prop (put-text-property pos posend (car prop) (cdr prop)))
- (setq pos posend)))
- nil) ; Do not iterate
-
-(defun cperl-fontify-update-bad (end)
- ;; Since fontification happens with different region than syntaxification,
- ;; do to the end of buffer, not to END;;; likewise, start earlier if needed
- (let* ((pos (point)) (prop (get-text-property pos 'cperl-postpone)) posend)
- (if prop
- (setq pos (or (cperl-beginning-of-property
- (cperl-1+ pos) 'cperl-postpone)
- (point-min))))
- (while (< pos end)
- (setq posend (next-single-property-change pos 'cperl-postpone))
- (and prop (put-text-property pos posend (car prop) (cdr prop)))
- (setq pos posend)
- (setq prop (get-text-property pos 'cperl-postpone))))
- nil) ; Do not iterate
-
-;; Called when any modification is made to buffer text.
-(defun cperl-after-change-function (beg end old-len)
- ;; We should have been informed about changes by `font-lock'. Since it
- ;; does not inform as which calls are defered, do it ourselves
- (if cperl-syntax-done-to
- (setq cperl-syntax-done-to (min cperl-syntax-done-to beg))))
-
-(defun cperl-update-syntaxification (from to)
- (if (and cperl-use-syntax-table-text-property
- cperl-syntaxify-by-font-lock
- (or (null cperl-syntax-done-to)
- (< cperl-syntax-done-to to)))
- (progn
- (save-excursion
- (goto-char from)
- (cperl-fontify-syntaxically to)))))
-
-(defvar cperl-version
- (let ((v "$Revision: 5.23 $"))
- (string-match ":\\s *\\([0-9.]+\\)" v)
- (substring v (match-beginning 1) (match-end 1)))
- "Version of IZ-supported CPerl package this file is based on.")
-
-(provide 'cperl-mode)
-
-;;; cperl-mode.el ends here
+++ /dev/null
-
-##e2ctags.pl
-##Convert an Emacs-style TAGS file to a standard ctags file.
-##Runs in a single pass over the TAGS file and keeps the first
-##tag entry found, and the file name and line number the tag can
-##be found on.
-##Then it opens all relevant files and builds the regular expression
-##for ctags.
-##Run over a few test files and compared with a real ctags file shows
-##only extra tags in the translated file, which probably won't hurt
-##vi.
-##
-
-use strict;
-
-my $filename;
-my ($tag,$line_no,$line);
-my %tags = ();
-my %filetags = ();
-my %files = ();
-my @lines = ();
-
-while (<>) {
- if ($_ eq "\x0C\n") {
- ##Grab next line and parse it for the filename
- $_ = <>;
- chomp;
- s/,\d+$//;
- $filename = $_;
- ++$files{$filename};
- next;
- }
- ##Figure out how many records in this line and
- ##extract the tag name and the line that it is found on
- next if /struct/;
- if (/\x01/) {
- ($tag,$line_no) = /\x7F(\w+)\x01(\d+)/;
- }
- else {
- tr/(//d;
- ($tag,$line_no) = /(\w+)\s*\x7F(\d+),/;
- }
- next unless $tag;
- ##Take only the first entry per tag
- next if defined($tags{$tag});
- $tags{$tag}{FILE} = $filename;
- $tags{$tag}{LINE_NO} = $line_no;
- push @{$filetags{$filename}}, $tag;
-}
-
-foreach $filename (keys %files) {
- open FILE, $filename or die "Couldn't open $filename: $!\n";
- @lines = <FILE>;
- close FILE;
- chomp @lines;
- foreach $tag ( @{$filetags{$filename}} ) {
- $line = $lines[$tags{$tag}{LINE_NO}-1];
- if (length($line) >= 50) {
- $line = substr($line,0,50);
- }
- else {
- $line .= '$';
- }
- $line =~ s#\\#\\\\#;
- $tags{$tag}{LINE} = join '', '/^',$line,'/';
- }
-}
-
-foreach $tag ( sort keys %tags ) {
- print "$tag\t$tags{$tag}{FILE}\t$tags{$tag}{LINE}\n";
-}
+++ /dev/null
-# Make a TAGS file for emacs ``M-x find-tag'' from all <c,h,y,xs> source files.
-# (``make realclean'' first to avoid generated files, or ``make'' first
-# to get tags from all files.)
-#
-#
-# usage: sh emacs/ptags <options>
-#
-# options:
-#
-# fullpath - use full paths in TAGS (default: relative to the root)
-#
-# (Some tags should probably live in their own subdirs, like those in x2p/,
-# but I have never been interested in x2p anyway.)
-#
-# Hallvard B Furuseth <h.b.furuseth@usit.uio.no>, Aug -96.
-#
-# Ilya Zakharevich, Oct 97: minor comments, add CPerl scan;
-# Use Hallvard's scan for XS files - since he processes the "C" part too -
-# but with a lot of improvements: now it is no worse than CPerl's one.
-
-# Avoid builtin on OS/2:
-if test ! -z "$OS2_SHELL"; then alias find=gnufind; fi
-
-case "$1" in
- fullpath)
- cwd=`pwd`
- cperl_add_tags='cperl-add-tags-recurse-noxs-fullpath'
- echo "Building TAGS with full paths"
- ;;
- *)
- cperl_add_tags='cperl-add-tags-recurse-noxs'
- cwd='.'
- echo "Building TAGS with relative paths"
-esac
-
-emacs=`(which emacs || which xemacs || echo emacs) 2>/dev/null`
-[ -x "$emacs" ] || { echo "can't find emacs or xemacs in PATH"; exit 1; }
-
-# Insure proper order (.h after .c, .xs before .c in subdirs):
-# Move autogenerated less-informative files to the end:
-# Hard to do embed.h and embedvar.h in one sweep:
-
-topfiles="`echo ' ' *.y *.c *.h ' ' | sed 's/ / /g' | sed 's/ embedvar\.h\|embed\.h\|perlapi\.h\|os2ish\.h\|\(globals\|perlapi\| os2\)\.c / /g'| sed "s#\(^\| \)\([^ ]\)#\1$cwd/\2#g"`"
-subdirs="`find $cwd/* -maxdepth 0 -type d`"
-subdirfiles="`find $subdirs -name '*.[cy]' -print | sort`"
-subdirfiles1="`find $subdirs -name '*.[hH]' -print | sort`"
-xsfiles="`find $cwd/ -name '*.xs' -print | sort`"
-
-# etags -d : process defines too (default now)
-
-# These are example lines for global variables and PP-code:
-## IEXT SV * Iparsehook;
-## IEXT char * Isplitstr IINIT(" ");
-## dEXTCONST char rcsid[] = "perl.c\nPatch level: ###\n";
-## PP(pp_const)
-## PERLVARI(Grsfp, PerlIO *, Nullfp)
-## PERLVAR(cvcache, HV *)
-
-# Putting PL_\1 in the substitution line makes etags dump core
-# Thus we do it later (but 20.2.92 does it OK).
-set x -d -l c \
- -r '/[dI]?EXT\(CONST\)?[ \t*]+\([a-zA-Z_0-9]+[ \t*]+\)*\([a-zA-Z_0-9]+\)[ \t]*\($\|;\|\[\|[ \t]I+NIT[ \t]*(\|\/\*\)/\3/' \
- -r '/IEXT[ \t][^\/]*[ \t*]I\([a-zA-Z_][a-zA-Z_0-9]*\)[\[; \t]/\1/' \
- -r '/PERLVAR[a-zA-Z_0-9]*[ \t]*([ \t]*[GIT]?\([a-zA-Z_][a-zA-Z_0-9]*\)[ \t]*[\[,]/\1/' \
- -r '/PP[ \t]*([ \t]*\([^ \t()]*\)[ \t]*)/\1/'
-
-shift
-
-rm -f TAGS.tmp TAGS.tm2
-
-# Process lines like this: #define MEM_ALIGNBYTES $alignbytes /**/
-etags -o TAGS.tmp \
- -l none -r '/#\(\$[a-zA-Z_0-9]+\|define\)[ \t]+\([a-zA-Z_0-9]+\)/\2/' \
- $cwd/config_h.SH
-# Process lines like this: Mcc (Loc.U):
-etags -o TAGS.tmp -a \
- -l none -r '/^\([a-zA-Z_0-9]+\)[ \t]+(/\$\1/' \
- -r '/^\([a-zA-Z_0-9]+\)[ \t]+(/\1/' $cwd/Porting/Glossary
-
-etags -o TAGS.tmp -a "$@" $topfiles
-
-# Now add these PL_:
-perl -w014pe 'if (s/^( .* PERLVAR A?I? # 1: TAG group
- \s* \( \s* [GIT] #
- .* #
- \x7F # End of description
- )
- ( .* \x01 ) # 2: Exact group
- /${1}PL_$2/mgx) { # Add PL_
- $chars = chomp;
- s/^((\n.+,)\d+)/ $2 . (length($_) - length($1) - 1) /e;
- $_ .= ("\f" x $chars);
- }' TAGS.tmp > TAGS.tm1 && mv TAGS.tm1 TAGS.tmp
-
-
-# Now remove these Perl_, add empty- and perl_-flavors:
-perl -w014pe 'if (s/^(Perl_ # 1: First group
- (\w+) \( # 2: Stripped name
- \x7F # End of description
- ) # End of description
- (\d+,\d+\n) # 3: TAGS Trail
- /$1$3$1$2\x01$3$1perl_$2\x01$3/mgx) { # Repeat, add empty and perl_ flavors
- $chars = chomp;
- s/^((\n.+,)\d+)/ $2 . (length($_) - length($1) - 1) /e;
- $_ .= ("\f" x $chars);
- }' TAGS.tmp > TAGS.tm1 && mv TAGS.tm1 TAGS.tmp
-
-# Now remove these S_, add empty-flavor:
-perl -w014pe 'if (s/^(S_ # 1: First group
- (\w+) \( # 2: Stripped name
- \x7F # End of description
- ) # End of description
- (\d+,\d+\n) # 3: TAGS Trail
- /$1$3$1$2\x01$3/mgx) { # Repeat, add empty_ flavor
- $chars = chomp;
- s/^((\n.+,)\d+)/ $2 . (length($_) - length($1) - 1) /e;
- $_ .= ("\f" x $chars);
- }' TAGS.tmp > TAGS.tm1 && mv TAGS.tm1 TAGS.tmp
-
-etags -o TAGS.tmp -a -D -l none -r '/#define.*\t\(Perl_.*\)/\1/' $cwd/embed.h
-etags -o TAGS.tmp -a $cwd/globals.c $cwd/embedvar.h $cwd/perlapi.c $cwd/perlapi.h
-
-# The above processes created a lot of descriptions with an
-# an explicitly specified tag. Such descriptions have higher
-# precedence than descriptions without an explicitely specified tag.
-# To restore the justice, make all the descriptions explicit.
-perl -w014pe 'if (s/^( [^\n\x7F\x01]*\b # 1: TAG group
- (\w+) # 2: word
- [^\w\x7F\x01\n]* # Most anything
- \x7F # End of description
- )
- (\d+,\d+\n) # 3: TAGS Trail
- /$1$2\x01$3/mgx) { # Add specific marking
- $chars = chomp;
- s/^((\n.+,)\d+)/ $2 . (length($_) - length($1) - 1) /e;
- $_ .= ("\f" x $chars);
- }' TAGS.tmp > TAGS.tm1 && mv TAGS.tm1 TAGS.tmp
-
-# Add MODULE lines to TAG files (to be postprocessed later),
-# and BOOT: lines (in DynaLoader processed twice?)
-
-# This skips too many XSUBs:
-
-# etags -o TAGS.tmp -a -d -l c \
-# -r '/MODULE[ \t=]+\(.*PACKAGE[ \t]*=[ \t]*\)?\([^ \t]+\)\([ \t]*PREFIX[ \t]*=[ \t]*\([^ \t]+\)\)?/\2/' \
-# -r '/[ \t]*BOOT:/' \
-# $xsfiles
-
-etags -o TAGS.tmp -a -d -l c \
- -r '/MODULE[ \t=]+\(.*PACKAGE[ \t]*=[ \t]*\)?\([^ \t]+\)\([ \t]*PREFIX[ \t]*=[ \t]*\([^ \t]+\)\)?/\2/' \
- -r '/[ \t]*BOOT:/' \
- -r '/\([_a-zA-Z][a-zA-Z0-9_:]*\)(/' \
- $xsfiles
-
-# -r '/MODULE[ \t=]+\(.*PACKAGE[ \t]*=[ \t]*\)?\([^ \t]+\)/\2/' \
-# -r '/MODULE.*PREFIX[ \t]*=[ \t]*\([^ \t]+\)/\1/' \
-# $xsfiles
-
-etags -o TAGS.tmp -a "$@" $subdirfiles
-etags -o TAGS.tmp -a "$@" $subdirfiles1
-
-if test ! -f emacs/cperl-mode.elc ; then
- ( cd emacs; $emacs -batch -q -no-site-file -f batch-byte-compile cperl-mode.el )
-fi
-
-# This should work with newer Emaxen
-
-cp TAGS.tmp TAGS
-if $emacs -batch -q -no-site-file -l emacs/cperl-mode.elc -f $cperl_add_tags ; then
- mv TAGS TAGS.tmp
-fi
-
-perl -w014pe '
- $update = s/^PP\(\177\d+,\d+\n//gm;
- $update += s/^(I?EXT.*[ \t])IINIT[ \t]*\((\177)/$1$2/gm;
- if (/^\n*[^\s,]+\.xs,/s) {
- $mod = $cmod = $bmod = $pref = "";
- s/^(.*\n)\1+/$1/mg; # Remove duplicate lines
- $_ = join("", map {
- if (/^MODULE[ \t]*=[ \t]*(\S+)(?:[ \t]+PACKAGE[ \t]*=[ \t]*(\S+))?[ \t\177]/m) {
- $mod = $+;
- ($bmod = $mod) =~ tr/:/_/;
- $cmod = "XS_${bmod}_";
- $pref = "";
- if (s/[ \t]+PREFIX[ \t]*=[ \t]*([^\s\177]+)(\177)/$+/) {
- $pref = $1;
- $pref =~ s/([^\w\s])/\\$1/g;
- $pref = "(?:$pref)?";
- }
- } elsif ($mod ne "") {
- # Ref points for Module::subr, XS_Module_subr, subr
- s/^($pref(\w+)[ \t()]*\177)(\d+,\d+)$/$1${mod}::${2}\01$3\n$1$2\01$3\n$1$cmod$2\01$3/gm;
- # Ref for Module::bootstrap bootstrap boot_Module
- s/^([ \t]*BOOT:\177)(\d+,\d+)$/$1${mod}::bootstrap\01$2\n${1}bootstrap\01$2\n${1}boot_$bmod\01$2/gm;
- }
- $_;
- } split(/(\nMODULE[ \t]*=[^\n\177]+\177)/));
-
- $update = 1;
- }
- if ($update) {
- $chars = chomp;
- s/^((\n.+,)\d+)/ $2 . (length($_) - length($1) - 1) /e;
- $_ .= ("\f" x $chars);
- }' TAGS.tmp > TAGS.tm2
-
-rm -f TAGS
-mv TAGS.tm2 TAGS
-rm -f TAGS.tmp
-
-
-
: BEGIN {die "You meant to run embed.pl"} # Stop early if fed to perl.
:
+: This file is processed by embed.pl and autodoc.pl
+:
: Lines are of the form:
: flags|return_type|function_name|arg1|arg2|...|argN
:
: Leading and trailing whitespace will be ignored in each component.
:
: flags are single letters with following meanings:
-: A member of public API
-: m Implemented as a macro - no export, no
-: proto, no #define
-: d function has documentation with its source
-: D function is deprecated
-: s static function, should have an S_ prefix in
-: source file; for macros (m), suffix the usage
-: example with a semicolon
-: n has no implicit interpreter/thread context argument
-: p function has a Perl_ prefix
-: f function takes printf style format string, varargs
-: r function never returns
-: o has no compatibility macro (#define foo Perl_foo)
-: x not exported
-: X explicitly exported
-: M may change
-: E visible to extensions included in the Perl core
-: b binary backward compatibility; function is a macro
-: but has also Perl_ implementation (which is exported)
-: U suppress usage example in autogenerated documentation
-: a allocates memory a la malloc/calloc. Is also "R".
-: R Return value must not be ignored.
-: P pure function: no effects except the return value;
-: return value depends only on parms and/or globals
+:
+: A Member of public API:
+:
+: add entry to global.sym (unless x or m);
+: any doc entry goes in perlapi.pod rather than perlintern.api
+: makes '#define foo Perl_foo' scope not just for PERL_CORE/PERL_EXT
+:
+: a Allocates memory a la malloc/calloc. Also implies "R":
+:
+: proto.h: add __attribute__malloc__
+:
+: b Binary backward compatibility; function is a macro
+: but has also Perl_ implementation (which is exported):
+:
+: add entry to global.sym;
+: don't define PERL_ARGS_ASSERT_FOO
+:
+: D Function is deprecated:
+:
+: proto.h: add __attribute__deprecated__
+:
+: d Function has documentation with its source:
+:
+: enables 'no docs for foo" warning in autodoc.pl
+:
+: E Visible to extensions included in the Perl core:
+:
+: in embed.h, change "#ifdef PERL_CORE"
+: into "#if defined(PERL_CORE) || defined(PERL_EXT)"
+:
+: Should always be combined with "X" to be usable from dynamically
+: loaded extensions.
+:
+: f Function takes printf style format string, varargs:
+:
+: proto.h: add __attribute__format__ (or ...null_ok__)
+:
+: M May change:
+:
+: (currently no effect)
+:
+: m Implemented as a macro:
+:
+: suppress proto.h entry
+: suppress global.sym entry
+: suppress embed.h entry
+:
+: n Has no implicit interpreter/thread context argument:
+:
+: suppress the pTHX part of "foo(pTHX...)" in proto.h;
+: In the PERL_IMPLICIT_SYS branch of embed.h, generates
+: "#define foo Perl_foo", rather than
+: "#define foo(a,b,c) Perl_foo(aTHX_ a,b,c)
+:
+: o Has no Perl_foo compatibility macro:
+:
+: embed.h: suppress "#define foo Perl_foo"
+:
+: P Pure function: no effects except the return value;
+: return value depends only on params and/or globals:
+:
+: proto.h: add __attribute__pure__
+:
+: p Function in source code has a Perl_ prefix:
+:
+: proto.h: function is declared as Perl_foo rather than foo
+: embed.h: "#define foo Perl_foo" entries added
+:
+: R Return value must not be ignored (also implied by 'a' flag):
+:
+: proto.h: add __attribute__warn_unused_result__
+:
+: r Function never returns:
+:
+: proto.h: add __attribute__noreturn__
+:
+: s Static function: function in source code has a S_ prefix:
+:
+: proto.h: function is declared as S_foo rather than foo,
+: STATIC is added to declaration;
+: embed.h: "#define foo S_foo" entries added
+:
+: U Suppress usage example in autogenerated documentation
+:
+: (currently no effect)
+:
+: X Explicitly exported:
+:
+: add entry to global.sym, unless x or m
+:
+: x Not exported
+:
+: suppress entry in global.sym
+:
: (see also L<perlguts/Internal Functions> for those flags.)
:
: Pointer parameters that must not be passed NULLs should be prefixed with NN.
AnpR |void* |get_context
Anp |void |set_context |NN void *t
+EXpRnP |I32 |regcurly |NN const char *s
END_EXTERN_C
pR |OP* |convert |I32 optype|I32 flags|NULLOK OP* o
: Used in op.c and perl.c
pM |PERL_CONTEXT* |create_eval_scope|U32 flags
+Aprd |void |croak_sv |NN SV *baseex
: croak()'s first parm can be NULL. Otherwise, mod_perl breaks.
Afprd |void |croak |NULLOK const char* pat|...
-Apr |void |vcroak |NULLOK const char* pat|NULLOK va_list* args
+Aprd |void |vcroak |NULLOK const char* pat|NULLOK va_list* args
Aprd |void |croak_xs_usage |NN const CV *const cv \
|NN const char *const params
|NN const char* fromend|int delim|NN I32* retlen
: Used in op.c, perl.c
pM |void |delete_eval_scope
-Afp |OP* |die |NULLOK const char* pat|...
-#if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
-s |OP* |vdie |NULLOK const char* pat|NULLOK va_list* args
-#endif
+Apd |OP* |die_sv |NN SV *baseex
+Afpd |OP* |die |NULLOK const char* pat|...
: Used in util.c
-pr |void |die_where |NULLOK SV* msv
+pr |void |die_unwind |NN SV* msv
Ap |void |dounwind |I32 cxix
: FIXME
pmb |bool |do_aexec |NULLOK SV* really|NN SV** mark|NN SV** sp
pMox |GP * |newGP |NN GV *const gv
Ap |void |gv_init |NN GV* gv|NULLOK HV* stash|NN const char* name|STRLEN len|int multi
Ap |void |gv_name_set |NN GV* gv|NN const char *name|U32 len|U32 flags
-Apd |void |gv_try_downgrade|NN GV* gv
+XMpd |void |gv_try_downgrade|NN GV* gv
Apd |HV* |gv_stashpv |NN const char* name|I32 flags
Apd |HV* |gv_stashpvn |NN const char* name|U32 namelen|I32 flags
Apd |HV* |gv_stashsv |NN SV* sv|I32 flags
ApR |bool |is_utf8_punct |NN const U8 *p
ApR |bool |is_utf8_xdigit |NN const U8 *p
ApR |bool |is_utf8_mark |NN const U8 *p
-ApR |bool |is_utf8_X_begin |NN const U8 *p
-ApR |bool |is_utf8_X_extend |NN const U8 *p
-ApR |bool |is_utf8_X_prepend |NN const U8 *p
-ApR |bool |is_utf8_X_non_hangul |NN const U8 *p
-ApR |bool |is_utf8_X_L |NN const U8 *p
-ApR |bool |is_utf8_X_LV |NN const U8 *p
-ApR |bool |is_utf8_X_LVT |NN const U8 *p
-ApR |bool |is_utf8_X_LV_LVT_V |NN const U8 *p
-ApR |bool |is_utf8_X_T |NN const U8 *p
-ApR |bool |is_utf8_X_V |NN const U8 *p
+EXpR |bool |is_utf8_X_begin |NN const U8 *p
+EXpR |bool |is_utf8_X_extend |NN const U8 *p
+EXpR |bool |is_utf8_X_prepend |NN const U8 *p
+EXpR |bool |is_utf8_X_non_hangul |NN const U8 *p
+EXpR |bool |is_utf8_X_L |NN const U8 *p
+EXpR |bool |is_utf8_X_LV |NN const U8 *p
+EXpR |bool |is_utf8_X_LVT |NN const U8 *p
+EXpR |bool |is_utf8_X_LV_LVT_V |NN const U8 *p
+EXpR |bool |is_utf8_X_T |NN const U8 *p
+EXpR |bool |is_utf8_X_V |NN const U8 *p
: Used in perly.y
p |OP* |jmaybe |NN OP *o
: Used in pp.c
: Public lexer API
AMpd |bool |lex_bufutf8
AMpd |char* |lex_grow_linestr|STRLEN len
-AMpd |void |lex_stuff_pvn |NN char* pv|STRLEN len|U32 flags
+AMpd |void |lex_stuff_pvn |NN const char* pv|STRLEN len|U32 flags
AMpd |void |lex_stuff_sv |NN SV* sv|U32 flags
AMpd |void |lex_unstuff |NN char* ptr
AMpd |void |lex_read_to |NN char* ptr
p |OP* |localize |NN OP *o|I32 lex
ApdR |I32 |looks_like_number|NN SV *const sv
Apd |UV |grok_bin |NN const char* start|NN STRLEN* len_p|NN I32* flags|NULLOK NV *result
+EXpR |char |grok_bslash_c |const char source|const bool output_warning
Apd |UV |grok_hex |NN const char* start|NN STRLEN* len_p|NN I32* flags|NULLOK NV *result
Apd |int |grok_number |NN const char *pv|STRLEN len|NULLOK UV *valuep
ApdR |bool |grok_numeric_radix|NN const char **sp|NN const char *send
p |int |magic_set_all_env|NN SV* sv|NN MAGIC* mg
p |U32 |magic_sizepack |NN SV* sv|NN MAGIC* mg
p |int |magic_wipepack |NN SV* sv|NN MAGIC* mg
+pod |SV* |magic_methcall |NN SV *sv|NN const MAGIC *mg \
+ |NN const char *meth|U32 flags \
+ |U32 argc|...
Ap |void |markstack_grow
#if defined(USE_LOCALE_COLLATE)
p |int |magic_setcollxfrm|NN SV* sv|NN MAGIC* mg
: Defined in locale.c, used only in sv.c
p |char* |mem_collxfrm |NN const char* s|STRLEN len|NN STRLEN* xlen
#endif
-Afp |SV* |mess |NN const char* pat|...
-Ap |SV* |vmess |NN const char* pat|NULLOK va_list* args
+Afpd |SV* |mess |NN const char* pat|...
+Apd |SV* |mess_sv |NN SV* basemsg|bool consume
+Apd |SV* |vmess |NN const char* pat|NULLOK va_list* args
: FIXME - either make it public, or stop exporting it. (Data::Alias uses this)
: Used in gv.c, op.c, toke.c
EXp |void |qerror |NN SV* err
Ap |char* |scan_vstring |NN const char *s|NN const char *const e \
|NN SV *sv
Apd |const char* |scan_version |NN const char *s|NN SV *rv|bool qv
+Apd |const char* |prescan_version |NN const char *s\
+ |bool strict|NULLOK const char** errstr|NULLOK bool *sqv\
+ |NULLOK int *ssaw_decimal|NULLOK int *swidth|NULLOK bool *salpha
Apd |SV* |new_version |NN SV *ver
Apd |SV* |upg_version |NN SV *ver|bool qv
Apd |bool |vverify |NN SV *vs
#if defined(PERL_USES_PL_PIDSTATUS) && defined(PERL_IN_UTIL_C)
s |void |pidgone |Pid_t pid|int status
#endif
-DUXpo |void |pmflag |NN U32 *pmfl|int ch
: Used in perly.y
p |OP* |pmruntime |NN OP *o|NN OP *expr|bool isreg
#if defined(PERL_IN_OP_C) || defined(PERL_DECL_PROT)
Amb |IV |sv_2iv |NULLOK SV *sv
Apd |IV |sv_2iv_flags |NULLOK SV *const sv|const I32 flags
Apd |SV* |sv_2mortal |NULLOK SV *const sv
-Apd |NV |sv_2nv |NULLOK SV *const sv
+Apd |NV |sv_2nv_flags |NULLOK SV *const sv|const I32 flags
: Used in pp.c, pp_hot.c, sv.c
pMd |SV* |sv_2num |NN SV *const sv
Amb |char* |sv_2pv |NULLOK SV *sv|NULLOK STRLEN *lp
Apd |SV* |sv_newref |NULLOK SV *const sv
Ap |char* |sv_peek |NULLOK SV* sv
Apd |void |sv_pos_u2b |NULLOK SV *const sv|NN I32 *const offsetp|NULLOK I32 *const lenp
+Apd |STRLEN |sv_pos_u2b_flags|NN SV *const sv|STRLEN uoffset \
+ |NULLOK STRLEN *const lenp|U32 flags
Apd |void |sv_pos_b2u |NULLOK SV *const sv|NN I32 *const offsetp
Amdb |char* |sv_pvn_force |NN SV* sv|NULLOK STRLEN* lp
Apd |char* |sv_pvutf8n_force|NN SV *const sv|NULLOK STRLEN *const lp
p |void |report_evil_fh |NULLOK const GV *gv|NULLOK const IO *io|I32 op
: Used in mg.c, pp.c, pp_hot.c, regcomp.c
XEpd |void |report_uninit |NULLOK const SV *uninit_sv
+Apd |void |warn_sv |NN SV *baseex
Afpd |void |warn |NN const char* pat|...
-Ap |void |vwarn |NN const char* pat|NULLOK va_list* args
+Apd |void |vwarn |NN const char* pat|NULLOK va_list* args
Afp |void |warner |U32 err|NN const char* pat|...
Afp |void |ck_warner |U32 err|NN const char* pat|...
Afp |void |ck_warner_d |U32 err|NN const char* pat|...
Ap |void |ptr_table_store|NN PTR_TBL_t *const tbl|NULLOK const void *const oldsv \
|NN void *const newsv
Ap |void |ptr_table_split|NN PTR_TBL_t *const tbl
-Ap |void |ptr_table_clear|NULLOK PTR_TBL_t *const tbl
+ApD |void |ptr_table_clear|NULLOK PTR_TBL_t *const tbl
Ap |void |ptr_table_free|NULLOK PTR_TBL_t *const tbl
#if defined(USE_ITHREADS)
# if defined(HAVE_INTERP_INTERN)
#if defined(PERL_IN_MG_C) || defined(PERL_DECL_PROT)
s |void |save_magic |I32 mgs_ix|NN SV *sv
-s |int |magic_methpack |NN SV *sv|NN const MAGIC *mg|NN const char *meth
-s |int |magic_methcall |NN SV *sv|NN const MAGIC *mg|NN const char *meth|I32 f \
+-s |int |magic_methpack |NN SV *sv|NN const MAGIC *mg|NN const char *meth
+s |SV* |magic_methcall1|NN SV *sv|NN const MAGIC *mg \
+ |NN const char *meth|U32 flags \
|int n|NULLOK SV *val
s |void |restore_magic |NULLOK const void *p
s |void |unwind_handler_stack|NN const void *p
Es |STRLEN |reguni |NN const struct RExC_state_t *pRExC_state \
|UV uv|NN char *s
Es |regnode*|regclass |NN struct RExC_state_t *pRExC_state|U32 depth
-ERsn |I32 |regcurly |NN const char *s
Es |regnode*|reg_node |NN struct RExC_state_t *pRExC_state|U8 op
Es |UV |reg_recode |const char value|NN SV **encp
Es |regnode*|regpiece |NN struct RExC_state_t *pRExC_state \
s |void |check_uni
s |void |force_next |I32 type
s |char* |force_version |NN char *s|int guessing
+s |char* |force_strict_version |NN char *s
s |char* |force_word |NN char *start|int token|int check_keyword \
|int allow_pack|int allow_tick
s |SV* |tokeq |NN SV *sv
#if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
s |const COP*|closest_cop |NN const COP *cop|NULLOK const OP *o
s |SV* |mess_alloc
-s |SV *|vdie_croak_common|NULLOK const char *pat|NULLOK va_list *args
-s |bool |vdie_common |NULLOK SV *message|bool warn
+s |SV *|with_queued_errors|NN SV *ex
+s |bool |invoke_exception_hook|NULLOK SV *ex|bool warn
sr |char * |write_no_mem
#if defined(PERL_MEM_LOG) && !defined(PERL_MEM_LOG_NOIMPL)
sn |void |mem_log_common |enum mem_log_type mlt|const UV n|const UV typesize \
#endif
#define get_context Perl_get_context
#define set_context Perl_set_context
+#if defined(PERL_CORE) || defined(PERL_EXT)
+#define regcurly Perl_regcurly
+#endif
#define amagic_call Perl_amagic_call
#define Gv_AMupdate Perl_Gv_AMupdate
#define gv_handler Perl_gv_handler
#define convert Perl_convert
#define create_eval_scope Perl_create_eval_scope
#endif
+#define croak_sv Perl_croak_sv
#define croak Perl_croak
#define vcroak Perl_vcroak
#define croak_xs_usage Perl_croak_xs_usage
#ifdef PERL_CORE
#define delete_eval_scope Perl_delete_eval_scope
#endif
+#define die_sv Perl_die_sv
#define die Perl_die
-#if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
-#ifdef PERL_CORE
-#define vdie S_vdie
-#endif
-#endif
#ifdef PERL_CORE
-#define die_where Perl_die_where
+#define die_unwind Perl_die_unwind
#endif
#define dounwind Perl_dounwind
#ifdef PERL_CORE
#define gv_fullname4 Perl_gv_fullname4
#define gv_init Perl_gv_init
#define gv_name_set Perl_gv_name_set
+#ifdef PERL_CORE
#define gv_try_downgrade Perl_gv_try_downgrade
+#endif
#define gv_stashpv Perl_gv_stashpv
#define gv_stashpvn Perl_gv_stashpvn
#define gv_stashsv Perl_gv_stashsv
#define is_utf8_punct Perl_is_utf8_punct
#define is_utf8_xdigit Perl_is_utf8_xdigit
#define is_utf8_mark Perl_is_utf8_mark
+#if defined(PERL_CORE) || defined(PERL_EXT)
#define is_utf8_X_begin Perl_is_utf8_X_begin
#define is_utf8_X_extend Perl_is_utf8_X_extend
#define is_utf8_X_prepend Perl_is_utf8_X_prepend
#define is_utf8_X_LV_LVT_V Perl_is_utf8_X_LV_LVT_V
#define is_utf8_X_T Perl_is_utf8_X_T
#define is_utf8_X_V Perl_is_utf8_X_V
+#endif
#ifdef PERL_CORE
#define jmaybe Perl_jmaybe
#define keyword Perl_keyword
#endif
#define looks_like_number Perl_looks_like_number
#define grok_bin Perl_grok_bin
+#if defined(PERL_CORE) || defined(PERL_EXT)
+#define grok_bslash_c Perl_grok_bslash_c
+#endif
#define grok_hex Perl_grok_hex
#define grok_number Perl_grok_number
#define grok_numeric_radix Perl_grok_numeric_radix
#endif
#endif
#define mess Perl_mess
+#define mess_sv Perl_mess_sv
#define vmess Perl_vmess
#if defined(PERL_CORE) || defined(PERL_EXT)
#define qerror Perl_qerror
#define new_stackinfo Perl_new_stackinfo
#define scan_vstring Perl_scan_vstring
#define scan_version Perl_scan_version
+#define prescan_version Perl_prescan_version
#define new_version Perl_new_version
#define upg_version Perl_upg_version
#define vverify Perl_vverify
#endif
#define sv_2iv_flags Perl_sv_2iv_flags
#define sv_2mortal Perl_sv_2mortal
-#define sv_2nv Perl_sv_2nv
+#define sv_2nv_flags Perl_sv_2nv_flags
#ifdef PERL_CORE
#define sv_2num Perl_sv_2num
#endif
#define sv_newref Perl_sv_newref
#define sv_peek Perl_sv_peek
#define sv_pos_u2b Perl_sv_pos_u2b
+#define sv_pos_u2b_flags Perl_sv_pos_u2b_flags
#define sv_pos_b2u Perl_sv_pos_b2u
#define sv_pvutf8n_force Perl_sv_pvutf8n_force
#define sv_pvbyten_force Perl_sv_pvbyten_force
#if defined(PERL_CORE) || defined(PERL_EXT)
#define report_uninit Perl_report_uninit
#endif
+#define warn_sv Perl_warn_sv
#define warn Perl_warn
#define vwarn Perl_vwarn
#define warner Perl_warner
#ifdef PERL_CORE
#define save_magic S_save_magic
#define magic_methpack S_magic_methpack
-#define magic_methcall S_magic_methcall
+#define magic_methcall1 S_magic_methcall1
#define restore_magic S_restore_magic
#define unwind_handler_stack S_unwind_handler_stack
#endif
#define regbranch S_regbranch
#define reguni S_reguni
#define regclass S_regclass
-#define regcurly S_regcurly
#define reg_node S_reg_node
#define reg_recode S_reg_recode
#define regpiece S_regpiece
#define check_uni S_check_uni
#define force_next S_force_next
#define force_version S_force_version
+#define force_strict_version S_force_strict_version
#define force_word S_force_word
#define tokeq S_tokeq
#define readpipe_override S_readpipe_override
#ifdef PERL_CORE
#define closest_cop S_closest_cop
#define mess_alloc S_mess_alloc
-#define vdie_croak_common S_vdie_croak_common
-#define vdie_common S_vdie_common
+#define with_queued_errors S_with_queued_errors
+#define invoke_exception_hook S_invoke_exception_hook
#define write_no_mem S_write_no_mem
#endif
#if defined(PERL_MEM_LOG) && !defined(PERL_MEM_LOG_NOIMPL)
#endif
#define get_context Perl_get_context
#define set_context Perl_set_context
+#if defined(PERL_CORE) || defined(PERL_EXT)
+#define regcurly Perl_regcurly
+#endif
#define amagic_call(a,b,c,d) Perl_amagic_call(aTHX_ a,b,c,d)
#define Gv_AMupdate(a,b) Perl_Gv_AMupdate(aTHX_ a,b)
#define gv_handler(a,b) Perl_gv_handler(aTHX_ a,b)
#define convert(a,b,c) Perl_convert(aTHX_ a,b,c)
#define create_eval_scope(a) Perl_create_eval_scope(aTHX_ a)
#endif
+#define croak_sv(a) Perl_croak_sv(aTHX_ a)
#define vcroak(a,b) Perl_vcroak(aTHX_ a,b)
#define croak_xs_usage(a,b) Perl_croak_xs_usage(aTHX_ a,b)
#if defined(PERL_IMPLICIT_CONTEXT)
#ifdef PERL_CORE
#define delete_eval_scope() Perl_delete_eval_scope(aTHX)
#endif
-#if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
-#ifdef PERL_CORE
-#define vdie(a,b) S_vdie(aTHX_ a,b)
-#endif
-#endif
+#define die_sv(a) Perl_die_sv(aTHX_ a)
#ifdef PERL_CORE
-#define die_where(a) Perl_die_where(aTHX_ a)
+#define die_unwind(a) Perl_die_unwind(aTHX_ a)
#endif
#define dounwind(a) Perl_dounwind(aTHX_ a)
#ifdef PERL_CORE
#endif
#define gv_init(a,b,c,d,e) Perl_gv_init(aTHX_ a,b,c,d,e)
#define gv_name_set(a,b,c,d) Perl_gv_name_set(aTHX_ a,b,c,d)
+#ifdef PERL_CORE
#define gv_try_downgrade(a) Perl_gv_try_downgrade(aTHX_ a)
+#endif
#define gv_stashpv(a,b) Perl_gv_stashpv(aTHX_ a,b)
#define gv_stashpvn(a,b,c) Perl_gv_stashpvn(aTHX_ a,b,c)
#define gv_stashsv(a,b) Perl_gv_stashsv(aTHX_ a,b)
#define is_utf8_punct(a) Perl_is_utf8_punct(aTHX_ a)
#define is_utf8_xdigit(a) Perl_is_utf8_xdigit(aTHX_ a)
#define is_utf8_mark(a) Perl_is_utf8_mark(aTHX_ a)
+#if defined(PERL_CORE) || defined(PERL_EXT)
#define is_utf8_X_begin(a) Perl_is_utf8_X_begin(aTHX_ a)
#define is_utf8_X_extend(a) Perl_is_utf8_X_extend(aTHX_ a)
#define is_utf8_X_prepend(a) Perl_is_utf8_X_prepend(aTHX_ a)
#define is_utf8_X_LV_LVT_V(a) Perl_is_utf8_X_LV_LVT_V(aTHX_ a)
#define is_utf8_X_T(a) Perl_is_utf8_X_T(aTHX_ a)
#define is_utf8_X_V(a) Perl_is_utf8_X_V(aTHX_ a)
+#endif
#ifdef PERL_CORE
#define jmaybe(a) Perl_jmaybe(aTHX_ a)
#define keyword(a,b,c) Perl_keyword(aTHX_ a,b,c)
#endif
#define looks_like_number(a) Perl_looks_like_number(aTHX_ a)
#define grok_bin(a,b,c,d) Perl_grok_bin(aTHX_ a,b,c,d)
+#if defined(PERL_CORE) || defined(PERL_EXT)
+#define grok_bslash_c(a,b) Perl_grok_bslash_c(aTHX_ a,b)
+#endif
#define grok_hex(a,b,c,d) Perl_grok_hex(aTHX_ a,b,c,d)
#define grok_number(a,b,c) Perl_grok_number(aTHX_ a,b,c)
#define grok_numeric_radix(a,b) Perl_grok_numeric_radix(aTHX_ a,b)
#define mem_collxfrm(a,b,c) Perl_mem_collxfrm(aTHX_ a,b,c)
#endif
#endif
+#define mess_sv(a,b) Perl_mess_sv(aTHX_ a,b)
#define vmess(a,b) Perl_vmess(aTHX_ a,b)
#if defined(PERL_CORE) || defined(PERL_EXT)
#define qerror(a) Perl_qerror(aTHX_ a)
#define new_stackinfo(a,b) Perl_new_stackinfo(aTHX_ a,b)
#define scan_vstring(a,b,c) Perl_scan_vstring(aTHX_ a,b,c)
#define scan_version(a,b,c) Perl_scan_version(aTHX_ a,b,c)
+#define prescan_version(a,b,c,d,e,f,g) Perl_prescan_version(aTHX_ a,b,c,d,e,f,g)
#define new_version(a) Perl_new_version(aTHX_ a)
#define upg_version(a,b) Perl_upg_version(aTHX_ a,b)
#define vverify(a) Perl_vverify(aTHX_ a)
#endif
#define sv_2iv_flags(a,b) Perl_sv_2iv_flags(aTHX_ a,b)
#define sv_2mortal(a) Perl_sv_2mortal(aTHX_ a)
-#define sv_2nv(a) Perl_sv_2nv(aTHX_ a)
+#define sv_2nv_flags(a,b) Perl_sv_2nv_flags(aTHX_ a,b)
#ifdef PERL_CORE
#define sv_2num(a) Perl_sv_2num(aTHX_ a)
#endif
#define sv_newref(a) Perl_sv_newref(aTHX_ a)
#define sv_peek(a) Perl_sv_peek(aTHX_ a)
#define sv_pos_u2b(a,b,c) Perl_sv_pos_u2b(aTHX_ a,b,c)
+#define sv_pos_u2b_flags(a,b,c,d) Perl_sv_pos_u2b_flags(aTHX_ a,b,c,d)
#define sv_pos_b2u(a,b) Perl_sv_pos_b2u(aTHX_ a,b)
#define sv_pvutf8n_force(a,b) Perl_sv_pvutf8n_force(aTHX_ a,b)
#define sv_pvbyten_force(a,b) Perl_sv_pvbyten_force(aTHX_ a,b)
#if defined(PERL_CORE) || defined(PERL_EXT)
#define report_uninit(a) Perl_report_uninit(aTHX_ a)
#endif
+#define warn_sv(a) Perl_warn_sv(aTHX_ a)
#define vwarn(a,b) Perl_vwarn(aTHX_ a,b)
#define vwarner(a,b,c) Perl_vwarner(aTHX_ a,b,c)
#ifdef PERL_CORE
#ifdef PERL_CORE
#define save_magic(a,b) S_save_magic(aTHX_ a,b)
#define magic_methpack(a,b,c) S_magic_methpack(aTHX_ a,b,c)
-#define magic_methcall(a,b,c,d,e,f) S_magic_methcall(aTHX_ a,b,c,d,e,f)
+#define magic_methcall1(a,b,c,d,e,f) S_magic_methcall1(aTHX_ a,b,c,d,e,f)
#define restore_magic(a) S_restore_magic(aTHX_ a)
#define unwind_handler_stack(a) S_unwind_handler_stack(aTHX_ a)
#endif
#define regbranch(a,b,c,d) S_regbranch(aTHX_ a,b,c,d)
#define reguni(a,b,c) S_reguni(aTHX_ a,b,c)
#define regclass(a,b) S_regclass(aTHX_ a,b)
-#define regcurly S_regcurly
#define reg_node(a,b) S_reg_node(aTHX_ a,b)
#define reg_recode(a,b) S_reg_recode(aTHX_ a,b)
#define regpiece(a,b,c) S_regpiece(aTHX_ a,b,c)
#define check_uni() S_check_uni(aTHX)
#define force_next(a) S_force_next(aTHX_ a)
#define force_version(a,b) S_force_version(aTHX_ a,b)
+#define force_strict_version(a) S_force_strict_version(aTHX_ a)
#define force_word(a,b,c,d,e) S_force_word(aTHX_ a,b,c,d,e)
#define tokeq(a) S_tokeq(aTHX_ a)
#define readpipe_override() S_readpipe_override(aTHX)
#ifdef PERL_CORE
#define closest_cop(a,b) S_closest_cop(aTHX_ a,b)
#define mess_alloc() S_mess_alloc(aTHX)
-#define vdie_croak_common(a,b) S_vdie_croak_common(aTHX_ a,b)
-#define vdie_common(a,b) S_vdie_common(aTHX_ a,b)
+#define with_queued_errors(a) S_with_queued_errors(aTHX_ a)
+#define invoke_exception_hook(a,b) S_invoke_exception_hook(aTHX_ a,b)
#define write_no_mem() S_write_no_mem(aTHX)
#endif
#if defined(PERL_MEM_LOG) && !defined(PERL_MEM_LOG_NOIMPL)
#define PL_rehash_seed (vTHX->Irehash_seed)
#define PL_rehash_seed_set (vTHX->Irehash_seed_set)
#define PL_replgv (vTHX->Ireplgv)
+#define PL_restartjmpenv (vTHX->Irestartjmpenv)
#define PL_restartop (vTHX->Irestartop)
#define PL_rs (vTHX->Irs)
#define PL_runops (vTHX->Irunops)
#define PL_Irehash_seed PL_rehash_seed
#define PL_Irehash_seed_set PL_rehash_seed_set
#define PL_Ireplgv PL_replgv
+#define PL_Irestartjmpenv PL_restartjmpenv
#define PL_Irestartop PL_restartop
#define PL_Irs PL_rs
#define PL_Irunops PL_runops
apisubversion=''
apiversion=''
ar='arm-epoc-pe-ar'
-archlib='/usr/lib/perl/5.11.3/epoc'
-archlibexp='/usr/lib/perl/5.11.3/epoc'
+archlib='/usr/lib/perl/5.13.0/epoc'
+archlibexp='/usr/lib/perl/5.13.0/epoc'
archname64=''
archname='epoc'
archobjs='epoc.o epocish.o epoc_stubs.o'
pr=''
prefix=''
prefixexp=''
-privlib='/usr/lib/perl/5.11.3'
-privlibexp='/usr/lib/perl/5.11.3'
+privlib='/usr/lib/perl/5.13.0'
+privlibexp='/usr/lib/perl/5.13.0'
procselfexe=''
prototype='define'
ptrsize='4'
sig_num_init='0, 0'
sig_size='1'
signal_t='void'
-sitearch='/usr/lib/perl/site_perl/5.11.3/epoc'
-sitearchexp='/usr/lib/perl/site_perl/5.11.3/epoc'
-sitelib='/usr/lib/perl/site_perl/5.11.3/'
+sitearch='/usr/lib/perl/site_perl/5.13.0/epoc'
+sitearchexp='/usr/lib/perl/site_perl/5.13.0/epoc'
+sitelib='/usr/lib/perl/site_perl/5.13.0/'
sitelib_stem='/usr/lib/perl/site_perl'
-sitelibexp='/usr/lib/perl/site_perl/5.11.3/'
+sitelibexp='/usr/lib/perl/site_perl/5.13.0/'
siteprefix=''
siteprefixexp=''
sizesize='4'
usevfork=''
usrinc=''
uuname=''
+vaproto='undef'
vendorlib=''
vendorlib_stem=''
vendorlibexp=''
vendorprefix=''
vendorprefixexp=''
-version='5.11.3'
+version='5.13.0'
versiononly='undef'
vi=''
voidflags='15'
config_arg10=''
config_arg11=''
PERL_REVISION=5
-PERL_VERSION=11
-PERL_SUBVERSION=3
+PERL_VERSION=13
+PERL_SUBVERSION=0
PERL_API_REVISION=5
-PERL_API_VERSION=11
+PERL_API_VERSION=13
PERL_API_SUBVERSION=0
PERL_CONFIG_SH=true
# Variables propagated from previous config.sh file.
vendorlibexp=''
vendorprefix=''
vendorprefixexp=''
-version='5.11.3'
+version='5.13.0'
vi=''
voidflags='15'
xlibpth=''
config_arg10=''
config_arg11=''
PERL_REVISION=5
-PERL_VERSION=11
-PERL_SUBVERSION=3
+PERL_VERSION=13
+PERL_SUBVERSION=0
PERL_API_REVISION=5
-PERL_API_VERSION=11
+PERL_API_VERSION=13
PERL_API_SUBVERSION=0
CONFIGDOTSH=true
# Variables propagated from previous config.sh file.
d_perl_otherlibdirs='undef'
nvsize='16'
issymlink=''
-installarchlib='/home/of/PERL/perl/lib/5.11.3/epoc'
+installarchlib='/home/of/PERL/perl/lib/5.13.0/epoc'
installbin='/home/of/PERL/System/Programs/'
installman1dir='/home/of/PERL/man1'
installman3dir='/home/of/PERL/man3'
installprefix=''
installprefixexp=''
-installprivlib='/home/of/PERL/perl/lib/5.11.3/'
+installprivlib='/home/of/PERL/perl/lib/5.13.0/'
installscript='/home/of/PERL/bin/'
-installsitearch='/home/of/PERL/site/lib/site_perl/5.11.3/epoc'
-installsitelib='/home/of/PERL/perl/lib/site_perl/5.11.3'
+installsitearch='/home/of/PERL/site/lib/site_perl/5.13.0/epoc'
+installsitelib='/home/of/PERL/perl/lib/site_perl/5.13.0'
installstyle=''
installusrbinperl='undef'
installvendorlib=''
d_ctermid='undef'
d_inc_version_list='undef'
d_libm_lib_version='0'
+d_prctl='undef'
+d_prctl_set_name='undef'
d_printf_format_null='undef'
d_pseudofork='undef'
d_signbit='undef'
use File::Find;
use Cwd;
-$VERSION="5.11.3";
+$VERSION="5.13.0";
$EPOC_VERSION=1;
XS => [qw/ unpack_sockaddr_un unpack_sockaddr_in
sockatmark sockaddr_family pack_sockaddr_un
pack_sockaddr_in inet_ntoa inet_aton
- inet_ntop inet_pton
/],
+ # skip inet_ntop and inet_pton as they're not exported by default
},
};
},
strip_open_hints => 1,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
-# 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
-# - <@> lineseq KP ->9
-# 1 <;> nextstate(main 426 optree.t:16) v:>,<,% ->2
+# 7 <1> leavesub[1 ref] K/REFC,1 ->(end)
+# - <@> lineseq KP ->7
+# 1 <;> nextstate(main 665 optree_samples.t:24) v:>,<,% ->2
# - <1> null K/1 ->-
-# 5 <|> cond_expr(other->6) K/1 ->a
-# 4 <1> shift sK/1 ->5
-# 3 <1> rv2av[t2] sKRM/1 ->4
-# 2 <#> gv[*_] s ->3
+# 3 <|> cond_expr(other->4) K/1 ->8
+# 2 <0> shift s* ->3
# - <@> scope K ->-
-# - <0> ex-nextstate v ->6
-# 8 <@> print sK ->9
-# 6 <0> pushmark s ->7
-# 7 <$> const[PV "then"] s ->8
-# f <@> leave KP ->9
-# a <0> enter ->b
-# b <;> nextstate(main 424 optree.t:17) v:>,<,% ->c
-# e <@> print sK ->f
-# c <0> pushmark s ->d
-# d <$> const[PV "else"] s ->e
+# - <0> ex-nextstate v ->4
+# 6 <@> print sK ->7
+# 4 <0> pushmark s ->5
+# 5 <$> const[PV "then"] s ->6
+# d <@> leave KP ->7
+# 8 <0> enter ->9
+# 9 <;> nextstate(main 663 optree_samples.t:25) v:>,<,% ->a
+# c <@> print sK ->d
+# a <0> pushmark s ->b
+# b <$> const[PV "else"] s ->c
EOT_EOT
-# 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
-# - <@> lineseq KP ->9
-# 1 <;> nextstate(main 427 optree_samples.t:18) v:>,<,% ->2
+# 7 <1> leavesub[1 ref] K/REFC,1 ->(end)
+# - <@> lineseq KP ->7
+# 1 <;> nextstate(main 665 optree_samples.t:24) v:>,<,% ->2
# - <1> null K/1 ->-
-# 5 <|> cond_expr(other->6) K/1 ->a
-# 4 <1> shift sK/1 ->5
-# 3 <1> rv2av[t1] sKRM/1 ->4
-# 2 <$> gv(*_) s ->3
+# 3 <|> cond_expr(other->4) K/1 ->8
+# 2 <0> shift s* ->3
# - <@> scope K ->-
-# - <0> ex-nextstate v ->6
-# 8 <@> print sK ->9
-# 6 <0> pushmark s ->7
-# 7 <$> const(PV "then") s ->8
-# f <@> leave KP ->9
-# a <0> enter ->b
-# b <;> nextstate(main 425 optree_samples.t:19) v:>,<,% ->c
-# e <@> print sK ->f
-# c <0> pushmark s ->d
-# d <$> const(PV "else") s ->e
+# - <0> ex-nextstate v ->4
+# 6 <@> print sK ->7
+# 4 <0> pushmark s ->5
+# 5 <$> const(PV "then") s ->6
+# d <@> leave KP ->7
+# 8 <0> enter ->9
+# 9 <;> nextstate(main 663 optree_samples.t:25) v:>,<,% ->a
+# c <@> print sK ->d
+# a <0> pushmark s ->b
+# b <$> const(PV "else") s ->c
EONT_EONT
checkOptree ( name => '-basic (see above, with my $a = shift)',
},
strip_open_hints => 1,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
-# d <1> leavesub[1 ref] K/REFC,1 ->(end)
-# - <@> lineseq KP ->d
-# 1 <;> nextstate(main 431 optree.t:68) v:>,<,% ->2
-# 6 <2> sassign vKS/2 ->7
-# 4 <1> shift sK/1 ->5
-# 3 <1> rv2av[t3] sKRM/1 ->4
-# 2 <#> gv[*_] s ->3
-# 5 <0> padsv[$a:431,435] sRM*/LVINTRO ->6
-# 7 <;> nextstate(main 435 optree.t:69) v:>,<,% ->8
+# b <1> leavesub[1 ref] K/REFC,1 ->(end)
+# - <@> lineseq KP ->b
+# 1 <;> nextstate(main 666 optree_samples.t:70) v:>,<,% ->2
+# 4 <2> sassign vKS/2 ->5
+# 2 <0> shift s* ->3
+# 3 <0> padsv[$a:666,670] sRM*/LVINTRO ->4
+# 5 <;> nextstate(main 670 optree_samples.t:71) v:>,<,% ->6
# - <1> null K/1 ->-
-# 9 <|> cond_expr(other->a) K/1 ->e
-# 8 <0> padsv[$a:431,435] s ->9
+# 7 <|> cond_expr(other->8) K/1 ->c
+# 6 <0> padsv[$a:666,670] s ->7
# - <@> scope K ->-
-# - <0> ex-nextstate v ->a
-# c <@> print sK ->d
-# a <0> pushmark s ->b
-# b <$> const[PV "foo"] s ->c
-# j <@> leave KP ->d
-# e <0> enter ->f
-# f <;> nextstate(main 433 optree.t:70) v:>,<,% ->g
-# i <@> print sK ->j
-# g <0> pushmark s ->h
-# h <$> const[PV "bar"] s ->i
+# - <0> ex-nextstate v ->8
+# a <@> print sK ->b
+# 8 <0> pushmark s ->9
+# 9 <$> const[PV "foo"] s ->a
+# h <@> leave KP ->b
+# c <0> enter ->d
+# d <;> nextstate(main 668 optree_samples.t:72) v:>,<,% ->e
+# g <@> print sK ->h
+# e <0> pushmark s ->f
+# f <$> const[PV "bar"] s ->g
EOT_EOT
-# d <1> leavesub[1 ref] K/REFC,1 ->(end)
-# - <@> lineseq KP ->d
-# 1 <;> nextstate(main 428 optree_samples.t:48) v:>,<,% ->2
-# 6 <2> sassign vKS/2 ->7
-# 4 <1> shift sK/1 ->5
-# 3 <1> rv2av[t2] sKRM/1 ->4
-# 2 <$> gv(*_) s ->3
-# 5 <0> padsv[$a:428,432] sRM*/LVINTRO ->6
-# 7 <;> nextstate(main 432 optree_samples.t:49) v:>,<,% ->8
+# b <1> leavesub[1 ref] K/REFC,1 ->(end)
+# - <@> lineseq KP ->b
+# 1 <;> nextstate(main 666 optree_samples.t:72) v:>,<,% ->2
+# 4 <2> sassign vKS/2 ->5
+# 2 <0> shift s* ->3
+# 3 <0> padsv[$a:666,670] sRM*/LVINTRO ->4
+# 5 <;> nextstate(main 670 optree_samples.t:73) v:>,<,% ->6
# - <1> null K/1 ->-
-# 9 <|> cond_expr(other->a) K/1 ->e
-# 8 <0> padsv[$a:428,432] s ->9
+# 7 <|> cond_expr(other->8) K/1 ->c
+# 6 <0> padsv[$a:666,670] s ->7
# - <@> scope K ->-
-# - <0> ex-nextstate v ->a
-# c <@> print sK ->d
-# a <0> pushmark s ->b
-# b <$> const(PV "foo") s ->c
-# j <@> leave KP ->d
-# e <0> enter ->f
-# f <;> nextstate(main 430 optree_samples.t:50) v:>,<,% ->g
-# i <@> print sK ->j
-# g <0> pushmark s ->h
-# h <$> const(PV "bar") s ->i
+# - <0> ex-nextstate v ->8
+# a <@> print sK ->b
+# 8 <0> pushmark s ->9
+# 9 <$> const(PV "foo") s ->a
+# h <@> leave KP ->b
+# c <0> enter ->d
+# d <;> nextstate(main 668 optree_samples.t:74) v:>,<,% ->e
+# g <@> print sK ->h
+# e <0> pushmark s ->f
+# f <$> const(PV "bar") s ->g
EONT_EONT
checkOptree ( name => '-exec sub {if shift print then,else}',
},
strip_open_hints => 1,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
-# 1 <;> nextstate(main 426 optree.t:16) v:>,<,%
-# 2 <#> gv[*_] s
-# 3 <1> rv2av[t2] sKRM/1
-# 4 <1> shift sK/1
-# 5 <|> cond_expr(other->6) K/1
-# 6 <0> pushmark s
-# 7 <$> const[PV "then"] s
-# 8 <@> print sK
-# goto 9
-# a <0> enter
-# b <;> nextstate(main 424 optree.t:17) v:>,<,%
-# c <0> pushmark s
-# d <$> const[PV "else"] s
-# e <@> print sK
-# f <@> leave KP
-# 9 <1> leavesub[1 ref] K/REFC,1
+# 1 <;> nextstate(main 674 optree_samples.t:125) v:>,<,%
+# 2 <0> shift s*
+# 3 <|> cond_expr(other->4) K/1
+# 4 <0> pushmark s
+# 5 <$> const[PV "then"] s
+# 6 <@> print sK
+# goto 7
+# 8 <0> enter
+# 9 <;> nextstate(main 672 optree_samples.t:126) v:>,<,%
+# a <0> pushmark s
+# b <$> const[PV "else"] s
+# c <@> print sK
+# d <@> leave KP
+# 7 <1> leavesub[1 ref] K/REFC,1
EOT_EOT
-# 1 <;> nextstate(main 436 optree_samples.t:123) v:>,<,%
-# 2 <$> gv(*_) s
-# 3 <1> rv2av[t1] sKRM/1
-# 4 <1> shift sK/1
-# 5 <|> cond_expr(other->6) K/1
-# 6 <0> pushmark s
-# 7 <$> const(PV "then") s
-# 8 <@> print sK
-# goto 9
-# a <0> enter
-# b <;> nextstate(main 434 optree_samples.t:124) v:>,<,%
-# c <0> pushmark s
-# d <$> const(PV "else") s
-# e <@> print sK
-# f <@> leave KP
-# 9 <1> leavesub[1 ref] K/REFC,1
+# 1 <;> nextstate(main 674 optree_samples.t:129) v:>,<,%
+# 2 <0> shift s*
+# 3 <|> cond_expr(other->4) K/1
+# 4 <0> pushmark s
+# 5 <$> const(PV "then") s
+# 6 <@> print sK
+# goto 7
+# 8 <0> enter
+# 9 <;> nextstate(main 672 optree_samples.t:130) v:>,<,%
+# a <0> pushmark s
+# b <$> const(PV "else") s
+# c <@> print sK
+# d <@> leave KP
+# 7 <1> leavesub[1 ref] K/REFC,1
EONT_EONT
checkOptree ( name => '-exec (see above, with my $a = shift)',
},
strip_open_hints => 1,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
-# 1 <;> nextstate(main 423 optree.t:16) v:>,<,%
-# 2 <#> gv[*_] s
-# 3 <1> rv2av[t3] sKRM/1
-# 4 <1> shift sK/1
-# 5 <0> padsv[$a:423,427] sRM*/LVINTRO
-# 6 <2> sassign vKS/2
-# 7 <;> nextstate(main 427 optree.t:17) v:>,<,%
-# 8 <0> padsv[$a:423,427] s
-# 9 <|> cond_expr(other->a) K/1
-# a <0> pushmark s
-# b <$> const[PV "foo"] s
-# c <@> print sK
-# goto d
-# e <0> enter
-# f <;> nextstate(main 425 optree.t:18) v:>,<,%
-# g <0> pushmark s
-# h <$> const[PV "bar"] s
-# i <@> print sK
-# j <@> leave KP
-# d <1> leavesub[1 ref] K/REFC,1
+# 1 <;> nextstate(main 675 optree_samples.t:165) v:>,<,%
+# 2 <0> shift s*
+# 3 <0> padsv[$a:675,679] sRM*/LVINTRO
+# 4 <2> sassign vKS/2
+# 5 <;> nextstate(main 679 optree_samples.t:166) v:>,<,%
+# 6 <0> padsv[$a:675,679] s
+# 7 <|> cond_expr(other->8) K/1
+# 8 <0> pushmark s
+# 9 <$> const[PV "foo"] s
+# a <@> print sK
+# goto b
+# c <0> enter
+# d <;> nextstate(main 677 optree_samples.t:167) v:>,<,%
+# e <0> pushmark s
+# f <$> const[PV "bar"] s
+# g <@> print sK
+# h <@> leave KP
+# b <1> leavesub[1 ref] K/REFC,1
EOT_EOT
-# 1 <;> nextstate(main 437 optree_samples.t:112) v:>,<,%
-# 2 <$> gv(*_) s
-# 3 <1> rv2av[t2] sKRM/1
-# 4 <1> shift sK/1
-# 5 <0> padsv[$a:437,441] sRM*/LVINTRO
-# 6 <2> sassign vKS/2
-# 7 <;> nextstate(main 441 optree_samples.t:113) v:>,<,%
-# 8 <0> padsv[$a:437,441] s
-# 9 <|> cond_expr(other->a) K/1
-# a <0> pushmark s
-# b <$> const(PV "foo") s
-# c <@> print sK
-# goto d
-# e <0> enter
-# f <;> nextstate(main 439 optree_samples.t:114) v:>,<,%
-# g <0> pushmark s
-# h <$> const(PV "bar") s
-# i <@> print sK
-# j <@> leave KP
-# d <1> leavesub[1 ref] K/REFC,1
+# 1 <;> nextstate(main 675 optree_samples.t:171) v:>,<,%
+# 2 <0> shift s*
+# 3 <0> padsv[$a:675,679] sRM*/LVINTRO
+# 4 <2> sassign vKS/2
+# 5 <;> nextstate(main 679 optree_samples.t:172) v:>,<,%
+# 6 <0> padsv[$a:675,679] s
+# 7 <|> cond_expr(other->8) K/1
+# 8 <0> pushmark s
+# 9 <$> const(PV "foo") s
+# a <@> print sK
+# goto b
+# c <0> enter
+# d <;> nextstate(main 677 optree_samples.t:173) v:>,<,%
+# e <0> pushmark s
+# f <$> const(PV "bar") s
+# g <@> print sK
+# h <@> leave KP
+# b <1> leavesub[1 ref] K/REFC,1
EONT_EONT
checkOptree ( name => '-exec sub { print (shift) ? "foo" : "bar" }',
bcopts => '-exec',
strip_open_hints => 1,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
-# 1 <;> nextstate(main 428 optree.t:31) v:>,<,%
+# 1 <;> nextstate(main 680 optree_samples.t:213) v:>,<,%
# 2 <0> pushmark s
-# 3 <#> gv[*_] s
-# 4 <1> rv2av[t2] sKRM/1
-# 5 <1> shift sK/1
-# 6 <@> print sK
-# 7 <|> cond_expr(other->8) K/1
-# 8 <$> const[PV "foo"] s
-# goto 9
-# a <$> const[PV "bar"] s
-# 9 <1> leavesub[1 ref] K/REFC,1
+# 3 <0> shift s*
+# 4 <@> print sK
+# 5 <|> cond_expr(other->6) K/1
+# 6 <$> const[PV "foo"] s
+# goto 7
+# 8 <$> const[PV "bar"] s
+# 7 <1> leavesub[1 ref] K/REFC,1
EOT_EOT
-# 1 <;> nextstate(main 442 optree_samples.t:144) v:>,<,%
+# 1 <;> nextstate(main 680 optree_samples.t:221) v:>,<,%
# 2 <0> pushmark s
-# 3 <$> gv(*_) s
-# 4 <1> rv2av[t1] sKRM/1
-# 5 <1> shift sK/1
-# 6 <@> print sK
-# 7 <|> cond_expr(other->8) K/1
-# 8 <$> const(PV "foo") s
-# goto 9
-# a <$> const(PV "bar") s
-# 9 <1> leavesub[1 ref] K/REFC,1
+# 3 <0> shift s*
+# 4 <@> print sK
+# 5 <|> cond_expr(other->6) K/1
+# 6 <$> const(PV "foo") s
+# goto 7
+# 8 <$> const(PV "bar") s
+# 7 <1> leavesub[1 ref] K/REFC,1
EONT_EONT
pass ("FOREACH");
RV = $ADDR
SV = REGEXP\\($ADDR\\) at $ADDR
REFCNT = 1
- FLAGS = \\(OBJECT,POK,pPOK\\)
+ FLAGS = \\(OBJECT,POK,FAKE,pPOK\\)
IV = 0
PV = $ADDR "\\(\\?-xism:tic\\)"
CUR = 12
FLAGS = \\(OBJECT\\)
IV = 0 # $] < 5.011
NV = 0 # $] < 5.011
- STASH = $ADDR\s+"IO::Handle"
+ STASH = $ADDR\s+"IO::File"
IFP = $ADDR
OFP = $ADDR
DIRP = 0x0
use Config;
use strict;
-our $VERSION = "1.11";
+our $VERSION = "1.12";
my %err = ();
my %wsa = ();
#
package Errno;
-our (\@EXPORT_OK,\%EXPORT_TAGS,\@ISA,\$VERSION,\%errno,\$AUTOLOAD);
+our (\@ISA,\$VERSION);
use Exporter ();
use Config;
use strict;
\$VERSION = eval \$VERSION;
\@ISA = qw(Exporter);
+my %err;
+
+BEGIN {
+ %err = (
EDQ
- my $len = 0;
my @err = sort { $err{$a} <=> $err{$b} } keys %err;
- map { $len = length if length > $len } @err;
- my $j = "\@EXPORT_OK = qw(" . join(" ",keys %err) . ");\n";
- $j =~ s/(.{50,70})\s/$1\n\t/g;
- print $j,"\n";
+ foreach $err (@err) {
+ print "\t$err => $err{$err},\n";
+ }
print <<'ESQ';
+ );
+ # Generate proxy constant subroutines for all the values.
+ # We assume at this point that our symbol table is empty.
+ # Doing this before defining @EXPORT_OK etc means that even if a platform is
+ # crazy enough to define EXPORT_OK as an error constant, everything will
+ # still work, because the parser will upgrade the PCS to a real typeglob.
+ # We rely on the subroutine definitions below to update the internal caches.
+ # Don't use %each, as we don't want a copy of the value.
+ foreach my $name (keys %err) {
+ $Errno::{$name} = \$err{$name};
+ }
+}
+
+our (@EXPORT_OK, %EXPORT_TAGS);
+
+@EXPORT_OK = keys %err;
+
%EXPORT_TAGS = (
POSIX => [qw(
ESQ
$k =~ s/(.{50,70})\s/$1\n\t/g;
print "\t",$k,"\n )]\n);\n\n";
- foreach $err (@err) {
- printf "sub %s () { %d }\n",,$err,$err{$err};
- }
-
print <<'ESQ';
-
-sub TIEHASH { bless [] }
+sub TIEHASH { bless \%err }
sub FETCH {
- my ($self, $errname) = @_;
- my $proto = prototype("Errno::$errname");
- my $errno = "";
- if (defined($proto) && $proto eq "") {
- no strict 'refs';
- $errno = &$errname;
- $errno = 0 unless $! == $errno;
- }
- return $errno;
+ my (undef, $errname) = @_;
+ return "" unless exists $err{$errname};
+ my $errno = $err{$errname};
+ return $errno == $! ? $errno : 0;
}
sub STORE {
*DELETE = \&STORE;
sub NEXTKEY {
- my($k,$v);
- while(($k,$v) = each %Errno::) {
- my $proto = prototype("Errno::$k");
- last if (defined($proto) && $proto eq "");
- }
- $k
+ each %err;
}
sub FIRSTKEY {
- my $s = scalar keys %Errno::; # initialize iterator
- goto &NEXTKEY;
+ my $s = scalar keys %err; # initialize iterator
+ each %err;
}
sub EXISTS {
- my ($self, $errname) = @_;
- my $r = ref $errname;
- my $proto = !$r || $r eq 'CODE' ? prototype($errname) : undef;
- defined($proto) && $proto eq "";
+ my (undef, $errname) = @_;
+ exists $err{$errname};
}
-tie %!, __PACKAGE__;
+tie %!, __PACKAGE__; # Returns an object, objects are true.
-1;
__END__
=head1 NAME
zap();
unless ($s1[7] == 1_000_003 && $s2[7] == 2_000_003 &&
- $s1[11] == $s2[11] && $s1[12] == $s2[12]) {
+ $s1[11] == $s2[11] && $s1[12] == $s2[12] &&
+ $s1[12] > 0) {
print "1..0 # Skip: no sparse files?\n";
bye;
}
$ENV{LC_ALL} = "C";
-my $r = system '../perl', '-I../lib', '-e', <<'EOF';
+my $perl = '../../perl';
+unless (-x $perl) {
+ print "1..1\nnot ok 1 - can't find perl: expected $perl\n";
+ exit 0;
+}
+my $r = system $perl, '-I../lib', '-e', <<'EOF';
use Fcntl qw(/^O_/ /^SEEK_/);
sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or die $!;
my $sysseek = sysseek(BIG, 5_000_000_000, SEEK_SET);
exit 0;
EOF
+
sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or
do { warn "sysopen 'big' failed: $!\n"; bye };
my $sysseek = sysseek(BIG, 5_000_000_000, SEEK_SET);
);
# This module isn't dual life, so no need for dev version numbers.
-$VERSION = '1.09';
+$VERSION = '1.10';
sub AUTOLOAD {
my($constname);
output_datum(pTHX_ SV *arg, char *str, int size)
{
sv_setpvn(arg, str, size);
+# undef free
free(str);
}
use Carp;
use Symbol qw(gensym qualify);
-$VERSION = 1.05;
+$VERSION = 1.06;
@ISA = qw(Exporter);
@EXPORT = qw(open3);
If either reader or writer is the null string, this will be replaced
by an autogenerated filehandle. If so, you must pass a valid lvalue
-in the parameter slot so it can be overwritten in the caller, or
+in the parameter slot so it can be overwritten in the caller, or
an exception will be raised.
The filehandles may also be integers, in which case they are understood
process rather than an external command. This feature isn't yet
supported on Win32 platforms.
-open3() does not wait for and reap the child process after it exits.
+open3() does not wait for and reap the child process after it exits.
Except for short programs where it's acceptable to let the operating system
-take care of this, you need to do this yourself. This is normally as
+take care of this, you need to do this yourself. This is normally as
simple as calling C<waitpid $pid, 0> when you're done with the process.
Failing to do this can result in an accumulation of defunct or "zombie"
processes. See L<perlfunc/waitpid> for more information.
pipe $_[0], $_[1] or croak "$Me: pipe($_[0], $_[1]) failed: $!";
}
+sub xpipe_anon {
+ pipe $_[0], $_[1] or croak "$Me: pipe failed: $!";
+}
+
+sub xclose_on_exec {
+ require Fcntl;
+ my $flags = fcntl($_[0], &Fcntl::F_GETFD, 0)
+ or croak "$Me: fcntl failed: $!";
+ fcntl($_[0], &Fcntl::F_SETFD, $flags|&Fcntl::FD_CLOEXEC)
+ or croak "$Me: fcntl failed: $!";
+}
+
# I tried using a * prototype character for the filehandle but it still
# disallows a bearword while compiling under strict subs.
unless (eval {
$dad_wtr = $_[1] = gensym unless defined $dad_wtr && length $dad_wtr;
$dad_rdr = $_[2] = gensym unless defined $dad_rdr && length $dad_rdr;
- 1; })
+ 1; })
{
# must strip crud for croak to add back, or looks ugly
$@ =~ s/(?<=value attempted) at .*//s;
croak "$Me: $@";
- }
+ }
$dad_err ||= $dad_rdr;
xpipe $dad_rdr, $kid_wtr if !$dup_rdr;
xpipe $dad_err, $kid_err if !$dup_err && $dad_err ne $dad_rdr;
- $kidpid = DO_SPAWN ? -1 : xfork;
- if ($kidpid == 0) { # Kid
- # A tie in the parent should not be allowed to cause problems.
- untie *STDIN;
- untie *STDOUT;
- # If she wants to dup the kid's stderr onto her stdout I need to
- # save a copy of her stdout before I put something else there.
- if ($dad_rdr ne $dad_err && $dup_err
- && xfileno($dad_err) == fileno(STDOUT)) {
- my $tmp = gensym;
- xopen($tmp, ">&$dad_err");
- $dad_err = $tmp;
- }
+ if (!DO_SPAWN) {
+ # Used to communicate exec failures.
+ xpipe my $stat_r, my $stat_w;
+
+ $kidpid = xfork;
+ if ($kidpid == 0) { # Kid
+ eval {
+ # A tie in the parent should not be allowed to cause problems.
+ untie *STDIN;
+ untie *STDOUT;
+
+ close $stat_r;
+ xclose_on_exec $stat_w;
+
+ # If she wants to dup the kid's stderr onto her stdout I need to
+ # save a copy of her stdout before I put something else there.
+ if ($dad_rdr ne $dad_err && $dup_err
+ && xfileno($dad_err) == fileno(STDOUT)) {
+ my $tmp = gensym;
+ xopen($tmp, ">&$dad_err");
+ $dad_err = $tmp;
+ }
+
+ if ($dup_wtr) {
+ xopen \*STDIN, "<&$dad_wtr" if fileno(STDIN) != xfileno($dad_wtr);
+ } else {
+ xclose $dad_wtr;
+ xopen \*STDIN, "<&=" . fileno $kid_rdr;
+ }
+ if ($dup_rdr) {
+ xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) != xfileno($dad_rdr);
+ } else {
+ xclose $dad_rdr;
+ xopen \*STDOUT, ">&=" . fileno $kid_wtr;
+ }
+ if ($dad_rdr ne $dad_err) {
+ if ($dup_err) {
+ # I have to use a fileno here because in this one case
+ # I'm doing a dup but the filehandle might be a reference
+ # (from the special case above).
+ xopen \*STDERR, ">&" . xfileno($dad_err)
+ if fileno(STDERR) != xfileno($dad_err);
+ } else {
+ xclose $dad_err;
+ xopen \*STDERR, ">&=" . fileno $kid_err;
+ }
+ } else {
+ xopen \*STDERR, ">&STDOUT" if fileno(STDERR) != fileno(STDOUT);
+ }
+ return 0 if ($cmd[0] eq '-');
+ exec @cmd or do {
+ local($")=(" ");
+ croak "$Me: exec of @cmd failed";
+ };
+ };
+
+ my $bang = 0+$!;
+ my $err = $@;
+ utf8::encode $err if $] >= 5.008;
+ print $stat_w pack('IIa*', $bang, length($err), $err);
+ close $stat_w;
- if ($dup_wtr) {
- xopen \*STDIN, "<&$dad_wtr" if fileno(STDIN) != xfileno($dad_wtr);
- } else {
- xclose $dad_wtr;
- xopen \*STDIN, "<&=" . fileno $kid_rdr;
- }
- if ($dup_rdr) {
- xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) != xfileno($dad_rdr);
- } else {
- xclose $dad_rdr;
- xopen \*STDOUT, ">&=" . fileno $kid_wtr;
+ eval { require POSIX; POSIX::_exit(255); };
+ exit 255;
}
- if ($dad_rdr ne $dad_err) {
- if ($dup_err) {
- # I have to use a fileno here because in this one case
- # I'm doing a dup but the filehandle might be a reference
- # (from the special case above).
- xopen \*STDERR, ">&" . xfileno($dad_err)
- if fileno(STDERR) != xfileno($dad_err);
- } else {
- xclose $dad_err;
- xopen \*STDERR, ">&=" . fileno $kid_err;
+ else { # Parent
+ close $stat_w;
+ my $to_read = length(pack('I', 0)) * 2;
+ my $bytes_read = read($stat_r, my $buf = '', $to_read);
+ if ($bytes_read) {
+ (my $bang, $to_read) = unpack('II', $buf);
+ read($stat_r, my $err = '', $to_read);
+ if ($err) {
+ utf8::decode $err if $] >= 5.008;
+ } else {
+ $err = "$Me: " . ($! = $bang);
+ }
+ $! = $bang;
+ die($err);
}
- } else {
- xopen \*STDERR, ">&STDOUT" if fileno(STDERR) != fileno(STDOUT);
}
- return 0 if ($cmd[0] eq '-');
- local($")=(" ");
- exec @cmd or do {
- carp "$Me: exec of @cmd failed";
- eval { require POSIX; POSIX::_exit(255); };
- exit 255;
- };
- } elsif (DO_SPAWN) {
+ }
+ else { # DO_SPAWN
# All the bookkeeping of coincidence between handles is
# handled in spawn_with_handles.
STDOUT->autoflush;
STDERR->autoflush;
-print "1..22\n";
+print "1..23\n";
# basic
ok 1, $pid = open3 'WRITE', 'READ', 'ERROR', $perl, '-e', cmd_line(<<'EOF');
print WRITE "ok 22\n";
waitpid $pid, 0;
}
+
+# RT 72016
+eval{$pid = open3 'WRITE', 'READ', 'ERROR', '/non/existant/program'; };
+if (IPC::Open3::DO_SPAWN) {
+ if ($@ || waitpid($pid, 0) > 0) {
+ print "ok 23\n";
+ } else {
+ print "not ok 23\n";
+ }
+} else {
+ if ($@) {
+ print "ok 23\n";
+ } else {
+ waitpid($pid, 0);
+ print "not ok 23\n";
+ }
+}
your operating system. Please consult L<perllocale> for how to find
out which locales are available in your system.
- $loc = setlocale( LC_ALL, "es_AR.ISO8859-1" );
+ $loc = setlocale( LC_COLLATE, "es_AR.ISO8859-1" );
=item setpgid
SKIP: {
eval 'use POSIX qw(SA_SIGINFO); SA_SIGINFO';
skip("no SA_SIGINFO", 1) if $@;
+ skip("SA_SIGINFO is broken on AIX 4.2", 1) if $^O.$Config{osvers} =~ m/^aix4\.2/;
sub hiphup {
is($_[1]->{signo}, SIGHUP, "SA_SIGINFO got right signal");
}
package PerlIO::encoding;
use strict;
-our $VERSION = '0.11';
+our $VERSION = '0.12';
our $DEBUG = 0;
$DEBUG and warn __PACKAGE__, " called by ", join(", ", caller), "\n";
if (!SvROK(result) || !SvOBJECT(SvRV(result))) {
e->enc = Nullsv;
- Perl_warner(aTHX_ packWARN(WARN_IO), "Cannot find encoding \"%" SVf "\"",
- arg);
+ if (ckWARN_d(WARN_IO))
+ Perl_warner(aTHX_ packWARN(WARN_IO), "Cannot find encoding \"%" SVf "\"",
+ arg);
errno = EINVAL;
code = -1;
}
XPUSHs(result);
PUTBACK;
if (call_method("renew",G_SCALAR|G_EVAL) != 1 || SvTRUE(ERRSV)) {
- Perl_warner(aTHX_ packWARN(WARN_IO), "\"%" SVf "\" does not support renew method",
- arg);
+ if (ckWARN_d(WARN_IO))
+ Perl_warner(aTHX_ packWARN(WARN_IO), "\"%" SVf "\" does not support renew method",
+ arg);
}
else {
SPAGAIN;
XPUSHs(e->enc);
PUTBACK;
if (call_method("needs_lines",G_SCALAR|G_EVAL) != 1 || SvTRUE(ERRSV)) {
- Perl_warner(aTHX_ packWARN(WARN_IO), "\"%" SVf "\" does not support needs_lines",
+ if (ckWARN_d(WARN_IO))
+ Perl_warner(aTHX_ packWARN(WARN_IO), "\"%" SVf "\" does not support needs_lines",
arg);
}
else {
package PerlIO::scalar;
-our $VERSION = '0.07';
+our $VERSION = '0.08';
use XSLoader ();
XSLoader::load 'PerlIO::scalar';
1;
s->posn = SvCUR(s->var);
else
s->posn = 0;
+ SvSETMAGIC(s->var);
return code;
}
PerlIOScalar_seek(pTHX_ PerlIO * f, Off_t offset, int whence)
{
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
- STRLEN oldcur = SvCUR(s->var);
+ STRLEN oldcur;
STRLEN newlen;
+
+ SvGETMAGIC(s->var);
+ oldcur = SvCUR(s->var);
+
switch (whence) {
case SEEK_SET:
s->posn = offset;
return s->posn;
}
+
+SSize_t
+PerlIOScalar_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
+{
+ if (!f)
+ return 0;
+ if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD)) {
+ PerlIOBase(f)->flags |= PERLIO_F_ERROR;
+ SETERRNO(EBADF, SS_IVCHAN);
+ return 0;
+ }
+ {
+ PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
+ SV *sv = s->var;
+ char *p;
+ STRLEN len, got;
+ p = SvPV(sv, len);
+ got = len - (STRLEN)(s->posn);
+ if (got <= 0)
+ return 0;
+ if (got > (STRLEN)count)
+ got = (STRLEN)count;
+ Copy(p + (STRLEN)(s->posn), vbuf, got, STDCHAR);
+ s->posn += (Off_t)got;
+ return (SSize_t)got;
+ }
+}
+
SSize_t
PerlIOScalar_write(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
{
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
SV *sv = s->var;
char *dst;
+ SvGETMAGIC(sv);
if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND) {
dst = SvGROW(sv, SvCUR(sv) + count);
offset = SvCUR(sv);
if ((s->posn + count) > SvCUR(sv))
dst = SvGROW(sv, (STRLEN)s->posn + count);
else
- dst = SvPV_nolen(sv);
+ dst = SvPVX(sv);
offset = s->posn;
s->posn += count;
}
Move(vbuf, dst + offset, count, char);
if ((STRLEN) s->posn > SvCUR(sv))
SvCUR_set(sv, (STRLEN)s->posn);
- SvPOK_on(s->var);
+ SvPOK_on(sv);
+ SvSETMAGIC(sv);
return count;
}
else
{
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
+ SvGETMAGIC(s->var);
return (STDCHAR *) SvPV_nolen(s->var);
}
return (STDCHAR *) NULL;
{
if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
+ SvGETMAGIC(s->var);
if (SvCUR(s->var) > (STRLEN) s->posn)
return SvCUR(s->var) - (STRLEN)s->posn;
else
{
if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
+ SvGETMAGIC(s->var);
return SvCUR(s->var);
}
return 0;
PerlIOScalar_set_ptrcnt(pTHX_ PerlIO * f, STDCHAR * ptr, SSize_t cnt)
{
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
+ SvGETMAGIC(s->var);
s->posn = SvCUR(s->var) - cnt;
}
PerlIOScalar_arg,
PerlIOScalar_fileno,
PerlIOScalar_dup,
- PerlIOBase_read,
+ PerlIOScalar_read,
NULL, /* unread */
PerlIOScalar_write,
PerlIOScalar_seek,
$| = 1;
-use Test::More tests => 55;
+use Test::More tests => 69;
my $fh;
my $var = "aaa\n";
is(<$fh>, "42", "reading from non-string scalars");
close $fh;
-{ package P; sub TIESCALAR {bless{}} sub FETCH { "shazam" } }
+{ package P; sub TIESCALAR {bless{}} sub FETCH { "shazam" } sub STORE {} }
tie $p, P; open $fh, '<', \$p;
is(<$fh>, "shazam", "reading from magic scalars");
package MgUndef;
sub TIESCALAR { bless [] }
sub FETCH { $fetch++; return undef }
+ sub STORE {}
}
tie my $scalar, MgUndef;
ok(!seek(F, -150, SEEK_END), $!);
}
+# RT #43789: should respect tied scalar
+
+{
+ package TS;
+ my $s;
+ sub TIESCALAR { bless \my $x }
+ sub FETCH { $s .= ':F'; ${$_[0]} }
+ sub STORE { $s .= ":S($_[1])"; ${$_[0]} = $_[1] }
+
+ package main;
+
+ my $x;
+ $s = '';
+ tie $x, 'TS';
+ my $fh;
+
+ ok(open($fh, '>', \$x), 'open-write tied scalar');
+ $s .= ':O';
+ print($fh 'ABC');
+ $s .= ':P';
+ ok(seek($fh, 0, SEEK_SET));
+ $s .= ':SK';
+ print($fh 'DEF');
+ $s .= ':P';
+ ok(close($fh), 'close tied scalar - write');
+ is($s, ':F:S():O:F:S(ABC):P:F:SK:F:S(DEF):P', 'tied actions - write');
+ is($x, 'DEF', 'new value preserved');
+
+ $x = 'GHI';
+ $s = '';
+ ok(open($fh, '+<', \$x), 'open-read tied scalar');
+ $s .= ':O';
+ my $buf;
+ is(read($fh,$buf,2), 2, 'read1');
+ $s .= ':R';
+ is($buf, 'GH', 'buf1');
+ is(read($fh,$buf,2), 1, 'read2');
+ $s .= ':R';
+ is($buf, 'I', 'buf2');
+ is(read($fh,$buf,2), 0, 'read3');
+ $s .= ':R';
+ is($buf, '', 'buf3');
+ ok(close($fh), 'close tied scalar - read');
+ is($s, ':F:S(GHI):O:F:R:F:R:F:R', 'tied actions - read');
+}
+
+
package Socket;
our($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
-$VERSION = "1.85";
+$VERSION = "1.87";
=head1 NAME
as 'www.perl.org', or an IP address. If using an IP address, the type of
IP address must be consistant with the address family passed into the function.
+This function is not exported by default.
+
=item inet_ntop ADDRESS_FAMILY, IP_ADDRESS
Takes an address family, either AF_INET or AF_INET6, and a string
(an opaque string as returned by inet_aton() or inet_pton()) and
translates it to an IPv4 or IPv6 address string.
+This function is not exported by default.
+
=back
=cut
@ISA = qw(Exporter);
@EXPORT = qw(
inet_aton inet_ntoa
- inet_pton inet_ntop
sockaddr_family
pack_sockaddr_in unpack_sockaddr_in
pack_sockaddr_un unpack_sockaddr_un
@EXPORT_OK = qw(CR LF CRLF $CR $LF $CRLF
+ inet_pton
+ inet_ntop
+
IPPROTO_IP
IPPROTO_IPV6
IPPROTO_RAW
char * addr_str;
char * ip_address;
if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
- croak("Wide character in Socket::inet_ntoa");
+ croak("Wide character in %s", "Socket::inet_ntoa");
ip_address = SvPVbyte(ip_address_sv, addrlen);
if (addrlen == sizeof(addr) || addrlen == 4)
addr.s_addr =
STRLEN addrlen;
char * ip_address;
if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
- croak("Wide character in Socket::pack_sockaddr_in");
+ croak("Wide character in %s", "Socket::pack_sockaddr_in");
ip_address = SvPVbyte(ip_address_sv, addrlen);
if (addrlen == sizeof(addr) || addrlen == 4)
addr.s_addr =
} else if(af == AF_INET6) {
struct_size = sizeof(struct in6_addr);
} else {
- croak("Bad address family for Socket::inet_ntop, got %d, should be either AF_INET or AF_INET6",
+ croak("Bad address family for %s, got %d, should be either AF_INET or AF_INET6",
+ "Socket::inet_ntop",
af);
}
ST(0) = sv_newmortal();
if (ok) {
- sv_setpvn( ST(0), (char *)&ip_address, sizeof ip_address );
+ sv_setpvn( ST(0), (char *)&ip_address,
+ af == AF_INET6 ? sizeof(ip_address) : sizeof(struct in_addr) );
}
#else
ST(0) = (SV *)not_here("inet_pton");
use warnings;
use strict;
-our $VERSION = "0.003";
+our $VERSION = "0.004";
require XSLoader;
XSLoader::load(__PACKAGE__, $VERSION);
(!sv_is_glob(sv) && !sv_is_regexp(sv) && \
(SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK|SVp_IOK|SVp_NOK|SVp_POK)))
-static SV *hintkey_rpn_sv, *hintkey_calcrpn_sv;
+static SV *hintkey_rpn_sv, *hintkey_calcrpn_sv, *hintkey_stufftest_sv;
static int (*next_keyword_plugin)(pTHX_ char *, STRLEN, OP **);
/* low-level parser helpers */
}
#define parse_keyword_calcrpn() THX_parse_keyword_calcrpn(aTHX)
+static OP *THX_parse_keyword_stufftest(pTHX)
+{
+ I32 c;
+ bool do_stuff;
+ lex_read_space(0);
+ do_stuff = lex_peek_unichar(0) == '+';
+ if(do_stuff) {
+ lex_read_unichar(0);
+ lex_read_space(0);
+ }
+ c = lex_peek_unichar(0);
+ if(c == ';') {
+ lex_read_unichar(0);
+ } else if(c != /*{*/'}') {
+ croak("syntax error");
+ }
+ if(do_stuff) lex_stuff_pvn(" ", 1, 0);
+ return newOP(OP_NULL, 0);
+}
+#define parse_keyword_stufftest() THX_parse_keyword_stufftest(aTHX)
+
/* plugin glue */
static int THX_keyword_active(pTHX_ SV *hintkey_sv)
keyword_active(hintkey_calcrpn_sv)) {
*op_ptr = parse_keyword_calcrpn();
return KEYWORD_PLUGIN_STMT;
+ } else if(keyword_len == 9 && strnEQ(keyword_ptr, "stufftest", 9) &&
+ keyword_active(hintkey_stufftest_sv)) {
+ *op_ptr = parse_keyword_stufftest();
+ return KEYWORD_PLUGIN_STMT;
} else {
return next_keyword_plugin(aTHX_
keyword_ptr, keyword_len, op_ptr);
BOOT:
hintkey_rpn_sv = newSVpvs_share("XS::APItest::KeywordRPN/rpn");
hintkey_calcrpn_sv = newSVpvs_share("XS::APItest::KeywordRPN/calcrpn");
+ hintkey_stufftest_sv =
+ newSVpvs_share("XS::APItest::KeywordRPN/stufftest");
next_keyword_plugin = PL_keyword_plugin;
PL_keyword_plugin = my_keyword_plugin;
keyword_enable(hintkey_rpn_sv);
} else if(sv_is_string(item) && strEQ(SvPVX(item), "calcrpn")) {
keyword_enable(hintkey_calcrpn_sv);
+ } else if(sv_is_string(item) &&
+ strEQ(SvPVX(item), "stufftest")) {
+ keyword_enable(hintkey_stufftest_sv);
} else {
croak("\"%s\" is not exported by the %s module",
SvPV_nolen(item), SvPV_nolen(ST(0)));
keyword_disable(hintkey_rpn_sv);
} else if(sv_is_string(item) && strEQ(SvPVX(item), "calcrpn")) {
keyword_disable(hintkey_calcrpn_sv);
+ } else if(sv_is_string(item) &&
+ strEQ(SvPVX(item), "stufftest")) {
+ keyword_disable(hintkey_stufftest_sv);
} else {
croak("\"%s\" is not exported by the %s module",
SvPV_nolen(item), SvPV_nolen(ST(0)));
--- /dev/null
+use warnings;
+use strict;
+
+use Test::More tests => 1;
+ok 1;
+
+use XS::APItest::KeywordRPN qw(stufftest);
+
+# In the buggy case, a syntax error occurs at EOF.
+# Adding a semicolon, any following statements, or anything else
+# causes the bug not to show itself.
+stufftest+;()
my_cxt_getint my_cxt_getsv my_cxt_setint my_cxt_setsv
sv_setsv_cow_hashkey_core sv_setsv_cow_hashkey_notcore
rmagical_cast rmagical_flags
- DPeek utf16_to_utf8 utf16_to_utf8_reversed pmflag my_exit
+ DPeek utf16_to_utf8 utf16_to_utf8_reversed my_exit
+ sv_count
);
-our $VERSION = '0.17';
+our $VERSION = '0.18';
use vars '$WARNINGS_ON_BOOTSTRAP';
use vars map "\$${_}_called_PP", qw(BEGIN UNITCHECK CHECK INIT END);
=head1 ABSTRACT
-This module tests the perl C API. Currently tests that C<printf>
-works correctly.
+This module tests the perl C API. Also exposes various bit of the perl
+internals for the use of core test scripts.
=head1 DESCRIPTION
#include "perl.h"
#include "XSUB.h"
+typedef SV *SVREF;
+typedef PTR_TBL_t *XS__APItest__PtrTable;
/* for my_cxt tests */
=cut
+MODULE = XS::APItest::PtrTable PACKAGE = XS::APItest::PtrTable PREFIX = ptr_table_
+
+void
+ptr_table_new(classname)
+const char * classname
+ PPCODE:
+ PUSHs(sv_setref_pv(sv_newmortal(), classname, (void*)ptr_table_new()));
+
+void
+DESTROY(table)
+XS::APItest::PtrTable table
+ CODE:
+ ptr_table_free(table);
+
+void
+ptr_table_store(table, from, to)
+XS::APItest::PtrTable table
+SVREF from
+SVREF to
+ CODE:
+ ptr_table_store(table, from, to);
+
+UV
+ptr_table_fetch(table, from)
+XS::APItest::PtrTable table
+SVREF from
+ CODE:
+ RETVAL = PTR2UV(ptr_table_fetch(table, from));
+ OUTPUT:
+ RETVAL
+
+void
+ptr_table_split(table)
+XS::APItest::PtrTable table
+
+void
+ptr_table_clear(table)
+XS::APItest::PtrTable table
+
MODULE = XS::APItest PACKAGE = XS::APItest
PROTOTYPES: DISABLE
ST(0) = dest;
XSRETURN(1);
-U32
-pmflag (flag, before = 0)
- int flag
- U32 before
- CODE:
- pmflag(&before, flag);
- RETVAL = before;
- OUTPUT:
- RETVAL
-
void
my_exit(int exitcode)
PPCODE:
my_exit(exitcode);
+
+I32
+sv_count()
+ CODE:
+ RETVAL = PL_sv_count;
+ OUTPUT:
+ RETVAL
use strict;
# Test::More doesn't have fresh_perl_is() yet
-# use Test::More tests => 240;
+# use Test::More tests => 342;
BEGIN {
require '../../t/test.pl';
- plan(240);
+ plan(342);
use_ok('XS::APItest')
};
}
sub d {
- no warnings 'misc'; # keep G_KEEPERR from emitting this as a warning
die "its_dead_jim\n";
}
}
sub Foo::d {
- no warnings 'misc'; # keep G_KEEPERR from emitting this as a warning
die "its_dead_jim\n";
}
? [0] : [ undef, 1 ];
for my $keep (0, G_KEEPERR) {
my $desc = $description . ($keep ? ' G_KEEPERR' : '');
- my $exp_err = $keep ? "before\n\t(in cleanup) its_dead_jim\n"
+ my $exp_warn = $keep ? "\t(in cleanup) its_dead_jim\n" : "";
+ my $exp_err = $keep ? "before\n"
: "its_dead_jim\n";
+ my $warn;
+ local $SIG{__WARN__} = sub { $warn .= $_[0] };
$@ = "before\n";
+ $warn = "";
ok(eq_array( [ call_sv('d', $flags|G_EVAL|$keep, @$args) ],
$returnval),
"$desc G_EVAL call_sv('d')");
is($@, $exp_err, "$desc G_EVAL call_sv('d') - \$@");
+ is($warn, $exp_warn, "$desc G_EVAL call_sv('d') - warning");
$@ = "before\n";
+ $warn = "";
ok(eq_array( [ call_pv('d', $flags|G_EVAL|$keep, @$args) ],
$returnval),
"$desc G_EVAL call_pv('d')");
is($@, $exp_err, "$desc G_EVAL call_pv('d') - \$@");
+ is($warn, $exp_warn, "$desc G_EVAL call_pv('d') - warning");
$@ = "before\n";
+ $warn = "";
ok(eq_array( [ eval_sv('d()', $flags|$keep) ],
$returnval),
"$desc eval_sv('d()')");
is($@, $exp_err, "$desc eval_sv('d()') - \$@");
+ is($warn, $exp_warn, "$desc G_EVAL eval_sv('d') - warning");
$@ = "before\n";
+ $warn = "";
ok(eq_array( [ call_method('d', $flags|G_EVAL|$keep, $obj, @$args) ],
$returnval),
"$desc G_EVAL call_method('d')");
is($@, $exp_err, "$desc G_EVAL call_method('d') - \$@");
+ is($warn, $exp_warn, "$desc G_EVAL call_method('d') - warning");
}
ok(eq_array( [ sub { call_sv('f', $flags|G_NOARGS, "bad") }->(@$args) ],
};
+foreach my $inx ("", "aabbcc\n", [qw(aa bb cc)]) {
+ foreach my $outx ("", "xxyyzz\n", [qw(xx yy zz)]) {
+ my $warn;
+ local $SIG{__WARN__} = sub { $warn .= $_[0] };
+ $@ = $outx;
+ $warn = "";
+ call_sv(sub { die $inx if $inx }, G_VOID|G_EVAL);
+ ok ref($@) eq ref($inx) && $@ eq $inx;
+ $warn =~ s/ at [^\n]*\n\z//;
+ is $warn, "";
+ $@ = $outx;
+ $warn = "";
+ call_sv(sub { die $inx if $inx }, G_VOID|G_EVAL|G_KEEPERR);
+ ok ref($@) eq ref($outx) && $@ eq $outx;
+ $warn =~ s/ at [^\n]*\n\z//;
+ is $warn, $inx ? "\t(in cleanup) $inx" : "";
+ }
+}
+
+{
+ no warnings "misc";
+ my $warn = "";
+ local $SIG{__WARN__} = sub { $warn .= $_[0] };
+ call_sv(sub { die "aa\n" }, G_VOID|G_EVAL|G_KEEPERR);
+ is $warn, "";
+}
+
+{
+ my $warn = "";
+ local $SIG{__WARN__} = sub { $warn .= $_[0] };
+ call_sv(sub { no warnings "misc"; die "aa\n" }, G_VOID|G_EVAL|G_KEEPERR);
+ is $warn, "\t(in cleanup) aa\n";
+}
+
is(eval_pv('f()', 0), 'y', "eval_pv('f()', 0)");
is(eval_pv('f(qw(a b c))', 0), 'y', "eval_pv('f(qw(a b c))', 0)");
is(eval_pv('d()', 0), undef, "eval_pv('d()', 0)");
#!perl
use strict;
-use Test::More 'no_plan';
+use Test::More 'tests' => 2;
-my @warnings;
-$SIG{__WARN__} = sub {
- push @warnings, "@_";
-};
+ok(!eval q{use XS::APItest 'pmflag'; 1}, "Perl_pmflag\(\) removed");
+like($@, qr{\Wpmflag\W\s+is\s+not\s+exported\b}, "pmflag not exported");
-use XS::APItest 'pmflag';
-
-foreach (["\0", 0],
- ['Q', 0],
- ['c', 0x00004000],
- ) {
- my ($char, $val) = @$_;
- my $ord = ord $char;
- foreach my $before (0, 1) {
- my $got = pmflag($ord, $before);
- is($got, $before | $val, "Flag $ord, before $before");
- is(@warnings, 1);
- like($warnings[0],
- qr/^Perl_pmflag\(\) is deprecated, and will be removed from the XS API/);
- @warnings = ();
-
- no warnings 'deprecated';
-
- $got = pmflag($ord, $before);
- is($got, $before | $val, "Flag $ord, before $before");
- is(@warnings, 0);
- @warnings = ();
-
- use warnings;
- $got = pmflag($ord, $before);
- is($got, $before | $val, "Flag $ord, before $before");
- is(@warnings, 1);
- like($warnings[0],
- qr/^Perl_pmflag\(\) is deprecated, and will be removed from the XS API/);
- @warnings = ();
- }
-}
--- /dev/null
+#!perl -w
+use strict;
+
+use XS::APItest;
+use Test::More;
+
+# Some addresses for testing.
+my $a = [];
+my $h = {};
+my $c = sub {};
+
+my $t1 = XS::APItest::PtrTable->new();
+isa_ok($t1, 'XS::APItest::PtrTable');
+my $t2 = XS::APItest::PtrTable->new();
+isa_ok($t2, 'XS::APItest::PtrTable');
+cmp_ok($t1, '!=', $t2, 'Not the same object');
+
+undef $t2;
+
+# Still here? :-)
+isa_ok($t1, 'XS::APItest::PtrTable');
+
+is($t1->fetch($a), 0, 'Not found');
+is($t1->fetch($h), 0, 'Not found');
+is($t1->fetch($c), 0, 'Not found');
+
+$t1->store($a, $h);
+
+cmp_ok($t1->fetch($a), '==', $h, 'Found');
+is($t1->fetch($h), 0, 'Not found');
+is($t1->fetch($c), 0, 'Not found');
+
+$t1->split();
+
+cmp_ok($t1->fetch($a), '==', $h, 'Found');
+is($t1->fetch($h), 0, 'Not found');
+is($t1->fetch($c), 0, 'Not found');
+
+$t1->clear();
+
+is($t1->fetch($a), 0, 'Not found');
+is($t1->fetch($h), 0, 'Not found');
+is($t1->fetch($c), 0, 'Not found');
+
+done_testing();
--- /dev/null
+XS::APItest::PtrTable T_PTROBJ
package re;
-# pragma for controlling the regex engine
+# pragma for controlling the regexp engine
use strict;
use warnings;
-our $VERSION = "0.10";
+our $VERSION = "0.11";
our @ISA = qw(Exporter);
our @EXPORT_OK = ('regmust',
qw(is_regexp regexp_pattern
# the last time it was called.
# install() returns an integer, which if casted properly
- # in C resolves to a structure containing the regex
+ # in C resolves to a structure containing the regexp
# hooks. Setting it to a random integer will guarantee
# segfaults.
$^H{regcomp} = install();
=head2 'taint' mode
When C<use re 'taint'> is in effect, and a tainted string is the target
-of a regex, the regex memories (or values returned by the m// operator
-in list context) are tainted. This feature is useful when regex operations
+of a regexp, the regexp memories (or values returned by the m// operator
+in list context) are tainted. This feature is useful when regexp operations
on tainted data aren't meant to extract safe substrings, but to perform
other transformations.
=head2 'eval' mode
-When C<use re 'eval'> is in effect, a regex is allowed to contain
-C<(?{ ... })> zero-width assertions even if regular expression contains
+When C<use re 'eval'> is in effect, a regexp is allowed to contain
+C<(?{ ... })> zero-width assertions and C<(??{ ... })> postponed
+subexpressions, even if the regular expression contains
variable interpolation. That is normally disallowed, since it is a
potential security risk. Note that this pragma is ignored when the regular
expression is obtained from tainted data, i.e. evaluation is always
-disallowed with tainted regular expressions. See L<perlre/(?{ code })>.
+disallowed with tainted regular expressions. See L<perlre/(?{ code })>
+and L<perlre/(??{ code })>.
For the purpose of this pragma, interpolation of precompiled regular
expressions (i.e., the result of C<qr//>) is I<not> considered variable
/foo${pat}bar/
I<is> allowed if $pat is a precompiled regular expression, even
-if $pat contains C<(?{ ... })> assertions.
+if $pat contains C<(?{ ... })> assertions or C<(??{ ... })> subexpressions.
=head2 'debug' mode
=item OPTIMISEM
Enable enhanced optimisation debugging and start point optimisations.
-Probably not useful except when debugging the regex engine itself.
+Probably not useful except when debugging the regexp engine itself.
=item OFFSETS
my ($pat, $mods) = regexp_pattern($ref);
-In scalar context it returns the same as perl would when strigifying a raw
+In scalar context it returns the same as perl would when stringifying a raw
C<qr//> with the same pattern inside. If the argument is not a compiled
reference then this routine returns false but defined in scalar context,
and the empty list in list context. Thus the following
=item regmust($ref)
If the argument is a compiled regular expression as returned by C<qr//>,
-then this function returns what the optimiser consiers to be the longest
+then this function returns what the optimiser considers to be the longest
anchored fixed string and longest floating fixed string in the pattern.
A I<fixed string> is defined as being a substring that must appear for the
s/\s+$//;
ok( $testout=~/\Q$_\E/, "$_: /$pattern/" )
or do {
- !$diaged++ and diag("$_: /$pattern/\n$testout");
+ !$diaged++ and diag("PATTERN: /$pattern/\n\n"
+ . "EXPECTED:\n$_\n\n"
+ . "WITHIN GOT:\n$testout");
};
}
}
# # 8| W 4 @ 0
# # 9| W 5 @ 0
# # A| W 6 @ 0
+# word_info N:(prev,char)= 1:(0,1) 2:(0,1) 3:(0,1) 4:(0,1) 5:(0,1) 6:(0,1)
# Final program:
-# 1: EXACT <ABC>(3)
-# 3: TRIEC-EXACT<S:4/10 W:6 L:1/1 C:24/7>[A-EGP](20)
+# 1: EXACT <ABC> (3)
+# 3: TRIEC-EXACT<S:4/10 W:6 L:1/1 C:24/7>[A-EGP] (20)
# <P>
# <G>
# <E>
# <B>
# <A>
# <D>
-# 20: END(0)
+# 20: END (0)
# anchored "ABC" at 0 (checking anchored) minlen 4
# Offsets: [20]
# 1:4[3] 3:4[15] 19:32[0] 20:34[0]
# 0 <> <ABCD> | 1:EXACT <ABC>(3)
# 3 <ABC> <D> | 3:TRIEC-EXACT<S:4/10 W:6 L:1/1 C:24/7>[A-EGP](20)
# 3 <ABC> <D> | State: 4 Accepted: 0 Charid: 7 CP: 44 After State: a
-# 4 <ABCD> <> | State: a Accepted: 1 Charid: 6 CP: 0 After State: 0
+# 4 <ABCD> <> | State: a Accepted: 1 Charid: 7 CP: 0 After State: 0
# got 1 possible matches
-# only one match left: #6 <D>
-# 4 <ABCD> <> | 20:END(0)
+# TRIE matched word #6, continuing
+# 4 <ABCD> <> | 20: END(0)
# Match successful!
# %MATCHED%
# Freeing REx: "(?:ABCP|ABCG|ABCE|ABCB|ABCA|ABCD)"
EXACT <ABC>
TRIEC-EXACT
[A-EGP]
-only one match left: #6 <D>
S:4/10
W:6
L:1/1
Perl_mfree
Perl_get_context
Perl_set_context
+Perl_regcurly
Perl_amagic_call
Perl_Gv_AMupdate
Perl_gv_handler
Perl_cast_iv
Perl_cast_uv
Perl_my_chsize
+Perl_croak_sv
Perl_croak
Perl_vcroak
Perl_croak_xs_usage
Perl_debstack
Perl_debstackptrs
Perl_delimcpy
+Perl_die_sv
Perl_die
Perl_dounwind
Perl_do_aexec
Perl_vload_module
Perl_looks_like_number
Perl_grok_bin
+Perl_grok_bslash_c
Perl_grok_hex
Perl_grok_number
Perl_grok_numeric_radix
Perl_grok_oct
Perl_markstack_grow
Perl_mess
+Perl_mess_sv
Perl_vmess
Perl_qerror
Perl_sortsv
Perl_new_stackinfo
Perl_scan_vstring
Perl_scan_version
+Perl_prescan_version
Perl_new_version
Perl_upg_version
Perl_vverify
Perl_require_pv
Perl_pack_cat
Perl_packlist
-Perl_pmflag
Perl_pop_scope
Perl_push_scope
Perl_ref
Perl_sv_2iv
Perl_sv_2iv_flags
Perl_sv_2mortal
-Perl_sv_2nv
+Perl_sv_2nv_flags
Perl_sv_2pv
Perl_sv_2pv_flags
Perl_sv_2pvutf8
Perl_sv_newref
Perl_sv_peek
Perl_sv_pos_u2b
+Perl_sv_pos_u2b_flags
Perl_sv_pos_b2u
Perl_sv_pvn_force
Perl_sv_pvutf8n_force
Perl_vivify_defelem
Perl_seed
Perl_report_uninit
+Perl_warn_sv
Perl_warn
Perl_vwarn
Perl_warner
(sv_type == SVt_PVHV && !GvIMPORTED_HV(*gvp)) )
{
/* diag_listed_as: Variable "%s" is not imported%s */
- Perl_warn(aTHX_ "Variable \"%c%s\" is not imported",
+ Perl_ck_warner_d(
+ aTHX_ packWARN(WARN_MISC),
+ "Variable \"%c%s\" is not imported",
sv_type == SVt_PVAV ? '@' :
sv_type == SVt_PVHV ? '%' : '$',
name);
if (GvCVu(*gvp))
- Perl_warn(aTHX_ "\t(Did you mean &%s instead?)\n", name);
+ Perl_ck_warner_d(
+ aTHX_ packWARN(WARN_MISC),
+ "\t(Did you mean &%s instead?)\n", name
+ );
stash = NULL;
}
}
/* Names of length 1. (Or 0. But name is NUL terminated, so that will
be case '\0' in this switch statement (ie a default case) */
switch (*name) {
- case '&':
- case '`':
- case '\'':
+ case '&': /* $& */
+ case '`': /* $` */
+ case '\'': /* $' */
if (
sv_type == SVt_PVAV ||
sv_type == SVt_PVHV ||
PL_sawampersand = TRUE;
goto magicalize;
- case ':':
+ case ':': /* $: */
sv_setpv(GvSVn(gv),PL_chopset);
goto magicalize;
- case '?':
+ case '?': /* $? */
#ifdef COMPLEX_STATUS
SvUPGRADE(GvSVn(gv), SVt_PVLV);
#endif
goto magicalize;
- case '!':
+ case '!': /* $! */
GvMULTI_on(gv);
/* If %! has been used, automatically load Errno.pm. */
require_tie_mod(gv, "!", newSVpvs("Errno"), "TIEHASH", 1);
break;
- case '-':
- case '+':
+ case '-': /* $- */
+ case '+': /* $+ */
GvMULTI_on(gv); /* no used once warnings here */
{
AV* const av = GvAVn(gv);
break;
}
- case '*':
- case '#':
+ case '*': /* $* */
+ case '#': /* $# */
if (sv_type == SVt_PV)
Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
"$%c is no longer supported", *name);
break;
- case '|':
+ case '|': /* $| */
sv_setiv(GvSVn(gv), (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0);
goto magicalize;
ro_magicalize:
SvREADONLY_on(GvSVn(gv));
/* FALL THROUGH */
- case '0':
- case '1':
- case '2':
- case '3':
- case '4':
- case '5':
- case '6':
- case '7':
- case '8':
- case '9':
- case '[':
- case '^':
- case '~':
- case '=':
- case '%':
- case '.':
- case '(':
- case ')':
- case '<':
- case '>':
- case '\\':
- case '/':
+ case '0': /* $0 */
+ case '1': /* $1 */
+ case '2': /* $2 */
+ case '3': /* $3 */
+ case '4': /* $4 */
+ case '5': /* $5 */
+ case '6': /* $6 */
+ case '7': /* $7 */
+ case '8': /* $8 */
+ case '9': /* $9 */
+ case '[': /* $[ */
+ case '^': /* $^ */
+ case '~': /* $~ */
+ case '=': /* $= */
+ case '%': /* $% */
+ case '.': /* $. */
+ case '(': /* $( */
+ case ')': /* $) */
+ case '<': /* $< */
+ case '>': /* $> */
+ case '\\': /* $\ */
+ case '/': /* $/ */
case '\001': /* $^A */
case '\003': /* $^C */
case '\004': /* $^D */
sv_setpvs(GvSVn(gv),"\f");
PL_formfeed = GvSVn(gv);
break;
- case ';':
+ case ';': /* $; */
sv_setpvs(GvSVn(gv),"\034");
break;
- case ']':
+ case ']': /* $] */
{
SV * const sv = GvSVn(gv);
if (!sv_derived_from(PL_patchlevel, "version"))
void
Perl_gv_efullname4(pTHX_ SV *sv, const GV *gv, const char *prefix, bool keepmain)
{
- const GV * const egv = GvEGV(gv);
+ const GV * const egv = GvEGVx(gv);
PERL_ARGS_ASSERT_GV_EFULLNAME4;
/*
=for apidoc gv_try_downgrade
-If C<gv> is a typeglob containing only a constant sub, and is only
-referenced from its package, and both the typeglob and the sub are
-sufficiently ordinary, replace the typeglob (in the package) with a
-placeholder that more compactly represents the same thing. This is meant
-to be used when a placeholder has been upgraded, most likely because
-something wanted to look at a proper code object, and it has turned out
-to be a constant sub to which a proper reference is no longer required.
+If the typeglob C<gv> can be expressed more succinctly, by having
+something other than a real GV in its place in the stash, replace it
+with the optimised form. Basic requirements for this are that C<gv>
+is a real typeglob, is sufficiently ordinary, and is only referenced
+from its package. This function is meant to be used when a GV has been
+looked up in part to see what was there, causing upgrading, but based
+on what was found it turns out that the real GV isn't required after all.
+
+If C<gv> is a completely empty typeglob, it is deleted from the stash.
+
+If C<gv> is a typeglob containing only a sufficiently-ordinary constant
+sub, the typeglob is replaced with a scalar-reference placeholder that
+more compactly represents the same thing.
=cut
*/
HEK *namehek;
SV **gvp;
PERL_ARGS_ASSERT_GV_TRY_DOWNGRADE;
- if (SvREFCNT(gv) == 1 && SvTYPE(gv) == SVt_PVGV && !SvFAKE(gv) &&
+ if (!(SvREFCNT(gv) == 1 && SvTYPE(gv) == SVt_PVGV && !SvFAKE(gv) &&
!SvOBJECT(gv) && !SvMAGICAL(gv) && !SvREADONLY(gv) &&
isGV_with_GP(gv) && GvGP(gv) &&
- GvMULTI(gv) && !GvINTRO(gv) && GvREFCNT(gv) == 1 &&
+ !GvINTRO(gv) && GvREFCNT(gv) == 1 &&
!GvSV(gv) && !GvAV(gv) && !GvHV(gv) && !GvIOp(gv) && !GvFORM(gv) &&
- GvEGV(gv) == gv && (stash = GvSTASH(gv)) && (cv = GvCV(gv)) &&
+ GvEGVx(gv) == gv && (stash = GvSTASH(gv))))
+ return;
+ cv = GvCV(gv);
+ if (!cv) {
+ HEK *gvnhek = GvNAME_HEK(gv);
+ (void)hv_delete(stash, HEK_KEY(gvnhek),
+ HEK_UTF8(gvnhek) ? -HEK_LEN(gvnhek) : HEK_LEN(gvnhek), G_DISCARD);
+ } else if (GvMULTI(gv) && cv &&
!SvOBJECT(cv) && !SvMAGICAL(cv) && !SvREADONLY(cv) &&
CvSTASH(cv) == stash && CvGV(cv) == gv &&
CvCONST(cv) && !CvMETHOD(cv) && !CvLVALUE(cv) && !CvUNIQUE(cv) &&
#define GvFILEGV(gv) (gv_fetchfile(GvFILE(gv)))
#define GvEGV(gv) (GvGP(gv)->gp_egv)
+#define GvEGVx(gv) (isGV_with_GP(gv) ? GvEGV(gv) : NULL)
#define GvENAME(gv) GvNAME(GvEGV(gv) ? GvEGV(gv) : gv)
#define GvESTASH(gv) GvSTASH(GvEGV(gv) ? GvEGV(gv) : gv)
# define HAS_BOOL 1
#endif
+/* a simple (bool) cast may not do the right thing: if bool is defined
+ * as char for example, then the cast from int is implementation-defined
+ */
+
+#define cBOOL(cbool) ((bool)!!(cbool))
+
/* Try to figure out __func__ or __FUNCTION__ equivalent, if any.
* XXX Should really be a Configure probe, with HAS__FUNCTION__
* and FUNCTION__ as results.
* GMTIME_MAX GMTIME_MIN LOCALTIME_MAX LOCALTIME_MIN
* HAS_CTIME64 HAS_LOCALTIME64 HAS_GMTIME64 HAS_DIFFTIME64
* HAS_MKTIME64 HAS_ASCTIME64 HAS_GETADDRINFO HAS_GETNAMEINFO
- * HAS_INETNTOP HAS_INETPTON
+ * HAS_INETNTOP HAS_INETPTON CHARBITS HAS_PRCTL
* Not (yet) used at top level, but mention them for metaconfig
*/
#endif
#define memEQs(s1, l, s2) \
- (sizeof(s2)-1 == l && memEQ(s1, (s2 ""), (sizeof(s2)-1)))
+ (sizeof(s2)-1 == l && memEQ(s1, ("" s2 ""), (sizeof(s2)-1)))
#define memNEs(s1, l, s2) !memEQs(s1, l, s2)
/*
US-ASCII (Basic Latin) range are viewed as not having any case.
=cut
+
+NOTE: Since some of these are macros, there is no check in those that the
+parameter is a char or U8. This means that if called with a larger width
+parameter, casts can silently truncate and yield wrong results.
+
*/
#define isALNUM(c) (isALPHA(c) || isDIGIT(c) || (c) == '_')
#define isIDFIRST(c) (isALPHA(c) || (c) == '_')
#define isALPHA(c) (isUPPER(c) || isLOWER(c))
+/* ALPHAU includes Unicode semantics for latin1 characters. It has an extra
+ * >= AA test to speed up ASCII-only tests at the expense of the others */
+#define isALPHAU(c) (isALPHA(c) || (NATIVE_TO_UNI((U8) c) >= 0xAA \
+ && ((NATIVE_TO_UNI((U8) c) >= 0xC0 \
+ && NATIVE_TO_UNI((U8) c) != 0xD7 && NATIVE_TO_UNI((U8) c) != 0xF7) \
+ || NATIVE_TO_UNI((U8) c) == 0xAA \
+ || NATIVE_TO_UNI((U8) c) == 0xB5 \
+ || NATIVE_TO_UNI((U8) c) == 0xBA)))
+#define isALNUMU(c) (isDIGIT(c) || isALPHAU(c) || (c) == '_')
+
+/* continuation character for legal NAME in \N{NAME} */
+#define isCHARNAME_CONT(c) (isALNUMU(c) || (c) == ' ' || (c) == '-' || (c) == '(' || (c) == ')' || (c) == ':' || NATIVE_TO_UNI((U8) c) == 0xA0)
#define isSPACE(c) \
((c) == ' ' || (c) == '\t' || (c) == '\n' || (c) =='\r' || (c) == '\f')
#define isPSXSPC(c) (isSPACE(c) || (c) == '\v')
# define isUPPER(c) ((c) >= 'A' && (c) <= 'Z')
# define isLOWER(c) ((c) >= 'a' && (c) <= 'z')
# define isALNUMC(c) (isALPHA(c) || isDIGIT(c))
-# define isASCII(c) ((c) <= 127)
-# define isCNTRL(c) ((c) < ' ' || (c) == 127)
+# define isASCII(c) ((U8) (c) <= 127)
+# define isCNTRL(c) ((U8) (c) < ' ' || (c) == 127)
# define isGRAPH(c) (isALNUM(c) || isPUNCT(c))
# define isPRINT(c) (((c) >= 32 && (c) < 127))
# define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
#define isPSXSPC_LC_utf8(c) (isSPACE_LC_utf8(c) ||(c) == '\f')
#define isBLANK_LC_utf8(c) isBLANK(c) /* could be wrong */
-#ifdef EBCDIC
-# ifdef PERL_IMPLICIT_CONTEXT
-# define toCTRL(c) Perl_ebcdic_control(aTHX_ c)
-# else
-# define toCTRL Perl_ebcdic_control
-# endif
-#else
- /* This conversion works both ways, strangely enough. */
-# define toCTRL(c) (toUPPER(c) ^ 64)
-#endif
+/* This conversion works both ways, strangely enough. On EBCDIC platforms,
+ * CTRL-@ is 0, CTRL-A is 1, etc, just like on ASCII */
+# define toCTRL(c) (toUPPER(NATIVE_TO_UNI(c)) ^ 64)
/* Line numbers are unsigned, 32 bits. */
typedef U32 line_t;
#define NOLINE ((line_t) 4294967295UL)
+/* Helpful alias for version prescan */
+#define is_LAX_VERSION(a,b) \
+ (a != Perl_prescan_version(aTHX_ a, FALSE, b, NULL, NULL, NULL, NULL))
+
+#define is_STRICT_VERSION(a,b) \
+ (a != Perl_prescan_version(aTHX_ a, TRUE, b, NULL, NULL, NULL, NULL))
+
+#define BADVERSION(a,b,c) \
+ if (b) { \
+ *b = c; \
+ } \
+ return a;
/*
=head1 Memory Management
* implementation unless -DPERL_MEM_LOG_NOIMPL is also defined.
*
* Known problems:
- * - all memory allocs do not get logged, only those
+ * - not all memory allocs get logged, only those
* that go through Newx() and derivatives (while all
- * Safefrees do get logged)
+ * Safefrees do get logged)
* - __FILE__ and __LINE__ do not work everywhere
* - __func__ or __FUNCTION__ even less so
* - I think more goes on after the perlio frees but
d_setgrent_r='undef'
d_setpwent_r='undef'
d_srand48_r='undef'
+ d_srandom_r='undef'
d_strerror_r='undef'
ccflags="$ccflags -DNEED_PTHREAD_INIT"
d_flock='undef'
# remove libgdbm from wanted libraries
-# The libgdbm 1.8.3 from the AIX Toolbox is not working
-# (the dbm_store() function is defective)
-libswanted=`echo " $libswanted " | sed -e 's/ gdbm / /'`
-i_gdbm='undef'
-i_gdbmndbm='undef'
-
+# The libgdbm < 1.8.3-5 from the AIX Toolbox is not working
+# because two wrong .h are present
+if [ -f "/opt/freeware/include/gdbm/dbm.h" ] ||
+ [ -f "/opt/freeware/include/gdbm/ndbm.h" ]; then
+ echo "GDBM support disabled because your GDBM package contains extraneous headers - see README.aix."
+ libswanted=`echo " $libswanted " | sed -e 's/ gdbm / /'`
+ i_gdbm='undef'
+ i_gdbmndbm='undef'
+fi
# EOF
# 1506-294 (S) Syntax error in expression on #if directive.
#
case "$osvers" in
- 4.2.1.0) ccflags="$ccflags -D_XOPEN_SOURCE" ;;
- *) ;;
+ 4.2.1.0)
+ ccflags="$ccflags -D_XOPEN_SOURCE"
+ # aix 4.2 does not have IPv6 support
+ d_inetpton='undef'
+ d_inetntop='undef'
+ ;;
esac
nm_opt='-B'
# mkdir -p /opt/perl-catamount
# mkdir -p /opt/perl-catamount/include
# mkdir -p /opt/perl-catamount/lib
-# mkdir -p /opt/perl-catamount/lib/perl5/5.11.3
+# mkdir -p /opt/perl-catamount/lib/perl5/5.13.0
# mkdir -p /opt/perl-catamount/bin
# cp *.h /opt/perl-catamount/include
# cp libperl.a /opt/perl-catamount/lib
-# cp -pr lib/* /opt/perl-catamount/lib/perl5/5.11.3
+# cp -pr lib/* /opt/perl-catamount/lib/perl5/5.13.0
# cp miniperl perl run.sh cc.sh /opt/perl-catamount/lib
#
# With the headers and the libperl.a you can embed Perl to your Catamount
#####################################
prefix=/usr/local
-perlpath="$prefix/bin/perl511"
-startperl="#! $prefix/bin/perl511"
-privlib="$prefix/lib/perl511"
+perlpath="$prefix/bin/perl513"
+startperl="#! $prefix/bin/perl513"
+privlib="$prefix/lib/perl513"
man1dir="$prefix/man/man1"
man3dir="$prefix/man/man3"
-sitearch="$prefix/lib/perl511/$archname"
-sitelib="$prefix/lib/perl511"
+sitearch="$prefix/lib/perl513/$archname"
+sitelib="$prefix/lib/perl513"
#Do not overwrite by default /usr/bin/perl of DG/UX
installusrbinperl="$undef"
# <takis@XFree86.Org>
#####################################
-libperl="libperl511.so"
+libperl="libperl513.so"
# Many functions (eg, gethostent(), killpg(), getpriority(), setruid()
# dbm_*(), and plenty more) are defined in -ldgc. Usually you don't
# DG/UX library!
libswanted="dbm posix resolv socket nsl dl m rte"
archname="ix86-dgux-thread"
- sitearch="$prefix/lib/perl511/$archname"
- sitelib="$prefix/lib/perl511"
+ sitearch="$prefix/lib/perl513/$archname"
+ sitelib="$prefix/lib/perl513"
case "$cc" in
*gcc*)
#### Use GCC -2.95.2/3 rev (DG/UX) and -pthread
lddlflags="-Bshareable $lddlflags"
;;
-*)
+3*|4*|5*|6*)
objformat=`/usr/bin/objformat`
if [ x$objformat = xaout ]; then
if [ -e /usr/lib/aout ]; then
fi
cccdlflags='-DPIC -fPIC'
;;
+*)
+ libpth="/usr/lib /usr/local/lib"
+ glibpth="/usr/lib /usr/local/lib"
+ ldflags="-Wl,-E "
+ lddlflags="-shared "
+ cccdlflags='-DPIC -fPIC'
+ ;;
esac
case "$osvers" in
exit 1
fi
+ if [ $xxOsRev -eq 1100 ]; then
+ # HP-UX 11.00 uses only 48 bits internally in 64bit mode, not 64
+ # force min/max to 2**47-1
+ sGMTIME_max=140737488355327
+ sGMTIME_min=-62167219200
+ sLOCALTIME_max=140737488355327
+ sLOCALTIME_min=-62167219200
+ fi
+
# Set libc and the library paths
case "$archname" in
PA-RISC*)
ldflags="$ldflags -mlp64"
;;
esac
- ;;
+ ;;
esac
;;
esac
;;
*)
- ccflags="$ccflags +DD64"
- ldflags="$ldflags +DD64"
+ case "$use64bitall" in
+ $define|true|[yY]*)
+ ccflags="$ccflags +DD64"
+ ldflags="$ldflags +DD64"
+ ;;
+ esac
;;
esac
d_asctime_r="$undef"
fi
-
# fpclassify () is a macro, the library call is Fpclassify
# Similarly with the others below.
d_fpclassify='define'
HV *
Perl_newHVhv(pTHX_ HV *ohv)
{
+ dVAR;
HV * const hv = newHV();
STRLEN hv_max, hv_fill;
}
}
+/* pp_entereval is aware that labels are stored with a key ':' at the top of
+ the linked list. */
const char *
Perl_fetch_cop_label(pTHX_ struct refcounted_he *const chain, STRLEN *len,
U32 *flags) {
new SV, you should consider using C<newSVhek(HeKEY_hek(he))> as it is more
efficient.
-=for apidoc Am|char*|HeUTF8|HE* he|STRLEN len
+=for apidoc Am|char*|HeUTF8|HE* he
Returns whether the C<char *> value returned by C<HePV> is encoded in UTF-8,
doing any necessary dereferencing of possibly C<SV*> keys. The value returned
will be 0 or non-0, not necessarily 1 (or even a value with any low bits set),
PERLVAR(Icurstash, HV *) /* symbol table for current package */
PERLVAR(Irestartop, OP *) /* propagating an error from croak? */
+PERLVAR(Irestartjmpenv, JMPENV *) /* target frame for longjmp in die */
PERLVAR(Icurcop, COP *)
PERLVAR(Icurstack, AV *) /* THE STACK */
PERLVAR(Icurstackinfo, PERL_SI *) /* current stack + context */
typedef int (*LPGetBufsiz)(struct IPerlStdIO*, FILE*);
typedef int (*LPGetCnt)(struct IPerlStdIO*, FILE*);
typedef STDCHAR* (*LPGetPtr)(struct IPerlStdIO*, FILE*);
-typedef char* (*LPGets)(struct IPerlStdIO*, FILE*, char*, int);
-typedef int (*LPPutc)(struct IPerlStdIO*, FILE*, int);
-typedef int (*LPPuts)(struct IPerlStdIO*, FILE*, const char*);
+typedef char* (*LPGets)(struct IPerlStdIO*, char*, int, FILE*);
+typedef int (*LPPutc)(struct IPerlStdIO*, int, FILE*);
+typedef int (*LPPuts)(struct IPerlStdIO*, const char *, FILE*);
typedef int (*LPFlush)(struct IPerlStdIO*, FILE*);
typedef int (*LPUngetc)(struct IPerlStdIO*, int,FILE*);
typedef int (*LPFileno)(struct IPerlStdIO*, FILE*);
(*PL_StdIO->pGetCnt)(PL_StdIO, (f))
#define PerlSIO_get_ptr(f) \
(*PL_StdIO->pGetPtr)(PL_StdIO, (f))
-#define PerlSIO_fputc(f,c) \
- (*PL_StdIO->pPutc)(PL_StdIO, (f),(c))
-#define PerlSIO_fputs(f,s) \
- (*PL_StdIO->pPuts)(PL_StdIO, (f),(s))
+#define PerlSIO_fputc(c,f) \
+ (*PL_StdIO->pPutc)(PL_StdIO, (c),(f))
+#define PerlSIO_fputs(s,f) \
+ (*PL_StdIO->pPuts)(PL_StdIO, (s),(f))
#define PerlSIO_fflush(f) \
(*PL_StdIO->pFlush)(PL_StdIO, (f))
-#define PerlSIO_fgets(s, n, fp) \
- (*PL_StdIO->pGets)(PL_StdIO, (fp), s, n)
+#define PerlSIO_fgets(s, n, f) \
+ (*PL_StdIO->pGets)(PL_StdIO, s, n, (f))
#define PerlSIO_ungetc(c,f) \
(*PL_StdIO->pUngetc)(PL_StdIO, (c),(f))
#define PerlSIO_fileno(f) \
#define PerlSIO_get_cnt(f) 0
#define PerlSIO_get_ptr(f) NULL
#endif
-#define PerlSIO_fputc(f,c) fputc(c,f)
-#define PerlSIO_fputs(f,s) fputs(s,f)
+#define PerlSIO_fputc(c,f) fputc(c,f)
+#define PerlSIO_fputs(s,f) fputs(s,f)
#define PerlSIO_fflush(f) Fflush(f)
-#define PerlSIO_fgets(s, n, fp) fgets(s,n,fp)
+#define PerlSIO_fgets(s, n, f) fgets(s,n,f)
#if defined(VMS) && defined(__DECC)
/* Unusual definition of ungetc() here to accomodate fast_sv_gets()'
* belief that it can mix getc/ungetc with reads from stdio buffer */
/DB_File.pm
/Data
/Devel/DProf.pm
+/Devel/DProf/
/Devel/InnerPackage.pm
/Devel/PPPort.pm
/Devel/Peek.pm
$^O eq 'os2' || $^O eq 'mint' ||
$^O eq 'cygwin');
-unlink <Op_dbmx*>;
+my $filename = "Any_dbmx$$";
+unlink <"$filename*">;
umask(0);
-ok( tie(%h,AnyDBM_File,'Op_dbmx', O_RDWR|O_CREAT, 0640), "Tie");
+ok( tie(%h,AnyDBM_File,"$filename", O_RDWR|O_CREAT, 0640), "Tie");
-$Dfile = "Op_dbmx.pag";
+$Dfile = "$filename.pag";
if (! -e $Dfile) {
- ($Dfile) = <Op_dbmx*>;
+ ($Dfile) = <$filename*>;
}
SKIP:
delete $h{'goner2'};
untie(%h);
-ok(tie(%h,AnyDBM_File,'Op_dbmx', O_RDWR, 0640),"Re-tie hash");
+ok(tie(%h,AnyDBM_File,"$filename", O_RDWR, 0640),"Re-tie hash");
$h{'j'} = 'J';
$h{'k'} = 'K';
untie %h;
if ($^O eq 'VMS') {
- unlink 'Op_dbmx.sdbm_dir', $Dfile;
+ unlink "$filename.sdbm_dir", $Dfile;
} else {
- unlink 'Op_dbmx.dir', $Dfile;
+ unlink "$filename.dir", $Dfile;
}
{
my $difference = $in_onesec - $estimate;
my $actual = abs ($difference / $in_onesec);
- ok ($actual < $delta, "is $in_onesec within $delta of estimate ($estimate)");
- print "# $in_onesec is between " . ($delta / 2) .
- " and $delta of estimate. Not that safe.\n" if $actual > $delta/2;
+ cmp_ok($actual, '<=', $delta, "is $in_onesec within $delta of estimate ($estimate)")
+ or diag("# $in_onesec is between " . ($delta / 2) . " and $delta of estimate. Not that safe.");
}
# I found that the eval'ed version was 3 times faster than the coderef.
package Carp;
-our $VERSION = '1.14';
+our $VERSION = '1.16';
our $MaxEvalLen = 0;
our $Verbose = 0;
# number of call levels to go back, so calls to longmess were off
# by one. Other code began calling longmess and expecting this
# behaviour, so the replacement has to emulate that behaviour.
- my $call_pack = defined (*CORE::GLOBAL::caller{CODE}) ? *CORE::GLOBAL::caller{CODE}->() : caller();
+ my $call_pack = defined &{"CORE::GLOBAL::caller"} ? &{"CORE::GLOBAL::caller"}() : caller();
if ($Internal{$call_pack} or $CarpInternal{$call_pack}) {
return longmess_heavy(@_);
}
sub shortmess {
# Icky backwards compatibility wrapper. :-(
- local @CARP_NOT = defined (*CORE::GLOBAL::caller{CODE}) ? *CORE::GLOBAL::caller{CODE}->() : caller();
+ local @CARP_NOT = defined &{"CORE::GLOBAL::caller"} ? &{"CORE::GLOBAL::caller"}() : caller();
shortmess_heavy(@_);
};
my %call_info;
@call_info{
qw(pack file line sub has_args wantarray evaltext is_require)
- } = defined (*CORE::GLOBAL::caller::{CODE}) ? *CORE::GLOBAL::{caller}->($i) : caller($i);
+ } = defined &{"CORE::GLOBAL::caller"} ? &{"CORE::GLOBAL::caller"}($i) : caller($i);
unless (defined $call_info{pack}) {
return ();
my $lvl = $CarpLevel;
{
++$i;
- my $pkg = defined (*CORE::GLOBAL::caller{CODE}) ? *CORE::GLOBAL::caller{CODE}->($i) : caller($i);
+ my $pkg = defined &{"CORE::GLOBAL::caller"} ? &{"CORE::GLOBAL::caller"}($i) : caller($i);
unless(defined($pkg)) {
# This *shouldn't* happen.
if (%Internal) {
my $lvl = $CarpLevel;
{
- my $called = defined (*CORE::GLOBAL::caller{CODE}) ? *CORE::GLOBAL::caller{CODE}->($i) : caller($i);
+ my $called = defined &{"CORE::GLOBAL::caller"} ? &{"CORE::GLOBAL::caller"}($i) : caller($i);
$i++;
- my $caller = defined (*CORE::GLOBAL::caller{CODE}) ? *CORE::GLOBAL::caller{CODE}->($i) : caller($i);
+ my $caller = defined &{"CORE::GLOBAL::caller"} ? &{"CORE::GLOBAL::caller"}($i) : caller($i);
return 0 unless defined($caller); # What happened?
redo if $Internal{$caller};
=head2 $Carp::Verbose
-This variable makes C<carp> and C<cluck> generate stack backtraces
+This variable makes C<carp> and C<croak> generate stack backtraces
just like C<cluck> and C<confess>. This is how C<use Carp 'verbose'>
is implemented internally.
require './test.pl';
}
+use warnings;
+no warnings "once";
+
my $Is_VMS = $^O eq 'VMS';
use Carp qw(carp cluck croak confess);
my $warning;
eval {
BEGIN {
- $^W = 1;
local $SIG{__WARN__} =
sub { if( defined $^S ){ warn $_[0] } else { $warning = $_[0] } }
}
# has been compiled
{
my $accum = '';
- local *CORE::GLOBAL::caller = sub { local *__ANON__="fakecaller"; my @c=CORE::caller(@_); $c[0] ||= 'undef'; $accum .= "@c[0..3]\n"; return CORE::caller(($_[0]||0)+1) };
+ local *CORE::GLOBAL::caller = sub {
+ local *__ANON__="fakecaller";
+ my @c=CORE::caller(@_);
+ $c[0] ||= 'undef';
+ $accum .= "@c[0..3]\n";
+ return CORE::caller(($_[0]||0)+1);
+ };
eval "scalar caller()";
like( $accum, qr/main::fakecaller/, "test CORE::GLOBAL::caller override in eval");
$accum = '';
@orig_inc{@orig_inc} = ();
my $failed;
-# This is the order that directories are pushed onto @INC in perl.c:
+# This [used to be] the order that directories are pushed onto @INC in perl.c:
foreach my $lib (qw(applibexp archlibexp privlibexp sitearchexp sitelibexp
- vendorarchexp vendorlibexp vendorlib_stem)) {
+ vendorarchexp vendorlibexp)) {
my $dir = $Config{$lib};
SKIP: {
skip "lib $lib not in \@INC on Win32" if $^O eq 'MSWin32';
if ($#$v >= 0) {
$short = $sp . "0..$#{$v} " .
join(" ",
- map {exists $v->[$_] ? $self->stringify($v->[$_]) : "empty"} ($[..$tArrayDepth)
+ map {exists $v->[$_] ? $self->stringify($v->[$_]) : "empty"} (0..$tArrayDepth)
) . "$shortmore";
} else {
$short = $sp . "empty array";
}
(print "$short\n"), return if length $short <= $self->{compactDump};
}
- for my $num ($[ .. $tArrayDepth) {
+ for my $num (0 .. $tArrayDepth) {
return if $DB::signal and $self->{stopDbSignal};
print "$sp$num ";
if (exists $v->[$num]) {
sub cp;
sub mv;
-$VERSION = '2.16';
+$VERSION = '2.18';
require Exporter;
@ISA = qw(Exporter);
if ($to_a_handle) {
$to_h = $to;
} else {
- $to = _protect($to) if $to =~ /^\s/s;
- $to_h = \do { local *FH };
+ $to_h = \do { local *FH }; # XXX is this line obsolete?
open $to_h, ">", $to or goto fail_open2;
binmode $to_h or die "($!,$^E)";
$closeto = 1;
$perm &= ~06000;
}
- if ($perm & 02000) { # setgid
+ if ($perm & 02000 && $> != 0) { # if not root, setgid
my $ok = $fromstat[5] == $tostat[5]; # group must match
if ($ok) { # and we must be in group
- my $uname = (getpwuid($>))[0] || '';
- my $group = (getpwuid($>))[3];
- $ok = $group && $group == $fromstat[5] ||
- grep { $_ eq $uname }
- split /\s+/, (getgrgid($fromstat[5]))[3];
+ $ok = grep { $_ == $fromstat[5] } split /\s+/, $)
}
$perm &= ~06000 unless $ok;
}
my $TB = Test::More->builder;
-plan tests => 461;
+plan tests => 463;
# We're going to override rename() later on but Perl has to see an override
# at compile time to honor it.
unlink "file-$$" or die $!;
unlink "copy-$$" or die $!;
+
+ # RT #73714 copy to file with leading whitespace failed
+
+ TODO: {
+ local $TODO = 'spaces in filenames require DECC$EFS_CHARSET enabled' if $^O eq 'VMS';
+ open(F, ">file-$$") or die $!;
+ close F;
+ copy "file-$$", " copy-$$";
+ ok -e " copy-$$", "copy with leading whitespace";
+ unlink "file-$$" or die "unlink: $!";
+ unlink " copy-$$" or die "unlink: $!";
+ }
}
=cut
-our $VERSION = '1.03';
+our $VERSION = '1.04';
require Exporter;
chmod File changes the permissions on a list of files
chomp String remove a trailing record separator from a string
chop String remove the last character from a string
-chown File change the owership on a list of files
+chown File change the ownership on a list of files
chr String get character this number represents
chroot File make directory new root for path lookups
close I/O close file (or pipe or socket) handle
lc String return lower-case version of a string
lcfirst String return a string with just the next letter in lower case
length String return the number of bytes in a string
-link File create a hard link in the filesytem
+link File create a hard link in the filesystem
listen Socket register your socket as a server
local Misc,Namespace create a temporary value for a global variable (dynamic scoping)
localtime Time convert UNIX time into record or string using local time
stat File get a file's status information
study Regexp optimize input data for repeated searches
sub Flow declare a subroutine, possibly anonymously
-substr String get or alter a portion of a stirng
+substr String get or alter a portion of a string
symlink File create a symbolic link to a file
syscall I/O,Binary execute an arbitrary system call
sysopen File open a file, pipe, or descriptor
(Note that processing of C<PERL_RL> for ornaments is in the discretion of the
particular used C<Term::ReadLine::*> package).
-=head1 CAVEATS
-
-It seems that using Term::ReadLine from Emacs minibuffer doesn't work
-quite right and one will get an error message like
-
- Cannot open /dev/tty for read at ...
-
-One possible workaround for this is to explicitly open /dev/tty like this
-
- open (FH, "/dev/tty" )
- or eval 'sub Term::ReadLine::findConsole { ("&STDIN", "&STDERR") }';
- die $@ if $@;
- close (FH);
-
-or you can try using the 4-argument form of Term::ReadLine->new().
-
=cut
use strict;
$consoleOUT = $console unless defined $consoleOUT;
$console = "&STDIN" unless defined $console;
+ if ($console eq "/dev/tty" && !open(my $fh, "<", $console)) {
+ $console = "&STDIN";
+ undef($consoleOUT);
+ }
if (!defined $consoleOUT) {
$consoleOUT = defined fileno(STDERR) && $^O ne 'MSWin32' ? "&STDERR" : "&STDOUT";
}
package Tie::Scalar;
-our $VERSION = '1.01';
+our $VERSION = '1.02';
=head1 NAME
=back
+=head2 Tie::Scalar vs Tie::StdScalar
+
+C<< Tie::Scalar >> provides all the necessary methods, but one should realize
+they do not do anything useful. Calling C<< Tie::Scalar::FETCH >> or
+C<< Tie::Scalar::STORE >> results in a (trappable) croak. And if you inherit
+from C<< Tie::Scalar >>, you I<must> provide either a C<< new >> or a
+C<< TIESCALAR >> method.
+
+If you are looking for a class that does everything for you you don't
+define yourself, use the C<< Tie::StdScalar >> class, not the
+C<< Tie::Scalar >> one.
+
=head1 MORE INFORMATION
The L<perltie> section uses a good example of tying scalars by associating
sub TIESCALAR {
my $pkg = shift;
- if ($pkg->can('new') and $pkg ne __PACKAGE__) {
- warnings::warnif("WARNING: calling ${pkg}->new since ${pkg}->TIESCALAR is missing");
- $pkg->new(@_);
+ my $pkg_new = $pkg -> can ('new');
+
+ if ($pkg_new and $pkg ne __PACKAGE__) {
+ my $my_new = __PACKAGE__ -> can ('new');
+ if ($pkg_new == $my_new) {
+ #
+ # Prevent recursion
+ #
+ croak "$pkg must define either a TIESCALAR() or a new() method";
+ }
+
+ warnings::warnif ("WARNING: calling ${pkg}->new since " .
+ "${pkg}->TIESCALAR is missing");
+ $pkg -> new (@_);
}
else {
croak "$pkg doesn't define a TIESCALAR method";
package main;
use vars qw( $flag );
-use Test::More tests => 13;
+use Test::More tests => 16;
use_ok( 'Tie::Scalar' );
sub DESTROY {
$main::flag = 1;
}
+
+
+#
+# Bug #72878: don't recurse forever if both new and TIESCALAR are missing.
+#
+package main;
+
+@NoMethods::ISA = qw [Tie::Scalar];
+
+{
+ #
+ # Without the fix for #72878, the code runs forever.
+ # Trap this, and die if with an appropriate message if this happens.
+ #
+ local $SIG {__WARN__} = sub {
+ die "Called NoMethods->new"
+ if $_ [0] =~ /^WARNING: calling NoMethods->new/;
+ };
+
+ eval {tie my $foo => "NoMethods";};
+
+ like $@ =>
+ qr /\QNoMethods must define either a TIESCALAR() or a new() method/,
+ "croaks if both new() and TIESCALAR() are missing";
+};
+
+#
+# Don't croak on missing new/TIESCALAR if you're inheriting one.
+#
+my $called1 = 0;
+my $called2 = 0;
+
+sub HasMethod1::new {$called1 ++}
+ @HasMethod1::ISA = qw [Tie::Scalar];
+ @InheritHasMethod1::ISA = qw [HasMethod1];
+
+sub HasMethod2::TIESCALAR {$called2 ++}
+ @HasMethod2::ISA = qw [Tie::Scalar];
+ @InheritHasMethod2::ISA = qw [HasMethod2];
+
+my $r1 = eval {tie my $foo => "InheritHasMethod1"; 1};
+my $r2 = eval {tie my $foo => "InheritHasMethod2"; 1};
+
+ok $r1 && $called1, "inheriting new() does not croak";
+ok $r2 && $called2, "inheriting TIESCALAR() does not croak";
my(@times, @methods);
BEGIN {
- @times = (-2**62, -2**50, -2**33, -2**31-1, -1, 0, 1, 2**31-1, 2**33, 2**50, 2**62, time);
+ @times = (-2**55, -2**50, -2**33, -2**31-1, -1, 0, 1, 2**31-1, 2**33, 2**50, 2**55, time);
@methods = qw(sec min hour mday mon year wday yday isdst);
- plan tests => (@times * @methods) + 1;
+ plan tests => (@times * (@methods + 1)) + 1;
use_ok Time::gmtime;
}
my $gmtime = gmtime $time; # This is the OO gmtime.
my @gmtime = CORE::gmtime $time; # This is the gmtime function
+ is @gmtime, 9, "gmtime($time)";
for my $method (@methods) {
is $gmtime->$method, shift @gmtime, "gmtime($time)->$method";
}
my(@times, @methods);
BEGIN {
- @times = (-2**62, -2**50, -2**33, -2**31-1, -1, 0, 1, 2**31-1, 2**33, 2**50, 2**62, time);
+ @times = (-2**55, -2**50, -2**33, -2**31-1, -1, 0, 1, 2**31-1, 2**33, 2**50, 2**55, time);
@methods = qw(sec min hour mday mon year wday yday isdst);
- plan tests => (@times * @methods) + 1;
+ plan tests => (@times * (@methods + 1)) + 1;
use_ok Time::localtime;
}
my $localtime = localtime $time; # This is the OO localtime.
my @localtime = CORE::localtime $time; # This is the localtime function
+ is @localtime, 9, "localtime($time)";
for my $method (@methods) {
is $localtime->$method, shift @localtime, "localtime($time)->$method";
}
C<VERSION> will return the value of the variable C<$VERSION> in the
package the object is blessed into. If C<REQUIRE> is given then
it will do a comparison and die if the package version is not
-greater than or equal to C<REQUIRE>.
+greater than or equal to C<REQUIRE>. Both C<$VERSION> or C<REQUIRE>
+must be "lax" version numbers (as defined by the L<version> module)
+or C<VERSION> will die with an error.
C<VERSION> can be called as either a class (static) method or an object
method.
use strict;
use warnings;
-our $VERSION = '0.27';
+our $VERSION = '0.28';
use Storable qw(dclone);
=cut
-# NB: This function is duplicated in charnames.pm
+# NB: This function is nearly duplicated in charnames.pm
sub _getcode {
my $arg = shift;
use Unicode::UCD;
use Test::More;
-BEGIN { plan tests => 239 };
+BEGIN { plan tests => 256 };
use Unicode::UCD 'charinfo';
my $charinfo;
+$charinfo = charinfo(0); # Null is often problematic, so test it.
+
+is($charinfo->{code}, '0000', '<control>');
+is($charinfo->{name}, '<control>');
+is($charinfo->{category}, 'Cc');
+is($charinfo->{combining}, '0');
+is($charinfo->{bidi}, 'BN');
+is($charinfo->{decomposition}, '');
+is($charinfo->{decimal}, '');
+is($charinfo->{digit}, '');
+is($charinfo->{numeric}, '');
+is($charinfo->{mirrored}, 'N');
+is($charinfo->{unicode10}, 'NULL');
+is($charinfo->{comment}, '');
+is($charinfo->{upper}, '');
+is($charinfo->{lower}, '');
+is($charinfo->{title}, '');
+is($charinfo->{block}, 'Basic Latin');
+is($charinfo->{script}, 'Common');
+
$charinfo = charinfo(0x41);
is($charinfo->{code}, '0041', 'LATIN CAPITAL LETTER A');
package abbrev;
-warn( "The 'abbrev.pl' legacy library is deprecated and will be"
- . " removed in the next major release of perl. Please use the"
- . " Text::Abbrev module instead." );
-
sub main'abbrev {
local(*domain) = @_;
shift(@_);
@cmp = @_;
- local($[) = 0;
foreach $name (@_) {
@extra = split(//,$name);
$abbrev = shift(@extra);
+#
+# This library is no longer being maintained, and is included for backward
+# compatibility with Perl 4 programs which may require it.
+# This legacy library is deprecated and will be removed in a future
+# release of perl.
+#
# assert.pl
# tchrist@convex.com (Tom Christiansen)
#
# be printed out by &panic, which is just the stack-backtrace
# routine shamelessly borrowed from the perl debugger.
-warn( "The 'assert.pl' legacy library is deprecated and will be"
- . " removed in the next major release of perl." );
-
sub assert {
- &panic("ASSERTION BOTCHED: $_[$[]",$@) unless eval $_[$[];
+ &panic("ASSERTION BOTCHED: $_[0]",$@) unless eval $_[0];
}
sub panic {
#
# Suggested alternative: Math::BigFloat
-warn( "The 'bigfloat.pl' legacy library is deprecated and will be"
- . " removed in the next major release of perl. Please use the"
- . " Math::BigFloat module instead." );
-
# Arbitrary length float math package
#
# by Mark Biggar
# negation
sub main'fneg { #(fnum_str) return fnum_str
- local($_) = &'fnorm($_[$[]);
+ local($_) = &'fnorm($_[0]);
vec($_,0,8) ^= ord('+') ^ ord('-') unless $_ eq '+0E+0'; # flip sign
if ( ord("\t") == 9 ) { # ascii
s/^H/N/;
# absolute value
sub main'fabs { #(fnum_str) return fnum_str
- local($_) = &'fnorm($_[$[]);
+ local($_) = &'fnorm($_[0]);
s/^-/+/; # mash sign
$_;
}
# multiplication
sub main'fmul { #(fnum_str, fnum_str) return fnum_str
- local($x,$y) = (&'fnorm($_[$[]),&'fnorm($_[$[+1]));
+ local($x,$y) = (&'fnorm($_[0]),&'fnorm($_[1]));
if ($x eq 'NaN' || $y eq 'NaN') {
'NaN';
} else {
\f
# addition
sub main'fadd { #(fnum_str, fnum_str) return fnum_str
- local($x,$y) = (&'fnorm($_[$[]),&'fnorm($_[$[+1]));
+ local($x,$y) = (&'fnorm($_[0]),&'fnorm($_[1]));
if ($x eq 'NaN' || $y eq 'NaN') {
'NaN';
} else {
# subtraction
sub main'fsub { #(fnum_str, fnum_str) return fnum_str
- &'fadd($_[$[],&'fneg($_[$[+1]));
+ &'fadd($_[0],&'fneg($_[1]));
}
# division
# result has at most max(scale, length(dividend), length(divisor)) digits
sub main'fdiv #(fnum_str, fnum_str[,scale]) return fnum_str
{
- local($x,$y,$scale) = (&'fnorm($_[$[]),&'fnorm($_[$[+1]),$_[$[+2]);
+ local($x,$y,$scale) = (&'fnorm($_[0]),&'fnorm($_[1]),$_[2]);
if ($x eq 'NaN' || $y eq 'NaN' || $y eq '+0E+0') {
'NaN';
} else {
if ( $cmp < 0 ||
($cmp == 0 &&
( $rnd_mode eq 'zero' ||
- ($rnd_mode eq '-inf' && (substr($q,$[,1) eq '+')) ||
- ($rnd_mode eq '+inf' && (substr($q,$[,1) eq '-')) ||
+ ($rnd_mode eq '-inf' && (substr($q,0,1) eq '+')) ||
+ ($rnd_mode eq '+inf' && (substr($q,0,1) eq '-')) ||
($rnd_mode eq 'even' && $q =~ /[24680]$/) ||
($rnd_mode eq 'odd' && $q =~ /[13579]$/) )) ) {
$q; # round down
} else {
- &'badd($q, ((substr($q,$[,1) eq '-') ? '-1' : '+1'));
+ &'badd($q, ((substr($q,0,1) eq '-') ? '-1' : '+1'));
# round up
}
}
# round the mantissa of $x to $scale digits
sub main'fround { #(fnum_str, scale) return fnum_str
- local($x,$scale) = (&'fnorm($_[$[]),$_[$[+1]);
+ local($x,$scale) = (&'fnorm($_[0]),$_[1]);
if ($x eq 'NaN' || $scale <= 0) {
$x;
} else {
if (length($xm)-1 <= $scale) {
$x;
} else {
- &norm(&round(substr($xm,$[,$scale+1),
- "+0".substr($xm,$[+$scale+1,1),"+10"),
+ &norm(&round(substr($xm,0,$scale+1),
+ "+0".substr($xm,$scale+1,1),"+10"),
$xe+length($xm)-$scale-1);
}
}
\f
# round $x at the 10 to the $scale digit place
sub main'ffround { #(fnum_str, scale) return fnum_str
- local($x,$scale) = (&'fnorm($_[$[]),$_[$[+1]);
+ local($x,$scale) = (&'fnorm($_[0]),$_[1]);
if ($x eq 'NaN') {
'NaN';
} else {
# we'll pass a non-normalized "-0" to &round when rounding
# -0.006 (for example), purely so that &round won't lose
# the sign.
- &norm(&round(substr($xm,$[,1).'0',
- "+0".substr($xm,$[+1,1),"+10"), $scale);
+ &norm(&round(substr($xm,0,1).'0',
+ "+0".substr($xm,1,1),"+10"), $scale);
} else {
- &norm(&round(substr($xm,$[,$xe),
- "+0".substr($xm,$[+$xe,1),"+10"), $scale);
+ &norm(&round(substr($xm,0,$xe),
+ "+0".substr($xm,$xe,1),"+10"), $scale);
}
}
}
# returns undef if either or both input value are not numbers
sub main'fcmp #(fnum_str, fnum_str) return cond_code
{
- local($x, $y) = (&'fnorm($_[$[]),&'fnorm($_[$[+1]));
+ local($x, $y) = (&'fnorm($_[0]),&'fnorm($_[1]));
if ($x eq "NaN" || $y eq "NaN") {
undef;
} else {
ord($y) <=> ord($x)
||
( local($xm,$xe,$ym,$ye) = split('E', $x."E$y"),
- (($xe <=> $ye) * (substr($x,$[,1).'1')
+ (($xe <=> $ye) * (substr($x,0,1).'1')
|| &bigint'cmp($xm,$ym))
);
}
\f
# square root by Newtons method.
sub main'fsqrt { #(fnum_str[, scale]) return fnum_str
- local($x, $scale) = (&'fnorm($_[$[]), $_[$[+1]);
+ local($x, $scale) = (&'fnorm($_[0]), $_[1]);
if ($x eq 'NaN' || $x =~ /^-/) {
'NaN';
} elsif ($x eq '+0E+0') {
#
# Suggested alternative: Math::BigInt
-warn( "The 'bigint.pl' legacy library is deprecated and will be"
- . " removed in the next major release of perl. Please use the"
- . " Math::BigInt module instead." );
-
# arbitrary size integer math package
#
# by Mark Biggar
local($_) = @_;
s/\s+//g; # strip white space
if (s/^([+-]?)0*(\d+)$/$1$2/) { # test if number
- substr($_,$[,0) = '+' unless $1; # Add missing sign
+ substr($_,0,0) = '+' unless $1; # Add missing sign
s/^-0/+0/;
$_;
} else {
# Assumes normalized value as input.
sub internal { #(num_str) return int_num_array
local($d) = @_;
- ($is,$il) = (substr($d,$[,1),length($d)-2);
- substr($d,$[,1) = '';
+ ($is,$il) = (substr($d,0,1),length($d)-2);
+ substr($d,0,1) = '';
($is, reverse(unpack("a" . ($il%5+1) . ("a5" x ($il/5)), $d)));
}
\f
# Compares 2 values. Returns one of undef, <0, =0, >0. (suitable for sort)
sub main'bcmp { #(num_str, num_str) return cond_code
- local($x,$y) = (&'bnorm($_[$[]),&'bnorm($_[$[+1]));
+ local($x,$y) = (&'bnorm($_[0]),&'bnorm($_[1]));
if ($x eq 'NaN') {
undef;
} elsif ($y eq 'NaN') {
}
sub main'badd { #(num_str, num_str) return num_str
- local(*x, *y); ($x, $y) = (&'bnorm($_[$[]),&'bnorm($_[$[+1]));
+ local(*x, *y); ($x, $y) = (&'bnorm($_[0]),&'bnorm($_[1]));
if ($x eq 'NaN') {
'NaN';
} elsif ($y eq 'NaN') {
}
sub main'bsub { #(num_str, num_str) return num_str
- &'badd($_[$[],&'bneg($_[$[+1]));
+ &'badd($_[0],&'bneg($_[1]));
}
# GCD -- Euclids algorithm Knuth Vol 2 pg 296
sub main'bgcd { #(num_str, num_str) return num_str
- local($x,$y) = (&'bnorm($_[$[]),&'bnorm($_[$[+1]));
+ local($x,$y) = (&'bnorm($_[0]),&'bnorm($_[1]));
if ($x eq 'NaN' || $y eq 'NaN') {
'NaN';
} else {
# multiply two numbers -- stolen from Knuth Vol 2 pg 233
sub main'bmul { #(num_str, num_str) return num_str
- local(*x, *y); ($x, $y) = (&'bnorm($_[$[]), &'bnorm($_[$[+1]));
+ local(*x, *y); ($x, $y) = (&'bnorm($_[0]), &'bnorm($_[1]));
if ($x eq 'NaN') {
'NaN';
} elsif ($y eq 'NaN') {
local($signr) = (shift @x ne shift @y) ? '-' : '+';
@prod = ();
for $x (@x) {
- ($car, $cty) = (0, $[);
+ ($car, $cty) = (0, 0);
for $y (@y) {
$prod = $x * $y + $prod[$cty] + $car;
if ($use_mult) {
# modulus
sub main'bmod { #(num_str, num_str) return num_str
- (&'bdiv(@_))[$[+1];
+ (&'bdiv(@_))[1];
}
\f
sub main'bdiv { #(dividend: num_str, divisor: num_str) return num_str
- local (*x, *y); ($x, $y) = (&'bnorm($_[$[]), &'bnorm($_[$[+1]));
+ local (*x, *y); ($x, $y) = (&'bnorm($_[0]), &'bnorm($_[1]));
return wantarray ? ('NaN','NaN') : 'NaN'
if ($x eq 'NaN' || $y eq 'NaN' || $y eq '+0');
return wantarray ? ('+0',$x) : '+0' if (&cmp(&abs($x),&abs($y)) < 0);
@x = &internal($x); @y = &internal($y);
- $srem = $y[$[];
+ $srem = $y[0];
$sr = (shift @x ne shift @y) ? '-' : '+';
$car = $bar = $prd = 0;
if (($dd = int(1e5/($y[$#y]+1))) != 1) {
--$q while ($v2*$q > ($u0*1e5+$u1-$q*$v1)*1e5+$u2);
if ($q) {
($car, $bar) = (0,0);
- for ($y = $[, $x = $#x-$#y+$[-1; $y <= $#y; ++$y,++$x) {
+ for ($y = 0, $x = $#x-$#y-1; $y <= $#y; ++$y,++$x) {
$prd = $q * $y[$y] + $car;
if ($use_mult) {
$prd -= ($car = int($prd * 1e-5)) * 1e5;
}
if ($x[$#x] < $car + $bar) {
$car = 0; --$q;
- for ($y = $[, $x = $#x-$#y+$[-1; $y <= $#y; ++$y,++$x) {
+ for ($y = 0, $x = $#x-$#y-1; $y <= $#y; ++$y,++$x) {
$x[$x] -= 1e5
if ($car = (($x[$x] += $y[$y] + $car) > 1e5));
}
#
# Arbitrary size rational math package
-warn( "The 'bigrat.pl' legacy library is deprecated and will be"
- . " removed in the next major release of perl. Please use the"
- . " bigrat module instead." );
-
# by Mark Biggar
#
# Input values to these routines consist of strings of the form
$num = &'bnorm($num);
$dom = &'bnorm($dom);
}
- substr($dom,$[,1) = '';
+ substr($dom,0,1) = '';
"$num/$dom";
}
}
# absolute value
sub main'rabs { #(rat_num) return $rat_num
local($_) = &'rnorm(@_);
- substr($_,$[,1) = '+' unless $_ eq 'NaN';
+ substr($_,0,1) = '+' unless $_ eq 'NaN';
$_;
}
# multipication
sub main'rmul { #(rat_num, rat_num) return rat_num
- local($xn,$xd) = split('/',&'rnorm($_[$[]));
- local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
+ local($xn,$xd) = split('/',&'rnorm($_[0]));
+ local($yn,$yd) = split('/',&'rnorm($_[1]));
&norm(&'bmul($xn,$yn),&'bmul($xd,$yd));
}
# division
sub main'rdiv { #(rat_num, rat_num) return rat_num
- local($xn,$xd) = split('/',&'rnorm($_[$[]));
- local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
+ local($xn,$xd) = split('/',&'rnorm($_[0]));
+ local($yn,$yd) = split('/',&'rnorm($_[1]));
&norm(&'bmul($xn,$yd),&'bmul($xd,$yn));
}
\f
# addition
sub main'radd { #(rat_num, rat_num) return rat_num
- local($xn,$xd) = split('/',&'rnorm($_[$[]));
- local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
+ local($xn,$xd) = split('/',&'rnorm($_[0]));
+ local($yn,$yd) = split('/',&'rnorm($_[1]));
&norm(&'badd(&'bmul($xn,$yd),&'bmul($yn,$xd)),&'bmul($xd,$yd));
}
# subtraction
sub main'rsub { #(rat_num, rat_num) return rat_num
- local($xn,$xd) = split('/',&'rnorm($_[$[]));
- local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
+ local($xn,$xd) = split('/',&'rnorm($_[0]));
+ local($yn,$yd) = split('/',&'rnorm($_[1]));
&norm(&'bsub(&'bmul($xn,$yd),&'bmul($yn,$xd)),&'bmul($xd,$yd));
}
# comparison
sub main'rcmp { #(rat_num, rat_num) return cond_code
- local($xn,$xd) = split('/',&'rnorm($_[$[]));
- local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
+ local($xn,$xd) = split('/',&'rnorm($_[0]));
+ local($yn,$yd) = split('/',&'rnorm($_[1]));
&bigint'cmp(&'bmul($xn,$yd),&'bmul($yn,$xd));
}
# square root by Newtons method.
# cycles specifies the number of iterations default: 5
sub main'rsqrt { #(fnum_str[, cycles]) return fnum_str
- local($x, $scale) = (&'rnorm($_[$[]), $_[$[+1]);
+ local($x, $scale) = (&'rnorm($_[0]), $_[1]);
if ($x eq 'NaN') {
'NaN';
} elsif ($x =~ /^-/) {
package bytes;
-our $VERSION = '1.03';
+our $VERSION = '1.04';
$bytes::hint_bits = 0x00000008;
bytes - Perl pragma to force byte semantics rather than character semantics
+=head1 NOTICE
+
+This pragma reflects early attempts to incorporate Unicode into perl and
+has since been superseded. It breaks encapsulation (i.e. it exposes the
+innards of how the perl executable currently happens to store a string),
+and use of this module for anything other than debugging purposes is
+strongly discouraged. If you feel that the functions here within might be
+useful for your application, this possibly indicates a mismatch between
+your mental model of Perl Unicode and the current reality. In that case,
+you may wish to read some of the perl Unicode documentation:
+L<perluniintro>, L<perlunitut>, L<perlunifaq> and L<perlunicode>.
+
=head1 SYNOPSIS
use bytes;
#
# Suggested alternative: FileCache
-warn( "The 'cacheout.pl' legacy library is deprecated and will be"
- . " removed in the next major release of perl. Please use the"
- . " FileCache module instead." );
-
# Open in their package.
sub cacheout'open {
use strict;
use warnings;
use File::Spec;
-our $VERSION = '1.07';
+our $VERSION = '1.08';
use bytes (); # for $bytes::hint_bits
my $arg = shift;
- # this comes actually from Unicode::UCD, where it is the named
- # function _getcode (), but it avoids the overhead of loading it
+ # this is derived from Unicode::UCD, where it is nearly the same as the
+ # function _getcode(), but it makes sure that even a hex argument has the
+ # proper number of leading zeros, which is critical in matching against $txt
+ # below
my $hex;
if ($arg =~ /^[1-9]\d*$/) {
$hex = sprintf "%04X", $arg;
} elsif ($arg =~ /^(?:[Uu]\+|0[xX])?([[:xdigit:]]+)$/) {
- $hex = $1;
+ # Below is the line that differs from the _getcode() source
+ $hex = sprintf "%04X", hex $arg;
} else {
carp("unexpected arg \"$arg\" to charnames::viacode()");
return;
$txt = do "unicore/Name.pl" unless $txt;
my $pos = index $txt, "\t\t$arg\n";
- if ($[ <= $pos) {
+ if (0 <= $pos) {
my $posLF = rindex $txt, "\n", $pos;
(my $code = substr $txt, $posLF + 1, 6) =~ tr/\t//d;
return $vianame{$arg} = CORE::hex $code;
- # If $pos is at the 1st line, $posLF must be $[ - 1 (not found);
- # then $posLF + 1 equals to $[ (at the beginning of $txt).
+ # If $pos is at the 1st line, $posLF must be -1 (not found);
+ # then $posLF + 1 equals to 0 (at the beginning of $txt).
# Otherwise $posLF is the position of "\n";
# then $posLF + 1 must be the position of the next to "\n"
# (the beginning of the line).
=head1 CUSTOM ALIASES
This version of charnames supports three mechanisms of adding local
-or customized aliases to standard Unicode naming conventions (:full)
+or customized aliases to standard Unicode naming conventions (:full).
+
+Note that an alias should not be something that is a legal curly
+brace-enclosed quantifier (see L<perlreref/QUANTIFIERS>). For example
+C<\N{123}> means to match 123 non-newline characters, and is not treated as an
+alias. Aliases are discouraged from beginning with anything other than an
+alphabetic character and from containing anything other than alphanumerics,
+spaces, dashes, colons, parentheses, and underscores. Currently they must be
+ASCII.
=head2 Anonymous hashes
}
}
+See L</CUSTOM ALIASES> above for restrictions on C<CHARNAME>.
+
=head1 ILLEGAL CHARACTERS
-If you ask by name for a character that does not exist, a warning is
-given and the Unicode I<replacement character> "\x{FFFD}" is returned.
+If you ask by name for a character that does not exist, a warning is given and
+the Unicode I<replacement character> "\x{FFFD}" is returned.
-If you ask by code for a character that does not exist, no warning is
+If you ask by code for a character that is unassigned, no warning is
given and C<undef> is returned. (Though if you ask for a code point
-past U+10FFFF you do get a warning.)
+past U+10FFFF you do get a warning.) See L</BUGS> below.
=head1 BUGS
+viacode should return an empty string for unassigned in-range Unicode code
+points, as that is their correct current name.
+
+viacode(0) doesn't return C<NULL>, but C<undef>
+
+vianame returns a chr if the input name is of the form C<U+...>, and an ord
+otherwise. It is planned to change this to always return an ord.
+
+None of the functions work on almost all the Hangul syllable and CJK Unicode
+characters that have their code points as part of their names.
+
+Names must be ASCII characters only.
+
Unicode standard named sequences are not recognized, such as
C<LATIN CAPITAL LETTER A WITH MACRON AND GRAVE>
(which should mean C<LATIN CAPITAL LETTER A WITH MACRON> with an additional
C<COMBINING GRAVE ACCENT>).
-Since evaluation of the translation function happens in a middle of
+Since evaluation of the translation function happens in the middle of
compilation (of a string literal), the translation function should not
do any C<eval>s or C<require>s. This restriction should be lifted in
a future version of Perl.
$| = 1;
-print "1..79\n";
+print "1..81\n";
use charnames ':full';
print "not " if grep { /you asked for U+110000/ } @WARN;
print "ok 46\n";
+print "not " unless "NULL" eq charnames::viacode(0);
+print "ok 47\n";
+
# ---- Alias extensions
@prgs = split "\n########\n", <DATA>;
}
-my $i = 46;
+my $i = 47;
for (@prgs) {
my ($code, $exp) = ((split m/\nEXPECT\n/), '$');
my ($prog, $fil) = ((split m/\nFILE\n/, $code), "");
$_ = 'foobar';
eval "use charnames ':full';";
print "not " unless $_ eq 'foobar';
-print "ok 74\n";
+print "ok 75\n";
# Unicode slowdown noted by Phil Pennock, traced to a bug fix in index
# SADAHIRO Tomoyuki's suggestion is to ensure that the UTF-8ness of both
# (or at least should be). So assert that that it's true here.
my $names = do "unicore/Name.pl";
-print defined $names ? "ok 75\n" : "not ok 75\n";
+print defined $names ? "ok 76\n" : "not ok 76\n";
if (ord('A') == 65) { # as on ASCII or UTF-8 machines
my $non_ascii = $names =~ tr/\0-\177//c;
- print $non_ascii ? "not ok 76 # $non_ascii\n" : "ok 76\n";
+ print $non_ascii ? "not ok 77 # $non_ascii\n" : "ok 77\n";
} else {
- print "ok 76\n";
+ print "ok 77\n";
}
# Verify that charnames propagate to eval("")
my $evaltry = eval q[ "Eval: \N{LEFT-POINTING DOUBLE ANGLE QUOTATION MARK}" ];
if ($@) {
- print "# $@not ok 77\nnot ok 78\n";
+ print "# $@not ok 78\nnot ok 79\n";
} else {
- print "ok 77\n";
- print "not " unless $evaltry eq "Eval: \N{LEFT-POINTING DOUBLE ANGLE QUOTATION MARK}";
print "ok 78\n";
+ print "not " unless $evaltry eq "Eval: \N{LEFT-POINTING DOUBLE ANGLE QUOTATION MARK}";
+ print "ok 79\n";
}
# Verify that db includes the normative NameAliases.txt names
print "not " unless "\N{U+1D0C5}" eq "\N{BYZANTINE MUSICAL SYMBOL FTHORA SKLIRON CHROMA VASIS}";
-print "ok 79\n";
+print "ok 80\n";
+
+# [perl #73174] use of \N{FOO} used to reset %^H
+
+{
+ use charnames ":full";
+ my $res;
+ BEGIN { $^H{73174} = "foo" }
+ BEGIN { $res = ($^H{73174} // "") }
+ # forces loading of utf8.pm, which used to reset %^H
+ $res .= '-1' if ":" =~ /\N{COLON}/i;
+ BEGIN { $res .= '-' . ($^H{73174} // "") }
+ $res .= '-' . ($^H{73174} // "");
+ $res .= '-2' if ":" =~ /\N{COLON}/;
+ $res .= '-3' if ":" =~ /\N{COLON}/i;
+ print $res eq "foo-foo-1--2-3" ? "" : "not ",
+ "ok 81 - \$^H{foo} correct after /\\N{bar}/i (res=$res)\n";
+}
__END__
# unsupported pragma
#
# Suggested alternative: Term::Complete
-warn( "The 'complete.pl' legacy library is deprecated and will be"
- . " removed in the next major release of perl. Please use the"
- . " Term::Complete module instead." );
-
;# @(#)complete.pl,v1.1 (me@anywhere.EBay.Sun.COM) 09/23/91
;#
;# Author: Wayne Thompson
#
# Suggested alternative: the POSIX ctime function
-warn( "The 'ctime.pl' legacy library is deprecated and will be"
- . " removed in the next major release of perl. Please use the"
- . " POSIX module (ctime function) instead." );
-
;#
;# Waldemar Kebsch, Federal Republic of Germany, November 1988
;# kebsch.pad@nixpbe.UUCP
package ctime;
local($time) = @_;
- local($[) = 0;
local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
# Determine what time zone is in effect.
# &dotsh ('/foo/bar arg1 ... argN');
#
-warn( "The 'dotsh.pl' legacy library is deprecated and will be"
- . " removed in the next major release of perl. Please use "
- . " one of the related modules from CPAN instead."
- . " (Shell::Source, Shell::GetEnv, ...)" );
-
sub dotsh {
local(@sh) = @_;
local($tmp,$key,$shell,$command,$args,$vars) = '';
if ($#$v >= 0) {
$short = $sp . "0..$#{$v} " .
join(" ",
- map {exists $v->[$_] ? stringify $v->[$_] : "empty"} ($[..$tArrayDepth)
+ map {exists $v->[$_] ? stringify $v->[$_] : "empty"} (0..$tArrayDepth)
) . "$shortmore";
} else {
$short = $sp . "empty array";
# print "$short\n";
# return;
#}
- for $num ($[ .. $tArrayDepth) {
+ for $num (0 .. $tArrayDepth) {
return if $DB::signal;
print "$sp$num ";
if (exists $v->[$num]) {
# In particular, this should not be used as an example of modern Perl
# programming techniques.
-warn( "The 'exceptions.pl' legacy library is deprecated and will be"
- . " removed in the next major release of perl." );
-
# Here's a little code I use for exception handling. It's really just
# glorfied eval/die. The way to use use it is when you might otherwise
# exit, use &throw to raise an exception. The first enclosing &catch
#
# Suggested alternative: Cwd
-warn( "The 'fastcwd.pl' legacy library is deprecated and will be"
- . " removed in the next major release of perl. Please use the"
- . " Cwd module instead." );
-
# Usage: $cwd = &fastcwd;
#
# This is a faster version of getcwd. It's also more dangerous because
package feature;
-our $VERSION = '1.14';
+our $VERSION = '1.17';
# (feature name) => (internal name, used in %^H)
my %feature = (
# This gets set (for now) in $^H as well as in %^H,
# for runtime speed of the uc/lc/ucfirst/lcfirst functions.
+# See HINT_UNI_8_BIT in perl.h.
our $hint_uni8bit = 0x00000800;
# NB. the latest bundle must be loaded by the -E switch (see toke.c)
my %feature_bundle = (
"5.10" => [qw(switch say state)],
"5.11" => [qw(switch say state unicode_strings)],
+ "5.12" => [qw(switch say state unicode_strings)],
+ "5.13" => [qw(switch say state unicode_strings)],
);
# special case
# removed in a future version of Perl. Please use the File::Find module
# instead.
-warn( "Please use the File::Find module instead of the deprecated"
- ." 'find.pl' library, which will be removed in the next major"
- ." release of perl" );
-
# Usage:
# require "find.pl";
#
# removed in a future version of Perl. Please use the File::Find module
# instead.
-warn( "Please use the File::Find module instead of the deprecated"
- ." 'finddepth.pl' library, which will be removed in the next"
- ." major release of perl" );
-
# Usage:
# require "finddepth.pl";
#
#
# Suggested alternative: IO::Handle
-warn( "The 'flush.pl' legacy library is deprecated and will be"
- . " removed in the next major release of perl. Please use the"
- . " IO::Handle module instead." );
-
;# Usage: &flush(FILEHANDLE)
;# flushes the named filehandle
#
# Suggested alternative: Cwd
-warn( "The 'getcwd.pl' legacy library is deprecated and will be"
- . " removed in the next major release of perl. Please use the"
- . " Cwd module instead." );
-
#
# Usage: $cwd = &getcwd;
closedir(getcwd'PARENT); #');
return '';
}
- if ($pst[$[] == $cst[$[] && $pst[$[ + 1] == $cst[$[ + 1])
+ if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
{
$dir = '';
}
# return '';
}
}
- while ($dir eq '.' || $dir eq '..' || $tst[$[] != $pst[$[] ||
- $tst[$[ + 1] != $pst[$[ + 1]);
+ while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
+ $tst[1] != $pst[1]);
}
$cwd = "$dir/$cwd";
closedir(getcwd'PARENT); #');
#
# Suggested alternatives: Getopt::Long or Getopt::Std
-warn( "The 'getopt.pl' legacy library is deprecated and will be"
- . " removed in the next major release of perl. Please use the"
- . " Getopt::Long or Getopt::Std modules instead." );
-
;# Process single-character switches with switch clustering. Pass one argument
;# which is a string containing all switches that take an argument. For each
;# switch found, sets $opt_x (where x is the switch name) to the value of the
sub Getopt {
local($argumentative) = @_;
local($_,$first,$rest);
- local($[) = 0;
while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
($first,$rest) = ($1,$2);
- if (index($argumentative,$first) >= $[) {
+ if (index($argumentative,$first) >= 0) {
if ($rest ne '') {
shift(@ARGV);
}
#
# Suggested alternatives: Getopt::Long or Getopt::Std
-warn( "The 'getopts.pl' legacy library is deprecated and will be"
- . " removed in the next major release of perl. Please use the"
- . " Getopt::Long or Getopt::Std module instead." );
-
;# Usage:
;# do Getopts('a:bc'); # -a takes arg. -b & -c not. Sets opt_* as a
;# # side effect.
local($argumentative) = @_;
local(@args,$_,$first,$rest);
local($errs) = 0;
- local($[) = 0;
@args = split( / */, $argumentative );
while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
($first,$rest) = ($1,$2);
$pos = index($argumentative,$first);
- if($pos >= $[) {
+ if($pos >= 0) {
if($args[$pos+1] eq ':') {
shift(@ARGV);
if($rest eq '') {
exit 0;
}
-plan(4);
+plan(5);
# quickly compare two text files
sub txt_compare {
stderr => 1 );
like( $result, qr/syntax OK$/, "output compiles");
+$result = runperl( progfile => '_h2ph_pre.ph',
+ switches => ['-c'],
+ stderr => 1 );
+like( $result, qr/syntax OK$/, "preamble compiles");
+
$result = runperl( switches => ["-w"],
- prog => '$SIG{__WARN__} = sub { die $_[0] }; require q(lib/h2ph.pht);');
+ stderr => 1,
+ prog => <<'PROG' );
+$SIG{__WARN__} = sub { die $_[0] }; require q(lib/h2ph.pht);
+PROG
is( $result, '', "output free of warnings" );
# cleanup
#
# Suggested alternative: Sys::Hostname
-warn( "The 'hostname.pl' legacy library is deprecated and will be"
- . " removed in the next major release of perl. Please use the"
- . " Sys::Hostname module instead." );
-
sub hostname
{
local(*P,@tmp,$hostname,$_);
# This legacy library is deprecated and will be removed in a future
# release of perl.
-warn( "The 'importenv.pl' legacy library is deprecated and will be"
- . " removed in the next major release of perl. Please use the"
- . " Env::Export module (or similar) from CPAN instead." );
-
;# This file, when interpreted, pulls the environment into normal variables.
;# Usage:
;# require 'importenv.pl';
use strict;
use warnings;
-our $VERSION = '0.02';
+our $VERSION = '0.03';
sub _pack_tags {
return join ' ', @_;
grep {defined} @_;
}
+sub stash_name { $_[0] }
+
sub of {
my $class = shift @_;
my $hinthash = ( caller 0 )[10];
my %tags;
- @tags{ _unpack_tags( $hinthash->{$class} ) } = ();
+ @tags{ _unpack_tags( $hinthash->{ $class->stash_name } ) } = ();
if (@_) {
exists $tags{$_} and return !!1 for @_;
sub import {
my $class = shift @_;
+ my $stash = $class->stash_name;
@_ = 'please' if not @_;
my %tags;
- @tags{ _unpack_tags( @_, $^H{$class} ) } = ();
+ @tags{ _unpack_tags( @_, $^H{ $stash } ) } = ();
- $^H{$class} = _pack_tags( keys %tags );
+ $^H{$stash} = _pack_tags( keys %tags );
return;
}
my $new = _pack_tags( keys %tags );
if ( not length $new ) {
- delete $^H{$class};
+ delete $^H{ $class->stash_name };
}
else {
- $^H{$class} = $new;
+ $^H{ $class->stash_name } = $new;
}
}
else {
- delete $^H{$class};
+ delete $^H{ $class->stash_name };
}
return;
push @INC, '../lib';
}
-use Test::More tests => 6;
+use Test::More tests => 12;
-BEGIN { use_ok( 'less' ) }
+BEGIN {
+ use_ok( 'less' );
+
+ package less::again;
+ sub stash_name {'less'}
+ @ISA = 'less';
+ $INC{'less/again.pm'} = 1;
+}
is_deeply([less->of], [], 'more please');
use less;
is_deeply([less->of], ['please'],'less please');
+is_deeply([less::again->of], ['please'], 'less::again please');
no less;
is_deeply([less->of],[],'more please');
+is_deeply([less::again->of], [], 'no less::again please');
+use less::again;
+is_deeply([less->of], ['please'],'less please');
+is_deeply([less::again->of], ['please'], 'less::again please');
+no less::again;
+is_deeply([less->of],[],'more please');
+is_deeply([less::again->of], [], 'no less::again please');
use less 'random acts';
is_deeply([sort less->of],[sort qw(random acts)],'less random acts');
(my $v) = $Config{osvers} =~ /^(\d+)/;
if ($v >= 8 and $v < 10) {
debug "# Skipping eu_ES, be_BY locales -- buggy in Darwin\n";
- @Locale = grep ! m/^(eu_ES|be_BY\.CP1131)$/, @Locale;
+ @Locale = grep ! m/^(eu_ES(?:\..*)?|be_BY\.CP1131)$/, @Locale;
} elsif ($v < 11) {
debug "# Skipping be_BY locales -- buggy in Darwin\n";
@Locale = grep ! m/^be_BY\.CP1131$/, @Locale;
- }
+ }
}
@Locale = sort @Locale;
# In particular, this should not be used as an example of modern Perl
# programming techniques.
-warn( "The 'look.pl' legacy library is deprecated and will be"
- . " removed in the next major release of perl." );
-
;# Sets file position in FILEHANDLE to be first line greater than or equal
;# (stringwise) to $key. Pass flags for dictionary order and case folding.
#
# Suggested alternative: Getopt::Long
-warn( "The 'newgetopt.pl' legacy library is deprecated and will be"
- . " removed in the next major release of perl. Please use the"
- . " Getopt::Long module instead." );
-
{ package newgetopt;
# Values for $order. See GNU getopt.c for details.
#
# require 'open2.pl';
-warn( "The 'open2.pl' legacy library is deprecated and will be"
- . " removed in the next major release of perl. Please use the"
- . " IPC::Open2 module instead." );
-
package main;
use IPC::Open2 'open2';
1
#
# require 'open3.pl';
-warn( "The 'open3.pl' legacy library is deprecated and will be"
- . " removed in the next major release of perl. Please use the"
- . " IPC::Open3 module instead." );
-
package main;
use IPC::Open3 'open3';
1
is($m+$m, 2*$num_val, 'numifies to usual reference value');
is(0-$m, -$num_val, 'numifies to usual reference value');
is(1*$m, $num_val, 'numifies to usual reference value');
- is($m/1, $num_val, 'numifies to usual reference value');
+ is(int($m/1), $num_val, 'numifies to usual reference value');
is($m%100, $num_val%100, 'numifies to usual reference value');
is($m**1, $num_val, 'numifies to usual reference value');
is($aref+$aref, 2*$num_val, 'ref addition');
is(0-$aref, -$num_val, 'subtraction of ref');
is(1*$aref, $num_val, 'multiplicaton of ref');
- is($aref/1, $num_val, 'division of ref');
+ is(int($aref/1), $num_val, 'division of ref');
is($aref%100, $num_val%100, 'modulo of ref');
is($aref**1, $num_val, 'exponentiation of ref');
}
{
rc(
qq|
- &parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
+ &parse_options("NonStop=0 ReadLine=0 TTY=db.out LineInfo=db.out");
\n|,
qq|
#
# Suggested alternative: Cwd
-warn( "The 'pwd.pl' legacy library is deprecated and will be"
- . " removed in the next major release of perl. Please use the"
- . " Cwd module instead." );
-
;# $RCSfile: pwd.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:11 $
;#
;# $Log: pwd.pl,v $
;# or
;# @words = shellwords(); # defaults to $_ (and clobbers it)
-warn( "The 'shellwords.pl' legacy library is deprecated and will be"
- . " removed in the next major release of perl. Please use the"
- . " Text::ParseWords module instead." );
-
require Text::ParseWords;
*shellwords = \&Text::ParseWords::old_shellwords;
;# $st_dev = @ary[$ST_DEV];
;#
-warn( "The 'stat.pl' legacy library is deprecated and will be"
- . " removed in the next major release of perl." );
-
-$ST_DEV = 0 + $[;
-$ST_INO = 1 + $[;
-$ST_MODE = 2 + $[;
-$ST_NLINK = 3 + $[;
-$ST_UID = 4 + $[;
-$ST_GID = 5 + $[;
-$ST_RDEV = 6 + $[;
-$ST_SIZE = 7 + $[;
-$ST_ATIME = 8 + $[;
-$ST_MTIME = 9 + $[;
-$ST_CTIME = 10 + $[;
-$ST_BLKSIZE = 11 + $[;
-$ST_BLOCKS = 12 + $[;
+$ST_DEV = 0;
+$ST_INO = 1;
+$ST_MODE = 2;
+$ST_NLINK = 3;
+$ST_UID = 4;
+$ST_GID = 5;
+$ST_RDEV = 6;
+$ST_SIZE = 7;
+$ST_ATIME = 8;
+$ST_MTIME = 9;
+$ST_CTIME = 10;
+$ST_BLKSIZE = 11;
+$ST_BLOCKS = 12;
;# Usage:
;# require 'stat.pl';
# release of perl.
# This subroutine returns true if its argument is tainted, false otherwise.
#
-warn( "The 'tainted.pl' legacy library is deprecated and will be"
- . " removed in the next major release of perl. Please use the"
- . " Scalar::Util module ('tainted' function) instead." );
sub tainted {
local($@);
# Suggested alternative: Term::Cap
#
-warn( "The 'termcap.pl' legacy library is deprecated and will be"
- . " removed in the next major release of perl. Please use the"
- . " Term::Cap module instead." );
-
;#
;# Usage:
;# require 'ioctl.pl';
}
elsif ($code eq '>') {
($code,$tmp,$string) = unpack("CCa99",$string);
- if ($tmp[$[] > $code) {
- $tmp[$[] += $tmp;
+ if ($tmp[0] > $code) {
+ $tmp[0] += $tmp;
}
}
elsif ($code eq '2') {
*timelocal::cheat = \&Time::Local::cheat;
-warn( "The 'timelocal.pl' legacy library is deprecated and will be"
- . " removed in the next major release of perl. Please use the"
- . " Time::Local module instead." );
When putting out a new Perl release, think about if any of the Deprecated
properties should be moved to Suppressed.
+perlrecharclass.pod has a list of all the characters that are white space,
+which needs to be updated if there are changes. A quick way to check if there
+have been changes would be to see if the number of such characters listed in
+perluniprops.pod (generated by running mktables) for the property
+\p{White_Space} is no longer 26. Further investigation would then be necessary
+to classify the new characters as horizontal and vertical.
+
The code in regexec.c for the \X match construct is intimately tied to the
regular expression in UAX #29 (http://www.unicode.org/reports/tr29/). You
should see if it has changed, and if so regexec.c should be modified. The
# have been checked for somewhat more than just sanity. It can handle all
# existing Unicode character properties in those releases.
#
-# This program needs to be able to run under miniperl. Therefore, it uses a
-# minimum of other modules, and hence implements some things itself that could
-# be gotten from CPAN
-#
-# This program uses inputs published by the Unicode Consortium. These can
-# change incompatibly between releases without the Perl maintainers realizing
-# it. Therefore this program is now designed to try to flag these. It looks
-# at the directories where the inputs are, and flags any unrecognized files.
-# It keeps track of all the properties in the files it handles, and flags any
-# that it doesn't know how to handle. It also flags any input lines that
-# don't match the expected syntax, among other checks.
-# It is also designed so if a new input file matches one of the known
-# templates, one hopefully just needs to add it to a list to have it
-# processed.
-#
-# It tries to keep fatal errors to a minimum, to generate something usable for
-# testing purposes. It always looks for files that could be inputs, and will
-# warn about any that it doesn't know how to handle (the -q option suppresses
-# the warning).
-#
# This program is mostly about Unicode character (or code point) properties.
# A property describes some attribute or quality of a code point, like if it
# is lowercase or not, its name, what version of Unicode it was first defined
# writing, such as the path to each one's file. There is a heading in each
# map table that gives the format of its entries, and what the map is for all
# the code points missing from it. (This allows tables to be more compact.)
-
+#
# The Property data structure contains one or more tables. All properties
# contain a map table (except the $perl property which is a
# pseudo-property containing only match tables), and any properties that
# constructs will. Generally a property will have either its map table or its
# match tables written but not both. Again, what gets written is controlled
# by lists which can easily be changed.
-
+#
# For information about the Unicode properties, see Unicode's UAX44 document:
my $unicode_reference_url = 'http://www.unicode.org/reports/tr44/';
# introductory comments.
#
# This program works on all properties as of 5.2, though the files for some
-# are suppressed from apparent lack of demand for. You can change which are
-# output by changing lists in this program.
-
+# are suppressed from apparent lack of demand for them. You can change which
+# are output by changing lists in this program.
+#
# The old version of mktables emphasized the term "Fuzzy" to mean Unocde's
# loose matchings rules (from Unicode TR18):
#
# The program still allows Fuzzy to override its determination of if loose
# matching should be used, but it isn't currently used, as it is no longer
# needed; the calculations it makes are good enough.
-
+#
# SUMMARY OF HOW IT WORKS:
#
# Process arguments
# The Perl-defined properties are created and populated. Many of these
# require data determined from the earlier steps
# Any Perl-defined synonyms are created, and name clashes between Perl
-# and Unicode are reconciled.
+# and Unicode are reconciled and warned about.
# All the properties are written to files
# Any other files are written, and final warnings issued.
-
-# As mentioned above, some properties are given in more than one file. In
-# particular, the files in the extracted directory are supposedly just
-# reformattings of the others. But they contain information not easily
-# derivable from the other files, including results for Unihan, which this
-# program doesn't ordinarily look at, and for unassigned code points. They
-# also have historically had errors or been incomplete. In an attempt to
-# create the best possible data, this program thus processes them first to
-# glean information missing from the other files; then processes those other
-# files to override any errors in the extracted ones.
-
+#
# For clarity, a number of operators have been overloaded to work on tables:
# ~ means invert (take all characters not in the set). The more
# conventional '!' is not used because of the possibility of confusing
# Operations are done on references and affect the underlying structures, so
# that the copy constructors for them have been overloaded to not return a new
# clone, but the input object itself.
-
+#
# The bool operator is deliberately not overloaded to avoid confusion with
# "should it mean if the object merely exists, or also is non-empty?".
-
#
# WHY CERTAIN DESIGN DECISIONS WERE MADE
-
-# XXX These comments need more work.
+#
+# This program needs to be able to run under miniperl. Therefore, it uses a
+# minimum of other modules, and hence implements some things itself that could
+# be gotten from CPAN
+#
+# This program uses inputs published by the Unicode Consortium. These can
+# change incompatibly between releases without the Perl maintainers realizing
+# it. Therefore this program is now designed to try to flag these. It looks
+# at the directories where the inputs are, and flags any unrecognized files.
+# It keeps track of all the properties in the files it handles, and flags any
+# that it doesn't know how to handle. It also flags any input lines that
+# don't match the expected syntax, among other checks.
+#
+# It is also designed so if a new input file matches one of the known
+# templates, one hopefully just needs to add it to a list to have it
+# processed.
+#
+# As mentioned earlier, some properties are given in more than one file. In
+# particular, the files in the extracted directory are supposedly just
+# reformattings of the others. But they contain information not easily
+# derivable from the other files, including results for Unihan, which this
+# program doesn't ordinarily look at, and for unassigned code points. They
+# also have historically had errors or been incomplete. In an attempt to
+# create the best possible data, this program thus processes them first to
+# glean information missing from the other files; then processes those other
+# files to override any errors in the extracted ones. Much of the design was
+# driven by this need to store things and then possibly override them.
+#
+# It tries to keep fatal errors to a minimum, to generate something usable for
+# testing purposes. It always looks for files that could be inputs, and will
+# warn about any that it doesn't know how to handle (the -q option suppresses
+# the warning).
#
# Why have files written out for binary 'N' matches?
# For binary properties, if you know the mapping for either Y or N; the
-# other is trivial to construct, so could be done at Perl run-time instead
-# of having a file for it. That is, if someone types in \p{foo: N}, Perl
-# could translate that to \P{foo: Y} and not need a file. The problem is
-# communicating to Perl that a given property is binary. Perl can't figure
-# it out from looking at the N (or No), as some non-binary properties have
-# these as property values.
-# Why
-# There are several types of properties, based on what form their values can
-# take on. These are described in more detail below in the DATA STRUCTURES
-# section of these comments, but for now, you should know that there are
-# string properties, whose values are strings of one or more code points (such
-# as the Uppercase_mapping property); every other property maps to some other
-# form, like true or false, or a number, or a name, etc. The reason there are
-# two directories for map files is because of the way utf8.c works. It
-# expects that any files there are string properties, that is that the
-# mappings are each to one code point, with mappings in multiple code points
-# handled specially in an extra hash data structure. Digit.pl is a table that
-# is written there for historical reasons, even though it doesn't fit that
-# mold. Thus it can't currently be looked at by the Perl core.
+# other is trivial to construct, so could be done at Perl run-time by just
+# complementing the result, instead of having a file for it. That is, if
+# someone types in \p{foo: N}, Perl could translate that to \P{foo: Y} and
+# not need a file. The problem is communicating to Perl that a given
+# property is binary. Perl can't figure it out from looking at the N (or
+# No), as some non-binary properties have these as property values. So
+# rather than inventing a way to communicate this info back to the core,
+# which would have required changes there as well, it was simpler just to
+# add the extra tables.
+#
+# Why is there more than one type of range?
+# This simplified things. There are some very specialized code points that
+# have to be handled specially for output, such as Hangul syllable names.
+# By creating a range type (done late in the development process), it
+# allowed this to be stored with the range, and overridden by other input.
+# Originally these were stored in another data structure, and it became a
+# mess trying to decide if a second file that was for the same property was
+# overriding the earlier one or not.
+#
+# Why are there two kinds of tables, match and map?
+# (And there is a base class shared by the two as well.) As stated above,
+# they actually are for different things. Development proceeded much more
+# smoothly when I (khw) realized the distinction. Map tables are used to
+# give the property value for every code point (actually every code point
+# that doesn't map to a default value). Match tables are used for regular
+# expression matches, and are essentially the inverse mapping. Separating
+# the two allows more specialized methods, and error checks so that one
+# can't just take the intersection of two map tables, for example, as that
+# is nonsensical.
#
# There are no match tables generated for matches of the null string. These
-# would like like \p{JSN=}. Perhaps something like them could be added if
-# necessary. The JSN does have a real code point U+110B that maps to the null
-# string, but it is a contributory property, and therefore not output by
-# default.
+# would like like qr/\p{JSN=}/ currently without modifying the regex code.
+# Perhaps something like them could be added if necessary. The JSN does have
+# a real code point U+110B that maps to the null string, but it is a
+# contributory property, and therefore not output by default. And it's easily
+# handled so far by making the null string the default where it is a
+# possibility.
#
# DEBUGGING
#
-# XXX Add more stuff here. use perl instead of miniperl to find problems with
-# Scalar::Util
-
+# This program is written so it will run under miniperl. Occasionally changes
+# will cause an error where the backtrace doesn't work well under miniperl.
+# To diagnose the problem, you can instead run it under regular perl, if you
+# have one compiled.
+#
+# There is a good trace facility. To enable it, first sub DEBUG must be set
+# to return true. Then a line like
+#
+# local $to_trace = 1 if main::DEBUG;
+#
+# can be added to enable tracing in its lexical scope or until you insert
+# another line:
+#
+# local $to_trace = 0 if main::DEBUG;
+#
+# then use a line like "trace $a, @b, %c, ...;
+#
+# Some of the more complex subroutines already have trace statements in them.
+# Permanent trace statements should be like:
+#
+# trace ... if main::DEBUG && $to_trace;
+#
+# If there is just one or a few files that you're debugging, you can easily
+# cause most everything else to be skipped. Change the line
+#
+# my $debug_skip = 0;
+#
+# to 1, and every file whose object is in @input_file_objects and doesn't have
+# a, 'non_skip => 1,' in its constructor will be skipped.
+#
# FUTURE ISSUES
#
# The program would break if Unicode were to change its names so that
# synonym would have to be used for the new property. This is ugly, and
# manual intervention would certainly be easier to do in the short run; lets
# hope it never comes to this.
-
+#
# A NOTE ON UNIHAN
#
# This program can generate tables from the Unihan database. But it doesn't
# file could be edited to fix them.
# have to be
#
-# HOW TO ADD A FILE
-
-# Unicode Versions Notes
-
-# alpha's numbers halve in 2.1.9, answer cjk block at 4E00 were removed from PropList; not changed, could add gc Letter, put back in in 3.1.0
-# Some versions of 2.1.x Jamo.txt have the wrong value for 1105, which causes
-# real problems for the algorithms for Jamo calculations, so it is changed
-# here.
-# White space vs Space. in 3.2 perl has +205F=medium math space, fixed in 4.0, and ok in 3.1.1 because not there in unicode. synonym introduced in 4.1
-# ATBL = 202. 202 changed to ATB, and all code points stayed there. So if you were useing ATBL you were out of luck.
-# Hrkt Katakana_Or_Hiragana came in 4.01, before was Unknown.
+# HOW TO ADD A FILE TO BE PROCESSED
+#
+# A new file from Unicode needs to have an object constructed for it in
+# @input_file_objects, probably at the end or at the end of the extracted
+# ones. The program should warn you if its name will clash with others on
+# restrictive file systems, like DOS. If so, figure out a better name, and
+# add lines to the README.perl file giving that. If the file is a character
+# property, it should be in the format that Unicode has by default
+# standardized for such files for the more recently introduced ones.
+# If so, the Input_file constructor for @input_file_objects can just be the
+# file name and release it first appeared in. If not, then it should be
+# possible to construct an each_line_handler() to massage the line into the
+# standardized form.
+#
+# For non-character properties, more code will be needed. You can look at
+# the existing entries for clues.
+#
+# UNICODE VERSIONS NOTES
+#
+# The Unicode UCD has had a number of errors in it over the versions. And
+# these remain, by policy, in the standard for that version. Therefore it is
+# risky to correct them, because code may be expecting the error. So this
+# program doesn't generally make changes, unless the error breaks the Perl
+# core. As an example, some versions of 2.1.x Jamo.txt have the wrong value
+# for U+1105, which causes real problems for the algorithms for Jamo
+# calculations, so it is changed here.
+#
+# But it isn't so clear cut as to what to do about concepts that are
+# introduced in a later release; should they extend back to earlier releases
+# where the concept just didn't exist? It was easier to do this than to not,
+# so that's what was done. For example, the default value for code points not
+# in the files for various properties was probably undefined until changed by
+# some version. No_Block for blocks is such an example. This program will
+# assign No_Block even in Unicode versions that didn't have it. This has the
+# benefit that code being written doesn't have to special case earlier
+# versions; and the detriment that it doesn't match the Standard precisely for
+# the affected versions.
+#
+# Here are some observations about some of the issues in early versions:
+#
+# The number of code points in \p{alpha} halve in 2.1.9. It turns out that
+# the reason is that the CJK block starting at 4E00 was removed from PropList,
+# and was not put back in until 3.1.0
+#
+# Unicode introduced the synonym Space for White_Space in 4.1. Perl has
+# always had a \p{Space}. In release 3.2 only, they are not synonymous. The
+# reason is that 3.2 introduced U+205F=medium math space, which was not
+# classed as white space, but Perl figured out that it should have been. 4.0
+# reclassified it correctly.
+#
+# Another change between 3.2 and 4.0 is the CCC property value ATBL. In 3.2
+# this was erroneously a synonym for 202. In 4.0, ATB became 202, and ATBL
+# was left with no code points, as all the ones that mapped to 202 stayed
+# mapped to 202. Thus if your program used the numeric name for the class,
+# it would not have been affected, but if it used the mnemonic, it would have
+# been.
+#
+# \p{Script=Hrkt} (Katakana_Or_Hiragana) came in 4.0.1. Before that code
+# points which eventually came to have this script property value, instead
+# mapped to "Unknown". But in the next release all these code points were
+# moved to \p{sc=common} instead.
#
# The default for missing code points for BidiClass is complicated. Starting
# in 3.1.1, the derived file DBidiClass.txt handles this, but this program
'StandardizedVariants.txt' => 'Only for glyph changes, not a Unicode character property. Does not fit into current scheme where one code point is mapped',
);
-################ End of externally interesting definitions ###############
+### End of externally interesting definitions, except for @input_file_objects
my $HEADER=<<"EOF";
# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
my $fkey = File::Spec->rel2abs($file);
my $expecting = delete $potential_files{$fkey};
$expecting = delete $potential_files{lc($fkey)} unless defined $expecting;
- Carp::my_carp("Was not expecting '$file'.") if
- ! $expecting
+ Carp::my_carp("Was not expecting '$file'.") if
+ ! $expecting
&& ! defined $handle{$addr};
# Having deleted from expected files, we can quit if not to do
# standard.
main::set_access('perl_extension', \%perl_extension, 'r');
+ my %output_range_counts;
+ # A boolean set iff this table is to have comments written in the
+ # output file that contain the number of code points in the range.
+ # The constructor can override the global flag of the same name.
+ main::set_access('output_range_counts', \%output_range_counts, 'r');
+
sub new {
# All arguments are key => value pairs, which you can see below, most
# of which match fields documented above. Otherwise: Pod_Entry,
my $complete_name = $complete_name{$addr}
= delete $args{'Complete_Name'};
$internal_only{$addr} = delete $args{'Internal_Only_Warning'} || 0;
+ $output_range_counts{$addr} = delete $args{'Output_Range_Counts'};
$property{$addr} = delete $args{'_Property'};
$range_list{$addr} = delete $args{'_Range_List'};
$status{$addr} = delete $args{'Status'} || $NORMAL;
# Can't use || above because conceivably the name could be 0, and
# can't use // operator in case this program gets used in Perl 5.8
$full_name{$addr} = $name{$addr} if ! defined $full_name{$addr};
+ $output_range_counts{$addr} = $output_range_counts if
+ ! defined $output_range_counts{$addr};
$aliases{$addr} = [ ];
$comment{$addr} = [ ];
# Add a comment with the size of the range, if requested.
# Expand Tabs to make sure they all start in the same
# column, and then unexpand to use mostly tabs.
- if (! $output_range_counts) {
+ if (! $output_range_counts{$addr}) {
$OUT[-1] .= "\n";
}
else {
range, in hex; STOP is the ending point, or if omitted, the range has just one
code point; MAPPING is what each code point between START and STOP maps to.
END
- if ($output_range_counts) {
+ if ($self->output_range_counts) {
$comment .= <<END;
Numbers in comments in [brackets] indicate how many code points are in the
range (omitted when the range is a single code point or if the mapping is to
# 'table' (If you change the '=' must also change the ':' in lots of
# places in this program that assume an equal sign)
$complete = $property->full_name . "=$complete" if $property != $perl;
-
+
my $self = $class->SUPER::new(%args,
Name => $name,
START\\tSTOP\\twhere START is the starting code point of the range, in hex;
STOP is the ending point, or if omitted, the range has just one code point.
END
- if ($output_range_counts) {
+ if ($leader->output_range_counts) {
$comment .= <<END;
Numbers in comments in [brackets] indicate how many code points are in the
range.
else {
$default_map = $missings;
}
-
+
# And store it with the property for outside use.
$property_object->set_default_map($default_map);
}
Perl_Extension => 1,
Default_Map => $CODE_POINT,
+ # normalize.pm can't cope with these
+ Output_Range_Counts => 0,
+
# This is a specially formatted table
# explicitly for normalize.pm, which
# is expecting a particular format,
while ($file->next_line) {
push @backslash_X_tests, $_;
}
-
+
return;
}
$ASCII->initialize([ 0..127 ]);
}
- # A number of the Perl synonyms have a restricted-range synonym whose name
- # begins with Posix. This hash gets filled in with them, so that they can
- # be populated in a small loop.
- my %posix_equivalent;
-
# Get the best available case definitions. Early Unicode versions didn't
# have Uppercase and Lowercase defined, so use the general category
# instead for them.
$Lower->set_equivalent_to($gc->table('Lowercase_Letter'),
Related => 1);
}
- $posix_equivalent{'Lower'} = $Lower;
+ $perl->add_match_table("PosixLower",
+ Description => "[a-z]",
+ Initialize => $Lower & $ASCII,
+ );
my $Upper = $perl->add_match_table('Upper');
my $Unicode_Upper = property_ref('Uppercase');
$Upper->set_equivalent_to($gc->table('Uppercase_Letter'),
Related => 1);
}
- $posix_equivalent{'Upper'} = $Upper;
+ $perl->add_match_table("PosixUpper",
+ Description => "[A-Z]",
+ Initialize => $Upper & $ASCII,
+ );
# Earliest releases didn't have title case. Initialize it to empty if not
# otherwise present
# one whose name generally begins with Posix that is posix-compliant, and
# one that matches Unicode characters beyond the Posix, ASCII range
- my $Alpha = $perl->add_match_table('Alpha',
- Description => '[[:Alpha:]] extended beyond ASCII');
+ my $Alpha = $perl->add_match_table('Alpha');
# Alphabetic was not present in early releases
my $Alphabetic = property_ref('Alphabetic');
+ $gc->table('Mn')
+ $gc->table('Mc'));
$Alpha += $gc->table('Nl') if defined $gc->table('Nl');
+ $Alpha->add_description('Alphabetic');
}
- $posix_equivalent{'Alpha'} = $Alpha;
+ $perl->add_match_table("PosixAlpha",
+ Description => "[A-Za-z]",
+ Initialize => $Alpha & $ASCII,
+ );
my $Alnum = $perl->add_match_table('Alnum',
- Description => "[[:Alnum:]] extended beyond ASCII",
+ Description => 'Alphabetic and (Decimal) Numeric',
Initialize => $Alpha + $gc->table('Decimal_Number'),
);
- $posix_equivalent{'Alnum'} = $Alnum;
+ $perl->add_match_table("PosixAlnum",
+ Description => "[A-Za-z0-9]",
+ Initialize => $Alnum & $ASCII,
+ );
my $Word = $perl->add_match_table('Word',
Description => '\w, including beyond ASCII',
my $Pc = $gc->table('Connector_Punctuation'); # 'Pc' Not in release 1
$Word += $Pc if defined $Pc;
- # There is no [[:Word:]], so the name doesn't begin with Posix.
+ # This is a Perl extension, so the name doesn't begin with Posix.
$perl->add_match_table('PerlWord',
Description => '\w, restricted to ASCII = [A-Za-z0-9_]',
Initialize => $Word & $ASCII,
- 0x200B, # ZWSP
);
$Blank->add_alias('HorizSpace'); # Another name for it.
- $posix_equivalent{'Blank'} = $Blank;
+ $perl->add_match_table("PosixBlank",
+ Description => "\\t and ' '",
+ Initialize => $Blank & $ASCII,
+ );
my $VertSpace = $perl->add_match_table('VertSpace',
Description => '\v',
# No Posix equivalent for vertical space
my $Space = $perl->add_match_table('Space',
- Description => '\s including beyond ASCII plus vertical tab = [[:Space:]]',
- Initialize => $Blank + $VertSpace,
+ Description => '\s including beyond ASCII plus vertical tab',
+ Initialize => $Blank + $VertSpace,
);
- $posix_equivalent{'Space'} = $Space;
+ $perl->add_match_table("PosixSpace",
+ Description => "\\t, \\n, \\cK, \\f, \\r, and ' '. (\\cK is vertical tab)",
+ Initialize => $Space & $ASCII,
+ );
# Perl's traditional space doesn't include Vertical Tab
my $SpacePerl = $perl->add_match_table('SpacePerl',
);
my $Cntrl = $perl->add_match_table('Cntrl',
- Description => "[[:Cntrl:]] extended beyond ASCII");
+ Description => 'Control characters');
$Cntrl->set_equivalent_to($gc->table('Cc'), Related => 1);
- $posix_equivalent{'Cntrl'} = $Cntrl;
+ $perl->add_match_table("PosixCntrl",
+ Description => "ASCII control characters: NUL, SOH, STX, ETX, EOT, ENQ, ACK, BEL, BS, HT, LF, VT, FF, CR, SO, SI, DLE, DC1, DC2, DC3, DC4, NAK, SYN, ETB, CAN, EOM, SUB, ESC, FS, GS, RS, US, and DEL",
+ Initialize => $Cntrl & $ASCII,
+ );
# $controls is a temporary used to construct Graph.
my $controls = Range_List->new(Initialize => $gc->table('Unassigned')
# Graph is ~space & ~(Cc|Cs|Cn) = ~(space + $controls)
my $Graph = $perl->add_match_table('Graph',
- Description => "[[:Graph:]] extended beyond ASCII",
+ Description => 'Characters that are graphical',
Initialize => ~ ($Space + $controls),
);
- $posix_equivalent{'Graph'} = $Graph;
+ $perl->add_match_table("PosixGraph",
+ Description =>
+ '[-!"#$%&\'()*+,./:;<>?@[\\\]^_`{|}~0-9A-Za-z]',
+ Initialize => $Graph & $ASCII,
+ );
my $Print = $perl->add_match_table('Print',
- Description => "[[:Print:]] extended beyond ASCII",
+ Description => 'Characters that are graphical plus space characters (but no controls)',
Initialize => $Blank + $Graph - $gc->table('Control'),
);
- $posix_equivalent{'Print'} = $Print;
+ $perl->add_match_table("PosixPrint",
+ Description =>
+ '[- 0-9A-Za-z!"#$%&\'()*+,./:;<>?@[\\\]^_`{|}~]',
+ Initialize => $Print & $ASCII,
+ );
my $Punct = $perl->add_match_table('Punct');
$Punct->set_equivalent_to($gc->table('Punctuation'), Related => 1);
# \p{punct} doesn't include the symbols, which posix does
$perl->add_match_table('PosixPunct',
- Description => "[[:Punct:]]",
- Initialize => $ASCII & ($gc->table('Punctuation')
- + $gc->table('Symbol')),
- );
+ Description => '[-!"#$%&\'()*+,./:;<>?@[\\\]^_`{|}~]',
+ Initialize => $ASCII & ($gc->table('Punctuation')
+ + $gc->table('Symbol')),
+ );
my $Digit = $perl->add_match_table('Digit',
Description => '\d, extended beyond just [0-9]');
$Digit->set_equivalent_to($gc->table('Decimal_Number'), Related => 1);
- $posix_equivalent{'Digit'} = $Digit;
+ my $PosixDigit = $perl->add_match_table("PosixDigit",
+ Description => '[0-9]',
+ Initialize => $Digit & $ASCII,
+ );
- # AHex was not present in early releases
- # XXX TUS recommends Hex_Digit, not ASCII_Hex_Digit.
- my $Xdigit = $perl->add_match_table('XDigit',
- Description => '[0-9A-Fa-f]');
- my $AHex = property_ref('ASCII_Hex_Digit');
- if (defined $AHex && ! $AHex->is_empty) {
- $Xdigit->set_equivalent_to($AHex->table('Y'), Related => 1);
+ # Hex_Digit was not present in first release
+ my $Xdigit = $perl->add_match_table('XDigit');
+ my $Hex = property_ref('Hex_Digit');
+ if (defined $Hex && ! $Hex->is_empty) {
+ $Xdigit->set_equivalent_to($Hex->table('Y'), Related => 1);
}
else {
- # (Have to use hex because could be running on an non-ASCII machine,
- # and we want the Unicode (ASCII) values)
- $Xdigit->initialize([ 0x30..0x39, 0x41..0x46, 0x61..0x66 ]);
+ # (Have to use hex instead of e.g. '0', because could be running on an
+ # non-ASCII machine, and we want the Unicode (ASCII) values)
+ $Xdigit->initialize([ 0x30..0x39, 0x41..0x46, 0x61..0x66,
+ 0xFF10..0xFF19, 0xFF21..0xFF26, 0xFF41..0xFF46]);
+ $Xdigit->add_description('[0-9A-Fa-f] and corresponding fullwidth versions, like U+FF10: FULLWIDTH DIGIT ZERO');
}
- # Now, add the ASCII-restricted tables that get uniform treatment
- while (my ($name, $table) = each %posix_equivalent) {
- $perl->add_match_table("Posix$name",
- Description => "[[:$name:]]",
- Initialize => $table & $ASCII,
- );
- }
- $perl->table('PosixDigit')->add_description('\d, restricted to ASCII');
- $perl->table('PosixDigit')->add_description('[0-9]');
-
-
my $dt = property_ref('Decomposition_Type');
$dt->add_match_table('Non_Canon', Full_Name => 'Non_Canonical',
Initialize => ~ ($dt->table('None') + $dt->table('Canonical')),
Perl_Extension => 1,
- Note => 'Perl extension consisting of the union of all non-canonical decompositions',
+ Note => 'Union of all non-canonical decompositions',
);
# _CanonDCIJ is equivalent to Soft_Dotted, but if on a release earlier
my $gcb = property_ref('Grapheme_Cluster_Break');
- # The 'extended' grapheme cluster came in 5.1. The non-extended
+ # The 'extended' grapheme cluster came in 5.1. The non-extended
# definition differs too much from the traditional Perl one to use.
if (defined $gcb && defined $gcb->table('SpacingMark')) {
$parenthesized .= ')' if $parenthesized;
push @info, $parenthesized if $parenthesized;
+
+ if ($table_property != $perl && $table->perl_extension) {
+ push @info, '(Perl extension)';
+ }
push @info, "($string_count)" if $output_range_counts;
# Now, we have both the entry and info so add them to the
The right column will also caution you if a property means something different
than what might normally be expected.
+All single forms are Perl extensions; a few compound forms are as well, and
+are noted as such.
+
Numbers in (parentheses) indicate the total number of code points matched by
the property. For emphasis, those properties that match no code points at all
are listed as well in a separate section following the table.
|| ! defined $pod_directory
|| ! $alias->make_pod_entry;
+ my $rhs = $full_property_name;
+ if ($property != $perl && $table->perl_extension) {
+ $rhs .= ' (Perl extension)';
+ }
push @match_properties,
format_pod_line($indent_info_column,
'\p{' . $alias->name . ': *}',
- $full_property_name,
+ $rhs,
$alias->status);
}
} # End of non-string-like property code
"\0",
(-1) x 6,
"\a", "\b", "\t", "\n",
- -1, # No Vt
+ -1, # No Vt
"\f", "\r",
(-1) x 18,
" ", "!", "\"", "#", '$', "%", "&", "'",
# If a string can be represented in both non-ut8 and utf8, test both cases
UPGRADE:
for my $to_upgrade (0 .. 1) {
-
+
if ($to_upgrade) {
# If already in utf8, would just be a repeat
Test_X("1100 $nobreak 1161"); # Bug #70940
Expect(0, 0x2028, '\p{Print}', ""); # Bug # 71722
Expect(0, 0x2029, '\p{Print}', ""); # Bug # 71722
+Expect(1, 0xFF10, '\p{XDigit}', ""); # Bug # 71726
$utf8::hint_bits = 0x00800000;
-our $VERSION = '1.07';
+our $VERSION = '1.08';
sub import {
$^H |= $utf8::hint_bits;
use utf8;
no utf8;
- # Convert a Perl scalar to/from UTF-8.
+ # Convert the internal representation of a Perl scalar to/from UTF-8.
+
$num_octets = utf8::upgrade($string);
$success = utf8::downgrade($string[, FAIL_OK]);
- # Change the native bytes of a Perl scalar to/from UTF-8 bytes.
- utf8::encode($string);
- utf8::decode($string);
+ # Change each character of a Perl scalar to/from a series of
+ # characters that represent the UTF-8 bytes of each original character.
+
+ utf8::encode($string); # "\x{100}" becomes "\xc4\x80"
+ utf8::decode($string); # "\xc4\x80" becomes "\x{100}"
$flag = utf8::is_utf8(STRING); # since Perl 5.8.1
$flag = utf8::valid(STRING);
=item * $num_octets = utf8::upgrade($string)
-Converts in-place the internal octet sequence in the native encoding
-(Latin-1 or EBCDIC) to the equivalent character sequence in I<UTF-X>.
-I<$string> already encoded as characters does no harm. Returns the
+Converts in-place the internal representation of the string from an octet
+sequence in the native encoding (Latin-1 or EBCDIC) to I<UTF-X>. The
+logical character sequence itself is unchanged. If I<$string> is already
+stored as I<UTF-X>, then this is a no-op. Returns the
number of octets necessary to represent the string as I<UTF-X>. Can be
used to make sure that the UTF-8 flag is on, so that C<\w> or C<lc()>
work as Unicode on strings containing characters in the range 0x80-0xFF
=item * $success = utf8::downgrade($string[, FAIL_OK])
-Converts in-place the internal octet sequence in I<UTF-X> to the
-equivalent octet sequence in the native encoding (Latin-1 or EBCDIC).
-I<$string> already encoded as native 8 bit does no harm. Can be used to
+Converts in-place the the internal representation of the string from
+I<UTF-X> to the equivalent octet sequence in the native encoding (Latin-1
+or EBCDIC). The logical character sequence itself is unchanged. If
+I<$string> is already stored as native 8 bit, then this is a no-op. Can
+be used to
make sure that the UTF-8 flag is off, e.g. when you want to make sure
that the substr() or length() function works with the usually faster
byte algorithm.
=item * utf8::encode($string)
Converts in-place the character sequence to the corresponding octet
-sequence in I<UTF-X>. The UTF8 flag is turned off, so that after this
-operation, the string is a byte string. Returns nothing.
+sequence in I<UTF-X>. That is, every (possibly wide) character gets
+replaced with a sequence of one or more characters that represent the
+individual I<UTF-X> bytes of the character. The UTF8 flag is turned off.
+Returns nothing.
+
+ my $a = "\x{100}"; # $a contains one character, with ord 0x100
+ utf8::encode($a); # $a contains two characters, with ords 0xc4 and 0x80
B<Note that this function does not handle arbitrary encodings.>
Therefore Encode is recommended for the general purposes; see also
=item * $success = utf8::decode($string)
Attempts to convert in-place the octet sequence in I<UTF-X> to the
-corresponding character sequence. The UTF-8 flag is turned on only if
-the source string contains multiple-byte I<UTF-X> characters. If
-I<$string> is invalid as I<UTF-X>, returns false; otherwise returns
-true.
+corresponding character sequence. That is, it replaces each sequence of
+characters in the string whose ords represent a valid UTF-X byte
+sequence, with the corresponding single character. The UTF-8 flag is
+turned on only if the source string contains multiple-byte I<UTF-X>
+characters. If I<$string> is invalid as I<UTF-X>, returns false;
+otherwise returns true.
+
+ my $a = "\xc4\x80"; # $a contains two characters, with ords 0xc4 and 0x80
+ utf8::decode($a); # $a contains one character, with ord 0x100
B<Note that this function does not handle arbitrary encodings.>
Therefore Encode is recommended for the general purposes; see also
use 5.005_04;
use strict;
-use vars qw(@ISA $VERSION $CLASS *declare *qv);
+use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv);
-$VERSION = 0.77;
+$VERSION = 0.82;
$CLASS = 'version';
+#--------------------------------------------------------------------------#
+# Version regexp components
+#--------------------------------------------------------------------------#
+
+# Fraction part of a decimal version number. This is a common part of
+# both strict and lax decimal versions
+
+my $FRACTION_PART = qr/\.[0-9]+/;
+
+# First part of either decimal or dotted-decimal strict version number.
+# Unsigned integer with no leading zeroes (except for zero itself) to
+# avoid confusion with octal.
+
+my $STRICT_INTEGER_PART = qr/0|[1-9][0-9]*/;
+
+# First part of either decimal or dotted-decimal lax version number.
+# Unsigned integer, but allowing leading zeros. Always interpreted
+# as decimal. However, some forms of the resulting syntax give odd
+# results if used as ordinary Perl expressions, due to how perl treats
+# octals. E.g.
+# version->new("010" ) == 10
+# version->new( 010 ) == 8
+# version->new( 010.2) == 82 # "8" . "2"
+
+my $LAX_INTEGER_PART = qr/[0-9]+/;
+
+# Second and subsequent part of a strict dotted-decimal version number.
+# Leading zeroes are permitted, and the number is always decimal.
+# Limited to three digits to avoid overflow when converting to decimal
+# form and also avoid problematic style with excessive leading zeroes.
+
+my $STRICT_DOTTED_DECIMAL_PART = qr/\.[0-9]{1,3}/;
+
+# Second and subsequent part of a lax dotted-decimal version number.
+# Leading zeroes are permitted, and the number is always decimal. No
+# limit on the numerical value or number of digits, so there is the
+# possibility of overflow when converting to decimal form.
+
+my $LAX_DOTTED_DECIMAL_PART = qr/\.[0-9]+/;
+
+# Alpha suffix part of lax version number syntax. Acts like a
+# dotted-decimal part.
+
+my $LAX_ALPHA_PART = qr/_[0-9]+/;
+
+#--------------------------------------------------------------------------#
+# Strict version regexp definitions
+#--------------------------------------------------------------------------#
+
+# Strict decimal version number.
+
+my $STRICT_DECIMAL_VERSION =
+ qr/ $STRICT_INTEGER_PART $FRACTION_PART? /x;
+
+# Strict dotted-decimal version number. Must have both leading "v" and
+# at least three parts, to avoid confusion with decimal syntax.
+
+my $STRICT_DOTTED_DECIMAL_VERSION =
+ qr/ v $STRICT_INTEGER_PART $STRICT_DOTTED_DECIMAL_PART{2,} /x;
+
+# Complete strict version number syntax -- should generally be used
+# anchored: qr/ \A $STRICT \z /x
+
+$STRICT =
+ qr/ $STRICT_DECIMAL_VERSION | $STRICT_DOTTED_DECIMAL_VERSION /x;
+
+#--------------------------------------------------------------------------#
+# Lax version regexp definitions
+#--------------------------------------------------------------------------#
+
+# Lax decimal version number. Just like the strict one except for
+# allowing an alpha suffix or allowing a leading or trailing
+# decimal-point
+
+my $LAX_DECIMAL_VERSION =
+ qr/ $LAX_INTEGER_PART (?: \. | $FRACTION_PART $LAX_ALPHA_PART? )?
+ |
+ $FRACTION_PART $LAX_ALPHA_PART?
+ /x;
+
+# Lax dotted-decimal version number. Distinguished by having either
+# leading "v" or at least three non-alpha parts. Alpha part is only
+# permitted if there are at least two non-alpha parts. Strangely
+# enough, without the leading "v", Perl takes .1.2 to mean v0.1.2,
+# so when there is no "v", the leading part is optional
+
+my $LAX_DOTTED_DECIMAL_VERSION =
+ qr/
+ v $LAX_INTEGER_PART (?: $LAX_DOTTED_DECIMAL_PART+ $LAX_ALPHA_PART? )?
+ |
+ $LAX_INTEGER_PART? $LAX_DOTTED_DECIMAL_PART{2,} $LAX_ALPHA_PART?
+ /x;
+
+# Complete lax version number syntax -- should generally be used
+# anchored: qr/ \A $LAX \z /x
+#
+# The string 'undef' is a special case to make for easier handling
+# of return values from ExtUtils::MM->parse_version
+
+$LAX =
+ qr/ undef | $LAX_DECIMAL_VERSION | $LAX_DOTTED_DECIMAL_VERSION /x;
+
+#--------------------------------------------------------------------------#
+
# Preloaded methods go here.
sub import {
no strict 'refs';
'UNIVERSAL::VERSION' => 1,
);
}
-
+
my $callpkg = caller();
if (exists($args{declare})) {
- *{$callpkg."::declare"} =
+ *{$callpkg.'::declare'} =
sub {return $class->declare(shift) }
unless defined(&{$callpkg.'::declare'});
}
if (exists($args{qv})) {
- *{$callpkg."::qv"} =
+ *{$callpkg.'::qv'} =
sub {return $class->qv(shift) }
- unless defined(&{"$callpkg\::qv"});
+ unless defined(&{$callpkg.'::qv'});
}
if (exists($args{'VERSION'})) {
- *{$callpkg."::VERSION"} = \&version::_VERSION;
+ *{$callpkg.'::VERSION'} = \&version::_VERSION;
+ }
+
+ if (exists($args{'is_strict'})) {
+ *{$callpkg.'::is_strict'} = \&version::is_strict;
+ }
+
+ if (exists($args{'is_lax'})) {
+ *{$callpkg.'::is_lax'} = \&version::is_lax;
}
}
+sub is_strict { defined $_[0] && $_[0] =~ qr/ \A $STRICT \z /x }
+sub is_lax { defined $_[0] && $_[0] =~ qr/ \A $LAX \z /x }
+
1;
# Declaring an old-style decimal $VERSION (use quotes!)
+ our $VERSION = "1.0203"; # recommended
use version 0.77; our $VERSION = version->parse("1.0203"); # formal
use version 0.77; our $VERSION = version->parse("1.02_03"); # alpha
versions of Perl. All previous releases before 0.74 are deprecated and should
not be used due to incompatible API changes. Version 0.77 introduces the new
'parse' and 'declare' methods to standardize usage. You are strongly urged to
-set 0.77 as a minimum in your code, e.g.
+set 0.77 as a minimum in your code, e.g.
use version 0.77; # even for Perl v.5.10.0
=item Decimal Versions
The classic floating-point number $VERSION. The advantage to this style is
-that you don't need to do anything special, just type a number (without
-quotes) into your source file.
+that you don't need to do anything special, just type a number into your
+source file. Quoting is recommended, as it ensures that trailing zeroes
+("1.50") are preserved in any warnings or other output.
=item Dotted Decimal Versions
The more modern form of version assignment, with 3 (or potentially more)
integers seperated by decimal points (e.g. v1.2.3). This is the form that
-Perl itself has used since 5.6.0 was released. The leading "v" is now
+Perl itself has used since 5.6.0 was released. The leading "v" is now
strongly recommended for clarity, and will throw a warning in a future
release if omitted.
=back
-See L<VERSION OBJECT DETAILS> for further information.
-
=head1 DECLARING VERSIONS
If you have a module that uses a decimal $VERSION (floating point), and you
do not intend to ever change that, this module is not for you. There is
nothing that version.pm gains you over a simple $VERSION assignment:
- our $VERSION = 1.02;
+ our $VERSION = "1.02";
-Since Perl v5.10.0 includes the version.pm comparison logic anyways,
+Since Perl v5.10.0 includes the version.pm comparison logic anyways,
you don't need to do anything at all.
=head2 How to convert a module from decimal to dotted-decimal
If you have used a decimal $VERSION in the past and wish to switch to a
dotted-decimal $VERSION, then you need to make a one-time conversion to
-the new format.
+the new format.
B<Important Note>: you must ensure that your new $VERSION is numerically
greater than your current decimal $VERSION; this is not always obvious. First,
use C<parse()> instead of declare. See the L<PARSING AND COMPARING VERSIONS>
for details.
-See also L<VERSION OBJECT DETAILS> for more on version number conversion,
+See also L<version::Internals> for more on version number conversion,
quoting, calculated version numbers and declaring developer or "alpha" version
numbers.
=head1 PARSING AND COMPARING VERSIONS
If you need to compare version numbers, but can't be sure whether they are
-expressed as numbers, strings, v-strings or version objects, then you can
+expressed as numbers, strings, v-strings or version objects, then you should
use version.pm to parse them all into objects for comparison.
=head2 How to C<parse()> a version
"1.2.3" v1.2.3
"v1.2.3" v1.2.3
-See L<VERSION OBJECT DETAILS> for more on version number conversion.
+See L<version::Internals> for more on version number conversion.
+
+=head2 How to check for a legal version string
+
+If you do not want to actually create a full blown version object, but
+would still like to verify that a given string meets the criteria to
+be parsed as a version, there are two helper functions that can be
+employed directly:
+
+=over 4
+
+=item C<is_lax()>
+
+The lax criteria corresponds to what is currently allowed by the
+version parser. All of the following formats are acceptable
+for dotted-decimal formats strings:
+
+ v1.2
+ 1.2345.6
+ v1.23_4
+ 1.2345
+ 1.2345_01
+
+=item C<is_strict()>
+
+If you want to limit youself to a much more narrow definition of what
+a version string constitutes, C<is_strict()> is limited to version
+strings like the following list:
+
+ v1.234.5
+ 2.3456
+
+=back
+
+See L<version::Internals> for details of the regular expressions
+that define the legal version string forms, as well as how to use
+those regular expressions in your own code if C<is_lax()> and
+C<is_strict()> are not sufficient for your needs.
=head2 How to compare version objects
$bool = $v1 < version->parse("v0.96.0"); # TRUE
-=head1 VERSION OBJECT DETAILS
-
-=head2 Equivalence between Decimal and Dotted-Decimal Versions
-
-When Perl 5.6.0 was released, the decision was made to provide a
-transformation between the old-style decimal versions and new-style
-dotted-decimal versions:
-
- 5.6.0 == 5.006000
- 5.005_04 == 5.5.40
-
-The floating point number is taken and split first on the single decimal
-place, then each group of three digits to the right of the decimal makes up
-the next digit, and so on until the number of significant digits is exhausted,
-B<plus> enough trailing zeros to reach the next multiple of three.
-
-This was the method that version.pm adopted as well. Some examples may be
-helpful:
-
- equivalent
- decimal zero-padded dotted-decimal
- ------- ----------- --------------
- 1.2 1.200 v1.200.0
- 1.02 1.020 v1.20.0
- 1.002 1.002 v1.2.0
- 1.0023 1.002300 v1.2.300
- 1.00203 1.002030 v1.2.30
- 1.002003 1.002003 v1.2.3
-
-=head2 Quoting rules
-
-Because of the nature of the Perl parsing and tokenizing routines,
-certain initialization values B<must> be quoted in order to correctly
-parse as the intended version, especially when using the L<declare> or
-L<qv> methods. While you do not have to quote decimal numbers when
-creating version objects, it is always safe to quote B<all> initial values
-when using version.pm methods, as this will ensure that what you type is
-what is used.
+Note that "alpha" version objects (where the version string contains
+a trailing underscore segment) compare as less than the equivalent
+version without an underscore:
-Additionally, if you quote your initializer, then the quoted value that goes
-B<in> will be be exactly what comes B<out> when your $VERSION is printed
-(stringified). If you do not quote your value, Perl's normal numeric handling
-comes into play and you may not get back what you were expecting.
+ $bool = version->parse("1.23_45") < version->parse("1.2345"); # TRUE
-If you use a mathematic formula that resolves to a floating point number,
-you are dependent on Perl's conversion routines to yield the version you
-expect. You are pretty safe by dividing by a power of 10, for example,
-but other operations are not likely to be what you intend. For example:
-
- $VERSION = version->new((qw$Revision: 1.4)[1]/10);
- print $VERSION; # yields 0.14
- $V2 = version->new(100/9); # Integer overflow in decimal number
- print $V2; # yields something like 11.111.111.100
-
-Perl 5.8.1 and beyond are able to automatically quote v-strings but
-that is not possible in earlier versions of Perl. In other words:
-
- $version = version->new("v2.5.4"); # legal in all versions of Perl
- $newvers = version->new(v2.5.4); # legal only in Perl >= 5.8.1
-
-=head2 What about v-strings?
-
-There are two ways to enter v-strings: a bare number with two or more
-decimal points, or a bare number with one or more decimal points and a
-leading 'v' character (also bare). For example:
-
- $vs1 = 1.2.3; # encoded as \1\2\3
- $vs2 = v1.2; # encoded as \1\2
-
-However, the use of bare v-strings to initialize version objects is
-B<strongly> discouraged in all circumstances. Also, bare
-v-strings are not completely supported in any version of Perl prior to
-5.8.1.
-
-If you insist on using bare v-strings with Perl > 5.6.0, be aware of the
-following limitations:
-
-1) For Perl releases 5.6.0 through 5.8.0, the v-string code merely guesses,
-based on some characteristics of v-strings. You B<must> use a three part
-version, e.g. 1.2.3 or v1.2.3 in order for this heuristic to be successful.
-
-2) For Perl releases 5.8.1 and later, v-strings have changed in the Perl
-core to be magical, which means that the version.pm code can automatically
-determine whether the v-string encoding was used.
-
-3) In all cases, a version created using v-strings will have a stringified
-form that has a leading 'v' character, for the simple reason that sometimes
-it is impossible to tell whether one was present initially.
-
-=head2 Alpha versions
-
-For module authors using CPAN, the convention has been to note unstable
-releases with an underscore in the version string. (See L<CPAN>.) version.pm
-follows this convention and alpha releases will test as being newer than the
-more recent stable release, and less than the next stable release. For
-dotted-decimal versions, only the last element may be separated by an
-underscore:
-
- # Declaring
- use version 0.77; our $VERSION = version->declare("v1.2_3");
-
- # Parsing
- $v1 = version->parse("v1.2_3");
- $v1 = version->parse("1.002_003");
+See L<version::Internals> for more details on "alpha" versions.
=head1 OBJECT METHODS
use version 0.77 ();
+=head2 is_lax()
+
+(Not exported by default)
+
+This function takes a scalar argument and returns a boolean value indicating
+whether the argument meets the "lax" rules for a version number. Leading and
+trailing spaces are not allowed.
+
+=head2 is_strict()
+
+(Not exported by default)
+
+This function takes a scalar argument and returns a boolean value indicating
+whether the argument meets the "strict" rules for a version number. Leading
+and trailing spaces are not allowed.
+
=head1 AUTHOR
John Peacock E<lt>jpeacock@cpan.orgE<gt>
=head1 SEE ALSO
-L<version::Internal>.
+L<version::Internals>.
L<perl>.
eval { my $test = ($testobj > 1.0) };
like($@, qr/Invalid version object/,
"Bad subclass vcmp");
+strict_lax_tests();
+
+# do strict lax tests in a sub to isolate a package to test importing
+sub strict_lax_tests {
+ package temp12345;
+ # copied from perl core test t/op/packagev.t
+ # format: STRING STRICT_OK LAX_OK
+ my $strict_lax_data = << 'CASE_DATA';
+1.00 pass pass
+1.00001 pass pass
+0.123 pass pass
+12.345 pass pass
+42 pass pass
+0 pass pass
+0.0 pass pass
+v1.2.3 pass pass
+v1.2.3.4 pass pass
+v0.1.2 pass pass
+v0.0.0 pass pass
+01 fail pass
+01.0203 fail pass
+v01 fail pass
+v01.02.03 fail pass
+.1 fail pass
+.1.2 fail pass
+1. fail pass
+1.a fail fail
+1._ fail fail
+1.02_03 fail pass
+v1.2_3 fail pass
+v1.02_03 fail pass
+v1.2_3_4 fail fail
+v1.2_3.4 fail fail
+1.2_3.4 fail fail
+0_ fail fail
+1_ fail fail
+1_. fail fail
+1.1_ fail fail
+1.02_03_04 fail fail
+1.2.3 fail pass
+v1.2 fail pass
+v0 fail pass
+v1 fail pass
+v.1.2.3 fail fail
+v fail fail
+v1.2345.6 fail pass
+undef fail pass
+1a fail fail
+1.2a3 fail fail
+bar fail fail
+_ fail fail
+CASE_DATA
+
+ require version;
+ version->import( qw/is_strict is_lax/ );
+ for my $case ( split qr/\n/, $strict_lax_data ) {
+ my ($v, $strict, $lax) = split qr/\t+/, $case;
+ main::ok( $strict eq 'pass' ? is_strict($v) : ! is_strict($v), "is_strict($v) [$strict]" );
+ main::ok( $strict eq 'pass' ? version::is_strict($v) : ! version::is_strict($v), "version::is_strict($v) [$strict]" );
+ main::ok( $lax eq 'pass' ? is_lax($v) : ! is_lax($v), "is_lax($v) [$lax]" );
+ main::ok( $lax eq 'pass' ? version::is_lax($v) : ! version::is_lax($v), "version::is_lax($v) [$lax]" );
+ }
+}
sub BaseTests {
# test illegal formats
diag "test illegal formats" unless $ENV{PERL_CORE};
- eval {my $version = $CLASS->$method("1.2_3_4")};
+ eval {$version = $CLASS->$method("1.2_3_4")};
like($@, qr/multiple underscores/,
"Invalid version format (multiple underscores)");
- eval {my $version = $CLASS->$method("1.2_3.4")};
+ eval {$version = $CLASS->$method("1.2_3.4")};
like($@, qr/underscores before decimal/,
"Invalid version format (underscores before decimal)");
- eval {my $version = $CLASS->$method("1_2")};
+ eval {$version = $CLASS->$method("1_2")};
like($@, qr/alpha without decimal/,
"Invalid version format (alpha without decimal)");
- # for this test, upgrade the warn() to die()
- eval {
- local $SIG{__WARN__} = sub { die $_[0] };
- $version = $CLASS->$method("1.2b3");
- };
- my $warnregex = "Version string '.+' contains invalid data; ".
- "ignoring: '.+'";
-
- like($@, qr/$warnregex/,
- "Version string contains invalid data; ignoring");
+ eval { $version = $CLASS->$method("1.2b3")};
+ like($@, qr/non-numeric data/,
+ "Invalid version format (non-numeric data)");
# from here on out capture the warning and test independently
{
- $version = $CLASS->$method("99 and 44/100 pure");
+ eval{$version = $CLASS->$method("99 and 44/100 pure")};
- like($warning, qr/$warnregex/,
- "Version string contains invalid data; ignoring");
- is ("$version", "99", '$version eq "99"');
- ok ($version->numify == 99.0, '$version->numify == 99.0');
- ok ($version->normal eq "v99.0.0", '$version->normal eq v99.0.0');
+ like($@, qr/non-numeric data/,
+ "Invalid version format (non-numeric data)");
- $version = $CLASS->$method("something");
- like($warning, qr/$warnregex/,
- "Version string contains invalid data; ignoring");
- ok (defined $version, 'defined $version');
+ eval{$version = $CLASS->$method("something")};
+ like($@, qr/non-numeric data/,
+ "Invalid version format (non-numeric data)");
# reset the test object to something reasonable
$version = $CLASS->$method("1.2.3");
local $SIG{__WARN__} = sub { $warning = $_[0] };
$DB::single = 1;
- my $v = $CLASS->$method('1,7');
- unlike($warning, qr"Version string '1,7' contains invalid data",
- 'Directly test comma as decimal compliance');
+ my $v = eval { $CLASS->$method('1,7') };
+# is( $@, "", 'Directly test comma as decimal compliance');
my $ver = 1.23; # has to be floating point number
my $orig_loc = setlocale( LC_ALL );
=head1 NAME
-version::Internal - Perl extension for Version Objects
+version::Internals - Perl extension for Version Objects
=head1 DESCRIPTION
Overloaded version objects for all modern versions of Perl. This documents
the internal data representation and underlying code for version.pm. See
L<version.pod> for daily usage. This document is only useful for users
-writing a subclass of version.pm or interested in the gory details.
+interested in the gory details.
-=head1 What IS a version
+=head1 WHAT IS A VERSION?
For the purposes of this module, a version "number" is a sequence of
-positive integer values separated by one or more decimal points and
-optionally a single underscore. This corresponds to what Perl itself
-uses for a version, as well as extending the "version as number" that
+positive integer values separated by one or more decimal points and
+optionally a single underscore. This corresponds to what Perl itself
+uses for a version, as well as extending the "version as number" that
is discussed in the various editions of the Camel book.
There are actually two distinct kinds of version objects:
Any version which "looks like a number", see L<Decimal Versions>. This
also includes versions with a single decimal point and a single embedded
-underscore, see L<Decimal Alpha Versions>, even though these must be quoted
+underscore, see L<Alpha Versions>, even though these must be quoted
to preserve the underscore formatting.
=item Dotted-Decimal Versions
=back
Both of these methods will produce similar version objects, in that
-the default stringification will yield the version L<Normal Form> only
+the default stringification will yield the version L<Normal Form> only
if required:
$v = version->new(1.002); # 1.002, but compares like 1.2.0
will have trailing zeros added to make up the difference, but only for
purposes of comparison with other version objects. For example:
- # Prints Equivalent to
+ # Prints Equivalent to
$v = version->new( 1.2); # 1.2 v1.200.0
$v = version->new( 1.02); # 1.02 v1.20.0
$v = version->new( 1.002); # 1.002 v1.2.0
$v = version->new( 1.00203); # 1.00203 v1.2.30
$v = version->new( 1.002003); # 1.002003 v1.2.3
-All of the preceding examples are true whether or not the input value is
-quoted. The important feature is that the input value contains only a
-single decimal. See also L<version/Alpha Versions> for how to handle
+All of the preceding examples are true whether or not the input value is
+quoted. The important feature is that the input value contains only a
+single decimal. See also L<Alpha Versions>.
-IMPORTANT NOTE: As shown above, if your Decimal version contains more
-than 3 significant digits after the decimal place, it will be split on
-each multiple of 3, so 1.0003 is equivalent to v1.0.300, due to the need
-to remain compatible with Perl's own 5.005_03 == 5.5.30 interpretation.
+IMPORTANT NOTE: As shown above, if your Decimal version contains more
+than 3 significant digits after the decimal place, it will be split on
+each multiple of 3, so 1.0003 is equivalent to v1.0.300, due to the need
+to remain compatible with Perl's own 5.005_03 == 5.5.30 interpretation.
Any trailing zeros are ignored for mathematical comparison purposes.
=head2 Dotted-Decimal Versions
These are the newest form of versions, and correspond to Perl's own
version style beginning with 5.6.0. Starting with Perl 5.10.0,
and most likely Perl 6, this is likely to be the preferred form. This
-method normally requires that the input parameter be quoted, although
+method normally requires that the input parameter be quoted, although
Perl's after 5.8.1 can use v-strings as a special form of quoting, but
this is highly discouraged.
In general, Dotted-Decimal Versions permit the greatest amount of freedom
to specify a version, whereas Decimal Versions enforce a certain
-uniformity. See also L<New Operator> for an additional method of
-initializing version objects.
+uniformity.
-Just like L<Decimal Versions>, Dotted-Decimal Versions can be used as
-L<version/Alpha Versions>.
+Just like L<Decimal Versions>, Dotted-Decimal Versions can be used as
+L<Alpha Versions>.
-=head2 Decimal Alpha Versions
+=head2 Alpha Versions
-The one time that a Decimal version must be quoted is when a alpha form is
-used with an otherwise Decimal version (i.e. a single decimal point). This
-is commonly used for CPAN releases, where CPAN or CPANPLUS will ignore alpha
-versions for automatic updating purposes. Since some developers have used
-only two significant decimal places for their non-alpha releases, the
-version object will automatically take that into account if the initializer
-is quoted. For example Module::Example was released to CPAN with the
-following sequence of $VERSION's:
+For module authors using CPAN, the convention has been to note unstable
+releases with an underscore in the version string. (See L<CPAN>.) version.pm
+follows this convention and alpha releases will test as being newer than the
+more recent stable release, and less than the next stable release. Only the
+last element may be separated by an underscore:
- # $VERSION Stringified
- 0.01 0.01
- 0.02 0.02
- 0.02_01 0.02_01
- 0.02_02 0.02_02
- 0.03 0.03
- etc.
+ # Declaring
+ use version 0.77; our $VERSION = version->declare("v1.2_3");
-The stringified form of Decimal versions will always be the same string
-that was used to initialize the version object.
+ # Parsing
+ $v1 = version->parse("v1.2_3");
+ $v1 = version->parse("1.002_003");
-=head1 High level design
+Note that you B<must> quote the version when writing an alpha Decimal version.
+The stringified form of Decimal versions will always be the same string that
+was used to initialize the version object.
-=head2 version objects
+=head2 Regular Expressions for Version Parsing
-version.pm provides an overloaded version object that is designed to both
+A formalized definition of the legal forms for version strings is
+included in the main F<version.pm> file. Primitives are included for
+common elements, although they are scoped to the file so they are useful
+for reference purposes only. There are two publicly accessible scalars
+that can be used in other code (not exported):
+
+=over 4
+
+=item C<$version::LAX>
+
+This regexp covers all of the legal forms allowed under the current
+version string parser. This is not to say that all of these forms
+are recommended, and some of them can only be used when quoted.
+
+For dotted decimals:
+
+ v1.2
+ 1.2345.6
+ v1.23_4
+
+The leading 'v' is optional if two or more decimals appear. If only
+a single decimal is included, then the leading 'v' is required to
+trigger the dotted-decimal parsing. A leading zero is permitted,
+though not recommended except when quoted, because of the risk that
+Perl will treat the number as octal. A trailing underscore plus one
+or more digits denotes an alpha or development release (and must be
+quoted to be parsed properly).
+
+For decimal versions:
+
+ 1
+ 1.2345
+ 1.2345_01
+
+an integer portion, an optional decimal point, and optionally one or
+more digits to the right of the decimal are all required. A trailing
+underscore is permitted and a leading zero is permitted. Just like
+the lax dotted-decimal version, quoting the values is required for
+alpha/development forms to be parsed correctly.
+
+=item C<$version::STRICT>
+
+This regexp covers a much more limited set of formats and constitutes
+the best practices for initializing version objects. Whether you choose
+to employ decimal or dotted-decimal for is a personal preference however.
+
+=over 4
+
+=item v1.234.5
+
+For dotted-decimal versions, a leading 'v' is required, with three or
+more sub-versions of no more than three digits. A leading 0 (zero)
+before the first sub-version (in the above example, '1') is also
+prohibited.
+
+=item 2.3456
+
+For decimal versions, an integer portion (no leading 0), a decimal point,
+and one or more digits to the right of the decimal are all required.
+
+=back
+
+=back
+
+Both of the provided scalars are already compiled as regular expressions
+and do not contain either anchors or implicit groupings, so they can be
+included in your own regular expressions freely. For example, consider
+the following code:
+
+ ($pkg, $ver) =~ /
+ ^[ \t]*
+ use [ \t]+($PKGNAME)
+ (?:[ \t]+($version::STRICT))?
+ [ \t]*;
+ /x;
+
+This would match a line of the form:
+
+ use Foo::Bar::Baz v1.2.3; # legal only in Perl 5.8.1+
+
+where C<$PKGNAME> is another regular expression that defines the legal
+forms for package names.
+
+=head1 IMPLEMENTATION DETAILS
+
+=head2 Equivalence between Decimal and Dotted-Decimal Versions
+
+When Perl 5.6.0 was released, the decision was made to provide a
+transformation between the old-style decimal versions and new-style
+dotted-decimal versions:
+
+ 5.6.0 == 5.006000
+ 5.005_04 == 5.5.40
+
+The floating point number is taken and split first on the single decimal
+place, then each group of three digits to the right of the decimal makes up
+the next digit, and so on until the number of significant digits is exhausted,
+B<plus> enough trailing zeros to reach the next multiple of three.
+
+This was the method that version.pm adopted as well. Some examples may be
+helpful:
+
+ equivalent
+ decimal zero-padded dotted-decimal
+ ------- ----------- --------------
+ 1.2 1.200 v1.200.0
+ 1.02 1.020 v1.20.0
+ 1.002 1.002 v1.2.0
+ 1.0023 1.002300 v1.2.300
+ 1.00203 1.002030 v1.2.30
+ 1.002003 1.002003 v1.2.3
+
+=head2 Quoting Rules
+
+Because of the nature of the Perl parsing and tokenizing routines,
+certain initialization values B<must> be quoted in order to correctly
+parse as the intended version, especially when using the L<declare> or
+L<qv> methods. While you do not have to quote decimal numbers when
+creating version objects, it is always safe to quote B<all> initial values
+when using version.pm methods, as this will ensure that what you type is
+what is used.
+
+Additionally, if you quote your initializer, then the quoted value that goes
+B<in> will be be exactly what comes B<out> when your $VERSION is printed
+(stringified). If you do not quote your value, Perl's normal numeric handling
+comes into play and you may not get back what you were expecting.
+
+If you use a mathematic formula that resolves to a floating point number,
+you are dependent on Perl's conversion routines to yield the version you
+expect. You are pretty safe by dividing by a power of 10, for example,
+but other operations are not likely to be what you intend. For example:
+
+ $VERSION = version->new((qw$Revision: 1.4)[1]/10);
+ print $VERSION; # yields 0.14
+ $V2 = version->new(100/9); # Integer overflow in decimal number
+ print $V2; # yields something like 11.111.111.100
+
+Perl 5.8.1 and beyond are able to automatically quote v-strings but
+that is not possible in earlier versions of Perl. In other words:
+
+ $version = version->new("v2.5.4"); # legal in all versions of Perl
+ $newvers = version->new(v2.5.4); # legal only in Perl >= 5.8.1
+
+=head2 What about v-strings?
+
+There are two ways to enter v-strings: a bare number with two or more
+decimal points, or a bare number with one or more decimal points and a
+leading 'v' character (also bare). For example:
+
+ $vs1 = 1.2.3; # encoded as \1\2\3
+ $vs2 = v1.2; # encoded as \1\2
+
+However, the use of bare v-strings to initialize version objects is
+B<strongly> discouraged in all circumstances. Also, bare
+v-strings are not completely supported in any version of Perl prior to
+5.8.1.
+
+If you insist on using bare v-strings with Perl > 5.6.0, be aware of the
+following limitations:
+
+1) For Perl releases 5.6.0 through 5.8.0, the v-string code merely guesses,
+based on some characteristics of v-strings. You B<must> use a three part
+version, e.g. 1.2.3 or v1.2.3 in order for this heuristic to be successful.
+
+2) For Perl releases 5.8.1 and later, v-strings have changed in the Perl
+core to be magical, which means that the version.pm code can automatically
+determine whether the v-string encoding was used.
+
+3) In all cases, a version created using v-strings will have a stringified
+form that has a leading 'v' character, for the simple reason that sometimes
+it is impossible to tell whether one was present initially.
+
+=head2 Version Object Internals
+
+version.pm provides an overloaded version object that is designed to both
encapsulate the author's intended $VERSION assignment as well as make it
completely natural to use those objects as if they were numbers (e.g. for
-comparisons). To do this, a version object contains both the original
+comparisons). To do this, a version object contains both the original
representation as typed by the author, as well as a parsed representation
to ease comparisons. Version objects employ L<overload> methods to
simplify code that needs to compare, print, etc the objects.
will also exclusively return the stringified form. See L<Stringification>
for more details.
-=head1 Usage question
+=head1 USAGE DETAILS
=head2 Using modules that use version.pm
=head2 Object Methods
-Overloading has been used with version objects to provide a natural
-interface for their use. All mathematical operations are forbidden,
-since they don't make any sense for base version objects. Consequently,
-there is no overloaded numification available. If you want to use a
-version object in a Decimal context for some reason, see the L<numify>
-object method.
-
=over 4
-=item New Operator
+=item new()
-Like all OO interfaces, the new() operator is used to initialize
-version objects. One way to increment versions when programming is to
-use the CVS variable $Revision, which is automatically incremented by
-CVS every time the file is committed to the repository.
+Like many OO interfaces, the new() method is used to initialize version
+objects. If two arguments are passed to C<new()>, the B<second> one will be
+used as if it were prefixed with "v". This is to support historical use of the
+C<qw> operator with the CVS variable $Revision, which is automatically
+incremented by CVS every time the file is committed to the repository.
In order to facilitate this feature, the following
code can be employed:
$v1 = qv(1.2); # v1.2.0
$v2 = qv("1.2"); # also v1.2.0
-As you can see, either a bare number or a quoted string can usually
+As you can see, either a bare number or a quoted string can usually
be used interchangably, except in the case of a trailing zero, which
must be quoted to be converted properly. For this reason, it is strongly
recommended that all initializers to qv() be quoted strings instead of
require version;
Both methods will prevent the import() method from firing and exporting the
-C<qv()> sub. This is true of subclasses of version as well, see
-L<SUBCLASSING> for details.
+C<qv()> sub.
=back
For the subsequent examples, the following three objects will be used:
- $ver = version->new("1.2.3.4"); # see "Quoting" below
- $alpha = version->new("1.2.3_4"); # see "<version/Alpha versions" below
- $nver = version->new(1.002); # see "Decimal Versions" above
+ $ver = version->new("1.2.3.4"); # see "Quoting Rules"
+ $alpha = version->new("1.2.3_4"); # see "Alpha Versions"
+ $nver = version->new(1.002); # see "Decimal Versions"
=over 4
print $ver->stringify; # ditto
print $ver; # ditto
print $nver->normal; # prints as v1.2.0
- print $nver->stringify; # prints as 1.002, see "Stringification"
+ print $nver->stringify; # prints as 1.002, see "Stringification"
-In order to preserve the meaning of the processed version, the
+In order to preserve the meaning of the processed version, the
normalized representation will always contain at least three sub terms.
In other words, the following is guaranteed to always be true:
=item Numification
Although all mathematical operations on version objects are forbidden
-by default, it is possible to retrieve a number which corresponds
+by default, it is possible to retrieve a number which corresponds
to the version object through the use of the $obj->numify
method. For formatting purposes, when displaying a number which
corresponds a version object, all sub versions are assumed to have
version->new("v1.2") v1.2
qv("1.2.3") 1.2.3
qv("v1.3.5") v1.3.5
- qv("1.2") v1.2 ### exceptional case
+ qv("1.2") v1.2 ### exceptional case
See also L<UNIVERSAL::VERSION>, as this also returns the stringified form
when used as a class method.
It is probably best to chose either the Decimal notation or the string
notation and stick with it, to reduce confusion. Perl6 version objects
-B<may> only support Decimal comparisons. See also L<Quoting>.
+B<may> only support Decimal comparisons. See also L<Quoting Rules>.
WARNING: Comparing version with unequal numbers of decimal points (whether
explicitly or implicitly initialized), may yield unexpected results at
$vobj = version->new($something);
if ( $vobj ) # true only if $something was non-blank
-You can also test whether a version object is an L<version/Alpha version>, for
+You can also test whether a version object is an alpha version, for
example to prevent the use of some feature not present in the main
release:
=back
-=head2 Quoting
-
-Because of the nature of the Perl parsing and tokenizing routines,
-certain initialization values B<must> be quoted in order to correctly
-parse as the intended version, especially when using the L<qv>() operator.
-In all cases, a floating point number passed to version->new() will be
-identically converted whether or not the value itself is quoted. This is
-not true for L<qv>(), however, when trailing zeros would be stripped on
-an unquoted input, which would result in a very different version object.
-
-In addition, in order to be compatible with earlier Perl version styles,
-any use of versions of the form 5.006001 will be translated as v5.6.1.
-In other words, a version with a single decimal point will be parsed as
-implicitly having three digits between subversions, but only for internal
-comparison purposes.
-
-The complicating factor is that in bare numbers (i.e. unquoted), the
-underscore is a legal Decimal character and is automatically stripped
-by the Perl tokenizer before the version code is called. However, if
-a number containing one or more decimals and an underscore is quoted, i.e.
-not bare, that is considered an L<version/Alpha version> and the underscore is
-significant.
-
-If you use a mathematic formula that resolves to a floating point number,
-you are dependent on Perl's conversion routines to yield the version you
-expect. You are pretty safe by dividing by a power of 10, for example,
-but other operations are not likely to be what you intend. For example:
-
- $VERSION = version->new((qw$Revision: 1.4)[1]/10);
- print $VERSION; # yields 0.14
- $V2 = version->new(100/9); # Integer overflow in decimal number
- print $V2; # yields something like 11.111.111.100
-
-Perl 5.8.1 and beyond will be able to automatically quote v-strings but
-that is not possible in earlier versions of Perl. In other words:
-
- $version = version->new("v2.5.4"); # legal in all versions of Perl
- $newvers = version->new(v2.5.4); # legal only in Perl >= 5.8.1
-
-=head1 SUBCLASSING
-
-This module is specifically designed and tested to be easily subclassed.
-In practice, you only need to override the methods you want to change, but
-you have to take some care when overriding new() (since that is where all
-of the parsing takes place). For example, this is a perfect acceptable
-derived class:
-
- package myversion;
- use base version;
- sub new {
- my($self,$n)=@_;
- my $obj;
- # perform any special input handling here
- $obj = $self->SUPER::new($n);
- # and/or add additional hash elements here
- return $obj;
- }
-
-See also L<version::AlphaBeta> on CPAN for an alternate representation of
-version strings.
-
-B<NOTE:> Although the L<qv> operator is not a true class method, but rather a
-function exported into the caller's namespace, a subclass of version will
-inherit an import() function which will perform the correct magic on behalf
-of the subclass.
-
-=head1 EXPORT
-
-qv - Dotted-Decimal Version initialization operator
-
=head1 AUTHOR
John Peacock E<lt>jpeacock@cpan.orgE<gt>
package warnings;
-our $VERSION = '1.08';
+our $VERSION = '1.09';
# Verify that we're called correctly so that warnings will work.
# see also strict.pm.
# Warnings Categories added in Perl 5.011
'imprecision' => 92,
+ 'illegalproto' => 94,
);
our %Bits = (
- 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x15", # [0..46]
+ 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..47]
'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
'closed' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
'exec' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
'exiting' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
'glob' => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
+ 'illegalproto' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40", # [47]
'imprecision' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [46]
'inplace' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23]
'internal' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24]
'severe' => "\x00\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x00", # [21..25]
'signal' => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [26]
'substr' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [27]
- 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x00", # [28..38]
+ 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x40", # [28..38,47]
'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
);
our %DeadBits = (
- 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x2a", # [0..46]
+ 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..47]
'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
'closed' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
'exec' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
'exiting' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
'glob' => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
+ 'illegalproto' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80", # [47]
'imprecision' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [46]
'inplace' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23]
'internal' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24]
'severe' => "\x00\x00\x00\x00\x00\xa8\x0a\x00\x00\x00\x00\x00", # [21..25]
'signal' => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [26]
'substr' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [27]
- 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x00", # [28..38]
+ 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x80", # [28..38,47]
'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
);
$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0";
-$LAST_BIT = 94 ;
+$LAST_BIT = 96 ;
$BYTES = 12 ;
$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
my $command = shift;
if (wantarray) {
my @result= `$subcd $command`;
- warn "$subcd $command: \$?=$?\n" if $?;
+ #warn "$subcd $command: \$?=$?\n" if $?;
print "#> $subcd $command ->\n @result\n" if !$? and $opt_v;
chomp @result;
return @result;
return 0;
}
-my $unpushed_commits = '/*no-op*/';
+my $unpushed_commits = ' ';
my ($read, $branch, $snapshot_created, $commit_id, $describe)= ("") x 5;
-my ($changed, $extra_info, $commit_title, $new_patchnum, $status)= ("") x 5;
+my ($changed, $extra_info, $commit_title)= ("") x 3;
if (my $patch_file= read_file(".patch")) {
($branch, $snapshot_created, $commit_id, $describe) = split /\s+/, $patch_file;
$commit_id = backtick("git rev-parse HEAD");
$describe = backtick("git describe");
my $commit_created = backtick(qq{git log -1 --pretty="format:%ci"});
- $new_patchnum = "describe: $describe";
$extra_info = "git_commit_date='$commit_created'";
+ backtick("git diff --no-ext-diff --quiet --exit-code");
+ $changed = $?;
+ unless ($changed) {
+ backtick("git diff-index --cached --quiet HEAD --");
+ $changed = $?;
+ }
+
if (length $branch && length $remote) {
# git cherry $remote/$branch | awk 'BEGIN{ORS=","} /\+/ {print $2}' | sed -e 's/,$//'
my $unpushed_commit_list =
git_unpushed='$unpushed_commit_list'";
}
}
- if ($changed) { # not touched since init'd. never true.
- $changed = 'true';
+ if ($changed) {
$commit_title = "Derived from:";
- $status='"uncommitted-changes"'
- } else {
- $status='/*clean-working-directory-maybe*/'
}
$commit_title ||= "Commit id:";
}
* WARNING: 'git_version.h' is automatically generated by make_patchnum.pl
* DO NOT EDIT DIRECTLY - edit make_patchnum.pl instead
***************************************************************************/
-#define PERL_GIT_UNCOMMITTED_CHANGES $status
-#define PERL_PATCHNUM "$describe"
+@{[$describe ? "#define PERL_PATCHNUM \"$describe\"" : ()]}
#define PERL_GIT_UNPUSHED_COMMITS\t\t\\
$unpushed_commits/*leave-this-comment*/
+@{[$changed ? "#define PERL_GIT_UNCOMMITTED_CHANGES" : ()]}
EOF_HEADER
######################################################################
# WARNING: 'lib/Config_git.pl' is generated by make_patchnum.pl
print STDERR "Defines: (" . join(' ', sort keys %define) . ")\n";
if ($PLATFORM =~ /^win(?:32|ce)$/) {
- (my $dll = ($define{PERL_DLL} || "perl511")) =~ s/\.dll$//i;
+ (my $dll = ($define{PERL_DLL} || "perl513")) =~ s/\.dll$//i;
print "LIBRARY $dll\n";
# The DESCRIPTION module definition file statement is not supported
# by VC7 onwards.
}
elsif ($PLATFORM eq 'netware') {
if ($FILETYPE eq 'def') {
- print "LIBRARY perl511\n";
+ print "LIBRARY perl513\n";
print "DESCRIPTION 'Perl interpreter for NetWare'\n";
print "EXPORTS\n";
}
PERL_CALLCONV void Perl_sv_taint(pTHX_ SV *sv);
PERL_CALLCONV IV Perl_sv_2iv(pTHX_ register SV *sv);
PERL_CALLCONV UV Perl_sv_2uv(pTHX_ register SV *sv);
+PERL_CALLCONV NV Perl_sv_2nv(pTHX_ register SV *sv);
PERL_CALLCONV char * Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp);
PERL_CALLCONV char * Perl_sv_2pv_nolen(pTHX_ register SV *sv);
PERL_CALLCONV char * Perl_sv_2pvbyte_nolen(pTHX_ register SV *sv);
return sv_2uv_flags(sv, SV_GMAGIC);
}
+/* sv_2nv() is now a macro using Perl_sv_2nv_flags();
+ * this function provided for binary compatibility only
+ */
+
+NV
+Perl_sv_2nv(pTHX_ register SV *sv)
+{
+ return sv_2nv_flags(sv, SV_GMAGIC);
+}
+
+
/* sv_2pv() is now a macro using Perl_sv_2pv_flags();
* this function provided for binary compatibility only
*/
SSCHECK(3);
SSPUSHLONG(*longp);
SSPUSHPTR(longp);
- SSPUSHINT(SAVEt_LONG);
+ SSPUSHUV(SAVEt_LONG);
}
void
SSCHECK(3);
SSPUSHIV(*ivp);
SSPUSHPTR(ivp);
- SSPUSHINT(SAVEt_IV);
+ SSPUSHUV(SAVEt_IV);
}
void
SSCHECK(2);
SSPUSHPTR(gv);
- SSPUSHINT(SAVEt_NSTAB);
+ SSPUSHUV(SAVEt_NSTAB);
}
void
SSCHECK(3);
SSPUSHPTR(sarg[i]); /* remember the pointer */
SSPUSHPTR(sv); /* remember the value */
- SSPUSHINT(SAVEt_ITEM);
+ SSPUSHUV(SAVEt_ITEM);
}
}
# include <sys/pstat.h>
#endif
+#ifdef HAS_PRCTL_SET_NAME
+# include <sys/prctl.h>
+#endif
+
#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
Signal_t Perl_csighandler(int sig, siginfo_t *, void *);
#else
case PERL_MAGIC_arylen_p:
case PERL_MAGIC_rhash:
case PERL_MAGIC_symtab:
+ case PERL_MAGIC_tied: /* treat as value, so 'local @tied' isn't tied */
+ case PERL_MAGIC_tiedscalar: /* so 'local $scalar' isn't tied */
return 0;
default:
return 1;
{
dVAR;
const I32 mgs_ix = SSNEW(sizeof(MGS));
- const bool was_temp = (bool)SvTEMP(sv);
+ const bool was_temp = cBOOL(SvTEMP(sv));
bool have_new = 0;
MAGIC *newmg, *head, *cur, *mg;
/* guard against sv having being freed midway by holding a private
}
break;
case '^':
- if (GvIOp(PL_defoutgv))
- s = IoTOP_NAME(GvIOp(PL_defoutgv));
+ if (!isGV_with_GP(PL_defoutgv))
+ s = "";
+ else if (GvIOp(PL_defoutgv))
+ s = IoTOP_NAME(GvIOp(PL_defoutgv));
if (s)
sv_setpv(sv,s);
else {
}
break;
case '~':
- if (GvIOp(PL_defoutgv))
+ if (!isGV_with_GP(PL_defoutgv))
+ s = "";
+ else if (GvIOp(PL_defoutgv))
s = IoFMT_NAME(GvIOp(PL_defoutgv));
if (!s)
s = GvENAME(PL_defoutgv);
sv_setpv(sv,s);
break;
case '=':
- if (GvIOp(PL_defoutgv))
+ if (GvIO(PL_defoutgv))
sv_setiv(sv, (IV)IoPAGE_LEN(GvIOp(PL_defoutgv)));
break;
case '-':
- if (GvIOp(PL_defoutgv))
+ if (GvIO(PL_defoutgv))
sv_setiv(sv, (IV)IoLINES_LEFT(GvIOp(PL_defoutgv)));
break;
case '%':
- if (GvIOp(PL_defoutgv))
+ if (GvIO(PL_defoutgv))
sv_setiv(sv, (IV)IoPAGE(GvIOp(PL_defoutgv)));
break;
case ':':
sv_setiv(sv, (IV)CopARYBASE_get(PL_curcop));
break;
case '|':
- if (GvIOp(PL_defoutgv))
+ if (GvIO(PL_defoutgv))
sv_setiv(sv, (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0 );
break;
case '\\':
sv_copypv(sv, PL_ors_sv);
break;
case '!':
+ {
+ dSAVE_ERRNO;
#ifdef VMS
sv_setnv(sv, (NV)((errno == EVMSERR) ? vaxc$errno : errno));
- sv_setpv(sv, errno ? Strerror(errno) : "");
#else
- {
- dSAVE_ERRNO;
sv_setnv(sv, (NV)errno);
+#endif
#ifdef OS2
if (errno == errno_isOS2 || errno == errno_isOS2_set)
sv_setpv(sv, os2error(Perl_rc));
else
#endif
sv_setpv(sv, errno ? Strerror(errno) : "");
+ if (SvPOKp(sv))
+ SvPOK_on(sv); /* may have got removed during taint processing */
RESTORE_ERRNO;
}
-#endif
+
SvRTRIM(sv);
SvNOK_on(sv); /* what a wonderful hack! */
break;
return 0;
}
-/* caller is responsible for stack switching/cleanup */
-STATIC int
-S_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, I32 flags, int n, SV *val)
+/*
+=for apidoc magic_methcall
+
+Invoke a magic method (like FETCH).
+
+* sv and mg are the tied thinggy and the tie magic;
+* meth is the name of the method to call;
+* argc, arg1, arg2 are the number of args (in addition to $self) to pass to
+ the method, and the args themselves
+* flags:
+ G_DISCARD: invoke method with G_DISCARD flag and don't return a value
+ G_UNDEF_FILL: fill the stack with argc pointers to PL_sv_undef;
+ ignore arg1 and arg2.
+
+Returns the SV (if any) returned by the method, or NULL on failure.
+
+
+=cut
+*/
+
+SV*
+Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags,
+ U32 argc, ...)
{
dVAR;
dSP;
+ SV* ret = NULL;
PERL_ARGS_ASSERT_MAGIC_METHCALL;
+ ENTER;
+ PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
- EXTEND(SP, n);
+
+ EXTEND(SP, argc+1);
PUSHs(SvTIED_obj(sv, mg));
- if (n > 1) {
- if (mg->mg_ptr) {
- if (mg->mg_len >= 0)
- mPUSHp(mg->mg_ptr, mg->mg_len);
- else if (mg->mg_len == HEf_SVKEY)
- PUSHs(MUTABLE_SV(mg->mg_ptr));
- }
- else if (mg->mg_type == PERL_MAGIC_tiedelem) {
- mPUSHi(mg->mg_len);
+ if (flags & G_UNDEF_FILL) {
+ while (argc--) {
+ PUSHs(&PL_sv_undef);
}
- }
- if (n > 2) {
- PUSHs(val);
+ } else if (argc > 0) {
+ va_list args;
+ va_start(args, argc);
+
+ do {
+ SV *const sv = va_arg(args, SV *);
+ PUSHs(sv);
+ } while (--argc);
+
+ va_end(args);
}
PUTBACK;
+ if (flags & G_DISCARD) {
+ call_method(meth, G_SCALAR|G_DISCARD);
+ }
+ else {
+ if (call_method(meth, G_SCALAR))
+ ret = *PL_stack_sp--;
+ }
+ POPSTACK;
+ LEAVE;
+ return ret;
+}
+
- return call_method(meth, flags);
+/* wrapper for magic_methcall that creates the first arg */
+
+STATIC SV*
+S_magic_methcall1(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags,
+ int n, SV *val)
+{
+ dVAR;
+ SV* arg1 = NULL;
+
+ PERL_ARGS_ASSERT_MAGIC_METHCALL1;
+
+ if (mg->mg_ptr) {
+ if (mg->mg_len >= 0) {
+ arg1 = newSVpvn_flags(mg->mg_ptr, mg->mg_len, SVs_TEMP);
+ }
+ else if (mg->mg_len == HEf_SVKEY)
+ arg1 = MUTABLE_SV(mg->mg_ptr);
+ }
+ else if (mg->mg_type == PERL_MAGIC_tiedelem) {
+ arg1 = newSViv((IV)(mg->mg_len));
+ sv_2mortal(arg1);
+ }
+ if (!arg1) {
+ return Perl_magic_methcall(aTHX_ sv, mg, meth, flags, n - 1, val);
+ }
+ return Perl_magic_methcall(aTHX_ sv, mg, meth, flags, n, arg1, val);
}
STATIC int
S_magic_methpack(pTHX_ SV *sv, const MAGIC *mg, const char *meth)
{
- dVAR; dSP;
+ dVAR;
+ SV* ret;
PERL_ARGS_ASSERT_MAGIC_METHPACK;
- ENTER;
- SAVETMPS;
- PUSHSTACKi(PERLSI_MAGIC);
-
- if (magic_methcall(sv, mg, meth, G_SCALAR, 2, NULL)) {
- sv_setsv(sv, *PL_stack_sp--);
- }
-
- POPSTACK;
- FREETMPS;
- LEAVE;
+ ret = magic_methcall1(sv, mg, meth, 0, 1, NULL);
+ if (ret)
+ sv_setsv(sv, ret);
return 0;
}
{
PERL_ARGS_ASSERT_MAGIC_GETPACK;
- if (mg->mg_ptr)
+ if (mg->mg_type == PERL_MAGIC_tiedelem)
mg->mg_flags |= MGf_GSKIP;
magic_methpack(sv,mg,"FETCH");
return 0;
int
Perl_magic_setpack(pTHX_ SV *sv, MAGIC *mg)
{
- dVAR; dSP;
+ dVAR;
+ MAGIC *tmg;
+ SV *val;
PERL_ARGS_ASSERT_MAGIC_SETPACK;
- ENTER;
- PUSHSTACKi(PERLSI_MAGIC);
- magic_methcall(sv, mg, "STORE", G_SCALAR|G_DISCARD, 3, sv);
- POPSTACK;
- LEAVE;
+ /* in the code C<$tied{foo} = $val>, the "thing" that gets passed to
+ * STORE() is not $val, but rather a PVLV (the sv in this call), whose
+ * public flags indicate its value based on copying from $val. Doing
+ * mg_set() on the PVLV temporarily does SvMAGICAL_off(), then calls us.
+ * So STORE()'s $_[2] arg is a temporarily disarmed PVLV. This goes
+ * wrong if $val happened to be tainted, as sv hasn't got magic
+ * enabled, even though taint magic is in the chain. In which case,
+ * fake up a temporary tainted value (this is easier than temporarily
+ * re-enabling magic on sv). */
+
+ if (PL_tainting && (tmg = mg_find(sv, PERL_MAGIC_taint))
+ && (tmg->mg_len & 1))
+ {
+ val = sv_mortalcopy(sv);
+ SvTAINTED_on(val);
+ }
+ else
+ val = sv;
+
+ magic_methcall1(sv, mg, "STORE", G_DISCARD, 2, val);
return 0;
}
U32
Perl_magic_sizepack(pTHX_ SV *sv, MAGIC *mg)
{
- dVAR; dSP;
+ dVAR;
I32 retval = 0;
+ SV* retsv;
PERL_ARGS_ASSERT_MAGIC_SIZEPACK;
- ENTER;
- SAVETMPS;
- PUSHSTACKi(PERLSI_MAGIC);
- if (magic_methcall(sv, mg, "FETCHSIZE", G_SCALAR, 2, NULL)) {
- sv = *PL_stack_sp--;
- retval = SvIV(sv)-1;
+ retsv = magic_methcall1(sv, mg, "FETCHSIZE", 0, 1, NULL);
+ if (retsv) {
+ retval = SvIV(retsv)-1;
if (retval < -1)
Perl_croak(aTHX_ "FETCHSIZE returned a negative value");
}
- POPSTACK;
- FREETMPS;
- LEAVE;
return (U32) retval;
}
int
Perl_magic_wipepack(pTHX_ SV *sv, MAGIC *mg)
{
- dVAR; dSP;
+ dVAR;
PERL_ARGS_ASSERT_MAGIC_WIPEPACK;
- ENTER;
- PUSHSTACKi(PERLSI_MAGIC);
- PUSHMARK(SP);
- XPUSHs(SvTIED_obj(sv, mg));
- PUTBACK;
- call_method("CLEAR", G_SCALAR|G_DISCARD);
- POPSTACK;
- LEAVE;
-
+ Perl_magic_methcall(aTHX_ sv, mg, "CLEAR", G_DISCARD, 0);
return 0;
}
int
Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key)
{
- dVAR; dSP;
- const char * const meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
+ dVAR;
+ SV* ret;
PERL_ARGS_ASSERT_MAGIC_NEXTPACK;
- ENTER;
- SAVETMPS;
- PUSHSTACKi(PERLSI_MAGIC);
- PUSHMARK(SP);
- EXTEND(SP, 2);
- PUSHs(SvTIED_obj(sv, mg));
- if (SvOK(key))
- PUSHs(key);
- PUTBACK;
-
- if (call_method(meth, G_SCALAR))
- sv_setsv(key, *PL_stack_sp--);
-
- POPSTACK;
- FREETMPS;
- LEAVE;
+ ret = SvOK(key) ? Perl_magic_methcall(aTHX_ sv, mg, "NEXTKEY", 0, 1, key)
+ : Perl_magic_methcall(aTHX_ sv, mg, "FIRSTKEY", 0, 0);
+ if (ret)
+ sv_setsv(key,ret);
return 0;
}
SV *
Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
{
- dVAR; dSP;
+ dVAR;
SV *retval;
SV * const tied = SvTIED_obj(MUTABLE_SV(hv), mg);
HV * const pkg = SvSTASH((const SV *)SvRV(tied));
}
/* there is a SCALAR method that we can call */
- ENTER;
- PUSHSTACKi(PERLSI_MAGIC);
- PUSHMARK(SP);
- EXTEND(SP, 1);
- PUSHs(tied);
- PUTBACK;
-
- if (call_method("SCALAR", G_SCALAR))
- retval = *PL_stack_sp--;
- else
+ retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(hv), mg, "SCALAR", 0, 0);
+ if (!retval)
retval = &PL_sv_undef;
- POPSTACK;
- LEAVE;
return retval;
}
STRLEN len;
SV * const lsv = LvTARG(sv);
const char * const tmps = SvPV_const(lsv,len);
- I32 offs = LvTARGOFF(sv);
- I32 rem = LvTARGLEN(sv);
+ STRLEN offs = LvTARGOFF(sv);
+ STRLEN rem = LvTARGLEN(sv);
PERL_ARGS_ASSERT_MAGIC_GETSUBSTR;
PERL_UNUSED_ARG(mg);
if (SvUTF8(lsv))
- sv_pos_u2b(lsv, &offs, &rem);
- if (offs > (I32)len)
+ offs = sv_pos_u2b_flags(lsv, offs, &rem, SV_CONST_RETURN);
+ if (offs > len)
offs = len;
- if (rem + offs > (I32)len)
+ if (rem > len - offs)
rem = len - offs;
- sv_setpvn(sv, tmps + offs, (STRLEN)rem);
+ sv_setpvn(sv, tmps + offs, rem);
if (SvUTF8(lsv))
SvUTF8_on(sv);
return 0;
STRLEN len;
const char * const tmps = SvPV_const(sv, len);
SV * const lsv = LvTARG(sv);
- I32 lvoff = LvTARGOFF(sv);
- I32 lvlen = LvTARGLEN(sv);
+ STRLEN lvoff = LvTARGOFF(sv);
+ STRLEN lvlen = LvTARGLEN(sv);
PERL_ARGS_ASSERT_MAGIC_SETSUBSTR;
PERL_UNUSED_ARG(mg);
if (DO_UTF8(sv)) {
sv_utf8_upgrade(lsv);
- sv_pos_u2b(lsv, &lvoff, &lvlen);
+ lvoff = sv_pos_u2b_flags(lsv, lvoff, &lvlen, SV_CONST_RETURN);
sv_insert(lsv, lvoff, lvlen, tmps, len);
LvTARGLEN(sv) = sv_len_utf8(sv);
SvUTF8_on(lsv);
}
else if (lsv && SvUTF8(lsv)) {
const char *utf8;
- sv_pos_u2b(lsv, &lvoff, &lvlen);
+ lvoff = sv_pos_u2b_flags(lsv, lvoff, &lvlen, SV_CONST_RETURN);
LvTARGLEN(sv) = len;
utf8 = (char*)bytes_to_utf8((U8*)tmps, &len);
sv_insert(lsv, lvoff, lvlen, utf8, len);
LvTARGLEN(sv) = len;
}
-
return 0;
}
PERL_ARGS_ASSERT_MAGIC_SETMGLOB;
PERL_UNUSED_CONTEXT;
mg->mg_len = -1;
- SvSCREAM_off(sv);
+ if (!isGV_with_GP(sv))
+ SvSCREAM_off(sv);
return 0;
}
sv_setsv(PL_bodytarget, sv);
break;
case '\003': /* ^C */
- PL_minus_c = (bool)SvIV(sv);
+ PL_minus_c = cBOOL(SvIV(sv));
break;
case '\004': /* ^D */
IoLINES(GvIOp(PL_last_in_gv)) = SvIV(sv);
break;
case '^':
- Safefree(IoTOP_NAME(GvIOp(PL_defoutgv)));
- s = IoTOP_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv);
- IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv, GV_ADD, SVt_PVIO);
+ if (isGV_with_GP(PL_defoutgv)) {
+ Safefree(IoTOP_NAME(GvIOp(PL_defoutgv)));
+ s = IoTOP_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv);
+ IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv, GV_ADD, SVt_PVIO);
+ }
break;
case '~':
- Safefree(IoFMT_NAME(GvIOp(PL_defoutgv)));
- s = IoFMT_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv);
- IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv, GV_ADD, SVt_PVIO);
+ if (isGV_with_GP(PL_defoutgv)) {
+ Safefree(IoFMT_NAME(GvIOp(PL_defoutgv)));
+ s = IoFMT_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv);
+ IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv, GV_ADD, SVt_PVIO);
+ }
break;
case '=':
- IoPAGE_LEN(GvIOp(PL_defoutgv)) = (SvIV(sv));
+ if (isGV_with_GP(PL_defoutgv))
+ IoPAGE_LEN(GvIOp(PL_defoutgv)) = (SvIV(sv));
break;
case '-':
- IoLINES_LEFT(GvIOp(PL_defoutgv)) = (SvIV(sv));
- if (IoLINES_LEFT(GvIOp(PL_defoutgv)) < 0L)
- IoLINES_LEFT(GvIOp(PL_defoutgv)) = 0L;
+ if (isGV_with_GP(PL_defoutgv)) {
+ IoLINES_LEFT(GvIOp(PL_defoutgv)) = (SvIV(sv));
+ if (IoLINES_LEFT(GvIOp(PL_defoutgv)) < 0L)
+ IoLINES_LEFT(GvIOp(PL_defoutgv)) = 0L;
+ }
break;
case '%':
- IoPAGE(GvIOp(PL_defoutgv)) = (SvIV(sv));
+ if (isGV_with_GP(PL_defoutgv))
+ IoPAGE(GvIOp(PL_defoutgv)) = (SvIV(sv));
break;
case '|':
{
- IO * const io = GvIOp(PL_defoutgv);
+ IO * const io = GvIO(PL_defoutgv);
if(!io)
break;
if ((SvIV(sv)) == 0)
#endif
#endif
PL_uid = PerlProc_getuid();
- PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
break;
case '>':
PL_euid = SvIV(sv);
#endif
#endif
PL_euid = PerlProc_geteuid();
- PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
break;
case '(':
PL_gid = SvIV(sv);
#endif
#endif
PL_gid = PerlProc_getgid();
- PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
break;
case ')':
#ifdef HAS_SETGROUPS
#endif
#endif
PL_egid = PerlProc_getegid();
- PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
break;
case ':':
PL_chopset = SvPV_force(sv,len);
PL_origargv[0][PL_origalen-1] = 0;
for (i = 1; i < PL_origargc; i++)
PL_origargv[i] = 0;
+#ifdef HAS_PRCTL_SET_NAME
+ /* Set the legacy process name in addition to the POSIX name on Linux */
+ if (prctl(PR_SET_NAME, (unsigned long)s, 0, 0, 0) != 0) {
+ /* diag_listed_as: SKIPME */
+ Perl_croak(aTHX_ "Can't set $0 with prctl(): %s", Strerror(errno));
+ }
+#endif
}
#endif
UNLOCK_DOLLARZERO_MUTEX;
(void)rsignal(sig, PL_csighandlerp);
#endif
#endif /* !PERL_MICRO */
- Perl_die(aTHX_ NULL);
+ die_sv(ERRSV);
}
cleanup:
if (flags & 1)
*/
if (PL_savestack_ix == mgs->mgs_ss_ix)
{
- I32 popval = SSPOPINT;
+ UV popval = SSPOPUV;
assert(popval == SAVEt_DESTRUCTOR_X);
PL_savestack_ix -= 2;
- popval = SSPOPINT;
- assert(popval == SAVEt_ALLOC);
- popval = SSPOPINT;
- PL_savestack_ix -= popval;
+ popval = SSPOPUV;
+ assert((popval & SAVE_MASK) == SAVEt_ALLOC);
+ PL_savestack_ix -= popval >> SAVE_TIGHT_SHIFT;
}
}
#define MGf_TAINTEDDIR 1 /* PERL_MAGIC_envelem only */
#define MGf_MINMATCH 1 /* PERL_MAGIC_regex_global only */
#define MGf_REFCOUNTED 2
-#define MGf_GSKIP 4
+#define MGf_GSKIP 4 /* skip further GETs until after next SET */
#define MGf_COPY 8 /* has an svt_copy MGVTBL entry */
#define MGf_DUP 0x10 /* has an svt_dup MGVTBL entry */
#define MGf_LOCAL 0x20 /* has an svt_local MGVTBL entry */
NV value_nv = 0;
const UV max_div_2 = UV_MAX / 2;
- const bool allow_underscores = (bool)(*flags & PERL_SCAN_ALLOW_UNDERSCORES);
+ const bool allow_underscores = cBOOL(*flags & PERL_SCAN_ALLOW_UNDERSCORES);
bool overflowed = FALSE;
char bit;
UV value = 0;
NV value_nv = 0;
const UV max_div_16 = UV_MAX / 16;
- const bool allow_underscores = (bool)(*flags & PERL_SCAN_ALLOW_UNDERSCORES);
+ const bool allow_underscores = cBOOL(*flags & PERL_SCAN_ALLOW_UNDERSCORES);
bool overflowed = FALSE;
PERL_ARGS_ASSERT_GROK_HEX;
UV value = 0;
NV value_nv = 0;
const UV max_div_8 = UV_MAX / 8;
- const bool allow_underscores = (bool)(*flags & PERL_SCAN_ALLOW_UNDERSCORES);
+ const bool allow_underscores = cBOOL(*flags & PERL_SCAN_ALLOW_UNDERSCORES);
bool overflowed = FALSE;
PERL_ARGS_ASSERT_GROK_OCT;
o->op_targ = 0;
goto retry;
}
+ case OP_ENTERTRY:
case OP_ENTEREVAL: /* Was holding hints. */
o->op_targ = 0;
break;
&& looks_like_bool(cLOGOPo->op_first->op_sibling));
case OP_NULL:
+ case OP_SCALAR:
return (
o->op_flags & OPf_KIDS
&& looks_like_bool(cUNOPo->op_first));
- case OP_SCALAR:
- return looks_like_bool(cUNOPo->op_first);
-
-
case OP_ENTERSUB:
case OP_NOT: case OP_XOR:
)&& !attrs) {
if (CvFLAGS(PL_compcv)) {
/* might have had built-in attrs applied */
- CvFLAGS(cv) |= (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS);
+ if (CvLVALUE(PL_compcv) && ! CvLVALUE(cv) && ckWARN(WARN_MISC))
+ Perl_warner(aTHX_ packWARN(WARN_MISC), "lvalue attribute ignored after the subroutine has been defined");
+ CvFLAGS(cv) |= (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS & ~CVf_LVALUE);
}
/* just a "sub foo;" when &foo is already defined */
SAVEFREESV(PL_compcv);
&& block->op_type != OP_NULL
#endif
) {
+ cv_flags_t existing_builtin_attrs = CvFLAGS(cv) & CVf_BUILTIN_ATTRS;
cv_undef(cv);
- CvFLAGS(cv) = CvFLAGS(PL_compcv);
+ CvFLAGS(cv) = CvFLAGS(PL_compcv) | existing_builtin_attrs;
if (!CvWEAKOUTSIDE(cv))
SvREFCNT_dec(CvOUTSIDE(cv));
CvOUTSIDE(cv) = CvOUTSIDE(PL_compcv);
PERL_ARGS_ASSERT_CK_SHIFT;
if (!(o->op_flags & OPf_KIDS)) {
- OP *argop = newUNOP(OP_RV2AV, 0,
- scalar(newGVOP(OP_GV, 0, CvUNIQUE(PL_compcv) ? PL_argvgv : PL_defgv)));
+ OP *argop;
+
+ if (!CvUNIQUE(PL_compcv)) {
+ o->op_flags |= OPf_SPECIAL;
+ return o;
+ }
+
+ argop = newUNOP(OP_RV2AV, 0, scalar(newGVOP(OP_GV, 0, PL_argvgv)));
#ifdef PERL_MAD
OP * const oldo = o;
o = newUNOP(type, 0, scalar(argop));
container of the rep_op var */
STATIC OP *
S_opt_scalarhv(pTHX_ OP *rep_op) {
+ dVAR;
UNOP *unop;
PERL_ARGS_ASSERT_OPT_SCALARHV;
){
OP * nop = o;
OP * lop = o;
- if (!(nop->op_flags && OPf_WANT_VOID)) {
+ if (!((nop->op_flags & OPf_WANT) == OPf_WANT_VOID)) {
while (nop && nop->op_next) {
switch (nop->op_next->op_type) {
case OP_NOT:
}
}
}
- if (lop->op_flags && OPf_WANT_VOID) {
+ if ((lop->op_flags & OPf_WANT) == OPf_WANT_VOID) {
if (fop->op_type == OP_PADHV || fop->op_type == OP_RV2HV)
cLOGOP->op_first = opt_scalarhv(fop);
if (sop && (sop->op_type == OP_PADHV || sop->op_type == OP_RV2HV))
: G_SCALAR) \
: dowantarray())
-/* NOTE: OP_NEXTSTATE, OP_DBSTATE, and OP_SETSTATE (i.e. COPs) carry lower
+/* NOTE: OP_NEXTSTATE and OP_DBSTATE (i.e. COPs) carry lower
* bits of PL_hints in op_private */
/* Private for lvalues */
Note that formats are treated as anon subs, and are cloned each time
write is called (if necessary).
-The flag SVf_PADSTALE is cleared on lexicals each time the my() is executed,
+The flag SVs_PADSTALE is cleared on lexicals each time the my() is executed,
and set on scope exit. This allows the 'Variable $x is not available' warning
to be generated in evals, such as
{ my $x = 1; sub f { eval '$x'} } f();
-For state vars, SVf_PADSTALE is overloaded to mean 'not yet initialised'
+For state vars, SVs_PADSTALE is overloaded to mean 'not yet initialised'
=cut
*/
* exactly on the third column */
#define PERL_REVISION 5 /* age */
-#define PERL_VERSION 11 /* epoch */
-#define PERL_SUBVERSION 3 /* generation */
+#define PERL_VERSION 13 /* epoch */
+#define PERL_SUBVERSION 0 /* generation */
/* The following numbers describe the earliest compatible version of
Perl ("compatibility" here being defined as sufficient binary/API
to include in @INC. See INSTALL for how this works.
*/
#define PERL_API_REVISION 5 /* Adjust manually as needed. */
-#define PERL_API_VERSION 11 /* Adjust manually as needed. */
+#define PERL_API_VERSION 13 /* Adjust manually as needed. */
#define PERL_API_SUBVERSION 0 /* Adjust manually as needed. */
/*
XXX Note: The selection of non-default Configure options, such
while (<PLIN>) {
if (/\t,NULL/ and $seen) {
while (my $c = shift @ARGV){
+ $c =~ s|\\|\\\\|g;
+ $c =~ s|"|\\"|g;
print PLOUT qq{\t,"$c"\n};
}
}
#if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT)
# if defined(PERL_IS_MINIPERL)
# define PERL_PATCHNUM "UNKNOWN-miniperl"
-# define PERL_GIT_UNCOMMITTED_CHANGES ,"UNKNOWN"
# define PERL_GIT_UNPUSHED_COMMITS /*leave-this-comment*/
# elif defined(PERL_MICRO)
# define PERL_PATCHNUM "UNKNOWN-microperl"
-# define PERL_GIT_UNCOMMITTED_CHANGES ,"UNKNOWN"
# define PERL_GIT_UNPUSHED_COMMITS /*leave-this-comment*/
# else
#include "git_version.h"
# endif
static const char * const local_patches[] = {
NULL
+#ifdef PERL_GIT_UNCOMMITTED_CHANGES
+ ,"uncommitted-changes"
+#endif
PERL_GIT_UNPUSHED_COMMITS /* do not remove this line */
- PERL_GIT_UNCOMMITTED_CHANGES /* do not remove this line */
,NULL
};
/* perl.c
*
* Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001
- * 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 by Larry Wall and others
+ * 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 by Larry Wall
+ * and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
PerlIO_printf(Perl_debug_log, "leaked: sv=0x%p"
" flags=0x%"UVxf
" refcnt=%"UVuf pTHX__FORMAT "\n"
- "\tallocated at %s:%d %s %s%s\n",
+ "\tallocated at %s:%d %s %s%s; serial %"UVuf"\n",
(void*)sv, (UV)sv->sv_flags, (UV)sv->sv_refcnt
pTHX__VALUE,
sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
sv->sv_debug_inpad ? "for" : "by",
sv->sv_debug_optype ?
PL_op_name[sv->sv_debug_optype]: "(none)",
- sv->sv_debug_cloned ? " (cloned)" : ""
+ sv->sv_debug_cloned ? " (cloned)" : "",
+ sv->sv_debug_serial
);
#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
Perl_dump_sv_child(aTHX_ sv);
" DEBUGGING"
# endif
# ifdef NO_MATHOMS
- " NO_MATHOMS"
+ " NO_MATHOMS"
# endif
# ifdef PERL_DISABLE_PMC
" PERL_DISABLE_PMC"
# ifdef PERL_USE_SAFE_PUTENV
" PERL_USE_SAFE_PUTENV"
# endif
-# ifdef USE_SITECUSTOMIZE
- " USE_SITECUSTOMIZE"
-# endif
+# ifdef USE_ATTRIBUTES_FOR_PERLIO
+ " USE_ATTRIBUTES_FOR_PERLIO"
+# endif
# ifdef USE_FAST_STDIO
" USE_FAST_STDIO"
# endif
+# ifdef USE_PERL_ATOF
+ " USE_PERL_ATOF"
+# endif
+# ifdef USE_SITECUSTOMIZE
+ " USE_SITECUSTOMIZE"
+# endif
;
PERL_UNUSED_ARG(cv);
PERL_UNUSED_ARG(items);
#endif
ENTER;
+ PL_restartjmpenv = NULL;
PL_restartop = 0;
return NULL;
}
/* do it */
if (PL_restartop) {
+ PL_restartjmpenv = NULL;
PL_op = PL_restartop;
PL_restartop = 0;
CALLRUNOPS(aTHX);
/* NOTREACHED */
case 3:
if (PL_restartop) {
+ PL_restartjmpenv = NULL;
PL_op = PL_restartop;
PL_restartop = 0;
goto redo_body;
/* NOTREACHED */
case 3:
if (PL_restartop) {
+ PL_restartjmpenv = NULL;
PL_op = PL_restartop;
PL_restartop = 0;
goto redo_body;
/* This message really ought to be max 23 lines.
* Removed -h because the user already knows that option. Others? */
+ /* Grouped as 6 lines per C string literal, to keep under the ANSI C 89
+ minimum of 509 character string literals. */
static const char * const usage_msg[] = {
-"-0[octal] specify record separator (\\0, if no argument)",
-"-a autosplit mode with -n or -p (splits $_ into @F)",
-"-C[number/list] enables the listed Unicode features",
-"-c check syntax only (runs BEGIN and CHECK blocks)",
-"-d[:debugger] run program under debugger",
-"-D[number/list] set debugging flags (argument is a bit mask or alphabets)",
-"-e program one line of program (several -e's allowed, omit programfile)",
-"-E program like -e, but enables all optional features",
-"-f don't do $sitelib/sitecustomize.pl at startup",
-"-F/pattern/ split() pattern for -a switch (//'s are optional)",
-"-i[extension] edit <> files in place (makes backup if extension supplied)",
-"-Idirectory specify @INC/#include directory (several -I's allowed)",
-"-l[octal] enable line ending processing, specifies line terminator",
-"-[mM][-]module execute \"use/no module...\" before executing program",
-"-n assume \"while (<>) { ... }\" loop around program",
-"-p assume loop like -n but print line also, like sed",
-"-s enable rudimentary parsing for switches after programfile",
-"-S look for programfile using PATH environment variable",
-"-t enable tainting warnings",
-"-T enable tainting checks",
-"-u dump core after parsing program",
-"-U allow unsafe operations",
-"-v print version, subversion (includes VERY IMPORTANT perl info)",
-"-V[:variable] print configuration summary (or a single Config.pm variable)",
-"-w enable many useful warnings (RECOMMENDED)",
-"-W enable all warnings",
-"-x[directory] strip off text before #!perl line and perhaps cd to directory",
-"-X disable all warnings",
-"\n",
+" -0[octal] specify record separator (\\0, if no argument)\n"
+" -a autosplit mode with -n or -p (splits $_ into @F)\n"
+" -C[number/list] enables the listed Unicode features\n"
+" -c check syntax only (runs BEGIN and CHECK blocks)\n"
+" -d[:debugger] run program under debugger\n"
+" -D[number/list] set debugging flags (argument is a bit mask or alphabets)\n",
+" -e program one line of program (several -e's allowed, omit programfile)\n"
+" -E program like -e, but enables all optional features\n"
+" -f don't do $sitelib/sitecustomize.pl at startup\n"
+" -F/pattern/ split() pattern for -a switch (//'s are optional)\n"
+" -i[extension] edit <> files in place (makes backup if extension supplied)\n"
+" -Idirectory specify @INC/#include directory (several -I's allowed)\n",
+" -l[octal] enable line ending processing, specifies line terminator\n"
+" -[mM][-]module execute \"use/no module...\" before executing program\n"
+" -n assume \"while (<>) { ... }\" loop around program\n"
+" -p assume loop like -n but print line also, like sed\n"
+" -s enable rudimentary parsing for switches after programfile\n"
+" -S look for programfile using PATH environment variable\n",
+" -t enable tainting warnings\n"
+" -T enable tainting checks\n"
+" -u dump core after parsing program\n"
+" -U allow unsafe operations\n"
+" -v print version, patchlevel and license\n"
+" -V[:variable] print configuration summary (or a single Config.pm variable)\n",
+" -w enable many useful warnings (RECOMMENDED)\n"
+" -W enable all warnings\n"
+" -x[directory] ignore text before #!perl line (optionally cd to directory)\n"
+" -X disable all warnings\n"
+" \n"
+"Run 'perldoc perl' for more help with Perl.\n\n",
NULL
};
const char * const *p = usage_msg;
+ PerlIO *out = PerlIO_stdout();
PERL_ARGS_ASSERT_USAGE;
- PerlIO_printf(PerlIO_stdout(),
- "\nUsage: %s [switches] [--] [programfile] [arguments]",
+ PerlIO_printf(out,
+ "\nUsage: %s [switches] [--] [programfile] [arguments]\n",
name);
while (*p)
- PerlIO_printf(PerlIO_stdout(), "\n %s", *p++);
+ PerlIO_puts(out, *p++);
}
/* convert a string of -D options (or digits) into an int.
Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
{
static const char * const usage_msgd[] = {
- " Debugging flag values: (see also -d)",
- " p Tokenizing and parsing (with v, displays parse stack)",
- " s Stack snapshots (with v, displays all stacks)",
- " l Context (loop) stack processing",
- " t Trace execution",
- " o Method and overloading resolution",
- " c String/numeric conversions",
- " P Print profiling info, source file input state",
- " m Memory and SV allocation",
- " f Format processing",
- " r Regular expression parsing and execution",
- " x Syntax tree dump",
- " u Tainting checks",
- " H Hash dump -- usurps values()",
- " X Scratchpad allocation",
- " D Cleaning up",
- " T Tokenising",
- " R Include reference counts of dumped variables (eg when using -Ds)",
- " J Do not s,t,P-debug (Jump over) opcodes within package DB",
- " v Verbose: use in conjunction with other flags",
- " C Copy On Write",
- " A Consistency checks on internal structures",
- " q quiet - currently only suppresses the 'EXECUTING' message",
- " M trace smart match resolution",
- " B dump suBroutine definitions, including special Blocks like BEGIN",
+ " Debugging flag values: (see also -d)\n"
+ " p Tokenizing and parsing (with v, displays parse stack)\n"
+ " s Stack snapshots (with v, displays all stacks)\n"
+ " l Context (loop) stack processing\n"
+ " t Trace execution\n"
+ " o Method and overloading resolution\n",
+ " c String/numeric conversions\n"
+ " P Print profiling info, source file input state\n"
+ " m Memory and SV allocation\n"
+ " f Format processing\n"
+ " r Regular expression parsing and execution\n"
+ " x Syntax tree dump\n",
+ " u Tainting checks\n"
+ " H Hash dump -- usurps values()\n"
+ " X Scratchpad allocation\n"
+ " D Cleaning up\n"
+ " T Tokenising\n"
+ " R Include reference counts of dumped variables (eg when using -Ds)\n",
+ " J Do not s,t,P-debug (Jump over) opcodes within package DB\n"
+ " v Verbose: use in conjunction with other flags\n"
+ " C Copy On Write\n"
+ " A Consistency checks on internal structures\n"
+ " q quiet - currently only suppresses the 'EXECUTING' message\n"
+ " M trace smart match resolution\n"
+ " B dump suBroutine definitions, including special Blocks like BEGIN\n",
NULL
};
int i = 0;
}
else if (givehelp) {
const char *const *p = usage_msgd;
- while (*p) PerlIO_printf(PerlIO_stdout(), "%s\n", *p++);
+ while (*p) PerlIO_puts(PerlIO_stdout(), *p++);
}
# ifdef EBCDIC
if ((i & DEBUG_p_FLAG) && ckWARN_d(WARN_DEBUGGING))
#endif
PerlIO_printf(PerlIO_stdout(),
- "\n\nCopyright 1987-2009, Larry Wall\n");
+ "\n\nCopyright 1987-2010, Larry Wall\n");
#ifdef MSDOS
PerlIO_printf(PerlIO_stdout(),
"\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
dVAR;
GV *tmpgv;
IO *io;
+ AV *isa;
sv_setpvs(get_sv("\"", GV_ADD), " ");
PL_ofsgv = (GV*)SvREFCNT_inc(gv_fetchpvs(",", GV_ADD|GV_NOTQUAL, SVt_PV));
+
+ /* Historically, PVIOs were blessed into IO::Handle, unless
+ FileHandle was loaded, in which case they were blessed into
+ that. Action at a distance.
+ However, if we simply bless into IO::Handle, we break code
+ that assumes that PVIOs will have (among others) a seek
+ method. IO::File inherits from IO::Handle and IO::Seekable,
+ and provides the needed methods. But if we simply bless into
+ it, then we break code that assumed that by loading
+ IO::Handle, *it* would work.
+ So a compromise is to set up the correct @IO::File::ISA,
+ so that code that does C<use IO::Handle>; will still work.
+ */
+
+ isa = get_av("IO::File::ISA", GV_ADD | GV_ADDMULTI);
+ av_push(isa, newSVpvs("IO::Handle"));
+ av_push(isa, newSVpvs("IO::Seekable"));
+ av_push(isa, newSVpvs("Exporter"));
+ (void) gv_fetchpvs("IO::Handle::", GV_ADD, SVt_PVGV);
+ (void) gv_fetchpvs("IO::Seekable::", GV_ADD, SVt_PVGV);
+ (void) gv_fetchpvs("Exporter::", GV_ADD, SVt_PVGV);
+
+
PL_stdingv = gv_fetchpvs("STDIN", GV_ADD|GV_NOTQUAL, SVt_PVIO);
GvMULTI_on(PL_stdingv);
io = GvIOp(PL_stdingv);
(and not the architecture specific directories from $ENV{PERL5LIB}) */
/* Use the ~-expanded versions of APPLLIB (undocumented),
- ARCHLIB PRIVLIB SITEARCH SITELIB VENDORARCH and VENDORLIB
+ SITEARCH, SITELIB, VENDORARCH, VENDORLIB, ARCHLIB and PRIVLIB
*/
#ifdef APPLLIB_EXP
S_incpush_use_sep(aTHX_ STR_WITH_LEN(APPLLIB_EXP),
}
/* Use the ~-expanded versions of APPLLIB (undocumented),
- ARCHLIB PRIVLIB SITEARCH SITELIB VENDORARCH and VENDORLIB
+ SITELIB and VENDORLIB for older versions
*/
#ifdef APPLLIB_EXP
S_incpush_use_sep(aTHX_ STR_WITH_LEN(APPLLIB_EXP), INCPUSH_ADD_OLD_VERS
# endif
#endif
-#if !defined(PERL_CORE) && !defined(PERL_NO_SHORT_NAMES)
-# if defined(PERL_IMPLICIT_CONTEXT)
-# define pmflag(a,b) Perl_pmflag(aTHX_ a,b)
-# else
-# define pmflag Perl_pmflag
-# endif
-#endif
-
#ifdef HASATTRIBUTE_DEPRECATED
# define __attribute__deprecated__ __attribute__((deprecated))
#endif
void* any_ptr;
I32 any_i32;
IV any_iv;
+ UV any_uv;
long any_long;
bool any_bool;
void (*any_dptr) (void*);
struct scan_data_t; /* Used in S_* functions in regcomp.c */
struct regnode_charclass_class; /* Used in S_* functions in regcomp.c */
-/* Keep next first in this structure, because sv_free_arenas take
- advantage of this to share code between the pte arenas and the SV
- body arenas */
struct ptr_tbl_ent {
struct ptr_tbl_ent* next;
const void* oldval;
struct ptr_tbl_ent** tbl_ary;
UV tbl_max;
UV tbl_items;
+ struct ptr_tbl_arena *tbl_arena;
+ struct ptr_tbl_ent *tbl_arena_next;
+ struct ptr_tbl_ent *tbl_arena_end;
};
#if defined(iAPX286) || defined(M_I286) || defined(I80286)
#define DEBUG_SCOPE(where) \
- DEBUG_l(WITH_THR(Perl_deb(aTHX_ "%s scope %ld at %s:%d\n", \
- where, (long)PL_scopestack_ix, __FILE__, __LINE__)));
+ DEBUG_l(WITH_THR( \
+ Perl_deb(aTHX_ "%s scope %ld (savestack=%ld) at %s:%d\n", \
+ where, (long)PL_scopestack_ix, (long)PL_savestack_ix, \
+ __FILE__, __LINE__)));
#define PL_rehash_seed_set (*Perl_Irehash_seed_set_ptr(aTHX))
#undef PL_replgv
#define PL_replgv (*Perl_Ireplgv_ptr(aTHX))
+#undef PL_restartjmpenv
+#define PL_restartjmpenv (*Perl_Irestartjmpenv_ptr(aTHX))
#undef PL_restartop
#define PL_restartop (*Perl_Irestartop_ptr(aTHX))
#undef PL_rs
*/
provider perl {
- probe sub__entry(char *, char *, int);
+ probe sub__entry(char *, char *, int);
probe sub__return(char *, char *, int);
};
+
+/*
+ * Local Variables:
+ * tab-width: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */
if (!b->buf) {
if (!b->bufsiz)
b->bufsiz = 4096;
- b->buf = Newxz(b->buf,b->bufsiz, STDCHAR);
+ Newxz(b->buf,b->bufsiz, STDCHAR);
if (!b->buf) {
b->buf = (STDCHAR *) & b->oneword;
b->bufsiz = sizeof(b->oneword);
int fd = -1;
char tempname[] = "/tmp/PerlIO_XXXXXX";
const char * const tmpdir = PL_tainting ? NULL : PerlEnv_getenv("TMPDIR");
- SV * const sv = tmpdir && *tmpdir ? newSVpv(tmpdir, 0) : NULL;
+ SV * sv;
/*
* I have no idea how portable mkstemp() is ... NI-S
*/
- if (sv) {
+ if (tmpdir && *tmpdir) {
/* if TMPDIR is set and not empty, we try that first */
+ sv = newSVpv(tmpdir, 0);
sv_catpv(sv, tempname + 4);
fd = mkstemp(SvPVX(sv));
}
if (fd < 0) {
+ sv = NULL;
/* else we try /tmp */
fd = mkstemp(tempname);
}
#define PerlIO_fdopen PerlSIO_fdopen
#define PerlIO_reopen PerlSIO_freopen
#define PerlIO_close(f) PerlSIO_fclose(f)
-#define PerlIO_puts(f,s) PerlSIO_fputs(f,s)
-#define PerlIO_putc(f,c) PerlSIO_fputc(f,c)
+#define PerlIO_puts(f,s) PerlSIO_fputs(s,f)
+#define PerlIO_putc(f,c) PerlSIO_fputc(c,f)
#if defined(VMS)
# if defined(__DECC)
/* Unusual definition of ungetc() here to accomodate fast_sv_gets()'
* This symbol contains the ~name expanded version of PRIVLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define PRIVLIB "/sys/lib/perl/5.11.3" /**/
-#define PRIVLIB_EXP "/sys/lib/perl/5.11.3" /**/
+#define PRIVLIB "/sys/lib/perl/5.13.0" /**/
+#define PRIVLIB_EXP "/sys/lib/perl/5.13.0" /**/
/* PTRSIZE:
* This symbol contains the size of a pointer, so that the C preprocessor
* removed. The elements in inc_version_list (inc_version_list.U) can
* be tacked onto this variable to generate a list of directories to search.
*/
-#define SITELIB "/sys/lib/perl/5.11.3/site_perl" /**/
-#define SITELIB_EXP "/sys/lib/perl/5.11.3/site_perl" /**/
-#define SITELIB_STEM "/sys/lib/perl/5.11.3/site_perl" /**/
+#define SITELIB "/sys/lib/perl/5.13.0/site_perl" /**/
+#define SITELIB_EXP "/sys/lib/perl/5.13.0/site_perl" /**/
+#define SITELIB_STEM "/sys/lib/perl/5.13.0/site_perl" /**/
/* Size_t_size:
* This symbol holds the size of a Size_t in bytes.
aphostname='/bin/uname -n'
api_revision='5'
api_subversion='0'
-api_version='11'
-api_versionstring='5.11.0'
+api_version='13'
+api_versionstring='5.13.0'
ar='ar'
-archlib='/sys/lib/perl5/5.11.3/386'
-archlibexp='/sys/lib/perl5/5.11.3/386'
+archlib='/sys/lib/perl5/5.13.0/386'
+archlibexp='/sys/lib/perl5/5.13.0/386'
archname64=''
archname='386'
archobjs=''
d_pipe='define'
d_poll='undef'
d_portable='define'
+d_prctl='undef'
+d_prctl_set_name='undef'
d_printf_format_null='undef'
d_procselfexe='undef'
d_pseudofork='undef'
inc_version_list_init='0'
incpath=''
inews=''
-installarchlib='/sys/lib/perl/5.11.3/386'
+installarchlib='/sys/lib/perl/5.13.0/386'
installbin='/usr/bin'
installman1dir='/sys/man/1pub'
installman3dir='/sys/man/2pub'
installprefix='/usr'
installprefixexp='/usr'
-installprivlib='/sys/lib/perl/5.11.3'
+installprivlib='/sys/lib/perl/5.13.0'
installscript='/usr/bin'
-installsitearch='/sys/lib/perl/5.11.3/site_perl/386'
+installsitearch='/sys/lib/perl/5.13.0/site_perl/386'
installsitebin='/usr/bin'
-installsitelib='/sys/lib/perl/5.11.3/site_perl'
+installsitelib='/sys/lib/perl/5.13.0/site_perl'
installstyle='lib/perl5'
installusrbinperl='undef'
installvendorarch=''
pr=''
prefix='/usr'
prefixexp='/usr'
-privlib='/sys/lib/perl/5.11.3'
-privlibexp='/sys/lib/perl/5.11.3'
+privlib='/sys/lib/perl/5.13.0'
+privlibexp='/sys/lib/perl/5.13.0'
procselfexe=''
prototype='define'
ptrsize='4'
sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 0'
sig_size='50'
signal_t='void'
-sitearch='/sys/lib/perl/5.11.3/site_perl/386'
+sitearch='/sys/lib/perl/5.13.0/site_perl/386'
sitearchexp='/sys/lib/perl/site_perl/386'
sitebin='/usr/bin'
sitebinexp='/usr/bin'
-sitelib='/sys/lib/perl/5.11.3/site_perl'
-sitelib_stem='/sys/lib/perl/5.11.3/site_perl'
-sitelibexp='/sys/lib/perl/5.11.3/site_perl'
+sitelib='/sys/lib/perl/5.13.0/site_perl'
+sitelib_stem='/sys/lib/perl/5.13.0/site_perl'
+sitelibexp='/sys/lib/perl/5.13.0/site_perl'
siteprefix='/usr'
siteprefixexp='/usr'
sizesize='4'
strerror_r_proto='0'
strings='/sys/include/ape/string.h'
submit=''
-subversion='3'
+subversion='0'
sysman='/sys/man/1pub'
tail=''
tar=''
uvtype='unsigned long'
uvuformat='"lu"'
uvxformat='"lx"'
+vaproto='undef'
vendorarch=''
vendorarchexp=''
vendorbin=''
vendorlibexp=''
vendorprefix=''
vendorprefixexp=''
-version='5.11.3'
-version_patchlevel_string='version 11 subversion 3'
+version='5.13.0'
+version_patchlevel_string='version 13 subversion 0'
versiononly='undef'
vi=''
voidflags='15'
config_args=''
config_argc=0
PERL_REVISION=5
-PERL_VERSION=11
-PERL_SUBVERSION=3
+PERL_VERSION=13
+PERL_SUBVERSION=0
PERL_API_REVISION=5
-PERL_API_VERSION=11
+PERL_API_VERSION=13
PERL_API_SUBVERSION=0
PERL_PATCHLEVEL=
PERL_CONFIG_SH=true
perluniintro Perl Unicode introduction
perlunicode Perl Unicode support
perlunifaq Perl Unicode FAQ
-g perluniprops Complete index of Unicode Version 5.1.0 properties
+g perluniprops Index of Unicode Version 5.2.0 properties in Perl
perlunitut Perl Unicode tutorial
perlebcdic Considerations for running Perl on EBCDIC platforms
perldoc Look up Perl documentation in Pod format
perlhist Perl history records
+D perl5131delta Perl changes in version 5.13.1
+ perl5130delta Perl changes in version 5.13.0
+ perl5120delta Perl changes in version 5.12.0
d perldelta Perl changes since previous version
-D perl5113delta Perl changes in version 5.11.3
+ perl5115delta Perl changes in version 5.11.5
+ perl5114delta Perl changes in version 5.11.4
+ perl5113delta Perl changes in version 5.11.3
perl5112delta Perl changes in version 5.11.2
perl5111delta Perl changes in version 5.11.1
perl5110delta Perl changes in version 5.11.0
}
print "Now processing $name\n" if $Verbose;
open THING, $name or die "Can't open $name: $!";
+ binmode THING;
my @orig = <THING>;
my $orig = join '', @orig;
close THING;
}
rename $name, "$name.old" or die "$0: Can't rename $name to $name.old: $!";
open THING, ">$name" or die "$0: Can't open $name for writing: $!";
+ binmode THING;
print THING $new or die "$0: print to $name failed: $!";
- close THING or die die "$0: close $name failed: $!";
+ close THING or die "$0: close $name failed: $!";
}
warn "$0: was not instructed to build anything\n" unless $built;
=head1 NAME
-perl - Practical Extraction and Report Language
+perl - The Perl language interpreter
=head1 SYNOPSIS
S<[ B<-i>[I<extension>] ]>
S<[ [B<-e>|B<-E>] I<'command'> ] [ B<--> ] [ I<programfile> ] [ I<argument> ]...>
-If you're new to Perl, you should start with L<perlintro>, which is a
-general intro for beginners and provides some background to help you
-navigate the rest of Perl's extensive documentation.
+=head1 GETTING HELP
+
+The F<perldoc> program gives you access to all the documentation that comes
+with Perl. You can get more documentation, tutorials and community support
+online at L<http://www.perl.org/>.
+
+If you're new to Perl, you should start by running C<perldoc perlintro>,
+which is a general intro for beginners and provides some background to help
+you navigate the rest of Perl's extensive documentation. Run C<perldoc
+perldoc> to learn more things you can do with F<perldoc>.
For ease of access, the Perl manual has been split up into several sections.
perluniintro Perl Unicode introduction
perlunicode Perl Unicode support
perlunifaq Perl Unicode FAQ
- perluniprops Perl Unicode property index
+ perluniprops Index of Unicode Version 5.2.0 properties in Perl
perlunitut Perl Unicode tutorial
perlebcdic Considerations for running Perl on EBCDIC platforms
perldoc Look up Perl documentation in Pod format
perlhist Perl history records
+ perl5130delta Perl changes in version 5.13.0
+ perl5120delta Perl changes in version 5.12.0
perldelta Perl changes since previous version
+ perl5115delta Perl changes in version 5.11.5
+ perl5114delta Perl changes in version 5.11.4
+ perl5113delta Perl changes in version 5.11.3
perl5112delta Perl changes in version 5.11.2
perl5111delta Perl changes in version 5.11.1
perl5110delta Perl changes in version 5.11.0
perlwin32 Perl notes for Windows
-By default, the manpages listed above are installed in the
-F</usr/local/man/> directory.
-
-Extensive additional documentation for Perl modules is available. The
-default configuration for perl will place this additional documentation
-in the F</usr/local/lib/perl5/man> directory (or else in the F<man>
-subdirectory of the Perl library directory). Some of this additional
-documentation is distributed standard with Perl, but you'll also find
-documentation for third-party modules there.
-
-You should be able to view Perl's documentation with your man(1)
-program by including the proper directories in the appropriate start-up
-files, or in the MANPATH environment variable. To find out where the
-configuration has installed the manpages, type:
+On a Unix-like system, these documentation files will usually also be
+available as manpages for use with the F<man> program.
- perl -V:man.dir
-
-If the directories have a common stem, such as F</usr/local/man/man1>
-and F</usr/local/man/man3>, you need only to add that stem
-(F</usr/local/man>) to your man(1) configuration files or your MANPATH
-environment variable. If they do not share a stem, you'll have to add
-both stems.
-
-If that doesn't work for some reason, you can still use the
-supplied F<perldoc> script to view module information. You might
-also look into getting a replacement man program.
-
-If something strange has gone wrong with your program and you're not
-sure where you should look for help, try the B<-w> switch first. It
-will often point out exactly where the trouble is.
+In general, if something strange has gone wrong with your program and you're
+not sure where you should look for help, try the B<-w> switch first. It will
+often point out exactly where the trouble is.
=head1 DESCRIPTION
+Perl officially stands for Practical Extraction and Report Language,
+except when it doesn't.
+
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
conditions when taint checks are turned on. (Taint checks are used
in setuid or setgid scripts, or when explicitly turned on with the
C<-T> invocation option.) Although it's unlikely, this may cause a
-previously-working script to now fail -- which should be construed
-as a blessing, since that indicates a potentially-serious security
+previously-working script to now fail, which should be construed
+as a blessing since that indicates a potentially-serious security
hole was just plugged.
The new restrictions when tainting include:
File handles are now stored internally as type IO::Handle. The
FileHandle module is still supported for backwards compatibility, but
-it is now merely a front end to the IO::* modules -- specifically,
+it is now merely a front end to the IO::* modules, specifically
IO::Handle, IO::Seekable, and IO::File. We suggest, but do not
require, that you use the IO::* modules in new code.
(W) The pattern match (//), substitution (s///), and transliteration (tr///)
operators work on scalar values. If you apply one of them to an array
-or a hash, it will convert the array or hash to a scalar value -- the
-length of an array, or the population info of a hash -- and then work on
+or a hash, it will convert the array or hash to a scalar value (the
+length of an array or the population info of a hash) and then work on
that scalar value. This is probably not what you meant to do. See
L<perlfunc/grep> and L<perlfunc/map> for alternatives.
(F) You said something like C<< local $ar->{'key'} >>, where $ar is
a reference to a pseudo-hash. That hasn't been implemented yet, but
you can get a similar effect by localizing the corresponding array
-element directly -- C<< local $ar->[$ar->[0]{'key'}] >>.
+element directly: C<< local $ar->[$ar->[0]{'key'}] >>.
=item Can't use %%! because Errno.pm is not available
=head2 kill() on Windows
On Windows platforms, C<kill(-9, $pid)> now kills a process tree.
-(On UNIX, this delivers the signal to all processes in the same process
+(On Unix, this delivers the signal to all processes in the same process
group.)
=head1 Incompatible Changes
use of the recursive inheritance while resolving a method or doing a
C<$foo-E<gt>isa($bar)> lookup.
+=head2 warnings::enabled and warnings::warnif changed to favor users of modules
+
+The behaviour in 5.10.x favors the person using the module;
+The behaviour in 5.8.x favors the module writer;
+
+Assume the following code:
+
+ main calls Foo::Bar::baz()
+ Foo::Bar inherits from Foo::Base
+ Foo::Bar::baz() calls Foo::Base::_bazbaz()
+ Foo::Base::_bazbaz() calls: warnings::warnif('substr', 'some warning
+message');
+
+On 5.8.x, the code warns when Foo::Bar contains C<use warnings;>
+It does not matter if Foo::Base or main have warnings enabled
+to disable the warning one has to modify Foo::Bar.
+
+On 5.10.0 and newer, the code warns when main contains C<use warnings;>
+It does not matter if Foo::Base or Foo::Bar have warnings enabled
+to disable the warning one has to modify main.
+
=head1 Modules and Pragmata
=head2 Upgrading individual core modules
=head2 Elimination of SVt_PVBM
-Related to this, the internal type C<SVt_PVBM> has been been removed. This
+Related to this, the internal type C<SVt_PVBM> has been removed. This
dedicated type of C<SV> was used by the C<index> operator and parts of the
regexp engine to facilitate fast Boyer-Moore matches. Its use internally has
been replaced by C<SV>s of type C<SVt_PVGV>.
=item *
-On some UNIX systems, the value in C<$?> would not have the top bit set
+On some Unix systems, the value in C<$?> would not have the top bit set
(C<$? & 128>) even if the child core dumped.
=item *
=item *
-On some UNIX systems, the value in C<$?> would not have the top bit set
+On some Unix systems, the value in C<$?> would not have the top bit set
(C<$? & 128>) even if the child core dumped.
=item *
To disable this feature in a given lexical scope, you should use C<no
warnings 'deprecated';> For information about which language features
are deprecated and explanations of various deprecation warnings, please
-see L<perldiag.pod>
+see L<perldiag>
=back
=head1 NAME
-perldelta - what is new for perl v5.11.3
+perl5113delta - what is new for perl v5.11.3
=head1 DESCRIPTION
=head1 Incompatible Changes
-=over
-
-=item Filehandles are blessed directly into C<IO::Handle::>, as C<FileHandle> is merely a wrapper around C<IO::Handle>.
+=head2 Filehandles are blessed directly into C<IO::Handle>, as C<FileHandle> is merely a wrapper around C<IO::Handle>.
The previous behaviour was to bless Filehandles into L<FileHandle>
(an empty proxy class) if it was loaded into memory and otherwise
-to bless them into C<IO::Handle::>.
-
-
-=back
+to bless them into C<IO::Handle>.
=head1 Core Enhancements
=item C<CPAN>
-Upgraded from version 1.94_51 to 1.94_5301, which is 1.94_53 on CPAN
+Upgraded from version 1.94_51 to 1.94_5301, which is 1.94_53 on CPAN
plus some local fixes for bleadperl.
Includes better bzip2 support, improved FirstTime experience with
=item C<POSIX>
-Upgraded from version 1.18 to 1.19. Error codes for C<getaddrinfo()> and C<getnameinfo()> are now
-available.
+Upgraded from version 1.18 to 1.19. Error codes for C<getaddrinfo()> and
+C<getnameinfo()> are now available.
=item C<Pod::Simple>
=item *
-Always add a manifest resource to C<perl.exe> to specify the <trustInfo>
+Always add a manifest resource to C<perl.exe> to specify the C<trustInfo>
settings for Windows Vista and later. Without this setting Windows
will treat C<perl.exe> as a legacy application and apply various
heuristics like redirecting access to protected file system areas
=item *
-Fixed a regression caused by commit fafafbaf which caused a panic during parameter passing [perl #70171]
-
+Fixed a regression caused by commit fafafbaf which caused a panic during
+parameter passing [perl #70171]
=item *
-On systems which in-place edits without backup files, -i'*' now works as the documentation says it does [perl #70802]
+On systems which in-place edits without backup files, -i'*' now works as
+the documentation says it does [perl #70802]
=item *
=item *
-Smart match against C<@_> sometimes gave false negatives negatives. [perl #71078]
+Smart match against C<@_> sometimes gave false negatives. [perl #71078]
=item *
=item *
-C<sort> called recursively from within an active comparison subroutine no longer causes a bus error if run multiple times. [perl #71076]
+C<sort> called recursively from within an active comparison subroutine no
+longer causes a bus error if run multiple times. [perl #71076]
=back
C<split> now warns when called in void context
-
=item *
-C<printf>-style functions called with too few arguments will now issue the warning C<"Missing argument in %s"> [perl #71000]
-
+C<printf>-style functions called with too few arguments will now issue the
+warning C<"Missing argument in %s"> [perl #71000]
=back
--- /dev/null
+=head1 NAME
+
+perl5114delta - what is new for perl v5.11.4
+
+=head1 DESCRIPTION
+
+This document describes differences between the 5.11.3 release and
+the 5.11.4 release.
+
+If you are upgrading from an earlier release such as 5.11.2, first read
+L<perl5113delta>, which describes differences between 5.11.2 and
+5.11.3.
+
+=head1 Incompatible Changes
+
+=head2 Version number formats
+
+Acceptable version number formats have been formalized into "strict" and
+"lax" rules. C<package NAME VERSION> takes a strict version number. C<use
+NAME VERSION> takes a lax version number. C<UNIVERSAL::VERSION> and the
+L<version> object constructors take lax version numbers. Providing an
+invalid version will result in a fatal error.
+
+These formats will be documented fully in the L<version> module in a
+subsequent release of Perl 5.11. To a first approximation, a "strict"
+version number is a positive decimal number (integer or decimal-fraction)
+without exponentiation or else a dotted-decimal v-string with a leading 'v'
+character and at least three components. A "lax" version number allows
+v-strings with fewer than three components or without a leading 'v'. Under
+"lax" rules, both decimal and dotted-decimal versions may have a trailing
+"alpha" component separated by an underscore character after a fractional
+or dotted-decimal component.
+
+The L<version> module adds C<version::is_strict> and C<version::is_lax>
+functions to check a scalar against these rules.
+
+=head1 Core Enhancements
+
+=head2 Unicode properties
+
+C<\p{XDigit}> now matches the same characters as C<\p{Hex_Digit}>. This
+means that in addition to the characters it currently matches,
+C<[A-Fa-f0-9]>, it will also match their fullwidth equivalent forms, for
+example U+FF10: FULLWIDTH DIGIT ZERO.
+
+=head1 Modules and Pragmata
+
+=head2 Pragmata Changes
+
+=over 4
+
+=item C<less>
+
+Upgraded from version 0.02 to 0.03.
+
+This version introduces the C<stash_name> method to allow subclasses of less to
+pick where in %^H to store their stash.
+
+=item C<version>
+
+Upgraded from version 0.77 to 0.81.
+
+This version adds support for L</Version number formats> as described earlier
+in this document and in its own documentation.
+
+=item C<warnings>
+
+Upgraded from version 1.08 to 1.09.
+
+This version adds the C<illegalproto> warning category. See also L</New or
+Changed Diagnostics> for this change.
+
+=back
+
+=head2 Updated Modules
+
+=over 4
+
+=item C<Archive::Extract>
+
+Upgraded from version 0.36 to 0.38.
+
+=item C<B::Deparse>
+
+Upgraded from version 0.93 to 0.94.
+
+=item C<Compress::Raw::Bzip2>
+
+Upgraded from version 2.021 to 2.024.
+
+=item C<Compress::Raw::Zlib>
+
+Upgraded from version 2.021 to 2.024.
+
+=item C<CPAN>
+
+Upgraded from version 1.94_5301 to 1.94_54.
+
+=item C<File::Fetch>
+
+Upgraded from version 0.22 to 0.24.
+
+=item C<Module::Build>
+
+Upgraded from version 0.36 to 0.3603.
+
+=item C<Safe>
+
+Upgraded from version 2.20 to 2.21.
+
+Anonymous coderefs created in Safe containers no longer get bogus
+arguments passed to them, fixing RT #72068.
+
+=back
+
+=head2 Removed Modules and Pragmata
+
+=over 4
+
+=item C<Devel::DProf::V>
+
+Removed from the Perl core. Prior version was 'undef'.
+
+=back
+
+=head1 Changes to Existing Documentation
+
+A significant fraction of the core documentation has been updated to clarify
+the behavior of Perl's Unicode handling.
+
+Much of the remaining core documentation has been reviewed and edited
+for clarity, consistent use of language, and to fix the spelling of Tom
+Christiansen's name.
+
+=head2 Configuration improvements
+
+USE_ATTRIBUTES_FOR_PERLIO is now reported in the compile-time options
+listed by the C<-V> switch.
+
+=head2 Platform Specific Changes
+
+=over 4
+
+=item VMS
+
+The default pipe buffer size on VMS has been updated to 8192 on 64-bit
+systems.
+
+=back
+
+=head1 Selected Bug Fixes
+
+=over 4
+
+=item *
+
+Tie::Hash::NamedCapture::* shouldn't abort if passed bad input (RT #71828)
+
+=item *
+
+@_ and $_ no longer leak under threads (RT #34342 and #41138, also
+#70602, #70974)
+
+=back
+
+=head1 New or Changed Diagnostics
+
+=over 4
+
+=item New warning category C<illegalproto>
+
+The two warnings :
+
+ Illegal character in prototype for %s : %s
+ Prototype after '%c' for %s : %s
+
+have been moved from the C<syntax> top-level warnings category into a new
+first-level category, C<illegalproto>. These two warnings are currently the
+only ones emitted during parsing of an invalid/illegal prototype, so one
+can now do
+
+ no warnings 'illegalproto';
+
+to suppress only those, but not other syntax-related warnings. Warnings where
+prototypes are changed, ignored, or not met are still in the C<prototype>
+category as before. (Matt S. Trout)
+
+=item lvalue attribute ignored after the subroutine has been defined
+
+This new warning is issued when one attempts to mark a subroutine as
+lvalue after it has been defined.
+
+=back
+
+=head1 Changed Internals
+
+=over 4
+
+=item *
+
+Perl_magic_setmglob now knows about globs, fixing RT #71254.
+
+=back
+
+=head1 Known Problems
+
+Perl 5.11.4 is a development release leading up to Perl 5.12.0.
+Some notable known problems found in 5.11.4 are listed as dependencies
+of RT #69710, the Perl 5 version 12 meta-ticket.
+
+=head1 Deprecations
+
+The following items are now deprecated.
+
+=over 4
+
+=item C<< UNIVERSAL-E<gt>import() >>
+
+The method C<< UNIVERSAL-E<gt>import() >> is now deprecated. Attempting to
+pass import arguments to a C<use UNIVERSAL> statement will result in a
+deprecation warning. (This is a less noisy version of the full deprecation
+warning added in 5.11.0.)
+
+=back
+
+=head1 Acknowledgements
+
+Perl 5.11.4 represents approximately one month of development since
+Perl 5.11.3 and contains 17682 lines of changes across 318 files
+from 40 authors and committers:
+
+Abigail, Andy Dougherty, brian d foy, Chris Williams, Craig A. Berry,
+David Golden, David Mitchell, Father Chrysostomos, Gerard Goossen,
+H.Merijn Brand, Jesse Vincent, Jim Cromie, Josh ben Jore, Karl
+Williamson, kmx, Matt S Trout, Nicholas Clark, Niko Tyni, Paul Marquess,
+Philip Hazel, Rafael Garcia-Suarez, Rainer Tammer, Reini Urban, Ricardo
+Signes, Shlomi Fish, Tim Bunce, Todd Rinaldo, Tom Christiansen, Tony
+Cook, Vincent Pit, and Zefram
+
+Many of the changes included in this version originated in the CPAN
+modules included in Perl's core. We're grateful to the entire CPAN
+community for helping Perl to flourish.
+
+=head1 Reporting Bugs
+
+If you find what you think is a bug, you might check the articles
+recently posted to the comp.lang.perl.misc newsgroup and the perl
+bug database at L<http://rt.perl.org/perlbug/>. There may also be
+information at L<http://www.perl.org/>, the Perl Home Page.
+
+If you believe you have an unreported bug, please run the B<perlbug>
+program included with your release. Be sure to 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.org to be
+analyzed by the Perl porting team.
+
+If the bug you are reporting has security implications, which make it
+inappropriate to send to a publicly archived mailing list, then please send
+it to perl5-security-report@perl.org. This points to a closed subscription
+unarchived mailing list, which includes all the core committers, who be able
+to help assess the impact of issues, figure out a resolution, and help
+co-ordinate the release of patches to mitigate or fix the problem across all
+platforms on which Perl is supported. Please only use this address for
+security issues in the Perl core, not for modules independently
+distributed on CPAN.
+
+=head1 SEE ALSO
+
+The F<Changes> file for an explanation of how to view exhaustive details
+on what changed.
+
+The F<INSTALL> file for how to build Perl.
+
+The F<README> file for general stuff.
+
+The F<Artistic> and F<Copying> files for copyright information.
+
+=cut
--- /dev/null
+=head1 NAME
+
+perl5115delta - what is new for perl v5.11.5
+
+=head1 DESCRIPTION
+
+This document describes differences between the 5.11.4 release and
+the 5.11.5 release.
+
+If you are upgrading from an earlier release such as 5.11.3, first read
+L<perl5114delta>, which describes differences between 5.11.3 and
+5.11.4.
+
+=head1 Core Enhancements
+
+=head2 32-bit limit on substr arguments removed
+
+The 32-bit limit on C<substr> arguments has now been removed. The full range
+of the system's signed and unsigned integers is now available for the C<pos>
+and C<len> arguments.
+
+=head1 Modules and Pragmata
+
+=head2 Pragmata Changes
+
+=over 4
+
+=item C<version>
+
+Upgraded from version 0.81 to 0.82.
+
+The C<is_lax> and C<is_strict> functions can now be optionally exported to the
+caller's namespace and are also now documented.
+
+Undefined version objects are now uninitialized with zero rather than C<undef>.
+
+=back
+
+=head2 Updated Modules
+
+=over 4
+
+=item C<B::Debug>
+
+Upgraded from version 1.11 to 1.12.
+
+=item C<CPAN>
+
+Upgraded from version 1.94_53 to 1.94_56.
+
+This resolves RT #72362, in which CPAN was ignoring C<configure_requires>,
+and RT #72348, in which the command C<o conf init> in the CPAN shell could
+cause an exception to be thrown.
+
+This module is also now built in a less specialized way, which resolves a
+problem that caused C<make> after C<make clean> to fail, fixing RT #72218.
+
+=item C<CPANPLUS::Dist::Build>
+
+Upgraded from version 0.44 to 0.46.
+
+This makes the prereq resolving fall back to F<_build/> querying if the
+C<prereq_data> action fails.
+
+=item C<Pod::Perldoc>
+
+Upgraded from version 3.15_01 to 3.15_02.
+
+=item C<Pod::Plainer>
+
+Upgraded from version 1.01 to 1.02.
+
+=item C<Safe>
+
+Upgraded from version 2.21 to 2.22.
+
+This resolves RT #72700, in which an exception thrown from a closure was
+getting lost.
+
+=item C<Socket>
+
+Upgraded from version 1.85 to 1.86.
+
+This makes the new Socket implementation of C<inet_pton> consistent with the
+existing Socket6 implementation of C<inet_pton>, fixing RT #72884.
+
+=item C<podlators>
+
+Upgraded from version 2.2.2 to 2.3.1.
+
+=back
+
+=head1 Changes to Existing Documentation
+
+The syntax C<unless (EXPR) BLOCK else BLOCK> is now documented as valid, as
+is the syntax C<unless (EXPR) BLOCK elsif (EXPR) BLOCK ... else BLOCK>,
+although actually using the latter may not be the best idea for the
+readability of your source code.
+
+=head1 Installation and Configuration Improvements
+
+=head2 Configuration improvements
+
+Support for SystemTap's C<dtrace> compatibility layer has been added and an
+issue with linking C<miniperl> has been fixed in the process.
+
+C<less -R> is now used instead of C<less> for C<groff>'s new usage of ANSI
+escape codes by setting C<$Config{less}> (and thereby C<$Config{pager}>,
+which fixes RT #72156.
+
+USE_PERL_ATOF is now reported in the compile-time options listed by the C<-V>
+switch.
+
+=head1 Selected Bug Fixes
+
+=over 4
+
+=item *
+
+Arbitrary whitespace is now allowed between C<NAME> and C<VERSION> in
+C<package NAME VERSION;> statements. (Fixes RT #72432)
+
+=item *
+
+A panic caused by trying to load C<charnames> when the parser is already in
+error (e.g. by a missing C<my> under C<use strict;>) is now averted. This
+was a regression since Perl 5.10.0. (Fixes RT #72590)
+
+=item *
+
+Reading C<$!> no longer causes a SEGV for out of range C<errno> values. (Fixes
+RT #72850)
+
+=item *
+
+A possible SEGV in C</\N{...}/> has been fixed. This was a regression since
+Perl 5.10.
+
+=item *
+
+A possible SEGV when freeing a scalar that was upgraded to an C<SVt_REGEXP>
+type from a simple(r) scalar has been fixed.
+
+=item *
+
+A type conversion bug in C<gmtime64> that caused it to break around C<2**48>
+has been fixed.
+
+=item *
+
+Interpolating a regex that makes use of the C<charnames> pragma will no longer
+cause a run-time error. (Fixes RT #56444)
+
+=item *
+
+Array references assigned to C<*Foo::ISA> now have the necessary magic added
+to them to catch any further updates to the new C<@ISA>. (Fixes RT #72866)
+
+=item *
+
+Filehandles are now always blessed into C<IO::File>, which, together with
+some suitable manipulation of C<@IO::File::ISA>, fixes a breakage introduced
+in Perl 5.11.3 by a change that always blessed filehandles into C<IO::Handle>
+rather than checking for C<FileHandle> first.
+
+=item *
+
+A change in the behaviour of C<warnings::enabled> and C<warnings::warnif> in
+Perl 5.10.0 that wasn't documented at the time is now documented in
+L<perl5100delta>. (Fixes RT #62522)
+
+=item *
+
+RT #71504 is now fixed by simply skipping the tests that failed on OpenBSD
+with ithreads and perlio.
+
+=back
+
+=head1 New or Changed Diagnostics
+
+=over 4
+
+=item *
+
+The fatal error C<Malformed UTF-8 returned by \N> is now produced if the
+C<charnames> handler returns malformed UTF-8.
+
+=item *
+
+If an unresolved named character or sequence was encountered when compiling a
+regex pattern then the fatal error C<\\N{NAME} must be resolved by the lexer>
+is now produced. This can happen, for example, when using a single-quotish
+context like C<$re = '\N{SPACE}'; $re;>. See L<perldiag> for more examples of
+how the lexer can get bypassed.
+
+=item *
+
+The fatal error C<Invalid hexadecimal number in \\N{U+...}> will be produced
+if the character constant represented by C<...> is not a valid hexadecimal
+number.
+
+=item *
+
+The new meaning of C<\N> as C<[^\n]> is not valid in a bracketed character
+class, just like C<.> in a character class loses its special meaning, and will
+cause the fatal error C<\\N in a character class must be a named character:
+\\N{...}>.
+
+=item *
+
+The rules on what is legal for the C<...> in C<\N{...}> have been tightened
+up so that unless the C<...> begins with an alphabetic character and continues
+with a combination of alphanumerics, dashes, spaces, parentheses or colons
+then the warning C<Deprecated character(s) in \\N{...} starting at '%s'> is
+now issued.
+
+=item *
+
+The warning C<Using just the first characters returned by \N{}> will be
+issued if the C<charnames> handler returns a sequence of characters which
+exceeds the limit of the number of characters that can be used. The message
+will indicate which characters were used and which were discarded.
+
+=item *
+
+Currently, all but the first of the several characters that the C<charnames>
+handler may return are discarded when used in a regular expression pattern
+bracketed character class. If this happens then the warning C<Using just the
+first character returned by \N{} in character class> will be issued.
+
+=item *
+
+The warning C<Missing right brace on \\N{} or unescaped left brace after \\N.
+Assuming the latter> will be issued if Perl encounters a C<\N{> but doesn't
+find a matching C<}>. In this case Perl doesn't know if it was mistakenly
+omitted, or if "match non-newline" followed by "match a C<{>" was desired.
+It assumes the latter because that is actually a valid interpretation as
+written, unlike the other case. If you meant the former, you need to add the
+matching right brace. If you did mean the latter, you can silence this
+warning by writing instead C<\N\{>.
+
+=item *
+
+C<gmtime> and C<localtime> called with numbers smaller than they can reliably
+handle will now issue the warnings C<gmtime(%.0f) too small> and
+C<localtime(%.0f) too small>.
+
+=back
+
+=head1 New Tests
+
+=over 4
+
+=item F<t/op/filehandle.t>
+
+Tests some suitably portable filetest operators to check that they work as
+expected, particularly in the light of some internal changes made in how
+filehandles are blessed.
+
+=item F<t/op/time_loop.t>
+
+Tests that times greater than C<2**63>, which can now be handed to C<gmtime>
+and C<localtime>, do not cause an internal overflow or an excessively long
+loop.
+
+=back
+
+=head1 Known Problems
+
+Perl 5.11.5 is a development release leading up to Perl 5.12.0.
+Some notable known problems found in 5.11.5 are listed as dependencies
+of RT #69710, the Perl 5 version 12 meta-ticket.
+
+=head1 Acknowledgements
+
+Perl 5.11.5 represents approximately one month of development since
+Perl 5.11.4 and contains 9618 lines of changes across 151 files
+from 33 authors and committers:
+
+E<AElig>var ArnfjE<ouml>rE<eth> Bjarmason, Abigail, brian d foy, Chris
+Williams, David Golden, David Mitchell, Eric Brine, Frank Wiegand, Gisle
+Aas, H.Merijn Brand, Jan Dubois, Jesse Vincent, Jim Cromie, John Peacock,
+Josh ben Jore, Karl Williamson, Marcus Holland-Moritz, Michael G Schwern,
+Nicholas Clark, Offer Kaye, Philippe Bruhat (BooK), Rafael Garcia-Suarez,
+Reini Urban, Ricardo Signes, Robin Barker, Slaven Rezic, Steffen Mueller,
+Steve Hay, Steve Peters, Tim Bunce, Todd Rinaldo, Tony Cook and
+Vincent Pit.
+
+Many of the changes included in this version originated in the CPAN
+modules included in Perl's core. We're grateful to the entire CPAN
+community for helping Perl to flourish.
+
+=head1 Reporting Bugs
+
+If you find what you think is a bug, you might check the articles
+recently posted to the comp.lang.perl.misc newsgroup and the perl
+bug database at http://rt.perl.org/perlbug/ . There may also be
+information at http://www.perl.org/ , the Perl Home Page.
+
+If you believe you have an unreported bug, please run the B<perlbug>
+program included with your release. Be sure to 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.org to be
+analyzed by the Perl porting team.
+
+If the bug you are reporting has security implications, which make it
+inappropriate to send to a publicly archived mailing list, then please send
+it to perl5-security-report@perl.org. This points to a closed subscription
+unarchived mailing list, which includes all the core committers, who be able
+to help assess the impact of issues, figure out a resolution, and help
+co-ordinate the release of patches to mitigate or fix the problem across all
+platforms on which Perl is supported. Please only use this address for
+security issues in the Perl core, not for modules independently
+distributed on CPAN.
+
+=head1 SEE ALSO
+
+The F<Changes> file for an explanation of how to view exhaustive details
+on what changed.
+
+The F<INSTALL> file for how to build Perl.
+
+The F<README> file for general stuff.
+
+The F<Artistic> and F<Copying> files for copyright information.
+
+=cut
--- /dev/null
+=encoding utf8
+
+=head1 NAME
+
+perl5120delta - what is new for perl v5.12.0
+
+=head1 DESCRIPTION
+
+This document describes differences between the 5.10.0 release and the
+5.12.0 release.
+
+Many of the bug fixes in 5.12.0 are already included in the 5.10.1
+maintenance release.
+
+You can see the list of those changes in the 5.10.1 release notes
+(L<perl5101delta>).
+
+
+=head1 Core Enhancements
+
+=head2 New C<package NAME VERSION> syntax
+
+This new syntax allows a module author to set the $VERSION of a namespace
+when the namespace is declared with 'package'. It eliminates the need
+for C<our $VERSION = ...> and similar constructs. E.g.
+
+ package Foo::Bar 1.23;
+ # $Foo::Bar::VERSION == 1.23
+
+There are several advantages to this:
+
+=over
+
+=item *
+
+C<$VERSION> is parsed in exactly the same way as C<use NAME VERSION>
+
+=item *
+
+C<$VERSION> is set at compile time
+
+=item *
+
+C<$VERSION> is a version object that provides proper overloading of
+comparison operators so comparing C<$VERSION> to decimal (1.23) or
+dotted-decimal (v1.2.3) version numbers works correctly.
+
+=item *
+
+Eliminates C<$VERSION = ...> and C<eval $VERSION> clutter
+
+=item *
+
+As it requires VERSION to be a numeric literal or v-string
+literal, it can be statically parsed by toolchain modules
+without C<eval> the way MM-E<gt>parse_version does for C<$VERSION = ...>
+
+=back
+
+It does not break old code with only C<package NAME>, but code that uses
+C<package NAME VERSION> will need to be restricted to perl 5.12.0 or newer
+This is analogous to the change to C<open> from two-args to three-args.
+Users requiring the latest Perl will benefit, and perhaps after several
+years, it will become a standard practice.
+
+
+However, C<package NAME VERSION> requires a new, 'strict' version
+number format. See L<"Version number formats"> for details.
+
+
+=head2 The C<...> operator
+
+A new operator, C<...>, nicknamed the Yada Yada operator, has been added.
+It is intended to mark placeholder code that is not yet implemented.
+See L<perlop/"Yada Yada Operator">.
+
+=head2 Implicit strictures
+
+Using the C<use VERSION> syntax with a version number greater or equal
+to 5.11.0 will lexically enable strictures just like C<use strict>
+would do (in addition to enabling features.) The following:
+
+ use 5.12.0;
+
+means:
+
+ use strict;
+ use feature ':5.12';
+
+=head2 Unicode improvements
+
+Perl 5.12 comes with Unicode 5.2, the latest version available to
+us at the time of release. This version of Unicode was released in
+October 2009. See L<http://www.unicode.org/versions/Unicode5.2.0> for
+further details about what's changed in this version of the standard.
+See L<perlunicode> for instructions on installing and using other versions
+of Unicode.
+
+Additionally, Perl's developers have significantly improved Perl's Unicode
+implementation. For full details, see L</Unicode overhaul> below.
+
+=head2 Y2038 compliance
+
+Perl's core time-related functions are now Y2038 compliant. (It may not mean much to you, but your kids will love it!)
+
+=head2 qr overloading
+
+It is now possible to overload the C<qr//> operator, that is,
+conversion to regexp, like it was already possible to overload
+conversion to boolean, string or number of objects. It is invoked when
+an object appears on the right hand side of the C<=~> operator or when
+it is interpolated into a regexp. See L<overload>.
+
+=head2 Pluggable keywords
+
+Extension modules can now cleanly hook into the Perl parser to define
+new kinds of keyword-headed expression and compound statement. The
+syntax following the keyword is defined entirely by the extension. This
+allow a completely non-Perl sublanguage to be parsed inline, with the
+correct ops cleanly generated.
+
+See L<perlapi/PL_keyword_plugin> for the mechanism. The Perl core
+source distribution also includes a new module
+L<XS::APItest::KeywordRPN>, which implements reverse Polish notation
+arithmetic via pluggable keywords. This module is mainly used for test
+purposes, and is not normally installed, but also serves as an example
+of how to use the new mechanism.
+
+Perl's developers consider this feature to be experimental. We may remove
+it or change it in a backwards-incompatible way in Perl 5.14.
+
+=head2 APIs for more internals
+
+The lowest layers of the lexer and parts of the pad system now have C
+APIs available to XS extensions. These are necessary to support proper
+use of pluggable keywords, but have other uses too. The new APIs are
+experimental, and only cover a small proportion of what would be
+necessary to take full advantage of the core's facilities in these
+areas. It is intended that the Perl 5.13 development cycle will see the
+addition of a full range of clean, supported interfaces.
+
+Perl's developers consider this feature to be experimental. We may remove
+it or change it in a backwards-incompatible way in Perl 5.14.
+
+=head2 Overridable function lookup
+
+Where an extension module hooks the creation of rv2cv ops to modify the
+subroutine lookup process, this now works correctly for bareword
+subroutine calls. This means that prototypes on subroutines referenced
+this way will be processed correctly. (Previously bareword subroutine
+names were initially looked up, for parsing purposes, by an unhookable
+mechanism, so extensions could only properly influence subroutine names
+that appeared with an C<&> sigil.)
+
+=head2 A proper interface for pluggable Method Resolution Orders
+
+As of Perl 5.12.0 there is a new interface for plugging and using method
+resolution orders other than the default linear depth first search.
+The C3 method resolution order added in 5.10.0 has been re-implemented as
+a plugin, without changing its Perl-space interface. See L<perlmroapi> for
+more information.
+
+
+
+=head2 C<\N> experimental regex escape
+
+Perl now supports C<\N>, a new regex escape which you can think of as
+the inverse of C<\n>. It will match any character that is not a newline,
+independently from the presence or absence of the single line match
+modifier C</s>. It is not usable within a character class. C<\N{3}>
+means to match 3 non-newlines; C<\N{5,}> means to match at least 5.
+C<\N{NAME}> still means the character or sequence named C<NAME>, but
+C<NAME> no longer can be things like C<3>, or C<5,>.
+
+This will break a L<custom charnames translator|charnames/CUSTOM
+TRANSLATORS> which allows numbers for character names, as C<\N{3}> will
+now mean to match 3 non-newline characters, and not the character whose
+name is C<3>. (No name defined by the Unicode standard is a number,
+so only custom translators might be affected.)
+
+Perl's developers are somewhat concerned about possible user confusion
+with the existing C<\N{...}> construct which matches characters by their
+Unicode name. Consequently, this feature is experimental. We may remove
+it or change it in a backwards-incompatible way in Perl 5.14.
+
+=head2 DTrace support
+
+Perl now has some support for DTrace. See "DTrace support" in F<INSTALL>.
+
+=head2 Support for C<configure_requires> in CPAN module metadata
+
+Both C<CPAN> and C<CPANPLUS> now support the C<configure_requires>
+keyword in the F<META.yml> metadata file included in most recent CPAN
+distributions. This allows distribution authors to specify configuration
+prerequisites that must be installed before running F<Makefile.PL>
+or F<Build.PL>.
+
+See the documentation for C<ExtUtils::MakeMaker> or C<Module::Build> for
+more on how to specify C<configure_requires> when creating a distribution
+for CPAN.
+
+=head2 C<each> is now more flexible
+
+The C<each> function can now operate on arrays.
+
+=head2 C<when> as a statement modifier
+
+C<when> is now allowed to be used as a statement modifier.
+
+=head2 C<$,> flexibility
+
+The variable C<$,> may now be tied.
+
+=head2 // in when clauses
+
+// now behaves like || in when clauses
+
+=head2 Enabling warnings from your shell environment
+
+You can now set C<-W> from the C<PERL5OPT> environment variable
+
+=head2 C<delete local>
+
+C<delete local> now allows you to locally delete a hash entry.
+
+=head2 New support for Abstract namespace sockets
+
+Abstract namespace sockets are Linux-specific socket type that live in
+AF_UNIX family, slightly abusing it to be able to use arbitrary
+character arrays as addresses: They start with nul byte and are not
+terminated by nul byte, but with the length passed to the socket()
+system call.
+
+=head2 32-bit limit on substr arguments removed
+
+The 32-bit limit on C<substr> arguments has now been removed. The full
+range of the system's signed and unsigned integers is now available for
+the C<pos> and C<len> arguments.
+
+=head1 Potentially Incompatible Changes
+
+=head2 Deprecations warn by default
+
+Over the years, Perl's developers have deprecated a number of language
+features for a variety of reasons. Perl now defaults to issuing a
+warning if a deprecated language feature is used. Many of the deprecations
+Perl now warns you about have been deprecated for many years. You can
+find a list of what was deprecated in a given release of Perl in the
+C<perl5xxdelta.pod> file for that release.
+
+To disable this feature in a given lexical scope, you should use C<no
+warnings 'deprecated';> For information about which language features
+are deprecated and explanations of various deprecation warnings, please
+see L<perldiag>. See L</Deprecations> below for the list of features
+and modules Perl's developers have deprecated as part of this release.
+
+=head2 Version number formats
+
+Acceptable version number formats have been formalized into "strict" and
+"lax" rules. C<package NAME VERSION> takes a strict version number.
+C<UNIVERSAL::VERSION> and the L<version> object constructors take lax
+version numbers. Providing an invalid version will result in a fatal
+error. The version argument in C<use NAME VERSION> is first parsed as a
+numeric literal or v-string and then passed to C<UNIVERSAL::VERSION>
+(and must then pass the "lax" format test).
+
+These formats are documented fully in the L<version> module. To a first
+approximation, a "strict" version number is a positive decimal number
+(integer or decimal-fraction) without exponentiation or else a
+dotted-decimal v-string with a leading 'v' character and at least three
+components. A "lax" version number allows v-strings with fewer than
+three components or without a leading 'v'. Under "lax" rules, both
+decimal and dotted-decimal versions may have a trailing "alpha"
+component separated by an underscore character after a fractional or
+dotted-decimal component.
+
+The L<version> module adds C<version::is_strict> and C<version::is_lax>
+functions to check a scalar against these rules.
+
+=head2 @INC reorganization
+
+In C<@INC>, C<ARCHLIB> and C<PRIVLIB> now occur after after the current
+version's C<site_perl> and C<vendor_perl>. Modules installed into
+C<site_perl> and C<vendor_perl> will now be loaded in preference to
+those installed in C<ARCHLIB> and C<PRIVLIB>.
+
+
+=head2 REGEXPs are now first class
+
+Internally, Perl now treates compiled regular expressions (such as
+those created with C<qr//>) as first class entities. Perl modules which
+serialize, deserialize or otherwise have deep interaction with Perl's
+internal data structures need to be updated for this change. Most
+affected CPAN modules have already been updated as of this writing.
+
+=head2 Switch statement changes
+
+The C<given>/C<when> switch statement handles complex statements better
+than Perl 5.10.0 did (These enhancements are also available in
+5.10.1 and subsequent 5.10 releases.) There are two new cases where
+C<when> now interprets its argument as a boolean, instead of an
+expression to be used in a smart match:
+
+=over
+
+=item flip-flop operators
+
+The C<..> and C<...> flip-flop operators are now evaluated in boolean
+context, following their usual semantics; see L<perlop/"Range Operators">.
+
+Note that, as in perl 5.10.0, C<when (1..10)> will not work to test
+whether a given value is an integer between 1 and 10; you should use
+C<when ([1..10])> instead (note the array reference).
+
+However, contrary to 5.10.0, evaluating the flip-flop operators in
+boolean context ensures it can now be useful in a C<when()>, notably
+for implementing bistable conditions, like in:
+
+ when (/^=begin/ .. /^=end/) {
+ # do something
+ }
+
+=item defined-or operator
+
+A compound expression involving the defined-or operator, as in
+C<when (expr1 // expr2)>, will be treated as boolean if the first
+expression is boolean. (This just extends the existing rule that applies
+to the regular or operator, as in C<when (expr1 || expr2)>.)
+
+=back
+
+=head2 Smart match changes
+
+Since Perl 5.10.0, Perl's developers have made a number of changes to
+the smart match operator. These, of course, also alter the behaviour
+of the switch statements where smart matching is implicitly used.
+These changes were also made for the 5.10.1 release, and will remain in
+subsequent 5.10 releases.
+
+=head3 Changes to type-based dispatch
+
+The smart match operator C<~~> is no longer commutative. The behaviour of
+a smart match now depends primarily on the type of its right hand
+argument. Moreover, its semantics have been adjusted for greater
+consistency or usefulness in several cases. While the general backwards
+compatibility is maintained, several changes must be noted:
+
+=over 4
+
+=item *
+
+Code references with an empty prototype are no longer treated specially.
+They are passed an argument like the other code references (even if they
+choose to ignore it).
+
+=item *
+
+C<%hash ~~ sub {}> and C<@array ~~ sub {}> now test that the subroutine
+returns a true value for each key of the hash (or element of the
+array), instead of passing the whole hash or array as a reference to
+the subroutine.
+
+=item *
+
+Due to the commutativity breakage, code references are no longer
+treated specially when appearing on the left of the C<~~> operator,
+but like any vulgar scalar.
+
+=item *
+
+C<undef ~~ %hash> is always false (since C<undef> can't be a key in a
+hash). No implicit conversion to C<""> is done (as was the case in perl
+5.10.0).
+
+=item *
+
+C<$scalar ~~ @array> now always distributes the smart match across the
+elements of the array. It's true if one element in @array verifies
+C<$scalar ~~ $element>. This is a generalization of the old behaviour
+that tested whether the array contained the scalar.
+
+=back
+
+The full dispatch table for the smart match operator is given in
+L<perlsyn/"Smart matching in detail">.
+
+=head3 Smart match and overloading
+
+According to the rule of dispatch based on the rightmost argument type,
+when an object overloading C<~~> appears on the right side of the
+operator, the overload routine will always be called (with a 3rd argument
+set to a true value, see L<overload>.) However, when the object will
+appear on the left, the overload routine will be called only when the
+rightmost argument is a simple scalar. This way, distributivity of smart
+match across arrays is not broken, as well as the other behaviours with
+complex types (coderefs, hashes, regexes). Thus, writers of overloading
+routines for smart match mostly need to worry only with comparing
+against a scalar, and possibly with stringification overloading; the
+other common cases will be automatically handled consistently.
+
+C<~~> will now refuse to work on objects that do not overload it (in order
+to avoid relying on the object's underlying structure). (However, if the
+object overloads the stringification or the numification operators, and
+if overload fallback is active, it will be used instead, as usual.)
+
+=head2 Other potentially incompatible changes
+
+=over 4
+
+=item *
+
+The definitions of a number of Unicode properties have changed to match
+those of the current Unicode standard. These are listed above under
+L</Unicode overhaul>. This change may break code that expects the old
+definitions.
+
+=item *
+
+The boolkeys op has moved to the group of hash ops. This breaks binary
+compatibility.
+
+=item *
+
+Filehandles are now always blessed into C<IO::File>.
+
+The previous behaviour was to bless Filehandles into L<FileHandle>
+(an empty proxy class) if it was loaded into memory and otherwise
+to bless them into C<IO::Handle>.
+
+=item *
+
+The semantics of C<use feature :5.10*> have changed slightly.
+See L<"Modules and Pragmata"> for more information.
+
+=item *
+
+Perl's developers now use git, rather than Perforce. This should be
+a purely internal change only relevant to people actively working on
+the core. However, you may see minor difference in perl as a consequence
+of the change. For example in some of details of the output of C<perl
+-V>. See L<perlrepository> for more information.
+
+=item *
+
+As part of the C<Test::Harness> 2.x to 3.x upgrade, the experimental
+C<Test::Harness::Straps> module has been removed.
+See L</"Modules and Pragmata"> for more details.
+
+=item *
+
+As part of the C<ExtUtils::MakeMaker> upgrade, the
+C<ExtUtils::MakeMaker::bytes> and C<ExtUtils::MakeMaker::vmsish> modules
+have been removed from this distribution.
+
+=item *
+
+C<Module::CoreList> no longer contains the C<%:patchlevel> hash.
+
+
+=item *
+
+C<length undef> now returns undef.
+
+=item *
+
+Unsupported private C API functions are now declared "static" to prevent
+leakage to Perl's public API.
+
+=item *
+
+To support the bootstrapping process, F<miniperl> no longer builds with
+UTF-8 support in the regexp engine.
+
+This allows a build to complete with PERL_UNICODE set and a UTF-8 locale.
+Without this there's a bootstrapping problem, as miniperl can't load
+the UTF-8 components of the regexp engine, because they're not yet built.
+
+=item *
+
+F<miniperl>'s @INC is now restricted to just C<-I...>, the split of
+C<$ENV{PERL5LIB}>, and "C<.>"
+
+=item *
+
+A space or a newline is now required after a C<"#line XXX"> directive.
+
+=item *
+
+Tied filehandles now have an additional method EOF which provides the
+EOF type.
+
+=item *
+
+To better match all other flow control statements, C<foreach> may no
+longer be used as an attribute.
+
+=item *
+
+Perl's command-line switch "-P", which was deprecated in version 5.10.0, has
+now been removed.
+
+=back
+
+
+=head1 Deprecations
+
+From time to time, Perl's developers find it necessary to deprecate
+features or modules we've previously shipped as part of the core
+distribution. We are well aware of the pain and frustration that a
+backwards-incompatible change to Perl can cause for developers building
+or maintaining software in Perl. You can be sure that when we deprecate
+a functionality or syntax, it isn't a choice we make lightly. Sometimes,
+we choose to deprecate functionality or syntax because it was found to
+be poorly designed or implemented. Sometimes, this is because they're
+holding back other features or causing performance problems. Sometimes,
+the reasons are more complex. Wherever possible, we try to keep deprecated
+functionality available to developers in its previous form for at least
+one major release. So long as a deprecated feature isn't actively
+disrupting our ability to maintain and extend Perl, we'll try to leave
+it in place as long as possible.
+
+The following items are now deprecated:
+
+=over
+
+=item suidperl
+
+C<suidperl> is no longer part of Perl. It used to provide a mechanism to
+emulate setuid permission bits on systems that don't support it properly.
+
+
+=item Use of C<:=> to mean an empty attribute list
+
+An accident of Perl's parser meant that these constructions were all
+equivalent:
+
+ my $pi := 4;
+ my $pi : = 4;
+ my $pi : = 4;
+
+with the C<:> being treated as the start of an attribute list, which
+ends before the C<=>. As whitespace is not significant here, all are
+parsed as an empty attribute list, hence all the above are equivalent
+to, and better written as
+
+ my $pi = 4;
+
+because no attribute processing is done for an empty list.
+
+As is, this meant that C<:=> cannot be used as a new token, without
+silently changing the meaning of existing code. Hence that particular
+form is now deprecated, and will become a syntax error. If it is
+absolutely necessary to have empty attribute lists (for example,
+because of a code generator) then avoid the warning by adding a space
+before the C<=>.
+
+=item C<< UNIVERSAL->import() >>
+
+The method C<< UNIVERSAL->import() >> is now deprecated. Attempting to
+pass import arguments to a C<use UNIVERSAL> statement will result in a
+deprecation warning.
+
+
+=item Use of "goto" to jump into a construct
+
+Using C<goto> to jump from an outer scope into an inner scope is now
+deprecated. This rare use case was causing problems in the
+implementation of scopes.
+
+=item Custom character names in \N{name} that don't look like names
+
+In C<\N{I<name>}>, I<name> can be just about anything. The standard
+Unicode names have a very limited domain, but a custom name translator
+could create names that are, for example, made up entirely of punctuation
+symbols. It is now deprecated to make names that don't begin with an
+alphabetic character, and aren't alphanumeric or contain other than
+a very few other characters, namely spaces, dashes, parentheses
+and colons. Because of the added meaning of C<\N> (See L</C<\N>
+experimental regex escape>), names that look like curly brace -enclosed
+quantifiers won't work. For example, C<\N{3,4}> now means to match 3 to
+4 non-newlines; before a custom name C<3,4> could have been created.
+
+=item Deprecated Modules
+
+The following modules will be removed from the core distribution in a
+future release, and should be installed from CPAN instead. Distributions
+on CPAN which require these should add them to their prerequisites. The
+core versions of these modules warnings will issue a deprecation warning.
+
+If you ship a packaged version of Perl, either alone or as part of a
+larger system, then you should carefully consider the reprecussions of
+core module deprecations. You may want to consider shipping your default
+build of Perl with packages for some or all deprecated modules which
+install into C<vendor> or C<site> perl library directories. This will
+inhibit the deprecation warnings.
+
+Alternatively, you may want to consider patching F<lib/deprecate.pm>
+to provide deprecation warnings specific to your packaging system
+or distribution of Perl, consistent with how your packaging system
+or distribution manages a staged transition from a release where the
+installation of a single package provides the given functionality, to
+a later release where the system administrator needs to know to install
+multiple packages to get that same functionality.
+
+You can silence these deprecation warnings by installing the modules
+in question from CPAN. To install the latest version of all of them,
+just install C<Task::Deprecations::5_12>.
+
+=over
+
+=item L<Class::ISA>
+
+=item L<Pod::Plainer>
+
+=item L<Shell>
+
+=item L<Switch>
+
+Switch is buggy and should be avoided. You may find Perl's new
+C<given>/C<when> feature a suitable replacement. See L<perlsyn/"Switch
+statements"> for more information.
+
+=back
+
+=item Assignment to $[
+
+=item Use of the attribute :locked on subroutines
+
+=item Use of "locked" with the attributes pragma
+
+=item Use of "unique" with the attributes pragma
+
+=item Perl_pmflag
+
+C<Perl_pmflag> is no longer part of Perl's public API. Calling it now
+generates a deprecation warning, and it will be removed in a future
+release. Although listed as part of the API, it was never documented,
+and only ever used in F<toke.c>, and prior to 5.10, F<regcomp.c>. In
+core, it has been replaced by a static function.
+
+=item Numerous Perl 4-era libraries
+
+F<termcap.pl>, F<tainted.pl>, F<stat.pl>, F<shellwords.pl>, F<pwd.pl>,
+F<open3.pl>, F<open2.pl>, F<newgetopt.pl>, F<look.pl>, F<find.pl>,
+F<finddepth.pl>, F<importenv.pl>, F<hostname.pl>, F<getopts.pl>,
+F<getopt.pl>, F<getcwd.pl>, F<flush.pl>, F<fastcwd.pl>, F<exceptions.pl>,
+F<ctime.pl>, F<complete.pl>, F<cacheout.pl>, F<bigrat.pl>, F<bigint.pl>,
+F<bigfloat.pl>, F<assert.pl>, F<abbrev.pl>, F<dotsh.pl>, and
+F<timelocal.pl> are all now deprecated. Earlier, Perl's developers
+intended to remove these libraries from Perl's core for the 5.14.0 release.
+
+During final testing before the release of 5.12.0, several developers
+discovered current production code using these ancient libraries, some
+inside the Perl core itself. Accordingly, the pumpking granted them
+a stay of execution. They will begin to warn about their deprecation
+in the 5.14.0 release and will be removed in the 5.16.0 release.
+
+
+=back
+
+=head1 Unicode overhaul
+
+Perl's developers have made a concerted effort to update Perl to be in
+sync with the latest Unicode standard. Changes for this include:
+
+Perl can now handle every Unicode character property. New documentation,
+L<perluniprops>, lists all available non-Unihan character properties. By
+default, perl does not expose Unihan, deprecated or Unicode-internal
+properties. See below for more details on these; there is also a section
+in the pod listing them, and explaining why they are not exposed.
+
+Perl now fully supports the Unicode compound-style of using C<=>
+and C<:> in writing regular expressions: C<\p{property=value}> and
+C<\p{property:value}> (both of which mean the same thing).
+
+Perl now fully supports the Unicode loose matching rules for text between
+the braces in C<\p{...}> constructs. In addition, Perl allows underscores
+between digits of numbers.
+
+Perl now accepts all the Unicode-defined synonyms for properties and
+property values.
+
+C<qr/\X/>, which matches a Unicode logical character, has
+been expanded to work better with various Asian languages. It
+now is defined as an I<extended grapheme cluster>. (See
+L<http://www.unicode.org/reports/tr29/>). Anything matched previously
+and that made sense will continue to be accepted. Additionally:
+
+=over
+
+=item *
+
+C<\X> will not break apart a C<S<CR LF>> sequence.
+
+=item *
+
+C<\X> will now match a sequence which includes the C<ZWJ> and C<ZWNJ>
+characters.
+
+=item *
+
+C<\X> will now always match at least one character, including an initial
+mark. Marks generally come after a base character, but it is possible in
+Unicode to have them in isolation, and C<\X> will now handle that case,
+for example at the beginning of a line, or after a C<ZWSP>. And this is
+the part where C<\X> doesn't match the things that it used to that don't
+make sense. Formerly, for example, you could have the nonsensical case
+of an accented LF.
+
+=item *
+
+C<\X> will now match a (Korean) Hangul syllable sequence, and the Thai
+and Lao exception cases.
+
+=back
+
+Otherwise, this change should be transparent for the non-affected
+languages.
+
+C<\p{...}> matches using the Canonical_Combining_Class property were
+completely broken in previous releases of Perl. They should now work
+correctly.
+
+Before Perl 5.12, the Unicode C<Decomposition_Type=Compat> property
+and a Perl extension had the same name, which led to neither matching
+all the correct values (with more than 100 mistakes in one, and several
+thousand in the other). The Perl extension has now been renamed to be
+C<Decomposition_Type=Noncanonical> (short: C<dt=noncanon>). It has the
+same meaning as was previously intended, namely the union of all the
+non-canonical Decomposition types, with Unicode C<Compat> being just
+one of those.
+
+C<\p{Decomposition_Type=Canonical}> now includes the Hangul syllables.
+
+C<\p{Uppercase}> and C<\p{Lowercase}> now work as the Unicode standard
+says they should. This means they each match a few more characters than
+they used to.
+
+C<\p{Cntrl}> now matches the same characters as C<\p{Control}>. This
+means it no longer will match Private Use (gc=co), Surrogates (gc=cs),
+nor Format (gc=cf) code points. The Format code points represent the
+biggest possible problem. All but 36 of them are either officially
+deprecated or strongly discouraged from being used. Of those 36, likely
+the most widely used are the soft hyphen (U+00AD), and BOM, ZWSP, ZWNJ,
+WJ, and similar characters, plus bidirectional controls.
+
+C<\p{Alpha}> now matches the same characters as C<\p{Alphabetic}>. Before
+5.12, Perl's definition definition included a number of things that aren't
+really alpha (all marks) while omitting many that were. The definitions
+of C<\p{Alnum}> and C<\p{Word}> depend on Alpha's definition and have
+changed accordingly.
+
+C<\p{Word}> no longer incorrectly matches non-word characters such
+as fractions.
+
+C<\p{Print}> no longer matches the line control characters: Tab, LF,
+CR, FF, VT, and NEL. This brings it in line with standards and the
+documentation.
+
+C<\p{XDigit}> now matches the same characters as C<\p{Hex_Digit}>. This
+means that in addition to the characters it currently matches,
+C<[A-Fa-f0-9]>, it will also match the 22 fullwidth equivalents, for
+example U+FF10: FULLWIDTH DIGIT ZERO.
+
+The Numeric type property has been extended to include the Unihan
+characters.
+
+There is a new Perl extension, the 'Present_In', or simply 'In',
+property. This is an extension of the Unicode Age property, but
+C<\p{In=5.0}> matches any code point whose usage has been determined
+I<as of> Unicode version 5.0. The C<\p{Age=5.0}> only matches code points
+added in I<precisely> version 5.0.
+
+A number of properties now have the correct values for unassigned
+code points. The affected properties are Bidi_Class, East_Asian_Width,
+Joining_Type, Decomposition_Type, Hangul_Syllable_Type, Numeric_Type,
+and Line_Break.
+
+The Default_Ignorable_Code_Point, ID_Continue, and ID_Start properties
+are now up to date with current Unicode definitions.
+
+Earlier versions of Perl erroneously exposed certain properties that
+are supposed to be Unicode internal-only. Use of these in regular
+expressions will now generate, if enabled, a deprecation warning message.
+The properties are: Other_Alphabetic, Other_Default_Ignorable_Code_Point,
+Other_Grapheme_Extend, Other_ID_Continue, Other_ID_Start, Other_Lowercase,
+Other_Math, and Other_Uppercase.
+
+It is now possible to change which Unicode properties Perl understands
+on a per-installation basis. As mentioned above, certain properties
+are turned off by default. These include all the Unihan properties
+(which should be accessible via the CPAN module Unicode::Unihan) and any
+deprecated or Unicode internal-only property that Perl has never exposed.
+
+The generated files in the C<lib/unicore/To> directory are now more
+clearly marked as being stable, directly usable by applications. New hash
+entries in them give the format of the normal entries, which allows for
+easier machine parsing. Perl can generate files in this directory for
+any property, though most are suppressed. You can find instructions
+for changing which are written in L<perluniprops>.
+
+=head1 Modules and Pragmata
+
+=head2 New Modules and Pragmata
+
+=over 4
+
+=item C<autodie>
+
+C<autodie> is a new lexically-scoped alternative for the C<Fatal> module.
+The bundled version is 2.06_01. Note that in this release, using a string
+eval when C<autodie> is in effect can cause the autodie behaviour to leak
+into the surrounding scope. See L<autodie/"BUGS"> for more details.
+
+Version 2.06_01 has been added to the Perl core.
+
+=item C<Compress::Raw::Bzip2>
+
+Version 2.024 has been added to the Perl core.
+
+=item C<overloading>
+
+C<overloading> allows you to lexically disable or enable overloading
+for some or all operations.
+
+Version 0.001 has been added to the Perl core.
+
+=item C<parent>
+
+C<parent> establishes an ISA relationship with base classes at compile
+time. It provides the key feature of C<base> without further unwanted
+behaviors.
+
+Version 0.223 has been added to the Perl core.
+
+=item C<Parse::CPAN::Meta>
+
+Version 1.40 has been added to the Perl core.
+
+=item C<VMS::DCLsym>
+
+Version 1.03 has been added to the Perl core.
+
+=item C<VMS::Stdio>
+
+Version 2.4 has been added to the Perl core.
+
+=item C<XS::APItest::KeywordRPN>
+
+Version 0.003 has been added to the Perl core.
+
+=back
+
+=head2 Updated Pragmata
+
+=over 4
+
+=item C<base>
+
+Upgraded from version 2.13 to 2.15.
+
+=item C<bignum>
+
+Upgraded from version 0.22 to 0.23.
+
+=item C<charnames>
+
+C<charnames> now contains the Unicode F<NameAliases.txt> database file.
+This has the effect of adding some extra C<\N> character names that
+formerly wouldn't have been recognised; for example, C<"\N{LATIN CAPITAL
+LETTER GHA}">.
+
+Upgraded from version 1.06 to 1.07.
+
+=item C<constant>
+
+Upgraded from version 1.13 to 1.20.
+
+=item C<diagnostics>
+
+C<diagnostics> now supports %.0f formatting internally.
+
+C<diagnostics> no longer suppresses C<Use of uninitialized value in range
+(or flip)> warnings. [perl #71204]
+
+Upgraded from version 1.17 to 1.19.
+
+=item C<feature>
+
+In C<feature>, the meaning of the C<:5.10> and C<:5.10.X> feature
+bundles has changed slightly. The last component, if any (i.e. C<X>) is
+simply ignored. This is predicated on the assumption that new features
+will not, in general, be added to maintenance releases. So C<:5.10>
+and C<:5.10.X> have identical effect. This is a change to the behaviour
+documented for 5.10.0.
+
+C<feature> now includes the C<unicode_strings> feature:
+
+ use feature "unicode_strings";
+
+This pragma turns on Unicode semantics for the case-changing operations
+(C<uc>, C<lc>, C<ucfirst>, C<lcfirst>) on strings that don't have the
+internal UTF-8 flag set, but that contain single-byte characters between
+128 and 255.
+
+Upgraded from version 1.11 to 1.16.
+
+=item C<less>
+
+C<less> now includes the C<stash_name> method to allow subclasses of
+C<less> to pick where in %^H to store their stash.
+
+Upgraded from version 0.02 to 0.03.
+
+=item C<lib>
+
+Upgraded from version 0.5565 to 0.62.
+
+=item C<mro>
+
+C<mro> is now implemented as an XS extension. The documented interface has
+not changed. Code relying on the implementation detail that some C<mro::>
+methods happened to be available at all times gets to "keep both pieces".
+
+Upgraded from version 1.00 to 1.02.
+
+=item C<overload>
+
+C<overload> now allow overloading of 'qr'.
+
+Upgraded from version 1.06 to 1.10.
+
+=item C<threads>
+
+Upgraded from version 1.67 to 1.75.
+
+=item C<threads::shared>
+
+Upgraded from version 1.14 to 1.32.
+
+=item C<version>
+
+C<version> now has support for L</Version number formats> as described
+earlier in this document and in its own documentation.
+
+Upgraded from version 0.74 to 0.82.
+
+=item C<warnings>
+
+C<warnings> has a new C<warnings::fatal_enabled()> function. It also
+includes a new C<illegalproto> warning category. See also L</New or
+Changed Diagnostics> for this change.
+
+Upgraded from version 1.06 to 1.09.
+
+=back
+
+=head2 Updated Modules
+
+=over 4
+
+=item C<Archive::Extract>
+
+Upgraded from version 0.24 to 0.38.
+
+=item C<Archive::Tar>
+
+Upgraded from version 1.38 to 1.54.
+
+=item C<Attribute::Handlers>
+
+Upgraded from version 0.79 to 0.87.
+
+=item C<AutoLoader>
+
+Upgraded from version 5.63 to 5.70.
+
+=item C<B::Concise>
+
+Upgraded from version 0.74 to 0.78.
+
+=item C<B::Debug>
+
+Upgraded from version 1.05 to 1.12.
+
+=item C<B::Deparse>
+
+Upgraded from version 0.83 to 0.96.
+
+=item C<B::Lint>
+
+Upgraded from version 1.09 to 1.11_01.
+
+=item C<CGI>
+
+Upgraded from version 3.29 to 3.48.
+
+=item C<Class::ISA>
+
+Upgraded from version 0.33 to 0.36.
+
+NOTE: C<Class::ISA> is deprecated and may be removed from a future
+version of Perl.
+
+=item C<Compress::Raw::Zlib>
+
+Upgraded from version 2.008 to 2.024.
+
+=item C<CPAN>
+
+Upgraded from version 1.9205 to 1.94_56.
+
+=item C<CPANPLUS>
+
+Upgraded from version 0.84 to 0.90.
+
+=item C<CPANPLUS::Dist::Build>
+
+Upgraded from version 0.06_02 to 0.46.
+
+=item C<Data::Dumper>
+
+Upgraded from version 2.121_14 to 2.125.
+
+=item C<DB_File>
+
+Upgraded from version 1.816_1 to 1.820.
+
+=item C<Devel::PPPort>
+
+Upgraded from version 3.13 to 3.19.
+
+=item C<Digest>
+
+Upgraded from version 1.15 to 1.16.
+
+=item C<Digest::MD5>
+
+Upgraded from version 2.36_01 to 2.39.
+
+=item C<Digest::SHA>
+
+Upgraded from version 5.45 to 5.47.
+
+=item C<Encode>
+
+Upgraded from version 2.23 to 2.39.
+
+=item C<Exporter>
+
+Upgraded from version 5.62 to 5.64_01.
+
+=item C<ExtUtils::CBuilder>
+
+Upgraded from version 0.21 to 0.27.
+
+=item C<ExtUtils::Command>
+
+Upgraded from version 1.13 to 1.16.
+
+=item C<ExtUtils::Constant>
+
+Upgraded from version 0.2 to 0.22.
+
+=item C<ExtUtils::Install>
+
+Upgraded from version 1.44 to 1.55.
+
+=item C<ExtUtils::MakeMaker>
+
+Upgraded from version 6.42 to 6.56.
+
+=item C<ExtUtils::Manifest>
+
+Upgraded from version 1.51_01 to 1.57.
+
+=item C<ExtUtils::ParseXS>
+
+Upgraded from version 2.18_02 to 2.21.
+
+=item C<File::Fetch>
+
+Upgraded from version 0.14 to 0.24.
+
+=item C<File::Path>
+
+Upgraded from version 2.04 to 2.08_01.
+
+=item C<File::Temp>
+
+Upgraded from version 0.18 to 0.22.
+
+=item C<Filter::Simple>
+
+Upgraded from version 0.82 to 0.84.
+
+=item C<Filter::Util::Call>
+
+Upgraded from version 1.07 to 1.08.
+
+=item C<Getopt::Long>
+
+Upgraded from version 2.37 to 2.38.
+
+=item C<IO>
+
+Upgraded from version 1.23_01 to 1.25_02.
+
+=item C<IO::Zlib>
+
+Upgraded from version 1.07 to 1.10.
+
+=item C<IPC::Cmd>
+
+Upgraded from version 0.40_1 to 0.54.
+
+=item C<IPC::SysV>
+
+Upgraded from version 1.05 to 2.01.
+
+=item C<Locale::Maketext>
+
+Upgraded from version 1.12 to 1.14.
+
+=item C<Locale::Maketext::Simple>
+
+Upgraded from version 0.18 to 0.21.
+
+=item C<Log::Message>
+
+Upgraded from version 0.01 to 0.02.
+
+=item C<Log::Message::Simple>
+
+Upgraded from version 0.04 to 0.06.
+
+=item C<Math::BigInt>
+
+Upgraded from version 1.88 to 1.89_01.
+
+=item C<Math::BigInt::FastCalc>
+
+Upgraded from version 0.16 to 0.19.
+
+=item C<Math::BigRat>
+
+Upgraded from version 0.21 to 0.24.
+
+=item C<Math::Complex>
+
+Upgraded from version 1.37 to 1.56.
+
+=item C<Memoize>
+
+Upgraded from version 1.01_02 to 1.01_03.
+
+=item C<MIME::Base64>
+
+Upgraded from version 3.07_01 to 3.08.
+
+=item C<Module::Build>
+
+Upgraded from version 0.2808_01 to 0.3603.
+
+=item C<Module::CoreList>
+
+Upgraded from version 2.12 to 2.29.
+
+=item C<Module::Load>
+
+Upgraded from version 0.12 to 0.16.
+
+=item C<Module::Load::Conditional>
+
+Upgraded from version 0.22 to 0.34.
+
+=item C<Module::Loaded>
+
+Upgraded from version 0.01 to 0.06.
+
+=item C<Module::Pluggable>
+
+Upgraded from version 3.6 to 3.9.
+
+=item C<Net::Ping>
+
+Upgraded from version 2.33 to 2.36.
+
+=item C<NEXT>
+
+Upgraded from version 0.60_01 to 0.64.
+
+=item C<Object::Accessor>
+
+Upgraded from version 0.32 to 0.36.
+
+=item C<Package::Constants>
+
+Upgraded from version 0.01 to 0.02.
+
+=item C<PerlIO>
+
+Upgraded from version 1.04 to 1.06.
+
+=item C<Pod::Parser>
+
+Upgraded from version 1.35 to 1.37.
+
+=item C<Pod::Perldoc>
+
+Upgraded from version 3.14_02 to 3.15_02.
+
+=item C<Pod::Plainer>
+
+Upgraded from version 0.01 to 1.02.
+
+NOTE: C<Pod::Plainer> is deprecated and may be removed from a future
+version of Perl.
+
+=item C<Pod::Simple>
+
+Upgraded from version 3.05 to 3.13.
+
+=item C<Safe>
+
+Upgraded from version 2.12 to 2.22.
+
+=item C<SelfLoader>
+
+Upgraded from version 1.11 to 1.17.
+
+=item C<Storable>
+
+Upgraded from version 2.18 to 2.22.
+
+=item C<Switch>
+
+Upgraded from version 2.13 to 2.16.
+
+NOTE: C<Switch> is deprecated and may be removed from a future version
+of Perl.
+
+=item C<Sys::Syslog>
+
+Upgraded from version 0.22 to 0.27.
+
+=item C<Term::ANSIColor>
+
+Upgraded from version 1.12 to 2.02.
+
+=item C<Term::UI>
+
+Upgraded from version 0.18 to 0.20.
+
+=item C<Test>
+
+Upgraded from version 1.25 to 1.25_02.
+
+=item C<Test::Harness>
+
+Upgraded from version 2.64 to 3.17.
+
+=item C<Test::Simple>
+
+Upgraded from version 0.72 to 0.94.
+
+=item C<Text::Balanced>
+
+Upgraded from version 2.0.0 to 2.02.
+
+=item C<Text::ParseWords>
+
+Upgraded from version 3.26 to 3.27.
+
+=item C<Text::Soundex>
+
+Upgraded from version 3.03 to 3.03_01.
+
+=item C<Thread::Queue>
+
+Upgraded from version 2.00 to 2.11.
+
+=item C<Thread::Semaphore>
+
+Upgraded from version 2.01 to 2.09.
+
+=item C<Tie::RefHash>
+
+Upgraded from version 1.37 to 1.38.
+
+=item C<Time::HiRes>
+
+Upgraded from version 1.9711 to 1.9719.
+
+=item C<Time::Local>
+
+Upgraded from version 1.18 to 1.1901_01.
+
+=item C<Time::Piece>
+
+Upgraded from version 1.12 to 1.15.
+
+=item C<Unicode::Collate>
+
+Upgraded from version 0.52 to 0.52_01.
+
+=item C<Unicode::Normalize>
+
+Upgraded from version 1.02 to 1.03.
+
+=item C<Win32>
+
+Upgraded from version 0.34 to 0.39.
+
+=item C<Win32API::File>
+
+Upgraded from version 0.1001_01 to 0.1101.
+
+=item C<XSLoader>
+
+Upgraded from version 0.08 to 0.10.
+
+=back
+
+=head2 Removed Modules and Pragmata
+
+=over 4
+
+=item C<attrs>
+
+Removed from the Perl core. Prior version was 1.02.
+
+=item C<CPAN::API::HOWTO>
+
+Removed from the Perl core. Prior version was 'undef'.
+
+=item C<CPAN::DeferedCode>
+
+Removed from the Perl core. Prior version was 5.50.
+
+=item C<CPANPLUS::inc>
+
+Removed from the Perl core. Prior version was 'undef'.
+
+=item C<DCLsym>
+
+Removed from the Perl core. Prior version was 1.03.
+
+=item C<ExtUtils::MakeMaker::bytes>
+
+Removed from the Perl core. Prior version was 6.42.
+
+=item C<ExtUtils::MakeMaker::vmsish>
+
+Removed from the Perl core. Prior version was 6.42.
+
+=item C<Stdio>
+
+Removed from the Perl core. Prior version was 2.3.
+
+=item C<Test::Harness::Assert>
+
+Removed from the Perl core. Prior version was 0.02.
+
+=item C<Test::Harness::Iterator>
+
+Removed from the Perl core. Prior version was 0.02.
+
+=item C<Test::Harness::Point>
+
+Removed from the Perl core. Prior version was 0.01.
+
+=item C<Test::Harness::Results>
+
+Removed from the Perl core. Prior version was 0.01.
+
+=item C<Test::Harness::Straps>
+
+Removed from the Perl core. Prior version was 0.26_01.
+
+=item C<Test::Harness::Util>
+
+Removed from the Perl core. Prior version was 0.01.
+
+=item C<XSSymSet>
+
+Removed from the Perl core. Prior version was 1.1.
+
+=back
+
+=head2 Deprecated Modules and Pragmata
+
+See L</Deprecated Modules> above.
+
+
+=head1 Documentation
+
+=head2 New Documentation
+
+=over 4
+
+=item *
+
+L<perlhaiku> contains instructions on how to build perl for the Haiku
+platform.
+
+=item *
+
+L<perlmroapi> describes the new interface for pluggable Method Resolution
+Orders.
+
+=item *
+
+L<perlperf>, by Richard Foley, provides an introduction to the use of
+performance and optimization techniques which can be used with particular
+reference to perl programs.
+
+=item *
+
+L<perlrepository> describes how to access the perl source using the I<git>
+version control system.
+
+=item *
+
+L<perlpolicy> extends the "Social contract about contributed modules" into
+the beginnings of a document on Perl porting policies.
+
+=back
+
+=head2 Changes to Existing Documentation
+
+
+=over
+
+
+=item *
+
+The various large F<Changes*> files (which listed every change made
+to perl over the last 18 years) have been removed, and replaced by a
+small file, also called F<Changes>, which just explains how that same
+information may be extracted from the git version control system.
+
+=item *
+
+F<Porting/patching.pod> has been deleted, as it mainly described
+interacting with the old Perforce-based repository, which is now obsolete.
+Information still relevant has been moved to L<perlrepository>.
+
+
+=item *
+
+The syntax C<unless (EXPR) BLOCK else BLOCK> is now documented as valid,
+as is the syntax C<unless (EXPR) BLOCK elsif (EXPR) BLOCK ... else
+BLOCK>, although actually using the latter may not be the best idea for
+the readability of your source code.
+
+
+=item *
+
+Documented -X overloading.
+
+=item *
+
+Documented that C<when()> treats specially most of the filetest operators
+
+=item *
+
+Documented C<when> as a syntax modifier.
+
+=item *
+
+Eliminated "Old Perl threads tutorial", which described 5005 threads.
+
+F<pod/perlthrtut.pod> is the same material reworked for ithreads.
+
+=item *
+
+Correct previous documentation: v-strings are not deprecated
+
+With version objects, we need them to use MODULE VERSION syntax. This
+patch removes the deprecation notice.
+
+=item *
+
+Security contact information is now part of L<perlsec>.
+
+=item *
+
+A significant fraction of the core documentation has been updated to
+clarify the behavior of Perl's Unicode handling.
+
+Much of the remaining core documentation has been reviewed and edited
+for clarity, consistent use of language, and to fix the spelling of Tom
+Christiansen's name.
+
+=item *
+
+The Pod specification (L<perlpodspec>) has been updated to bring the
+specification in line with modern usage already supported by most Pod
+systems. A parameter string may now follow the format name in a
+"begin/end" region. Links to URIs with a text description are now
+allowed. The usage of C<LE<lt>"section"E<gt>> has been marked as
+deprecated.
+
+=item *
+
+L<if.pm|if> has been documented in L<perlfunc/use> as a means to get
+conditional loading of modules despite the implicit BEGIN block around
+C<use>.
+
+=item *
+
+The documentation for C<$1> in perlvar.pod has been clarified.
+
+=item *
+
+C<\N{U+I<wide hex char>}> is now documented.
+
+=back
+
+=head1 Selected Performance Enhancements
+
+=over 4
+
+=item *
+
+A new internal cache means that C<isa()> will often be faster.
+
+=item *
+
+The implementation of C<C3> Method Resolution Order has been
+optimised - linearisation for classes with single inheritance is 40%
+faster. Performance for multiple inheritance is unchanged.
+
+=item *
+
+Under C<use locale>, the locale-relevant information is now cached on
+read-only values, such as the list returned by C<keys %hash>. This makes
+operations such as C<sort keys %hash> in the scope of C<use locale>
+much faster.
+
+=item *
+
+Empty C<DESTROY> methods are no longer called.
+
+=item *
+
+C<Perl_sv_utf8_upgrade()> is now faster.
+
+=item *
+
+C<keys> on empty hash is now faster.
+
+=item *
+
+C<if (%foo)> has been optimized to be faster than C<if (keys %foo)>.
+
+=item *
+
+The string repetition operator (C<$str x $num>) is now several times
+faster when C<$str> has length one or C<$num> is large.
+
+=item *
+
+Reversing an array to itself (as in C<@a = reverse @a>) in void context
+now happens in-place and is several orders of magnitude faster than
+it used to be. It will also preserve non-existent elements whenever
+possible, i.e. for non magical arrays or tied arrays with C<EXISTS>
+and C<DELETE> methods.
+
+=back
+
+=head1 Installation and Configuration Improvements
+
+=over 4
+
+=item *
+
+L<perlapi>, L<perlintern>, L<perlmodlib> and L<perltoc> are now all
+generated at build time, rather than being shipped as part of the release.
+
+=item *
+
+If C<vendorlib> and C<vendorarch> are the same, then they are only added
+to C<@INC> once.
+
+=item *
+
+C<$Config{usedevel}> and the C-level C<PERL_USE_DEVEL> are now defined if
+perl is built with C<-Dusedevel>.
+
+=item *
+
+F<Configure> will enable use of C<-fstack-protector>, to provide protection
+against stack-smashing attacks, if the compiler supports it.
+
+=item *
+
+F<Configure> will now determine the correct prototypes for re-entrant
+functions and for C<gconvert> if you are using a C++ compiler rather
+than a C compiler.
+
+=item *
+
+On Unix, if you build from a tree containing a git repository, the
+configuration process will note the commit hash you have checked out, for
+display in the output of C<perl -v> and C<perl -V>. Unpushed local commits
+are automatically added to the list of local patches displayed by
+C<perl -V>.
+
+=item *
+
+Perl now supports SystemTap's C<dtrace> compatibility layer and an
+issue with linking C<miniperl> has been fixed in the process.
+
+=item *
+
+perldoc now uses C<less -R> instead of C<less> for improved behaviour
+in the face of C<groff>'s new usage of ANSI escape codes.
+
+=item *
+
+
+C<perl -V> now reports use of the compile-time options C<USE_PERL_ATOF> and
+C<USE_ATTRIBUTES_FOR_PERLIO>.
+
+=item *
+
+As part of the flattening of F<ext>, all extensions on all platforms are
+built by F<make_ext.pl>. This replaces the Unix-specific
+F<ext/util/make_ext>, VMS-specific F<make_ext.com> and Win32-specific
+F<win32/buildext.pl>.
+
+=back
+
+=head1 Internal Changes
+
+Each release of Perl sees numerous internal changes which shouldn't
+affect day to day usage but may still be notable for developers working
+with Perl's source code.
+
+=over
+
+=item *
+
+The J.R.R. Tolkien quotes at the head of C source file have been checked
+and proper citations added, thanks to a patch from Tom Christiansen.
+
+=item *
+
+The internal structure of the dual-life modules traditionally found in
+the F<lib/> and F<ext/> directories in the perl source has changed
+significantly. Where possible, dual-lifed modules have been extracted
+from F<lib/> and F<ext/>.
+
+Dual-lifed modules maintained by Perl's developers as part of the Perl
+core now live in F<dist/>. Dual-lifed modules maintained primarily on
+CPAN now live in F<cpan/>. When reporting a bug in a module located
+under F<cpan/>, please send your bug report directly to the module's
+bug tracker or author, rather than Perl's bug tracker.
+
+=item *
+
+C<\N{...}> now compiles better, always forces UTF-8 internal representation
+
+Perl's developers have fixed several problems with the recognition of
+C<\N{...}> constructs. As part of this, perl will store any scalar
+or regex containing C<\N{I<name>}> or C<\N{U+I<wide hex char>}> in its
+definition in UTF-8 format. (This was true previously for all occurences
+of C<\N{I<name>}> that did not use a custom translator, but now it's
+always true.)
+
+=item *
+
+Perl_magic_setmglob now knows about globs, fixing RT #71254.
+
+=item *
+
+C<SVt_RV> no longer exists. RVs are now stored in IVs.
+
+=item *
+
+C<Perl_vcroak()> now accepts a null first argument. In addition, a full
+audit was made of the "not NULL" compiler annotations, and those for
+several other internal functions were corrected.
+
+=item *
+
+New macros C<dSAVEDERRNO>, C<dSAVE_ERRNO>, C<SAVE_ERRNO>, C<RESTORE_ERRNO>
+have been added to formalise the temporary saving of the C<errno>
+variable.
+
+=item *
+
+The function C<Perl_sv_insert_flags> has been added to augment
+C<Perl_sv_insert>.
+
+=item *
+
+The function C<Perl_newSV_type(type)> has been added, equivalent to
+C<Perl_newSV()> followed by C<Perl_sv_upgrade(type)>.
+
+=item *
+
+The function C<Perl_newSVpvn_flags()> has been added, equivalent to
+C<Perl_newSVpvn()> and then performing the action relevant to the flag.
+
+Two flag bits are currently supported.
+
+=over 4
+
+=item *
+
+C<SVf_UTF8> will call C<SvUTF8_on()> for you. (Note that this does
+not convert an sequence of ISO 8859-1 characters to UTF-8). A wrapper,
+C<newSVpvn_utf8()> is available for this.
+
+=item *
+
+C<SVs_TEMP> now calls C<Perl_sv_2mortal()> on the new SV.
+
+=back
+
+There is also a wrapper that takes constant strings, C<newSVpvs_flags()>.
+
+=item *
+
+The function C<Perl_croak_xs_usage> has been added as a wrapper to
+C<Perl_croak>.
+
+=item *
+
+Perl now exports the functions C<PerlIO_find_layer> and C<PerlIO_list_alloc>.
+
+=item *
+
+C<PL_na> has been exterminated from the core code, replaced by local
+STRLEN temporaries, or C<*_nolen()> calls. Either approach is faster than
+C<PL_na>, which is a pointer dereference into the interpreter structure
+under ithreads, and a global variable otherwise.
+
+=item *
+
+C<Perl_mg_free()> used to leave freed memory accessible via C<SvMAGIC()>
+on the scalar. It now updates the linked list to remove each piece of
+magic as it is freed.
+
+=item *
+
+Under ithreads, the regex in C<PL_reg_curpm> is now reference
+counted. This eliminates a lot of hackish workarounds to cope with it
+not being reference counted.
+
+=item *
+
+C<Perl_mg_magical()> would sometimes incorrectly turn on C<SvRMAGICAL()>.
+This has been fixed.
+
+=item *
+
+The I<public> IV and NV flags are now not set if the string value has
+trailing "garbage". This behaviour is consistent with not setting the
+public IV or NV flags if the value is out of range for the type.
+
+=item *
+
+Uses of C<Nullav>, C<Nullcv>, C<Nullhv>, C<Nullop>, C<Nullsv> etc have
+been replaced by C<NULL> in the core code, and non-dual-life modules,
+as C<NULL> is clearer to those unfamiliar with the core code.
+
+=item *
+
+A macro C<MUTABLE_PTR(p)> has been added, which on (non-pedantic) gcc will
+not cast away C<const>, returning a C<void *>. Macros C<MUTABLE_SV(av)>,
+C<MUTABLE_SV(cv)> etc build on this, casting to C<AV *> etc without
+casting away C<const>. This allows proper compile-time auditing of
+C<const> correctness in the core, and helped picked up some errors
+(now fixed).
+
+=item *
+
+Macros C<mPUSHs()> and C<mXPUSHs()> have been added, for pushing SVs on the
+stack and mortalizing them.
+
+=item *
+
+Use of the private structure C<mro_meta> has changed slightly. Nothing
+outside the core should be accessing this directly anyway.
+
+=item *
+
+A new tool, F<Porting/expand-macro.pl> has been added, that allows you
+to view how a C preprocessor macro would be expanded when compiled.
+This is handy when trying to decode the macro hell that is the perl
+guts.
+
+=back
+
+=head1 Testing
+
+=head2 Testing improvements
+
+=over 4
+
+=item Parallel tests
+
+The core distribution can now run its regression tests in parallel on
+Unix-like platforms. Instead of running C<make test>, set C<TEST_JOBS> in
+your environment to the number of tests to run in parallel, and run
+C<make test_harness>. On a Bourne-like shell, this can be done as
+
+ TEST_JOBS=3 make test_harness # Run 3 tests in parallel
+
+An environment variable is used, rather than parallel make itself, because
+L<TAP::Harness> needs to be able to schedule individual non-conflicting test
+scripts itself, and there is no standard interface to C<make> utilities to
+interact with their job schedulers.
+
+Note that currently some test scripts may fail when run in parallel (most
+notably C<ext/IO/t/io_dir.t>). If necessary run just the failing scripts
+again sequentially and see if the failures go away.
+
+=item Test harness flexibility
+
+It's now possible to override C<PERL5OPT> and friends in F<t/TEST>
+
+=item Test watchdog
+
+Several tests that have the potential to hang forever if they fail now
+incorporate a "watchdog" functionality that will kill them after a timeout,
+which helps ensure that C<make test> and C<make test_harness> run to
+completion automatically.
+
+
+=back
+
+=head2 New Tests
+
+Perl's developers have added a number of new tests to the core.
+In addition to the items listed below, many modules updated from CPAN
+incorporate new tests.
+
+=over 4
+
+=item *
+
+Significant cleanups to core tests to ensure that language and
+interpreter features are not used before they're tested.
+
+=item *
+
+C<make test_porting> now runs a number of important pre-commit checks
+which might be of use to anyone working on the Perl core.
+
+=item *
+
+F<t/porting/podcheck.t> automatically checks the well-formedness of
+POD found in all .pl, .pm and .pod files in the F<MANIFEST>, other than in
+dual-lifed modules which are primarily maintained outside the Perl core.
+
+=item *
+
+F<t/porting/manifest.t> now tests that all files listed in MANIFEST
+are present.
+
+=item *
+
+F<t/op/while_readdir.t> tests that a bare readdir in while loop sets $_.
+
+=item *
+
+F<t/comp/retainedlines.t> checks that the debugger can retain source
+lines from C<eval>.
+
+=item *
+
+F<t/io/perlio_fail.t> checks that bad layers fail.
+
+=item *
+
+F<t/io/perlio_leaks.t> checks that PerlIO layers are not leaking.
+
+=item *
+
+F<t/io/perlio_open.t> checks that certain special forms of open work.
+
+=item *
+
+F<t/io/perlio.t> includes general PerlIO tests.
+
+=item *
+
+F<t/io/pvbm.t> checks that there is no unexpected interaction between
+the internal types C<PVBM> and C<PVGV>.
+
+=item *
+
+F<t/mro/package_aliases.t> checks that mro works properly in the presence
+of aliased packages.
+
+=item *
+
+F<t/op/dbm.t> tests C<dbmopen> and C<dbmclose>.
+
+=item *
+
+F<t/op/index_thr.t> tests the interaction of C<index> and threads.
+
+=item *
+
+F<t/op/pat_thr.t> tests the interaction of esoteric patterns and threads.
+
+=item *
+
+F<t/op/qr_gc.t> tests that C<qr> doesn't leak.
+
+=item *
+
+F<t/op/reg_email_thr.t> tests the interaction of regex recursion and threads.
+
+=item *
+
+F<t/op/regexp_qr_embed_thr.t> tests the interaction of patterns with
+embedded C<qr//> and threads.
+
+=item *
+
+F<t/op/regexp_unicode_prop.t> tests Unicode properties in regular
+expressions.
+
+=item *
+
+F<t/op/regexp_unicode_prop_thr.t> tests the interaction of Unicode
+properties and threads.
+
+=item *
+
+F<t/op/reg_nc_tie.t> tests the tied methods of C<Tie::Hash::NamedCapture>.
+
+=item *
+
+F<t/op/reg_posixcc.t> checks that POSIX character classes behave
+consistently.
+
+=item *
+
+F<t/op/re.t> checks that exportable C<re> functions in F<universal.c> work.
+
+=item *
+
+F<t/op/setpgrpstack.t> checks that C<setpgrp> works.
+
+=item *
+
+F<t/op/substr_thr.t> tests the interaction of C<substr> and threads.
+
+=item *
+
+F<t/op/upgrade.t> checks that upgrading and assigning scalars works.
+
+=item *
+
+F<t/uni/lex_utf8.t> checks that Unicode in the lexer works.
+
+=item *
+
+F<t/uni/tie.t> checks that Unicode and C<tie> work.
+
+=item *
+
+F<t/comp/final_line_num.t> tests whether line numbers are correct at EOF
+
+=item *
+
+F<t/comp/form_scope.t> tests format scoping.
+
+=item *
+
+F<t/comp/line_debug.t> tests whether C<< @{"_<$file"} >> works.
+
+=item *
+
+F<t/op/filetest_t.t> tests if -t file test works.
+
+=item *
+
+F<t/op/qr.t> tests C<qr>.
+
+=item *
+
+F<t/op/utf8cache.t> tests malfunctions of the utf8 cache.
+
+=item *
+
+F<t/re/uniprops.t> test unicodes C<\p{}> regex constructs.
+
+=item *
+
+F<t/op/filehandle.t> tests some suitably portable filetest operators
+to check that they work as expected, particularly in the light of some
+internal changes made in how filehandles are blessed.
+
+=item *
+
+F<t/op/time_loop.t> tests that unix times greater than C<2**63>, which
+can now be handed to C<gmtime> and C<localtime>, do not cause an internal
+overflow or an excessively long loop.
+
+=back
+
+
+=head1 New or Changed Diagnostics
+
+=head2 New Diagnostics
+
+=over
+
+=item *
+
+SV allocation tracing has been added to the diagnostics enabled by C<-Dm>.
+The tracing can alternatively output via the C<PERL_MEM_LOG> mechanism, if
+that was enabled when the F<perl> binary was compiled.
+
+=item *
+
+Smartmatch resolution tracing has been added as a new diagnostic. Use
+C<-DM> to enable it.
+
+=item *
+
+A new debugging flag C<-DB> now dumps subroutine definitions, leaving
+C<-Dx> for its original purpose of dumping syntax trees.
+
+=item *
+
+Perl 5.12 provides a number of new diagnostic messages to help you write
+better code. See L<perldiag> for details of these new messages.
+
+=over 4
+
+=item *
+
+C<Bad plugin affecting keyword '%s'>
+
+=item *
+
+C<gmtime(%.0f) too large>
+
+=item *
+
+C<Lexing code attempted to stuff non-Latin-1 character into Latin-1 input>
+
+=item *
+
+C<Lexing code internal error (%s)>
+
+=item *
+
+C<localtime(%.0f) too large>
+
+=item *
+
+C<Overloaded dereference did not return a reference>
+
+=item *
+
+C<Overloaded qr did not return a REGEXP>
+
+=item *
+
+C<Perl_pmflag() is deprecated, and will be removed from the XS API>
+
+=item *
+
+C<lvalue attribute ignored after the subroutine has been defined>
+
+This new warning is issued when one attempts to mark a subroutine as
+lvalue after it has been defined.
+
+=item *
+
+Perl now warns you if C<++> or C<--> are unable to change the value
+because it's beyond the limit of representation.
+
+This uses a new warnings category: "imprecision".
+
+=item *
+
+C<lc>, C<uc>, C<lcfirst>, and C<ucfirst> warn when passed undef.
+
+=item *
+
+C<Show constant in "Useless use of a constant in void context">
+
+=item *
+
+C<Prototype after '%s'>
+
+=item *
+
+C<panic: sv_chop %s>
+
+This new fatal error occurs when the C routine C<Perl_sv_chop()> was
+passed a position that is not within the scalar's string buffer. This
+could be caused by buggy XS code, and at this point recovery is not
+possible.
+
+
+=item *
+
+The fatal error C<Malformed UTF-8 returned by \N> is now produced if the
+C<charnames> handler returns malformed UTF-8.
+
+=item *
+
+If an unresolved named character or sequence was encountered when
+compiling a regex pattern then the fatal error C<\N{NAME} must be resolved
+by the lexer> is now produced. This can happen, for example, when using a
+single-quotish context like C<$re = '\N{SPACE}'; /$re/;>. See L<perldiag>
+for more examples of how the lexer can get bypassed.
+
+=item *
+
+C<Invalid hexadecimal number in \N{U+...}> is a new fatal error
+triggered when the character constant represented by C<...> is not a
+valid hexadecimal number.
+
+=item *
+
+The new meaning of C<\N> as C<[^\n]> is not valid in a bracketed character
+class, just like C<.> in a character class loses its special meaning,
+and will cause the fatal error C<\N in a character class must be a named
+character: \N{...}>.
+
+=item *
+
+The rules on what is legal for the C<...> in C<\N{...}> have been
+tightened up so that unless the C<...> begins with an alphabetic
+character and continues with a combination of alphanumerics, dashes,
+spaces, parentheses or colons then the warning C<Deprecated character(s)
+in \N{...} starting at '%s'> is now issued.
+
+=item *
+
+The warning C<Using just the first characters returned by \N{}> will
+be issued if the C<charnames> handler returns a sequence of characters
+which exceeds the limit of the number of characters that can be used. The
+message will indicate which characters were used and which were discarded.
+
+=back
+
+=back
+
+=head2 Changed Diagnostics
+
+A number of existing diagnostic messages have been improved or corrected:
+
+=over
+
+=item *
+
+A new warning category C<illegalproto> allows finer-grained control of
+warnings around function prototypes.
+
+The two warnings:
+
+=over
+
+=item C<Illegal character in prototype for %s : %s>
+
+=item C<Prototype after '%c' for %s : %s>
+
+=back
+
+have been moved from the C<syntax> top-level warnings category into a new
+first-level category, C<illegalproto>. These two warnings are currently
+the only ones emitted during parsing of an invalid/illegal prototype,
+so one can now use
+
+ no warnings 'illegalproto';
+
+to suppress only those, but not other syntax-related warnings. Warnings
+where prototypes are changed, ignored, or not met are still in the
+C<prototype> category as before.
+
+=item *
+
+C<Deep recursion on subroutine "%s">
+
+It is now possible to change the depth threshold for this warning from the
+default of 100, by recompiling the F<perl> binary, setting the C
+pre-processor macro C<PERL_SUB_DEPTH_WARN> to the desired value.
+
+=item *
+
+C<Illegal character in prototype> warning is now more precise
+when reporting illegal characters after _
+
+=item *
+
+mro merging error messages are now very similar to those produced by
+L<Algorithm::C3>.
+
+=item *
+
+Amelioration of the error message "Unrecognized character %s in column %d"
+
+Changes the error message to "Unrecognized character %s; marked by E<lt>--
+HERE after %sE<lt>-- HERE near column %d". This should make it a little
+simpler to spot and correct the suspicious character.
+
+=item *
+
+Perl now explicitly points to C<$.> when it causes an uninitialized
+warning for ranges in scalar context.
+
+=item *
+
+C<split> now warns when called in void context.
+
+=item *
+
+C<printf>-style functions called with too few arguments will now issue the
+warning C<"Missing argument in %s"> [perl #71000]
+
+=item *
+
+Perl now properly returns a syntax error instead of segfaulting
+if C<each>, C<keys>, or C<values> is used without an argument.
+
+=item *
+
+C<tell()> now fails properly if called without an argument and when no
+previous file was read.
+
+C<tell()> now returns C<-1>, and sets errno to C<EBADF>, thus restoring
+the 5.8.x behaviour.
+
+=item *
+
+C<overload> no longer implicitly unsets fallback on repeated 'use
+overload' lines.
+
+=item *
+
+POSIX::strftime() can now handle Unicode characters in the format string.
+
+=item *
+
+The C<syntax> category was removed from 5 warnings that should only be in
+C<deprecated>.
+
+=item *
+
+Three fatal C<pack>/C<unpack> error messages have been normalized to
+C<panic: %s>
+
+=item *
+
+C<Unicode character is illegal> has been rephrased to be more accurate
+
+It now reads C<Unicode non-character is illegal in interchange> and the
+perldiag documentation has been expanded a bit.
+
+=item *
+
+Currently, all but the first of the several characters that the
+C<charnames> handler may return are discarded when used in a regular
+expression pattern bracketed character class. If this happens then the
+warning C<Using just the first character returned by \N{} in character
+class> will be issued.
+
+=item *
+
+The warning C<Missing right brace on \N{} or unescaped left brace after
+\N. Assuming the latter> will be issued if Perl encounters a C<\N{>
+but doesn't find a matching C<}>. In this case Perl doesn't know if it
+was mistakenly omitted, or if "match non-newline" followed by "match
+a C<{>" was desired. It assumes the latter because that is actually a
+valid interpretation as written, unlike the other case. If you meant
+the former, you need to add the matching right brace. If you did mean
+the latter, you can silence this warning by writing instead C<\N\{>.
+
+=item *
+
+C<gmtime> and C<localtime> called with numbers smaller than they can
+reliably handle will now issue the warnings C<gmtime(%.0f) too small>
+and C<localtime(%.0f) too small>.
+
+=back
+
+The following diagnostic messages have been removed:
+
+=over 4
+
+=item *
+
+C<Runaway format>
+
+=item *
+
+C<Can't locate package %s for the parents of %s>
+
+In general this warning it only got produced in
+conjunction with other warnings, and removing it allowed an ISA lookup
+optimisation to be added.
+
+=item *
+
+C<v-string in use/require is non-portable>
+
+=back
+
+=head1 Utility Changes
+
+=over 4
+
+=item *
+
+F<h2ph> now looks in C<include-fixed> too, which is a recent addition
+to gcc's search path.
+
+=item *
+
+F<h2xs> no longer incorrectly treats enum values like macros.
+It also now handles C++ style comments (C<//>) properly in enums.
+
+=item *
+
+F<perl5db.pl> now supports C<LVALUE> subroutines. Additionally, the
+debugger now correctly handles proxy constant subroutines, and
+subroutine stubs.
+
+=item *
+
+F<perlbug> now uses C<%Module::CoreList::bug_tracker> to print out
+upstream bug tracker URLs. If a user identifies a particular module
+as the topic of their bug report and we're able to divine the URL for
+its upstream bug tracker, perlbug now provide a message to the user
+explaining that the core copies the CPAN version directly, and provide
+the URL for reporting the bug directly to the upstream author.
+
+F<perlbug> no longer reports "Message sent" when it hasn't actually sent
+the message
+
+=item *
+
+F<perlthanks> is a new utility for sending non-bug-reports to the
+authors and maintainers of Perl. Getting nothing but bug reports can
+become a bit demoralising. If Perl 5.12 works well for you, please try
+out F<perlthanks>. It will make the developers smile.
+
+=item *
+
+Perl's developers have fixed bugs in F<a2p> having to do with the
+C<match()> operator in list context. Additionally, F<a2p> no longer
+generates code that uses the C<$[> variable.
+
+=back
+
+=head1 Selected Bug Fixes
+
+=over 4
+
+=item *
+
+U+0FFFF is now a legal character in regular expressions.
+
+=item *
+
+pp_qr now always returns a new regexp SV. Resolves RT #69852.
+
+Instead of returning a(nother) reference to the (pre-compiled) regexp
+in the optree, use reg_temp_copy() to create a copy of it, and return a
+reference to that. This resolves issues about Regexp::DESTROY not being
+called in a timely fashion (the original bug tracked by RT #69852), as
+well as bugs related to blessing regexps, and of assigning to regexps,
+as described in correspondence added to the ticket.
+
+It transpires that we also need to undo the SvPVX() sharing when ithreads
+cloning a Regexp SV, because mother_re is set to NULL, instead of a
+cloned copy of the mother_re. This change might fix bugs with regexps
+and threads in certain other situations, but as yet neither tests nor
+bug reports have indicated any problems, so it might not actually be an
+edge case that it's possible to reach.
+
+=item *
+
+Several compilation errors and segfaults when perl was built with C<-Dmad>
+were fixed.
+
+=item *
+
+Fixes for lexer API changes in 5.11.2 which broke NYTProf's savesrc option.
+
+=item *
+
+C<-t> should only return TRUE for file handles connected to a TTY
+
+The Microsoft C version of C<isatty()> returns TRUE for all character mode
+devices, including the F</dev/null>-style "nul" device and printers like
+"lpt1".
+
+=item *
+
+Fixed a regression caused by commit fafafbaf which caused a panic during
+parameter passing [perl #70171]
+
+=item *
+
+On systems which in-place edits without backup files, -i'*' now works as
+the documentation says it does [perl #70802]
+
+=item *
+
+Saving and restoring magic flags no longer loses readonly flag.
+
+=item *
+
+The malformed syntax C<grep EXPR LIST> (note the missing comma) no longer
+causes abrupt and total failure.
+
+=item *
+
+Regular expressions compiled with C<qr{}> literals properly set C<$'> when
+matching again.
+
+=item *
+
+Using named subroutines with C<sort> should no longer lead to bus errors
+[perl #71076]
+
+=item *
+
+Numerous bugfixes catch small issues caused by the recently-added Lexer API.
+
+=item *
+
+Smart match against C<@_> sometimes gave false negatives. [perl #71078]
+
+=item *
+
+C<$@> may now be assigned a read-only value (without error or busting
+the stack).
+
+=item *
+
+C<sort> called recursively from within an active comparison subroutine no
+longer causes a bus error if run multiple times. [perl #71076]
+
+=item *
+
+Tie::Hash::NamedCapture::* will not abort if passed bad input (RT #71828)
+
+=item *
+
+@_ and $_ no longer leak under threads (RT #34342 and #41138, also
+#70602, #70974)
+
+=item *
+
+C<-I> on shebang line now adds directories in front of @INC
+as documented, and as does C<-I> when specified on the command-line.
+
+=item *
+
+C<kill> is now fatal when called on non-numeric process identifiers.
+Previously, an C<undef> process identifier would be interpreted as a
+request to kill process 0, which would terminate the current process
+group on POSIX systems. Since process identifiers are always integers,
+killing a non-numeric process is now fatal.
+
+=item *
+
+5.10.0 inadvertently disabled an optimisation, which caused a measurable
+performance drop in list assignment, such as is often used to assign
+function parameters from C<@_>. The optimisation has been re-instated, and
+the performance regression fixed. (This fix is also present in 5.10.1)
+
+=item *
+
+Fixed memory leak on C<while (1) { map 1, 1 }> [RT #53038].
+
+=item *
+
+Some potential coredumps in PerlIO fixed [RT #57322,54828].
+
+=item *
+
+The debugger now works with lvalue subroutines.
+
+=item *
+
+The debugger's C<m> command was broken on modules that defined constants
+[RT #61222].
+
+=item *
+
+C<crypt> and string complement could return tainted values for untainted
+arguments [RT #59998].
+
+=item *
+
+The C<-i>I<.suffix> command-line switch now recreates the file using
+restricted permissions, before changing its mode to match the original
+file. This eliminates a potential race condition [RT #60904].
+
+=item *
+
+On some Unix systems, the value in C<$?> would not have the top bit set
+(C<$? & 128>) even if the child core dumped.
+
+=item *
+
+Under some circumstances, C<$^R> could incorrectly become undefined
+[RT #57042].
+
+=item *
+
+In the XS API, various hash functions, when passed a pre-computed hash where
+the key is UTF-8, might result in an incorrect lookup.
+
+=item *
+
+XS code including F<XSUB.h> before F<perl.h> gave a compile-time error
+[RT #57176].
+
+=item *
+
+C<< $object-E<gt>isa('Foo') >> would report false if the package C<Foo>
+didn't exist, even if the object's C<@ISA> contained C<Foo>.
+
+=item *
+
+Various bugs in the new-to 5.10.0 mro code, triggered by manipulating
+C<@ISA>, have been found and fixed.
+
+=item *
+
+Bitwise operations on references could crash the interpreter, e.g.
+C<$x=\$y; $x |= "foo"> [RT #54956].
+
+=item *
+
+Patterns including alternation might be sensitive to the internal UTF-8
+representation, e.g.
+
+ my $byte = chr(192);
+ my $utf8 = chr(192); utf8::upgrade($utf8);
+ $utf8 =~ /$byte|X}/i; # failed in 5.10.0
+
+=item *
+
+Within UTF8-encoded Perl source files (i.e. where C<use utf8> is in
+effect), double-quoted literal strings could be corrupted where a C<\xNN>,
+C<\0NNN> or C<\N{}> is followed by a literal character with ordinal value
+greater than 255 [RT #59908].
+
+=item *
+
+C<B::Deparse> failed to correctly deparse various constructs:
+C<readpipe STRING> [RT #62428], C<CORE::require(STRING)> [RT #62488],
+C<sub foo(_)> [RT #62484].
+
+=item *
+
+Using C<setpgrp> with no arguments could corrupt the perl stack.
+
+=item *
+
+The block form of C<eval> is now specifically trappable by C<Safe> and
+C<ops>. Previously it was erroneously treated like string C<eval>.
+
+=item *
+
+In 5.10.0, the two characters C<[~> were sometimes parsed as the smart
+match operator (C<~~>) [RT #63854].
+
+=item *
+
+In 5.10.0, the C<*> quantifier in patterns was sometimes treated as
+C<{0,32767}> [RT #60034, #60464]. For example, this match would fail:
+
+ ("ab" x 32768) =~ /^(ab)*$/
+
+=item *
+
+C<shmget> was limited to a 32 bit segment size on a 64 bit OS [RT #63924].
+
+=item *
+
+Using C<next> or C<last> to exit a C<given> block no longer produces a
+spurious warning like the following:
+
+ Exiting given via last at foo.pl line 123
+
+=item *
+
+Assigning a format to a glob could corrupt the format; e.g.:
+
+ *bar=*foo{FORMAT}; # foo format now bad
+
+=item *
+
+Attempting to coerce a typeglob to a string or number could cause an
+assertion failure. The correct error message is now generated,
+C<Can't coerce GLOB to I<$type>>.
+
+=item *
+
+Under C<use filetest 'access'>, C<-x> was using the wrong access
+mode. This has been fixed [RT #49003].
+
+=item *
+
+C<length> on a tied scalar that returned a Unicode value would not be
+correct the first time. This has been fixed.
+
+=item *
+
+Using an array C<tie> inside in array C<tie> could SEGV. This has been
+fixed. [RT #51636]
+
+=item *
+
+A race condition inside C<PerlIOStdio_close()> has been identified and
+fixed. This used to cause various threading issues, including SEGVs.
+
+=item *
+
+In C<unpack>, the use of C<()> groups in scalar context was internally
+placing a list on the interpreter's stack, which manifested in various
+ways, including SEGVs. This is now fixed [RT #50256].
+
+=item *
+
+Magic was called twice in C<substr>, C<\&$x>, C<tie $x, $m> and C<chop>.
+These have all been fixed.
+
+=item *
+
+A 5.10.0 optimisation to clear the temporary stack within the implicit
+loop of C<s///ge> has been reverted, as it turned out to be the cause of
+obscure bugs in seemingly unrelated parts of the interpreter [commit
+ef0d4e17921ee3de].
+
+=item *
+
+The line numbers for warnings inside C<elsif> are now correct.
+
+=item *
+
+The C<..> operator now works correctly with ranges whose ends are at or
+close to the values of the smallest and largest integers.
+
+=item *
+
+C<binmode STDIN, ':raw'> could lead to segmentation faults on some platforms.
+This has been fixed [RT #54828].
+
+=item *
+
+An off-by-one error meant that C<index $str, ...> was effectively being
+executed as C<index "$str\0", ...>. This has been fixed [RT #53746].
+
+=item *
+
+Various leaks associated with named captures in regexes have been fixed
+[RT #57024].
+
+=item *
+
+A weak reference to a hash would leak. This was affecting C<DBI>
+[RT #56908].
+
+=item *
+
+Using (?|) in a regex could cause a segfault [RT #59734].
+
+=item *
+
+Use of a UTF-8 C<tr//> within a closure could cause a segfault [RT #61520].
+
+=item *
+
+Calling C<Perl_sv_chop()> or otherwise upgrading an SV could result in an
+unaligned 64-bit access on the SPARC architecture [RT #60574].
+
+=item *
+
+In the 5.10.0 release, C<inc_version_list> would incorrectly list
+C<5.10.*> after C<5.8.*>; this affected the C<@INC> search order
+[RT #67628].
+
+=item *
+
+In 5.10.0, C<pack "a*", $tainted_value> returned a non-tainted value
+[RT #52552].
+
+=item *
+
+In 5.10.0, C<printf> and C<sprintf> could produce the fatal error
+C<panic: utf8_mg_pos_cache_update> when printing UTF-8 strings
+[RT #62666].
+
+=item *
+
+In the 5.10.0 release, a dynamically created C<AUTOLOAD> method might be
+missed (method cache issue) [RT #60220,60232].
+
+=item *
+
+In the 5.10.0 release, a combination of C<use feature> and C<//ee> could
+cause a memory leak [RT #63110].
+
+=item *
+
+C<-C> on the shebang (C<#!>) line is once more permitted if it is also
+specified on the command line. C<-C> on the shebang line used to be a
+silent no-op I<if> it was not also on the command line, so perl 5.10.0
+disallowed it, which broke some scripts. Now perl checks whether it is
+also on the command line and only dies if it is not [RT #67880].
+
+=item *
+
+In 5.10.0, certain types of re-entrant regular expression could crash,
+or cause the following assertion failure [RT #60508]:
+
+ Assertion rx->sublen >= (s - rx->subbeg) + i failed
+
+=item *
+
+Perl now includes previously missing files from the Unicode Character
+Database.
+
+=item *
+
+Perl now honors C<TMPDIR> when opening an anonymous temporary file.
+
+=back
+
+
+=head1 Platform Specific Changes
+
+Perl is incredibly portable. In general, if a platform has a C compiler,
+someone has ported Perl to it (or will soon). We're happy to announce
+that Perl 5.12 includes support for several new platforms. At the same
+time, it's time to bid farewell to some (very) old friends.
+
+=head2 New Platforms
+
+=over
+
+=item Haiku
+
+Perl's developers have merged patches from Haiku's maintainers. Perl
+should now build on Haiku.
+
+=item MirOS BSD
+
+Perl should now build on MirOS BSD.
+
+=back
+
+=head2 Discontinued Platforms
+
+=over
+
+=item Domain/OS
+
+=item MiNT
+
+=item Tenon MachTen
+
+=back
+
+=head2 Updated Platforms
+
+=over 4
+
+=item AIX
+
+=over 4
+
+=item *
+
+Removed F<libbsd> for AIX 5L and 6.1. Only C<flock()> was used from
+F<libbsd>.
+
+=item *
+
+Removed F<libgdbm> for AIX 5L and 6.1 if F<libgdbm> < 1.8.3-5 is
+installed. The F<libgdbm> is delivered as an optional package with the
+AIX Toolbox. Unfortunately the versions below 1.8.3-5 are broken.
+
+=item *
+
+Hints changes mean that AIX 4.2 should work again.
+
+=back
+
+=item Cygwin
+
+=over 4
+
+=item *
+
+Perl now supports IPv6 on Cygwin 1.7 and newer.
+
+=item *
+
+On Cygwin we now strip the last number from the DLL. This has been the
+behaviour in the cygwin.com build for years. The hints files have been
+updated.
+
+=back
+
+=item Darwin (Mac OS X)
+
+=over 4
+
+=item *
+
+Skip testing the be_BY.CP1131 locale on Darwin 10 (Mac OS X 10.6),
+as it's still buggy.
+
+=item *
+
+Correct infelicities in the regexp used to identify buggy locales
+on Darwin 8 and 9 (Mac OS X 10.4 and 10.5, respectively).
+
+=back
+
+=item DragonFly BSD
+
+=over 4
+
+=item *
+
+Fix thread library selection [perl #69686]
+
+=back
+
+=item FreeBSD
+
+=over 4
+
+=item *
+
+The hints files now identify the correct threading libraries on FreeBSD 7
+and later.
+
+=back
+
+=item Irix
+
+=over 4
+
+=item *
+
+We now work around a bizarre preprocessor bug in the Irix 6.5 compiler:
+C<cc -E -> unfortunately goes into K&R mode, but C<cc -E file.c> doesn't.
+
+=back
+
+=item NetBSD
+
+=over 4
+
+=item *
+
+Hints now supports versions 5.*.
+
+=back
+
+=item OpenVMS
+
+=over 4
+
+=item *
+
+C<-UDEBUGGING> is now the default on VMS.
+
+Like it has been everywhere else for ages and ages. Also make command-line
+selection of -UDEBUGGING and -DDEBUGGING work in configure.com; before
+the only way to turn it off was by saying no in answer to the interactive
+question.
+
+=item *
+
+The default pipe buffer size on VMS has been updated to 8192 on 64-bit
+systems.
+
+=item *
+
+Reads from the in-memory temporary files of C<PerlIO::scalar> used to fail
+if C<$/> was set to a numeric reference (to indicate record-style reads).
+This is now fixed.
+
+=item *
+
+VMS now supports C<getgrgid>.
+
+=item *
+
+Many improvements and cleanups have been made to the VMS file name handling
+and conversion code.
+
+=item *
+
+Enabling the C<PERL_VMS_POSIX_EXIT> logical name now encodes a POSIX exit
+status in a VMS condition value for better interaction with GNV's bash
+shell and other utilities that depend on POSIX exit values. See
+L<perlvms/"$?"> for details.
+
+=item *
+
+C<File::Copy> now detects Unix compatibility mode on VMS.
+
+=back
+
+=item Stratus VOS
+
+=over 4
+
+=item *
+
+Various changes from Stratus have been merged in.
+
+=back
+
+=item Symbian
+
+=over 4
+
+=item *
+
+There is now support for Symbian S60 3.2 SDK and S60 5.0 SDK.
+
+=back
+
+=item Windows
+
+=over 4
+
+=item *
+
+Perl 5.12 supports Windows 2000 and later. The supporting code for
+legacy versions of Windows is still included, but will be removed
+during the next development cycle.
+
+=item *
+
+Initial support for building Perl with MinGW-w64 is now available.
+
+=item *
+
+F<perl.exe> now includes a manifest resource to specify the C<trustInfo>
+settings for Windows Vista and later. Without this setting Windows
+would treat F<perl.exe> as a legacy application and apply various
+heuristics like redirecting access to protected file system areas
+(like the "Program Files" folder) to the users "VirtualStore"
+instead of generating a proper "permission denied" error.
+
+The manifest resource also requests the Microsoft Common-Controls
+version 6.0 (themed controls introduced in Windows XP). Check out the
+Win32::VisualStyles module on CPAN to switch back to old style
+unthemed controls for legacy applications.
+
+=item *
+
+The C<-t> filetest operator now only returns true if the filehandle
+is connected to a console window. In previous versions of Perl it
+would return true for all character mode devices, including F<NUL>
+and F<LPT1>.
+
+=item *
+
+The C<-p> filetest operator now works correctly, and the
+Fcntl::S_IFIFO constant is defined when Perl is compiled with
+Microsoft Visual C. In previous Perl versions C<-p> always
+returned a false value, and the Fcntl::S_IFIFO constant
+was not defined.
+
+This bug is specific to Microsoft Visual C and never affected
+Perl binaries built with MinGW.
+
+=item *
+
+The socket error codes are now more widely supported: The POSIX
+module will define the symbolic names, like POSIX::EWOULDBLOCK,
+and stringification of socket error codes in $! works as well
+now;
+
+ C:\>perl -MPOSIX -E "$!=POSIX::EWOULDBLOCK; say $!"
+ A non-blocking socket operation could not be completed immediately.
+
+=item *
+
+flock() will now set sensible error codes in $!. Previous Perl versions
+copied the value of $^E into $!, which caused much confusion.
+
+=item *
+
+select() now supports all empty C<fd_set>s more correctly.
+
+=item *
+
+C<'.\foo'> and C<'..\foo'> were treated differently than
+C<'./foo'> and C<'../foo'> by C<do> and C<require> [RT #63492].
+
+=item *
+
+Improved message window handling means that C<alarm> and C<kill> messages
+will no longer be dropped under race conditions.
+
+=item *
+
+Various bits of Perl's build infrastructure are no longer converted to
+win32 line endings at release time. If this hurts you, please report the
+problem with the L<perlbug> program included with perl.
+
+=back
+
+=back
+
+
+=head1 Known Problems
+
+This is a list of some significant unfixed bugs, which are regressions
+from either 5.10.x or 5.8.x.
+
+=over 4
+
+=item *
+
+Some CPANPLUS tests may fail if there is a functioning file
+F<../../cpanp-run-perl> outside your build directory. The failure
+shouldn't imply there's a problem with the actual functional
+software. The bug is already fixed in [RT #74188] and is scheduled for
+inclusion in perl-v5.12.1.
+
+=item *
+
+C<List::Util::first> misbehaves in the presence of a lexical C<$_>
+(typically introduced by C<my $_> or implicitly by C<given>). The variable
+which gets set for each iteration is the package variable C<$_>, not the
+lexical C<$_> [RT #67694].
+
+A similar issue may occur in other modules that provide functions which
+take a block as their first argument, like
+
+ foo { ... $_ ...} list
+
+=item *
+
+Some regexes may run much more slowly when run in a child thread compared
+with the thread the pattern was compiled into [RT #55600].
+
+=item *
+
+Things like C<"\N{LATIN SMALL LIGATURE FF}" =~ /\N{LATIN SMALL LETTER F}+/>
+will appear to hang as they get into a very long running loop [RT #72998].
+
+=item *
+
+Several porters have reported mysterious crashes when Perl's entire
+test suite is run after a build on certain Windows 2000 systems. When
+run by hand, the individual tests reportedly work fine.
+
+=back
+
+=head1 Errata
+
+=over
+
+=item *
+
+This one is actually a change introduced in 5.10.0, but it was missed
+from that release's perldelta, so it is mentioned here instead.
+
+A bugfix related to the handling of the C</m> modifier and C<qr> resulted
+in a change of behaviour between 5.8.x and 5.10.0:
+
+ # matches in 5.8.x, doesn't match in 5.10.0
+ $re = qr/^bar/; "foo\nbar" =~ /$re/m;
+
+=back
+
+=head1 Acknowledgements
+
+Perl 5.12.0 represents approximately two years of development since
+Perl 5.10.0 and contains over 750,000 lines of changes across over
+3,000 files from over 200 authors and committers.
+
+Perl continues to flourish into its third decade thanks to a vibrant
+community of users and developers. The following people are known to
+have contributed the improvements that became Perl 5.12.0:
+
+Aaron Crane, Abe Timmerman, Abhijit Menon-Sen, Abigail, Adam Russell,
+Adriano Ferreira, Ævar Arnfjörð Bjarmason, Alan Grover, Alexandr
+Ciornii, Alex Davies, Alex Vandiver, Andreas Koenig, Andrew Rodland,
+andrew@sundale.net, Andy Armstrong, Andy Dougherty, Jose AUGUSTE-ETIENNE,
+Benjamin Smith, Ben Morrow, bharanee rathna, Bo Borgerson, Bo Lindbergh,
+Brad Gilbert, Bram, Brendan O'Dea, brian d foy, Charles Bailey,
+Chip Salzenberg, Chris 'BinGOs' Williams, Christoph Lamprecht, Chris
+Williams, chromatic, Claes Jakobsson, Craig A. Berry, Dan Dascalescu,
+Daniel Frederick Crisman, Daniel M. Quinlan, Dan Jacobson, Dan Kogai,
+Dave Mitchell, Dave Rolsky, David Cantrell, David Dick, David Golden,
+David Mitchell, David M. Syzdek, David Nicol, David Wheeler, Dennis
+Kaarsemaker, Dintelmann, Peter, Dominic Dunlop, Dr.Ruud, Duke Leto,
+Enrico Sorcinelli, Eric Brine, Father Chrysostomos, Florian Ragwitz,
+Frank Wiegand, Gabor Szabo, Gene Sullivan, Geoffrey T. Dairiki, George
+Greer, Gerard Goossen, Gisle Aas, Goro Fuji, Graham Barr, Green, Paul,
+Hans Dieter Pearcey, Harmen, H. Merijn Brand, Hugo van der Sanden,
+Ian Goodacre, Igor Sutton, Ingo Weinhold, James Bence, James Mastros,
+Jan Dubois, Jari Aalto, Jarkko Hietaniemi, Jay Hannah, Jerry Hedden,
+Jesse Vincent, Jim Cromie, Jody Belka, John E. Malmberg, John Malmberg,
+John Peacock, John Peacock via RT, John P. Linderman, John Wright,
+Josh ben Jore, Jos I. Boumans, Karl Williamson, Kenichi Ishigaki, Ken
+Williams, Kevin Brintnall, Kevin Ryde, Kurt Starsinic, Leon Brocard,
+Lubomir Rintel, Luke Ross, Marcel Grünauer, Marcus Holland-Moritz, Mark
+Jason Dominus, Marko Asplund, Martin Hasch, Mashrab Kuvatov, Matt Kraai,
+Matt S Trout, Max Maischein, Michael Breen, Michael Cartmell, Michael
+G Schwern, Michael Witten, Mike Giroux, Milosz Tanski, Moritz Lenz,
+Nicholas Clark, Nick Cleaton, Niko Tyni, Offer Kaye, Osvaldo Villalon,
+Paul Fenwick, Paul Gaborit, Paul Green, Paul Johnson, Paul Marquess,
+Philip Hazel, Philippe Bruhat, Rafael Garcia-Suarez, Rainer Tammer,
+Rajesh Mandalemula, Reini Urban, Renée Bäcker, Ricardo Signes,
+Ricardo SIGNES, Richard Foley, Rich Rauenzahn, Rick Delaney, Risto
+Kankkunen, Robert May, Roberto C. Sanchez, Robin Barker, SADAHIRO
+Tomoyuki, Salvador Ortiz Garcia, Sam Vilain, Scott Lanning, Sébastien
+Aperghis-Tramoni, Sérgio Durigan Júnior, Shlomi Fish, Simon 'corecode'
+Schubert, Sisyphus, Slaven Rezic, Smylers, Steffen Müller, Steffen
+Ullrich, Stepan Kasal, Steve Hay, Steven Schubiger, Steve Peters, Tels,
+The Doctor, Tim Bunce, Tim Jenness, Todd Rinaldo, Tom Christiansen,
+Tom Hukins, Tom Wyant, Tony Cook, Torsten Schoenfeld, Tye McQueen,
+Vadim Konovalov, Vincent Pit, Hio YAMASHINA, Yasuhiro Matsumoto,
+Yitzchak Scott-Thoennes, Yuval Kogman, Yves Orton, Zefram, Zsban Ambrus
+
+This is woefully incomplete as it's automatically generated from version
+control history. In particular, it doesn't include the names of the
+(very much appreciated) contributors who reported issues in previous
+versions of Perl that helped make Perl 5.12.0 better. For a more complete
+list of all of Perl's historical contributors, please see the C<AUTHORS>
+file in the Perl 5.12.0 distribution.
+
+Our "retired" pumpkings Nicholas Clark and Rafael Garcia-Suarez
+deserve special thanks for their brilliant and substantive ongoing
+contributions. Nicholas personally authored over 30% of the patches
+since 5.10.0. Rafael comes in second in patch authorship with 11%,
+but is first by a long shot in committing patches authored by others,
+pushing 44% of the commits since 5.10.0 in this category, often after
+providing considerable coaching to the patch authors. These statistics
+in no way comprise all of their contributions, but express in shorthand
+that we couldn't have done it without them.
+
+Many of the changes included in this version originated in the CPAN
+modules included in Perl's core. We're grateful to the entire CPAN
+community for helping Perl to flourish.
+
+=head1 Reporting Bugs
+
+If you find what you think is a bug, you might check the articles
+recently posted to the comp.lang.perl.misc newsgroup and the perl
+bug database at L<http://rt.perl.org/perlbug/>. There may also be
+information at L<http://www.perl.org/>, the Perl Home Page.
+
+If you believe you have an unreported bug, please run the B<perlbug>
+program included with your release. Be sure to 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.org to be
+analyzed by the Perl porting team.
+
+If the bug you are reporting has security implications, which make it
+inappropriate to send to a publicly archived mailing list, then please send
+it to perl5-security-report@perl.org. This points to a closed subscription
+unarchived mailing list, which includes all the core committers, who be able
+to help assess the impact of issues, figure out a resolution, and help
+co-ordinate the release of patches to mitigate or fix the problem across all
+platforms on which Perl is supported. Please only use this address for
+security issues in the Perl core, not for modules independently
+distributed on CPAN.
+
+=head1 SEE ALSO
+
+The F<Changes> file for an explanation of how to view exhaustive details
+on what changed.
+
+The F<INSTALL> file for how to build Perl.
+
+The F<README> file for general stuff.
+
+The F<Artistic> and F<Copying> files for copyright information.
+
+L<http://dev.perl.org/perl5/errata.html> for a list of issues
+found after this release, as well as a list of CPAN modules known
+to be incompatible with this release.
+
+=cut
--- /dev/null
+=encoding utf8
+
+=head1 NAME
+
+perldelta5130 - what is new for perl v5.13.0
+
+=head1 DESCRIPTION
+
+This document describes differences between the 5.12.0 release and the
+5.13.0 release.
+
+If you are upgrading from an earlier release such as 5.10.0, first read
+L<perl5120delta>, which describes differences between 5.10.0 and
+5.12.0.
+
+=head1 Core Enhancements
+
+=head2 "safe signals" optimization
+
+Signal dispatch has been moved from the runloop into control ops. This
+should give a few percent speed increase, and eliminates almost all of
+the speed penalty caused by the introduction of "safe signals" in
+5.8.0. Signals should still be dispatched within the same statement as
+they were previously - if this is not the case, or it is possible to
+create uninterruptable loops, this is a bug, and reports are encouraged
+of how to recreate such issues.
+
+=head2 Assignment to C<$0> sets the legacy process name with C<prctl()> on Linux
+
+On Linux the legacy process name will be set with L<prctl(2)>, in
+addition to altering the POSIX name via C<argv[0]> as perl has done
+since version 4.000. Now system utilities that read the legacy process
+name such as ps, top and killall will recognize the name you set when
+assigning to C<$0>. The string you supply will be cut off at 16 bytes,
+this is a limitation imposed by Linux.
+
+=head2 Optimization of shift; and pop; calls without arguments
+
+Additional two OPs are not added anymore into op tree for shift and pop
+calls without argument (when it works on C<@_>). Makes C<shift;> 5%
+faster over C<shift @_;> on not threaded perl and 25% faster on threaded.
+
+=head1 Modules and Pragmata
+
+=head2 Updated Modules
+
+=over 4
+
+=item CGI
+
+Updated to version 3.49.
+
+=item Data::Dumper
+
+Updated to version 2.126.
+
+=item MIME::Base64
+
+Updated to 3.09.
+
+=item threads
+
+Updated to version 1.77
+
+=item threads-shared
+
+Updated to version 1.33
+
+=back
+
+=head1 Installation and Configuration Improvements
+
+=head2 Platform Specific Changes
+
+=over 4
+
+=item AIX
+
+Allow building on AIX 4.2.
+
+=back
+
+=head1 Acknowledgements
+
+Perl 5.13.0 represents eight days of development since Perl 5.12.0 and
+contains 3,766 lines of changes across 151 files from 29 authors and
+committers.
+
+Thank you to the following for contributing to this release:
+
+Ævar Arnfjörð Bjarmason, Alex Vandiver, Chris Williams, chromatic,
+Craig A. Berry, David Golden, David Mitchell, Eric Brine, Father
+Chrysostomos, Florian Ragwitz, Frank Wiegand, Gisle Aas, H.Merijn
+Brand, Hugo van der Sanden, Jesse Vincent, Josh ben Jore, Karl
+Williamson, Leon Brocard, Michael G Schwern, Michael G. Schwern, Nga
+Tang Chan, Nicholas Clark, Niko Tyni, Rafael Garcia-Suarez, Ricardo
+Signes, Robin Barker, Slaven Rezic, Steffen Mueller, Zefram.
+
+=head1 Reporting Bugs
+
+If you find what you think is a bug, you might check the articles
+recently posted to the comp.lang.perl.misc newsgroup and the perl bug
+database at http://rt.perl.org/perlbug/ . There may also be
+information at http://www.perl.org/ , the Perl Home Page.
+
+If you believe you have an unreported bug, please run the B<perlbug>
+program included with your release. Be sure to 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.org to be analysed by
+the Perl porting team.
+
+If the bug you are reporting has security implications, which make it
+inappropriate to send to a publicly archived mailing list, then please
+send it to perl5-security-report@perl.org. This points to a closed
+subscription unarchived mailing list, which includes all the core
+committers, who be able to help assess the impact of issues, figure out
+a resolution, and help co-ordinate the release of patches to mitigate
+or fix the problem across all platforms on which Perl is supported.
+Please only use this address for security issues in the Perl core, not
+for modules independently distributed on CPAN.
+
+=head1 SEE ALSO
+
+The F<Changes> file for an explanation of how to view exhaustive
+details on what changed.
+
+The F<INSTALL> file for how to build Perl.
+
+The F<README> file for general stuff.
+
+The F<Artistic> and F<Copying> files for copyright information.
+
+=cut
--- /dev/null
+=encoding utf8
+
+=head1 NAME
+
+[ this is a template for a new perldelta file. Any text flagged as
+XXX needs to be processed before release. ]
+
+perldelta - what is new for perl v5.13.1
+
+=head1 DESCRIPTION
+
+This document describes differences between the 5.13.0 release and
+the 5.13.1 release.
+
+If you are upgrading from an earlier release such as 5.10, first read
+L<perl5120delta>, which describes differences between 5.10 and
+5.12.
+
+=head1 Notice
+
+XXX Any important notices here
+
+=head1 Incompatible Changes
+
+=head2 "C<\cI<X>>"
+
+The backslash-c construct was designed as a way of specifying
+non-printable characters, but there were no restrictions (on ASCII
+platforms) on what the character following the C<c> could be. Now, that
+character must be one of the ASCII characters.
+
+=head2 localised tied hashes, arrays and scalars are no longed tied
+
+In the following:
+
+ tie @a, ...;
+ {
+ local @a;
+ # here, @a is a now a new, untied array
+ }
+ # here, @a refers again to the old, tied array
+
+The new local array used to be made tied too, which was fairly pointless,
+and has now been fixed. This fix could however potentially cause a change
+in behaviour of some code.
+
+=head1 Core Enhancements
+
+XXX New core language features go here. Summarise user-visible core language
+enhancements. Particularly prominent performance optimisations could go
+here, but most should go in the L</Performance Enhancements> section.
+
+=head2 Exception Handling Reliability
+
+Several changes have been made to the way C<die>, C<warn>, and C<$@>
+behave, in order to make them more reliable and consistent.
+
+When an exception is thrown inside an C<eval>, the exception is no
+longer at risk of being clobbered by code running during unwinding
+(e.g., destructors). Previously, the exception was written into C<$@>
+early in the throwing process, and would be overwritten if C<eval> was
+used internally in the destructor for an object that had to be freed
+while exiting from the outer C<eval>. Now the exception is written
+into C<$@> last thing before exiting the outer C<eval>, so the code
+running immediately thereafter can rely on the value in C<$@> correctly
+corresponding to that C<eval>.
+
+Likewise, a C<local $@> inside an C<eval> will no longer clobber any
+exception thrown in its scope. Previously, the restoration of C<$@> upon
+unwinding would overwrite any exception being thrown. Now the exception
+gets to the C<eval> anyway. So C<local $@> is safe inside an C<eval>,
+albeit of rather limited use.
+
+Exceptions thrown from object destructors no longer modify the C<$@>
+of the surrounding context. (If the surrounding context was exception
+unwinding, this used to be another way to clobber the exception being
+thrown. Due to the above change it no longer has that significance,
+but there are other situations where C<$@> is significant.) Previously
+such an exception was sometimes emitted as a warning, and then either
+string-appended to the surrounding C<$@> or completely replaced the
+surrounding C<$@>, depending on whether that exception and the surrounding
+C<$@> were strings or objects. Now, an exception in this situation is
+always emitted as a warning, leaving the surrounding C<$@> untouched.
+In addition to object destructors, this also affects any function call
+performed by XS code using the C<G_KEEPERR> flag.
+
+C<$@> is also no longer used as an internal temporary variable when
+preparing to C<die>. Previously it was internally necessary to put
+any exception object (any non-string exception) into C<$@> first,
+before it could be used as an exception. (The C API still offers the
+old option, so an XS module might still clobber C<$@> in the old way.)
+This change together with the foregoing means that, in various places,
+C<$@> may be observed to contain its previously-assigned value, rather
+than having been overwritten by recent exception-related activity.
+
+Warnings for C<warn> can now be objects, in the same way as exceptions
+for C<die>. If an object-based warning gets the default handling,
+of writing to standard error, it will of course still be stringified
+along the way. But a C<$SIG{__WARN__}> handler will now receive an
+object-based warning as an object, where previously it was passed the
+result of stringifying the object.
+
+=head1 New Platforms
+
+XXX List any platforms that this version of perl compiles on, that previous
+versions did not. These will either be enabled by new files in the F<hints/>
+directories, or new subdirectories and F<README> files at the top level of the
+source tree.
+
+=head1 Modules and Pragmata
+
+XXX All changes to installed files in F<cpan/>, F<dist/>, F<ext/> and F<lib/>
+go here. If Module::CoreList is updated, generate an initial draft of the
+following sections using F<Porting/corelist-perldelta.pl>, which prints stub
+entries to STDOUT. Results can be pasted in place of the '=head2' entries
+below. A paragraph summary for important changes should then be added by hand.
+In an ideal world, dual-life modules would have a F<Changes> file that could be
+cribbed.
+
+=over
+
+=item C<Errno>
+
+The implementation of C<Errno> has been refactored to use about 55% less memory.
+There should be no user-visible changes.
+
+=back
+
+=head2 New Modules and Pragmata
+
+=head2 Pragmata Changes
+
+=head2 Updated Modules
+
+=over
+
+=item Perl 4 C<.pl> libraries
+
+These historical libraries have been minimally modified to avoid using
+C<$[>. This is to prepare them for the deprecation of C<$[>.
+
+=item C<B::Deparse>
+
+A bug has been fixed when deparsing a nextstate op that has both a
+change of package (relative to the previous nextstate), or a change of
+C<%^H> or other state, and a label. Previously the label was emitted
+first, leading to syntactically invalid output because a label is not
+permitted immediately before a package declaration, B<BEGIN> block,
+or some other things. Now the label is emitted last.
+
+=back
+
+=head2 Removed Modules and Pragmata
+
+The following modules have been removed from the core distribution, and if
+needed should be installed from CPAN instead.
+
+=over
+
+=item C<Class::ISA>
+
+=item C<Pod::Plainer>
+
+=item C<Switch>
+
+=back
+
+The removal of C<Shell> has been deferred until after 5.14, as the
+implementation of C<Shell> shipped with 5.12.0 did not correctly issue the
+warning that it was to be removed from core.
+
+=head1 Utility Changes
+
+XXX Changes to installed programs such as F<perlbug> and F<xsubpp> go
+here. Most of these are built within the directories F<utils> and F<x2p>.
+
+=over 4
+
+=item F<XXX>
+
+XXX
+
+=back
+
+=head1 New Documentation
+
+XXX Changes which create B<new> files in F<pod/> go here.
+
+=over 4
+
+=item L<XXX>
+
+XXX
+
+=back
+
+=head1 Changes to Existing Documentation
+
+XXX Changes which significantly change existing files in F<pod/> go here.
+Any changes to F<pod/perldiag.pod> should go in L</New or Changed Diagnostics>.
+
+
+=head1 Performance Enhancements
+
+XXX Changes which enhance performance without changing behaviour go here. There
+may well be none in a stable release.
+
+=over 4
+
+=item *
+
+XXX
+
+=back
+
+=head1 Installation and Configuration Improvements
+
+XXX Changes to F<Configure>, F<installperl>, F<installman>, and analogous tools
+go here.
+
+=head2 Configuration improvements
+
+XXX
+
+=head2 Compilation improvements
+
+XXX
+
+=head2 Platform Specific Changes
+
+=over 4
+
+=item XXX-some-platform
+
+XXX
+
+=back
+
+=head1 Selected Bug Fixes
+
+XXX Important bug fixes in the core language are summarised here.
+Bug fixes in files in F<ext/> and F<lib/> are best summarised in
+L</Modules and Pragmata>.
+
+=over 4
+
+=item *
+
+XXX
+
+=back
+
+=head1 New or Changed Diagnostics
+
+XXX New or changed warnings emitted by the core's C<C> code go here.
+
+=over 4
+
+=item C<XXX>
+
+XXX
+
+=back
+
+=head1 Changed Internals
+
+XXX Changes which affect the interface available to C<XS> code go here.
+
+=over 4
+
+=item *
+
+The protocol for unwinding the C stack at the last stage of a C<die>
+has changed how it identifies the target stack frame. This now uses
+a separate variable C<PL_restartjmpenv>, where previously it relied on
+the C<blk_eval.cur_top_env> pointer in the C<eval> context frame that
+has nominally just been discarded. This change means that code running
+during various stages of Perl-level unwinding no longer needs to take
+care to avoid destroying the ghost frame.
+
+=item *
+
+The format of entries on the scope stack has been changed, resulting in a
+reduction of memory usage of about 10%. In particular, the memory used by
+the scope stack to record each active lexical variable has been halved.
+
+=item *
+
+Memory allocation for pointer tables has been changed. Previously
+C<Perl_ptr_table_store> allocated memory from the same arena system as C<SV>
+bodies and C<HE>s, with freed memory remaining bound to those arenas until
+interpreter exit. Now it allocates memory from arenas private to the specific
+pointer table, and that memory is returned to the system when
+C<Perl_ptr_table_free> is called. Additionally, allocation and release are both
+less CPU intensive.
+
+=item *
+
+XXX
+
+=back
+
+=head1 New Tests
+
+XXX Changes which create B<new> files in F<t/> go here. Changes to
+existing files in F<t/> aren't worth summarising, although the bugs that
+they represent may be.
+
+=over 4
+
+=item F<XXX>
+
+XXX
+
+=back
+
+=head1 Known Problems
+
+XXX Descriptions of platform agnostic bugs we know we can't fix go here. Any
+tests that had to be C<TODO>ed for the release would be noted here, unless
+they were specific to a particular platform (see below).
+
+This is a list of some significant unfixed bugs, which are regressions
+from either 5.XXX.XXX or 5.XXX.XXX.
+
+=over 4
+
+=item *
+
+XXX
+
+=back
+
+=head1 Deprecations
+
+XXX Add any new known deprecations here.
+
+The following items are now deprecated.
+
+=over 4
+
+=item C<Perl_ptr_table_clear>
+
+C<Perl_ptr_table_clear> is no longer part of Perl's public API. Calling it now
+generates a deprecation warning, and it will be removed in a future
+release.
+
+=item *
+
+XXX
+
+=back
+
+=head1 Platform Specific Notes
+
+XXX Any changes specific to a particular platform. VMS and Win32 are the usual
+stars here. It's probably best to group changes under the same section layout
+as the main perldelta
+
+=head1 Obituary
+
+XXX If any significant core contributor has died, we've added a short obituary
+here.
+
+=head1 Acknowledgements
+
+XXX The list of people to thank goes here.
+
+
+=head1 Reporting Bugs
+
+If you find what you think is a bug, you might check the articles
+recently posted to the comp.lang.perl.misc newsgroup and the perl
+bug database at http://rt.perl.org/perlbug/ . There may also be
+information at http://www.perl.org/ , the Perl Home Page.
+
+If you believe you have an unreported bug, please run the B<perlbug>
+program included with your release. Be sure to 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.org to be
+analysed by the Perl porting team.
+
+If the bug you are reporting has security implications, which make it
+inappropriate to send to a publicly archived mailing list, then please send
+it to perl5-security-report@perl.org. This points to a closed subscription
+unarchived mailing list, which includes all the core committers, who be able
+to help assess the impact of issues, figure out a resolution, and help
+co-ordinate the release of patches to mitigate or fix the problem across all
+platforms on which Perl is supported. Please only use this address for
+security issues in the Perl core, not for modules independently
+distributed on CPAN.
+
+=head1 SEE ALSO
+
+The F<Changes> file for an explanation of how to view exhaustive details
+on what changed.
+
+The F<INSTALL> file for how to build Perl.
+
+The F<README> file for general stuff.
+
+The F<Artistic> and F<Copying> files for copyright information.
+
+=cut
=item *
The perlcc utility has been rewritten and its user interface (that is,
-command line) is much more like that of the UNIX C compiler, cc.
+command line) is much more like that of the Unix C compiler, cc.
=item *
previous Perls), perlio (re-implementation of stdio buffering in a
portable manner), crlf (does CRLF <=> "\n" translation as on Win32,
but available on any platform). A mmap layer may be available if
-platform supports it (mostly UNIXes).
+platform supports it (mostly Unixes).
Layers to be applied by default may be specified via the 'open' pragma.
=item *
-The list form of C<open> is now implemented for pipes (at least on UNIX):
+The list form of C<open> is now implemented for pipes (at least on Unix):
open($fh,"-|", 'cat', '/etc/motd')
Many new tests have been added. The most notable is probably the
lib/1_compile: it is very notable because running it takes quite a
-long time -- it test compiles all the Perl modules in the distribution.
+long time. It test compiles all the Perl modules in the distribution.
Please be patient.
=head1 Known Problems
=item *
-The Amdahl UTS UNIX mainframe platform is now supported.
+The Amdahl UTS Unix mainframe platform is now supported.
=back
L<Changes58> (or L<Changes> in Perl 5.8.1). In addition to these
changes, lots of work took place in integrating threads, PerlIO, and
Unicode; general code cleanup; and last but not least porting to
-non-UNIX lands such as Win32, VMS, Cygwin, DJGPP, VOS, MacOS Classic,
+non-Unix lands such as Win32, VMS, Cygwin, DJGPP, VOS, MacOS Classic,
and EBCDIC.
=over 4
=head1 Installation and Configuration Improvements
-The UNIX standard Perl location, F</usr/bin/perl>, is no longer
+The Unix standard Perl location, F</usr/bin/perl>, is no longer
overwritten by default if it exists. This change was very prudent
-because so many UNIX vendors already provide a F</usr/bin/perl>,
+because so many Unix vendors already provide a F</usr/bin/perl>,
but simultaneously many system utilities may depend on that
exact version of Perl, so better not to overwrite it.
+=encoding utf8
+
=head1 NAME
perl588delta - what is new for perl v5.8.8
=item *
-Operations that require perl to read a process' list of groups, such as reads
+Operations that require perl to read a process's list of groups, such as reads
of C<$(> and C<$)>, now dynamically allocate memory rather than using a
fixed sized array. The fixed size array could cause C stack exhaustion on
systems configured to use large numbers of groups.
=item *
-now generates correct correct code for C<#if defined A || defined B>
+now generates correct code for C<#if defined A || defined B>
[RT #39130]
=back
=item *
-On VMS, escaped dots will be preserved when converted to UNIX syntax.
+On VMS, escaped dots will be preserved when converted to Unix syntax.
=item *
=item t/op/incfilter.t
-Tests for for source filters returned from code references in C<@INC>.
+Tests for source filters returned from code references in C<@INC>.
=item t/op/kill0.t
The list of filenames from glob() (or <...>) is now by default sorted
alphabetically to be csh-compliant (which is what happened before
-in most UNIX platforms). (bsd_glob() does still sort platform
+in most Unix platforms). (bsd_glob() does still sort platform
natively, ASCII or EBCDIC, unless GLOB_ALPHASORT is specified.) [561]
=head2 Deprecations
previous Perls), perlio (re-implementation of stdio buffering in a
portable manner), crlf (does CRLF <=> "\n" translation as on Win32,
but available on any platform). A mmap layer may be available if
-platform supports it (mostly UNIXes).
+platform supports it (mostly Unixes).
Layers to be applied by default may be specified via the 'open' pragma.
=item *
C<perlcc> has been rewritten and its user interface (that is,
-command line) is much more like that of the UNIX C compiler, cc.
+command line) is much more like that of the Unix C compiler, cc.
(The perlbc tools has been removed. Use C<perlcc -B> instead.)
B<Note that perlcc is still considered very experimental and
unsupported.> [561]
=item *
C<pod2html> now understands POD written using different line endings
-(PC-like CRLF versus UNIX-like LF versus MacClassic-like CR).
+(PC-like CRLF versus Unix-like LF versus MacClassic-like CR).
=item *
=item *
-The Amdahl UTS UNIX mainframe platform is now supported. [561]
+The Amdahl UTS Unix mainframe platform is now supported. [561]
=item *
=head1 Installation and Configuration Improvements
-The UNIX standard Perl location, F</usr/bin/perl>, is no longer
+The Unix standard Perl location, F</usr/bin/perl>, is no longer
overwritten by default if it exists. This change was very prudent
-because so many UNIX vendors already provide a F</usr/bin/perl>,
+because so many Unix vendors already provide a F</usr/bin/perl>,
but simultaneously many system utilities may depend on that
exact version of Perl, so better not to overwrite it.
effect for the regular expression engine when running under C<use re
"debug">. See L<re> for details.
-A new variable ${^UTF8LOCALE} indicates where an UTF-8 locale was detected
+A new variable ${^UTF8LOCALE} indicates where a UTF-8 locale was detected
by perl at startup.
=head1 Modules and Pragmata
+=encoding utf8
+
=head1 NAME
perl593delta - what is new for perl v5.9.3
=item *
-Operations that require perl to read a process' list of groups, such as reads
+Operations that require perl to read a process's list of groups, such as reads
of C<$(> and C<$)>, now dynamically allocate memory rather than using a
fixed sized array. The fixed size array could cause C stack exhaustion on
systems configured to use large numbers of groups.
=head1 DESCRIPTION
-This is B<"The Artistic License">. It's here so that modules,
-programs, etc., that want to declare this as their distribution
-license, can link to it.
+Perl is free software; you can redistribute it and/or modify
+it under the terms of either:
-It is also one of the two licenses Perl allows itself to be
-redistributed and/or modified; for the other one, the GNU General
-Public License, see the L<perlgpl>.
+ a) the GNU General Public License as published by the Free
+ Software Foundation; either version 1, or (at your option) any
+ later version, or
+
+ b) the "Artistic License" which comes with this Kit.
+
+This is B<"The Artistic License">.
+It's here so that modules, programs, etc., that want to declare
+this as their distribution license can link to it.
+
+For the GNU General Public License, see L<perlgpl>.
=head1 The "Artistic License"
Now, what about data?
-=head2 A horse is a horse, of course of course -- or is it?
+=head2 A horse is a horse, of course of course, or is it?
Let's start with the code for the C<Animal> class
and the C<Horse> class:
=head2 G_KEEPERR
-You may have noticed that using the G_EVAL flag described above will
-B<always> clear the C<$@> variable and set it to a string describing
-the error iff there was an error in the called code. This unqualified
-resetting of C<$@> can be problematic in the reliable identification of
-errors using the C<eval {}> mechanism, because the possibility exists
-that perl will call other code (end of block processing code, for
-example) between the time the error causes C<$@> to be set within
-C<eval {}>, and the subsequent statement which checks for the value of
-C<$@> gets executed in the user's script.
-
-This scenario will mostly be applicable to code that is meant to be
-called from within destructors, asynchronous callbacks, signal
-handlers, C<__DIE__> or C<__WARN__> hooks, and C<tie> functions. In
-such situations, you will not want to clear C<$@> at all, but simply to
-append any new errors to any existing value of C<$@>.
+Using the G_EVAL flag described above will always set C<$@>: clearing
+it if there was no error, and setting it to describe the error if there
+was an error in the called code. This is what you want if your intention
+is to handle possible errors, but sometimes you just want to trap errors
+and stop them interfering with the rest of the program.
+
+This scenario will mostly be applicable to code that is meant to be called
+from within destructors, asynchronous callbacks, and signal handlers.
+In such situations, where the code being called has little relation to the
+surrounding dynamic context, the main program needs to be insulated from
+errors in the called code, even if they can't be handled intelligently.
+It may also be useful to do this with code for C<__DIE__> or C<__WARN__>
+hooks, and C<tie> functions.
The G_KEEPERR flag is meant to be used in conjunction with G_EVAL in
I<call_*> functions that are used to implement such code. This flag
has no effect when G_EVAL is not used.
-When G_KEEPERR is used, any errors in the called code will be prefixed
-with the string "\t(in cleanup)", and appended to the current value
-of C<$@>. an error will not be appended if that same error string is
-already at the end of C<$@>.
-
-In addition, a warning is generated using the appended string. This can be
-disabled using C<no warnings 'misc'>.
+When G_KEEPERR is used, any error in the called code will terminate the
+call as usual, and the error will not propagate beyond the call (as usual
+for G_EVAL), but it will not go into C<$@>. Instead the error will be
+converted into a warning, prefixed with the string "\t(in cleanup)".
+This can be disabled using C<no warnings 'misc'>. If there is no error,
+C<$@> will not be cleared.
The G_KEEPERR flag was introduced in Perl version 5.002.
sub foo { die "foo dies"; }
package main;
- eval { Foo->new->foo };
+ {
+ my $foo = Foo->new;
+ eval { $foo->foo };
+ }
print "Saw: $@" if $@; # should be, but isn't
This example will fail to recognize that an error occurred inside the
C<eval {}>. Here's why: the call_Subtract code got executed while perl
-was cleaning up temporaries when exiting the eval block, and because
+was cleaning up temporaries when exiting the outer braced block, and because
call_Subtract is implemented with I<call_pv> using the G_EVAL
flag, it promptly reset C<$@>. This results in the failure of the
outermost test for C<$@>, and thereby the failure of the error trap.
created and destroyed once, and the sub can be called
arbitrarily many times in between.
-It is usual to pass parameters using global variables -- typically
-$_ for one parameter, or $a and $b for two parameters -- rather
+It is usual to pass parameters using global variables (typically
+$_ for one parameter, or $a and $b for two parameters) rather
than via @_. (It is possible to use the @_ mechanism if you know
what you're doing, though there is as yet no supported API for
it. It's also inherently slower.)
=head1 SEE ALSO
-C<perlapi>, C<perlapio>, C<perlguts>
+L<perlapi>, L<perlapio>, L<perlguts>
It is often more readable to use the C<< => >> operator between key/value
pairs. The C<< => >> operator is mostly just a more visually distinctive
synonym for a comma, but it also arranges for its left-hand operand to be
-interpreted as a string -- if it's a bareword that would be a legal simple
-identifier (C<< => >> doesn't quote compound identifiers, that contain
-double colons). This makes it nice for initializing hashes:
+interpreted as a string if it's a bareword that would be a legal simple
+identifier. C<< => >> doesn't quote compound identifiers, that contain
+double colons. This makes it nice for initializing hashes:
%map = (
red => 0x00f,
the key or value to be filtered. Filtering is achieved by modifying
the contents of C<$_>. The return code from the filter is ignored.
-=head2 An Example -- the NULL termination problem.
+=head2 An Example: the NULL termination problem.
DBM Filters are useful for a class of problems where you I<always>
want to make the same transformation to all keys, all values or both.
and both "store" filters add a terminating NULL.
-=head2 Another Example -- Key is a C int.
+=head2 Another Example: Key is a C int.
Here is another real-life example. By default, whenever Perl writes to
a DBM database it always writes the key and value as strings. So when
The code above uses DB_File, but again it will work with any of the
DBM modules.
-This time only two filters have been used -- we only need to manipulate
+This time only two filters have been used; we only need to manipulate
the contents of the key, so it wasn't necessary to install any value
filters.
=head1 DESCRIPTION
-This is not the perldebug(1) manpage, which tells you how to use
+This is not L<perldebug>, which tells you how to use
the debugger. This manpage describes low-level details concerning
the debugger's internals, which range from difficult to impossible
to understand for anyone who isn't incredibly intimate with Perl's guts.
(W misc) The pattern match (C<//>), substitution (C<s///>), and
transliteration (C<tr///>) operators work on scalar values. If you apply
one of them to an array or a hash, it will convert the array or hash to
-a scalar value -- the length of an array, or the population info of a
-hash -- and then work on that scalar value. This is probably not what
+a scalar value (the length of an array, or the population info of a
+hash) and then work on that scalar value. This is probably not what
you meant to do. See L<perlfunc/grep> and L<perlfunc/map> for
alternatives.
(P) Perl detected an attempt to copy a value to an internal type that cannot
be directly assigned not.
+=item Cannot find encoding "%s"
+
+(S io) You tried to apply an encoding that did not exist to a filehandle,
+either with open() or binmode().
+
=item Can only compress unsigned integers in pack
(F) An argument to pack("w",...) was not an integer. The BER compressed
For example you cannot force little-endianness on a type that
is inside a big-endian group.
-=item Can't use keyword '%s' as a label
-
-(F) You attempted to use a reserved keyword, such as C<print> or C<BEGIN>,
-as a statement label. This is disallowed since Perl 5.11.0.
-
=item Can't use "my %s" in sort comparison
(F) The global variables $a and $b are reserved for sort comparisons.
with an assignment operator, which implies modifying the value itself.
Perhaps you need to copy the value to a temporary, and repeat that.
+=item Character following "\\c" must be ASCII
+
+(F) In C<\cI<X>>, I<X> must be an ASCII character.
+
=item Character in 'C' format wrapped in pack
(W pack) You said
you have also specified an explicit size for the string. See
L<perlfunc/pack>.
+=item "\c%c" more clearly written simply as "%c"
+
+(D deprecated) The C<\cI<X>> construct is intended to be a way to specify
+non-printable characters. You used it for a printable one, which is better
+written as simply itself.
+
=item Deep recursion on subroutine "%s"
(W recursion) This subroutine has called itself (directly or indirectly)
long for Perl to handle. You have to be seriously twisted to write code
that triggers this error.
+=item Deprecated character in \\N{...}; marked by <-- HERE in \\N{%s<-- HERE %s
+
+(D deprecated) Just about anything is legal for the C<...> in C<\N{...}>.
+But starting in 5.12, non-reasonable ones that don't look like names are
+deprecated. A reasonable name begins with an alphabetic character and
+continues with any combination of alphanumerics, dashes, spaces, parentheses or
+colons.
+
=item Deprecated use of my() in false conditional
(D deprecated) You used a declaration similar to C<my $x if 0>.
=item (Did you mean &%s instead?)
-(W) You probably referred to an imported subroutine &FOO as $FOO or some
-such.
+(W misc) You probably referred to an imported subroutine &FOO as $FOO or
+some such.
=item (Did you mean "local" instead of "our"?)
=item gmtime(%.0f) too large
-(W overflow) You called C<gmtime> with an number that was beyond the 64-bit
-range that it accepts, and some rounding resulted. This warning is also
-triggered with nan (the special not-a-number value).
+(W overflow) You called C<gmtime> with an number that was larger than
+it can reliably handle and C<gmtime> probably returned the wrong
+date. This warning is also triggered with nan (the special
+not-a-number value).
+
+=item gmtime(%.0f) too small
+
+(W overflow) You called C<gmtime> with an number that was smaller than
+it can reliably handle and C<gmtime> probably returned the wrong
+date. This warning is also triggered with nan (the special
+not-a-number value).
=item Got an error from DosAllocMem
names (like C<$A::B>). You've exceeded Perl's limits. Future versions
of Perl are likely to eliminate these arbitrary limitations.
-=item Ignoring %s in character class in regex; marked by <-- HERE in m/%s/
+=item Ignoring zero length \N{} in character class
-(W) Named Unicode character escapes (\N{...}) may return multi-char
-or zero length sequences. When such an escape is used in a character class
+(W) Named Unicode character escapes (\N{...}) may return a
+zero length sequence. When such an escape is used in a character class
its behaviour is not well defined. Check that the correct escape has
been used, and the correct charname handler is in scope.
=item Illegal character in prototype for %s : %s
-(W syntax) An illegal character was found in a prototype declaration. Legal
-characters in prototypes are $, @, %, *, ;, [, ], &, and \.
+(W illegalproto) An illegal character was found in a prototype declaration.
+Legal characters in prototypes are $, @, %, *, ;, [, ], &, and \.
=item Illegal declaration of anonymous subroutine
=item localtime(%.0f) too large
-(W overflow) You called C<localtime> with an number that was beyond the
-64-bit range that it accepts, and some rounding resulted. This warning is also triggered with nan (the special not-a-number value).
+(W overflow) You called C<localtime> with an number that was larger
+than it can reliably handle and C<localtime> probably returned the
+wrong date. This warning is also triggered with nan (the special
+not-a-number value).
+
+=item localtime(%.0f) too small
+
+(W overflow) You called C<localtime> with an number that was smaller
+than it can reliably handle and C<localtime> probably returned the
+wrong date. This warning is also triggered with nan (the special
+not-a-number value).
=item Lookbehind longer than %d not implemented in regex m/%s/
by that? lstat() makes sense only on filenames. (Perl did a fstat()
instead on the filehandle.)
+=item lvalue attribute ignored after the subroutine has been defined
+
+(W misc) Making a subroutine an lvalue subroutine after it has been defined
+by declaring the subroutine with a lvalue attribute is not
+possible. To make the the subroutine a lvalue subroutine add the
+lvalue attribute to the definition, or put the the declaration before
+the definition.
+
=item Lvalue subs returning %s not implemented yet
(F) Due to limitations in the current implementation, array and hash
(F) Perl thought it was reading UTF-16 encoded character data but while
doing it Perl met a malformed Unicode surrogate.
+=item Malformed UTF-8 returned by \N
+
+(F) The charnames handler returned malformed UTF-8.
+
=item Malformed UTF-8 string in pack
(F) You tried to pack something that didn't comply with UTF-8 encoding
(F) The argument to the indicated command line switch must follow
immediately after the switch, without intervening spaces.
-=item Missing %sbrace%s on \N{}
+=item Missing braces on \N{}
(F) Wrong syntax of character name literal C<\N{charname}> within
-double-quotish context.
+double-quotish context. This can also happen when there is a space (or
+comment) between the C<\N> and the C<{> in a regex with the C</x> modifier.
+This modifier does not change the requirement that the brace immediately follow
+the C<\N>.
=item Missing comma after first argument to %s function
=item Missing right brace on %s
-(F) Missing right brace in C<\x{...}>, C<\p{...}> or C<\P{...}>.
+(F) Missing right brace in C<\x{...}>, C<\p{...}>, C<\P{...}>, or C<\N{...}>.
+
+=item Missing right brace on \\N{} or unescaped left brace after \\N
+
+(F)
+C<\N> has two meanings.
+
+The traditional one has it followed by a name enclosed
+in braces, meaning the character (or sequence of characters) given by that name.
+Thus C<\N{ASTERISK}> is another way of writing C<*>, valid in both
+double-quoted strings and regular expression patterns. In patterns, it doesn't
+have the meaning an unescaped C<*> does.
+
+Starting in Perl 5.12.0, C<\N> also can have an additional meaning (only) in
+patterns, namely to match a non-newline character. (This is short for
+C<[^\n]>, and like C<.> but is not affected by the C</s> regex modifier.)
+
+This can lead to some ambiguities. When C<\N> is not followed immediately by a
+left brace, Perl assumes the C<[^\n]> meaning. Also, if
+the braces form a valid quantifier such as C<\N{3}> or C<\N{5,}>, Perl assumes
+that this means to match the given quantity of non-newlines (in these examples,
+3; and 5 or more, respectively). In all other case, where there is a C<\N{>
+and a matching C<}>, Perl assumes that a character name is desired.
+
+However, if there is no matching C<}>, Perl doesn't know if it was mistakenly
+omitted, or if C<[^\n]{> was desired, and
+raises this error. If you meant the former, add the right brace; if you meant
+the latter, escape the brace with a backslash, like so: C<\N\{>
=item Missing right curly or square bracket
sense to try to declare one with a package qualifier on the front. Use
local() if you want to localize a package variable.
+=item \\N in a character class must be a named character: \\N{...}
+
+(F) The new (5.12) meaning of C<\N> as C<[^\n]> is not valid in a bracketed
+character class, for the same reason that C<.> in a character class loses its
+specialness: it matches almost everything, which is probably not what you want.
+
+=item \\N{NAME} must be resolved by the lexer
+
+(F) When compiling a regex pattern, an unresolved named character or sequence
+was encountered. This can happen in any of several ways that bypass the lexer,
+such as using single-quotish context, or an extra backslash in double quotish:
+
+ $re = '\N{SPACE}'; # Wrong!
+ $re = "\\N{SPACE}"; # Wrong!
+ /$re/;
+
+Instead, use double-quotes with a single backslash:
+
+ $re = "\N{SPACE}"; # ok
+ /$re/;
+
+The lexer can be bypassed as well by creating the pattern from smaller
+components:
+
+ $re = '\N';
+ /${re}{SPACE}/; # Wrong!
+
+It's not a good idea to split a construct in the middle like this, and it
+doesn't work here. Instead use the solution above.
+
+Finally, the message also can happen under the C</x> regex modifier when the
+C<\N> is separated by spaces from the C<{>, in which case, remove the spaces.
+
+ /\N {SPACE}/x; # Wrong!
+ /\N{SPACE}/x; # ok
+
=item Name "%s::%s" used only once: possible typo
(W once) Typographical errors often show up as unique variable names.
the same; if a program uses $c only once but also uses any of the others it
will not trigger this warning.
+=item Invalid hexadecimal number in \\N{U+...}
+
+(F) The character constant represented by C<...> is not a valid hexadecimal
+number. Either it is empty, or you tried to use a character other than 0 - 9
+or A - F, a - f in a hexadecimal number.
+
=item Negative '/' count in unpack
(F) The length count obtained from a length/code unpack operation was
conversion functions. This is only a problem when you're using the
'<' or '>' modifiers in (un)pack templates. See L<perlfunc/pack>.
-=item Perl_pmflag() is deprecated, and will be removed from the XS API
-
-(D deprecated) XS code called the C function C<Perl_pmflag>. This was part of
-Perl's listed public API for extending or embedding the perl interpreter. It has
-now been removed from the public API, and will be removed in a future release,
-hence XS code should be re-written not to use it.
-
=item Perl %s required--this is only version %s, stopped
(F) The module in question uses features of a version of Perl more
=item Prototype after '%c' for %s : %s
-(W syntax) A character follows % or @ in a prototype. This is useless,
+(W illegalproto) A character follows % or @ in a prototype. This is useless,
since % and @ gobble the rest of the subroutine arguments.
=item Prototype mismatch: %s vs %s
(W regexp) You used a backslash-character combination which is not
recognized by Perl inside character classes. The character was
-understood literally.
+understood literally, but this may change in a future version of Perl.
The <-- HERE shows in the regular expression about where the
escape was discovered.
=item Unrecognized escape \\%c passed through
(W misc) You used a backslash-character combination which is not
-recognized by Perl. The character was understood literally.
+recognized by Perl. The character was understood literally, but this may
+change in a future version of Perl.
=item Unrecognized escape \\%c passed through in regex; marked by <-- HERE in m/%s/
(W regexp) You used a backslash-character combination which is not
-recognized by Perl. The character was understood literally.
+recognized by Perl. The character was understood literally, but this may
+change in a future version of Perl.
The <-- HERE shows in the regular expression about where the
escape was discovered.
use the /g modifier. Currently, /c is meaningful only when /g is
used. (This may change in the future.)
+=item Use of := for an empty attribute list is deprecated
+
+(D deprecated) The construction C<my $x := 42> currently
+parses correctly in perl, being equivalent to C<my $x : = 42>
+(applying an empty attribute list to C<$x>). This useless
+construct is now deprecated, so C<:=> can be reclaimed as a new
+operator in the future.
+
=item Use of freed value in iteration
(F) Perhaps you modified the iterated array within the loop?
allow this syntax, but shouldn't have. It is now deprecated, and will be
removed in a future version.
+=item Using just the first character returned by \N{} in character class
+
+(W) A charnames handler may return a sequence of more than one character.
+Currently all but the first one are discarded when used in a regular
+expression pattern bracketed character class.
+
+=item Using just the first characters returned by \N{}
+
+(W) A charnames handler may return a sequence of characters. There is a finite
+limit as to the number of characters that can be used, which this sequence
+exceeded. In the message, the characters in the sequence are separated by
+dots, and each is shown by its ordinal in hex. Anything to the left of the
+C<HERE> was retained; anything to the right was discarded.
+
=item UTF-16 surrogate %s
-(W utf8) You tried to generate half of an UTF-16 surrogate by
+(W utf8) You tried to generate half of a UTF-16 surrogate by
requesting a Unicode character between the code points 0xD800 and
0xDFFF (inclusive). That range is reserved exclusively for the use of
UTF-16 encoding (by having two 16-bit UCS-2 characters); but Perl
=item Variable "%s" is not imported%s
-(F) While "use strict" in effect, you referred to a global variable that
-you apparently thought was imported from another module, because
+(W misc) With "use strict" in effect, you referred to a global variable
+that you apparently thought was imported from another module, because
something else of the same name (usually a subroutine) is exported by
that module. It usually means you put the wrong funny character on the
front of your variable.
=item B<-X>
-Use an index if it is present -- the B<-X> option looks for an entry
+Use an index if it is present. The B<-X> option looks for an entry
whose basename matches the name given on the command line in the file
C<$Config{archlib}/pod.idx>. The F<pod.idx> file should contain fully
qualified filenames, one per line.
One useful value for C<PERLDOC_PAGER> is C<less -+C -E>.
Having PERLDOCDEBUG set to a positive integer will make perldoc emit
-even more descriptive output than the C<-v> switch does -- the higher the
+even more descriptive output than the C<-v> switch does; the higher the
number, the more it emits.
confusing. If so, just think of it as the difference between a structure
and a pointer to a structure.
-You can (and should) read more about references in the perlref(1) man
-page. Briefly, references are rather like pointers that know what they
+You can (and should) read more about references in L<perlref>.
+Briefly, references are rather like pointers that know what they
point to. (Objects are also a kind of reference, but we won't be needing
them right away--if ever.) This means that when you have something which
looks to you like an access to a two-or-more-dimensional array and/or hash,
=head1 SEE ALSO
-perlref(1), perllol(1), perldata(1), perlobj(1)
+L<perlref>, L<perllol>, L<perldata>, L<perlobj>
=head1 AUTHOR
+=encoding utf8
+
=head1 NAME
perlebcdic - Considerations for running Perl on EBCDIC platforms
range.
Some IBM EBCDIC character sets may be known by character code set
-identification numbers (CCSID numbers) or code page numbers. Leading
-zero digits in CCSID numbers within this document are insignificant.
-E.g. CCSID 0037 may be referred to as 37 in places.
+identification numbers (CCSID numbers) or code page numbers.
Perl can be compiled on platforms that run any of three commonly used EBCDIC
character sets, listed below.
Character code set ID 0037 is a mapping of the ASCII plus Latin-1
characters (i.e. ISO 8859-1) to an EBCDIC set. 0037 is used
in North American English locales on the OS/400 operating system
-that runs on AS/400 computers. CCSID 37 differs from ISO 8859-1
+that runs on AS/400 computers. CCSID 0037 differs from ISO 8859-1
in 237 places, in other words they agree on only 19 code point values.
=head2 1047
In EBCDIC, for the low 256 the EBCDIC code points are used. This
means that the equivalences
- pack("U", ord($character)) eq $character
- unpack("U", $character) == ord $character
+ pack("U", ord($character)) eq $character
+ unpack("U", $character) == ord $character
will hold. (If Unicode code points were applied consistently over
all the possible code points, pack("U",ord("A")) would in EBCDIC
Encode knows about more EBCDIC character sets than Perl can currently
be compiled to run on.
- use Encode 'from_to';
+ use Encode 'from_to';
- my %ebcdic = ( 176 => 'cp37', 95 => 'cp1047', 106 => 'posix-bc' );
+ my %ebcdic = ( 176 => 'cp37', 95 => 'cp1047', 106 => 'posix-bc' );
- # $a is in EBCDIC code points
- from_to($a, $ebcdic{ord '^'}, 'latin1');
- # $a is ISO 8859-1 code points
+ # $a is in EBCDIC code points
+ from_to($a, $ebcdic{ord '^'}, 'latin1');
+ # $a is ISO 8859-1 code points
and from Latin-1 code points to EBCDIC code points
- use Encode 'from_to';
+ use Encode 'from_to';
- my %ebcdic = ( 176 => 'cp37', 95 => 'cp1047', 106 => 'posix-bc' );
+ my %ebcdic = ( 176 => 'cp37', 95 => 'cp1047', 106 => 'posix-bc' );
- # $a is ISO 8859-1 code points
- from_to($a, 'latin1', $ebcdic{ord '^'});
- # $a is in EBCDIC code points
+ # $a is ISO 8859-1 code points
+ from_to($a, 'latin1', $ebcdic{ord '^'});
+ # $a is in EBCDIC code points
For doing I/O it is suggested that you use the autotranslating features
of PerlIO, see L<perluniintro>.
open($f, ">:encoding(utf8)", "test.utf8");
print $f "Hello World!\n";
-to get four files containing "Hello World!\n" in ASCII, CP 37 EBCDIC,
+to get four files containing "Hello World!\n" in ASCII, CP 0037 EBCDIC,
ISO 8859-1 (Latin-1) (in this example identical to ASCII since only ASCII
characters were printed), and
UTF-EBCDIC (in this example identical to normal EBCDIC since only characters
corresponding to I<The Unicode Standard, Version 3.0> albeit with
substitutions such as s/LATIN// and s/VULGAR// in all cases,
s/CAPITAL LETTER// in some cases, and s/SMALL LETTER ([A-Z])/\l$1/
-in some other cases (the C<charnames> pragma names unfortunately do
-not list explicit names for the C0 or C1 control characters). The
-"names" of the C1 control set (128..159 in ISO 8859-1) listed here are
-somewhat arbitrary. The differences between the 0037 and 1047 sets are
+in some other cases. The "names" of the controls listed here are
+the Unicode Version 1 names, except for the few that don't have names, in which
+case the names in the Wikipedia article were used
+(L<http://en.wikipedia.org/wiki/C0_and_C1_control_codes>.
+The differences between the 0037 and 1047 sets are
flagged with ***. The differences between the 1047 and POSIX-BC sets
are flagged with ###. All ord() numbers listed are decimal. If you
would rather see this table listing octal values then run the table
=back
- perl -ne 'if(/(.{33})(\d+)\s+(\d+)\s+(\d+)\s+(\d+)/)' \
+ perl -ne 'if(/(.{43})(\d+)\s+(\d+)\s+(\d+)\s+(\d+)/)' \
-e '{printf("%s%-9o%-9o%-9o%o\n",$1,$2,$3,$4,$5)}' perlebcdic.pod
If you want to retain the UTF-x code points then in script form you
=back
- open(FH,"<perlebcdic.pod") or die "Could not open perlebcdic.pod: $!";
- while (<FH>) {
- if (/(.{33})(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\.?(\d*)\s+(\d+)\.?(\d*)/) {
- if ($7 ne '' && $9 ne '') {
- printf("%s%-9o%-9o%-9o%-9o%-3o.%-5o%-3o.%o\n",$1,$2,$3,$4,$5,$6,$7,$8,$9);
- }
- elsif ($7 ne '') {
- printf("%s%-9o%-9o%-9o%-9o%-3o.%-5o%o\n",$1,$2,$3,$4,$5,$6,$7,$8);
- }
- else {
- printf("%s%-9o%-9o%-9o%-9o%-9o%o\n",$1,$2,$3,$4,$5,$6,$8);
- }
- }
- }
+ open(FH,"<perlebcdic.pod") or die "Could not open perlebcdic.pod: $!";
+ while (<FH>) {
+ if (/(.{43})(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\.?(\d*)\s+(\d+)\.?(\d*)/) {
+ if ($7 ne '' && $9 ne '') {
+ printf("%s%-9o%-9o%-9o%-9o%-3o.%-5o%-3o.%o\n",
+ $1,$2,$3,$4,$5,$6,$7,$8,$9);
+ }
+ elsif ($7 ne '') {
+ printf("%s%-9o%-9o%-9o%-9o%-3o.%-5o%o\n",
+ $1,$2,$3,$4,$5,$6,$7,$8);
+ }
+ else {
+ printf("%s%-9o%-9o%-9o%-9o%-9o%o\n",$1,$2,$3,$4,$5,$6,$8);
+ }
+ }
+ }
If you would rather see this table listing hexadecimal values then
run the table through:
=back
- perl -ne 'if(/(.{33})(\d+)\s+(\d+)\s+(\d+)\s+(\d+)/)' \
+ perl -ne 'if(/(.{43})(\d+)\s+(\d+)\s+(\d+)\s+(\d+)/)' \
-e '{printf("%s%-9X%-9X%-9X%X\n",$1,$2,$3,$4,$5)}' perlebcdic.pod
Or, in order to retain the UTF-x code points in hexadecimal:
=back
- open(FH,"<perlebcdic.pod") or die "Could not open perlebcdic.pod: $!";
- while (<FH>) {
- if (/(.{33})(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\.?(\d*)\s+(\d+)\.?(\d*)/) {
- if ($7 ne '' && $9 ne '') {
- printf("%s%-9X%-9X%-9X%-9X%-2X.%-6X%-2X.%X\n",$1,$2,$3,$4,$5,$6,$7,$8,$9);
- }
- elsif ($7 ne '') {
- printf("%s%-9X%-9X%-9X%-9X%-2X.%-6X%X\n",$1,$2,$3,$4,$5,$6,$7,$8);
- }
- else {
- printf("%s%-9X%-9X%-9X%-9X%-9X%X\n",$1,$2,$3,$4,$5,$6,$8);
- }
- }
- }
-
-
- incomp- incomp-
- 8859-1 lete lete
- chr 0819 0037 1047 POSIX-BC UTF-8 UTF-EBCDIC
- ------------------------------------------------------------------------------------
- <NULL> 0 0 0 0 0 0
- <START OF HEADING> 1 1 1 1 1 1
- <START OF TEXT> 2 2 2 2 2 2
- <END OF TEXT> 3 3 3 3 3 3
- <END OF TRANSMISSION> 4 55 55 55 4 55
- <ENQUIRY> 5 45 45 45 5 45
- <ACKNOWLEDGE> 6 46 46 46 6 46
- <BELL> 7 47 47 47 7 47
- <BACKSPACE> 8 22 22 22 8 22
- <HORIZONTAL TABULATION> 9 5 5 5 9 5
- <LINE FEED> 10 37 21 21 10 21 ***
- <VERTICAL TABULATION> 11 11 11 11 11 11
- <FORM FEED> 12 12 12 12 12 12
- <CARRIAGE RETURN> 13 13 13 13 13 13
- <SHIFT OUT> 14 14 14 14 14 14
- <SHIFT IN> 15 15 15 15 15 15
- <DATA LINK ESCAPE> 16 16 16 16 16 16
- <DEVICE CONTROL ONE> 17 17 17 17 17 17
- <DEVICE CONTROL TWO> 18 18 18 18 18 18
- <DEVICE CONTROL THREE> 19 19 19 19 19 19
- <DEVICE CONTROL FOUR> 20 60 60 60 20 60
- <NEGATIVE ACKNOWLEDGE> 21 61 61 61 21 61
- <SYNCHRONOUS IDLE> 22 50 50 50 22 50
- <END OF TRANSMISSION BLOCK> 23 38 38 38 23 38
- <CANCEL> 24 24 24 24 24 24
- <END OF MEDIUM> 25 25 25 25 25 25
- <SUBSTITUTE> 26 63 63 63 26 63
- <ESCAPE> 27 39 39 39 27 39
- <FILE SEPARATOR> 28 28 28 28 28 28
- <GROUP SEPARATOR> 29 29 29 29 29 29
- <RECORD SEPARATOR> 30 30 30 30 30 30
- <UNIT SEPARATOR> 31 31 31 31 31 31
- <SPACE> 32 64 64 64 32 64
- ! 33 90 90 90 33 90
- " 34 127 127 127 34 127
- # 35 123 123 123 35 123
- $ 36 91 91 91 36 91
- % 37 108 108 108 37 108
- & 38 80 80 80 38 80
- ' 39 125 125 125 39 125
- ( 40 77 77 77 40 77
- ) 41 93 93 93 41 93
- * 42 92 92 92 42 92
- + 43 78 78 78 43 78
- , 44 107 107 107 44 107
- - 45 96 96 96 45 96
- . 46 75 75 75 46 75
- / 47 97 97 97 47 97
- 0 48 240 240 240 48 240
- 1 49 241 241 241 49 241
- 2 50 242 242 242 50 242
- 3 51 243 243 243 51 243
- 4 52 244 244 244 52 244
- 5 53 245 245 245 53 245
- 6 54 246 246 246 54 246
- 7 55 247 247 247 55 247
- 8 56 248 248 248 56 248
- 9 57 249 249 249 57 249
- : 58 122 122 122 58 122
- ; 59 94 94 94 59 94
- < 60 76 76 76 60 76
- = 61 126 126 126 61 126
- > 62 110 110 110 62 110
- ? 63 111 111 111 63 111
- @ 64 124 124 124 64 124
- A 65 193 193 193 65 193
- B 66 194 194 194 66 194
- C 67 195 195 195 67 195
- D 68 196 196 196 68 196
- E 69 197 197 197 69 197
- F 70 198 198 198 70 198
- G 71 199 199 199 71 199
- H 72 200 200 200 72 200
- I 73 201 201 201 73 201
- J 74 209 209 209 74 209
- K 75 210 210 210 75 210
- L 76 211 211 211 76 211
- M 77 212 212 212 77 212
- N 78 213 213 213 78 213
- O 79 214 214 214 79 214
- P 80 215 215 215 80 215
- Q 81 216 216 216 81 216
- R 82 217 217 217 82 217
- S 83 226 226 226 83 226
- T 84 227 227 227 84 227
- U 85 228 228 228 85 228
- V 86 229 229 229 86 229
- W 87 230 230 230 87 230
- X 88 231 231 231 88 231
- Y 89 232 232 232 89 232
- Z 90 233 233 233 90 233
- [ 91 186 173 187 91 173 *** ###
- \ 92 224 224 188 92 224 ###
- ] 93 187 189 189 93 189 ***
- ^ 94 176 95 106 94 95 *** ###
- _ 95 109 109 109 95 109
- ` 96 121 121 74 96 121 ###
- a 97 129 129 129 97 129
- b 98 130 130 130 98 130
- c 99 131 131 131 99 131
- d 100 132 132 132 100 132
- e 101 133 133 133 101 133
- f 102 134 134 134 102 134
- g 103 135 135 135 103 135
- h 104 136 136 136 104 136
- i 105 137 137 137 105 137
- j 106 145 145 145 106 145
- k 107 146 146 146 107 146
- l 108 147 147 147 108 147
- m 109 148 148 148 109 148
- n 110 149 149 149 110 149
- o 111 150 150 150 111 150
- p 112 151 151 151 112 151
- q 113 152 152 152 113 152
- r 114 153 153 153 114 153
- s 115 162 162 162 115 162
- t 116 163 163 163 116 163
- u 117 164 164 164 117 164
- v 118 165 165 165 118 165
- w 119 166 166 166 119 166
- x 120 167 167 167 120 167
- y 121 168 168 168 121 168
- z 122 169 169 169 122 169
- { 123 192 192 251 123 192 ###
- | 124 79 79 79 124 79
- } 125 208 208 253 125 208 ###
- ~ 126 161 161 255 126 161 ###
- <DELETE> 127 7 7 7 127 7
- <C1 0> 128 32 32 32 194.128 32
- <C1 1> 129 33 33 33 194.129 33
- <C1 2> 130 34 34 34 194.130 34
- <C1 3> 131 35 35 35 194.131 35
- <C1 4> 132 36 36 36 194.132 36
- <C1 5> 133 21 37 37 194.133 37 ***
- <C1 6> 134 6 6 6 194.134 6
- <C1 7> 135 23 23 23 194.135 23
- <C1 8> 136 40 40 40 194.136 40
- <C1 9> 137 41 41 41 194.137 41
- <C1 10> 138 42 42 42 194.138 42
- <C1 11> 139 43 43 43 194.139 43
- <C1 12> 140 44 44 44 194.140 44
- <C1 13> 141 9 9 9 194.141 9
- <C1 14> 142 10 10 10 194.142 10
- <C1 15> 143 27 27 27 194.143 27
- <C1 16> 144 48 48 48 194.144 48
- <C1 17> 145 49 49 49 194.145 49
- <C1 18> 146 26 26 26 194.146 26
- <C1 19> 147 51 51 51 194.147 51
- <C1 20> 148 52 52 52 194.148 52
- <C1 21> 149 53 53 53 194.149 53
- <C1 22> 150 54 54 54 194.150 54
- <C1 23> 151 8 8 8 194.151 8
- <C1 24> 152 56 56 56 194.152 56
- <C1 25> 153 57 57 57 194.153 57
- <C1 26> 154 58 58 58 194.154 58
- <C1 27> 155 59 59 59 194.155 59
- <C1 28> 156 4 4 4 194.156 4
- <C1 29> 157 20 20 20 194.157 20
- <C1 30> 158 62 62 62 194.158 62
- <C1 31> 159 255 255 95 194.159 255 ###
- <NON-BREAKING SPACE> 160 65 65 65 194.160 128.65
- <INVERTED EXCLAMATION MARK> 161 170 170 170 194.161 128.66
- <CENT SIGN> 162 74 74 176 194.162 128.67 ###
- <POUND SIGN> 163 177 177 177 194.163 128.68
- <CURRENCY SIGN> 164 159 159 159 194.164 128.69
- <YEN SIGN> 165 178 178 178 194.165 128.70
- <BROKEN BAR> 166 106 106 208 194.166 128.71 ###
- <SECTION SIGN> 167 181 181 181 194.167 128.72
- <DIAERESIS> 168 189 187 121 194.168 128.73 *** ###
- <COPYRIGHT SIGN> 169 180 180 180 194.169 128.74
- <FEMININE ORDINAL INDICATOR> 170 154 154 154 194.170 128.81
- <LEFT POINTING GUILLEMET> 171 138 138 138 194.171 128.82
- <NOT SIGN> 172 95 176 186 194.172 128.83 *** ###
- <SOFT HYPHEN> 173 202 202 202 194.173 128.84
- <REGISTERED TRADE MARK SIGN> 174 175 175 175 194.174 128.85
- <MACRON> 175 188 188 161 194.175 128.86 ###
- <DEGREE SIGN> 176 144 144 144 194.176 128.87
- <PLUS-OR-MINUS SIGN> 177 143 143 143 194.177 128.88
- <SUPERSCRIPT TWO> 178 234 234 234 194.178 128.89
- <SUPERSCRIPT THREE> 179 250 250 250 194.179 128.98
- <ACUTE ACCENT> 180 190 190 190 194.180 128.99
- <MICRO SIGN> 181 160 160 160 194.181 128.100
- <PARAGRAPH SIGN> 182 182 182 182 194.182 128.101
- <MIDDLE DOT> 183 179 179 179 194.183 128.102
- <CEDILLA> 184 157 157 157 194.184 128.103
- <SUPERSCRIPT ONE> 185 218 218 218 194.185 128.104
- <MASC. ORDINAL INDICATOR> 186 155 155 155 194.186 128.105
- <RIGHT POINTING GUILLEMET> 187 139 139 139 194.187 128.106
- <FRACTION ONE QUARTER> 188 183 183 183 194.188 128.112
- <FRACTION ONE HALF> 189 184 184 184 194.189 128.113
- <FRACTION THREE QUARTERS> 190 185 185 185 194.190 128.114
- <INVERTED QUESTION MARK> 191 171 171 171 194.191 128.115
- <A WITH GRAVE> 192 100 100 100 195.128 138.65
- <A WITH ACUTE> 193 101 101 101 195.129 138.66
- <A WITH CIRCUMFLEX> 194 98 98 98 195.130 138.67
- <A WITH TILDE> 195 102 102 102 195.131 138.68
- <A WITH DIAERESIS> 196 99 99 99 195.132 138.69
- <A WITH RING ABOVE> 197 103 103 103 195.133 138.70
- <CAPITAL LIGATURE AE> 198 158 158 158 195.134 138.71
- <C WITH CEDILLA> 199 104 104 104 195.135 138.72
- <E WITH GRAVE> 200 116 116 116 195.136 138.73
- <E WITH ACUTE> 201 113 113 113 195.137 138.74
- <E WITH CIRCUMFLEX> 202 114 114 114 195.138 138.81
- <E WITH DIAERESIS> 203 115 115 115 195.139 138.82
- <I WITH GRAVE> 204 120 120 120 195.140 138.83
- <I WITH ACUTE> 205 117 117 117 195.141 138.84
- <I WITH CIRCUMFLEX> 206 118 118 118 195.142 138.85
- <I WITH DIAERESIS> 207 119 119 119 195.143 138.86
- <CAPITAL LETTER ETH> 208 172 172 172 195.144 138.87
- <N WITH TILDE> 209 105 105 105 195.145 138.88
- <O WITH GRAVE> 210 237 237 237 195.146 138.89
- <O WITH ACUTE> 211 238 238 238 195.147 138.98
- <O WITH CIRCUMFLEX> 212 235 235 235 195.148 138.99
- <O WITH TILDE> 213 239 239 239 195.149 138.100
- <O WITH DIAERESIS> 214 236 236 236 195.150 138.101
- <MULTIPLICATION SIGN> 215 191 191 191 195.151 138.102
- <O WITH STROKE> 216 128 128 128 195.152 138.103
- <U WITH GRAVE> 217 253 253 224 195.153 138.104 ###
- <U WITH ACUTE> 218 254 254 254 195.154 138.105
- <U WITH CIRCUMFLEX> 219 251 251 221 195.155 138.106 ###
- <U WITH DIAERESIS> 220 252 252 252 195.156 138.112
- <Y WITH ACUTE> 221 173 186 173 195.157 138.113 *** ###
- <CAPITAL LETTER THORN> 222 174 174 174 195.158 138.114
- <SMALL LETTER SHARP S> 223 89 89 89 195.159 138.115
- <a WITH GRAVE> 224 68 68 68 195.160 139.65
- <a WITH ACUTE> 225 69 69 69 195.161 139.66
- <a WITH CIRCUMFLEX> 226 66 66 66 195.162 139.67
- <a WITH TILDE> 227 70 70 70 195.163 139.68
- <a WITH DIAERESIS> 228 67 67 67 195.164 139.69
- <a WITH RING ABOVE> 229 71 71 71 195.165 139.70
- <SMALL LIGATURE ae> 230 156 156 156 195.166 139.71
- <c WITH CEDILLA> 231 72 72 72 195.167 139.72
- <e WITH GRAVE> 232 84 84 84 195.168 139.73
- <e WITH ACUTE> 233 81 81 81 195.169 139.74
- <e WITH CIRCUMFLEX> 234 82 82 82 195.170 139.81
- <e WITH DIAERESIS> 235 83 83 83 195.171 139.82
- <i WITH GRAVE> 236 88 88 88 195.172 139.83
- <i WITH ACUTE> 237 85 85 85 195.173 139.84
- <i WITH CIRCUMFLEX> 238 86 86 86 195.174 139.85
- <i WITH DIAERESIS> 239 87 87 87 195.175 139.86
- <SMALL LETTER eth> 240 140 140 140 195.176 139.87
- <n WITH TILDE> 241 73 73 73 195.177 139.88
- <o WITH GRAVE> 242 205 205 205 195.178 139.89
- <o WITH ACUTE> 243 206 206 206 195.179 139.98
- <o WITH CIRCUMFLEX> 244 203 203 203 195.180 139.99
- <o WITH TILDE> 245 207 207 207 195.181 139.100
- <o WITH DIAERESIS> 246 204 204 204 195.182 139.101
- <DIVISION SIGN> 247 225 225 225 195.183 139.102
- <o WITH STROKE> 248 112 112 112 195.184 139.103
- <u WITH GRAVE> 249 221 221 192 195.185 139.104 ###
- <u WITH ACUTE> 250 222 222 222 195.186 139.105
- <u WITH CIRCUMFLEX> 251 219 219 219 195.187 139.106
- <u WITH DIAERESIS> 252 220 220 220 195.188 139.112
- <y WITH ACUTE> 253 141 141 141 195.189 139.113
- <SMALL LETTER thorn> 254 142 142 142 195.190 139.114
- <y WITH DIAERESIS> 255 223 223 223 195.191 139.115
+ open(FH,"<perlebcdic.pod") or die "Could not open perlebcdic.pod: $!";
+ while (<FH>) {
+ if (/(.{43})(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\.?(\d*)\s+(\d+)\.?(\d*)/) {
+ if ($7 ne '' && $9 ne '') {
+ printf("%s%-9X%-9X%-9X%-9X%-2X.%-6X%-2X.%X\n",
+ $1,$2,$3,$4,$5,$6,$7,$8,$9);
+ }
+ elsif ($7 ne '') {
+ printf("%s%-9X%-9X%-9X%-9X%-2X.%-6X%X\n",
+ $1,$2,$3,$4,$5,$6,$7,$8);
+ }
+ else {
+ printf("%s%-9X%-9X%-9X%-9X%-9X%X\n",$1,$2,$3,$4,$5,$6,$8);
+ }
+ }
+ }
+
+
+ ISO 8859-1 CCSID CCSID CCSID 1047
+ chr CCSID 0819 0037 1047 POSIX-BC UTF-8 UTF-EBCDIC
+ ----------------------------------------------------------------------------------------------
+ <NULL> 0 0 0 0 0 0
+ <START OF HEADING> 1 1 1 1 1 1
+ <START OF TEXT> 2 2 2 2 2 2
+ <END OF TEXT> 3 3 3 3 3 3
+ <END OF TRANSMISSION> 4 55 55 55 4 55
+ <ENQUIRY> 5 45 45 45 5 45
+ <ACKNOWLEDGE> 6 46 46 46 6 46
+ <BELL> 7 47 47 47 7 47
+ <BACKSPACE> 8 22 22 22 8 22
+ <HORIZONTAL TABULATION> 9 5 5 5 9 5
+ <LINE FEED> 10 37 21 21 10 21 ***
+ <VERTICAL TABULATION> 11 11 11 11 11 11
+ <FORM FEED> 12 12 12 12 12 12
+ <CARRIAGE RETURN> 13 13 13 13 13 13
+ <SHIFT OUT> 14 14 14 14 14 14
+ <SHIFT IN> 15 15 15 15 15 15
+ <DATA LINK ESCAPE> 16 16 16 16 16 16
+ <DEVICE CONTROL ONE> 17 17 17 17 17 17
+ <DEVICE CONTROL TWO> 18 18 18 18 18 18
+ <DEVICE CONTROL THREE> 19 19 19 19 19 19
+ <DEVICE CONTROL FOUR> 20 60 60 60 20 60
+ <NEGATIVE ACKNOWLEDGE> 21 61 61 61 21 61
+ <SYNCHRONOUS IDLE> 22 50 50 50 22 50
+ <END OF TRANSMISSION BLOCK> 23 38 38 38 23 38
+ <CANCEL> 24 24 24 24 24 24
+ <END OF MEDIUM> 25 25 25 25 25 25
+ <SUBSTITUTE> 26 63 63 63 26 63
+ <ESCAPE> 27 39 39 39 27 39
+ <FILE SEPARATOR> 28 28 28 28 28 28
+ <GROUP SEPARATOR> 29 29 29 29 29 29
+ <RECORD SEPARATOR> 30 30 30 30 30 30
+ <UNIT SEPARATOR> 31 31 31 31 31 31
+ <SPACE> 32 64 64 64 32 64
+ ! 33 90 90 90 33 90
+ " 34 127 127 127 34 127
+ # 35 123 123 123 35 123
+ $ 36 91 91 91 36 91
+ % 37 108 108 108 37 108
+ & 38 80 80 80 38 80
+ ' 39 125 125 125 39 125
+ ( 40 77 77 77 40 77
+ ) 41 93 93 93 41 93
+ * 42 92 92 92 42 92
+ + 43 78 78 78 43 78
+ , 44 107 107 107 44 107
+ - 45 96 96 96 45 96
+ . 46 75 75 75 46 75
+ / 47 97 97 97 47 97
+ 0 48 240 240 240 48 240
+ 1 49 241 241 241 49 241
+ 2 50 242 242 242 50 242
+ 3 51 243 243 243 51 243
+ 4 52 244 244 244 52 244
+ 5 53 245 245 245 53 245
+ 6 54 246 246 246 54 246
+ 7 55 247 247 247 55 247
+ 8 56 248 248 248 56 248
+ 9 57 249 249 249 57 249
+ : 58 122 122 122 58 122
+ ; 59 94 94 94 59 94
+ < 60 76 76 76 60 76
+ = 61 126 126 126 61 126
+ > 62 110 110 110 62 110
+ ? 63 111 111 111 63 111
+ @ 64 124 124 124 64 124
+ A 65 193 193 193 65 193
+ B 66 194 194 194 66 194
+ C 67 195 195 195 67 195
+ D 68 196 196 196 68 196
+ E 69 197 197 197 69 197
+ F 70 198 198 198 70 198
+ G 71 199 199 199 71 199
+ H 72 200 200 200 72 200
+ I 73 201 201 201 73 201
+ J 74 209 209 209 74 209
+ K 75 210 210 210 75 210
+ L 76 211 211 211 76 211
+ M 77 212 212 212 77 212
+ N 78 213 213 213 78 213
+ O 79 214 214 214 79 214
+ P 80 215 215 215 80 215
+ Q 81 216 216 216 81 216
+ R 82 217 217 217 82 217
+ S 83 226 226 226 83 226
+ T 84 227 227 227 84 227
+ U 85 228 228 228 85 228
+ V 86 229 229 229 86 229
+ W 87 230 230 230 87 230
+ X 88 231 231 231 88 231
+ Y 89 232 232 232 89 232
+ Z 90 233 233 233 90 233
+ [ 91 186 173 187 91 173 *** ###
+ \ 92 224 224 188 92 224 ###
+ ] 93 187 189 189 93 189 ***
+ ^ 94 176 95 106 94 95 *** ###
+ _ 95 109 109 109 95 109
+ ` 96 121 121 74 96 121 ###
+ a 97 129 129 129 97 129
+ b 98 130 130 130 98 130
+ c 99 131 131 131 99 131
+ d 100 132 132 132 100 132
+ e 101 133 133 133 101 133
+ f 102 134 134 134 102 134
+ g 103 135 135 135 103 135
+ h 104 136 136 136 104 136
+ i 105 137 137 137 105 137
+ j 106 145 145 145 106 145
+ k 107 146 146 146 107 146
+ l 108 147 147 147 108 147
+ m 109 148 148 148 109 148
+ n 110 149 149 149 110 149
+ o 111 150 150 150 111 150
+ p 112 151 151 151 112 151
+ q 113 152 152 152 113 152
+ r 114 153 153 153 114 153
+ s 115 162 162 162 115 162
+ t 116 163 163 163 116 163
+ u 117 164 164 164 117 164
+ v 118 165 165 165 118 165
+ w 119 166 166 166 119 166
+ x 120 167 167 167 120 167
+ y 121 168 168 168 121 168
+ z 122 169 169 169 122 169
+ { 123 192 192 251 123 192 ###
+ | 124 79 79 79 124 79
+ } 125 208 208 253 125 208 ###
+ ~ 126 161 161 255 126 161 ###
+ <DELETE> 127 7 7 7 127 7
+ <PADDING CHARACTER> 128 32 32 32 194.128 32
+ <HIGH OCTET PRESET> 129 33 33 33 194.129 33
+ <BREAK PERMITTED HERE> 130 34 34 34 194.130 34
+ <NO BREAK HERE> 131 35 35 35 194.131 35
+ <INDEX> 132 36 36 36 194.132 36
+ <NEXT LINE> 133 21 37 37 194.133 37 ***
+ <START OF SELECTED AREA> 134 6 6 6 194.134 6
+ <END OF SELECTED AREA> 135 23 23 23 194.135 23
+ <CHARACTER TABULATION SET> 136 40 40 40 194.136 40
+ <CHARACTER TABULATION WITH JUSTIFICATION> 137 41 41 41 194.137 41
+ <LINE TABULATION SET> 138 42 42 42 194.138 42
+ <PARTIAL LINE FORWARD> 139 43 43 43 194.139 43
+ <PARTIAL LINE BACKWARD> 140 44 44 44 194.140 44
+ <REVERSE LINE FEED> 141 9 9 9 194.141 9
+ <SINGLE SHIFT TWO> 142 10 10 10 194.142 10
+ <SINGLE SHIFT THREE> 143 27 27 27 194.143 27
+ <DEVICE CONTROL STRING> 144 48 48 48 194.144 48
+ <PRIVATE USE ONE> 145 49 49 49 194.145 49
+ <PRIVATE USE TWO> 146 26 26 26 194.146 26
+ <SET TRANSMIT STATE> 147 51 51 51 194.147 51
+ <CANCEL CHARACTER> 148 52 52 52 194.148 52
+ <MESSAGE WAITING> 149 53 53 53 194.149 53
+ <START OF GUARDED AREA> 150 54 54 54 194.150 54
+ <END OF GUARDED AREA> 151 8 8 8 194.151 8
+ <START OF STRING> 152 56 56 56 194.152 56
+ <SINGLE GRAPHIC CHARACTER INTRODUCER> 153 57 57 57 194.153 57
+ <SINGLE CHARACTER INTRODUCER> 154 58 58 58 194.154 58
+ <CONTROL SEQUENCE INTRODUCER> 155 59 59 59 194.155 59
+ <STRING TERMINATOR> 156 4 4 4 194.156 4
+ <OPERATING SYSTEM COMMAND> 157 20 20 20 194.157 20
+ <PRIVACY MESSAGE> 158 62 62 62 194.158 62
+ <APPLICATION PROGRAM COMMAND> 159 255 255 95 194.159 255 ###
+ <NON-BREAKING SPACE> 160 65 65 65 194.160 128.65
+ <INVERTED EXCLAMATION MARK> 161 170 170 170 194.161 128.66
+ <CENT SIGN> 162 74 74 176 194.162 128.67 ###
+ <POUND SIGN> 163 177 177 177 194.163 128.68
+ <CURRENCY SIGN> 164 159 159 159 194.164 128.69
+ <YEN SIGN> 165 178 178 178 194.165 128.70
+ <BROKEN BAR> 166 106 106 208 194.166 128.71 ###
+ <SECTION SIGN> 167 181 181 181 194.167 128.72
+ <DIAERESIS> 168 189 187 121 194.168 128.73 *** ###
+ <COPYRIGHT SIGN> 169 180 180 180 194.169 128.74
+ <FEMININE ORDINAL INDICATOR> 170 154 154 154 194.170 128.81
+ <LEFT POINTING GUILLEMET> 171 138 138 138 194.171 128.82
+ <NOT SIGN> 172 95 176 186 194.172 128.83 *** ###
+ <SOFT HYPHEN> 173 202 202 202 194.173 128.84
+ <REGISTERED TRADE MARK SIGN> 174 175 175 175 194.174 128.85
+ <MACRON> 175 188 188 161 194.175 128.86 ###
+ <DEGREE SIGN> 176 144 144 144 194.176 128.87
+ <PLUS-OR-MINUS SIGN> 177 143 143 143 194.177 128.88
+ <SUPERSCRIPT TWO> 178 234 234 234 194.178 128.89
+ <SUPERSCRIPT THREE> 179 250 250 250 194.179 128.98
+ <ACUTE ACCENT> 180 190 190 190 194.180 128.99
+ <MICRO SIGN> 181 160 160 160 194.181 128.100
+ <PARAGRAPH SIGN> 182 182 182 182 194.182 128.101
+ <MIDDLE DOT> 183 179 179 179 194.183 128.102
+ <CEDILLA> 184 157 157 157 194.184 128.103
+ <SUPERSCRIPT ONE> 185 218 218 218 194.185 128.104
+ <MASC. ORDINAL INDICATOR> 186 155 155 155 194.186 128.105
+ <RIGHT POINTING GUILLEMET> 187 139 139 139 194.187 128.106
+ <FRACTION ONE QUARTER> 188 183 183 183 194.188 128.112
+ <FRACTION ONE HALF> 189 184 184 184 194.189 128.113
+ <FRACTION THREE QUARTERS> 190 185 185 185 194.190 128.114
+ <INVERTED QUESTION MARK> 191 171 171 171 194.191 128.115
+ <A WITH GRAVE> 192 100 100 100 195.128 138.65
+ <A WITH ACUTE> 193 101 101 101 195.129 138.66
+ <A WITH CIRCUMFLEX> 194 98 98 98 195.130 138.67
+ <A WITH TILDE> 195 102 102 102 195.131 138.68
+ <A WITH DIAERESIS> 196 99 99 99 195.132 138.69
+ <A WITH RING ABOVE> 197 103 103 103 195.133 138.70
+ <CAPITAL LIGATURE AE> 198 158 158 158 195.134 138.71
+ <C WITH CEDILLA> 199 104 104 104 195.135 138.72
+ <E WITH GRAVE> 200 116 116 116 195.136 138.73
+ <E WITH ACUTE> 201 113 113 113 195.137 138.74
+ <E WITH CIRCUMFLEX> 202 114 114 114 195.138 138.81
+ <E WITH DIAERESIS> 203 115 115 115 195.139 138.82
+ <I WITH GRAVE> 204 120 120 120 195.140 138.83
+ <I WITH ACUTE> 205 117 117 117 195.141 138.84
+ <I WITH CIRCUMFLEX> 206 118 118 118 195.142 138.85
+ <I WITH DIAERESIS> 207 119 119 119 195.143 138.86
+ <CAPITAL LETTER ETH> 208 172 172 172 195.144 138.87
+ <N WITH TILDE> 209 105 105 105 195.145 138.88
+ <O WITH GRAVE> 210 237 237 237 195.146 138.89
+ <O WITH ACUTE> 211 238 238 238 195.147 138.98
+ <O WITH CIRCUMFLEX> 212 235 235 235 195.148 138.99
+ <O WITH TILDE> 213 239 239 239 195.149 138.100
+ <O WITH DIAERESIS> 214 236 236 236 195.150 138.101
+ <MULTIPLICATION SIGN> 215 191 191 191 195.151 138.102
+ <O WITH STROKE> 216 128 128 128 195.152 138.103
+ <U WITH GRAVE> 217 253 253 224 195.153 138.104 ###
+ <U WITH ACUTE> 218 254 254 254 195.154 138.105
+ <U WITH CIRCUMFLEX> 219 251 251 221 195.155 138.106 ###
+ <U WITH DIAERESIS> 220 252 252 252 195.156 138.112
+ <Y WITH ACUTE> 221 173 186 173 195.157 138.113 *** ###
+ <CAPITAL LETTER THORN> 222 174 174 174 195.158 138.114
+ <SMALL LETTER SHARP S> 223 89 89 89 195.159 138.115
+ <a WITH GRAVE> 224 68 68 68 195.160 139.65
+ <a WITH ACUTE> 225 69 69 69 195.161 139.66
+ <a WITH CIRCUMFLEX> 226 66 66 66 195.162 139.67
+ <a WITH TILDE> 227 70 70 70 195.163 139.68
+ <a WITH DIAERESIS> 228 67 67 67 195.164 139.69
+ <a WITH RING ABOVE> 229 71 71 71 195.165 139.70
+ <SMALL LIGATURE ae> 230 156 156 156 195.166 139.71
+ <c WITH CEDILLA> 231 72 72 72 195.167 139.72
+ <e WITH GRAVE> 232 84 84 84 195.168 139.73
+ <e WITH ACUTE> 233 81 81 81 195.169 139.74
+ <e WITH CIRCUMFLEX> 234 82 82 82 195.170 139.81
+ <e WITH DIAERESIS> 235 83 83 83 195.171 139.82
+ <i WITH GRAVE> 236 88 88 88 195.172 139.83
+ <i WITH ACUTE> 237 85 85 85 195.173 139.84
+ <i WITH CIRCUMFLEX> 238 86 86 86 195.174 139.85
+ <i WITH DIAERESIS> 239 87 87 87 195.175 139.86
+ <SMALL LETTER eth> 240 140 140 140 195.176 139.87
+ <n WITH TILDE> 241 73 73 73 195.177 139.88
+ <o WITH GRAVE> 242 205 205 205 195.178 139.89
+ <o WITH ACUTE> 243 206 206 206 195.179 139.98
+ <o WITH CIRCUMFLEX> 244 203 203 203 195.180 139.99
+ <o WITH TILDE> 245 207 207 207 195.181 139.100
+ <o WITH DIAERESIS> 246 204 204 204 195.182 139.101
+ <DIVISION SIGN> 247 225 225 225 195.183 139.102
+ <o WITH STROKE> 248 112 112 112 195.184 139.103
+ <u WITH GRAVE> 249 221 221 192 195.185 139.104 ###
+ <u WITH ACUTE> 250 222 222 222 195.186 139.105
+ <u WITH CIRCUMFLEX> 251 219 219 219 195.187 139.106
+ <u WITH DIAERESIS> 252 220 220 220 195.188 139.112
+ <y WITH ACUTE> 253 141 141 141 195.189 139.113
+ <SMALL LETTER thorn> 254 142 142 142 195.190 139.114
+ <y WITH DIAERESIS> 255 223 223 223 195.191 139.115
If you would rather see the above table in CCSID 0037 order rather than
ASCII + Latin-1 order then run the table through:
=back
- perl -ne 'if(/.{33}\d{1,3}\s{6,8}\d{1,3}\s{6,8}\d{1,3}\s{6,8}\d{1,3}/)'\
+ perl -ne 'if(/.{43}\d{1,3}\s{6,8}\d{1,3}\s{6,8}\d{1,3}\s{6,8}\d{1,3}/)'\
-e '{push(@l,$_)}' \
-e 'END{print map{$_->[0]}' \
-e ' sort{$a->[1] <=> $b->[1]}' \
- -e ' map{[$_,substr($_,42,3)]}@l;}' perlebcdic.pod
+ -e ' map{[$_,substr($_,52,3)]}@l;}' perlebcdic.pod
-If you would rather see it in CCSID 1047 order then change the digit
-42 in the last line to 51, like this:
+If you would rather see it in CCSID 1047 order then change the number
+52 in the last line to 61, like this:
=over 4
=back
- perl -ne 'if(/.{33}\d{1,3}\s{6,8}\d{1,3}\s{6,8}\d{1,3}\s{6,8}\d{1,3}/)'\
+ perl -ne 'if(/.{43}\d{1,3}\s{6,8}\d{1,3}\s{6,8}\d{1,3}\s{6,8}\d{1,3}/)'\
-e '{push(@l,$_)}' \
-e 'END{print map{$_->[0]}' \
-e ' sort{$a->[1] <=> $b->[1]}' \
- -e ' map{[$_,substr($_,51,3)]}@l;}' perlebcdic.pod
+ -e ' map{[$_,substr($_,61,3)]}@l;}' perlebcdic.pod
-If you would rather see it in POSIX-BC order then change the digit
-51 in the last line to 60, like this:
+If you would rather see it in POSIX-BC order then change the number
+61 in the last line to 70, like this:
=over 4
=back
- perl -ne 'if(/.{33}\d{1,3}\s{6,8}\d{1,3}\s{6,8}\d{1,3}\s{6,8}\d{1,3}/)'\
+ perl -ne 'if(/.{43}\d{1,3}\s{6,8}\d{1,3}\s{6,8}\d{1,3}\s{6,8}\d{1,3}/)'\
-e '{push(@l,$_)}' \
-e 'END{print map{$_->[0]}' \
-e ' sort{$a->[1] <=> $b->[1]}' \
- -e ' map{[$_,substr($_,60,3)]}@l;}' perlebcdic.pod
+ -e ' map{[$_,substr($_,70,3)]}@l;}' perlebcdic.pod
=head1 IDENTIFYING CHARACTER CODE SETS
An interesting property of the 32 C0 control characters
in the ASCII table is that they can "literally" be constructed
-as control characters in perl, e.g. C<(chr(0) eq "\c@")>
-C<(chr(1) eq "\cA")>, and so on. Perl on EBCDIC platforms has been
-ported to take "\c@" to chr(0) and "\cA" to chr(1) as well, but the
+as control characters in perl, e.g. C<(chr(0)> eq C<\c@>)>
+C<(chr(1)> eq C<\cA>)>, and so on. Perl on EBCDIC platforms has been
+ported to take C<\c@> to chr(0) and C<\cA> to chr(1), etc. as well, but the
thirty three characters that result depend on which code page you are
-using. The table below uses the character names from the previous table
-but with substitutions such as s/START OF/S.O./; s/END OF /E.O./;
-s/TRANSMISSION/TRANS./; s/TABULATION/TAB./; s/VERTICAL/VERT./;
-s/HORIZONTAL/HORIZ./; s/DEVICE CONTROL/D.C./; s/SEPARATOR/SEP./;
-s/NEGATIVE ACKNOWLEDGE/NEG. ACK./;. The POSIX-BC and 1047 sets are
+using. The table below uses the standard acronyms for the controls.
+The POSIX-BC and 1047 sets are
identical throughout this range and differ from the 0037 set at only
one spot (21 decimal). Note that the C<LINE FEED> character
-may be generated by "\cJ" on ASCII platforms but by "\cU" on 1047 or POSIX-BC
+may be generated by C<\cJ> on ASCII platforms but by C<\cU> on 1047 or POSIX-BC
platforms and cannot be generated as a C<"\c.letter."> control character on
-0037 platforms. Note also that "\c\\" maps to two characters
-not one.
-
- chr ord 8859-1 0037 1047 && POSIX-BC
- ------------------------------------------------------------------------
- "\c?" 127 <DELETE> " " ***><
- "\c@" 0 <NULL> <NULL> <NULL> ***><
- "\cA" 1 <S.O. HEADING> <S.O. HEADING> <S.O. HEADING>
- "\cB" 2 <S.O. TEXT> <S.O. TEXT> <S.O. TEXT>
- "\cC" 3 <E.O. TEXT> <E.O. TEXT> <E.O. TEXT>
- "\cD" 4 <E.O. TRANS.> <C1 28> <C1 28>
- "\cE" 5 <ENQUIRY> <HORIZ. TAB.> <HORIZ. TAB.>
- "\cF" 6 <ACKNOWLEDGE> <C1 6> <C1 6>
- "\cG" 7 <BELL> <DELETE> <DELETE>
- "\cH" 8 <BACKSPACE> <C1 23> <C1 23>
- "\cI" 9 <HORIZ. TAB.> <C1 13> <C1 13>
- "\cJ" 10 <LINE FEED> <C1 14> <C1 14>
- "\cK" 11 <VERT. TAB.> <VERT. TAB.> <VERT. TAB.>
- "\cL" 12 <FORM FEED> <FORM FEED> <FORM FEED>
- "\cM" 13 <CARRIAGE RETURN> <CARRIAGE RETURN> <CARRIAGE RETURN>
- "\cN" 14 <SHIFT OUT> <SHIFT OUT> <SHIFT OUT>
- "\cO" 15 <SHIFT IN> <SHIFT IN> <SHIFT IN>
- "\cP" 16 <DATA LINK ESCAPE> <DATA LINK ESCAPE> <DATA LINK ESCAPE>
- "\cQ" 17 <D.C. ONE> <D.C. ONE> <D.C. ONE>
- "\cR" 18 <D.C. TWO> <D.C. TWO> <D.C. TWO>
- "\cS" 19 <D.C. THREE> <D.C. THREE> <D.C. THREE>
- "\cT" 20 <D.C. FOUR> <C1 29> <C1 29>
- "\cU" 21 <NEG. ACK.> <C1 5> <LINE FEED> ***
- "\cV" 22 <SYNCHRONOUS IDLE> <BACKSPACE> <BACKSPACE>
- "\cW" 23 <E.O. TRANS. BLOCK> <C1 7> <C1 7>
- "\cX" 24 <CANCEL> <CANCEL> <CANCEL>
- "\cY" 25 <E.O. MEDIUM> <E.O. MEDIUM> <E.O. MEDIUM>
- "\cZ" 26 <SUBSTITUTE> <C1 18> <C1 18>
- "\c[" 27 <ESCAPE> <C1 15> <C1 15>
- "\c\\" 28 <FILE SEP.>\ <FILE SEP.>\ <FILE SEP.>\
- "\c]" 29 <GROUP SEP.> <GROUP SEP.> <GROUP SEP.>
- "\c^" 30 <RECORD SEP.> <RECORD SEP.> <RECORD SEP.> ***><
- "\c_" 31 <UNIT SEP.> <UNIT SEP.> <UNIT SEP.> ***><
-
+0037 platforms. Note also that C<\c\> cannot be the final element in a string
+or regex, as it will absorb the terminator. But C<\c\I<X>> is a C<FILE
+SEPARATOR> concatenated with I<X> for all I<X>.
+
+ chr ord 8859-1 0037 1047 && POSIX-BC
+ -----------------------------------------------------------------------
+ \c? 127 <DEL> " "
+ \c@ 0 <NUL> <NUL> <NUL>
+ \cA 1 <SOH> <SOH> <SOH>
+ \cB 2 <STX> <STX> <STX>
+ \cC 3 <ETX> <ETX> <ETX>
+ \cD 4 <EOT> <ST> <ST>
+ \cE 5 <ENQ> <HT> <HT>
+ \cF 6 <ACK> <SSA> <SSA>
+ \cG 7 <BEL> <DEL> <DEL>
+ \cH 8 <BS> <EPA> <EPA>
+ \cI 9 <HT> <RI> <RI>
+ \cJ 10 <LF> <SS2> <SS2>
+ \cK 11 <VT> <VT> <VT>
+ \cL 12 <FF> <FF> <FF>
+ \cM 13 <CR> <CR> <CR>
+ \cN 14 <SO> <SO> <SO>
+ \cO 15 <SI> <SI> <SI>
+ \cP 16 <DLE> <DLE> <DLE>
+ \cQ 17 <DC1> <DC1> <DC1>
+ \cR 18 <DC2> <DC2> <DC2>
+ \cS 19 <DC3> <DC3> <DC3>
+ \cT 20 <DC4> <OSC> <OSC>
+ \cU 21 <NAK> <NEL> <LF> ***
+ \cV 22 <SYN> <BS> <BS>
+ \cW 23 <ETB> <ESA> <ESA>
+ \cX 24 <CAN> <CAN> <CAN>
+ \cY 25 <EOM> <EOM> <EOM>
+ \cZ 26 <SUB> <PU2> <PU2>
+ \c[ 27 <ESC> <SS3> <SS3>
+ \c\X 28 <FS>X <FS>X <FS>X
+ \c] 29 <GS> <GS> <GS>
+ \c^ 30 <RS> <RS> <RS>
+ \c_ 31 <US> <US> <US>
=head1 FUNCTION DIFFERENCES
if (ord('^')==94) { # ascii
return $char =~ /[\000-\037]/;
}
- if (ord('^')==176) { # 37
+ if (ord('^')==176) { # 0037
return $char =~ /[\000-\003\067\055-\057\026\005\045\013-\023\074\075\062\046\030\031\077\047\034-\037]/;
}
if (ord('^')==95 || ord('^')==106) { # 1047 || posix-bc
if (ord('^')==94) { # ascii
return $char =~ /[\200-\237]/;
}
- if (ord('^')==176) { # 37
+ if (ord('^')==176) { # 0037
return $char =~ /[\040-\044\025\006\027\050-\054\011\012\033\060\061\032\063-\066\010\070-\073\040\024\076\377]/;
}
if (ord('^')==95) { # 1047
if (ord('^')==94) { # ascii
return $char =~ /[\240-\377]/;
}
- if (ord('^')==176) { # 37
+ if (ord('^')==176) { # 0037
return $char =~
/[\101\252\112\261\237\262\152\265\275\264\232\212\137\312\257\274\220\217\352\372\276\240\266\263\235\332\233\213\267\270\271\253\144\145\142\146\143\147\236\150\164\161-\163\170\165-\167\254\151\355\356\353\357\354\277\200\375\376\373\374\255\256\131\104\105\102\106\103\107\234\110\124\121-\123\130\125-\127\214\111\315\316\313\317\314\341\160\335\336\333\334\215\216\337]/;
}
two letter abbreviation for a physician comes before the two letter
for drive, that is:
- @sorted = sort(qw(Dr. dr.)); # @sorted holds ('Dr.','dr.') on ASCII,
+ @sorted = sort(qw(Dr. dr.)); # @sorted holds ('Dr.','dr.') on ASCII,
# but ('dr.','Dr.') on EBCDIC
The property of lower case before uppercase letters in EBCDIC is
Joe Smith. Trademarks, registered trademarks, service marks and
registered service marks used in this document are the property of
their respective owners.
-
-
SvREFCNT_dec(command);
*match_list = get_av("array", 0);
- num_matches = av_len(*match_list) + 1; /** assume $[ is 0 **/
+ num_matches = av_len(*match_list) + 1;
return num_matches;
}
=head1 Hiding Perl_
-If you completely hide the short forms forms of the Perl public API,
+If you completely hide the short forms of the Perl public API,
add -DPERL_NO_SHORT_NAMES to the compilation flags. This means that
for example instead of writing
The perlfaq comes with the standard Perl distribution, so if you have Perl
you should have the perlfaq. You should also have the C<perldoc> tool
-that let's you read the L<perlfaq>:
+that lets you read the L<perlfaq>:
$ perldoc perlfaq
at http://faq.perl.org/ . The perlfaq-workers periodically post extracts
of the latest perlfaq to comp.lang.perl.misc.
-You can view the source tree at
-https://github.com/briandfoy/perlfaq (which is outside of the
-main Perl source tree). The git repository notes all changes to the FAQ
-and holds the latest version of the working documents and may vary
-significantly from the version distributed with the latest version of
-Perl. Check the repository before sending your corrections.
+You can view the source tree at https://github.com/briandfoy/perlfaq
+(which is outside of the main Perl source tree). The git repository
+notes all changes to the FAQ and holds the latest version of the
+working documents and may vary significantly from the version
+distributed with the latest version of Perl. Check the repository
+before sending your corrections.
=head2 How to contribute to the perlfaq
request so the main repository can pull your changes. The repository
is at:
- https://github.com/briandfoy/perlfaq
+ https://github.com/briandfoy/perlfaq
=head2 What will happen if you mail your Perl programming problems to the authors?
=head1 AUTHOR AND COPYRIGHT
-Copyright (c) 1997-2009 Tom Christiansen, Nathan Torkington, and
-other authors as noted. All rights reserved.
-
Tom Christainsen wrote the original version of this document.
brian d foy C<< <bdfoy@cpan.org> >> wrote this version. See the
individual perlfaq documents for additional copyright information.
This document is available under the same terms as Perl itself. Code
examples in all the perlfaq documents are in the public domain. Use
-them as you see fit and at your own risk with no warranty from anyone.
+them as you see fit (and at your own risk with no warranty from anyone).
=head1 Table of Contents
=item *
-Does Perl have a Year 2000 problem? Is Perl Y2K compliant?
+Does Perl have a Year 2000 or 2038 problem? Is Perl Y2K compliant?
=item *
=item *
+How do I delete the last N lines from a file?
+
+=item *
+
How can I use Perl's C<-i> option from within a program?
=item *
=item *
-How can I comment out a large block of perl code?
+How can I comment out a large block of Perl code?
=item *
of Perl and its implementation, but was ultimately abandoned.
If you want to learn more about Perl 6, or have a desire to help in
-the crusade to make Perl a better place then peruse the Perl 6 developers
+the crusade to make Perl a better place then read the Perl 6 developers
page at http://dev.perl.org/perl6/ and get involved.
Perl 6 is not scheduled for release yet, and Perl 5 will still be supported
=back
-=head1 REVISION
-
-Revision: $Revision$
-
-Date: $Date$
-
-See L<perlfaq> for source control details and availability.
-
=head1 AUTHOR AND COPYRIGHT
-Copyright (c) 1997-2009 Tom Christiansen, Nathan Torkington, and
+Copyright (c) 1997-2010 Tom Christiansen, Nathan Torkington, and
other authors as noted. All rights reserved.
This documentation is free; you can redistribute it and/or modify it
see their FAQ ( http://www.faqs.org/faqs/alt-sources-intro/ ) for details.
If you're just looking for software, first use Google
-( http://www.google.com ), Google's usenet search interface
+( http://www.google.com ), Google's Usenet search interface
( http://groups.google.com ), and CPAN Search ( http://search.cpan.org ).
This is faster and more productive than just posting a request.
a replicated worldwide repository of Perl software, see
the I<What is CPAN?> question earlier in this document.
-=head1 REVISION
-
-Revision: $Revision$
-
-Date: $Date$
-
-See L<perlfaq> for source control details and availability.
-
=head1 AUTHOR AND COPYRIGHT
-Copyright (c) 1997-2009 Tom Christiansen, Nathan Torkington, and
+Copyright (c) 1997-2010 Tom Christiansen, Nathan Torkington, and
other authors as noted. All rights reserved.
This documentation is free; you can redistribute it and/or modify it
Perl programs are just plain text, so any editor will do.
-If you're on Unix, you already have an IDE--Unix itself. The UNIX
+If you're on Unix, you already have an IDE--Unix itself. The Unix
philosophy is the philosophy of several small tools that each do one
thing and do it well. It's like a carpenter's toolbox.
nvi ( http://www.bostic.com/vi/ , available from CPAN in src/misc/) is
yet another vi clone, unfortunately not available for Windows, but in
-UNIX platforms you might be interested in trying it out, firstly because
+Unix platforms you might be interested in trying it out, firstly because
strictly speaking it is not a vi clone, it is the real vi, or the new
incarnation of it, and secondly because you can embed Perl inside it
to use Perl as the scripting language. nvi is not alone in this,
research purposes), Cygwin is covered by the GNU General Public
License (but that shouldn't matter for Perl use). The Cygwin, MKS,
and U/WIN all contain (in addition to the shells) a comprehensive set
-of standard UNIX toolkit utilities.
+of standard Unix toolkit utilities.
If you're transferring text files between Unix and Windows using FTP
be sure to transfer them in ASCII mode so the ends of lines are
Perl2Exe ( http://www.indigostar.com/perl2exe.htm ) is a command line
program for converting perl scripts to executable files. It targets both
-Windows and unix platforms.
+Windows and Unix platforms.
=head2 How can I get C<#!perl> to work on [MS-DOS,NT,...]?
The C<ExtUtils::MakeMaker> module, better known simply as "MakeMaker",
turns a Perl script, typically called C<Makefile.PL>, into a Makefile.
-The unix tool C<make> uses this file to manage dependencies and actions
+The Unix tool C<make> uses this file to manage dependencies and actions
to process and install a Perl distribution.
-=head1 REVISION
-
-Revision: $Revision$
-
-Date: $Date$
-
-See L<perlfaq> for source control details and availability.
-
=head1 AUTHOR AND COPYRIGHT
-Copyright (c) 1997-2009 Tom Christiansen, Nathan Torkington, and
+Copyright (c) 1997-2010 Tom Christiansen, Nathan Torkington, and
other authors as noted. All rights reserved.
This documentation is free; you can redistribute it and/or modify it
print $string + 44; # prints 688, certainly not octal!
This problem usually involves one of the Perl built-ins that has the
-same name a unix command that uses octal numbers as arguments on the
+same name a Unix command that uses octal numbers as arguments on the
command line. In this example, C<chmod> on the command line knows that
its first argument is octal because that's what it does:
(contributed by brian d foy)
-Perl itself never had a Y2K problem, although that nevers stopped people
+Perl itself never had a Y2K problem, although that never stopped people
from creating Y2K problems on their own. See the documentation for
C<localtime> for its proper use.
=head2 What is the difference between a list and an array?
-An array has a changeable length. A list does not. An array is
-something you can push or pop, while a list is a set of values. Some
-people make the distinction that a list is a value while an array is a
-variable. Subroutines are passed and return lists, you put things into
-list context, you initialize arrays with lists, and you C<foreach()>
-across a list. C<@> variables are arrays, anonymous arrays are
-arrays, arrays in scalar context behave like the number of elements in
-them, subroutines access their arguments through the array C<@_>, and
-C<push>/C<pop>/C<shift> only work on arrays.
+(contributed by brian d foy)
+
+A list is a fixed collection of scalars. An array is a variable that
+holds a variable collection of scalars. An array can supply its collection
+for list operations, so list operations also work on arrays:
+
+ # slices
+ ( 'dog', 'cat', 'bird' )[2,3];
+ @animals[2,3];
+
+ # iteration
+ foreach ( qw( dog cat bird ) ) { ... }
+ foreach ( @animals ) { ... }
+
+ my @three = grep { length == 3 } qw( dog cat bird );
+ my @three = grep { length == 3 } @animals;
+
+ # supply an argument list
+ wash_animals( qw( dog cat bird ) );
+ wash_animals( @animals );
+
+Array operations, which change the scalars, reaaranges them, or adds
+or subtracts some scalars, only work on arrays. These can't work on a
+list, which is fixed. Array operations include C<shift>, C<unshift>,
+C<push>, C<pop>, and C<splice>.
+
+An array can also change its length:
+
+ $#animals = 1; # truncate to two elements
+ $#animals = 10000; # pre-extend to 10,001 elements
+
+You can change an array element, but you can't change a list element:
+
+ $animals[0] = 'Rottweiler';
+ qw( dog cat bird )[0] = 'Rottweiler'; # syntax error!
+
+ foreach ( @animals ) {
+ s/^d/fr/; # works fine
+ }
+
+ foreach ( qw( dog cat bird ) ) {
+ s/^d/fr/; # Error! Modification of read only value!
+ }
+
+However, if the list element is itself a variable, it appears that you
+can change a list element. However, the list element is the variable, not
+the data. You're not changing the list element, but something the list
+element refers to. The list element itself doesn't change: it's still
+the same variable.
-As a side note, there's no such thing as a list in scalar context.
-When you say
+You also have to be careful about context. You can assign an array to
+a scalar to get the number of elements in the array. This only works
+for arrays, though:
+
+ my $count = @animals; # only works with arrays
+
+If you try to do the same thing with what you think is a list, you
+get a quite different result. Although it looks like you have a list
+on the righthand side, Perl actually sees a bunch of scalars separated
+by a comma:
- $scalar = (2, 5, 7, 9);
+ my $scalar = ( 'dog', 'cat', 'bird' ); # $scalar gets bird
-you're using the comma operator in scalar context, so it uses the scalar
-comma operator. There never was a list there at all! This causes the
-last value to be returned: 9.
+Since you're assigning to a scalar, the righthand side is in scalar
+context. The comma operator (yes, it's an operator!) in scalar
+context evaluates its lefthand side, throws away the result, and
+evaluates it's righthand side and returns the result. In effect,
+that list-lookalike assigns to C<$scalar> it's rightmost value. Many
+people mess this up becuase they choose a list-lookalike whose
+last element is also the count they expect:
+
+ my $scalar = ( 1, 2, 3 ); # $scalar gets 3, accidentally
=head2 What is the difference between $array[1] and @array[1]?
-The former is a scalar value; the latter an array slice, making
-it a list with one (scalar) value. You should use $ when you want a
-scalar value (most of the time) and @ when you want a list with one
-scalar value in it (very, very rarely; nearly never, in fact).
+(contributed by brian d foy)
+
+The difference is the sigil, that special character in front of the
+array name. The C<$> sigil means "exactly one item", while the C<@>
+sigil means "zero or more items". The C<$> gets you a single scalar,
+while the C<@> gets you a list.
-Sometimes it doesn't make a difference, but sometimes it does.
-For example, compare:
+The confusion arises because people incorrectly assume that the sigil
+denotes the variable type.
- $good[0] = `some program that outputs several lines`;
+The C<$array[1]> is a single-element access to the array. It's going
+to return the item in index 1 (or undef if there is no item there).
+If you intend to get exactly one element from the array, this is the
+form you should use.
-with
+The C<@array[1]> is an array slice, although it has only one index.
+You can pull out multiple elements simultaneously by specifying
+additional indices as a list, like C<@array[1,4,3,0]>.
- @bad[0] = `same program that outputs several lines`;
+Using a slice on the lefthand side of the assignment supplies list
+context to the righthand side. This can lead to unexpected results.
+For instance, if you want to read a single line from a filehandle,
+assigning to a scalar value is fine:
-The C<use warnings> pragma and the B<-w> flag will warn you about these
-matters.
+ $array[1] = <STDIN>;
+
+However, in list context, the line input operator returns all of the
+lines as a list. The first line goes into C<@array[1]> and the rest
+of the lines mysteriously disappear:
+
+ @array[1] = <STDIN>; # most likely not what you want
+
+Either the C<use warnings> pragma or the B<-w> flag will warn you when
+you use an array slice with a single index.
=head2 How can I remove duplicate elements from a list or array?
See L<http://search.cpan.org/dist/PGPLOT> for the code.
-=head1 REVISION
-
-Revision: $Revision$
-
-Date: $Date$
-
-See L<perlfaq> for source control details and availability.
-
=head1 AUTHOR AND COPYRIGHT
-Copyright (c) 1997-2009 Tom Christiansen, Nathan Torkington, and
+Copyright (c) 1997-2010 Tom Christiansen, Nathan Torkington, and
other authors as noted. All rights reserved.
This documentation is free; you can redistribute it and/or modify it
=head2 How do I count the number of lines in a file?
X<file, counting lines> X<lines> X<line>
-One fairly efficient way is to count newlines in the file. The
-following program uses a feature of tr///, as documented in L<perlop>.
-If your text file doesn't end with a newline, then it's not really a
-proper text file, so this may report one fewer line than you expect.
-
- $lines = 0;
- open(FILE, $filename) or die "Can't open `$filename': $!";
- while (sysread FILE, $buffer, 4096) {
- $lines += ($buffer =~ tr/\n//);
+(contributed by brian d foy)
+
+Conceptually, the easiest way to count the lines in a file is to
+simply read them and count them:
+
+ my $count = 0;
+ while( <$fh> ) { $count++; }
+
+You don't really have to count them yourself, though, since Perl
+already does that with the C<$.> variable, which is the current line
+number from the last filehandle read:
+
+ 1 while( <$fh> );
+ my $count = $.;
+
+If you want to use C<$.>, you can reduce it to a simple one-liner,
+like one of these:
+
+ % perl -lne '} print $.; {' file
+
+ % perl -lne 'END { print $. }' file
+
+Those can be rather inefficient though. If they aren't fast enough for
+you, you might just read chunks of data and count the number of
+newlines:
+
+ my $lines = 0;
+ open my($fh), '<:raw', $filename or die "Can't open $filename: $!";
+ while( sysread $fh, $buffer, 4096 ) {
+ $lines += ( $buffer =~ tr/\n// );
}
close FILE;
-This assumes no funny games with newline translations.
+However, that doesn't work if the line ending isn't a newline. You
+might change that C<tr///> to a C<s///> so you can count the number of
+times the input record separator, C<$/>, shows up:
+
+ my $lines = 0;
+ open my($fh), '<:raw', $filename or die "Can't open $filename: $!";
+ while( sysread $fh, $buffer, 4096 ) {
+ $lines += ( $buffer =~ s|$/||g; );
+ }
+ close FILE;
+
+If you don't mind shelling out, the C<wc> command is usually the
+fastest, even with the extra interprocess overhead. Ensure that you
+have an untainted filename though:
+
+ #!perl -T
+
+ $ENV{PATH} = undef;
+
+ my $lines;
+ if( $filename =~ /^([0-9a-z_.]+)\z/ ) {
+ $lines = `/usr/bin/wc -l $1`
+ chomp $lines;
+ }
=head2 How do I delete the last N lines from a file?
X<lines> X<file>
(contributed by brian d foy)
-If you have an empty directory, you can use Perl's built-in C<rmdir>. If
-the directory is not empty (so, no files or subdirectories), you either
-have to empty it yourself (a lot of work) or use a module to help you.
+If you have an empty directory, you can use Perl's built-in C<rmdir>.
+If the directory is not empty (so, no files or subdirectories), you
+either have to empty it yourself (a lot of work) or use a module to
+help you.
-The C<File::Path> module, which comes with Perl, has a C<rmtree> which
-can take care of all of the hard work for you:
+The C<File::Path> module, which comes with Perl, has a C<remove_tree>
+which can take care of all of the hard work for you:
- use File::Path qw(rmtree);
+ use File::Path qw(remove_tree);
- rmtree( \@directories, 0, 0 );
+ remove_tree( @directories );
-The first argument to C<rmtree> is either a string representing a directory path
-or an array reference. The second argument controls progress messages, and the
-third argument controls the handling of files you don't have permissions to
-delete. See the C<File::Path> module for the details.
+The C<File::Path> module also has a legacy interface to the older
+C<rmtree> subroutine.
=head2 How do I copy an entire directory?
To do the equivalent of C<cp -R> (i.e. copy an entire directory tree
recursively) in portable Perl, you'll either need to write something yourself
or find a good CPAN module such as L<File::Copy::Recursive>.
-=head1 REVISION
-
-Revision: $Revision$
-
-Date: $Date$
-
-See L<perlfaq> for source control details and availability.
=head1 AUTHOR AND COPYRIGHT
-Copyright (c) 1997-2009 Tom Christiansen, Nathan Torkington, and
+Copyright (c) 1997-2010 Tom Christiansen, Nathan Torkington, and
other authors as noted. All rights reserved.
This documentation is free; you can redistribute it and/or modify it
=item Comments Inside the Regex
The C</x> modifier causes whitespace to be ignored in a regex pattern
-(except in a character class), and also allows you to use normal
-comments there, too. As you can imagine, whitespace and comments help
-a lot.
+(except in a character class and a few other places), and also allows you to
+use normal comments there, too. As you can imagine, whitespace and comments
+help a lot.
C</x> lets you turn this:
warn $@;
}
-=head1 REVISION
-
-Revision: $Revision$
-
-Date: $Date$
-
-See L<perlfaq> for source control details and availability.
-
=head1 AUTHOR AND COPYRIGHT
-Copyright (c) 1997-2009 Tom Christiansen, Nathan Torkington, and
+Copyright (c) 1997-2010 Tom Christiansen, Nathan Torkington, and
other authors as noted. All rights reserved.
This documentation is free; you can redistribute it and/or modify it
Calling a subroutine as C<&foo> with no trailing parentheses ignores
the prototype of C<foo> and passes it the current value of the argument
list, C<@_>. Here's an example; the C<bar> subroutine calls C<&foo>,
-which prints what its arguments list:
+which prints its arguments list:
sub bar { &foo }
your PATH, which might also mean that the location of perl is not
where you expect it so you need to adjust your shebang line.
-=head1 REVISION
-
-Revision: $Revision$
-
-Date: $Date$
-
-See L<perlfaq> for source control details and availability.
-
=head1 AUTHOR AND COPYRIGHT
-Copyright (c) 1997-2009 Tom Christiansen, Nathan Torkington, and
+Copyright (c) 1997-2010 Tom Christiansen, Nathan Torkington, and
other authors as noted. All rights reserved.
This documentation is free; you can redistribute it and/or modify it
=head2 How do I find out which operating system I'm running under?
-The C<$^O> variable (C<$OSNAME> if you use C<English>) contains an indication of
-the name of the operating system (not its release number) that your perl
-binary was built for.
+The C<$^O> variable (C<$OSNAME> if you use C<English>) contains an
+indication of the name of the operating system (not its release
+number) that your perl binary was built for.
=head2 How come exec() doesn't return?
X<exec> X<system> X<fork> X<open> X<pipe>
However, using the code requires that you have a working C compiler
and can use it to build and install a CPAN module. Here's a solution
-using the standard C<POSIX> module, which is already on your systems
+using the standard C<POSIX> module, which is already on your system
(assuming your system supports POSIX).
use HotKey;
=back
-While trying to read from his caller-id box, the notorious Jamie Zawinski
-C<< <jwz@netscape.com> >>, after much gnashing of teeth and fighting with C<sysread>,
-C<sysopen>, POSIX's C<tcgetattr> business, and various other functions that
-go bump in the night, finally came up with this:
+While trying to read from his caller-id box, the notorious Jamie
+Zawinski C<< <jwz@netscape.com> >>, after much gnashing of teeth and
+fighting with C<sysread>, C<sysopen>, POSIX's C<tcgetattr> business,
+and various other functions that go bump in the night, finally came up
+with this:
sub open_modem {
use IPC::Open2;
and many of the techniques are in L<perlipc>.
Several CPAN modules may be able to help, including C<IPC::Open2> or
-C<IPC::Open3>, C<IPC::Run>, C<Parallel::Jobs>, C<Parallel::ForkManager>, C<POE>,
-C<Proc::Background>, and C<Win32::Process>. There are many other modules you
-might use, so check those namespaces for other options too.
+C<IPC::Open3>, C<IPC::Run>, C<Parallel::Jobs>,
+C<Parallel::ForkManager>, C<POE>, C<Proc::Background>, and
+C<Win32::Process>. There are many other modules you might use, so
+check those namespaces for other options too.
-If you are on a unix-like system, you might be able to get away with a
+If you are on a Unix-like system, you might be able to get away with a
system call where you put an C<&> on the end of the command:
system("cmd &")
However, if all you want to do is change your time zone, you can
probably get away with setting an environment variable:
- $ENV{TZ} = "MST7MDT"; # unixish
+ $ENV{TZ} = "MST7MDT"; # Unixish
$ENV{'SYS$TIMEZONE_DIFFERENTIAL'}="-5" # vms
system "trn comp.lang.perl.misc";
use sigtrap qw(die normal-signals);
-Perl's exception-handling mechanism is its C<eval()> operator. You can
-use C<eval()> as C<setjmp> and C<die()> as C<longjmp>. For details of this, see
-the section on signals, especially the time-out handler for a blocking
-C<flock()> in L<perlipc/"Signals"> or the section on "Signals" in
-the Camel Book.
+Perl's exception-handling mechanism is its C<eval()> operator. You
+can use C<eval()> as C<setjmp> and C<die()> as C<longjmp>. For
+details of this, see the section on signals, especially the time-out
+handler for a blocking C<flock()> in L<perlipc/"Signals"> or the
+section on "Signals" in the Camel Book.
If exception handling is all you're interested in, try the
C<exceptions.pl> library (part of the standard perl distribution).
=head2 How can I open a pipe both to and from a command?
-The C<IPC::Open2> module (part of the standard perl distribution) is an
-easy-to-use approach that internally uses C<pipe()>, C<fork()>, and C<exec()>
-to do the job. Make sure you read the deadlock warnings in its documentation,
-though (see L<IPC::Open2>). See
+The C<IPC::Open2> module (part of the standard perl distribution) is
+an easy-to-use approach that internally uses C<pipe()>, C<fork()>, and
+C<exec()> to do the job. Make sure you read the deadlock warnings in
+its documentation, though (see L<IPC::Open2>). See
L<perlipc/"Bidirectional Communication with Another Process"> and
L<perlipc/"Bidirectional Communication with Yourself">
=head2 Why can't my script read from STDIN after I gave it EOF (^D on Unix, ^Z on MS-DOS)?
This happens only if your perl is compiled to use stdio instead of
-perlio, which is the default. Some (maybe all?) stdio's set error and
+perlio, which is the default. Some (maybe all?) stdios set error and
eof flags that you may need to clear. The C<POSIX> module defines
C<clearerr()> that you can use. That is the technically correct way to
do it. Here are some less reliable workarounds:
=head2 Can I use perl to run a telnet or ftp session?
-Try the C<Net::FTP>, C<TCP::Client>, and C<Net::Telnet> modules (available from
-CPAN). http://www.cpan.org/scripts/netstuff/telnet.emul.shar
-will also help for emulating the telnet protocol, but C<Net::Telnet> is
-quite probably easier to use.
+Try the C<Net::FTP>, C<TCP::Client>, and C<Net::Telnet> modules
+(available from CPAN).
+http://www.cpan.org/scripts/netstuff/telnet.emul.shar will also help
+for emulating the telnet protocol, but C<Net::Telnet> is quite
+probably easier to use.
If all you want to do is pretend to be telnet but don't need
the initial telnet handshaking, then the standard dual-process
(contributed by brian d foy)
This is a difficult question to answer, and the best answer is
-only a guess. What do you really want to know? If you merely
-want to know if one of your filehandles is connected to a terminal,
-you can try the C<-t> file test:
+only a guess.
+
+What do you really want to know? If you merely want to know if one of
+your filehandles is connected to a terminal, you can try the C<-t>
+file test:
if( -t STDOUT ) {
print "I'm connected to a terminal!\n";
available drivers on CPAN: http://www.cpan.org/modules/by-module/DBD/ .
You can read more about DBI on http://dbi.perl.org .
-Other modules provide more specific access: C<Win32::ODBC>, C<Alzabo>, C<iodbc>,
-and others found on CPAN Search: http://search.cpan.org .
+Other modules provide more specific access: C<Win32::ODBC>, C<Alzabo>,
+C<iodbc>, and others found on CPAN Search: http://search.cpan.org .
=head2 How do I make a system() exit on control-C?
perl Makefile.PL INSTALL_BASE=/mydir/perl
-You can set this in your C<CPAN.pm> configuration so modules automatically install
-in your private library directory when you use the CPAN.pm shell:
+You can set this in your C<CPAN.pm> configuration so modules
+automatically install in your private library directory when you use
+the CPAN.pm shell:
% cpan
cpan> o conf makepl_arg INSTALL_BASE=/mydir/perl
You can configure C<CPAN.pm> to automatically use this option too:
% cpan
- cpan> o conf mbuild_arg --install_base /mydir/perl
+ cpan> o conf mbuild_arg "--install_base /mydir/perl"
cpan> o conf commit
INSTALL_BASE tells these tools to put your modules into
constants. Sometimes it is built using C<h2ph> when Perl is installed,
but other times it is not. Modern programs C<use Socket;> instead.
-=head1 REVISION
-
-Revision: $Revision$
-
-Date: $Date$
-
-See L<perlfaq> for source control details and availability.
-
=head1 AUTHOR AND COPYRIGHT
-Copyright (c) 1997-2009 Tom Christiansen, Nathan Torkington, and
+Copyright (c) 1997-2010 Tom Christiansen, Nathan Torkington, and
other authors as noted. All rights reserved.
This documentation is free; you can redistribute it and/or modify it
Use one of the RPC modules you can find on CPAN (
http://search.cpan.org/search?query=RPC&mode=all ).
-=head1 REVISION
-
-Revision: $Revision$
-
-Date: $Date$
-
-See L<perlfaq> for source control details and availability.
-
=head1 AUTHOR AND COPYRIGHT
-Copyright (c) 1997-2009 Tom Christiansen, Nathan Torkington, and
+Copyright (c) 1997-2010 Tom Christiansen, Nathan Torkington, and
other authors as noted. All rights reserved.
This documentation is free; you can redistribute it and/or modify it
a unary operator, but merely separates the arguments of a list
operator. A unary operator generally provides a scalar context to its
argument, while a list operator may provide either scalar or list
-contexts for its arguments. If it does both, the scalar arguments will
-be first, and the list argument will follow. (Note that there can ever
-be only one such list argument.) For instance, splice() has three scalar
+contexts for its arguments. If it does both, scalar arguments
+come first and list argument follow, and there can only ever
+be one such list argument. For instance, splice() has three scalar
arguments followed by a list, whereas gethostbyname() has four scalar
arguments.
In the syntax descriptions that follow, list operators that expect a
-list (and provide list context for the elements of the list) are shown
+list (and provide list context for elements of the list) are shown
with LIST as an argument. Such a list may consist of any combination
of scalar arguments or list values; the list values will be included
in the list as if each individual element were interpolated at that
point in the list, forming a longer single-dimensional list value.
-Commas should separate elements of the LIST.
+Commas should separate literal elements of the LIST.
Any function in the list below may be used either with or without
parentheses around its arguments. (The syntax descriptions omit the
-parentheses.) If you use the parentheses, the simple (but occasionally
-surprising) rule is this: It I<looks> like a function, therefore it I<is> a
+parentheses.) If you use parentheses, the simple but occasionally
+surprising rule is this: It I<looks> like a function, therefore it I<is> a
function, and precedence doesn't matter. Otherwise it's a list
-operator or unary operator, and precedence does matter. And whitespace
-between the function and left parenthesis doesn't count--so you need to
-be careful sometimes:
+operator or unary operator, and precedence does matter. Whitespace
+between the function and left parenthesis doesn't count, so sometimes
+you need to be careful:
print 1+2+4; # Prints 7.
print(1+2) + 4; # Prints 3.
For functions that can be used in either a scalar or list context,
nonabortive failure is generally indicated in a scalar context by
returning the undefined value, and in a list context by returning the
-null list.
+empty list.
Remember the following important rule: There is B<no rule> that relates
the behavior of an expression in list context to its behavior in scalar
context, or vice versa. It might do two totally different things.
-Each operator and function decides which sort of value it would be most
+Each operator and function decides which sort of value would be most
appropriate to return in scalar context. Some operators return the
length of the list that would have been returned in list context. Some
operators return the first value in the list. Some operators return the
there, not the list construction version of the comma. That means it
was never a list to start with.
-In general, functions in Perl that serve as wrappers for system calls
+In general, functions in Perl that serve as wrappers for system calls ("syscalls")
of the same name (like chown(2), fork(2), closedir(2), etc.) all return
true when they succeed and C<undef> otherwise, as is usually mentioned
in the descriptions below. This is different from the C interfaces,
C<break>, C<continue>, C<given>, C<when>, C<default>
-(These are only available if you enable the "switch" feature.
+(These are available only if you enable the C<"switch"> feature.
See L<feature> and L<perlsyn/"Switch statements">.)
=item Keywords related to scoping
C<caller>, C<import>, C<local>, C<my>, C<our>, C<state>, C<package>,
C<use>
-(C<state> is only available if the "state" feature is enabled. See
+(C<state> is available only if the C<"state"> feature is enabled. See
L<feature>.)
=item Miscellaneous functions
C<pipe>, C<qx//>, C<setpgrp>, C<setpriority>, C<sleep>, C<system>,
C<times>, C<wait>, C<waitpid>
-=item Keywords related to perl modules
+=item Keywords related to Perl modules
X<module>
C<do>, C<import>, C<no>, C<package>, C<require>, C<use>
C<readline>, C<readpipe>, C<ref>, C<sub>*, C<sysopen>, C<tie>, C<tied>, C<uc>,
C<ucfirst>, C<untie>, C<use>, C<when>
-* - C<sub> was a keyword in perl4, but in perl5 it is an
+* C<sub> was a keyword in Perl 4, but in Perl 5 it is an
operator, which can be used in expressions.
=item Functions obsoleted in perl5
=head2 Alphabetical Listing of Perl Functions
-=over 8
+=over
=item -X FILEHANDLE
X<-r>X<-w>X<-x>X<-o>X<-R>X<-W>X<-X>X<-O>X<-e>X<-z>X<-s>X<-f>X<-d>X<-l>X<-p>
If you are using ACLs, there is a pragma called C<filetest> that may
produce more accurate results than the bare stat() mode bits.
When under the C<use filetest 'access'> the above-mentioned filetests
-will test whether the permission can (not) be granted using the
-access() family of system calls. Also note that the C<-x> and C<-X> may
+test whether the permission can (not) be granted using the
+access(2) family of system calls. Also note that the C<-x> and C<-X> may
under this pragma return true even if there are no execute permission
bits set (nor any extra execute permission ACLs). This strangeness is
due to the underlying system calls' definitions. Note also that, due to
information.
Note that C<-s/a/b/> does not do a negated substitution. Saying
-C<-exp($foo)> still works as expected, however--only single letters
+C<-exp($foo)> still works as expected, however: only single letters
following a minus are interpreted as file tests.
The C<-T> and C<-B> switches work as follows. The first block or so of the
file is examined for odd characters such as strange control codes or
characters with the high bit set. If too many strange characters (>30%)
are found, it's a C<-B> file; otherwise it's a C<-T> file. Also, any file
-containing null in the first block is considered a binary file. If C<-T>
+containing a zero byte in the first block is considered a binary file. If C<-T>
or C<-B> is used on a filehandle, the current IO buffer is examined
-rather than the first block. Both C<-T> and C<-B> return true on a null
+rather than the first block. Both C<-T> and C<-B> return true on an empty
file, or a file at EOF when testing a filehandle. Because you have to
read a file to do the C<-T> test, on most occasions you want to use a C<-f>
against the file first, as in C<next unless -f $file && -T $file>.
the special filehandle consisting of a solitary underline, then the stat
structure of the previous file test (or stat operator) is used, saving
a system call. (This doesn't work with C<-t>, and you need to remember
-that lstat() and C<-l> will leave values in the stat structure for the
+that lstat() and C<-l> leave values in the stat structure for the
symbolic link, not the real file.) (Also, if the stat buffer was filled by
an C<lstat> call, C<-T> and C<-B> will reset it with the results of C<stat _>).
Example:
As of Perl 5.9.1, as a form of purely syntactic sugar, you can stack file
test operators, in a way that C<-f -w -x $file> is equivalent to
-C<-x $file && -w _ && -f _>. (This is only syntax fancy: if you use
+C<-x $file && -w _ && -f _>. (This is only fancy fancy: if you use
the return value of C<-f $file> as an argument to another filetest
operator, no special magic will happen.)
=item accept NEWSOCKET,GENERICSOCKET
X<accept>
-Accepts an incoming socket connect, just as the accept(2) system call
+Accepts an incoming socket connect, just as accept(2)
does. Returns the packed address if it succeeded, false otherwise.
See the example in L<perlipc/"Sockets: Client/Server Communication">.
might be able to use the C<syscall> interface to access setitimer(2) if
your system supports it. See L<perlfaq8> for details.
-It is usually a mistake to intermix C<alarm> and C<sleep> calls.
-(C<sleep> may be internally implemented in your system with C<alarm>)
+It is usually a mistake to intermix C<alarm> and C<sleep> calls, because
+C<sleep> may be internally implemented on your system with C<alarm>.
If you want to use C<alarm> to time out a system call you need to use an
C<eval>/C<die> pair. You can't rely on the alarm causing the system call to
=item bind SOCKET,NAME
X<bind>
-Binds a network address to a socket, just as the bind system call
+Binds a network address to a socket, just as bind(2)
does. Returns true if it succeeded, false otherwise. NAME should be a
packed address of the appropriate type for the socket. See the examples in
L<perlipc/"Sockets: Client/Server Communication">.
like for example images.
If LAYER is present it is a single string, but may contain multiple
-directives. The directives alter the behaviour of the file handle.
+directives. The directives alter the behaviour of the filehandle.
When LAYER is present using binmode on a text file makes sense.
If LAYER is omitted or specified as C<:raw> the filehandle is made
suitable for passing binary data. This includes turning off possible CRLF
translation and marking it as bytes (as opposed to Unicode characters).
Note that, despite what may be implied in I<"Programming Perl"> (the
-Camel) or elsewhere, C<:raw> is I<not> simply the inverse of C<:crlf>
--- other layers which would affect the binary nature of the stream are
-I<also> disabled. See L<PerlIO>, L<perlrun> and the discussion about the
+Camel, 3rd edition) or elsewhere, C<:raw> is I<not> simply the inverse of C<:crlf>.
+Other layers that would affect the binary nature of the stream are
+I<also> disabled. See L<PerlIO>, L<perlrun>, and the discussion about the
PERLIO environment variable.
-The C<:bytes>, C<:crlf>, and C<:utf8>, and any other directives of the
+The C<:bytes>, C<:crlf>, C<:utf8>, and any other directives of the
form C<:...>, are called I/O I<layers>. The C<open> pragma can be used to
establish default I/O layers. See L<open>.
UTF-8. More details can be found in L<PerlIO::encoding>.
In general, binmode() should be called after open() but before any I/O
-is done on the filehandle. Calling binmode() will normally flush any
+is done on the filehandle. Calling binmode() normally flushes any
pending buffered output data (and perhaps pending input data) on the
handle. An exception to this is the C<:encoding> layer that
changes the default character encoding of the handle, see L<open>.
The C<:encoding> layer sometimes needs to be called in
mid-stream, and it doesn't flush the stream. The C<:encoding>
also implicitly pushes on top of itself the C<:utf8> layer because
-internally Perl will operate on UTF-8 encoded Unicode characters.
+internally Perl operates on UTF8-encoded Unicode characters.
The operating system, device drivers, C libraries, and Perl run-time
system all work together to let the programmer treat a single
data contains C<\cZ>, the I/O subsystem will regard it as the end of
the file, unless you use binmode().
-binmode() is not only important for readline() and print() operations,
+binmode() is important not only for readline() and print() operations,
but also when using read(), seek(), sysread(), syswrite() and tell()
(see L<perlport> for more details). See the C<$/> and C<$\> variables
in L<perlvar> for how to manually set your input and output
Break out of a C<given()> block.
-This keyword is enabled by the "switch" feature: see L<feature>
+This keyword is enabled by the C<"switch"> feature: see L<feature>
for more information.
=item caller EXPR
=item caller
Returns the context of the current subroutine call. In scalar context,
-returns the caller's package name if there is a caller, that is, if
-we're in a subroutine or C<eval> or C<require>, and the undefined value
+returns the caller's package name if there I<is> a caller (that is, if
+we're in a subroutine or C<eval> or C<require>) and the undefined value
otherwise. In list context, returns
# 0 1 2
Be aware that the optimizer might have optimized call frames away before
C<caller> had a chance to get the information. That means that C<caller(N)>
-might not return information about the call frame you expect it do, for
+might not return information about the call frame you expect it to, for
C<< N > 1 >>. In particular, C<@DB::args> might have information from the
previous time C<caller> was called.
+Also be aware that setting C<@DB::args> is I<best effort>, intended for
+debugging or generating backtraces, and should not be relied upon. In
+particular, as C<@_> contains aliases to the caller's arguments, Perl does
+not take a copy of C<@_>, so C<@DB::args> will contain modifications the
+subroutine makes to C<@_> or its contents, not the original values at call
+time. C<@DB::args>, like C<@_>, does not hold explicit references to its
+elements, so under certain cases its elements may have become freed and
+reallocated for other variables or temporary values. Finally, a side effect
+of the current implementation means that the effects of C<shift @_> can
+I<normally> be undone (but not C<pop @_> or other splicing, and not if a
+reference to C<@_> has been taken, and subject to the caveat about reallocated
+elements), so C<@DB::args> is actually a hybrid of the current state and
+initial state of C<@_>. Buyer beware.
+
=item chdir EXPR
X<chdir>
X<cd>
changes to the directory specified by C<$ENV{HOME}>, if set; if not,
changes to the directory specified by C<$ENV{LOGDIR}>. (Under VMS, the
variable C<$ENV{SYS$LOGIN}> is also checked, and used if it is set.) If
-neither is set, C<chdir> does nothing. It returns true upon success,
+neither is set, C<chdir> does nothing. It returns true on success,
false otherwise. See the example under C<die>.
-On systems that support fchdir, you might pass a file handle or
-directory handle as argument. On systems that don't support fchdir,
-passing handles produces a fatal error at run time.
+On systems that support fchdir(2), you may pass a filehandle or
+directory handle as argument. On systems that don't support fchdir(2),
+passing handles raises an exception.
=item chmod LIST
X<chmod> X<permission> X<mode>
Changes the permissions of a list of files. The first element of the
list must be the numerical mode, which should probably be an octal
number, and which definitely should I<not> be a string of octal digits:
-C<0644> is okay, C<'0644'> is not. Returns the number of files
+C<0644> is okay, but C<"0644"> is not. Returns the number of files
successfully changed. See also L</oct>, if all you have is a string.
- $cnt = chmod 0755, 'foo', 'bar';
+ $cnt = chmod 0755, "foo", "bar";
chmod 0755, @executables;
- $mode = '0644'; chmod $mode, 'foo'; # !!! sets mode to
+ $mode = "0644"; chmod $mode, "foo"; # !!! sets mode to
# --w----r-T
- $mode = '0644'; chmod oct($mode), 'foo'; # this is better
- $mode = 0644; chmod $mode, 'foo'; # this is best
+ $mode = "0644"; chmod oct($mode), "foo"; # this is better
+ $mode = 0644; chmod $mode, "foo"; # this is best
-On systems that support fchmod, you might pass file handles among the
-files. On systems that don't support fchmod, passing file handles
-produces a fatal error at run time. The file handles must be passed
-as globs or references to be recognized. Barewords are considered
-file names.
+On systems that support fchmod(2), you may pass filehandles among the
+files. On systems that don't support fchmod(2), passing filehandles raises
+an exception. Filehandles must be passed as globs or glob references to be
+recognized; barewords are considered filenames.
open(my $fh, "<", "foo");
my $perm = (stat $fh)[2] & 07777;
chmod($perm | 0600, $fh);
-You can also import the symbolic C<S_I*> constants from the Fcntl
+You can also import the symbolic C<S_I*> constants from the C<Fcntl>
module:
- use Fcntl ':mode';
-
+ use Fcntl qw( :mode );
chmod S_IRWXU|S_IRGRP|S_IXGRP|S_IROTH|S_IXOTH, @executables;
- # This is identical to the chmod 0755 of the above example.
+ # Identical to the chmod 0755 of the example above.
=item chomp VARIABLE
X<chomp> X<INPUT_RECORD_SEPARATOR> X<$/> X<newline> X<eol>
$cnt = chown $uid, $gid, 'foo', 'bar';
chown $uid, $gid, @filenames;
-On systems that support fchown, you might pass file handles among the
-files. On systems that don't support fchown, passing file handles
-produces a fatal error at run time. The file handles must be passed
-as globs or references to be recognized. Barewords are considered
-file names.
+On systems that support fchown(2), you may pass filehandles among the
+files. On systems that don't support fchown(2), passing filehandles raises
+an exception. Filehandles must be passed as globs or glob references to be
+recognized; barewords are considered filenames.
Here's an example that looks up nonnumeric uids in the passwd file:
chr(0x263a) is a Unicode smiley face.
Negative values give the Unicode replacement character (chr(0xfffd)),
-except under the L<bytes> pragma, where low eight bits of the value
+except under the L<bytes> pragma, where the low eight bits of the value
(truncated to an integer) are used.
If NUMBER is omitted, uses C<$_>.
=item close
-Closes the file or pipe associated with the file handle, flushes the IO
+Closes the file or pipe associated with the filehandle, flushes the IO
buffers, and closes the system file descriptor. Returns true if those
operations have succeeded and if no error was reported by any PerlIO
layer. Closes the currently selected filehandle if the argument is
omitted.
You don't have to close FILEHANDLE if you are immediately going to do
-another C<open> on it, because C<open> will close it for you. (See
+another C<open> on it, because C<open> closes it for you. (See
C<open>.) However, an explicit C<close> on an input file resets the line
counter (C<$.>), while the implicit close done by C<open> does not.
-If the file handle came from a piped open, C<close> will additionally
-return false if one of the other system calls involved fails, or if the
-program exits with non-zero status. (If the only problem was that the
-program exited non-zero, C<$!> will be set to C<0>.) Closing a pipe
-also waits for the process executing on the pipe to complete, in case you
-want to look at the output of the pipe afterwards, and
-implicitly puts the exit status value of that command into C<$?> and
-C<${^CHILD_ERROR_NATIVE}>.
+If the filehandle came from a piped open, C<close> returns false if one of
+the other syscalls involved fails or if its program exits with non-zero
+status. If the only problem was that the program exited non-zero, C<$!>
+will be set to C<0>. Closing a pipe also waits for the process executing
+on the pipe to exit--in case you wish to look at the output of the pipe
+afterwards--and implicitly puts the exit status value of that command into
+C<$?> and C<${^CHILD_ERROR_NATIVE}>.
-Prematurely closing the read end of a pipe (i.e. before the process
-writing to it at the other end has closed it) will result in a
-SIGPIPE being delivered to the writer. If the other end can't
-handle that, be sure to read all the data before closing the pipe.
+Closing the read end of a pipe before the process writing to it at the
+other end is done writing results in the writer receiving a SIGPIPE. If
+the other end can't handle that, be sure to read all the data before
+closing the pipe.
Example:
=item connect SOCKET,NAME
X<connect>
-Attempts to connect to a remote socket, just as the connect system call
-does. Returns true if it succeeded, false otherwise. NAME should be a
+Attempts to connect to a remote socket, just like connect(2).
+Returns true if it succeeded, false otherwise. NAME should be a
packed address of the appropriate type for the socket. See the examples in
L<perlipc/"Sockets: Client/Server Communication">.
statement).
C<last>, C<next>, or C<redo> may appear within a C<continue>
-block. C<last> and C<redo> will behave as if they had been executed within
+block; C<last> and C<redo> behave as if they had been executed within
the main block. So will C<next>, but since it will execute a C<continue>
block, it may be more entertaining.
}
### last always comes here
-Omitting the C<continue> section is semantically equivalent to using an
-empty one, logically enough. In that case, C<next> goes directly back
+Omitting the C<continue> section is equivalent to using an
+empty one, logically enough, so C<next> goes directly back
to check the condition at the top of the loop.
-If the "switch" feature is enabled, C<continue> is also a
-function that will break out of the current C<when> or C<default>
-block, and fall through to the next case. See L<feature> and
+If the C<"switch"> feature is enabled, C<continue> is also a
+function that exits the current C<when> (or C<default>) block and
+falls through to the next one. See L<feature> and
L<perlsyn/"Switch statements"> for more information.
the salt, followed by 11 bytes from the set C<[./0-9A-Za-z]>, and only
the first eight bytes of PLAINTEXT mattered. But alternative
hashing schemes (like MD5), higher level security schemes (like C2),
-and implementations on non-UNIX platforms may produce different
+and implementations on non-Unix platforms may produce different
strings.
When choosing a new salt create a random two character string whose
is the name of the database (without the F<.dir> or F<.pag> extension if
any). If the database does not exist, it is created with protection
specified by MASK (as modified by the C<umask>). If your system supports
-only the older DBM functions, you may perform only one C<dbmopen> in your
+only the older DBM functions, you may make only one C<dbmopen> call in your
program. In older versions of Perl, if your system had neither DBM nor
ndbm, calling C<dbmopen> produced a fatal error; it now falls back to
sdbm(3).
If you don't have write access to the DBM file, you can only read hash
variables, not set them. If you want to test whether you can write,
-either use file tests or try setting a dummy hash entry inside an C<eval>,
-which will trap the error.
+either use file tests or try setting a dummy hash entry inside an C<eval>
+to trap the error.
Note that functions such as C<keys> and C<values> may return huge lists
when used on large DBM files. You may prefer to use the C<each>
=item defined
Returns a Boolean value telling whether EXPR has a value other than
-the undefined value C<undef>. If EXPR is not present, C<$_> will be
+the undefined value C<undef>. If EXPR is not present, C<$_> is
checked.
Many operations return C<undef> to indicate failure, end of file,
You may also use C<defined(&func)> to check whether subroutine C<&func>
has ever been defined. The return value is unaffected by any forward
-declarations of C<&func>. Note that a subroutine which is not defined
+declarations of C<&func>. A subroutine that is not defined
may still be callable: its package may have an C<AUTOLOAD> method that
-makes it spring into existence the first time that it is called -- see
+makes it spring into existence the first time that it is called; see
L<perlsub>.
Use of C<defined> on aggregates (hashes and arrays) is deprecated. It
"ab" =~ /a(.*)b/;
-The pattern match succeeds, and C<$1> is defined, despite the fact that it
+The pattern match succeeds and C<$1> is defined, although it
matched "nothing". It didn't really fail to match anything. Rather, it
matched something that happened to be zero characters long. This is all
very above-board and honest. When a function returns an undefined value,
it's an admission that it couldn't give you an honest answer. So you
-should use C<defined> only when you're questioning the integrity of what
+should use C<defined> only when questioning the integrity of what
you're trying to do. At other times, a simple comparison to C<0> or C<""> is
what you want.
=item delete EXPR
X<delete>
-Given an expression that specifies a hash element, array element, hash slice,
-or array slice, deletes the specified element(s) from the hash or array.
-In the case of an array, if the array elements happen to be at the end,
-the size of the array will shrink to the highest element that tests
-true for exists() (or 0 if no such element exists).
+Given an expression that specifies an element or slice of a hash, C<delete>
+deletes the specified elements from that hash so that exists() on that element
+no longer returns true. Setting a hash element to the undefined value does
+not remove its key, but deleting it does; see L</exists>.
+
+It returns the value or values deleted in list context, or the last such
+element in scalar context. The return list's length always matches that of
+the argument list: deleting non-existent elements returns the undefined value
+in their corresponding positions.
-Returns a list with the same number of elements as the number of elements
-for which deletion was attempted. Each element of that list consists of
-either the value of the element deleted, or the undefined value. In scalar
-context, this means that you get the value of the last element deleted (or
-the undefined value if that element did not exist).
+delete() may also be used on arrays and array slices, but its behavior is less
+straightforward. Although exists() will return false for deleted entries,
+deleting array elements never changes indices of existing values; use shift()
+or splice() for that. However, if all deleted elements fall at the end of an
+array, the array's size shrinks to the position of the highest element that
+still tests true for exists(), or to 0 if none do.
+
+B<Be aware> that calling delete on array values is deprecated and likely to
+be removed in a future version of Perl.
+
+Deleting from C<%ENV> modifies the environment. Deleting from a hash tied to
+a DBM file deletes the entry from the DBM file. Deleting from a C<tied> hash
+or array may not necessarily return anything; it depends on the implementation
+of the C<tied> package's DELETE method, which may do whatever it pleases.
+
+The C<delete local EXPR> construct localizes the deletion to the current
+block at run time. Until the block exits, elements locally deleted
+temporarily no longer exist. See L<perlsub/"Localized deletion of elements
+of composite types">.
%hash = (foo => 11, bar => 22, baz => 33);
$scalar = delete $hash{foo}; # $scalar is 11
$scalar = delete @hash{qw(foo bar)}; # $scalar is 22
@array = delete @hash{qw(foo bar baz)}; # @array is (undef,undef,33)
-Deleting from C<%ENV> modifies the environment. Deleting from
-a hash tied to a DBM file deletes the entry from the DBM file. Deleting
-from a C<tie>d hash or array may not necessarily return anything.
-
-Deleting an array element effectively returns that position of the array
-to its initial, uninitialized state. Subsequently testing for the same
-element with exists() will return false. Also, deleting array elements
-in the middle of an array will not shift the index of the elements
-after them down. Use splice() for that. See L</exists>.
-
The following (inefficiently) deletes all the values of %HASH and @ARRAY:
foreach $key (keys %HASH) {
delete @ARRAY[0 .. $#ARRAY];
-But both of these are slower than just assigning the empty list
-or undefining %HASH or @ARRAY:
+But both are slower than assigning the empty list
+or undefining %HASH or @ARRAY, which is the customary
+way to empty out an aggregate:
%HASH = (); # completely empty %HASH
undef %HASH; # forget %HASH ever existed
@ARRAY = (); # completely empty @ARRAY
undef @ARRAY; # forget @ARRAY ever existed
-Note that the EXPR can be arbitrarily complicated as long as the final
-operation is a hash element, array element, hash slice, or array slice
-lookup:
+The EXPR can be arbitrarily complicated provided its
+final operation is an element or slice of an aggregate:
delete $ref->[$x][$y]{$key};
delete @{$ref->[$x][$y]}{$key1, $key2, @morekeys};
delete $ref->[$x][$y][$index];
delete @{$ref->[$x][$y]}[$index1, $index2, @moreindices];
-The C<delete local EXPR> construct can also be used to localize the deletion
-of array/hash elements to the current block.
-See L<perlsub/"Localized deletion of elements of composite types">.
-
=item die LIST
X<die> X<throw> X<exception> X<raise> X<$@> X<abort>
If the output is empty and C<$@> contains an object reference that has a
C<PROPAGATE> method, that method will be called with additional file
and line number parameters. The return value replaces the value in
-C<$@>. i.e. as if C<< $@ = eval { $@->PROPAGATE(__FILE__, __LINE__) }; >>
+C<$@>. i.e., as if C<< $@ = eval { $@->PROPAGATE(__FILE__, __LINE__) }; >>
were called.
If C<$@> is empty then the string C<"Died"> is used.
-die() can also be called with a reference argument. If this happens to be
-trapped within an eval(), $@ contains the reference. This behavior permits
-a more elaborate exception handling implementation using objects that
-maintain arbitrary state about the nature of the exception. Such a scheme
-is sometimes preferable to matching particular string values of $@ using
-regular expressions. Because $@ is a global variable, and eval() may be
-used within object implementations, care must be taken that analyzing the
-error object doesn't replace the reference in the global variable. The
-easiest solution is to make a local copy of the reference before doing
-other manipulations. Here's an example:
+You can also call C<die> with a reference argument, and if this is trapped
+within an C<eval>, C<$@> contains that reference. This permits more
+elaborate exception handling using objects that maintain arbitrary state
+about the exception. Such a scheme is sometimes preferable to matching
+particular string values of C<$@> with regular expressions. Because C<$@>
+is a global variable and C<eval> may be used within object implementations,
+be careful that analyzing the error object doesn't replace the reference in
+the global variable. It's easiest to make a local copy of the reference
+before any manipulations. Here's an example:
- use Scalar::Util 'blessed';
+ use Scalar::Util "blessed";
eval { ... ; die Some::Module::Exception->new( FOO => "bar" ) };
if (my $ev_err = $@) {
}
}
-Because perl will stringify uncaught exception messages before displaying
-them, you may want to overload stringification operations on such custom
+Because Perl stringifies uncaught exception messages before display,
+you'll probably want to overload stringification operations on
exception objects. See L<overload> for details about that.
You can arrange for a callback to be run just before the C<die>
does its deed, by setting the C<$SIG{__DIE__}> hook. The associated
-handler will be called with the error text and can change the error
+handler is called with the error text and can change the error
message, if it sees fit, by calling C<die> again. See
L<perlvar/$SIG{expr}> for details on setting C<%SIG> entries, and
L<"eval BLOCK"> for some examples. Although this feature was
to be run only right before your program was to exit, this is not
-currently the case--the C<$SIG{__DIE__}> hook is currently called
+currently so: the C<$SIG{__DIE__}> hook is currently called
even inside eval()ed blocks/strings! If one wants the hook to do
nothing in such situations, put
successfully compiled, C<do> returns the value of the last expression
evaluated.
-Note that inclusion of library modules is better done with the
+Inclusion of library modules is better done with the
C<use> and C<require> operators, which also do automatic error checking
and raise an exception if there's a problem.
B<WARNING>: Any files opened at the time of the dump will I<not>
be open any more when the program is reincarnated, with possible
-resulting confusion on the part of Perl.
+resulting confusion by Perl.
This function is now largely obsolete, mostly because it's very hard to
convert a core file into an executable. That's why you should now invoke
=item each ARRAY
X<array, iterator>
-When called in list context, returns a 2-element list consisting of the
-key and value for the next element of a hash, or the index and value for
-the next element of an array, so that you can iterate over it. When called
-in scalar context, returns only the key for the next element in the hash
-(or the index for an array).
+When called in list context, returns a 2-element list consisting of the key
+and value for the next element of a hash, or the index and value for the
+next element of an array, so that you can iterate over it. When called in
+scalar context, returns only the key (not the value) in a hash, or the index
+in an array.
Hash entries are returned in an apparently random order. The actual random
-order is subject to change in future versions of perl, but it is
+order is subject to change in future versions of Perl, but it is
guaranteed to be in the same order as either the C<keys> or C<values>
function would produce on the same (unmodified) hash. Since Perl
5.8.2 the ordering can be different even between different runs of Perl
for security reasons (see L<perlsec/"Algorithmic Complexity Attacks">).
-When the hash or array is entirely read, a null array is returned in list
-context (which when assigned produces a false (C<0>) value), and C<undef> in
-scalar context. The next call to C<each> after that will start iterating
-again. There is a single iterator for each hash or array, shared by all
-C<each>, C<keys>, and C<values> function calls in the program; it can be
-reset by reading all the elements from the hash or array, or by evaluating
-C<keys HASH>, C<values HASH>, C<keys ARRAY>, or C<values ARRAY>. If you add
-or delete elements of a hash while you're
-iterating over it, you may get entries skipped or duplicated, so
-don't. Exception: It is always safe to delete the item most recently
-returned by C<each()>, which means that the following code will work:
+After C<each> has returned all entries from the hash or array, the next
+call to C<each> returns the empty list in list context and C<undef> in
+scalar context. The next call following that one restarts iteration. Each
+hash or array has its own internal iterator, accessed by C<each>, C<keys>,
+and C<values>. The iterator is implicitly reset when C<each> has reached
+the end as just described; it can be explicitly reset by calling C<keys> or
+C<values> on the hash or array. If you add or delete a hash's elements
+while iterating over it, entries may be skipped or duplicated--so don't do
+that. Exception: It is always safe to delete the item most recently
+returned by C<each()>, so the following code works properly:
while (($key, $value) = each %hash) {
print $key, "\n";
delete $hash{$key}; # This is safe
}
-The following prints out your environment like the printenv(1) program,
-only in a different order:
+This prints out your environment like the printenv(1) program,
+but in a different order:
while (($key,$value) = each %ENV) {
print "$key=$value\n";
Returns 1 if the next read on FILEHANDLE will return end of file, or if
FILEHANDLE is not open. FILEHANDLE may be an expression whose value
gives the real filehandle. (Note that this function actually
-reads a character and then C<ungetc>s it, so isn't very useful in an
+reads a character and then C<ungetc>s it, so isn't useful in an
interactive context.) Do not read from a terminal file (or call
C<eof(FILEHANDLE)> on it) after end-of-file is reached. File types such
as terminals may lose the end-of-file condition if you do.
An C<eof> without an argument uses the last file read. Using C<eof()>
-with empty parentheses is very different. It refers to the pseudo file
+with empty parentheses is different. It refers to the pseudo file
formed from the files listed on the command line and accessed via the
C<< <> >> operator. Since C<< <> >> isn't explicitly opened,
as a normal filehandle is, an C<eof()> before C<< <> >> has been
see L<perlop/"I/O Operators">.
In a C<< while (<>) >> loop, C<eof> or C<eof(ARGV)> can be used to
-detect the end of each file, C<eof()> will only detect the end of the
+detect the end of each file, C<eof()> will detect the end of only the
last file. Examples:
# reset line numbering on each input file
If there is a syntax error or runtime error, or a C<die> statement is
executed, C<eval> returns an undefined value in scalar context
or an empty list in list context, and C<$@> is set to the
-error message. If there was no error, C<$@> is guaranteed to be a null
-string. Beware that using C<eval> neither silences perl from printing
+error message. If there was no error, C<$@> is guaranteed to be the empty
+string. Beware that using C<eval> neither silences Perl from printing
warnings to STDERR, nor does it stuff the text of warning messages into C<$@>.
To do either of those, you have to use the C<$SIG{__WARN__}> facility, or
turn off warnings inside the BLOCK or EXPR using S<C<no warnings 'all'>>.
issues. Due to the current arguably broken state of C<__DIE__> hooks, you
may wish not to trigger any C<__DIE__> hooks that user code may have installed.
You can use the C<local $SIG{__DIE__}> construct for this purpose,
-as shown in this example:
+as this example shows:
- # a very private exception trap for divide-by-zero
+ # a private exception trap for divide-by-zero
eval { local $SIG{'__DIE__'}; $answer = $a / $b; };
warn $@ if $@;
C<eval BLOCK> does I<not> count as a loop, so the loop control statements
C<next>, C<last>, or C<redo> cannot be used to leave or restart the block.
-Note that as a very special case, an C<eval ''> executed within the C<DB>
-package doesn't see the usual surrounding lexical scope, but rather the
-scope of the first non-DB piece of code that called it. You don't normally
-need to worry about this unless you are writing a Perl debugger.
+An C<eval ''> executed within the C<DB> package doesn't see the usual
+surrounding lexical scope, but rather the scope of the first non-DB piece
+of code that called it. You don't normally need to worry about this unless
+you are writing a Perl debugger.
=item exec LIST
X<exec> X<execute>
=item exec PROGRAM LIST
-The C<exec> function executes a system command I<and never returns>--
+The C<exec> function executes a system command I<and never returns>;
use C<system> instead of C<exec> if you want it to return. It fails and
returns false only if the command does not exist I<and> it is executed
directly instead of via your system's command shell (see below).
Since it's a common mistake to use C<exec> instead of C<system>, Perl
-warns you if there is a following statement which isn't C<die>, C<warn>,
-or C<exit> (if C<-w> is set - but you always do that). If you
+warns you if there is a following statement that isn't C<die>, C<warn>,
+or C<exit> (if C<-w> is set--but you always do that, right?). If you
I<really> want to follow an C<exec> with some other statement, you
can use one of these styles to avoid the warning:
exec {'/bin/csh'} '-sh'; # pretend it's a login shell
-When the arguments get executed via the system shell, results will
-be subject to its quirks and capabilities. See L<perlop/"`STRING`">
+When the arguments get executed via the system shell, results are
+subject to its quirks and capabilities. See L<perlop/"`STRING`">
for details.
Using an indirect object with C<exec> or C<system> is also more
exec { $args[0] } @args; # safe even with one-arg list
The first version, the one without the indirect object, ran the I<echo>
-program, passing it C<"surprise"> an argument. The second version
-didn't--it tried to run a program literally called I<"echo surprise">,
-didn't find it, and set C<$?> to a non-zero value indicating failure.
+program, passing it C<"surprise"> an argument. The second version didn't;
+it tried to run a program named I<"echo surprise">, didn't find it, and set
+C<$?> to a non-zero value indicating failure.
-Beginning with v5.6.0, Perl will attempt to flush all files opened for
+Beginning with v5.6.0, Perl attempts to flush all files opened for
output before the exec, but this may not be supported on some platforms
(see L<perlport>). To be safe, you may need to set C<$|> ($AUTOFLUSH
in English) or call the C<autoflush()> method of C<IO::Handle> on any
-open handles in order to avoid lost output.
+open handles to avoid lost output.
-Note that C<exec> will not call your C<END> blocks, nor will it call
-any C<DESTROY> methods in your objects.
+Note that C<exec> will not call your C<END> blocks, nor will it invoke
+C<DESTROY> methods on your objects.
=item exists EXPR
X<exists> X<autovivification>
-Given an expression that specifies a hash element or array element,
-returns true if the specified element in the hash or array has ever
-been initialized, even if the corresponding value is undefined.
+Given an expression that specifies an element of a hash, returns true if the
+specified element in the hash has ever been initialized, even if the
+corresponding value is undefined.
print "Exists\n" if exists $hash{$key};
print "Defined\n" if defined $hash{$key};
print "True\n" if $hash{$key};
+exists may also be called on array elements, but its behavior is much less
+obvious, and is strongly tied to the use of L</delete> on arrays. B<Be aware>
+that calling exists on array values is deprecated and likely to be removed in
+a future version of Perl.
+
print "Exists\n" if exists $array[$index];
print "Defined\n" if defined $array[$index];
print "True\n" if $array[$index];
Given an expression that specifies the name of a subroutine,
returns true if the specified subroutine has ever been declared, even
if it is undefined. Mentioning a subroutine name for exists or defined
-does not count as declaring it. Note that a subroutine which does not
+does not count as declaring it. Note that a subroutine that does not
exist may still be callable: its package may have an C<AUTOLOAD>
method that makes it spring into existence the first time that it is
-called -- see L<perlsub>.
+called; see L<perlsub>.
print "Exists\n" if exists &subroutine;
print "Defined\n" if defined &subroutine;
if (exists &{$ref->{A}{B}{$key}}) { }
-Although the deepest nested array or hash will not spring into existence
-just because its existence was tested, any intervening ones will.
+Although the mostly deeply nested array or hash will not spring into
+existence just because its existence was tested, any intervening ones will.
Thus C<< $ref->{"A"} >> and C<< $ref->{"A"}->{"B"} >> will spring
into existence due to the existence test for the $key element above.
-This happens anywhere the arrow operator is used, including even:
+This happens anywhere the arrow operator is used, including even here:
undef $ref;
if (exists $ref->{"Some key"}) { }
use Fcntl;
first to get the correct constant definitions. Argument processing and
-value return works just like C<ioctl> below.
+value returned work just like C<ioctl> below.
For example:
use Fcntl;
in numeric context. It is also exempt from the normal B<-w> warnings
on improper numeric conversions.
-Note that C<fcntl> will produce a fatal error if used on a machine that
+Note that C<fcntl> raises an exception if used on a machine that
doesn't implement fcntl(2). See the Fcntl module or your fcntl(2)
manpage to learn what functions are available on your system.
for success, false on failure. Produces a fatal error if used on a
machine that doesn't implement flock(2), fcntl(2) locking, or lockf(3).
C<flock> is Perl's portable file locking interface, although it locks
-only entire files, not records.
+entire files only, not records.
Two potentially non-obvious but traditional C<flock> semantics are
that it waits indefinitely until the lock is granted, and that its locks
either individually, or as a group using the ':flock' tag. LOCK_SH
requests a shared lock, LOCK_EX requests an exclusive lock, and LOCK_UN
releases a previously requested lock. If LOCK_NB is bitwise-or'ed with
-LOCK_SH or LOCK_EX then C<flock> will return immediately rather than blocking
-waiting for the lock (check the return status to see if you got it).
+LOCK_SH or LOCK_EX then C<flock> returns immediately rather than blocking
+waiting for the lock; check the return status to see if you got it.
To avoid the possibility of miscoordination, Perl now flushes FILEHANDLE
before locking or unlocking it.
that. If you like you can force Perl to ignore your system's flock(2)
function, and so provide its own fcntl(2)-based emulation, by passing
the switch C<-Ud_flock> to the F<Configure> program when you configure
-perl.
+Perl.
Here's a mailbox appender for BSD systems.
print $mbox $msg,"\n\n";
unlock($mbox);
-On systems that support a real flock(), locks are inherited across fork()
-calls, whereas those that must resort to the more capricious fcntl()
-function lose the locks, making it harder to write servers.
+On systems that support a real flock(2), locks are inherited across fork()
+calls, whereas those that must resort to the more capricious fcntl(2)
+function lose their locks, making it seriously harder to write servers.
See also L<DB_File> for other flock() examples.
example, using copy-on-write technology on data pages), making it the
dominant paradigm for multitasking over the last few decades.
-Beginning with v5.6.0, Perl will attempt to flush all files opened for
+Beginning with v5.6.0, Perl attempts to flush all files opened for
output before forking the child process, but this may not be supported
on some platforms (see L<perlport>). To be safe, you may need to set
C<$|> ($AUTOFLUSH in English) or call the C<autoflush()> method of
-C<IO::Handle> on any open handles in order to avoid duplicate output.
+C<IO::Handle> on any open handles to avoid duplicate output.
If you C<fork> without ever waiting on your children, you will
accumulate zombies. On some systems, you can avoid this by setting
and then set C<$^A> back to C<"">. Note that a format typically
does one C<formline> per line of form, but the C<formline> function itself
doesn't care how many newlines are embedded in the PICTURE. This means
-that the C<~> and C<~~> tokens will treat the entire PICTURE as a single line.
+that the C<~> and C<~~> tokens treat the entire PICTURE as a single line.
You may therefore need to use multiple formlines to implement a single
-record format, just like the format compiler.
+record format, just like the C<format> compiler.
Be careful if you put double quotes around the picture, because an C<@>
character may be taken to mean the beginning of an array name.
=item getc
Returns the next character from the input file attached to FILEHANDLE,
-or the undefined value at end of file, or if there was an error (in
+or the undefined value at end of file or if there was an error (in
the latter case C<$!> is set). If FILEHANDLE is omitted, reads from
STDIN. This is not particularly efficient. However, it cannot be
used by itself to fetch single characters without waiting for the user
system "stty -cbreak </dev/tty >/dev/tty 2>&1";
}
else {
- system "stty", 'icanon', 'eol', '^@'; # ASCII null
+ system 'stty', 'icanon', 'eol', '^@'; # ASCII NUL
}
print "\n";
X<getlogin> X<login>
This implements the C library function of the same name, which on most
-systems returns the current login from F</etc/utmp>, if any. If null,
-use C<getpwuid>.
+systems returns the current login from F</etc/utmp>, if any. If it
+returns the empty string, use C<getpwuid>.
$login = getlogin || getpwuid($<) || "Kilroy";
Note for Linux users: on Linux, the C functions C<getpid()> and
C<getppid()> return different values from different threads. In order to
-be portable, this behavior is not reflected by the perl-level function
+be portable, this behavior is not reflected by the Perl-level function
C<getppid()>, that returns a consistent value across threads. If you want
to call the underlying C<getppid()>, you may use the CPAN module
C<Linux::Pid>.
=item endservent
-These routines perform the same functions as their counterparts in the
-system library. In list context, the return values from the
+These routines are the same as their counterparts in the
+system C library. In list context, the return values from the
various get routines are as follows:
($name,$passwd,$uid,$gid,
($name,$aliases,$proto) = getproto*
($name,$aliases,$port,$proto) = getserv*
-(If the entry doesn't exist you get a null list.)
+(If the entry doesn't exist you get an empty list.)
The exact meaning of the $gcos field varies but it usually contains
the real name of the user (as opposed to the login name) and other
#etc.
In I<getpw*()> the fields $quota, $comment, and $expire are special
-cases in the sense that in many systems they are unsupported. If the
+in that they are unsupported on many systems. If the
$quota is unsupported, it is an empty scalar. If it is supported, it
usually encodes the disk quota. If the $comment field is unsupported,
it is an empty scalar. If it is supported it usually encodes some
$quota and $comment fields mean and whether you have the $expire field
by using the C<Config> module and the values C<d_pwquota>, C<d_pwage>,
C<d_pwchange>, C<d_pwcomment>, and C<d_pwexpire>. Shadow password
-files are only supported if your vendor has implemented them in the
+files are supported only if your vendor has implemented them in the
intuitive fashion that calling the regular C library routines gets the
shadow versions if you're running under privilege or if there exists
the shadow(3) functions as found in System V (this includes Solaris
For the I<gethost*()> functions, if the C<h_errno> variable is supported in
C, it will be returned to you via C<$?> if the function call fails. The
-C<@addrs> value returned by a successful call is a list of the raw
-addresses returned by the corresponding system library call. In the
-Internet domain, each address is four bytes long and you can unpack it
+C<@addrs> value returned by a successful call is a list of raw
+addresses returned by the corresponding library call. In the
+Internet domain, each address is four bytes long; you can unpack it
by saying something like:
($a,$b,$c,$d) = unpack('W4',$addr[0]);
protocol number of the appropriate protocol controlling the option
should be supplied. For example, to indicate that an option is to be
interpreted by the TCP protocol, LEVEL should be set to the protocol
-number of TCP, which you can get using getprotobyname.
+number of TCP, which you can get using C<getprotobyname>.
-The call returns a packed string representing the requested socket option,
-or C<undef> if there is an error (the error reason will be in $!). What
-exactly is in the packed string depends in the LEVEL and OPTNAME, consult
-your system documentation for details. A very common case however is that
-the option is an integer, in which case the result will be a packed
-integer which you can decode using unpack with the C<i> (or C<I>) format.
+The function returns a packed string representing the requested socket
+option, or C<undef> on error, with the reason for the error placed in
+C<$!>). Just what is in the packed string depends on LEVEL and OPTNAME;
+consult getsockopt(2) for details. A common case is that the option is an
+integer, in which case the result is a packed integer, which you can decode
+using C<unpack> with the C<i> (or C<I>) format.
-An example testing if Nagle's algorithm is turned on on a socket:
+An example to test whether Nagle's algorithm is turned on on a socket:
use Socket qw(:all);
or die "Could not determine the protocol number for tcp";
# my $tcp = IPPROTO_TCP; # Alternative
my $packed = getsockopt($socket, $tcp, TCP_NODELAY)
- or die "Could not query TCP_NODELAY socket option: $!";
+ or die "getsockopt TCP_NODELAY: $!";
my $nodelay = unpack("I", $packed);
print "Nagle's algorithm is turned ", $nodelay ? "off\n" : "on\n";
EXPR is omitted, C<$_> is used. The C<< <*.c> >> operator is discussed in
more detail in L<perlop/"I/O Operators">.
-Note that C<glob> will split its arguments on whitespace, treating
-each segment as separate pattern. As such, C<glob('*.c *.h')> would
-match all files with a F<.c> or F<.h> extension. The expression
-C<glob('.* *')> would match all files in the current working directory.
+Note that C<glob> splits its arguments on whitespace and treats
+each segment as separate pattern. As such, C<glob("*.c *.h")>
+matches all files with a F<.c> or F<.h> extension. The expression
+C<glob(".* *")> matchs all files in the current working directory.
+
+If non-empty braces are the only wildcard characters used in the
+C<glob>, no filenames are matched, but potentially many strings
+are returned. For example, this produces nine strings, one for
+each pairing of fruits and colors:
+
+ @many = glob "{apple,tomato,cherry}={green,yellow,red}";
Beginning with v5.6.0, this operator is implemented using the standard
C<File::Glob> extension. See L<File::Glob> for details, including
else within the dynamic scope, including out of subroutines, but it's
usually better to use some other construct such as C<last> or C<die>.
The author of Perl has never felt the need to use this form of C<goto>
-(in Perl, that is--C is another matter). (The difference being that C
+(in Perl, that is; C is another matter). (The difference is that C
does not offer named loops combined with loop control. Perl does, and
this replaces most structured uses of C<goto> in other languages.)
If C<$_> is lexical in the scope where the C<grep> appears (because it has
been declared with C<my $_>) then, in addition to being locally aliased to
-the list elements, C<$_> keeps being lexical inside the block; i.e. it
+the list elements, C<$_> keeps being lexical inside the block; i.e., it
can't be seen from the outside, avoiding any potential side-effects.
See also L</map> for a list composed of the results of the BLOCK or EXPR.
Returns the integer portion of EXPR. If EXPR is omitted, uses C<$_>.
You should not use this function for rounding: one because it truncates
-towards C<0>, and two because machine representations of floating point
+towards C<0>, and two because machine representations of floating-point
numbers can sometimes produce counterintuitive results. For example,
C<int(-6.725/0.025)> produces -268 rather than the correct -269; that's
because it's really more like -268.99999999999994315658 instead. Usually,
own, based on your C header files such as F<< <sys/ioctl.h> >>.
(There is a Perl script called B<h2ph> that comes with the Perl kit that
may help you in this, but it's nontrivial.) SCALAR will be read and/or
-written depending on the FUNCTION--a pointer to the string value of SCALAR
+written depending on the FUNCTION; a C pointer to the string value of SCALAR
will be passed as the third argument of the actual C<ioctl> call. (If SCALAR
has no string value but does have a numeric value, that value will be
passed rather than a pointer to the string value. To guarantee this to be
of an array. (In scalar context, returns the number of keys or indices.)
The keys of a hash are returned in an apparently random order. The actual
-random order is subject to change in future versions of perl, but it
+random order is subject to change in future versions of Perl, but it
is guaranteed to be the same order as either the C<values> or C<each>
function produces (given that the hash has not been modified). Since
Perl 5.8.1 the ordering is different even between different runs of
printf "%4d %s\n", $hash{$key}, $key;
}
-As an lvalue C<keys> allows you to increase the number of hash buckets
+Used as an lvalue, C<keys> allows you to increase the number of hash buckets
allocated for the given hash. 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
$cnt = kill 1, $child1, $child2;
kill 9, @goners;
-If SIGNAL is zero, no signal is sent to the process, but the kill(2)
-system call will check whether it's possible to send a signal to it (that
+If SIGNAL is zero, no signal is sent to the process, but C<kill>
+checks whether it's I<possible> to send a signal to it (that
means, to be brief, that the process is owned by the same user, or we are
-the super-user). This is a useful way to check that a child process is
+the super-user). This is useful to check that a child process is still
alive (even if only as a zombie) and hasn't changed its UID. See
L<perlport> for notes on the portability of this construct.
#...
}
-C<last> cannot be used to exit a block which returns a value such as
+C<last> cannot be used to exit a block that returns a value such as
C<eval {}>, C<sub {}> or C<do {}>, and should not be used to exit
a grep() or map() operation.
Returns the length in I<characters> of the value of EXPR. If EXPR is
omitted, returns length of C<$_>. If EXPR is undefined, returns C<undef>.
-Note that this cannot be used on an entire array or hash to find out how
-many elements these have. For that, use C<scalar @array> and C<scalar keys
-%hash> respectively.
-
-Note the I<characters>: if the EXPR is in Unicode, you will get the
-number of characters, not the number of bytes. To get the length
-of the internal string in bytes, use C<bytes::length(EXPR)>, see
-L<bytes>. Note that the internal encoding is variable, and the number
-of bytes usually meaningless. To get the number of bytes that the
-string would have when encoded as UTF-8, use
-C<length(Encoding::encode_utf8(EXPR))>.
+
+This function cannot be used on an entire array or hash to find out how
+many elements these have. For that, use C<scalar @array> and C<scalar keys
+%hash>, respectively.
+
+Like all Perl character operations, length() normally deals in logical
+characters, not physical bytes. For how many bytes a string encoded as
+UTF-8 would take up, use C<length(Encode::encode_utf8(EXPR))> (you'll have
+to C<use Encode> first). See L<Encode> and L<perlunicode>.
=item link OLDFILE,NEWFILE
X<link>
=item listen SOCKET,QUEUESIZE
X<listen>
-Does the same thing that the listen system call does. Returns true if
+Does the same thing that the listen(2) system call does. Returns true if
it succeeded, false otherwise. See the example in
L<perlipc/"Sockets: Client/Server Communication">.
C<$year> is the number of years since 1900, not just the last two digits
of the year. That is, C<$year> is C<123> in year 2023. The proper way
-to get a complete 4-digit year is simply:
+to get a 4-digit year is simply:
$year += 1900;
lock() is a "weak keyword" : this means that if you've defined a function
by this name (before any calls to it), that function will be called
-instead. (However, if you've said C<use threads>, lock() is always a
-keyword.) See L<threads>.
+instead. If you are not under C<use threads::shared> this does nothing.
+See L<threads::shared>.
=item log EXPR
X<log> X<logarithm> X<e> X<ln> X<base>
can't be seen from the outside, avoiding any potential side-effects.
C<{> starts both hash references and blocks, so C<map { ...> could be either
-the start of map BLOCK LIST or map EXPR, LIST. Because perl doesn't look
-ahead for the closing C<}> it has to take a guess at which its dealing with
-based what it finds just after the C<{>. Usually it gets it right, but if it
+the start of map BLOCK LIST or map EXPR, LIST. Because Perl doesn't look
+ahead for the closing C<}> it has to take a guess at which it's dealing with
+based on what it finds just after the C<{>. Usually it gets it right, but if it
doesn't it won't realize something is wrong until it gets to the C<}> and
encounters the missing (or unexpected) comma. The syntax error will be
-reported close to the C<}> but you'll need to change something near the C<{>
-such as using a unary C<+> to give perl some help:
+reported close to the C<}>, but you'll need to change something near the C<{>
+such as using a unary C<+> to give Perl some help:
- %hash = map { "\L$_", 1 } @array # perl guesses EXPR. wrong
- %hash = map { +"\L$_", 1 } @array # perl guesses BLOCK. right
- %hash = map { ("\L$_", 1) } @array # this also works
- %hash = map { lc($_), 1 } @array # as does this.
- %hash = map +( lc($_), 1 ), @array # this is EXPR and works!
+ %hash = map { "\L$_" => 1 } @array # perl guesses EXPR. wrong
+ %hash = map { +"\L$_" => 1 } @array # perl guesses BLOCK. right
+ %hash = map { ("\L$_" => 1) } @array # this also works
+ %hash = map { lc($_) => 1 } @array # as does this.
+ %hash = map +( lc($_) => 1 ), @array # this is EXPR and works!
- %hash = map ( lc($_), 1 ), @array # evaluates to (1, @array)
+ %hash = map ( lc($_), 1 ), @array # evaluates to (1, @array)
or to force an anon hash constructor use C<+{>:
- @hashes = map +{ lc($_), 1 }, @array # EXPR, so needs , at end
+ @hashes = map +{ lc($_) => 1 }, @array # EXPR, so needs comma at end
-and you get list of anonymous hashes each with only 1 entry.
+to get a list of anonymous hashes each with only one entry apiece.
=item mkdir FILENAME,MASK
X<mkdir> X<md> X<directory, create>
this right, so Perl automatically removes all trailing slashes to keep
everyone happy.
-In order to recursively create a directory structure look at
+To recursively create a directory structure, look at
the C<mkpath> function of the L<File::Path> module.
=item msgctl ID,CMD,ARG
}
Note that if there were a C<continue> block on the above, it would get
-executed even on discarded lines. If the LABEL is omitted, the command
+executed even on discarded lines. If LABEL is omitted, the command
refers to the innermost enclosing loop.
C<next> cannot be used to exit a block which returns a value such as
See also L</continue> for an illustration of how C<last>, C<next>, and
C<redo> work.
-=item no Module VERSION LIST
-X<no>
+=item no MODULE VERSION LIST
+X<no declarations>
+X<unimporting>
-=item no Module VERSION
+=item no MODULE VERSION
-=item no Module LIST
+=item no MODULE LIST
-=item no Module
+=item no MODULE
=item no VERSION
value. (If EXPR happens to start off with C<0x>, interprets it as a
hex string. If EXPR starts off with C<0b>, it is interpreted as a
binary string. Leading whitespace is ignored in all three cases.)
-The following will handle decimal, binary, octal, and hex in the standard
-Perl or C notation:
+The following will handle decimal, binary, octal, and hex in standard
+Perl notation:
$val = oct($val) if $val =~ /^0/;
If EXPR is omitted, uses C<$_>. To go the other way (produce a number
in octal), use sprintf() or printf():
- $perms = (stat("filename"))[2] & 07777;
- $oct_perms = sprintf "%lo", $perms;
+ $dec_perms = (stat("filename"))[2] & 07777;
+ $oct_perm_str = sprintf "%o", $perms;
The oct() function is commonly used when a string such as C<644> needs
-to be converted into a file mode, for example. (Although perl will
-automatically convert strings into numbers as needed, this automatic
-conversion assumes base 10.)
+to be converted into a file mode, for example. Although Perl
+automatically converts strings into numbers as needed, this automatic
+conversion assumes base 10.
+
+Leading white space is ignored without warning, as too are any trailing
+non-digits, such as a decimal point (C<oct> only handles non-negative
+integers, not negative integers or floating point).
=item open FILEHANDLE,EXPR
X<open> X<pipe> X<file, open> X<fopen>
using C<my>, specify EXPR in your call to open.)
If three or more arguments are specified then the mode of opening and
-the file name are separate. If MODE is C<< '<' >> or nothing, the file
+the filename are separate. If MODE is C<< '<' >> or nothing, the file
is opened for input. If MODE is C<< '>' >>, the file is truncated and
opened for output, being created if necessary. If MODE is C<<< '>>' >>>,
the file is opened for appending, again being created if necessary.
You can put a C<'+'> in front of the C<< '>' >> or C<< '<' >> to
indicate that you want both read and write access to the file; thus
-C<< '+<' >> is almost always preferred for read/write updates--the C<<
-'+>' >> mode would clobber the file first. You can't usually use
+C<< '+<' >> is almost always preferred for read/write updates--the
+C<< '+>' >> mode would clobber the file first. You can't usually use
either read-write mode for updating textfiles, since they have
variable length records. See the B<-i> switch in L<perlrun> for a
better approach. The file is created with permissions of C<0666>
-modified by the process' C<umask> value.
+modified by the process's C<umask> value.
These various prefixes correspond to the fopen(3) modes of C<'r'>,
C<'r+'>, C<'w'>, C<'w+'>, C<'a'>, and C<'a+'>.
-In the 2-arguments (and 1-argument) form of the call the mode and
-filename should be concatenated (in this order), possibly separated by
-spaces. It is possible to omit the mode in these forms if the mode is
+In the two-argument (and one-argument) form of the call, the mode and
+filename should be concatenated (in that order), possibly separated by
+spaces. You may omit the mode in these forms when that mode is
C<< '<' >>.
If the filename begins with C<'|'>, the filename is interpreted as a
command to which output is to be piped, and if the filename ends with a
-C<'|'>, the filename is interpreted as a command which pipes output to
+C<'|'>, the filename is interpreted as a command that pipes output to
us. See L<perlipc/"Using open() for IPC">
for more examples of this. (You are not allowed to C<open> to a command
that pipes both in I<and> out, but see L<IPC::Open2>, L<IPC::Open3>,
For three or more arguments if MODE is C<'|-'>, the filename is
interpreted as a command to which output is to be piped, and if MODE
-is C<'-|'>, the filename is interpreted as a command which pipes
-output to us. In the 2-arguments (and 1-argument) form one should
+is C<'-|'>, the filename is interpreted as a command that pipes
+output to us. In the two-argument (and one-argument) form, one should
replace dash (C<'-'>) with the command.
See L<perlipc/"Using open() for IPC"> for more examples of this.
(You are not allowed to C<open> to a command that pipes both in I<and>
out, but see L<IPC::Open2>, L<IPC::Open3>, and
L<perlipc/"Bidirectional Communication"> for alternatives.)
-In the three-or-more argument form of pipe opens, if LIST is specified
+In the form of pipe opens taking three or more arguments, if LIST is specified
(extra arguments after the command name) then LIST becomes arguments
to the command invoked if the platform supports it. The meaning of
C<open> with more than three arguments for non-pipe modes is not yet
-specified. Experimental "layers" may give extra LIST arguments
+defined, but experimental "layers" may give extra LIST arguments
meaning.
-In the 2-arguments (and 1-argument) form opening C<'-'> opens STDIN
-and opening C<< '>-' >> opens STDOUT.
+In the two-argument (and one-argument) form, opening C<< '<-' >>
+or C<'-'> opens STDIN and opening C<< '>-' >> opens STDOUT.
-You may use the three-argument form of open to specify IO "layers"
-(sometimes also referred to as "disciplines") to be applied to the handle
+You may use the three-argument form of open to specify I/O layers
+(sometimes referred to as "disciplines") to apply to the handle
that affect how the input and output are processed (see L<open> and
-L<PerlIO> for more details). For example
+L<PerlIO> for more details). For example:
- open(my $fh, "<:encoding(UTF-8)", "file")
+ open(my $fh, "<:encoding(UTF-8)", "filename")
+ || die "can't open UTF-8 encoded filename: $!";
-will open the UTF-8 encoded file containing Unicode characters,
+opens the UTF-8 encoded file containing Unicode characters;
see L<perluniintro>. Note that if layers are specified in the
-three-arg form then default layers stored in ${^OPEN} (see L<perlvar>;
+three-argument form, then default layers stored in ${^OPEN} (see L<perlvar>;
usually set by the B<open> pragma or the switch B<-CioD>) are ignored.
-Open returns nonzero upon success, the undefined value otherwise. If
+Open returns nonzero on success, the undefined value otherwise. If
the C<open> involved a pipe, the return value happens to be the pid of
the subprocess.
files and binary files, then you should check out L</binmode> for tips
for dealing with this. The key distinction between systems that need
C<binmode> and those that don't is their text file formats. Systems
-like Unix, Mac OS, and Plan 9, which delimit lines with a single
-character, and which encode that character in C as C<"\n">, do not
+like Unix, Mac OS, and Plan 9, that end lines with a single
+character and encode that character in C as C<"\n"> do not
need C<binmode>. The rest need it.
-When opening a file, it's usually a bad idea to continue normal execution
-if the request failed, so C<open> is frequently used in connection with
+When opening a file, it's seldom a good idea to continue
+if the request failed, so C<open> is frequently used with
C<die>. Even if C<die> won't do what you want (say, in a CGI script,
-where you want to make a nicely formatted error message (but there are
-modules that can help with that problem)) you should always check
-the return value from opening a file. The infrequent exception is when
-working with an unopened filehandle is actually what you want to do.
+where you want to format a suitable error message (but there are
+modules that can help with that problem)) always check
+the return value from opening a file.
As a special case the 3-arg form with a read/write mode and the third
argument being C<undef>:
to the temporary file first. You will need to seek() to do the
reading.
-Since v5.8.0, perl has built using PerlIO by default. Unless you've
-changed this (i.e. Configure -Uuseperlio), you can open file handles to
-"in memory" files held in Perl scalars via:
+Since v5.8.0, Perl has built using PerlIO by default. Unless you've
+changed this (i.e., Configure -Uuseperlio), you can open filehandles
+directly to Perl scalars via:
open($fh, '>', \$variable) || ..
-Though if you try to re-open C<STDOUT> or C<STDERR> as an "in memory"
-file, you have to close it first:
+To (re)open C<STDOUT> or C<STDERR> as an in-memory file, close it first:
close STDOUT;
open STDOUT, '>', \$variable or die "Can't open STDOUT: $!";
-Examples:
+General examples:
$ARTICLE = 100;
open ARTICLE or die "Can't find article $ARTICLE: $!\n";
open(EXTRACT, "|sort >Tmp$$") # $$ is our process id
or die "Can't start sort: $!";
- # in memory files
+ # in-memory files
open(MEMORY,'>', \$var)
or die "Can't open memory file: $!";
- print MEMORY "foo!\n"; # output will end up in $var
+ print MEMORY "foo!\n"; # output will appear in $var
# process argument list of files along with any includes
Note that if you are using Perls older than 5.8.0, Perl will be using
the standard C libraries' fdopen() to implement the "=" functionality.
-On many UNIX systems fdopen() fails when file descriptors exceed a
+On many Unix systems fdopen() fails when file descriptors exceed a
certain value, typically 255. For Perls 5.8.0 and later, PerlIO is
most often the default.
there is an implicit fork done, and the return value of open is the pid
of the child within the parent process, and C<0> within the child
process. (Use C<defined($pid)> to determine whether the open was successful.)
-The filehandle behaves normally for the parent, but i/o to that
+The filehandle behaves normally for the parent, but I/O to that
filehandle is piped from/to the STDOUT/STDIN of the child process.
-In the child process the filehandle isn't opened--i/o happens from/to
-the new STDOUT or STDIN. Typically this is used like the normal
+In the child process, the filehandle isn't opened--I/O happens from/to
+the new STDOUT/STDIN. Typically this is used like the normal
piped open when you want to exercise more control over just how the
-pipe command gets executed, such as when you are running setuid, and
-don't want to have to scan shell commands for metacharacters.
+pipe command gets executed, such as when running setuid and
+you don't want to have to scan shell commands for metacharacters.
+
The following triples are more or less equivalent:
open(FOO, "|tr '[a-z]' '[A-Z]'");
The last example in each block shows the pipe as "list form", which is
not yet supported on all platforms. A good rule of thumb is that if
your platform has true C<fork()> (in other words, if your platform is
-UNIX) you can use the list form.
+Unix) you can use the list form.
See L<perlipc/"Safe Pipe Opens"> for more examples of this.
open IN, $ARGV[0];
will allow the user to specify an argument of the form C<"rsh cat file |">,
-but will not work on a filename which happens to have a trailing space, while
+but will not work on a filename that happens to have a trailing space, while
open IN, '<', $ARGV[0];
given by the TEMPLATE. The resulting string is the concatenation of
the converted values. Typically, each converted value looks
like its machine-level representation. For example, on 32-bit machines
-an integer may be represented by a sequence of 4 bytes that will be
-converted to a sequence of 4 characters.
+an integer may be represented by a sequence of 4 bytes, which will in
+Perl be presented as a string that's 4 characters long.
See L<perlpacktut> for an introduction to this function.
a A string with arbitrary binary data, will be null padded.
A A text (ASCII) string, will be space padded.
- Z A null terminated (ASCIZ) string, will be null padded.
+ Z A null-terminated (ASCIZ) string, will be null padded.
b A bit string (ascending bit order inside each byte, like vec()).
B A bit string (descending bit order inside each byte).
c A signed char (8-bit) value.
C An unsigned char (octet) value.
- W An unsigned char value (can be greater than 255).
+ W An unsigned char value (can be greater than 255).
s A signed short (16-bit) value.
S An unsigned short value.
Q An unsigned quad value.
(Quads are available only if your system supports 64-bit
integer values _and_ if Perl has been compiled to support those.
- Causes a fatal error otherwise.)
+ Raises an exception otherwise.)
i A signed integer value.
I A unsigned integer value.
j A Perl internal signed integer value (IV).
J A Perl internal unsigned integer value (UV).
- f A single-precision float in the native format.
- d A double-precision float in the native format.
+ f A single-precision float in native format.
+ d A double-precision float in native format.
- F A Perl internal floating point value (NV) in the native format
- D A long double-precision float in the native format.
+ F A Perl internal floating-point value (NV) in native format
+ D A float of long-double precision in native format.
(Long doubles are available only if your system supports long
double values _and_ if Perl has been compiled to support those.
- Causes a fatal error otherwise.)
+ Raises an exception otherwise.)
p A pointer to a null-terminated string.
P A pointer to a structure (fixed-length string).
and UTF-8 (or UTF-EBCDIC in EBCDIC platforms) in byte mode.
w A BER compressed integer (not an ASN.1 BER, see perlpacktut for
- details). Its bytes represent an unsigned integer in base 128,
- most significant digit first, with as few digits as possible. Bit
- eight (the high bit) is set on each byte except the last.
+ details). Its bytes represent an unsigned integer in base 128,
+ most significant digit first, with as few digits as possible. Bit
+ eight (the high bit) is set on each byte except the last.
- x A null byte.
+ x A null byte (a.k.a ASCII NUL, "\000", chr(0))
X Back up a byte.
- @ Null fill or truncate to absolute position, counted from the
- start of the innermost ()-group.
- . Null fill or truncate to absolute position specified by value.
+ @ Null-fill or truncate to absolute position, counted from the
+ start of the innermost ()-group.
+ . Null-fill or truncate to absolute position specified by the value.
( Start of a ()-group.
-One or more of the modifiers below may optionally follow some letters in the
-TEMPLATE (the second column lists the letters for which the modifier is
-valid):
+One or more modifiers below may optionally follow certain letters in the
+TEMPLATE (the second column lists letters for which the modifier is valid):
! sSlLiI Forces native (short, long, int) sizes instead
of fixed (16-/32-bit) sizes.
< sSiIlLqQ Force little-endian byte-order on the type.
jJfFdDpP (The "little end" touches the construct.)
-The C<E<gt>> and C<E<lt>> modifiers can also be used on C<()>-groups,
-in which case they force a certain byte-order on all components of
-that group, including subgroups.
+The C<< > >> and C<< < >> modifiers can also be used on C<()> groups
+to force a particular byte-order on all components in that group,
+including all its subgroups.
The following rules apply:
-=over 8
+=over
=item *
-Each letter may optionally be followed by a number giving a repeat
-count. With all types except C<a>, C<A>, C<Z>, C<b>, C<B>, C<h>,
-C<H>, C<@>, C<.>, C<x>, C<X> and C<P> the pack function will gobble up
-that many values from the LIST. A C<*> for the repeat count means to
-use however many items are left, except for C<@>, C<x>, C<X>, where it
-is equivalent to C<0>, for <.> where it means relative to string start
-and C<u>, where it is equivalent to 1 (or 45, which is the same).
-A numeric repeat count may optionally be enclosed in brackets, as in
-C<pack 'C[80]', @arr>.
-
-One can replace the numeric repeat count by a template enclosed in brackets;
-then the packed length of this template in bytes is used as a count.
-For example, C<x[L]> skips a long (it skips the number of bytes in a long);
-the template C<$t X[$t] $t> unpack()s twice what $t unpacks.
-If the template in brackets contains alignment commands (such as C<x![d]>),
-its packed length is calculated as if the start of the template has the maximal
-possible alignment.
-
-When used with C<Z>, C<*> results in the addition of a trailing null
-byte (so the packed result will be one longer than the byte C<length>
-of the item).
+Each letter may optionally be followed by a number indicating the repeat
+count. A numeric repeat count may optionally be enclosed in brackets, as
+in C<pack("C[80]", @arr)>. The repeat count gobbles that many values from
+the LIST when used with all format types other than C<a>, C<A>, C<Z>, C<b>,
+C<B>, C<h>, C<H>, C<@>, C<.>, C<x>, C<X>, and C<P>, where it means
+something else, dscribed below. Supplying a C<*> for the repeat count
+instead of a number means to use however many items are left, except for:
+
+=over
+
+=item *
+
+C<@>, C<x>, and C<X>, where it is equivalent to C<0>.
+
+=item *
+
+<.>, where it means relative to the start of the string.
+
+=item *
+
+C<u>, where it is equivalent to 1 (or 45, which here is equivalent).
+
+=back
+
+One can replace a numeric repeat count with a template letter enclosed in
+brackets to use the packed byte length of the bracketed template for the
+repeat count.
+
+For example, the template C<x[L]> skips as many bytes as in a packed long,
+and the template C<"$t X[$t] $t"> unpacks twice whatever $t (when
+variable-expanded) unpacks. If the template in brackets contains alignment
+commands (such as C<x![d]>), its packed length is calculated as if the
+start of the template had the maximal possible alignment.
+
+When used with C<Z>, a C<*> as the repeat count is guaranteed to add a
+trailing null byte, so the resulting string is always one byte longer than
+the byte length of the item itself.
When used with C<@>, the repeat count represents an offset from the start
-of the innermost () group.
+of the innermost C<()> group.
+
+When used with C<.>, the repeat count determines the starting position to
+calculate the value offset as follows:
+
+=over
+
+=item *
+
+If the repeat count is C<0>, it's relative to the current position.
-When used with C<.>, the repeat count is used to determine the starting
-position from where the value offset is calculated. If the repeat count
-is 0, it's relative to the current position. If the repeat count is C<*>,
-the offset is relative to the start of the packed string. And if its an
-integer C<n> the offset is relative to the start of the n-th innermost
-() group (or the start of the string if C<n> is bigger then the group
-level).
+=item *
+
+If the repeat count is C<*>, the offset is relative to the start of the
+packed string.
+
+=item *
+
+And if it's an integer I<n>, the offset is relative to the start of the
+I<n>th innermost C<()> group, or to the start of the string if I<n> is
+bigger then the group level.
+
+=back
The repeat count for C<u> is interpreted as the maximal number of bytes
to encode per line of output, with 0, 1 and 2 replaced by 45. The repeat
=item *
The C<a>, C<A>, and C<Z> types gobble just one value, but pack it as a
-string of length count, padding with nulls or spaces as necessary. When
+string of length count, padding with nulls or spaces as needed. When
unpacking, C<A> strips trailing whitespace and nulls, C<Z> strips everything
-after the first null, and C<a> returns data verbatim.
+after the first null, and C<a> returns data without any sort of trimming.
-If the value-to-pack is too long, it is truncated. If too long and an
-explicit count is provided, C<Z> packs only C<$count-1> bytes, followed
-by a null byte. Thus C<Z> always packs a trailing null (except when the
-count is 0).
+If the value to pack is too long, the result is truncated. If it's too
+long and an explicit count is provided, C<Z> packs only C<$count-1> bytes,
+followed by a null byte. Thus C<Z> always packs a trailing null, except
+for when the count is 0.
=item *
-Likewise, the C<b> and C<B> fields pack a string that many bits long.
-Each character of the input field of pack() generates 1 bit of the result.
+Likewise, the C<b> and C<B> formats pack a string that's that many bits long.
+Each such format generates 1 bit of the result.
+
Each result bit is based on the least-significant bit of the corresponding
input character, i.e., on C<ord($char)%2>. In particular, characters C<"0">
-and C<"1"> generate bits 0 and 1, as do characters C<"\0"> and C<"\1">.
+and C<"1"> generate bits 0 and 1, as do characters C<"\000"> and C<"\001">.
-Starting from the beginning of the input string of pack(), each 8-tuple
-of characters is converted to 1 character of output. With format C<b>
+Starting from the beginning of the input string, each 8-tuple
+of characters is converted to 1 character of output. With format C<b>,
the first character of the 8-tuple determines the least-significant bit of a
-character, and with format C<B> it determines the most-significant bit of
+character; with format C<B>, it determines the most-significant bit of
a character.
-If the length of the input string is not exactly divisible by 8, the
+If the length of the input string is not evenly divisible by 8, the
remainder is packed as if the input string were padded by null characters
-at the end. Similarly, during unpack()ing the "extra" bits are ignored.
+at the end. Similarly during unpacking, "extra" bits are ignored.
+
+If the input string is longer than needed, remaining characters are ignored.
-If the input string of pack() is longer than needed, extra characters are
-ignored. A C<*> for the repeat count of pack() means to use all the
-characters of the input field. On unpack()ing the bits are converted to a
-string of C<"0">s and C<"1">s.
+A C<*> for the repeat count uses all characters of the input field.
+On unpacking, bits are converted to a string of C<"0">s and C<"1">s.
=item *
-The C<h> and C<H> fields pack a string that many nybbles (4-bit groups,
-representable as hexadecimal digits, 0-9a-f) long.
+The C<h> and C<H> formats pack a string that many nybbles (4-bit groups,
+representable as hexadecimal digits, C<"0".."9"> C<"a".."f">) long.
-Each character of the input field of pack() generates 4 bits of the result.
-For non-alphabetical characters the result is based on the 4 least-significant
+For each such format, pack() generates 4 bits of the result.
+With non-alphabetical characters, the result is based on the 4 least-significant
bits of the input character, i.e., on C<ord($char)%16>. In particular,
characters C<"0"> and C<"1"> generate nybbles 0 and 1, as do bytes
-C<"\0"> and C<"\1">. For characters C<"a".."f"> and C<"A".."F"> the result
+C<"\0"> and C<"\1">. For characters C<"a".."f"> and C<"A".."F">, the result
is compatible with the usual hexadecimal digits, so that C<"a"> and
-C<"A"> both generate the nybble C<0xa==10>. The result for characters
-C<"g".."z"> and C<"G".."Z"> is not well-defined.
+C<"A"> both generate the nybble C<0xa==10>. Do not use any characters
+but these with this format.
-Starting from the beginning of the input string of pack(), each pair
-of characters is converted to 1 character of output. With format C<h> the
+Starting from the beginning of the template to pack(), each pair
+of characters is converted to 1 character of output. With format C<h>, the
first character of the pair determines the least-significant nybble of the
-output character, and with format C<H> it determines the most-significant
+output character; with format C<H>, it determines the most-significant
nybble.
-If the length of the input string is not even, it behaves as if padded
-by a null character at the end. Similarly, during unpack()ing the "extra"
-nybbles are ignored.
+If the length of the input string is not even, it behaves as if padded by
+a null character at the end. Similarly, "extra" nybbles are ignored during
+unpacking.
-If the input string of pack() is longer than needed, extra characters are
-ignored.
-A C<*> for the repeat count of pack() means to use all the characters of
-the input field. On unpack()ing the nybbles are converted to a string
-of hexadecimal digits.
+If the input string is longer than needed, extra characters are ignored.
+
+A C<*> for the repeat count uses all characters of the input field. For
+unpack(), nybbles are converted to a string of hexadecimal digits.
=item *
-The C<p> type packs a pointer to a null-terminated string. You are
-responsible for ensuring the string is not a temporary value (which can
-potentially get deallocated before you get around to using the packed result).
-The C<P> type packs a pointer to a structure of the size indicated by the
-length. A NULL pointer is created if the corresponding value for C<p> or
-C<P> is C<undef>, similarly for unpack().
+The C<p> format packs a pointer to a null-terminated string. You are
+responsible for ensuring that the string is not a temporary value, as that
+could potentially get deallocated before you got around to using the packed
+result. The C<P> format packs a pointer to a structure of the size indicated
+by the length. A null pointer is created if the corresponding value for
+C<p> or C<P> is C<undef>; similarly with unpack(), where a null pointer
+unpacks into C<undef>.
-If your system has a strange pointer size (i.e. a pointer is neither as
-big as an int nor as big as a long), it may not be possible to pack or
+If your system has a strange pointer size--meaning a pointer is neither as
+big as an int nor as big as a long--it may not be possible to pack or
unpack pointers in big- or little-endian byte order. Attempting to do
-so will result in a fatal error.
+so raises an exception.
=item *
The C</> template character allows packing and unpacking of a sequence of
-items where the packed structure contains a packed item count followed by
-the packed items themselves.
-
-For C<pack> you write I<length-item>C</>I<sequence-item> and the
-I<length-item> describes how the length value is packed. The ones likely
-to be of most use are integer-packing ones like C<n> (for Java strings),
-C<w> (for ASN.1 or SNMP) and C<N> (for Sun XDR).
-
-For C<pack>, the I<sequence-item> may have a repeat count, in which case
-the minimum of that and the number of available items is used as argument
-for the I<length-item>. If it has no repeat count or uses a '*', the number
+items where the packed structure contains a packed item count followed by
+the packed items themselves. This is useful when the structure you're
+unpacking has encoded the sizes or repeat counts for some of its fields
+within the structure itself as separate fields.
+
+For C<pack>, you write I<length-item>C</>I<sequence-item>, and the
+I<length-item> describes how the length value is packed. Formats likely
+to be of most use are integer-packing ones like C<n> for Java strings,
+C<w> for ASN.1 or SNMP, and C<N> for Sun XDR.
+
+For C<pack>, I<sequence-item> may have a repeat count, in which case
+the minimum of that and the number of available items is used as the argument
+for I<length-item>. If it has no repeat count or uses a '*', the number
of available items is used.
-For C<unpack> an internal stack of integer arguments unpacked so far is
+For C<unpack>, an internal stack of integer arguments unpacked so far is
used. You write C</>I<sequence-item> and the repeat count is obtained by
popping off the last element from the stack. The I<sequence-item> must not
have a repeat count.
-If the I<sequence-item> refers to a string type (C<"A">, C<"a"> or C<"Z">),
-the I<length-item> is a string length, not a number of strings. If there is
-an explicit repeat count for pack, the packed string will be adjusted to that
-given length.
+If I<sequence-item> refers to a string type (C<"A">, C<"a">, or C<"Z">),
+the I<length-item> is the string length, not the number of strings. With
+an explicit repeat count for pack, the packed string is adjusted to that
+length. For example:
+
+ unpack("W/a", "\04Gurusamy") gives ("Guru")
+ unpack("a3/A A*", "007 Bond J ") gives (" Bond", "J")
+ unpack("a3 x2 /A A*", "007: Bond, J.") gives ("Bond, J", ".")
- unpack 'W/a', "\04Gurusamy"; gives ('Guru')
- unpack 'a3/A A*', '007 Bond J '; gives (' Bond', 'J')
- unpack 'a3 x2 /A A*', '007: Bond, J.'; gives ('Bond, J', '.')
- pack 'n/a* w/a','hello,','world'; gives "\000\006hello,\005world"
- pack 'a/W2', ord('a') .. ord('z'); gives '2ab'
+ pack("n/a* w/a","hello,","world") gives "\000\006hello,\005world"
+ pack("a/W2", ord("a") .. ord("z")) gives "2ab"
The I<length-item> is not returned explicitly from C<unpack>.
-Adding a count to the I<length-item> letter is unlikely to do anything
-useful, unless that letter is C<A>, C<a> or C<Z>. Packing with a
-I<length-item> of C<a> or C<Z> may introduce C<"\000"> characters,
-which Perl does not regard as legal in numeric strings.
+Supplying a count to the I<length-item> format letter is only useful with
+C<A>, C<a>, or C<Z>. Packing with a I<length-item> of C<a> or C<Z> may
+introduce C<"\000"> characters, which Perl does not regard as legal in
+numeric strings.
=item *
The integer types C<s>, C<S>, C<l>, and C<L> may be
-followed by a C<!> modifier to signify native shorts or
-longs--as you can see from above for example a bare C<l> does mean
-exactly 32 bits, the native C<long> (as seen by the local C compiler)
-may be larger. This is an issue mainly in 64-bit platforms. You can
-see whether using C<!> makes any difference by
+followed by a C<!> modifier to specify native shorts or
+longs. As shown in the example above, a bare C<l> means
+exactly 32 bits, although the native C<long> as seen by the local C compiler
+may be larger. This is mainly an issue on 64-bit platforms. You can
+see whether using C<!> makes any difference this way:
+
+ printf "format s is %d, s! is %d\n",
+ length pack("s"), length pack("s!");
- print length(pack("s")), " ", length(pack("s!")), "\n";
- print length(pack("l")), " ", length(pack("l!")), "\n";
+ printf "format l is %d, l! is %d\n",
+ length pack("l"), length pack("l!");
-C<i!> and C<I!> also work but only because of completeness;
+
+C<i!> and C<I!> are also allowed, but only for completeness' sake:
they are identical to C<i> and C<I>.
The actual sizes (in bytes) of native shorts, ints, longs, and long
-longs on the platform where Perl was built are also available via
-L<Config>:
+longs on the platform where Perl was built are also available from
+the command line:
+
+ $ perl -V:{short,int,long{,long}}size
+ shortsize='2';
+ intsize='4';
+ longsize='4';
+ longlongsize='8';
+
+or programmatically via the C<Config> module:
use Config;
print $Config{shortsize}, "\n";
print $Config{longsize}, "\n";
print $Config{longlongsize}, "\n";
-(The C<$Config{longlongsize}> will be undefined if your system does
-not support long longs.)
+C<$Config{longlongsize}> is undefined on systems without
+long long support.
=item *
-The integer formats C<s>, C<S>, C<i>, C<I>, C<l>, C<L>, C<j>, and C<J>
-are inherently non-portable between processors and operating systems
-because they obey the native byteorder and endianness. For example a
-4-byte integer 0x12345678 (305419896 decimal) would be ordered natively
-(arranged in and handled by the CPU registers) into bytes as
+The integer formats C<s>, C<S>, C<i>, C<I>, C<l>, C<L>, C<j>, and C<J> are
+inherently non-portable between processors and operating systems because
+they obey native byteorder and endianness. For example, a 4-byte integer
+0x12345678 (305419896 decimal) would be ordered natively (arranged in and
+handled by the CPU registers) into bytes as
0x12 0x34 0x56 0x78 # big-endian
0x78 0x56 0x34 0x12 # little-endian
-Basically, the Intel and VAX CPUs are little-endian, while everybody
-else, for example Motorola m68k/88k, PPC, Sparc, HP PA, Power, and
-Cray are big-endian. Alpha and MIPS can be either: Digital/Compaq
-used/uses them in little-endian mode; SGI/Cray uses them in big-endian
-mode.
+Basically, Intel and VAX CPUs are little-endian, while everybody else,
+including Motorola m68k/88k, PPC, Sparc, HP PA, Power, and Cray, are
+big-endian. Alpha and MIPS can be either: Digital/Compaq used/uses them in
+little-endian mode, but SGI/Cray uses them in big-endian mode.
-The names `big-endian' and `little-endian' are comic references to
-the classic "Gulliver's Travels" (via the paper "On Holy Wars and a
-Plea for Peace" by Danny Cohen, USC/ISI IEN 137, April 1, 1980) and
-the egg-eating habits of the Lilliputians.
+The names I<big-endian> and I<little-endian> are comic references to the
+egg-eating habits of the little-endian Lilliputians and the big-endian
+Blefuscudians from the classic Jonathan Swift satire, I<Gulliver's Travels>.
+This entered computer lingo via the paper "On Holy Wars and a Plea for
+Peace" by Danny Cohen, USC/ISI IEN 137, April 1, 1980.
Some systems may have even weirder byte orders such as
0x56 0x78 0x12 0x34
0x34 0x12 0x78 0x56
-You can see your system's preference with
+You can determine your system endianness with this incantation:
- print join(" ", map { sprintf "%#02x", $_ }
- unpack("W*",pack("L",0x12345678))), "\n";
+ printf("%#02x ", $_) for unpack("W*", pack L=>0x12345678);
The byteorder on the platform where Perl was built is also available
via L<Config>:
use Config;
- print $Config{byteorder}, "\n";
+ print "$Config{byteorder}\n";
+
+or from the command line:
+
+ $ perl -V:byteorder
-Byteorders C<'1234'> and C<'12345678'> are little-endian, C<'4321'>
-and C<'87654321'> are big-endian.
+Byteorders C<"1234"> and C<"12345678"> are little-endian; C<"4321">
+and C<"87654321"> are big-endian.
-If you want portable packed integers you can either use the formats
-C<n>, C<N>, C<v>, and C<V>, or you can use the C<E<gt>> and C<E<lt>>
-modifiers. These modifiers are only available as of perl 5.9.2.
-See also L<perlport>.
+For portably packed integers, either use the formats C<n>, C<N>, C<v>,
+and C<V> or else use the C<< > >> and C<< < >> modifiers described
+immediately below. See also L<perlport>.
=item *
-All integer and floating point formats as well as C<p> and C<P> and
-C<()>-groups may be followed by the C<E<gt>> or C<E<lt>> modifiers
-to force big- or little- endian byte-order, respectively.
-This is especially useful, since C<n>, C<N>, C<v> and C<V> don't cover
-signed integers, 64-bit integers and floating point values. However,
-there are some things to keep in mind.
+Starting with Perl 5.9.2, integer and floating-point formats, along with
+the C<p> and C<P> formats and C<()> groups, may all be followed by the
+C<< > >> or C<< < >> endianness modifiers to respectively enforce big-
+or little-endian byte-order. These modifiers are especially useful
+given how C<n>, C<N>, C<v> and C<V> don't cover signed integers,
+64-bit integers, or floating-point values.
+
+Here are some concerns to keep in mind when using endianness modifier:
+
+=over
+
+=item *
+
+Exchanging signed integers between different platforms works only
+when all platforms store them in the same format. Most platforms store
+signed integers in two's-complement notation, so usually this is not an issue.
-Exchanging signed integers between different platforms only works
-if all platforms store them in the same format. Most platforms store
-signed integers in two's complement, so usually this is not an issue.
+=item *
-The C<E<gt>> or C<E<lt>> modifiers can only be used on floating point
+The C<< > >> or C<< < >> modifiers can only be used on floating-point
formats on big- or little-endian machines. Otherwise, attempting to
-do so will result in a fatal error.
-
-Forcing big- or little-endian byte-order on floating point values for
-data exchange can only work if all platforms are using the same
-binary representation (e.g. IEEE floating point format). Even if all
-platforms are using IEEE, there may be subtle differences. Being able
-to use C<E<gt>> or C<E<lt>> on floating point values can be very useful,
-but also very dangerous if you don't know exactly what you're doing.
-It is definitely not a general way to portably store floating point
-values.
-
-When using C<E<gt>> or C<E<lt>> on an C<()>-group, this will affect
-all types inside the group that accept the byte-order modifiers,
-including all subgroups. It will silently be ignored for all other
+use them raises an exception.
+
+=item *
+
+Forcing big- or little-endian byte-order on floating-point values for
+data exchange can work only if all platforms use the same
+binary representation such as IEEE floating-point. Even if all
+platforms are using IEEE, there may still be subtle differences. Being able
+to use C<< > >> or C<< < >> on floating-point values can be useful,
+but also dangerous if you don't know exactly what you're doing.
+It is not a general way to portably store floating-point values.
+
+=item *
+
+When using C<< > >> or C<< < >> on a C<()> group, this affects
+all types inside the group that accept byte-order modifiers,
+including all subgroups. It is silently ignored for all other
types. You are not allowed to override the byte-order within a group
that already has a byte-order modifier suffix.
+=back
+
=item *
-Real numbers (floats and doubles) are in the native machine format only;
-due to the multiplicity of floating formats around, and the lack of a
-standard "network" representation, no facility for interchange has been
-made. This means that packed floating point data written on one machine
-may not be readable on another - even if both use IEEE floating point
-arithmetic (as the endian-ness of the memory representation is not part
+Real numbers (floats and doubles) are in native machine format only.
+Due to the multiplicity of floating-point formats and the lack of a
+standard "network" representation for them, no facility for interchange has been
+made. This means that packed floating-point data written on one machine
+may not be readable on another, even if both use IEEE floating-point
+arithmetic (because the endianness of the memory representation is not part
of the IEEE spec). See also L<perlport>.
-If you know exactly what you're doing, you can use the C<E<gt>> or C<E<lt>>
-modifiers to force big- or little-endian byte-order on floating point values.
+If you know I<exactly> what you're doing, you can use the C<< > >> or C<< < >>
+modifiers to force big- or little-endian byte-order on floating-point values.
-Note that Perl uses doubles (or long doubles, if configured) internally for
-all numeric calculation, and converting from double into float and thence back
-to double again will lose precision (i.e., C<unpack("f", pack("f", $foo)>)
-will not in general equal $foo).
+Because Perl uses doubles (or long doubles, if configured) internally for
+all numeric calculation, converting from double into float and thence
+to double again loses precision, so C<unpack("f", pack("f", $foo)>)
+will not in general equal $foo.
=item *
-Pack and unpack can operate in two modes, character mode (C<C0> mode) where
-the packed string is processed per character and UTF-8 mode (C<U0> mode)
+Pack and unpack can operate in two modes: character mode (C<C0> mode) where
+the packed string is processed per character, and UTF-8 mode (C<U0> mode)
where the packed string is processed in its UTF-8-encoded Unicode form on
-a byte by byte basis. Character mode is the default unless the format string
-starts with an C<U>. You can switch mode at any moment with an explicit
-C<C0> or C<U0> in the format. A mode is in effect until the next mode switch
-or until the end of the ()-group in which it was entered.
+a byte-by-byte basis. Character mode is the default unless the format string
+starts with C<U>. You can always switch mode mid-format with an explicit
+C<C0> or C<U0> in the format. This mode remains in effect until the next
+mode change, or until the end of the C<()> group it (directly) applies to.
=item *
-You must yourself do any alignment or padding by inserting for example
-enough C<'x'>es while packing. There is no way to pack() and unpack()
-could know where the characters are going to or coming from. Therefore
-C<pack> (and C<unpack>) handle their output and input as flat
-sequences of characters.
+You must yourself do any alignment or padding by inserting, for example,
+enough C<"x">es while packing. There is no way for pack() and unpack()
+to know where characters are going to or coming from, so they
+handle their output and input as flat sequences of characters.
=item *
-A ()-group is a sub-TEMPLATE enclosed in parentheses. A group may
-take a repeat count, both as postfix, and for unpack() also via the C</>
-template character. Within each repetition of a group, positioning with
-C<@> starts again at 0. Therefore, the result of
+A C<()> group is a sub-TEMPLATE enclosed in parentheses. A group may
+take a repeat count either as postfix, or for unpack(), also via the C</>
+template character. Within each repetition of a group, positioning with
+C<@> starts over at 0. Therefore, the result of
- pack( '@1A((@2A)@3A)', 'a', 'b', 'c' )
+ pack("@1A((@2A)@3A)", qw[X Y Z])
-is the string "\0a\0\0bc".
+is the string C<"\0X\0\0YZ">.
=item *
-C<x> and C<X> accept C<!> modifier. In this case they act as
-alignment commands: they jump forward/back to the closest position
-aligned at a multiple of C<count> characters. For example, to pack() or
-unpack() C's C<struct {char c; double d; char cc[2]}> one may need to
-use the template C<W x![d] d W[2]>; this assumes that doubles must be
-aligned on the double's size.
+C<x> and C<X> accept the C<!> modifier to act as alignment commands: they
+jump forward or back to the closest position aligned at a multiple of C<count>
+characters. For example, to pack() or unpack() a C structure like
+
+ struct {
+ char c; /* one signed, 8-bit character */
+ double d;
+ char cc[2];
+ }
-For alignment commands C<count> of 0 is equivalent to C<count> of 1;
-both result in no-ops.
+one may need to use the template C<c x![d] d c[2]>. This assumes that
+doubles must be aligned to the size of double.
+
+For alignment commands, a C<count> of 0 is equivalent to a C<count> of 1;
+both are no-ops.
=item *
-C<n>, C<N>, C<v> and C<V> accept the C<!> modifier. In this case they
-will represent signed 16-/32-bit integers in big-/little-endian order.
-This is only portable if all platforms sharing the packed data use the
-same binary representation for signed integers (e.g. all platforms are
-using two's complement representation).
+C<n>, C<N>, C<v> and C<V> accept the C<!> modifier to
+represent signed 16-/32-bit integers in big-/little-endian order.
+This is portable only when all platforms sharing packed data use the
+same binary representation for signed integers; for example, when all
+platforms use two's-complement representation.
=item *
-A comment in a TEMPLATE starts with C<#> and goes to the end of line.
-White space may be used to separate pack codes from each other, but
-modifiers and a repeat count must follow immediately.
+Comments can be embedded in a TEMPLATE using C<#> through the end of line.
+White space can separate pack codes from each other, but modifiers and
+repeat counts must follow immediately. Breaking complex templates into
+individual line-by-line components, suitably annotated, can do as much to
+improve legibility and maintainability of pack/unpack formats as C</x> can
+for complicated pattern matches.
=item *
-If TEMPLATE requires more arguments to pack() than actually given, pack()
+If TEMPLATE requires more arguments that pack() is given, pack()
assumes additional C<""> arguments. If TEMPLATE requires fewer arguments
-to pack() than actually given, extra arguments are ignored.
+than given, extra arguments are ignored.
=back
$foo = pack("ccxxcc",65,66,67,68);
# foo eq "AB\0\0CD"
- # note: the above examples featuring "W" and "c" are true
+ # NOTE: The examples above featuring "W" and "c" are true
# only on ASCII and ASCII-derived systems such as ISO Latin 1
- # and UTF-8. In EBCDIC the first example would be
- # $foo = pack("WWWW",193,194,195,196);
+ # and UTF-8. On EBCDIC systems, the first example would be
+ # $foo = pack("WWWW",193,194,195,196);
$foo = pack("s2",1,2);
# "\1\0\2\0" on little-endian
of the package declaration is from the declaration itself through the end
of the enclosing block, file, or eval (the same as the C<my> operator).
All further unqualified dynamic identifiers will be in this namespace.
-A package statement affects only dynamic variables--including those
-you've used C<local> on--but I<not> lexical variables, which are created
-with C<my>. Typically it would be the first declaration in a file to
-be included by the C<require> or C<use> operator. You can switch into a
-package in more than one place; it merely influences which symbol table
-is used by the compiler for the rest of that block. You can refer to
-variables and filehandles in other packages by prefixing the identifier
-with the package name and a double colon: C<$Package::Variable>.
-If the package name is null, the C<main> package as assumed. That is,
-C<$::sail> is equivalent to C<$main::sail> (as well as to C<$main'sail>,
-still seen in older code).
-
-If VERSION is provided, C<package> also sets the C<$VERSION> variable in the
-given namespace. VERSION must be be a numeric literal or v-string; it is
-parsed exactly the same way as a VERSION argument to C<use MODULE VERSION>.
-C<$VERSION> should only be set once per package.
+A package statement affects dynamic variables only, including those
+you've used C<local> on, but I<not> lexical variables, which are created
+with C<my> (or C<our> (or C<state>)). Typically it would be the first
+declaration in a file included by C<require> or C<use>. You can switch into a
+package in more than one place, since this only determines which default
+symbol table the compiler uses for the rest of that block. You can refer to
+identifiers in other packages than the current one by prefixing the identifier
+with the package name and a double colon, as in C<$SomePack::var>
+or C<ThatPack::INPUT_HANDLE>. If package name is omitted, the C<main>
+package as assumed. That is, C<$::sail> is equivalent to
+C<$main::sail> (as well as to C<$main'sail>, still seen in ancient
+code, mostly from Perl 4).
+
+If VERSION is provided, C<package> sets the C<$VERSION> variable in the given
+namespace to a L<version> object with the VERSION provided. VERSION must be a
+"strict" style version number as defined by the L<version> module: a positive
+decimal number (integer or decimal-fraction) without exponentiation or else a
+dotted-decimal v-string with a leading 'v' character and at least three
+components. You should set C<$VERSION> only once per package.
See L<perlmod/"Packages"> for more information about packages, modules,
and classes. See L<perlsub> for other scoping issues.
See L<IPC::Open2>, L<IPC::Open3>, and L<perlipc/"Bidirectional Communication">
for examples of such things.
-On systems that support a close-on-exec flag on files, the flag will be set
-for the newly opened file descriptors as determined by the value of $^F.
-See L<perlvar/$^F>.
+On systems that support a close-on-exec flag on files, that flag is set
+on all newly opened file descriptors whose C<fileno>s are I<higher> than
+the current value of $^F (by default 2 for C<STDERR>). See L<perlvar/$^F>.
=item pop ARRAY
X<pop> X<stack>
Pops and returns the last value of the array, shortening the array by
one element.
-If there are no elements in the array, returns the undefined value
-(although this may happen at other times as well). If ARRAY is
-omitted, pops the C<@ARGV> array in the main program, and the C<@_>
-array in subroutines, just like C<shift>.
+Returns the undefined value if the array is empty, although this may also
+happen at other times. If ARRAY is omitted, pops the C<@ARGV> array in the
+main program, but the C<@_> array in subroutines, just like C<shift>.
=item pos SCALAR
X<pos> X<match, position>
in question (C<$_> is used when the variable is not specified). Note that
0 is a valid match offset. C<undef> indicates that the search position
is reset (usually due to match failure, but can also be because no match has
-yet been performed on the scalar). C<pos> directly accesses the location used
+yet been run on the scalar). C<pos> directly accesses the location used
by the regexp engine to store the offset, so assigning to C<pos> will change
that offset, and so will also influence the C<\G> zero-width assertion in
regular expressions. Because a failed C<m//gc> match doesn't reset the offset,
=item print
Prints a string or a list of strings. Returns true if successful.
-FILEHANDLE may be a scalar variable name, in which case the variable
-contains the name of or a reference to the filehandle, thus introducing
+FILEHANDLE may be a scalar variable containing
+the name of or a reference to the filehandle, thus introducing
one level of indirection. (NOTE: If FILEHANDLE is a variable and
the next token is a term, it may be misinterpreted as an operator
unless you interpose a C<+> or put parentheses around the arguments.)
-If FILEHANDLE is omitted, prints by default to standard output (or
-to the last selected output channel--see L</select>). If LIST is
-also omitted, prints C<$_> to the currently selected output channel.
-To set the default output channel to something other than STDOUT
+If FILEHANDLE is omitted, prints to standard output by default, or
+to the last selected output channel; see L</select>. If LIST is
+also omitted, prints C<$_> to the currently selected output handle.
+To set the default output handle to something other than STDOUT
use the select operation. The current value of C<$,> (if any) is
printed between each LIST item. The current value of C<$\> (if
any) is printed after the entire LIST has been printed. Because
its expressions evaluated in list context. Also be careful not to
follow the print keyword with a left parenthesis unless you want
the corresponding right parenthesis to terminate the arguments to
-the print--interpose a C<+> or put parentheses around all the
-arguments.
+the print; put parentheses around all the arguments
+(or interpose a C<+>, but that doesn't look as good).
Note that if you're storing FILEHANDLEs in an array, or if you're using
any other expression more complex than a scalar variable to retrieve it,
of the list will be interpreted as the C<printf> format. See C<sprintf>
for an explanation of the format argument. If C<use locale> is in effect,
and POSIX::setlocale() has been called, the character used for the decimal
-separator in formatted floating point numbers is affected by the LC_NUMERIC
+separator in formatted floating-point numbers is affected by the LC_NUMERIC
locale. See L<perllocale> and L<POSIX>.
Don't fall into the trap of using a C<printf> when a simple
the function whose prototype you want to retrieve.
If FUNCTION is a string starting with C<CORE::>, the rest is taken as a
-name for Perl builtin. If the builtin is not I<overridable> (such as
+name for a Perl builtin. If the builtin is not I<overridable> (such as
C<qw//>) or if its arguments cannot be adequately expressed by a prototype
(such as C<system>), prototype() returns C<undef>, because the builtin
does not really behave like a Perl function. Otherwise, the string
Returns a random fractional number greater than or equal to C<0> and less
than the value of EXPR. (EXPR should be positive.) If EXPR is
omitted, the value C<1> is used. Currently EXPR with the value C<0> is
-also special-cased as C<1> - this has not been documented before perl 5.8.0
-and is subject to change in future versions of perl. Automatically calls
+also special-cased as C<1> (this was undocumented before Perl 5.8.0
+and is subject to change in future versions of Perl). Automatically calls
C<srand> unless C<srand> has already been called. See also C<srand>.
Apply C<int()> to the value returned by C<rand()> if you want random
results in the string being padded to the required size with C<"\0">
bytes before the result of the read is appended.
-The call is actually implemented in terms of either Perl's or system's
-fread() call. To get a true read(2) system call, see C<sysread>.
+The call is implemented in terms of either Perl's or your system's native
+fread(3) library function. To get a true read(2) system call, see C<sysread>.
Note the I<characters>: depending on the status of the filehandle,
either (8-bit) bytes or characters are read. By default all
Returns the next directory entry for a directory opened by C<opendir>.
If used in list context, returns all the rest of the entries in the
-directory. If there are no more entries, returns an undefined value in
-scalar context or a null list in list context.
+directory. If there are no more entries, returns the undefined value in
+scalar context and the empty list in list context.
If you're planning to filetest the return values out of a C<readdir>, you'd
better prepend the directory in question. Otherwise, because we didn't
Reads from the filehandle whose typeglob is contained in EXPR (or from
*ARGV if EXPR is not provided). In scalar context, each call reads and
-returns the next line, until end-of-file is reached, whereupon the
+returns the next line until end-of-file is reached, whereupon the
subsequent call returns C<undef>. In list context, reads until end-of-file
is reached and returns a list of lines. Note that the notion of "line"
-used here is however you may have defined it with C<$/> or
+used here is whatever you may have defined with C<$/> or
C<$INPUT_RECORD_SEPARATOR>). See L<perlvar/"$/">.
When C<$/> is set to C<undef>, when C<readline> is in scalar
-context (i.e. file slurp mode), and when an empty file is read, it
+context (i.e., file slurp mode), and when an empty file is read, it
returns C<''> the first time, followed by C<undef> subsequently.
This is the internal function implementing the C<< <EXPR> >>
=item readlink
Returns the value of a symbolic link, if symbolic links are
-implemented. If not, gives a fatal error. If there is some system
+implemented. If not, raises an exception. If there is a system
error, returns the undefined value and sets C<$!> (errno). If EXPR is
omitted, uses C<$_>.
print;
}
-C<redo> cannot be used to retry a block which returns a value such as
+C<redo> cannot be used to retry a block that returns a value such as
C<eval {}>, C<sub {}> or C<do {}>, and should not be used to exit
a grep() or map() operation.
VERSION may be either a numeric argument such as 5.006, which will be
compared to C<$]>, or a literal of the form v5.6.1, which will be compared
-to C<$^V> (aka $PERL_VERSION). A fatal error is produced at run time if
+to C<$^V> (aka $PERL_VERSION). An exception is raised if
VERSION is greater than the version of the current Perl interpreter.
Compare with L</use>, which can do a similar check at compile time.
eval "require $class";
-Now that you understand how C<require> looks for files in the case of a
+Now that you understand how C<require> looks for files with a
bareword argument, there is a little extra functionality going on behind
the scenes. Before C<require> looks for a "F<.pm>" extension, it will
first look for a similar filename with a "F<.pmc>" extension. If this file
is found, it will be loaded in place of any file ending in a "F<.pm>"
extension.
-You can also insert hooks into the import facility, by putting directly
-Perl code into the @INC array. There are three forms of hooks: subroutine
+You can also insert hooks into the import facility, by putting Perl code
+directly into the @INC array. There are three forms of hooks: subroutine
references, array references and blessed objects.
Subroutine references are the simplest case. When the inclusion system
walks through @INC and encounters a subroutine, this subroutine gets
-called with two parameters, the first being a reference to itself, and the
-second the name of the file to be included (e.g. "F<Foo/Bar.pm>"). The
-subroutine should return nothing, or a list of up to three values in the
-following order:
+called with two parameters, the first a reference to itself, and the
+second the name of the file to be included (e.g., "F<Foo/Bar.pm>"). The
+subroutine should return either nothing or else a list of up to three
+values in the following order:
=over
A reference to a subroutine. If there is no filehandle (previous item),
then this subroutine is expected to generate one line of source code per
call, writing the line into C<$_> and returning 1, then returning 0 at
-"end of file". If there is a filehandle, then the subroutine will be
+end of file. If there is a filehandle, then the subroutine will be
called to act as a simple source filter, with the line as read in C<$_>.
Again, return 1 for each valid line, and 0 after all lines have been
returned.
=back
If an empty list, C<undef>, or nothing that matches the first 3 values above
-is returned then C<require> will look at the remaining elements of @INC.
-Note that this file handle must be a real file handle (strictly a typeglob,
-or reference to a typeglob, blessed or unblessed) - tied file handles will be
+is returned, then C<require> looks at the remaining elements of @INC.
+Note that this filehandle must be a real filehandle (strictly a typeglob
+or reference to a typeglob, blessed or unblessed); tied filehandles will be
ignored and return value processing will stop there.
If the hook is an array reference, its first element must be a subroutine
reference. This subroutine is called as above, but the first parameter is
-the array reference. This enables to pass indirectly some arguments to
+the array reference. This lets you indirectly pass arguments to
the subroutine.
In other words, you can write:
# In the main program
push @INC, Foo->new(...);
-Note that these hooks are also permitted to set the %INC entry
+These hooks are also permitted to set the %INC entry
corresponding to the files they have loaded. See L<perlvar/%INC>.
For a yet-more-powerful import facility, see L</use> and L<perlmod>.
expression is interpreted as a list of single characters (hyphens
allowed for ranges). All variables and arrays beginning with one of
those letters are reset to their pristine state. If the expression is
-omitted, one-match searches (C<?pattern?>) are reset to match again. Resets
-only variables or searches in the current package. Always returns
-1. Examples:
+omitted, one-match searches (C<?pattern?>) are reset to match again.
+Only resets variables or searches in the current package. Always returns
+1. Examples:
reset 'X'; # reset all X variables
reset 'a-z'; # reset lower case variables
Resetting C<"A-Z"> is not recommended because you'll wipe out your
C<@ARGV> and C<@INC> arrays and your C<%ENV> hash. Resets only package
-variables--lexical variables are unaffected, but they clean themselves
+variables; lexical variables are unaffected, but they clean themselves
up on scope exit anyway, so you'll probably want to use them instead.
See L</my>.
context, depending on how the return value will be used, and the context
may vary from one execution to the next (see C<wantarray>). If no EXPR
is given, returns an empty list in list context, the undefined value in
-scalar context, and (of course) nothing at all in a void context.
+scalar context, and (of course) nothing at all in void context.
-(Note that in the absence of an explicit C<return>, a subroutine, eval,
-or do FILE will automatically return the value of the last expression
+(In the absence of an explicit C<return>, a subroutine, eval,
+or do FILE automatically returns the value of the last expression
evaluated.)
=item reverse LIST
print scalar reverse; # Hello, world
Note that reversing an array to itself (as in C<@a = reverse @a>) will
-preserve non-existent elements whenever possible, i.e. for non magical
+preserve non-existent elements whenever possible, i.e., for non magical
arrays or tied arrays with C<EXISTS> and C<DELETE> methods.
This operator is also handy for inverting a hash, although there are some
empty. If it succeeds it returns true, otherwise it returns false and
sets C<$!> (errno). If FILENAME is omitted, uses C<$_>.
-To remove a directory tree recursively (C<rm -rf> on unix) look at
+To remove a directory tree recursively (C<rm -rf> on Unix) look at
the C<rmtree> function of the L<File::Path> module.
=item s///
C<say LIST> is simply an abbreviation for C<{ local $\ = "\n"; print
LIST }>.
-This keyword is only available when the "say" feature is
+This keyword is available only when the "say" feature is
enabled: see L<feature>.
=item scalar EXPR
the construction C<@{[ (some expression) ]}>, but usually a simple
C<(some expression)> suffices.
-Because C<scalar> is unary operator, if you accidentally use for EXPR a
+Because C<scalar> is a unary operator, if you accidentally use for EXPR a
parenthesized list, this behaves as a scalar comma expression, evaluating
all but the last element in void context and returning the final element
evaluated in scalar context. This is seldom what you want.
POSITION, and C<2> to set it to EOF plus POSITION (typically
negative). For WHENCE you may use the constants C<SEEK_SET>,
C<SEEK_CUR>, and C<SEEK_END> (start of the file, current position, end
-of the file) from the Fcntl module. Returns C<1> upon success, C<0>
+of the file) from the Fcntl module. Returns C<1> on success, C<0>
otherwise.
Note the I<in bytes>: even if the filehandle has been set to
layer), tell() will return byte offsets, not character offsets
(because implementing that would render seek() and tell() rather slow).
-If you want to position file for C<sysread> or C<syswrite>, don't use
-C<seek>--buffering makes its effect on the file's system position
+If you want to position the file for C<sysread> or C<syswrite>, don't use
+C<seek>, because buffering makes its effect on the file's read-write position
unpredictable and non-portable. Use C<sysseek> instead.
Due to the rules and rigors of ANSI C, on some systems you have to do a
seek(TEST,0,1);
This is also useful for applications emulating C<tail -f>. Once you hit
-EOF on your read, and then sleep for a while, you might have to stick in a
-seek() to reset things. The C<seek> doesn't change the current position,
+EOF on your read and then sleep for a while, you (probably) have to stick in a
+dummy seek() to reset things. The C<seek> doesn't change the position,
but it I<does> clear the end-of-file condition on the handle, so that the
-next C<< <FILE> >> makes Perl try again to read something. We hope.
+next C<< <FILE> >> makes Perl try again to read something. (We hope.)
-If that doesn't work (some IO implementations are particularly
-cantankerous), then you may need something more like this:
+If that doesn't work (some I/O implementations are particularly
+cantankerous), you might need something like this:
for (;;) {
for ($curpos = tell(FILE); $_ = <FILE>;
=item select RBITS,WBITS,EBITS,TIMEOUT
X<select>
-This calls the select(2) system call with the bit masks specified, which
+This calls the select(2) syscall with the bit masks specified, which
can be constructed using C<fileno> and C<vec>, along these lines:
$rin = $win = $ein = '';
vec($win,fileno(STDOUT),1) = 1;
$ein = $rin | $win;
-If you want to select on many filehandles you might wish to write a
-subroutine:
+If you want to select on many filehandles, you may wish to write a
+subroutine like this:
sub fhbits {
my(@fhlist) = split(' ',$_[0]);
is implementation-dependent. See also L<perlport> for notes on the
portability of C<select>.
-On error, C<select> behaves like the select(2) system call : it returns
+On error, C<select> behaves like select(2): it returns
-1 and sets C<$!>.
-Note: on some Unixes, the select(2) system call may report a socket file
-descriptor as "ready for reading", when actually no data is available,
-thus a subsequent read blocks. It can be avoided using always the
-O_NONBLOCK flag on the socket. See select(2) and fcntl(2) for further
+On some Unixes, select(2) may report a socket file
+descriptor as "ready for reading" when no data is available, and
+thus a subsequent read blocks. This can be avoided if you always use
+O_NONBLOCK on the socket. See select(2) and fcntl(2) for further
details.
B<WARNING>: One should not attempt to mix buffered I/O (like C<read>
=item semctl ID,SEMNUM,CMD,ARG
X<semctl>
-Calls the System V IPC function C<semctl>. You'll probably have to say
+Calls the System V IPC function semctl(2). You'll probably have to say
use IPC::SysV;
=item semget KEY,NSEMS,FLAGS
X<semget>
-Calls the System V IPC function semget. Returns the semaphore id, or
+Calls the System V IPC function semget(2). Returns the semaphore id, or
the undefined value if there is an error. See also
L<perlipc/"SysV IPC">, C<IPC::SysV>, C<IPC::SysV::Semaphore>
documentation.
=item semop KEY,OPSTRING
X<semop>
-Calls the System V IPC function semop to perform semaphore operations
+Calls the System V IPC function semop(2) for semaphore operations
such as signalling and waiting. OPSTRING must be a packed array of
semop structures. Each semop structure can be generated with
C<pack("s!3", $semnum, $semop, $semflag)>. The length of OPSTRING
=item send SOCKET,MSG,FLAGS
-Sends a message on a socket. Attempts to send the scalar MSG to the
-SOCKET filehandle. Takes the same flags as the system call of the
-same name. On unconnected sockets you must specify a destination to
-send TO, in which case it does a C C<sendto>. Returns the number of
-characters sent, or the undefined value if there is an error. The C
-system call sendmsg(2) is currently unimplemented. See
-L<perlipc/"UDP: Message Passing"> for examples.
+Sends a message on a socket. Attempts to send the scalar MSG to the SOCKET
+filehandle. Takes the same flags as the system call of the same name. On
+unconnected sockets, you must specify a destination to I<send to>, in which
+case it does a sendto(2) syscall. Returns the number of characters sent,
+or the undefined value on error. The sendmsg(2) syscall is currently
+unimplemented. See L<perlipc/"UDP: Message Passing"> for examples.
Note the I<characters>: depending on the status of the socket, either
(8-bit) bytes or characters are sent. By default all sockets operate
X<setpgrp> X<group>
Sets the current process group for the specified PID, C<0> for the current
-process. Will produce a fatal error if used on a machine that doesn't
+process. Raises an exception when used on a machine that doesn't
implement POSIX setpgid(2) or BSD setpgrp(2). If the arguments are omitted,
it defaults to C<0,0>. Note that the BSD 4.2 version of C<setpgrp> does not
accept any arguments, so only C<setpgrp(0,0)> is portable. See also
X<setpriority> X<priority> X<nice> X<renice>
Sets the current priority for a process, a process group, or a user.
-(See setpriority(2).) Will produce a fatal error if used on a machine
+(See setpriority(2).) Raises an exception when used on a machine
that doesn't implement setpriority(2).
=item setsockopt SOCKET,LEVEL,OPTNAME,OPTVAL
getprotobyname. OPTVAL might either be a packed string or an integer.
An integer OPTVAL is shorthand for pack("i", OPTVAL).
-An example disabling the Nagle's algorithm for a socket:
+An example disabling Nagle's algorithm on a socket:
use Socket qw(IPPROTO_TCP TCP_NODELAY);
setsockopt($socket, IPPROTO_TCP, TCP_NODELAY, 1);
array by 1 and moving everything down. If there are no elements in the
array, returns the undefined value. If ARRAY is omitted, shifts the
C<@_> array within the lexical scope of subroutines and formats, and the
-C<@ARGV> array outside of a subroutine and also within the lexical scopes
+C<@ARGV> array outside a subroutine and also within the lexical scopes
established by the C<eval STRING>, C<BEGIN {}>, C<INIT {}>, C<CHECK {}>,
C<UNITCHECK {}> and C<END {}> constructs.
X<shutdown>
Shuts down a socket connection in the manner indicated by HOW, which
-has the same interpretation as in the system call of the same name.
+has the same interpretation as in the syscall of the same name.
shutdown(SOCKET, 0); # I/we have stopped reading data
shutdown(SOCKET, 1); # I/we have stopped writing data
disables the file descriptor in any forked copies in other
processes.
-Returns C<1> for success. In the case of error, returns C<undef> if
+Returns C<1> for success; on error, returns C<undef> if
the first argument is not a valid filehandle, or returns C<0> and sets
C<$!> for any other failure.
=item sleep
-Causes the script to sleep for EXPR seconds, or forever if no EXPR.
-Returns the number of seconds actually slept.
+Causes the script to sleep for (integer) EXPR seconds, or forever if no
+argument is given. Returns the integer number of seconds actually slept.
May be interrupted if the process receives a signal such as C<SIGALRM>.
Opens a socket of the specified kind and attaches it to filehandle
SOCKET. DOMAIN, TYPE, and PROTOCOL are specified the same as for
-the system call of the same name. You should C<use Socket> first
+the syscall of the same name. You should C<use Socket> first
to get the proper definitions imported. See the examples in
L<perlipc/"Sockets: Client/Server Communication">.
Creates an unnamed pair of sockets in the specified domain, of the
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.
+for the syscall of the same name. If unimplemented, raises an exception.
+Returns true if successful.
On systems that support a close-on-exec flag on files, the flag will
be set for the newly opened file descriptors, as determined by the value
If SUBNAME or BLOCK is omitted, C<sort>s in standard string comparison
order. If SUBNAME is specified, it gives the name of a subroutine
that returns an integer less than, equal to, or greater than C<0>,
-depending on how the elements of the list are to be ordered. (The C<<
-<=> >> and C<cmp> operators are extremely useful in such routines.)
+depending on how the elements of the list are to be ordered. (The
+C<< <=> >> and C<cmp> operators are extremely useful in such routines.)
SUBNAME may be a scalar variable name (unsubscripted), in which case
the value provides the name of (or a reference to) the actual
subroutine to use. In place of a SUBNAME, you can provide a BLOCK as
well-defined.
Because C<< <=> >> returns C<undef> when either operand is C<NaN>
-(not-a-number), and because C<sort> will trigger a fatal error unless the
+(not-a-number), and because C<sort> raises an exception unless the
result of a comparison is defined, when sorting with a comparison function
like C<< $a <=> $b >>, be careful about lists that might contain a C<NaN>.
-The following example takes advantage of the fact that C<NaN != NaN> to
-eliminate any C<NaN>s from the input.
+The following example takes advantage that C<NaN != NaN> to
+eliminate any C<NaN>s from the input list.
@result = sort { $a <=> $b } grep { $_ == $_ } @input;
If LENGTH is negative, removes the elements from OFFSET onward
except for -LENGTH elements at the end of the array.
If both OFFSET and LENGTH are omitted, removes everything. If OFFSET is
-past the end of the array, perl issues a warning, and splices at the
+past the end of the array, Perl issues a warning, and splices at the
end of the array.
The following equivalences hold (assuming C<< $[ == 0 and $#a >= $i >> )
empty string always returns the empty list, regardless of the LIMIT
specified.
-A pattern matching the null string (not to be confused with
-a null pattern C<//>, which is just one member of the set of patterns
-matching a null string) will split the value of EXPR into separate
-characters at each point it matches that way. For example:
+A pattern matching the empty string (not to be confused with
+an empty pattern C<//>, which is just one member of the set of patterns
+matching the epmty string), splits EXPR into individual
+characters. For example:
print join(':', split(/ */, 'hi there')), "\n";
produces the output 'h:i:t:h:e:r:e'.
-As a special case for C<split>, using the empty pattern C<//> specifically
-matches only the null string, and is not be confused with the regular use
-of C<//> to mean "the last successful pattern match". So, for C<split>,
-the following:
+As a special case for C<split>, the empty pattern C<//> specifically
+matches the empty string; this is not be confused with the normal use
+of an empty pattern to mean the last successful match. So to split
+a string into individual characters, the following:
print join(':', split(//, 'hi there')), "\n";
As a special case, specifying a PATTERN of space (S<C<' '>>) will split on
white space just as C<split> with no arguments does. Thus, S<C<split(' ')>> can
be used to emulate B<awk>'s default behavior, whereas S<C<split(/ /)>>
-will give you as many null initial fields as there are leading spaces.
+will give you as many initial null fields (empty string) as there are leading spaces.
A C<split> on C</\s+/> is like a S<C<split(' ')>> except that any leading
whitespace produces a null first field. A C<split> with no arguments
really does a S<C<split(' ', $_)>> internally.
# Round number to 3 digits after decimal point
$rounded = sprintf("%.3f", $number);
-Perl does its own C<sprintf> formatting--it emulates the C
-function C<sprintf>, but it doesn't use it (except for floating-point
-numbers, and even then only the standard modifiers are allowed). As a
-result, any non-standard extensions in your local C<sprintf> are not
-available from Perl.
+Perl does its own C<sprintf> formatting: it emulates the C
+function sprintf(3), but doesn't use it except for floating-point
+numbers, and even then only standard modifiers are allowed.
+Non-standard extensions in your local sprintf(3) are
+therefore unavailable from Perl.
Unlike C<printf>, C<sprintf> does not do what you probably mean when you
pass it an array as your first argument. The array is given scalar context,
(zero-padded as necessary). In other words, 1.23 times ten to the
99th may be either "1.23e99" or "1.23e099".
-Between the C<%> and the format letter, you may specify a number of
+Between the C<%> and the format letter, you may specify several
additional attributes controlling the interpretation of the format.
In order, these are:
An explicit format parameter index, such as C<2$>. By default sprintf
will format the next unused argument in the list, but this allows you
-to take the arguments out of order, e.g.:
+to take the arguments out of order:
printf '%2$d %1$d', 12, 34; # prints "34 12"
printf '%3$d %d %1$d', 1, 2, 3; # prints "3 1 1"
=item vector flag
-This flag tells perl to interpret the supplied string as a vector of
+This flag tells Perl to interpret the supplied string as a vector of
integers, one for each character in the string. Perl applies the format to
each integer in turn, then joins the resulting strings with a separator (a
dot C<.> by default). This can be useful for displaying ordinal values of
printf "bits are %0*v8b\n", " ", $bits; # random bitstring
You can also explicitly specify the argument number to use for
-the join string using e.g. C<*2$v>:
+the join string using something like C<*2$v>; for example:
printf '%*4$vX %*4$vX %*4$vX', @addr[1..3], ":"; # 3 IPv6 addresses
Arguments are usually formatted to be only as wide as required to
display the given value. You can override the width by putting
a number here, or get the width from the next argument (with C<*>)
-or from a specified argument (with e.g. C<*2$>):
+or from a specified argument (e.g., with C<*2$>):
printf '<%s>', "a"; # prints "<a>"
printf '<%6s>', "a"; # prints "< a>"
You can specify a precision (for numeric conversions) or a maximum
width (for string conversions) by specifying a C<.> followed by a number.
-For floating point formats, with the exception of 'g' and 'G', this specifies
-the number of decimal places to show (the default being 6), e.g.:
+For floating-point formats except 'g' and 'G', this specifies
+how many places right of the decimal point to show (the default being 6).
+For example:
# these examples are subject to system-specific variation
printf '<%f>', 1; # prints "<1.000000>"
printf '<%e>', 10; # prints "<1.000000e+01>"
printf '<%.1e>', 10; # prints "<1.0e+01>"
-For 'g' and 'G', this specifies the maximum number of digits to show,
-including prior to the decimal point as well as after it, e.g.:
+For "g" and "G", this specifies the maximum number of digits to show,
+including thoe prior to the decimal point and those after it; for
+example:
- # these examples are subject to system-specific variation
+ # These examples are subject to system-specific variation.
printf '<%g>', 1; # prints "<1>"
printf '<%.10g>', 1; # prints "<1>"
printf '<%g>', 100; # prints "<100>"
printf '<%#10.6x>', 1; # prints "< 0x000001>"
For string conversions, specifying a precision truncates the string
-to fit in the specified width:
+to fit the specified width:
printf '<%.5s>', "truncated"; # prints "<trunc>"
printf '<%10.5s>', "truncated"; # prints "< trunc>"
printf '<%.6x>', 1; # prints "<000001>"
printf '<%.*x>', 6, 1; # prints "<000001>"
-If a precision obtained through C<*> is negative, it has the same
-effect as no precision.
+If a precision obtained through C<*> is negative, it counts
+as having no precision at all.
printf '<%.*s>', 7, "string"; # prints "<string>"
printf '<%.*s>', 3, "string"; # prints "<str>"
printf '<%.*d>', -1, 0; # prints "<0>"
You cannot currently get the precision from a specified number,
-but it is intended that this will be possible in the future using
-e.g. C<.*2$>:
+but it is intended that this will be possible in the future, for
+example using C<.*2$>:
- printf '<%.*2$x>', 1, 6; # INVALID, but in future will print "<000001>"
+ printf "<%.*2$x>", 1, 6; # INVALID, but in future will print "<000001>"
=item size
q, L or ll interpret integer as C type "long long", "unsigned long long".
or "quads" (typically 64-bit integers)
-The last will produce errors if Perl does not understand "quads" in your
-installation. (This requires that either the platform natively supports quads
-or Perl was specifically compiled to support quads.) You can find out
+The last will raise an exception if Perl does not understand "quads" in your
+installation. (This requires either that the platform natively support quads,
+or that Perl were specifically compiled to support quads.) You can find out
whether your Perl supports quads via L<Config>:
use Config;
- ($Config{use64bitint} eq 'define' || $Config{longsize} >= 8) &&
- print "quads\n";
+ if ($Config{use64bitint} eq "define" || $Config{longsize} >= 8) {
+ print "Nice quads!\n";
+ }
-For floating point conversions (C<e f g E F G>), numbers are usually assumed
-to be the default floating point size on your platform (double or long double),
-but you can force 'long double' with C<q>, C<L>, or C<ll> if your
+For floating-point conversions (C<e f g E F G>), numbers are usually assumed
+to be the default floating-point size on your platform (double or long double),
+but you can force "long double" with C<q>, C<L>, or C<ll> if your
platform supports them. You can find out whether your Perl supports long
doubles via L<Config>:
use Config;
- $Config{d_longdbl} eq 'define' && print "long doubles\n";
+ print "long doubles\n" if $Config{d_longdbl} eq "define";
-You can find out whether Perl considers 'long double' to be the default
-floating point size to use on your platform via L<Config>:
+You can find out whether Perl considers "long double" to be the default
+floating-point size to use on your platform via L<Config>:
- use Config;
- ($Config{uselongdouble} eq 'define') &&
- print "long doubles by default\n";
+ use Config;
+ if ($Config{uselongdouble} eq "define") {
+ print "long doubles by default\n";
+ }
-It can also be the case that long doubles and doubles are the same thing:
+It can also be that long doubles and doubles are the same thing:
use Config;
($Config{doublesize} == $Config{longdblsize}) &&
print "doubles are long doubles\n";
-The size specifier C<V> has no effect for Perl code, but it is supported
-for compatibility with XS code; it means 'use the standard size for
-a Perl integer (or floating-point number)', which is already the
-default for Perl code.
+The size specifier C<V> has no effect for Perl code, but is supported for
+compatibility with XS code. It means "use the standard size for a Perl
+integer or floating-point number", which is the default.
=item order of arguments
-Normally, sprintf takes the next unused argument as the value to
+Normally, sprintf() takes the next unused argument as the value to
format for each format specification. If the format specification
uses C<*> to require additional arguments, these are consumed from
-the argument list in the order in which they appear in the format
-specification I<before> the value to format. Where an argument is
-specified using an explicit index, this does not affect the normal
-order for the arguments (even when the explicitly specified index
-would have been the next argument in any case).
+the argument list in the order they appear in the format
+specification I<before> the value to format. Where an argument is
+specified by an explicit index, this does not affect the normal
+order for the arguments, even when the explicitly specified index
+would have been the next argument.
So:
- printf '<%*.*s>', $a, $b, $c;
+ printf "<%*.*s>", $a, $b, $c;
-would use C<$a> for the width, C<$b> for the precision and C<$c>
-as the value to format, while:
+uses C<$a> for the width, C<$b> for the precision, and C<$c>
+as the value to format; while:
- printf '<%*1$.*s>', $a, $b;
+ printf "<%*1$.*s>", $a, $b;
-would use C<$a> for the width and the precision, and C<$b> as the
+would use C<$a> for the width and precision, and C<$b> as the
value to format.
-Here are some more examples - beware that when using an explicit
-index, the C<$> may need to be escaped:
+Here are some more examples; be aware that when using an explicit
+index, the C<$> may need escaping:
printf "%2\$d %d\n", 12, 34; # will print "34 12\n"
printf "%2\$d %d %d\n", 12, 34; # will print "34 12 34\n"
=back
-If C<use locale> is in effect, and POSIX::setlocale() has been called,
-the character used for the decimal separator in formatted floating
-point numbers is affected by the LC_NUMERIC locale. See L<perllocale>
+If C<use locale> is in effect and POSIX::setlocale() has been called,
+the character used for the decimal separator in formatted floating-point
+numbers is affected by the LC_NUMERIC locale. See L<perllocale>
and L<POSIX>.
=item sqrt EXPR
=item sqrt
-Return the square root of EXPR. If EXPR is omitted, returns square
-root of C<$_>. Only works on non-negative operands, unless you've
-loaded the standard Math::Complex module.
+Return the positive square root of EXPR. If EXPR is omitted, uses
+C<$_>. Works only for non-negative operands unless you've
+loaded the C<Math::Complex> module.
use Math::Complex;
- print sqrt(-2); # prints 1.4142135623731i
+ print sqrt(-4); # prints 2i
=item srand EXPR
X<srand> X<seed> X<randseed>
program.
If srand() is not called explicitly, it is called implicitly at the
-first use of the C<rand> operator. However, this was not the case in
+first use of the C<rand> operator. However, this was not true of
versions of Perl before 5.004, so if your script will run under older
Perl versions, it should call C<srand>.
Most programs won't even call srand() at all, except those that
need a cryptographically-strong starting point rather than the
generally acceptable default, which is based on time of day,
-process ID, and memory allocation, or the F</dev/urandom> device,
+process ID, and memory allocation, or the F</dev/urandom> device
if available.
You can call srand($seed) with the same $seed to reproduce the
generating predictable results for testing or debugging.
Otherwise, don't call srand() more than once in your program.
-Do B<not> call srand() (i.e. without an argument) more than once in
+Do B<not> call srand() (i.e., without an argument) more than once in
a script. The internal state of the random number generator should
contain more entropy than can be provided by any seed, so calling
srand() again actually I<loses> randomness.
Returns a 13-element list giving the status info for a file, either
the file opened via FILEHANDLE or DIRHANDLE, or named by EXPR. If EXPR is
-omitted, it stats C<$_>. Returns a null list if the stat fails. Typically
+omitted, it stats C<$_>. Returns the empty list if C<stat> fails. Typically
used as follows:
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$is_directory = S_ISDIR($mode);
You could write the last two using the C<-u> and C<-d> operators.
-The commonly available C<S_IF*> constants are
+Commonly available C<S_IF*> constants are:
# Permissions: read, write, execute, for user, group, others.
and the setuid/setgid/sticky bits
S_IFMT($mode) the part of $mode containing the file type
- which can be bit-anded with e.g. S_IFREG
+ which can be bit-anded with (for example) S_IFREG
or with the following functions
# The operators -f, -d, -l, -b, -c, -p, and -S.
lexical variables that are reinitialized each time their enclosing block
is entered.
-C<state> variables are only enabled when the C<feature 'state'> pragma is
-in effect. See L<feature>.
+C<state> variables are enabled only when the C<use feature "state"> pragma
+is in effect. See L<feature>.
=item study SCALAR
X<study>
doing many pattern matches on the string before it is next modified.
This may or may not save time, depending on the nature and number of
patterns you are searching on, and on the distribution of character
-frequencies in the string to be searched--you probably want to compare
+frequencies in the string to be searched; you probably want to compare
run times with and without it to see which runs faster. Those loops
that scan for many short constant strings (including the constant
parts of more complex patterns) will benefit most. You may have only
-one C<study> active at a time--if you study a different scalar the first
+one C<study> active at a time: if you study a different scalar the first
is "unstudied". (The way C<study> works is this: a linked list of every
character in the string to be searched is made, so we know, for
example, where all the C<'k'> characters are. From each search string,
print;
}
-In searching for C</\bfoo\b/>, only those locations in C<$_> that contain C<f>
+In searching for C</\bfoo\b/>, only locations in C<$_> that contain C<f>
will be looked at, because C<f> is rarer than C<o>. In general, this is
a big win except in pathological cases. The only question is whether
it saves you more time than it took to build the linked list in the
Note that if you have to look for strings that you don't know till
runtime, you can build an entire loop as a string and C<eval> that to
avoid recompiling all your patterns all the time. Together with
-undefining C<$/> to input entire files as one record, this can be very
+undefining C<$/> to input entire files as one record, this can be quite
fast, often faster than specialized programs like fgrep(1). The following
scans a list of files (C<@files>) for a list of words (C<@words>), and prints
out the names of those files that contain a match:
must itself be an lvalue. If you assign something shorter than LENGTH,
the string will shrink, and if you assign something longer than LENGTH,
the string will grow to accommodate it. To keep the string the same
-length you may need to pad or chop your value using C<sprintf>.
+length, you may need to pad or chop your value using C<sprintf>.
If OFFSET and LENGTH specify a substring that is partly outside the
string, only the part within the string is returned. If the substring
is beyond either end of the string, substr() returns the undefined
value and produces a warning. When used as an lvalue, specifying a
-substring that is entirely outside the string is a fatal error.
+substring that is entirely outside the string raises an exception.
Here's an example showing the behavior for boundary cases:
my $name = 'fred';
substr($name, 4) = 'dy'; # $name is now 'freddy'
- my $null = substr $name, 6, 2; # returns '' (no warning)
+ my $null = substr $name, 6, 2; # returns "" (no warning)
my $oops = substr $name, 7; # returns undef, with warning
- substr($name, 7) = 'gap'; # fatal error
+ substr($name, 7) = 'gap'; # raises an exception
An alternative to using substr() as an lvalue is to specify the
replacement string as the 4th argument. This allows you to replace
Creates a new filename symbolically linked to the old filename.
Returns C<1> for success, C<0> otherwise. On systems that don't support
-symbolic links, produces a fatal error at run time. To check for that,
+symbolic links, raises an exception. To check for that,
use eval:
$symlink_exists = eval { symlink("",""); 1 };
Calls the system call specified as the first element of the list,
passing the remaining elements as arguments to the system call. If
-unimplemented, produces a fatal error. The arguments are interpreted
+unimplemented, raises an exception. The arguments are interpreted
as follows: if a given argument is numeric, the argument is passed as
an int. If not, the pointer to the string value is passed. You are
responsible to make sure a string is pre-extended long enough to
$s = "hi there\n";
syscall(&SYS_write, fileno(STDOUT), $s, length $s);
-Note that Perl supports passing of up to only 14 arguments to your system call,
-which in practice should usually suffice.
+Note that Perl supports passing of up to only 14 arguments to your syscall,
+which in practice should (usually) suffice.
Syscall returns whatever value returned by the system call it calls.
If the system call fails, C<syscall> returns C<-1> and sets C<$!> (errno).
X<O_RDONLY> X<O_RDWR> X<O_WRONLY>
For historical reasons, some values work on almost every system
-supported by perl: zero means read-only, one means write-only, and two
+supported by Perl: 0 means read-only, 1 means write-only, and 2
means read/write. We know that these values do I<not> work under
OS/390 & VM/ESA Unix and on the Macintosh; you probably don't want to
use them in new code.
on this.
Note that C<sysopen> depends on the fdopen() C library function.
-On many UNIX systems, fdopen() is known to fail when file descriptors
+On many Unix systems, fdopen() is known to fail when file descriptors
exceed a certain value, typically 255. If you need more file
descriptors than that, consider rebuilding Perl to use the C<sfio>
library, or perhaps using the POSIX::open() function.
=item sysread FILEHANDLE,SCALAR,LENGTH
Attempts to read LENGTH bytes of data into variable SCALAR from the
-specified FILEHANDLE, using the system call read(2). It bypasses
+specified FILEHANDLE, using the read(2). It bypasses
buffered IO, so mixing this with other kinds of reads, C<print>,
C<write>, C<seek>, C<tell>, or C<eof> can cause confusion because the
perlio or stdio layers usually buffers data. Returns the number of
bytes before the result of the read is appended.
There is no syseof() function, which is ok, since eof() doesn't work
-very well on device files (like ttys) anyway. Use sysread() and check
+well on device files (like ttys) anyway. Use sysread() and check
for a return value for 0 to decide whether you're done.
Note that if the filehandle has been marked as C<:utf8> Unicode
=item sysseek FILEHANDLE,POSITION,WHENCE
X<sysseek> X<lseek>
-Sets FILEHANDLE's system position in bytes using the system call
+Sets FILEHANDLE's system position in bytes using
lseek(2). FILEHANDLE may be an expression whose value gives the name
of the filehandle. The values for WHENCE are C<0> to set the new
position to POSITION, C<1> to set the it to the current position plus
Note the I<in bytes>: even if the filehandle has been set to operate
on characters (for example by using the C<:encoding(utf8)> I/O layer),
tell() will return byte offsets, not character offsets (because
-implementing that would render sysseek() very slow).
+implementing that would render sysseek() unacceptably slow).
sysseek() bypasses normal buffered IO, so mixing this with reads (other
than C<sysread>, for example C<< <> >> or read()) C<print>, C<write>,
Does exactly the same thing as C<exec LIST>, except that a fork is
done first, and the parent process waits for the child process to
-complete. Note that argument processing varies depending on the
+exit. Note that argument processing varies depending on the
number of arguments. If there is more than one argument in LIST,
or if LIST is an array with more than one value, starts the program
given by the first element of the list with arguments given by the
printf "child exited with value %d\n", $? >> 8;
}
-Alternatively you might inspect the value of C<${^CHILD_ERROR_NATIVE}>
-with the W*() calls of the POSIX extension.
+Alternatively, you may inspect the value of C<${^CHILD_ERROR_NATIVE}>
+with the C<W*()> calls from the POSIX module.
-When the arguments get executed via the system shell, results
-and return codes will be subject to its quirks and capabilities.
+When C<system>'s arguments are executed indirectly by the shell,
+results and return codes are subject to its quirks.
See L<perlop/"`STRING`"> and L</exec> for details.
=item syswrite FILEHANDLE,SCALAR,LENGTH,OFFSET
=item syswrite FILEHANDLE,SCALAR
Attempts to write LENGTH bytes of data from variable SCALAR to the
-specified FILEHANDLE, using the system call write(2). If LENGTH is
+specified FILEHANDLE, using write(2). If LENGTH is
not specified, writes whole SCALAR. It bypasses buffered IO, so
mixing this with reads (other than C<sysread())>, C<print>, C<write>,
C<seek>, C<tell>, or C<eof> may cause confusion because the perlio and
stdio layers usually buffers data. Returns the number of bytes
actually written, or C<undef> if there was an error (in this case the
errno variable C<$!> is also set). If the LENGTH is greater than the
-available data in the SCALAR after the OFFSET, only as much data as is
+data available in the SCALAR after the OFFSET, only as much data as is
available will be written.
An OFFSET may be specified to write the data from some part of the
string other than the beginning. A negative OFFSET specifies writing
that many characters counting backwards from the end of the string.
-In the case the SCALAR is empty you can use OFFSET but only zero offset.
+If SCALAR is of length zero, you can only use an OFFSET of 0.
-Note that if the filehandle has been marked as C<:utf8>, Unicode
-characters are written instead of bytes (the LENGTH, OFFSET, and the
-return value of syswrite() are in UTF-8 encoded Unicode characters).
+B<Warning>: If the filehandle is marked C<:utf8>, Unicode characters
+encoded in UTF-8 are written instead of bytes, and the LENGTH, OFFSET, and
+return value of syswrite() are in (UTF-8 encoded Unicode) characters.
The C<:encoding(...)> layer implicitly introduces the C<:utf8> layer.
See L</binmode>, L</open>, and the C<open> pragma, L<open>.
There is no C<systell> function. Use C<sysseek(FH, 0, 1)> for that.
-Do not use tell() (or other buffered I/O operations) on a file handle
+Do not use tell() (or other buffered I/O operations) on a filehandle
that has been manipulated by sysread(), syswrite() or sysseek().
Those functions ignore the buffering, while tell() does not.
DESTROY this
UNTIE this
-A class implementing a file handle should have the following methods:
+A class implementing a filehandle should have the following methods:
TIEHANDLE classname, LIST
READ this, scalar, length, offset
Not all methods indicated above need be implemented. See L<perltie>,
L<Tie::Hash>, L<Tie::Array>, L<Tie::Scalar>, and L<Tie::Handle>.
-Unlike C<dbmopen>, the C<tie> function will not use or require a module
-for you--you need to do that explicitly yourself. See L<DB_File>
+Unlike C<dbmopen>, the C<tie> function will not C<use> or C<require> a module
+for you; you need to do that explicitly yourself. See L<DB_File>
or the F<Config> module for interesting C<tie> implementations.
For further details see L<perltie>, L<"tied VARIABLE">.
In scalar context, C<times> returns C<$user>.
-Note that times for children are included only after they terminate.
+Children's times are only included for terminated children.
=item tr///
=item truncate EXPR,LENGTH
Truncates the file opened on FILEHANDLE, or named by EXPR, to the
-specified length. Produces a fatal error if truncate isn't implemented
+specified length. Raises an exception if truncate isn't implemented
on your system. Returns true if successful, the undefined value
otherwise.
Returns an uppercased version of EXPR. This is the internal function
implementing the C<\U> escape in double-quoted strings.
It does not attempt to do titlecase mapping on initial letters. See
-C<ucfirst> for that.
+L</ucfirst> for that.
If EXPR is omitted, uses C<$_>.
so on.
If umask(2) is not implemented on your system and you are trying to
-restrict access for I<yourself> (i.e., (EXPR & 0700) > 0), produces a
-fatal error at run time. If umask(2) is not implemented and you are
+restrict access for I<yourself> (i.e., C<< (EXPR & 0700) > 0 >>),
+raises an exception. If umask(2) is not implemented and you are
not trying to restrict access for yourself, returns C<undef>.
Remember that a umask is a number, usually given in octal; it is I<not> a
Undefines the value of EXPR, which must be an lvalue. Use only on a
scalar value, an array (using C<@>), a hash (using C<%>), a subroutine
-(using C<&>), or a typeglob (using C<*>). (Saying C<undef $hash{$key}>
+(using C<&>), or a typeglob (using C<*>). Saying C<undef $hash{$key}>
will probably not do what you expect on most predefined variables or
-DBM list values, so don't do that; see L<delete>.) Always returns the
+DBM list values, so don't do that; see L<delete>. Always returns the
undefined value. You can omit the EXPR, in which case nothing is
undefined, but you still get an undefined value that you could, for
-instance, return from a subroutine, assign to a variable or pass as a
+instance, return from a subroutine, assign to a variable, or pass as a
parameter. Examples:
undef $foo;
foreach my $file ( @goners ) {
unlink $file or warn "Could not unlink $file: $!";
- }
+ }
Note: C<unlink> will not attempt to delete directories unless you are
superuser and the B<-U> flag is supplied to Perl. Even if these
and expands it out into a list of values.
(In scalar context, it returns merely the first value produced.)
-If EXPR is omitted, unpacks the C<$_> string. for an introduction to this function.
-
+If EXPR is omitted, unpacks the C<$_> string.
See L<perlpacktut> for an introduction to this function.
The string is broken into chunks described by the TEMPLATE. Each chunk
If there are more pack codes or if the repeat count of a field or a group
is larger than what the remainder of the input string allows, the result
-is not well defined: in some cases, the repeat count is decreased, or
-C<unpack()> will produce null strings or zeroes, or terminate with an
-error. If the input string is longer than one described by the TEMPLATE,
-the rest is ignored.
+is not well defined: the repeat count may be decreased, or
+C<unpack()> may produce empty strings or zeros, or it may raise an exception.
+If the input string is longer than one described by the TEMPLATE,
+the remainder of that input string is ignored.
See L</pack> for more examples and notes.
except that Module I<must> be a bareword.
-In the peculiar C<use VERSION> form, VERSION may be either a numeric
-argument such as 5.006, which will be compared to C<$]>, or a literal of
-the form v5.6.1, which will be compared to C<$^V> (aka $PERL_VERSION). A
-fatal error is produced if VERSION is greater than the version of the
+In the peculiar C<use VERSION> form, VERSION may be either a positive
+decimal fraction such as 5.006, which will be compared to C<$]>, or a v-string
+of the form v5.6.1, which will be compared to C<$^V> (aka $PERL_VERSION). An
+exception is raised if VERSION is greater than the version of the
current Perl interpreter; Perl will not attempt to parse the rest of the
file. Compare with L</require>, which can do a similar check at run time.
Symmetrically, C<no VERSION> allows you to specify that you want a version
-of perl older than the specified one.
+of Perl older than the specified one.
Specifying VERSION as a literal of the form v5.6.1 should generally be
avoided, because it leads to misleading error messages under earlier
C<use>ing library modules that won't work with older versions of Perl.
(We try not to do this more than we have to.)
-Also, if the specified perl version is greater than or equal to 5.9.5,
+Also, if the specified Perl version is greater than or equal to 5.9.5,
C<use VERSION> will also load the C<feature> pragma and enable all
features available in the requested version. See L<feature>.
-Similarly, if the specified perl version is greater than or equal to
+Similarly, if the specified Perl version is greater than or equal to
5.11.0, strictures are enabled lexically as with C<use strict> (except
that the F<strict.pm> file is not actually loaded).
The C<BEGIN> forces the C<require> and C<import> to happen at compile time. The
C<require> makes sure the module is loaded into memory if it hasn't been
-yet. The C<import> is not a builtin--it's just an ordinary static method
+yet. The C<import> is not a builtin; it's just an ordinary static method
call into the C<Module> package to tell the module to import the list of
features back into the current package. The module can implement its
C<import> method any way it likes, though most modules just choose to
Because C<use> takes effect at compile time, it doesn't respect the
ordinary flow control of the code being compiled. In particular, putting
a C<use> inside the false branch of a conditional doesn't prevent it
-from being processed. If a module or pragma needs to be loaded only
+from being processed. If a module or pragma only needs to be loaded
conditionally, this can be done using the L<if> pragma:
use if $] < 5.008, "utf8";
There's a corresponding C<no> command that unimports meanings imported
by C<use>, i.e., it calls C<unimport Module LIST> instead of C<import>.
-It behaves exactly as C<import> does with respect to VERSION, an
-omitted LIST, empty LIST, or no unimport method being found.
+It behaves just as C<import> does with VERSION, an omitted or empty LIST,
+or no unimport method being found.
no integer;
no strict 'refs';
no warnings;
See L<perlmodlib> for a list of standard modules and pragmas. See L<perlrun>
-for the C<-M> and C<-m> command-line options to perl that give C<use>
+for the C<-M> and C<-m> command-line options to Perl that give C<use>
functionality from the command-line.
=item utime LIST
$atime = $mtime = time;
utime $atime, $mtime, @ARGV;
-Since perl 5.7.2, if the first two elements of the list are C<undef>, then
-the utime(2) function in the C library will be called with a null second
+Since Perl 5.7.2, if the first two elements of the list are C<undef>,
+the utime(2) syscall from your C library is called with a null second
argument. On most systems, this will set the file's access and
-modification times to the current time (i.e. equivalent to the example
-above) and will even work on other users' files where you have write
+modification times to the current time (i.e., equivalent to the example
+above) and will work even on files you don't own provided you have write
permission:
- utime undef, undef, @ARGV;
+ for $file (@ARGV) {
+ utime(undef, undef, $file)
+ || warn "couldn't touch $file: $!";
+ }
Under NFS this will use the time of the NFS server, not the time of
the local machine. If there is a time synchronization problem, the
touch(1) command will in fact normally use this form instead of the
one shown in the first example.
-Note that only passing one of the first two elements as C<undef> will
-be equivalent of passing it as 0 and will not have the same effect as
-described when they are both C<undef>. This case will also trigger an
+Passing only one of the first two elements as C<undef> is
+equivalent to passing a 0 and will not have the effect
+described when both are C<undef>. This also triggers an
uninitialized warning.
-On systems that support futimes, you might pass file handles among the
-files. On systems that don't support futimes, passing file handles
-produces a fatal error at run time. The file handles must be passed
-as globs or references to be recognized. Barewords are considered
-file names.
+On systems that support futimes(2), you may pass filehandles among the
+files. On systems that don't support futimes(2), passing filehandles raises
+an exception. Filehandles must be passed as globs or glob references to be
+recognized; barewords are considered filenames.
=item values HASH
X<values>
of an array. (In a scalar context, returns the number of values.)
The values are returned in an apparently random order. The actual
-random order is subject to change in future versions of perl, but it
+random order is subject to change in future versions of Perl, but it
is guaranteed to be the same order as either the C<keys> or C<each>
function would produce on the same (unmodified) hash. Since Perl
5.8.1 the ordering is different even between different runs of Perl
iterator,
see L</each>. (In particular, calling values() in void context resets
the iterator with no other overhead. Apart from resetting the iterator,
-C<values @array> in list context is no different to plain C<@array>.
+C<values @array> in list context is the same as plain C<@array>.
We recommend that you use void context C<keys @array> for this, but reasoned
that it taking C<values @array> out would require more documentation than
leaving it in.)
If the selected element is outside the string, the value 0 is returned.
If an element off the end of the string is written to, Perl will first
extend the string with sufficiently many zero bytes. It is an error
-to try to write off the beginning of the string (i.e. negative OFFSET).
+to try to write off the beginning of the string (i.e., negative OFFSET).
If the string happens to be encoded as UTF-8 internally (and thus has
the UTF8 flag set), this is ignored by C<vec>, and it operates on the
.
__END__
-Regardless of the machine architecture on which it is run, the above
-example should print the following table:
+Regardless of the machine architecture on which it runs, the
+example above should print the following table:
0 1 2 3
unpack("V",$_) 01234567890123456789012345678901
=item wait
X<wait>
-Behaves like the wait(2) system call on your system: it waits for a child
+Behaves like wait(2) on your system: it waits for a child
process to terminate and returns the pid of the deceased process, or
C<-1> if there are no child processes. The status is returned in C<$?>
and C<${^CHILD_ERROR_NATIVE}>.
then you can do a non-blocking wait for all pending zombie processes.
Non-blocking wait is available on machines supporting either the
-waitpid(2) or wait4(2) system calls. However, waiting for a particular
+waitpid(2) or wait4(2) syscalls. However, waiting for a particular
pid with FLAGS of C<0> is implemented everywhere. (Perl emulates the
system call by remembering the status values of processes that have
exited but have not been harvested by the Perl script yet.)
No message is printed if there is a C<$SIG{__WARN__}> handler
installed. It is the handler's responsibility to deal with the message
as it sees fit (like, for instance, converting it into a C<die>). Most
-handlers must therefore make arrangements to actually display the
+handlers must therefore arrange to actually display the
warnings that they are not prepared to deal with, by calling C<warn>
again in the handler. Note that this is quite safe and will not
produce an endless loop, since C<__WARN__> hooks are not called from
=head1 NAME
-perlgpl - the GNU General Public License, version 2
+perlgpl - the GNU General Public License, version 1
=head1 SYNOPSIS
You can refer to this document in Pod via "L<perlgpl>"
Or you can see this document by entering "perldoc perlgpl"
-=cut
-
-# Because the following document's language disallows "changing"
-# it, we haven't gone thru and prettied it up with =item's or
-# anything. It's good enough the way it is.
-
=head1 DESCRIPTION
-This is B<"The GNU General Public License, version 2">. It's here so
-that modules, programs, etc., that want to declare this as their
-distribution license, can link to it.
-
-It is also one of the two licenses Perl allows itself to be
-redistributed and/or modified; for the other one, the Perl Artistic
-License, see the L<perlartistic>.
-
-=head1 GNU GENERAL PUBLIC LICENSE
-
- GNU GENERAL PUBLIC LICENSE
- Version 2, June 1991
-
- Copyright (C) 1989, 1991 Free Software Foundation, Inc.
- 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
- Preamble
-
- The licenses for most software are designed to take away your
-freedom to share and change it. By contrast, the GNU General Public
-License is intended to guarantee your freedom to share and change free
-software--to make sure the software is free for all its users. This
-General Public License applies to most of the Free Software
-Foundation's software and to any other program whose authors commit to
-using it. (Some other Free Software Foundation software is covered by
-the GNU Library General Public License instead.) You can apply it to
-your programs, too.
-
- When we speak of free software, we are referring to freedom, not
-price. Our General Public Licenses are designed to make sure that you
-have the freedom to distribute copies of free software (and charge for
-this service if you wish), that you receive source code or can get it
-if you want it, that you can change the software or use pieces of it
-in new free programs; and that you know you can do these things.
-
- To protect your rights, we need to make restrictions that forbid
-anyone to deny you these rights or to ask you to surrender the rights.
-These restrictions translate to certain responsibilities for you if you
-distribute copies of the software, or if you modify it.
-
- For example, if you distribute copies of such a program, whether
-gratis or for a fee, you must give the recipients all the rights that
-you have. You must make sure that they, too, receive or can get the
-source code. And you must show them these terms so they know their
-rights.
-
- We protect your rights with two steps: (1) copyright the software, and
-(2) offer you this license which gives you legal permission to copy,
-distribute and/or modify the software.
-
- Also, for each author's protection and ours, we want to make certain
-that everyone understands that there is no warranty for this free
-software. If the software is modified by someone else and passed on, we
-want its recipients to know that what they have is not the original, so
-that any problems introduced by others will not reflect on the original
-authors' reputations.
-
- Finally, any free program is threatened constantly by software
-patents. We wish to avoid the danger that redistributors of a free
-program will individually obtain patent licenses, in effect making the
-program proprietary. To prevent this, we have made it clear that any
-patent must be licensed for everyone's free use or not licensed at all.
-
- The precise terms and conditions for copying, distribution and
-modification follow.
-
- GNU GENERAL PUBLIC LICENSE
- TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-
- 0. This License applies to any program or other work which contains
-a notice placed by the copyright holder saying it may be distributed
-under the terms of this General Public License. The "Program", below,
-refers to any such program or work, and a "work based on the Program"
-means either the Program or any derivative work under copyright law:
-that is to say, a work containing the Program or a portion of it,
-either verbatim or with modifications and/or translated into another
-language. (Hereinafter, translation is included without limitation in
-the term "modification".) Each licensee is addressed as "you".
-
-Activities other than copying, distribution and modification are not
-covered by this License; they are outside its scope. The act of
-running the Program is not restricted, and the output from the Program
-is covered only if its contents constitute a work based on the
-Program (independent of having been made by running the Program).
-Whether that is true depends on what the Program does.
-
- 1. You may copy and distribute verbatim copies of the Program's
-source code as you receive it, in any medium, provided that you
-conspicuously and appropriately publish on each copy an appropriate
-copyright notice and disclaimer of warranty; keep intact all the
-notices that refer to this License and to the absence of any warranty;
-and give any other recipients of the Program a copy of this License
-along with the Program.
-
-You may charge a fee for the physical act of transferring a copy, and
-you may at your option offer warranty protection in exchange for a fee.
-
- 2. You may modify your copy or copies of the Program or any portion
-of it, thus forming a work based on the Program, and copy and
-distribute such modifications or work under the terms of Section 1
-above, provided that you also meet all of these conditions:
-
- a) You must cause the modified files to carry prominent notices
- stating that you changed the files and the date of any change.
-
- b) You must cause any work that you distribute or publish, that in
- whole or in part contains or is derived from the Program or any
- part thereof, to be licensed as a whole at no charge to all third
- parties under the terms of this License.
-
- c) If the modified program normally reads commands interactively
- when run, you must cause it, when started running for such
- interactive use in the most ordinary way, to print or display an
- announcement including an appropriate copyright notice and a
- notice that there is no warranty (or else, saying that you provide
- a warranty) and that users may redistribute the program under
- these conditions, and telling the user how to view a copy of this
- License. (Exception: if the Program itself is interactive but
- does not normally print such an announcement, your work based on
- the Program is not required to print an announcement.)
-
-These requirements apply to the modified work as a whole. If
-identifiable sections of that work are not derived from the Program,
-and can be reasonably considered independent and separate works in
-themselves, then this License, and its terms, do not apply to those
-sections when you distribute them as separate works. But when you
-distribute the same sections as part of a whole which is a work based
-on the Program, the distribution of the whole must be on the terms of
-this License, whose permissions for other licensees extend to the
-entire whole, and thus to each and every part regardless of who wrote it.
-
-Thus, it is not the intent of this section to claim rights or contest
-your rights to work written entirely by you; rather, the intent is to
-exercise the right to control the distribution of derivative or
-collective works based on the Program.
-
-In addition, mere aggregation of another work not based on the Program
-with the Program (or with a work based on the Program) on a volume of
-a storage or distribution medium does not bring the other work under
-the scope of this License.
-
- 3. You may copy and distribute the Program (or a work based on it,
-under Section 2) in object code or executable form under the terms of
-Sections 1 and 2 above provided that you also do one of the following:
-
- a) Accompany it with the complete corresponding machine-readable
- source code, which must be distributed under the terms of Sections
- 1 and 2 above on a medium customarily used for software
- interchange; or,
+Perl is free software; you can redistribute it and/or modify
+it under the terms of either:
- b) Accompany it with a written offer, valid for at least three
- years, to give any third party, for a charge no more than your
- cost of physically performing source distribution, a complete
- machine-readable copy of the corresponding source code, to be
- distributed under the terms of Sections 1 and 2 above on a medium
- customarily used for software interchange; or,
+ a) the GNU General Public License as published by the Free
+ Software Foundation; either version 1, or (at your option) any
+ later version, or
- c) Accompany it with the information you received as to the offer
- to distribute corresponding source code. (This alternative is
- allowed only for noncommercial distribution and only if you
- received the program in object code or executable form with such
- an offer, in accord with Subsection b above.)
+ b) the "Artistic License" which comes with this Kit.
-The source code for a work means the preferred form of the work for
-making modifications to it. For an executable work, complete source
-code means all the source code for all modules it contains, plus any
-associated interface definition files, plus the scripts used to
-control compilation and installation of the executable. However, as a
-special exception, the source code distributed need not include
-anything that is normally distributed (in either source or binary
-form) with the major components (compiler, kernel, and so on) of the
-operating system on which the executable runs, unless that component
-itself accompanies the executable.
+This is the B<"GNU General Public License, version 1">.
+It's here so that modules, programs, etc., that want to declare
+this as their distribution license can link to it.
-If distribution of executable or object code is made by offering
-access to copy from a designated place, then offering equivalent
-access to copy the source code from the same place counts as
-distribution of the source code, even though third parties are not
-compelled to copy the source along with the object code.
+For the Perl Artistic License, see L<perlartistic>.
- 4. You may not copy, modify, sublicense, or distribute the Program
-except as expressly provided under this License. Any attempt
-otherwise to copy, modify, sublicense or distribute the Program is
-void, and will automatically terminate your rights under this License.
-However, parties who have received copies, or rights, from you under
-this License will not have their licenses terminated so long as such
-parties remain in full compliance.
-
- 5. You are not required to accept this License, since you have not
-signed it. However, nothing else grants you permission to modify or
-distribute the Program or its derivative works. These actions are
-prohibited by law if you do not accept this License. Therefore, by
-modifying or distributing the Program (or any work based on the
-Program), you indicate your acceptance of this License to do so, and
-all its terms and conditions for copying, distributing or modifying
-the Program or works based on it.
-
- 6. Each time you redistribute the Program (or any work based on the
-Program), the recipient automatically receives a license from the
-original licensor to copy, distribute or modify the Program subject to
-these terms and conditions. You may not impose any further
-restrictions on the recipients' exercise of the rights granted herein.
-You are not responsible for enforcing compliance by third parties to
-this License.
-
- 7. If, as a consequence of a court judgment or allegation of patent
-infringement or for any other reason (not limited to patent issues),
-conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License. If you cannot
-distribute so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you
-may not distribute the Program at all. For example, if a patent
-license would not permit royalty-free redistribution of the Program by
-all those who receive copies directly or indirectly through you, then
-the only way you could satisfy both it and this License would be to
-refrain entirely from distribution of the Program.
-
-If any portion of this section is held invalid or unenforceable under
-any particular circumstance, the balance of the section is intended to
-apply and the section as a whole is intended to apply in other
-circumstances.
-
-It is not the purpose of this section to induce you to infringe any
-patents or other property right claims or to contest validity of any
-such claims; this section has the sole purpose of protecting the
-integrity of the free software distribution system, which is
-implemented by public license practices. Many people have made
-generous contributions to the wide range of software distributed
-through that system in reliance on consistent application of that
-system; it is up to the author/donor to decide if he or she is willing
-to distribute software through any other system and a licensee cannot
-impose that choice.
-
-This section is intended to make thoroughly clear what is believed to
-be a consequence of the rest of this License.
-
- 8. If the distribution and/or use of the Program is restricted in
-certain countries either by patents or by copyrighted interfaces, the
-original copyright holder who places the Program under this License
-may add an explicit geographical distribution limitation excluding
-those countries, so that distribution is permitted only in or among
-countries not thus excluded. In such case, this License incorporates
-the limitation as if written in the body of this License.
-
- 9. The Free Software Foundation may publish revised and/or new versions
-of the General Public License from time to time. Such new versions will
-be similar in spirit to the present version, but may differ in detail to
-address new problems or concerns.
-
-Each version is given a distinguishing version number. If the Program
-specifies a version number of this License which applies to it and
-"any later version", you have the option of following the terms and
-conditions either of that version or of any later version published by
-the Free Software Foundation. If the Program does not specify a
-version number of this License, you may choose any version ever
-published by the Free Software Foundation.
-
- 10. If you wish to incorporate parts of the Program into other free
-programs whose distribution conditions are different, write to the author
-to ask for permission. For software which is copyrighted by the Free
-Software Foundation, write to the Free Software Foundation; we sometimes
-make exceptions for this. Our decision will be guided by the two goals
-of preserving the free status of all derivatives of our free software and
-of promoting the sharing and reuse of software generally.
-
- NO WARRANTY
-
- 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO
-WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
-EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
-OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY
-KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
-PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME
-THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
-
- 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
-WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
-AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU
-FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
-CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
-PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
-RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
-FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF
-SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
-DAMAGES.
-
- END OF TERMS AND CONDITIONS
-
- How to Apply These Terms to Your New Programs
-
- If you develop a new program, and you want it to be of the greatest
-possible use to the public, the best way to achieve this is to make it
-free software which everyone can redistribute and change under these
-terms.
-
- To do so, attach the following notices to the program. It is safest
-to attach them to the start of each source file to most effectively
-convey the exclusion of warranty; and each file should have at least
-the "copyright" line and a pointer to where the full notice is found.
-
- <one line to give the program's name and a brief idea of what it does.>
- Copyright (C) <year> <name of author>
-
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-
-
-Also add information on how to contact you by electronic and paper mail.
-
-If the program is interactive, make it output a short notice like this
-when it starts in an interactive mode:
-
- Gnomovision version 69, Copyright (C) year name of author
- Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
- This is free software, and you are welcome to redistribute it
- under certain conditions; type `show c' for details.
-
-The hypothetical commands `show w' and `show c' should show the appropriate
-parts of the General Public License. Of course, the commands you use may
-be called something other than `show w' and `show c'; they could even be
-mouse-clicks or menu items--whatever suits your program.
-
-You should also get your employer (if you work as a programmer) or your
-school, if any, to sign a "copyright disclaimer" for the program, if
-necessary. Here is a sample; alter the names:
-
- Yoyodyne, Inc., hereby disclaims all copyright interest in the program
- `Gnomovision' (which makes passes at compilers) written by James Hacker.
-
- <signature of Ty Coon>, 1 April 1989
- Ty Coon, President of Vice
+=cut
-This General Public License does not permit incorporating your program into
-proprietary programs. If your program is a subroutine library, you may
-consider it more useful to permit linking proprietary applications with the
-library. If this is what you want to do, use the GNU Library General
-Public License instead of this License.
+# Because the following document's language disallows "changing"
+# it, we haven't gone thru and prettied it up with =item's or
+# anything. It's good enough the way it is.
+=head1 GNU GENERAL PUBLIC LICENSE
-[End.]
+ GNU GENERAL PUBLIC LICENSE
+ Version 1, February 1989
+
+ Copyright (C) 1989 Free Software Foundation, Inc.
+ 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The license agreements of most software companies try to keep users
+ at the mercy of those companies. By contrast, our General Public
+ License is intended to guarantee your freedom to share and change free
+ software--to make sure the software is free for all its users. The
+ General Public License applies to the Free Software Foundation's
+ software and to any other program whose authors commit to using it.
+ You can use it for your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+ price. Specifically, the General Public License is designed to make
+ sure that you have the freedom to give away or sell copies of free
+ software, that you receive source code or can get it if you want it,
+ that you can change the software or use pieces of it in new free
+ programs; and that you know you can do these things.
+
+ To protect your rights, we need to make restrictions that forbid
+ anyone to deny you these rights or to ask you to surrender the rights.
+ These restrictions translate to certain responsibilities for you if you
+ distribute copies of the software, or if you modify it.
+
+ For example, if you distribute copies of a such a program, whether
+ gratis or for a fee, you must give the recipients all the rights that
+ you have. You must make sure that they, too, receive or can get the
+ source code. And you must tell them their rights.
+
+ We protect your rights with two steps: (1) copyright the software, and
+ (2) offer you this license which gives you legal permission to copy,
+ distribute and/or modify the software.
+
+ Also, for each author's protection and ours, we want to make certain
+ that everyone understands that there is no warranty for this free
+ software. If the software is modified by someone else and passed on, we
+ want its recipients to know that what they have is not the original, so
+ that any problems introduced by others will not reflect on the original
+ authors' reputations.
+
+ The precise terms and conditions for copying, distribution and
+ modification follow.
+
+ GNU GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License Agreement applies to any program or other work which
+ contains a notice placed by the copyright holder saying it may be
+ distributed under the terms of this General Public License. The
+ "Program", below, refers to any such program or work, and a "work based
+ on the Program" means either the Program or any work containing the
+ Program or a portion of it, either verbatim or with modifications. Each
+ licensee is addressed as "you".
+
+ 1. You may copy and distribute verbatim copies of the Program's source
+ code as you receive it, in any medium, provided that you conspicuously and
+ appropriately publish on each copy an appropriate copyright notice and
+ disclaimer of warranty; keep intact all the notices that refer to this
+ General Public License and to the absence of any warranty; and give any
+ other recipients of the Program a copy of this General Public License
+ along with the Program. You may charge a fee for the physical act of
+ transferring a copy.
+
+ 2. You may modify your copy or copies of the Program or any portion of
+ it, and copy and distribute such modifications under the terms of Paragraph
+ 1 above, provided that you also do the following:
+
+ a) cause the modified files to carry prominent notices stating that
+ you changed the files and the date of any change; and
+
+ b) cause the whole of any work that you distribute or publish, that
+ in whole or in part contains the Program or any part thereof, either
+ with or without modifications, to be licensed at no charge to all
+ third parties under the terms of this General Public License (except
+ that you may choose to grant warranty protection to some or all
+ third parties, at your option).
+
+ c) If the modified program normally reads commands interactively when
+ run, you must cause it, when started running for such interactive use
+ in the simplest and most usual way, to print or display an
+ announcement including an appropriate copyright notice and a notice
+ that there is no warranty (or else, saying that you provide a
+ warranty) and that users may redistribute the program under these
+ conditions, and telling the user how to view a copy of this General
+ Public License.
+
+ d) You may charge a fee for the physical act of transferring a
+ copy, and you may at your option offer warranty protection in
+ exchange for a fee.
+
+ Mere aggregation of another independent work with the Program (or its
+ derivative) on a volume of a storage or distribution medium does not bring
+ the other work under the scope of these terms.
+
+ 3. You may copy and distribute the Program (or a portion or derivative of
+ it, under Paragraph 2) in object code or executable form under the terms of
+ Paragraphs 1 and 2 above provided that you also do one of the following:
+
+ a) accompany it with the complete corresponding machine-readable
+ source code, which must be distributed under the terms of
+ Paragraphs 1 and 2 above; or,
+
+ b) accompany it with a written offer, valid for at least three
+ years, to give any third party free (except for a nominal charge
+ for the cost of distribution) a complete machine-readable copy of the
+ corresponding source code, to be distributed under the terms of
+ Paragraphs 1 and 2 above; or,
+
+ c) accompany it with the information you received as to where the
+ corresponding source code may be obtained. (This alternative is
+ allowed only for noncommercial distribution and only if you
+ received the program in object code or executable form alone.)
+
+ Source code for a work means the preferred form of the work for making
+ modifications to it. For an executable file, complete source code means
+ all the source code for all modules it contains; but, as a special
+ exception, it need not include source code for modules which are standard
+ libraries that accompany the operating system on which the executable
+ file runs, or for standard header files or definitions files that
+ accompany that operating system.
+
+ 4. You may not copy, modify, sublicense, distribute or transfer the
+ Program except as expressly provided under this General Public License.
+ Any attempt otherwise to copy, modify, sublicense, distribute or transfer
+ the Program is void, and will automatically terminate your rights to use
+ the Program under this License. However, parties who have received
+ copies, or rights to use copies, from you under this General Public
+ License will not have their licenses terminated so long as such parties
+ remain in full compliance.
+
+ 5. By copying, distributing or modifying the Program (or any work based
+ on the Program) you indicate your acceptance of this license to do so,
+ and all its terms and conditions.
+
+ 6. Each time you redistribute the Program (or any work based on the
+ Program), the recipient automatically receives a license from the original
+ licensor to copy, distribute or modify the Program subject to these
+ terms and conditions. You may not impose any further restrictions on the
+ recipients' exercise of the rights granted herein.
+
+ 7. The Free Software Foundation may publish revised and/or new versions
+ of the General Public License from time to time. Such new versions will
+ be similar in spirit to the present version, but may differ in detail to
+ address new problems or concerns.
+
+ Each version is given a distinguishing version number. If the Program
+ specifies a version number of the license which applies to it and "any
+ later version", you have the option of following the terms and conditions
+ either of that version or of any later version published by the Free
+ Software Foundation. If the Program does not specify a version number of
+ the license, you may choose any version ever published by the Free Software
+ Foundation.
+
+ 8. If you wish to incorporate parts of the Program into other free
+ programs whose distribution conditions are different, write to the author
+ to ask for permission. For software which is copyrighted by the Free
+ Software Foundation, write to the Free Software Foundation; we sometimes
+ make exceptions for this. Our decision will be guided by the two goals
+ of preserving the free status of all derivatives of our free software and
+ of promoting the sharing and reuse of software generally.
+
+ NO WARRANTY
+
+ 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+ FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+ OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+ PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+ OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+ MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
+ TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
+ PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+ REPAIR OR CORRECTION.
+
+ 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+ WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+ REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+ INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+ OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+ TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+ YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+ PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+ POSSIBILITY OF SUCH DAMAGES.
+
+ END OF TERMS AND CONDITIONS
+
+ Appendix: How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+ possible use to humanity, the best way to achieve this is to make it
+ free software which everyone can redistribute and change under these
+ terms.
+
+ To do so, attach the following notices to the program. It is safest to
+ attach them to the start of each source file to most effectively convey
+ the exclusion of warranty; and each file should have at least the
+ "copyright" line and a pointer to where the full notice is found.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) 19yy <name of author>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 1, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software Foundation,
+ Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+ Also add information on how to contact you by electronic and paper mail.
+
+ If the program is interactive, make it output a short notice like this
+ when it starts in an interactive mode:
+
+ Gnomovision version 69, Copyright (C) 19xx name of author
+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+ The hypothetical commands `show w' and `show c' should show the
+ appropriate parts of the General Public License. Of course, the
+ commands you use may be called something other than `show w' and `show
+ c'; they could even be mouse-clicks or menu items--whatever suits your
+ program.
+
+ You should also get your employer (if you work as a programmer) or your
+ school, if any, to sign a "copyright disclaimer" for the program, if
+ necessary. Here a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the
+ program `Gnomovision' (a program to direct compilers to make passes
+ at assemblers) written by James Hacker.
+
+ <signature of Ty Coon>, 1 April 1989
+ Ty Coon, President of Vice
+
+ That's all there is to it!
=cut
If you are not sure then doing an C<SvREFCNT_inc> and C<sv_2mortal>, or
making a C<sv_mortalcopy> is safer.
-The mortal routines are not just for SVs -- AVs and HVs can be
+The mortal routines are not just for SVs; AVs and HVs can be
made mortal by passing their address (type-casted to C<SV*>) to the
C<sv_2mortal> or C<sv_mortalcopy> routines.
=head2 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
-array is created, which is called a scratchpad for the current
-unit.
+are created. The answer is that they are created when the current
+unit--a subroutine or a file (for opcodes for statements outside of
+subroutines)--is compiled. During this time a special anonymous Perl
+array is created, which is called a scratchpad for the current unit.
A scratchpad keeps SVs which are lexicals for the current unit and are
targets for opcodes. One can deduce that an SV lives on a scratchpad
state. With multiplicity-enabled perls, PERL_IMPLICIT_CONTEXT is also
normally defined, and enables the support for passing in a "hidden" first
argument that represents all three data structures. MULTIPLICITY makes
-mutli-threaded perls possible (with the ithreads threading model, related
+multi-threaded perls possible (with the ithreads threading model, related
to the macro USE_ITHREADS.)
Two other "encapsulation" macros are the PERL_GLOBAL_STRUCT and
Similarly, all global variables begin with C<PL_>. (By convention,
static functions start with C<S_>.)
-Inside the Perl core, you can get at the functions either with or
-without the C<Perl_> prefix, thanks to a bunch of defines that live in
-F<embed.h>. This header file is generated automatically from
+Inside the Perl core (C<PERL_CORE> defined), you can get at the functions
+either with or without the C<Perl_> prefix, thanks to a bunch of defines
+that live in F<embed.h>. Note that extension code should I<not> set
+C<PERL_CORE>; this exposes the full perl internals, and is likely to cause
+breakage of the XS in each new perl release.
+
+The file F<embed.h> is generated automatically from
F<embed.pl> and F<embed.fnc>. F<embed.pl> also creates the prototyping
header files for the internal functions, generates the documentation
and a lot of other bits and pieces. It's important that when you add
need to enter a name and description for your op at the appropriate
place in the C<PL_custom_op_names> and C<PL_custom_op_descs> hashes.
-Forthcoming versions of C<B::Generate> (version 1.0 and above) should
-directly support the creation of custom ops by name.
+C<B::Generate> directly supports the creation of custom ops by name.
=head1 AUTHORS
=head1 SEE ALSO
-perlapi(1), perlintern(1), perlxs(1), perlembed(1)
+L<perlapi>, L<perlintern>, L<perlxs>, L<perlembed>
portability of the core code rests with the Configure pumpkin -
others help out with individual operating systems.
-The three files that fall under his/her resposibility are Configure,
+The three files that fall under his/her responsibility are Configure,
config_h.SH, and Porting/Glossary (and a whole bunch of small related
files that are less important here). The Configure pumpkin decides how
patches to these are dealt with. Currently, the Configure pumpkin will
=back
The C<-Wtraditional> is another example of the annoying tendency of
-gcc to bundle a lot of warnings under one switch -- it would be
-impossible to deploy in practice because it would complain a lot -- but
+gcc to bundle a lot of warnings under one switch (it would be
+impossible to deploy in practice because it would complain a lot) but
it does contain some warnings that would be beneficial to have available
on their own, such as the warning about string constants inside macros
containing the macro arguments: this behaved differently pre-ANSI
The following are common causes of compilation and/or execution
failures, not common to Perl as such. The C FAQ is good bedtime
reading. Please test your changes with as many C compilers and
-platforms as possible -- we will, anyway, and it's nice to save
+platforms as possible; we will, anyway, and it's nice to save
oneself from public embarrassment.
If using gcc, you can add the C<-std=c89> option which will hopefully
#endif
How does the HAS_QUUX become defined where it needs to be? Well, if
-Foonix happens to be UNIXy enough to be able to run the Configure
+Foonix happens to be Unixy enough to be able to run the Configure
script, and Configure has been taught about detecting and testing
quux(), the HAS_QUUX will be correctly defined. In other platforms,
the corresponding configuration step will hopefully do the same.
minutes become hours. For example as of Perl 5.8.1, the
ext/Encode/t/Unicode.t takes extraordinarily long to complete under
e.g. Purify, Third Degree, and valgrind. Under valgrind it takes more
-than six hours, even on a snappy computer-- the said test must be
+than six hours, even on a snappy computer. The said test must be
doing something that is quite unfriendly for memory debuggers. If you
don't feel like waiting, that you can simply kill away the perl
process.
B<NOTE 2>: To minimize the number of memory leak false alarms (see
-L</PERL_DESTRUCT_LEVEL> for more information), you have to have
-environment variable PERL_DESTRUCT_LEVEL set to 2. The F<TEST>
-and harness scripts do that automatically. But if you are running
-some of the tests manually-- for csh-like shells:
+L</PERL_DESTRUCT_LEVEL> for more information), you have to set the
+environment variable PERL_DESTRUCT_LEVEL to 2.
+
+For csh-like shells:
setenv PERL_DESTRUCT_LEVEL 2
-and for Bourne-type shells:
+For Bourne-type shells:
PERL_DESTRUCT_LEVEL=2
export PERL_DESTRUCT_LEVEL
-or in UNIXy environments you can also use the C<env> command:
+In Unixy environments you can also use the C<env> command:
env PERL_DESTRUCT_LEVEL=2 valgrind ./perl -Ilib ...
=head2 Gprof Profiling
-gprof is a profiling tool available in many UNIX platforms,
+gprof is a profiling tool available in many Unix platforms,
it uses F<statistical time-sampling>.
You can build a profiled version of perl called "perl.gprof" by
+=encoding utf8
+
=head1 NAME
perlhist - the Perl history records
Ing-Simmons, Chip Salzenberg, Tim Bunce, Malcolm Beattie, Gurusamy
Sarathy, Graham Barr, Jarkko Hietaniemi, Hugo van der Sanden,
Michael Schwern, Rafael Garcia-Suarez, Nicholas Clark, Richard Clamp,
-Leon Brocard, Dave Mitchell, Jesse Vincent.
+Leon Brocard, Dave Mitchell, Jesse Vincent, Ricardo Signes, Steve Hay.
=head2 PUMPKIN?
5.11.1 2009-Oct-20
Leon 5.11.2 2009-Nov-20
Jesse 5.11.3 2009-Dec-20
+ Ricardo 5.11.4 2010-Jan-20
+ Steve 5.11.5 2010-Feb-20
+ Jesse 5.12.0-RC1 2010-Mar-29
+ Jesse 5.12.0 2010-Apr-12
+ Leon 5.13.0 2010-Apr-20
+ Jesse 5.12.1 2010-May-16
=head2 SELECTED RELEASE SIZES
if (@animals < 5) { ... }
The elements we're getting from the array start with a C<$> because
-we're getting just a single value out of the array -- you ask for a scalar,
+we're getting just a single value out of the array; you ask for a scalar,
you get a scalar.
To get multiple values from an array:
=head2 Conditional and looping constructs
-Perl has most of the usual conditional and looping constructs except for
-case/switch (but if you really want it, there is a Switch module in Perl
-5.8 and newer, and on CPAN. See the section on modules, below, for more
-information about modules and CPAN).
+Perl has most of the usual conditional and looping constructs. As of Perl
+5.10, it even has a case/switch statement (spelled C<given>/C<when>). See
+L<perlsyn/"Switch statements"> for more details.
The conditions can be any Perl expression. See the list of operators in
the next section for information on comparison and boolean logic operators,
! not
(C<and>, C<or> and C<not> aren't just in the above table as descriptions
-of the operators -- they're also supported as operators in their own
+of the operators. They're also supported as operators in their own
right. They're more readable than the C-style operators, but have
different precedence to C<&&> and friends. Check L<perlop> for more
detail.)
order.
sysopen() operates (unsurprisingly) at a lower level in the stack than
-open(). For example in UNIX or UNIX-like systems sysopen() operates
+open(). For example in Unix or Unix-like systems sysopen() operates
directly at the level of file descriptors: in the terms of PerlIO
layers, it uses only the "unix" layer, which is a rather thin wrapper
-on top of the UNIX file descriptors.
+on top of the Unix file descriptors.
=head2 Layers vs Disciplines
Unread PerlIOBase_unread
Write FAILURE
- FAILURE Set errno (to EINVAL in UNIXish, to LIB$_INVARG in VMS) and
+ FAILURE Set errno (to EINVAL in Unixish, to LIB$_INVARG in VMS) and
return -1 (for numeric return values) or NULL (for pointers)
INHERITED Inherited from the layer below
SUCCESS Return 0 (for numeric return values) or a pointer
convenience", and to do anything you wanted in your signal handler,
and be prepared to clean up core dumps now and again.
-In Perl 5.7.3 and later to avoid these problems signals are
-"deferred"-- that is when the signal is delivered to the process by
+Perl 5.7.3 and later avoid these problems by "deferring" signals.
+That is, when the signal is delivered to the process by
the system (to the C code that implements Perl) a flag is set, and the
handler returns immediately. Then at strategic "safe" points in the
Perl interpreter (e.g. when it is about to execute a new opcode) the
never exit. A single process closing a pipe is not enough to close it;
the last process with the pipe open must close it for it to read EOF.
-There are some features built-in to unix to help prevent this most of
+Certain built-in Unix features help prevent this most of
the time. For instance, filehandles have a 'close on exec' flag (set
I<en masse> with Perl using the C<$^F> L<perlvar>), so that any
filehandles which you didn't explicitly route to the STDIN, STDOUT or
use IPC::SysV qw(IPC_PRIVATE IPC_RMID S_IRUSR S_IWUSR);
$size = 2000;
- $id = shmget(IPC_PRIVATE, $size, S_IRUSR|S_IWUSR) || die "$!";
+ $id = shmget(IPC_PRIVATE, $size, S_IRUSR|S_IWUSR) // die "$!";
print "shm key $id\n";
$message = "Message #1";
use IPC::SysV qw(IPC_CREAT);
$IPC_KEY = 1234;
- $id = semget($IPC_KEY, 10, 0666 | IPC_CREAT ) || die "$!";
+ $id = semget($IPC_KEY, 10, 0666 | IPC_CREAT ) // die "$!";
print "shm key $id\n";
Put this code in a separate file to be run in more than one process.
}
When this code is run with the B<-w> flag, a warning will be produced
-for the C<$a> line -- C<"Reversed += operator">.
+for the C<$a> line: C<"Reversed += operator">.
The problem is that Perl has both compile-time and run-time warnings. To
disable compile-time warnings you need to rewrite the code like this:
=item 2.
-The B<-w> flag just sets the global C<$^W> variable as in 5.005 -- this
+The B<-w> flag just sets the global C<$^W> variable as in 5.005. This
means that any legacy code that currently relies on manipulating C<$^W>
to control warning behavior will still work as is.
| |
| +- digit
| |
+ | +- illegalproto
+ | |
| +- parenthesis
| |
| +- precedence
=head2 I18N::Langinfo
Another interface for querying locale-dependent information is the
-I18N::Langinfo::langinfo() function, available at least in UNIX-like
+I18N::Langinfo::langinfo() function, available at least in Unix-like
systems and VMS.
The following example will import the langinfo() function itself and
B<NOTE>: C<LANGUAGE> is a GNU extension, it affects you only if you
are using the GNU libc. This is the case if you are using e.g. Linux.
-If you are using "commercial" UNIXes you are most probably I<not>
+If you are using "commercial" Unixes you are most probably I<not>
using GNU libc and you can ignore C<LANGUAGE>.
However, in the case you are using C<LANGUAGE>: it affects the
=head1 SEE ALSO
-perldata(1), perlref(1), perldsc(1)
+L<perldata>, L<perlref>, L<perldsc>
=head1 AUTHOR
}
Would print '1', because C<$foo> holds a reference to the I<original>
-C<$bar> -- the one that was stuffed away by C<local()> and which will be
+C<$bar>. The one that was stuffed away by C<local()> and which will be
restored when the block ends. Because variables are accessed through the
typeglob, you can use C<*foo = *bar> to create an alias which can be
localized. (But be aware that this means you can't have a separate
A C<BEGIN> code block is executed as soon as possible, that is, the moment
it is completely defined, even before the rest of the containing file (or
string) is parsed. You may have multiple C<BEGIN> blocks within a file (or
-eval'ed string) -- they will execute in order of definition. Because a C<BEGIN>
+eval'ed string); they will execute in order of definition. Because a C<BEGIN>
code block executes immediately, it can pull in definitions of subroutines
and such from other files in time to be visible to the rest of the compile
and run time. Once a C<BEGIN> has run, it is immediately undefined and any
might have come with your module!
Also note that these instructions are tailored for installing the
-module into your system's repository of Perl modules -- but you can
+module into your system's repository of Perl modules, but you can
install modules into any directory you wish. For instance, where I
say C<perl Makefile.PL>, you can substitute C<perl Makefile.PL
PREFIX=/my/perl_directory> to install the modules into
in your Perl 5 library directory. Often, you'll need to be root.
That's all you need to do on Unix systems with dynamic linking.
-Most Unix systems have dynamic linking -- if yours doesn't, or if for
+Most Unix systems have dynamic linking. If yours doesn't, or if for
another reason you have a statically-linked perl, B<and> the
module requires compilation, you'll need to build a new Perl binary
that includes the module. Again, you'll probably need to be root.
Does the module require compilation (i.e. does it have files that end
in .xs, .c, .h, .y, .cc, .cxx, or .C)? If it does, life is now
officially tough for you, because you have to compile the module
-yourself -- no easy feat on Windows. You'll need a compiler such as
+yourself (no easy feat on Windows). You'll need a compiler such as
Visual C++. Alternatively, you can download a pre-built PPM package
from ActiveState.
http://aspn.activestate.com/ASPN/Downloads/ActivePerl/PPM/
open (MANIFEST, "../MANIFEST") or die $!;
@files = grep m#(?:\.pm|\.pod|_pm\.PL)#, map {s/\s.*//s; $_}
- grep {m#^lib# || m#^ext#} grep !m#/(?:t|demo)/#, <MANIFEST>;
+ grep { m#^(lib|ext|dist|cpan)/# && !m#/(?:t|demo)/# } <MANIFEST>;
my %exceptions = (
'abbrev' => 'Text::Abbrev',
Always use B<-w>.
-Follow the guidelines in the perlstyle(1) manual.
+Follow the guidelines in L<perlstyle>.
Always use B<-w>.
For Module::Build you would use the C<make test> equivalent C<perl Build test>.
The importance of these tests is proportional to the alleged stability of a
-module -- a module which purports to be stable or which hopes to achieve wide
+module. A module which purports to be stable or which hopes to achieve wide
use should adhere to as strict a testing regime as possible.
Useful modules to help you write tests (with minimum impact on your
L<perlmod>, L<perlmodlib>, L<perlmodinstall>, L<h2xs>, L<strict>,
L<Carp>, L<Exporter>, L<perlpod>, L<Test::Simple>, L<Test::More>
L<ExtUtils::MakeMaker>, L<Module::Build>, L<Module::Starter>
-http://www.cpan.org/ , Ken Williams' tutorial on building your own
+http://www.cpan.org/ , Ken Williams's tutorial on building your own
module at http://mathforum.org/~ken/perl_modules.html
call compiled as a method, or vice versa. This can introduce subtle bugs
that are hard to detect.
-For example, a call to a method C<new> in indirect notation -- as C++
-programmers are wont to make -- can be miscompiled into a subroutine
+For example, a call to a method C<new> in indirect notation (as C++
+programmers are wont to make) can be miscompiled into a subroutine
call if there's already a C<new> function in scope. You'd end up
calling the current package's C<new> as a subroutine, rather than the
desired class's method. The compiler tries to cheat by remembering
# code
}
-The range operator also works on strings, using the magical auto-increment,
-see below.
+The range operator also works on strings, using the magical
+auto-increment, see below.
In scalar context, ".." returns a boolean value. The operator is
-bistable, like a flip-flop, and emulates the line-range (comma) operator
-of B<sed>, B<awk>, and various editors. Each ".." operator maintains its
-own boolean state. It is false as long as its left operand is false.
+bistable, like a flip-flop, and emulates the line-range (comma)
+operator of B<sed>, B<awk>, and various editors. Each ".." operator
+maintains its own boolean state, even across calls to a subroutine
+that contains it. It is false as long as its left operand is false.
Once the left operand is true, the range operator stays true until the
right operand is true, I<AFTER> which the range operator becomes false
-again. It doesn't become false till the next time the range operator is
-evaluated. It can test the right operand and become false on the same
-evaluation it became true (as in B<awk>), but it still returns true once.
-If you don't want it to test the right operand until the next
-evaluation, as in B<sed>, just use three dots ("...") instead of
+again. It doesn't become false till the next time the range operator
+is evaluated. It can test the right operand and become false on the
+same evaluation it became true (as in B<awk>), but it still returns
+true once. If you don't want it to test the right operand until the
+next evaluation, as in B<sed>, just use three dots ("...") instead of
two. In all other regards, "..." behaves just like ".." does.
The right operand is not evaluated while the operator is in the
"false" state, and the left operand is not evaluated while the
operator is in the "true" state. The precedence is a little lower
than || and &&. The value returned is either the empty string for
-false, or a sequence number (beginning with 1) for true. The
-sequence number is reset for each range encountered. The final
-sequence number in a range has the string "E0" appended to it, which
-doesn't affect its numeric value, but gives you something to search
-for if you want to exclude the endpoint. You can exclude the
-beginning point by waiting for the sequence number to be greater
-than 1.
+false, or a sequence number (beginning with 1) for true. The sequence
+number is reset for each range encountered. The final sequence number
+in a range has the string "E0" appended to it, which doesn't affect
+its numeric value, but gives you something to search for if you want
+to exclude the endpoint. You can exclude the beginning point by
+waiting for the sequence number to be greater than 1.
If either operand of scalar ".." is a constant expression,
that operand is considered true if it is equal (C<==>) to the current
As a scalar operator:
if (101 .. 200) { print; } # print 2nd hundred lines, short for
- # if ($. == 101 .. $. == 200) { print; }
+ # if ($. == 101 .. $. == 200) { print; }
next LINE if (1 .. /^$/); # skip header lines, short for
# next LINE if ($. == 1 .. /^$/);
To get lower-case greek letters, use this instead:
- my @greek_small = map { chr } ( ord("\N{alpha}") .. ord("\N{omega}") );
+ my @greek_small = map { chr } ( ord("\N{alpha}") ..
+ ord("\N{omega}") );
Because each operand is evaluated in integer form, C<2.18 .. 3.14> will
return two elements in list context.
=head2 Yada Yada Operator
X<...> X<... operator> X<yada yada operator>
-The yada yada operator (noted C<...>) is a placeholder for code.
-It parses without error, but when executed it throws an exception
-with the text C<Unimplemented>:
-
- sub foo { ... }
- foo();
-
- Unimplemented at <file> line <line number>.
-
-It takes no argument.
+The yada yada operator (noted C<...>) is a placeholder for code. Perl
+parses it without error, but when you try to execute a yada yada, it
+throws an exception with the text C<Unimplemented>:
+
+ sub unimplemented { ... }
+
+ eval { unimplemented() };
+ if( $@ eq 'Unimplemented' ) {
+ print "I found the yada yada!\n";
+ }
+
+You can only use the yada yada to stand in for a complete statement.
+These examples of the yada yada work:
+
+ { ... }
+
+ sub foo { ... }
+
+ ...;
+
+ eval { ... };
+
+ sub foo {
+ my( $self ) = shift;
+
+ ...;
+ }
+
+ do { my $n; ...; print 'Hurrah!' };
+
+The yada yada cannot stand in for an expression that is part of a
+larger statement since the C<...> is also the three-dot version of the
+range operator (see L<Range Operators>). These examples of the yada
+yada are still syntax errors:
+
+ print ...;
+
+ open my($fh), '>', '/dev/passwd' or ...;
+
+ if( $condition && ... ) { print "Hello\n" };
+
+There are some cases where Perl can't immediately tell the difference
+between an expression and a statement. For instance, the syntax for a
+block and an anonymous hash reference constructor look the same unless
+there's something in the braces that give Perl a hint. The yada yada
+is a syntax error if Perl doesn't guess that the C<{ ... }> is a
+block. In that case, it doesn't think the C<...> is the yada yada
+because it's expecting an expression instead of a statement:
+
+ my @transformed = map { ... } @input; # syntax error
+
+You can use a C<;> inside your block to denote that the C<{ ... }> is
+a block and not a hash reference constructor. Now the yada yada works:
+
+ my @transformed = map {; ... } @input; # ; disambiguates
+
+ my @transformed = map { ...; } @input; # ; disambiguates
=head2 List Operators (Rightward)
X<operator, list, rightward> X<list operator>
The following escape sequences are available in constructs that interpolate
and in transliterations.
-X<\t> X<\n> X<\r> X<\f> X<\b> X<\a> X<\e> X<\x> X<\0> X<\c> X<\N>
-
- \t tab (HT, TAB)
- \n newline (NL)
- \r return (CR)
- \f form feed (FF)
- \b backspace (BS)
- \a alarm (bell) (BEL)
- \e escape (ESC)
- \033 octal char (example: ESC)
- \x1b hex char (example: ESC)
- \x{263a} wide hex char (example: SMILEY)
- \c[ control char (example: ESC)
- \N{name} named Unicode character
-
-The character following C<\c> is mapped to some other character by
-converting letters to upper case and then (on ASCII systems) by inverting
-the 7th bit (0x40). The most interesting range is from '@' to '_'
-(0x40 through 0x5F), resulting in a control character from 0x00
-through 0x1F. A '?' maps to the DEL character. On EBCDIC systems only
-'@', the letters, '[', '\', ']', '^', '_' and '?' will work, resulting
-in 0x00 through 0x1F and 0x7F.
-
-B<NOTE>: Unlike C and other languages, Perl has no \v escape sequence for
-the vertical tab (VT - ASCII 11), but you may use C<\ck> or C<\x0b>.
+X<\t> X<\n> X<\r> X<\f> X<\b> X<\a> X<\e> X<\x> X<\0> X<\c> X<\N> X<\N{}>
+
+ Sequence Note Description
+ \t tab (HT, TAB)
+ \n newline (NL)
+ \r return (CR)
+ \f form feed (FF)
+ \b backspace (BS)
+ \a alarm (bell) (BEL)
+ \e escape (ESC)
+ \033 octal char (example: ESC)
+ \x1b hex char (example: ESC)
+ \x{263a} wide hex char (example: SMILEY)
+ \c[ [1] control char (example: chr(27))
+ \N{name} [2] named Unicode character
+ \N{U+263D} [3] Unicode character (example: FIRST QUARTER MOON)
-The following escape sequences are available in constructs that interpolate
+=over 4
+
+=item [1]
+
+The character following C<\c> is mapped to some other character as shown in the
+table:
+
+ Sequence Value
+ \c@ chr(0)
+ \cA chr(1)
+ \ca chr(1)
+ \cB chr(2)
+ \cb chr(2)
+ ...
+ \cZ chr(26)
+ \cz chr(26)
+ \c[ chr(27)
+ \c] chr(29)
+ \c^ chr(30)
+ \c? chr(127)
+
+Also, C<\c\I<X>> yields C< chr(28) . "I<X>"> for any I<X>, but cannot come at the
+end of a string, because the backslash would be parsed as escaping the end
+quote.
+
+On ASCII platforms, the resulting characters from the list above are the
+complete set of ASCII controls. This isn't the case on EBCDIC platforms; see
+L<perlebcdic/OPERATOR DIFFERENCES> for the complete list of what these
+sequences mean on both ASCII and EBCDIC platforms.
+
+Use of any other character following the "c" besides those listed above is
+discouraged, and may become deprecated or forbidden. What happens for those
+other characters currently though, is that the value is derived by inverting
+the 7th bit (0x40).
+
+To get platform independent controls, you can use C<\N{...}>.
+
+=item [2]
+
+For documentation of C<\N{name}>, see L<charnames>.
+
+=item [3]
+
+C<\N{U+I<wide hex char>}> means the Unicode character whose Unicode ordinal
+number is I<wide hex char>.
+
+=back
+
+B<NOTE>: Unlike C and other languages, Perl has no C<\v> escape sequence for
+the vertical tab (VT - ASCII 11), but you may use C<\ck> or C<\x0b>. (C<\v>
+does have meaning in regular expression patterns in Perl, see L<perlre>.)
+
+The following escape sequences are available in constructs that interpolate,
but not in transliterations.
X<\l> X<\u> X<\L> X<\U> X<\E> X<\Q>
C<\u> and C<\U> is taken from the current locale. See L<perllocale>.
If Unicode (for example, C<\N{}> or wide hex characters of 0x100 or
beyond) is being used, the case map used by C<\l>, C<\L>, C<\u> and
-C<\U> is as defined by Unicode. For documentation of C<\N{name}>,
-see L<charnames>.
+C<\U> is as defined by Unicode.
All systems use the virtual C<"\n"> to represent a line terminator,
called a "newline". There is no such thing as an unvarying, physical
Options are as described in C<qr//>; in addition, the following match
process modifiers are available:
- g Match globally, i.e., find all occurrences.
- c Do not reset search position on a failed match when /g is in effect.
+ g Match globally, i.e., find all occurrences.
+ c Do not reset search position on a failed match when /g is in effect.
If "/" is the delimiter then the initial C<m> is optional. With the C<m>
you can use any pair of non-whitespace characters
Notice that the final match matched C<q> instead of C<p>, which a match
without the C<\G> anchor would have done. Also note that the final match
-did not update C<pos> -- C<pos> is only updated on a C</g> match. If the
+did not update C<pos>. C<pos> is only updated on a C</g> match. If the
final match did indeed match C<p>, it's a good bet that you're running an
older (pre-5.6.0) Perl.
regexp tries to match where the previous one leaves off.
$_ = <<'EOL';
- $url = URI::URL->new( "http://example.com/" ); die if $url eq "xXx";
+ $url = URI::URL->new( "http://example.com/" ); die if $url eq "xXx";
EOL
LOOP:
{
- print(" digits"), redo LOOP if /\G\d+\b[,.;]?\s*/gc;
- print(" lowercase"), redo LOOP if /\G[a-z]+\b[,.;]?\s*/gc;
- print(" UPPERCASE"), redo LOOP if /\G[A-Z]+\b[,.;]?\s*/gc;
- print(" Capitalized"), redo LOOP if /\G[A-Z][a-z]+\b[,.;]?\s*/gc;
- print(" MiXeD"), redo LOOP if /\G[A-Za-z]+\b[,.;]?\s*/gc;
- print(" alphanumeric"), redo LOOP if /\G[A-Za-z0-9]+\b[,.;]?\s*/gc;
- print(" line-noise"), redo LOOP if /\G[^A-Za-z0-9]+/gc;
- print ". That's all!\n";
+ print(" digits"), redo LOOP if /\G\d+\b[,.;]?\s*/gc;
+ print(" lowercase"), redo LOOP if /\G[a-z]+\b[,.;]?\s*/gc;
+ print(" UPPERCASE"), redo LOOP if /\G[A-Z]+\b[,.;]?\s*/gc;
+ print(" Capitalized"), redo LOOP if /\G[A-Z][a-z]+\b[,.;]?\s*/gc;
+ print(" MiXeD"), redo LOOP if /\G[A-Za-z]+\b[,.;]?\s*/gc;
+ print(" alphanumeric"), redo LOOP if /\G[A-Za-z0-9]+\b[,.;]?\s*/gc;
+ print(" line-noise"), redo LOOP if /\G[^A-Za-z0-9]+/gc;
+ print ". That's all!\n";
}
Here is the output (split into several lines):
warning B<Can't find string terminator "END" anywhere before EOF...>.
Additionally, the quoting rules for the end of string identifier are not
-related to Perl's quoting rules -- C<q()>, C<qq()>, and the like are not
+related to Perl's quoting rules. C<q()>, C<qq()>, and the like are not
supported in place of C<''> and C<"">, and the only interpolation is for
backslashing the quoting character:
Processing of C<\Q>, C<\U>, C<\u>, C<\L>, C<\l>, C<\E>,
and interpolation happens (almost) as with C<qq//> constructs.
+Processing of C<\N{...}> is also done here, and compiled into an intermediate
+form for the regex compiler. (This is because, as mentioned below, the regex
+compilation may be done at execution time, and C<\N{...}> is a compile-time
+construct.)
+
However any other combinations of C<\> followed by a character
are not substituted but only skipped, in order to parse them
as regular expressions at the following step.
X<regexp, parse>
Previous steps were performed during the compilation of Perl code,
-but this one happens at run time--although it may be optimized to
+but this one happens at run time, although it may be optimized to
be calculated at compile time if appropriate. After preprocessing
described above, and possibly after evaluation if concatenation,
joining, casing translation, or metaquoting are involved, the
except that it isn't so cumbersome to say, and will actually work.
It really does shift the @ARGV array and put the current filename
into the $ARGV variable. It also uses filehandle I<ARGV>
-internally--<> is just a synonym for <ARGV>, which
+internally. <> is just a synonym for <ARGV>, which
is magical. (The pseudo code above doesn't work because it treats
<ARGV> as non-magical.)
printf "%.20g\n", 123456789123456789;
# produces 123456789123456784
-Testing for exact equality of floating-point equality or inequality is
-not a good idea. Here's a (relatively expensive) work-around to compare
+Testing for exact floating-point equality or inequality is not a
+good idea. Here's a (relatively expensive) work-around to compare
whether two floating-point numbers are equal to a particular number of
decimal places. See Knuth, volume II, for a more robust treatment of
this topic.
Here is a short, but incomplete summary:
- Math::Fraction big, unlimited fractions like 9973 / 12967
- Math::String treat string sequences like numbers
- Math::FixedPrecision calculate with a fixed precision
- Math::Currency for currency calculations
- Bit::Vector manipulate bit vectors fast (uses C)
- Math::BigIntFast Bit::Vector wrapper for big numbers
- Math::Pari provides access to the Pari C library
- Math::BigInteger uses an external C library
- Math::Cephes uses external Cephes C library (no big numbers)
- Math::Cephes::Fraction fractions via the Cephes library
- Math::GMP another one using an external C library
+ Math::Fraction big, unlimited fractions like 9973 / 12967
+ Math::String treat string sequences like numbers
+ Math::FixedPrecision calculate with a fixed precision
+ Math::Currency for currency calculations
+ Bit::Vector manipulate bit vectors fast (uses C)
+ Math::BigIntFast Bit::Vector wrapper for big numbers
+ Math::Pari provides access to the Pari C library
+ Math::BigInteger uses an external C library
+ Math::Cephes uses external Cephes C library (no big numbers)
+ Math::Cephes::Fraction fractions via the Cephes library
+ Math::GMP another one using an external C library
Choose wisely.
Why so permissive? Well, it isn't really. The MASK will be modified
by your process's current C<umask>. A umask is a number representing
I<disabled> permissions bits; that is, bits that will not be turned on
-in the created files' permissions field.
+in the created file's permissions field.
For example, if your C<umask> were 027, then the 020 part would
disable the group from writing, and the 007 part would disable others
Firstly, you need to establish a baseline time for the existing code, which
timing needs to be reliable and repeatable. You'll probably want to use the
C<Benchmark> or C<Devel::DProf> modules, or something similar, for this step,
-or perhaps the unix system C<time> utility, whichever is appropriate. See the
+or perhaps the Unix system C<time> utility, whichever is appropriate. See the
base of this document for a longer list of benchmarking and profiling modules,
and recommended further reading.
direct approach managed to run an additional 204,403 times, unfortunately.
Unfortunately, because there are many examples of code written using the
multiple layer direct variable access, and it's usually horrible. It is,
-however, miniscully faster. The question remains whether the minute gain is
+however, minusculy faster. The question remains whether the minute gain is
actually worth the eyestrain, or the loss of maintainability.
=head2 Search and replace or tr
tr: 0 wallclock secs ( 0.49 usr + 0.00 sys = 0.49 CPU) @ 2040816.33/s (n=1000000)
The C<tr> version is a clear winner. One solution is flexible, the other is
-fast - and it's appropriately the programmers choice which to use in the
-circumstances.
+fast - and it's appropriately the programmer's choice which to use.
Check the C<Benchmark> docs for further useful techniques.
Interestingly we get slightly different results, which is mostly because the
algorithm which generates the report is different, even though the output file
format was allegedly identical. The elapsed, user and system times are clearly
-showing the time it took for C<Devel::Profiler> to execute it's own run, but
+showing the time it took for C<Devel::Profiler> to execute its own run, but
the column listings feel more accurate somehow than the ones we had earlier
from C<Devel::DProf>. The 102% figure has disappeared, for example. This is
where we have to use the tools at our disposal, and recognise their pros and
C<NYTProf> will generate a report database into the file F<nytprof.out> by
default. Human readable reports can be generated from here by using the
supplied C<nytprofhtml> (HTML output) and C<nytprofcsv> (CSV output) programs.
-We've used the unix sytem C<html2text> utility to convert the
+We've used the Unix sytem C<html2text> utility to convert the
F<nytprof/index.html> file for convenience here.
$> html2text nytprof/index.html
A command such as this can vastly reduce the volume of material to actually
sort through in the first place, and should not be too lightly disregarded
-purely on the basis of it's simplicity. The C<KISS> principle is too often
+purely on the basis of its simplicity. The C<KISS> principle is too often
overlooked - the next example uses the simple system C<time> utility to
demonstrate. Let's take a look at an actual example of sorting the contents of
a large file, an apache logfile would do. This one has over a quarter of a
The time has been cut in half, which is a respectable speed improvement by any
standard. Naturally, it is important to check the output is consistent with
-the first program run, this is where the unix system C<cksum> utility comes in.
+the first program run, this is where the Unix system C<cksum> utility comes in.
$> cksum out-sort out-schwarz
3044173777 52029194 out-sort
And perhaps most importantly, keep the items consistent: either use
"=item *" for all of them, to produce bullets; or use "=item 1.",
"=item 2.", etc., to produce numbered lists; or use "=item foo",
-"=item bar", etc. -- namely, things that look nothing like bullets or
+"=item bar", etc.--namely, things that look nothing like bullets or
numbers.
If you start with bullets or numbers, stick with them, as
Link to a Perl manual page (e.g., C<LE<lt>Net::PingE<gt>>). Note
that C<name> should not contain spaces. This syntax
-is also occasionally used for references to UNIX man pages, as in
+is also occasionally used for references to Unix man pages, as in
C<LE<lt>crontab(5)E<gt>>.
=item *
This will produce: "C<$a E<lt>=E<gt> $b>"
A more readable, and perhaps more "plain" way is to use an alternate
-set of delimiters that doesn't require a single ">" to be escaped. With
-the Pod formatters that are standard starting with perl5.5.660, doubled
-angle brackets ("<<" and ">>") may be used I<if and only if there is
+set of delimiters that doesn't require a single ">" to be escaped.
+Doubled angle brackets ("<<" and ">>") may be used I<if and only if there is
whitespace right after the opening delimiter and whitespace right
before the closing delimiter!> For example, the following will
do the trick:
C<$a E<lt>=E<gt> $b>
+The multiple-bracket form does not affect the interpretation of the contents of
+the formatting code, only how it must end. That means that the examples above
+are also exactly the same as this:
+
+ C<< $a E<lt>=E<gt> $b >>
+
As a further example, this means that if you wanted to put these bits of
code in C<C> (code) style:
Older translators might add wording around an LE<lt>E<gt> link, so that
C<LE<lt>Foo::BarE<gt>> may become "the Foo::Bar manpage", for example.
So you shouldn't write things like C<the LE<lt>fooE<gt>
-documentation>, if you want the translated document to read sensibly
--- instead write C<the LE<lt>Foo::Bar|Foo::BarE<gt> documentation> or
+documentation>, if you want the translated document to read sensibly.
+Instead, write C<the LE<lt>Foo::Bar|Foo::BarE<gt> documentation> or
C<LE<lt>the Foo::Bar documentation|Foo::BarE<gt>>, to control how the
link comes out.
+=encoding utf8
=head1 NAME
=head1 Pod Definitions
-Pod is embedded in files, typically Perl source files -- although you
+Pod is embedded in files, typically Perl source files, although you
can write a file that's nothing but Pod.
A B<line> in a file consists of zero or more non-newline characters,
than space or tab (and terminated by a newline or end-of-file).
(I<Note:> Many older Pod parsers did not accept a line consisting of
-spaces/tabs and then a newline as a blank line -- the only lines they
+spaces/tabs and then a newline as a blank line. The only lines they
considered blank were lines consisting of I<no characters at all>,
terminated by a newline.)
Pod content is contained in B<Pod blocks>. A Pod block starts with a
line that matches <m/\A=[a-zA-Z]/>, and continues up to the next line
-that matches C<m/\A=cut/> -- or up to the end of the file, if there is
+that matches C<m/\A=cut/> or up to the end of the file if there is
no C<m/\A=cut/> line.
=for comment
In other words, the Pod processing handler for "head1" will apply the
same processing to "Did You Remember to CE<lt>use strict;>?" that it
-would to an ordinary paragraph -- i.e., formatting codes (like
+would to an ordinary paragraph (i.e., formatting codes like
"CE<lt>...>") are parsed and presumably formatted appropriately, and
whitespace in the form of literal spaces and/or tabs is not
significant.
B<< $foo->bar(); >>
With this syntax, the whitespace character(s) after the "CE<lt><<"
-and before the ">>" (or whatever letter) are I<not> renderable -- they
+and before the ">>" (or whatever letter) are I<not> renderable. They
do not signify whitespace, are merely part of the formatting codes
themselves. That is, these are all synonymous:
and so on.
+Finally, the multiple-angle-bracket form does I<not> alter the interpretation
+of nested formatting codes, meaning that the following four example lines are
+identical in meaning:
+
+ B<example: C<$a E<lt>=E<gt> $b>>
+
+ B<example: C<< $a <=> $b >>>
+
+ B<example: C<< $a E<lt>=E<gt> $b >>>
+
+ B<<< example: C<< $a E<lt>=E<gt> $b >> >>>
+
=back
In parsing Pod, a notably tricky part is the correct parsing of
=item Second:
-The possibly inferred link-text -- i.e., if there was no real link
+The possibly inferred link-text; i.e., if there was no real link
text, then this is the text that we'll infer in its place. (E.g., for
"LE<lt>Getopt::Std>", the inferred link text is "Getopt::Std".)
=item Third:
The name or URL, or undef if none. (E.g., in "LE<lt>Perl
-Functions|perlfunc>", the name -- also sometimes called the page --
+Functions|perlfunc>", the name (also sometimes called the page)
is "perlfunc". In "LE<lt>/CAVEATS>", the name is undef.)
=item Fourth:
L<B<ummE<234>stuff>|...>
For C<LE<lt>...E<gt>> codes without a "name|" part, only
-C<EE<lt>...E<gt>> and C<ZE<lt>E<gt>> codes may occur -- no
-other formatting codes. That is, authors should not use
-"C<LE<lt>BE<lt>Foo::BarE<gt>E<gt>>".
+C<EE<lt>...E<gt>> and C<ZE<lt>E<gt>> codes may occur. That is,
+authors should not use "C<LE<lt>BE<lt>Foo::BarE<gt>E<gt>>".
Note, however, that formatting codes and ZE<lt>>'s can occur in any
and all parts of an LE<lt>...> (i.e., in I<name>, I<section>, I<text>,
At time of writing, C<LE<lt>nameE<gt>> values are of two types:
either the name of a Pod page like C<LE<lt>Foo::BarE<gt>> (which
might be a real Perl module or program in an @INC / PATH
-directory, or a .pod file in those places); or the name of a UNIX
+directory, or a .pod file in those places); or the name of a Unix
man page, like C<LE<lt>crontab(5)E<gt>>. In theory, C<LE<lt>chmodE<gt>>
in ambiguous between a Pod page called "chmod", or the Unix man page
"chmod" (in whatever man-section). However, the presence of a string
in parens, as in "crontab(5)", is sufficient to signal that what
is being discussed is not a Pod page, and so is presumably a
-UNIX man page. The distinction is of no importance to many
+Unix man page. The distinction is of no importance to many
Pod processors, but some processors that render to hypertext formats
may need to distinguish them in order to know how to render a
given C<LE<lt>fooE<gt>> code.
happens that "outer" is the format name of a higher-up region.) This is
an error. Processors must by default report this as an error, and may halt
processing the document containing that error. A corollary of this is that
-regions cannot "overlap" -- i.e., the latter block above does not represent
+regions cannot "overlap". That is, the latter block above does not represent
a region called "outer" which contains X and Y, overlapping a region called
"inner" which contains Y and Z. But because it is invalid (as all
apparently overlapping regions would be), it doesn't represent that, or
the Perl core.
+=head1 MAINTENANCE BRANCHES
+
+=over
+
+=item *
+
+New releases of maint should contain as few changes as possible.
+If there is any question about whether a given patch might merit
+inclusion in a maint release, then it almost certainly should not
+be included.
+
+=item *
+
+Portability fixes, such as changes to Configure and the files in
+hints/ are acceptable. Ports of Perl to a new platform, architecture
+or OS release that involve changes to the implementation are NOT
+acceptable.
+
+=item *
+
+Documentation updates are acceptable.
+
+=item *
+
+Patches that add new warnings or errors or deprecate features
+are not acceptable.
+
+=item *
+
+Patches that fix crashing bugs that do not otherwise change Perl's
+functionality or negatively impact performance are acceptable.
+
+=item *
+
+Patches that fix CVEs or security issues are acceptable, but should
+be run through the perl5-security-report@perl.org mailing list
+rather than applied directly.
+
+=item *
+
+Updates to dual-life modules should consist of minimal patches to
+fix crashing or security issues (as above).
+
+=item *
+
+New versions of dual-life modules should NOT be imported into maint.
+Those belong in the next stable series.
+
+=item *
+
+Patches that add or remove features are not acceptable.
+
+=item *
+
+Patches that break binary compatibility are not acceptable. (Please
+talk to a pumpking.)
+
+=back
+
+
+=head2 Getting changes into a maint branch
+
+Historically, only the pumpking cherry-picked changes from bleadperl
+into maintperl. This has...scaling problems. At the same time,
+maintenance branches of stable versions of Perl need to be treated with
+great care. To that end, we're going to try out a new process for
+maint-5.12.
+
+Any committer may cherry-pick any commit from blead to maint-5.12 if
+they send mail to perl5-porters announcing their intent to cherry-pick
+a specific commit along with a rationale for doing so and at least two
+other committers respond to the list giving their assent. (This policy
+applies to current and former pumpkings, as well as other committers.)
=head1 CONTRIBUTED MODULES
=over
-=item * The version of the module in the core should still be considered the
- work of the original author. All patches, bug reports, and so forth
- should be fed back to them. Their development directions should be
- respected whenever possible.
+=item *
+
+The version of the module in the core should still be considered the
+work of the original author. All patches, bug reports, and so
+forth should be fed back to them. Their development directions
+should be respected whenever possible.
=item *
(e.g. the FAT filesystem limits the time granularity to two seconds).
The "inode change timestamp" (the C<-C> filetest) may really be the
-"creation timestamp" (which it is not in UNIX).
+"creation timestamp" (which it is not in Unix).
VOS perl can emulate Unix filenames with C</> as path separator. The
native pathname characters greater-than, less-than, number-sign, and
separator, or go native and use C<.> for path separator and C<:> to
signal filesystems and disk names.
-Don't assume UNIX filesystem access semantics: that read, write,
+Don't assume Unix filesystem access semantics: that read, write,
and execute are all the permissions there are, and even if they exist,
that their semantics (for example what do r, w, and x mean on
-a directory) are the UNIX ones. The various UNIX/POSIX compatibility
+a directory) are the Unix ones. The various Unix/POSIX compatibility
layers usually try to make interfaces like chmod() work, but sometimes
there simply is no good mapping.
directories.
Don't count on specific values of C<$!>, neither numeric nor
-especially the strings values-- users may switch their locales causing
+especially the strings values. Users may switch their locales causing
error messages to be translated into their languages. If you can
trust a POSIXish environment, you can portably use the symbols defined
by the Errno module, like ENOENT. And don't trust on the values of C<$!>
To convert $^X to a file pathname, taking account of the requirements
of the various operating system possibilities, say:
- use Config;
- my $thisperl = $^X;
- if ($^O ne 'VMS')
- {$thisperl .= $Config{_exe} unless $thisperl =~ m/$Config{_exe}$/i;}
+ use Config;
+ my $thisperl = $^X;
+ if ($^O ne 'VMS')
+ {$thisperl .= $Config{_exe} unless $thisperl =~ m/$Config{_exe}$/i;}
To convert $Config{perlpath} to a file pathname, say:
- use Config;
- my $thisperl = $Config{perlpath};
- if ($^O ne 'VMS')
- {$thisperl .= $Config{_exe} unless $thisperl =~ m/$Config{_exe}$/i;}
+ use Config;
+ my $thisperl = $Config{perlpath};
+ if ($^O ne 'VMS')
+ {$thisperl .= $Config{_exe} unless $thisperl =~ m/$Config{_exe}$/i;}
=head2 Networking
Don't assume that any particular port (service) will respond.
-Don't assume that Sys::Hostname (or any other API or command)
-returns either a fully qualified hostname or a non-qualified hostname:
-it all depends on how the system had been configured. Also remember
-things like DHCP and NAT-- the hostname you get back might not be very
-useful.
+Don't assume that Sys::Hostname (or any other API or command) returns
+either a fully qualified hostname or a non-qualified hostname: it all
+depends on how the system had been configured. Also remember that for
+things such as DHCP and NAT, the hostname you get back might not be
+very useful.
-All the above "don't":s may look daunting, and they are -- but the key
+All the above "don't":s may look daunting, and they are, but the key
is to degrade gracefully if one cannot reach the particular network
service one wants. Croaking or hanging do not look very professional.
=head2 Security
Most multi-user platforms provide basic levels of security, usually
-implemented at the filesystem level. Some, however, do
-not-- unfortunately. Thus the notion of user id, or "home" directory,
+implemented at the filesystem level. Some, however, unfortunately do
+not. Thus the notion of user id, or "home" directory,
or even the state of being logged-in, may be unrecognizable on many
platforms. If you write programs that are security-conscious, it
is usually best to know what type of system you will be running
under so that you can write code explicitly for that platform (or
class of platforms).
-Don't assume the UNIX filesystem access semantics: the operating
+Don't assume the Unix filesystem access semantics: the operating
system or the filesystem may be using some ACL systems, which are
richer languages than the usual rwx. Even if the rwx exist,
their semantics might be different.
(From security viewpoint testing for permissions before attempting to
do something is silly anyway: if one tries this, there is potential
-for race conditions-- someone or something might change the
+for race conditions. Someone or something might change the
permissions between the permissions check and the actual operation.
Just try the operation.)
-Don't assume the UNIX user and group semantics: especially, don't
+Don't assume the Unix user and group semantics: especially, don't
expect the C<< $< >> and C<< $> >> (or the C<$(> and C<$)>) to work
for switching identities (or memberships).
Windows 2000 MSWin32 MSWin32-x86 2 5 00
Windows XP MSWin32 MSWin32-x86 2 5 01
Windows 2003 MSWin32 MSWin32-x86 2 5 02
+ Windows Vista MSWin32 MSWin32-x86 2 6 00
+ Windows 7 MSWin32 MSWin32-x86 2 6 01
+ Windows 7 MSWin32 MSWin32-x64 2 6 01
Windows CE MSWin32 ? 3
Cygwin cygwin cygwin
shell or file parsing utilities need to be prefixed with the C<^>
character, or replaced with hexadecimal characters prefixed with the
C<^> character. Such prefixing is only needed with the pathnames are
-in VMS format in applications. Programs that can accept the UNIX format
+in VMS format in applications. Programs that can accept the Unix format
of pathnames do not need the escape characters. The maximum length for
filenames is 255 characters. The ODS-5 file system can handle both
a case preserved and a case sensitive mode.
settings to preserve backward compatibility with Perl scripts that
assume the previous VMS limitations.
-In general routines on VMS that get a UNIX format file specification
-should return it in a UNIX format, and when they get a VMS format
+In general routines on VMS that get a Unix format file specification
+should return it in a Unix format, and when they get a VMS format
specification they should return a VMS format unless they are documented
to do a conversion.
For routines that generate return a file specification, VMS allows setting
if the C library which Perl is built on if it will be returned in VMS
-format or in UNIX format.
+format or in Unix format.
With the ODS-2 file system, there is not much difference in syntax of
-filenames without paths for VMS or UNIX. With the extended character
+filenames without paths for VMS or Unix. With the extended character
set available with ODS-5 there can be a significant difference.
Because of this, existing Perl scripts written for VMS were sometimes
-treating VMS and UNIX filenames interchangeably. Without the extended
+treating VMS and Unix filenames interchangeably. Without the extended
character set enabled, this behavior will mostly be maintained for
backwards compatibility.
When extended characters are enabled with ODS-5, the handling of
-UNIX formatted file specifications is to that of a UNIX system.
+Unix formatted file specifications is to that of a Unix system.
VMS file specifications without extensions have a trailing dot. An
-equivalent UNIX file specification should not show the trailing dot.
+equivalent Unix file specification should not show the trailing dot.
The result of all of this, is that for VMS, for portable scripts, you
can not depend on Perl to present the filenames in lowercase, to be
case sensitive, and that the filenames could be returned in either
-UNIX or VMS format.
+Unix or VMS format.
And if a routine returns a file specification, unless it is intended to
convert it, it should return it in the same format as it found it.
C<open(FH, 'A')>).
With support for extended file specifications and if C<opendir> was
-given a UNIX format directory, a file named F<A.;5> will return F<a>
+given a Unix format directory, a file named F<A.;5> will return F<a>
and optionally in the exact case on the disk. When C<opendir> is given
a VMS format directory, then C<readdir> should return F<a.>, and
again with the optionally the exact case.
directory levels have snuck into the core by running the following in the
top-level source directory:
- $ perl -ne "$_=~s/\s+.*//; print if scalar(split /\//) > 8;" < MANIFEST
+ $ perl -ne "$_=~s/\s+.*//; print if scalar(split /\//) > 8;" < MANIFEST
The VMS::Filespec module, which gets installed as part of the build
=item exit
-Emulates UNIX exit() (which considers C<exit 1> to indicate an error) by
+Emulates Unix exit() (which considers C<exit 1> to indicate an error) by
mapping the C<1> to SS$_ABORT (C<44>). This behavior may be overridden
with the pragma C<use vmsish 'exit'>. As with the CRTL's exit()
function, C<exit 0> is also mapped to an exit status of SS$_NORMAL
=item localtime
-localtime() has the same range as L<gmtime>, but because time zone
+localtime() has the same range as L</gmtime>, but because time zone
rules change its accuracy for historical and future times may degrade
but usually by no more than an hour.
=item sockatmark
A relatively recent addition to socket functions, may not
-be implemented even in UNIX platforms.
+be implemented even in Unix platforms.
=item socketpair
=back
-=head1 Supported Platforms (Perl 5.12)
+=head1 Supported Platforms
-
-As of _____ 20??, (The release of Perl 5.12), the following platforms are
-known to build Perl from the standard source code distribution available
+The following platforms are known to build Perl 5.12 (as of April 2010,
+its release date) from the standard source code distribution available
at http://www.cpan.org/src
-
=over
=item Linux (x86, ARM, IA64)
Treat string as single line. That is, change "." to match any character
whatsoever, even a newline, which normally it would not match.
-Used together, as /ms, they let the "." match any character whatsoever,
+Used together, as C</ms>, they let the "." match any character whatsoever,
while still allowing "^" and "$" to match, respectively, just after
and just before newlines within the string.
the C<(?...)> construct. See below.
The C</x> modifier itself needs a little more explanation. It tells
-the regular expression parser to ignore whitespace that is neither
+the regular expression parser to ignore most whitespace that is neither
backslashed nor within a character class. You can use this to break up
your regular expression into (slightly) more readable parts. The C<#>
character is also treated as a metacharacter introducing a comment,
just as in ordinary Perl code. This also means that if you want real
whitespace or C<#> characters in the pattern (outside a character
class, where they are unaffected by C</x>), then you'll either have to
-escape them (using backslashes or C<\Q...\E>) or encode them using octal
-or hex escapes. Taken together, these features go a long way towards
+escape them (using backslashes or C<\Q...\E>) or encode them using octal,
+hex, or C<\N{}> escapes. Taken together, these features go a long way towards
making Perl's regular expressions more readable. Note that you have to
be careful not to include the pattern delimiter in the comment--perl has
no way of knowing you did not intend to close the pattern early. See
the C-comment deletion code in L<perlop>. Also note that anything inside
-a C<\Q...\E> stays unaffected by C</x>.
+a C<\Q...\E> stays unaffected by C</x>. And note that C</x> doesn't affect
+whether space interpretation within a single multi-character construct. For
+example in C<\x{...}>, regardless of the C</x> modifier, there can be no
+spaces. Same for a L<quantifier|/Quantifiers> such as C<{3}> or
+C<{5,}>. Similarly, C<(?:...)> can't have a space between the C<?> and C<:>,
+but can between the C<(> and C<?>. Within any delimiters for such a
+construct, allowed spaces are not affected by C</x>, and depend on the
+construct. For example, C<\x{...}> can't have spaces because hexadecimal
+numbers don't have spaces in them. But, Unicode properties can have spaces, so
+in C<\p{...}> there can be spaces that follow the Unicode rules, for which see
+L<perluniprops/Properties accessible through \p{} and \P{}>.
X</x>
=head2 Regular Expressions
X<\> X<^> X<.> X<$> X<|> X<(> X<()> X<[> X<[]>
- \ Quote the next metacharacter
- ^ Match the beginning of the line
- . Match any character (except newline)
- $ Match the end of the line (or before newline at the end)
- | Alternation
- () Grouping
- [] Character class
+ \ Quote the next metacharacter
+ ^ Match the beginning of the line
+ . Match any character (except newline)
+ $ Match the end of the line (or before newline at the end)
+ | Alternation
+ () Grouping
+ [] Bracketed Character class
By default, the "^" character is guaranteed to match only the
beginning of the string, the "$" character only the end (or before the
The following standard quantifiers are recognized:
X<metacharacter> X<quantifier> X<*> X<+> X<?> X<{n}> X<{n,}> X<{n,m}>
- * Match 0 or more times
- + Match 1 or more times
- ? Match 1 or 0 times
- {n} Match exactly n times
- {n,} Match at least n times
- {n,m} Match at least n but not more than m times
+ * Match 0 or more times
+ + Match 1 or more times
+ ? Match 1 or 0 times
+ {n} Match exactly n times
+ {n,} Match at least n times
+ {n,m} Match at least n but not more than m times
(If a curly bracket occurs in any other context, it is treated
as a regular character. In particular, the lower bound
is not optional.) The "*" quantifier is equivalent to C<{0,}>, the "+"
quantifier to C<{1,}>, and the "?" quantifier to C<{0,1}>. n and m are limited
-to integral values less than a preset limit defined when perl is built.
+to non-negative integral values less than a preset limit defined when perl is built.
This is usually 32766 on the most common platforms. The actual limit can
be seen in the error message generated by code such as this:
X<metacharacter> X<greedy> X<greediness>
X<?> X<*?> X<+?> X<??> X<{n}?> X<{n,}?> X<{n,m}?>
- *? Match 0 or more times, not greedily
- +? Match 1 or more times, not greedily
- ?? Match 0 or 1 time, not greedily
- {n}? Match exactly n times, not greedily
- {n,}? Match at least n times, not greedily
- {n,m}? Match at least n but not more than m times, not greedily
+ *? Match 0 or more times, not greedily
+ +? Match 1 or more times, not greedily
+ ?? Match 0 or 1 time, not greedily
+ {n}? Match exactly n times, not greedily
+ {n,}? Match at least n times, not greedily
+ {n,m}? Match at least n but not more than m times, not greedily
By default, when a quantified subpattern does not allow the rest of the
overall pattern to match, Perl will backtrack. However, this behaviour is
sometimes undesirable. Thus Perl provides the "possessive" quantifier form
as well.
- *+ Match 0 or more times and give nothing back
- ++ Match 1 or more times and give nothing back
- ?+ Match 0 or 1 time and give nothing back
- {n}+ Match exactly n times and give nothing back (redundant)
- {n,}+ Match at least n times and give nothing back
- {n,m}+ Match at least n but not more than m times and give nothing back
+ *+ Match 0 or more times and give nothing back
+ ++ Match 1 or more times and give nothing back
+ ?+ Match 0 or 1 time and give nothing back
+ {n}+ Match exactly n times and give nothing back (redundant)
+ {n,}+ Match at least n times and give nothing back
+ {n,m}+ Match at least n but not more than m times and give nothing back
For instance,
Because patterns are processed as double quoted strings, the following
also work:
-X<\t> X<\n> X<\r> X<\f> X<\e> X<\a> X<\l> X<\u> X<\L> X<\U> X<\E> X<\Q>
-X<\0> X<\c> X<\N> X<\x>
-
- \t tab (HT, TAB)
- \n newline (LF, NL)
- \r return (CR)
- \f form feed (FF)
- \a alarm (bell) (BEL)
- \e escape (think troff) (ESC)
- \033 octal char (example: ESC)
- \x1B hex char (example: ESC)
- \x{263a} long hex char (example: Unicode SMILEY)
- \cK control char (example: VT)
- \N{name} named Unicode character
- \l lowercase next char (think vi)
- \u uppercase next char (think vi)
- \L lowercase till \E (think vi)
- \U uppercase till \E (think vi)
- \E end case modification (think vi)
- \Q quote (disable) pattern metacharacters till \E
-
-If C<use locale> is in effect, the case map used by C<\l>, C<\L>, C<\u>
-and C<\U> is taken from the current locale. See L<perllocale>. For
-documentation of C<\N{name}>, see L<charnames>.
-
-You cannot include a literal C<$> or C<@> within a C<\Q> sequence.
-An unescaped C<$> or C<@> interpolates the corresponding variable,
-while escaping will cause the literal string C<\$> to be matched.
-You'll need to write something like C<m/\Quser\E\@\Qhost/>.
+
+ \t tab (HT, TAB)
+ \n newline (LF, NL)
+ \r return (CR)
+ \f form feed (FF)
+ \a alarm (bell) (BEL)
+ \e escape (think troff) (ESC)
+ \033 octal char (example: ESC)
+ \x1B hex char (example: ESC)
+ \x{263a} long hex char (example: Unicode SMILEY)
+ \cK control char (example: VT)
+ \N{name} named Unicode character
+ \N{U+263D} Unicode character (example: FIRST QUARTER MOON)
+ \l lowercase next char (think vi)
+ \u uppercase next char (think vi)
+ \L lowercase till \E (think vi)
+ \U uppercase till \E (think vi)
+ \Q quote (disable) pattern metacharacters till \E
+ \E end either case modification or quoted section, think vi
+
+Details are in L<perlop/Quote and Quote-like Operators>.
=head3 Character Classes and other Special Escapes
In addition, Perl defines the following:
-X<\w> X<\W> X<\s> X<\S> X<\d> X<\D> X<\X> X<\p> X<\P> X<\C>
-X<\g> X<\k> X<\N> X<\K> X<\v> X<\V> X<\h> X<\H>
-X<word> X<whitespace> X<character class> X<backreference>
-
- \w Match a "word" character (alphanumeric plus "_")
- \W Match a non-"word" character
- \s Match a whitespace character
- \S Match a non-whitespace character
- \d Match a digit character
- \D Match a non-digit character
- \pP Match P, named property. Use \p{Prop} for longer names.
- \PP Match non-P
- \X Match Unicode "eXtended grapheme cluster"
- \C Match a single C char (octet) even under Unicode.
- NOTE: breaks up characters into their UTF-8 bytes,
- so you may end up with malformed pieces of UTF-8.
- Unsupported in lookbehind.
- \1 Backreference to a specific group.
- '1' may actually be any positive integer.
- \g1 Backreference to a specific or previous group,
- \g{-1} number may be negative indicating a previous buffer and may
- optionally be wrapped in curly brackets for safer parsing.
- \g{name} Named backreference
- \k<name> Named backreference
- \K Keep the stuff left of the \K, don't include it in $&
- \N Any character but \n
- \v Vertical whitespace
- \V Not vertical whitespace
- \h Horizontal whitespace
- \H Not horizontal whitespace
- \R Linebreak
-
-A C<\w> matches a single alphanumeric character (an alphabetic
-character, or a decimal digit) or C<_>, not a whole word. Use C<\w+>
-to match a string of Perl-identifier characters (which isn't the same
-as matching an English word). If C<use locale> is in effect, the list
-of alphabetic characters generated by C<\w> is taken from the current
-locale. See L<perllocale>. You may use C<\w>, C<\W>, C<\s>, C<\S>,
-C<\d>, and C<\D> within character classes, but they aren't usable
-as either end of a range. If any of them precedes or follows a "-",
-the "-" is understood literally. If Unicode is in effect, C<\s> matches
-also "\x{85}", "\x{2028}", and "\x{2029}". See L<perlunicode> for more
-details about C<\pP>, C<\PP>, C<\X> and the possibility of defining
-your own C<\p> and C<\P> properties, and L<perluniintro> about Unicode
-in general.
-X<\w> X<\W> X<word>
-
-C<\R> will atomically match a linebreak, including the network line-ending
-"\x0D\x0A". Specifically, X<\R> is exactly equivalent to
-
- (?>\x0D\x0A?|[\x0A-\x0C\x85\x{2028}\x{2029}])
-
-B<Note:> C<\R> has no special meaning inside of a character class;
-use C<\v> instead (vertical whitespace).
-X<\R>
-
-The POSIX character class syntax
-X<character class>
-
- [:class:]
-
-is also available. Note that the C<[> and C<]> brackets are I<literal>;
-they must always be used within a character class expression.
-
- # this is correct:
- $string =~ /[[:alpha:]]/;
-
- # this is not, and will generate a warning:
- $string =~ /[:alpha:]/;
-
-The following table shows the mapping of POSIX character class
-names, common escapes, literal escape sequences and their equivalent
-Unicode style property names.
-X<character class> X<\p> X<\p{}>
-X<alpha> X<alnum> X<ascii> X<blank> X<cntrl> X<digit> X<graph>
-X<lower> X<print> X<punct> X<space> X<upper> X<word> X<xdigit>
-
-B<Note:> up to Perl 5.10 the property names used were shared with
-standard Unicode properties, this was changed in Perl 5.11, see
-L<perl5110delta> for details.
-
- POSIX Esc Class Property Note
- --------------------------------------------------------
- alnum [0-9A-Za-z] IsPosixAlnum
- alpha [A-Za-z] IsPosixAlpha
- ascii [\000-\177] IsASCII
- blank [\011 ] IsPosixBlank [1]
- cntrl [\0-\37\177] IsPosixCntrl
- digit \d [0-9] IsPosixDigit
- graph [!-~] IsPosixGraph
- lower [a-z] IsPosixLower
- print [ -~] IsPosixPrint
- punct [!-/:-@[-`{-~] IsPosixPunct
- space [\11-\15 ] IsPosixSpace [2]
- \s [\11\12\14\15 ] IsPerlSpace [2]
- upper [A-Z] IsPosixUpper
- word \w [0-9A-Z_a-z] IsPerlWord [3]
- xdigit [0-9A-Fa-f] IsXDigit
-
-=over
+X<\g> X<\k> X<\K> X<backreference>
+
+ Sequence Note Description
+ [...] [1] Match a character according to the rules of the
+ bracketed character class defined by the "...".
+ Example: [a-z] matches "a" or "b" or "c" ... or "z"
+ [[:...:]] [2] Match a character according to the rules of the POSIX
+ character class "..." within the outer bracketed
+ character class. Example: [[:upper:]] matches any
+ uppercase character.
+ \w [3] Match a "word" character (alphanumeric plus "_")
+ \W [3] Match a non-"word" character
+ \s [3] Match a whitespace character
+ \S [3] Match a non-whitespace character
+ \d [3] Match a decimal digit character
+ \D [3] Match a non-digit character
+ \pP [3] Match P, named property. Use \p{Prop} for longer names
+ \PP [3] Match non-P
+ \X [4] Match Unicode "eXtended grapheme cluster"
+ \C Match a single C-language char (octet) even if that is
+ part of a larger UTF-8 character. Thus it breaks up
+ characters into their UTF-8 bytes, so you may end up
+ with malformed pieces of UTF-8. Unsupported in
+ lookbehind.
+ \1 [5] Backreference to a specific capture buffer or group.
+ '1' may actually be any positive integer.
+ \g1 [5] Backreference to a specific or previous group,
+ \g{-1} [5] The number may be negative indicating a relative
+ previous buffer and may optionally be wrapped in
+ curly brackets for safer parsing.
+ \g{name} [5] Named backreference
+ \k<name> [5] Named backreference
+ \K [6] Keep the stuff left of the \K, don't include it in $&
+ \N [7] Any character but \n (experimental). Not affected by
+ /s modifier
+ \v [3] Vertical whitespace
+ \V [3] Not vertical whitespace
+ \h [3] Horizontal whitespace
+ \H [3] Not horizontal whitespace
+ \R [4] Linebreak
+
+=over 4
=item [1]
-A GNU extension equivalent to C<[ \t]>, "all horizontal whitespace".
+See L<perlrecharclass/Bracketed Character Classes> for details.
=item [2]
-Note that C<\s> and C<[[:space:]]> are B<not> equivalent as C<[[:space:]]>
-includes also the (very rare) "vertical tabulator", "\cK" or chr(11) in
-ASCII.
+See L<perlrecharclass/POSIX Character Classes> for details.
=item [3]
-A Perl extension, see above.
-
-=back
-
-For example use C<[:upper:]> to match all the uppercase characters.
-Note that the C<[]> are part of the C<[::]> construct, not part of the
-whole character class. For example:
-
- [01[:alpha:]%]
+See L<perlrecharclass/Backslash sequences> for details.
-matches zero, one, any alphabetic character, and the percent sign.
+=item [4]
-=over 4
+See L<perlrebackslash/Misc> for details.
-=item C<$>
+=item [5]
-Currency symbol
+See L</Capture buffers> below for details.
-=item C<+> C<< < >> C<=> C<< > >> C<|> C<~>
+=item [6]
-Mathematical symbols
+See L</Extended Patterns> below for details.
-=item C<^> C<`>
-
-Modifier symbols (accents)
+=item [7]
+Note that C<\N> has two meanings. When of the form C<\N{NAME}>, it matches the
+character whose name is C<NAME>; and similarly when of the form
+C<\N{U+I<wide hex char>}>, it matches the character whose Unicode ordinal is
+I<wide hex char>. Otherwise it matches any character but C<\n>.
=back
-The other named classes are:
-
-=over 4
-
-=item cntrl
-X<cntrl>
-
-Any control character. Usually characters that don't produce output as
-such but instead control the terminal somehow: for example newline and
-backspace are control characters. All characters with ord() less than
-32 are usually classified as control characters (assuming ASCII,
-the ISO Latin character sets, and Unicode), as is the character with
-the ord() value of 127 (C<DEL>).
-
-=item graph
-X<graph>
-
-Any alphanumeric or punctuation (special) character.
-
-=item print
-X<print>
-
-Any alphanumeric or punctuation (special) character or the space character.
-
-=item punct
-X<punct>
-
-Any punctuation (special) character.
-
-=item xdigit
-X<xdigit>
-
-Any hexadecimal digit. Though this may feel silly ([0-9A-Fa-f] would
-work just fine) it is included for completeness.
-
-=back
-
-You can negate the [::] character classes by prefixing the class name
-with a '^'. This is a Perl extension. For example:
-X<character class, negation>
-
- POSIX traditional Unicode
-
- [[:^digit:]] \D \P{IsPosixDigit}
- [[:^space:]] \S \P{IsPosixSpace}
- [[:^word:]] \W \P{IsPerlWord}
-
-Perl respects the POSIX standard in that POSIX character classes are
-only supported within a character class. The POSIX character classes
-[.cc.] and [=cc=] are recognized but B<not> supported and trying to
-use them will cause an error.
-
=head3 Assertions
Perl defines the following zero-width assertions:
X<regular expression, zero-width assertion>
X<\b> X<\B> X<\A> X<\Z> X<\z> X<\G>
- \b Match a word boundary
- \B Match except at a word boundary
- \A Match only at beginning of string
- \Z Match only at end of string, or before newline at the end
- \z Match only at end of string
- \G Match only at pos() (e.g. at the end-of-match position
+ \b Match a word boundary
+ \B Match except at a word boundary
+ \A Match only at beginning of string
+ \Z Match only at end of string, or before newline at the end
+ \z Match only at end of string
+ \G Match only at pos() (e.g. at the end-of-match position
of prior m//g)
A word boundary (C<\b>) is a spot between two characters
and print "'$1' is the first doubled character\n";
if (/Time: (..):(..):(..)/) { # parse out values
- $hours = $1;
- $minutes = $2;
- $seconds = $3;
+ $hours = $1;
+ $minutes = $2;
+ $seconds = $3;
}
Several special variables also refer back to portions of the previous
$_ = 'a' x 8;
m<
- (?{ $cnt = 0 }) # Initialize $cnt.
+ (?{ $cnt = 0 }) # Initialize $cnt.
(
a
(?{
- local $cnt = $cnt + 1; # Update $cnt, backtracking-safe.
+ local $cnt = $cnt + 1; # Update $cnt, backtracking-safe.
})
)*
aaaa
- (?{ $res = $cnt }) # On success copy to non-localized
- # location.
+ (?{ $res = $cnt }) # On success copy to
+ # non-localized location.
>x;
will set C<$res = 4>. Note that after the match, C<$cnt> returns to the globally
expression involves run-time interpolation of variables, unless the
perilous C<use re 'eval'> pragma has been used (see L<re>), or the
variables contain results of C<qr//> operator (see
-L<perlop/"qr/STRING/imosx">).
+L<perlop/"qr/STRINGE<sol>msixpo">).
This restriction is due to the wide-spread and remarkably convenient
custom of using run-time determined strings as patterns. For example:
The following pattern matches a parenthesized group:
$re = qr{
- \(
- (?:
- (?> [^()]+ ) # Non-parens without backtracking
- |
- (??{ $re }) # Group with matching parens
- )*
- \)
- }x;
+ \(
+ (?:
+ (?> [^()]+ ) # Non-parens without backtracking
+ |
+ (??{ $re }) # Group with matching parens
+ )*
+ \)
+ }x;
See also C<(?PARNO)> for a different, more efficient way to accomplish
the same task.
+For reasons of security, this construct is forbidden if the regular
+expression involves run-time interpolation of variables, unless the
+perilous C<use re 'eval'> pragma has been used (see L<re>), or the
+variables contain results of C<qr//> operator (see
+L<perlop/"qrE<sol>STRINGE<sol>msixpo">).
+
Because perl's regex engine is not currently re-entrant, delayed
code may not invoke the regex engine either directly with C<m//> or C<s///>),
or indirectly with functions such as C<split>.
m{ \(
(
- [^()]+ # x+
+ [^()]+ # x+
|
\( [^()]* \)
)+
m{ \(
(
- (?> [^()]+ ) # change x+ above to (?> x+ )
+ (?> [^()]+ ) # change x+ above to (?> x+ )
|
\( [^()]* \)
)+
forbidden.
Any pattern containing a special backtracking verb that allows an argument
-has the special behaviour that when executed it sets the current packages'
+has the special behaviour that when executed it sets the current package's
C<$REGERROR> and C<$REGMARK> variables. When doing so the following
rules apply:
when a certain part of the pattern has been successfully matched. This
mark may be given a name. A later C<(*SKIP)> pattern will then skip
forward to that point if backtracked into on failure. Any number of
-C<(*MARK)> patterns are allowed, and the NAME portion is optional and may
-be duplicated.
+C<(*MARK)> patterns are allowed, and the NAME portion may be duplicated.
In addition to interacting with the C<(*SKIP)> pattern, C<(*MARK:NAME)>
can be used to "label" a pattern branch, so that after matching, the
$_ = "Food is on the foo table.";
if ( /\b(foo)\s+(\w+)/i ) {
- print "$2 follows $1.\n";
+ print "$2 follows $1.\n";
}
When the match runs, the first part of the regular expression (C<\b(foo)>)
$_ = "The food is under the bar in the barn.";
if ( /foo(.*)bar/ ) {
- print "got <$1>\n";
+ print "got <$1>\n";
}
Which perhaps unexpectedly yields:
So you write this:
$_ = "I have 2 numbers: 53147";
- if ( /(.*)(\d*)/ ) { # Wrong!
- print "Beginning is <$1>, number is <$2>.\n";
+ if ( /(.*)(\d*)/ ) { # Wrong!
+ print "Beginning is <$1>, number is <$2>.\n";
}
That won't work at all, because C<.*> was greedy and gobbled up the
$_ = "I have 2 numbers: 53147";
@pats = qw{
- (.*)(\d*)
- (.*)(\d+)
- (.*?)(\d*)
- (.*?)(\d+)
- (.*)(\d+)$
- (.*?)(\d+)$
- (.*)\b(\d+)$
- (.*\D)(\d+)$
+ (.*)(\d*)
+ (.*)(\d+)
+ (.*?)(\d*)
+ (.*?)(\d+)
+ (.*)(\d+)$
+ (.*?)(\d+)$
+ (.*)\b(\d+)$
+ (.*\D)(\d+)$
};
for $pat (@pats) {
- printf "%-12s ", $pat;
- if ( /$pat/ ) {
- print "<$1> <$2>\n";
- } else {
- print "FAIL\n";
- }
+ printf "%-12s ", $pat;
+ if ( /$pat/ ) {
+ print "<$1> <$2>\n";
+ } else {
+ print "FAIL\n";
+ }
}
That will print out:
followed by "123". You might try to write that as
$_ = "ABC123";
- if ( /^\D*(?!123)/ ) { # Wrong!
- print "Yup, no 123 in $_\n";
+ if ( /^\D*(?!123)/ ) { # Wrong!
+ print "Yup, no 123 in $_\n";
}
But that isn't going to match; at least, not the way you're hoping. It
of doing that, you get yourself into trouble if you then add an C</e>
modifier.
- s/(\d+)/ \1 + 1 /eg; # causes warning under -w
+ s/(\d+)/ \1 + 1 /eg; # causes warning under -w
Or if you try to do
be significantly simplified by using repeated subexpressions that
may match zero-length substrings. Here's a simple example being:
- @chars = split //, $string; # // is not magic in split
+ @chars = split //, $string; # // is not magic in split
($whitewashed = $string) =~ s/()/ /g; # parens avoid magic s// /
Thus Perl allows such constructs, by I<forcefully breaking
# We must also take care of not escaping the legitimate \\Y|
# sequence, hence the presence of '\\' in the conversion rules.
my %rules = ( '\\' => '\\\\',
- 'Y|' => qr/(?=\S)(?<!\S)|(?!\S)(?<=\S)/ );
+ 'Y|' => qr/(?=\S)(?<!\S)|(?!\S)(?<=\S)/ );
sub convert {
my $re = shift;
$re =~ s{
=head1 BUGS
+There are numerous problems with case insensitive matching of characters
+outside the ASCII range, especially with those whose folds are multiple
+characters, such as ligatures like C<LATIN SMALL LIGATURE FF>.
+
+In a bracketed character class with case insensitive matching, ranges only work
+for ASCII characters. For example,
+C<m/[\N{CYRILLIC CAPITAL LETTER A}-\N{CYRILLIC CAPITAL LETTER YA}]/i>
+doesn't match all the Russian upper and lower case letters.
+
+Many regular expression constructs don't work on EBCDIC platforms.
+
This document varies from difficult to understand to completely
and utterly opaque. The wandering prose riddled with jargon is
hard to fathom in several places.
purpose of this document is to have a quick reference guide describing all
backslash and escape sequences.
-
=head2 The backslash
In a regular expression, the backslash can perform one of two tasks:
or it is the start of a backslash or escape sequence.
The rules determining what it is are quite simple: if the character
-following the backslash is a punctuation (non-word) character (that is,
-anything that is not a letter, digit or underscore), then the backslash
-just takes away the special meaning (if any) of the character following
-it.
-
-If the character following the backslash is a letter or a digit, then the
-sequence may be special; if so, it's listed below. A few letters have not
-been used yet, and escaping them with a backslash is safe for now, but a
-future version of Perl may assign a special meaning to it. However, if you
-have warnings turned on, Perl will issue a warning if you use such a sequence.
-[1].
+following the backslash is an ASCII punctuation (non-word) character (that is,
+anything that is not a letter, digit or underscore), then the backslash just
+takes away the special meaning (if any) of the character following it.
+
+If the character following the backslash is an ASCII letter or an ASCII digit,
+then the sequence may be special; if so, it's listed below. A few letters have
+not been used yet, so escaping them with a backslash doesn't change them to be
+special. A future version of Perl may assign a special meaning to them, so if
+you have warnings turned on, Perl will issue a warning if you use such a
+sequence. [1].
It is however guaranteed that backslash or escape sequences never have a
punctuation character following the backslash, not now, and not in a future
=head2 All the sequences and escapes
+Those not usable within a bracketed character class (like C<[\da-z]>) are marked
+as C<Not in [].>
+
\000 Octal escape sequence.
- \1 Absolute backreference.
+ \1 Absolute backreference. Not in [].
\a Alarm or bell.
- \A Beginning of string.
- \b Word/non-word boundary. (Backspace in a char class).
- \B Not a word/non-word boundary.
- \cX Control-X (X can be any ASCII character).
- \C Single octet, even under UTF-8.
+ \A Beginning of string. Not in [].
+ \b Word/non-word boundary. (Backspace in []).
+ \B Not a word/non-word boundary. Not in [].
+ \cX Control-X
+ \C Single octet, even under UTF-8. Not in [].
\d Character class for digits.
\D Character class for non-digits.
\e Escape character.
- \E Turn off \Q, \L and \U processing.
+ \E Turn off \Q, \L and \U processing. Not in [].
\f Form feed.
- \g{}, \g1 Named, absolute or relative backreference.
- \G Pos assertion.
- \h Character class for horizontal white space.
- \H Character class for non horizontal white space.
- \k{}, \k<>, \k'' Named backreference.
- \K Keep the stuff left of \K.
- \l Lowercase next character.
- \L Lowercase till \E.
+ \g{}, \g1 Named, absolute or relative backreference. Not in []
+ \G Pos assertion. Not in [].
+ \h Character class for horizontal whitespace.
+ \H Character class for non horizontal whitespace.
+ \k{}, \k<>, \k'' Named backreference. Not in [].
+ \K Keep the stuff left of \K. Not in [].
+ \l Lowercase next character. Not in [].
+ \L Lowercase till \E. Not in [].
\n (Logical) newline character.
- \N Any character but newline.
- \N{} Named (Unicode) character.
+ \N Any character but newline. Experimental. Not in [].
+ \N{} Named or numbered (Unicode) character.
\p{}, \pP Character with the given Unicode property.
\P{}, \PP Character without the given Unicode property.
- \Q Quotemeta till \E.
+ \Q Quotemeta till \E. Not in [].
\r Return character.
- \R Generic new line.
- \s Character class for white space.
- \S Character class for non white space.
+ \R Generic new line. Not in [].
+ \s Character class for whitespace.
+ \S Character class for non whitespace.
\t Tab character.
- \u Titlecase next character.
- \U Uppercase till \E.
- \v Character class for vertical white space.
- \V Character class for non vertical white space.
+ \u Titlecase next character. Not in [].
+ \U Uppercase till \E. Not in [].
+ \v Character class for vertical whitespace.
+ \V Character class for non vertical whitespace.
\w Character class for word characters.
\W Character class for non-word characters.
\x{}, \x00 Hexadecimal escape sequence.
- \X Unicode "extended grapheme cluster".
- \z End of string.
- \Z End of string.
+ \X Unicode "extended grapheme cluster". Not in [].
+ \z End of string. Not in [].
+ \Z End of string. Not in [].
=head2 Character Escapes
=head3 Fixed characters
A handful of characters have a dedicated I<character escape>. The following
-table shows them, along with their code points (in decimal and hex), their
-ASCII name, the control escape (see below) and a short description.
+table shows them, along with their ASCII code points (in decimal and hex),
+their ASCII name, the control escape on ASCII platforms and a short
+description. (For EBCDIC platforms, see L<perlebcdic/OPERATOR DIFFERENCES>.)
- Seq. Code Point ASCII Cntr Description.
+ Seq. Code Point ASCII Cntrl Description.
Dec Hex
\a 7 07 BEL \cG alarm or bell
\b 8 08 BS \cH backspace [1]
=head3 Control characters
C<\c> is used to denote a control character; the character following C<\c>
-is the name of the control character. For instance, C</\cM/> matches the
-character I<control-M> (a carriage return, code point 13). The case of the
-character following C<\c> doesn't matter: C<\cM> and C<\cm> match the same
-character.
+determines the value of the construct. For example the value of C<\cA> is
+C<chr(1)>, and the value of C<\cb> is C<chr(2)>, etc.
+The gory details are in L<perlop/"Regexp Quote-Like Operators">. A complete
+list of what C<chr(1)>, etc. means for ASCII and EBCDIC platforms is in
+L<perlebcdic/OPERATOR DIFFERENCES>.
+
+Note that C<\c\> alone at the end of a regular expression (or doubled-quoted
+string) is not valid. The backslash must be followed by another character.
+That is, C<\c\I<X>> means C<chr(28) . 'I<X>'> for all characters I<X>.
+
+To write platform-independent code, you must use C<\N{I<NAME>}> instead, like
+C<\N{ESCAPE}> or C<\N{U+001B}>, see L<charnames>.
Mnemonic: I<c>ontrol character.
$str =~ /\cK/; # Matches if $str contains a vertical tab (control-K).
-=head3 Named characters
+=head3 Named or numbered characters
+
+All Unicode characters have a Unicode name and numeric ordinal value. Use the
+C<\N{}> construct to specify a character by either of these values.
+
+To specify by name, the name of the character goes between the curly braces.
+In this case, you have to C<use charnames> to load the Unicode names of the
+characters, otherwise Perl will complain.
+
+To specify by Unicode ordinal number, use the form
+C<\N{U+I<wide hex character>}>, where I<wide hex character> is a number in
+hexadecimal that gives the ordinal number that Unicode has assigned to the
+desired character. It is customary (but not required) to use leading zeros to
+pad the number to 4 digits. Thus C<\N{U+0041}> means
+C<Latin Capital Letter A>, and you will rarely see it written without the two
+leading zeros. C<\N{U+0041}> means C<A> even on EBCDIC machines (where the
+ordinal value of C<A> is not 0x41).
-All Unicode characters have a Unicode name, and characters in various scripts
-have names as well. It is even possible to give your own names to characters.
-You can use a character by name by using the C<\N{}> construct; the name of
-the character goes between the curly braces. You do have to C<use charnames>
-to load the names of the characters, otherwise Perl will complain you use
-a name it doesn't know about. For more details, see L<charnames>.
+It is even possible to give your own names to characters, and even to short
+sequences of characters. For details, see L<charnames>.
+
+(There is an expanded internal form that you may see in debug output:
+C<\N{U+I<wide hex character>.I<wide hex character>...}>.
+The C<...> means any number of these I<wide hex character>s separated by dots.
+This represents the sequence formed by the characters. This is an internal
+form only, subject to change, and you should not try to use it yourself.)
Mnemonic: I<N>amed character.
+Note that a character that is expressed as a named or numbered character is
+considered as a character without special meaning by the regex engine, and will
+match "as is".
+
=head4 Example
use charnames ':full'; # Loads the Unicode names.
Octal escapes consist of a backslash followed by two or three octal digits
matching the code point of the character you want to use. This allows for
-512 characters (C<\00> up to C<\777>) that can be expressed this way.
+512 characters (C<\00> up to C<\777>) that can be expressed this way (but
+anything above C<\377> is deprecated).
Enough in pre-Unicode days, but most Unicode characters cannot be escaped
this way.
as a character without special meaning by the regex engine, and will match
"as is".
-=head4 Examples
+=head4 Examples (assuming an ASCII platform)
$str = "Perl";
$str =~ /\120/; # Match, "\120" is "P".
- $str =~ /\120+/; # Match, "\120" is "P", it is repeated at least once.
+ $str =~ /\120+/; # Match, "\120" is "P", it is repeated at least once
$str =~ /P\053/; # No match, "\053" is "+" and taken literally.
=head4 Caveat
=head3 Hexadecimal escapes
-Hexadecimal escapes start with C<\x> and are then either followed by
+Hexadecimal escapes start with C<\x> and are then either followed by a
two digit hexadecimal number, or a hexadecimal number of arbitrary length
surrounded by curly braces. The hexadecimal number is the code point of
the character you want to express.
Mnemonic: heI<x>adecimal.
-=head4 Examples
+=head4 Examples (assuming an ASCII platform)
$str = "Perl";
$str =~ /\x50/; # Match, "\x50" is "P".
- $str =~ /\x50+/; # Match, "\x50" is "P", it is repeated at least once.
+ $str =~ /\x50+/; # Match, "\x50" is "P", it is repeated at least once
$str =~ /P\x2B/; # No match, "\x2B" is "+" and taken literally.
/\x{2603}\x{2602}/ # Snowman with an umbrella.
discuss those here; full details of character classes can be found in
L<perlrecharclass>.
-C<\w> is a character class that matches any I<word> character (letters,
-digits, underscore). C<\d> is a character class that matches any digit,
-while the character class C<\s> matches any white space character.
+C<\w> is a character class that matches any single I<word> character (letters,
+digits, underscore). C<\d> is a character class that matches any decimal digit,
+while the character class C<\s> matches any whitespace character.
New in perl 5.10.0 are the classes C<\h> and C<\v> which match horizontal
-and vertical white space characters.
+and vertical whitespace characters.
The uppercase variants (C<\W>, C<\D>, C<\S>, C<\H>, and C<\V>) are
character classes that match any character that isn't a word character,
-digit, white space, horizontal white space or vertical white space.
+digit, whitespace, horizontal whitespace nor vertical whitespace.
Mnemonics: I<w>ord, I<d>igit, I<s>pace, I<h>orizontal, I<v>ertical.
include things like "letter", or "thai character". Capitalizing the
sequence to C<\PP> and C<\P{Property}> make the sequence match a character
that doesn't match the given Unicode property. For more details, see
-L<perlrecharclass/Backslashed sequences> and
+L<perlrecharclass/Backslash sequences> and
L<perlunicode/Unicode Character Properties>.
Mnemonic: I<p>roperty.
A backslash sequence that starts with a backslash and is followed by a
number is an absolute reference (but be aware of the caveat mentioned above).
-If the number is I<N>, it refers to the Nth set of parenthesis - whatever
+If the number is I<N>, it refers to the Nth set of parentheses - whatever
has been matched by that set of parenthesis has to be matched by the C<\N>
as well.
Note that C<\g{}> has the potential to be ambiguous, as it could be a named
reference, or an absolute or relative reference (if its argument is numeric).
-However, names are not allowed to start with digits, nor are allowed to
+However, names are not allowed to start with digits, nor are they allowed to
contain a hyphen, so there is no ambiguity.
=head4 Examples
=head2 Assertions
-Assertions are conditions that have to be true -- they don't actually
+Assertions are conditions that have to be true; they don't actually
match parts of the substring. There are six assertions that are written as
backslash sequences.
Mnemonic: I<K>eep.
+=item \N
+
+This is a new experimental feature in perl 5.12.0. It matches any character
+that is not a newline. It is a short-hand for writing C<[^\n]>, and is
+identical to the C<.> metasymbol, except under the C</s> flag, which changes
+the meaning of C<.>, but not C<\N>.
+
+Note that C<\N{...}> can mean a
+L<named or numbered character|/Named or numbered characters>.
+
+Mnemonic: Complement of I<\n>.
+
=item \R
+X<\R>
C<\R> matches a I<generic newline>, that is, anything that is considered
a newline by Unicode. This includes all characters matched by C<\v>
-(vertical white space), and the multi character sequence C<"\x0D\x0A">
+(vertical whitespace), and the multi character sequence C<"\x0D\x0A">
(carriage return followed by a line feed, aka the network newline, or
-the newline used in Windows text files). C<\R> is equivalent with
-C<< (?>\x0D\x0A)|\v) >>. Since C<\R> can match a more than one character,
-it cannot be put inside a bracketed character class; C</[\R]/> is an error.
-C<\R> was introduced in perl 5.10.0.
+the newline used in Windows text files). C<\R> is equivalent to
+C<< (?>\x0D\x0A)|\v) >>. Since C<\R> can match a sequence of more than one
+character, it cannot be put inside a bracketed character class; C</[\R]/> is an
+error; use C<\v> instead. C<\R> was introduced in perl 5.10.0.
Mnemonic: none really. C<\R> was picked because PCRE already uses C<\R>,
and more importantly because Unicode recommends such a regular expression
metacharacter, and suggests C<\R> as the notation.
=item \X
+X<\X>
This matches a Unicode I<extended grapheme cluster>.
C<\X> matches quite well what normal (non-Unicode-programmer) usage
would consider a single character. As an example, consider a G with some sort
of diacritic mark, such as an arrow. There is no such single character in
-Unicode, but one can be composed using a G followed by a Unicode "COMBINING
+Unicode, but one can be composed by using a G followed by a Unicode "COMBINING
UPWARDS ARROW BELOW", and would be displayed by Unicode-aware software as if it
were a single character.
"\x{256}" =~ /^\C\C$/; # Match as chr (256) takes 2 octets in UTF-8.
- $str =~ s/foo\Kbar/baz/g; # Change any 'bar' following a 'foo' to 'baz'.
+ $str =~ s/foo\Kbar/baz/g; # Change any 'bar' following a 'foo' to 'baz'
$str =~ s/(.)\K\1//g; # Delete duplicated characters.
"\n" =~ /^\R$/; # Match, \n is a generic newline.
=head1 NAME
+X<character class>
perlrecharclass - Perl Regular Expression Character Classes
is found in L<perlre>.
This manual page discusses the syntax and use of character
-classes in Perl Regular Expressions.
+classes in Perl regular expressions.
-A character class is a way of denoting a set of characters,
+A character class is a way of denoting a set of characters
in such a way that one character of the set is matched.
-It's important to remember that matching a character class
+It's important to remember that: matching a character class
consumes exactly one character in the source string. (The source
string is the string the regular expression is matched against.)
There are three types of character classes in Perl regular
-expressions: the dot, backslashed sequences, and the bracketed form.
+expressions: the dot, backslash sequences, and the form enclosed in square
+brackets. Keep in mind, though, that often the term "character class" is used
+to mean just the bracketed form. Certainly, most Perl documentation does that.
=head2 The dot
The dot (or period), C<.> is probably the most used, and certainly
the most well-known character class. By default, a dot matches any
character, except for the newline. The default can be changed to
-add matching the newline with the I<single line> modifier: either
-for the entire regular expression using the C</s> modifier, or
-locally using C<(?s)>.
+add matching the newline by using the I<single line> modifier: either
+for the entire regular expression with the C</s> modifier, or
+locally with C<(?s)>. (The experimental C<\N> backslash sequence, described
+below, matches any character except newline without regard to the
+I<single line> modifier.)
Here are some examples:
"\n" =~ /(?s:.)/ # Match (local 'single line' modifier)
"ab" =~ /^.$/ # No match (dot matches one character)
-=head2 Backslashed sequences
+=head2 Backslash sequences
+X<\w> X<\W> X<\s> X<\S> X<\d> X<\D> X<\p> X<\P>
+X<\N> X<\v> X<\V> X<\h> X<\H>
+X<word> X<whitespace>
-Perl regular expressions contain many backslashed sequences that
-constitute a character class. That is, they will match a single
-character, if that character belongs to a specific set of characters
-(defined by the sequence). A backslashed sequence is a sequence of
-characters starting with a backslash. Not all backslashed sequences
-are character class; for a full list, see L<perlrebackslash>.
+A backslash sequence is a sequence of characters, the first one of which is a
+backslash. Perl ascribes special meaning to many such sequences, and some of
+these are character classes. That is, they match a single character each,
+provided that the character belongs to the specific set of characters defined
+by the sequence.
-Here's a list of the backslashed sequences, which are discussed in
-more detail below.
+Here's a list of the backslash sequences that are character classes. They
+are discussed in more detail below. (For the backslash sequences that aren't
+character classes, see L<perlrebackslash>.)
- \d Match a digit character.
- \D Match a non-digit character.
+ \d Match a decimal digit character.
+ \D Match a non-decimal-digit character.
\w Match a "word" character.
\W Match a non-"word" character.
- \s Match a white space character.
- \S Match a non-white space character.
- \h Match a horizontal white space character.
- \H Match a character that isn't horizontal white space.
- \N Match a character that isn't newline.
- \v Match a vertical white space character.
- \V Match a character that isn't vertical white space.
- \pP, \p{Prop} Match a character matching a Unicode property.
- \PP, \P{Prop} Match a character that doesn't match a Unicode property.
+ \s Match a whitespace character.
+ \S Match a non-whitespace character.
+ \h Match a horizontal whitespace character.
+ \H Match a character that isn't horizontal whitespace.
+ \v Match a vertical whitespace character.
+ \V Match a character that isn't vertical whitespace.
+ \N Match a character that isn't a newline. Experimental.
+ \pP, \p{Prop} Match a character that has the given Unicode property.
+ \PP, \P{Prop} Match a character that doesn't have the Unicode property
=head3 Digits
-C<\d> matches a single character that is considered to be a I<digit>.
-What is considered a digit depends on the internal encoding of
-the source string. If the source string is in UTF-8 format, C<\d>
-not only matches the digits '0' - '9', but also Arabic, Devanagari and
-digits from other languages. Otherwise, if there is a locale in effect,
-it will match whatever characters the locale considers digits. Without
-a locale, C<\d> matches the digits '0' to '9'.
-See L</Locale, Unicode and UTF-8>.
+C<\d> matches a single character that is considered to be a decimal I<digit>.
+What is considered a decimal digit depends on the internal encoding of the
+source string and the locale that is in effect. If the source string is in
+UTF-8 format, C<\d> not only matches the digits '0' - '9', but also Arabic,
+Devanagari and digits from other languages. Otherwise, if there is a locale in
+effect, it will match whatever characters the locale considers decimal digits.
+Without a locale, C<\d> matches just the digits '0' to '9'.
+See L</Locale, EBCDIC, Unicode and UTF-8>.
+
+Unicode digits may cause some confusion, and some security issues. In UTF-8
+strings, C<\d> matches the same characters matched by
+C<\p{General_Category=Decimal_Number}>, or synonymously,
+C<\p{General_Category=Digit}>. Starting with Unicode version 4.1, this is the
+same set of characters matched by C<\p{Numeric_Type=Decimal}>.
+
+But Unicode also has a different property with a similar name,
+C<\p{Numeric_Type=Digit}>, which matches a completely different set of
+characters. These characters are things such as subscripts.
+
+The design intent is for C<\d> to match all the digits (and no other characters)
+that can be used with "normal" big-endian positional decimal syntax, whereby a
+sequence of such digits {N0, N1, N2, ...Nn} has the numeric value (...(N0 * 10
++ N1) * 10 + N2) * 10 ... + Nn). In Unicode 5.2, the Tamil digits (U+0BE6 -
+U+0BEF) can also legally be used in old-style Tamil numbers in which they would
+appear no more than one in a row, separated by characters that mean "times 10",
+"times 100", etc. (See L<http://www.unicode.org/notes/tn21>.)
+
+Some of the non-European digits that C<\d> matches look like European ones, but
+have different values. For example, BENGALI DIGIT FOUR (U+09A) looks very much
+like an ASCII DIGIT EIGHT (U+0038).
+
+It may be useful for security purposes for an application to require that all
+digits in a row be from the same script. See L<Unicode::UCD/charscript()>.
Any character that isn't matched by C<\d> will be matched by C<\D>.
=head3 Word characters
-C<\w> matches a single I<word> character: an alphanumeric character
-(that is, an alphabetic character, or a digit), or the underscore (C<_>).
-What is considered a word character depends on the internal encoding
-of the string. If it's in UTF-8 format, C<\w> matches those characters
-that are considered word characters in the Unicode database. That is, it
-not only matches ASCII letters, but also Thai letters, Greek letters, etc.
-If the source string isn't in UTF-8 format, C<\w> matches those characters
-that are considered word characters by the current locale. Without
-a locale in effect, C<\w> matches the ASCII letters, digits and the
-underscore.
+A C<\w> matches a single alphanumeric character (an alphabetic character, or a
+decimal digit) or an underscore (C<_>), not a whole word. To match a whole
+word, use C<\w+>. This isn't the same thing as matching an English word, but
+is the same as a string of Perl-identifier characters. What is considered a
+word character depends on the internal
+encoding of the string and the locale or EBCDIC code page that is in effect. If
+it's in UTF-8 format, C<\w> matches those characters that are considered word
+characters in the Unicode database. That is, it not only matches ASCII letters,
+but also Thai letters, Greek letters, etc. If the source string isn't in UTF-8
+format, C<\w> matches those characters that are considered word characters by
+the current locale or EBCDIC code page. Without a locale or EBCDIC code page,
+C<\w> matches the ASCII letters, digits and the underscore.
+See L</Locale, EBCDIC, Unicode and UTF-8>.
+
+There are a number of security issues with the full Unicode list of word
+characters. See L<http://unicode.org/reports/tr36>.
+
+Also, for a somewhat finer-grained set of characters that are in programming
+language identifiers beyond the ASCII range, you may wish to instead use the
+more customized Unicode properties, "ID_Start", ID_Continue", "XID_Start", and
+"XID_Continue". See L<http://unicode.org/reports/tr31>.
Any character that isn't matched by C<\w> will be matched by C<\W>.
-=head3 White space
-
-C<\s> matches any single character that is considered white space. In the
-ASCII range, C<\s> matches the horizontal tab (C<\t>), the new line
-(C<\n>), the form feed (C<\f>), the carriage return (C<\r>), and the
-space (the vertical tab, C<\cK> is not matched by C<\s>). The exact set
-of characters matched by C<\s> depends on whether the source string is
-in UTF-8 format. If it is, C<\s> matches what is considered white space
-in the Unicode database. Otherwise, if there is a locale in effect, C<\s>
-matches whatever is considered white space by the current locale. Without
-a locale, C<\s> matches the five characters mentioned in the beginning
-of this paragraph. Perhaps the most notable difference is that C<\s>
-matches a non-breaking space only if the non-breaking space is in a
-UTF-8 encoded string.
+=head3 Whitespace
+
+C<\s> matches any single character that is considered whitespace. The exact
+set of characters matched by C<\s> depends on whether the source string is in
+UTF-8 format and the locale or EBCDIC code page that is in effect. If it's in
+UTF-8 format, C<\s> matches what is considered whitespace in the Unicode
+database; the complete list is in the table below. Otherwise, if there is a
+locale or EBCDIC code page in effect, C<\s> matches whatever is considered
+whitespace by the current locale or EBCDIC code page. Without a locale or
+EBCDIC code page, C<\s> matches the horizontal tab (C<\t>), the newline
+(C<\n>), the form feed (C<\f>), the carriage return (C<\r>), and the space.
+(Note that it doesn't match the vertical tab, C<\cK>.) Perhaps the most notable
+possible surprise is that C<\s> matches a non-breaking space only if the
+non-breaking space is in a UTF-8 encoded string or the locale or EBCDIC code
+page that is in effect has that character.
+See L</Locale, EBCDIC, Unicode and UTF-8>.
Any character that isn't matched by C<\s> will be matched by C<\S>.
-C<\h> will match any character that is considered horizontal white space;
-this includes the space and the tab characters. C<\H> will match any character
-that is not considered horizontal white space.
+C<\h> will match any character that is considered horizontal whitespace;
+this includes the space and the tab characters and a number other characters,
+all of which are listed in the table below. C<\H> will match any character
+that is not considered horizontal whitespace.
-C<\N>, like the dot, will match any character that is not a newline. The
-difference is that C<\N> will not be influenced by the single line C</s>
-regular expression modifier. (Note that, since C<\N{}> is also used for
-Unicode named characters, if C<\N> is followed by an opening brace and
-by a letter, perl will assume that a Unicode character name is coming.)
-
-C<\v> will match any character that is considered vertical white space;
-this includes the carriage return and line feed characters (newline).
-C<\V> will match any character that is not considered vertical white space.
+C<\v> will match any character that is considered vertical whitespace;
+this includes the carriage return and line feed characters (newline) plus several
+other characters, all listed in the table below.
+C<\V> will match any character that is not considered vertical whitespace.
C<\R> matches anything that can be considered a newline under Unicode
rules. It's not a character class, as it can match a multi-character
sequence. Therefore, it cannot be used inside a bracketed character
-class. Details are discussed in L<perlrebackslash>.
-
-C<\h>, C<\H>, C<\v>, C<\V>, and C<\R> are new in perl 5.10.0.
+class; use C<\v> instead (vertical whitespace).
+Details are discussed in L<perlrebackslash>.
Note that unlike C<\s>, C<\d> and C<\w>, C<\h> and C<\v> always match
the same characters, regardless whether the source string is in UTF-8
format or not. The set of characters they match is also not influenced
-by locale.
+by locale nor EBCDIC code page.
-One might think that C<\s> is equivalent with C<[\h\v]>. This is not true.
-The vertical tab (C<"\x0b">) is not matched by C<\s>, it is however
-considered vertical white space. Furthermore, if the source string is
-not in UTF-8 format, the next line (C<"\x85">) and the no-break space
-(C<"\xA0">) are not matched by C<\s>, but are by C<\v> and C<\h> respectively.
-If the source string is in UTF-8 format, both the next line and the
-no-break space are matched by C<\s>.
+One might think that C<\s> is equivalent to C<[\h\v]>. This is not true. The
+vertical tab (C<"\x0b">) is not matched by C<\s>, it is however considered
+vertical whitespace. Furthermore, if the source string is not in UTF-8 format,
+and any locale or EBCDIC code page that is in effect doesn't include them, the
+next line (ASCII-platform C<"\x85">) and the no-break space (ASCII-platform
+C<"\xA0">) characters are not matched by C<\s>, but are by C<\v> and C<\h>
+respectively. If the source string is in UTF-8 format, both the next line and
+the no-break space are matched by C<\s>.
The following table is a complete listing of characters matched by
-C<\s>, C<\h> and C<\v>.
+C<\s>, C<\h> and C<\v> as of Unicode 5.2.
The first column gives the code point of the character (in hex format),
the second column gives the (Unicode) name. The third column indicates
-by which class(es) the character is matched.
+by which class(es) the character is matched (assuming no locale or EBCDIC code
+page is in effect that changes the C<\s> matching).
0x00009 CHARACTER TABULATION h s
0x0000a LINE FEED (LF) vs
=item [1]
NEXT LINE and NO-BREAK SPACE only match C<\s> if the source string is in
-UTF-8 format.
+UTF-8 format, or the locale or EBCDIC code page that is in effect includes them.
=back
complete numbers or words. To match a number (that consists of integers),
use C<\d+>; to match a word, use C<\w+>.
+=head3 \N
+
+C<\N> is new in 5.12, and is experimental. It, like the dot, will match any
+character that is not a newline. The difference is that C<\N> is not influenced
+by the I<single line> regular expression modifier (see L</The dot> above). Note
+that the form C<\N{...}> may mean something completely different. When the
+C<{...}> is a L<quantifier|perlre/Quantifiers>, it means to match a non-newline
+character that many times. For example, C<\N{3}> means to match 3
+non-newlines; C<\N{5,}> means to match 5 or more non-newlines. But if C<{...}>
+is not a legal quantifier, it is presumed to be a named character. See
+L<charnames> for those. For example, none of C<\N{COLON}>, C<\N{4F}>, and
+C<\N{F4}> contain legal quantifiers, so Perl will try to find characters whose
+names are, respectively, C<COLON>, C<4F>, and C<F4>.
=head3 Unicode Properties
-C<\pP> and C<\p{Prop}> are character classes to match characters that
-fit given Unicode classes. One letter classes can be used in the C<\pP>
-form, with the class name following the C<\p>, otherwise, braces are required.
-There is a single form, which is just the property name enclosed in the braces,
-and a compound form which looks like C<\p{name=value}>, which means to match
-if the property C<name> for the character has the particular C<value>.
+C<\pP> and C<\p{Prop}> are character classes to match characters that fit given
+Unicode properties. One letter property names can be used in the C<\pP> form,
+with the property name following the C<\p>, otherwise, braces are required.
+When using braces, there is a single form, which is just the property name
+enclosed in the braces, and a compound form which looks like C<\p{name=value}>,
+which means to match if the property "name" for the character has the particular
+"value".
For instance, a match for a number can be written as C</\pN/> or as
C</\p{Number}/>, or as C</\p{Number=True}/>.
Lowercase letters are matched by the property I<Lowercase_Letter> which
"7" =~ /\w/ # Match, "7" is a 'word' character as well.
"a" =~ /\d/ # No match, "a" isn't a digit.
"7" =~ /\d/ # Match, "7" is a digit.
- " " =~ /\s/ # Match, a space is white space.
+ " " =~ /\s/ # Match, a space is whitespace.
"a" =~ /\D/ # Match, "a" is a non-digit.
"7" =~ /\D/ # No match, "7" is not a non-digit.
- " " =~ /\S/ # No match, a space is not non-white space.
+ " " =~ /\S/ # No match, a space is not non-whitespace.
- " " =~ /\h/ # Match, space is horizontal white space.
- " " =~ /\v/ # No match, space is not vertical white space.
- "\r" =~ /\v/ # Match, a return is vertical white space.
+ " " =~ /\h/ # Match, space is horizontal whitespace.
+ " " =~ /\v/ # No match, space is not vertical whitespace.
+ "\r" =~ /\v/ # Match, a return is vertical whitespace.
"a" =~ /\pL/ # Match, "a" is a letter.
"a" =~ /\p{Lu}/ # No match, /\p{Lu}/ matches upper case letters.
"\x{0e0b}" =~ /\p{Thai}/ # Match, \x{0e0b} is the character
# 'THAI CHARACTER SO SO', and that's in
# Thai Unicode class.
- "a" =~ /\P{Lao}/ # Match, as "a" is not a Laoian character.
+ "a" =~ /\P{Lao}/ # Match, as "a" is not a Laotian character.
=head2 Bracketed Character Classes
The third form of character class you can use in Perl regular expressions
-is the bracketed form. In its simplest form, it lists the characters
-that may be matched inside square brackets, like this: C<[aeiou]>.
-This matches one of C<a>, C<e>, C<i>, C<o> or C<u>. Just as the other
+is the bracketed character class. In its simplest form, it lists the characters
+that may be matched, surrounded by square brackets, like this: C<[aeiou]>.
+This matches one of C<a>, C<e>, C<i>, C<o> or C<u>. Like the other
character classes, exactly one character will be matched. To match
-a longer string consisting of characters mentioned in the characters
-class, follow the character class with a quantifier. For instance,
-C<[aeiou]+> matches a string of one or more lowercase ASCII vowels.
+a longer string consisting of characters mentioned in the character
+class, follow the character class with a L<quantifier|perlre/Quantifiers>. For
+instance, C<[aeiou]+> matches a string of one or more lowercase English vowels.
Repeating a character in a character class has no
effect; it's considered to be in the set only once.
=head3 Special Characters Inside a Bracketed Character Class
Most characters that are meta characters in regular expressions (that
-is, characters that carry a special meaning like C<*> or C<(>) lose
+is, characters that carry a special meaning like C<.>, C<*>, or C<(>) lose
their special meaning and can be used inside a character class without
the need to escape them. For instance, C<[()]> matches either an opening
parenthesis, or a closing parenthesis, and the parens inside the character
case the backslash may be omitted.
The sequence C<\b> is special inside a bracketed character class. While
-outside the character class C<\b> is an assertion indicating a point
+outside the character class, C<\b> is an assertion indicating a point
that does not have either two word characters or two non-word characters
on either side, inside a bracketed character class, C<\b> matches a
backspace character.
-A C<[> is not special inside a character class, unless it's the start
-of a POSIX character class (see below). It normally does not need escaping.
-
-A C<]> is either the end of a POSIX character class (see below), or it
-signals the end of the bracketed character class. Normally it needs
-escaping if you want to include a C<]> in the set of characters.
+The sequences
+C<\a>,
+C<\c>,
+C<\e>,
+C<\f>,
+C<\n>,
+C<\N{I<NAME>}>,
+C<\N{U+I<wide hex char>}>,
+C<\r>,
+C<\t>,
+and
+C<\x>
+are also special and have the same meanings as they do outside a bracketed character
+class.
+
+Also, a backslash followed by two or three octal digits is considered an octal
+number.
+
+A C<[> is not special inside a character class, unless it's the start of a
+POSIX character class (see L</POSIX Character Classes> below). It normally does
+not need escaping.
+
+A C<]> is normally either the end of a POSIX character class (see
+L</POSIX Character Classes> below), or it signals the end of the bracketed
+character class. If you want to include a C<]> in the set of characters, you
+must generally escape it.
However, if the C<]> is the I<first> (or the second if the first
character is a caret) character of a bracketed character class, it
does not denote the end of the class (as you cannot have an empty class)
"+" =~ /[+?*]/ # Match, "+" in a character class is not special.
"\cH" =~ /[\b]/ # Match, \b inside in a character class
- # is equivalent with a backspace.
+ # is equivalent to a backspace.
"]" =~ /[][]/ # Match, as the character class contains.
# both [ and ].
"[]" =~ /[[]]/ # Match, the pattern contains a character class
such ranges may lead to portability problems if the code has to run on
a platform that uses a different character set, such as EBCDIC.
-If a hyphen in a character class cannot be part of a range, for instance
-because it is the first or the last character of the character class,
+If a hyphen in a character class cannot syntactically be part of a range, for
+instance because it is the first or the last character of the character class,
or if it immediately follows a range, the hyphen isn't special, and will be
-considered a character that may be matched. You have to escape the hyphen
-with a backslash if you want to have a hyphen in your set of characters to
-be matched, and its position in the class is such that it can be considered
-part of a range.
+considered a character that is to be matched literally. You have to escape the
+hyphen with a backslash if you want to have a hyphen in your set of characters
+to be matched, and its position in the class is such that it could be
+considered part of a range.
Examples:
[a-z] # Matches a character that is a lower case ASCII letter.
- [a-fz] # Matches any letter between 'a' and 'f' (inclusive) or the
- # letter 'z'.
+ [a-fz] # Matches any letter between 'a' and 'f' (inclusive) or
+ # the letter 'z'.
[-z] # Matches either a hyphen ('-') or the letter 'z'.
[a-f-m] # Matches any letter between 'a' and 'f' (inclusive), the
# hyphen ('-'), or the letter 'm'.
=head3 Backslash Sequences
-You can put a backslash sequence character class inside a bracketed character
-class, and it will act just as if you put all the characters matched by
-the backslash sequence inside the character class. For instance,
-C<[a-f\d]> will match any digit, or any of the lowercase letters between
-'a' and 'f' inclusive.
+You can put any backslash sequence character class (with the exception of
+C<\N>) inside a bracketed character class, and it will act just
+as if you put all the characters matched by the backslash sequence inside the
+character class. For instance, C<[a-f\d]> will match any decimal digit, or any
+of the lowercase letters between 'a' and 'f' inclusive.
+
+C<\N> within a bracketed character class must be of the forms C<\N{I<name>}>
+or C<\N{U+I<wide hex char>}>, and NOT be the form that matches non-newlines,
+for the same reason that a dot C<.> inside a bracketed character class loses
+its special meaning: it matches nearly anything, which generally isn't what you
+want to happen.
+
Examples:
# character, nor a parenthesis.
Backslash sequence character classes cannot form one of the endpoints
-of a range.
+of a range. Thus, you can't say:
+
+ /[\p{Thai}-\d]/ # Wrong!
-=head3 Posix Character Classes
+=head3 POSIX Character Classes
+X<character class> X<\p> X<\p{}>
+X<alpha> X<alnum> X<ascii> X<blank> X<cntrl> X<digit> X<graph>
+X<lower> X<print> X<punct> X<space> X<upper> X<word> X<xdigit>
-Posix character classes have the form C<[:class:]>, where I<class> is
-name, and the C<[:> and C<:]> delimiters. Posix character classes appear
+POSIX character classes have the form C<[:class:]>, where I<class> is
+name, and the C<[:> and C<:]> delimiters. POSIX character classes only appear
I<inside> bracketed character classes, and are a convenient and descriptive
-way of listing a group of characters. Be careful about the syntax,
+way of listing a group of characters, though they currently suffer from
+portability issues (see below and L<Locale, EBCDIC, Unicode and UTF-8>).
+
+Be careful about the syntax,
# Correct:
$string =~ /[[:alpha:]]/
The latter pattern would be a character class consisting of a colon,
and the letters C<a>, C<l>, C<p> and C<h>.
+POSIX character classes can be part of a larger bracketed character class. For
+example,
+
+ [01[:alpha:]%]
+
+is valid and matches '0', '1', any alphabetic character, and the percent sign.
Perl recognizes the following POSIX character classes:
- alpha Any alphabetical character.
- alnum Any alphanumerical character.
- ascii Any ASCII character.
+ alpha Any alphabetical character ("[A-Za-z]").
+ alnum Any alphanumerical character. ("[A-Za-z0-9]")
+ ascii Any character in the ASCII character set.
blank A GNU extension, equal to a space or a horizontal tab ("\t").
- cntrl Any control character.
- digit Any digit, equivalent to "\d".
- graph Any printable character, excluding a space.
- lower Any lowercase character.
- print Any printable character, including a space.
- punct Any punctuation character.
- space Any white space character. "\s" plus the vertical tab ("\cK").
- upper Any uppercase character.
- word Any "word" character, equivalent to "\w".
- xdigit Any hexadecimal digit, '0' - '9', 'a' - 'f', 'A' - 'F'.
-
-The exact set of characters matched depends on whether the source string
-is internally in UTF-8 format or not. See L</Locale, Unicode and UTF-8>.
-
-Most POSIX character classes have C<\p> counterparts. The difference
-is that the C<\p> classes will always match according to the Unicode
-properties, regardless whether the string is in UTF-8 format or not.
-
-The following table shows the relation between POSIX character classes
-and the Unicode properties:
-
- [[:...:]] \p{...} backslash
-
- alpha IsAlpha
- alnum IsAlnum
- ascii IsASCII
- blank
- cntrl IsCntrl
- digit IsDigit \d
- graph IsGraph
- lower IsLower
- print IsPrint
- punct IsPunct
- space IsSpace
- IsSpacePerl \s
- upper IsUpper
- word IsWord
- xdigit IsXDigit
-
-Some of these names may not be obvious:
+ cntrl Any control character. See Note [2] below.
+ digit Any decimal digit ("[0-9]"), equivalent to "\d".
+ graph Any printable character, excluding a space. See Note [3] below.
+ lower Any lowercase character ("[a-z]").
+ print Any printable character, including a space. See Note [4] below.
+ punct Any graphical character excluding "word" characters. Note [5].
+ space Any whitespace character. "\s" plus the vertical tab ("\cK").
+ upper Any uppercase character ("[A-Z]").
+ word A Perl extension ("[A-Za-z0-9_]"), equivalent to "\w".
+ xdigit Any hexadecimal digit ("[0-9a-fA-F]").
+
+Most POSIX character classes have two Unicode-style C<\p> property
+counterparts. (They are not official Unicode properties, but Perl extensions
+derived from official Unicode properties.) The table below shows the relation
+between POSIX character classes and these counterparts.
+
+One counterpart, in the column labelled "ASCII-range Unicode" in
+the table, will only match characters in the ASCII character set.
+
+The other counterpart, in the column labelled "Full-range Unicode", matches any
+appropriate characters in the full Unicode character set. For example,
+C<\p{Alpha}> will match not just the ASCII alphabetic characters, but any
+character in the entire Unicode character set that is considered to be
+alphabetic.
+
+(Each of the counterparts has various synonyms as well.
+L<perluniprops/Properties accessible through \p{} and \P{}> lists all the
+synonyms, plus all the characters matched by each of the ASCII-range
+properties. For example C<\p{AHex}> is a synonym for C<\p{ASCII_Hex_Digit}>,
+and any C<\p> property name can be prefixed with "Is" such as C<\p{IsAlpha}>.)
+
+Both the C<\p> forms are unaffected by any locale that is in effect, or whether
+the string is in UTF-8 format or not, or whether the platform is EBCDIC or not.
+In contrast, the POSIX character classes are affected. If the source string is
+in UTF-8 format, the POSIX classes (with the exception of C<[[:punct:]]>, see
+Note [5] below) behave like their "Full-range" Unicode counterparts. If the
+source string is not in UTF-8 format, and no locale is in effect, and the
+platform is not EBCDIC, all the POSIX classes behave like their ASCII-range
+counterparts. Otherwise, they behave based on the rules of the locale or
+EBCDIC code page.
+
+It is proposed to change this behavior in a future release of Perl so that the
+the UTF8ness of the source string will be irrelevant to the behavior of the
+POSIX character classes. This means they will always behave in strict
+accordance with the official POSIX standard. That is, if either locale or
+EBCDIC code page is present, they will behave in accordance with those; if
+absent, the classes will match only their ASCII-range counterparts. If you
+disagree with this proposal, send email to C<perl5-porters@perl.org>.
+
+ [[:...:]] ASCII-range Full-range backslash Note
+ Unicode Unicode sequence
+ -----------------------------------------------------
+ alpha \p{PosixAlpha} \p{Alpha}
+ alnum \p{PosixAlnum} \p{Alnum}
+ ascii \p{ASCII}
+ blank \p{PosixBlank} \p{Blank} = [1]
+ \p{HorizSpace} \h [1]
+ cntrl \p{PosixCntrl} \p{Cntrl} [2]
+ digit \p{PosixDigit} \p{Digit} \d
+ graph \p{PosixGraph} \p{Graph} [3]
+ lower \p{PosixLower} \p{Lower}
+ print \p{PosixPrint} \p{Print} [4]
+ punct \p{PosixPunct} \p{Punct} [5]
+ \p{PerlSpace} \p{SpacePerl} \s [6]
+ space \p{PosixSpace} \p{Space} [6]
+ upper \p{PosixUpper} \p{Upper}
+ word \p{PerlWord} \p{Word} \w
+ xdigit \p{ASCII_Hex_Digit} \p{XDigit}
=over 4
-=item cntrl
+=item [1]
+
+C<\p{Blank}> and C<\p{HorizSpace}> are synonyms.
+
+=item [2]
+
+Control characters don't produce output as such, but instead usually control
+the terminal somehow: for example newline and backspace are control characters.
+In the ASCII range, characters whose ordinals are between 0 and 31 inclusive,
+plus 127 (C<DEL>) are control characters.
-Any control character. Usually, control characters don't produce output
-as such, but instead control the terminal somehow: for example newline
-and backspace are control characters. All characters with C<ord()> less
-than 32 are usually classified as control characters (in ASCII, the ISO
-Latin character sets, and Unicode), as is the character C<ord()> value
-of 127 (C<DEL>).
+On EBCDIC platforms, it is likely that the code page will define C<[[:cntrl:]]>
+to be the EBCDIC equivalents of the ASCII controls, plus the controls
+that in Unicode have ordinals from 128 through 159.
-=item graph
+=item [3]
Any character that is I<graphical>, that is, visible. This class consists
of all the alphanumerical characters and all punctuation characters.
-=item print
+=item [4]
All printable characters, which is the set of all the graphical characters
-plus the space.
+plus whitespace characters that are not also controls.
+
+=item [5] (punct)
+
+C<\p{PosixPunct}> and C<[[:punct:]]> in the ASCII range match all the
+non-controls, non-alphanumeric, non-space characters:
+C<[-!"#$%&'()*+,./:;<=E<gt>?@[\\\]^_`{|}~]> (although if a locale is in effect,
+it could alter the behavior of C<[[:punct:]]>).
+
+C<\p{Punct}> matches a somewhat different set in the ASCII range, namely
+C<[-!"#%&'()*,./:;?@[\\\]_{}]>. That is, it is missing C<[$+E<lt>=E<gt>^`|~]>.
+This is because Unicode splits what POSIX considers to be punctuation into two
+categories, Punctuation and Symbols.
+
+When the matching string is in UTF-8 format, C<[[:punct:]]> matches what it
+matches in the ASCII range, plus what C<\p{Punct}> matches. This is different
+than strictly matching according to C<\p{Punct}>. Another way to say it is that
+for a UTF-8 string, C<[[:punct:]]> matches all the characters that Unicode
+considers to be punctuation, plus all the ASCII-range characters that Unicode
+considers to be symbols.
-=item punct
+=item [6]
-Any punctuation (special) character.
+C<\p{SpacePerl}> and C<\p{Space}> differ only in that C<\p{Space}> additionally
+matches the vertical tab, C<\cK>. Same for the two ASCII-only range forms.
=back
=head4 Negation
+X<character class, negation>
A Perl extension to the POSIX character class is the ability to
negate it. This is done by prefixing the class name with a caret (C<^>).
Some examples:
- POSIX Unicode Backslash
- [[:^digit:]] \P{IsDigit} \D
- [[:^space:]] \P{IsSpace} \S
- [[:^word:]] \P{IsWord} \W
+ POSIX ASCII-range Full-range backslash
+ Unicode Unicode sequence
+ -----------------------------------------------------
+ [[:^digit:]] \P{PosixDigit} \P{Digit} \D
+ [[:^space:]] \P{PosixSpace} \P{Space}
+ \P{PerlSpace} \P{SpacePerl} \S
+ [[:^word:]] \P{PerlWord} \P{Word} \W
=head4 [= =] and [. .]
Perl will recognize the POSIX character classes C<[=class=]>, and
-C<[.class.]>, but does not (yet?) support this construct. Use of
+C<[.class.]>, but does not (yet?) support them. Use of
such a construct will lead to an error.
/[[:digit:]]/ # Matches a character that is a digit.
/[01[:lower:]]/ # Matches a character that is either a
# lowercase letter, or '0' or '1'.
- /[[:digit:][:^xdigit:]]/ # Matches a character that can be anything,
- # but the letters 'a' to 'f' in either case.
- # This is because the character class contains
- # all digits, and anything that isn't a
- # hex digit, resulting in a class containing
- # all characters, but the letters 'a' to 'f'
- # and 'A' to 'F'.
+ /[[:digit:][:^xdigit:]]/ # Matches a character that can be anything
+ # except the letters 'a' to 'f'. This is
+ # because the main character class is composed
+ # of two POSIX character classes that are ORed
+ # together, one that matches any digit, and
+ # the other that matches anything that isn't a
+ # hex digit. The result matches all
+ # characters except the letters 'a' to 'f' and
+ # 'A' to 'F'.
-=head2 Locale, Unicode and UTF-8
+=head2 Locale, EBCDIC, Unicode and UTF-8
Some of the character classes have a somewhat different behaviour depending
on the internal encoding of the source string, and the locale that is
-in effect.
+in effect, and if the program is running on an EBCDIC platform.
C<\w>, C<\d>, C<\s> and the POSIX character classes (and their negations,
-including C<\W>, C<\D>, C<\S>) suffer from this behaviour.
+including C<\W>, C<\D>, C<\S>) suffer from this behaviour. (Since the backslash
+sequences C<\b> and C<\B> are defined in terms of C<\w> and C<\W>, they also are
+affected.)
The rule is that if the source string is in UTF-8 format, the character
classes match according to the Unicode properties. If the source string
-isn't, then the character classes match according to whatever locale is
-in effect. If there is no locale, they match the ASCII defaults
-(52 letters, 10 digits and underscore for C<\w>, 0 to 9 for C<\d>, etc).
+isn't, then the character classes match according to whatever locale or EBCDIC
+code page is in effect. If there is no locale nor EBCDIC, they match the ASCII
+defaults (0 to 9 for C<\d>; 52 letters, 10 digits and underscore for C<\w>;
+etc.).
This usually means that if you are matching against characters whose C<ord()>
values are between 128 and 255 inclusive, your character class may match
-or not depending on the current locale, and whether the source string is
-in UTF-8 format. The string will be in UTF-8 format if it contains
-characters whose C<ord()> value exceeds 255. But a string may be in UTF-8
-format without it having such characters.
+or not depending on the current locale or EBCDIC code page, and whether the
+source string is in UTF-8 format. The string will be in UTF-8 format if it
+contains characters whose C<ord()> value exceeds 255. But a string may be in
+UTF-8 format without it having such characters. See L<perlunicode/The
+"Unicode Bug">.
For portability reasons, it may be better to not use C<\w>, C<\d>, C<\s>
or the POSIX character classes, and use the Unicode properties instead.
this document are expected to understand perl's regex syntax and its
usage in detail. If you want to learn about the basics of Perl's
regular expressions, see L<perlre>. And if you want to replace the
-regex engine with your own see see L<perlreapi>.
+regex engine with your own, see L<perlreapi>.
=head1 OVERVIEW
=item *
There is the "next regop" from a given regop/regnode. This is the
-regop physically located after the the current one, as determined by
+regop physically located after the current one, as determined by
the size of the current regop. This is often useful, such as when
dumping the structure we use this order to traverse. Sometimes the code
assumes that the "next regnode" is the same as the "next regop", or in
The two entry points are C<re_intuit_start()> and C<pregexec()>. These routines
have a somewhat incestuous relationship with overlap between their functions,
and C<pregexec()> may even call C<re_intuit_start()> on its own. Nevertheless
-other parts of the the perl source code may call into either, or both.
+other parts of the perl source code may call into either, or both.
Execution of the interpreter itself used to be recursive, but thanks to the
efforts of Dave Mitchell in the 5.9.x development track, that has changed: now an
internal stack is maintained on the heap and the routine is fully
iterative. This can make it tricky as the code is quite conservative
-about what state it stores, with the result that that two consecutive lines in the
+about what state it stores, with the result that two consecutive lines in the
code can actually be running in totally different contexts due to the
simulated recursion.
bytes to represent characters from the ASCII character set, and sequences
of two or more bytes for all other characters. (See L<perlunitut>
for more information about the relationship between UTF-8 and perl's
-encoding, utf8 -- the difference isn't important for this discussion.)
+encoding, utf8. The difference isn't important for this discussion.)
No matter how you look at it, Unicode support is going to be a pain in a
regex engine. Tricks that might be fine when you have 256 possible
+=encoding utf8
+
=for comment
Consistent formatting of this file is achieved with:
perl ./Porting/podtidy pod/perlrepository.pod
disk space (including the repository). A build of bleadperl takes up
about 200MB (including the repository and the check out).
-=head1 GETTING ACCESS TO THE REPOSITORY
+=head1 Getting access to the repository
-=head2 READ ACCESS VIA THE WEB
+=head2 Read access via the web
You may access the repository over the web. This allows you to browse
the tree, see recent commits, subscribe to RSS feeds for the changes,
A mirror of the repository is found at:
- http://github.com/github/perl
+ http://github.com/mirrors/perl
-=head2 READ ACCESS VIA GIT
+=head2 Read access via Git
You will need a copy of Git for your computer. You can fetch a copy of
the repository using the Git protocol (which uses port 9418):
- git clone git://perl5.git.perl.org/perl.git perl-git
+ % git clone git://perl5.git.perl.org/perl.git perl-git
This clones the repository and makes a local copy in the F<perl-git>
directory.
If your local network does not allow you to use port 9418, then you can
-fetch a copy of the repository over HTTP (this is slower):
+fetch a copy of the repository over HTTP (this is at least 4x slower):
- git clone http://perl5.git.perl.org/perl.git perl-http
+ % git clone http://perl5.git.perl.org/perl.git perl-http
This clones the repository and makes a local copy in the F<perl-http>
directory.
-=head2 WRITE ACCESS TO THE REPOSITORY
+=head2 Write access to the repository
If you are a committer, then you can fetch a copy of the repository
that you can push back on with:
- git clone ssh://perl5.git.perl.org/perl.git perl-ssh
+ % git clone ssh://perl5.git.perl.org/perl.git perl-ssh
This clones the repository and makes a local copy in the F<perl-ssh>
directory.
If you cloned using the git protocol, which is faster than ssh, then
-you will need to modify your config in order to enable pushing. Edit
-F<.git/config> where you will see something like:
+you will need to modify the URL for the origin remote to enable
+pushing. To do that edit F<.git/config> with git-config(1) like
+this:
- [remote "origin"]
- url = git://perl5.git.perl.org/perl.git
+ % git config remote.origin.url ssh://perl5.git.perl.org/perl.git
-change that to something like this:
+You can also set up your user name and e-mail address. Most people do
+this once globally in their F<~/.gitconfig> by doing something like:
- [remote "origin"]
- url = ssh://perl5.git.perl.org/perl.git
+ % git config --global user.name "Ævar Arnfjörð Bjarmason"
+ % git config --global user.email avarab@gmail.com
-You can also set up your user name and e-mail address. For example
+However if you'd like to override that just for perl then execute then
+execute something like the following in F<perl-git>:
- % git config user.name "Leon Brocard"
- % git config user.email acme@astray.com
+ % git config user.email avar@cpan.org
It is also possible to keep C<origin> as a git remote, and add a new
remote for ssh access:
The C<fetch> command just updates the C<camel> refs, as the objects
themselves should have been fetched when pulling from C<origin>.
-=head2 A NOTE ON CAMEL AND DROMEDARY
+=head2 A note on camel and dromedary
The committers have SSH access to the two servers that serve
C<perl5.git.perl.org>. One is C<perl5.git.perl.org> itself (I<camel>),
reach the sysadmins in #p5p on irc.perl.org or via mail to
C<perl5-porters@perl.org>
-=head1 OVERVIEW OF THE REPOSITORY
+=head1 Overview of the repository
Once you have changed into the repository directory, you can inspect
it.
however both will update the remote-tracking branches in your
repository.
-To switch to another branch:
-
- % git checkout origin/maint-5.8-dor
-
To make a local branch of a remote branch:
% git checkout -b maint-5.10 origin/maint-5.10
% git checkout blead
-=head2 FINDING OUT YOUR STATUS
+=head2 Finding out your status
The most common git command you will use will probably be
% git commit -a
(That C<-a> tells git to add every file you've changed to this commit.
-If you want to commit some, but not all of your changes, have a look
-at the documentation for C<git add>.)
+New files aren't automatically added to your commit when you use C<commit
+-a> If you want to add files or to commit some, but not all of your
+changes, have a look at the documentation for C<git add>.)
Git will start up your favorite text editor, so that you can craft a
commit message for your change. See L</Commit message> below for more
it carefully, many questions are answered directly by the git status
output.
-=head1 SUBMITTING A PATCH
+=head1 Submitting a patch
If you have a patch in mind for Perl, you should first get a copy of
the repository:
% git branch orange
% git checkout orange
+Creating a topic branch makes it easier for the maintainers to rebase
+or merge back into the master blead for a more linear history. If you
+don't work on a topic branch the maintainer has to manually cherry
+pick your changes onto blead before they can be applied.
+
+That'll get you scolded on perl5-porters, so don't do that. Be
+Awesome.
+
Then make your changes. For example, if Leon Brocard changes his name
to Orange Brocard, we should change his name in the AUTHORS file:
Now you should create a patch file for all your local changes:
- % git format-patch origin
+ % git format-patch -M origin..
0001-Rename-Leon-Brocard-to-Orange-Brocard.patch
-You should now send an email to perl5-porters@perl.org with a
-description of your changes, and include this patch file as an
-attachment. (See the next section for how to configure and use git to
-send these emails for you.)
+You should now send an email to to
+L<perlbug@perl.org|mailto:perlbug@perl.org> with a description of your
+changes, and include this patch file as an attachment. In addition to
+being tracked by RT, mail to perlbug will automatically be forwarded
+to perl5-porters. You should only send patches to
+L<perl5-porters@perl.org|mailto:perl5-porters@perl.org> directly if the
+patch is not ready to be applied, but intended for discussion.
+
+See the next section for how to configure and use git to send these
+emails for you.
If you want to delete your temporary branch, you may do so with:
=head2 Using git to send patch emails
-In your ~/git/perl repository, set the destination email to the
-perl5-porters mailing list.
+In your ~/git/perl repository, set the destination email to perl's bug
+tracker:
+
+ $ git config sendemail.to perlbug@perl.org
+
+Or maybe perl5-porters (discussed above):
$ git config sendemail.to perl5-porters@perl.org
patching them, because git won't see the changes to them, and the build
process will overwrite them. Patch the originals instead. Most
utilities (like perldoc) are in this category, i.e. patch
-utils/perldoc.PL rather than utils/perldoc. Similarly, don't create
+F<utils/perldoc.PL> rather than F<utils/perldoc>. Similarly, don't create
patches for files under $src_root/ext from their copies found in
$install_root/lib. If you are unsure about the proper location of a
file that may have gotten copied while building the source
As you craft each patch you intend to submit to the Perl core, it's
important to write a good commit message.
-Your commit message should start with a description of the problem that
-the patch corrects or new functionality that the patch adds.
+The first line of the commit message should be a short description and
+should skip the full stop. It should be no longer than the subject
+line of an E-Mail, 50 characters being a good rule of thumb.
+
+A lot of Git tools (Gitweb, GitHub, git log --pretty=oneline, ..) will
+only display the first line (cut off at 50 characters) when presenting
+commit summaries.
+
+The commit message should include description of the problem that the
+patch corrects or new functionality that the patch adds.
As a general rule of thumb, your commit message should let a programmer
with a reasonable familiarity with the Perl core quickly understand what
=back
+A commit message isn't intended to take the place of comments in your
+code. Commit messages should describe the change you made, while code
+comments should describe the current state of the code. If you've just
+implemented a new feature, complete with doc, tests and well-commented
+code, a brief commit message will often suffice. If, however, you've
+just changed a single character deep in the parser or lexer, you might
+need to write a small novel to ensure that future readers understand
+what you did and why you did it.
+
=item Comments, Comments, Comments
Be sure to adequately comment your code. While commenting every line
=back
-=head1 ACCEPTING A PATCH
+=head1 Accepting a patch
If you have received a patch file generated using the above section,
you should try out the patch.
% git branch -D experimental
Deleted branch experimental.
-=head1 CLEANING A WORKING DIRECTORY
+=head1 Cleaning a working directory
The command C<git clean> can with varying arguments be used as a
replacement for C<make clean>.
To reset your working directory to a pristine condition you can do:
- git clean -dxf
+ % git clean -dxf
However, be aware this will delete ALL untracked content. You can use
- git clean -Xf
+ % git clean -Xf
to remove all ignored untracked files, such as build and test
byproduct, but leave any manually created files alone.
If you want to cancel one or several commits, you can use C<git reset>.
-=head1 BISECTING
+=head1 Bisecting
C<git> provides a built-in way to determine, with a binary search in
the history, which commit should be blamed for introducing a given bug.
% cat ~/run
#!/bin/sh
git clean -dxf
+
+ # If you get './makedepend: 1: Syntax error: Unterminated quoted
+ # string' when bisecting versions of perl older than 5.9.5 this hack
+ # will work around the bug in makedepend.SH which was fixed in
+ # version 96a8704c. Make sure to comment out `git checkout makedepend.SH'
+ # below too.
+ git show blead:makedepend.SH > makedepend.SH
+
# If you can use ccache, add -Dcc=ccache\ gcc -Dld=gcc to the Configure line
# if Encode is not needed for the test, you can speed up the bisect by
# excluding it from the runs with -Dnoextensions=Encode
# Correct makefile for newer GNU gcc
perl -ni -we 'print unless /<(?:built-in|command)/' makefile x2p/makefile
# if you just need miniperl, replace test_prep with miniperl
- make -j4 test_prep
+ make test_prep
[ -x ./perl ] || exit 125
./perl -Ilib ~/testcase.pl
ret=$?
[ $ret -gt 127 ] && ret=127
+ # git checkout makedepend.SH
git clean -dxf
exit $ret
C<git help bisect> has much more information on how you can tweak your
binary searches.
-=head1 SUBMITTING A PATCH VIA GITHUB
+=head1 Submitting a patch via GitHub
GitHub is a website that makes it easy to fork and publish projects
with Git. First you should set up a GitHub account and log in.
Perl's git repository is mirrored on GitHub at this page:
- http://github.com/github/perl/tree/blead
+ http://github.com/mirrors/perl/tree/blead
Visit the page and click the "fork" button. This clones the Perl git
repository for you and provides you with "Your Clone URL" from which
The same patch as above, using github might look like this:
% cd perl-github
- % git remote add upstream git://github.com/github/perl.git
+ % git remote add upstream git://perl5.git.perl.org/perl.git
% git pull upstream blead
% git checkout -b orange
% perl -pi -e 's{Leon Brocard}{Orange Brocard}' AUTHORS
% git push origin orange
The orange branch has been pushed to GitHub, so you should now send an
-email to perl5-porters@perl.org with a description of your changes and
-the following information:
+email (see L</Submitting a patch>) with a description of your changes
+and the following information:
http://github.com/USERNAME/perl/tree/orange
- git@github.com:USERNAME/perl.git branch orange
+ git://github.com/USERNAME/perl.git branch orange
-=head1 MERGING FROM A BRANCH VIA GITHUB
+=head1 Merging from a branch via GitHub
If someone has provided a branch via GitHub and you are a committer,
you should use the following in your perl-ssh directory:
- % git remote add dandv git://github.com/dandv/perl.git
- % git fetch
+ % git remote add avar git://github.com/avar/perl.git
+ % git fetch avar
Now you can see the differences between the branch and blead:
- % git diff dandv/blead
+ % git diff avar/orange
And you can see the commits:
- % git log dandv/blead
+ % git log avar/orange
If you approve of a specific commit, you can cherry pick it:
- % git cherry-pick 3adac458cb1c1d41af47fc66e67b49c8dec2323f
+ % git cherry-pick 0c24b290ae02b2ab3304f51d5e11e85eb3659eae
Or you could just merge the whole branch if you like it all:
- % git merge dandv/blead
+ % git merge avar/orange
And then push back to the repository:
% git push
-=head1 TOPIC BRANCHES AND REWRITING HISTORY
+=head1 Topic branches and rewriting history
Individual committers should create topic branches under
B<yourname>/B<some_descriptive_name>. Other committers should check
with a topic branch's creator before making any change to it.
+The simplest way to create a remote topic branch that works on all
+versions of git is to push the current head as a new branch on the
+remote, then check it out locally:
+
+ $ branch="$yourname/$some_descriptive_name"
+ $ git push origin HEAD:$branch
+ $ git checkout -b $branch origin/$branch
+
+Users of git 1.7 or newer can do it in a more obvious manner:
+
+ $ branch="$yourname/$some_descriptive_name"
+ $ git checkout -b $branch
+ $ git push origin -u $branch
+
If you are not the creator of B<yourname>/B<some_descriptive_name>, you
might sometimes find that the original author has edited the branch's
history. There are lots of good reasons for this. Sometimes, an author
a local tag to perl.git before doing so. (Pushing unannotated tags is
not allowed.)
-=head1 COMMITTING TO MAINTENANCE VERSIONS
+=head1 Committing to maintenance versions
-Maintenance versions should only be altered to add critical bug fixes.
+Maintenance versions should only be altered to add critical bug
+fixes, see L<perlpolicy>.
To commit to a maintenance version of perl, you need to create a local
tracking branch:
B<-x> option to C<git cherry-pick> in order to record the SHA1 of the
original commit in the new commit message.
-=head1 GRAFTS
+=head1 Grafts
The perl history contains one mistake which was not caught in the
-conversion -- a merge was recorded in the history between blead and
+conversion: a merge was recorded in the history between blead and
maint-5.10 where no merge actually occurred. Due to the nature of git,
this is now impossible to fix in the public repository. You can remove
this mis-merge locally by adding the following line to your
It is particularly important to have this graft line if any bisecting
is done in the area of the "merge" in question.
+=head1 SEE ALSO
+=over
-=head1 SEE ALSO
+=item *
+
+The git documentation, accessible via the C<git help> command
-The git documentation, accessible via C<git help command>.
+=item *
+
+L<perlpolicy> - Perl core development policy
+
+=back
+=cut
escape sequences, e.g., C<\033>, or hexadecimal escape sequences,
e.g., C<\x1B>:
- "1000\t2000" =~ m(0\t2) # matches
- "cat" =~ /\143\x61\x74/ # matches, but a weird way to spell cat
+ "1000\t2000" =~ m(0\t2) # matches
+ "cat" =~ /\143\x61\x74/ # matches in ASCII, but a weird way to spell cat
Regexes are treated mostly as double quoted strings, so variable
substitution works:
=head2 SYNTAX
- \ Escapes the character immediately following it
- . Matches any single character except a newline (unless /s is used)
- ^ Matches at the beginning of the string (or line, if /m is used)
- $ Matches at the end of the string (or line, if /m is used)
- * Matches the preceding element 0 or more times
- + Matches the preceding element 1 or more times
- ? Matches the preceding element 0 or 1 times
- {...} Specifies a range of occurrences for the element preceding it
- [...] Matches any one of the characters contained within the brackets
- (...) Groups subexpressions for capturing to $1, $2...
- (?:...) Groups subexpressions without capturing (cluster)
- | Matches either the subexpression preceding or following it
- \1, \2, \3 ... Matches the text from the Nth group
- \g1 or \g{1}, \g2 ... Matches the text from the Nth group
- \g-1 or \g{-1}, \g-2 ... Matches the text from the Nth previous group
- \g{name} Named backreference
- \k<name> Named backreference
- \k'name' Named backreference
- (?P=name) Named backreference (python syntax)
+ \ Escapes the character immediately following it
+ . Matches any single character except a newline (unless /s is
+ used)
+ ^ Matches at the beginning of the string (or line, if /m is used)
+ $ Matches at the end of the string (or line, if /m is used)
+ * Matches the preceding element 0 or more times
+ + Matches the preceding element 1 or more times
+ ? Matches the preceding element 0 or 1 times
+ {...} Specifies a range of occurrences for the element preceding it
+ [...] Matches any one of the characters contained within the brackets
+ (...) Groups subexpressions for capturing to $1, $2...
+ (?:...) Groups subexpressions without capturing (cluster)
+ | Matches either the subexpression preceding or following it
+ \1, \2, \3 ... Matches the text from the Nth group
+ \g1 or \g{1}, \g2 ... Matches the text from the Nth group
+ \g-1 or \g{-1}, \g-2 ... Matches the text from the Nth previous group
+ \g{name} Named backreference
+ \k<name> Named backreference
+ \k'name' Named backreference
+ (?P=name) Named backreference (python syntax)
=head2 ESCAPE SEQUENCES
\x{263a} A wide hexadecimal value
\cx Control-x
\N{name} A named character
+ \N{U+263D} A Unicode character by hex ordinal
\l Lowercase next character
\u Titlecase next character
[f-j-] Dash escaped or at start or end means 'dash'
[^f-j] Caret indicates "match any character _except_ these"
-The following sequences work within or without a character class.
+The following sequences (except C<\N>) work within or without a character class.
The first six are locale aware, all are Unicode aware. See L<perllocale>
and L<perlunicode> for details.
\W A non-word character
\s A whitespace character
\S A non-whitespace character
- \h An horizontal white space
- \H A non horizontal white space
- \N A non newline (when not followed by a '{'; it's like . without /s)
- \v A vertical white space
- \V A non vertical white space
+ \h An horizontal whitespace
+ \H A non horizontal whitespace
+ \N A non newline (when not followed by '{NAME}'; experimental;
+ not valid in a character class; equivalent to [^\n]; it's
+ like '.' without /s modifier)
+ \v A vertical whitespace
+ \V A non vertical whitespace
\R A generic newline (?>\v|\x0D\x0A)
\C Match a byte (with Unicode, '.' matches a character)
POSIX character classes and their Unicode and Perl equivalents:
- alnum IsAlnum Alphanumeric
- alpha IsAlpha Alphabetic
- ascii IsASCII Any ASCII char
- blank IsSpace [ \t] Horizontal whitespace (GNU extension)
- cntrl IsCntrl Control characters
- digit IsDigit \d Digits
- graph IsGraph Alphanumeric and punctuation
- lower IsLower Lowercase chars (locale and Unicode aware)
- print IsPrint Alphanumeric, punct, and space
- punct IsPunct Punctuation
- space IsSpace [\s\ck] Whitespace
- IsSpacePerl \s Perl's whitespace definition
- upper IsUpper Uppercase chars (locale and Unicode aware)
- word IsWord \w Alphanumeric plus _ (Perl extension)
- xdigit IsXDigit [0-9A-Fa-f] Hexadecimal digit
+ ASCII- Full-
+ range range backslash
+ POSIX \p{...} \p{} sequence Description
+ -----------------------------------------------------------------------
+ alnum PosixAlnum Alnum Alpha plus Digit
+ alpha PosixAlpha Alpha Alphabetic characters
+ ascii ASCII Any ASCII character
+ blank PosixBlank Blank \h Horizontal whitespace;
+ full-range also written
+ as \p{HorizSpace} (GNU
+ extension)
+ cntrl PosixCntrl Cntrl Control characters
+ digit PosixDigit Digit \d Decimal digits
+ graph PosixGraph Graph Alnum plus Punct
+ lower PosixLower Lower Lowercase characters
+ print PosixPrint Print Graph plus Print, but not
+ any Cntrls
+ punct PosixPunct Punct These aren't precisely
+ equivalent. See NOTE,
+ below.
+ space PosixSpace Space [\s\cK] Whitespace
+ PerlSpace SpacePerl \s Perl's whitespace
+ definition
+ upper PosixUpper Upper Uppercase characters
+ word PerlWord Word \w Alnum plus '_' (Perl
+ extension)
+ xdigit ASCII_Hex_Digit XDigit Hexadecimal digit,
+ ASCII-range is
+ [0-9A-Fa-f]
+
+NOTE on C<[[:punct:]]>, C<\p{PosixPunct}> and C<\p{Punct}>:
+In the ASCII range, C<[[:punct:]]> and C<\p{PosixPunct}> match
+C<[-!"#$%&'()*+,./:;<=E<gt>?@[\\\]^_`{|}~]> (although if a locale is in
+effect, it could alter the behavior of C<[[:punct:]]>); and C<\p{Punct}>
+matches C<[-!"#%&'()*,./:;?@[\\\]_{}]>. When matching a UTF-8 string,
+C<[[:punct:]]> matches what it does in the ASCII range, plus what
+C<\p{Punct}> matches. C<\p{Punct}> matches, anything that isn't a
+control, an alphanumeric, a space, nor a symbol.
Within a character class:
- POSIX traditional Unicode
- [:digit:] \d \p{IsDigit}
- [:^digit:] \D \P{IsDigit}
+ POSIX traditional Unicode
+ [:digit:] \d \p{Digit}
+ [:^digit:] \D \P{Digit}
=head2 ANCHORS
\Z Match string end (before optional newline)
\z Match absolute string end
\G Match where previous m//g left off
-
\K Keep the stuff left of the \K, don't include it in $&
=head2 QUANTIFIERS
-Quantifiers are greedy by default -- match the B<longest> leftmost.
+Quantifiers are greedy by default and match the B<longest> leftmost.
Maximal Minimal Possessive Allowed range
------- ------- ---------- -------------
matched by a pattern with a possessive quantifier will not be backtracked
into, even if that causes the whole match to fail.
-There is no quantifier {,n} -- that gets understood as a literal string.
+There is no quantifier C<{,n}>. That's interpreted as a literal string.
=head2 EXTENDED CONSTRUCTS
"1000\t2000" =~ m(0\t2) # matches
"1000\n2000" =~ /0\n20/ # matches
"1000\t2000" =~ /\000\t2/ # doesn't match, "0" ne "\000"
- "cat" =~ /\143\x61\x74/ # matches, but a weird way to spell cat
+ "cat" =~ /\143\x61\x74/ # matches in ASCII, but a weird way to spell cat
If you've been around Perl a while, all this talk of escape sequences
may seem familiar. Similar escape sequences are used in double-quoted
Closely associated with the matching variables C<$1>, C<$2>, ... are
the I<backreferences> C<\1>, C<\2>,... Backreferences are simply
matching variables that can be used I<inside> a regexp. This is a
-really nice feature -- what matches later in a regexp is made to depend on
+really nice feature; what matches later in a regexp is made to depend on
what matched earlier in the regexp. Suppose we wanted to look
for doubled words in a text, like 'the the'. The following regexp finds
all 3-letter doubles with a space in between:
print "bad line: '$line'\n";
}
-But this doesn't match -- at least not the way one might expect. Only
+But this doesn't match, at least not the way one might expect. Only
after inserting the interpolated C<$a99a> and looking at the resulting
full text of the regexp is it obvious that the backreferences have
-backfired -- the subexpression C<(\w+)> has snatched number 1 and
+backfired. The subexpression C<(\w+)> has snatched number 1 and
demoted the groups in C<$a99a> by one rank. This can be avoided by
using relative backreferences:
=back
-As we have seen above, Principle 0 overrides the others -- the regexp
+As we have seen above, Principle 0 overrides the others. The regexp
will be matched as early as possible, with the other principles
determining how the regexp matches at that earliest character
position.
Figuring out the hexadecimal sequence of a Unicode character you want
or deciphering someone else's hexadecimal Unicode regexp is about as
much fun as programming in machine code. So another way to specify
-Unicode characters is to use the I<named character>> escape
-sequence C<\N{name}>. C<name> is a name for the Unicode character, as
+Unicode characters is to use the I<named character> escape
+sequence C<\N{I<name>}>. I<name> is a name for the Unicode character, as
specified in the Unicode standard. For instance, if we wanted to
represent or match the astrological sign for the planet Mercury, we
could use
# but _does_ print
Hmm. What happened here? If you've been following along, you know that
-the above pattern should be effectively (almost) the same as the last one --
-enclosing the d in a character class isn't going to change what it
+the above pattern should be effectively (almost) the same as the last one;
+enclosing the C<d> in a character class isn't going to change what it
matches. So why does the first not print while the second one does?
The answer lies in the optimizations the regex engine makes. In the first
the regexp engine proceeds according to the book: as long as the end of
the string hasn't been reached, the position is advanced before looking
for another vowel. Thus, match or no match makes no difference, and the
-regexp engine proceeds until the the entire string has been inspected.
+regexp engine proceeds until the entire string has been inspected.
(It's remarkable that an alternative solution using something like
$count{lc($_)}++ for split('', "supercalifragilisticexpialidoceous");
disable all the above Unicode features.
The read-only magic variable C<${^UNICODE}> reflects the numeric value
-of this setting. This is variable is set during Perl startup and is
+of this setting. This variable is set during Perl startup and is
thereafter read-only. If you want runtime effects, use the three-arg
open() (see L<perlfunc/open>), the two-arg binmode() (see L<perlfunc/binmode>),
and the C<open> pragma (see L<open>).
optional features (in the main compilation unit). See L<feature>.
=item B<-f>
-X<-f>
+X<-f> X<sitecustomize> X<sitecustomize.pl>
Disable executing F<$Config{sitelib}/sitecustomize.pl> at startup.
It can for instance be used to add entries to the @INC array to make perl
find modules in non-standard locations.
+Perl actually inserts the following code:
+
+ BEGIN {
+ do { local $!; -f "$Config{sitelib}/sitecustomize.pl"; }
+ && do "$Config{sitelib}/sitecustomize.pl";
+ }
+
+Since it is an actual C<do> (not a C<require>), F<sitecustomize.pl>
+doesn't need to return a true value. The code is run in package C<main>,
+in its own lexical scope. However, if the script dies, C<$@> will not
+be set.
+
+The value of C<$Config{sitelib}> is also determined in C code and not
+read from C<Config.pm>, which is not loaded.
+
+The code is executed B<very> early. For example, any changes made to
+C<@INC> will show up in the output of `perl -V`. Of course, C<END>
+blocks will be likewise executed very late.
+
+To determine at runtime if this capability has been compiled in your
+perl, you can check the value of C<$Config{usesitecustomize}>.
+
=item B<-F>I<pattern>
X<-F>
$ perl -pi~ -e 's/foo/bar/' file1 file2 file3...
Note that because B<-i> renames or deletes the original file before
-creating a new file of the same name, UNIX-style soft and hard links will
+creating a new file of the same name, Unix-style soft and hard links will
not be preserved.
Finally, the B<-i> switch does not impede execution when no
being done at interpreter startup time.)
If PERL5LIB is not defined, PERLLIB is used. Directories are separated
-(like in PATH) by a colon on unixish platforms and by a semicolon on
+(like in PATH) by a colon on Unixish platforms and by a semicolon on
Windows (the proper path separator being given by the command C<perl
-V:path_sep>).
environment variable) treats the colon as a separator.
An unset or empty PERLIO is equivalent to the default set of layers for
-your platform, for example C<:unix:perlio> on UNIX-like systems
+your platform, for example C<:unix:perlio> on Unix-like systems
and C<:unix:crlf> on Windows and other DOS-like systems.
The list becomes the default for I<all> perl's IO. Consequently only built-in
On all platforms the default set of layers should give acceptable results.
-For UNIX platforms that will equivalent of "unix perlio" or "stdio".
+For Unix platforms that will equivalent of "unix perlio" or "stdio".
Configure is setup to prefer "stdio" implementation if system's library
provides for fast access to the buffer, otherwise it uses the "unix perlio"
implementation.
If set to the name of a file or device then certain operations of PerlIO
sub-system will be logged to that file (opened as append). Typical uses
-are UNIX:
+are Unix:
PERLIO_DEBUG=/dev/tty perl script ...
X<PERL_UNICODE>
Equivalent to the B<-C> command-line switch. Note that this is not
-a boolean variable-- setting this to C<"1"> is not the right way to
+a boolean variable. Setting this to C<"1"> is not the right way to
"enable Unicode" (whatever that would mean). You can use C<"0"> to
"disable Unicode", though (or alternatively unset PERL_UNICODE in
your shell before starting Perl). See the description of the C<-C>
This is quite different, however, from not even trusting the writer of the
code not to try to do something evil. That's the kind of trust needed
when someone hands you a program you've never seen before and says, "Here,
-run this." For that kind of safety, check out the Safe module,
-included standard in the Perl distribution. This module allows the
+run this." For that kind of safety, you might want to check out the Safe
+module, included standard in the Perl distribution. This module allows the
programmer to set up special compartments in which all system operations
-are trapped and namespace access is carefully controlled.
+are trapped and namespace access is carefully controlled. Safe should
+not be considered bullet-proof, though: it will not prevent the foreign
+code to set up infinite loops, allocate gigabytes of memory, or even
+abusing perl bugs to make the host interpreter crash or behave in
+unpredictable ways. In any case it's better avoided completely if you're
+really concerned about security.
=head2 Security Bugs
if (EXPR) BLOCK
if (EXPR) BLOCK else BLOCK
if (EXPR) BLOCK elsif (EXPR) BLOCK ... else BLOCK
+ unless (EXPR) BLOCK
+ unless (EXPR) BLOCK else BLOCK
+ unless (EXPR) BLOCK elsif (EXPR) BLOCK ... else BLOCK
LABEL while (EXPR) BLOCK
LABEL while (EXPR) BLOCK continue BLOCK
LABEL until (EXPR) BLOCK
The C<if> statement is straightforward. Because BLOCKs are always
bounded by curly brackets, there is never any ambiguity about which
C<if> an C<else> goes with. If you use C<unless> in place of C<if>,
-the sense of the test is reversed.
+the sense of the test is reversed. Like C<if>, C<unless> can be followed
+by C<else>. C<unless> can even be followed by one or more C<elsif>
+statements, though you may want to think twice before using that particular
+language construct, as everyone reading your code will have to think at least
+twice before they can understand what's going on.
The C<while> statement executes the block as long as the expression is
L<true|/"Truth and Falsehood">.
+=encoding utf8
+
=head1 NAME
perlthrtut - Tutorial on threads in Perl
disappointed or confused. Possibly both.
This is not to say that Perl threads are completely different from
-everything that's ever come before -- they're not. Perl's threading
+everything that's ever come before. They're not. Perl's threading
model owes a lot to other thread models, especially POSIX. Just as
Perl is not C, though, Perl threads are not POSIX threads. So if you
find yourself looking for mutexes, or thread priorities, it's time to
=head2 Basic Thread Support
-Thread support is a Perl compile-time option -- it's something that's
+Thread support is a Perl compile-time option. It's something that's
turned on or off when Perl is built at your site, rather than when
your programs are compiled. If your Perl wasn't compiled with thread
support enabled, then any attempt to use threads will fail.
NOTE: In the example above, the thread returns a list, thus necessitating
that the thread creation call be made in list context (i.e., C<my ($thr)>).
-See L<threads/"$thr->join()"> and L<threads/"THREAD CONTEXT"> for more
+See L<< threads/"$thr->join()" >> and L<threads/"THREAD CONTEXT"> for more
details on thread context and return values.
=head2 Ignoring A Thread
is that by default, no data is shared. When a new Perl thread is created,
all the data associated with the current thread is copied to the new
thread, and is subsequently private to that new thread!
-This is similar in feel to what happens when a UNIX process forks,
+This is similar in feel to what happens when a Unix process forks,
except that in this case, the data is just copied to a different part of
memory within the same process rather than a real fork taking place.
establishing quotas. Say, for example, that you have a number of
threads that can do I/O at once. You don't want all the threads
reading or writing at once though, since that can potentially swamp
-your I/O channels, or deplete your process' quota of filehandles. You
+your I/O channels, or deplete your process's quota of filehandles. You
can use a semaphore initialized to the number of concurrent I/O
requests (or open files) that you want at any one time, and have your
threads quietly block and unblock themselves.
thread creation can be quite expensive, both in terms of memory usage and
time spent in creation. The ideal way to reduce these costs is to have a
relatively short number of long-lived threads, all created fairly early
-on -- before the base thread has accumulated too much data. Of course, this
+on (before the base thread has accumulated too much data). Of course, this
may not always be possible, so compromises have to be made. However, after
a thread has been created, its performance and extra memory usage should
be little different than ordinary code.
Thinking of mixing C<fork()> and threads? Please lie down and wait
until the feeling passes. Be aware that the semantics of C<fork()> vary
-between platforms. For example, some UNIX systems copy all the current
+between platforms. For example, some Unix systems copy all the current
threads into the child process, while others only copy the thread that
called C<fork()>. You have been warned!
of Perl. Calls often suffering from not being thread-safe include:
C<localtime()>, C<gmtime()>, functions fetching user, group and
network information (such as C<getgrent()>, C<gethostent()>,
-C<getnetent()> and so on), C<readdir()>,
-C<rand()>, and C<srand()> -- in general, calls that depend on some global
-external state.
+C<getnetent()> and so on), C<readdir()>, C<rand()>, and C<srand()>. In
+general, calls that depend on some global external state.
If the system Perl is compiled in has thread-safe variants of such
calls, they will be used. Beyond that, Perl is at the mercy of
Slightly modified by Arthur Bergman to fit the new thread model/module.
-Reworked slightly by Jˆrg Walter E<lt>jwalt@cpan.org<gt> to be more concise
+Reworked slightly by Jörg Walter E<lt>jwalt@cpan.org<gt> to be more concise
about thread-safety of Perl code.
Rearranged slightly by Elizabeth Mattijsen E<lt>liz@dijkmat.nl<gt> to put
This method will be triggered every time the tied variable is set
(assigned). Beyond its self reference, it also expects one (and only one)
-argument--the new value the user is trying to assign. Don't worry about
-returning a value from STORE -- the semantic of assignment returning the
+argument: the new value the user is trying to assign. Don't worry about
+returning a value from STORE; the semantic of assignment returning the
assigned value is implemented with FETCH.
sub STORE {
So far so good. Those of you who have been paying attention will have
spotted that the tied object hasn't been used so far. So lets add an
extra method to the Remember class to allow comments to be included in
-the file -- say, something like this:
+the file; say, something like this:
sub comment {
my $self = shift;
quite a few tests in F<t/> have not been refactored to use it. Refactoring
any of these tests, one at a time, is a useful thing TODO.
+The subdirectories F<base>, F<cmd> and F<comp>, that contain the most
+basic tests, should be excluded from this task.
+
=head2 Test that regen.pl was run
There are various generated files shipped with the perl distribution, for
=head2 Improve the coverage of the core tests
-Use Devel::Cover to ascertain the core modules's test coverage, then add
+Use Devel::Cover to ascertain the core modules' test coverage, then add
tests that are currently missing.
=head2 test B
Another option could be deconstructing the implementation of some simpler
functions in op.c.
+=head2 Allow XSUBs to inline themselves as OPs
+
+For a simple XSUB, often the subroutine dispatch takes more time than the
+XSUB itself. The tokeniser already has the ability to inline constant
+subroutines - it would be good to provide a way to inline other subroutines.
+
+Specifically, simplest approach looks to be to allow an XSUB to provide an
+alternative implementation of itself as a custom OP. A new flag bit in
+C<CvFLAGS()> would signal to the peephole optimiser to take an optree
+such as this:
+
+ b <@> leave[1 ref] vKP/REFC ->(end)
+ 1 <0> enter ->2
+ 2 <;> nextstate(main 1 -e:1) v:{ ->3
+ a <2> sassign vKS/2 ->b
+ 8 <1> entersub[t2] sKS/TARG,1 ->9
+ - <1> ex-list sK ->8
+ 3 <0> pushmark s ->4
+ 4 <$> const(IV 1) sM ->5
+ 6 <1> rv2av[t1] lKM/1 ->7
+ 5 <$> gv(*a) s ->6
+ - <1> ex-rv2cv sK ->-
+ 7 <$> gv(*x) s/EARLYCV ->8
+ - <1> ex-rv2sv sKRM*/1 ->a
+ 9 <$> gvsv(*b) s ->a
+
+perform the symbol table lookup of C<rv2cv> and C<gv(*x)>, locate the
+pointer to the custom OP that provides the direct implementation, and re-
+write the optree something like:
+
+ b <@> leave[1 ref] vKP/REFC ->(end)
+ 1 <0> enter ->2
+ 2 <;> nextstate(main 1 -e:1) v:{ ->3
+ a <2> sassign vKS/2 ->b
+ 7 <1> custom_x -> 8
+ - <1> ex-list sK ->7
+ 3 <0> pushmark s ->4
+ 4 <$> const(IV 1) sM ->5
+ 6 <1> rv2av[t1] lKM/1 ->7
+ 5 <$> gv(*a) s ->6
+ - <1> ex-rv2cv sK ->-
+ - <$> ex-gv(*x) s/EARLYCV ->7
+ - <1> ex-rv2sv sKRM*/1 ->a
+ 8 <$> gvsv(*b) s ->a
+
+I<i.e.> the C<gv(*)> OP has been nulled and spliced out of the execution
+path, and the C<entersub> OP has been replaced by the custom op.
+
+This approach should provide a measurable speed up to simple XSUBs inside
+tight loops. Initially one would have to write the OP alternative
+implementation by hand, but it's likely that this should be reasonably
+straightforward for the type of XSUB that would benefit the most. Longer
+term, once the run-time implementation is proven, it should be possible to
+progressively update ExtUtils::ParseXS to generate OP implementations for
+some XSUBs.
+
=head2 Remove the use of SVs as temporaries in dump.c
F<dump.c> contains debugging routines to dump out the contains of perl data
These tasks would need C knowledge, and knowledge of how the interpreter works,
or a willingness to learn.
+=head2 forbid labels with keyword names
+
+Currently C<goto keyword> "computes" the label value:
+
+ $ perl -e 'goto print'
+ Can't find label 1 at -e line 1.
+
+It is controversial if the right way to avoid the confusion is to forbid
+labels with keyword names, or if it would be better to always treat
+bareword expressions after a "goto" as a label and never as a keyword.
+
=head2 truncate() prototype
The prototype of truncate() is currently C<$$>. It should probably
The regexp optimiser is not optional. It should configurable to be, to allow
its performance to be measured, and its bugs to be easily demonstrated.
-=head2 delete &function
-
-Allow to delete functions. One can already undef them, but they're still
-in the stash.
-
=head2 C</w> regex modifier
That flag would enable to match whole words, and also to interpolate
This has actually already been implemented (but only for Win32),
take a look at F<iperlsys.h> and F<win32/perlhost.h>. While all Win32
variants go through a set of "vtables" for operating system access,
-non-Win32 systems currently go straight for the POSIX/UNIX-style
+non-Win32 systems currently go straight for the POSIX/Unix-style
system/library call. Similar system as for Win32 should be
implemented for all platforms. The existing Win32 implementation
probably does not need to survive alongside this proposed new
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
+What do we mean by the Person::new() function? Isn't that actually
a method? Well, in principle, yes. A method is just a function that
expects as its first argument a class name (package) or object
(blessed reference). Person::new() is the function that both the
from cover to cover, Perl does support many Unicode features.
People who want to learn to use Unicode in Perl, should probably read
-L<the Perl Unicode tutorial, perlunitut|perlunitut>, before reading
+the L<Perl Unicode tutorial, perlunitut|perlunitut>, before reading
this reference document.
+Also, the use of Unicode may present security issues that aren't obvious.
+Read L<Unicode Security Considerations|http://www.unicode.org/reports/tr36>.
+
=over 4
=item Input and Output Layers
The regular expression compiler produces polymorphic opcodes. That is,
the pattern adapts to the data and automatically switches to the Unicode
character scheme when presented with data that is internally encoded in
-UTF-8 -- or instead uses a traditional byte scheme when presented with
+UTF-8, or instead uses a traditional byte scheme when presented with
byte data.
=item C<use utf8> still needed to enable UTF-8/UTF-EBCDIC in scripts
semantics in a particular lexical scope. See L<bytes>.
The C<use feature 'unicode_strings'> pragma is intended to always, regardless
-of platform, force Unicode semantics in a particular lexical scope. In
-release 5.12, it is partially implemented, applying only to case changes.
+of platform, force character (Unicode) semantics in a particular lexical scope.
+In release 5.12, it is partially implemented, applying only to case changes.
See L</The "Unicode Bug"> below.
The C<utf8> pragma is primarily a compatibility device that enables
If strings operating under byte semantics and strings with Unicode
character data are concatenated, the new string will have
-character semantics. This can cause surprises: See L</BUGS>, below
+character semantics. This can cause surprises: See L</BUGS>, below.
+You can choose to be warned when this happens. See L<encoding::warnings>.
Under character semantics, many operations that formerly operated on
bytes now operate on characters. A character in Perl is
occur directly within the literal strings in UTF-8 encoding, or UTF-16.
(The former requires a BOM or C<use utf8>, the latter requires a BOM.)
-Unicode characters can also be added to a string by using the C<\x{...}>
+Unicode characters can also be added to a string by using the C<\N{U+...}>
notation. The Unicode code for the desired character, in hexadecimal,
-should be placed in the braces. For instance, a smiley face is
-C<\x{263A}>. This encoding scheme works for all characters, but
-for characters under 0x100, note that Perl may use an 8 bit encoding
-internally, for optimization and/or backward compatibility.
+should be placed in the braces, after the C<U>. For instance, a smiley face is
+C<\N{U+263A}>.
+
+Alternatively, you can use the C<\x{...}> notation for characters 0x100 and
+above. For characters below 0x100 you may get byte semantics instead of
+character semantics; see L</The "Unicode Bug">. On EBCDIC machines there is
+the additional problem that the value for such characters gives the EBCDIC
+character rather than the Unicode one.
Additionally, if you
you can use the C<\N{...}> notation and put the official Unicode
character name within the braces, such as C<\N{WHITE SMILING FACE}>.
+See L<charnames>.
=item *
=item *
-Character classes in regular expressions match characters instead of
+Bracketed character classes in regular expressions match characters instead of
bytes and match against the character properties specified in the
Unicode properties database. C<\w> can be used to match a Japanese
ideograph, for instance.
=item *
-Named Unicode properties, scripts, and block ranges may be used like
-character classes via the C<\p{}> "matches property" construct and
+Named Unicode properties, scripts, and block ranges may be used (like bracketed
+character classes) by using the C<\p{}> "matches property" construct and
the C<\P{}> negation, "doesn't match property".
See L</"Unicode Character Properties"> for more details.
=item *
-You can define your own mappings to be used in lc(),
-lcfirst(), uc(), and ucfirst() (or their string-inlined versions).
+You can define your own mappings to be used in C<lc()>,
+C<lcfirst()>, C<uc()>, and C<ucfirst()> (or their double-quoted string inlined
+versions such as C<\U>).
See L</"User-Defined Case Mappings"> for more details.
=back
=head2 Unicode Character Properties
Most Unicode character properties are accessible by using regular expressions.
-They are used like character classes via the C<\p{}> "matches property"
-construct and the C<\P{}> negation, "doesn't match property".
+They are used (like bracketed character classes) by using the C<\p{}> "matches
+property" construct and the C<\P{}> negation, "doesn't match property".
-For instance, C<\p{Uppercase}> matches any character with the Unicode
+Note that the only time that Perl considers a sequence of individual code
+points as a single logical character is in the C<\X> construct, already
+mentioned above. Therefore "character" in this discussion means a single
+Unicode code point.
+
+For instance, C<\p{Uppercase}> matches any single character with the Unicode
"Uppercase" property, while C<\p{L}> matches any character with a
General_Category of "L" (letter) property. Brackets are not
-required for single letter properties, so C<\p{L}> is equivalent to C<\pL>.
+required for single letter property names, so C<\p{L}> is equivalent to C<\pL>.
-More formally, C<\p{Uppercase}> matches any character whose Unicode Uppercase
-property value is True, and C<\P{Uppercase}> matches any character whose
-Uppercase property value is False, and they could have been written as
-C<\p{Uppercase=True}> and C<\p{Uppercase=False}>, respectively
+More formally, C<\p{Uppercase}> matches any single character whose Unicode
+Uppercase property value is True, and C<\P{Uppercase}> matches any character
+whose Uppercase property value is False, and they could have been written as
+C<\p{Uppercase=True}> and C<\p{Uppercase=False}>, respectively.
This formality is needed when properties are not binary, that is if they can
take on more values than just True and False. For example, the Bidi_Class (see
L</"Bidirectional Character Types"> below), can take on a number of different
values, such as Left, Right, Whitespace, and others. To match these, one needs
to specify the property name (Bidi_Class), and the value being matched against
-(Left, Right, I<etc.>). This is done, as in the examples above, by having the
+(Left, Right, etc.). This is done, as in the examples above, by having the
two components separated by an equal sign (or interchangeably, a colon), like
C<\p{Bidi_Class: Left}>.
Zp Paragraph_Separator
C Other
- Cc Control (also Cntrl)
+ Cc Control (also Cntrl)
Cf Format
Cs Surrogate (not usable)
Co Private_Use
Single-letter properties match all characters in any of the
two-letter sub-properties starting with the same letter.
-C<LC> and C<L&> are special cases, which are aliases for the set of
-C<Ll>, C<Lu>, and C<Lt>.
+C<LC> and C<L&> are special cases, which are both aliases for the set consisting of everything matched by C<Ll>, C<Lu>, and C<Lt>.
Because Perl hides the need for the user to understand the internal
representation of Unicode characters, there is no need to implement
=head3 B<Bidirectional Character Types>
-Because scripts differ in their directionality--Hebrew is
-written right to left, for example--Unicode supplies these properties in
+Because scripts differ in their directionality (Hebrew is
+written right to left, for example) Unicode supplies these properties in
the Bidi_Class class:
Property Meaning
Hiragana or Katakana. There are many more.
The Unicode Script property gives what script a given character is in,
-and can be matched with the compound form like C<\p{Script=Hebrew}> (short:
-C<\p{sc=hebr}>). Perl furnishes shortcuts for all script names. You can omit
-everything up through the equals (or colon), and simply write C<\p{Latin}> or
-C<\P{Cyrillic}>.
+and the property can be specified with the compound form like
+C<\p{Script=Hebrew}> (short: C<\p{sc=hebr}>). Perl furnishes shortcuts for all
+script names. You can omit everything up through the equals (or colon), and
+simply write C<\p{Latin}> or C<\P{Cyrillic}>.
A complete list of scripts and their shortcuts is in L<perluniprops>.
block is all characters whose ordinals are between 0 and 127, inclusive, in
other words, the ASCII characters. The "Latin" script contains some letters
from this block as well as several more, like "Latin-1 Supplement",
-"Latin Extended-A", I<etc.>, but it does not contain all the characters from
+"Latin Extended-A", etc., but it does not contain all the characters from
those blocks. It does not, for example, contain digits, because digits are
shared across many scripts. Digits and similar groups, like punctuation, are in
the script called C<Common>. There is also a script called C<Inherited> for
necessary to know some basics about decomposition.
Consider a character, say H. It could appear with various marks around it,
such as an acute accent, or a circumflex, or various hooks, circles, arrows,
-I<etc.>, above, below, to one side and/or the other, I<etc.> There are many
+I<etc.>, above, below, to one side and/or the other, etc. There are many
possibilities among the world's languages. The number of combinations is
astronomical, and if there were a character for each combination, it would
soon exhaust Unicode's more than a million possible characters. So Unicode
syllabaries (hiragana and katakana), you can define
sub InKana {
- return <<END;
+ return <<END;
3040\t309F
30A0\t30FF
END
You could also have used the existing block property names:
sub InKana {
- return <<'END';
+ return <<'END';
+utf8::InHiragana
+utf8::InKatakana
END
the non-characters:
sub InKana {
- return <<'END';
+ return <<'END';
+utf8::InHiragana
+utf8::InKatakana
-utf8::IsCn
The negation is useful for defining (surprise!) negated classes.
sub InNotKana {
- return <<'END';
+ return <<'END';
!utf8::InHiragana
-utf8::InKatakana
+utf8::IsCn
END
}
-It's important to remember not to use "&" for the first set -- that
+It's important to remember not to use "&" for the first set; that
would be intersecting with nothing (resulting in an empty set).
=head2 User-Defined Case Mappings
code point and the destination code point. For example:
sub ToUpper {
- return <<END;
+ return <<END;
0061\t\t0041
END
}
Level 1 - Basic Unicode Support
- RL1.1 Hex Notation - done [1]
- RL1.2 Properties - done [2][3]
- RL1.2a Compatibility Properties - done [4]
- RL1.3 Subtraction and Intersection - MISSING [5]
- RL1.4 Simple Word Boundaries - done [6]
- RL1.5 Simple Loose Matches - done [7]
- RL1.6 Line Boundaries - MISSING [8]
- RL1.7 Supplementary Code Points - done [9]
+ RL1.1 Hex Notation - done [1]
+ RL1.2 Properties - done [2][3]
+ RL1.2a Compatibility Properties - done [4]
+ RL1.3 Subtraction and Intersection - MISSING [5]
+ RL1.4 Simple Word Boundaries - done [6]
+ RL1.5 Simple Loose Matches - done [7]
+ RL1.6 Line Boundaries - MISSING [8]
+ RL1.7 Supplementary Code Points - done [9]
[1] \x{...}
[2] \p{...} \P{...}
- [3] supports not only minimal list, but all Unicode character
- properties (see L</Unicode Character Properties>)
+ [3] supports not only minimal list, but all Unicode character
+ properties (see L</Unicode Character Properties>)
[4] \d \D \s \S \w \W \X [:prop:] [:^prop:]
[5] can use regular expression look-ahead [a] or
- user-defined character properties [b] to emulate set operations
+ user-defined character properties [b] to emulate set
+ operations
[6] \b \B
- [7] note that Perl does Full case-folding in matching (but with bugs),
- not Simple: for example U+1F88 is equivalent to U+1F00 U+03B9,
- not with 1F80. This difference matters mainly for certain Greek
- capital letters with certain modifiers: the Full case-folding
- decomposes the letter, while the Simple case-folding would map
- it to a single character.
- [8] should do ^ and $ also on U+000B (\v in C), FF (\f), CR (\r),
- CRLF (\r\n), NEL (U+0085), LS (U+2028), and PS (U+2029);
- should also affect <>, $., and script line numbers;
- should not split lines within CRLF [c] (i.e. there is no empty
- line between \r and \n)
- [9] UTF-8/UTF-EBDDIC used in perl allows not only U+10000 to U+10FFFF
- but also beyond U+10FFFF [d]
+ [7] note that Perl does Full case-folding in matching (but with
+ bugs), not Simple: for example U+1F88 is equivalent to
+ U+1F00 U+03B9, not with 1F80. This difference matters
+ mainly for certain Greek capital letters with certain
+ modifiers: the Full case-folding decomposes the letter,
+ while the Simple case-folding would map it to a single
+ character.
+ [8] should do ^ and $ also on U+000B (\v in C), FF (\f), CR
+ (\r), CRLF (\r\n), NEL (U+0085), LS (U+2028), and PS
+ (U+2029); should also affect <>, $., and script line
+ numbers; should not split lines within CRLF [c] (i.e. there
+ is no empty line between \r and \n)
+ [9] UTF-8/UTF-EBDDIC used in perl allows not only U+10000 to
+ U+10FFFF but also beyond U+10FFFF [d]
[a] You can mimic class subtraction using lookahead.
For example, what UTS#18 might write as
[17] see UAX#10 "Unicode Collation Algorithms"
[18] have Unicode::Collate but not integrated to regexes
- [19] have (?<=x) and (?=x), but look-aheads or look-behinds should see
- outside of the target substring
- [20] need insensitive matching for linguistic features other than case;
- for example, hiragana to katakana, wide and narrow, simplified Han
- to traditional Han (see UTR#30 "Character Foldings")
+ [19] have (?<=x) and (?=x), but look-aheads or look-behinds
+ should see outside of the target substring
+ [20] need insensitive matching for linguistic features other
+ than case; for example, hiragana to katakana, wide and
+ narrow, simplified Han to traditional Han (see UTR#30
+ "Character Foldings")
=back
The following table is from Unicode 3.2.
- Code Points 1st Byte 2nd Byte 3rd Byte 4th Byte
+ Code Points 1st Byte 2nd Byte 3rd Byte 4th Byte
- U+0000..U+007F 00..7F
+ U+0000..U+007F 00..7F
U+0080..U+07FF * C2..DF 80..BF
- U+0800..U+0FFF E0 * A0..BF 80..BF
+ U+0800..U+0FFF E0 * A0..BF 80..BF
U+1000..U+CFFF E1..EC 80..BF 80..BF
U+D000..U+D7FF ED 80..9F 80..BF
U+D800..U+DFFF +++++++ utf16 surrogates, not legal utf8 +++++++
U+E000..U+FFFF EE..EF 80..BF 80..BF
- U+10000..U+3FFFF F0 * 90..BF 80..BF 80..BF
- U+40000..U+FFFFF F1..F3 80..BF 80..BF 80..BF
- U+100000..U+10FFFF F4 80..8F 80..BF 80..BF
+ U+10000..U+3FFFF F0 * 90..BF 80..BF 80..BF
+ U+40000..U+FFFFF F1..F3 80..BF 80..BF 80..BF
+ U+100000..U+10FFFF F4 80..8F 80..BF 80..BF
Note the gaps before several of the byte entries above marked by '*'. These are
caused by legal UTF-8 avoiding non-shortest encodings: it is technically
surrogates> are the range C<U+D800..U+DBFF> and the I<low surrogates>
are the range C<U+DC00..U+DFFF>. The surrogate encoding is
- $hi = ($uni - 0x10000) / 0x400 + 0xD800;
- $lo = ($uni - 0x10000) % 0x400 + 0xDC00;
+ $hi = ($uni - 0x10000) / 0x400 + 0xD800;
+ $lo = ($uni - 0x10000) % 0x400 + 0xDC00;
and the decoding is
- $uni = 0x10000 + ($hi - 0xD800) * 0x400 + ($lo - 0xDC00);
+ $uni = 0x10000 + ($hi - 0xD800) * 0x400 + ($lo - 0xDC00);
If you try to generate surrogates (for example by using chr()), you
will get a warning, if warnings are turned on, because those code
=head2 The "Unicode Bug"
The term, the "Unicode bug" has been applied to an inconsistency with the
-Unicode characters whose code points are in the Latin-1 Supplement block, that
+Unicode characters whose ordinals are in the Latin-1 Supplement block, that
is, between 128 and 255. Without a locale specified, unlike all other
characters or code points, these characters have very different semantics in
byte semantics versus character semantics.
problematic behaviors in later releases: you can't have one without them all.
In the meantime, a workaround is to always call utf8::upgrade($string), or to
-use the standard modules L<Encode> or L<charnames>.
+use the standard module L<Encode>. Also, a scalar that has any characters
+whose ordinal is above 0x100, or which were specified using either of the
+C<\N{...}> notations will automatically have character semantics.
=head2 Forcing Unicode in Perl (Or Unforcing Unicode in Perl)
Perl's internal representation like so:
sub my_escape_html ($) {
- my($what) = shift;
- return unless defined $what;
- Encode::decode_utf8(Foo::Bar::escape_html(Encode::encode_utf8($what)));
+ my($what) = shift;
+ return unless defined $what;
+ Encode::decode_utf8(Foo::Bar::escape_html(
+ Encode::encode_utf8($what)));
}
Sometimes, when the extension does not convert data but just stores
that is still true.
sub fetchrow {
- my($self, $sth, $what) = @_; # $what is one of fetchrow_{array,hashref}
+ # $what is one of fetchrow_{array,hashref}
+ my($self, $sth, $what) = @_;
if ($] < 5.007) {
return $sth->$what;
} else {
my $ret = $sth->$what;
if (ref $ret) {
for my $k (keys %$ret) {
- defined && /[^\000-\177]/ && Encode::_utf8_on($_) for $ret->{$k};
+ defined
+ && /[^\000-\177]/
+ && Encode::_utf8_on($_) for $ret->{$k};
}
return $ret;
} else {
=head2 Which version of perl should I use?
Well, if you can, upgrade to the most recent, but certainly C<5.8.1> or newer.
-The tutorial and FAQ are based on the status quo as of C<5.8.8>.
+The tutorial and FAQ assume the latest release.
You should also check your modules, and upgrade them if necessary. For example,
HTML::Entities requires version >= 1.32 to function correctly, even though the
You can provide this layer when C<open>ing the file:
- open my $fh, '>:encoding(UTF-8)', $filename; # auto encoding on write
- open my $fh, '<:encoding(UTF-8)', $filename; # auto decoding on read
+ open my $fh, '>:encoding(UTF-8)', $filename; # auto encoding on write
+ open my $fh, '<:encoding(UTF-8)', $filename; # auto decoding on read
Or if you already have an open filehandle:
- binmode $fh, ':encoding(UTF-8)';
+ binmode $fh, ':encoding(UTF-8)';
Some database drivers for DBI can also automatically encode and decode, but
that is sometimes limited to the UTF-8 encoding.
The UTF8 flag, also called SvUTF8, is an internal flag that indicates that the
current internal representation is UTF-8. Without the flag, it is assumed to be
-ISO-8859-1. Perl converts between these automatically. (Actually Perl assumes
-the representation is ASCII; see L</Why do regex character classes sometimes
-match only in the ASCII range?> above.)
+ISO-8859-1. Perl converts between these automatically. (Actually Perl usually
+assumes the representation is ASCII; see L</Why do regex character classes
+sometimes match only in the ASCII range?> above.)
One of Perl's internal formats happens to be UTF-8. Unfortunately, Perl can't
keep a secret, so everyone knows about this. That is the source of much
With this "whole sequence" view of characters, the total number of
characters is open-ended. But in the programmer's "one unit is one
character" point of view, the concept of "characters" is more
-deterministic. In this document, we take that second point of view:
+deterministic. In this document, we take that second point of view:
one "character" is one Unicode code point.
For some combinations, there are I<precomposed> characters.
A user of Perl does not normally need to know nor care how Perl
happens to encode its internal strings, but it becomes relevant when
-outputting Unicode strings to a stream without a PerlIO layer -- one with
-the "default" encoding. In such a case, the raw bytes used internally
+outputting Unicode strings to a stream without a PerlIO layer (one with
+the "default" encoding). In such a case, the raw bytes used internally
(the native character set or UTF-8, as appropriate for each string)
will be used, and a "Wide character" warning will be issued if those
strings contain a character beyond 0x00FF.
The I/O layers can also be specified more flexibly with
the C<open> pragma. See L<open>, or look at the following example.
- use open ':encoding(utf8)'; # input/output default encoding will be UTF-8
+ use open ':encoding(utf8)'; # input/output default encoding will be
+ # UTF-8
open X, ">file";
print X chr(0x100), "\n";
close X;
With the C<open> pragma you can use the C<:locale> layer
BEGIN { $ENV{LC_ALL} = $ENV{LANG} = 'ru_RU.KOI8-R' }
- # the :locale will probe the locale environment variables like LC_ALL
+ # the :locale will probe the locale environment variables like
+ # LC_ALL
use open OUT => ':locale'; # russki parusski
open(O, ">koi8");
print O chr(0x430); # Unicode CYRILLIC SMALL LETTER A = KOI8-R 0xc1
255 are displayed as C<\x{...}>, control characters (like C<\n>) are
displayed as C<\x..>, and the rest of the characters as themselves:
- sub nice_string {
- join("",
- map { $_ > 255 ? # if wide character...
- sprintf("\\x{%04X}", $_) : # \x{...}
- chr($_) =~ /[[:cntrl:]]/ ? # else if control character ...
- sprintf("\\x%02X", $_) : # \x..
- quotemeta(chr($_)) # else quoted or as themselves
+ sub nice_string {
+ join("",
+ map { $_ > 255 ? # if wide character...
+ sprintf("\\x{%04X}", $_) : # \x{...}
+ chr($_) =~ /[[:cntrl:]]/ ? # else if control character ...
+ sprintf("\\x%02X", $_) : # \x..
+ quotemeta(chr($_)) # else quoted or as themselves
} unpack("W*", $_[0])); # unpack Unicode characters
}
Character Ranges and Classes
-Character ranges in regular expression character classes (C</[a-z]/>)
-and in the C<tr///> (also known as C<y///>) operator are not magically
-Unicode-aware. What this means is that C<[A-Za-z]> will not magically start
-to mean "all alphabetic letters"; not that it does mean that even for
-8-bit characters, you should be using C</[[:alpha:]]/> in that case.
+Character ranges in regular expression bracketed character classes ( e.g.,
+C</[a-z]/>) and in the C<tr///> (also known as C<y///>) operator are not
+magically Unicode-aware. What this means is that C<[A-Za-z]> will not
+magically start to mean "all alphabetic letters" (not that it does mean that
+even for 8-bit characters; for those, if you are using locales (L<perllocale>),
+use C</[[:alpha:]]/>; and if not, use the 8-bit-aware property C<\p{alpha}>).
-For specifying character classes like that in regular expressions,
-you can use the various Unicode properties--C<\pL>, or perhaps
-C<\p{Alphabetic}>, in this particular case. You can use Unicode
-code points as the end points of character ranges, but there is no
-magic associated with specifying a certain range. For further
-information--there are dozens of Unicode character classes--see
-L<perlunicode>.
+All the properties that begin with C<\p> (and its inverse C<\P>) are actually
+character classes that are Unicode-aware. There are dozens of them, see
+L<perluniprops>.
+
+You can use Unicode code points as the end points of character ranges, and the
+range will include all Unicode code points that lie between those end points.
=item *
How Do I Know Whether My String Is In Unicode?
You shouldn't have to care. But you may, because currently the semantics of the
-characters whose ordinals are in the range 128 to 255 is different depending on
+characters whose ordinals are in the range 128 to 255 are different depending on
whether the string they are contained within is in Unicode or not.
(See L<perlunicode/When Unicode Does Not Happen>.)
return the value of the internal "utf8ness" flag attached to the
C<$string>. If the flag is off, the bytes in the scalar are interpreted
as a single byte encoding. If the flag is on, the bytes in the scalar
-are interpreted as the (multi-byte, variable-length) UTF-8 encoded code
-points of the characters. Bytes added to an UTF-8 encoded string are
+are interpreted as the (variable-length, potentially multi-byte) UTF-8 encoded
+code points of the characters. Bytes added to a UTF-8 encoded string are
automatically upgraded to UTF-8. If mixed non-UTF-8 and UTF-8 scalars
are merged (double-quoted interpolation, explicit concatenation, and
printf/sprintf parameter substitution), the result will be UTF-8 encoded
use bytes;
print length($unicode), "\n"; # will also print 2
# (the 0xC4 0x80 of the UTF-8)
+ no bytes;
=item *
You can find the bytes that make up a UTF-8 sequence with
- @bytes = unpack("C*", $Unicode_string)
+ @bytes = unpack("C*", $Unicode_string)
and you can create well-formed Unicode with
- $Unicode_string = pack("U*", 0xff, ...)
+ $Unicode_string = pack("U*", 0xff, ...)
=item *
irrelevant here, and so are encodings. Each character is just that: the
character.
-Text strings are also called B<Unicode strings>, because in Perl, every text
-string is a Unicode string.
-
On a text string, you would do things like:
$text =~ s/foo/bar/;
based around this code:
while (<>) {
- ($Fld1,$Fld2) = split(/[:\n]/, $_, 9999);
+ ($Fld1,$Fld2) = split(/[:\n]/, $_, -1);
print $Fld2;
}
=item L<prove>
-F<prove> is a command-line interface to the test-running functionality of
+F<prove> is a command-line interface to the test-running functionality
of F<Test::Harness>. It's an alternative to C<make test>.
=item L<corelist>
If the program has been given to perl via the switches C<-e> or C<-E>,
C<$0> will contain the string C<"-e">.
+On Linux as of perl 5.14 the legacy process name will be set with
+L<prctl(2)>, in addition to altering the POSIX name via C<argv[0]> as
+perl has done since version 4.000. Now system utilities that read the
+legacy process name such as ps, top and killall will recognize the
+name you set when assigning to C<$0>. The string you supply will be
+cut off at 16 bytes, this is a limitation imposed by Linux.
+
=item $[
X<$[>
=item ${^UTF8LOCALE}
-This variable indicates whether an UTF-8 locale was detected by perl at
+This variable indicates whether a UTF-8 locale was detected by perl at
startup. This information is used by perl when it's in
adjust-utf8ness-to-locale mode (as when run with the C<-CL> command-line
switch); see L<perlrun> for more info on this.
See the documentation of C<warnings> for more details.
=item ${^WIN32_SLOPPY_STAT}
+X<sitecustomize> X<sitecustomize.pl>
If this variable is set to a true value, then stat() on Windows will
not try to open the file. This means that the link count cannot be
This variable could be set in the F<sitecustomize.pl> file to
configure the local Perl installation to use "sloppy" stat() by
-default. See L<perlrun> for more information about site
+default. See the documentation for B<-f> in
+L<perlrun|perlrun/"Command Switches"> for more information about site
customization.
=item $EXECUTABLE_NAME
routine to force it to that format.
The feature logical name DECC$FILENAME_UNIX_REPORT modifies traditional
-Perl behavior in the conversion of file specifications from UNIX to VMS
+Perl behavior in the conversion of file specifications from Unix to VMS
format in order to follow the extended character handling rules now
expected by the CRTL. Specifically, when this feature is in effect, the
-C<./.../> in a UNIX path is now translated to C<[.^.^.^.]> instead of
+C<./.../> in a Unix path is now translated to C<[.^.^.^.]> instead of
the traditional VMS C<[...]>. To be compatible with what MakeMaker
-expects, if a VMS path cannot be translated to a UNIX path, it is
+expects, if a VMS path cannot be translated to a Unix path, it is
passed through unchanged, so C<unixify("[...]")> will return C<[...]>.
The handling of extended characters is largely complete in the
directories containing some extended characters.
There are several ambiguous cases where a conversion routine cannot
-determine whether an input filename is in UNIX format or in VMS format,
-since now both VMS and UNIX file specifications may have characters in
+determine whether an input filename is in Unix format or in VMS format,
+since now both VMS and Unix file specifications may have characters in
them that could be mistaken for syntax delimiters of the other type. So
some pathnames simply cannot be used in a mode that allows either type
of pathname to be present. Perl will tend to assume that an ambiguous
-filename is in UNIX format.
+filename is in Unix format.
Allowing "." as a version delimiter is simply incompatible with
-determining whether a pathname is in VMS format or in UNIX format with
+determining whether a pathname is in VMS format or in Unix format with
extended file syntax. There is no way to know whether "perl-5.8.6" is a
-UNIX "perl-5.8.6" or a VMS "perl-5.8;6" when passing it to unixify() or
+Unix "perl-5.8.6" or a VMS "perl-5.8;6" when passing it to unixify() or
vmsify().
The DECC$FILENAME_UNIX_REPORT logical name controls how Perl interprets
filenames to the extent that Perl uses the CRTL internally for many
purposes, and attempts to follow CRTL conventions for reporting
filenames. The DECC$FILENAME_UNIX_ONLY feature differs in that it
-expects all filenames passed to the C run-time to be already in UNIX
+expects all filenames passed to the C run-time to be already in Unix
format. This feature is not yet supported in Perl since Perl uses
traditional OpenVMS file specifications internally and in the test
harness, and it is not yet clear whether this mode will be useful or
in the filesystem and CRTL (generally 64-bit OpenVMS v8.3 and later).
There are a number of limitations and caveats to be aware of when
working with symbolic links on VMS. Most notably, the target of a valid
-symbolic link must be expressed as a UNIX-style path and it must exist
+symbolic link must be expressed as a Unix-style path and it must exist
on a volume visible from your POSIX root (see the C<SHOW ROOT> command
in DCL help). For further details on symbolic link capabilities and
requirements, see chapter 12 of the CRTL manual that ships with OpenVMS
Perl will wait for the subprocess to complete before continuing.
The mailbox (MBX) that perl can create to communicate with a pipe
-defaults to a buffer size of 512. The default buffer size is
-adjustable via the logical name PERL_MBX_SIZE provided that the
-value falls between 128 and the SYSGEN parameter MAXBUF inclusive.
-For example, to double the MBX size from the default within
-a Perl program, use C<$ENV{'PERL_MBX_SIZE'} = 1024;> and then
-open and use pipe constructs. An alternative would be to issue
-the command:
+defaults to a buffer size of 8192 on 64-bit systems, 512 on VAX. The
+default buffer size is adjustable via the logical name PERL_MBX_SIZE
+provided that the value falls between 128 and the SYSGEN parameter
+MAXBUF inclusive. For example, to set the mailbox size to 32767 use
+C<$ENV{'PERL_MBX_SIZE'} = 32767;> and then open and use pipe constructs.
+An alternative would be to issue the command:
- $ Define PERL_MBX_SIZE 1024
+ $ Define PERL_MBX_SIZE 32767
before running your wide record pipe program. A larger value may
improve performance at the expense of the BYTLM UAF quota.
$define DISPLAY "hostname:0.0"
Currently the value of C<DISPLAY> is ignored. It is recommended that it be set
-to be the hostname of the display, the server and screen in UNIX notation. In
+to be the hostname of the display, the server and screen in Unix notation. In
the future the value of DISPLAY may be honored by Perl instead of using the
default display.
When C<PERL_VMS_POSIX_EXIT> is active (see L</"$?"> below), the native VMS exit
status value will have either one of the C<$!> or C<$?> or C<$^E> or
-the UNIX value 255 encoded into it in a way that the effective original
+the Unix value 255 encoded into it in a way that the effective original
value can be decoded by other programs written in C, including Perl
and the GNV package. As per the normal non-VMS behavior of C<die> if
either C<$!> or C<$?> are non-zero, one of those values will be
-encoded into a native VMS status value. If both of the UNIX status
+encoded into a native VMS status value. If both of the Unix status
values are 0, and the C<$^E> value is set one of ERROR or SEVERE_ERROR
severity, then the C<$^E> value will be used as the exit code as is.
-If none of the above apply, the UNIX value of 255 will be encoded into
+If none of the above apply, the Unix value of 255 will be encoded into
a native VMS exit status value.
Please note a significant difference in the behavior of C<die> in
the C<PERL_VMS_POSIX_EXIT> mode is that it does not force a VMS
-SEVERE_ERROR status on exit. The UNIX exit values of 2 through
+SEVERE_ERROR status on exit. The Unix exit values of 2 through
255 will be encoded in VMS status values with severity levels of
-SUCCESS. The UNIX exit value of 1 will be encoded in a VMS status
+SUCCESS. The Unix exit value of 1 will be encoded in a VMS status
value with a severity level of ERROR. This is to be compatible with
how the VMS C library encodes these values.
may be changed to be ERROR or higher in the future depending on the
results of testing and further review.
-See L</"$?"> for a description of the encoding of the UNIX value to
+See L</"$?"> for a description of the encoding of the Unix value to
produce a native VMS status containing it.
contain the actual value of 0 to 255 returned by that program
on a normal exit.
-With the _POSIX_EXIT macro set, the UNIX exit value of zero is
-represented as a VMS native status of 1, and the UNIX values
+With the _POSIX_EXIT macro set, the Unix exit value of zero is
+represented as a VMS native status of 1, and the Unix values
from 2 to 255 are encoded by the equation:
VMS_status = 0x35a000 + (unix_value * 8) + 1.
-And in the special case of unix value 1 the encoding is:
+And in the special case of Unix value 1 the encoding is:
VMS_status = 0x35a000 + 8 + 2 + 0x10000000.
For other termination statuses, the severity portion of the
-subprocess' exit status is used: if the severity was success or
+subprocess's exit status is used: if the severity was success or
informational, these bits are all 0; if the severity was
warning, they contain a value of 1; if the severity was
error or fatal error, they contain the actual severity bits,
which turns out to be a value of 2 for error and 4 for severe_error.
Fatal is another term for the severe_error status.
-As a result, C<$?> will always be zero if the subprocess' exit
+As a result, C<$?> will always be zero if the subprocess's exit
status indicated successful completion, and non-zero if a
warning or error occurred or a program compliant with encoding
_POSIX_EXIT values was run and set a status.
How can you tell the difference between a non-zero status that is
-the result of a VMS native error status or an encoded UNIX status?
+the result of a VMS native error status or an encoded Unix status?
You can not unless you look at the ${^CHILD_ERROR_NATIVE} value.
The ${^CHILD_ERROR_NATIVE} value returns the actual VMS status value
and check the severity bits. If the severity bits are equal to 1,
then if the numeric value for C<$?> is between 2 and 255 or 0, then
-C<$?> accurately reflects a value passed back from a UNIX application.
+C<$?> accurately reflects a value passed back from a Unix application.
If C<$?> is 1, and the severity bits indicate a VMS error (2), then
-C<$?> is from a UNIX application exit value.
+C<$?> is from a Unix application exit value.
In practice, Perl scripts that call programs that return _POSIX_EXIT
type status values will be expecting those values, and programs that
And success is always the value 0 in all behaviors.
When the actual VMS termination status of the child is an error,
-internally the C<$!> value will be set to the closest UNIX errno
+internally the C<$!> value will be set to the closest Unix errno
value to that error so that Perl scripts that test for error
-messages will see the expected UNIX style error message instead
+messages will see the expected Unix style error message instead
of a VMS message.
Conversely, when setting C<$?> in an END block, an attempt is made
almost a NOOP as it will cause the current native VMS status in the
C library to become the current native Perl VMS status, and is handled
this way as it is known to not be a valid native VMS status value.
-It is recommend that only values in the range of normal UNIX parent or
+It is recommend that only values in the range of normal Unix parent or
child status numbers, 0 to 255 are used.
The pragma C<use vmsish 'status'> makes C<$?> reflect the actual
INCLUDE: Rpcb1.xsh
If the parameters to the INCLUDE: keyword are followed by a pipe (C<|>) then
-the compiler will interpret the parameters as a command.
+the compiler will interpret the parameters as a command. This feature is
+mildly deprecated in favour of the C<INCLUDE_COMMAND:> directive, as documented
+below.
INCLUDE: cat Rpcb1.xsh |
+Do not use this to run perl: C<INCLUDE: perl |> will run the perl that
+happens to be the first in your path and not necessarily the same perl that is
+used to run C<xsubpp>. See L<"The INCLUDE_COMMAND: Keyword">.
+
+=head2 The INCLUDE_COMMAND: Keyword
+
+Runs the supplied command and includes its output into the current XS
+document. C<INCLUDE_COMMAND> assigns special meaning to the C<$^X> token
+in that it runs the same perl interpreter that is running C<xsubpp>:
+
+ INCLUDE_COMMAND: cat Rpcb1.xsh
+
+ INCLUDE_COMMAND: $^X -e ...
+
=head2 The CASE: Keyword
The CASE: keyword allows an XSUB to have multiple distinct parts with each
=item typedef my_cxt_t
-This struct typedef I<must> always be called C<my_cxt_t> -- the other
+This struct typedef I<must> always be called C<my_cxt_t>. The other
C<CXT*> macros assume the existence of the C<my_cxt_t> typedef name.
Declare a typedef named C<my_cxt_t> that is a structure that contains
The MY_CXT_INIT macro initialises storage for the C<my_cxt_t> struct.
-It I<must> be called exactly once -- typically in a BOOT: section. If you
+It I<must> be called exactly once, typically in a BOOT: section. If you
are maintaining multiple interpreters, it should be called once in each
interpreter instance, except for interpreters cloned from existing ones.
(But see C<MY_CXT_CLONE> below.)
next to the variable name and away from the variable type), and place a
"*" near the variable type, but away from the variable name (as in the
call to foo above). By doing so, it is easy to understand exactly what
-will be passed to the C function -- it will be whatever is in the "last
+will be passed to the C function; it will be whatever is in the "last
column".
You should take great pains to try to pass the function the type of variable
Manual page indexers are often extremely picky about the format of this
section, so don't put anything in it except this line. A single dash, and
only a single dash, should separate the list of programs or functions from
-the description. Functions should not be qualified with C<()> or the like.
+the description. Do not use any markup such as CE<lt>E<gt> or
+BE<lt>E<gt>. Functions should not be qualified with C<()> or the like.
The description should ideally fit on a single line, even if a man program
replaces the dash with a few tabs.
/* Translations. */
-const char S_no_symref_sv[] =
+static const char S_no_symref_sv[] =
"Can't use string (\"%" SVf32 "\"%s) as %s ref while \"strict refs\" in use";
PP(pp_rv2gv)
}
else {
if (PL_op->op_private & HINT_STRICT_REFS)
- DIE(aTHX_ S_no_symref_sv, sv, (SvCUR(sv)>32 ? "..." : ""), "a symbol");
+ DIE(aTHX_ S_no_symref_sv, sv, (SvPOK(sv) && SvCUR(sv)>32 ? "..." : ""), "a symbol");
if ((PL_op->op_private & (OPpLVAL_INTRO|OPpDONT_INIT_GV))
== OPpDONT_INIT_GV) {
/* We are the target of a coderef assignment. Return
if (PL_op->op_private & HINT_STRICT_REFS) {
if (SvOK(sv))
- Perl_die(aTHX_ S_no_symref_sv, sv, (SvCUR(sv)>32 ? "..." : ""), what);
+ Perl_die(aTHX_ S_no_symref_sv, sv, (SvPOK(sv) && SvCUR(sv)>32 ? "..." : ""), what);
else
Perl_die(aTHX_ PL_no_usym, what);
}
on same algorithm as above */
register UV result = 1;
register UV base = baseuv;
- const bool odd_power = (bool)(power & 1);
+ const bool odd_power = cBOOL(power & 1);
if (odd_power) {
result *= base;
}
PP(pp_not)
{
- dVAR; dSP; tryAMAGICunSET(not);
+ dVAR; dSP; tryAMAGICunSET_var(not_amg);
*PL_stack_sp = boolSV(!SvTRUE(*PL_stack_sp));
return NORMAL;
}
PP(pp_complement)
{
- dVAR; dSP; dTARGET; tryAMAGICun(compl);
+ dVAR; dSP; dTARGET; tryAMAGICun_var(compl_amg);
{
dTOPss;
SvGETMAGIC(sv);
{
dVAR; dSP; dTARGET;
SV *sv;
- I32 len = 0;
STRLEN curlen;
STRLEN utf8_curlen;
- I32 pos;
- I32 rem;
- I32 fail;
+ SV * pos_sv;
+ IV pos1_iv;
+ int pos1_is_uv;
+ IV pos2_iv;
+ int pos2_is_uv;
+ SV * len_sv;
+ IV len_iv = 0;
+ int len_is_uv = 1;
const I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
const char *tmps;
- const I32 arybase = CopARYBASE_get(PL_curcop);
+ const IV arybase = CopARYBASE_get(PL_curcop);
SV *repl_sv = NULL;
const char *repl = NULL;
STRLEN repl_len;
repl = SvPV_const(repl_sv, repl_len);
repl_is_utf8 = DO_UTF8(repl_sv) && SvCUR(repl_sv);
}
- len = POPi;
+ len_sv = POPs;
+ len_iv = SvIV(len_sv);
+ len_is_uv = SvIOK_UV(len_sv);
}
- pos = POPi;
+ pos_sv = POPs;
+ pos1_iv = SvIV(pos_sv);
+ pos1_is_uv = SvIOK_UV(pos_sv);
sv = POPs;
PUTBACK;
if (repl_sv) {
else
utf8_curlen = 0;
- if (pos >= arybase) {
- pos -= arybase;
- rem = curlen-pos;
- fail = rem;
- if (num_args > 2) {
- if (len < 0) {
- rem += len;
- if (rem < 0)
- rem = 0;
- }
- else if (rem > len)
- rem = len;
+ if ( (pos1_is_uv && arybase < 0) || (pos1_iv >= arybase) ) { /* pos >= $[ */
+ UV pos1_uv = pos1_iv-arybase;
+ /* Overflow can occur when $[ < 0 */
+ if (arybase < 0 && pos1_uv < (UV)pos1_iv)
+ goto bound_fail;
+ pos1_iv = pos1_uv;
+ pos1_is_uv = 1;
+ }
+ else if (pos1_is_uv ? (UV)pos1_iv > 0 : pos1_iv > 0) {
+ goto bound_fail; /* $[=3; substr($_,2,...) */
+ }
+ else { /* pos < $[ */
+ if (pos1_iv == 0) { /* $[=1; substr($_,0,...) */
+ pos1_iv = curlen;
+ pos1_is_uv = 1;
+ } else {
+ if (curlen) {
+ pos1_is_uv = curlen-1 > ~(UV)pos1_iv;
+ pos1_iv += curlen;
+ }
}
}
- else {
- pos += curlen;
- if (num_args < 3)
- rem = curlen;
- else if (len >= 0) {
- rem = pos+len;
- if (rem > (I32)curlen)
- rem = curlen;
+ if (pos1_is_uv || pos1_iv > 0) {
+ if ((UV)pos1_iv > curlen)
+ goto bound_fail;
+ }
+
+ if (num_args > 2) {
+ if (!len_is_uv && len_iv < 0) {
+ pos2_iv = curlen + len_iv;
+ if (curlen)
+ pos2_is_uv = curlen-1 > ~(UV)len_iv;
+ else
+ pos2_is_uv = 0;
+ } else { /* len_iv >= 0 */
+ if (!pos1_is_uv && pos1_iv < 0) {
+ pos2_iv = pos1_iv + len_iv;
+ pos2_is_uv = (UV)len_iv > (UV)IV_MAX;
+ } else {
+ if ((UV)len_iv > curlen-(UV)pos1_iv)
+ pos2_iv = curlen;
+ else
+ pos2_iv = pos1_iv+len_iv;
+ pos2_is_uv = 1;
+ }
}
- else {
- rem = curlen+len;
- if (rem < pos)
- rem = pos;
- }
- if (pos < 0)
- pos = 0;
- fail = rem;
- rem -= pos;
- }
- if (fail < 0) {
- if (lvalue || repl)
- Perl_croak(aTHX_ "substr outside of string");
- Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR), "substr outside of string");
- RETPUSHUNDEF;
}
else {
- const I32 upos = pos;
- const I32 urem = rem;
- if (utf8_curlen)
- sv_pos_u2b(sv, &pos, &rem);
- tmps += pos;
+ pos2_iv = curlen;
+ pos2_is_uv = 1;
+ }
+
+ if (!pos2_is_uv && pos2_iv < 0) {
+ if (!pos1_is_uv && pos1_iv < 0)
+ goto bound_fail;
+ pos2_iv = 0;
+ }
+ else if (!pos1_is_uv && pos1_iv < 0)
+ pos1_iv = 0;
+
+ if ((UV)pos2_iv < (UV)pos1_iv)
+ pos2_iv = pos1_iv;
+ if ((UV)pos2_iv > curlen)
+ pos2_iv = curlen;
+
+ {
+ /* pos1_iv and pos2_iv both in 0..curlen, so the cast is safe */
+ const STRLEN pos = (STRLEN)( (UV)pos1_iv );
+ const STRLEN len = (STRLEN)( (UV)pos2_iv - (UV)pos1_iv );
+ STRLEN byte_len = len;
+ STRLEN byte_pos = utf8_curlen
+ ? sv_pos_u2b_flags(sv, pos, &byte_len, SV_CONST_RETURN) : pos;
+
+ tmps += byte_pos;
/* we either return a PV or an LV. If the TARG hasn't been used
* before, or is of that type, reuse it; otherwise use a mortal
* instead. Note that LVs can have an extended lifetime, so also
}
}
- sv_setpvn(TARG, tmps, rem);
+ sv_setpvn(TARG, tmps, byte_len);
#ifdef USE_LOCALE_COLLATE
sv_unmagic(TARG, PERL_MAGIC_collxfrm);
#endif
}
if (!SvOK(sv))
sv_setpvs(sv, "");
- sv_insert_flags(sv, pos, rem, repl, repl_len, 0);
+ sv_insert_flags(sv, byte_pos, byte_len, repl, repl_len, 0);
if (repl_is_utf8)
SvUTF8_on(sv);
SvREFCNT_dec(repl_sv_copy);
SvREFCNT_dec(LvTARG(TARG));
LvTARG(TARG) = SvREFCNT_inc_simple(sv);
}
- LvTARGOFF(TARG) = upos;
- LvTARGLEN(TARG) = urem;
+ LvTARGOFF(TARG) = pos;
+ LvTARGLEN(TARG) = len;
}
}
SPAGAIN;
PUSHs(TARG); /* avoid SvSETMAGIC here */
RETURN;
+
+bound_fail:
+ if (lvalue || repl)
+ Perl_croak(aTHX_ "substr outside of string");
+ Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR), "substr outside of string");
+ RETPUSHUNDEF;
}
PP(pp_vec)
dVAR; dSP; dMARK; dORIGMARK; dTARGET;
if (SvTAINTED(MARK[1]))
TAINT_PROPER("sprintf");
+ SvTAINTED_off(TARG);
do_sprintf(TARG, SP-MARK, MARK+1);
TAINT_IF(SvTAINTED(TARG));
SP = ORIGMARK;
{
dVAR;
dSP;
- AV * const av = MUTABLE_AV(POPs);
+ AV * const av = PL_op->op_flags & OPf_SPECIAL
+ ? MUTABLE_AV(GvAV(PL_defgv)) : MUTABLE_AV(POPs);
SV * const sv = PL_op->op_type == OP_SHIFT ? av_shift(av) : av_pop(av);
EXTEND(SP, 1);
assert (sv);
}
else {
SV **begin = AvARRAY(av);
- SV **end = begin + AvFILLp(av);
- while (begin < end) {
- register SV * const tmp = *begin;
- *begin++ = *end;
- *end-- = tmp;
+ if (begin) {
+ SV **end = begin + AvFILLp(av);
+
+ while (begin < end) {
+ register SV * const tmp = *begin;
+ *begin++ = *end;
+ *end-- = tmp;
+ }
}
}
}
#define tryAMAGICun_var(meth_enum) tryAMAGICunW_var(meth_enum,SETsvUN,0,RETURN)
#define tryAMAGICun(meth) tryAMAGICun_var(CAT2(meth,_amg))
+#define tryAMAGICunSET_var(meth_enum) tryAMAGICunW_var(meth_enum,SETs,0,RETURN)
#define tryAMAGICunSET(meth) tryAMAGICunW(meth,SETs,0,RETURN)
#define tryAMAGICunTARGET(meth, shift) \
STMT_START { dSP; sp--; /* get TARGET from below PL_stack_sp */ \
#define tryAMAGICftest(chr) \
STMT_START { \
assert(chr != '?'); \
- if (SvAMAGIC(TOPs)) { \
+ if ((PL_op->op_flags & OPf_KIDS) \
+ && SvAMAGIC(TOPs)) { \
const char tmpchr = (chr); \
SV * const tmpsv = amagic_call(TOPs, \
newSVpvn_flags(&tmpchr, 1, SVs_TEMP), \
ly this hack can be replaced with the approach described at
http://www.nntp.perl.org/group/perl.perl5.porters/2007/03
/msg122415.html some day. */
- OP *matchop = pm->op_next;
- SV *lhs;
- const bool was_tainted = PL_tainted;
- if (matchop->op_flags & OPf_STACKED)
+ if(pm->op_type == OP_MATCH) {
+ SV *lhs;
+ const bool was_tainted = PL_tainted;
+ if (pm->op_flags & OPf_STACKED)
lhs = TOPs;
- else if (matchop->op_private & OPpTARGET_MY)
- lhs = PAD_SV(matchop->op_targ);
- else lhs = DEFSV;
- SvGETMAGIC(lhs);
- /* Restore the previous value of PL_tainted (which may have been
- modified by get-magic), to avoid incorrectly setting the
- RXf_TAINTED flag further down. */
- PL_tainted = was_tainted;
+ else if (pm->op_private & OPpTARGET_MY)
+ lhs = PAD_SV(pm->op_targ);
+ else lhs = DEFSV;
+ SvGETMAGIC(lhs);
+ /* Restore the previous value of PL_tainted (which may have been
+ modified by get-magic), to avoid incorrectly setting the
+ RXf_TAINTED flag further down. */
+ PL_tainted = was_tainted;
+ }
re = reg_temp_copy(NULL, re);
ReREFCNT_dec(PM_GETRE(pm));
register REGEXP * const rx = cx->sb_rx;
SV *nsv = NULL;
REGEXP *old = PM_GETRE(pm);
+
+ PERL_ASYNC_CHECK();
+
if(old != rx) {
if(old)
ReREFCNT_dec(old);
if (cx->sb_iters > cx->sb_maxiters)
DIE(aTHX_ "Substitution loop");
+ SvGETMAGIC(TOPs); /* possibly clear taint on $1 etc: #67962 */
+
if (!(cx->sb_rxtainted & 2) && SvTAINTED(TOPs))
cx->sb_rxtainted |= 2;
- sv_catsv(dstr, POPs);
+ sv_catsv_nomg(dstr, POPs);
/* XXX: adjust for positive offsets of \G for instance s/(.)\G//g with positive pos() */
s -= RX_GOFS(rx);
{
const char *cx_label = CxLABEL(cx);
if (!cx_label || strNE(label, cx_label) ) {
- DEBUG_l(Perl_deb(aTHX_ "(Skipping label #%ld %s)\n",
+ DEBUG_l(Perl_deb(aTHX_ "(poptolabel(): skipping label at cx=%ld %s)\n",
(long)i, cx_label));
continue;
}
- DEBUG_l( Perl_deb(aTHX_ "(Found label #%ld %s)\n", (long)i, label));
+ DEBUG_l( Perl_deb(aTHX_ "(poptolabel(): found label at cx=%ld %s)\n", (long)i, label));
return i;
}
}
case CXt_EVAL:
case CXt_SUB:
case CXt_FORMAT:
- DEBUG_l( Perl_deb(aTHX_ "(Found sub #%ld)\n", (long)i));
+ DEBUG_l( Perl_deb(aTHX_ "(dopoptosub_at(): found sub at cx=%ld)\n", (long)i));
return i;
}
}
default:
continue;
case CXt_EVAL:
- DEBUG_l( Perl_deb(aTHX_ "(Found eval #%ld)\n", (long)i));
+ DEBUG_l( Perl_deb(aTHX_ "(dopoptoeval(): found eval at cx=%ld)\n", (long)i));
return i;
}
}
case CXt_LOOP_LAZYSV:
case CXt_LOOP_FOR:
case CXt_LOOP_PLAIN:
- DEBUG_l( Perl_deb(aTHX_ "(Found loop #%ld)\n", (long)i));
+ DEBUG_l( Perl_deb(aTHX_ "(dopoptoloop(): found loop at cx=%ld)\n", (long)i));
return i;
}
}
default:
continue;
case CXt_GIVEN:
- DEBUG_l( Perl_deb(aTHX_ "(Found given #%ld)\n", (long)i));
+ DEBUG_l( Perl_deb(aTHX_ "(dopoptogiven(): found given at cx=%ld)\n", (long)i));
return i;
case CXt_LOOP_PLAIN:
assert(!CxFOREACHDEF(cx));
case CXt_LOOP_LAZYSV:
case CXt_LOOP_FOR:
if (CxFOREACHDEF(cx)) {
- DEBUG_l( Perl_deb(aTHX_ "(Found foreach #%ld)\n", (long)i));
+ DEBUG_l( Perl_deb(aTHX_ "(dopoptogiven(): found foreach at cx=%ld)\n", (long)i));
return i;
}
}
default:
continue;
case CXt_WHEN:
- DEBUG_l( Perl_deb(aTHX_ "(Found when #%ld)\n", (long)i));
+ DEBUG_l( Perl_deb(aTHX_ "(dopoptowhen(): found when at cx=%ld)\n", (long)i));
return i;
}
}
while (cxstack_ix > cxix) {
SV *sv;
register PERL_CONTEXT *cx = &cxstack[cxstack_ix];
- DEBUG_l(PerlIO_printf(Perl_debug_log, "Unwinding block %ld, type %s\n",
- (long) cxstack_ix, PL_block_type[CxTYPE(cx)]));
+ DEBUG_CX("UNWIND"); \
/* Note: we don't need to restore the base context info till the end. */
switch (CxTYPE(cx)) {
case CXt_SUBST:
}
void
-Perl_die_where(pTHX_ SV *msv)
+Perl_die_unwind(pTHX_ SV *msv)
{
dVAR;
+ SV *exceptsv = sv_mortalcopy(msv);
+ U8 in_eval = PL_in_eval;
+ PERL_ARGS_ASSERT_DIE_UNWIND;
- if (PL_in_eval) {
+ if (in_eval) {
I32 cxix;
I32 gimme;
- if (msv) {
- if (PL_in_eval & EVAL_KEEPERR) {
- static const char prefix[] = "\t(in cleanup) ";
- SV * const err = ERRSV;
- const char *e = NULL;
- if (!SvPOK(err))
- sv_setpvs(err,"");
- else if (SvCUR(err) >= sizeof(prefix)+SvCUR(msv)-1) {
- STRLEN len;
- STRLEN msglen;
- const char* message = SvPV_const(msv, msglen);
- e = SvPV_const(err, len);
- e += len - msglen;
- if (*e != *message || strNE(e,message))
- e = NULL;
- }
- if (!e) {
- STRLEN start;
- SvGROW(err, SvCUR(err)+sizeof(prefix)+SvCUR(msv));
- sv_catpvn(err, prefix, sizeof(prefix)-1);
- sv_catsv(err, msv);
- start = SvCUR(err)-SvCUR(msv)-sizeof(prefix)+1;
- Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "%s",
- SvPVX_const(err)+start);
- }
- }
- else {
- STRLEN msglen;
- const char* message = SvPV_const(msv, msglen);
- sv_setpvn(ERRSV, message, msglen);
- SvFLAGS(ERRSV) |= SvFLAGS(msv) & SVf_UTF8;
- }
- }
-
while ((cxix = dopoptoeval(cxstack_ix)) < 0
&& PL_curstackinfo->si_prev)
{
if (cxix >= 0) {
I32 optype;
+ SV *namesv;
register PERL_CONTEXT *cx;
SV **newsp;
POPBLOCK(cx,PL_curpm);
if (CxTYPE(cx) != CXt_EVAL) {
STRLEN msglen;
- const char* message = SvPVx_const( msv ? msv : ERRSV, msglen);
+ const char* message = SvPVx_const(exceptsv, msglen);
PerlIO_write(Perl_error_log, (const char *)"panic: die ", 11);
PerlIO_write(Perl_error_log, message, msglen);
my_exit(1);
}
POPEVAL(cx);
+ namesv = cx->blk_eval.old_namesv;
if (gimme == G_SCALAR)
*++newsp = &PL_sv_undef;
PL_curcop = cx->blk_oldcop;
if (optype == OP_REQUIRE) {
- const char* const msg = SvPVx_nolen_const(ERRSV);
- SV * const nsv = cx->blk_eval.old_namesv;
- (void)hv_store(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv),
+ const char* const msg = SvPVx_nolen_const(exceptsv);
+ (void)hv_store(GvHVn(PL_incgv),
+ SvPVX_const(namesv), SvCUR(namesv),
&PL_sv_undef, 0);
+ /* note that unlike pp_entereval, pp_require isn't
+ * supposed to trap errors. So now that we've popped the
+ * EVAL that pp_require pushed, and processed the error
+ * message, rethrow the error */
DIE(aTHX_ "%sCompilation failed in require",
*msg ? msg : "Unknown error\n");
}
+ if (in_eval & EVAL_KEEPERR) {
+ Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "\t(in cleanup) %s",
+ SvPV_nolen_const(exceptsv));
+ }
+ else {
+ sv_setsv(ERRSV, exceptsv);
+ }
assert(CxTYPE(cx) == CXt_EVAL);
+ PL_restartjmpenv = cx->blk_eval.cur_top_env;
PL_restartop = cx->blk_eval.retop;
JMPENV_JUMP(3);
/* NOTREACHED */
}
}
- write_to_stderr( msv ? msv : ERRSV );
+ write_to_stderr(exceptsv);
my_failure_exit();
/* NOTREACHED */
}
PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
FREETMPS;
+ PERL_ASYNC_CHECK();
+
if (PL_op->op_flags & OPf_SPECIAL /* breakpoint */
|| SvIV(PL_DBsingle) || SvIV(PL_DBsignal) || SvIV(PL_DBtrace))
{
/* don't do recursive DB::DB call */
return NORMAL;
- ENTER_with_name("sub");
+ ENTER;
SAVETMPS;
SAVEI32(PL_debug);
(void)(*CvXSUB(cv))(aTHX_ cv);
CvDEPTH(cv)--;
FREETMPS;
- LEAVE_with_name("sub");
+ LEAVE;
return NORMAL;
}
else {
SV **newsp;
PMOP *newpm;
I32 optype = 0;
+ SV *namesv;
SV *sv;
OP *retop = NULL;
if (!(PL_in_eval & EVAL_KEEPERR))
clear_errsv = TRUE;
POPEVAL(cx);
+ namesv = cx->blk_eval.old_namesv;
retop = cx->blk_eval.retop;
if (CxTRYBLOCK(cx))
break;
(MARK == SP || (gimme == G_SCALAR && !SvTRUE(*SP))) )
{
/* Unassume the success we assumed earlier. */
- SV * const nsv = cx->blk_eval.old_namesv;
- (void)hv_delete(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv), G_DISCARD);
- DIE(aTHX_ "%"SVf" did not return a true value", SVfARG(nsv));
+ (void)hv_delete(GvHVn(PL_incgv),
+ SvPVX_const(namesv), SvCUR(namesv),
+ G_DISCARD);
+ DIE(aTHX_ "%"SVf" did not return a true value", SVfARG(namesv));
}
break;
case CXt_FORMAT:
PUSHMARK(mark);
PUTBACK;
(void)(*CvXSUB(cv))(aTHX_ cv);
- LEAVE_with_name("sub");
+ LEAVE;
return retop;
}
else {
else
label = cPVOP->op_pv;
+ PERL_ASYNC_CHECK();
+
if (label && *label) {
OP *gotoprobe = NULL;
bool leaving_eval = FALSE;
}
}
+/*
+=for apidoc docatch
+
+Check for the cases 0 or 3 of cur_env.je_ret, only used inside an eval context.
+
+0 is used as continue inside eval,
+
+3 is used for a die caught by an inner eval - continue inner loop
+
+See cop.h: je_mustcatch, when set at any runlevel to TRUE, means eval ops must
+establish a local jmpenv to handle exception traps.
+
+=cut
+*/
STATIC OP *
S_docatch(pTHX_ OP *o)
{
break;
case 3:
/* die caught by an inner eval - continue inner loop */
-
- /* NB XXX we rely on the old popped CxEVAL still being at the top
- * of the stack; the way die_where() currently works, this
- * assumption is valid. In theory The cur_top_env value should be
- * returned in another global, the way retop (aka PL_restartop)
- * is. */
- assert(CxTYPE(&cxstack[cxstack_ix+1]) == CXt_EVAL);
-
- if (PL_restartop
- && cxstack[cxstack_ix+1].blk_eval.cur_top_env == PL_top_env)
- {
+ if (PL_restartop && PL_restartjmpenv == PL_top_env) {
+ PL_restartjmpenv = NULL;
PL_op = PL_restartop;
PL_restartop = 0;
goto redo_body;
return NULL;
}
+/* James Bond: Do you expect me to talk?
+ Auric Goldfinger: No, Mr. Bond. I expect you to die.
+
+ This code is an ugly hack, doesn't work with lexicals in subroutines that are
+ called more than once, and is only used by regcomp.c, for (?{}) blocks.
+
+ Currently it is not used outside the core code. Best if it stays that way.
+*/
OP *
Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
/* sv Text to convert to OP tree. */
/* startop op_free() this to undo. */
/* code Short string id of the caller. */
{
- /* FIXME - how much of this code is common with pp_entereval? */
dVAR; dSP; /* Make POPBLOCK work. */
PERL_CONTEXT *cx;
SV **newsp;
}
+/* Run yyparse() in a setjmp wrapper. Returns:
+ * 0: yyparse() successful
+ * 1: yyparse() failed
+ * 3: yyparse() died
+ */
+STATIC int
+S_try_yyparse(pTHX)
+{
+ int ret;
+ dJMPENV;
+
+ assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL);
+ JMPENV_PUSH(ret);
+ switch (ret) {
+ case 0:
+ ret = yyparse() ? 1 : 0;
+ break;
+ case 3:
+ break;
+ default:
+ JMPENV_POP;
+ JMPENV_JUMP(ret);
+ /* NOTREACHED */
+ }
+ JMPENV_POP;
+ return ret;
+}
+
+
/* Compile a require/do, an eval '', or a /(?{...})/.
* In the last case, startop is non-null, and contains the address of
* a pointer that should be set to the just-compiled code.
{
dVAR; dSP;
OP * const saveop = PL_op;
+ bool in_require = (saveop && saveop->op_type == OP_REQUIRE);
+ int yystatus;
- PL_in_eval = ((saveop && saveop->op_type == OP_REQUIRE)
+ PL_in_eval = (in_require
? (EVAL_INREQUIRE | (PL_in_eval & EVAL_INEVAL))
: EVAL_INEVAL);
PL_in_eval |= EVAL_KEEPERR;
else
CLEAR_ERRSV();
- if (yyparse() || PL_parser->error_count || !PL_eval_root) {
+
+ /* note that yyparse() may raise an exception, e.g. C<BEGIN{die}>,
+ * so honour CATCH_GET and trap it here if necessary */
+
+ yystatus = (!in_require && CATCH_GET) ? S_try_yyparse(aTHX) : yyparse();
+
+ if (yystatus || PL_parser->error_count || !PL_eval_root) {
SV **newsp; /* Used by POPBLOCK. */
- PERL_CONTEXT *cx = &cxstack[cxstack_ix];
- I32 optype = 0; /* Might be reset by POPEVAL. */
+ PERL_CONTEXT *cx = NULL;
+ I32 optype; /* Used by POPEVAL. */
+ SV *namesv = NULL;
const char *msg;
+ PERL_UNUSED_VAR(newsp);
+ PERL_UNUSED_VAR(optype);
+
+ /* note that if yystatus == 3, then the EVAL CX block has already
+ * been popped, and various vars restored */
PL_op = saveop;
- if (PL_eval_root) {
- op_free(PL_eval_root);
- PL_eval_root = NULL;
- }
- SP = PL_stack_base + POPMARK; /* pop original mark */
- if (!startop) {
- POPBLOCK(cx,PL_curpm);
- POPEVAL(cx);
+ if (yystatus != 3) {
+ if (PL_eval_root) {
+ op_free(PL_eval_root);
+ PL_eval_root = NULL;
+ }
+ SP = PL_stack_base + POPMARK; /* pop original mark */
+ if (!startop) {
+ POPBLOCK(cx,PL_curpm);
+ POPEVAL(cx);
+ namesv = cx->blk_eval.old_namesv;
+ }
}
lex_end();
- LEAVE_with_name("eval"); /* pp_entereval knows about this LEAVE. */
+ if (yystatus != 3)
+ LEAVE_with_name("eval"); /* pp_entereval knows about this LEAVE. */
msg = SvPVx_nolen_const(ERRSV);
- if (optype == OP_REQUIRE) {
- const SV * const nsv = cx->blk_eval.old_namesv;
- (void)hv_store(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv),
- &PL_sv_undef, 0);
+ if (in_require) {
+ if (!cx) {
+ /* If cx is still NULL, it means that we didn't go in the
+ * POPEVAL branch. */
+ cx = &cxstack[cxstack_ix];
+ assert(CxTYPE(cx) == CXt_EVAL);
+ namesv = cx->blk_eval.old_namesv;
+ }
+ (void)hv_store(GvHVn(PL_incgv),
+ SvPVX_const(namesv), SvCUR(namesv),
+ &PL_sv_undef, 0);
Perl_croak(aTHX_ "%sCompilation failed in require",
*msg ? msg : "Unknown error\n");
}
else if (startop) {
- POPBLOCK(cx,PL_curpm);
- POPEVAL(cx);
+ if (yystatus != 3) {
+ POPBLOCK(cx,PL_curpm);
+ POPEVAL(cx);
+ }
Perl_croak(aTHX_ "%sCompilation failed in regexp",
(*msg ? msg : "Unknown error\n"));
}
sv_setpvs(ERRSV, "Compilation error");
}
}
- PERL_UNUSED_VAR(newsp);
PUSHs(&PL_sv_undef);
PUTBACK;
return FALSE;
SVfARG(vnormal(PL_patchlevel)));
}
else { /* probably 'use 5.10' or 'use 5.8' */
- SV * hintsv = newSV(0);
+ SV *hintsv;
I32 second = 0;
if (av_len(lav)>=1)
second = SvIV(*av_fetch(lav,1,0));
second /= second >= 600 ? 100 : 10;
- hintsv = Perl_newSVpvf(aTHX_ "v%d.%d.%d",
- (int)first, (int)second,0);
+ hintsv = Perl_newSVpvf(aTHX_ "v%d.%d.0",
+ (int)first, (int)second);
upg_version(hintsv, TRUE);
DIE(aTHX_ "Perl %"SVf" required (did you mean %"SVf"?)"
"--this is only %"SVf", stopped",
SVfARG(vnormal(req)),
- SVfARG(vnormal(hintsv)),
+ SVfARG(vnormal(sv_2mortal(hintsv))),
SVfARG(vnormal(PL_patchlevel)));
}
}
if (PL_compiling.cop_hints_hash) {
Perl_refcounted_he_free(aTHX_ PL_compiling.cop_hints_hash);
}
- PL_compiling.cop_hints_hash = PL_curcop->cop_hints_hash;
+ if (Perl_fetch_cop_label(aTHX_ PL_curcop->cop_hints_hash, NULL, NULL)) {
+ /* The label, if present, is the first entry on the chain. So rather
+ than writing a blank label in front of it (which involves an
+ allocation), just use the next entry in the chain. */
+ PL_compiling.cop_hints_hash
+ = PL_curcop->cop_hints_hash->refcounted_he_next;
+ /* Check the assumption that this removed the label. */
+ assert(Perl_fetch_cop_label(aTHX_ PL_compiling.cop_hints_hash, NULL,
+ NULL) == NULL);
+ }
+ else
+ PL_compiling.cop_hints_hash = PL_curcop->cop_hints_hash;
if (PL_compiling.cop_hints_hash) {
HINTS_REFCNT_LOCK;
PL_compiling.cop_hints_hash->refcounted_he_refcnt++;
OP *retop;
const U8 save_flags = PL_op -> op_flags;
I32 optype;
+ SV *namesv;
POPBLOCK(cx,newpm);
POPEVAL(cx);
+ namesv = cx->blk_eval.old_namesv;
retop = cx->blk_eval.retop;
TAINT_NOT;
!(gimme == G_SCALAR ? SvTRUE(*SP) : SP > newsp))
{
/* Unassume the success we assumed earlier. */
- SV * const nsv = cx->blk_eval.old_namesv;
- (void)hv_delete(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv), G_DISCARD);
- retop = Perl_die(aTHX_ "%"SVf" did not return a true value", SVfARG(nsv));
- /* die_where() did LEAVE, or we won't be here */
+ (void)hv_delete(GvHVn(PL_incgv),
+ SvPVX_const(namesv), SvCUR(namesv),
+ G_DISCARD);
+ retop = Perl_die(aTHX_ "%"SVf" did not return a true value",
+ SVfARG(namesv));
+ /* die_unwind() did LEAVE, or we won't be here */
}
else {
LEAVE_with_name("eval");
TAINT_NOT; /* Each statement is presumed innocent */
PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
FREETMPS;
+ PERL_ASYNC_CHECK();
return NORMAL;
}
PP(pp_and)
{
dVAR; dSP;
+ PERL_ASYNC_CHECK();
if (!SvTRUE(TOPs))
RETURN;
else {
PP(pp_cond_expr)
{
dVAR; dSP;
+ PERL_ASYNC_CHECK();
if (SvTRUEx(POPs))
RETURNOP(cLOGOP->op_other);
else
{
dVAR;
I32 oldsave;
+ PERL_ASYNC_CHECK();
TAINT_NOT; /* Each statement is presumed innocent */
PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
FREETMPS;
PP(pp_or)
{
dVAR; dSP;
+ PERL_ASYNC_CHECK();
if (SvTRUE(TOPs))
RETURN;
else {
const bool is_dor = (op_type == OP_DOR || op_type == OP_DORASSIGN);
if (is_dor) {
+ PERL_ASYNC_CHECK();
sv = TOPs;
if (!sv || !SvANY(sv)) {
if (op_type == OP_DOR)
SV** const svp = av_fetch(av, PL_op->op_private, lval);
SV *sv = (svp ? *svp : &PL_sv_undef);
EXTEND(SP, 1);
- if (!lval && SvGMAGICAL(sv)) /* see note in pp_helem() */
- sv = sv_mortalcopy(sv);
+ if (!lval && SvRMAGICAL(av) && SvGMAGICAL(sv)) /* see note in pp_helem() */
+ mg_get(sv);
PUSHs(sv);
RETURN;
}
RETURN;
}
if (!(io = GvIO(gv))) {
- if ((GvEGV(gv)) && (io = GvIO(GvEGV(gv)))
+ if ((GvEGVx(gv)) && (io = GvIO(GvEGV(gv)))
&& (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar)))
goto had_magic;
if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
SV ** const svp = av_fetch(av, i, FALSE);
/* See note in pp_helem, and bug id #27839 */
SP[i+1] = svp
- ? SvGMAGICAL(*svp) ? sv_mortalcopy(*svp) : *svp
+ ? SvGMAGICAL(*svp) ? (mg_get(*svp), *svp) : *svp
: &PL_sv_undef;
}
}
for (relem = firstrelem; relem <= lastrelem; relem++) {
if ((sv = *relem)) {
TAINT_NOT; /* Each item is independent */
- *relem = sv_mortalcopy(sv);
+
+ /* Dear TODO test in t/op/sort.t, I love you.
+ (It's relying on a panic, not a "semi-panic" from newSVsv()
+ and then an assertion failure below.) */
+ if (SvIS_FREED(sv)) {
+ Perl_croak(aTHX_ "panic: attempt to copy freed scalar %p",
+ (void*)sv);
+ }
+ /* Specifically *not* sv_mortalcopy(), as that will steal TEMPs,
+ and we need a second copy of a temp here. */
+ *relem = sv_2mortal(newSVsv(sv));
}
}
}
while (relem <= lastrelem) { /* gobble up all the rest */
SV **didstore;
assert(*relem);
- sv = newSVsv(*relem);
+ sv = newSV(0);
+ sv_setsv(sv, *relem);
*(relem++) = sv;
didstore = av_store(ary,i++,sv);
if (magic) {
vivify_ref(*svp, PL_op->op_private & OPpDEREF);
}
sv = (svp ? *svp : &PL_sv_undef);
- /* This makes C<local $tied{foo} = $tied{foo}> possible.
- * Pushing the magical RHS on to the stack is useless, since
- * that magic is soon destined to be misled by the local(),
- * and thus the later pp_sassign() will fail to mg_get() the
- * old value. This should also cure problems with delayed
- * mg_get()s. GSAR 98-07-03 */
- if (!lval && SvGMAGICAL(sv))
- sv = sv_mortalcopy(sv);
+ /* Originally this did a conditional C<sv = sv_mortalcopy(sv)>; this
+ * was to make C<local $tied{foo} = $tied{foo}> possible.
+ * However, it seems no longer to be needed for that purpose, and
+ * introduced a new bug: stuff like C<while ($hash{taintedval} =~ /.../g>
+ * would loop endlessly since the pos magic is getting set on the
+ * mortal copy and lost. However, the copy has the effect of
+ * triggering the get magic, and losing it altogether made things like
+ * c<$tied{foo};> in void context no longer do get magic, which some
+ * code relied on. Also, delayed triggering of magic on @+ and friends
+ * meant the original regex may be out of scope by now. So as a
+ * compromise, do the get magic here. (The MGf_GSKIP flag will stop it
+ * being called too many times). */
+ if (!lval && SvRMAGICAL(hv) && SvGMAGICAL(sv))
+ mg_get(sv);
PUSHs(sv);
RETURN;
}
bool is_cow;
#endif
SV *nsv = NULL;
-
/* known replacement string? */
register SV *dstr = (pm->op_pmflags & PMf_CONST) ? POPs : NULL;
+
+ PERL_ASYNC_CHECK();
+
if (PL_op->op_flags & OPf_STACKED)
TARG = POPs;
else if (PL_op->op_private & OPpTARGET_MY)
DIE(aTHX_ "%s", PL_no_modify);
PUTBACK;
+ setup_match:
s = SvPV_mutable(TARG, len);
if (!SvPOKp(TARG) || SvTYPE(TARG) == SVt_PVGV)
force_on_match = 1;
r_flags | REXEC_CHECKED);
/* known replacement string? */
if (dstr) {
+
+ /* Upgrade the source if the replacement is utf8 but the source is not,
+ * but only if it matched; see
+ * http://www.nntp.perl.org/group/perl.perl5.porters/2010/04/msg158809.html
+ */
+ if (matched && DO_UTF8(dstr) && ! DO_UTF8(TARG)) {
+ const STRLEN new_len = sv_utf8_upgrade(TARG);
+
+ /* If the lengths are the same, the pattern contains only
+ * invariants, can keep going; otherwise, various internal markers
+ * could be off, so redo */
+ if (new_len != len) {
+ goto setup_match;
+ }
+ }
+
/* replacement needing upgrading? */
if (DO_UTF8(TARG) && !doutf8) {
nsv = sv_newmortal();
}
PUTBACK;
- LEAVE_with_name("sub");
+ LEAVE;
cxstack_ix--;
POPSUB(cx,sv); /* Stack values are safe: release CV and @_ ... */
PL_curpm = newpm; /* ... and pop $1 et al */
* the refcounts so the caller gets a live guy. Cannot set
* TEMP, so sv_2mortal is out of question. */
if (!CvLVALUE(cx->blk_sub.cv)) {
- LEAVE_with_name("sub");
+ LEAVE;
cxstack_ix--;
POPSUB(cx,sv);
PL_curpm = newpm;
* of a tied hash or array */
if (SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY) &&
!(SvRMAGICAL(TOPs) && mg_find(TOPs, PERL_MAGIC_tiedelem))) {
- LEAVE_with_name("sub");
+ LEAVE;
cxstack_ix--;
POPSUB(cx,sv);
PL_curpm = newpm;
}
}
else { /* Should not happen? */
- LEAVE_with_name("sub");
+ LEAVE;
cxstack_ix--;
POPSUB(cx,sv);
PL_curpm = newpm;
&& SvFLAGS(*mark) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) {
/* Might be flattened array after $#array = */
PUTBACK;
- LEAVE_with_name("sub");
+ LEAVE;
cxstack_ix--;
POPSUB(cx,sv);
PL_curpm = newpm;
}
PUTBACK;
- LEAVE_with_name("sub");
+ LEAVE;
cxstack_ix--;
POPSUB(cx,sv); /* Stack values are safe: release CV and @_ ... */
PL_curpm = newpm; /* ... and pop $1 et al */
cv = sv_2cv(sv, &stash, &gv, 0);
}
if (!cv) {
- ENTER_with_name("sub");
+ ENTER;
SAVETMPS;
goto try_autoload;
}
break;
}
- ENTER_with_name("sub");
+ ENTER;
SAVETMPS;
retry:
*(PL_stack_base + markix) = *PL_stack_sp;
PL_stack_sp = PL_stack_base + markix;
}
- LEAVE_with_name("sub");
+ LEAVE;
return NORMAL;
}
}
vivify_ref(*svp, PL_op->op_private & OPpDEREF);
}
sv = (svp ? *svp : &PL_sv_undef);
- if (!lval && SvGMAGICAL(sv)) /* see note in pp_helem() */
- sv = sv_mortalcopy(sv);
+ if (!lval && SvRMAGICAL(av) && SvGMAGICAL(sv)) /* see note in pp_helem() */
+ mg_get(sv);
PUSHs(sv);
RETURN;
}
(symptr)->previous = NULL; \
} STMT_END
+typedef union {
+ NV nv;
+ U8 bytes[sizeof(NV)];
+} NV_bytes;
+
+#if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
+typedef union {
+ long double ld;
+ U8 bytes[sizeof(long double)];
+} ld_bytes;
+#endif
+
#if PERL_VERSION >= 9
# define PERL_PACK_CAN_BYTEORDER
# define PERL_PACK_CAN_SHRIEKSIGN
#define PUSH32(utf8, cur, p) PUSH_BYTES(utf8, cur, OFF32(p), SIZE32)
/* Only to be used inside a loop (see the break) */
-#define SHIFT_VAR(utf8, s, strend, var, datumtype) \
+#define SHIFT_BYTES(utf8, s, strend, buf, len, datumtype) \
STMT_START { \
if (utf8) { \
if (!uni_to_bytes(aTHX_ &s, strend, \
- (char *) &var, sizeof(var), datumtype)) break;\
+ (char *) (buf), len, datumtype)) break; \
} else { \
- Copy(s, (char *) &var, sizeof(var), char); \
- s += sizeof(var); \
+ Copy(s, (char *) (buf), len, char); \
+ s += len; \
} \
} STMT_END
+#define SHIFT_VAR(utf8, s, strend, var, datumtype) \
+ SHIFT_BYTES(utf8, s, strend, &(var), sizeof(var), datumtype)
+
#define PUSH_VAR(utf8, aptr, var) \
PUSH_BYTES(utf8, aptr, &(var), sizeof(var))
S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const char *strend, const char **new_s )
{
dVAR; dSP;
- SV *sv;
+ SV *sv = NULL;
const I32 start_sp_offset = SP - PL_stack_base;
howlen_t howlen;
I32 checksum = 0;
}
case 'H':
case 'h': {
- char *str;
+ char *str = NULL;
/* Preliminary length estimate, acceptable for utf8 too */
if (howlen == e_star || len > (strend - s) * 2)
len = (strend - s) * 2;
- sv = sv_2mortal(newSV(len ? len : 1));
- SvPOK_on(sv);
- str = SvPVX(sv);
+ if (!checksum) {
+ sv = sv_2mortal(newSV(len ? len : 1));
+ SvPOK_on(sv);
+ str = SvPVX(sv);
+ }
if (datumtype == 'h') {
U8 bits = 0;
I32 ai32 = len;
if (s >= strend) break;
bits = uni_to_byte(aTHX_ &s, strend, datumtype);
} else bits = * (U8 *) s++;
- *str++ = PL_hexdigit[bits & 15];
+ if (!checksum)
+ *str++ = PL_hexdigit[bits & 15];
}
} else {
U8 bits = 0;
if (s >= strend) break;
bits = uni_to_byte(aTHX_ &s, strend, datumtype);
} else bits = *(U8 *) s++;
- *str++ = PL_hexdigit[(bits >> 4) & 15];
+ if (!checksum)
+ *str++ = PL_hexdigit[(bits >> 4) & 15];
}
}
- *str = '\0';
- SvCUR_set(sv, str - SvPVX_const(sv));
- XPUSHs(sv);
+ if (!checksum) {
+ *str = '\0';
+ SvCUR_set(sv, str - SvPVX_const(sv));
+ XPUSHs(sv);
+ }
break;
}
case 'C':
break;
case 'F':
while (len-- > 0) {
- NV anv;
- SHIFT_VAR(utf8, s, strend, anv, datumtype);
- DO_BO_UNPACK_N(anv, NV);
+ NV_bytes anv;
+ SHIFT_BYTES(utf8, s, strend, anv.bytes, sizeof(anv.bytes), datumtype);
+ DO_BO_UNPACK_N(anv.nv, NV);
if (!checksum)
- mPUSHn(anv);
+ mPUSHn(anv.nv);
else
- cdouble += anv;
+ cdouble += anv.nv;
}
break;
#if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
case 'D':
while (len-- > 0) {
- long double aldouble;
- SHIFT_VAR(utf8, s, strend, aldouble, datumtype);
- DO_BO_UNPACK_N(aldouble, long double);
+ ld_bytes aldouble;
+ SHIFT_BYTES(utf8, s, strend, aldouble.bytes, sizeof(aldouble.bytes), datumtype);
+ DO_BO_UNPACK_N(aldouble.ld, long double);
if (!checksum)
- mPUSHn(aldouble);
+ mPUSHn(aldouble.ld);
else
- cdouble += aldouble;
+ cdouble += aldouble.ld;
}
break;
#endif
case 'u':
- {
+ if (!checksum) {
const STRLEN l = (STRLEN) (strend - s) * 3 / 4;
sv = sv_2mortal(newSV(l));
if (l) SvPOK_on(sv);
hunk[0] = (char)((a << 2) | (b >> 4));
hunk[1] = (char)((b << 4) | (c >> 2));
hunk[2] = (char)((c << 6) | d);
- sv_catpvn(sv, hunk, (len > 3) ? 3 : len);
+ if (!checksum)
+ sv_catpvn(sv, hunk, (len > 3) ? 3 : len);
len -= 3;
}
if (s < strend) {
hunk[0] = (char)((a << 2) | (b >> 4));
hunk[1] = (char)((b << 4) | (c >> 2));
hunk[2] = (char)((c << 6) | d);
- sv_catpvn(sv, hunk, (len > 3) ? 3 : len);
+ if (!checksum)
+ sv_catpvn(sv, hunk, (len > 3) ? 3 : len);
len -= 3;
}
if (*s == '\n')
s += 2;
}
}
- XPUSHs(sv);
+ if (!checksum)
+ XPUSHs(sv);
break;
}
}
break;
case 'F': {
- NV anv;
+ NV_bytes anv;
Zero(&anv, 1, NV); /* can be long double with unused bits */
while (len-- > 0) {
fromstr = NEXTFROM;
- anv = SvNV(fromstr);
+ anv.nv = SvNV(fromstr);
DO_BO_PACK_N(anv, NV);
- PUSH_VAR(utf8, cur, anv);
+ PUSH_BYTES(utf8, cur, anv.bytes, sizeof(anv.bytes));
}
break;
}
#if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
case 'D': {
- long double aldouble;
+ ld_bytes aldouble;
/* long doubles can have unused bits, which may be nonzero */
Zero(&aldouble, 1, long double);
while (len-- > 0) {
fromstr = NEXTFROM;
- aldouble = (long double)SvNV(fromstr);
+ aldouble.ld = (long double)SvNV(fromstr);
DO_BO_PACK_N(aldouble, long double);
- PUSH_VAR(utf8, cur, aldouble);
+ PUSH_BYTES(utf8, cur, aldouble.bytes, sizeof(aldouble.bytes));
}
break;
}
if (!PL_sortcop) {
if (priv & OPpSORT_NUMERIC) {
if (priv & OPpSORT_INTEGER) {
- if (!SvIOK(*p1)) {
- if (SvAMAGIC(*p1))
- overloading = 1;
- else
- (void)sv_2iv(*p1);
- }
+ if (!SvIOK(*p1))
+ (void)sv_2iv_flags(*p1, SV_GMAGIC|SV_SKIP_OVERLOAD);
}
else {
- if (!SvNSIOK(*p1)) {
- if (SvAMAGIC(*p1))
- overloading = 1;
- else
- (void)sv_2nv(*p1);
- }
+ if (!SvNSIOK(*p1))
+ (void)sv_2nv_flags(*p1, SV_GMAGIC|SV_SKIP_OVERLOAD);
if (all_SIVs && !SvSIOK(*p1))
all_SIVs = 0;
}
}
else {
- if (!SvPOK(*p1)) {
- if (SvAMAGIC(*p1))
- overloading = 1;
- else
- (void)sv_2pv_flags(*p1, 0,
- SV_GMAGIC|SV_CONST_RETURN);
- }
+ if (!SvPOK(*p1))
+ (void)sv_2pv_flags(*p1, 0,
+ SV_GMAGIC|SV_CONST_RETURN|SV_SKIP_OVERLOAD);
}
+ if (SvAMAGIC(*p1))
+ overloading = 1;
}
p1++;
}
PP(pp_warn)
{
dVAR; dSP; dMARK;
- SV *tmpsv;
- const char *tmps;
+ SV *exsv;
+ const char *pv;
STRLEN len;
if (SP - MARK > 1) {
dTARGET;
do_join(TARG, &PL_sv_no, MARK, SP);
- tmpsv = TARG;
+ exsv = TARG;
SP = MARK + 1;
}
else if (SP == MARK) {
- tmpsv = &PL_sv_no;
+ exsv = &PL_sv_no;
EXTEND(SP, 1);
SP = MARK + 1;
}
else {
- tmpsv = TOPs;
- }
- tmps = SvPV_const(tmpsv, len);
- if ((!tmps || !len) && PL_errgv) {
- SV * const error = ERRSV;
- SvUPGRADE(error, SVt_PV);
- if (SvPOK(error) && SvCUR(error))
- sv_catpvs(error, "\t...caught");
- tmpsv = error;
- tmps = SvPV_const(tmpsv, len);
+ exsv = TOPs;
}
- if (!tmps || !len)
- tmpsv = newSVpvs_flags("Warning: something's wrong", SVs_TEMP);
- Perl_warn(aTHX_ "%"SVf, SVfARG(tmpsv));
+ if (SvROK(exsv) || (pv = SvPV_const(exsv, len), len)) {
+ /* well-formed exception supplied */
+ }
+ else if (SvROK(ERRSV)) {
+ exsv = ERRSV;
+ }
+ else if (SvPOK(ERRSV) && SvCUR(ERRSV)) {
+ exsv = sv_mortalcopy(ERRSV);
+ sv_catpvs(exsv, "\t...caught");
+ }
+ else {
+ exsv = newSVpvs_flags("Warning: something's wrong", SVs_TEMP);
+ }
+ warn_sv(exsv);
RETSETYES;
}
PP(pp_die)
{
dVAR; dSP; dMARK;
- const char *tmps;
- SV *tmpsv;
+ SV *exsv;
+ const char *pv;
STRLEN len;
- bool multiarg = 0;
#ifdef VMS
VMSISH_HUSHED = VMSISH_HUSHED || (PL_op->op_private & OPpHUSH_VMSISH);
#endif
if (SP - MARK != 1) {
dTARGET;
do_join(TARG, &PL_sv_no, MARK, SP);
- tmpsv = TARG;
- tmps = SvPV_const(tmpsv, len);
- multiarg = 1;
+ exsv = TARG;
SP = MARK + 1;
}
else {
- tmpsv = TOPs;
- tmps = SvROK(tmpsv) ? (const char *)NULL : SvPV_const(tmpsv, len);
- }
- if (!tmps || !len) {
- SV * const error = ERRSV;
- SvUPGRADE(error, SVt_PV);
- if (multiarg ? SvROK(error) : SvROK(tmpsv)) {
- if (!multiarg)
- SvSetSV(error,tmpsv);
- else if (sv_isobject(error)) {
- HV * const stash = SvSTASH(SvRV(error));
- GV * const gv = gv_fetchmethod(stash, "PROPAGATE");
- if (gv) {
- SV * const file = sv_2mortal(newSVpv(CopFILE(PL_curcop),0));
- SV * const line = sv_2mortal(newSVuv(CopLINE(PL_curcop)));
- EXTEND(SP, 3);
- PUSHMARK(SP);
- PUSHs(error);
- PUSHs(file);
- PUSHs(line);
- PUTBACK;
- call_sv(MUTABLE_SV(GvCV(gv)),
- G_SCALAR|G_EVAL|G_KEEPERR);
- sv_setsv(error,*PL_stack_sp--);
- }
+ exsv = TOPs;
+ }
+
+ if (SvROK(exsv) || (pv = SvPV_const(exsv, len), len)) {
+ /* well-formed exception supplied */
+ }
+ else if (SvROK(ERRSV)) {
+ exsv = ERRSV;
+ if (sv_isobject(exsv)) {
+ HV * const stash = SvSTASH(SvRV(exsv));
+ GV * const gv = gv_fetchmethod(stash, "PROPAGATE");
+ if (gv) {
+ SV * const file = sv_2mortal(newSVpv(CopFILE(PL_curcop),0));
+ SV * const line = sv_2mortal(newSVuv(CopLINE(PL_curcop)));
+ EXTEND(SP, 3);
+ PUSHMARK(SP);
+ PUSHs(exsv);
+ PUSHs(file);
+ PUSHs(line);
+ PUTBACK;
+ call_sv(MUTABLE_SV(GvCV(gv)),
+ G_SCALAR|G_EVAL|G_KEEPERR);
+ exsv = sv_mortalcopy(*PL_stack_sp--);
}
- DIE(aTHX_ NULL);
- }
- else {
- if (SvPOK(error) && SvCUR(error))
- sv_catpvs(error, "\t...propagated");
- tmpsv = error;
- if (SvOK(tmpsv))
- tmps = SvPV_const(tmpsv, len);
- else
- tmps = NULL;
}
}
- if (!tmps || !len)
- tmpsv = newSVpvs_flags("Died", SVs_TEMP);
-
- DIE(aTHX_ "%"SVf, SVfARG(tmpsv));
+ else if (SvPOK(ERRSV) && SvCUR(ERRSV)) {
+ exsv = sv_mortalcopy(ERRSV);
+ sv_catpvs(exsv, "\t...propagated");
+ }
+ else {
+ exsv = newSVpvs_flags("Died", SVs_TEMP);
+ }
+ die_sv(exsv);
RETURN;
}
dVAR; dSP; dTARGET;
HV *hv;
GV * const newdefout = (PL_op->op_private > 0) ? (MUTABLE_GV(POPs)) : NULL;
- GV * egv = GvEGV(PL_defoutgv);
+ GV * egv = GvEGVx(PL_defoutgv);
if (!egv)
egv = PL_defoutgv;
- hv = GvSTASH(egv);
+ hv = isGV_with_GP(egv) ? GvSTASH(egv) : NULL;
if (! hv)
XPUSHs(&PL_sv_undef);
else {
if (MAXARG)
gv = PL_last_in_gv = MUTABLE_GV(POPs); /* eof(FH) */
else if (PL_op->op_flags & OPf_SPECIAL)
- gv = PL_last_in_gv = GvEGV(PL_argvgv); /* eof() - ARGV magic */
+ gv = PL_last_in_gv = GvEGVx(PL_argvgv); /* eof() - ARGV magic */
else
gv = PL_last_in_gv; /* eof */
#endif /* HAS_TIMES */
}
+/* The 32 bit int year limits the times we can represent to these
+ boundaries with a few days wiggle room to account for time zone
+ offsets
+*/
+/* Sat Jan 3 00:00:00 -2147481748 */
+#define TIME_LOWER_BOUND -67768100567755200.0
+/* Sun Dec 29 12:00:00 2147483647 */
+#define TIME_UPPER_BOUND 67767976233316800.0
+
PP(pp_gmtime)
{
dVAR;
when = (Time64_T)now;
}
else {
- double input = Perl_floor(POPn);
+ NV input = Perl_floor(POPn);
when = (Time64_T)input;
if (when != input) {
Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
- "%s(%.0f) too large", opname, input);
+ "%s(%.0" NVff ") too large", opname, input);
}
}
- if (PL_op->op_type == OP_LOCALTIME)
- err = S_localtime64_r(&when, &tmbuf);
- else
- err = S_gmtime64_r(&when, &tmbuf);
+ if ( TIME_LOWER_BOUND > when ) {
+ Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
+ "%s(%.0" NVff ") too small", opname, when);
+ err = NULL;
+ }
+ else if( when > TIME_UPPER_BOUND ) {
+ Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
+ "%s(%.0" NVff ") too large", opname, when);
+ err = NULL;
+ }
+ else {
+ if (PL_op->op_type == OP_LOCALTIME)
+ err = S_localtime64_r(&when, &tmbuf);
+ else
+ err = S_gmtime64_r(&when, &tmbuf);
+ }
if (err == NULL) {
/* XXX %lld broken for quads */
Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
- "%s(%.0f) failed", opname, (double)when);
+ "%s(%.0" NVff ") failed", opname, when);
}
if (GIMME != G_ARRAY) { /* scalar context */
#define PERL_ARGS_ASSERT_SET_CONTEXT \
assert(t)
+PERL_CALLCONV I32 Perl_regcurly(const char *s)
+ __attribute__warn_unused_result__
+ __attribute__pure__
+ __attribute__nonnull__(1);
+#define PERL_ARGS_ASSERT_REGCURLY \
+ assert(s)
+
END_EXTERN_C
__attribute__warn_unused_result__;
PERL_CALLCONV PERL_CONTEXT* Perl_create_eval_scope(pTHX_ U32 flags);
+PERL_CALLCONV void Perl_croak_sv(pTHX_ SV *baseex)
+ __attribute__noreturn__
+ __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_CROAK_SV \
+ assert(baseex)
+
PERL_CALLCONV void Perl_croak(pTHX_ const char* pat, ...)
__attribute__noreturn__
__attribute__format__null_ok__(__printf__,pTHX_1,pTHX_2);
assert(to); assert(toend); assert(from); assert(fromend); assert(retlen)
PERL_CALLCONV void Perl_delete_eval_scope(pTHX);
+PERL_CALLCONV OP* Perl_die_sv(pTHX_ SV *baseex)
+ __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_DIE_SV \
+ assert(baseex)
+
PERL_CALLCONV OP* Perl_die(pTHX_ const char* pat, ...)
__attribute__format__null_ok__(__printf__,pTHX_1,pTHX_2);
-#if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
-STATIC OP* S_vdie(pTHX_ const char* pat, va_list* args);
-#endif
-PERL_CALLCONV void Perl_die_where(pTHX_ SV* msv)
- __attribute__noreturn__;
+PERL_CALLCONV void Perl_die_unwind(pTHX_ SV* msv)
+ __attribute__noreturn__
+ __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_DIE_UNWIND \
+ assert(msv)
PERL_CALLCONV void Perl_dounwind(pTHX_ I32 cxix);
/* PERL_CALLCONV bool Perl_do_aexec(pTHX_ SV* really, SV** mark, SV** sp)
PERL_CALLCONV void Perl_lex_start(pTHX_ SV* line, PerlIO *rsfp, bool new_filter);
PERL_CALLCONV bool Perl_lex_bufutf8(pTHX);
PERL_CALLCONV char* Perl_lex_grow_linestr(pTHX_ STRLEN len);
-PERL_CALLCONV void Perl_lex_stuff_pvn(pTHX_ char* pv, STRLEN len, U32 flags)
+PERL_CALLCONV void Perl_lex_stuff_pvn(pTHX_ const char* pv, STRLEN len, U32 flags)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_LEX_STUFF_PVN \
assert(pv)
#define PERL_ARGS_ASSERT_GROK_BIN \
assert(start); assert(len_p); assert(flags)
+PERL_CALLCONV char Perl_grok_bslash_c(pTHX_ const char source, const bool output_warning)
+ __attribute__warn_unused_result__;
+
PERL_CALLCONV UV Perl_grok_hex(pTHX_ const char* start, STRLEN* len_p, I32* flags, NV *result)
__attribute__nonnull__(pTHX_1)
__attribute__nonnull__(pTHX_2)
#define PERL_ARGS_ASSERT_MAGIC_WIPEPACK \
assert(sv); assert(mg)
+PERL_CALLCONV SV* Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags, U32 argc, ...)
+ __attribute__nonnull__(pTHX_1)
+ __attribute__nonnull__(pTHX_2)
+ __attribute__nonnull__(pTHX_3);
+#define PERL_ARGS_ASSERT_MAGIC_METHCALL \
+ assert(sv); assert(mg); assert(meth)
+
PERL_CALLCONV void Perl_markstack_grow(pTHX);
#if defined(USE_LOCALE_COLLATE)
PERL_CALLCONV int Perl_magic_setcollxfrm(pTHX_ SV* sv, MAGIC* mg)
#define PERL_ARGS_ASSERT_MESS \
assert(pat)
+PERL_CALLCONV SV* Perl_mess_sv(pTHX_ SV* basemsg, bool consume)
+ __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_MESS_SV \
+ assert(basemsg)
+
PERL_CALLCONV SV* Perl_vmess(pTHX_ const char* pat, va_list* args)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_VMESS \
#define PERL_ARGS_ASSERT_SCAN_VERSION \
assert(s); assert(rv)
+PERL_CALLCONV const char* Perl_prescan_version(pTHX_ const char *s, bool strict, const char** errstr, bool *sqv, int *ssaw_decimal, int *swidth, bool *salpha)
+ __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_PRESCAN_VERSION \
+ assert(s)
+
PERL_CALLCONV SV* Perl_new_version(pTHX_ SV *ver)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_NEW_VERSION \
#if defined(PERL_USES_PL_PIDSTATUS) && defined(PERL_IN_UTIL_C)
STATIC void S_pidgone(pTHX_ Pid_t pid, int status);
#endif
-PERL_CALLCONV void Perl_pmflag(pTHX_ U32 *pmfl, int ch)
- __attribute__deprecated__
- __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_PMFLAG \
- assert(pmfl)
-
PERL_CALLCONV OP* Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
__attribute__nonnull__(pTHX_1)
__attribute__nonnull__(pTHX_2);
/* PERL_CALLCONV IV Perl_sv_2iv(pTHX_ SV *sv); */
PERL_CALLCONV IV Perl_sv_2iv_flags(pTHX_ SV *const sv, const I32 flags);
PERL_CALLCONV SV* Perl_sv_2mortal(pTHX_ SV *const sv);
-PERL_CALLCONV NV Perl_sv_2nv(pTHX_ SV *const sv);
+PERL_CALLCONV NV Perl_sv_2nv_flags(pTHX_ SV *const sv, const I32 flags);
PERL_CALLCONV SV* Perl_sv_2num(pTHX_ SV *const sv)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_SV_2NUM \
#define PERL_ARGS_ASSERT_SV_POS_U2B \
assert(offsetp)
+PERL_CALLCONV STRLEN Perl_sv_pos_u2b_flags(pTHX_ SV *const sv, STRLEN uoffset, STRLEN *const lenp, U32 flags)
+ __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_SV_POS_U2B_FLAGS \
+ assert(sv)
+
PERL_CALLCONV void Perl_sv_pos_b2u(pTHX_ SV *const sv, I32 *const offsetp)
__attribute__nonnull__(pTHX_2);
#define PERL_ARGS_ASSERT_SV_POS_B2U \
PERL_CALLCONV void Perl_report_evil_fh(pTHX_ const GV *gv, const IO *io, I32 op);
PERL_CALLCONV void Perl_report_uninit(pTHX_ const SV *uninit_sv);
+PERL_CALLCONV void Perl_warn_sv(pTHX_ SV *baseex)
+ __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_WARN_SV \
+ assert(baseex)
+
PERL_CALLCONV void Perl_warn(pTHX_ const char* pat, ...)
__attribute__format__(__printf__,pTHX_1,pTHX_2)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_PTR_TABLE_SPLIT \
assert(tbl)
-PERL_CALLCONV void Perl_ptr_table_clear(pTHX_ PTR_TBL_t *const tbl);
+PERL_CALLCONV void Perl_ptr_table_clear(pTHX_ PTR_TBL_t *const tbl)
+ __attribute__deprecated__;
+
PERL_CALLCONV void Perl_ptr_table_free(pTHX_ PTR_TBL_t *const tbl);
#if defined(USE_ITHREADS)
# if defined(HAVE_INTERP_INTERN)
#define PERL_ARGS_ASSERT_MAGIC_METHPACK \
assert(sv); assert(mg); assert(meth)
-STATIC int S_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, I32 f, int n, SV *val)
+STATIC SV* S_magic_methcall1(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags, int n, SV *val)
__attribute__nonnull__(pTHX_1)
__attribute__nonnull__(pTHX_2)
__attribute__nonnull__(pTHX_3);
-#define PERL_ARGS_ASSERT_MAGIC_METHCALL \
+#define PERL_ARGS_ASSERT_MAGIC_METHCALL1 \
assert(sv); assert(mg); assert(meth)
STATIC void S_restore_magic(pTHX_ const void *p);
#define PERL_ARGS_ASSERT_REGCLASS \
assert(pRExC_state)
-STATIC I32 S_regcurly(const char *s)
- __attribute__warn_unused_result__
- __attribute__nonnull__(1);
-#define PERL_ARGS_ASSERT_REGCURLY \
- assert(s)
-
STATIC regnode* S_reg_node(pTHX_ struct RExC_state_t *pRExC_state, U8 op)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_REG_NODE \
#define PERL_ARGS_ASSERT_FORCE_VERSION \
assert(s)
+STATIC char* S_force_strict_version(pTHX_ char *s)
+ __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_FORCE_STRICT_VERSION \
+ assert(s)
+
STATIC char* S_force_word(pTHX_ char *start, int token, int check_keyword, int allow_pack, int allow_tick)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_FORCE_WORD \
assert(cop)
STATIC SV* S_mess_alloc(pTHX);
-STATIC SV * S_vdie_croak_common(pTHX_ const char *pat, va_list *args);
-STATIC bool S_vdie_common(pTHX_ SV *message, bool warn);
+STATIC SV * S_with_queued_errors(pTHX_ SV *ex)
+ __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_WITH_QUEUED_ERRORS \
+ assert(ex)
+
+STATIC bool S_invoke_exception_hook(pTHX_ SV *ex, bool warn);
STATIC char * S_write_no_mem(pTHX)
__attribute__noreturn__;
I32 orig_utf8; /* whether the pattern was originally in utf8 */
/* XXX use this for future optimisation of case
* where pattern must be upgraded to utf8. */
- HV *charnames; /* cache of named sequences */
HV *paren_names; /* Paren names */
regnode **recurse; /* Recurse regops */
#define RExC_seen_evals (pRExC_state->seen_evals)
#define RExC_utf8 (pRExC_state->utf8)
#define RExC_orig_utf8 (pRExC_state->orig_utf8)
-#define RExC_charnames (pRExC_state->charnames)
#define RExC_open_parens (pRExC_state->open_parens)
#define RExC_close_parens (pRExC_state->close_parens)
#define RExC_opend (pRExC_state->opend)
U32 state;
SV *sv=sv_newmortal();
int colwidth= widecharmap ? 6 : 4;
+ U16 word;
GET_RE_DEBUG_FLAGS_DECL;
PERL_ARGS_ASSERT_DUMP_TRIE;
}
PerlIO_printf( Perl_debug_log, "\n" );
}
+ PerlIO_printf(Perl_debug_log, "%*sword_info N:(prev,len)=", (int)depth*2, "");
+ for (word=1; word <= trie->wordcount; word++) {
+ PerlIO_printf(Perl_debug_log, " %d:(%d,%d)",
+ (int)word, (int)(trie->wordinfo[word].prev),
+ (int)(trie->wordinfo[word].len));
+ }
+ PerlIO_printf(Perl_debug_log, "\n" );
}
/*
Dumps a fully constructed but uncompressed trie in list form.
#endif
+
/* make_trie(startbranch,first,last,tail,word_count,flags,depth)
startbranch: the first branch in the whole branch sequence
first : start branch of sequence of branch-exact nodes.
U16 dupe= trie->states[ state ].wordnum; \
regnode * const noper_next = regnext( noper ); \
\
- if (trie->wordlen) \
- trie->wordlen[ curword ] = wordlen; \
DEBUG_r({ \
/* store the word for dumping */ \
SV* tmp; \
}); \
\
curword++; \
+ trie->wordinfo[curword].prev = 0; \
+ trie->wordinfo[curword].len = wordlen; \
+ trie->wordinfo[curword].accept = state; \
\
if ( noper_next < tail ) { \
if (!trie->jump) \
} \
\
if ( dupe ) { \
- /* So it's a dupe. This means we need to maintain a */\
- /* linked-list from the first to the next. */\
- /* we only allocate the nextword buffer when there */\
- /* a dupe, so first time we have to do the allocation */\
- if (!trie->nextword) \
- trie->nextword = (U16 *) \
- PerlMemShared_calloc( word_count + 1, sizeof(U16)); \
- while ( trie->nextword[dupe] ) \
- dupe= trie->nextword[dupe]; \
- trie->nextword[dupe]= curword; \
+ /* It's a dupe. Pre-insert into the wordinfo[].prev */\
+ /* chain, so that when the bits of chain are later */\
+ /* linked together, the dups appear in the chain */\
+ trie->wordinfo[curword].prev = trie->wordinfo[dupe].prev; \
+ trie->wordinfo[dupe].prev = curword; \
} else { \
/* we haven't inserted this word yet. */ \
trie->states[ state ].wordnum = curword; \
regnode *jumper = NULL;
regnode *nextbranch = NULL;
regnode *convert = NULL;
+ U32 *prev_states; /* temp array mapping each state to previous one */
/* we just use folder as a flag in utf8 */
const U8 * const folder = ( flags == EXACTF
? PL_fold
trie->charmap = (U16 *) PerlMemShared_calloc( 256, sizeof(U16) );
if (!(UTF && folder))
trie->bitmap = (char *) PerlMemShared_calloc( ANYOF_BITMAP_SIZE, 1 );
+ trie->wordinfo = (reg_trie_wordinfo *) PerlMemShared_calloc(
+ trie->wordcount+1, sizeof(reg_trie_wordinfo));
+
DEBUG_r({
trie_words = newAV();
});
(int)TRIE_CHARCOUNT(trie), trie->uniquecharcount,
(int)trie->minlen, (int)trie->maxlen )
);
- trie->wordlen = (U32 *) PerlMemShared_calloc( word_count, sizeof(U32) );
/*
We now know what we are dealing with in terms of unique chars and
*/
+ Newx(prev_states, TRIE_CHARCOUNT(trie) + 2, U32);
+ prev_states[1] = 0;
+
if ( (IV)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1) > SvIV(re_trie_maxbuff) ) {
/*
Second Pass -- Array Of Lists Representation
}
if ( ! newstate ) {
newstate = next_alloc++;
+ prev_states[newstate] = state;
TRIE_LIST_PUSH( state, charid, newstate );
transcount++;
}
if ( !trie->trans[ state + charid ].next ) {
trie->trans[ state + charid ].next = next_alloc;
trie->trans[ state ].check++;
+ prev_states[TRIE_NODENUM(next_alloc)]
+ = TRIE_NODENUM(state);
next_alloc += trie->uniquecharcount;
}
state = trie->trans[ state + charid ].next;
PerlMemShared_realloc( trie->trans, trie->lasttrans
* sizeof(reg_trie_trans) );
- /* and now dump out the compressed format */
- DEBUG_TRIE_COMPILE_r(dump_trie(trie, widecharmap, revcharmap, depth+1));
-
{ /* Modify the program and insert the new TRIE node*/
U8 nodetype =(U8)(flags & 0xFF);
char *str=NULL;
break;
}
}
+ trie->prefixlen = (state-1);
if (str) {
regnode *n = convert+NODE_SZ_STR(convert);
NEXT_OFF(convert) = NODE_SZ_STR(convert);
Set_Node_Offset_Length(convert,mjd_offset,mjd_nodelen);
});
} /* end node insert */
+
+ /* Finish populating the prev field of the wordinfo array. Walk back
+ * from each accept state until we find another accept state, and if
+ * so, point the first word's .prev field at the second word. If the
+ * second already has a .prev field set, stop now. This will be the
+ * case either if we've already processed that word's accept state,
+ * or that that state had multiple words, and the overspill words
+ * were already linked up earlier.
+ */
+ {
+ U16 word;
+ U32 state;
+ U16 prev;
+
+ for (word=1; word <= trie->wordcount; word++) {
+ prev = 0;
+ if (trie->wordinfo[word].prev)
+ continue;
+ state = trie->wordinfo[word].accept;
+ while (state) {
+ state = prev_states[state];
+ if (!state)
+ break;
+ prev = trie->states[state].wordnum;
+ if (prev)
+ break;
+ }
+ trie->wordinfo[word].prev = prev;
+ }
+ Safefree(prev_states);
+ }
+
+
+ /* and now dump out the compressed format */
+ DEBUG_TRIE_COMPILE_r(dump_trie(trie, widecharmap, revcharmap, depth+1));
+
RExC_rxi->data->data[ data_slot + 1 ] = (void*)widecharmap;
#ifdef DEBUGGING
RExC_rxi->data->data[ data_slot + TRIE_WORDS_OFFSET ] = (void*)trie_words;
RExC_size = 0L;
RExC_emit = &PL_regdummy;
RExC_whilem_seen = 0;
- RExC_charnames = NULL;
RExC_open_parens = NULL;
RExC_close_parens = NULL;
RExC_opend = NULL;
recognized '\N' and needs to handle the rest. RExC_parse is
expected to point at the first char following the N at the time
of the call.
+
+ The \N may be inside (indicated by valuep not being NULL) or outside a
+ character class.
+
+ \N may begin either a named sequence, or if outside a character class, mean
+ to match a non-newline. For non single-quoted regexes, the tokenizer has
+ attempted to decide which, and in the case of a named sequence converted it
+ into one of the forms: \N{} (if the sequence is null), or \N{U+c1.c2...},
+ where c1... are the characters in the sequence. For single-quoted regexes,
+ the tokenizer passes the \N sequence through unchanged; this code will not
+ attempt to determine this nor expand those. The net effect is that if the
+ beginning of the passed-in pattern isn't '{U+' or there is no '}', it
+ signals that this \N occurrence means to match a non-newline.
+
+ Only the \N{U+...} form should occur in a character class, for the same
+ reason that '.' inside a character class means to just match a period: it
+ just doesn't make sense.
If valuep is non-null then it is assumed that we are parsing inside
of a charclass definition and the first codepoint in the resolved
string is returned via *valuep and the routine will return NULL.
In this mode if a multichar string is returned from the charnames
- handler a warning will be issued, and only the first char in the
+ handler, a warning will be issued, and only the first char in the
sequence will be examined. If the string returned is zero length
then the value of *valuep is undefined and NON-NULL will
be returned to indicate failure. (This will NOT be a valid pointer
to a regnode.)
- If valuep is null then it is assumed that we are parsing normal text
- and inserts a new EXACT node into the program containing the resolved
- string and returns a pointer to the new node. If the string is
- zerolength a NOTHING node is emitted.
+ If valuep is null then it is assumed that we are parsing normal text and a
+ new EXACT node is inserted into the program containing the resolved string,
+ and a pointer to the new node is returned. But if the string is zero length
+ a NOTHING node is emitted instead.
On success RExC_parse is set to the char following the endbrace.
- Parsing failures will generate a fatal errorvia vFAIL(...)
-
- NOTE: We cache all results from the charnames handler locally in
- the RExC_charnames hash (created on first use) to prevent a charnames
- handler from playing silly-buggers and returning a short string and
- then a long string for a given pattern. Since the regexp program
- size is calculated during an initial parse this would result
- in a buffer overrun so we cache to prevent the charname result from
- changing during the course of the parse.
-
+ Parsing failures will generate a fatal error via vFAIL(...)
*/
STATIC regnode *
S_reg_namedseq(pTHX_ RExC_state_t *pRExC_state, UV *valuep, I32 *flagp)
{
- char * name; /* start of the content of the name */
- char * endbrace; /* endbrace following the name */
- SV *sv_str = NULL;
- SV *sv_name = NULL;
- STRLEN len; /* this has various purposes throughout the code */
- bool cached = 0; /* if this is true then we shouldn't refcount dev sv_str */
+ char * endbrace; /* '}' following the name */
regnode *ret = NULL;
+#ifdef DEBUGGING
+ char* parse_start = RExC_parse - 2; /* points to the '\N' */
+#endif
+ char* p;
+
+ GET_RE_DEBUG_FLAGS_DECL;
PERL_ARGS_ASSERT_REG_NAMEDSEQ;
+
+ GET_RE_DEBUG_FLAGS;
+
+ /* The [^\n] meaning of \N ignores spaces and comments under the /x
+ * modifier. The other meaning does not */
+ p = (RExC_flags & RXf_PMf_EXTENDED)
+ ? regwhite( pRExC_state, RExC_parse )
+ : RExC_parse;
- if (*RExC_parse != '{' ||
- (*RExC_parse == '{' && RExC_parse[1]
- && strchr("0123456789", RExC_parse[1])))
- {
- GET_RE_DEBUG_FLAGS_DECL;
- if (valuep)
+ /* Disambiguate between \N meaning a named character versus \N meaning
+ * [^\n]. The former is assumed when it can't be the latter. */
+ if (*p != '{' || regcurly(p)) {
+ RExC_parse = p;
+ if (valuep) {
/* no bare \N in a charclass */
- vFAIL("Missing braces on \\N{}");
- GET_RE_DEBUG_FLAGS;
+ vFAIL("\\N in a character class must be a named character: \\N{...}");
+ }
nextchar(pRExC_state);
ret = reg_node(pRExC_state, REG_ANY);
*flagp |= HASWIDTH|SIMPLE;
Set_Node_Length(ret, 1); /* MJD */
return ret;
}
- name = RExC_parse+1;
- endbrace = strchr(RExC_parse, '}');
- if ( ! endbrace ) {
- RExC_parse++;
- vFAIL("Missing right brace on \\N{}");
- }
- RExC_parse = endbrace + 1;
-
-
- /* RExC_parse points at the beginning brace,
- endbrace points at the last */
- if ( name[0]=='U' && name[1]=='+' ) {
- /* its a "Unicode hex" notation {U+89AB} */
- I32 fl = PERL_SCAN_ALLOW_UNDERSCORES
- | PERL_SCAN_DISALLOW_PREFIX
- | (SIZE_ONLY ? PERL_SCAN_SILENT_ILLDIGIT : 0);
- UV cp;
- len = (STRLEN)(endbrace - name - 2);
- cp = grok_hex(name + 2, &len, &fl, NULL);
- if ( len != (STRLEN)(endbrace - name - 2) ) {
- cp = 0xFFFD;
- }
- if ( valuep ) {
- if (cp > 0xff) RExC_utf8 = 1;
- *valuep = cp;
- return NULL;
- }
- /* Need to convert to utf8 if either: won't fit into a byte, or the re
- * is going to be in utf8 and the representation changes under utf8. */
- if (cp > 0xff || (RExC_utf8 && ! UNI_IS_INVARIANT(cp))) {
- U8 string[UTF8_MAXBYTES+1];
- U8 *tmps;
- RExC_utf8 = 1;
- tmps = uvuni_to_utf8(string, cp);
- sv_str = newSVpvn_utf8((char*)string, tmps - string, TRUE);
- } else { /* Otherwise, no need for utf8, can skip that step */
- char string;
- string = (char)cp;
- sv_str= newSVpvn(&string, 1);
+ /* Here, we have decided it should be a named sequence */
+
+ /* The test above made sure that the next real character is a '{', but
+ * under the /x modifier, it could be separated by space (or a comment and
+ * \n) and this is not allowed (for consistency with \x{...} and the
+ * tokenizer handling of \N{NAME}). */
+ if (*RExC_parse != '{') {
+ vFAIL("Missing braces on \\N{}");
+ }
+
+ RExC_parse++; /* Skip past the '{' */
+
+ if (! (endbrace = strchr(RExC_parse, '}')) /* no trailing brace */
+ || ! (endbrace == RExC_parse /* nothing between the {} */
+ || (endbrace - RExC_parse >= 2 /* U+ (bad hex is checked below */
+ && strnEQ(RExC_parse, "U+", 2)))) /* for a better error msg) */
+ {
+ if (endbrace) RExC_parse = endbrace; /* position msg's '<--HERE' */
+ vFAIL("\\N{NAME} must be resolved by the lexer");
+ }
+
+ if (endbrace == RExC_parse) { /* empty: \N{} */
+ if (! valuep) {
+ RExC_parse = endbrace + 1;
+ return reg_node(pRExC_state,NOTHING);
}
- } else {
- /* fetch the charnames handler for this scope */
- HV * const table = GvHV(PL_hintgv);
- SV **cvp= table ?
- hv_fetchs(table, "charnames", FALSE) :
- NULL;
- SV *cv= cvp ? *cvp : NULL;
- HE *he_str;
- int count;
- /* create an SV with the name as argument */
- sv_name = newSVpvn(name, endbrace - name);
-
- if (!table || !(PL_hints & HINT_LOCALIZE_HH)) {
- vFAIL2("Constant(\\N{%" SVf "}) unknown: "
- "(possibly a missing \"use charnames ...\")",
- SVfARG(sv_name));
- }
- if (!cvp || !SvOK(*cvp)) { /* when $^H{charnames} = undef; */
- vFAIL2("Constant(\\N{%" SVf "}): "
- "$^H{charnames} is not defined", SVfARG(sv_name));
- }
-
-
-
- if (!RExC_charnames) {
- /* make sure our cache is allocated */
- RExC_charnames = newHV();
- sv_2mortal(MUTABLE_SV(RExC_charnames));
- }
- /* see if we have looked this one up before */
- he_str = hv_fetch_ent( RExC_charnames, sv_name, 0, 0 );
- if ( he_str ) {
- sv_str = HeVAL(he_str);
- cached = 1;
- } else {
- dSP ;
- ENTER ;
- SAVETMPS ;
- PUSHMARK(SP) ;
-
- XPUSHs(sv_name);
-
- PUTBACK ;
-
- count= call_sv(cv, G_SCALAR);
-
- if (count == 1) { /* XXXX is this right? dmq */
- sv_str = POPs;
- SvREFCNT_inc_simple_void(sv_str);
- }
-
- SPAGAIN ;
- PUTBACK ;
- FREETMPS ;
- LEAVE ;
-
- if ( !sv_str || !SvOK(sv_str) ) {
- vFAIL2("Constant(\\N{%" SVf "}): Call to &{$^H{charnames}} "
- "did not return a defined value", SVfARG(sv_name));
- }
- if (hv_store_ent( RExC_charnames, sv_name, sv_str, 0))
- cached = 1;
- }
+ if (SIZE_ONLY) {
+ ckWARNreg(RExC_parse,
+ "Ignoring zero length \\N{} in character class"
+ );
+ RExC_parse = endbrace + 1;
+ }
+ *valuep = 0;
+ return (regnode *) &RExC_parse; /* Invalid regnode pointer */
}
- if (valuep) {
- char *p = SvPV(sv_str, len);
- if (len) {
- STRLEN numlen = 1;
- if ( SvUTF8(sv_str) ) {
- *valuep = utf8_to_uvchr((U8*)p, &numlen);
- if (*valuep > 0x7F)
- RExC_utf8 = 1;
- /* XXXX
- We have to turn on utf8 for high bit chars otherwise
- we get failures with
-
- "ss" =~ /[\N{LATIN SMALL LETTER SHARP S}]/i
- "SS" =~ /[\N{LATIN SMALL LETTER SHARP S}]/i
-
- This is different from what \x{} would do with the same
- codepoint, where the condition is > 0xFF.
- - dmq
- */
-
-
- } else {
- *valuep = (UV)*p;
- /* warn if we havent used the whole string? */
- }
- if (numlen<len && SIZE_ONLY) {
- ckWARN2reg(RExC_parse,
- "Ignoring excess chars from \\N{%" SVf "} in character class",
- SVfARG(sv_name)
- );
- }
- } else if (SIZE_ONLY) {
- ckWARN2reg(RExC_parse,
- "Ignoring zero length \\N{%" SVf "} in character class",
- SVfARG(sv_name)
- );
- }
- SvREFCNT_dec(sv_name);
- if (!cached)
- SvREFCNT_dec(sv_str);
- return len ? NULL : (regnode *)&len;
- } else if(SvCUR(sv_str)) {
-
- char *s;
- char *p, *pend;
- STRLEN charlen = 1;
-#ifdef DEBUGGING
- char * parse_start = name-3; /* needed for the offsets */
-#endif
- GET_RE_DEBUG_FLAGS_DECL; /* needed for the offsets */
-
- ret = reg_node(pRExC_state,
- (U8)(FOLD ? (LOC ? EXACTFL : EXACTF) : EXACT));
- s= STRING(ret);
-
- if ( RExC_utf8 && !SvUTF8(sv_str) ) {
- sv_utf8_upgrade(sv_str);
- } else if ( !RExC_utf8 && SvUTF8(sv_str) ) {
- RExC_utf8= 1;
- }
-
- p = SvPV(sv_str, len);
- pend = p + len;
- /* len is the length written, charlen is the size the char read */
- for ( len = 0; p < pend; p += charlen ) {
- if (UTF) {
- UV uvc = utf8_to_uvchr((U8*)p, &charlen);
- if (FOLD) {
- STRLEN foldlen,numlen;
- U8 tmpbuf[UTF8_MAXBYTES_CASE+1], *foldbuf;
- uvc = toFOLD_uni(uvc, tmpbuf, &foldlen);
- /* Emit all the Unicode characters. */
-
- for (foldbuf = tmpbuf;
- foldlen;
- foldlen -= numlen)
- {
- uvc = utf8_to_uvchr(foldbuf, &numlen);
- if (numlen > 0) {
- const STRLEN unilen = reguni(pRExC_state, uvc, s);
- s += unilen;
- len += unilen;
- /* In EBCDIC the numlen
- * and unilen can differ. */
- foldbuf += numlen;
- if (numlen >= foldlen)
- break;
- }
- else
- break; /* "Can't happen." */
- }
- } else {
- const STRLEN unilen = reguni(pRExC_state, uvc, s);
- if (unilen > 0) {
- s += unilen;
- len += unilen;
- }
- }
- } else {
- len++;
- REGC(*p, s++);
- }
- }
- if (SIZE_ONLY) {
- RExC_size += STR_SZ(len);
- } else {
- STR_LEN(ret) = len;
- RExC_emit += STR_SZ(len);
- }
- Set_Node_Cur_Length(ret); /* MJD */
- RExC_parse--;
- nextchar(pRExC_state);
- } else { /* zero length */
- ret = reg_node(pRExC_state,NOTHING);
+
+ RExC_utf8 = 1; /* named sequences imply Unicode semantics */
+ RExC_parse += 2; /* Skip past the 'U+' */
+
+ if (valuep) { /* In a bracketed char class */
+ /* We only pay attention to the first char of
+ multichar strings being returned. I kinda wonder
+ if this makes sense as it does change the behaviour
+ from earlier versions, OTOH that behaviour was broken
+ as well. XXX Solution is to recharacterize as
+ [rest-of-class]|multi1|multi2... */
+
+ STRLEN length_of_hex;
+ I32 flags = PERL_SCAN_ALLOW_UNDERSCORES
+ | PERL_SCAN_DISALLOW_PREFIX
+ | (SIZE_ONLY ? PERL_SCAN_SILENT_ILLDIGIT : 0);
+
+ char * endchar = RExC_parse + strcspn(RExC_parse, ".}");
+ if (endchar < endbrace) {
+ ckWARNreg(endchar, "Using just the first character returned by \\N{} in character class");
+ }
+
+ length_of_hex = (STRLEN)(endchar - RExC_parse);
+ *valuep = grok_hex(RExC_parse, &length_of_hex, &flags, NULL);
+
+ /* The tokenizer should have guaranteed validity, but it's possible to
+ * bypass it by using single quoting, so check */
+ if (length_of_hex == 0
+ || length_of_hex != (STRLEN)(endchar - RExC_parse) )
+ {
+ RExC_parse += length_of_hex; /* Includes all the valid */
+ RExC_parse += (RExC_orig_utf8) /* point to after 1st invalid */
+ ? UTF8SKIP(RExC_parse)
+ : 1;
+ /* Guard against malformed utf8 */
+ if (RExC_parse >= endchar) RExC_parse = endchar;
+ vFAIL("Invalid hexadecimal number in \\N{U+...}");
+ }
+
+ RExC_parse = endbrace + 1;
+ if (endchar == endbrace) return NULL;
+
+ ret = (regnode *) &RExC_parse; /* Invalid regnode pointer */
}
- SvREFCNT_dec(sv_name);
- if (!cached)
- SvREFCNT_dec(sv_str);
- return ret;
+ else { /* Not a char class */
+ char *s; /* String to put in generated EXACT node */
+ STRLEN len = 0; /* Its current length */
+ char *endchar; /* Points to '.' or '}' ending cur char in the input
+ stream */
+
+ ret = reg_node(pRExC_state,
+ (U8)(FOLD ? (LOC ? EXACTFL : EXACTF) : EXACT));
+ s= STRING(ret);
+
+ /* Exact nodes can hold only a U8 length's of text = 255. Loop through
+ * the input which is of the form now 'c1.c2.c3...}' until find the
+ * ending brace or exeed length 255. The characters that exceed this
+ * limit are dropped. The limit could be relaxed should it become
+ * desirable by reparsing this as (?:\N{NAME}), so could generate
+ * multiple EXACT nodes, as is done for just regular input. But this
+ * is primarily a named character, and not intended to be a huge long
+ * string, so 255 bytes should be good enough */
+ while (1) {
+ STRLEN length_of_hex;
+ I32 grok_flags = PERL_SCAN_ALLOW_UNDERSCORES
+ | PERL_SCAN_DISALLOW_PREFIX
+ | (SIZE_ONLY ? PERL_SCAN_SILENT_ILLDIGIT : 0);
+ UV cp; /* Ord of current character */
+
+ /* Code points are separated by dots. If none, there is only one
+ * code point, and is terminated by the brace */
+ endchar = RExC_parse + strcspn(RExC_parse, ".}");
+
+ /* The values are Unicode even on EBCDIC machines */
+ length_of_hex = (STRLEN)(endchar - RExC_parse);
+ cp = grok_hex(RExC_parse, &length_of_hex, &grok_flags, NULL);
+ if ( length_of_hex == 0
+ || length_of_hex != (STRLEN)(endchar - RExC_parse) )
+ {
+ RExC_parse += length_of_hex; /* Includes all the valid */
+ RExC_parse += (RExC_orig_utf8) /* point to after 1st invalid */
+ ? UTF8SKIP(RExC_parse)
+ : 1;
+ /* Guard against malformed utf8 */
+ if (RExC_parse >= endchar) RExC_parse = endchar;
+ vFAIL("Invalid hexadecimal number in \\N{U+...}");
+ }
+
+ if (! FOLD) { /* Not folding, just append to the string */
+ STRLEN unilen;
+
+ /* Quit before adding this character if would exceed limit */
+ if (len + UNISKIP(cp) > U8_MAX) break;
+
+ unilen = reguni(pRExC_state, cp, s);
+ if (unilen > 0) {
+ s += unilen;
+ len += unilen;
+ }
+ } else { /* Folding, output the folded equivalent */
+ STRLEN foldlen,numlen;
+ U8 tmpbuf[UTF8_MAXBYTES_CASE+1], *foldbuf;
+ cp = toFOLD_uni(cp, tmpbuf, &foldlen);
+
+ /* Quit before exceeding size limit */
+ if (len + foldlen > U8_MAX) break;
+
+ for (foldbuf = tmpbuf;
+ foldlen;
+ foldlen -= numlen)
+ {
+ cp = utf8_to_uvchr(foldbuf, &numlen);
+ if (numlen > 0) {
+ const STRLEN unilen = reguni(pRExC_state, cp, s);
+ s += unilen;
+ len += unilen;
+ /* In EBCDIC the numlen and unilen can differ. */
+ foldbuf += numlen;
+ if (numlen >= foldlen)
+ break;
+ }
+ else
+ break; /* "Can't happen." */
+ }
+ }
+
+ /* Point to the beginning of the next character in the sequence. */
+ RExC_parse = endchar + 1;
+
+ /* Quit if no more characters */
+ if (RExC_parse >= endbrace) break;
+ }
+
+ if (SIZE_ONLY) {
+ if (RExC_parse < endbrace) {
+ ckWARNreg(RExC_parse - 1,
+ "Using just the first characters returned by \\N{}");
+ }
+
+ RExC_size += STR_SZ(len);
+ } else {
+ STR_LEN(ret) = len;
+ RExC_emit += STR_SZ(len);
+ }
+
+ RExC_parse = endbrace + 1;
+
+ *flagp |= HASWIDTH; /* Not SIMPLE, as that causes the engine to fail
+ with malformed in t/re/pat_advanced.t */
+ RExC_parse --;
+ Set_Node_Cur_Length(ret); /* MJD */
+ nextchar(pRExC_state);
+ }
+
+ return ret;
}
break;
case 'c':
p++;
- ender = UCHARAT(p++);
- ender = toCTRL(ender);
+ ender = grok_bslash_c(*p++, SIZE_ONLY);
break;
case '0': case '1': case '2': case '3':case '4':
case '5': case '6': case '7': case '8':case '9':
goto recode_encoding;
break;
case 'c':
- value = UCHARAT(RExC_parse++);
- value = toCTRL(value);
+ value = grok_bslash_c(*RExC_parse++, SIZE_ONLY);
break;
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
/*
- regcurly - a little FSA that accepts {\d+,?\d*}
*/
-STATIC I32
-S_regcurly(register const char *s)
+#ifndef PERL_IN_XSUB_RE
+I32
+Perl_regcurly(register const char *s)
{
PERL_ARGS_ASSERT_REGCURLY;
return FALSE;
return TRUE;
}
-
+#endif
/*
- regdump - dump a regexp onto Perl_debug_log in vaguely comprehensible form
memcpy(&(ret->xpv_cur), &(r->xpv_cur),
sizeof(regexp) - STRUCT_OFFSET(regexp, xpv_cur));
SvLEN_set(ret_x, 0);
+ SvSTASH_set(ret_x, NULL);
+ SvMAGIC_set(ret_x, NULL);
Newx(ret->offs, npar, regexp_paren_pair);
Copy(r->offs, ret->offs, npar, regexp_paren_pair);
if (r->substrs) {
PerlMemShared_free(trie->trans);
if (trie->bitmap)
PerlMemShared_free(trie->bitmap);
- if (trie->wordlen)
- PerlMemShared_free(trie->wordlen);
if (trie->jump)
PerlMemShared_free(trie->jump);
- if (trie->nextword)
- PerlMemShared_free(trie->nextword);
+ PerlMemShared_free(trie->wordinfo);
/* do this last!!!! */
PerlMemShared_free(ri->data->data[n]);
}
state = (struct re_save_state *)(PL_savestack + PL_savestack_ix);
PL_savestack_ix += SAVESTACK_ALLOC_FOR_RE_SAVE_STATE;
- SSPUSHINT(SAVEt_RE_STATE);
+ SSPUSHUV(SAVEt_RE_STATE);
Copy(&PL_reg_state, state, 1, struct re_save_state);
} trans;
};
+/* info per word; indexed by wordnum */
+typedef struct {
+ U16 prev; /* previous word in acceptance chain; eg in
+ * zzz|abc|ab/ after matching the chars abc, the
+ * accepted word is #2, and the previous accepted
+ * word is #3 */
+ U32 len; /* how many chars long is this word? */
+ U32 accept; /* accept state for this word */
+} reg_trie_wordinfo;
typedef struct _reg_trie_state reg_trie_state;
reg_trie_state *states; /* state data */
reg_trie_trans *trans; /* array of transition elements */
char *bitmap; /* stclass bitmap */
- U32 *wordlen; /* array of lengths of words */
U16 *jump; /* optional 1 indexed array of offsets before tail
for the node following a given word. */
- U16 *nextword; /* optional 1 indexed array to support linked list
- of duplicate wordnums */
+ reg_trie_wordinfo *wordinfo; /* array of info per word */
U16 uniquecharcount; /* unique chars in trie (width of trans table) */
U32 startstate; /* initial state - used for common prefix optimisation */
STRLEN minlen; /* minimum length of words in trie - build/opt only? */
STRLEN maxlen; /* maximum length of words in trie - build/opt only? */
+ U32 prefixlen; /* #chars in common prefix */
U32 statecount; /* Build only - number of states in the states array
(including the unused zero state) */
U32 wordcount; /* Build only */
# the test below to allow that version too. DAPM Feb 04.
my $version = `$bison -V`;
+unless ($version) { die <<EOF; }
+Could not find a version of bison in your path. Please install bison.
+EOF
+
unless ($version =~ /\b(1\.875[a-z]?|2\.[0134])\b/) { die <<EOF; }
You have the wrong version of bison in your path; currently 1.875
LEAVE; \
} \
if (!(OP(scan) == NAME \
- ? (bool)swash_fetch(CAT2(PL_utf8_,CLASS), (U8*)locinput, do_utf8) \
+ ? cBOOL(swash_fetch(CAT2(PL_utf8_,CLASS), (U8*)locinput, do_utf8)) \
: LCFUNC_utf8((U8*)locinput))) \
{ \
sayNO; \
LEAVE; \
} \
if ((OP(scan) == NAME \
- ? (bool)swash_fetch(CAT2(PL_utf8_,CLASS), (U8*)locinput, do_utf8) \
+ ? cBOOL(swash_fetch(CAT2(PL_utf8_,CLASS), (U8*)locinput, do_utf8)) \
: LCFUNC_utf8((U8*)locinput))) \
{ \
sayNO; \
static void restore_pos(pTHX_ void *arg);
+#define REGCP_PAREN_ELEMS 4
+#define REGCP_OTHER_ELEMS 5
+#define REGCP_FRAME_ELEMS 1
+/* REGCP_FRAME_ELEMS are not part of the REGCP_OTHER_ELEMS and
+ * are needed for the regexp context stack bookkeeping. */
+
STATIC CHECKPOINT
S_regcppush(pTHX_ I32 parenfloor)
{
dVAR;
const int retval = PL_savestack_ix;
-#define REGCP_PAREN_ELEMS 4
const int paren_elems_to_push = (PL_regsize - parenfloor) * REGCP_PAREN_ELEMS;
+ const UV total_elems = paren_elems_to_push + REGCP_OTHER_ELEMS;
+ const UV elems_shifted = total_elems << SAVE_TIGHT_SHIFT;
int p;
GET_RE_DEBUG_FLAGS_DECL;
if (paren_elems_to_push < 0)
Perl_croak(aTHX_ "panic: paren_elems_to_push < 0");
-#define REGCP_OTHER_ELEMS 7
- SSGROW(paren_elems_to_push + REGCP_OTHER_ELEMS);
+ if ((elems_shifted >> SAVE_TIGHT_SHIFT) != total_elems)
+ Perl_croak(aTHX_ "panic: paren_elems_to_push offset %"UVuf
+ " out of range (%d-%d)", total_elems, PL_regsize, parenfloor);
+
+ SSGROW(total_elems + REGCP_FRAME_ELEMS);
for (p = PL_regsize; p > parenfloor; p--) {
/* REGCP_PARENS_ELEMS are pushed per pairs of parentheses. */
SSPUSHINT(*PL_reglastparen);
SSPUSHINT(*PL_reglastcloseparen);
SSPUSHPTR(PL_reginput);
-#define REGCP_FRAME_ELEMS 2
-/* REGCP_FRAME_ELEMS are part of the REGCP_OTHER_ELEMS and
- * are needed for the regexp context stack bookkeeping. */
- SSPUSHINT(paren_elems_to_push + REGCP_OTHER_ELEMS - REGCP_FRAME_ELEMS);
- SSPUSHINT(SAVEt_REGCONTEXT); /* Magic cookie. */
+ SSPUSHUV(SAVEt_REGCONTEXT | elems_shifted); /* Magic cookie. */
return retval;
}
S_regcppop(pTHX_ const regexp *rex)
{
dVAR;
- U32 i;
+ UV i;
char *input;
GET_RE_DEBUG_FLAGS_DECL;
PERL_ARGS_ASSERT_REGCPPOP;
/* Pop REGCP_OTHER_ELEMS before the parentheses loop starts. */
- i = SSPOPINT;
- assert(i == SAVEt_REGCONTEXT); /* Check that the magic cookie is there. */
- i = SSPOPINT; /* Parentheses elements to pop. */
+ i = SSPOPUV;
+ assert((i & SAVE_MASK) == SAVEt_REGCONTEXT); /* Check that the magic cookie is there. */
+ i >>= SAVE_TIGHT_SHIFT; /* Parentheses elements to pop. */
input = (char *) SSPOPPTR;
*PL_reglastcloseparen = SSPOPINT;
*PL_reglastparen = SSPOPINT;
PL_regsize = SSPOPINT;
PL_regoffs=(regexp_paren_pair *) SSPOPPTR;
-
+ i -= REGCP_OTHER_ELEMS;
/* Now restore the parentheses context. */
- for (i -= (REGCP_OTHER_ELEMS - REGCP_FRAME_ELEMS);
- i > 0; i -= REGCP_PAREN_ELEMS) {
+ for ( ; i > 0; i -= REGCP_PAREN_ELEMS) {
I32 tmps;
U32 paren = (U32)SSPOPINT;
PL_reg_start_tmp[paren] = (char *) SSPOPPTR;
if ( (CoNd) \
&& (ln == len || \
!ibcmp_utf8(s, &my_strend, 0, do_utf8, \
- m, NULL, ln, (bool)UTF)) \
+ m, NULL, ln, cBOOL(UTF))) \
&& (!reginfo || regtry(reginfo, &s)) ) \
goto got_it; \
else { \
&& (f == c1 || f == c2) \
&& (ln == len || \
!ibcmp_utf8(s, &my_strend, 0, do_utf8,\
- m, NULL, ln, (bool)UTF)) \
+ m, NULL, ln, cBOOL(UTF)))\
&& (!reginfo || regtry(reginfo, &s)) ) \
goto got_it; \
} \
LOAD_UTF8_CHARCLASS_ALNUM();
REXEC_FBC_UTF8_SCAN(
if (tmp == !(OP(c) == BOUND ?
- (bool)swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8) :
+ cBOOL(swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8)) :
isALNUM_LC_utf8((U8*)s)))
{
tmp = !tmp;
LOAD_UTF8_CHARCLASS_ALNUM();
REXEC_FBC_UTF8_SCAN(
if (tmp == !(OP(c) == NBOUND ?
- (bool)swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8) :
+ cBOOL(swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8)) :
isALNUM_LC_utf8((U8*)s)))
tmp = !tmp;
else REXEC_FBC_TRYIT;
}
if ( word ) {
- U8 *lpos= points[ (pointpos - trie->wordlen[word-1] ) % maxlen ];
+ U8 *lpos= points[ (pointpos - trie->wordinfo[word].len) % maxlen ];
if (!leftmost || lpos < leftmost) {
DEBUG_r(accepted_word=word);
leftmost= lpos;
}
}
if ( aho->states[ state ].wordnum ) {
- U8 *lpos = points[ (pointpos - trie->wordlen[aho->states[ state ].wordnum-1]) % maxlen ];
+ U8 *lpos = points[ (pointpos - trie->wordinfo[aho->states[ state ].wordnum].len) % maxlen ];
if (!leftmost || lpos < leftmost) {
DEBUG_r(accepted_word=aho->states[ state ].wordnum);
leftmost = lpos;
I32 end_shift = 0; /* Same for the end. */ /* CC */
I32 scream_pos = -1; /* Internal iterator of scream. */
char *scream_olds = NULL;
- const bool do_utf8 = (bool)DO_UTF8(sv);
+ const bool do_utf8 = cBOOL(DO_UTF8(sv));
I32 multiline;
RXi_GET_DECL(prog,progi);
regmatch_info reginfo; /* create some info to pass to regtry etc */
#define REPORT_CODE_OFF 32
-/* Make sure there is a test for this +1 options in re_tests */
-#define TRIE_INITAL_ACCEPT_BUFFLEN 4;
-
#define CHRTEST_UNINIT -1001 /* c1/c2 haven't been calculated yet */
#define CHRTEST_VOID -1000 /* the c1/c2 "next char" test should be skipped */
}
/* FALL THROUGH */
case TRIE:
+ /* the basic plan of execution of the trie is:
+ * At the beginning, run though all the states, and
+ * find the longest-matching word. Also remember the position
+ * of the shortest matching word. For example, this pattern:
+ * 1 2 3 4 5
+ * ab|a|x|abcd|abc
+ * when matched against the string "abcde", will generate
+ * accept states for all words except 3, with the longest
+ * matching word being 4, and the shortest being 1 (with
+ * the position being after char 1 of the string).
+ *
+ * Then for each matching word, in word order (i.e. 1,2,4,5),
+ * we run the remainder of the pattern; on each try setting
+ * the current position to the character following the word,
+ * returning to try the next word on failure.
+ *
+ * We avoid having to build a list of words at runtime by
+ * using a compile-time structure, wordinfo[].prev, which
+ * gives, for each word, the previous accepting word (if any).
+ * In the case above it would contain the mappings 1->2, 2->0,
+ * 3->0, 4->5, 5->1. We can use this table to generate, from
+ * the longest word (4 above), a list of all words, by
+ * following the list of prev pointers; this gives us the
+ * unordered list 4,5,1,2. Then given the current word we have
+ * just tried, we can go through the list and find the
+ * next-biggest word to try (so if we just failed on word 2,
+ * the next in the list is 4).
+ *
+ * Since at runtime we don't record the matching position in
+ * the string for each word, we have to work that out for
+ * each word we're about to process. The wordinfo table holds
+ * the character length of each word; given that we recorded
+ * at the start: the position of the shortest word and its
+ * length in chars, we just need to move the pointer the
+ * difference between the two char lengths. Depending on
+ * Unicode status and folding, that's cheap or expensive.
+ *
+ * This algorithm is optimised for the case where are only a
+ * small number of accept states, i.e. 0,1, or maybe 2.
+ * With lots of accepts states, and having to try all of them,
+ * it becomes quadratic on number of accept states to find all
+ * the next words.
+ */
+
{
/* what type of TRIE am I? (utf8 makes this contextual) */
DECL_TRIE_TYPE(scan);
STRLEN len = 0;
STRLEN foldlen = 0;
U8 *uscan = (U8*)NULL;
- STRLEN bufflen=0;
- SV *sv_accept_buff = NULL;
U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
+ U32 charcount = 0; /* how many input chars we have matched */
+ U32 accepted = 0; /* have we seen any accepting states? */
- ST.accepted = 0; /* how many accepting states we have seen */
ST.B = next;
ST.jump = trie->jump;
ST.me = scan;
- /*
- traverse the TRIE keeping track of all accepting states
- we transition through until we get to a failing node.
- */
+ ST.firstpos = NULL;
+ ST.longfold = FALSE; /* char longer if folded => it's harder */
+ ST.nextword = 0;
+
+ /* fully traverse the TRIE; note the position of the
+ shortest accept state and the wordnum of the longest
+ accept state */
while ( state && uc <= (U8*)PL_regeol ) {
U32 base = trie->states[ state ].trans.base;
UV uvc = 0;
U16 charid;
- /* We use charid to hold the wordnum as we don't use it
- for charid until after we have done the wordnum logic.
- We define an alias just so that the wordnum logic reads
- more naturally. */
-
-#define got_wordnum charid
- got_wordnum = trie->states[ state ].wordnum;
-
- if ( got_wordnum ) {
- if ( ! ST.accepted ) {
- ENTER;
- SAVETMPS; /* XXX is this necessary? dmq */
- bufflen = TRIE_INITAL_ACCEPT_BUFFLEN;
- sv_accept_buff=newSV(bufflen *
- sizeof(reg_trie_accepted) - 1);
- SvCUR_set(sv_accept_buff, 0);
- SvPOK_on(sv_accept_buff);
- sv_2mortal(sv_accept_buff);
- SAVETMPS;
- ST.accept_buff =
- (reg_trie_accepted*)SvPV_nolen(sv_accept_buff );
- }
- do {
- if (ST.accepted >= bufflen) {
- bufflen *= 2;
- ST.accept_buff =(reg_trie_accepted*)
- SvGROW(sv_accept_buff,
- bufflen * sizeof(reg_trie_accepted));
+ U16 wordnum;
+ wordnum = trie->states[ state ].wordnum;
+
+ if (wordnum) { /* it's an accept state */
+ if (!accepted) {
+ accepted = 1;
+ /* record first match position */
+ if (ST.longfold) {
+ ST.firstpos = (U8*)locinput;
+ ST.firstchars = 0;
}
- SvCUR_set(sv_accept_buff,SvCUR(sv_accept_buff)
- + sizeof(reg_trie_accepted));
-
-
- ST.accept_buff[ST.accepted].wordnum = got_wordnum;
- ST.accept_buff[ST.accepted].endpos = uc;
- ++ST.accepted;
- } while (trie->nextword && (got_wordnum= trie->nextword[got_wordnum]));
+ else {
+ ST.firstpos = uc;
+ ST.firstchars = charcount;
+ }
+ }
+ if (!ST.nextword || wordnum < ST.nextword)
+ ST.nextword = wordnum;
+ ST.topword = wordnum;
}
-#undef got_wordnum
DEBUG_TRIE_EXECUTE_r({
DUMP_EXEC_POS( (char *)uc, scan, do_utf8 );
PerlIO_printf( Perl_debug_log,
- "%*s %sState: %4"UVxf" Accepted: %4"UVxf" ",
+ "%*s %sState: %4"UVxf" Accepted: %c ",
2+depth * 2, "", PL_colors[4],
- (UV)state, (UV)ST.accepted );
+ (UV)state, (accepted ? 'Y' : 'N'));
});
+ /* read a char and goto next state */
if ( base ) {
REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc,
uscan, len, uvc, charid, foldlen,
foldbuf, uniflags);
-
+ charcount++;
+ if (foldlen>0)
+ ST.longfold = TRUE;
if (charid &&
(base + charid > trie->uniquecharcount )
&& (base + charid - 1 - trie->uniquecharcount
charid, uvc, (UV)state, PL_colors[5] );
);
}
- if (!ST.accepted )
+ if (!accepted)
sayNO;
+ /* calculate total number of accept states */
+ {
+ U16 w = ST.topword;
+ accepted = 0;
+ while (w) {
+ w = trie->wordinfo[w].prev;
+ accepted++;
+ }
+ ST.accepted = accepted;
+ }
+
DEBUG_EXECUTE_r(
PerlIO_printf( Perl_debug_log,
"%*s %sgot %"IVdf" possible matches%s\n",
REPORT_CODE_OFF + depth * 2, "",
PL_colors[4], (IV)ST.accepted, PL_colors[5] );
);
+ goto trie_first_try; /* jump into the fail handler */
}}
- goto trie_first_try; /* jump into the fail handler */
/* NOTREACHED */
- case TRIE_next_fail: /* we failed - try next alterative */
+
+ case TRIE_next_fail: /* we failed - try next alternative */
if ( ST.jump) {
REGCP_UNWIND(ST.cp);
for (n = *PL_reglastparen; n > ST.lastparen; n--)
PL_regoffs[n].end = -1;
*PL_reglastparen = n;
}
- trie_first_try:
- if (do_cutgroup) {
- do_cutgroup = 0;
- no_final = 0;
- }
-
- if ( ST.jump) {
- ST.lastparen = *PL_reglastparen;
- REGCP_SET(ST.cp);
- }
- if ( ST.accepted == 1 ) {
- /* only one choice left - just continue */
- DEBUG_EXECUTE_r({
- AV *const trie_words
- = MUTABLE_AV(rexi->data->data[ARG(ST.me)+TRIE_WORDS_OFFSET]);
- SV ** const tmp = av_fetch( trie_words,
- ST.accept_buff[ 0 ].wordnum-1, 0 );
- SV *sv= tmp ? sv_newmortal() : NULL;
-
- PerlIO_printf( Perl_debug_log,
- "%*s %sonly one match left: #%d <%s>%s\n",
- REPORT_CODE_OFF+depth*2, "", PL_colors[4],
- ST.accept_buff[ 0 ].wordnum,
- tmp ? pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 0,
- PL_colors[0], PL_colors[1],
- (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0)
- )
- : "not compiled under -Dr",
- PL_colors[5] );
- });
- PL_reginput = (char *)ST.accept_buff[ 0 ].endpos;
- /* in this case we free tmps/leave before we call regmatch
- as we wont be using accept_buff again. */
-
- locinput = PL_reginput;
- nextchr = UCHARAT(locinput);
- if ( !ST.jump || !ST.jump[ST.accept_buff[0].wordnum])
- scan = ST.B;
- else
- scan = ST.me + ST.jump[ST.accept_buff[0].wordnum];
- if (!has_cutgroup) {
- FREETMPS;
- LEAVE;
- } else {
- ST.accepted--;
- PUSH_YES_STATE_GOTO(TRIE_next, scan);
- }
-
- continue; /* execute rest of RE */
- }
-
- if ( !ST.accepted-- ) {
+ if (!--ST.accepted) {
DEBUG_EXECUTE_r({
PerlIO_printf( Perl_debug_log,
"%*s %sTRIE failed...%s\n",
PL_colors[4],
PL_colors[5] );
});
- FREETMPS;
- LEAVE;
sayNO_SILENT;
- /*NOTREACHED*/
- }
+ }
+ {
+ /* Find next-highest word to process. Note that this code
+ * is O(N^2) per trie run (O(N) per branch), so keep tight */
+ register U16 min = 0;
+ register U16 word;
+ register U16 const nextword = ST.nextword;
+ register reg_trie_wordinfo * const wordinfo
+ = ((reg_trie_data*)rexi->data->data[ARG(ST.me)])->wordinfo;
+ for (word=ST.topword; word; word=wordinfo[word].prev) {
+ if (word > nextword && (!min || word < min))
+ min = word;
+ }
+ ST.nextword = min;
+ }
- /*
- There are at least two accepting states left. Presumably
- the number of accepting states is going to be low,
- typically two. So we simply scan through to find the one
- with lowest wordnum. Once we find it, we swap the last
- state into its place and decrement the size. We then try to
- match the rest of the pattern at the point where the word
- ends. If we succeed, control just continues along the
- regex; if we fail we return here to try the next accepting
- state
- */
+ trie_first_try:
+ if (do_cutgroup) {
+ do_cutgroup = 0;
+ no_final = 0;
+ }
- {
- U32 best = 0;
- U32 cur;
- for( cur = 1 ; cur <= ST.accepted ; cur++ ) {
- DEBUG_TRIE_EXECUTE_r(
- PerlIO_printf( Perl_debug_log,
- "%*s %sgot %"IVdf" (%d) as best, looking at %"IVdf" (%d)%s\n",
- REPORT_CODE_OFF + depth * 2, "", PL_colors[4],
- (IV)best, ST.accept_buff[ best ].wordnum, (IV)cur,
- ST.accept_buff[ cur ].wordnum, PL_colors[5] );
- );
+ if ( ST.jump) {
+ ST.lastparen = *PL_reglastparen;
+ REGCP_SET(ST.cp);
+ }
- if (ST.accept_buff[cur].wordnum <
- ST.accept_buff[best].wordnum)
- best = cur;
+ /* find start char of end of current word */
+ {
+ U32 chars; /* how many chars to skip */
+ U8 *uc = ST.firstpos;
+ reg_trie_data * const trie
+ = (reg_trie_data*)rexi->data->data[ARG(ST.me)];
+
+ assert((trie->wordinfo[ST.nextword].len - trie->prefixlen)
+ >= ST.firstchars);
+ chars = (trie->wordinfo[ST.nextword].len - trie->prefixlen)
+ - ST.firstchars;
+
+ if (ST.longfold) {
+ /* the hard option - fold each char in turn and find
+ * its folded length (which may be different */
+ U8 foldbuf[UTF8_MAXBYTES_CASE + 1];
+ STRLEN foldlen;
+ STRLEN len;
+ UV uvc;
+ U8 *uscan;
+
+ while (chars) {
+ if (do_utf8) {
+ uvc = utf8n_to_uvuni((U8*)uc, UTF8_MAXLEN, &len,
+ uniflags);
+ uc += len;
+ }
+ else {
+ uvc = *uc;
+ uc++;
+ }
+ uvc = to_uni_fold(uvc, foldbuf, &foldlen);
+ uscan = foldbuf;
+ while (foldlen) {
+ if (!--chars)
+ break;
+ uvc = utf8n_to_uvuni(uscan, UTF8_MAXLEN, &len,
+ uniflags);
+ uscan += len;
+ foldlen -= len;
+ }
+ }
+ }
+ else {
+ if (do_utf8)
+ while (chars--)
+ uc += UTF8SKIP(uc);
+ else
+ uc += chars;
}
+ PL_reginput = (char *)uc;
+ }
- DEBUG_EXECUTE_r({
- AV *const trie_words
- = MUTABLE_AV(rexi->data->data[ARG(ST.me)+TRIE_WORDS_OFFSET]);
- SV ** const tmp = av_fetch( trie_words,
- ST.accept_buff[ best ].wordnum - 1, 0 );
- regnode *nextop=(!ST.jump || !ST.jump[ST.accept_buff[best].wordnum]) ?
- ST.B :
- ST.me + ST.jump[ST.accept_buff[best].wordnum];
- SV *sv= tmp ? sv_newmortal() : NULL;
-
- PerlIO_printf( Perl_debug_log,
- "%*s %strying alternation #%d <%s> at node #%d %s\n",
- REPORT_CODE_OFF+depth*2, "", PL_colors[4],
- ST.accept_buff[best].wordnum,
- tmp ? pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 0,
- PL_colors[0], PL_colors[1],
- (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0)
- ) : "not compiled under -Dr",
- REG_NODE_NUM(nextop),
- PL_colors[5] );
- });
+ scan = (ST.jump && ST.jump[ST.nextword])
+ ? ST.me + ST.jump[ST.nextword]
+ : ST.B;
- if ( best<ST.accepted ) {
- reg_trie_accepted tmp = ST.accept_buff[ best ];
- ST.accept_buff[ best ] = ST.accept_buff[ ST.accepted ];
- ST.accept_buff[ ST.accepted ] = tmp;
- best = ST.accepted;
- }
- PL_reginput = (char *)ST.accept_buff[ best ].endpos;
- if ( !ST.jump || !ST.jump[ST.accept_buff[best].wordnum]) {
- scan = ST.B;
- } else {
- scan = ST.me + ST.jump[ST.accept_buff[best].wordnum];
- }
- PUSH_YES_STATE_GOTO(TRIE_next, scan);
- /* NOTREACHED */
+ DEBUG_EXECUTE_r({
+ PerlIO_printf( Perl_debug_log,
+ "%*s %sTRIE matched word #%d, continuing%s\n",
+ REPORT_CODE_OFF+depth*2, "",
+ PL_colors[4],
+ ST.nextword,
+ PL_colors[5]
+ );
+ });
+
+ if (ST.accepted > 1 || has_cutgroup) {
+ PUSH_STATE_GOTO(TRIE_next, scan);
+ /* NOTREACHED */
}
+ /* only one choice left - just continue */
+ DEBUG_EXECUTE_r({
+ AV *const trie_words
+ = MUTABLE_AV(rexi->data->data[ARG(ST.me)+TRIE_WORDS_OFFSET]);
+ SV ** const tmp = av_fetch( trie_words,
+ ST.nextword-1, 0 );
+ SV *sv= tmp ? sv_newmortal() : NULL;
+
+ PerlIO_printf( Perl_debug_log,
+ "%*s %sonly one match left, short-circuiting: #%d <%s>%s\n",
+ REPORT_CODE_OFF+depth*2, "", PL_colors[4],
+ ST.nextword,
+ tmp ? pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 0,
+ PL_colors[0], PL_colors[1],
+ (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0)
+ )
+ : "not compiled under -Dr",
+ PL_colors[5] );
+ });
+
+ locinput = PL_reginput;
+ nextchr = UCHARAT(locinput);
+ continue; /* execute rest of RE */
/* NOTREACHED */
- case TRIE_next:
- /* we dont want to throw this away, see bug 57042*/
- if (oreplsv != GvSV(PL_replgv))
- sv_setsv(oreplsv, GvSV(PL_replgv));
- FREETMPS;
- LEAVE;
- sayYES;
#undef ST
case EXACT: {
const char * const l = locinput;
char *e = PL_regeol;
- if (ibcmp_utf8(s, 0, ln, (bool)UTF,
+ if (ibcmp_utf8(s, 0, ln, cBOOL(UTF),
l, &e, 0, do_utf8)) {
/* One more case for the sharp s:
* pack("U0U*", 0xDF) =~ /ss/i,
/* NOTREACHED */
}
/* logical is 1, /(?(?{...})X|Y)/ */
- sw = (bool)SvTRUE(ret);
+ sw = cBOOL(SvTRUE(ret));
logical = 0;
break;
}
/*NOTREACHED*/
case GROUPP:
n = ARG(scan); /* which paren pair */
- sw = (bool)(*PL_reglastparen >= n && PL_regoffs[n].end != -1);
+ sw = cBOOL(*PL_reglastparen >= n && PL_regoffs[n].end != -1);
break;
case NGROUPP:
/* reg_check_named_buff_matched returns 0 for no match */
- sw = (bool)(0 < reg_check_named_buff_matched(rex,scan));
+ sw = cBOOL(0 < reg_check_named_buff_matched(rex,scan));
break;
case INSUBP:
n = ARG(scan);
/* trivial fail */
if (logical) {
logical = 0;
- sw = 1 - (bool)ST.wanted;
+ sw = 1 - cBOOL(ST.wanted);
}
else if (ST.wanted)
sayNO;
case IFMATCH_A: /* body of (?...A) succeeded */
if (ST.logical) {
- sw = (bool)ST.wanted;
+ sw = cBOOL(ST.wanted);
}
else if (!ST.wanted)
sayNO;
#define FBMrf_MULTILINE 1
-/* an accepting state/position*/
-struct _reg_trie_accepted {
- U8 *endpos;
- U16 wordnum;
-};
-typedef struct _reg_trie_accepted reg_trie_accepted;
-
/* some basic information about the current match that is created by
* Perl_regexec_flags and then passed to regtry(), regmatch() etc */
U32 lastparen;
CHECKPOINT cp;
- reg_trie_accepted *accept_buff; /* accepting states we have seen */
- U32 accepted; /* how many accepting states we have seen */
+ U32 accepted; /* how many accepting states left */
U16 *jump; /* positive offsets from me */
regnode *B; /* node following the trie */
regnode *me; /* Which node am I - needed for jump tries*/
+ U8 *firstpos;/* pos in string of first trie match */
+ U32 firstchars;/* len in chars of firstpos from start */
+ U16 nextword;/* next word to try */
+ U16 topword; /* longest accepted word */
+ bool longfold;/* saw a fold with a 1->n char mapping */
} trie;
/* special types - these members are used to store state for special
Perl_runops_standard(pTHX)
{
dVAR;
- while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX))) {
- PERL_ASYNC_CHECK();
+ register OP *op = PL_op;
+ while ((PL_op = op = CALL_FPTR(op->op_ppaddr)(aTHX))) {
}
TAINT_NOT;
SSCHECK(3);
SSPUSHPTR(ptr1);
SSPUSHPTR(ptr2);
- SSPUSHINT(type);
+ SSPUSHUV(type);
}
SV *
SSPUSHPTR(sv);
SSPUSHINT(mask);
SSPUSHINT(val);
- SSPUSHINT(SAVEt_SET_SVFLAGS);
+ SSPUSHUV(SAVEt_SET_SVFLAGS);
}
void
PERL_ARGS_ASSERT_SAVE_GP;
- save_pushptrptr(SvREFCNT_inc(gv), GvGP(gv), SAVEt_GP);
+ SSCHECK(4);
+ SSPUSHINT(SvFAKE(gv));
+ SSPUSHPTR(GvGP(gv));
+ SSPUSHPTR(SvREFCNT_inc(gv));
+ SSPUSHUV(SAVEt_GP);
+
+ /* Don't let the localized GV coerce into non-glob, otherwise we would
+ * not be able to restore GP upon leave from context if that happened */
+ SvFAKE_off(gv);
if (empty) {
GP *gp = Perl_newGP(aTHX_ gv);
PERL_ARGS_ASSERT_SAVE_BOOL;
- SSCHECK(3);
- SSPUSHBOOL(*boolp);
+ SSCHECK(2);
SSPUSHPTR(boolp);
- SSPUSHINT(SAVEt_BOOL);
+ SSPUSHUV(SAVEt_BOOL | (*boolp << 8));
}
void
SSCHECK(3);
SSPUSHINT(i);
SSPUSHPTR(ptr);
- SSPUSHINT(type);
+ SSPUSHUV(type);
}
void
Perl_save_int(pTHX_ int *intp)
{
dVAR;
+ const UV shifted = (UV)*intp << SAVE_TIGHT_SHIFT;
PERL_ARGS_ASSERT_SAVE_INT;
- save_pushi32ptr(*intp, intp, SAVEt_INT);
+ if ((int)(shifted >> SAVE_TIGHT_SHIFT) == *intp) {
+ SSCHECK(2);
+ SSPUSHPTR(intp);
+ SSPUSHUV(SAVEt_INT_SMALL | shifted);
+ } else
+ save_pushi32ptr(*intp, intp, SAVEt_INT);
}
void
PERL_ARGS_ASSERT_SAVE_I8;
- save_pushi32ptr(*bytep, bytep, SAVEt_I8);
+ SSCHECK(2);
+ SSPUSHPTR(bytep);
+ SSPUSHUV(SAVEt_I8 | ((UV)*bytep << 8));
}
void
PERL_ARGS_ASSERT_SAVE_I16;
- save_pushi32ptr(*intp, intp, SAVEt_I16);
+ SSCHECK(2);
+ SSPUSHPTR(intp);
+ SSPUSHUV(SAVEt_I16 | ((UV)*intp << 8));
}
void
Perl_save_I32(pTHX_ I32 *intp)
{
dVAR;
+ const UV shifted = (UV)*intp << SAVE_TIGHT_SHIFT;
PERL_ARGS_ASSERT_SAVE_I32;
- save_pushi32ptr(*intp, intp, SAVEt_I32);
+ if ((I32)(shifted >> SAVE_TIGHT_SHIFT) == *intp) {
+ SSCHECK(2);
+ SSPUSHPTR(intp);
+ SSPUSHUV(SAVEt_I32_SMALL | shifted);
+ } else
+ save_pushi32ptr(*intp, intp, SAVEt_I32);
}
/* Cannot use save_sptr() to store a char* since the SV** cast will
SSPUSHPTR(SvREFCNT_inc_simple_NN(PL_curpad[off]));
SSPUSHPTR(PL_comppad);
SSPUSHLONG((long)off);
- SSPUSHINT(SAVEt_PADSV_AND_MORTALIZE);
+ SSPUSHUV(SAVEt_PADSV_AND_MORTALIZE);
}
void
dVAR;
SSCHECK(2);
SSPUSHPTR(ptr);
- SSPUSHINT(type);
+ SSPUSHUV(type);
}
void
Perl_save_clearsv(pTHX_ SV **svp)
{
dVAR;
+ const UV offset = svp - PL_curpad;
+ const UV offset_shifted = offset << SAVE_TIGHT_SHIFT;
PERL_ARGS_ASSERT_SAVE_CLEARSV;
ASSERT_CURPAD_ACTIVE("save_clearsv");
- SSCHECK(2);
- SSPUSHLONG((long)(svp-PL_curpad));
- SSPUSHINT(SAVEt_CLEARSV);
+ if ((offset_shifted >> SAVE_TIGHT_SHIFT) != offset)
+ Perl_croak(aTHX_ "panic: pad offset %"UVuf" out of range (%p-%p)",
+ offset, svp, PL_curpad);
+
+ SSCHECK(1);
+ SSPUSHUV(offset_shifted | SAVEt_CLEARSV);
SvPADSTALE_off(*svp); /* mark lexical as active */
}
SSCHECK(3);
SSPUSHDPTR(f);
SSPUSHPTR(p);
- SSPUSHINT(SAVEt_DESTRUCTOR);
+ SSPUSHUV(SAVEt_DESTRUCTOR);
}
void
SSCHECK(3);
SSPUSHDXPTR(f);
SSPUSHPTR(p);
- SSPUSHINT(SAVEt_DESTRUCTOR_X);
+ SSPUSHUV(SAVEt_DESTRUCTOR_X);
}
void
SSPUSHPTR(ptr1);
SSPUSHINT(i);
SSPUSHPTR(ptr2);
- SSPUSHINT(type);
+ SSPUSHUV(type);
}
void
* won't actually be stored in the array - so it won't get
* reaped when the localize ends. Ensure it gets reaped by
* mortifying it instead. DAPM */
- if (SvTIED_mg(sv, PERL_MAGIC_tiedelem))
+ if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied))
sv_2mortal(sv);
}
SSPUSHPTR(SvREFCNT_inc_simple(hv));
SSPUSHPTR(newSVsv(key));
SSPUSHPTR(SvREFCNT_inc(*sptr));
- SSPUSHINT(SAVEt_HELEM);
+ SSPUSHUV(SAVEt_HELEM);
save_scalar_at(sptr, flags);
if (flags & SAVEf_KEEPOLDELEM)
return;
* won't actually be stored in the hash - so it won't get
* reaped when the localize ends. Ensure it gets reaped by
* mortifying it instead. DAPM */
- if (SvTIED_mg(sv, PERL_MAGIC_tiedelem))
+ if (SvTIED_mg((const SV *)hv, PERL_MAGIC_tied))
sv_2mortal(sv);
}
dVAR;
register const I32 start = pad + ((char*)&PL_savestack[PL_savestack_ix]
- (char*)PL_savestack);
- register const I32 elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack));
+ const UV elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack));
+ const UV elems_shifted = elems << SAVE_TIGHT_SHIFT;
- SSGROW(elems + 2);
+ if ((elems_shifted >> SAVE_TIGHT_SHIFT) != elems)
+ Perl_croak(aTHX_ "panic: save_alloc elems %"UVuf" out of range (%ld-%ld)",
+ elems, size, pad);
+
+ SSGROW(elems + 1);
PL_savestack_ix += elems;
- SSPUSHINT(elems);
- SSPUSHINT(SAVEt_ALLOC);
+ SSPUSHUV(SAVEt_ALLOC | elems_shifted);
return start;
}
if (base < -1)
Perl_croak(aTHX_ "panic: corrupt saved stack index");
+ DEBUG_l(Perl_deb(aTHX_ "savestack: releasing items %ld -> %ld\n",
+ (long)PL_savestack_ix, (long)base));
while (PL_savestack_ix > base) {
+ UV uv = SSPOPUV;
+ const U8 type = (U8)uv & SAVE_MASK;
TAINT_NOT;
- switch (SSPOPINT) {
+ switch (type) {
case SAVEt_ITEM: /* normal string */
value = MUTABLE_SV(SSPOPPTR);
sv = MUTABLE_SV(SSPOPPTR);
PL_localizing = 0;
}
break;
+ case SAVEt_INT_SMALL:
+ ptr = SSPOPPTR;
+ *(int*)ptr = (int)(uv >> SAVE_TIGHT_SHIFT);
+ break;
case SAVEt_INT: /* int reference */
ptr = SSPOPPTR;
*(int*)ptr = (int)SSPOPINT;
break;
case SAVEt_BOOL: /* bool reference */
ptr = SSPOPPTR;
- *(bool*)ptr = (bool)SSPOPBOOL;
+ *(bool*)ptr = cBOOL(uv >> 8);
+ break;
+ case SAVEt_I32_SMALL:
+ ptr = SSPOPPTR;
+ *(I32*)ptr = (I32)(uv >> SAVE_TIGHT_SHIFT);
break;
case SAVEt_I32: /* I32 reference */
ptr = SSPOPPTR;
*(AV**)ptr = MUTABLE_AV(SSPOPPTR);
break;
case SAVEt_GP: /* scalar reference */
- ptr = SSPOPPTR;
gv = MUTABLE_GV(SSPOPPTR);
gp_free(gv);
- GvGP(gv) = (GP*)ptr;
+ GvGP(gv) = (GP*)SSPOPPTR;
+ if (SSPOPINT)
+ SvFAKE_on(gv);
/* putting a method back into circulation ("local")*/
if (GvCVu(gv) && (hv=GvSTASH(gv)) && HvNAME_get(hv))
mro_method_changed_in(hv);
Safefree(ptr);
break;
case SAVEt_CLEARSV:
- ptr = (void*)&PL_curpad[SSPOPLONG];
+ ptr = (void*)&PL_curpad[uv >> SAVE_TIGHT_SHIFT];
sv = *(SV**)ptr;
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
(*SSPOPDXPTR)(aTHX_ ptr);
break;
case SAVEt_REGCONTEXT:
+ /* regexp must have croaked */
case SAVEt_ALLOC:
- i = SSPOPINT;
- PL_savestack_ix -= i; /* regexp must have croaked */
+ PL_savestack_ix -= uv >> SAVE_TIGHT_SHIFT;
break;
case SAVEt_STACK_POS: /* Position on Perl stack */
i = SSPOPINT;
case SAVEt_I16: /* I16 reference */
ptr = SSPOPPTR;
- *(I16*)ptr = (I16)SSPOPINT;
+ *(I16*)ptr = (I16)(uv >> 8);
break;
case SAVEt_I8: /* I8 reference */
ptr = SSPOPPTR;
- *(I8*)ptr = (I8)SSPOPINT;
+ *(I8*)ptr = (I8)(uv >> 8);
break;
case SAVEt_DESTRUCTOR:
ptr = SSPOPPTR;
}
PL_tainted = was;
+
+ PERL_ASYNC_CHECK();
}
void
#define SAVEt_STACK_CXPOS 44
#define SAVEt_PARSER 45
#define SAVEt_ADELETE 46
+#define SAVEt_I32_SMALL 47
+#define SAVEt_INT_SMALL 48
#define SAVEf_SETMAGIC 1
#define SAVEf_KEEPOLDELEM 2
+#define SAVE_TIGHT_SHIFT 6
+#define SAVE_MASK 0x3F
+
#define save_aelem(av,idx,sptr) save_aelem_flags(av,idx,sptr,SAVEf_SETMAGIC)
#define save_helem(hv,key,sptr) save_helem_flags(hv,key,sptr,SAVEf_SETMAGIC)
#define SSPUSHLONG(i) (PL_savestack[PL_savestack_ix++].any_long = (long)(i))
#define SSPUSHBOOL(p) (PL_savestack[PL_savestack_ix++].any_bool = (p))
#define SSPUSHIV(i) (PL_savestack[PL_savestack_ix++].any_iv = (IV)(i))
+#define SSPUSHUV(u) (PL_savestack[PL_savestack_ix++].any_uv = (UV)(u))
#define SSPUSHPTR(p) (PL_savestack[PL_savestack_ix++].any_ptr = (void*)(p))
#define SSPUSHDPTR(p) (PL_savestack[PL_savestack_ix++].any_dptr = (p))
#define SSPUSHDXPTR(p) (PL_savestack[PL_savestack_ix++].any_dxptr = (p))
#define SSPOPLONG (PL_savestack[--PL_savestack_ix].any_long)
#define SSPOPBOOL (PL_savestack[--PL_savestack_ix].any_bool)
#define SSPOPIV (PL_savestack[--PL_savestack_ix].any_iv)
+#define SSPOPUV (PL_savestack[--PL_savestack_ix].any_uv)
#define SSPOPPTR (PL_savestack[--PL_savestack_ix].any_ptr)
#define SSPOPDPTR (PL_savestack[--PL_savestack_ix].any_dptr)
#define SSPOPDXPTR (PL_savestack[--PL_savestack_ix].any_dxptr)
#define SAVEINT(i) save_int((int*)&(i))
#define SAVEIV(i) save_iv((IV*)&(i))
#define SAVELONG(l) save_long((long*)&(l))
-#define SAVEBOOL(b) save_bool((bool*)&(b))
+#define SAVEBOOL(b) save_bool(&(b))
#define SAVESPTR(s) save_sptr((SV**)&(s))
#define SAVEPPTR(s) save_pptr((char**)&(s))
#define SAVEVPTR(s) save_vptr((void*)&(s))
STMT_START { \
SSCHECK(2); \
SSPUSHINT(PL_stack_sp - PL_stack_base); \
- SSPUSHINT(SAVEt_STACK_POS); \
+ SSPUSHUV(SAVEt_STACK_POS); \
} STMT_END
#define SAVEOP() save_op()
SSCHECK(3); \
SSPUSHINT(cxstack[cxstack_ix].blk_oldsp); \
SSPUSHINT(cxstack_ix); \
- SSPUSHINT(SAVEt_STACK_CXPOS); \
+ SSPUSHUV(SAVEt_STACK_CXPOS); \
} STMT_END
#define SAVEPARSER(p) save_pushptr((p), SAVEt_PARSER)
2. regular body arenas
3. arenas for reduced-size bodies
4. Hash-Entry arenas
- 5. pte arenas (thread related)
Arena types 2 & 3 are chained by body-type off an array of
arena-root pointers, which is indexed by svtype. Some of the
HE, HEK arenas are managed separately, with separate code, but may
be merge-able later..
-
- PTE arenas are not sv-bodies, but they share these mid-level
- mechanics, so are considered here. The new mid-level mechanics rely
- on the sv_type of the body being allocated, so we just reserve one
- of the unused body-slots for PTEs, then use it in those (2) PTE
- contexts below (line ~10k)
*/
/* get_arena(size): this creates custom-sized arenas
bodies_by_type[SVt_NULL] slot is not used, as the table is not
available in hv.c.
-PTEs also use arenas, but are never seen in Perl_sv_upgrade. Nonetheless,
-they get their own slot in bodies_by_type[PTE_SVSLOT =SVt_IV], so they can
-just use the same allocation semantics. At first, PTEs were also
-overloaded to a non-body sv-type, but this yielded hard-to-find malloc
-bugs, so was simplified by claiming a new slot. This choice has no
-consequence at this time.
-
*/
struct body_details {
implemented. */
{ 0, 0, 0, SVt_BIND, TRUE, NONV, NOARENA, 0 },
- /* IVs are in the head, so the allocation size is 0.
- However, the slot is overloaded for PTEs. */
- { sizeof(struct ptr_tbl_ent), /* This is used for PTEs. */
+ /* IVs are in the head, so the allocation size is 0. */
+ { 0,
sizeof(IV), /* This is used to copy out the IV body. */
STRUCT_OFFSET(XPVIV, xiv_iv), SVt_IV, FALSE, NONV,
- NOARENA /* IVS don't need an arena */,
- /* But PTEs need to know the size of their arena */
- FIT_ARENA(0, sizeof(struct ptr_tbl_ent))
+ NOARENA /* IVS don't need an arena */, 0
},
/* 8 bytes on most ILP32 with IEEE doubles */
break;
+ case SVt_REGEXP:
+ /* This ensures that SvTHINKFIRST(sv) is true, and hence that
+ sv_force_normal_flags(sv) is called. */
+ SvFAKE_on(sv);
case SVt_PVIV:
/* XXX Is this still needed? Was it ever needed? Surely as there is
no route from NV to PVIV, NOK can never be true */
case SVt_PVGV:
case SVt_PVCV:
case SVt_PVLV:
- case SVt_REGEXP:
case SVt_PVMG:
case SVt_PVNV:
case SVt_PV:
if (new_type == SVt_PVIO) {
IO * const io = MUTABLE_IO(sv);
- GV *iogv = gv_fetchpvs("IO::Handle::", GV_ADD, SVt_PVHV);
+ GV *iogv = gv_fetchpvs("IO::File::", GV_ADD, SVt_PVHV);
SvOBJECT_on(io);
/* Clear the stashcache because a new IO could overrule a package
(unsigned long)new_type);
}
- if (old_type > SVt_IV) { /* SVt_IVs are overloaded for PTEs */
+ if (old_type > SVt_IV) {
#ifdef PURIFY
my_safefree(old_body);
#else
case SVt_PVFM:
case SVt_PVIO:
Perl_croak(aTHX_ "Can't coerce %s to number in %s", sv_reftype(sv,0),
- OP_NAME(PL_op));
+ OP_DESC(PL_op));
default: NOOP;
}
SvNV_set(sv, num);
if (SvROK(sv)) {
return_rok:
if (SvAMAGIC(sv)) {
- SV * const tmpstr=AMG_CALLun(sv,numer);
+ SV * tmpstr;
+ if (flags & SV_SKIP_OVERLOAD)
+ return 0;
+ tmpstr=AMG_CALLun(sv,numer);
if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
return SvIV(tmpstr);
}
if (SvROK(sv)) {
return_rok:
if (SvAMAGIC(sv)) {
- SV *const tmpstr = AMG_CALLun(sv,numer);
+ SV *tmpstr;
+ if (flags & SV_SKIP_OVERLOAD)
+ return 0;
+ tmpstr = AMG_CALLun(sv,numer);
if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
return SvUV(tmpstr);
}
=for apidoc sv_2nv
Return the num value of an SV, doing any necessary string or integer
-conversion, magic etc. Normally used via the C<SvNV(sv)> and C<SvNVx(sv)>
-macros.
+conversion. If flags includes SV_GMAGIC, does an mg_get() first.
+Normally used via the C<SvNV(sv)> and C<SvNVx(sv)> macros.
=cut
*/
NV
-Perl_sv_2nv(pTHX_ register SV *const sv)
+Perl_sv_2nv_flags(pTHX_ register SV *const sv, const I32 flags)
{
dVAR;
if (!sv)
if (SvGMAGICAL(sv) || (SvTYPE(sv) == SVt_PVGV && SvVALID(sv))) {
/* FBMs use the same flag bit as SVf_IVisUV, so must let them
cache IVs just in case. */
- mg_get(sv);
+ if (flags & SV_GMAGIC)
+ mg_get(sv);
if (SvNOKp(sv))
return SvNVX(sv);
if ((SvPOKp(sv) && SvLEN(sv)) && !SvIOKp(sv)) {
if (SvROK(sv)) {
return_rok:
if (SvAMAGIC(sv)) {
- SV *const tmpstr = AMG_CALLun(sv,numer);
+ SV *tmpstr;
+ if (flags & SV_SKIP_OVERLOAD)
+ return 0;
+ tmpstr = AMG_CALLun(sv,numer);
if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
return SvNV(tmpstr);
}
if (SvROK(sv)) {
return_rok:
if (SvAMAGIC(sv)) {
- SV *const tmpstr = AMG_CALLun(sv,string);
+ SV *tmpstr;
+ if (flags & SV_SKIP_OVERLOAD)
+ return NULL;
+ tmpstr = AMG_CALLun(sv,string);
if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
/* Unwrap this: */
/* char *pv = lp ? SvPV(tmpstr, *lp) : SvPV_nolen(tmpstr);
gv_efullname3(buffer, gv, "*");
SvFLAGS(gv) |= wasfake;
- assert(SvPOK(buffer));
- if (lp) {
- *lp = SvCUR(buffer);
+ if (SvPOK(buffer)) {
+ if (lp) {
+ *lp = SvCUR(buffer);
+ }
+ return SvPVX(buffer);
+ }
+ else {
+ if (lp)
+ *lp = 0;
+ return (char *)"";
}
- return SvPVX(buffer);
}
if (lp)
if (SvAMAGIC(sv)) {
SV * const tmpsv = AMG_CALLun(sv,bool_);
if (tmpsv && (!SvROK(tmpsv) || (SvRV(tmpsv) != SvRV(sv))))
- return (bool)SvTRUE(tmpsv);
+ return cBOOL(SvTRUE(tmpsv));
}
return SvRV(sv) != 0;
}
SV **location;
U8 import_flag = 0;
const U32 stype = SvTYPE(sref);
- bool mro_changes = FALSE;
PERL_ARGS_ASSERT_GLOB_ASSIGN_REF;
goto common;
case SVt_PVAV:
location = (SV **) &GvAV(dstr);
- if (strEQ(GvNAME((GV*)dstr), "ISA"))
- mro_changes = TRUE;
import_flag = GVf_IMPORTED_AV;
goto common;
case SVt_PVIO:
&& CopSTASH_ne(PL_curcop, GvSTASH(dstr))) {
GvFLAGS(dstr) |= import_flag;
}
+ if (stype == SVt_PVAV && strEQ(GvNAME((GV*)dstr), "ISA")) {
+ sv_magic(sref, dstr, PERL_MAGIC_isa, NULL, 0);
+ mro_isa_changed_in(GvSTASH(dstr));
+ }
break;
}
SvREFCNT_dec(dref);
if (SvTAINTED(sstr))
SvTAINT(dstr);
- if (mro_changes) mro_isa_changed_in(GvSTASH(dstr));
return;
}
{
const char * const type = sv_reftype(sstr,0);
if (PL_op)
- Perl_croak(aTHX_ "Bizarre copy of %s in %s", type, OP_NAME(PL_op));
+ Perl_croak(aTHX_ "Bizarre copy of %s in %s", type, OP_DESC(PL_op));
else
Perl_croak(aTHX_ "Bizarre copy of %s", type);
}
} else if (dtype == SVt_PVAV || dtype == SVt_PVHV) {
const char * const type = sv_reftype(dstr,0);
if (PL_op)
- Perl_croak(aTHX_ "Cannot copy to %s in %s", type, OP_NAME(PL_op));
+ Perl_croak(aTHX_ "Cannot copy to %s in %s", type, OP_DESC(PL_op));
else
Perl_croak(aTHX_ "Cannot copy to %s", type);
} else if (sflags & SVf_ROK) {
(!(flags & SV_NOSTEAL)) &&
/* and we're allowed to steal temps */
SvREFCNT(sstr) == 1 && /* and no other references to it? */
- SvLEN(sstr) && /* and really is a string */
- /* and won't be needed again, potentially */
- !(PL_op && PL_op->op_type == OP_AASSIGN))
+ SvLEN(sstr)) /* and really is a string */
#ifdef PERL_OLD_COPY_ON_WRITE
&& ((flags & SV_COW_SHARED_HASH_KEYS)
? (!((sflags & CAN_COW_MASK) == CAN_COW_FLAGS
sv_unref_flags(sv, flags);
else if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
sv_unglob(sv);
+ else if (SvFAKE(sv) && SvTYPE(sv) == SVt_REGEXP) {
+ /* Need to downgrade the REGEXP to a simple(r) scalar. This is analagous
+ to sv_unglob. We only need it here, so inline it. */
+ const svtype new_type = SvMAGIC(sv) || SvSTASH(sv) ? SVt_PVMG : SVt_PV;
+ SV *const temp = newSV_type(new_type);
+ void *const temp_p = SvANY(sv);
+
+ if (new_type == SVt_PVMG) {
+ SvMAGIC_set(temp, SvMAGIC(sv));
+ SvMAGIC_set(sv, NULL);
+ SvSTASH_set(temp, SvSTASH(sv));
+ SvSTASH_set(sv, NULL);
+ }
+ SvCUR_set(temp, SvCUR(sv));
+ /* Remember that SvPVX is in the head, not the body. */
+ if (SvLEN(temp)) {
+ SvLEN_set(temp, SvLEN(sv));
+ /* This signals "buffer is owned by someone else" in sv_clear,
+ which is the least effort way to stop it freeing the buffer.
+ */
+ SvLEN_set(sv, SvLEN(sv)+1);
+ } else {
+ /* Their buffer is already owned by someone else. */
+ SvPVX(sv) = savepvn(SvPVX(sv), SvCUR(sv));
+ SvLEN_set(temp, SvCUR(sv)+1);
+ }
+
+ /* Now swap the rest of the bodies. */
+
+ SvFLAGS(sv) &= ~(SVf_FAKE|SVTYPEMASK);
+ SvFLAGS(sv) |= new_type;
+ SvANY(sv) = SvANY(temp);
+
+ SvFLAGS(temp) &= ~(SVTYPEMASK);
+ SvFLAGS(temp) |= SVt_REGEXP|SVf_FAKE;
+ SvANY(temp) = temp_p;
+
+ SvREFCNT_dec(temp);
+ }
}
/*
if (type <= SVt_IV) {
/* See the comment in sv.h about the collusion between this early
- return and the overloading of the NULL and IV slots in the size
- table. */
- if (SvROK(sv)) {
- SV * const target = SvRV(sv);
- if (SvWEAKREF(sv))
- sv_del_backref(target, sv);
- else
- SvREFCNT_dec(target);
- }
+ return and the overloading of the NULL slots in the size table. */
+ if (SvROK(sv))
+ goto free_rv;
SvFLAGS(sv) &= SVf_BREAK;
SvFLAGS(sv) |= SVTYPEMASK;
return;
&& !CvCONST(destructor)
/* Don't bother calling an empty destructor */
&& (CvISXSUB(destructor)
- || CvSTART(destructor)->op_next->op_type != OP_LEAVESUB))
+ || (CvSTART(destructor)
+ && (CvSTART(destructor)->op_next->op_type != OP_LEAVESUB))))
{
SV* const tmpref = newRV(sv);
SvREADONLY_on(tmpref); /* DESTROY() could be naughty */
/* Don't even bother with turning off the OOK flag. */
}
if (SvROK(sv)) {
- SV * const target = SvRV(sv);
- if (SvWEAKREF(sv))
- sv_del_backref(target, sv);
- else
- SvREFCNT_dec(target);
+ free_rv:
+ {
+ SV * const target = SvRV(sv);
+ if (SvWEAKREF(sv))
+ sv_del_backref(target, sv);
+ else
+ SvREFCNT_dec(target);
+ }
}
#ifdef PERL_OLD_COPY_ON_WRITE
else if (SvPVX_const(sv)) {
}
assert(mg);
mg->mg_len = ulen;
+ /* For now, treat "overflowed" as "still unknown".
+ See RT #72924. */
+ if (ulen != (STRLEN) mg->mg_len)
+ mg->mg_len = -1;
}
}
return ulen;
/*
-=for apidoc sv_pos_u2b
+=for apidoc sv_pos_u2b_flags
Converts the value pointed to by offsetp from a count of UTF-8 chars from
the start of the string, to a count of the equivalent number of bytes; if
lenp is non-zero, it does the same to lenp, but this time starting from
-the offset, rather than from the start of the string. Handles magic and
-type coercion.
+the offset, rather than from the start of the string. Handles type coercion.
+I<flags> is passed to C<SvPV_flags>, and usually should be
+C<SV_GMAGIC|SV_CONST_RETURN> to handle magic.
=cut
*/
/*
- * sv_pos_u2b() uses, like sv_pos_b2u(), the mg_ptr of the potential
+ * sv_pos_u2b_flags() uses, like sv_pos_b2u(), the mg_ptr of the potential
* PERL_MAGIC_utf8 of the sv to store the mapping between UTF-8 and
* byte offsets. See also the comments of S_utf8_mg_pos_cache_update().
*
*/
-void
-Perl_sv_pos_u2b(pTHX_ register SV *const sv, I32 *const offsetp, I32 *const lenp)
+STRLEN
+Perl_sv_pos_u2b_flags(pTHX_ SV *const sv, STRLEN uoffset, STRLEN *const lenp,
+ U32 flags)
{
const U8 *start;
STRLEN len;
+ STRLEN boffset;
- PERL_ARGS_ASSERT_SV_POS_U2B;
-
- if (!sv)
- return;
+ PERL_ARGS_ASSERT_SV_POS_U2B_FLAGS;
- start = (U8*)SvPV_const(sv, len);
+ start = (U8*)SvPV_flags(sv, len, flags);
if (len) {
- STRLEN uoffset = (STRLEN) *offsetp;
const U8 * const send = start + len;
MAGIC *mg = NULL;
- const STRLEN boffset = sv_pos_u2b_cached(sv, &mg, start, send,
- uoffset, 0, 0);
-
- *offsetp = (I32) boffset;
+ boffset = sv_pos_u2b_cached(sv, &mg, start, send, uoffset, 0, 0);
if (lenp) {
/* Convert the relative offset to absolute. */
- const STRLEN uoffset2 = uoffset + (STRLEN) *lenp;
+ const STRLEN uoffset2 = uoffset + *lenp;
const STRLEN boffset2
= sv_pos_u2b_cached(sv, &mg, start, send, uoffset2,
uoffset, boffset) - boffset;
*lenp = boffset2;
}
- }
- else {
- *offsetp = 0;
- if (lenp)
- *lenp = 0;
+ } else {
+ if (lenp)
+ *lenp = 0;
+ boffset = 0;
}
- return;
+ return boffset;
+}
+
+/*
+=for apidoc sv_pos_u2b
+
+Converts the value pointed to by offsetp from a count of UTF-8 chars from
+the start of the string, to a count of the equivalent number of bytes; if
+lenp is non-zero, it does the same to lenp, but this time starting from
+the offset, rather than from the start of the string. Handles magic and
+type coercion.
+
+Use C<sv_pos_u2b_flags> in preference, which correctly handles strings longer
+than 2Gb.
+
+=cut
+*/
+
+/*
+ * sv_pos_u2b() uses, like sv_pos_b2u(), the mg_ptr of the potential
+ * PERL_MAGIC_utf8 of the sv to store the mapping between UTF-8 and
+ * byte offsets. See also the comments of S_utf8_mg_pos_cache_update().
+ *
+ */
+
+/* This function is subject to size and sign problems */
+
+void
+Perl_sv_pos_u2b(pTHX_ register SV *const sv, I32 *const offsetp, I32 *const lenp)
+{
+ PERL_ARGS_ASSERT_SV_POS_U2B;
+
+ if (lenp) {
+ STRLEN ulen = (STRLEN)*lenp;
+ *offsetp = (I32)sv_pos_u2b_flags(sv, (STRLEN)*offsetp, &ulen,
+ SV_GMAGIC|SV_CONST_RETURN);
+ *lenp = (I32)ulen;
+ } else {
+ *offsetp = (I32)sv_pos_u2b_flags(sv, (STRLEN)*offsetp, NULL,
+ SV_GMAGIC|SV_CONST_RETURN);
+ }
}
/* Create and update the UTF8 magic offset cache, with the proffered utf8/
C<len> bytes long. If the C<s> argument is NULL the new SV will be undefined.
Currently the only flag bits accepted are C<SVf_UTF8> and C<SVs_TEMP>.
If C<SVs_TEMP> is set, then C<sv2mortal()> is called on the result before
-returning. If C<SVf_UTF8> is set, then it will be set on the new SV.
+returning. If C<SVf_UTF8> is set, C<s> is considered to be in UTF-8 and the
+C<SVf_UTF8> flag will be set on the new SV.
C<newSVpvn_utf8()> is a convenience wrapper for this function, defined as
#define newSVpvn_utf8(s, len, u) \
const char * const ref = sv_reftype(sv,0);
if (PL_op)
Perl_croak(aTHX_ "Can't coerce readonly %s to string in %s",
- ref, OP_NAME(PL_op));
+ ref, OP_DESC(PL_op));
else
Perl_croak(aTHX_ "Can't coerce readonly %s to string", ref);
}
if ((SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM)
|| isGV_with_GP(sv))
Perl_croak(aTHX_ "Can't coerce %s to string in %s", sv_reftype(sv,0),
- OP_NAME(PL_op));
+ OP_DESC(PL_op));
s = sv_2pv_flags(sv, &len, flags);
if (lp)
*lp = len;
while (isDIGIT(**pattern)) {
const I32 tmp = var * 10 + (*(*pattern)++ - '0');
if (tmp < var)
- Perl_croak(aTHX_ "Integer overflow in format string for %s", (PL_op ? OP_NAME(PL_op) : "sv_vcatpvfn"));
+ Perl_croak(aTHX_ "Integer overflow in format string for %s", (PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn"));
var = tmp;
}
}
else if (svix < svmax) {
sv_catsv(sv, *svargs);
}
+ else
+ S_vcatpvfn_missing_argument(aTHX);
return;
}
if (args && patlen == 3 && pat[0] == '%' &&
pp = pat + 2;
while (*pp >= '0' && *pp <= '9')
digits = 10 * digits + (*pp++ - '0');
- if (pp - pat == (int)patlen - 1) {
- NV nv;
-
- if (svix < svmax)
- nv = SvNV(*svargs);
- else
- return;
+ if (pp - pat == (int)patlen - 1 && svix < svmax) {
+ const NV nv = SvNV(*svargs);
if (*pp == 'g') {
/* Add check for digits != 0 because it seems that some
gconverts are buggy in this case, and we don't yet have
goto vector;
}
}
+ SvTAINT(sv);
}
/* =========================================================================
#endif /* USE_ITHREADS */
+struct ptr_tbl_arena {
+ struct ptr_tbl_arena *next;
+ struct ptr_tbl_ent array[1023/3]; /* as ptr_tbl_ent has 3 pointers. */
+};
+
/* create a new pointer-mapping table */
PTR_TBL_t *
Newx(tbl, 1, PTR_TBL_t);
tbl->tbl_max = 511;
tbl->tbl_items = 0;
+ tbl->tbl_arena = NULL;
+ tbl->tbl_arena_next = NULL;
+ tbl->tbl_arena_end = NULL;
Newxz(tbl->tbl_ary, tbl->tbl_max + 1, PTR_TBL_ENT_t*);
return tbl;
}
#define PTR_TABLE_HASH(ptr) \
((PTR2UV(ptr) >> 3) ^ (PTR2UV(ptr) >> (3 + 7)) ^ (PTR2UV(ptr) >> (3 + 17)))
-/*
- we use the PTE_SVSLOT 'reservation' made above, both here (in the
- following define) and at call to new_body_inline made below in
- Perl_ptr_table_store()
- */
-
-#define del_pte(p) del_body_type(p, PTE_SVSLOT)
-
/* map an existing pointer using a table */
STATIC PTR_TBL_ENT_t *
} else {
const UV entry = PTR_TABLE_HASH(oldsv) & tbl->tbl_max;
- new_body_inline(tblent, PTE_SVSLOT);
+ if (tbl->tbl_arena_next == tbl->tbl_arena_end) {
+ struct ptr_tbl_arena *new_arena;
+
+ Newx(new_arena, 1, struct ptr_tbl_arena);
+ new_arena->next = tbl->tbl_arena;
+ tbl->tbl_arena = new_arena;
+ tbl->tbl_arena_next = new_arena->array;
+ tbl->tbl_arena_end = new_arena->array
+ + sizeof(new_arena->array) / sizeof(new_arena->array[0]);
+ }
+
+ tblent = tbl->tbl_arena_next++;
tblent->oldval = oldsv;
tblent->newval = newsv;
}
/* remove all the entries from a ptr table */
+/* Deprecated - will be removed post 5.14 */
void
Perl_ptr_table_clear(pTHX_ PTR_TBL_t *const tbl)
{
if (tbl && tbl->tbl_items) {
- register PTR_TBL_ENT_t * const * const array = tbl->tbl_ary;
- UV riter = tbl->tbl_max;
+ struct ptr_tbl_arena *arena = tbl->tbl_arena;
- do {
- PTR_TBL_ENT_t *entry = array[riter];
+ Zero(tbl->tbl_ary, tbl->tbl_max + 1, struct ptr_tbl_ent **);
- while (entry) {
- PTR_TBL_ENT_t * const oentry = entry;
- entry = entry->next;
- del_pte(oentry);
- }
- } while (riter--);
+ while (arena) {
+ struct ptr_tbl_arena *next = arena->next;
+
+ Safefree(arena);
+ arena = next;
+ };
tbl->tbl_items = 0;
+ tbl->tbl_arena = NULL;
+ tbl->tbl_arena_next = NULL;
+ tbl->tbl_arena_end = NULL;
}
}
void
Perl_ptr_table_free(pTHX_ PTR_TBL_t *const tbl)
{
+ struct ptr_tbl_arena *arena;
+
if (!tbl) {
return;
}
- ptr_table_clear(tbl);
+
+ arena = tbl->tbl_arena;
+
+ while (arena) {
+ struct ptr_tbl_arena *next = arena->next;
+
+ Safefree(arena);
+ arena = next;
+ }
+
Safefree(tbl->tbl_ary);
Safefree(tbl);
}
else {
while (items-- > 0)
*dst_ary++ = sv_dup(*src_ary++, param);
+ if (!(param->flags & CLONEf_COPY_STACKS)
+ && AvREIFY(sstr))
+ {
+ av_reify(MUTABLE_AV(dstr)); /* #41138 */
+ }
}
items = AvMAX((const AV *)sstr) - AvFILLp((const AV *)sstr);
while (items-- > 0) {
daux->xhv_riter = saux->xhv_riter;
daux->xhv_eiter = saux->xhv_eiter
? he_dup(saux->xhv_eiter,
- (bool)!!HvSHAREKEYS(sstr), param) : 0;
+ cBOOL(HvSHAREKEYS(sstr)), param) : 0;
/* backref array needs refcnt=2; see sv_add_backref */
daux->xhv_backreferences =
saux->xhv_backreferences
#define TOPLONG(ss,ix) ((ss)[ix].any_long)
#define POPIV(ss,ix) ((ss)[--(ix)].any_iv)
#define TOPIV(ss,ix) ((ss)[ix].any_iv)
+#define POPUV(ss,ix) ((ss)[--(ix)].any_uv)
+#define TOPUV(ss,ix) ((ss)[ix].any_uv)
#define POPBOOL(ss,ix) ((ss)[--(ix)].any_bool)
#define TOPBOOL(ss,ix) ((ss)[ix].any_bool)
#define POPPTR(ss,ix) ((ss)[--(ix)].any_ptr)
Newxz(nss, max, ANY);
while (ix > 0) {
- const I32 type = POPINT(ss,ix);
- TOPINT(nss,ix) = type;
+ const UV uv = POPUV(ss,ix);
+ const U8 type = (U8)uv & SAVE_MASK;
+
+ TOPUV(nss,ix) = uv;
switch (type) {
+ case SAVEt_CLEARSV:
+ break;
case SAVEt_HELEM: /* hash element */
sv = (const SV *)POPPTR(ss,ix);
TOPPTR(nss,ix) = sv_dup_inc(sv, param);
case SAVEt_LONG: /* long reference */
ptr = POPPTR(ss,ix);
TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
- /* fall through */
- case SAVEt_CLEARSV:
longval = (long)POPLONG(ss,ix);
TOPLONG(nss,ix) = longval;
break;
case SAVEt_I32: /* I32 reference */
- case SAVEt_I16: /* I16 reference */
- case SAVEt_I8: /* I8 reference */
case SAVEt_COP_ARYBASE: /* call CopARYBASE_set */
ptr = POPPTR(ss,ix);
TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
case SAVEt_VPTR: /* random* reference */
ptr = POPPTR(ss,ix);
TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+ /* Fall through */
+ case SAVEt_INT_SMALL:
+ case SAVEt_I32_SMALL:
+ case SAVEt_I16: /* I16 reference */
+ case SAVEt_I8: /* I8 reference */
+ case SAVEt_BOOL:
ptr = POPPTR(ss,ix);
TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
break;
TOPPTR(nss,ix) = pv_dup(c);
break;
case SAVEt_GP: /* scalar reference */
+ gv = (const GV *)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = gv_dup_inc(gv, param);
gp = (GP*)POPPTR(ss,ix);
TOPPTR(nss,ix) = gp = gp_dup(gp, param);
(void)GpREFCNT_inc(gp);
- gv = (const GV *)POPPTR(ss,ix);
- TOPPTR(nss,ix) = gv_dup_inc(gv, param);
- break;
+ i = POPINT(ss,ix);
+ TOPINT(nss,ix) = i;
+ break;
case SAVEt_FREEOP:
ptr = POPPTR(ss,ix);
if (ptr && (((OP*)ptr)->op_private & OPpREFCOUNTED)) {
break;
case SAVEt_REGCONTEXT:
case SAVEt_ALLOC:
- i = POPINT(ss,ix);
- TOPINT(nss,ix) = i;
- ix -= i;
+ ix -= uv >> SAVE_TIGHT_SHIFT;
break;
case SAVEt_AELEM: /* array element */
sv = (const SV *)POPPTR(ss,ix);
sv = (const SV *)POPPTR(ss,ix);
TOPPTR(nss,ix) = sv_dup_inc(sv, param);
break;
- case SAVEt_BOOL:
- ptr = POPPTR(ss,ix);
- TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
- longval = (long)POPBOOL(ss,ix);
- TOPBOOL(nss,ix) = (bool)longval;
- break;
case SAVEt_SET_SVFLAGS:
i = POPINT(ss,ix);
TOPINT(nss,ix) = i;
PerlInterpreter * const my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter));
PERL_ARGS_ASSERT_PERL_CLONE_USING;
+#else /* !PERL_IMPLICIT_SYS */
+ IV i;
+ CLONE_PARAMS clone_params;
+ CLONE_PARAMS* param = &clone_params;
+ PerlInterpreter * const my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
+
+ PERL_ARGS_ASSERT_PERL_CLONE;
+#endif /* PERL_IMPLICIT_SYS */
/* for each stash, determine whether its objects should be cloned */
S_visit(proto_perl, do_mark_cloneable_stash, SVt_PVHV, SVTYPEMASK);
PERL_SET_THX(my_perl);
-# ifdef DEBUGGING
+#ifdef DEBUGGING
PoisonNew(my_perl, 1, PerlInterpreter);
PL_op = NULL;
PL_curcop = NULL;
PL_sig_pending = 0;
PL_parser = NULL;
Zero(&PL_debug_pad, 1, struct perl_debug_pad);
-# else /* !DEBUGGING */
+# ifdef DEBUG_LEAKING_SCALARS
+ PL_sv_serial = (((U32)my_perl >> 2) & 0xfff) * 1000000;
+# endif
+#else /* !DEBUGGING */
Zero(my_perl, 1, PerlInterpreter);
-# endif /* DEBUGGING */
+#endif /* DEBUGGING */
+#ifdef PERL_IMPLICIT_SYS
/* host pointers */
PL_Mem = ipM;
PL_MemShared = ipMS;
PL_Dir = ipD;
PL_Sock = ipS;
PL_Proc = ipP;
-#else /* !PERL_IMPLICIT_SYS */
- IV i;
- CLONE_PARAMS clone_params;
- CLONE_PARAMS* param = &clone_params;
- PerlInterpreter * const my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
-
- PERL_ARGS_ASSERT_PERL_CLONE;
-
- /* for each stash, determine whether its objects should be cloned */
- S_visit(proto_perl, do_mark_cloneable_stash, SVt_PVHV, SVTYPEMASK);
- PERL_SET_THX(my_perl);
-
-# ifdef DEBUGGING
- PoisonNew(my_perl, 1, PerlInterpreter);
- PL_op = NULL;
- PL_curcop = NULL;
- PL_markstack = 0;
- PL_scopestack = 0;
- PL_scopestack_name = 0;
- PL_savestack = 0;
- PL_savestack_ix = 0;
- PL_savestack_max = -1;
- PL_sig_pending = 0;
- PL_parser = NULL;
- Zero(&PL_debug_pad, 1, struct perl_debug_pad);
-# else /* !DEBUGGING */
- Zero(my_perl, 1, PerlInterpreter);
-# endif /* DEBUGGING */
#endif /* PERL_IMPLICIT_SYS */
+
param->flags = flags;
param->proto_perl = proto_perl;
SvNV_set(&PL_sv_yes, 1);
ptr_table_store(PL_ptr_table, &proto_perl->Isv_yes, &PL_sv_yes);
+ /* dbargs array probably holds garbage */
+ PL_dbargs = NULL;
+
/* create (a non-shared!) shared string table */
PL_strtab = newHV();
HvSHAREKEYS_off(PL_strtab);
PL_DBsingle = sv_dup(proto_perl->IDBsingle, param);
PL_DBtrace = sv_dup(proto_perl->IDBtrace, param);
PL_DBsignal = sv_dup(proto_perl->IDBsignal, param);
- PL_dbargs = av_dup(proto_perl->Idbargs, param);
/* symbol tables */
PL_defstash = hv_dup_inc(proto_perl->Idefstash, param);
PL_bodytarget = sv_dup_inc(proto_perl->Ibodytarget, param);
PL_formtarget = sv_dup(proto_perl->Iformtarget, param);
+ PL_restartjmpenv = proto_perl->Irestartjmpenv;
PL_restartop = proto_perl->Irestartop;
PL_in_eval = proto_perl->Iin_eval;
PL_delaymagic = proto_perl->Idelaymagic;
#endif
/* There is collusion here with sv_clear - sv_clear exits early for SVt_NULL
- and SVt_IV, so never reaches the clause at the end that uses
- sv_type_details->body_size to determine whether to call safefree(). Hence
- body_size can be set no-zero to record the size of PTEs and HEs, without
- fear of bogus frees. */
-#ifdef PERL_IN_SV_C
-#define PTE_SVSLOT SVt_IV
-#endif
+ so never reaches the clause at the end that uses sv_type_details->body_size
+ to determine whether to call safefree(). Hence body_size can be set
+ non-zero to record the size of HEs, without fear of bogus frees. */
#if defined(PERL_IN_HV_C) || defined(PERL_IN_XS_APITEST)
#define HE_SVSLOT SVt_NULL
#endif
* This is used when the caller has already determined it is, and avoids
* redundant work */
#define SV_FORCE_UTF8_UPGRADE 4096
+/* if (after resolving magic etc), the SV is found to be overloaded,
+ * don't call the overload magic, just return as-is */
+#define SV_SKIP_OVERLOAD 8192
/* The core is safe for this COW optimisation. XS code on CPAN may not be.
So only default to doing the COW setup if we're in the core.
#define sv_utf8_upgrade(sv) sv_utf8_upgrade_flags(sv, SV_GMAGIC)
#define sv_2iv(sv) sv_2iv_flags(sv, SV_GMAGIC)
#define sv_2uv(sv) sv_2uv_flags(sv, SV_GMAGIC)
+#define sv_2nv(sv) sv_2nv_flags(sv, SV_GMAGIC)
#define sv_insert(bigstr, offset, len, little, littlelen) \
Perl_sv_insert_flags(aTHX_ (bigstr),(offset), (len), (little), \
(littlelen), SV_GMAGIC)
+=encoding utf8
+
=head1 BASE PORT
=head2 Console
- The Console only does "ASCII" input: e.g. pressing the "2"
- key five times, "aaaaa", does not produce "ä" ("a diaeresis"),
+ key five times, "aaaaa", does not produce "ä" ("a diaeresis"),
but instead the "2" key rotates through "abc2abc2...".
This is a pity because the Console is actually capable of full
Unicode input and output (if you have the fonts, that is). You
d_pipe='undef'
d_poll='undef'
d_portable='undef'
+d_prctl='undef'
+d_prctl_set_name='undef'
d_printf_format_null='undef'
d_procselfexe='undef'
d_pseudofork='undef'
uvsize='4'
uvtype='unsigned long'
uvuformat='"lu"'
+vaproto='undef'
vendorlib_stem=''
vendorlib=''
vendorlibexp=''
# Ensure that syntax using colons (:) is parsed correctly.
# The tests are done on the following tokens (by default):
# ABC LABEL XYZZY m q qq qw qx s tr y AUTOLOAD and alarm
-# -- Robin Barker <rmb@cise.npl.co.uk>
+# -- Robin Barker
#
# Uncomment this for testing, but don't leave it in for "production", as
not eval "y:echo: eq y|echo|" and
eval "y:echo:ohce: >= 0");
-ok 23, (not eval "AUTOLOAD:1" and
+ok 23, (eval "AUTOLOAD:1" and
not eval "AUTOLOAD:echo: eq AUTOLOAD|echo|" and
not eval "AUTOLOAD:echo:ohce: >= 0");
-ok 24, (not eval "and:1" and
+ok 24, (eval "and:1" and
not eval "and:echo: eq and|echo|" and
not eval "and:echo:ohce: >= 0");
-ok 25, (not eval "alarm:1" and
+ok 25, (eval "alarm:1" and
not eval "alarm:echo: eq alarm|echo|" and
not eval "alarm:echo:ohce: >= 0");
# Tests the scoping of $^H and %^H
-@INC = '../lib';
+BEGIN {
+ @INC = qw(. ../lib);
+}
-BEGIN { print "1..23\n"; }
+BEGIN { print "1..24\n"; }
BEGIN {
print "not " if exists $^H{foo};
print "ok 1 - \$^H{foo} doesn't exist initially\n";
print +($rf2 eq "z" ? "" : "not "), "ok 22 - \$^H{foo} correct after require\n";
}
+# [perl #73174]
+
+{
+ my $res;
+ BEGIN { $^H{73174} = "foo" }
+ BEGIN { $res = ($^H{73174} // "") }
+ "" =~ /\x{100}/i; # forces loading of utf8.pm, which used to reset %^H
+ BEGIN { $res .= '-' . ($^H{73174} // "")}
+ $res .= '-' . ($^H{73174} // "");
+ print $res eq "foo-foo-" ? "" : "not ",
+ "ok 23 - \$^H{foo} correct after /unicode/i (res=$res)\n";
+}
+
+
+
# Add new tests above this require, in case it fails.
require './test.pl';
stderr => 1
);
print "not " if length $result;
-print "ok 23 - double-freeing hints hash\n";
+print "ok 24 - double-freeing hints hash\n";
print "# got: $result\n" if length $result;
__END__
#!./perl
-print "1..22\n";
+print "1..14\n";
$blurfl = 123;
$foo = 3;
print __PACKAGE__ eq 'bug32562' ? "ok 13\n" : "not ok 13\n";
print eval '__PACKAGE__' eq 'bug32562' ? "ok 14\n" : "not ok 14\n";
-# test: package NAME VERSION
-
-my @variations = (
- '1.00',
- '1.00_01',
- 'v1.2.3',
- 'v1.2_3',
-);
-
-my $test_count = 15;
-
-for my $v ( @variations ) {
- my $ok = eval "package withversion $v; $v eq \$withversion::VERSION";
- print $ok ? "ok $test_count\n" : "not ok $test_count\n";
- $test_count++;
-}
-
-eval q/package Foo Bar/;
-$@ =~ /syntax error/ or print "not ";
-print "ok $test_count\n"; $test_count++;
-
-eval q/package Foo 1a/;
-$@ =~ /syntax error/ or print "not ";
-print "ok $test_count\n"; $test_count++;
-
-eval q/package Foo v/;
-$@ =~ /syntax error/ or print "not ";
-print "ok $test_count\n"; $test_count++;
-
-eval q/package Foo $foo/;
-$@ =~ /syntax error/ or print "not ";
-print "ok $test_count\n"; $test_count++;
# Checks if the parser behaves correctly in edge cases
# (including weird syntax errors)
-print "1..118\n";
+print "1..122\n";
sub failed {
my ($got, $expected, $name) = @_;
}
{
+ is(exists &zlonk, '', 'sub not present');
eval qq[ {sub zlonk} ];
is($@, '', 'sub declaration followed by a closing curly');
+ is(exists &zlonk, 1, 'sub now stubbed');
+ is(defined &zlonk, '', 'but no body defined');
}
+# bug #71748
+eval q{
+ $_ = "";
+ s/(.)/
+ {
+ #
+ }->{$1};
+ /e;
+ 1;
+};
+is($@, "", "multiline whitespace inside substitute expression");
+
# Add new tests HERE:
# More awkward tests for #line. Keep these at the end, as they will screw
--- /dev/null
+#!./perl
+#
+# tests for default output handle
+
+# DAPM 30/4/10 this area seems to have been undertested. For now, the only
+# tests are ensuring things don't crash when PL_defoutgv isn't a GV;
+# it probably needs expanding at some point to cover other stuff.
+
+BEGIN {
+ chdir 't';
+ @INC = '../lib';
+ require './test.pl';
+}
+
+plan tests => 16;
+
+
+my $stderr = *STDERR;
+select($stderr);
+$stderr = 1; # whoops, PL_defoutgv no longer a GV!
+
+# note that in the tests below, the return values aren't as important
+# as the fact that they don't crash
+
+ok !print(""), 'print';
+ok !select(), 'select';
+$a = 'fooo';
+format STDERR =
+#@<<
+$a;
+.
+ok ! write(), 'write';
+
+is($^, "", '$^');
+is($~, "", '$~');
+is($=, undef, '$=');
+is($-, undef, '$-');
+is($%, undef, '$%');
+is($|, 0, '$|');
+$^ = 1; pass '$^ = 1';
+$~ = 1; pass '$~ = 1';
+$= = 1; pass '$= = 1';
+$- = 1; pass '$- = 1';
+$% = 1; pass '$% = 1';
+$| = 1; pass '$| = 1';
+ok !close(), 'close';
+
# http://rt.perl.org/rt3/Ticket/Display.html?id=39060
use strict;
+use Config;
+
require './test.pl';
plan( tests => 16 );
SKIP:
for my $test_in ("test\n", "test") {
skip("Guaranteed newline at EOF on VMS", 4) if $^O eq 'VMS' && $test_in eq 'test';
+ skip("[perl #71504] OpenBSD test failures in errno.t with ithreads and perlio", 8)
+ if $^O eq 'openbsd' && $Config{useithreads} && $perlio eq 'stdio';
my $test_in_esc = $test_in;
$test_in_esc =~ s/\n/\\n/g;
for my $rs_code ('', '$/=undef', '$/=\2', '$/=\1024') {
+ TODO:
+ {
+ local $::TODO = "We get RMS\$_IOP at EOF on VMS when \$/ is undef"
+ if $^O eq 'VMS' && $rs_code eq '$/=undef';
is( runperl( prog => "$rs_code; $test_prog",
stdin => $test_in, stderr => 1),
$test_in,
"Wrong errno, PERLIO=$ENV{PERLIO} stdin='$test_in_esc', $rs_code");
+ }
}
}
}
use warnings;
use Config;
-plan tests => 108;
+plan tests => 109;
my $Perl = which_perl();
eval { open $99, "foo" };
like($@, qr/Modification of a read-only value attempted/, "readonly fh");
+
+# [perl#73626] mg_get wasn't run on the pipe arg
+
+{
+ package p73626;
+ sub TIESCALAR { bless {} }
+ sub FETCH { "$Perl -e 1"}
+
+ tie my $p, 'p73626';
+
+ package main;
+
+ ok( open(my $f, '-|', $p), 'open -| magic');
+}
require './test.pl';
}
-plan tests => 40;
+plan tests => 42;
use_ok('PerlIO');
close OLDOUT;
SKIP: {
- skip("TMPDIR not honored on this platform", 2)
+ skip("TMPDIR not honored on this platform", 4)
if !$Config{d_mkstemp}
|| $^O eq 'VMS' || $^O eq 'MSwin32' || $^O eq 'os2';
local $ENV{TMPDIR} = $nonexistent;
+
+ # hardcoded default temp path
+ my $perlio_tmp_file_glob = '/tmp/PerlIO_??????';
+
ok( open(my $x,"+<",undef), 'TMPDIR honored by magic temp file via 3 arg open with undef - works if TMPDIR points to a non-existent dir');
+ my $filename = find_filename($x, $perlio_tmp_file_glob);
+ is($filename, undef, "No tmp files leaked");
+ unlink $filename if defined $filename;
+
mkdir $ENV{TMPDIR};
ok(open(my $x,"+<",undef), 'TMPDIR honored by magic temp file via 3 arg open with undef - works if TMPDIR points to an existent dir');
+
+ $filename = find_filename($x, $perlio_tmp_file_glob);
+ is($filename, undef, "No tmp files leaked");
+ unlink $filename if defined $filename;
+ }
+}
+
+sub find_filename {
+ my ($fh, @globs) = @_;
+ my ($dev, $inode) = stat $fh;
+ die "Can't stat $fh: $!" unless defined $dev;
+
+ foreach (@globs) {
+ foreach my $file (glob $_) {
+ my ($this_dev, $this_inode) = stat $file;
+ next unless defined $this_dev;
+ return $file if $this_dev == $dev && $this_inode == $inode;
+ }
}
+ return;
}
# in-memory open
sub translator {
my $str = shift;
if ( $str eq 'EVIL' ) {
+ # Returns A first time, AB second, ABC third ... A-ZA the 27th time.
(my $c=substr("A".$Evil,-1))++;
my $r=$Evil;
$Evil.=$c;
if ( $str eq 'EMPTY-STR') {
return "";
}
+ if ( $str eq 'NULL') {
+ return "\0";
+ }
+ if ( $str eq 'LONG-STR') {
+ return 'A' x 255;
+ }
+ # Should exceed limit for regex \N bytes in a sequence. Anyway it will if
+ # UCHAR_MAX is 255.
+ if ( $str eq 'TOO-LONG-STR') {
+ return 'A' x 256;
+ }
+ if ($str eq 'MALFORMED') {
+ $str = "\xDF\xDFabc";
+ utf8::upgrade($str);
+
+ # Create a malformed in first and second characters.
+ $str =~ s/^\C/A/;
+ $str =~ s/^(\C\C)\C/$1A/;
+ }
return $str;
}
is(Cygwin::win_to_posix_path($winpath, 1), "/", "win to absolute posix path");
my $mount = join '', `/usr/bin/mount`;
-$mount =~ m|on /usr/bin type .+ \((\w+mode)[,\)]|m;
-my $binmode = $1 eq 'binmode';
+$mount =~ m|on /usr/bin type .+ \((\w+)[,\)]|m;
+my $binmode = $1 =~ /binmode|binary/;
is(Cygwin::is_binmount("/"), $binmode ? 1 : '', "check / for binmount");
my $rootmnt = Cygwin::mount_flags("/");
-ok($binmode ? ($rootmnt =~ /,binmode/) : ($rootmnt =~ /,textmode/), "check / mount_flags");
+ok($binmode ? ($rootmnt =~ /,(binmode|binary)/) : ($rootmnt =~ /,textmode/), "check / mount_flags");
is(Cygwin::mount_flags("/cygdrive") =~ /,cygdrive/, 1, "check cygdrive mount_flags");
# Cygdrive mount prefix
defined(%hash) is deprecated at - line 4.
(Maybe you should just omit the defined()?)
Can't use string ("foo") as a HASH ref while "strict refs" in use at - line 4.
+########
+# [perl #74168] Assertion failed: (SvTYPE(_svcur) >= SVt_PV), function Perl_softref2xv, file pp.c, line 240.
+use strict 'refs';
+my $o = 1 ; $o->{1} ;
+EXPECT
+Can't use string ("1") as a HASH ref while "strict refs" in use at - line 3.
EXPECT
Global symbol "$foo" requires explicit package name at (re_eval 1) line 1.
Compilation failed in regexp at - line 3.
+########
+# [perl #73712] 'Variable is not imported' should be suppressable
+$dweck;
+use strict 'vars';
+no warnings;
+eval q/$dweck/;
+EXPECT
{ bless ['B'], 'Foo' for 1..10 }
EXPECT
(in cleanup) A foo bar at - line 4.
+ (in cleanup) A foo bar at - line 4.
+ (in cleanup) A foo bar at - line 4.
+ (in cleanup) A foo bar at - line 4.
+ (in cleanup) A foo bar at - line 4.
+ (in cleanup) A foo bar at - line 4.
+ (in cleanup) A foo bar at - line 4.
+ (in cleanup) A foo bar at - line 4.
+ (in cleanup) A foo bar at - line 4.
+ (in cleanup) A foo bar at - line 4.
+ (in cleanup) B foo bar at - line 4.
+ (in cleanup) B foo bar at - line 4.
+ (in cleanup) B foo bar at - line 4.
+ (in cleanup) B foo bar at - line 4.
+ (in cleanup) B foo bar at - line 4.
+ (in cleanup) B foo bar at - line 4.
+ (in cleanup) B foo bar at - line 4.
+ (in cleanup) B foo bar at - line 4.
+ (in cleanup) B foo bar at - line 4.
(in cleanup) B foo bar at - line 4.
########
# pp_ctl.c
use strict;
use warnings;
-require q(./test.pl); plan(tests => 44);
+require q(./test.pl); plan(tests => 48);
require mro;
}
{
+ # assigning @ISA via arrayref then modifying it RT 72866
+ {
+ package Q1;
+ sub foo { }
+
+ package Q2;
+ sub bar { }
+
+ package Q3;
+ }
+ push @Q3::ISA, "Q1";
+ can_ok("Q3", "foo");
+ *Q3::ISA = [];
+ push @Q3::ISA, "Q1";
+ can_ok("Q3", "foo");
+ *Q3::ISA = [];
+ push @Q3::ISA, "Q2";
+ can_ok("Q3", "bar");
+ ok(!Q3->can("foo"), "can't call foo method any longer");
+}
+
+{
# test mro::method_changed_in
my $count = mro::get_pkg_gen("MRO_A");
mro::method_changed_in("MRO_A");
=pod
-example taken from: L<http://gauss.gwydiondylan.org/books/drm/drm_50.html>
+example taken from: L<http://www.opendylan.org/books/drm/Method_Dispatch>
Object
^
=pod
-example taken from: L<http://gauss.gwydiondylan.org/books/drm/drm_50.html>
+example taken from: L<http://www.opendylan.org/books/drm/Method_Dispatch>
Object
^
#
# Verify which OP= operators warn if their targets are undefined.
# Based on redef.t, contributed by Graham Barr <Graham.Barr@tiuk.ti.com>
-# -- Robin Barker <rmb@cise.npl.co.uk>
+# -- Robin Barker
#
BEGIN {
use warnings;
-plan 91;
+plan 92;
$SIG{__WARN__} = sub { die @_ };
@attrs = eval 'attributes::get \&A::PS';
is "@attrs", "lvalue";
+# Test attributes on predeclared subroutines, after definition
+eval 'package A; sub PS : lvalue; sub PS { }';
+@attrs = eval 'attributes::get \&A::PS';
+is "@attrs", "lvalue";
+
# Test ability to modify existing sub's (or XSUB's) attributes.
-eval 'package A; sub X { $_[0] } sub X : lvalue';
+eval 'package A; sub X { $_[0] } sub X : method';
@attrs = eval 'attributes::get \&A::X';
-is "@attrs", "lvalue";
+is "@attrs", "method";
# Above not with just 'pure' built-in attributes.
sub Z::MODIFY_CODE_ATTRIBUTES { (); }
-eval 'package Z; sub L { $_[0] } sub L : Z lvalue';
+eval 'package Z; sub L { $_[0] } sub L : Z method';
@attrs = eval 'attributes::get \&Z::L';
-is "@attrs", "lvalue Z";
+is "@attrs", "method Z";
# Begin testing attributes that tie
--- /dev/null
+#!./perl
+
+print "1..12\n";
+my $test_num = 0;
+sub ok {
+ print $_[0] ? "" : "not ", "ok ", ++$test_num, "\n";
+}
+
+{
+ package End;
+ sub DESTROY { $_[0]->() }
+ sub main::end(&) {
+ my($cleanup) = @_;
+ return bless(sub { $cleanup->() }, "End");
+ }
+}
+
+my($val, $err);
+
+$@ = "t0\n";
+$val = eval {
+ $@ = "t1\n";
+ 1;
+}; $err = $@;
+ok $val == 1;
+ok $err eq "";
+
+$@ = "t0\n";
+$val = eval {
+ $@ = "t1\n";
+ do {
+ die "t3\n";
+ };
+ 1;
+}; $err = $@;
+ok !defined($val);
+ok $err eq "t3\n";
+
+$@ = "t0\n";
+$val = eval {
+ $@ = "t1\n";
+ local $@ = "t2\n";
+ 1;
+}; $err = $@;
+ok $val == 1;
+ok $err eq "";
+
+$@ = "t0\n";
+$val = eval {
+ $@ = "t1\n";
+ local $@ = "t2\n";
+ do {
+ die "t3\n";
+ };
+ 1;
+}; $err = $@;
+ok !defined($val);
+ok $err eq "t3\n";
+
+$@ = "t0\n";
+$val = eval {
+ $@ = "t1\n";
+ my $c = end { $@ = "t2\n"; };
+ 1;
+}; $err = $@;
+ok $val == 1;
+ok $err eq "";
+
+$@ = "t0\n";
+$val = eval {
+ $@ = "t1\n";
+ my $c = end { $@ = "t2\n"; };
+ do {
+ die "t3\n";
+ };
+ 1;
+}; $err = $@;
+ok !defined($val);
+ok $err eq "t3\n";
+
+1;
#
# Verify that C<die> return the return code
-# -- Robin Barker <rmb@cise.npl.co.uk>
+# -- Robin Barker
#
BEGIN {
--- /dev/null
+#!perl -w
+
+BEGIN {
+ chdir 't' if -d 't';
+ require 'test.pl';
+ plan(20);
+}
+
+sub End::DESTROY { $_[0]->() }
+
+sub end(&) {
+ my($c) = @_;
+ return bless(sub { $c->() }, "End");
+}
+
+foreach my $inx ("", "aabbcc\n", [qw(aa bb cc)]) {
+ foreach my $outx ("", "xxyyzz\n", [qw(xx yy zz)]) {
+ my $warn = "";
+ local $SIG{__WARN__} = sub { $warn .= $_[0] };
+ {
+ $@ = $outx;
+ my $e = end { die $inx if $inx };
+ }
+ ok ref($@) eq ref($outx) && $@ eq $outx;
+ $warn =~ s/ at [^\n]*\n\z//;
+ is $warn, $inx ? "\t(in cleanup) $inx" : "";
+ }
+}
+
+{
+ no warnings "misc";
+ my $warn = "";
+ local $SIG{__WARN__} = sub { $warn .= $_[0] };
+ { my $e = end { die "aa\n"; }; }
+ is $warn, "";
+}
+
+{
+ my $warn = "";
+ local $SIG{__WARN__} = sub { $warn .= $_[0] };
+ { my $e = end { no warnings "misc"; die "aa\n"; }; }
+ is $warn, "\t(in cleanup) aa\n";
+}
+
+1;
require './test.pl';
}
-plan tests => 52;
+plan tests => 54;
$h{'abc'} = 'ABC';
$h{'def'} = 'DEF';
is($rest,3,"Got the expect number of keys");
my $hsv=1 && %foo;
like($hsv,'/',"Got bucket stats from %foo in scalar assignment context");
+ my @arr=%foo&&%foo;
+ is(@arr,10,"Got expected number of elements in list context");
}
{
our %foo=(1..10);
is($rest,3,"Got the expect number of keys");
my $hsv=1 && %foo;
like($hsv,'/',"Got bucket stats from %foo in scalar assignment context");
+ my @arr=%foo&&%foo;
+ is(@arr,10,"Got expected number of elements in list context");
}
require './test.pl';
}
-print "1..105\n";
+print "1..106\n";
eval 'print "ok 1\n";';
my $in = <IN>;
my ($first, $second) = split (/\*\*\*\*\*\*\n/, $in, 2);
$first =~ s/,pNOK//;
+ s/ PV = 0x[0-9a-f]+/ PV = 0x/ foreach $first, $second;
+ s/ LEN = [0-9]+/ LEN = / foreach $first, $second;
$ok = 1 if ($first eq $second);
}
}
};
print "ok\n";
EOP
+
+ fresh_perl_is(<<'EOP', "ok\n", undef, 'segfault on syntax errors in block evals');
+# localize the hits hash so the eval ends up with the pad offset of a copy of it in its targ
+BEGIN { $^H |= 0x00020000 }
+eval q{ eval { + } };
+print "ok\n";
+EOP
+
--- /dev/null
+#!./perl
+
+# There are few filetest operators that are portable enough to test.
+# See pod/perlport.pod for details.
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require './test.pl';
+}
+
+plan 4;
+use FileHandle;
+
+my $str = "foo";
+open my $fh, "<", \$str;
+is <$fh>, "foo";
+
+eval {
+ $fh->seek(0, 0);
+ is $fh->tell, 0;
+ is <$fh>, "foo";
+};
+
+is $@, '';
EXPECT
1
1
+########
+# [perl #72604] @DB::args stops working across Win32 fork
+$|=1;
+sub f {
+ if ($pid = fork()) {
+ print "waitpid() returned ok\n" if waitpid($pid,0) == $pid;
+ }
+ else {
+ package DB;
+ my @c = caller(0);
+ print "child: called as [$c[3](", join(',',@DB::args), ")]\n";
+ exit(0);
+ }
+}
+f("foo", "bar");
+EXPECT
+child: called as [main::f(foo,bar)]
+waitpid() returned ok
use warnings;
use strict;
-plan tests => 66;
+plan tests => 67;
our $TODO;
my $deprecated = 0;
}
is($deprecated, 0);
+
+#74290
+{
+ my $x;
+ my $y;
+ F1:++$x and eval 'return if ++$y == 10; goto F1;';
+ is($x, 10,
+ 'labels outside evals can be distinguished from the start of the eval');
+}
#!./perl
-
-$ENV{PATH} ="/bin:/usr/bin:/usr/xpg4/bin:/usr/ucb" .
- exists $ENV{PATH} ? ":$ENV{PATH}" : "" unless $^O eq 'VMS';
-$ENV{LC_ALL} = "C"; # so that external utilities speak English
-$ENV{LANGUAGE} = 'C'; # GNU locale extension
-
BEGIN {
+ if ( $^O eq 'VMS' ) {
+ my $p = "/bin:/usr/bin:/usr/xpg4/bin:/usr/ucb";
+ if ( $ENV{PATH} ) {
+ $p .= ":$ENV{PATH}";
+ }
+ $ENV{PATH} = $p;
+ }
+ $ENV{LC_ALL} = "C"; # so that external utilities speak English
+ $ENV{LANGUAGE} = 'C'; # GNU locale extension
+
chdir 't';
@INC = '../lib';
+}
+use 5.010;
+use strict;
+use Config ();
+use POSIX ();
+
+unless (eval { my($foo) = getgrgid(0); 1 }) {
+ quit( "getgrgid() not implemented" );
+}
+
+quit("No `id' or `groups'") if
+ $^O eq 'MSWin32'
+ || $^O eq 'NetWare'
+ || $^O eq 'VMS'
+ || $^O =~ /lynxos/i;
+
+Test();
+exit;
+
+
+
+sub Test {
+
+ # Get our supplementary groups from the system by running commands
+ # like `id -a'.
+ my ( $groups_command, $groups_string ) = system_groups()
+ or quit( "No `id' or `groups'" );
+ my @extracted_groups = extract_system_groups( $groups_string )
+ or quit( "Can't parse `${groups_command}'" );
+
+ my $pwgid = $( + 0;
+ my ($pwgnam) = getgrgid($pwgid);
+ $pwgnam //= '';
+ print "# pwgid=$pwgid pwgnam=$pwgnam \$(=$(\n";
+
+ # Get perl's supplementary groups by looking at $(
+ my ( $gid_count, $all_perl_groups ) = perl_groups();
+ my %basegroup = basegroups( $pwgid, $pwgnam );
+ my @extracted_supplementary_groups = remove_basegroup( \ %basegroup, \ @extracted_groups );
+
+ print "1..2\n";
+
+
+ # Test: The supplementary groups in $( should match the
+ # getgroups(2) kernal API call.
+ #
+ my $ngroups_max = posix_ngroups_max();
+ if ( defined $ngroups_max && $ngroups_max < @extracted_groups ) {
+ # Some OSes (like darwin)but conceivably others might return
+ # more groups from `id -a' than can be handled by the
+ # kernel. On darwin, NGROUPS_MAX is 16 and 12 are taken up for
+ # the system already.
+ #
+ # There is more fall-out from this than just Perl's unit
+ # tests. You may be a member of a group according to Active
+ # Directory (or whatever) but the OS won't respect it because
+ # it's the 17th (or higher) group and there's no space to
+ # store your membership.
+ print "ok 1 # SKIP Your platform's `$groups_command' is broken\n";
+ }
- require Config;
- if ($@) {
- print "1..0 # Skip: no Config\n";
- } else {
- Config->import;
+ elsif ( darwin() ) {
+ # darwin uses getgrouplist(3) or an Open Directory API within
+ # /usr/bin/id and /usr/bin/groups which while "nice" isn't
+ # accurate for this test. The hard, real, list of groups we're
+ # running in derives from getgroups(2) and is not dynamic but
+ # the Libc API getgrouplist(3) is.
+ #
+ # In practical terms, this meant that while `id -a' can be
+ # relied on in other OSes to purely use getgroups(2) and show
+ # us what's real, darwin will use getgrouplist(3) to show us
+ # what might be real if only we'd open a new console.
+ #
+ print "ok 1 # SKIP darwin's `${groups_command}' can't be trusted\n";
}
+
+ else {
+
+ # Read $( but ignore any groups in $( that we failed to parse
+ # successfully out of the `id -a` mess.
+ #
+ my @perl_groups = remove_unparsed_entries( \ @extracted_groups,
+ \ @$all_perl_groups );
+ my @supplementary_groups = remove_basegroup( \ %basegroup,
+ \ @perl_groups );
+
+ my $ok1 = 0;
+ if ( match_groups( \ @supplementary_groups,
+ \ @extracted_supplementary_groups,
+ $pwgid ) ) {
+ print "ok 1\n";
+ $ok1 = 1;
+ }
+ elsif ( cygwin_nt() ) {
+ %basegroup = unixy_cygwin_basegroups();
+ @extracted_supplementary_groups = remove_basegroup( \ %basegroup, \ @extracted_groups );
+
+ if ( match_groups( \ @supplementary_groups,
+ \ @extracted_supplementary_groups,
+ $pwgid ) ) {
+ print "ok 1 # This Cygwin behaves like Unix (Win2k?)\n";
+ $ok1 = 1;
+ }
+ }
+
+ unless ( $ok1 ) {
+
+ }
+ }
+
+ # multiple 0's indicate GROUPSTYPE is currently long but should be short
+ $gid_count->{0} //= 0;
+ if ( 0 == $pwgid || $gid_count->{0} < 2 ) {
+ print "ok 2\n";
+ }
+ else {
+ print "not ok 2 (groupstype should be type short, not long)\n";
+ }
+
+ return;
}
+# Cleanly abort this entire test file
sub quit {
- print "1..0 # Skip: no `id` or `groups`\n";
+ print "1..0 # SKIP: @_\n";
exit 0;
}
-unless (eval { getgrgid(0); 1 }) {
- print "1..0 # Skip: getgrgid() not implemented\n";
- exit 0;
-}
+# Get the system groups and the command used to fetch them.
+#
+sub system_groups {
+ my ( $cmd, $groups_string ) = _system_groups();
+
+ if ( $groups_string ) {
+ chomp $groups_string;
+ diag_variable( groups => $groups_string );
+ }
-quit() if (($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS')
- or $^O =~ /lynxos/i);
+ return ( $cmd, $groups_string );
+}
# We have to find a command that prints all (effective
# and real) group names (not ids). The known commands are:
# foo bar zot # accept
# foo 22 42 bar zot # accept
# 1 22 42 2 3 # reject
-# groups=(42),foo(1),bar(2),zot me(3) # parse
-# groups=22,42,1(foo),2(bar),3(zot me) # parse
+# groups=(42),foo(1),bar(2),zot me(3) # parsed by $GROUP_RX1
+# groups=22,42,1(foo),2(bar),3(zot(me)) # parsed by $GROUP_RX2
#
# and the groups= might be after, before, or between uid=... and gid=...
+use constant GROUP_RX1 => qr/
+ ^
+ (?<gr_name>.+)
+ \(
+ (?<gid>\d+)
+ \)
+ $
+/x;
+use constant GROUP_RX2 => qr/
+ ^
+ (?<gid>\d+)
+ \(
+ (?<gr_name>.+)
+ \)
+ $
+/x;
+sub _system_groups {
+ my $cmd;
+ my $str;
-GROUPS: {
# prefer 'id' over 'groups' (is this ever wrong anywhere?)
# and 'id -a' over 'id -Gn' (the former is good about spaces in group names)
- if (($groups = `id -a 2>/dev/null`) ne '') {
- # $groups is of the form:
- # uid=39957(gsar) gid=22(users) groups=33536,39181,22(users),0(root),1067(dev)
- # FreeBSD since 6.2 has a fake id -a:
- # uid=1001(tobez) gid=20(staff) groups=20(staff), 0(wheel), 68(dialer)
- last GROUPS if $groups =~ /groups=/;
+
+ $cmd = 'id -a 2>/dev/null || id 2>/dev/null';
+ $str = `$cmd`;
+ if ( $str && $str =~ /groups=/ ) {
+ # $str is of the form:
+ # uid=39957(gsar) gid=22(users) groups=33536,39181,22(users),0(root),1067(dev)
+ # FreeBSD since 6.2 has a fake id -a:
+ # uid=1001(tobez) gid=20(staff) groups=20(staff), 0(wheel), 68(dialer)
+ # On AIX it's id
+ #
+ # Linux may also have a context= field
+
+ return ( $cmd, $str );
}
- if (($groups = `id -Gn 2>/dev/null`) ne '') {
- # $groups could be of the form:
- # users 33536 39181 root dev
- last GROUPS if $groups !~ /^(\d|\s)+$/;
+
+ $cmd = 'id -Gn 2>/dev/null';
+ $str = `$cmd`;
+ if ( $str && $str !~ /^[\d\s]$/ ) {
+ # $str could be of the form:
+ # users 33536 39181 root dev
+ return ( $cmd, $str );
}
- if (($groups = `groups 2>/dev/null`) ne '') {
- # may not reflect all groups in some places, so do a sanity check
- if (-d '/afs') {
- print <<EOM;
+
+ $cmd = 'groups 2>/dev/null';
+ $str = `$cmd`;
+ if ( $str ) {
+ # may not reflect all groups in some places, so do a sanity check
+ if (-d '/afs') {
+ print <<EOM;
# These test results *may* be bogus, as you appear to have AFS,
# and I can't find a working 'id' in your PATH (which I have set
# to '$ENV{PATH}').
# on this platform to find *all* the groups that an arbitrary
# user may belong to, using the 'perlbug' program.
EOM
- }
- last GROUPS;
- }
- # Okay, not today.
- quit();
-}
-
-chomp($groups);
-
-print "# groups = $groups\n";
-
-# Remember that group names can contain whitespace, '-', et cetera.
-# That is: do not \w, do not \S.
-if ($groups =~ /groups=(.+)( [ug]id=|$)/) {
- my $gr = $1;
- my @g0 = split /, ?/, $gr;
- my @g1;
- # prefer names over numbers
- for (@g0) {
- # 42(zot me)
- if (/^(\d+)(?:\(([^)]+)\))?/) {
- push @g1, ($2 || $1);
- }
- # zot me(42)
- elsif (/^([^(]*)\((\d+)\)/) {
- push @g1, ($1 || $2);
- }
- else {
- print "# ignoring group entry [$_]\n";
- }
+ }
+ return ( $cmd, $str );
}
- print "# groups=$gr\n";
- print "# g0 = @g0\n";
- print "# g1 = @g1\n";
- $groups = "@g1";
-}
-print "1..2\n";
+ return ();
+}
-$pwgid = $( + 0;
-($pwgnam) = getgrgid($pwgid);
-$seen{$pwgid}++;
+# Convert the strings produced by parsing `id -a' into a list of group
+# names
+sub extract_system_groups {
+ my ( $groups_string ) = @_;
-print "# pwgid = $pwgid, pwgnam = $pwgnam\n";
+ # Remember that group names can contain whitespace, '-', '(parens)',
+ # et cetera. That is: do not \w, do not \S.
+ my @extracted;
-for (split(' ', $()) {
- ($group) = getgrgid($_);
- next if (! defined $group or ! grep { $_ eq $group } @gr) and $seen{$_}++;
- if (defined $group) {
- push(@gr, $group);
+ my @fields = split /\b(\w+=)/, $groups_string;
+ my $gr;
+ for my $i (0..@fields-2) {
+ if ($fields[$i] eq 'groups=') {
+ $gr = $fields[$i+1];
+ $gr =~ s/ $//;
+ last;
+ }
}
- else {
- push(@gr, $_);
+ if (defined $gr) {
+ my @g = split m{, ?}, $gr;
+ # prefer names over numbers
+ for (@g) {
+ if ( $_ =~ GROUP_RX1() || $_ =~ GROUP_RX2() ) {
+ push @extracted, $+{gr_name} || $+{gid};
+ }
+ else {
+ print "# ignoring group entry [$_]\n";
+ }
+ }
+
+ diag_variable( gr => $gr );
+ diag_variable( g => join ',', @g );
+ diag_variable( ex_gr => join ',', @extracted );
}
+
+ return @extracted;
}
-print "# gr = @gr\n";
+# Get the POSIX value NGROUPS_MAX.
+sub posix_ngroups_max {
+ return eval {
+ POSIX::NGROUPS_MAX();
+ };
+}
+
+# Test if this is Apple's darwin
+sub darwin {
+ # Observed 'darwin-2level'
+ return $Config::Config{myuname} =~ /^darwin/;
+}
-my %did;
-if ($^O =~ /^(?:uwin|cygwin|interix|solaris|linux|darwin)$/) {
- # Or anybody else who can have spaces in group names.
- $gr1 = join(' ', grep(!$did{$_}++, sort split(' ', join(' ', @gr))));
-} else {
- # Don't assume that there aren't duplicate groups
- $gr1 = join(' ', sort grep defined $_ && !$did{$_}++, @gr);
+# Test if this is Cygwin
+sub cygwin_nt {
+ return $Config::Config{myuname} =~ /^cygwin_nt/i;
}
-if ($Config{myuname} =~ /^cygwin_nt/i) { # basegroup on CYGWIN_NT has id = 0.
- @basegroup{$pwgid,$pwgnam} = (0,0);
-} else {
- @basegroup{$pwgid,$pwgnam} = (1,1);
+# Get perl's supplementary groups and the number of times each gid
+# appeared.
+sub perl_groups {
+ # Lookup perl's own groups from $(
+ my @gids = split ' ', $(;
+ my %gid_count;
+ my @gr_name;
+ for my $gid ( @gids ) {
+ ++ $gid_count{$gid};
+
+ my ($group) = getgrgid $gid;
+
+ # Why does this test prefer to not test groups which we don't have
+ # a name for? One possible answer is that my primary group comes
+ # from from my entry in the user database but isn't mentioned in
+ # the group database. Are there more reasons?
+ next if ! defined $group;
+
+
+ push @gr_name, $group;
+ }
+
+ diag_variable( gr_name => join ',', @gr_name );
+
+ return ( \ %gid_count, \ @gr_name );
}
-$gr2 = join(' ', grep(!$basegroup{$_}++, sort split(' ',$groups)));
-my $ok1 = 0;
-if ($gr1 eq $gr2 || ($gr1 eq '' && $gr2 eq $pwgid)) {
- print "ok 1\n";
- $ok1++;
+# Remove entries from our parsing of $( that don't appear in our
+# parsing of `id -a`.
+sub remove_unparsed_entries {
+ my ( $extracted_groups, $perl_groups ) = @_;
+
+ my %was_extracted =
+ map { $_ => 1 }
+ @$extracted_groups;
+
+ return
+ grep { $was_extracted{$_} }
+ @$perl_groups;
}
-elsif ($Config{myuname} =~ /^cygwin_nt/i) { # basegroup on CYGWIN_NT has id = 0.
- # Retry in default unix mode
- %basegroup = ( $pwgid => 1, $pwgnam => 1 );
- $gr2 = join(' ', grep(!$basegroup{$_}++, sort split(' ',$groups)));
- if ($gr1 eq $gr2 || ($gr1 eq '' && $gr2 eq $pwgid)) {
- print "ok 1 # This Cygwin behaves like Unix (Win2k?)\n";
- $ok1++;
+
+# Get a list of base groups. I'm not sure why cygwin by default is
+# skipped here.
+sub basegroups {
+ my ( $pwgid, $pwgnam ) = @_;
+
+ if ( cygwin_nt() ) {
+ return;
+ }
+ else {
+ return (
+ $pwgid => 1,
+ $pwgnam => 1,
+ );
}
}
-unless ($ok1) {
- print "#gr1 is <$gr1>\n";
- print "#gr2 is <$gr2>\n";
- print "not ok 1\n";
+
+# Cygwin might have another form of basegroup which we should actually use
+sub unixy_cygwin_basegroups {
+ my ( $pwgid, $pwgnam ) = @_;
+ return (
+ $pwgid => 1,
+ $pwgnam => 1,
+ );
}
-# multiple 0's indicate GROUPSTYPE is currently long but should be short
+# Filter a full list of groups and return only the supplementary
+# gorups.
+sub remove_basegroup {
+ my ( $basegroups, $groups ) = @_;
-if ($pwgid == 0 || $seen{0} < 2) {
- print "ok 2\n";
+ return
+ grep { ! $basegroups->{$_} }
+ @$groups;
}
-else {
- print "not ok 2 (groupstype should be type short, not long)\n";
+
+# Test supplementary groups to see if they're a close enough match or
+# if there aren't any supplementary groups then validate the current
+# group against $(.
+sub match_groups {
+ my ( $supplementary_groups, $extracted_supplementary_groups, $pwgid ) = @_;
+
+ # Compare perl vs system groups
+ my %g;
+ $g{$_}[0] = 1 for @$supplementary_groups;
+ $g{$_}[1] = 1 for @$extracted_supplementary_groups;
+
+ # Find any mismatches
+ my @misses =
+ grep { ! ( $g{$_}[0] && $g{$_}[1] ) }
+ sort keys %g;
+
+ return
+ ! @misses
+ || ( ! @$supplementary_groups
+ && 1 == @$extracted_supplementary_groups
+ && $pwgid == $extracted_supplementary_groups->[0] );
+}
+
+# Print a nice little diagnostic.
+sub diag_variable {
+ my ( $label, $content ) = @_;
+
+ printf "# %-11s=%s\n", $label, $content;
+ return;
}
+
+# Removes duplicates from a list
+sub uniq {
+ my %seen;
+ return
+ grep { ! $seen{$_}++ }
+ @_;
+}
+
+# Local variables:
+# indent-tabs-mode: nil
+# End:
+#
+# ex: set ts=8 sts=4 sw=4 noet:
use warnings;
require './test.pl';
-plan( tests => 178 );
+plan( tests => 191 );
# type coersion on assignment
$foo = 'foo';
"with the correct error message");
}
+# RT #60954 anonymous glob should be defined, and not coredump when
+# stringified. The behaviours are:
+#
+# defined($glob) "$glob"
+# 5.8.8 false "" with uninit warning
+# 5.10.0 true (coredump)
+# 5.12.0 true ""
+
+{
+ my $io_ref = *STDOUT{IO};
+ my $glob = *$io_ref;
+ ok(defined $glob, "RT #60954 anon glob should be defined");
+
+ my $warn = '';
+ local $SIG{__WARN__} = sub { $warn = $_[0] };
+ use warnings;
+ my $str = "$glob";
+ is($warn, '', "RT #60954 anon glob stringification shouln't warn");
+ is($str, '', "RT #60954 anon glob stringification should be empty");
+}
+
+# [perl #71254] - Assigning a glob to a variable that has a current
+# match position. (We are testing that Perl_magic_setmglob respects globs'
+# special used of SvSCREAM.)
+{
+ $m = 2; $m=~s/./0/gems; $m= *STDERR;
+ is(
+ "$m", "*main::STDERR",
+ '[perl #71254] assignment of globs to vars with pos'
+ );
+}
+
+# [perl #72740] - indirect object syntax, heuristically imputed due to
+# the non-existence of a function, should not cause a stash entry to be
+# created for the non-existent function.
+{
+ package RT72740a;
+ my $f = bless({}, RT72740b);
+ sub s1 { s2 $f; }
+ our $s4;
+ sub s3 { s4 $f; }
+}
+{
+ package RT72740b;
+ sub s2 { "RT72740b::s2" }
+ sub s4 { "RT72740b::s4" }
+}
+ok(exists($RT72740a::{s1}), "RT72740a::s1 exists");
+ok(!exists($RT72740a::{s2}), "RT72740a::s2 does not exist");
+ok(exists($RT72740a::{s3}), "RT72740a::s3 exists");
+ok(exists($RT72740a::{s4}), "RT72740a::s4 exists");
+is(RT72740a::s1(), "RT72740b::s2", "RT72740::s1 parsed correctly");
+is(RT72740a::s3(), "RT72740b::s4", "RT72740::s3 parsed correctly");
+
+# [perl #71686] Globs that are in symbol table can be un-globbed
+$sym = undef;
+$::{fake} = *sym;
+is (eval 'local *::fake = \"chuck"; $fake', 'chuck',
+ "Localized glob didn't coerce into a RV");
+is ($@, '', "Can localize FAKE glob that's present in stash");
+is (scalar $::{fake}, "*main::sym",
+ "Localized FAKE glob's value was correctly restored");
+
__END__
Perl
Rules
@INC = qw(. ../lib);
require './test.pl';
}
-plan tests => 296;
+plan tests => 310;
my $list_assignment_supported = 1;
local @a = @a;
is("@a", $d);
}
+# RT #7938: localising an array should make it temporarily untied
+{
+ @a = qw(a b c);
+ local @a = (6,7,8);
+ is("@a", "6 7 8", 'local @a assigned 6,7,8');
+ {
+ my $c = 0;
+ local *TA::STORE = sub { $c++ };
+ $a[0] = 9;
+ is($c, 0, 'STORE not called after array localised');
+ }
+ is("@a", "9 7 8", 'local @a should now be 9 7 8');
+}
+is("@a", "a b c", '@a should now contain original value');
+
# local() should preserve the existenceness of tied array elements
@a = ('a', 'b', 'c');
is($h{'a'}, 1);
is($h{'b'}, 2);
is($h{'c'}, 3);
+
# local() should preserve the existenceness of tied hash elements
ok(! exists $h{'y'});
ok(! exists $h{'z'});
is(join("\n", map { "$_=>$h{$_}" } sort keys %h), $d);
}
+# RT #7939: localising a hash should make it temporarily untied
+{
+ %h = qw(a 1 b 2 c 3);
+ local %h = qw(x 6 y 7 z 8);
+ is(join('', sort keys %h), "xyz", 'local %h has new keys');
+ is(join('', sort values %h), "678", 'local %h has new values');
+ {
+ my $c = 0;
+ local *TH::STORE = sub { $c++ };
+ $h{x} = 9;
+ is($c, 0, 'STORE not called after hash localised');
+ }
+ is($h{x}, 9, '$h{x} should now be 9');
+}
+is(join('', sort keys %h), "abc", 'restored %h has original keys');
+is(join('', sort values %h), "123", 'restored %h has original values');
+
+
%h = (a => 1, b => 2, c => 3, d => 4);
{
delete local $h{b};
'index(q(a), foo);' .
'local *g=${::}{foo};print q(ok);'), "ok", "[perl #52740]");
+# localising a tied scalar should give you an untied var
+{
+ package TS;
+ sub TIESCALAR { bless \my $self, shift }
+
+ my $s;
+ sub FETCH { $s .= ":F=${$_[0]}"; ${$_[0]} }
+ sub STORE { $s .= ":S($_[1])"; ${$_[0]} = $_[1]; }
+
+ package main;
+ tie $ts, 'TS';
+ $ts = 1;
+ {
+ $s .= ':L1';
+ local $ts;
+ $s .= ':L2';
+ is($ts, undef, 'local tied scalar initially undef');
+ $ts = 2;
+ is($ts, 2, 'local tied scalar now has a value');
+ $s .= ':E';
+ }
+ is($ts, 1, 'restored tied scalar has correct value');
+ $ts = 3;
+ is($s, ':S(1):L1:F=1:L2:E:F=1:S(3)',
+ "local tied scalar shouldn't call methods");
+}
+
# Keep this test last, as it can SEGV
{
local *@;
use warnings;
use Config;
-plan (tests => 79);
+plan (tests => 83);
$Is_MSWin32 = $^O eq 'MSWin32';
$Is_NetWare = $^O eq 'NetWare';
}
}
+# Check that assigning to $0 on Linux sets the process name with both
+# argv[0] assignment and by calling prctl()
+{
+ SKIP: {
+ skip "We don't have prctl() here", 2 unless $Config{d_prctl_set_name};
+
+ # We don't really need these tests. prctl() is tested in the
+ # Kernel, but test it anyway for our sanity. If something doesn't
+ # work (like if the system doesn't have a ps(1) for whatever
+ # reason) just bail out gracefully.
+ my $maybe_ps = sub {
+ my ($cmd) = @_;
+ local ($?, $!);
+
+ no warnings;
+ my $res = `$cmd`;
+ skip "Couldn't shell out to `$cmd', returned code $?", 2 if $?;
+ return $res;
+ };
+
+ my $name = "Good Morning, Dave";
+ $0 = $name;
+
+ chomp(my $argv0 = $maybe_ps->("ps h $$"));
+ chomp(my $prctl = $maybe_ps->("ps hc $$"));
+
+ like($argv0, $name, "Set process name through argv[0] ($argv0)");
+ like($prctl, substr($name, 0, 15), "Set process name through prctl() ($prctl)");
+ }
+}
+
{
my $ok = 1;
my $warn = '';
$x = "@+";
return @+;
};
+ "pqrstuvwxyz" =~ /..(....)../; # prime @+ etc in this scope
my @y = f();
is $x, "@y", "return a magic array ($x) vs (@y)";
+
+ sub f2 {
+ "abc" =~ /(?<foo>.)./;
+ my @h = %+;
+ $x = "@h";
+ return %+;
+ };
+ @y = f();
+ is $x, "@y", "return a magic hash ($x) vs (@y)";
}
# Test for bug [perl #36434]
is $SIG{$sig}, undef, "$sig is not present";
is delete $SIG{$sig}, undef, "delete of $sig returns undef";
}
+
+{
+ $! = 9999;
+ is int $!, 9999, q{[perl #72850] Core dump in bleadperl from perl -e '$! = 9999; $a = $!;'};
+
+}
require "test.pl";
}
-print "1..78\n";
+print "1..79\n";
@A::ISA = 'B';
@B::ISA = 'C';
"check if UNIVERSAL::AUTOLOAD works",
);
}
+
+# Test for #71952: crash when looking for a nonexistent destructor
+# Regression introduced by fbb3ee5af3d4
+{
+ fresh_perl_is(<<'EOT',
+sub M::DESTROY; bless {}, "M" ; print "survived\n";
+EOT
+ "survived",
+ {},
+ "no crash with a declared but missing DESTROY method"
+ );
+}
+
my $no_signedness = $] > 5.009 ? '' :
"Signed/unsigned pack modifiers not available on this perl";
-plan tests => 14697;
+plan tests => 14699;
use strict;
use warnings qw(FATAL all);
my ($v) = split //, unpack ('(B)*', 'ab');
is($v, 0); # Doesn't SEGV :-)
}
+{
+ #73814
+ my $x = runperl( prog => 'print split( /,/, unpack(q(%2H*), q(hello world))), qq(\n)' );
+ is($x, "0\n", "split /a/, unpack('%2H*'...) didn't crash");
+
+ my $y = runperl( prog => 'print split( /,/, unpack(q(%32u*), q(#,3,Q)), qq(\n)), qq(\n)' );
+ is($y, "0\n", "split /a/, unpack('%32u*'...) didn't crash");
+}
--- /dev/null
+#!./perl
+
+BEGIN {
+ chdir 't';
+ @INC = '../lib';
+ require './test.pl';
+}
+
+# XXX remove this later -- dagolden, 2010-01-13
+# local *STDERR = *STDOUT;
+
+my @syntax_cases = (
+ 'package Foo',
+ 'package Bar 1.23',
+ 'package Baz v1.2.3',
+);
+
+my @version_cases = <DATA>;
+
+plan tests => 5 * @syntax_cases + 5 * (grep { $_ !~ /^#/ } @version_cases)
+ + 3;
+
+use warnings qw/syntax/;
+use version;
+
+for my $string ( @syntax_cases ) {
+ eval "$string";
+ is( $@, '', qq/eval "$string"/ );
+ eval "$string;";
+ is( $@, '', qq/eval "$string;"/ );
+ eval "$string ;";
+ is( $@, '', qq/eval "$string ;"/ );
+ eval "{$string}";
+ is( $@, '', qq/eval "{$string}"/ );
+ eval "{ $string }";
+ is( $@, '', qq/eval "{ $string }"/ );
+}
+
+LINE:
+for my $line (@version_cases) {
+ chomp $line;
+ # comments in data section are just diagnostics
+ if ($line =~ /^#/) {
+ diag $line;
+ next LINE;
+ }
+
+ my ($v, $package, $quoted, $bare, $match) = split /\t+/, $line;
+ my $warning = "";
+ local $SIG{__WARN__} = sub { $warning .= $_[0] . "\n" };
+ $match = defined $match ? $match : "";
+ $match =~ s/\s*\z//; # kill trailing spaces
+
+ # First handle the 'package NAME VERSION' case
+ $withversion::VERSION = undef;
+ if ($package eq 'fail') {
+ eval "package withversion $v";
+ like($@, qr/$match/, "package withversion $v -> syntax error ($match)");
+ ok(! version::is_strict($v), qq{... and "$v" should also fail STRICT regex});
+ }
+ else {
+ my $ok = eval "package withversion $v; $v eq \$withversion::VERSION";
+ ok($ok, "package withversion $v")
+ or diag( $@ ? $@ : "and \$VERSION = $withversion::VERSION");
+ ok( version::is_strict($v), qq{... and "$v" should pass STRICT regex});
+ }
+
+
+ # Now check the version->new("V") case
+ my $ver = undef;
+ eval qq/\$ver = version->new("$v")/;
+ if ($quoted eq 'fail') {
+ like($@, qr/$match/, qq{version->new("$v") -> invalid format ($match)})
+ or diag( $@ ? $@ : "and \$ver = $ver" );
+ ok( ! version::is_lax($v), qq{... and "$v" should fail LAX regex});
+ }
+ else {
+ is($@, "", qq{version->new("$v")});
+ ok( version::is_lax($v), qq{... and "$v" should pass LAX regex});
+ }
+
+ # Now check the version->new(V) case, unless we're skipping it
+ if ( $bare eq 'na' ) {
+ pass( "... skipping version->new($v)" );
+ next LINE;
+ }
+ $ver = undef;
+ eval qq/\$ver = version->new($v)/;
+ if ($bare eq 'fail') {
+ like($@, qr/$match/m, qq{... and unquoted version->new($v) has same error})
+ or diag( $@ ? $@ : "and \$ver = $ver" );
+ }
+ else {
+ is($@, "", qq{... and version->new($v) is ok});
+ }
+}
+
+#
+# Tests for #72432 - which reports a syntax error if there's a newline
+# between the package name and the version.
+#
+# Note that we are using 'run_perl' here - there's no problem if
+# "package Foo\n1;" is evalled.
+#
+for my $v ("1", "1.23", "v1.2.3") {
+ ok (run_perl (prog => "package Foo\n$v; print 1;"),
+ "New line between package name and version");
+}
+
+# The data is organized in tab delimited format with these columns:
+#
+# value package version->new version->new regex
+# quoted unquoted
+#
+# For each value, it is tested using eval in the following expressions
+#
+# package foo $value; # column 2
+# and
+# my $ver = version->new("$value"); # column 3
+# and
+# my $ver = version->new($value); # column 4
+#
+# The second through fourth columns can contain 'pass' or 'fail'.
+#
+# For any column with 'pass', the tests makes sure that no warning/error
+# was thrown. For any column with 'fail', the tests make sure that the
+# error thrown matches the regex in the last column. The unquoted column
+# may also have 'na' indicating that it's pointless to test as behavior
+# is subject to the perl parser before a stringifiable value is available
+# to version->new
+#
+# If all columns are marked 'pass', the regex column is left empty.
+#
+# there are multiple ways that underscores can fail depending on strict
+# vs lax format so these test do not distinguish between them
+#
+# If the DATA line begins with a # mark, it is used as a diag comment
+__DATA__
+1.00 pass pass pass
+1.00001 pass pass pass
+0.123 pass pass pass
+12.345 pass pass pass
+42 pass pass pass
+0 pass pass pass
+0.0 pass pass pass
+v1.2.3 pass pass pass
+v1.2.3.4 pass pass pass
+v0.1.2 pass pass pass
+v0.0.0 pass pass pass
+01 fail pass pass no leading zeros
+01.0203 fail pass pass no leading zeros
+v01 fail pass pass no leading zeros
+v01.02.03 fail pass pass no leading zeros
+.1 fail pass pass 0 before decimal required
+.1.2 fail pass pass 0 before decimal required
+1. fail pass pass fractional part required
+1.a fail fail na fractional part required
+1._ fail fail na fractional part required
+1.02_03 fail pass pass underscore
+v1.2_3 fail pass pass underscore
+v1.02_03 fail pass pass underscore
+v1.2_3_4 fail fail fail underscore
+v1.2_3.4 fail fail fail underscore
+1.2_3.4 fail fail fail underscore
+0_ fail fail na underscore
+1_ fail fail na underscore
+1_. fail fail na underscore
+1.1_ fail fail na underscore
+1.02_03_04 fail fail na underscore
+1.2.3 fail pass pass dotted-decimal versions must begin with 'v'
+v1.2 fail pass pass dotted-decimal versions require at least three parts
+v0 fail pass pass dotted-decimal versions require at least three parts
+v1 fail pass pass dotted-decimal versions require at least three parts
+v.1.2.3 fail fail na dotted-decimal versions require at least three parts
+v fail fail na dotted-decimal versions require at least three parts
+v1.2345.6 fail pass pass maximum 3 digits between decimals
+undef fail pass pass non-numeric data
+1a fail fail na non-numeric data
+1.2a3 fail fail na non-numeric data
+bar fail fail na non-numeric data
+_ fail fail na non-numeric data
--- /dev/null
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = qw(. ../lib);
+}
+
+use strict;
+use warnings;
+
+BEGIN {
+ require 'test.pl';
+ plan( tests => 12 );
+}
+
+use vars qw{ @warnings $sub $warn };
+
+BEGIN {
+ $warn = 'Illegal character in prototype';
+}
+
+sub one_warning_ok {
+ cmp_ok(scalar(@warnings), '==', 1, 'One warning');
+ cmp_ok(substr($warnings[0],0,length($warn)),'eq',$warn,'warning message');
+ @warnings = ();
+}
+
+sub no_warnings_ok {
+ cmp_ok(scalar(@warnings), '==', 0, 'No warnings');
+ @warnings = ();
+}
+
+BEGIN {
+ $SIG{'__WARN__'} = sub { push @warnings, @_ };
+ $| = 1;
+}
+
+BEGIN { @warnings = () }
+
+$sub = sub (x) { };
+
+BEGIN {
+ one_warning_ok;
+}
+
+{
+ no warnings 'syntax';
+ $sub = sub (x) { };
+}
+
+BEGIN {
+ no_warnings_ok;
+}
+
+{
+ no warnings 'illegalproto';
+ $sub = sub (x) { };
+}
+
+BEGIN {
+ no_warnings_ok;
+}
+
+{
+ no warnings 'syntax';
+ use warnings 'illegalproto';
+ $sub = sub (x) { };
+}
+
+BEGIN {
+ one_warning_ok;
+}
+
+BEGIN {
+ $warn = q{Prototype after '@' for};
+}
+
+$sub = sub (@$) { };
+
+BEGIN {
+ one_warning_ok;
+}
+
+{
+ no warnings 'syntax';
+ $sub = sub (@$) { };
+}
+
+BEGIN {
+ no_warnings_ok;
+}
+
+{
+ no warnings 'illegalproto';
+ $sub = sub (@$) { };
+}
+
+BEGIN {
+ no_warnings_ok;
+}
+
+{
+ no warnings 'syntax';
+ use warnings 'illegalproto';
+ $sub = sub (@$) { };
+}
+
+BEGIN {
+ one_warning_ok;
+}
@INC = '../lib';
}
-print q(1..21
+print q(1..23
);
# This is() function is written to avoid ""
is ("\x{0_06_5}", chr 101);
is ("\x{1234}", chr 4660);
is ("\x{10FFFD}", chr 1114109);
+
+# These kludged tests should change when we remove the temporary fatal error
+# in util.c for "\c{"
+# BE SURE TO remove the message from the __DATA__ section of porting/diag.t,
+# and to verify the messages in util.c are adequately covered in perldiag.pod
+my $value = eval '"\c{ACK}"';
+if ($^V lt v5.13.0 || $^V ge v5.14.0) {
+ is ($@, "");
+ is ($value, ";ACK}");
+}
+elsif ($@ ne "") { # 5.13 series, should fail
+ is ("1", "1"); # This .t only has 'is' at its disposal
+ is ("1", "1");
+}
+else { # Something wrong; someone has removed the failure in util.c
+ is ("Should fail for 5.13 until fix test", "0");
+ is ("1", "1");
+}
require './test.pl';
-plan(tests => 12);
+plan(tests => 18);
sub r {
return qr/Good/;
$$d = 'Bad';
like("$c", qr/Good/);
-like("$d", qr/Bad/);
-like("$d1", qr/Bad/);
+is($$d, 'Bad');
+is($$d1, 'Bad');
+
+# Assignment to an implicitly blessed Regexp object retains the class
+# (No different from direct value assignment to any other blessed SV
+
+isa_ok($d, 'Regexp');
+like("$d", qr/\ARegexp=SCALAR\(0x[0-9a-f]+\)\z/);
+
+# As does an explicitly blessed Regexp object.
+
+my $e = bless qr/Faux Pie/, 'Stew';
+
+isa_ok($e, 'Stew');
+$$e = 'Fake!';
+
+is($$e, 'Fake!');
+isa_ok($e, 'Stew');
+like("$e", qr/\Stew=SCALAR\(0x[0-9a-f]+\)\z/);
like ("$ref", qr/^$type\(0x[0-9a-f]+\)$/, "stringify for ref to $desc");
}
-is (ref *STDOUT{IO}, 'IO::Handle', 'IO refs are blessed into IO::Handle');
-like (*STDOUT{IO}, qr/^IO::Handle=IO\(0x[0-9a-f]+\)$/,
+is (ref *STDOUT{IO}, 'IO::File', 'IO refs are blessed into IO::File');
+like (*STDOUT{IO}, qr/^IO::File=IO\(0x[0-9a-f]+\)$/,
'stringify for IO refs');
# Test anonymous hash syntax.
# REGEX pad had already been freed (ithreads build only). The
# object is required to trigger the early freeing of GV refs to to STDOUT
-like (runperl(
- prog => '$x=bless[]; sub IO::Handle::DESTROY{$_="bad";s/bad/ok/;print}',
- stderr => 1
- ), qr/^(ok)+$/, 'STDOUT destructor');
+TODO: {
+ local $TODO = "works but output through pipe is mangled" if $^O eq 'VMS';
+ like (runperl(
+ prog => '$x=bless[]; sub IO::Handle::DESTROY{$_="bad";s/bad/ok/;print}',
+ stderr => 1
+ ), qr/^(ok)+$/, 'STDOUT destructor');
+}
TODO: {
no strict 'refs';
require './test.pl';
}
-plan tests => 21;
+plan tests => 23;
is(reverse("abc"), "cba");
@a = reverse @a;
ok(!exists $a[2] && !exists $a[3]);
is($a[0] . $a[1] . $a[4], '985');
+
+ my @empty;
+ @empty = reverse @empty;
+ is("@empty", "");
}
use Tie::Array;
@a = reverse @a;
ok(!exists $a[2] && !exists $a[3]);
is($a[0] . $a[1] . $a[4], '985');
+
+ tie my @empty, "Tie::StdArray";
+ @empty = reverse @empty;
+ is(scalar(@empty), 0);
}
{
--- /dev/null
+#!perl -w
+
+# We assume that TestInit has been used.
+
+BEGIN {
+ require './test.pl';
+}
+
+use strict;
+
+plan tests => 4;
+
+watchdog(10);
+
+$SIG{ALRM} = sub {
+ die "Alarm!\n";
+};
+
+pass('before the first loop');
+
+alarm 2;
+
+eval {
+ 1 while 1;
+};
+
+is($@, "Alarm!\n", 'after the first loop');
+
+pass('before the second loop');
+
+alarm 2;
+
+eval {
+ while (1) {
+ }
+};
+
+is($@, "Alarm!\n", 'after the second loop');
require 'test.pl';
}
use warnings;
-plan( tests => 148 );
+plan( tests => 151 );
# these shouldn't hang
{
is("@b", "1 2 3 3 4 5 7", "comparison result as string");
@b = sort cmp_as_string (1,5,4,7,3,2,3);
is("@b", "1 2 3 3 4 5 7", "comparison result as string");
+
+# RT #34604: sort didn't honour overloading if the overloaded elements
+# were retrieved via tie
+
+{
+ package RT34604;
+
+ sub TIEHASH { bless {
+ p => bless({ val => 2 }),
+ q => bless({ val => 1 }),
+ }
+ }
+ sub FETCH { $_[0]{$_[1] } }
+
+ my $cc = 0;
+ sub compare { $cc++; $_[0]{val} cmp $_[1]{val} }
+ my $cs = 0;
+ sub str { $cs++; $_[0]{val} }
+
+ use overload 'cmp' => \&compare, '""' => \&str;
+
+ package main;
+
+ tie my %h, 'RT34604';
+ my @sorted = sort @h{qw(p q)};
+ is($cc, 1, 'overload compare called once');
+ is("@sorted","1 2", 'overload sort result');
+ is($cs, 2, 'overload string called twice');
+}
$SIG{__WARN__} = sub {
if ($_[0] =~ /^Invalid conversion/) {
- $w = ' INVALID';
+ $w .= ' INVALID';
} elsif ($_[0] =~ /^Use of uninitialized value/) {
- $w = ' UNINIT';
+ $w .= ' UNINIT';
} elsif ($_[0] =~ /^Missing argument/) {
- $w = ' MISSING';
+ $w .= ' MISSING';
} else {
warn @_;
}
for ($i = 1; @tests; $i++) {
($template, $evalData, $result, $comment, $data) = @{shift @tests};
$w = undef;
- $x = sprintf(">$template<", @$evalData);
+ $x = sprintf($template, @$evalData);
+ $x = ">$x<" if defined $x;
substr($x, -1, 0) = $w if $w;
# $x may have 3 exponent digits, not 2
my $y = $x;
>%+8.1f< >-1234.875< > -1234.9<
>%*.*f< >[5, 2, 12.3456]< >12.35<
>%f< >0< >0.000000<
+>%.0f< >[]< >0 MISSING<
+> %.0f< >[]< > 0 MISSING<
>%.0f< >0< >0<
>%.0f< >2**38< >274877906944< >Should have exact int'l rep'n<
>%.0f< >0.1< >0<
>%g< >12345.6789< >12345.7<
>%+g< >12345.6789< >+12345.7<
>%#g< >12345.6789< >12345.7<
->%.0g< >-0.0< >-0< >C99 standard mandates minus sign but C89 does not skip: MSWin32 VMS hpux:10.20 openbsd netbsd:1.5 irix darwin<
+>%.0g< >[]< >0 MISSING<
+> %.0g< >[]< > 0 MISSING<
+>%.0g< >-0.0< >-0< >C99 standard mandates minus sign but C89 does not skip: MSWin32 VMS hpux:10.20 openbsd netbsd:1.5 irix darwin<
>%.0g< >12345.6789< >1e+04<
>%#.0g< >12345.6789< >1.e+04<
>%.2g< >12345.6789< >1.2e+04<
>%#p< >''< >%#p INVALID<
>%q< >''< >%q INVALID<
>%r< >''< >%r INVALID<
+>%s< >[]< > MISSING<
+> %s< >[]< > MISSING<
>%s< >'string'< >string<
>%10s< >'string'< > string<
>%+10s< >'string'< > string<
>%V-%s< >["Hello"]< >%V-Hello INVALID<
>%K %d %d< >[13, 29]< >%K 13 29 INVALID<
>%*.*K %d< >[13, 29, 76]< >%*.*K 13 INVALID<
->%4$K %d< >[45, 67]< >%4$K 45 INVALID<
+>%4$K %d< >[45, 67]< >%4$K 45 MISSING INVALID<
>%d %K %d< >[23, 45]< >23 %K 45 INVALID<
>%*v*999\$d %d %d< >[11, 22, 33]< >%*v*999\$d 11 22 INVALID<
>%#b< >0< >0<
is(eval {sprintf "%${_}d", 0}, undef, "no sprintf result expected %${_}d");
like($@, qr/^Integer overflow in format string for sprintf /, "overflow in sprintf");
is(eval {printf "%${_}d\n", 0}, undef, "no printf result expected %${_}d");
- like($@, qr/^Integer overflow in format string for prtf /, "overflow in printf");
+ like($@, qr/^Integer overflow in format string for printf /, "overflow in printf");
}
# check %NNN$ for range bounds
eval {select $blank, $blank, "a", 0};
like ($@, qr/^Modification of a read-only value attempted/);
-my $sleep = 3;
+my($sleep,$fudge) = (3,0);
+# Actual sleep time on Windows may be rounded down to an integral
+# multiple of the system clock tick interval. Clock tick interval
+# is configurable, but usually about 15.625 milliseconds.
+# time() however doesn't return fractional values, so the observed
+# delay may be 1 second short.
+($sleep,$fudge) = (4,1) if $^O eq "MSWin32";
+
my $t = time;
select(undef, undef, undef, $sleep);
-ok(time-$t >= $sleep, "$sleep seconds have passed");
+ok(time-$t >= $sleep-$fudge, "$sleep seconds have passed");
my $empty = "";
vec($empty,0,1) = 0;
$t = time;
select($empty, undef, undef, $sleep);
-ok(time-$t >= $sleep, "$sleep seconds have passed");
+ok(time-$t >= $sleep-$fudge, "$sleep seconds have passed");
plan( tests => 31 );
# Used to segfault (bug #15479)
-fresh_perl_is(
+fresh_perl_like(
'%:: = ""',
- 'Odd number of elements in hash assignment at - line 1.',
+ qr/Odd number of elements in hash assignment at - line 1\./,
{ switches => [ '-w' ] },
'delete $::{STDERR} and print a warning',
);
$Is_MPRAS = $^O =~ /svr4/ && -f '/etc/.relid';
$Is_Rhapsody= $^O eq 'rhapsody';
-$Is_Dosish = $Is_Dos || $Is_OS2 || $Is_MSWin32 || $Is_NetWare || $Is_Cygwin;
+$Is_Dosish = $Is_Dos || $Is_OS2 || $Is_MSWin32 || $Is_NetWare;
$Is_UFS = $Is_Darwin && (() = `df -t ufs . 2>/dev/null`) == 2;
+if ($Is_Cygwin) {
+ require Win32;
+ Win32->import;
+}
+
my($DEV, $INO, $MODE, $NLINK, $UID, $GID, $RDEV, $SIZE,
$ATIME, $MTIME, $CTIME, $BLKSIZE, $BLOCKS) = (0..12);
my $olduid = $>;
eval { $> = 1; };
skip "Can't test -r or -w meaningfully if you're superuser", 2
- if $> == 0;
+ if ($Is_Cygwin ? Win32::IsAdminUser : $> == 0);
SKIP: {
- skip "Can't test -r meaningfully?", 1 if $Is_Dos || $Is_Cygwin;
+ skip "Can't test -r meaningfully?", 1 if $Is_Dos;
ok(!-r $tmpfile, " -r");
}
@INC = '../lib';
require './test.pl';
}
-plan tests=>69;
+plan tests=>71;
sub a : lvalue { my $a = 34; ${\(bless \$a)} } # Return a temporary
sub b : lvalue { ${\shift} }
$foo->bar;
is ($result, 'bar', "RT #41550");
}
+
+fresh_perl_is(<<'----', <<'====', "lvalue can not be set after definition. [perl #68758]");
+use warnings;
+our $x;
+sub foo { $x }
+sub foo : lvalue;
+foo = 3;
+----
+lvalue attribute ignored after the subroutine has been defined at - line 4.
+Can't modify non-lvalue subroutine call in scalar assignment at - line 5, near "3;"
+Execution of - aborted due to compilation errors.
+====
+
+{
+ my $x;
+ sub lval_decl : lvalue;
+ sub lval_decl { $x }
+ lval_decl = 5;
+ is($x, 5, "subroutine declared with lvalue before definition retains lvalue. [perl #68758]");
+}
--- /dev/null
+#!./perl
+
+# A place to put some simple leak tests. Uses XS::APItest to make
+# PL_sv_count available, allowing us to run a bit a code multiple times and
+# see if the count increases.
+
+BEGIN {
+ chdir 't';
+ @INC = '../lib';
+ require './test.pl';
+
+ eval { require XS::APItest; XS::APItest->import('sv_count'); 1 }
+ or skip_all("XS::APItest not available");
+}
+
+plan tests => 5;
+
+# run some code N times. If the number of SVs at the end of loop N is
+# greater than (N-1)*delta at the end of loop 1, we've got a leak
+#
+sub leak {
+ my ($n, $delta, $code, @rest) = @_;
+ my $sv0 = 0;
+ my $sv1 = 0;
+ for my $i (1..$n) {
+ &$code();
+ $sv1 = sv_count();
+ $sv0 = $sv1 if $i == 1;
+ }
+ cmp_ok($sv1-$sv0, '<=', ($n-1)*$delta, @rest);
+}
+
+# run some expression N times. The expr is concatenated N times and then
+# evaled, ensuring that that there are no scope exits between executions.
+# If the number of SVs at the end of expr N is greater than (N-1)*delta at
+# the end of expr 1, we've got a leak
+#
+sub leak_expr {
+ my ($n, $delta, $expr, @rest) = @_;
+ my $sv0 = 0;
+ my $sv1 = 0;
+ my $true = 1; # avoid stuff being optimised away
+ my $code1 = "($expr || \$true)";
+ my $code = "$code1 && (\$sv0 = sv_count())" . ("&& $code1" x 4)
+ . " && (\$sv1 = sv_count())";
+ if (eval $code) {
+ cmp_ok($sv1-$sv0, '<=', ($n-1)*$delta, @rest);
+ }
+ else {
+ fail("eval @rest: $@");
+ }
+}
+
+
+my @a;
+
+leak(5, 0, sub {}, "basic check 1 of leak test infrastructure");
+leak(5, 0, sub {push @a,1;pop @a}, "basic check 2 of leak test infrastructure");
+leak(5, 1, sub {push @a,1;}, "basic check 3 of leak test infrastructure");
+
+sub TIEARRAY { bless [], $_[0] }
+sub FETCH { $_[0]->[$_[1]] }
+sub STORE { $_[0]->[$_[1]] = $_[2] }
+
+# local $tied_elem[..] leaks <20020502143736.N16831@dansat.data-plan.com>"
+{
+ tie my @a, 'main';
+ leak(5, 0, sub {local $a[0]}, "local \$tied[0]");
+}
+
+# [perl #74484] repeated tries leaked SVs on the tmps stack
+
+leak_expr(5, 0, q{"YYYYYa" =~ /.+?(a(.+?)|b)/ }, "trie leak");
use File::Spec::Functions;
BEGIN { require './test.pl'; }
-plan tests => 301;
+plan tests => 325;
$| = 1;
# Operations which affect directories can't use tainted data.
{
- test !eval { mkdir "foo".$TAINT, 0755.$TAINT0 }, 'mkdir';
+ test !eval { mkdir "foo".$TAINT, 0755 . $TAINT0 }, 'mkdir';
test $@ =~ /^Insecure dependency/, $@;
test !eval { rmdir $TAINT }, 'rmdir';
{
my @a;
- local $::TODO = 1;
- $a[0] = $^X;
- my $i = 0;
- while($a[0]=~ m/(.)/g ) {
- last if $i++ > 10000;
- }
- cmp_ok $i, '<', 10000, "infinite m//g";
+ $a[0] = $^X . '-';
+ $a[0]=~ m/(.)/g;
+ cmp_ok pos($a[0]), '>', 0, "infinite m//g on arrays (aelemfast)";
+
+ my $i = 1;
+ $a[$i] = $^X . '-';
+ $a[$i]=~ m/(.)/g;
+ cmp_ok pos($a[$i]), '>', 0, "infinite m//g on arrays (aelem)";
+
+ my %h;
+ $h{a} = $^X . '-';
+ $h{a}=~ m/(.)/g;
+ cmp_ok pos($h{a}), '>', 0, "infinite m//g on hashes (helem)";
}
SKIP:
ok(tainted($zz), "pack a*a* preserves tainting");
}
+# Bug RT #61976 tainted $! would show numeric rather than string value
+
+{
+ my $tainted_path = substr($^X,0,0) . "/no/such/file";
+ my $err;
+ # $! is used in a tainted expression, so gets tainted
+ open my $fh, $tainted_path or $err= "$!";
+ unlike($err, qr/^\d+$/, 'tainted $!');
+}
+
+{
+ # #6758: tainted values become untainted in tied hashes
+ # (also applies to other value magic such as pos)
+
+
+ package P6758;
+
+ sub TIEHASH { bless {} }
+ sub TIEARRAY { bless {} }
+
+ my $i = 0;
+
+ sub STORE {
+ main::ok(main::tainted($_[1]), "tied arg1 tainted");
+ main::ok(main::tainted($_[2]), "tied arg2 tainted");
+ $i++;
+ }
+
+ package main;
+
+ my ($k,$v) = qw(1111 val);
+ taint_these($k,$v);
+ tie my @array, 'P6758';
+ tie my %hash , 'P6758';
+ $array[$k] = $v;
+ $hash{$k} = $v;
+ ok $i == 2, "tied STORE called correct number of times";
+}
+
+# Bug RT #45167 the return value of sprintf sometimes wasn't tainted
+# when the args were tainted. This only occured on the first use of
+# sprintf; after that, its TARG has taint magic attached, so setmagic
+# at the end works. That's why there are multiple sprintf's below, rather
+# than just one wrapped in an inner loop. Also, any plantext betwerrn
+# fprmat entires would correctly cause tainting to get set. so test with
+# "%s%s" rather than eg "%s %s".
+
+{
+ for my $var1 ($TAINT, "123") {
+ for my $var2 ($TAINT0, "456") {
+ my @s;
+ push @s, sprintf '%s', $var1, $var2;
+ push @s, sprintf ' %s', $var1, $var2;
+ push @s, sprintf '%s%s', $var1, $var2;
+ for (0..2) {
+ ok( !(
+ tainted($s[$_]) xor
+ (tainted($var1) || ($_==2 && tainted($var2)))
+ ),
+ "sprintf fmt$_, '$var1', '$var2'");
+ }
+ }
+ }
+}
+
+
+# Bug RT #67962: old tainted $1 gets treated as tainted
+# in next untainted # match
+
+{
+ use re 'taint';
+ "abc".$TAINT =~ /(.*)/; # make $1 tainted
+ ok(tainted($1), '$1 should be tainted');
+
+ my $untainted = "abcdef";
+ ok(!tainted($untainted), '$untainted should be untainted');
+ $untainted =~ s/(abc)/$1/;
+ ok(!tainted($untainted), '$untainted should still be untainted');
+ $untainted =~ s/(abc)/x$1/;
+ ok(!tainted($untainted), '$untainted should yet still be untainted');
+}
+
+
# This may bomb out with the alarm signal so keep it last
SKIP: {
skip "No alarm()" unless $Config{d_alarm};
exit 0;
}
- plan(17);
+ plan(18);
}
use strict;
EOI
}
+} # TODO
+
# Scalars leaked: 1
fresh_perl_is(<<'EOI', 'ok', { }, 'Bug #41138');
use threads;
print 'ok';
EOI
-} # TODO
# [perl #45053] Memory corruption with heavy module loading in threads
#
//"undef"
EOJ
+# At the point of thread creation, $h{1} is on the temps stack.
+# The weak reference $a, however, is visible from the symbol table.
+fresh_perl_is(<<'EOI', 'ok', { }, 'Test for 34394ecd06e704e9');
+ use threads;
+ %h = (1, 2);
+ use Scalar::Util 'weaken';
+ $a = \$h{1};
+ weaken($a);
+ delete $h{1} && threads->create(sub {}, shift)->join();
+ print 'ok';
+EOI
+
# EOF
}
package main;
tie $a->{foo}, "Foo", $a, "foo";
-$a->{foo}; # access once
+my $s = $a->{foo}; # access once
# the hash element should not be tied anymore
print defined tied $a->{foo} ? "not ok" : "ok";
EXPECT
}
print "tied\n" if tied %h;
EXPECT
+########
+# RT 20727: PL_defoutgv is left as a tied element
+sub TIESCALAR { return bless {}, 'main' }
+
+sub STORE {
+ select($_[1]);
+ $_[1] = 1;
+ select(); # this used to coredump or assert fail
+}
+tie $SELECT, 'main';
+$SELECT = *STDERR;
+EXPECT
+########
+# RT 23810: eval in die in FETCH can corrupt context stack
+
+my $file = 'rt23810.pm';
+
+my $e;
+my $s;
+
+sub do_require {
+ my ($str, $eval) = @_;
+ open my $fh, '>', $file or die "Can't create $file: $!\n";
+ print $fh $str;
+ close $fh;
+ if ($eval) {
+ $s .= '-ERQ';
+ eval { require $pm; $s .= '-ENDE' }
+ }
+ else {
+ $s .= '-RQ';
+ require $pm;
+ }
+ $s .= '-ENDRQ';
+ unlink $file;
+}
+
+sub TIEHASH { bless {} }
+
+sub FETCH {
+ # 10 or more syntax errors makes yyparse croak()
+ my $bad = q{$x+;$x+;$x+;$x+;$x+;$x+;$x+;$x+;$x+$x+;$x+;$x+;$x+;$x+;;$x+;};
+
+ if ($_[1] eq 'eval') {
+ $s .= 'EVAL';
+ eval q[BEGIN { die; $s .= '-X1' }];
+ $s .= '-BD';
+ eval q[BEGIN { $x+ }];
+ $s .= '-BS';
+ eval '$x+';
+ $s .= '-E1';
+ $s .= '-S1' while $@ =~ /syntax error at/g;
+ eval $bad;
+ $s .= '-E2';
+ $s .= '-S2' while $@ =~ /syntax error at/g;
+ }
+ elsif ($_[1] eq 'require') {
+ $s .= 'REQUIRE';
+ my @text = (
+ q[BEGIN { die; $s .= '-X1' }],
+ q[BEGIN { $x+ }],
+ '$x+',
+ $bad
+ );
+ for my $i (0..$#text) {
+ $s .= "-$i";
+ do_require($txt[$i], 0) if $e;;
+ do_require($txt[$i], 1);
+ }
+ }
+ elsif ($_[1] eq 'exit') {
+ eval q[exit(0); print "overshot eval\n"];
+ }
+ else {
+ print "unknown key: '$_[1]'\n";
+ }
+ return "-R";
+}
+my %foo;
+tie %foo, "main";
+
+for my $action(qw(eval require)) {
+ $s = ''; $e = 0; $s .= main->FETCH($action); print "$action: s0=$s\n";
+ $s = ''; $e = 1; eval { $s .= main->FETCH($action)}; print "$action: s1=$s\n";
+ $s = ''; $e = 0; $s .= $foo{$action}; print "$action: s2=$s\n";
+ $s = ''; $e = 1; eval { $s .= $foo{$action}}; print "$action: s3=$s\n";
+}
+1 while unlink $file;
+
+$foo{'exit'};
+print "overshot main\n"; # shouldn't reach here
+
+EXPECT
+eval: s0=EVAL-BD-BS-E1-S1-E2-S2-S2-S2-S2-S2-S2-S2-S2-S2-S2-R
+eval: s1=EVAL-BD-BS-E1-S1-E2-S2-S2-S2-S2-S2-S2-S2-S2-S2-S2-R
+eval: s2=EVAL-BD-BS-E1-S1-E2-S2-S2-S2-S2-S2-S2-S2-S2-S2-S2-R
+eval: s3=EVAL-BD-BS-E1-S1-E2-S2-S2-S2-S2-S2-S2-S2-S2-S2-S2-R
+require: s0=REQUIRE-0-ERQ-ENDRQ-1-ERQ-ENDRQ-2-ERQ-ENDRQ-3-ERQ-ENDRQ-R
+require: s1=REQUIRE-0-RQ
+require: s2=REQUIRE-0-ERQ-ENDRQ-1-ERQ-ENDRQ-2-ERQ-ENDRQ-3-ERQ-ENDRQ-R
+require: s3=REQUIRE-0-RQ
+########
+# RT 8857: STORE incorrectly invoked for local($_) on aliased tied array
+# element
+
+sub TIEARRAY { bless [], $_[0] }
+sub TIEHASH { bless [], $_[0] }
+sub FETCH { $_[0]->[$_[1]] }
+sub STORE { $_[0]->[$_[1]] = $_[2] }
+
+
+sub f {
+ local $_[0];
+}
+tie @a, 'main';
+tie %h, 'main';
+
+foreach ($a[0], $h{a}) {
+ f($_);
+}
+# on failure, chucks up 'premature free' etc messages
+EXPECT
+########
+# RT 5475:
+# the initial fix for this bug caused tied scalar FETCH to be called
+# multiple times when that scalar was an element in an array. Check it
+# only gets called once now.
+
+sub TIESCALAR { bless [], $_[0] }
+my $c = 0;
+sub FETCH { $c++; 0 }
+sub FETCHSIZE { 1 }
+sub STORE { $c += 100; 0 }
+
+
+my (@a, %h);
+tie $a[0], 'main';
+tie $h{foo}, 'main';
+
+my $i = 0;
+my $x = $a[0] + $h{foo} + $a[$i] + (@a)[0];
+print "x=$x c=$c\n";
+EXPECT
+x=0 c=4
-#!./perl
+#!./perl -w
BEGIN {
chdir 't' if -d 't';
require './test.pl';
}
-plan tests => 44;
+plan tests => 66;
+
+# These tests make sure, among other things, that we don't end up
+# burning tons of CPU for dates far in the future.
+# watchdog() makes sure that the test script eventually exits if
+# the tests are triggering the failing behavior
+watchdog(15);
($beguser,$begsys) = times;
($xsec,$foo) = localtime($now);
$localyday = $yday;
-isnt($sec, $xsec), 'localtime() list context';
-ok $mday, ' month day';
-ok $year, ' year';
+isnt($sec, $xsec, 'localtime() list context');
+ok $mday, ' month day';
+ok $year, ' year';
ok(localtime() =~ /^(Sun|Mon|Tue|Wed|Thu|Fri|Sat)[ ]
(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)[ ]
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($beg);
($xsec,$foo) = localtime($now);
-isnt($sec, $xsec), 'gmtime() list conext';
-ok $mday, ' month day';
-ok $year, ' year';
+isnt($sec, $xsec, 'gmtime() list conext');
+ok $mday, ' month day';
+ok $year, ' year';
my $day_diff = $localyday - $yday;
ok( grep({ $day_diff == $_ } (0, 1, -1, 364, 365, -364, -365)),
{
eval {
$SIG{__WARN__} = sub { die @_; };
- localtime(1.23);
+ is( (localtime(1296000.23))[5] + 1900, 1970 );
};
is($@, '', 'Ignore fractional time');
eval {
$SIG{__WARN__} = sub { die @_; };
- gmtime(1.23);
+ is( (gmtime(1.23))[5] + 1900, 1970 );
};
is($@, '', 'Ignore fractional time');
}
+
+
+# Some sanity tests for the far, far future and far, far past
+{
+ my %time2year = (
+ -2**52 => -142711421,
+ -2**48 => -8917617,
+ -2**46 => -2227927,
+ 2**46 => 2231866,
+ 2**48 => 8921556,
+ 2**52 => 142715360,
+ );
+
+ for my $time (sort keys %time2year) {
+ my $want = $time2year{$time};
+
+ my $have = (gmtime($time))[5] + 1900;
+ is $have, $want, "year check, gmtime($time)";
+
+ $have = (localtime($time))[5] + 1900;
+ is $have, $want, "year check, localtime($time)";
+ }
+}
+
+
+# Test that Perl warns properly when it can't handle a time.
+{
+ my $warning;
+ local $SIG{__WARN__} = sub { $warning .= join "\n", @_; };
+
+ my $big_time = 2**60;
+ my $small_time = -2**60;
+
+ $warning = '';
+ my $date = gmtime($big_time);
+ like $warning, qr/^gmtime(.*) too large/;
+
+ $warning = '';
+ $date = localtime($big_time);
+ like $warning, qr/^localtime(.*) too large/;
+
+ $warning = '';
+ $date = gmtime($small_time);
+ like $warning, qr/^gmtime(.*) too small/;
+
+ $warning = '';
+ $date = localtime($small_time);
+ like $warning, qr/^localtime(.*) too small/;
+}
+
+SKIP: { #rt #73040
+ # these are from the definitions of TIME_LOWER_BOUND AND TIME_UPPER_BOUND
+ my $smallest = -67768100567755200.0;
+ my $biggest = 67767976233316800.0;
+
+ # offset to a value that will fail
+ my $small_time = $smallest - 200;
+ my $big_time = $biggest + 200;
+
+ # check they're representable - typically means NV is
+ # long double
+ if ($small_time + 200 != $smallest
+ || $small_time == $smallest
+ || $big_time - 200 != $biggest
+ || $big_time == $biggest) {
+ skip "Can't represent test values", 4;
+ }
+ my $small_time_f = sprintf("%.0f", $small_time);
+ my $big_time_f = sprintf("%.0f", $big_time);
+
+ # check the numbers in the warning are correct
+ my $warning;
+ local $SIG{__WARN__} = sub { $warning .= join "\n", @_; };
+ $warning = '';
+ my $date = gmtime($big_time);
+ like $warning, qr/^gmtime\($big_time_f\) too large/;
+
+ $warning = '';
+ $date = localtime($big_time);
+ like $warning, qr/^localtime\($big_time_f\) too large/;
+
+ $warning = '';
+ $date = gmtime($small_time);
+ like $warning, qr/^gmtime\($small_time_f\) too small/;
+
+ $warning = '';
+ $date = localtime($small_time);
+ like $warning, qr/^localtime\($small_time_f\) too small/;
+
+}
--- /dev/null
+#!perl -w
+
+# d95a2ea538e6c332f36c34ca45b78d6ad93c3a1f allowed times greater than
+# 2**63 to be handed to gm/localtime() which caused an internal overflow
+# and an excessively long loop. Test this does not happen.
+
+use strict;
+
+BEGIN { require './test.pl'; }
+
+plan tests => 2;
+watchdog(2);
+
+local $SIG{__WARN__} = sub {};
+is gmtime(2**69), undef;
+is localtime(2**69), undef;
--- /dev/null
+#!perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require './test.pl';
+}
+
+plan tests => 4;
+
+use strict;
+
+my $str = "\x{99f1}\x{99dd}"; # "camel" in Japanese kanji
+$str =~ /(.)/;
+
+ok utf8::is_utf8($1), "is_utf8(unistr)";
+scalar "$1"; # invoke SvGETMAGIC
+ok utf8::is_utf8($1), "is_utf8(unistr)";
+
+utf8::encode($str); # off the utf8 flag
+$str =~ /(.)/;
+
+ok !utf8::is_utf8($1), "is_utf8(bytes)";
+scalar "$1"; # invoke SvGETMAGIC
+ok !utf8::is_utf8($1), "is_utf8(bytes)";
--- /dev/null
+#!./perl
+#line 3 warn.t
+
+print "1..18\n";
+my $test_num = 0;
+sub ok {
+ print $_[0] ? "" : "not ", "ok ", ++$test_num, "\n";
+}
+
+my @warnings;
+my $wa = []; my $ea = [];
+$SIG{__WARN__} = sub { push @warnings, $_[0] };
+
+@warnings = ();
+$@ = "";
+warn "foo\n";
+ok @warnings==1 && $warnings[0] eq "foo\n";
+
+@warnings = ();
+$@ = "";
+warn "foo", "bar\n";
+ok @warnings==1 && $warnings[0] eq "foobar\n";
+
+@warnings = ();
+$@ = "";
+warn "foo";
+ok @warnings==1 && $warnings[0] eq "foo at warn.t line 26.\n";
+
+@warnings = ();
+$@ = "";
+warn $wa;
+ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $wa;
+
+@warnings = ();
+$@ = "";
+warn "";
+ok @warnings==1 &&
+ $warnings[0] eq "Warning: something's wrong at warn.t line 36.\n";
+
+@warnings = ();
+$@ = "";
+warn;
+ok @warnings==1 &&
+ $warnings[0] eq "Warning: something's wrong at warn.t line 42.\n";
+
+@warnings = ();
+$@ = "ERR\n";
+warn "foo\n";
+ok @warnings==1 && $warnings[0] eq "foo\n";
+
+@warnings = ();
+$@ = "ERR\n";
+warn "foo", "bar\n";
+ok @warnings==1 && $warnings[0] eq "foobar\n";
+
+@warnings = ();
+$@ = "ERR\n";
+warn "foo";
+ok @warnings==1 && $warnings[0] eq "foo at warn.t line 58.\n";
+
+@warnings = ();
+$@ = "ERR\n";
+warn $wa;
+ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $wa;
+
+@warnings = ();
+$@ = "ERR\n";
+warn "";
+ok @warnings==1 &&
+ $warnings[0] eq "ERR\n\t...caught at warn.t line 68.\n";
+
+@warnings = ();
+$@ = "ERR\n";
+warn;
+ok @warnings==1 &&
+ $warnings[0] eq "ERR\n\t...caught at warn.t line 74.\n";
+
+@warnings = ();
+$@ = $ea;
+warn "foo\n";
+ok @warnings==1 && $warnings[0] eq "foo\n";
+
+@warnings = ();
+$@ = $ea;
+warn "foo", "bar\n";
+ok @warnings==1 && $warnings[0] eq "foobar\n";
+
+@warnings = ();
+$@ = $ea;
+warn "foo";
+ok @warnings==1 && $warnings[0] eq "foo at warn.t line 90.\n";
+
+@warnings = ();
+$@ = $ea;
+warn $wa;
+ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $wa;
+
+@warnings = ();
+$@ = $ea;
+warn "";
+ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $ea;
+
+@warnings = ();
+$@ = $ea;
+warn;
+ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $ea;
+
+1;
use strict;
-plan 1;
+plan 5;
my $err = "Unimplemented at $0 line " . ( __LINE__ + 2 ) . ".\n";
eval { ... };
is $@, $err;
+
+
+#
+# Regression tests, making sure ... is still parsable as an operator.
+#
+my @lines = split /\n/ => <<'--';
+
+# Check simple range operator.
+my @arr = 'A' ... 'D';
+
+# Range operator with print.
+print 'D' ... 'A';
+
+# Without quotes, 'D' could be a file handle.
+print D ... A ;
+
+# Another possible interaction with a file handle.
+print ${\"D"} ... A ;
+--
+
+foreach my $line (@lines) {
+ next if $line =~ /^\s*#/ || $line !~ /\S/;
+ my $mess = qq {Parsing '...' in "$line" as a range operator};
+ eval qq {
+ {local *STDOUT; no strict "subs"; $line;}
+ pass \$mess;
+ 1;
+ } or do {
+ my $err = $@;
+ $err =~ s/\n//g;
+ fail "$mess ($err)";
+ }
+}
my $make_exceptions_list = ($ARGV[0]||'') eq '--make-exceptions-list';
chdir '..' or die "Can't chdir ..: $!";
+BEGIN { defined $ENV{PERL_UNICODE} and push @INC, "lib"; }
open my $diagfh, "<", "pod/perldiag.pod"
or die "Can't open pod/perldiag.pod: $!";
Invalid type '%c' in %s
Invalid type '%c' in unpack
Invalid type ',' in %s
+Invalid strict version format (0 before decimal required)
+Invalid strict version format (no leading zeros)
+Invalid strict version format (no underscores)
+Invalid strict version format (v1.2.3 required)
+Invalid strict version format (version required)
+Invalid strict version format (1.[0-9] required)
Invalid version format (alpha without decimal)
Invalid version format (misplaced _ in number)
Invalid version object
+It is proposed that "\\c{" no longer be valid. It has historically evaluated to ";". If you disagree with this proposal, send email to perl5-porters@perl.org Otherwise, or in the meantime, you can work around this failure by changing "\\c{" to ";"
'j' not supported on this platform
'J' not supported on this platform
Layer does not match this perl
Unicode non-character 0x%04
Unknown PerlIO layer "scalar"
Unknown Unicode option letter '%c'
-unrecognised control character '%c'
Unstable directory path, current directory changed unexpectedly
Unsupported script encoding UTF-16BE
Unsupported script encoding UTF-16LE
#
# This is a home for regular expression tests that don't fit into
# the format supported by re/regexp.t. If you want to add a test
-# that does fit that format, add it to re/re_tests, not here.
+# that does fit that format, add it to re/re_tests, not here. Tests for \N
+# should be added here because they are treated as single quoted strings
+# there, which means they avoid the lexer which otherwise would look at them.
use strict;
use warnings;
}
-plan tests => 293; # Update this when adding/deleting tests.
+plan tests => 299; # Update this when adding/deleting tests.
run_tests() unless caller;
iseq "@space2", "spc tab";
}
+ {
+ use charnames ":full";
+ local $Message = 'Delayed interpolation of \N';
+ my $r1 = qr/\N{THAI CHARACTER SARA I}/;
+ my $s1 = "\x{E34}\x{E34}\x{E34}\x{E34}";
+
+ # Bug #56444
+ ok $s1 =~ /$r1+/, 'my $r1 = qr/\N{THAI CHARACTER SARA I}/; my $s1 = "\x{E34}\x{E34}\x{E34}\x{E34}; $s1 =~ /$r1+/';
+
+ # Bug #62056
+ ok "${s1}A" =~ m/$s1\N{LATIN CAPITAL LETTER A}/, '"${s1}A" =~ m/$s1\N{LATIN CAPITAL LETTER A}/';
+
+ ok "abbbbc" =~ m/\N{1}/ && $& eq "a", '"abbbbc" =~ m/\N{1}/ && $& eq "a"';
+ ok "abbbbc" =~ m/\N{3,4}/ && $& eq "abbb", '"abbbbc" =~ m/\N{3,4}/ && $& eq "abbb"';
+ }
+
+ {
+ use charnames ":full";
+ local $Message = '[perl #74982] Period coming after \N{}';
+ ok "\x{ff08}." =~ m/\N{FULLWIDTH LEFT PARENTHESIS}./ && $& eq "\x{ff08}.";
+ ok "\x{ff08}." =~ m/[\N{FULLWIDTH LEFT PARENTHESIS}]./ && $& eq "\x{ff08}.";
+ }
+
} # End of sub run_tests
1;
}
-plan tests => 1143; # Update this when adding/deleting tests.
+plan tests => 1159; # Update this when adding/deleting tests.
run_tests() unless caller;
use Cname;
ok 'fooB' =~ /\N{foo}[\N{B}\N{b}]/, "Passthrough charname";
- my $test = 1233;
#
# Why doesn't must_warn work here?
#
my $w;
local $SIG {__WARN__} = sub {$w .= "@_"};
eval 'q(xxWxx) =~ /[\N{WARN}]/';
- ok $w && $w =~ /^Ignoring excess chars from/,
- "Ignoring excess chars warning";
+ ok $w && $w =~ /Using just the first character returned by \\N{} in character class/,
+ "single character in [\\N{}] warning";
undef $w;
eval q [ok "\0" !~ /[\N{EMPTY-STR}XY]/,
"Zerolength charname in charclass doesn't match \\0"];
- ok $w && $w =~ /^Ignoring zero length/,
- 'Ignoring zero length \N{%} in character class warning';
+ ok $w && $w =~ /Ignoring zero length/,
+ 'Ignoring zero length \N{} in character class warning';
ok 'AB' =~ /(\N{EVIL})/ && $1 eq 'A', 'Charname caching $1';
ok 'ABC' =~ /(\N{EVIL})/, 'Charname caching $1';
'Empty string charname produces NOTHING node';
ok '' =~ /\N{EMPTY-STR}/,
'Empty string charname produces NOTHING node';
+ ok "\N{LONG-STR}" =~ /^\N{LONG-STR}$/, 'Verify that long string works';
+ ok "\N{LONG-STR}" =~ /^\N{LONG-STR}$/i, 'Verify under folding that long string works';
+
+ # If remove the limitation in regcomp code these should work
+ # differently
+ undef $w;
+ eval q [ok "\N{LONG-STR}" =~ /^\N{TOO-LONG-STR}$/, 'Verify that too long a string fails gracefully'];
+ ok $w && $w =~ /Using just the first characters returned/, 'Verify that got too-long string warning in \N{} that exceeds the limit';
+ undef $w;
+ eval q [ok "\N{LONG-STR}" =~ /^\N{TOO-LONG-STR}$/i, 'Verify under folding that too long a string fails gracefully'];
+ ok $w && $w =~ /Using just the first characters returned/, 'Verify under folding that got too-long string warning in \N{} that exceeds the limit';
+ undef $w;
+ eval q [ok "\N{TOO-LONG-STR}" !~ /^\N{TOO-LONG-STR}$/, 'Verify that too long a string doesnt work'];
+ ok $w && $w =~ /Using just the first characters returned/, 'Verify that got too-long string warning in \N{} that exceeds the limit';
+ undef $w;
+ eval q [ok "\N{TOO-LONG-STR}" !~ /^\N{TOO-LONG-STR}$/i, 'Verify under folding that too long a string doesnt work'];
+ ok $w && $w =~ /Using just the first characters returned/i, 'Verify under folding that got too-long string warning in \N{} that exceeds the limit';
+ undef $w;
+ eval 'q(syntax error) =~ /\N{MALFORMED}/';
+ ok $@ && $@ =~ /Malformed/, 'Verify that malformed utf8 gives an error';
+ undef $w;
+ eval 'q() =~ /\N{4F}/';
+ ok $w && $w =~ /Deprecated/, 'Verify that leading digit in name gives warning';
+ undef $w;
+ eval 'q() =~ /\N{COM,MA}/';
+ ok $w && $w =~ /Deprecated/, 'Verify that comma in name gives warning';
+ undef $w;
+ my $name = "A\x{D7}O";
+ eval "q(W) =~ /\\N{$name}/";
+ ok $w && $w =~ /Deprecated/, 'Verify that latin1 symbol in name gives warning';
+ undef $w;
+ $name = "A\x{D1}O";
+ eval "q(W) =~ /\\N{$name}/";
+ ok ! $w, 'Verify that latin1 letter in name doesnt give warning';
}
ok "\N{SPACE}\N{U+0041}\N{SPACE}\N{U+0042}" =~
/[\N{SPACE}\N{U+0041}][\N{SPACE}\N{U+0042}]/,
'Intermixed named and unicode escapes';
+ ok "\0" =~ /^\N{NULL}$/, 'Verify that \N{NULL} works; is not confused with an error';
}
require './test.pl';
}
-plan tests => 4;
+plan tests => 5;
my $rx = qr//;
is $output, "5\n1: 5\n2: 5\n", q|/$qr/ with $'_ aliased to a match var|;
}
+
+# Make sure /$qr/ calls get-magic on its LHS (bug ~~~~~).
+{
+ my $scratch;
+ sub qrBug::TIESCALAR{bless[], 'qrBug'}
+ sub qrBug::FETCH { $scratch .= "[fetching]"; 'glat' }
+ tie my $flile, "qrBug";
+ $flile =~ qr/(?:)/;
+ is $scratch, "[fetching]", '/$qr/ with magical LHS';
+}
}
is(regnames_count(),3);
}
+
+ { # Keep this test last, as whole script will be interrupted if times out
+ # Bug #72998; this can loop
+ watchdog(2);
+ eval '"\x{100}\x{FB00}" =~ /\x{100}\N{U+66}+/i';
+ pass("Didn't loop");
+ }
+
# New tests above this line, don't forget to update the test count below!
-BEGIN { plan tests => 18 }
+BEGIN { plan tests => 19 }
# No tests here!
# This stops me getting screenfulls of syntax errors every time I accidentally
-# run this file via a shell glob
+# run this file via a shell glob. Format of this file is given in regexp.t
+# Can't use \N{VALID NAME TEST} here because need 'use charnames'; but can use
+# \N{U+valid} here.
__END__
abc abc y $& abc
abc abc y $-[0] 0
\N{1} abbbbc y $& a
\N{1} abbbbc y $-[0] 0
\N{1} abbbbc y $+[0] 1
+/\N {1}/x abbbbc y $& a
+/\N {1}/x abbbbc y $-[0] 0
+/\N {1}/x abbbbc y $+[0] 1
\N{3,4} abbbbc y $& abbb
\N{3,4} abbbbc y $-[0] 0
\N{3,4} abbbbc y $+[0] 4
+/\N {3,4}/x abbbbc y $& abbb
+/\N {3,4}/x abbbbc y $-[0] 0
+/\N {3,4}/x abbbbc y $+[0] 4
ab{0,}bc abbbbc y $& abbbbc
ab{0,}bc abbbbc y $-[0] 0
ab{0,}bc abbbbc y $+[0] 6
a.c abc y $& abc
a.c axc y $& axc
a\Nc abc y $& abc
+/a\N c/x abc y $& abc
a.*c axyzc y $& axyzc
a\N*c axyzc y $& axyzc
+/a\N *c/x axyzc y $& axyzc
a.*c axyzd n - -
a\N*c axyzd n - -
+/a\N *c/x axyzd n - -
a[bc]d abc n - -
a[bc]d abd y $& abd
a[b]d abd y $& abd
# [perl #60344] Regex lookbehind failure after an (if)then|else in perl 5.10
/\A(?(?=db2)db2|\D+)(?<!processed)\.csv\z/xms sql_processed.csv n - -
/\N{U+0100}/ \x{100} y $& \x{100} # Bug #59328
+/[a\N{U+0100}]/ \x{100} y $& \x{100}
+/[a\N{U+0100}]/ a y $& a
+
+# Verify that \N{U+...} forces Unicode semantics
+/\N{U+41}\x{c1}/i a\x{e1} y $& a\x{e1}
+/[\N{U+41}\x{c1}]/i \x{e1} y $& \x{e1}
+
[\s][\S] \x{a0}\x{a0} nT - - # Unicode complements should not match same character
# was generating malformed utf8
((??{ "(?:|)" }))\s C\x20 y - -
+# Verify that \ escapes the { after \N, and causes \N to match non-newline
+abc\N\{U+BEEF} abc\n{UBEEF} n
+abc\N\{U+BEEF} abc.{UBEEF} y $& abc.{UBEEF}
+[abc\N\{U+BEEF}] - c - \\N in a character class must be a named character
+
+# Verify that \N can be trailing and causes \N to match non-newline
+abc\N abcd y $& abcd
+abc\N abc\n n
+
+# Verify get errors. For these, we need // or else puts it in single quotes,
+# and bypasses the lexer.
+/\N{U+}/ - c - Invalid hexadecimal number
+# Below currently gives a misleading message
+/[\N{U+}]/ - c - Unmatched
+/abc\N{def/ - c - Missing right brace
+/\N{U+4AG3}/ - c - Illegal hexadecimal digit
+/[\N{U+4AG3}]/ - c - Illegal hexadecimal digit
+
+# And verify that in single quotes which bypasses the lexer, the regex compiler
+# figures it out.
+\N{U+} - c - Invalid hexadecimal number
+[\N{U+}] - c - Invalid hexadecimal number
+\N{U+4AG3} - c - Invalid hexadecimal number
+[\N{U+4AG3}] - c - Invalid hexadecimal number
+abc\N{def - c - \\N{NAME} must be resolved by the lexer
+
+# Verify that under /x that still cant have space before left brace
+/abc\N {U+41}/x - c - Missing braces
+/abc\N {SPACE}/x - c - Missing braces
+
+# Verifies catches hex errors, and doesn't expose our . notation to the outside
+/\N{U+0xBEEF}/ - c - Illegal hexadecimal digit
+/\N{U+BEEF.BEAD}/ - c - Illegal hexadecimal digit
+
+# Verify works in single quotish context; regex compiler delivers slightly different msg
+# \N{U+BEEF.BEAD} succeeds here, because can't completely hide it from the outside.
+\N{U+0xBEEF} - c - Invalid hexadecimal number
+
# vim: set noexpandtab
my $count=1;
my @tests;
+my %todo_pass = map { $_ => 1 }
+ qw(00DF 1E9E FB00 FB01 FB02 FB03 FB04 FB05 FB06);
+
my $file="../lib/unicore/CaseFolding.txt";
open my $fh,"<",$file or die "Failed to read '$file': $!";
while (<$fh>) {
$tests[-1]="TODO: { local \$::TODO='Multi-char, non-utf8 folded inside character class [ ] doesnt work';\n$tests[-1] }"
} elsif (! $upgrade && $cpv >= 128 && $cpv <= 255 && $cpv != 0xb5) {
$tests[-1]="TODO: { local \$::TODO='Most non-utf8 latin1 doesnt work';\n$tests[-1] }"
- } elsif (! $swap && $charclass && @folded > 1) {
+ } elsif (! $swap && $charclass && @folded > 1
+ && ! $todo_pass{$cp})
+ {
# There are a few of these that pass; most fail.
$tests[-1]="TODO: { local \$::TODO='Some multi-char, f8 folded inside character class [ ] doesnt work';\n$tests[-1] }"
}
# Do a basic test on all the tied methods of Tie::Hash::NamedCapture
-print "1..13\n";
+plan(tests => 21);
# PL_curpm->paren_names can be a null pointer. See that this succeeds anyway.
'x' =~ /(.)/;
# SCALAR
is(scalar(%+), 3, "SCALAR");
is(scalar(%-), 3, "SCALAR");
+
+# Abuse all methods with undef as the first argument (RT #71828 and then some):
+
+is(Tie::Hash::NamedCapture::FETCH(undef, undef), undef, 'FETCH with undef');
+eval {Tie::Hash::NamedCapture::STORE(undef, undef, undef)};
+like($@, qr/Modification of a read-only value attempted/, 'STORE with undef');
+eval {Tie::Hash::NamedCapture::DELETE(undef, undef)};
+like($@, , qr/Modification of a read-only value attempted/,
+ 'DELETE with undef');
+eval {Tie::Hash::NamedCapture::CLEAR(undef)};
+like($@, qr/Modification of a read-only value attempted/, 'CLEAR with undef');
+is(Tie::Hash::NamedCapture::EXISTS(undef, undef), undef, 'EXISTS with undef');
+is(Tie::Hash::NamedCapture::FIRSTKEY(undef), undef, 'FIRSTKEY with undef');
+is(Tie::Hash::NamedCapture::NEXTKEY(undef, undef), undef, 'NEXTKEY with undef');
+is(Tie::Hash::NamedCapture::SCALAR(undef), undef, 'SCALAR with undef');
# If you want to add a regular expression test that can't be expressed
# in this format, don't add it here: put it in re/pat.t instead.
#
+# Note that the inputs get passed on as "m're'", so the re bypasses the lexer.
+# This means this file cannot be used for testing anything that the lexer
+# handles; in 5.12 this means just \N{NAME} and \N{U+...}.
+#
# Note that columns 2,3 and 5 are all enclosed in double quotes and then
# evalled; so something like a\"\x{100}$1 has length 3+length($1).
}
require './test.pl';
-plan( tests => 142 );
+plan( tests => 149 );
$x = 'foo';
$_ = "x";
fresh_perl_is( '$_=q(foo);s/(.)\G//g;print' => 'foo', '[perl #69056] positive GPOS regex segfault' );
fresh_perl_is( '$_="abcef"; s/bc|(.)\G(.)/$1 ? "[$1-$2]" : "XX"/ge; print' => 'aXX[c-e][e-f]f', 'positive GPOS regex substitution failure' );
+# [perl #~~~~~] $var =~ s/$qr//e calling get-magic on $_ as well as $var
+{
+ local *_;
+ my $scratch;
+ sub qrBug::TIESCALAR { bless[pop], 'qrBug' }
+ sub qrBug::FETCH { $scratch .= "[fetching $_[0][0]]"; 'prew' }
+ sub qrBug::STORE{}
+ tie my $kror, qrBug => '$kror';
+ tie $_, qrBug => '$_';
+ my $qr = qr/(?:)/;
+ $kror =~ s/$qr/""/e;
+ is(
+ $scratch, '[fetching $kror]',
+ 'bug: $var =~ s/$qr//e calling get-magic on $_ as well as $var',
+ );
+}
+
+{ # Bug #41530; replacing non-utf8 with a utf8 causes problems
+ my $string = "a\x{a0}a";
+ my $sub_string = $string;
+ ok(! utf8::is_utf8($sub_string), "Verify that string isn't initially utf8");
+ $sub_string =~ s/a/\x{100}/g;
+ ok(utf8::is_utf8($sub_string),
+ 'Verify replace of non-utf8 with utf8 upgrades to utf8');
+ is($sub_string, "\x{100}\x{A0}\x{100}",
+ 'Verify #41530 fixed: replace of non-utf8 with utf8');
+
+ my $non_sub_string = $string;
+ ok(! utf8::is_utf8($non_sub_string),
+ "Verify that string isn't initially utf8");
+ $non_sub_string =~ s/b/\x{100}/g;
+ ok(! utf8::is_utf8($non_sub_string),
+ "Verify that failed substitute doesn't change string's utf8ness");
+ is($non_sub_string, $string,
+ "Verify that failed substitute doesn't change string");
+}
require './test.pl';
-plan(334);
+plan(360);
run_tests() unless caller;
eval{substr($a,1) = "" ; }; # P=R=S Q
like($@, $FATAL_MSG);
+$b = substr($a,-7,-6) ; # warn # Q R P S
+is($w--, 1);
+eval{substr($a,-7,-6) = "" ; }; # Q R P S
+like($@, $FATAL_MSG);
+
my $a = 'zxcvbnm';
substr($a,2,0) = '';
is($a, 'zxcvbnm');
is(substr($a,1,1), 'b');
}
+# [perl #62646] offsets exceeding 32 bits on 64-bit system
+SKIP: {
+ skip("32-bit system", 24) unless ~0 > 0xffffffff;
+ my $a = "abc";
+ my $s;
+ my $r;
+
+ utf8::downgrade($a);
+ for (1..2) {
+ $w = 0;
+ $r = substr($a, 0xffffffff, 1);
+ is($r, undef);
+ is($w, 1);
+
+ $w = 0;
+ $r = substr($a, 0xffffffff+1, 1);
+ is($r, undef);
+ is($w, 1);
+
+ $w = 0;
+ ok( !eval { $r = substr($s=$a, 0xffffffff, 1, "_"); 1 } );
+ is($r, undef);
+ is($s, $a);
+ is($w, 0);
+
+ $w = 0;
+ ok( !eval { $r = substr($s=$a, 0xffffffff+1, 1, "_"); 1 } );
+ is($r, undef);
+ is($s, $a);
+ is($w, 0);
+
+ utf8::upgrade($a);
+ }
+}
+
}
print $@
EXPECT
Malformed UTF-8 character (unexpected end of string) in substitution (s///) at
+######## "#75146: 27e904532594b7fb (fix for #23810) introduces a #regression"
+use strict;
+
+unshift @INC, sub {
+ my ($self, $fn) = @_;
+
+ (my $pkg = $fn) =~ s{/}{::}g;
+ $pkg =~ s{.pm$}{};
+
+ if ($pkg eq 'Credit') {
+ my $code = <<'EOC';
+package Credit;
+
+use NonsenseAndBalderdash;
+
+1;
+EOC
+ eval $code;
+ die "\$@ is $@";
+ }
+
+ #print STDERR "Generator: not one of mine, ignoring\n";
+ return undef;
+};
+
+# create load-on-demand new() constructors
+{
+ package Credit;
+ sub new {
+ eval "use Credit";
+ }
+};
+
+eval {
+ my $credit = new Credit;
+};
+
+print "If you get here, you didn't crash\n";
+EXPECT
+If you get here, you didn't crash
my @keys = grep {exists $ENV{$_}} qw(CDPATH IFS ENV BASH_ENV);
local @ENV{@keys} = ();
# Untaint, plus take out . and empty string:
- local $ENV{'DCL$PATH'} = $1 if $is_vms && ($ENV{'DCL$PATH'} =~ /(.*)/s);
+ local $ENV{'DCL$PATH'} = $1 if $is_vms && exists($ENV{'DCL$PATH'}) && ($ENV{'DCL$PATH'} =~ /(.*)/s);
$ENV{PATH} =~ /(.*)/s;
local $ENV{PATH} =
join $sep, grep { $_ ne "" and $_ ne "." and -d $_ and
time = time >= 0 ? floor(time / 60.0) : ceil(time / 60.0);
v_tm_hour = (int)fmod(time, 24.0);
time = time >= 0 ? floor(time / 24.0) : ceil(time / 24.0);
- v_tm_tday = (int)time;
+ v_tm_tday = time;
WRAP (v_tm_sec, v_tm_min, 60);
WRAP (v_tm_min, v_tm_hour, 60);
}
/*
-=for apidoc Amx|void|lex_stuff_pvn|char *pv|STRLEN len|U32 flags
+=for apidoc Amx|void|lex_stuff_pvn|const char *pv|STRLEN len|U32 flags
Insert characters into the lexer buffer (L</PL_parser-E<gt>linestr>),
immediately after the current lexing point (L</PL_parser-E<gt>bufptr>),
*/
void
-Perl_lex_stuff_pvn(pTHX_ char *pv, STRLEN len, U32 flags)
+Perl_lex_stuff_pvn(pTHX_ const char *pv, STRLEN len, U32 flags)
{
+ dVAR;
char *bufptr;
PERL_ARGS_ASSERT_LEX_STUFF_PVN;
if (flags & ~(LEX_STUFF_UTF8))
goto plain_copy;
} else {
STRLEN highhalf = 0;
- char *p, *e = pv+len;
+ const char *p, *e = pv+len;
for (p = pv; p != e; p++)
highhalf += !!(((U8)*p) & 0x80);
if (!highhalf)
lex_grow_linestr(SvCUR(PL_parser->linestr)+1+len+highhalf);
bufptr = PL_parser->bufptr;
Move(bufptr, bufptr+len+highhalf, PL_parser->bufend+1-bufptr, char);
+ SvCUR_set(PL_parser->linestr,
+ SvCUR(PL_parser->linestr) + len+highhalf);
PL_parser->bufend += len+highhalf;
for (p = pv; p != e; p++) {
U8 c = (U8)*p;
} else {
if (flags & LEX_STUFF_UTF8) {
STRLEN highhalf = 0;
- char *p, *e = pv+len;
+ const char *p, *e = pv+len;
for (p = pv; p != e; p++) {
U8 c = (U8)*p;
if (c >= 0xc4) {
lex_grow_linestr(SvCUR(PL_parser->linestr)+1+len-highhalf);
bufptr = PL_parser->bufptr;
Move(bufptr, bufptr+len-highhalf, PL_parser->bufend+1-bufptr, char);
+ SvCUR_set(PL_parser->linestr,
+ SvCUR(PL_parser->linestr) + len-highhalf);
PL_parser->bufend += len-highhalf;
for (p = pv; p != e; p++) {
U8 c = (U8)*p;
lex_grow_linestr(SvCUR(PL_parser->linestr)+1+len);
bufptr = PL_parser->bufptr;
Move(bufptr, bufptr+len, PL_parser->bufend+1-bufptr, char);
+ SvCUR_set(PL_parser->linestr, SvCUR(PL_parser->linestr) + len);
PL_parser->bufend += len;
Copy(pv, bufptr, len, char);
}
Normally it is not necessarily to do this directly, because it suffices to
use the implicit discarding behaviour of L</lex_next_chunk> and things
based on it. However, if a token stretches across multiple lines,
-and the lexing code has kept multiple lines of text in the buffer fof
+and the lexing code has kept multiple lines of text in the buffer for
that purpose, then after completion of the token it would be wise to
explicitly discard the now-unneeded earlier lines, to avoid future
multi-line tokens growing the buffer without bound.
I32
Perl_lex_peek_unichar(pTHX_ U32 flags)
{
+ dVAR;
char *s, *bufend;
if (flags & ~(LEX_KEEP_PREVIOUS))
Perl_croak(aTHX_ "Lexing code internal error (%s)", "lex_peek_unichar");
=cut
*/
+#define LEX_NO_NEXT_CHUNK 0x80000000
+
void
Perl_lex_read_space(pTHX_ U32 flags)
{
char *s, *bufend;
bool need_incline = 0;
- if (flags & ~(LEX_KEEP_PREVIOUS))
+ if (flags & ~(LEX_KEEP_PREVIOUS|LEX_NO_NEXT_CHUNK))
Perl_croak(aTHX_ "Lexing code internal error (%s)", "lex_read_space");
#ifdef PERL_MAD
if (PL_skipwhite) {
if (PL_madskills)
sv_catpvn(PL_skipwhite, PL_parser->bufptr, s-PL_parser->bufptr);
#endif /* PERL_MAD */
+ if (flags & LEX_NO_NEXT_CHUNK)
+ break;
PL_parser->bufptr = s;
CopLINE_inc(PL_curcop);
got_more = lex_next_chunk(flags);
if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
while (s < PL_bufend && SPACE_OR_TAB(*s))
s++;
- } else if (PL_sublex_info.sub_inwhat || PL_lex_state == LEX_FORMLINE) {
- while (isSPACE(*s) && *s != '\n')
- s++;
- if (*s == '#') {
- do {
- s++;
- } while (s != PL_bufend && *s != '\n');
- }
- if (*s == '\n')
- s++;
} else {
STRLEN bufptr_pos = PL_bufptr - SvPVX(PL_linestr);
PL_bufptr = s;
- lex_read_space(LEX_KEEP_PREVIOUS);
+ lex_read_space(LEX_KEEP_PREVIOUS |
+ (PL_sublex_info.sub_inwhat || PL_lex_state == LEX_FORMLINE ?
+ LEX_NO_NEXT_CHUNK : 0));
s = PL_bufptr;
PL_bufptr = SvPVX(PL_linestr) + bufptr_pos;
if (PL_linestart > PL_bufptr)
#endif
if (*d == ';' || isSPACE(*d) || *d == '}' || !*d) {
SV *ver;
+#ifdef USE_LOCALE_NUMERIC
+ char *loc = setlocale(LC_NUMERIC, "C");
+#endif
s = scan_num(s, &pl_yylval);
+#ifdef USE_LOCALE_NUMERIC
+ setlocale(LC_NUMERIC, loc);
+#endif
version = pl_yylval.opval;
ver = cSVOPx(version)->op_sv;
if (SvPOK(ver) && !SvNIOK(ver)) {
}
/*
+ * S_force_strict_version
+ * Forces the next token to be a version number using strict syntax rules.
+ */
+
+STATIC char *
+S_force_strict_version(pTHX_ char *s)
+{
+ dVAR;
+ OP *version = NULL;
+#ifdef PERL_MAD
+ I32 startoff = s - SvPVX(PL_linestr);
+#endif
+ const char *errstr = NULL;
+
+ PERL_ARGS_ASSERT_FORCE_STRICT_VERSION;
+
+ while (isSPACE(*s)) /* leading whitespace */
+ s++;
+
+ if (is_STRICT_VERSION(s,&errstr)) {
+ SV *ver = newSV(0);
+ s = (char *)scan_version(s, ver, 0);
+ version = newSVOP(OP_CONST, 0, ver);
+ }
+ else if ( (*s != ';' && *s != '}' ) && (s = SKIPSPACE1(s), (*s != ';' && *s !='}' ))) {
+ PL_bufptr = s;
+ if (errstr)
+ yyerror(errstr); /* version required */
+ return s;
+ }
+
+#ifdef PERL_MAD
+ if (PL_madskills && !version) {
+ sv_free(PL_nextwhite); /* let next token collect whitespace */
+ PL_nextwhite = 0;
+ s = SvPVX(PL_linestr) + startoff;
+ }
+#endif
+ /* NOTE: The parser sees the package name and the VERSION swapped */
+ start_force(PL_curforce);
+ NEXTVAL_NEXTTOKE.opval = version;
+ force_next(WORD);
+
+ return s;
+}
+
+/*
* S_tokeq
* Tokenize a quoted string passed in as an SV. It finds the next
* chunk, up to end of string or a backslash. It may make a new
In patterns:
backslashes:
- double-quoted style: \r and \n
- regexp special ones: \D \s
- constants: \x31
- backrefs: \1
+ constants: \N{NAME} only
case and quoting: \U \Q \E
stops on @ and $, but not for $ as tail anchor
In double-quoted strings:
backslashes:
double-quoted style: \r and \n
- constants: \x31
+ constants: \x31, etc.
deprecated backrefs: \1 (in substitution replacements)
case and quoting: \U \Q \E
stops on @ and $
check for embedded arrays
check for embedded scalars
if (backslash) {
- leave intact backslashes from leaveit (below)
deprecate \1 in substitution replacements
handle string-changing backslashes \l \U \Q \E, etc.
switch (what was escaped) {
handle \- in a transliteration (becomes a literal -)
+ if a pattern and not \N{, go treat as regular character
handle \132 (octal characters)
handle \x15 and \x{1234} (hex characters)
- handle \N{name} (named characters)
+ handle \N{name} (named characters, also \N{3,5} in a pattern)
handle \cV (control characters)
handle printf-style backslashes (\f, \r, \n, etc)
} (end switch)
while (s < send || dorange) {
+
/* get transliterations out of the way (they're most literal) */
if (PL_lex_inwhat == OP_TRANS) {
/* expand a range A-Z to the full set of characters. AIE! */
/* backslashes */
if (*s == '\\' && s+1 < send) {
+ char* e; /* Can be used for ending '}', etc. */
+
s++;
/* deprecate \1 in strings and substitution replacements */
--s;
break;
}
- /* skip any other backslash escapes in a pattern */
- else if (PL_lex_inpat) {
+ /* In a pattern, process \N, but skip any other backslash escapes.
+ * This is because we don't want to translate an escape sequence
+ * into a meta symbol and have the regex compiler use the meta
+ * symbol meaning, e.g. \x{2E} would be confused with a dot. But
+ * in spite of this, we do have to process \N here while the proper
+ * charnames handler is in scope. See bugs #56444 and #62056.
+ * There is a complication because \N in a pattern may also stand
+ * for 'match a non-nl', and not mean a charname, in which case its
+ * processing should be deferred to the regex compiler. To be a
+ * charname it must be followed immediately by a '{', and not look
+ * like \N followed by a curly quantifier, i.e., not something like
+ * \N{3,}. regcurly returns a boolean indicating if it is a legal
+ * quantifier */
+ else if (PL_lex_inpat
+ && (*s != 'N'
+ || s[1] != '{'
+ || regcurly(s + 1)))
+ {
*d++ = NATIVE_TO_NEED(has_utf8,'\\');
goto default_action;
}
- /* if we get here, it's either a quoted -, or a digit */
switch (*s) {
/* quoted - in transliterations */
}
NUM_ESCAPE_INSERT:
- /* Insert oct, hex, or \N{U+...} escaped character. There will
- * always be enough room in sv since such escapes will be
- * longer than any UTF-8 sequence they can end up as, except if
- * they force us to recode the rest of the string into utf8 */
+ /* Insert oct or hex escaped character. There will always be
+ * enough room in sv since such escapes will be longer than any
+ * UTF-8 sequence they can end up as, except if they force us
+ * to recode the rest of the string into utf8 */
/* Here uv is the ordinal of the next character being added in
- * unicode (converted from native). (It has to be done before
- * here because \N is interpreted as unicode, and oct and hex
- * as native.) */
+ * unicode (converted from native). */
if (!UNI_IS_INVARIANT(uv)) {
if (!has_utf8 && uv > 255) {
/* Might need to recode whatever we have accumulated so
}
continue;
- /* \N{LATIN SMALL LETTER A} is a named character, and so is
- * \N{U+0041} */
case 'N':
- ++s;
- if (*s == '{') {
- char* e = strchr(s, '}');
- SV *res;
- STRLEN len;
- const char *str;
-
- if (!e) {
+ /* In a non-pattern \N must be a named character, like \N{LATIN
+ * SMALL LETTER A} or \N{U+0041}. For patterns, it also can
+ * mean to match a non-newline. For non-patterns, named
+ * characters are converted to their string equivalents. In
+ * patterns, named characters are not converted to their
+ * ultimate forms for the same reasons that other escapes
+ * aren't. Instead, they are converted to the \N{U+...} form
+ * to get the value from the charnames that is in effect right
+ * now, while preserving the fact that it was a named character
+ * so that the regex compiler knows this */
+
+ /* This section of code doesn't generally use the
+ * NATIVE_TO_NEED() macro to transform the input. I (khw) did
+ * a close examination of this macro and determined it is a
+ * no-op except on utfebcdic variant characters. Every
+ * character generated by this that would normally need to be
+ * enclosed by this macro is invariant, so the macro is not
+ * needed, and would complicate use of copy(). There are other
+ * parts of this file where the macro is used inconsistently,
+ * but are saved by it being a no-op */
+
+ /* The structure of this section of code (besides checking for
+ * errors and upgrading to utf8) is:
+ * Further disambiguate between the two meanings of \N, and if
+ * not a charname, go process it elsewhere
+ * If of form \N{U+...}, pass it through if a pattern;
+ * otherwise convert to utf8
+ * Otherwise must be \N{NAME}: convert to \N{U+c1.c2...} if a
+ * pattern; otherwise convert to utf8 */
+
+ /* Here, s points to the 'N'; the test below is guaranteed to
+ * succeed if we are being called on a pattern as we already
+ * know from a test above that the next character is a '{'.
+ * On a non-pattern \N must mean 'named sequence, which
+ * requires braces */
+ s++;
+ if (*s != '{') {
+ yyerror("Missing braces on \\N{}");
+ continue;
+ }
+ s++;
+
+ /* If there is no matching '}', it is an error. */
+ if (! (e = strchr(s, '}'))) {
+ if (! PL_lex_inpat) {
yyerror("Missing right brace on \\N{}");
- e = s - 1;
- goto cont_scan;
- }
- if (e > s + 2 && s[1] == 'U' && s[2] == '+') {
- /* \N{U+...} The ... is a unicode value even on EBCDIC
- * machines */
- I32 flags = PERL_SCAN_ALLOW_UNDERSCORES |
- PERL_SCAN_DISALLOW_PREFIX;
- s += 3;
- len = e - s;
- uv = grok_hex(s, &len, &flags, NULL);
- if ( e > s && len != (STRLEN)(e - s) ) {
- uv = 0xFFFD;
- }
- s = e + 1;
- goto NUM_ESCAPE_INSERT;
+ } else {
+ yyerror("Missing right brace on \\N{} or unescaped left brace after \\N.");
}
- res = newSVpvn(s + 1, e - s - 1);
- res = new_constant( NULL, 0, "charnames",
- res, NULL, s - 2, e - s + 3 );
- if (has_utf8)
- sv_utf8_upgrade(res);
- str = SvPV_const(res,len);
-#ifdef EBCDIC_NEVER_MIND
- /* charnames uses pack U and that has been
- * recently changed to do the below uni->native
- * mapping, so this would be redundant (and wrong,
- * the code point would be doubly converted).
- * But leave this in just in case the pack U change
- * gets revoked, but the semantics is still
- * desireable for charnames. --jhi */
- {
- UV uv = utf8_to_uvchr((const U8*)str, 0);
+ continue;
+ }
- if (uv < 0x100) {
- U8 tmpbuf[UTF8_MAXBYTES+1], *d;
+ /* Here it looks like a named character */
- d = uvchr_to_utf8(tmpbuf, UNI_TO_NATIVE(uv));
- sv_setpvn(res, (char *)tmpbuf, d - tmpbuf);
- str = SvPV_const(res, len);
- }
- }
-#endif
- /* If destination is not in utf8 but this new character is,
- * recode the dest to utf8 */
- if (!has_utf8 && SvUTF8(res)) {
+ if (PL_lex_inpat) {
+
+ /* XXX This block is temporary code. \N{} implies that the
+ * pattern is to have Unicode semantics, and therefore
+ * currently has to be encoded in utf8. By putting it in
+ * utf8 now, we save a whole pass in the regular expression
+ * compiler. Once that code is changed so Unicode
+ * semantics doesn't necessarily have to be in utf8, this
+ * block should be removed */
+ if (!has_utf8) {
SvCUR_set(sv, d - SvPVX_const(sv));
SvPOK_on(sv);
*d = '\0';
/* See Note on sizing above. */
sv_utf8_upgrade_flags_grow(sv,
- SV_GMAGIC|SV_FORCE_UTF8_UPGRADE,
- len + (STRLEN)(send - s) + 1);
+ SV_GMAGIC|SV_FORCE_UTF8_UPGRADE,
+ /* 5 = '\N{' + cur char + NUL */
+ (STRLEN)(send - s) + 5);
d = SvPVX(sv) + SvCUR(sv);
has_utf8 = TRUE;
- } else if (len > (STRLEN)(e - s + 4)) { /* I _guess_ 4 is \N{} --jhi */
+ }
+ }
+
+ if (*s == 'U' && s[1] == '+') { /* \N{U+...} */
+ I32 flags = PERL_SCAN_ALLOW_UNDERSCORES
+ | PERL_SCAN_DISALLOW_PREFIX;
+ STRLEN len;
+
+ /* For \N{U+...}, the '...' is a unicode value even on
+ * EBCDIC machines */
+ s += 2; /* Skip to next char after the 'U+' */
+ len = e - s;
+ uv = grok_hex(s, &len, &flags, NULL);
+ if (len == 0 || len != (STRLEN)(e - s)) {
+ yyerror("Invalid hexadecimal number in \\N{U+...}");
+ s = e + 1;
+ continue;
+ }
+
+ if (PL_lex_inpat) {
+
+ /* Pass through to the regex compiler unchanged. The
+ * reason we evaluated the number above is to make sure
+ * there wasn't a syntax error. */
+ s -= 5; /* Include the '\N{U+' */
+ Copy(s, d, e - s + 1, char); /* 1 = include the } */
+ d += e - s + 1;
+ }
+ else { /* Not a pattern: convert the hex to string */
+
+ /* If destination is not in utf8, unconditionally
+ * recode it to be so. This is because \N{} implies
+ * Unicode semantics, and scalars have to be in utf8
+ * to guarantee those semantics */
+ if (! has_utf8) {
+ SvCUR_set(sv, d - SvPVX_const(sv));
+ SvPOK_on(sv);
+ *d = '\0';
+ /* See Note on sizing above. */
+ sv_utf8_upgrade_flags_grow(
+ sv,
+ SV_GMAGIC|SV_FORCE_UTF8_UPGRADE,
+ UNISKIP(uv) + (STRLEN)(send - e) + 1);
+ d = SvPVX(sv) + SvCUR(sv);
+ has_utf8 = TRUE;
+ }
+
+ /* Add the string to the output */
+ if (UNI_IS_INVARIANT(uv)) {
+ *d++ = (char) uv;
+ }
+ else d = (char*)uvuni_to_utf8((U8*)d, uv);
+ }
+ }
+ else { /* Here is \N{NAME} but not \N{U+...}. */
- /* See Note on sizing above. (NOTE: SvCUR() is not set
- * correctly here). */
- const STRLEN off = d - SvPVX_const(sv);
- d = SvGROW(sv, off + len + (STRLEN)(send - s) + 1) + off;
+ SV *res; /* result from charnames */
+ const char *str; /* the string in 'res' */
+ STRLEN len; /* its length */
+
+ /* Get the value for NAME */
+ res = newSVpvn(s, e - s);
+ res = new_constant( NULL, 0, "charnames",
+ /* includes all of: \N{...} */
+ res, NULL, s - 3, e - s + 4 );
+
+ /* Most likely res will be in utf8 already since the
+ * standard charnames uses pack U, but a custom translator
+ * can leave it otherwise, so make sure. XXX This can be
+ * revisited to not have charnames use utf8 for characters
+ * that don't need it when regexes don't have to be in utf8
+ * for Unicode semantics. If doing so, remember EBCDIC */
+ sv_utf8_upgrade(res);
+ str = SvPV_const(res, len);
+
+ /* Don't accept malformed input */
+ if (! is_utf8_string((U8 *) str, len)) {
+ yyerror("Malformed UTF-8 returned by \\N");
}
+ else if (PL_lex_inpat) {
+
+ if (! len) { /* The name resolved to an empty string */
+ Copy("\\N{}", d, 4, char);
+ d += 4;
+ }
+ else {
+ /* In order to not lose information for the regex
+ * compiler, pass the result in the specially made
+ * syntax: \N{U+c1.c2.c3...}, where c1 etc. are
+ * the code points in hex of each character
+ * returned by charnames */
+
+ const char *str_end = str + len;
+ STRLEN char_length; /* cur char's byte length */
+ STRLEN output_length; /* and the number of bytes
+ after this is translated
+ into hex digits */
+ const STRLEN off = d - SvPVX_const(sv);
+
+ /* 2 hex per byte; 2 chars for '\N'; 2 chars for
+ * max('U+', '.'); and 1 for NUL */
+ char hex_string[2 * UTF8_MAXBYTES + 5];
+
+ /* Get the first character of the result. */
+ U32 uv = utf8n_to_uvuni((U8 *) str,
+ len,
+ &char_length,
+ UTF8_ALLOW_ANYUV);
+
+ /* The call to is_utf8_string() above hopefully
+ * guarantees that there won't be an error. But
+ * it's easy here to make sure. The function just
+ * above warns and returns 0 if invalid utf8, but
+ * it can also return 0 if the input is validly a
+ * NUL. Disambiguate */
+ if (uv == 0 && NATIVE_TO_ASCII(*str) != '\0') {
+ uv = UNICODE_REPLACEMENT;
+ }
+
+ /* Convert first code point to hex, including the
+ * boiler plate before it */
+ sprintf(hex_string, "\\N{U+%X", (unsigned int) uv);
+ output_length = strlen(hex_string);
+
+ /* Make sure there is enough space to hold it */
+ d = off + SvGROW(sv, off
+ + output_length
+ + (STRLEN)(send - e)
+ + 2); /* '}' + NUL */
+ /* And output it */
+ Copy(hex_string, d, output_length, char);
+ d += output_length;
+
+ /* For each subsequent character, append dot and
+ * its ordinal in hex */
+ while ((str += char_length) < str_end) {
+ const STRLEN off = d - SvPVX_const(sv);
+ U32 uv = utf8n_to_uvuni((U8 *) str,
+ str_end - str,
+ &char_length,
+ UTF8_ALLOW_ANYUV);
+ if (uv == 0 && NATIVE_TO_ASCII(*str) != '\0') {
+ uv = UNICODE_REPLACEMENT;
+ }
+
+ sprintf(hex_string, ".%X", (unsigned int) uv);
+ output_length = strlen(hex_string);
+
+ d = off + SvGROW(sv, off
+ + output_length
+ + (STRLEN)(send - e)
+ + 2); /* '}' + NUL */
+ Copy(hex_string, d, output_length, char);
+ d += output_length;
+ }
+
+ *d++ = '}'; /* Done. Add the trailing brace */
+ }
+ }
+ else { /* Here, not in a pattern. Convert the name to a
+ * string. */
+
+ /* If destination is not in utf8, unconditionally
+ * recode it to be so. This is because \N{} implies
+ * Unicode semantics, and scalars have to be in utf8
+ * to guarantee those semantics */
+ if (! has_utf8) {
+ SvCUR_set(sv, d - SvPVX_const(sv));
+ SvPOK_on(sv);
+ *d = '\0';
+ /* See Note on sizing above. */
+ sv_utf8_upgrade_flags_grow(sv,
+ SV_GMAGIC|SV_FORCE_UTF8_UPGRADE,
+ len + (STRLEN)(send - s) + 1);
+ d = SvPVX(sv) + SvCUR(sv);
+ has_utf8 = TRUE;
+ } else if (len > (STRLEN)(e - s + 4)) { /* I _guess_ 4 is \N{} --jhi */
+
+ /* See Note on sizing above. (NOTE: SvCUR() is not
+ * set correctly here). */
+ const STRLEN off = d - SvPVX_const(sv);
+ d = off + SvGROW(sv, off + len + (STRLEN)(send - s) + 1);
+ }
+ Copy(str, d, len, char);
+ d += len;
+ }
+ SvREFCNT_dec(res);
+
+ /* Deprecate non-approved name syntax */
+ if (ckWARN_d(WARN_DEPRECATED)) {
+ bool problematic = FALSE;
+ char* i = s;
+
+ /* For non-ut8 input, look to see that the first
+ * character is an alpha, then loop through the rest
+ * checking that each is a continuation */
+ if (! this_utf8) {
+ if (! isALPHAU(*i)) problematic = TRUE;
+ else for (i = s + 1; i < e; i++) {
+ if (isCHARNAME_CONT(*i)) continue;
+ problematic = TRUE;
+ break;
+ }
+ }
+ else {
+ /* Similarly for utf8. For invariants can check
+ * directly. We accept anything above the latin1
+ * range because it is immaterial to Perl if it is
+ * correct or not, and is expensive to check. But
+ * it is fairly easy in the latin1 range to convert
+ * the variants into a single character and check
+ * those */
+ if (UTF8_IS_INVARIANT(*i)) {
+ if (! isALPHAU(*i)) problematic = TRUE;
+ } else if (UTF8_IS_DOWNGRADEABLE_START(*i)) {
+ if (! isALPHAU(UNI_TO_NATIVE(UTF8_ACCUMULATE(*i,
+ *(i+1)))))
+ {
+ problematic = TRUE;
+ }
+ }
+ if (! problematic) for (i = s + UTF8SKIP(s);
+ i < e;
+ i+= UTF8SKIP(i))
+ {
+ if (UTF8_IS_INVARIANT(*i)) {
+ if (isCHARNAME_CONT(*i)) continue;
+ } else if (! UTF8_IS_DOWNGRADEABLE_START(*i)) {
+ continue;
+ } else if (isCHARNAME_CONT(
+ UNI_TO_NATIVE(
+ UTF8_ACCUMULATE(*i, *(i+1)))))
+ {
+ continue;
+ }
+ problematic = TRUE;
+ break;
+ }
+ }
+ if (problematic) {
+ /* The e-i passed to the final %.*s makes sure that
+ * should the trailing NUL be missing that this
+ * print won't run off the end of the string */
+ Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
+ "Deprecated character in \\N{...}; marked by <-- HERE in \\N{%.*s<-- HERE %.*s", i - s + 1, s, e - i, i + 1);
+ }
+ }
+ } /* End \N{NAME} */
#ifdef EBCDIC
- if (!dorange)
- native_range = FALSE; /* \N{} is guessed to be Unicode */
+ if (!dorange)
+ native_range = FALSE; /* \N{} is defined to be Unicode */
#endif
- Copy(str, d, len, char);
- d += len;
- SvREFCNT_dec(res);
- cont_scan:
- s = e + 1;
- }
- else
- yyerror("Missing braces on \\N{}");
+ s = e + 1; /* Point to just after the '}' */
continue;
/* \c is a control character */
case 'c':
s++;
if (s < send) {
- U8 c = *s++;
-#ifdef EBCDIC
- if (isLOWER(c))
- c = toUPPER(c);
-#endif
- *d++ = NATIVE_TO_NEED(has_utf8,toCTRL(c));
+ *d++ = grok_bslash_c(*s++, 1);
}
else {
yyerror("Missing control char name in \\c");
}
}
- if (s[1] == '#' && (isIDFIRST_lazy_if(s+2,UTF) || strchr("{$:+-", s[2]))) {
+ if (s[1] == '#' && (isIDFIRST_lazy_if(s+2,UTF) || strchr("{$:+-@", s[2]))) {
PL_tokenbuf[0] = '@';
s = scan_ident(s + 1, PL_bufend, PL_tokenbuf + 1,
sizeof PL_tokenbuf - 1, FALSE);
/* Is this a label? */
if (!anydelim && PL_expect == XSTATE
&& d < PL_bufend && *d == ':' && *(d + 1) != ':') {
- if (tmp)
- Perl_croak(aTHX_ "Can't use keyword '%s' as a label", PL_tokenbuf);
s = d + 1;
pl_yylval.pval = CopLABEL_alloc(PL_tokenbuf);
CLINE;
case KEY_package:
s = force_word(s,WORD,FALSE,TRUE,FALSE);
- s = force_version(s, FALSE);
+ s = SKIPSPACE1(s);
+ s = force_strict_version(s);
OPERATOR(PACKAGE);
case KEY_pipe:
bool must_be_last = FALSE;
bool underscore = FALSE;
bool seen_underscore = FALSE;
- const bool warnsyntax = ckWARN(WARN_SYNTAX);
+ const bool warnillegalproto = ckWARN(WARN_ILLEGALPROTO);
s = scan_str(s,!!PL_madskills,FALSE);
if (!s)
if (!isSPACE(*p)) {
d[tmp++] = *p;
- if (warnsyntax) {
+ if (warnillegalproto) {
if (must_be_last)
proto_after_greedy_proto = TRUE;
if (!strchr("$@%*;[]&\\_", *p)) {
}
d[tmp] = '\0';
if (proto_after_greedy_proto)
- Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
+ Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO),
"Prototype after '%c' for %"SVf" : %s",
greedy_proto, SVfARG(PL_subname), d);
if (bad_proto)
- Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
+ Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO),
"Illegal character %sin prototype for %"SVf" : %s",
seen_underscore ? "after '_' " : "",
SVfARG(PL_subname), d);
SvREFCNT_dec(msg);
return sv;
}
+
+ /* charnames doesn't work well if there have been errors found */
+ if (PL_error_count > 0 && strEQ(key,"charnames"))
+ return &PL_sv_undef;
+
cvp = hv_fetch(table, key, keylen, FALSE);
if (!cvp || !SvOK(*cvp)) {
why1 = "$^H{";
return pmfl;
}
-void
-Perl_pmflag(pTHX_ U32* pmfl, int ch)
-{
- PERL_ARGS_ASSERT_PMFLAG;
-
- Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
- "Perl_pmflag() is deprecated, and will be removed from the XS API");
-
- if (ch<256) {
- *pmfl = S_pmflag(*pmfl, (char)ch);
- }
-}
-
STATIC char *
S_scan_pat(pTHX_ char *start, I32 type)
{
SV *const utf16_buffer = MUTABLE_SV(IoTOP_GV(filter));
SV *const utf8_buffer = filter;
IV status = IoPAGE(filter);
- const bool reverse = (bool) IoLINES(filter);
+ const bool reverse = cBOOL(IoLINES(filter));
I32 retval;
/* As we're automatically added, at the lowest level, and hence only called
afsroot='/afs'
alignbytes='4'
aphostname='/bin/hostname'
-archlib='/usr/local/lib/perl5/5.11/unknown'
-archlibexp='/usr/local/lib/perl5/5.11/unknown'
+archlib='/usr/local/lib/perl5/5.12/unknown'
+archlibexp='/usr/local/lib/perl5/5.12/unknown'
archname='unknown'
asctime_r_proto='0'
bin='/usr/local/bin'
d_pipe='undef'
d_poll='undef'
d_portable='undef'
+d_prctl='undef'
+d_prctl_set_name='undef'
d_printf_format_null='undef'
d_procselfexe='undef'
d_pseudofork='undef'
package='perl5'
phostname='hostname'
pidtype=int
-privlib='/usr/local/lib/perl5/5.11'
-privlibexp='/usr/local/lib/perl5/5.11'
+privlib='/usr/local/lib/perl5/5.12'
+privlibexp='/usr/local/lib/perl5/5.12'
procselfexe=''
prototype='undef'
ptrsize='4'
sig_num_init='0'
sig_size='1'
signal_t=int
-sitearch='/usr/local/lib/perl5/5.11/unknown'
-sitearchexp='/usr/local/lib/perl5/5.11/unknown'
-sitelib='/usr/local/lib/perl5/5.11'
+sitearch='/usr/local/lib/perl5/5.12/unknown'
+sitearchexp='/usr/local/lib/perl5/5.12/unknown'
+sitelib='/usr/local/lib/perl5/5.12'
sitelib_stem='/usr/local/lib/perl5'
-sitelibexp='/usr/local/lib/perl5/5.11'
+sitelibexp='/usr/local/lib/perl5/5.12'
sizesize=4
sizetype='size_t'
socksizetype='int'
uvtype='unsigned long'
uvuformat='"lu"'
uvxformat='"lx"'
+vaproto='undef'
vendorarch=''
vendorarchexp=''
vendorlib_stem=''
? HvNAME(SvSTASH(SvRV(ST(0))))
: (char *)SvPV_nolen(ST(0));
- if ( items == 1 || vs == &PL_sv_undef ) { /* no param or explicit undef */
+ if ( items == 1 || ! SvOK(vs) ) { /* no param or explicit undef */
/* create empty object */
vs = sv_newmortal();
- sv_setpvs(vs,"");
+ sv_setpvs(vs, "0");
}
else if ( items == 3 ) {
vs = sv_newmortal();
if ( ! sv_derived_from(robj, "version") )
{
- robj = new_version(robj);
+ robj = new_version(SvOK(robj) ? robj : newSVpvs("0"));
}
rvs = SvRV(robj);
SV * ver = ST(0);
SV * rv;
const char * classname = "";
- if ( items == 2 && (ST(1)) != &PL_sv_undef ) {
+ if ( items == 2 && SvOK(ST(1)) ) {
/* getting called as object or class method */
ver = ST(1);
classname =
if (items != 1)
croak_xs_usage(cv, "sv");
else {
- const SV * const sv = ST(0);
+ SV * const sv = ST(0);
+ SvGETMAGIC(sv);
if (SvUTF8(sv))
XSRETURN_YES;
else
rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
- if (!rx)
+ if (!rx || !SvROK(ST(0)))
XSRETURN_UNDEF;
SP -= items;
rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
- if (!rx) {
+ if (!rx || !SvROK(ST(0))) {
if (!PL_localizing)
Perl_croak(aTHX_ "%s", PL_no_modify);
else
if (items != 2)
croak_xs_usage(cv, "$key, $flags");
- if (!rx)
+ if (!rx || !SvROK(ST(0)))
Perl_croak(aTHX_ "%s", PL_no_modify);
SP -= items;
rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
- if (!rx)
+ if (!rx || !SvROK(ST(0)))
Perl_croak(aTHX_ "%s", PL_no_modify);
SP -= items;
rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
- if (!rx)
+ if (!rx || !SvROK(ST(0)))
XSRETURN_UNDEF;
SP -= items;
rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
- if (!rx)
+ if (!rx || !SvROK(ST(0)))
XSRETURN_UNDEF;
SP -= items;
rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
- if (!rx)
+ if (!rx || !SvROK(ST(0)))
XSRETURN_UNDEF;
SP -= items;
rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
- if (!rx)
+ if (!rx || !SvROK(ST(0)))
XSRETURN_UNDEF;
SP -= items;
PUSHSTACKi(PERLSI_MAGIC);
ENTER;
- SAVEI32(PL_hints);
- PL_hints = 0;
+ SAVEHINTS();
save_re_context();
if (!gv_fetchmeth(stash, "SWASHNEW", 8, -1)) { /* demand load utf8 */
ENTER;
/* A match is defined by all the scans that specified
* an explicit length reaching their final goals. */
- match = (f1 == 0 || p1 == f1) && (f2 == 0 || p2 == f2);
+ match = (n1 == 0 && n2 == 0 /* Must not match partial char; Bug #72998 */
+ && (f1 == 0 || p1 == f1) && (f2 == 0 || p2 == f2));
if (match) {
if (pe1)
return SvPVX(sv);
}
+/*
+=for apidoc Am|SV *|mess|const char *pat|...
+
+Take a sprintf-style format pattern and argument list. These are used to
+generate a string message. If the message does not end with a newline,
+then it will be extended with some indication of the current location
+in the code, as described for L</mess_sv>.
+
+Normally, the resulting message is returned in a new mortal SV.
+During global destruction a single SV may be shared between uses of
+this function.
+
+=cut
+*/
+
#if defined(PERL_IMPLICIT_CONTEXT)
SV *
Perl_mess_nocontext(const char *pat, ...)
return NULL;
}
+/*
+=for apidoc Am|SV *|mess_sv|SV *basemsg|bool consume
+
+Expands a message, intended for the user, to include an indication of
+the current location in the code, if the message does not already appear
+to be complete.
+
+C<basemsg> is the initial message or object. If it is a reference, it
+will be used as-is and will be the result of this function. Otherwise it
+is used as a string, and if it already ends with a newline, it is taken
+to be complete, and the result of this function will be the same string.
+If the message does not end with a newline, then a segment such as C<at
+foo.pl line 37> will be appended, and possibly other clauses indicating
+the current state of execution. The resulting message will end with a
+dot and a newline.
+
+Normally, the resulting message is returned in a new mortal SV.
+During global destruction a single SV may be shared between uses of this
+function. If C<consume> is true, then the function is permitted (but not
+required) to modify and return C<basemsg> instead of allocating a new SV.
+
+=cut
+*/
+
SV *
-Perl_vmess(pTHX_ const char *pat, va_list *args)
+Perl_mess_sv(pTHX_ SV *basemsg, bool consume)
{
dVAR;
- SV * const sv = mess_alloc();
+ SV *sv;
- PERL_ARGS_ASSERT_VMESS;
+ PERL_ARGS_ASSERT_MESS_SV;
+
+ if (SvROK(basemsg)) {
+ if (consume) {
+ sv = basemsg;
+ }
+ else {
+ sv = mess_alloc();
+ sv_setsv(sv, basemsg);
+ }
+ return sv;
+ }
+
+ if (SvPOK(basemsg) && consume) {
+ sv = basemsg;
+ }
+ else {
+ sv = mess_alloc();
+ sv_copypv(sv, basemsg);
+ }
- sv_vsetpvfn(sv, pat, strlen(pat), args, NULL, 0, NULL);
if (!SvCUR(sv) || *(SvEND(sv) - 1) != '\n') {
/*
* Try and find the file and line for PL_op. This will usually be
return sv;
}
+/*
+=for apidoc Am|SV *|vmess|const char *pat|va_list *args
+
+C<pat> and C<args> are a sprintf-style format pattern and encapsulated
+argument list. These are used to generate a string message. If the
+message does not end with a newline, then it will be extended with
+some indication of the current location in the code, as described for
+L</mess_sv>.
+
+Normally, the resulting message is returned in a new mortal SV.
+During global destruction a single SV may be shared between uses of
+this function.
+
+=cut
+*/
+
+SV *
+Perl_vmess(pTHX_ const char *pat, va_list *args)
+{
+ dVAR;
+ SV * const sv = mess_alloc();
+
+ PERL_ARGS_ASSERT_VMESS;
+
+ sv_vsetpvfn(sv, pat, strlen(pat), args, NULL, 0, NULL);
+ return mess_sv(sv, 1);
+}
+
void
Perl_write_to_stderr(pTHX_ SV* msv)
{
}
}
-/* Common code used by vcroak, vdie, vwarn and vwarner */
+/*
+=head1 Warning and Dieing
+*/
+
+/* Common code used in dieing and warning */
+
+STATIC SV *
+S_with_queued_errors(pTHX_ SV *ex)
+{
+ PERL_ARGS_ASSERT_WITH_QUEUED_ERRORS;
+ if (PL_errors && SvCUR(PL_errors) && !SvROK(ex)) {
+ sv_catsv(PL_errors, ex);
+ ex = sv_mortalcopy(PL_errors);
+ SvCUR_set(PL_errors, 0);
+ }
+ return ex;
+}
STATIC bool
-S_vdie_common(pTHX_ SV *message, bool warn)
+S_invoke_exception_hook(pTHX_ SV *ex, bool warn)
{
dVAR;
HV *stash;
/* sv_2cv might call Perl_croak() or Perl_warner() */
SV * const oldhook = *hook;
- assert(oldhook);
+ if (!oldhook)
+ return FALSE;
ENTER;
SAVESPTR(*hook);
LEAVE;
if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) {
dSP;
- SV *msg;
+ SV *exarg;
ENTER;
save_re_context();
SAVESPTR(*hook);
*hook = NULL;
}
- if (warn || message) {
- msg = newSVsv(message);
- SvREADONLY_on(msg);
- SAVEFREESV(msg);
- }
- else {
- msg = ERRSV;
- }
+ exarg = newSVsv(ex);
+ SvREADONLY_on(exarg);
+ SAVEFREESV(exarg);
PUSHSTACKi(warn ? PERLSI_WARNHOOK : PERLSI_DIEHOOK);
PUSHMARK(SP);
- XPUSHs(msg);
+ XPUSHs(exarg);
PUTBACK;
call_sv(MUTABLE_SV(cv), G_DISCARD);
POPSTACK;
return FALSE;
}
-STATIC SV *
-S_vdie_croak_common(pTHX_ const char* pat, va_list* args)
-{
- dVAR;
- SV *message;
+/*
+=for apidoc Am|OP *|die_sv|SV *baseex
- if (pat) {
- SV * const msv = vmess(pat, args);
- if (PL_errors && SvCUR(PL_errors)) {
- sv_catsv(PL_errors, msv);
- message = sv_mortalcopy(PL_errors);
- SvCUR_set(PL_errors, 0);
- }
- else
- message = msv;
- }
- else {
- message = NULL;
- }
+Behaves the same as L</croak_sv>, except for the return type.
+It should be used only where the C<OP *> return type is required.
+The function never actually returns.
- if (PL_diehook) {
- S_vdie_common(aTHX_ message, FALSE);
- }
- return message;
-}
+=cut
+*/
-static OP *
-S_vdie(pTHX_ const char* pat, va_list *args)
+OP *
+Perl_die_sv(pTHX_ SV *baseex)
{
- dVAR;
- SV *message;
-
- message = vdie_croak_common(pat, args);
-
- die_where(message);
+ PERL_ARGS_ASSERT_DIE_SV;
+ croak_sv(baseex);
/* NOTREACHED */
return NULL;
}
+/*
+=for apidoc Am|OP *|die|const char *pat|...
+
+Behaves the same as L</croak>, except for the return type.
+It should be used only where the C<OP *> return type is required.
+The function never actually returns.
+
+=cut
+*/
+
#if defined(PERL_IMPLICIT_CONTEXT)
OP *
Perl_die_nocontext(const char* pat, ...)
{
dTHX;
- OP *o;
va_list args;
va_start(args, pat);
- o = vdie(pat, &args);
+ vcroak(pat, &args);
+ /* NOTREACHED */
va_end(args);
- return o;
+ return NULL;
}
#endif /* PERL_IMPLICIT_CONTEXT */
OP *
Perl_die(pTHX_ const char* pat, ...)
{
- OP *o;
va_list args;
va_start(args, pat);
- o = vdie(pat, &args);
+ vcroak(pat, &args);
+ /* NOTREACHED */
va_end(args);
- return o;
+ return NULL;
}
+/*
+=for apidoc Am|void|croak_sv|SV *baseex
+
+This is an XS interface to Perl's C<die> function.
+
+C<baseex> is the error message or object. If it is a reference, it
+will be used as-is. Otherwise it is used as a string, and if it does
+not end with a newline then it will be extended with some indication of
+the current location in the code, as described for L</mess_sv>.
+
+The error message or object will be used as an exception, by default
+returning control to the nearest enclosing C<eval>, but subject to
+modification by a C<$SIG{__DIE__}> handler. In any case, the C<croak_sv>
+function never returns normally.
+
+To die with a simple string message, the L</croak> function may be
+more convenient.
+
+=cut
+*/
+
void
-Perl_vcroak(pTHX_ const char* pat, va_list *args)
+Perl_croak_sv(pTHX_ SV *baseex)
{
- dVAR;
- SV *msv;
+ SV *ex = with_queued_errors(mess_sv(baseex, 0));
+ PERL_ARGS_ASSERT_CROAK_SV;
+ invoke_exception_hook(ex, FALSE);
+ die_unwind(ex);
+}
+
+/*
+=for apidoc Am|void|vcroak|const char *pat|va_list *args
+
+This is an XS interface to Perl's C<die> function.
+
+C<pat> and C<args> are a sprintf-style format pattern and encapsulated
+argument list. These are used to generate a string message. If the
+message does not end with a newline, then it will be extended with
+some indication of the current location in the code, as described for
+L</mess_sv>.
+
+The error message will be used as an exception, by default
+returning control to the nearest enclosing C<eval>, but subject to
+modification by a C<$SIG{__DIE__}> handler. In any case, the C<croak>
+function never returns normally.
- msv = S_vdie_croak_common(aTHX_ pat, args);
+For historical reasons, if C<pat> is null then the contents of C<ERRSV>
+(C<$@>) will be used as an error message or object instead of building an
+error message from arguments. If you want to throw a non-string object,
+or build an error message in an SV yourself, it is preferable to use
+the L</croak_sv> function, which does not involve clobbering C<ERRSV>.
- die_where(msv);
+=cut
+*/
+
+void
+Perl_vcroak(pTHX_ const char* pat, va_list *args)
+{
+ SV *ex = with_queued_errors(pat ? vmess(pat, args) : mess_sv(ERRSV, 0));
+ invoke_exception_hook(ex, FALSE);
+ die_unwind(ex);
}
+/*
+=for apidoc Am|void|croak|const char *pat|...
+
+This is an XS interface to Perl's C<die> function.
+
+Take a sprintf-style format pattern and argument list. These are used to
+generate a string message. If the message does not end with a newline,
+then it will be extended with some indication of the current location
+in the code, as described for L</mess_sv>.
+
+The error message will be used as an exception, by default
+returning control to the nearest enclosing C<eval>, but subject to
+modification by a C<$SIG{__DIE__}> handler. In any case, the C<croak>
+function never returns normally.
+
+For historical reasons, if C<pat> is null then the contents of C<ERRSV>
+(C<$@>) will be used as an error message or object instead of building an
+error message from arguments. If you want to throw a non-string object,
+or build an error message in an SV yourself, it is preferable to use
+the L</croak_sv> function, which does not involve clobbering C<ERRSV>.
+
+=cut
+*/
+
#if defined(PERL_IMPLICIT_CONTEXT)
void
Perl_croak_nocontext(const char *pat, ...)
}
#endif /* PERL_IMPLICIT_CONTEXT */
+void
+Perl_croak(pTHX_ const char *pat, ...)
+{
+ va_list args;
+ va_start(args, pat);
+ vcroak(pat, &args);
+ /* NOTREACHED */
+ va_end(args);
+}
+
/*
-=head1 Warning and Dieing
+=for apidoc Am|void|warn_sv|SV *baseex
-=for apidoc croak
+This is an XS interface to Perl's C<warn> function.
-This is the XSUB-writer's interface to Perl's C<die> function.
-Normally call this function the same way you call the C C<printf>
-function. Calling C<croak> returns control directly to Perl,
-sidestepping the normal C order of execution. See C<warn>.
+C<baseex> is the error message or object. If it is a reference, it
+will be used as-is. Otherwise it is used as a string, and if it does
+not end with a newline then it will be extended with some indication of
+the current location in the code, as described for L</mess_sv>.
-If you want to throw an exception object, assign the object to
-C<$@> and then pass C<NULL> to croak():
+The error message or object will by default be written to standard error,
+but this is subject to modification by a C<$SIG{__WARN__}> handler.
- errsv = get_sv("@", GV_ADD);
- sv_setsv(errsv, exception_object);
- croak(NULL);
+To warn with a simple string message, the L</warn> function may be
+more convenient.
=cut
*/
void
-Perl_croak(pTHX_ const char *pat, ...)
+Perl_warn_sv(pTHX_ SV *baseex)
{
- va_list args;
- va_start(args, pat);
- vcroak(pat, &args);
- /* NOTREACHED */
- va_end(args);
+ SV *ex = mess_sv(baseex, 0);
+ PERL_ARGS_ASSERT_WARN_SV;
+ if (!invoke_exception_hook(ex, TRUE))
+ write_to_stderr(ex);
}
+/*
+=for apidoc Am|void|vwarn|const char *pat|va_list *args
+
+This is an XS interface to Perl's C<warn> function.
+
+C<pat> and C<args> are a sprintf-style format pattern and encapsulated
+argument list. These are used to generate a string message. If the
+message does not end with a newline, then it will be extended with
+some indication of the current location in the code, as described for
+L</mess_sv>.
+
+The error message or object will by default be written to standard error,
+but this is subject to modification by a C<$SIG{__WARN__}> handler.
+
+Unlike with L</vcroak>, C<pat> is not permitted to be null.
+
+=cut
+*/
+
void
Perl_vwarn(pTHX_ const char* pat, va_list *args)
{
- dVAR;
- SV * const msv = vmess(pat, args);
-
+ SV *ex = vmess(pat, args);
PERL_ARGS_ASSERT_VWARN;
+ if (!invoke_exception_hook(ex, TRUE))
+ write_to_stderr(ex);
+}
- if (PL_warnhook) {
- if (vdie_common(msv, TRUE))
- return;
- }
+/*
+=for apidoc Am|void|warn|const char *pat|...
- write_to_stderr(msv);
-}
+This is an XS interface to Perl's C<warn> function.
+
+Take a sprintf-style format pattern and argument list. These are used to
+generate a string message. If the message does not end with a newline,
+then it will be extended with some indication of the current location
+in the code, as described for L</mess_sv>.
+
+The error message or object will by default be written to standard error,
+but this is subject to modification by a C<$SIG{__WARN__}> handler.
+
+Unlike with L</croak>, C<pat> is not permitted to be null.
+
+=cut
+*/
#if defined(PERL_IMPLICIT_CONTEXT)
void
}
#endif /* PERL_IMPLICIT_CONTEXT */
-/*
-=for apidoc warn
-
-This is the XSUB-writer's interface to Perl's C<warn> function. Call this
-function the same way you call the C C<printf> function. See C<croak>.
-
-=cut
-*/
-
void
Perl_warn(pTHX_ const char *pat, ...)
{
if (PL_warnhook == PERL_WARNHOOK_FATAL || ckDEAD(err)) {
SV * const msv = vmess(pat, args);
- if (PL_diehook) {
- assert(msv);
- S_vdie_common(aTHX_ msv, FALSE);
- }
- die_where(msv);
+ invoke_exception_hook(msv, FALSE);
+ die_unwind(msv);
}
else {
Perl_vwarn(aTHX_ pat, args);
}
}
-#ifdef EBCDIC
-/* in ASCII order, not that it matters */
-static const char controllablechars[] = "?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_";
+/* XXX Add documentation after final interface and behavior is decided */
+/* May want to show context for error, so would pass Perl_bslash_c(pTHX_ const char* current, const char* start, const bool output_warning)
+ U8 source = *current;
-int
-Perl_ebcdic_control(pTHX_ int ch)
+ May want to add eg, WARN_REGEX
+*/
+
+char
+Perl_grok_bslash_c(pTHX_ const char source, const bool output_warning)
{
- if (ch > 'a') {
- const char *ctlp;
+
+ U8 result;
- if (islower(ch))
- ch = toupper(ch);
+ if (! isASCII(source)) {
+ Perl_croak(aTHX_ "Character following \"\\c\" must be ASCII");
+ }
- if ((ctlp = strchr(controllablechars, ch)) == 0) {
- Perl_die(aTHX_ "unrecognised control character '%c'\n", ch);
+ result = toCTRL(source);
+ if (! isCNTRL(result)) {
+ if (source == '{') {
+ Perl_croak(aTHX_ "It is proposed that \"\\c{\" no longer be valid. It has historically evaluated to\n \";\". If you disagree with this proposal, send email to perl5-porters@perl.org\nOtherwise, or in the meantime, you can work around this failure by changing\n\"\\c{\" to \";\"");
+ }
+ else if (output_warning) {
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
+ "\"\\c%c\" more clearly written simply as \"%c\"",
+ source,
+ result);
}
-
- if (ctlp == controllablechars)
- return('\177'); /* DEL */
- else
- return((unsigned char)(ctlp - controllablechars - 1));
- } else { /* Want uncontrol */
- if (ch == '\177' || ch == -1)
- return('?');
- else if (ch == '\157')
- return('\177');
- else if (ch == '\174')
- return('\000');
- else if (ch == '^') /* '\137' in 1047, '\260' in 819 */
- return('\036');
- else if (ch == '\155')
- return('\037');
- else if (0 < ch && ch < (sizeof(controllablechars) - 1))
- return(controllablechars[ch+1]);
- else
- Perl_die(aTHX_ "invalid control request: '\\%03o'\n", ch & 0xFF);
}
+
+ return result;
}
-#endif
/* To workaround core dumps from the uninitialised tm_zone we get the
* system to give us a reasonable struct to copy. This fix means that
}
#define VERSION_MAX 0x7FFFFFFF
+
+/*
+=for apidoc prescan_version
+
+=cut
+*/
+const char *
+Perl_prescan_version(pTHX_ const char *s, bool strict,
+ const char **errstr,
+ bool *sqv, int *ssaw_decimal, int *swidth, bool *salpha) {
+ bool qv = (sqv ? *sqv : FALSE);
+ int width = 3;
+ int saw_decimal = 0;
+ bool alpha = FALSE;
+ const char *d = s;
+
+ PERL_ARGS_ASSERT_PRESCAN_VERSION;
+
+ if (qv && isDIGIT(*d))
+ goto dotted_decimal_version;
+
+ if (*d == 'v') { /* explicit v-string */
+ d++;
+ if (isDIGIT(*d)) {
+ qv = TRUE;
+ }
+ else { /* degenerate v-string */
+ /* requires v1.2.3 */
+ BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
+ }
+
+dotted_decimal_version:
+ if (strict && d[0] == '0' && isDIGIT(d[1])) {
+ /* no leading zeros allowed */
+ BADVERSION(s,errstr,"Invalid version format (no leading zeros)");
+ }
+
+ while (isDIGIT(*d)) /* integer part */
+ d++;
+
+ if (*d == '.')
+ {
+ saw_decimal++;
+ d++; /* decimal point */
+ }
+ else
+ {
+ if (strict) {
+ /* require v1.2.3 */
+ BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
+ }
+ else {
+ goto version_prescan_finish;
+ }
+ }
+
+ {
+ int i = 0;
+ int j = 0;
+ while (isDIGIT(*d)) { /* just keep reading */
+ i++;
+ while (isDIGIT(*d)) {
+ d++; j++;
+ /* maximum 3 digits between decimal */
+ if (strict && j > 3) {
+ BADVERSION(s,errstr,"Invalid version format (maximum 3 digits between decimals)");
+ }
+ }
+ if (*d == '_') {
+ if (strict) {
+ BADVERSION(s,errstr,"Invalid version format (no underscores)");
+ }
+ if ( alpha ) {
+ BADVERSION(s,errstr,"Invalid version format (multiple underscores)");
+ }
+ d++;
+ alpha = TRUE;
+ }
+ else if (*d == '.') {
+ if (alpha) {
+ BADVERSION(s,errstr,"Invalid version format (underscores before decimal)");
+ }
+ saw_decimal++;
+ d++;
+ }
+ else if (!isDIGIT(*d)) {
+ break;
+ }
+ j = 0;
+ }
+
+ if (strict && i < 2) {
+ /* requires v1.2.3 */
+ BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
+ }
+ }
+ } /* end if dotted-decimal */
+ else
+ { /* decimal versions */
+ /* special strict case for leading '.' or '0' */
+ if (strict) {
+ if (*d == '.') {
+ BADVERSION(s,errstr,"Invalid version format (0 before decimal required)");
+ }
+ if (*d == '0' && isDIGIT(d[1])) {
+ BADVERSION(s,errstr,"Invalid version format (no leading zeros)");
+ }
+ }
+
+ /* consume all of the integer part */
+ while (isDIGIT(*d))
+ d++;
+
+ /* look for a fractional part */
+ if (*d == '.') {
+ /* we found it, so consume it */
+ saw_decimal++;
+ d++;
+ }
+ else if (!*d || *d == ';' || isSPACE(*d) || *d == '}') {
+ if ( d == s ) {
+ /* found nothing */
+ BADVERSION(s,errstr,"Invalid version format (version required)");
+ }
+ /* found just an integer */
+ goto version_prescan_finish;
+ }
+ else if ( d == s ) {
+ /* didn't find either integer or period */
+ BADVERSION(s,errstr,"Invalid version format (non-numeric data)");
+ }
+ else if (*d == '_') {
+ /* underscore can't come after integer part */
+ if (strict) {
+ BADVERSION(s,errstr,"Invalid version format (no underscores)");
+ }
+ else if (isDIGIT(d[1])) {
+ BADVERSION(s,errstr,"Invalid version format (alpha without decimal)");
+ }
+ else {
+ BADVERSION(s,errstr,"Invalid version format (misplaced underscore)");
+ }
+ }
+ else {
+ /* anything else after integer part is just invalid data */
+ BADVERSION(s,errstr,"Invalid version format (non-numeric data)");
+ }
+
+ /* scan the fractional part after the decimal point*/
+
+ if (!isDIGIT(*d) && (strict || ! (!*d || *d == ';' || isSPACE(*d) || *d == '}') )) {
+ /* strict or lax-but-not-the-end */
+ BADVERSION(s,errstr,"Invalid version format (fractional part required)");
+ }
+
+ while (isDIGIT(*d)) {
+ d++;
+ if (*d == '.' && isDIGIT(d[-1])) {
+ if (alpha) {
+ BADVERSION(s,errstr,"Invalid version format (underscores before decimal)");
+ }
+ if (strict) {
+ BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions must begin with 'v')");
+ }
+ d = (char *)s; /* start all over again */
+ qv = TRUE;
+ goto dotted_decimal_version;
+ }
+ if (*d == '_') {
+ if (strict) {
+ BADVERSION(s,errstr,"Invalid version format (no underscores)");
+ }
+ if ( alpha ) {
+ BADVERSION(s,errstr,"Invalid version format (multiple underscores)");
+ }
+ if ( ! isDIGIT(d[1]) ) {
+ BADVERSION(s,errstr,"Invalid version format (misplaced underscore)");
+ }
+ d++;
+ alpha = TRUE;
+ }
+ }
+ }
+
+version_prescan_finish:
+ while (isSPACE(*d))
+ d++;
+
+ if (!isDIGIT(*d) && (! (!*d || *d == ';' || *d == '}') )) {
+ /* trailing non-numeric data */
+ BADVERSION(s,errstr,"Invalid version format (non-numeric data)");
+ }
+
+ if (sqv)
+ *sqv = qv;
+ if (swidth)
+ *swidth = width;
+ if (ssaw_decimal)
+ *ssaw_decimal = saw_decimal;
+ if (salpha)
+ *salpha = alpha;
+ return d;
+}
+
/*
=for apidoc scan_version
const char *start;
const char *pos;
const char *last;
- int saw_period = 0;
- int alpha = 0;
+ const char *errstr = NULL;
+ int saw_decimal = 0;
int width = 3;
+ bool alpha = FALSE;
bool vinf = FALSE;
AV * const av = newAV();
SV * const hv = newSVrv(rv, "version"); /* create an SV and upgrade the RV */
(void)sv_upgrade(hv, SVt_PVHV); /* needs to be an HV type */
+#ifndef NODEFAULT_SHAREKEYS
+ HvSHAREKEYS_on(hv); /* key-sharing on by default */
+#endif
+
while (isSPACE(*s)) /* leading whitespace is OK */
s++;
- start = last = s;
-
- if (*s == 'v') {
- s++; /* get past 'v' */
- qv = 1; /* force quoted version processing */
- }
-
- pos = s;
-
- /* pre-scan the input string to check for decimals/underbars */
- while ( *pos == '.' || *pos == '_' || *pos == ',' || isDIGIT(*pos) )
- {
- if ( *pos == '.' )
- {
- if ( alpha )
- Perl_croak(aTHX_ "Invalid version format (underscores before decimal)");
- saw_period++ ;
- last = pos;
- }
- else if ( *pos == '_' )
- {
- if ( alpha )
- Perl_croak(aTHX_ "Invalid version format (multiple underscores)");
- alpha = 1;
- width = pos - last - 1; /* natural width of sub-version */
- }
- else if ( *pos == ',' && isDIGIT(pos[1]) )
- {
- saw_period++ ;
- last = pos;
+ last = prescan_version(s, FALSE, &errstr, &qv, &saw_decimal, &width, &alpha);
+ if (errstr) {
+ /* "undef" is a special case and not an error */
+ if ( ! ( *s == 'u' && strEQ(s,"undef")) ) {
+ Perl_croak(aTHX_ "%s", errstr);
}
-
- pos++;
}
- if ( alpha && !saw_period )
- Perl_croak(aTHX_ "Invalid version format (alpha without decimal)");
-
- if ( alpha && saw_period && width == 0 )
- Perl_croak(aTHX_ "Invalid version format (misplaced _ in number)");
-
- if ( saw_period > 1 )
- qv = 1; /* force quoted version processing */
-
- last = pos;
+ start = s;
+ if (*s == 'v')
+ s++;
pos = s;
if ( qv )
* point of a version originally created with a bare
* floating point number, i.e. not quoted in any way
*/
- if ( !qv && s > start && saw_period == 1 ) {
+ if ( !qv && s > start && saw_decimal == 1 ) {
mult *= 100;
while ( s < end ) {
orev = rev;
}
else if ( s > start ) {
SV * orig = newSVpvn(start,s-start);
- if ( qv && saw_period == 1 && *start != 'v' ) {
+ if ( qv && saw_decimal == 1 && *start != 'v' ) {
/* need to insert a v to be consistent */
sv_insert(orig, 0, 0, "v", 1);
}
/* This will get reblessed later if a derived class*/
SV * const hv = newSVrv(rv, "version");
(void)sv_upgrade(hv, SVt_PVHV); /* needs to be an HV type */
+#ifndef NODEFAULT_SHAREKEYS
+ HvSHAREKEYS_on(hv); /* key-sharing on by default */
+#endif
if ( SvROK(ver) )
ver = SvRV(ver);
char * const version = savepvn( (const char*)mg->mg_ptr, len);
sv_setpvn(rv,version,len);
/* this is for consistency with the pure Perl class */
- if ( *version != 'v' )
+ if ( isDIGIT(*version) )
sv_insert(rv, 0, 0, "v", 1);
Safefree(version);
}
#ifdef SvVOK
else if ( (mg = SvVSTRING_mg(ver)) ) { /* already a v-string */
version = savepvn( (const char*)mg->mg_ptr,mg->mg_len );
- qv = 1;
+ qv = TRUE;
}
#endif
else /* must be a string or something like a string */
#ifndef SvVOK
# if PERL_VERSION > 5
/* This will only be executed for 5.6.0 - 5.8.0 inclusive */
- if ( len == 3 && !instr(version,".") && !instr(version,"_") ) {
+ if ( len >= 3 && !instr(version,".") && !instr(version,"_")
+ && !(*version == 'u' && strEQ(version, "undef"))
+ && (*version < '0' || *version > '9') ) {
/* may be a v-string */
SV * const nsv = sv_newmortal();
const char *nver;
const char *pos;
- int saw_period = 0;
+ int saw_decimal = 0;
sv_setpvf(nsv,"v%vd",ver);
pos = nver = savepv(SvPV_nolen(nsv));
pos++; /* skip the leading 'v' */
while ( *pos == '.' || isDIGIT(*pos) ) {
if ( *pos == '.' )
- saw_period++ ;
+ saw_decimal++ ;
pos++;
}
/* is definitely a v-string */
- if ( saw_period == 2 ) {
+ if ( saw_decimal >= 2 ) {
Safefree(version);
version = nver;
}
I32 i, len, digit;
int width;
bool alpha = FALSE;
- SV * const sv = newSV(0);
+ SV *sv;
AV *av;
PERL_ARGS_ASSERT_VNUMIFY;
/* attempt to retrieve the version array */
if ( !(av = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(vs), "version", FALSE))) ) ) {
- sv_catpvs(sv,"0");
- return sv;
+ return newSVpvs("0");
}
len = av_len(av);
if ( len == -1 )
{
- sv_catpvs(sv,"0");
- return sv;
+ return newSVpvs("0");
}
digit = SvIV(*av_fetch(av, 0, 0));
- Perl_sv_setpvf(aTHX_ sv, "%d.", (int)PERL_ABS(digit));
+ sv = Perl_newSVpvf(aTHX_ "%d.", (int)PERL_ABS(digit));
for ( i = 1 ; i < len ; i++ )
{
digit = SvIV(*av_fetch(av, i, 0));
{
I32 i, len, digit;
bool alpha = FALSE;
- SV * const sv = newSV(0);
+ SV *sv;
AV *av;
PERL_ARGS_ASSERT_VNORMAL;
len = av_len(av);
if ( len == -1 )
{
- sv_catpvs(sv,"");
- return sv;
+ return newSVpvs("");
}
digit = SvIV(*av_fetch(av, 0, 0));
- Perl_sv_setpvf(aTHX_ sv, "v%"IVdf, (IV)digit);
+ sv = Perl_newSVpvf(aTHX_ "v%"IVdf, (IV)digit);
for ( i = 1 ; i < len ; i++ ) {
digit = SvIV(*av_fetch(av, i, 0));
Perl_sv_catpvf(aTHX_ sv, ".%"IVdf, (IV)digit);
$perl++ if $0 =~ m#/?c2ph$#;
-require 'getopts.pl';
+use Getopt::Std qw(getopts);
use File::Temp 'tempdir';
eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift;
-&Getopts('aixdpvtnws:') || &usage(0);
+getopts('aixdpvtnws:') || &usage(0);
$opt_d && $debug++;
$opt_t && $trace++;
exit $Exit;
sub expr {
- $new = '"(assembly code)"' and return if /\b__asm__\b/; # freak out.
+ if (/\b__asm__\b/) { # freak out
+ $new = '"(assembly code)"';
+ return
+ }
my $joined_args;
if(keys(%curargs)) {
$joined_args = join('|', keys(%curargs));
sub build_preamble_if_necessary
{
# Increment $VERSION every time this function is modified:
- my $VERSION = 2;
+ my $VERSION = 3;
my $preamble = "$Dest_dir/_h2ph_pre.ph";
# Can we skip building the preamble file?
# parenthesized value: d=(v)
$define{$_} = $1;
}
- if ($define{$_} =~ /^([+-]?(\d+)?\.\d+([eE][+-]?\d+)?)[FL]?$/) {
+ if (/^(\w+)\((\w)\)$/) {
+ my($macro, $arg) = ($1, $2);
+ my $def = $define{$_};
+ $def =~ s/$arg/\$\{$arg\}/g;
+ print PREAMBLE <<DEFINE;
+unless (defined &$macro) { sub $macro(\$) { my (\$$arg) = \@_; \"$def\" } }
+
+DEFINE
+ } elsif
+ ($define{$_} =~ /^([+-]?(\d+)?\.\d+([eE][+-]?\d+)?)[FL]?$/) {
# float:
print PREAMBLE
"unless (defined &$_) { sub $_() { $1 } }\n\n";
print PREAMBLE
"unless (defined &$_) { sub $_() { $1 } }\n\n";
} elsif ($define{$_} =~ /^\w+$/) {
- print PREAMBLE
- "unless (defined &$_) { sub $_() { &$define{$_} } }\n\n";
+ my $def = $define{$_};
+ if ($isatype{$def}) {
+ print PREAMBLE
+ "unless (defined &$_) { sub $_() { \"$def\" } }\n\n";
+ } else {
+ print PREAMBLE
+ "unless (defined &$_) { sub $_() { &$def } }\n\n";
+ }
} else {
print PREAMBLE
"unless (defined &$_) { sub $_() { \"",
last if /^\s*}/;
next if /^\s*#/; # preprocessor stuff
next if /PERL_GIT_UNPUSHED_COMMITS/; # XXX expand instead
- next if /PERL_GIT_UNCOMMITTED_CHANGES/; # XXX expand instead
+ next if /"uncommitted-changes"/; # XXX determine if active instead
chomp;
s/^\s+,?\s*"?//;
s/"?\s*,?$//;
# Try and guess return address
my $guess;
- $guess = $ENV{'REPLY-TO'} || $ENV{'REPLYTO'} || '';
+ $guess = $ENV{'REPLY-TO'} || $ENV{'REPLYTO'} || $ENV{'EMAIL'} || '';
if ($Is_MacOS) {
require Mac::InternetConfig;
$guess = $Mac::InternetConfig::InternetConfig{
@ @extra_pods.com
pod0 = [.lib.pods]perl.pod [.lib.pods]perl5004delta.pod [.lib.pods]perl5005delta.pod [.lib.pods]perl5100delta.pod [.lib.pods]perl5101delta.pod
-pod1 = [.lib.pods]perl5110delta.pod [.lib.pods]perl5111delta.pod [.lib.pods]perl5112delta.pod [.lib.pods]perl5113delta.pod [.lib.pods]perl561delta.pod
-pod2 = [.lib.pods]perl56delta.pod [.lib.pods]perl570delta.pod [.lib.pods]perl571delta.pod [.lib.pods]perl572delta.pod [.lib.pods]perl573delta.pod
-pod3 = [.lib.pods]perl581delta.pod [.lib.pods]perl582delta.pod [.lib.pods]perl583delta.pod [.lib.pods]perl584delta.pod [.lib.pods]perl585delta.pod
-pod4 = [.lib.pods]perl586delta.pod [.lib.pods]perl587delta.pod [.lib.pods]perl588delta.pod [.lib.pods]perl589delta.pod [.lib.pods]perl58delta.pod
-pod5 = [.lib.pods]perl590delta.pod [.lib.pods]perl591delta.pod [.lib.pods]perl592delta.pod [.lib.pods]perl593delta.pod [.lib.pods]perl594delta.pod
-pod6 = [.lib.pods]perl595delta.pod [.lib.pods]perlaix.pod [.lib.pods]perlamiga.pod [.lib.pods]perlapi.pod [.lib.pods]perlapio.pod [.lib.pods]perlapollo.pod
-pod7 = [.lib.pods]perlartistic.pod [.lib.pods]perlbeos.pod [.lib.pods]perlbook.pod [.lib.pods]perlboot.pod [.lib.pods]perlbot.pod [.lib.pods]perlbs2000.pod
-pod8 = [.lib.pods]perlcall.pod [.lib.pods]perlce.pod [.lib.pods]perlcheat.pod [.lib.pods]perlclib.pod [.lib.pods]perlcn.pod [.lib.pods]perlcommunity.pod
-pod9 = [.lib.pods]perlcompile.pod [.lib.pods]perlcygwin.pod [.lib.pods]perldata.pod [.lib.pods]perldbmfilter.pod [.lib.pods]perldebguts.pod
-pod10 = [.lib.pods]perldebtut.pod [.lib.pods]perldebug.pod [.lib.pods]perldelta.pod [.lib.pods]perldgux.pod [.lib.pods]perldiag.pod [.lib.pods]perldoc.pod
-pod11 = [.lib.pods]perldos.pod [.lib.pods]perldsc.pod [.lib.pods]perlebcdic.pod [.lib.pods]perlembed.pod [.lib.pods]perlepoc.pod [.lib.pods]perlfaq.pod
-pod12 = [.lib.pods]perlfaq1.pod [.lib.pods]perlfaq2.pod [.lib.pods]perlfaq3.pod [.lib.pods]perlfaq4.pod [.lib.pods]perlfaq5.pod [.lib.pods]perlfaq6.pod
-pod13 = [.lib.pods]perlfaq7.pod [.lib.pods]perlfaq8.pod [.lib.pods]perlfaq9.pod [.lib.pods]perlfilter.pod [.lib.pods]perlfork.pod [.lib.pods]perlform.pod
-pod14 = [.lib.pods]perlfreebsd.pod [.lib.pods]perlfunc.pod [.lib.pods]perlglossary.pod [.lib.pods]perlgpl.pod [.lib.pods]perlguts.pod [.lib.pods]perlhack.pod
-pod15 = [.lib.pods]perlhaiku.pod [.lib.pods]perlhist.pod [.lib.pods]perlhpux.pod [.lib.pods]perlhurd.pod [.lib.pods]perlintern.pod [.lib.pods]perlintro.pod
-pod16 = [.lib.pods]perliol.pod [.lib.pods]perlipc.pod [.lib.pods]perlirix.pod [.lib.pods]perljp.pod [.lib.pods]perlko.pod [.lib.pods]perllexwarn.pod
-pod17 = [.lib.pods]perllinux.pod [.lib.pods]perllocale.pod [.lib.pods]perllol.pod [.lib.pods]perlmacos.pod [.lib.pods]perlmacosx.pod [.lib.pods]perlmod.pod
-pod18 = [.lib.pods]perlmodinstall.pod [.lib.pods]perlmodlib.pod [.lib.pods]perlmodstyle.pod [.lib.pods]perlmpeix.pod [.lib.pods]perlmroapi.pod
-pod19 = [.lib.pods]perlnetware.pod [.lib.pods]perlnewmod.pod [.lib.pods]perlnumber.pod [.lib.pods]perlobj.pod [.lib.pods]perlop.pod
-pod20 = [.lib.pods]perlopenbsd.pod [.lib.pods]perlopentut.pod [.lib.pods]perlos2.pod [.lib.pods]perlos390.pod [.lib.pods]perlos400.pod
-pod21 = [.lib.pods]perlpacktut.pod [.lib.pods]perlperf.pod [.lib.pods]perlplan9.pod [.lib.pods]perlpod.pod [.lib.pods]perlpodspec.pod
-pod22 = [.lib.pods]perlpolicy.pod [.lib.pods]perlport.pod [.lib.pods]perlpragma.pod [.lib.pods]perlqnx.pod [.lib.pods]perlre.pod [.lib.pods]perlreapi.pod
-pod23 = [.lib.pods]perlrebackslash.pod [.lib.pods]perlrecharclass.pod [.lib.pods]perlref.pod [.lib.pods]perlreftut.pod [.lib.pods]perlreguts.pod
-pod24 = [.lib.pods]perlrepository.pod [.lib.pods]perlrequick.pod [.lib.pods]perlreref.pod [.lib.pods]perlretut.pod [.lib.pods]perlriscos.pod
-pod25 = [.lib.pods]perlrun.pod [.lib.pods]perlsec.pod [.lib.pods]perlsolaris.pod [.lib.pods]perlstyle.pod [.lib.pods]perlsub.pod [.lib.pods]perlsymbian.pod
-pod26 = [.lib.pods]perlsyn.pod [.lib.pods]perlthrtut.pod [.lib.pods]perltie.pod [.lib.pods]perltoc.pod [.lib.pods]perltodo.pod [.lib.pods]perltooc.pod
-pod27 = [.lib.pods]perltoot.pod [.lib.pods]perltrap.pod [.lib.pods]perltru64.pod [.lib.pods]perltw.pod [.lib.pods]perlunicode.pod [.lib.pods]perlunifaq.pod
-pod28 = [.lib.pods]perluniintro.pod [.lib.pods]perluniprops.pod [.lib.pods]perlunitut.pod [.lib.pods]perlutil.pod [.lib.pods]perluts.pod
-pod29 = [.lib.pods]perlvar.pod [.lib.pods]perlvmesa.pod [.lib.pods]perlvms.pod [.lib.pods]perlvos.pod [.lib.pods]perlwin32.pod [.lib.pods]perlxs.pod
-pod30 = [.lib.pods]perlxstut.pod
-pod = $(pod0) $(pod1) $(pod2) $(pod3) $(pod4) $(pod5) $(pod6) $(pod7) $(pod8) $(pod9) $(pod10) $(pod11) $(pod12) $(pod13) $(pod14) $(pod15) $(pod16) $(pod17) $(pod18) $(pod19) $(pod20) $(pod21) $(pod22) $(pod23) $(pod24) $(pod25) $(pod26) $(pod27) $(pod28) $(pod29) $(pod30)
+pod1 = [.lib.pods]perl5110delta.pod [.lib.pods]perl5111delta.pod [.lib.pods]perl5112delta.pod [.lib.pods]perl5113delta.pod [.lib.pods]perl5114delta.pod
+pod2 = [.lib.pods]perl5115delta.pod [.lib.pods]perl5120delta.pod [.lib.pods]perl5130delta.pod [.lib.pods]perl5131delta.pod [.lib.pods]perl561delta.pod
+pod3 = [.lib.pods]perl56delta.pod [.lib.pods]perl570delta.pod [.lib.pods]perl571delta.pod [.lib.pods]perl572delta.pod [.lib.pods]perl573delta.pod
+pod4 = [.lib.pods]perl581delta.pod [.lib.pods]perl582delta.pod [.lib.pods]perl583delta.pod [.lib.pods]perl584delta.pod [.lib.pods]perl585delta.pod
+pod5 = [.lib.pods]perl586delta.pod [.lib.pods]perl587delta.pod [.lib.pods]perl588delta.pod [.lib.pods]perl589delta.pod [.lib.pods]perl58delta.pod
+pod6 = [.lib.pods]perl590delta.pod [.lib.pods]perl591delta.pod [.lib.pods]perl592delta.pod [.lib.pods]perl593delta.pod [.lib.pods]perl594delta.pod
+pod7 = [.lib.pods]perl595delta.pod [.lib.pods]perlaix.pod [.lib.pods]perlamiga.pod [.lib.pods]perlapi.pod [.lib.pods]perlapio.pod [.lib.pods]perlapollo.pod
+pod8 = [.lib.pods]perlartistic.pod [.lib.pods]perlbeos.pod [.lib.pods]perlbook.pod [.lib.pods]perlboot.pod [.lib.pods]perlbot.pod [.lib.pods]perlbs2000.pod
+pod9 = [.lib.pods]perlcall.pod [.lib.pods]perlce.pod [.lib.pods]perlcheat.pod [.lib.pods]perlclib.pod [.lib.pods]perlcn.pod [.lib.pods]perlcommunity.pod
+pod10 = [.lib.pods]perlcompile.pod [.lib.pods]perlcygwin.pod [.lib.pods]perldata.pod [.lib.pods]perldbmfilter.pod [.lib.pods]perldebguts.pod
+pod11 = [.lib.pods]perldebtut.pod [.lib.pods]perldebug.pod [.lib.pods]perldelta.pod [.lib.pods]perldgux.pod [.lib.pods]perldiag.pod [.lib.pods]perldoc.pod
+pod12 = [.lib.pods]perldos.pod [.lib.pods]perldsc.pod [.lib.pods]perlebcdic.pod [.lib.pods]perlembed.pod [.lib.pods]perlepoc.pod [.lib.pods]perlfaq.pod
+pod13 = [.lib.pods]perlfaq1.pod [.lib.pods]perlfaq2.pod [.lib.pods]perlfaq3.pod [.lib.pods]perlfaq4.pod [.lib.pods]perlfaq5.pod [.lib.pods]perlfaq6.pod
+pod14 = [.lib.pods]perlfaq7.pod [.lib.pods]perlfaq8.pod [.lib.pods]perlfaq9.pod [.lib.pods]perlfilter.pod [.lib.pods]perlfork.pod [.lib.pods]perlform.pod
+pod15 = [.lib.pods]perlfreebsd.pod [.lib.pods]perlfunc.pod [.lib.pods]perlglossary.pod [.lib.pods]perlgpl.pod [.lib.pods]perlguts.pod [.lib.pods]perlhack.pod
+pod16 = [.lib.pods]perlhaiku.pod [.lib.pods]perlhist.pod [.lib.pods]perlhpux.pod [.lib.pods]perlhurd.pod [.lib.pods]perlintern.pod [.lib.pods]perlintro.pod
+pod17 = [.lib.pods]perliol.pod [.lib.pods]perlipc.pod [.lib.pods]perlirix.pod [.lib.pods]perljp.pod [.lib.pods]perlko.pod [.lib.pods]perllexwarn.pod
+pod18 = [.lib.pods]perllinux.pod [.lib.pods]perllocale.pod [.lib.pods]perllol.pod [.lib.pods]perlmacos.pod [.lib.pods]perlmacosx.pod [.lib.pods]perlmod.pod
+pod19 = [.lib.pods]perlmodinstall.pod [.lib.pods]perlmodlib.pod [.lib.pods]perlmodstyle.pod [.lib.pods]perlmpeix.pod [.lib.pods]perlmroapi.pod
+pod20 = [.lib.pods]perlnetware.pod [.lib.pods]perlnewmod.pod [.lib.pods]perlnumber.pod [.lib.pods]perlobj.pod [.lib.pods]perlop.pod
+pod21 = [.lib.pods]perlopenbsd.pod [.lib.pods]perlopentut.pod [.lib.pods]perlos2.pod [.lib.pods]perlos390.pod [.lib.pods]perlos400.pod
+pod22 = [.lib.pods]perlpacktut.pod [.lib.pods]perlperf.pod [.lib.pods]perlplan9.pod [.lib.pods]perlpod.pod [.lib.pods]perlpodspec.pod
+pod23 = [.lib.pods]perlpolicy.pod [.lib.pods]perlport.pod [.lib.pods]perlpragma.pod [.lib.pods]perlqnx.pod [.lib.pods]perlre.pod [.lib.pods]perlreapi.pod
+pod24 = [.lib.pods]perlrebackslash.pod [.lib.pods]perlrecharclass.pod [.lib.pods]perlref.pod [.lib.pods]perlreftut.pod [.lib.pods]perlreguts.pod
+pod25 = [.lib.pods]perlrepository.pod [.lib.pods]perlrequick.pod [.lib.pods]perlreref.pod [.lib.pods]perlretut.pod [.lib.pods]perlriscos.pod
+pod26 = [.lib.pods]perlrun.pod [.lib.pods]perlsec.pod [.lib.pods]perlsolaris.pod [.lib.pods]perlstyle.pod [.lib.pods]perlsub.pod [.lib.pods]perlsymbian.pod
+pod27 = [.lib.pods]perlsyn.pod [.lib.pods]perlthrtut.pod [.lib.pods]perltie.pod [.lib.pods]perltoc.pod [.lib.pods]perltodo.pod [.lib.pods]perltooc.pod
+pod28 = [.lib.pods]perltoot.pod [.lib.pods]perltrap.pod [.lib.pods]perltru64.pod [.lib.pods]perltw.pod [.lib.pods]perlunicode.pod [.lib.pods]perlunifaq.pod
+pod29 = [.lib.pods]perluniintro.pod [.lib.pods]perluniprops.pod [.lib.pods]perlunitut.pod [.lib.pods]perlutil.pod [.lib.pods]perluts.pod
+pod30 = [.lib.pods]perlvar.pod [.lib.pods]perlvmesa.pod [.lib.pods]perlvms.pod [.lib.pods]perlvos.pod [.lib.pods]perlwin32.pod [.lib.pods]perlxs.pod
+pod31 = [.lib.pods]perlxstut.pod
+pod = $(pod0) $(pod1) $(pod2) $(pod3) $(pod4) $(pod5) $(pod6) $(pod7) $(pod8) $(pod9) $(pod10) $(pod11) $(pod12) $(pod13) $(pod14) $(pod15) $(pod16) $(pod17) $(pod18) $(pod19) $(pod20) $(pod21) $(pod22) $(pod23) $(pod24) $(pod25) $(pod26) $(pod27) $(pod28) $(pod29) $(pod30) $(pod31)
# Would be useful to automate the generation of this rule from pod/buildtoc
# Plus its corresponding delete in the clean target.
-[.pod]perldelta.pod : [.pod]perl5113delta.pod
+[.pod]perldelta.pod : [.pod]perl5131delta.pod
Copy/NoConfirm/Log $(MMS$SOURCE) $(MMS$TARGET)
[.pod]perlapi.pod : embed.fnc autodoc.pl $(MINIPERL_EXE)
@ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
+[.lib.pods]perl5114delta.pod : [.pod]perl5114delta.pod
+ @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
+ Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
+
+[.lib.pods]perl5115delta.pod : [.pod]perl5115delta.pod
+ @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
+ Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
+
+[.lib.pods]perl5120delta.pod : [.pod]perl5120delta.pod
+ @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
+ Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
+
+[.lib.pods]perl5130delta.pod : [.pod]perl5130delta.pod
+ @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
+ Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
+
+[.lib.pods]perl5131delta.pod : [.pod]perl5131delta.pod
+ @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
+ Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
+
[.lib.pods]perl561delta.pod : [.pod]perl561delta.pod
@ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
/* default piping mailbox size */
-#define PERL_BUFSIZ 512
+#ifdef __VAX
+# define PERL_BUFSIZ 512
+#else
+# define PERL_BUFSIZ 8192
+#endif
static void
#if defined(USE_ITHREADS)
&& my_perl
#endif
- && PL_perlio_fd_refcnt)
+#ifdef USE_PERLIO
+ && PL_perlio_fd_refcnt
+#endif
+ )
PerlIO_flush(info->fp);
else
fflush((FILE *)info->fp);
#if defined(USE_ITHREADS)
&& my_perl
#endif
- && PL_perlio_fd_refcnt)
+#ifdef USE_PERLIO
+ && PL_perlio_fd_refcnt
+#endif
+ )
PerlIO_flush(info->fp);
else
fflush((FILE *)info->fp);
#if defined(USE_ITHREADS)
&& my_perl
#endif
- && PL_perlio_fd_refcnt)
+#ifdef USE_PERLIO
+ && PL_perlio_fd_refcnt
+#endif
+ )
PerlIO_close(info->fp);
else
fclose((FILE *)info->fp);
/* Warnings Categories added in Perl 5.011 */
#define WARN_IMPRECISION 46
+#define WARN_ILLEGALPROTO 47
#define WARNsize 12
#define WARN_ALLstring "\125\125\125\125\125\125\125\125\125\125\125\125"
'printf' => [ 5.008, DEFAULT_OFF],
'prototype' => [ 5.008, DEFAULT_OFF],
'qw' => [ 5.008, DEFAULT_OFF],
+ 'illegalproto' => [ 5.011, DEFAULT_OFF],
}],
'severe' => [ 5.008, {
'inplace' => [ 5.008, DEFAULT_ON],
package warnings;
-our $VERSION = '1.08';
+our $VERSION = '1.09';
# Verify that we're called correctly so that warnings will work.
# see also strict.pm.
# MS Platform SDK 64-bit compiler and tools
#
# This is set up to build a perl.exe that runs off a shared library
-# (perl511.dll). Also makes individual DLLs for the XS extensions.
+# (perl513.dll). Also makes individual DLLs for the XS extensions.
#
##
# versioned installation can be obtained by setting INST_TOP above to a
# path that includes an arbitrary version string.
#
-#INST_VER = \5.11.3
+#INST_VER = \5.13.0
#
# Comment this out if you DON'T want your perl installation to have
# set this to additionally provide a statically linked perl-static.exe.
# Note that dynamic loading will not work with this perl, so you must
# include required modules statically using the STATIC_EXT or ALL_STATIC
-# variables below. A static library perl511s.lib will also be created.
+# variables below. A static library perl513s.lib will also be created.
# Ordinary perl.exe is not affected by this option.
#
#BUILD_STATIC = define
# makedef.pl must be updated if this changes, and this should normally
# only change when there is an incompatible revision of the public API.
-PERLIMPLIB = ..\perl511.lib
-PERLSTATICLIB = ..\perl511s.lib
-PERLDLL = ..\perl511.dll
+PERLIMPLIB = ..\perl513.lib
+PERLSTATICLIB = ..\perl513s.lib
+PERLDLL = ..\perl513.dll
MINIPERL = ..\miniperl.exe
MINIDIR = .\mini
copy ..\README.vmesa ..\pod\perlvmesa.pod
copy ..\README.vos ..\pod\perlvos.pod
copy ..\README.win32 ..\pod\perlwin32.pod
- copy ..\pod\perl5113delta.pod ..\pod\perldelta.pod
+ copy ..\pod\perl5131delta.pod ..\pod\perldelta.pod
$(MAKE) -f ..\win32\pod.mak converters
cd ..\win32
$(PERLEXE) $(PL2BAT) $(UTILS)
-del /f $(LIBDIR)\ops.pm $(LIBDIR)\Safe.pm
-del /f $(LIBDIR)\SDBM_File.pm $(LIBDIR)\Socket.pm $(LIBDIR)\POSIX.pm
-del /f $(LIBDIR)\B.pm $(LIBDIR)\O.pm $(LIBDIR)\re.pm
- -del /f $(LIBDIR)\Devel\Peek.pm $(LIBDIR)\Devel\DProf.pm
- -del /f $(LIBDIR)\Devel\PPPort.pm
-del /f $(LIBDIR)\File\Glob.pm
-del /f $(LIBDIR)\Storable.pm
- -del /f $(LIBDIR)\Digest\MD5.pm
- -del /f $(LIBDIR)\Digest\SHA.pm
- -del /f $(LIBDIR)\PerlIO\encoding.pm
- -del /f $(LIBDIR)\PerlIO\scalar.pm
- -del /f $(LIBDIR)\PerlIO\via.pm
-del /f $(LIBDIR)\Sys\Hostname.pm
- -del /f $(LIBDIR)\threads\shared.pm
-del /f $(LIBDIR)\Time\HiRes.pm
-del /f $(LIBDIR)\Unicode\Normalize.pm
-del /f $(LIBDIR)\Math\BigInt\FastCalc.pm
-del /f $(LIBDIR)\Win32API\File.pm
-del /f $(LIBDIR)\Win32API\File\cFile.pc
-del /f $(DISTDIR)\XSLoader\XSLoader.pm
+ -if exist $(LIBDIR)\App rmdir /s /q $(LIBDIR)\App
+ -if exist $(LIBDIR)\Archive rmdir /s /q $(LIBDIR)\Archive
+ -if exist $(LIBDIR)\Attribute rmdir /s /q $(LIBDIR)\Attribute
+ -if exist $(LIBDIR)\autodie rmdir /s /q $(LIBDIR)\autodie
-if exist $(LIBDIR)\B rmdir /s /q $(LIBDIR)\B
+ -if exist $(LIBDIR)\CGI rmdir /s /q $(LIBDIR)\CGI
+ -if exist $(LIBDIR)\CPAN rmdir /s /q $(LIBDIR)\CPAN
+ -if exist $(LIBDIR)\CPANPLUS rmdir /s /q $(LIBDIR)\CPANPLUS
-if exist $(LIBDIR)\Compress rmdir /s /q $(LIBDIR)\Compress
-if exist $(LIBDIR)\Data rmdir /s /q $(LIBDIR)\Data
+ -if exist $(LIBDIR)\Devel rmdir /s /q $(LIBDIR)\Devel
+ -if exist $(LIBDIR)\Digest rmdir /s /q $(LIBDIR)\Digest
-if exist $(LIBDIR)\Encode rmdir /s /q $(LIBDIR)\Encode
- -if exist $(LIBDIR)\Filter\Util rmdir /s /q $(LIBDIR)\Filter\Util
+ -if exist $(LIBDIR)\encoding rmdir /s /q $(LIBDIR)\encoding
+ -if exist $(LIBDIR)\ExtUtils\CBuilder rmdir /s /q $(LIBDIR)\ExtUtils\CBuilder
+ -if exist $(LIBDIR)\ExtUtils\Command rmdir /s /q $(LIBDIR)\ExtUtils\Command
+ -if exist $(LIBDIR)\ExtUtils\Constant rmdir /s /q $(LIBDIR)\ExtUtils\Constant
+ -if exist $(LIBDIR)\ExtUtils\Liblist rmdir /s /q $(LIBDIR)\ExtUtils\Liblist
+ -if exist $(LIBDIR)\ExtUtils\MakeMaker rmdir /s /q $(LIBDIR)\ExtUtils\MakeMaker
+ -if exist $(LIBDIR)\File\Spec rmdir /s /q $(LIBDIR)\File\Spec
+ -if exist $(LIBDIR)\Filter rmdir /s /q $(LIBDIR)\Filter
-if exist $(LIBDIR)\Hash rmdir /s /q $(LIBDIR)\Hash
- -if exist $(LIBDIR)\App rmdir /s /q $(LIBDIR)\App
+ -if exist $(LIBDIR)\I18N\LangTags rmdir /s /q $(LIBDIR)\I18N\LangTags
+ -if exist $(LIBDIR)\inc rmdir /s /q $(LIBDIR)\inc
-if exist $(LIBDIR)\Module\Pluggable rmdir /s /q $(LIBDIR)\Module\Pluggable
- -if exist $(LIBDIR)\TAP rmdir /s /q $(LIBDIR)\TAP
- -if exist $(LIBDIR)\mro rmdir /s /q $(LIBDIR)\mro
- -if exist $(LIBDIR)\IO\Compress rmdir /s /q $(LIBDIR)\IO\Compress
- -if exist $(LIBDIR)\IO\Socket rmdir /s /q $(LIBDIR)\IO\Socket
- -if exist $(LIBDIR)\IO\Uncompress rmdir /s /q $(LIBDIR)\IO\Uncompress
+ -if exist $(LIBDIR)\IO rmdir /s /q $(LIBDIR)\IO
+ -if exist $(LIBDIR)\IPC rmdir /s /q $(LIBDIR)\IPC
-if exist $(LIBDIR)\List rmdir /s /q $(LIBDIR)\List
+ -if exist $(LIBDIR)\Locale rmdir /s /q $(LIBDIR)\Locale
+ -if exist $(LIBDIR)\Log rmdir /s /q $(LIBDIR)\Log
+ -if exist $(LIBDIR)\Math rmdir /s /q $(LIBDIR)\Math
+ -if exist $(LIBDIR)\Memoize rmdir /s /q $(LIBDIR)\Memoize
-if exist $(LIBDIR)\MIME rmdir /s /q $(LIBDIR)\MIME
+ -if exist $(LIBDIR)\Module rmdir /s /q $(LIBDIR)\Module
+ -if exist $(LIBDIR)\mro rmdir /s /q $(LIBDIR)\mro
+ -if exist $(LIBDIR)\Net\FTP rmdir /s /q $(LIBDIR)\Net\FTP
+ -if exist $(LIBDIR)\Object rmdir /s /q $(LIBDIR)\Object
+ -if exist $(LIBDIR)\Package rmdir /s /q $(LIBDIR)\Package
+ -if exist $(LIBDIR)\Params rmdir /s /q $(LIBDIR)\Params
+ -if exist $(LIBDIR)\Parse rmdir /s /q $(LIBDIR)\Parse
+ -if exist $(LIBDIR)\PerlIO rmdir /s /q $(LIBDIR)\PerlIO
+ -if exist $(LIBDIR)\Pod\Perldoc rmdir /s /q $(LIBDIR)\Pod\Perldoc
+ -if exist $(LIBDIR)\Pod\Simple rmdir /s /q $(LIBDIR)\Pod\Simple
+ -if exist $(LIBDIR)\Pod\Text rmdir /s /q $(LIBDIR)\Pod\Text
-if exist $(LIBDIR)\re rmdir /s /q $(LIBDIR)\re
-if exist $(LIBDIR)\Scalar rmdir /s /q $(LIBDIR)\Scalar
-if exist $(LIBDIR)\Sys rmdir /s /q $(LIBDIR)\Sys
+ -if exist $(LIBDIR)\TAP rmdir /s /q $(LIBDIR)\TAP
+ -if exist $(LIBDIR)\Term\UI rmdir /s /q $(LIBDIR)\Term\UI
+ -if exist $(LIBDIR)\Test rmdir /s /q $(LIBDIR)\Test
+ -if exist $(LIBDIR)\Thread rmdir /s /q $(LIBDIR)\Thread
-if exist $(LIBDIR)\threads rmdir /s /q $(LIBDIR)\threads
+ -if exist $(LIBDIR)\Unicode\Collate rmdir /s /q $(LIBDIR)\Unicode\Collate
-if exist $(LIBDIR)\XS rmdir /s /q $(LIBDIR)\XS
-if exist $(LIBDIR)\Win32API rmdir /s /q $(LIBDIR)\Win32API
- -cd $(PODDIR) && del /f *.html *.bat podchecker \
+ -cd $(PODDIR) && del /f *.html *.bat \
perlaix.pod perlamiga.pod perlapi.pod perlapollo.pod \
perlbeos.pod perlbs2000.pod perlce.pod perlcn.pod \
perlcygwin.pod perldelta.pod perldgux.pod perldos.pod \
SRCDIR = ..
PV = 59
-INST_VER = 5.11.3
+INST_VER = 5.13.0
# INSTALL_ROOT specifies a path where this perl will be installed on CE device
INSTALL_ROOT=/netzwerk/sprache/perl
d_pipe='define'
d_poll='undef'
d_portable='define'
+d_prctl='undef'
+d_prctl_set_name='undef'
d_printf_format_null='undef'
d_procselfexe='undef'
d_pseudofork='undef'
uvtype='unsigned long'
uvuformat='"lu"'
uvxformat='"lx"'
+vaproto='undef'
vendorarch=''
vendorarchexp=''
vendorbin=''
d_pipe='undef'
d_poll='undef'
d_portable='define'
+d_prctl='undef'
+d_prctl_set_name='undef'
d_printf_format_null='undef'
d_procselfexe='undef'
d_pseudofork='undef'
uvtype='unsigned long'
uvuformat='"lu"'
uvxformat='"lx"'
+vaproto='undef'
vendorarch=''
vendorarchexp=''
vendorbin=''
d_pipe='define'
d_poll='undef'
d_portable='define'
+d_prctl='undef'
+d_prctl_set_name='undef'
d_printf_format_null='undef'
d_procselfexe='undef'
d_pseudofork='undef'
uvtype='unsigned long'
uvuformat='"lu"'
uvxformat='"lx"'
+vaproto='undef'
vendorarch=''
vendorarchexp=''
vendorbin=''
d_pipe='define'
d_poll='undef'
d_portable='define'
+d_prctl='undef'
+d_prctl_set_name='undef'
d_printf_format_null='undef'
d_procselfexe='undef'
d_pseudofork='undef'
uvtype='unsigned long'
uvuformat='"lu"'
uvxformat='"lx"'
+vaproto='undef'
vendorarch=''
vendorarchexp=''
vendorbin=''
d_pipe='define'
d_poll='undef'
d_portable='define'
+d_prctl='undef'
+d_prctl_set_name='undef'
d_printf_format_null='undef'
d_procselfexe='undef'
d_pseudofork='undef'
uvtype='unsigned __int64'
uvuformat='"I64u"'
uvxformat='"I64x"'
+vaproto='undef'
vendorarch=''
vendorarchexp=''
vendorbin=''
/*
* Package name : perl5
* Source directory :
- * Configuration time: Fri Dec 12 15:47:15 2008
- * Configured by : shay
+ * Configuration time: Mon Jan 11 00:09:46 2010
+ * Configured by : Steve
* Target system :
*/
* This symbol is defined if the bcmp() routine is available to
* compare blocks of memory.
*/
-/*#define HAS_BCMP /**/
+/*#define HAS_BCMP / **/
/* HAS_BCOPY:
* This symbol is defined if the bcopy() routine is available to
* copy blocks of memory.
*/
-/*#define HAS_BCOPY /**/
+/*#define HAS_BCOPY / **/
/* HAS_BZERO:
* This symbol is defined if the bzero() routine is available to
* set a memory block to 0.
*/
-/*#define HAS_BZERO /**/
+/*#define HAS_BZERO / **/
/* HAS_CHOWN:
* This symbol, if defined, indicates that the chown routine is
* available.
*/
-/*#define HAS_CHOWN /**/
+/*#define HAS_CHOWN / **/
/* HAS_CHROOT:
* This symbol, if defined, indicates that the chroot routine is
* available.
*/
-/*#define HAS_CHROOT /**/
+/*#define HAS_CHROOT / **/
/* HAS_CHSIZE:
* This symbol, if defined, indicates that the chsize routine is available
* This symbol, if defined, indicates that the crypt routine is available
* to encrypt passwords and the like.
*/
-/*#define HAS_CRYPT /**/
+/*#define HAS_CRYPT / **/
/* HAS_CTERMID:
* This symbol, if defined, indicates that the ctermid routine is
* available to generate filename for terminal.
*/
-/*#define HAS_CTERMID /**/
+/*#define HAS_CTERMID / **/
/* HAS_CUSERID:
* This symbol, if defined, indicates that the cuserid routine is
* available to get character login names.
*/
-/*#define HAS_CUSERID /**/
+/*#define HAS_CUSERID / **/
/* HAS_DBL_DIG:
* This symbol, if defined, indicates that this system's <float.h>
*/
#define HAS_DLERROR /**/
-/* SETUID_SCRIPTS_ARE_SECURE_NOW:
- * This symbol, if defined, indicates that the bug that prevents
- * setuid scripts from being secure is not present in this kernel.
- */
-/* DOSUID:
- * This symbol, if defined, indicates that the C program should
- * check the script that it is executing for setuid/setgid bits, and
- * attempt to emulate setuid/setgid on systems that have disabled
- * setuid #! scripts because the kernel can't do it securely.
- * It is up to the package designer to make sure that this emulation
- * is done securely. Among other things, it should do an fstat on
- * the script it just opened to make sure it really is a setuid/setgid
- * script, it should make sure the arguments passed correspond exactly
- * to the argument on the #! line, and it should not trust any
- * subprocesses to which it must pass the filename rather than the
- * file descriptor of the script to be executed.
- */
-/*#define SETUID_SCRIPTS_ARE_SECURE_NOW /**/
-/*#define DOSUID /**/
-
/* HAS_DUP2:
* This symbol, if defined, indicates that the dup2 routine is
* available to duplicate file descriptors.
* This symbol, if defined, indicates that the fchmod routine is available
* to change mode of opened files. If unavailable, use chmod().
*/
-/*#define HAS_FCHMOD /**/
+/*#define HAS_FCHMOD / **/
/* HAS_FCHOWN:
* This symbol, if defined, indicates that the fchown routine is available
* to change ownership of opened files. If unavailable, use chown().
*/
-/*#define HAS_FCHOWN /**/
+/*#define HAS_FCHOWN / **/
/* HAS_FCNTL:
* This symbol, if defined, indicates to the C program that
* the fcntl() function exists.
*/
-/*#define HAS_FCNTL /**/
+/*#define HAS_FCNTL / **/
/* HAS_FGETPOS:
* This symbol, if defined, indicates that the fgetpos routine is
* This symbol, if defined, indicates that the fork routine is
* available.
*/
-/*#define HAS_FORK /**/
+/*#define HAS_FORK / **/
/* HAS_FSETPOS:
* This symbol, if defined, indicates that the fsetpos routine is
* available to get the list of process groups. If unavailable, multiple
* groups are probably not supported.
*/
-/*#define HAS_GETGROUPS /**/
+/*#define HAS_GETGROUPS / **/
/* HAS_GETLOGIN:
* This symbol, if defined, indicates that the getlogin routine is
* the getpgid(pid) function is available to get the
* process group id.
*/
-/*#define HAS_GETPGID /**/
+/*#define HAS_GETPGID / **/
/* HAS_GETPGRP2:
* This symbol, if defined, indicates that the getpgrp2() (as in DG/UX)
* routine is available to get the current process group.
*/
-/*#define HAS_GETPGRP2 /**/
+/*#define HAS_GETPGRP2 / **/
/* HAS_GETPPID:
* This symbol, if defined, indicates that the getppid routine is
* available to get the parent process ID.
*/
-/*#define HAS_GETPPID /**/
+/*#define HAS_GETPPID / **/
/* HAS_GETPRIORITY:
* This symbol, if defined, indicates that the getpriority routine is
* available to get a process's priority.
*/
-/*#define HAS_GETPRIORITY /**/
+/*#define HAS_GETPRIORITY / **/
/* HAS_INET_ATON:
* This symbol, if defined, indicates to the C program that the
* inet_aton() function is available to parse IP address "dotted-quad"
* strings.
*/
-/*#define HAS_INET_ATON /**/
+/*#define HAS_INET_ATON / **/
/* HAS_KILLPG:
* This symbol, if defined, indicates that the killpg routine is available
* This symbol, if defined, indicates that the lockf routine is
* available to do file locking.
*/
-/*#define HAS_LOCKF /**/
+/*#define HAS_LOCKF / **/
/* HAS_LSTAT:
* This symbol, if defined, indicates that the lstat routine is
* available to do file stats on symbolic links.
*/
-/*#define HAS_LSTAT /**/
+/*#define HAS_LSTAT / **/
/* HAS_MBLEN:
* This symbol, if defined, indicates that the mblen routine is available
* do it for you. However, if mkfifo is there, mknod might require
* super-user privileges which mkfifo will not.
*/
-/*#define HAS_MKFIFO /**/
+/*#define HAS_MKFIFO / **/
/* HAS_MKTIME:
* This symbol, if defined, indicates that the mktime routine is
* This symbol, if defined, indicates that the msync system call is
* available to synchronize a mapped file.
*/
-/*#define HAS_MSYNC /**/
+/*#define HAS_MSYNC / **/
/* HAS_MUNMAP:
* This symbol, if defined, indicates that the munmap system call is
* available to unmap a region, usually mapped by mmap().
*/
-/*#define HAS_MUNMAP /**/
+/*#define HAS_MUNMAP / **/
/* HAS_NICE:
* This symbol, if defined, indicates that the nice routine is
* available.
*/
-/*#define HAS_NICE /**/
+/*#define HAS_NICE / **/
/* HAS_PATHCONF:
* This symbol, if defined, indicates that pathconf() is available
* to determine file-system related limits and options associated
* with a given open file descriptor.
*/
-/*#define HAS_PATHCONF /**/
-/*#define HAS_FPATHCONF /**/
+/*#define HAS_PATHCONF / **/
+/*#define HAS_FPATHCONF / **/
/* HAS_PAUSE:
* This symbol, if defined, indicates that the pause routine is
* available to poll active file descriptors. Please check I_POLL and
* I_SYS_POLL to know which header should be included as well.
*/
-/*#define HAS_POLL /**/
+/*#define HAS_POLL / **/
/* HAS_READDIR:
* This symbol, if defined, indicates that the readdir routine is
* This symbol, if defined, indicates that the readlink routine is
* available to read the value of a symbolic link.
*/
-/*#define HAS_READLINK /**/
+/*#define HAS_READLINK / **/
/* HAS_RENAME:
* This symbol, if defined, indicates that the rename routine is available
* This symbol, if defined, indicates that the setegid routine is available
* to change the effective gid of the current program.
*/
-/*#define HAS_SETEGID /**/
+/*#define HAS_SETEGID / **/
/* HAS_SETEUID:
* This symbol, if defined, indicates that the seteuid routine is available
* to change the effective uid of the current program.
*/
-/*#define HAS_SETEUID /**/
+/*#define HAS_SETEUID / **/
/* HAS_SETGROUPS:
* This symbol, if defined, indicates that the setgroups() routine is
* available to set the list of process groups. If unavailable, multiple
* groups are probably not supported.
*/
-/*#define HAS_SETGROUPS /**/
+/*#define HAS_SETGROUPS / **/
/* HAS_SETLINEBUF:
* This symbol, if defined, indicates that the setlinebuf routine is
* available to change stderr or stdout from block-buffered or unbuffered
* to a line-buffered mode.
*/
-/*#define HAS_SETLINEBUF /**/
+/*#define HAS_SETLINEBUF / **/
/* HAS_SETLOCALE:
* This symbol, if defined, indicates that the setlocale routine is
* This symbol, if defined, indicates that the setpgid(pid, gpid)
* routine is available to set process group ID.
*/
-/*#define HAS_SETPGID /**/
+/*#define HAS_SETPGID / **/
/* HAS_SETPGRP2:
* This symbol, if defined, indicates that the setpgrp2() (as in DG/UX)
* routine is available to set the current process group.
*/
-/*#define HAS_SETPGRP2 /**/
+/*#define HAS_SETPGRP2 / **/
/* HAS_SETPRIORITY:
* This symbol, if defined, indicates that the setpriority routine is
* available to set a process's priority.
*/
-/*#define HAS_SETPRIORITY /**/
+/*#define HAS_SETPRIORITY / **/
/* HAS_SETREGID:
* This symbol, if defined, indicates that the setregid routine is
* available to change the real, effective and saved gid of the current
* process.
*/
-/*#define HAS_SETREGID /**/
-/*#define HAS_SETRESGID /**/
+/*#define HAS_SETREGID / **/
+/*#define HAS_SETRESGID / **/
/* HAS_SETREUID:
* This symbol, if defined, indicates that the setreuid routine is
* available to change the real, effective and saved uid of the current
* process.
*/
-/*#define HAS_SETREUID /**/
-/*#define HAS_SETRESUID /**/
+/*#define HAS_SETREUID / **/
+/*#define HAS_SETRESUID / **/
/* HAS_SETRGID:
* This symbol, if defined, indicates that the setrgid routine is available
* to change the real gid of the current program.
*/
-/*#define HAS_SETRGID /**/
+/*#define HAS_SETRGID / **/
/* HAS_SETRUID:
* This symbol, if defined, indicates that the setruid routine is available
* to change the real uid of the current program.
*/
-/*#define HAS_SETRUID /**/
+/*#define HAS_SETRUID / **/
/* HAS_SETSID:
* This symbol, if defined, indicates that the setsid routine is
* available to set the process group ID.
*/
-/*#define HAS_SETSID /**/
+/*#define HAS_SETSID / **/
/* HAS_STRCHR:
* This symbol is defined to indicate that the strchr()/strrchr()
* functions are available for string searching.
*/
#define HAS_STRCHR /**/
-/*#define HAS_INDEX /**/
+/*#define HAS_INDEX / **/
/* HAS_STRCOLL:
* This symbol, if defined, indicates that the strcoll routine is
* This symbol, if defined, indicates that the symlink routine is available
* to create symbolic links.
*/
-/*#define HAS_SYMLINK /**/
+/*#define HAS_SYMLINK / **/
/* HAS_SYSCALL:
* This symbol, if defined, indicates that the syscall routine is
* available to call arbitrary system calls. If undefined, that's tough.
*/
-/*#define HAS_SYSCALL /**/
+/*#define HAS_SYSCALL / **/
/* HAS_SYSCONF:
* This symbol, if defined, indicates that sysconf() is available
* to determine system related limits and options.
*/
-/*#define HAS_SYSCONF /**/
+/*#define HAS_SYSCONF / **/
/* HAS_SYSTEM:
* This symbol, if defined, indicates that the system routine is
* This symbol, if defined, indicates that the tcgetpgrp routine is
* available to get foreground process group ID.
*/
-/*#define HAS_TCGETPGRP /**/
+/*#define HAS_TCGETPGRP / **/
/* HAS_TCSETPGRP:
* This symbol, if defined, indicates that the tcsetpgrp routine is
* available to set foreground process group ID.
*/
-/*#define HAS_TCSETPGRP /**/
+/*#define HAS_TCSETPGRP / **/
/* HAS_TRUNCATE:
* This symbol, if defined, indicates that the truncate routine is
* available to truncate files.
*/
-/*#define HAS_TRUNCATE /**/
+/*#define HAS_TRUNCATE / **/
/* HAS_TZNAME:
* This symbol, if defined, indicates that the tzname[] array is
* This symbol, if defined, indicates that the usleep routine is
* available to let the process sleep on a sub-second accuracy.
*/
-/*#define HAS_USLEEP /**/
+/*#define HAS_USLEEP / **/
/* HAS_WAIT4:
* This symbol, if defined, indicates that wait4() exists.
*/
-/*#define HAS_WAIT4 /**/
+/*#define HAS_WAIT4 / **/
/* HAS_WAITPID:
* This symbol, if defined, indicates that the waitpid routine is
* This symbol, if defined, indicates that <rpcsvc/dbm.h> exists and
* should be included.
*/
-/*#define I_DBM /**/
+/*#define I_DBM / **/
#define I_RPCSVC_DBM /**/
/* I_DLFCN:
* This symbol, if defined, indicates that <gdbm.h> exists and should
* be included.
*/
-/*#define I_GDBM /**/
+/*#define I_GDBM / **/
/* I_LIMITS:
* This symbol, if defined, indicates to the C program that it should
* This symbol, if defined, indicates to the C program that it should
* include <memory.h>.
*/
-/*#define I_MEMORY /**/
+/*#define I_MEMORY / **/
/* I_NETINET_IN:
* This symbol, if defined, indicates to the C program that it should
* include <netinet/in.h>. Otherwise, you may try <sys/in.h>.
*/
-/*#define I_NETINET_IN /**/
+/*#define I_NETINET_IN / **/
/* I_SFIO:
* This symbol, if defined, indicates to the C program that it should
* include <sfio.h>.
*/
-/*#define I_SFIO /**/
+/*#define I_SFIO / **/
/* I_STDDEF:
* This symbol, if defined, indicates that <stddef.h> exists and should
* This symbol, if defined, indicates to the C program that it should
* include <sys/dir.h>.
*/
-/*#define I_SYS_DIR /**/
+/*#define I_SYS_DIR / **/
/* I_SYS_FILE:
* This symbol, if defined, indicates to the C program that it should
* include <sys/file.h> to get definition of R_OK and friends.
*/
-/*#define I_SYS_FILE /**/
+/*#define I_SYS_FILE / **/
/* I_SYS_IOCTL:
* This symbol, if defined, indicates that <sys/ioctl.h> exists and should
* This symbol, if defined, indicates the <sys/sockio.h> should be included
* to get socket ioctl options, like SIOCATMARK.
*/
-/*#define I_SYS_IOCTL /**/
-/*#define I_SYS_SOCKIO /**/
+/*#define I_SYS_IOCTL / **/
+/*#define I_SYS_SOCKIO / **/
/* I_SYS_NDIR:
* This symbol, if defined, indicates to the C program that it should
* include <sys/ndir.h>.
*/
-/*#define I_SYS_NDIR /**/
+/*#define I_SYS_NDIR / **/
/* I_SYS_PARAM:
* This symbol, if defined, indicates to the C program that it should
* include <sys/param.h>.
*/
-/*#define I_SYS_PARAM /**/
+/*#define I_SYS_PARAM / **/
/* I_SYS_POLL:
* This symbol, if defined, indicates that the program may include
* <sys/poll.h>. When I_POLL is also defined, it's probably safest
* to only include <poll.h>.
*/
-/*#define I_SYS_POLL /**/
+/*#define I_SYS_POLL / **/
/* I_SYS_RESOURCE:
* This symbol, if defined, indicates to the C program that it should
* include <sys/resource.h>.
*/
-/*#define I_SYS_RESOURCE /**/
+/*#define I_SYS_RESOURCE / **/
/* I_SYS_SELECT:
* This symbol, if defined, indicates to the C program that it should
* include <sys/select.h> in order to get definition of struct timeval.
*/
-/*#define I_SYS_SELECT /**/
+/*#define I_SYS_SELECT / **/
/* I_SYS_STAT:
* This symbol, if defined, indicates to the C program that it should
* This symbol, if defined, indicates to the C program that it should
* include <sys/times.h>.
*/
-/*#define I_SYS_TIMES /**/
+/*#define I_SYS_TIMES / **/
/* I_SYS_TYPES:
* This symbol, if defined, indicates to the C program that it should
* This symbol, if defined, indicates to the C program that it should
* include <sys/un.h> to get UNIX domain socket definitions.
*/
-/*#define I_SYS_UN /**/
+/*#define I_SYS_UN / **/
/* I_SYS_WAIT:
* This symbol, if defined, indicates to the C program that it should
* include <sys/wait.h>.
*/
-/*#define I_SYS_WAIT /**/
+/*#define I_SYS_WAIT / **/
/* I_TERMIO:
* This symbol, if defined, indicates that the program should include
* <sgtty.h> rather than <termio.h>. There are also differences in
* the ioctl() calls that depend on the value of this symbol.
*/
-/*#define I_TERMIO /**/
-/*#define I_TERMIOS /**/
-/*#define I_SGTTY /**/
+/*#define I_TERMIO / **/
+/*#define I_TERMIOS / **/
+/*#define I_SGTTY / **/
/* I_UNISTD:
* This symbol, if defined, indicates to the C program that it should
* include <unistd.h>.
*/
-/*#define I_UNISTD /**/
+/*#define I_UNISTD / **/
/* I_UTIME:
* This symbol, if defined, indicates to the C program that it should
* MAXLONG, i.e. machine dependant limitations. Probably, you
* should use <limits.h> instead, if it is available.
*/
-/*#define I_VALUES /**/
+/*#define I_VALUES / **/
/* I_VFORK:
* This symbol, if defined, indicates to the C program that it should
* include vfork.h.
*/
-/*#define I_VFORK /**/
+/*#define I_VFORK / **/
+
+/* CAN_VAPROTO:
+ * This variable is defined on systems supporting prototype declaration
+ * of functions with a variable number of arguments.
+ */
+/* _V:
+ * This macro is used to declare function parameters in prototypes for
+ * functions with a variable number of parameters. Use double parentheses.
+ * For example:
+ *
+ * int printf _V((char *fmt, ...));
+ *
+ * Remember to use the plain simple _() macro when declaring a function
+ * with no variable number of arguments, since it might be possible to
+ * have a non-effect _V() macro and still get prototypes via _().
+ */
+/*#define CAN_VAPROTO / **/
+#ifdef CAN_VAPROTO
+#define _V(args) args
+#else
+#define _V(args) ()
+#endif
/* INTSIZE:
* This symbol contains the value of sizeof(int) so that the C
* example with the NeXT "fat" binaries that contain executables
* for several CPUs.
*/
-/*#define MULTIARCH /**/
+/*#define MULTIARCH / **/
/* HAS_QUAD:
* This symbol, if defined, tells that there's a 64-bit integer type,
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
#define ARCHLIB "c:\\perl\\lib" /**/
-/*#define ARCHLIB_EXP "" /**/
+/*#define ARCHLIB_EXP "" / **/
/* ARCHNAME:
* This symbol holds a string representing the architecture name.
* This symbol, if defined, indicates that the accessx routine is
* available to do extended access checks.
*/
-/*#define HAS_ACCESSX /**/
+/*#define HAS_ACCESSX / **/
/* HAS_ASCTIME_R:
* This symbol, if defined, indicates that the asctime_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_asctime_r
* is defined.
*/
-/*#define HAS_ASCTIME_R /**/
+/*#define HAS_ASCTIME_R / **/
#define ASCTIME_R_PROTO 0 /**/
/* HASATTRIBUTE_FORMAT:
/* HASATTRIBUTE_WARN_UNUSED_RESULT:
* Can we handle GCC attribute for warning on unused results
*/
-/*#define HASATTRIBUTE_DEPRECATED /**/
-/*#define HASATTRIBUTE_FORMAT /**/
-/*#define PRINTF_FORMAT_NULL_OK /**/
-/*#define HASATTRIBUTE_NORETURN /**/
-/*#define HASATTRIBUTE_MALLOC /**/
-/*#define HASATTRIBUTE_NONNULL /**/
-/*#define HASATTRIBUTE_PURE /**/
-/*#define HASATTRIBUTE_UNUSED /**/
-/*#define HASATTRIBUTE_WARN_UNUSED_RESULT /**/
+/*#define HASATTRIBUTE_DEPRECATED / **/
+/*#define HASATTRIBUTE_FORMAT / **/
+/*#define PRINTF_FORMAT_NULL_OK / **/
+/*#define HASATTRIBUTE_NORETURN / **/
+/*#define HASATTRIBUTE_MALLOC / **/
+/*#define HASATTRIBUTE_NONNULL / **/
+/*#define HASATTRIBUTE_PURE / **/
+/*#define HASATTRIBUTE_UNUSED / **/
+/*#define HASATTRIBUTE_WARN_UNUSED_RESULT / **/
/* HASCONST:
* This symbol, if defined, indicates that this C compiler knows about
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_crypt_r
* is defined.
*/
-/*#define HAS_CRYPT_R /**/
+/*#define HAS_CRYPT_R / **/
#define CRYPT_R_PROTO 0 /**/
/* HAS_CSH:
/* CSH:
* This symbol, if defined, contains the full pathname of csh.
*/
-/*#define HAS_CSH /**/
+/*#define HAS_CSH / **/
#ifdef HAS_CSH
#define CSH "" /**/
#endif
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_ctermid_r
* is defined.
*/
-/*#define HAS_CTERMID_R /**/
+/*#define HAS_CTERMID_R / **/
#define CTERMID_R_PROTO 0 /**/
/* HAS_CTIME_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_ctime_r
* is defined.
*/
-/*#define HAS_CTIME_R /**/
+/*#define HAS_CTIME_R / **/
#define CTIME_R_PROTO 0 /**/
/* HAS_DRAND48_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_drand48_r
* is defined.
*/
-/*#define HAS_DRAND48_R /**/
+/*#define HAS_DRAND48_R / **/
#define DRAND48_R_PROTO 0 /**/
/* HAS_DRAND48_PROTO:
* to the program to supply one. A good guess is
* extern double drand48(void);
*/
-/*#define HAS_DRAND48_PROTO /**/
+/*#define HAS_DRAND48_PROTO / **/
/* HAS_EACCESS:
* This symbol, if defined, indicates that the eaccess routine is
* available to do extended access checks.
*/
-/*#define HAS_EACCESS /**/
+/*#define HAS_EACCESS / **/
/* HAS_ENDGRENT:
* This symbol, if defined, indicates that the getgrent routine is
* available for finalizing sequential access of the group database.
*/
-/*#define HAS_ENDGRENT /**/
+/*#define HAS_ENDGRENT / **/
/* HAS_ENDGRENT_R:
* This symbol, if defined, indicates that the endgrent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endgrent_r
* is defined.
*/
-/*#define HAS_ENDGRENT_R /**/
+/*#define HAS_ENDGRENT_R / **/
#define ENDGRENT_R_PROTO 0 /**/
/* HAS_ENDHOSTENT:
* This symbol, if defined, indicates that the endhostent() routine is
* available to close whatever was being used for host queries.
*/
-/*#define HAS_ENDHOSTENT /**/
+/*#define HAS_ENDHOSTENT / **/
/* HAS_ENDHOSTENT_R:
* This symbol, if defined, indicates that the endhostent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endhostent_r
* is defined.
*/
-/*#define HAS_ENDHOSTENT_R /**/
+/*#define HAS_ENDHOSTENT_R / **/
#define ENDHOSTENT_R_PROTO 0 /**/
/* HAS_ENDNETENT:
* This symbol, if defined, indicates that the endnetent() routine is
* available to close whatever was being used for network queries.
*/
-/*#define HAS_ENDNETENT /**/
+/*#define HAS_ENDNETENT / **/
/* HAS_ENDNETENT_R:
* This symbol, if defined, indicates that the endnetent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endnetent_r
* is defined.
*/
-/*#define HAS_ENDNETENT_R /**/
+/*#define HAS_ENDNETENT_R / **/
#define ENDNETENT_R_PROTO 0 /**/
/* HAS_ENDPROTOENT:
* This symbol, if defined, indicates that the endprotoent() routine is
* available to close whatever was being used for protocol queries.
*/
-/*#define HAS_ENDPROTOENT /**/
+/*#define HAS_ENDPROTOENT / **/
/* HAS_ENDPROTOENT_R:
* This symbol, if defined, indicates that the endprotoent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endprotoent_r
* is defined.
*/
-/*#define HAS_ENDPROTOENT_R /**/
+/*#define HAS_ENDPROTOENT_R / **/
#define ENDPROTOENT_R_PROTO 0 /**/
/* HAS_ENDPWENT:
* This symbol, if defined, indicates that the getgrent routine is
* available for finalizing sequential access of the passwd database.
*/
-/*#define HAS_ENDPWENT /**/
+/*#define HAS_ENDPWENT / **/
/* HAS_ENDPWENT_R:
* This symbol, if defined, indicates that the endpwent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endpwent_r
* is defined.
*/
-/*#define HAS_ENDPWENT_R /**/
+/*#define HAS_ENDPWENT_R / **/
#define ENDPWENT_R_PROTO 0 /**/
/* HAS_ENDSERVENT:
* This symbol, if defined, indicates that the endservent() routine is
* available to close whatever was being used for service queries.
*/
-/*#define HAS_ENDSERVENT /**/
+/*#define HAS_ENDSERVENT / **/
/* HAS_ENDSERVENT_R:
* This symbol, if defined, indicates that the endservent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endservent_r
* is defined.
*/
-/*#define HAS_ENDSERVENT_R /**/
+/*#define HAS_ENDSERVENT_R / **/
#define ENDSERVENT_R_PROTO 0 /**/
/* FLEXFILENAMES:
* This symbol, if defined, indicates that the getgrent routine is
* available for sequential access of the group database.
*/
-/*#define HAS_GETGRENT /**/
+/*#define HAS_GETGRENT / **/
/* HAS_GETGRENT_R:
* This symbol, if defined, indicates that the getgrent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrent_r
* is defined.
*/
-/*#define HAS_GETGRENT_R /**/
+/*#define HAS_GETGRENT_R / **/
#define GETGRENT_R_PROTO 0 /**/
/* HAS_GETGRGID_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrgid_r
* is defined.
*/
-/*#define HAS_GETGRGID_R /**/
+/*#define HAS_GETGRGID_R / **/
#define GETGRGID_R_PROTO 0 /**/
/* HAS_GETGRNAM_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrnam_r
* is defined.
*/
-/*#define HAS_GETGRNAM_R /**/
+/*#define HAS_GETGRNAM_R / **/
#define GETGRNAM_R_PROTO 0 /**/
/* HAS_GETHOSTBYADDR:
* This symbol, if defined, indicates that the gethostent() routine is
* available to look up host names in some data base or another.
*/
-/*#define HAS_GETHOSTENT /**/
+/*#define HAS_GETHOSTENT / **/
/* HAS_GETHOSTNAME:
* This symbol, if defined, indicates that the C program may use the
*/
#define HAS_GETHOSTNAME /**/
#define HAS_UNAME /**/
-/*#define HAS_PHOSTNAME /**/
+/*#define HAS_PHOSTNAME / **/
#ifdef HAS_PHOSTNAME
#define PHOSTNAME "" /* How to get the host name */
#endif
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostbyaddr_r
* is defined.
*/
-/*#define HAS_GETHOSTBYADDR_R /**/
+/*#define HAS_GETHOSTBYADDR_R / **/
#define GETHOSTBYADDR_R_PROTO 0 /**/
/* HAS_GETHOSTBYNAME_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostbyname_r
* is defined.
*/
-/*#define HAS_GETHOSTBYNAME_R /**/
+/*#define HAS_GETHOSTBYNAME_R / **/
#define GETHOSTBYNAME_R_PROTO 0 /**/
/* HAS_GETHOSTENT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostent_r
* is defined.
*/
-/*#define HAS_GETHOSTENT_R /**/
+/*#define HAS_GETHOSTENT_R / **/
#define GETHOSTENT_R_PROTO 0 /**/
/* HAS_GETHOST_PROTOS:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getlogin_r
* is defined.
*/
-/*#define HAS_GETLOGIN_R /**/
+/*#define HAS_GETLOGIN_R / **/
#define GETLOGIN_R_PROTO 0 /**/
/* HAS_GETNETBYADDR:
* This symbol, if defined, indicates that the getnetbyaddr() routine is
* available to look up networks by their IP addresses.
*/
-/*#define HAS_GETNETBYADDR /**/
+/*#define HAS_GETNETBYADDR / **/
/* HAS_GETNETBYNAME:
* This symbol, if defined, indicates that the getnetbyname() routine is
* available to look up networks by their names.
*/
-/*#define HAS_GETNETBYNAME /**/
+/*#define HAS_GETNETBYNAME / **/
/* HAS_GETNETENT:
* This symbol, if defined, indicates that the getnetent() routine is
* available to look up network names in some data base or another.
*/
-/*#define HAS_GETNETENT /**/
+/*#define HAS_GETNETENT / **/
/* HAS_GETNETBYADDR_R:
* This symbol, if defined, indicates that the getnetbyaddr_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetbyaddr_r
* is defined.
*/
-/*#define HAS_GETNETBYADDR_R /**/
+/*#define HAS_GETNETBYADDR_R / **/
#define GETNETBYADDR_R_PROTO 0 /**/
/* HAS_GETNETBYNAME_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetbyname_r
* is defined.
*/
-/*#define HAS_GETNETBYNAME_R /**/
+/*#define HAS_GETNETBYNAME_R / **/
#define GETNETBYNAME_R_PROTO 0 /**/
/* HAS_GETNETENT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetent_r
* is defined.
*/
-/*#define HAS_GETNETENT_R /**/
+/*#define HAS_GETNETENT_R / **/
#define GETNETENT_R_PROTO 0 /**/
/* HAS_GETNET_PROTOS:
* getnetbyaddr(). Otherwise, it is up to the program to guess
* them. See netdbtype.U for probing for various Netdb_xxx_t types.
*/
-/*#define HAS_GETNET_PROTOS /**/
+/*#define HAS_GETNET_PROTOS / **/
/* HAS_GETPROTOENT:
* This symbol, if defined, indicates that the getprotoent() routine is
* available to look up protocols in some data base or another.
*/
-/*#define HAS_GETPROTOENT /**/
+/*#define HAS_GETPROTOENT / **/
/* HAS_GETPGRP:
* This symbol, if defined, indicates that the getpgrp routine is
* This symbol, if defined, indicates that getpgrp needs one
* arguments whereas USG one needs none.
*/
-/*#define HAS_GETPGRP /**/
-/*#define USE_BSD_GETPGRP /**/
+/*#define HAS_GETPGRP / **/
+/*#define USE_BSD_GETPGRP / **/
/* HAS_GETPROTOBYNAME:
* This symbol, if defined, indicates that the getprotobyname()
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotobyname_r
* is defined.
*/
-/*#define HAS_GETPROTOBYNAME_R /**/
+/*#define HAS_GETPROTOBYNAME_R / **/
#define GETPROTOBYNAME_R_PROTO 0 /**/
/* HAS_GETPROTOBYNUMBER_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotobynumber_r
* is defined.
*/
-/*#define HAS_GETPROTOBYNUMBER_R /**/
+/*#define HAS_GETPROTOBYNUMBER_R / **/
#define GETPROTOBYNUMBER_R_PROTO 0 /**/
/* HAS_GETPROTOENT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotoent_r
* is defined.
*/
-/*#define HAS_GETPROTOENT_R /**/
+/*#define HAS_GETPROTOENT_R / **/
#define GETPROTOENT_R_PROTO 0 /**/
/* HAS_GETPROTO_PROTOS:
* available for sequential access of the passwd database.
* If this is not available, the older getpw() function may be available.
*/
-/*#define HAS_GETPWENT /**/
+/*#define HAS_GETPWENT / **/
/* HAS_GETPWENT_R:
* This symbol, if defined, indicates that the getpwent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwent_r
* is defined.
*/
-/*#define HAS_GETPWENT_R /**/
+/*#define HAS_GETPWENT_R / **/
#define GETPWENT_R_PROTO 0 /**/
/* HAS_GETPWNAM_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwnam_r
* is defined.
*/
-/*#define HAS_GETPWNAM_R /**/
+/*#define HAS_GETPWNAM_R / **/
#define GETPWNAM_R_PROTO 0 /**/
/* HAS_GETPWUID_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwuid_r
* is defined.
*/
-/*#define HAS_GETPWUID_R /**/
+/*#define HAS_GETPWUID_R / **/
#define GETPWUID_R_PROTO 0 /**/
/* HAS_GETSERVENT:
* This symbol, if defined, indicates that the getservent() routine is
* available to look up network services in some data base or another.
*/
-/*#define HAS_GETSERVENT /**/
+/*#define HAS_GETSERVENT / **/
/* HAS_GETSERVBYNAME_R:
* This symbol, if defined, indicates that the getservbyname_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservbyname_r
* is defined.
*/
-/*#define HAS_GETSERVBYNAME_R /**/
+/*#define HAS_GETSERVBYNAME_R / **/
#define GETSERVBYNAME_R_PROTO 0 /**/
/* HAS_GETSERVBYPORT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservbyport_r
* is defined.
*/
-/*#define HAS_GETSERVBYPORT_R /**/
+/*#define HAS_GETSERVBYPORT_R / **/
#define GETSERVBYPORT_R_PROTO 0 /**/
/* HAS_GETSERVENT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservent_r
* is defined.
*/
-/*#define HAS_GETSERVENT_R /**/
+/*#define HAS_GETSERVENT_R / **/
#define GETSERVENT_R_PROTO 0 /**/
/* HAS_GETSERV_PROTOS:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getspnam_r
* is defined.
*/
-/*#define HAS_GETSPNAM_R /**/
+/*#define HAS_GETSPNAM_R / **/
#define GETSPNAM_R_PROTO 0 /**/
/* HAS_GETSERVBYNAME:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_gmtime_r
* is defined.
*/
-/*#define HAS_GMTIME_R /**/
+/*#define HAS_GMTIME_R / **/
#define GMTIME_R_PROTO 0 /**/
/* HAS_HTONL:
* changes using \undef{TZ} without explicitly calling tzset
* impossible. This symbol makes us call tzset before localtime_r
*/
-/*#define LOCALTIME_R_NEEDS_TZSET /**/
+/*#define LOCALTIME_R_NEEDS_TZSET / **/
#ifdef LOCALTIME_R_NEEDS_TZSET
#define L_R_TZSET tzset(),
#else
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_localtime_r
* is defined.
*/
-/*#define HAS_LOCALTIME_R /**/
+/*#define HAS_LOCALTIME_R / **/
#define LOCALTIME_R_PROTO 0 /**/
/* HAS_LONG_DOUBLE:
* C preprocessor can make decisions based on it. It is only
* defined if the system supports long long.
*/
-/*#define HAS_LONG_LONG /**/
+/*#define HAS_LONG_LONG / **/
#ifdef HAS_LONG_LONG
#define LONGLONGSIZE 8 /**/
#endif
* available to exclusively create and open a uniquely named
* temporary file.
*/
-/*#define HAS_MKSTEMP /**/
+/*#define HAS_MKSTEMP / **/
/* HAS_MMAP:
* This symbol, if defined, indicates that the mmap system call is
* (and simultaneously the type of the first argument).
* Usually set to 'void *' or 'caddr_t'.
*/
-/*#define HAS_MMAP /**/
+/*#define HAS_MMAP / **/
#define Mmap_t void * /**/
/* HAS_MSG:
* This symbol, if defined, indicates that the entire msg*(2) library is
* supported (IPC mechanism based on message queues).
*/
-/*#define HAS_MSG /**/
+/*#define HAS_MSG / **/
/* OLD_PTHREAD_CREATE_JOINABLE:
* This symbol, if defined, indicates how to create pthread
* If defined, known values are PTHREAD_CREATE_UNDETACHED
* and __UNDETACHED.
*/
-/*#define OLD_PTHREAD_CREATE_JOINABLE /**/
+/*#define OLD_PTHREAD_CREATE_JOINABLE / **/
/* HAS_PTHREAD_ATFORK:
* This symbol, if defined, indicates that the pthread_atfork routine
* is available to setup fork handlers.
*/
-/*#define HAS_PTHREAD_ATFORK /**/
+/*#define HAS_PTHREAD_ATFORK / **/
/* HAS_PTHREAD_YIELD:
* This symbol, if defined, indicates that the pthread_yield
* routine is available to yield the execution of the current
* thread. sched_yield is preferable to pthread_yield.
*/
-/*#define HAS_PTHREAD_YIELD /**/
+/*#define HAS_PTHREAD_YIELD / **/
#define SCHED_YIELD /**/
-/*#define HAS_SCHED_YIELD /**/
+/*#define HAS_SCHED_YIELD / **/
/* HAS_RANDOM_R:
* This symbol, if defined, indicates that the random_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_random_r
* is defined.
*/
-/*#define HAS_RANDOM_R /**/
+/*#define HAS_RANDOM_R / **/
#define RANDOM_R_PROTO 0 /**/
/* HAS_READDIR64_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_readdir64_r
* is defined.
*/
-/*#define HAS_READDIR64_R /**/
+/*#define HAS_READDIR64_R / **/
#define READDIR64_R_PROTO 0 /**/
/* HAS_READDIR_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_readdir_r
* is defined.
*/
-/*#define HAS_READDIR_R /**/
+/*#define HAS_READDIR_R / **/
#define READDIR_R_PROTO 0 /**/
/* HAS_SEM:
* This symbol, if defined, indicates that the entire sem*(2) library is
* supported.
*/
-/*#define HAS_SEM /**/
+/*#define HAS_SEM / **/
/* HAS_SETGRENT:
* This symbol, if defined, indicates that the setgrent routine is
* available for initializing sequential access of the group database.
*/
-/*#define HAS_SETGRENT /**/
+/*#define HAS_SETGRENT / **/
/* HAS_SETGRENT_R:
* This symbol, if defined, indicates that the setgrent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setgrent_r
* is defined.
*/
-/*#define HAS_SETGRENT_R /**/
+/*#define HAS_SETGRENT_R / **/
#define SETGRENT_R_PROTO 0 /**/
/* HAS_SETHOSTENT:
* This symbol, if defined, indicates that the sethostent() routine is
* available.
*/
-/*#define HAS_SETHOSTENT /**/
+/*#define HAS_SETHOSTENT / **/
/* HAS_SETHOSTENT_R:
* This symbol, if defined, indicates that the sethostent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_sethostent_r
* is defined.
*/
-/*#define HAS_SETHOSTENT_R /**/
+/*#define HAS_SETHOSTENT_R / **/
#define SETHOSTENT_R_PROTO 0 /**/
/* HAS_SETLOCALE_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setlocale_r
* is defined.
*/
-/*#define HAS_SETLOCALE_R /**/
+/*#define HAS_SETLOCALE_R / **/
#define SETLOCALE_R_PROTO 0 /**/
/* HAS_SETNETENT:
* This symbol, if defined, indicates that the setnetent() routine is
* available.
*/
-/*#define HAS_SETNETENT /**/
+/*#define HAS_SETNETENT / **/
/* HAS_SETNETENT_R:
* This symbol, if defined, indicates that the setnetent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setnetent_r
* is defined.
*/
-/*#define HAS_SETNETENT_R /**/
+/*#define HAS_SETNETENT_R / **/
#define SETNETENT_R_PROTO 0 /**/
/* HAS_SETPROTOENT:
* This symbol, if defined, indicates that the setprotoent() routine is
* available.
*/
-/*#define HAS_SETPROTOENT /**/
+/*#define HAS_SETPROTOENT / **/
/* HAS_SETPGRP:
* This symbol, if defined, indicates that the setpgrp routine is
* arguments whereas USG one needs none. See also HAS_SETPGID
* for a POSIX interface.
*/
-/*#define HAS_SETPGRP /**/
-/*#define USE_BSD_SETPGRP /**/
+/*#define HAS_SETPGRP / **/
+/*#define USE_BSD_SETPGRP / **/
/* HAS_SETPROTOENT_R:
* This symbol, if defined, indicates that the setprotoent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setprotoent_r
* is defined.
*/
-/*#define HAS_SETPROTOENT_R /**/
+/*#define HAS_SETPROTOENT_R / **/
#define SETPROTOENT_R_PROTO 0 /**/
/* HAS_SETPWENT:
* This symbol, if defined, indicates that the setpwent routine is
* available for initializing sequential access of the passwd database.
*/
-/*#define HAS_SETPWENT /**/
+/*#define HAS_SETPWENT / **/
/* HAS_SETPWENT_R:
* This symbol, if defined, indicates that the setpwent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setpwent_r
* is defined.
*/
-/*#define HAS_SETPWENT_R /**/
+/*#define HAS_SETPWENT_R / **/
#define SETPWENT_R_PROTO 0 /**/
/* HAS_SETSERVENT:
* This symbol, if defined, indicates that the setservent() routine is
* available.
*/
-/*#define HAS_SETSERVENT /**/
+/*#define HAS_SETSERVENT / **/
/* HAS_SETSERVENT_R:
* This symbol, if defined, indicates that the setservent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setservent_r
* is defined.
*/
-/*#define HAS_SETSERVENT_R /**/
+/*#define HAS_SETSERVENT_R / **/
#define SETSERVENT_R_PROTO 0 /**/
/* HAS_SETVBUF:
* This symbol, if defined, indicates that the entire shm*(2) library is
* supported.
*/
-/*#define HAS_SHM /**/
+/*#define HAS_SHM / **/
/* Shmat_t:
* This symbol holds the return type of the shmat() system call.
* when HAS_SHMAT_PROTOTYPE is not defined to avoid conflicting defs.
*/
#define Shmat_t void * /**/
-/*#define HAS_SHMAT_PROTOTYPE /**/
+/*#define HAS_SHMAT_PROTOTYPE / **/
/* HAS_SOCKET:
* This symbol, if defined, indicates that the BSD socket interface is
* has been known to be an enum.
*/
#define HAS_SOCKET /**/
-/*#define HAS_SOCKETPAIR /**/
-/*#define HAS_MSG_CTRUNC /**/
-/*#define HAS_MSG_DONTROUTE /**/
-/*#define HAS_MSG_OOB /**/
-/*#define HAS_MSG_PEEK /**/
-/*#define HAS_MSG_PROXY /**/
-/*#define HAS_SCM_RIGHTS /**/
+/*#define HAS_SOCKETPAIR / **/
+/*#define HAS_MSG_CTRUNC / **/
+/*#define HAS_MSG_DONTROUTE / **/
+/*#define HAS_MSG_OOB / **/
+/*#define HAS_MSG_PEEK / **/
+/*#define HAS_MSG_PROXY / **/
+/*#define HAS_SCM_RIGHTS / **/
/* HAS_SRAND48_R:
* This symbol, if defined, indicates that the srand48_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_srand48_r
* is defined.
*/
-/*#define HAS_SRAND48_R /**/
+/*#define HAS_SRAND48_R / **/
#define SRAND48_R_PROTO 0 /**/
/* HAS_SRANDOM_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_srandom_r
* is defined.
*/
-/*#define HAS_SRANDOM_R /**/
+/*#define HAS_SRANDOM_R / **/
#define SRANDOM_R_PROTO 0 /**/
/* USE_STAT_BLOCKS:
* st_blksize and st_blocks.
*/
#ifndef USE_STAT_BLOCKS
-/*#define USE_STAT_BLOCKS /**/
+/*#define USE_STAT_BLOCKS / **/
#endif
/* USE_STRUCT_COPY:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_strerror_r
* is defined.
*/
-/*#define HAS_STRERROR_R /**/
+/*#define HAS_STRERROR_R / **/
#define STRERROR_R_PROTO 0 /**/
/* HAS_STRTOUL:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_tmpnam_r
* is defined.
*/
-/*#define HAS_TMPNAM_R /**/
+/*#define HAS_TMPNAM_R / **/
#define TMPNAM_R_PROTO 0 /**/
/* HAS_TTYNAME_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_ttyname_r
* is defined.
*/
-/*#define HAS_TTYNAME_R /**/
+/*#define HAS_TTYNAME_R / **/
#define TTYNAME_R_PROTO 0 /**/
/* HAS_UNION_SEMUN:
* used for semctl IPC_STAT.
*/
#define HAS_UNION_SEMUN /**/
-/*#define USE_SEMCTL_SEMUN /**/
-/*#define USE_SEMCTL_SEMID_DS /**/
+/*#define USE_SEMCTL_SEMUN / **/
+/*#define USE_SEMCTL_SEMID_DS / **/
/* HAS_VFORK:
* This symbol, if defined, indicates that vfork() exists.
*/
-/*#define HAS_VFORK /**/
+/*#define HAS_VFORK / **/
/* HAS_PSEUDOFORK:
* This symbol, if defined, indicates that an emulation of the
* fork routine is available.
*/
-/*#define HAS_PSEUDOFORK /**/
+/*#define HAS_PSEUDOFORK / **/
/* Signal_t:
* This symbol's value is either "void" or "int", corresponding to the
* This symbol, if defined, indicates to the C program that struct group
* in <grp.h> contains gr_passwd.
*/
-/*#define I_GRP /**/
-/*#define GRPASSWD /**/
+/*#define I_GRP / **/
+/*#define GRPASSWD / **/
/* I_MACH_CTHREADS:
* This symbol, if defined, indicates to the C program that it should
* include <mach/cthreads.h>.
*/
-/*#define I_MACH_CTHREADS /**/
+/*#define I_MACH_CTHREADS / **/
/* I_NDBM:
* This symbol, if defined, indicates that <ndbm.h> exists and should
* parameter information. While ANSI C prototypes are supported in C++,
* K&R style function declarations will yield errors.
*/
-/*#define I_NDBM /**/
-/*#define I_GDBMNDBM /**/
-/*#define I_GDBM_NDBM /**/
-/*#define NDBM_H_USES_PROTOTYPES /**/
-/*#define GDBMNDBM_H_USES_PROTOTYPES /**/
-/*#define GDBM_NDBM_H_USES_PROTOTYPES /**/
+/*#define I_NDBM / **/
+/*#define I_GDBMNDBM / **/
+/*#define I_GDBM_NDBM / **/
+/*#define NDBM_H_USES_PROTOTYPES / **/
+/*#define GDBMNDBM_H_USES_PROTOTYPES / **/
+/*#define GDBM_NDBM_H_USES_PROTOTYPES / **/
/* I_NETDB:
* This symbol, if defined, indicates that <netdb.h> exists and
* should be included.
*/
-/*#define I_NETDB /**/
+/*#define I_NETDB / **/
/* I_NET_ERRNO:
* This symbol, if defined, indicates that <net/errno.h> exists and
* should be included.
*/
-/*#define I_NET_ERRNO /**/
+/*#define I_NET_ERRNO / **/
/* I_PTHREAD:
* This symbol, if defined, indicates to the C program that it should
* include <pthread.h>.
*/
-/*#define I_PTHREAD /**/
+/*#define I_PTHREAD / **/
/* I_PWD:
* This symbol, if defined, indicates to the C program that it should
* This symbol, if defined, indicates to the C program that struct passwd
* contains pw_passwd.
*/
-/*#define I_PWD /**/
-/*#define PWQUOTA /**/
-/*#define PWAGE /**/
-/*#define PWCHANGE /**/
-/*#define PWCLASS /**/
-/*#define PWEXPIRE /**/
-/*#define PWCOMMENT /**/
-/*#define PWGECOS /**/
-/*#define PWPASSWD /**/
+/*#define I_PWD / **/
+/*#define PWQUOTA / **/
+/*#define PWAGE / **/
+/*#define PWCHANGE / **/
+/*#define PWCLASS / **/
+/*#define PWEXPIRE / **/
+/*#define PWCOMMENT / **/
+/*#define PWGECOS / **/
+/*#define PWPASSWD / **/
/* I_SYS_ACCESS:
* This symbol, if defined, indicates to the C program that it should
* include <sys/access.h>.
*/
-/*#define I_SYS_ACCESS /**/
+/*#define I_SYS_ACCESS / **/
/* I_SYS_SECURITY:
* This symbol, if defined, indicates to the C program that it should
* include <sys/security.h>.
*/
-/*#define I_SYS_SECURITY /**/
+/*#define I_SYS_SECURITY / **/
/* I_SYSUIO:
* This symbol, if defined, indicates that <sys/uio.h> exists and
* should be included.
*/
-/*#define I_SYSUIO /**/
+/*#define I_SYSUIO / **/
/* I_STDARG:
* This symbol, if defined, indicates that <stdarg.h> exists and should
* include <varargs.h>.
*/
#define I_STDARG /**/
-/*#define I_VARARGS /**/
+/*#define I_VARARGS / **/
/* PERL_INC_VERSION_LIST:
* This variable specifies the list of subdirectories in over
* for a C initialization string. See the inc_version_list entry
* in Porting/Glossary for more details.
*/
-/*#define PERL_INC_VERSION_LIST 0 /**/
+/*#define PERL_INC_VERSION_LIST 0 / **/
/* INSTALL_USR_BIN_PERL:
* This symbol, if defined, indicates that Perl is to be installed
* also as /usr/bin/perl.
*/
-/*#define INSTALL_USR_BIN_PERL /**/
+/*#define INSTALL_USR_BIN_PERL / **/
/* Off_t:
* This symbol holds the type used to declare offsets in the kernel.
/* MYMALLOC:
* This symbol, if defined, indicates that we're using our own malloc.
*/
-/*#define MYMALLOC /**/
+/*#define MYMALLOC / **/
/* Mode_t:
* This symbol holds the type used to declare file modes
* and architecture-specific directories. See PERL_INC_VERSION_LIST
* for more details.
*/
-/*#define PERL_OTHERLIBDIRS "" /**/
+/*#define PERL_OTHERLIBDIRS "" / **/
/* Pid_t:
* This symbol holds the type used to declare process ids in the kernel.
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
#define SITEARCH "c:\\perl\\site\\lib" /**/
-/*#define SITEARCH_EXP "" /**/
+/*#define SITEARCH_EXP "" / **/
/* SITELIB:
* This symbol contains the name of the private library for this package.
* try to use the various _r versions of library functions.
* This is extremely experimental.
*/
-/*#define USE_5005THREADS /**/
-/*#define USE_ITHREADS /**/
+/*#define USE_5005THREADS / **/
+/*#define USE_ITHREADS / **/
#if defined(USE_5005THREADS) && !defined(USE_ITHREADS)
#define USE_THREADS /* until src is revised*/
#endif
-/*#define OLD_PTHREADS_API /**/
-/*#define USE_REENTRANT_API /**/
+/*#define OLD_PTHREADS_API / **/
+/*#define USE_REENTRANT_API / **/
/* PERL_VENDORARCH:
* If defined, this symbol contains the name of a private library.
* This symbol contains the ~name expanded version of PERL_VENDORARCH, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-/*#define PERL_VENDORARCH "" /**/
-/*#define PERL_VENDORARCH_EXP "" /**/
+/*#define PERL_VENDORARCH "" / **/
+/*#define PERL_VENDORARCH_EXP "" / **/
/* PERL_VENDORLIB_EXP:
* This symbol contains the ~name expanded version of VENDORLIB, to be used
* removed. The elements in inc_version_list (inc_version_list.U) can
* be tacked onto this variable to generate a list of directories to search.
*/
-/*#define PERL_VENDORLIB_EXP "" /**/
-/*#define PERL_VENDORLIB_STEM "" /**/
+/*#define PERL_VENDORLIB_EXP "" / **/
+/*#define PERL_VENDORLIB_STEM "" / **/
/* VOIDFLAGS:
* This symbol indicates how much support of the void type is given by this
* Perl has been cross-compiled to. Undefined if not a cross-compile.
*/
#ifndef USE_CROSS_COMPILE
-/*#define USE_CROSS_COMPILE /**/
+/*#define USE_CROSS_COMPILE / **/
#define PERL_TARGETARCH "" /**/
#endif
#define BYTEORDER 0x1234 /* large digits for MSB */
#endif /* NeXT */
+/* CHARBITS:
+ * This symbol contains the size of a char, so that the C preprocessor
+ * can make decisions based on it.
+ */
+#define CHARBITS 8 /**/
+
/* CASTI32:
* This symbol is defined if the C compiler can cast negative
* or large floating point numbers to 32-bit ints.
* This symbol, if defined, indicates that the closedir() routine
* does not return a value.
*/
-/*#define VOID_CLOSEDIR /**/
+/*#define VOID_CLOSEDIR / **/
/* HAS_FD_SET:
* This symbol, when defined, indicates presence of the fd_set typedef
* is available to get system page size, which is the granularity of
* many memory management calls.
*/
-/*#define HAS_GETPAGESIZE /**/
+/*#define HAS_GETPAGESIZE / **/
/* HAS_GNULIBC:
* This symbol, if defined, indicates to the C program that
* the GNU C library is being used. A better check is to use
* the __GLIBC__ and __GLIBC_MINOR__ symbols supplied with glibc.
*/
-/*#define HAS_GNULIBC /**/
+/*#define HAS_GNULIBC / **/
#if defined(HAS_GNULIBC) && !defined(_GNU_SOURCE)
# define _GNU_SOURCE
#endif
* available to operate on a symbolic link (instead of following the
* link).
*/
-/*#define HAS_LCHOWN /**/
+/*#define HAS_LCHOWN / **/
/* HAS_OPEN3:
* This manifest constant lets the C program know that the three
* argument form of open(2) is available.
*/
-/*#define HAS_OPEN3 /**/
+/*#define HAS_OPEN3 / **/
/* HAS_SAFE_BCOPY:
* This symbol, if defined, indicates that the bcopy routine is available
* probably use memmove() or memcpy(). If neither is defined, roll your
* own version.
*/
-/*#define HAS_SAFE_BCOPY /**/
+/*#define HAS_SAFE_BCOPY / **/
/* HAS_SAFE_MEMCPY:
* This symbol, if defined, indicates that the memcpy routine is available
* copy overlapping memory blocks, you should check HAS_MEMMOVE and
* use memmove() instead, if available.
*/
-/*#define HAS_SAFE_MEMCPY /**/
+/*#define HAS_SAFE_MEMCPY / **/
/* HAS_SANE_MEMCMP:
* This symbol, if defined, indicates that the memcmp routine is available
* This symbol, if defined, indicates that Vr4's sigaction() routine
* is available.
*/
-/*#define HAS_SIGACTION /**/
+/*#define HAS_SIGACTION / **/
/* HAS_SIGSETJMP:
* This variable indicates to the C program that the sigsetjmp()
* traditional longjmp() if siglongjmp isn't available.
* See HAS_SIGSETJMP.
*/
-/*#define HAS_SIGSETJMP /**/
+/*#define HAS_SIGSETJMP / **/
#ifdef HAS_SIGSETJMP
#define Sigjmp_buf sigjmp_buf
#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask))
#define STDIO_PTR_LVALUE /**/
#define FILE_cnt(fp) ((fp)->level)
#define STDIO_CNT_LVALUE /**/
-/*#define STDIO_PTR_LVAL_SETS_CNT /**/
+/*#define STDIO_PTR_LVAL_SETS_CNT / **/
#define STDIO_PTR_LVAL_NOCHANGE_CNT /**/
#endif
* symbol.
*/
#define HAS_VPRINTF /**/
-/*#define USE_CHAR_VSPRINTF /**/
+/*#define USE_CHAR_VSPRINTF / **/
/* DOUBLESIZE:
* This symbol contains the size of a double, so that the C preprocessor
* the struct tm has a tm_gmtoff field.
*/
#define I_TIME /**/
-/*#define I_SYS_TIME /**/
-/*#define I_SYS_TIME_KERNEL /**/
-/*#define HAS_TM_TM_ZONE /**/
-/*#define HAS_TM_TM_GMTOFF /**/
+/*#define I_SYS_TIME / **/
+/*#define I_SYS_TIME_KERNEL / **/
+/*#define HAS_TM_TM_ZONE / **/
+/*#define HAS_TM_TM_GMTOFF / **/
/* VAL_O_NONBLOCK:
* This symbol is to be used during open() or fcntl(F_SETFL) to turn on
* This symbol, if defined, indicates that this system uses
* EBCDIC encoding.
*/
-/*#define EBCDIC /**/
+/*#define EBCDIC / **/
+
+/* SETUID_SCRIPTS_ARE_SECURE_NOW:
+ * This symbol, if defined, indicates that the bug that prevents
+ * setuid scripts from being secure is not present in this kernel.
+ */
+/* DOSUID:
+ * This symbol, if defined, indicates that the C program should
+ * check the script that it is executing for setuid/setgid bits, and
+ * attempt to emulate setuid/setgid on systems that have disabled
+ * setuid #! scripts because the kernel can't do it securely.
+ * It is up to the package designer to make sure that this emulation
+ * is done securely. Among other things, it should do an fstat on
+ * the script it just opened to make sure it really is a setuid/setgid
+ * script, it should make sure the arguments passed correspond exactly
+ * to the argument on the #! line, and it should not trust any
+ * subprocesses to which it must pass the filename rather than the
+ * file descriptor of the script to be executed.
+ */
+/*#define SETUID_SCRIPTS_ARE_SECURE_NOW / **/
+/*#define DOSUID / **/
/* PERL_USE_DEVEL:
* This symbol, if defined, indicates that Perl was configured with
* -Dusedevel, to enable development features. This should not be
* done for production builds.
*/
-/*#define PERL_USE_DEVEL /**/
+/*#define PERL_USE_DEVEL / **/
/* HAS_ATOLF:
* This symbol, if defined, indicates that the atolf routine is
* available to convert strings into long doubles.
*/
-/*#define HAS_ATOLF /**/
+/*#define HAS_ATOLF / **/
/* HAS_ATOLL:
* This symbol, if defined, indicates that the atoll routine is
* available to convert strings into long longs.
*/
-/*#define HAS_ATOLL /**/
+/*#define HAS_ATOLL / **/
/* HAS__FWALK:
* This symbol, if defined, indicates that the _fwalk system call is
* available to apply a function to all the file handles.
*/
-/*#define HAS__FWALK /**/
+/*#define HAS__FWALK / **/
/* HAS_AINTL:
* This symbol, if defined, indicates that the aintl routine is
* available. If copysignl is also present we can emulate modfl.
*/
-/*#define HAS_AINTL /**/
+/*#define HAS_AINTL / **/
/* HAS_BUILTIN_CHOOSE_EXPR:
* Can we handle GCC builtin for compile-time ternary-like expressions
* Can we handle GCC builtin for telling that certain values are more
* likely
*/
-/*#define HAS_BUILTIN_EXPECT /**/
-/*#define HAS_BUILTIN_CHOOSE_EXPR /**/
+/*#define HAS_BUILTIN_EXPECT / **/
+/*#define HAS_BUILTIN_CHOOSE_EXPR / **/
/* HAS_C99_VARIADIC_MACROS:
* If defined, the compiler supports C99 variadic macros.
*/
-/*#define HAS_C99_VARIADIC_MACROS /**/
+/*#define HAS_C99_VARIADIC_MACROS / **/
/* HAS_CLASS:
* This symbol, if defined, indicates that the class routine is
* FP_NANS Signaling Not a Number (NaNS)
* FP_NANQ Quiet Not a Number (NaNQ)
*/
-/*#define HAS_CLASS /**/
+/*#define HAS_CLASS / **/
/* HAS_CLEARENV:
* This symbol, if defined, indicates that the clearenv () routine is
* available for use.
*/
-/*#define HAS_CLEARENV /**/
+/*#define HAS_CLEARENV / **/
/* HAS_STRUCT_CMSGHDR:
* This symbol, if defined, indicates that the struct cmsghdr
* is supported.
*/
-/*#define HAS_STRUCT_CMSGHDR /**/
+/*#define HAS_STRUCT_CMSGHDR / **/
/* HAS_COPYSIGNL:
* This symbol, if defined, indicates that the copysignl routine is
* available. If aintl is also present we can emulate modfl.
*/
-/*#define HAS_COPYSIGNL /**/
+/*#define HAS_COPYSIGNL / **/
/* USE_CPLUSPLUS:
* This symbol, if defined, indicates that a C++ compiler was
* used to compiled Perl and will be used to compile extensions.
*/
-/*#define USE_CPLUSPLUS /**/
+/*#define USE_CPLUSPLUS / **/
/* HAS_DBMINIT_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. A good guess is
* extern int dbminit(char *);
*/
-/*#define HAS_DBMINIT_PROTO /**/
+/*#define HAS_DBMINIT_PROTO / **/
/* HAS_DIR_DD_FD:
* This symbol, if defined, indicates that the the DIR* dirstream
* structure contains a member variable named dd_fd.
*/
-/*#define HAS_DIR_DD_FD /**/
+/*#define HAS_DIR_DD_FD / **/
/* HAS_DIRFD:
* This manifest constant lets the C program know that dirfd
* is available.
*/
-/*#define HAS_DIRFD /**/
+/*#define HAS_DIRFD / **/
/* DLSYM_NEEDS_UNDERSCORE:
* This symbol, if defined, indicates that we need to prepend an
* makes sense if you *have* dlsym, which we will presume is the
* case if you're using dl_dlopen.xs.
*/
-/*#define DLSYM_NEEDS_UNDERSCORE /**/
+/*#define DLSYM_NEEDS_UNDERSCORE / **/
/* HAS_FAST_STDIO:
* This symbol, if defined, indicates that the "fast stdio"
* This symbol, if defined, indicates that the fchdir routine is
* available to change directory using a file descriptor.
*/
-/*#define HAS_FCHDIR /**/
+/*#define HAS_FCHDIR / **/
/* FCNTL_CAN_LOCK:
* This symbol, if defined, indicates that fcntl() can be used
* for file locking. Normally on Unix systems this is defined.
* It may be undefined on VMS.
*/
-/*#define FCNTL_CAN_LOCK /**/
+/*#define FCNTL_CAN_LOCK / **/
/* HAS_FINITE:
* This symbol, if defined, indicates that the finite routine is
* available to check whether a double is finite (non-infinity non-NaN).
*/
-/*#define HAS_FINITE /**/
+/*#define HAS_FINITE / **/
/* HAS_FINITEL:
* This symbol, if defined, indicates that the finitel routine is
* available to check whether a long double is finite
* (non-infinity non-NaN).
*/
-/*#define HAS_FINITEL /**/
+/*#define HAS_FINITEL / **/
/* HAS_FLOCK_PROTO:
* This symbol, if defined, indicates that the system provides
* FP_POS_ZERO +0.0 (positive zero)
* FP_NEG_ZERO -0.0 (negative zero)
*/
-/*#define HAS_FP_CLASS /**/
+/*#define HAS_FP_CLASS / **/
/* HAS_FPCLASS:
* This symbol, if defined, indicates that the fpclass routine is
* FP_NNORM negative normalized non-zero
* FP_PNORM positive normalized non-zero
*/
-/*#define HAS_FPCLASS /**/
+/*#define HAS_FPCLASS / **/
/* HAS_FPCLASSIFY:
* This symbol, if defined, indicates that the fpclassify routine is
* FP_NAN NaN
*
*/
-/*#define HAS_FPCLASSIFY /**/
+/*#define HAS_FPCLASSIFY / **/
/* HAS_FPCLASSL:
* This symbol, if defined, indicates that the fpclassl routine is
* FP_NNORM negative normalized non-zero
* FP_PNORM positive normalized non-zero
*/
-/*#define HAS_FPCLASSL /**/
+/*#define HAS_FPCLASSL / **/
/* HAS_FPOS64_T:
* This symbol will be defined if the C compiler supports fpos64_t.
*/
-/*#define HAS_FPOS64_T /**/
+/*#define HAS_FPOS64_T / **/
/* HAS_FREXPL:
* This symbol, if defined, indicates that the frexpl routine is
* available to break a long double floating-point number into
* a normalized fraction and an integral power of 2.
*/
-/*#define HAS_FREXPL /**/
+/*#define HAS_FREXPL / **/
/* HAS_STRUCT_FS_DATA:
* This symbol, if defined, indicates that the struct fs_data
* to do statfs() is supported.
*/
-/*#define HAS_STRUCT_FS_DATA /**/
+/*#define HAS_STRUCT_FS_DATA / **/
/* HAS_FSEEKO:
* This symbol, if defined, indicates that the fseeko routine is
* available to fseek beyond 32 bits (useful for ILP32 hosts).
*/
-/*#define HAS_FSEEKO /**/
+/*#define HAS_FSEEKO / **/
/* HAS_FSTATFS:
* This symbol, if defined, indicates that the fstatfs routine is
* available to stat filesystems by file descriptors.
*/
-/*#define HAS_FSTATFS /**/
+/*#define HAS_FSTATFS / **/
/* HAS_FSYNC:
* This symbol, if defined, indicates that the fsync routine is
* available to write a file's modified data and attributes to
* permanent storage.
*/
-/*#define HAS_FSYNC /**/
+/*#define HAS_FSYNC / **/
/* HAS_FTELLO:
* This symbol, if defined, indicates that the ftello routine is
* available to ftell beyond 32 bits (useful for ILP32 hosts).
*/
-/*#define HAS_FTELLO /**/
+/*#define HAS_FTELLO / **/
/* HAS_FUTIMES:
* This symbol, if defined, indicates that the futimes routine is
* available to change file descriptor time stamps with struct timevals.
*/
-/*#define HAS_FUTIMES /**/
+/*#define HAS_FUTIMES / **/
+
+/* HAS_GETADDRINFO:
+ * This symbol, if defined, indicates that the getaddrinfo() function
+ * is available for use.
+ */
+/*#define HAS_GETADDRINFO / **/
/* HAS_GETCWD:
* This symbol, if defined, indicates that the getcwd routine is
* This symbol, if defined, indicates that the getespwnam system call is
* available to retrieve enchanced (shadow) password entries by name.
*/
-/*#define HAS_GETESPWNAM /**/
+/*#define HAS_GETESPWNAM / **/
/* HAS_GETFSSTAT:
* This symbol, if defined, indicates that the getfsstat routine is
* available to stat filesystems in bulk.
*/
-/*#define HAS_GETFSSTAT /**/
+/*#define HAS_GETFSSTAT / **/
/* HAS_GETITIMER:
* This symbol, if defined, indicates that the getitimer routine is
* available to return interval timers.
*/
-/*#define HAS_GETITIMER /**/
+/*#define HAS_GETITIMER / **/
/* HAS_GETMNT:
* This symbol, if defined, indicates that the getmnt routine is
* available to get filesystem mount info by filename.
*/
-/*#define HAS_GETMNT /**/
+/*#define HAS_GETMNT / **/
/* HAS_GETMNTENT:
* This symbol, if defined, indicates that the getmntent routine is
* available to iterate through mounted file systems to get their info.
*/
-/*#define HAS_GETMNTENT /**/
+/*#define HAS_GETMNTENT / **/
+
+/* HAS_GETNAMEINFO:
+ * This symbol, if defined, indicates that the getnameinfo() function
+ * is available for use.
+ */
+/*#define HAS_GETNAMEINFO / **/
/* HAS_GETPRPWNAM:
* This symbol, if defined, indicates that the getprpwnam system call is
* available to retrieve protected (shadow) password entries by name.
*/
-/*#define HAS_GETPRPWNAM /**/
+/*#define HAS_GETPRPWNAM / **/
/* HAS_GETSPNAM:
* This symbol, if defined, indicates that the getspnam system call is
* available to retrieve SysV shadow password entries by name.
*/
-/*#define HAS_GETSPNAM /**/
+/*#define HAS_GETSPNAM / **/
/* HAS_HASMNTOPT:
* This symbol, if defined, indicates that the hasmntopt routine is
* available to query the mount options of file systems.
*/
-/*#define HAS_HASMNTOPT /**/
+/*#define HAS_HASMNTOPT / **/
/* HAS_ILOGBL:
* This symbol, if defined, indicates that the ilogbl routine is
* available. If scalbnl is also present we can emulate frexpl.
*/
-/*#define HAS_ILOGBL /**/
+/*#define HAS_ILOGBL / **/
+
+/* HAS_INETNTOP:
+ * This symbol, if defined, indicates that the inet_ntop() function
+ * is available to parse IPv4 and IPv6 strings.
+ */
+/*#define HAS_INETNTOP / **/
+
+/* HAS_INETPTON:
+ * This symbol, if defined, indicates that the inet_pton() function
+ * is available to parse IPv4 and IPv6 strings.
+ */
+/*#define HAS_INETPTON / **/
/* HAS_INT64_T:
* This symbol will defined if the C compiler supports int64_t.
* Usually the <inttypes.h> needs to be included, but sometimes
* <sys/types.h> is enough.
*/
-/*#define HAS_INT64_T /**/
+/*#define HAS_INT64_T / **/
/* HAS_ISFINITE:
* This symbol, if defined, indicates that the isfinite routine is
* available to check whether a double is finite (non-infinity non-NaN).
*/
-/*#define HAS_ISFINITE /**/
+/*#define HAS_ISFINITE / **/
/* HAS_ISINF:
* This symbol, if defined, indicates that the isinf routine is
* available to check whether a double is an infinity.
*/
-/*#define HAS_ISINF /**/
+/*#define HAS_ISINF / **/
/* HAS_ISNAN:
* This symbol, if defined, indicates that the isnan routine is
* This symbol, if defined, indicates that the isnanl routine is
* available to check whether a long double is a NaN.
*/
-/*#define HAS_ISNANL /**/
+/*#define HAS_ISNANL / **/
/* HAS_LDBL_DIG:
* This symbol, if defined, indicates that this system's <float.h>
* This symbol, if defined, indicates that libm exports _LIB_VERSION
* and that math.h defines the enum to manipulate it.
*/
-/*#define LIBM_LIB_VERSION /**/
+/*#define LIBM_LIB_VERSION / **/
/* HAS_MADVISE:
* This symbol, if defined, indicates that the madvise system call is
* available to map a file into memory.
*/
-/*#define HAS_MADVISE /**/
+/*#define HAS_MADVISE / **/
/* HAS_MALLOC_SIZE:
* This symbol, if defined, indicates that the malloc_size
* routine is available for use.
*/
-/*#define HAS_MALLOC_SIZE /**/
+/*#define HAS_MALLOC_SIZE / **/
/* HAS_MALLOC_GOOD_SIZE:
* This symbol, if defined, indicates that the malloc_good_size
* routine is available for use.
*/
-/*#define HAS_MALLOC_GOOD_SIZE /**/
+/*#define HAS_MALLOC_GOOD_SIZE / **/
/* HAS_MKDTEMP:
* This symbol, if defined, indicates that the mkdtemp routine is
* available to exclusively create a uniquely named temporary directory.
*/
-/*#define HAS_MKDTEMP /**/
+/*#define HAS_MKDTEMP / **/
/* HAS_MKSTEMPS:
* This symbol, if defined, indicates that the mkstemps routine is
* available to excluslvely create and open a uniquely named
* (with a suffix) temporary file.
*/
-/*#define HAS_MKSTEMPS /**/
+/*#define HAS_MKSTEMPS / **/
/* HAS_MODFL:
* This symbol, if defined, indicates that the modfl routine is
* and 1.150000. The bug has been seen in certain versions of glibc,
* release 2.2.2 is known to be okay.
*/
-/*#define HAS_MODFL /**/
-/*#define HAS_MODFL_PROTO /**/
-/*#define HAS_MODFL_POW32_BUG /**/
+/*#define HAS_MODFL / **/
+/*#define HAS_MODFL_PROTO / **/
+/*#define HAS_MODFL_POW32_BUG / **/
/* HAS_MPROTECT:
* This symbol, if defined, indicates that the mprotect system call is
* available to modify the access protection of a memory mapped file.
*/
-/*#define HAS_MPROTECT /**/
+/*#define HAS_MPROTECT / **/
/* HAS_STRUCT_MSGHDR:
* This symbol, if defined, indicates that the struct msghdr
* is supported.
*/
-/*#define HAS_STRUCT_MSGHDR /**/
+/*#define HAS_STRUCT_MSGHDR / **/
/* HAS_NL_LANGINFO:
* This symbol, if defined, indicates that the nl_langinfo routine is
* available to return local data. You will also need <langinfo.h>
* and therefore I_LANGINFO.
*/
-/*#define HAS_NL_LANGINFO /**/
+/*#define HAS_NL_LANGINFO / **/
/* HAS_OFF64_T:
* This symbol will be defined if the C compiler supports off64_t.
*/
-/*#define HAS_OFF64_T /**/
+/*#define HAS_OFF64_T / **/
/* HAS_PROCSELFEXE:
* This symbol is defined if PROCSELFEXE_PATH is a symlink
* of the symbolic link pointing to the absolute pathname of
* the executing program.
*/
-/*#define HAS_PROCSELFEXE /**/
+/*#define HAS_PROCSELFEXE / **/
#if defined(HAS_PROCSELFEXE) && !defined(PROCSELFEXE_PATH)
#define PROCSELFEXE_PATH /**/
#endif
* system call is available to set the contention scope attribute of
* a thread attribute object.
*/
-/*#define HAS_PTHREAD_ATTR_SETSCOPE /**/
+/*#define HAS_PTHREAD_ATTR_SETSCOPE / **/
/* HAS_READV:
* This symbol, if defined, indicates that the readv routine is
* available to do gather reads. You will also need <sys/uio.h>
* and there I_SYSUIO.
*/
-/*#define HAS_READV /**/
+/*#define HAS_READV / **/
/* HAS_RECVMSG:
* This symbol, if defined, indicates that the recvmsg routine is
* available to send structured socket messages.
*/
-/*#define HAS_RECVMSG /**/
+/*#define HAS_RECVMSG / **/
/* HAS_SBRK_PROTO:
* This symbol, if defined, indicates that the system provides
* extern void* sbrk(int);
* extern void* sbrk(size_t);
*/
-/*#define HAS_SBRK_PROTO /**/
+/*#define HAS_SBRK_PROTO / **/
/* HAS_SCALBNL:
* This symbol, if defined, indicates that the scalbnl routine is
* available. If ilogbl is also present we can emulate frexpl.
*/
-/*#define HAS_SCALBNL /**/
+/*#define HAS_SCALBNL / **/
/* HAS_SENDMSG:
* This symbol, if defined, indicates that the sendmsg routine is
* available to send structured socket messages.
*/
-/*#define HAS_SENDMSG /**/
+/*#define HAS_SENDMSG / **/
/* HAS_SETITIMER:
* This symbol, if defined, indicates that the setitimer routine is
* available to set interval timers.
*/
-/*#define HAS_SETITIMER /**/
+/*#define HAS_SETITIMER / **/
/* HAS_SETPROCTITLE:
* This symbol, if defined, indicates that the setproctitle routine is
* available to set process title.
*/
-/*#define HAS_SETPROCTITLE /**/
+/*#define HAS_SETPROCTITLE / **/
/* USE_SFIO:
* This symbol, if defined, indicates that sfio should
* be used.
*/
-/*#define USE_SFIO /**/
+/*#define USE_SFIO / **/
/* HAS_SIGNBIT:
* This symbol, if defined, indicates that the signbit routine is
* in perl. Users should call Perl_signbit(), which will be #defined to
* the system's signbit() function or macro if this symbol is defined.
*/
-/*#define HAS_SIGNBIT /**/
+/*#define HAS_SIGNBIT / **/
/* HAS_SIGPROCMASK:
* This symbol, if defined, indicates that the sigprocmask
* system call is available to examine or change the signal mask
* of the calling process.
*/
-/*#define HAS_SIGPROCMASK /**/
+/*#define HAS_SIGPROCMASK / **/
/* USE_SITECUSTOMIZE:
* This symbol, if defined, indicates that sitecustomize should
* be used.
*/
#ifndef USE_SITECUSTOMIZE
-/*#define USE_SITECUSTOMIZE /**/
+/*#define USE_SITECUSTOMIZE / **/
#endif
/* HAS_SNPRINTF:
* This symbol, if defined, indicates that the sockatmark routine is
* available to test whether a socket is at the out-of-band mark.
*/
-/*#define HAS_SOCKATMARK /**/
+/*#define HAS_SOCKATMARK / **/
/* HAS_SOCKATMARK_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. A good guess is
* extern int sockatmark(int);
*/
-/*#define HAS_SOCKATMARK_PROTO /**/
+/*#define HAS_SOCKATMARK_PROTO / **/
/* HAS_SOCKS5_INIT:
* This symbol, if defined, indicates that the socks5_init routine is
* available to initialize SOCKS 5.
*/
-/*#define HAS_SOCKS5_INIT /**/
+/*#define HAS_SOCKS5_INIT / **/
/* SPRINTF_RETURNS_STRLEN:
* This variable defines whether sprintf returns the length of the string
* This symbol, if defined, indicates that the sqrtl routine is
* available to do long double square roots.
*/
-/*#define HAS_SQRTL /**/
+/*#define HAS_SQRTL / **/
/* HAS_SETRESGID_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. Good guesses are
* extern int setresgid(uid_t ruid, uid_t euid, uid_t suid);
*/
-/*#define HAS_SETRESGID_PROTO /**/
+/*#define HAS_SETRESGID_PROTO / **/
/* HAS_SETRESUID_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. Good guesses are
* extern int setresuid(uid_t ruid, uid_t euid, uid_t suid);
*/
-/*#define HAS_SETRESUID_PROTO /**/
+/*#define HAS_SETRESUID_PROTO / **/
/* HAS_STRUCT_STATFS_F_FLAGS:
* This symbol, if defined, indicates that the struct statfs
* have statfs() and struct statfs, they have ustat() and getmnt()
* with struct ustat and struct fs_data.
*/
-/*#define HAS_STRUCT_STATFS_F_FLAGS /**/
+/*#define HAS_STRUCT_STATFS_F_FLAGS / **/
/* HAS_STRUCT_STATFS:
* This symbol, if defined, indicates that the struct statfs
* to do statfs() is supported.
*/
-/*#define HAS_STRUCT_STATFS /**/
+/*#define HAS_STRUCT_STATFS / **/
/* HAS_FSTATVFS:
* This symbol, if defined, indicates that the fstatvfs routine is
* available to stat filesystems by file descriptors.
*/
-/*#define HAS_FSTATVFS /**/
+/*#define HAS_FSTATVFS / **/
/* HAS_STRFTIME:
* This symbol, if defined, indicates that the strftime routine is
* This symbol, if defined, indicates that the strlcat () routine is
* available to do string concatenation.
*/
-/*#define HAS_STRLCAT /**/
+/*#define HAS_STRLCAT / **/
/* HAS_STRLCPY:
* This symbol, if defined, indicates that the strlcpy () routine is
* available to do string copying.
*/
-/*#define HAS_STRLCPY /**/
+/*#define HAS_STRLCPY / **/
/* HAS_STRTOLD:
* This symbol, if defined, indicates that the strtold routine is
* available to convert strings to long doubles.
*/
-/*#define HAS_STRTOLD /**/
+/*#define HAS_STRTOLD / **/
/* HAS_STRTOLL:
* This symbol, if defined, indicates that the strtoll routine is
* available to convert strings to long longs.
*/
-/*#define HAS_STRTOLL /**/
+/*#define HAS_STRTOLL / **/
/* HAS_STRTOQ:
* This symbol, if defined, indicates that the strtoq routine is
* available to convert strings to long longs (quads).
*/
-/*#define HAS_STRTOQ /**/
+/*#define HAS_STRTOQ / **/
/* HAS_STRTOULL:
* This symbol, if defined, indicates that the strtoull routine is
* available to convert strings to unsigned long longs.
*/
-/*#define HAS_STRTOULL /**/
+/*#define HAS_STRTOULL / **/
/* HAS_STRTOUQ:
* This symbol, if defined, indicates that the strtouq routine is
* available to convert strings to unsigned long longs (quads).
*/
-/*#define HAS_STRTOUQ /**/
+/*#define HAS_STRTOUQ / **/
/* HAS_SYSCALL_PROTO:
* This symbol, if defined, indicates that the system provides
* extern int syscall(int, ...);
* extern int syscall(long, ...);
*/
-/*#define HAS_SYSCALL_PROTO /**/
+/*#define HAS_SYSCALL_PROTO / **/
/* HAS_TELLDIR_PROTO:
* This symbol, if defined, indicates that the system provides
* This symbol, if defined, indicates that the asctime64 () routine is
* available to do the 64bit variant of asctime ()
*/
-/*#define HAS_CTIME64 /**/
-/*#define HAS_LOCALTIME64 /**/
-/*#define HAS_GMTIME64 /**/
-/*#define HAS_MKTIME64 /**/
-/*#define HAS_DIFFTIME64 /**/
-/*#define HAS_ASCTIME64 /**/
+/*#define HAS_CTIME64 / **/
+/*#define HAS_LOCALTIME64 / **/
+/*#define HAS_GMTIME64 / **/
+/*#define HAS_MKTIME64 / **/
+/*#define HAS_DIFFTIME64 / **/
+/*#define HAS_ASCTIME64 / **/
/* HAS_TIMEGM:
* This symbol, if defined, indicates that the timegm routine is
* available to do the opposite of gmtime ()
*/
-/*#define HAS_TIMEGM /**/
+/*#define HAS_TIMEGM / **/
/* U32_ALIGNMENT_REQUIRED:
* This symbol, if defined, indicates that you must access
* This symbol, if defined, indicates that the ualarm routine is
* available to do alarms with microsecond granularity.
*/
-/*#define HAS_UALARM /**/
+/*#define HAS_UALARM / **/
/* HAS_UNORDERED:
* This symbol, if defined, indicates that the unordered routine is
* available to check whether two doubles are unordered
* (effectively: whether either of them is NaN)
*/
-/*#define HAS_UNORDERED /**/
+/*#define HAS_UNORDERED / **/
/* HAS_UNSETENV:
* This symbol, if defined, indicates that the unsetenv () routine is
* available for use.
*/
-/*#define HAS_UNSETENV /**/
+/*#define HAS_UNSETENV / **/
/* HAS_USLEEP_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. A good guess is
* extern int usleep(useconds_t);
*/
-/*#define HAS_USLEEP_PROTO /**/
+/*#define HAS_USLEEP_PROTO / **/
/* HAS_USTAT:
* This symbol, if defined, indicates that the ustat system call is
* available to query file system statistics by dev_t.
*/
-/*#define HAS_USTAT /**/
+/*#define HAS_USTAT / **/
/* HAS_WRITEV:
* This symbol, if defined, indicates that the writev routine is
* available to do scatter writes.
*/
-/*#define HAS_WRITEV /**/
+/*#define HAS_WRITEV / **/
/* USE_DYNAMIC_LOADING:
* This symbol, if defined, indicates that dynamic loading of
* even be probed for and will be left undefined.
*/
#define FFLUSH_NULL /**/
-/*#define FFLUSH_ALL /**/
+/*#define FFLUSH_ALL / **/
/* I_ASSERT:
* This symbol, if defined, indicates that <assert.h> exists and
* This symbol, if defined, indicates that <crypt.h> exists and
* should be included.
*/
-/*#define I_CRYPT /**/
+/*#define I_CRYPT / **/
/* DB_Prefix_t:
* This symbol contains the type of the prefix structure element
* This symbol, if defined, indicates that <fp.h> exists and
* should be included.
*/
-/*#define I_FP /**/
+/*#define I_FP / **/
/* I_FP_CLASS:
* This symbol, if defined, indicates that <fp_class.h> exists and
* should be included.
*/
-/*#define I_FP_CLASS /**/
+/*#define I_FP_CLASS / **/
/* I_IEEEFP:
* This symbol, if defined, indicates that <ieeefp.h> exists and
* should be included.
*/
-/*#define I_IEEEFP /**/
+/*#define I_IEEEFP / **/
/* I_INTTYPES:
* This symbol, if defined, indicates to the C program that it should
* include <inttypes.h>.
*/
-/*#define I_INTTYPES /**/
+/*#define I_INTTYPES / **/
/* I_LANGINFO:
* This symbol, if defined, indicates that <langinfo.h> exists and
* should be included.
*/
-/*#define I_LANGINFO /**/
+/*#define I_LANGINFO / **/
/* I_LIBUTIL:
* This symbol, if defined, indicates that <libutil.h> exists and
* should be included.
*/
-/*#define I_LIBUTIL /**/
+/*#define I_LIBUTIL / **/
/* I_MALLOCMALLOC:
* This symbol, if defined, indicates to the C program that it should
* include <malloc/malloc.h>.
*/
-/*#define I_MALLOCMALLOC /**/
+/*#define I_MALLOCMALLOC / **/
/* I_MNTENT:
* This symbol, if defined, indicates that <mntent.h> exists and
* should be included.
*/
-/*#define I_MNTENT /**/
+/*#define I_MNTENT / **/
/* I_NETINET_TCP:
* This symbol, if defined, indicates to the C program that it should
* include <netinet/tcp.h>.
*/
-/*#define I_NETINET_TCP /**/
+/*#define I_NETINET_TCP / **/
/* I_POLL:
* This symbol, if defined, indicates that <poll.h> exists and
* should be included. (see also HAS_POLL)
*/
-/*#define I_POLL /**/
+/*#define I_POLL / **/
/* I_PROT:
* This symbol, if defined, indicates that <prot.h> exists and
* should be included.
*/
-/*#define I_PROT /**/
+/*#define I_PROT / **/
/* I_SHADOW:
* This symbol, if defined, indicates that <shadow.h> exists and
* should be included.
*/
-/*#define I_SHADOW /**/
+/*#define I_SHADOW / **/
/* I_SOCKS:
* This symbol, if defined, indicates that <socks.h> exists and
* should be included.
*/
-/*#define I_SOCKS /**/
+/*#define I_SOCKS / **/
/* I_SUNMATH:
* This symbol, if defined, indicates that <sunmath.h> exists and
* should be included.
*/
-/*#define I_SUNMATH /**/
+/*#define I_SUNMATH / **/
/* I_SYSLOG:
* This symbol, if defined, indicates that <syslog.h> exists and
* should be included.
*/
-/*#define I_SYSLOG /**/
+/*#define I_SYSLOG / **/
/* I_SYSMODE:
* This symbol, if defined, indicates that <sys/mode.h> exists and
* should be included.
*/
-/*#define I_SYSMODE /**/
+/*#define I_SYSMODE / **/
/* I_SYS_MOUNT:
* This symbol, if defined, indicates that <sys/mount.h> exists and
* should be included.
*/
-/*#define I_SYS_MOUNT /**/
+/*#define I_SYS_MOUNT / **/
/* I_SYS_STATFS:
* This symbol, if defined, indicates that <sys/statfs.h> exists.
*/
-/*#define I_SYS_STATFS /**/
+/*#define I_SYS_STATFS / **/
/* I_SYS_STATVFS:
* This symbol, if defined, indicates that <sys/statvfs.h> exists and
* should be included.
*/
-/*#define I_SYS_STATVFS /**/
+/*#define I_SYS_STATVFS / **/
/* I_SYSUTSNAME:
* This symbol, if defined, indicates that <sys/utsname.h> exists and
* should be included.
*/
-/*#define I_SYSUTSNAME /**/
+/*#define I_SYSUTSNAME / **/
/* I_SYS_VFS:
* This symbol, if defined, indicates that <sys/vfs.h> exists and
* should be included.
*/
-/*#define I_SYS_VFS /**/
+/*#define I_SYS_VFS / **/
/* I_USTAT:
* This symbol, if defined, indicates that <ustat.h> exists and
* should be included.
*/
-/*#define I_USTAT /**/
+/*#define I_USTAT / **/
/* PERL_PRIfldbl:
* This symbol, if defined, contains the string used by stdio to
* This symbol, if defined, contains the string used by stdio to
* format long doubles (format 'f') for input.
*/
-/*#define PERL_PRIfldbl "Lf" /**/
-/*#define PERL_PRIgldbl "Lg" /**/
-/*#define PERL_PRIeldbl "Le" /**/
-/*#define PERL_SCNfldbl "Lf" /**/
+/*#define PERL_PRIfldbl "Lf" / **/
+/*#define PERL_PRIgldbl "Lg" / **/
+/*#define PERL_PRIeldbl "Le" / **/
+/*#define PERL_SCNfldbl "Lf" / **/
/* PERL_MAD:
* This symbol, if defined, indicates that the Misc Attribution
* Declaration code should be conditionally compiled.
*/
-/*#define PERL_MAD /**/
+/*#define PERL_MAD / **/
/* NEED_VA_COPY:
* This symbol, if defined, indicates that the system stores
* of copying mechanisms, handy.h defines a platform-
* independent macro, Perl_va_copy(src, dst), to do the job.
*/
-/*#define NEED_VA_COPY /**/
+/*#define NEED_VA_COPY / **/
/* IVTYPE:
* This symbol defines the C type used for Perl's IV.
* This symbol tells the name of the array holding the stdio streams.
* Usual values include _iob, __iob, and __sF.
*/
-/*#define HAS_STDIO_STREAM_ARRAY /**/
+/*#define HAS_STDIO_STREAM_ARRAY / **/
#ifdef HAS_STDIO_STREAM_ARRAY
#define STDIO_STREAM_ARRAY
#endif
* you may need at least to reboot your OS to 64-bit mode.
*/
#ifndef USE_64_BIT_INT
-/*#define USE_64_BIT_INT /**/
+/*#define USE_64_BIT_INT / **/
#endif
#ifndef USE_64_BIT_ALL
-/*#define USE_64_BIT_ALL /**/
+/*#define USE_64_BIT_ALL / **/
#endif
/* USE_DTRACE:
* This symbol, if defined, indicates that Perl should
* be built with support for DTrace.
*/
-/*#define USE_DTRACE /**/
+/*#define USE_DTRACE / **/
/* USE_FAST_STDIO:
* This symbol, if defined, indicates that Perl should
* Defaults to define in Perls 5.8 and earlier, to undef later.
*/
#ifndef USE_FAST_STDIO
-/*#define USE_FAST_STDIO /**/
+/*#define USE_FAST_STDIO / **/
#endif
/* USE_LARGE_FILES:
* should be used when available.
*/
#ifndef USE_LARGE_FILES
-/*#define USE_LARGE_FILES /**/
+/*#define USE_LARGE_FILES / **/
#endif
/* USE_LONG_DOUBLE:
* be used when available.
*/
#ifndef USE_LONG_DOUBLE
-/*#define USE_LONG_DOUBLE /**/
+/*#define USE_LONG_DOUBLE / **/
#endif
/* USE_MORE_BITS:
* long doubles should be used when available.
*/
#ifndef USE_MORE_BITS
-/*#define USE_MORE_BITS /**/
+/*#define USE_MORE_BITS / **/
#endif
/* MULTIPLICITY:
* be built to use multiplicity.
*/
#ifndef MULTIPLICITY
-/*#define MULTIPLICITY /**/
+/*#define MULTIPLICITY / **/
#endif
/* USE_PERLIO:
* used in a fully backward compatible manner.
*/
#ifndef USE_PERLIO
-/*#define USE_PERLIO /**/
+/*#define USE_PERLIO / **/
#endif
/* USE_SOCKS:
* be built to use socks.
*/
#ifndef USE_SOCKS
-/*#define USE_SOCKS /**/
+/*#define USE_SOCKS / **/
#endif
#endif
/*
* Package name : perl5
* Source directory :
- * Configuration time: Fri Dec 12 15:41:26 2008
- * Configured by : shay
+ * Configuration time: Sun Jan 10 19:53:56 2010
+ * Configured by : Steve
* Target system :
*/
* This symbol is defined if the bcmp() routine is available to
* compare blocks of memory.
*/
-/*#define HAS_BCMP /**/
+/*#define HAS_BCMP / **/
/* HAS_BCOPY:
* This symbol is defined if the bcopy() routine is available to
* copy blocks of memory.
*/
-/*#define HAS_BCOPY /**/
+/*#define HAS_BCOPY / **/
/* HAS_BZERO:
* This symbol is defined if the bzero() routine is available to
* set a memory block to 0.
*/
-/*#define HAS_BZERO /**/
+/*#define HAS_BZERO / **/
/* HAS_CHOWN:
* This symbol, if defined, indicates that the chown routine is
* available.
*/
-/*#define HAS_CHOWN /**/
+/*#define HAS_CHOWN / **/
/* HAS_CHROOT:
* This symbol, if defined, indicates that the chroot routine is
* available.
*/
-/*#define HAS_CHROOT /**/
+/*#define HAS_CHROOT / **/
/* HAS_CHSIZE:
* This symbol, if defined, indicates that the chsize routine is available
* This symbol, if defined, indicates that the crypt routine is available
* to encrypt passwords and the like.
*/
-/*#define HAS_CRYPT /**/
+/*#define HAS_CRYPT / **/
/* HAS_CTERMID:
* This symbol, if defined, indicates that the ctermid routine is
* available to generate filename for terminal.
*/
-/*#define HAS_CTERMID /**/
+/*#define HAS_CTERMID / **/
/* HAS_CUSERID:
* This symbol, if defined, indicates that the cuserid routine is
* available to get character login names.
*/
-/*#define HAS_CUSERID /**/
+/*#define HAS_CUSERID / **/
/* HAS_DBL_DIG:
* This symbol, if defined, indicates that this system's <float.h>
*/
#define HAS_DLERROR /**/
-/* SETUID_SCRIPTS_ARE_SECURE_NOW:
- * This symbol, if defined, indicates that the bug that prevents
- * setuid scripts from being secure is not present in this kernel.
- */
-/* DOSUID:
- * This symbol, if defined, indicates that the C program should
- * check the script that it is executing for setuid/setgid bits, and
- * attempt to emulate setuid/setgid on systems that have disabled
- * setuid #! scripts because the kernel can't do it securely.
- * It is up to the package designer to make sure that this emulation
- * is done securely. Among other things, it should do an fstat on
- * the script it just opened to make sure it really is a setuid/setgid
- * script, it should make sure the arguments passed correspond exactly
- * to the argument on the #! line, and it should not trust any
- * subprocesses to which it must pass the filename rather than the
- * file descriptor of the script to be executed.
- */
-/*#define SETUID_SCRIPTS_ARE_SECURE_NOW /**/
-/*#define DOSUID /**/
-
/* HAS_DUP2:
* This symbol, if defined, indicates that the dup2 routine is
* available to duplicate file descriptors.
* This symbol, if defined, indicates that the fchmod routine is available
* to change mode of opened files. If unavailable, use chmod().
*/
-/*#define HAS_FCHMOD /**/
+/*#define HAS_FCHMOD / **/
/* HAS_FCHOWN:
* This symbol, if defined, indicates that the fchown routine is available
* to change ownership of opened files. If unavailable, use chown().
*/
-/*#define HAS_FCHOWN /**/
+/*#define HAS_FCHOWN / **/
/* HAS_FCNTL:
* This symbol, if defined, indicates to the C program that
* the fcntl() function exists.
*/
-/*#define HAS_FCNTL /**/
+/*#define HAS_FCNTL / **/
/* HAS_FGETPOS:
* This symbol, if defined, indicates that the fgetpos routine is
* This symbol, if defined, indicates that the fork routine is
* available.
*/
-/*#define HAS_FORK /**/
+/*#define HAS_FORK / **/
/* HAS_FSETPOS:
* This symbol, if defined, indicates that the fsetpos routine is
* available to get the list of process groups. If unavailable, multiple
* groups are probably not supported.
*/
-/*#define HAS_GETGROUPS /**/
+/*#define HAS_GETGROUPS / **/
/* HAS_GETLOGIN:
* This symbol, if defined, indicates that the getlogin routine is
* the getpgid(pid) function is available to get the
* process group id.
*/
-/*#define HAS_GETPGID /**/
+/*#define HAS_GETPGID / **/
/* HAS_GETPGRP2:
* This symbol, if defined, indicates that the getpgrp2() (as in DG/UX)
* routine is available to get the current process group.
*/
-/*#define HAS_GETPGRP2 /**/
+/*#define HAS_GETPGRP2 / **/
/* HAS_GETPPID:
* This symbol, if defined, indicates that the getppid routine is
* available to get the parent process ID.
*/
-/*#define HAS_GETPPID /**/
+/*#define HAS_GETPPID / **/
/* HAS_GETPRIORITY:
* This symbol, if defined, indicates that the getpriority routine is
* available to get a process's priority.
*/
-/*#define HAS_GETPRIORITY /**/
+/*#define HAS_GETPRIORITY / **/
/* HAS_INET_ATON:
* This symbol, if defined, indicates to the C program that the
* inet_aton() function is available to parse IP address "dotted-quad"
* strings.
*/
-/*#define HAS_INET_ATON /**/
+/*#define HAS_INET_ATON / **/
/* HAS_KILLPG:
* This symbol, if defined, indicates that the killpg routine is available
* This symbol, if defined, indicates that the lockf routine is
* available to do file locking.
*/
-/*#define HAS_LOCKF /**/
+/*#define HAS_LOCKF / **/
/* HAS_LSTAT:
* This symbol, if defined, indicates that the lstat routine is
* available to do file stats on symbolic links.
*/
-/*#define HAS_LSTAT /**/
+/*#define HAS_LSTAT / **/
/* HAS_MBLEN:
* This symbol, if defined, indicates that the mblen routine is available
* do it for you. However, if mkfifo is there, mknod might require
* super-user privileges which mkfifo will not.
*/
-/*#define HAS_MKFIFO /**/
+/*#define HAS_MKFIFO / **/
/* HAS_MKTIME:
* This symbol, if defined, indicates that the mktime routine is
* This symbol, if defined, indicates that the msync system call is
* available to synchronize a mapped file.
*/
-/*#define HAS_MSYNC /**/
+/*#define HAS_MSYNC / **/
/* HAS_MUNMAP:
* This symbol, if defined, indicates that the munmap system call is
* available to unmap a region, usually mapped by mmap().
*/
-/*#define HAS_MUNMAP /**/
+/*#define HAS_MUNMAP / **/
/* HAS_NICE:
* This symbol, if defined, indicates that the nice routine is
* available.
*/
-/*#define HAS_NICE /**/
+/*#define HAS_NICE / **/
/* HAS_PATHCONF:
* This symbol, if defined, indicates that pathconf() is available
* to determine file-system related limits and options associated
* with a given open file descriptor.
*/
-/*#define HAS_PATHCONF /**/
-/*#define HAS_FPATHCONF /**/
+/*#define HAS_PATHCONF / **/
+/*#define HAS_FPATHCONF / **/
/* HAS_PAUSE:
* This symbol, if defined, indicates that the pause routine is
* available to poll active file descriptors. Please check I_POLL and
* I_SYS_POLL to know which header should be included as well.
*/
-/*#define HAS_POLL /**/
+/*#define HAS_POLL / **/
/* HAS_READDIR:
* This symbol, if defined, indicates that the readdir routine is
* This symbol, if defined, indicates that the readlink routine is
* available to read the value of a symbolic link.
*/
-/*#define HAS_READLINK /**/
+/*#define HAS_READLINK / **/
/* HAS_RENAME:
* This symbol, if defined, indicates that the rename routine is available
* This symbol, if defined, indicates that the setegid routine is available
* to change the effective gid of the current program.
*/
-/*#define HAS_SETEGID /**/
+/*#define HAS_SETEGID / **/
/* HAS_SETEUID:
* This symbol, if defined, indicates that the seteuid routine is available
* to change the effective uid of the current program.
*/
-/*#define HAS_SETEUID /**/
+/*#define HAS_SETEUID / **/
/* HAS_SETGROUPS:
* This symbol, if defined, indicates that the setgroups() routine is
* available to set the list of process groups. If unavailable, multiple
* groups are probably not supported.
*/
-/*#define HAS_SETGROUPS /**/
+/*#define HAS_SETGROUPS / **/
/* HAS_SETLINEBUF:
* This symbol, if defined, indicates that the setlinebuf routine is
* available to change stderr or stdout from block-buffered or unbuffered
* to a line-buffered mode.
*/
-/*#define HAS_SETLINEBUF /**/
+/*#define HAS_SETLINEBUF / **/
/* HAS_SETLOCALE:
* This symbol, if defined, indicates that the setlocale routine is
* This symbol, if defined, indicates that the setpgid(pid, gpid)
* routine is available to set process group ID.
*/
-/*#define HAS_SETPGID /**/
+/*#define HAS_SETPGID / **/
/* HAS_SETPGRP2:
* This symbol, if defined, indicates that the setpgrp2() (as in DG/UX)
* routine is available to set the current process group.
*/
-/*#define HAS_SETPGRP2 /**/
+/*#define HAS_SETPGRP2 / **/
/* HAS_SETPRIORITY:
* This symbol, if defined, indicates that the setpriority routine is
* available to set a process's priority.
*/
-/*#define HAS_SETPRIORITY /**/
+/*#define HAS_SETPRIORITY / **/
/* HAS_SETREGID:
* This symbol, if defined, indicates that the setregid routine is
* available to change the real, effective and saved gid of the current
* process.
*/
-/*#define HAS_SETREGID /**/
-/*#define HAS_SETRESGID /**/
+/*#define HAS_SETREGID / **/
+/*#define HAS_SETRESGID / **/
/* HAS_SETREUID:
* This symbol, if defined, indicates that the setreuid routine is
* available to change the real, effective and saved uid of the current
* process.
*/
-/*#define HAS_SETREUID /**/
-/*#define HAS_SETRESUID /**/
+/*#define HAS_SETREUID / **/
+/*#define HAS_SETRESUID / **/
/* HAS_SETRGID:
* This symbol, if defined, indicates that the setrgid routine is available
* to change the real gid of the current program.
*/
-/*#define HAS_SETRGID /**/
+/*#define HAS_SETRGID / **/
/* HAS_SETRUID:
* This symbol, if defined, indicates that the setruid routine is available
* to change the real uid of the current program.
*/
-/*#define HAS_SETRUID /**/
+/*#define HAS_SETRUID / **/
/* HAS_SETSID:
* This symbol, if defined, indicates that the setsid routine is
* available to set the process group ID.
*/
-/*#define HAS_SETSID /**/
+/*#define HAS_SETSID / **/
/* HAS_STRCHR:
* This symbol is defined to indicate that the strchr()/strrchr()
* functions are available for string searching.
*/
#define HAS_STRCHR /**/
-/*#define HAS_INDEX /**/
+/*#define HAS_INDEX / **/
/* HAS_STRCOLL:
* This symbol, if defined, indicates that the strcoll routine is
* This symbol, if defined, indicates that the symlink routine is available
* to create symbolic links.
*/
-/*#define HAS_SYMLINK /**/
+/*#define HAS_SYMLINK / **/
/* HAS_SYSCALL:
* This symbol, if defined, indicates that the syscall routine is
* available to call arbitrary system calls. If undefined, that's tough.
*/
-/*#define HAS_SYSCALL /**/
+/*#define HAS_SYSCALL / **/
/* HAS_SYSCONF:
* This symbol, if defined, indicates that sysconf() is available
* to determine system related limits and options.
*/
-/*#define HAS_SYSCONF /**/
+/*#define HAS_SYSCONF / **/
/* HAS_SYSTEM:
* This symbol, if defined, indicates that the system routine is
* This symbol, if defined, indicates that the tcgetpgrp routine is
* available to get foreground process group ID.
*/
-/*#define HAS_TCGETPGRP /**/
+/*#define HAS_TCGETPGRP / **/
/* HAS_TCSETPGRP:
* This symbol, if defined, indicates that the tcsetpgrp routine is
* available to set foreground process group ID.
*/
-/*#define HAS_TCSETPGRP /**/
+/*#define HAS_TCSETPGRP / **/
/* HAS_TRUNCATE:
* This symbol, if defined, indicates that the truncate routine is
* available to truncate files.
*/
-/*#define HAS_TRUNCATE /**/
+/*#define HAS_TRUNCATE / **/
/* HAS_TZNAME:
* This symbol, if defined, indicates that the tzname[] array is
* This symbol, if defined, indicates that the usleep routine is
* available to let the process sleep on a sub-second accuracy.
*/
-/*#define HAS_USLEEP /**/
+/*#define HAS_USLEEP / **/
/* HAS_WAIT4:
* This symbol, if defined, indicates that wait4() exists.
*/
-/*#define HAS_WAIT4 /**/
+/*#define HAS_WAIT4 / **/
/* HAS_WAITPID:
* This symbol, if defined, indicates that the waitpid routine is
* This symbol, if defined, indicates that <rpcsvc/dbm.h> exists and
* should be included.
*/
-/*#define I_DBM /**/
+/*#define I_DBM / **/
#define I_RPCSVC_DBM /**/
/* I_DLFCN:
* This symbol, if defined, indicates that <gdbm.h> exists and should
* be included.
*/
-/*#define I_GDBM /**/
+/*#define I_GDBM / **/
/* I_LIMITS:
* This symbol, if defined, indicates to the C program that it should
* This symbol, if defined, indicates to the C program that it should
* include <memory.h>.
*/
-/*#define I_MEMORY /**/
+/*#define I_MEMORY / **/
/* I_NETINET_IN:
* This symbol, if defined, indicates to the C program that it should
* include <netinet/in.h>. Otherwise, you may try <sys/in.h>.
*/
-/*#define I_NETINET_IN /**/
+/*#define I_NETINET_IN / **/
/* I_SFIO:
* This symbol, if defined, indicates to the C program that it should
* include <sfio.h>.
*/
-/*#define I_SFIO /**/
+/*#define I_SFIO / **/
/* I_STDDEF:
* This symbol, if defined, indicates that <stddef.h> exists and should
* This symbol, if defined, indicates to the C program that it should
* include <sys/dir.h>.
*/
-/*#define I_SYS_DIR /**/
+/*#define I_SYS_DIR / **/
/* I_SYS_FILE:
* This symbol, if defined, indicates to the C program that it should
* include <sys/file.h> to get definition of R_OK and friends.
*/
-/*#define I_SYS_FILE /**/
+/*#define I_SYS_FILE / **/
/* I_SYS_IOCTL:
* This symbol, if defined, indicates that <sys/ioctl.h> exists and should
* This symbol, if defined, indicates the <sys/sockio.h> should be included
* to get socket ioctl options, like SIOCATMARK.
*/
-/*#define I_SYS_IOCTL /**/
-/*#define I_SYS_SOCKIO /**/
+/*#define I_SYS_IOCTL / **/
+/*#define I_SYS_SOCKIO / **/
/* I_SYS_NDIR:
* This symbol, if defined, indicates to the C program that it should
* include <sys/ndir.h>.
*/
-/*#define I_SYS_NDIR /**/
+/*#define I_SYS_NDIR / **/
/* I_SYS_PARAM:
* This symbol, if defined, indicates to the C program that it should
* include <sys/param.h>.
*/
-/*#define I_SYS_PARAM /**/
+/*#define I_SYS_PARAM / **/
/* I_SYS_POLL:
* This symbol, if defined, indicates that the program may include
* <sys/poll.h>. When I_POLL is also defined, it's probably safest
* to only include <poll.h>.
*/
-/*#define I_SYS_POLL /**/
+/*#define I_SYS_POLL / **/
/* I_SYS_RESOURCE:
* This symbol, if defined, indicates to the C program that it should
* include <sys/resource.h>.
*/
-/*#define I_SYS_RESOURCE /**/
+/*#define I_SYS_RESOURCE / **/
/* I_SYS_SELECT:
* This symbol, if defined, indicates to the C program that it should
* include <sys/select.h> in order to get definition of struct timeval.
*/
-/*#define I_SYS_SELECT /**/
+/*#define I_SYS_SELECT / **/
/* I_SYS_STAT:
* This symbol, if defined, indicates to the C program that it should
* This symbol, if defined, indicates to the C program that it should
* include <sys/times.h>.
*/
-/*#define I_SYS_TIMES /**/
+/*#define I_SYS_TIMES / **/
/* I_SYS_TYPES:
* This symbol, if defined, indicates to the C program that it should
* This symbol, if defined, indicates to the C program that it should
* include <sys/un.h> to get UNIX domain socket definitions.
*/
-/*#define I_SYS_UN /**/
+/*#define I_SYS_UN / **/
/* I_SYS_WAIT:
* This symbol, if defined, indicates to the C program that it should
* include <sys/wait.h>.
*/
-/*#define I_SYS_WAIT /**/
+/*#define I_SYS_WAIT / **/
/* I_TERMIO:
* This symbol, if defined, indicates that the program should include
* <sgtty.h> rather than <termio.h>. There are also differences in
* the ioctl() calls that depend on the value of this symbol.
*/
-/*#define I_TERMIO /**/
-/*#define I_TERMIOS /**/
-/*#define I_SGTTY /**/
+/*#define I_TERMIO / **/
+/*#define I_TERMIOS / **/
+/*#define I_SGTTY / **/
/* I_UNISTD:
* This symbol, if defined, indicates to the C program that it should
* include <unistd.h>.
*/
-/*#define I_UNISTD /**/
+/*#define I_UNISTD / **/
/* I_UTIME:
* This symbol, if defined, indicates to the C program that it should
* MAXLONG, i.e. machine dependant limitations. Probably, you
* should use <limits.h> instead, if it is available.
*/
-/*#define I_VALUES /**/
+/*#define I_VALUES / **/
/* I_VFORK:
* This symbol, if defined, indicates to the C program that it should
* include vfork.h.
*/
-/*#define I_VFORK /**/
+/*#define I_VFORK / **/
+
+/* CAN_VAPROTO:
+ * This variable is defined on systems supporting prototype declaration
+ * of functions with a variable number of arguments.
+ */
+/* _V:
+ * This macro is used to declare function parameters in prototypes for
+ * functions with a variable number of parameters. Use double parentheses.
+ * For example:
+ *
+ * int printf _V((char *fmt, ...));
+ *
+ * Remember to use the plain simple _() macro when declaring a function
+ * with no variable number of arguments, since it might be possible to
+ * have a non-effect _V() macro and still get prototypes via _().
+ */
+/*#define CAN_VAPROTO / **/
+#ifdef CAN_VAPROTO
+#define _V(args) args
+#else
+#define _V(args) ()
+#endif
/* INTSIZE:
* This symbol contains the value of sizeof(int) so that the C
* example with the NeXT "fat" binaries that contain executables
* for several CPUs.
*/
-/*#define MULTIARCH /**/
+/*#define MULTIARCH / **/
/* HAS_QUAD:
* This symbol, if defined, tells that there's a 64-bit integer type,
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
#define ARCHLIB "c:\\perl\\lib" /**/
-/*#define ARCHLIB_EXP "" /**/
+/*#define ARCHLIB_EXP "" / **/
/* ARCHNAME:
* This symbol holds a string representing the architecture name.
* This symbol, if defined, indicates that the accessx routine is
* available to do extended access checks.
*/
-/*#define HAS_ACCESSX /**/
+/*#define HAS_ACCESSX / **/
/* HAS_ASCTIME_R:
* This symbol, if defined, indicates that the asctime_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_asctime_r
* is defined.
*/
-/*#define HAS_ASCTIME_R /**/
+/*#define HAS_ASCTIME_R / **/
#define ASCTIME_R_PROTO 0 /**/
/* The HASATTRIBUTE_* defines are left undefined here because they vary from
/* HASATTRIBUTE_WARN_UNUSED_RESULT:
* Can we handle GCC attribute for warning on unused results
*/
-/*#define HASATTRIBUTE_DEPRECATED /**/
-/*#define HASATTRIBUTE_FORMAT /**/
-/*#define PRINTF_FORMAT_NULL_OK /**/
-/*#define HASATTRIBUTE_NORETURN /**/
-/*#define HASATTRIBUTE_MALLOC /**/
-/*#define HASATTRIBUTE_NONNULL /**/
-/*#define HASATTRIBUTE_PURE /**/
-/*#define HASATTRIBUTE_UNUSED /**/
-/*#define HASATTRIBUTE_WARN_UNUSED_RESULT /**/
+/*#define HASATTRIBUTE_DEPRECATED / **/
+/*#define HASATTRIBUTE_FORMAT / **/
+/*#define PRINTF_FORMAT_NULL_OK / **/
+/*#define HASATTRIBUTE_NORETURN / **/
+/*#define HASATTRIBUTE_MALLOC / **/
+/*#define HASATTRIBUTE_NONNULL / **/
+/*#define HASATTRIBUTE_PURE / **/
+/*#define HASATTRIBUTE_UNUSED / **/
+/*#define HASATTRIBUTE_WARN_UNUSED_RESULT / **/
/* HASCONST:
* This symbol, if defined, indicates that this C compiler knows about
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_crypt_r
* is defined.
*/
-/*#define HAS_CRYPT_R /**/
+/*#define HAS_CRYPT_R / **/
#define CRYPT_R_PROTO 0 /**/
/* HAS_CSH:
/* CSH:
* This symbol, if defined, contains the full pathname of csh.
*/
-/*#define HAS_CSH /**/
+/*#define HAS_CSH / **/
#ifdef HAS_CSH
#define CSH "" /**/
#endif
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_ctermid_r
* is defined.
*/
-/*#define HAS_CTERMID_R /**/
+/*#define HAS_CTERMID_R / **/
#define CTERMID_R_PROTO 0 /**/
/* HAS_CTIME_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_ctime_r
* is defined.
*/
-/*#define HAS_CTIME_R /**/
+/*#define HAS_CTIME_R / **/
#define CTIME_R_PROTO 0 /**/
/* HAS_DRAND48_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_drand48_r
* is defined.
*/
-/*#define HAS_DRAND48_R /**/
+/*#define HAS_DRAND48_R / **/
#define DRAND48_R_PROTO 0 /**/
/* HAS_DRAND48_PROTO:
* to the program to supply one. A good guess is
* extern double drand48(void);
*/
-/*#define HAS_DRAND48_PROTO /**/
+/*#define HAS_DRAND48_PROTO / **/
/* HAS_EACCESS:
* This symbol, if defined, indicates that the eaccess routine is
* available to do extended access checks.
*/
-/*#define HAS_EACCESS /**/
+/*#define HAS_EACCESS / **/
/* HAS_ENDGRENT:
* This symbol, if defined, indicates that the getgrent routine is
* available for finalizing sequential access of the group database.
*/
-/*#define HAS_ENDGRENT /**/
+/*#define HAS_ENDGRENT / **/
/* HAS_ENDGRENT_R:
* This symbol, if defined, indicates that the endgrent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endgrent_r
* is defined.
*/
-/*#define HAS_ENDGRENT_R /**/
+/*#define HAS_ENDGRENT_R / **/
#define ENDGRENT_R_PROTO 0 /**/
/* HAS_ENDHOSTENT:
* This symbol, if defined, indicates that the endhostent() routine is
* available to close whatever was being used for host queries.
*/
-/*#define HAS_ENDHOSTENT /**/
+/*#define HAS_ENDHOSTENT / **/
/* HAS_ENDHOSTENT_R:
* This symbol, if defined, indicates that the endhostent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endhostent_r
* is defined.
*/
-/*#define HAS_ENDHOSTENT_R /**/
+/*#define HAS_ENDHOSTENT_R / **/
#define ENDHOSTENT_R_PROTO 0 /**/
/* HAS_ENDNETENT:
* This symbol, if defined, indicates that the endnetent() routine is
* available to close whatever was being used for network queries.
*/
-/*#define HAS_ENDNETENT /**/
+/*#define HAS_ENDNETENT / **/
/* HAS_ENDNETENT_R:
* This symbol, if defined, indicates that the endnetent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endnetent_r
* is defined.
*/
-/*#define HAS_ENDNETENT_R /**/
+/*#define HAS_ENDNETENT_R / **/
#define ENDNETENT_R_PROTO 0 /**/
/* HAS_ENDPROTOENT:
* This symbol, if defined, indicates that the endprotoent() routine is
* available to close whatever was being used for protocol queries.
*/
-/*#define HAS_ENDPROTOENT /**/
+/*#define HAS_ENDPROTOENT / **/
/* HAS_ENDPROTOENT_R:
* This symbol, if defined, indicates that the endprotoent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endprotoent_r
* is defined.
*/
-/*#define HAS_ENDPROTOENT_R /**/
+/*#define HAS_ENDPROTOENT_R / **/
#define ENDPROTOENT_R_PROTO 0 /**/
/* HAS_ENDPWENT:
* This symbol, if defined, indicates that the getgrent routine is
* available for finalizing sequential access of the passwd database.
*/
-/*#define HAS_ENDPWENT /**/
+/*#define HAS_ENDPWENT / **/
/* HAS_ENDPWENT_R:
* This symbol, if defined, indicates that the endpwent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endpwent_r
* is defined.
*/
-/*#define HAS_ENDPWENT_R /**/
+/*#define HAS_ENDPWENT_R / **/
#define ENDPWENT_R_PROTO 0 /**/
/* HAS_ENDSERVENT:
* This symbol, if defined, indicates that the endservent() routine is
* available to close whatever was being used for service queries.
*/
-/*#define HAS_ENDSERVENT /**/
+/*#define HAS_ENDSERVENT / **/
/* HAS_ENDSERVENT_R:
* This symbol, if defined, indicates that the endservent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endservent_r
* is defined.
*/
-/*#define HAS_ENDSERVENT_R /**/
+/*#define HAS_ENDSERVENT_R / **/
#define ENDSERVENT_R_PROTO 0 /**/
/* FLEXFILENAMES:
* This symbol, if defined, indicates that the getgrent routine is
* available for sequential access of the group database.
*/
-/*#define HAS_GETGRENT /**/
+/*#define HAS_GETGRENT / **/
/* HAS_GETGRENT_R:
* This symbol, if defined, indicates that the getgrent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrent_r
* is defined.
*/
-/*#define HAS_GETGRENT_R /**/
+/*#define HAS_GETGRENT_R / **/
#define GETGRENT_R_PROTO 0 /**/
/* HAS_GETGRGID_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrgid_r
* is defined.
*/
-/*#define HAS_GETGRGID_R /**/
+/*#define HAS_GETGRGID_R / **/
#define GETGRGID_R_PROTO 0 /**/
/* HAS_GETGRNAM_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrnam_r
* is defined.
*/
-/*#define HAS_GETGRNAM_R /**/
+/*#define HAS_GETGRNAM_R / **/
#define GETGRNAM_R_PROTO 0 /**/
/* HAS_GETHOSTBYADDR:
* This symbol, if defined, indicates that the gethostent() routine is
* available to look up host names in some data base or another.
*/
-/*#define HAS_GETHOSTENT /**/
+/*#define HAS_GETHOSTENT / **/
/* HAS_GETHOSTNAME:
* This symbol, if defined, indicates that the C program may use the
*/
#define HAS_GETHOSTNAME /**/
#define HAS_UNAME /**/
-/*#define HAS_PHOSTNAME /**/
+/*#define HAS_PHOSTNAME / **/
#ifdef HAS_PHOSTNAME
#define PHOSTNAME "" /* How to get the host name */
#endif
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostbyaddr_r
* is defined.
*/
-/*#define HAS_GETHOSTBYADDR_R /**/
+/*#define HAS_GETHOSTBYADDR_R / **/
#define GETHOSTBYADDR_R_PROTO 0 /**/
/* HAS_GETHOSTBYNAME_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostbyname_r
* is defined.
*/
-/*#define HAS_GETHOSTBYNAME_R /**/
+/*#define HAS_GETHOSTBYNAME_R / **/
#define GETHOSTBYNAME_R_PROTO 0 /**/
/* HAS_GETHOSTENT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostent_r
* is defined.
*/
-/*#define HAS_GETHOSTENT_R /**/
+/*#define HAS_GETHOSTENT_R / **/
#define GETHOSTENT_R_PROTO 0 /**/
/* HAS_GETHOST_PROTOS:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getlogin_r
* is defined.
*/
-/*#define HAS_GETLOGIN_R /**/
+/*#define HAS_GETLOGIN_R / **/
#define GETLOGIN_R_PROTO 0 /**/
/* HAS_GETNETBYADDR:
* This symbol, if defined, indicates that the getnetbyaddr() routine is
* available to look up networks by their IP addresses.
*/
-/*#define HAS_GETNETBYADDR /**/
+/*#define HAS_GETNETBYADDR / **/
/* HAS_GETNETBYNAME:
* This symbol, if defined, indicates that the getnetbyname() routine is
* available to look up networks by their names.
*/
-/*#define HAS_GETNETBYNAME /**/
+/*#define HAS_GETNETBYNAME / **/
/* HAS_GETNETENT:
* This symbol, if defined, indicates that the getnetent() routine is
* available to look up network names in some data base or another.
*/
-/*#define HAS_GETNETENT /**/
+/*#define HAS_GETNETENT / **/
/* HAS_GETNETBYADDR_R:
* This symbol, if defined, indicates that the getnetbyaddr_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetbyaddr_r
* is defined.
*/
-/*#define HAS_GETNETBYADDR_R /**/
+/*#define HAS_GETNETBYADDR_R / **/
#define GETNETBYADDR_R_PROTO 0 /**/
/* HAS_GETNETBYNAME_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetbyname_r
* is defined.
*/
-/*#define HAS_GETNETBYNAME_R /**/
+/*#define HAS_GETNETBYNAME_R / **/
#define GETNETBYNAME_R_PROTO 0 /**/
/* HAS_GETNETENT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetent_r
* is defined.
*/
-/*#define HAS_GETNETENT_R /**/
+/*#define HAS_GETNETENT_R / **/
#define GETNETENT_R_PROTO 0 /**/
/* HAS_GETNET_PROTOS:
* getnetbyaddr(). Otherwise, it is up to the program to guess
* them. See netdbtype.U for probing for various Netdb_xxx_t types.
*/
-/*#define HAS_GETNET_PROTOS /**/
+/*#define HAS_GETNET_PROTOS / **/
/* HAS_GETPROTOENT:
* This symbol, if defined, indicates that the getprotoent() routine is
* available to look up protocols in some data base or another.
*/
-/*#define HAS_GETPROTOENT /**/
+/*#define HAS_GETPROTOENT / **/
/* HAS_GETPGRP:
* This symbol, if defined, indicates that the getpgrp routine is
* This symbol, if defined, indicates that getpgrp needs one
* arguments whereas USG one needs none.
*/
-/*#define HAS_GETPGRP /**/
-/*#define USE_BSD_GETPGRP /**/
+/*#define HAS_GETPGRP / **/
+/*#define USE_BSD_GETPGRP / **/
/* HAS_GETPROTOBYNAME:
* This symbol, if defined, indicates that the getprotobyname()
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotobyname_r
* is defined.
*/
-/*#define HAS_GETPROTOBYNAME_R /**/
+/*#define HAS_GETPROTOBYNAME_R / **/
#define GETPROTOBYNAME_R_PROTO 0 /**/
/* HAS_GETPROTOBYNUMBER_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotobynumber_r
* is defined.
*/
-/*#define HAS_GETPROTOBYNUMBER_R /**/
+/*#define HAS_GETPROTOBYNUMBER_R / **/
#define GETPROTOBYNUMBER_R_PROTO 0 /**/
/* HAS_GETPROTOENT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotoent_r
* is defined.
*/
-/*#define HAS_GETPROTOENT_R /**/
+/*#define HAS_GETPROTOENT_R / **/
#define GETPROTOENT_R_PROTO 0 /**/
/* HAS_GETPROTO_PROTOS:
* available for sequential access of the passwd database.
* If this is not available, the older getpw() function may be available.
*/
-/*#define HAS_GETPWENT /**/
+/*#define HAS_GETPWENT / **/
/* HAS_GETPWENT_R:
* This symbol, if defined, indicates that the getpwent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwent_r
* is defined.
*/
-/*#define HAS_GETPWENT_R /**/
+/*#define HAS_GETPWENT_R / **/
#define GETPWENT_R_PROTO 0 /**/
/* HAS_GETPWNAM_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwnam_r
* is defined.
*/
-/*#define HAS_GETPWNAM_R /**/
+/*#define HAS_GETPWNAM_R / **/
#define GETPWNAM_R_PROTO 0 /**/
/* HAS_GETPWUID_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwuid_r
* is defined.
*/
-/*#define HAS_GETPWUID_R /**/
+/*#define HAS_GETPWUID_R / **/
#define GETPWUID_R_PROTO 0 /**/
/* HAS_GETSERVENT:
* This symbol, if defined, indicates that the getservent() routine is
* available to look up network services in some data base or another.
*/
-/*#define HAS_GETSERVENT /**/
+/*#define HAS_GETSERVENT / **/
/* HAS_GETSERVBYNAME_R:
* This symbol, if defined, indicates that the getservbyname_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservbyname_r
* is defined.
*/
-/*#define HAS_GETSERVBYNAME_R /**/
+/*#define HAS_GETSERVBYNAME_R / **/
#define GETSERVBYNAME_R_PROTO 0 /**/
/* HAS_GETSERVBYPORT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservbyport_r
* is defined.
*/
-/*#define HAS_GETSERVBYPORT_R /**/
+/*#define HAS_GETSERVBYPORT_R / **/
#define GETSERVBYPORT_R_PROTO 0 /**/
/* HAS_GETSERVENT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservent_r
* is defined.
*/
-/*#define HAS_GETSERVENT_R /**/
+/*#define HAS_GETSERVENT_R / **/
#define GETSERVENT_R_PROTO 0 /**/
/* HAS_GETSERV_PROTOS:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getspnam_r
* is defined.
*/
-/*#define HAS_GETSPNAM_R /**/
+/*#define HAS_GETSPNAM_R / **/
#define GETSPNAM_R_PROTO 0 /**/
/* HAS_GETSERVBYNAME:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_gmtime_r
* is defined.
*/
-/*#define HAS_GMTIME_R /**/
+/*#define HAS_GMTIME_R / **/
#define GMTIME_R_PROTO 0 /**/
/* HAS_HTONL:
* changes using \undef{TZ} without explicitly calling tzset
* impossible. This symbol makes us call tzset before localtime_r
*/
-/*#define LOCALTIME_R_NEEDS_TZSET /**/
+/*#define LOCALTIME_R_NEEDS_TZSET / **/
#ifdef LOCALTIME_R_NEEDS_TZSET
#define L_R_TZSET tzset(),
#else
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_localtime_r
* is defined.
*/
-/*#define HAS_LOCALTIME_R /**/
+/*#define HAS_LOCALTIME_R / **/
#define LOCALTIME_R_PROTO 0 /**/
/* HAS_LONG_DOUBLE:
* C preprocessor can make decisions based on it. It is only
* defined if the system supports long long.
*/
-/*#define HAS_LONG_LONG /**/
+/*#define HAS_LONG_LONG / **/
#ifdef HAS_LONG_LONG
#define LONGLONGSIZE 8 /**/
#endif
* available to exclusively create and open a uniquely named
* temporary file.
*/
-/*#define HAS_MKSTEMP /**/
+/*#define HAS_MKSTEMP / **/
/* HAS_MMAP:
* This symbol, if defined, indicates that the mmap system call is
* (and simultaneously the type of the first argument).
* Usually set to 'void *' or 'caddr_t'.
*/
-/*#define HAS_MMAP /**/
+/*#define HAS_MMAP / **/
#define Mmap_t void * /**/
/* HAS_MSG:
* This symbol, if defined, indicates that the entire msg*(2) library is
* supported (IPC mechanism based on message queues).
*/
-/*#define HAS_MSG /**/
+/*#define HAS_MSG / **/
/* OLD_PTHREAD_CREATE_JOINABLE:
* This symbol, if defined, indicates how to create pthread
* If defined, known values are PTHREAD_CREATE_UNDETACHED
* and __UNDETACHED.
*/
-/*#define OLD_PTHREAD_CREATE_JOINABLE /**/
+/*#define OLD_PTHREAD_CREATE_JOINABLE / **/
/* HAS_PTHREAD_ATFORK:
* This symbol, if defined, indicates that the pthread_atfork routine
* is available to setup fork handlers.
*/
-/*#define HAS_PTHREAD_ATFORK /**/
+/*#define HAS_PTHREAD_ATFORK / **/
/* HAS_PTHREAD_YIELD:
* This symbol, if defined, indicates that the pthread_yield
* routine is available to yield the execution of the current
* thread. sched_yield is preferable to pthread_yield.
*/
-/*#define HAS_PTHREAD_YIELD /**/
+/*#define HAS_PTHREAD_YIELD / **/
#define SCHED_YIELD /**/
-/*#define HAS_SCHED_YIELD /**/
+/*#define HAS_SCHED_YIELD / **/
/* HAS_RANDOM_R:
* This symbol, if defined, indicates that the random_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_random_r
* is defined.
*/
-/*#define HAS_RANDOM_R /**/
+/*#define HAS_RANDOM_R / **/
#define RANDOM_R_PROTO 0 /**/
/* HAS_READDIR64_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_readdir64_r
* is defined.
*/
-/*#define HAS_READDIR64_R /**/
+/*#define HAS_READDIR64_R / **/
#define READDIR64_R_PROTO 0 /**/
/* HAS_READDIR_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_readdir_r
* is defined.
*/
-/*#define HAS_READDIR_R /**/
+/*#define HAS_READDIR_R / **/
#define READDIR_R_PROTO 0 /**/
/* HAS_SEM:
* This symbol, if defined, indicates that the entire sem*(2) library is
* supported.
*/
-/*#define HAS_SEM /**/
+/*#define HAS_SEM / **/
/* HAS_SETGRENT:
* This symbol, if defined, indicates that the setgrent routine is
* available for initializing sequential access of the group database.
*/
-/*#define HAS_SETGRENT /**/
+/*#define HAS_SETGRENT / **/
/* HAS_SETGRENT_R:
* This symbol, if defined, indicates that the setgrent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setgrent_r
* is defined.
*/
-/*#define HAS_SETGRENT_R /**/
+/*#define HAS_SETGRENT_R / **/
#define SETGRENT_R_PROTO 0 /**/
/* HAS_SETHOSTENT:
* This symbol, if defined, indicates that the sethostent() routine is
* available.
*/
-/*#define HAS_SETHOSTENT /**/
+/*#define HAS_SETHOSTENT / **/
/* HAS_SETHOSTENT_R:
* This symbol, if defined, indicates that the sethostent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_sethostent_r
* is defined.
*/
-/*#define HAS_SETHOSTENT_R /**/
+/*#define HAS_SETHOSTENT_R / **/
#define SETHOSTENT_R_PROTO 0 /**/
/* HAS_SETLOCALE_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setlocale_r
* is defined.
*/
-/*#define HAS_SETLOCALE_R /**/
+/*#define HAS_SETLOCALE_R / **/
#define SETLOCALE_R_PROTO 0 /**/
/* HAS_SETNETENT:
* This symbol, if defined, indicates that the setnetent() routine is
* available.
*/
-/*#define HAS_SETNETENT /**/
+/*#define HAS_SETNETENT / **/
/* HAS_SETNETENT_R:
* This symbol, if defined, indicates that the setnetent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setnetent_r
* is defined.
*/
-/*#define HAS_SETNETENT_R /**/
+/*#define HAS_SETNETENT_R / **/
#define SETNETENT_R_PROTO 0 /**/
/* HAS_SETPROTOENT:
* This symbol, if defined, indicates that the setprotoent() routine is
* available.
*/
-/*#define HAS_SETPROTOENT /**/
+/*#define HAS_SETPROTOENT / **/
/* HAS_SETPGRP:
* This symbol, if defined, indicates that the setpgrp routine is
* arguments whereas USG one needs none. See also HAS_SETPGID
* for a POSIX interface.
*/
-/*#define HAS_SETPGRP /**/
-/*#define USE_BSD_SETPGRP /**/
+/*#define HAS_SETPGRP / **/
+/*#define USE_BSD_SETPGRP / **/
/* HAS_SETPROTOENT_R:
* This symbol, if defined, indicates that the setprotoent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setprotoent_r
* is defined.
*/
-/*#define HAS_SETPROTOENT_R /**/
+/*#define HAS_SETPROTOENT_R / **/
#define SETPROTOENT_R_PROTO 0 /**/
/* HAS_SETPWENT:
* This symbol, if defined, indicates that the setpwent routine is
* available for initializing sequential access of the passwd database.
*/
-/*#define HAS_SETPWENT /**/
+/*#define HAS_SETPWENT / **/
/* HAS_SETPWENT_R:
* This symbol, if defined, indicates that the setpwent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setpwent_r
* is defined.
*/
-/*#define HAS_SETPWENT_R /**/
+/*#define HAS_SETPWENT_R / **/
#define SETPWENT_R_PROTO 0 /**/
/* HAS_SETSERVENT:
* This symbol, if defined, indicates that the setservent() routine is
* available.
*/
-/*#define HAS_SETSERVENT /**/
+/*#define HAS_SETSERVENT / **/
/* HAS_SETSERVENT_R:
* This symbol, if defined, indicates that the setservent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setservent_r
* is defined.
*/
-/*#define HAS_SETSERVENT_R /**/
+/*#define HAS_SETSERVENT_R / **/
#define SETSERVENT_R_PROTO 0 /**/
/* HAS_SETVBUF:
* This symbol, if defined, indicates that the entire shm*(2) library is
* supported.
*/
-/*#define HAS_SHM /**/
+/*#define HAS_SHM / **/
/* Shmat_t:
* This symbol holds the return type of the shmat() system call.
* when HAS_SHMAT_PROTOTYPE is not defined to avoid conflicting defs.
*/
#define Shmat_t void * /**/
-/*#define HAS_SHMAT_PROTOTYPE /**/
+/*#define HAS_SHMAT_PROTOTYPE / **/
/* HAS_SOCKET:
* This symbol, if defined, indicates that the BSD socket interface is
* has been known to be an enum.
*/
#define HAS_SOCKET /**/
-/*#define HAS_SOCKETPAIR /**/
-/*#define HAS_MSG_CTRUNC /**/
-/*#define HAS_MSG_DONTROUTE /**/
-/*#define HAS_MSG_OOB /**/
-/*#define HAS_MSG_PEEK /**/
-/*#define HAS_MSG_PROXY /**/
-/*#define HAS_SCM_RIGHTS /**/
+/*#define HAS_SOCKETPAIR / **/
+/*#define HAS_MSG_CTRUNC / **/
+/*#define HAS_MSG_DONTROUTE / **/
+/*#define HAS_MSG_OOB / **/
+/*#define HAS_MSG_PEEK / **/
+/*#define HAS_MSG_PROXY / **/
+/*#define HAS_SCM_RIGHTS / **/
/* HAS_SRAND48_R:
* This symbol, if defined, indicates that the srand48_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_srand48_r
* is defined.
*/
-/*#define HAS_SRAND48_R /**/
+/*#define HAS_SRAND48_R / **/
#define SRAND48_R_PROTO 0 /**/
/* HAS_SRANDOM_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_srandom_r
* is defined.
*/
-/*#define HAS_SRANDOM_R /**/
+/*#define HAS_SRANDOM_R / **/
#define SRANDOM_R_PROTO 0 /**/
/* USE_STAT_BLOCKS:
* st_blksize and st_blocks.
*/
#ifndef USE_STAT_BLOCKS
-/*#define USE_STAT_BLOCKS /**/
+/*#define USE_STAT_BLOCKS / **/
#endif
/* USE_STRUCT_COPY:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_strerror_r
* is defined.
*/
-/*#define HAS_STRERROR_R /**/
+/*#define HAS_STRERROR_R / **/
#define STRERROR_R_PROTO 0 /**/
/* HAS_STRTOUL:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_tmpnam_r
* is defined.
*/
-/*#define HAS_TMPNAM_R /**/
+/*#define HAS_TMPNAM_R / **/
#define TMPNAM_R_PROTO 0 /**/
/* HAS_TTYNAME_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_ttyname_r
* is defined.
*/
-/*#define HAS_TTYNAME_R /**/
+/*#define HAS_TTYNAME_R / **/
#define TTYNAME_R_PROTO 0 /**/
/* HAS_UNION_SEMUN:
* used for semctl IPC_STAT.
*/
#define HAS_UNION_SEMUN /**/
-/*#define USE_SEMCTL_SEMUN /**/
-/*#define USE_SEMCTL_SEMID_DS /**/
+/*#define USE_SEMCTL_SEMUN / **/
+/*#define USE_SEMCTL_SEMID_DS / **/
/* HAS_VFORK:
* This symbol, if defined, indicates that vfork() exists.
*/
-/*#define HAS_VFORK /**/
+/*#define HAS_VFORK / **/
/* HAS_PSEUDOFORK:
* This symbol, if defined, indicates that an emulation of the
* fork routine is available.
*/
-/*#define HAS_PSEUDOFORK /**/
+/*#define HAS_PSEUDOFORK / **/
/* Signal_t:
* This symbol's value is either "void" or "int", corresponding to the
* This symbol, if defined, indicates to the C program that struct group
* in <grp.h> contains gr_passwd.
*/
-/*#define I_GRP /**/
-/*#define GRPASSWD /**/
+/*#define I_GRP / **/
+/*#define GRPASSWD / **/
/* I_MACH_CTHREADS:
* This symbol, if defined, indicates to the C program that it should
* include <mach/cthreads.h>.
*/
-/*#define I_MACH_CTHREADS /**/
+/*#define I_MACH_CTHREADS / **/
/* I_NDBM:
* This symbol, if defined, indicates that <ndbm.h> exists and should
* parameter information. While ANSI C prototypes are supported in C++,
* K&R style function declarations will yield errors.
*/
-/*#define I_NDBM /**/
-/*#define I_GDBMNDBM /**/
-/*#define I_GDBM_NDBM /**/
-/*#define NDBM_H_USES_PROTOTYPES /**/
-/*#define GDBMNDBM_H_USES_PROTOTYPES /**/
-/*#define GDBM_NDBM_H_USES_PROTOTYPES /**/
+/*#define I_NDBM / **/
+/*#define I_GDBMNDBM / **/
+/*#define I_GDBM_NDBM / **/
+/*#define NDBM_H_USES_PROTOTYPES / **/
+/*#define GDBMNDBM_H_USES_PROTOTYPES / **/
+/*#define GDBM_NDBM_H_USES_PROTOTYPES / **/
/* I_NETDB:
* This symbol, if defined, indicates that <netdb.h> exists and
* should be included.
*/
-/*#define I_NETDB /**/
+/*#define I_NETDB / **/
/* I_NET_ERRNO:
* This symbol, if defined, indicates that <net/errno.h> exists and
* should be included.
*/
-/*#define I_NET_ERRNO /**/
+/*#define I_NET_ERRNO / **/
/* I_PTHREAD:
* This symbol, if defined, indicates to the C program that it should
* include <pthread.h>.
*/
-/*#define I_PTHREAD /**/
+/*#define I_PTHREAD / **/
/* I_PWD:
* This symbol, if defined, indicates to the C program that it should
* This symbol, if defined, indicates to the C program that struct passwd
* contains pw_passwd.
*/
-/*#define I_PWD /**/
-/*#define PWQUOTA /**/
-/*#define PWAGE /**/
-/*#define PWCHANGE /**/
-/*#define PWCLASS /**/
-/*#define PWEXPIRE /**/
-/*#define PWCOMMENT /**/
-/*#define PWGECOS /**/
-/*#define PWPASSWD /**/
+/*#define I_PWD / **/
+/*#define PWQUOTA / **/
+/*#define PWAGE / **/
+/*#define PWCHANGE / **/
+/*#define PWCLASS / **/
+/*#define PWEXPIRE / **/
+/*#define PWCOMMENT / **/
+/*#define PWGECOS / **/
+/*#define PWPASSWD / **/
/* I_SYS_ACCESS:
* This symbol, if defined, indicates to the C program that it should
* include <sys/access.h>.
*/
-/*#define I_SYS_ACCESS /**/
+/*#define I_SYS_ACCESS / **/
/* I_SYS_SECURITY:
* This symbol, if defined, indicates to the C program that it should
* include <sys/security.h>.
*/
-/*#define I_SYS_SECURITY /**/
+/*#define I_SYS_SECURITY / **/
/* I_SYSUIO:
* This symbol, if defined, indicates that <sys/uio.h> exists and
* should be included.
*/
-/*#define I_SYSUIO /**/
+/*#define I_SYSUIO / **/
/* I_STDARG:
* This symbol, if defined, indicates that <stdarg.h> exists and should
* include <varargs.h>.
*/
#define I_STDARG /**/
-/*#define I_VARARGS /**/
+/*#define I_VARARGS / **/
/* PERL_INC_VERSION_LIST:
* This variable specifies the list of subdirectories in over
* for a C initialization string. See the inc_version_list entry
* in Porting/Glossary for more details.
*/
-/*#define PERL_INC_VERSION_LIST 0 /**/
+/*#define PERL_INC_VERSION_LIST 0 / **/
/* INSTALL_USR_BIN_PERL:
* This symbol, if defined, indicates that Perl is to be installed
* also as /usr/bin/perl.
*/
-/*#define INSTALL_USR_BIN_PERL /**/
+/*#define INSTALL_USR_BIN_PERL / **/
/* Off_t:
* This symbol holds the type used to declare offsets in the kernel.
/* MYMALLOC:
* This symbol, if defined, indicates that we're using our own malloc.
*/
-/*#define MYMALLOC /**/
+/*#define MYMALLOC / **/
/* Mode_t:
* This symbol holds the type used to declare file modes
* and architecture-specific directories. See PERL_INC_VERSION_LIST
* for more details.
*/
-/*#define PERL_OTHERLIBDIRS "" /**/
+/*#define PERL_OTHERLIBDIRS "" / **/
/* Pid_t:
* This symbol holds the type used to declare process ids in the kernel.
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
#define SITEARCH "c:\\perl\\site\\lib" /**/
-/*#define SITEARCH_EXP "" /**/
+/*#define SITEARCH_EXP "" / **/
/* SITELIB:
* This symbol contains the name of the private library for this package.
* try to use the various _r versions of library functions.
* This is extremely experimental.
*/
-/*#define USE_5005THREADS /**/
-/*#define USE_ITHREADS /**/
+/*#define USE_5005THREADS / **/
+/*#define USE_ITHREADS / **/
#if defined(USE_5005THREADS) && !defined(USE_ITHREADS)
#define USE_THREADS /* until src is revised*/
#endif
-/*#define OLD_PTHREADS_API /**/
-/*#define USE_REENTRANT_API /**/
+/*#define OLD_PTHREADS_API / **/
+/*#define USE_REENTRANT_API / **/
/* PERL_VENDORARCH:
* If defined, this symbol contains the name of a private library.
* This symbol contains the ~name expanded version of PERL_VENDORARCH, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-/*#define PERL_VENDORARCH "" /**/
-/*#define PERL_VENDORARCH_EXP "" /**/
+/*#define PERL_VENDORARCH "" / **/
+/*#define PERL_VENDORARCH_EXP "" / **/
/* PERL_VENDORLIB_EXP:
* This symbol contains the ~name expanded version of VENDORLIB, to be used
* removed. The elements in inc_version_list (inc_version_list.U) can
* be tacked onto this variable to generate a list of directories to search.
*/
-/*#define PERL_VENDORLIB_EXP "" /**/
-/*#define PERL_VENDORLIB_STEM "" /**/
+/*#define PERL_VENDORLIB_EXP "" / **/
+/*#define PERL_VENDORLIB_STEM "" / **/
/* VOIDFLAGS:
* This symbol indicates how much support of the void type is given by this
* Perl has been cross-compiled to. Undefined if not a cross-compile.
*/
#ifndef USE_CROSS_COMPILE
-/*#define USE_CROSS_COMPILE /**/
+/*#define USE_CROSS_COMPILE / **/
#define PERL_TARGETARCH "" /**/
#endif
#define BYTEORDER 0x1234 /* large digits for MSB */
#endif /* NeXT */
+/* CHARBITS:
+ * This symbol contains the size of a char, so that the C preprocessor
+ * can make decisions based on it.
+ */
+#define CHARBITS 8 /**/
+
/* CASTI32:
* This symbol is defined if the C compiler can cast negative
* or large floating point numbers to 32-bit ints.
* This symbol, if defined, indicates that the closedir() routine
* does not return a value.
*/
-/*#define VOID_CLOSEDIR /**/
+/*#define VOID_CLOSEDIR / **/
/* HAS_FD_SET:
* This symbol, when defined, indicates presence of the fd_set typedef
* is available to get system page size, which is the granularity of
* many memory management calls.
*/
-/*#define HAS_GETPAGESIZE /**/
+/*#define HAS_GETPAGESIZE / **/
/* HAS_GNULIBC:
* This symbol, if defined, indicates to the C program that
* the GNU C library is being used. A better check is to use
* the __GLIBC__ and __GLIBC_MINOR__ symbols supplied with glibc.
*/
-/*#define HAS_GNULIBC /**/
+/*#define HAS_GNULIBC / **/
#if defined(HAS_GNULIBC) && !defined(_GNU_SOURCE)
# define _GNU_SOURCE
#endif
* available to operate on a symbolic link (instead of following the
* link).
*/
-/*#define HAS_LCHOWN /**/
+/*#define HAS_LCHOWN / **/
/* HAS_OPEN3:
* This manifest constant lets the C program know that the three
* argument form of open(2) is available.
*/
-/*#define HAS_OPEN3 /**/
+/*#define HAS_OPEN3 / **/
/* HAS_SAFE_BCOPY:
* This symbol, if defined, indicates that the bcopy routine is available
* probably use memmove() or memcpy(). If neither is defined, roll your
* own version.
*/
-/*#define HAS_SAFE_BCOPY /**/
+/*#define HAS_SAFE_BCOPY / **/
/* HAS_SAFE_MEMCPY:
* This symbol, if defined, indicates that the memcpy routine is available
* copy overlapping memory blocks, you should check HAS_MEMMOVE and
* use memmove() instead, if available.
*/
-/*#define HAS_SAFE_MEMCPY /**/
+/*#define HAS_SAFE_MEMCPY / **/
/* HAS_SANE_MEMCMP:
* This symbol, if defined, indicates that the memcmp routine is available
* This symbol, if defined, indicates that Vr4's sigaction() routine
* is available.
*/
-/*#define HAS_SIGACTION /**/
+/*#define HAS_SIGACTION / **/
/* HAS_SIGSETJMP:
* This variable indicates to the C program that the sigsetjmp()
* traditional longjmp() if siglongjmp isn't available.
* See HAS_SIGSETJMP.
*/
-/*#define HAS_SIGSETJMP /**/
+/*#define HAS_SIGSETJMP / **/
#ifdef HAS_SIGSETJMP
#define Sigjmp_buf sigjmp_buf
#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask))
#define STDIO_PTR_LVALUE /**/
#define FILE_cnt(fp) ((fp)->_cnt)
#define STDIO_CNT_LVALUE /**/
-/*#define STDIO_PTR_LVAL_SETS_CNT /**/
+/*#define STDIO_PTR_LVAL_SETS_CNT / **/
#define STDIO_PTR_LVAL_NOCHANGE_CNT /**/
#endif
* symbol.
*/
#define HAS_VPRINTF /**/
-/*#define USE_CHAR_VSPRINTF /**/
+/*#define USE_CHAR_VSPRINTF / **/
/* DOUBLESIZE:
* This symbol contains the size of a double, so that the C preprocessor
* the struct tm has a tm_gmtoff field.
*/
#define I_TIME /**/
-/*#define I_SYS_TIME /**/
-/*#define I_SYS_TIME_KERNEL /**/
-/*#define HAS_TM_TM_ZONE /**/
-/*#define HAS_TM_TM_GMTOFF /**/
+/*#define I_SYS_TIME / **/
+/*#define I_SYS_TIME_KERNEL / **/
+/*#define HAS_TM_TM_ZONE / **/
+/*#define HAS_TM_TM_GMTOFF / **/
/* VAL_O_NONBLOCK:
* This symbol is to be used during open() or fcntl(F_SETFL) to turn on
* This symbol, if defined, indicates that this system uses
* EBCDIC encoding.
*/
-/*#define EBCDIC /**/
+/*#define EBCDIC / **/
+
+/* SETUID_SCRIPTS_ARE_SECURE_NOW:
+ * This symbol, if defined, indicates that the bug that prevents
+ * setuid scripts from being secure is not present in this kernel.
+ */
+/* DOSUID:
+ * This symbol, if defined, indicates that the C program should
+ * check the script that it is executing for setuid/setgid bits, and
+ * attempt to emulate setuid/setgid on systems that have disabled
+ * setuid #! scripts because the kernel can't do it securely.
+ * It is up to the package designer to make sure that this emulation
+ * is done securely. Among other things, it should do an fstat on
+ * the script it just opened to make sure it really is a setuid/setgid
+ * script, it should make sure the arguments passed correspond exactly
+ * to the argument on the #! line, and it should not trust any
+ * subprocesses to which it must pass the filename rather than the
+ * file descriptor of the script to be executed.
+ */
+/*#define SETUID_SCRIPTS_ARE_SECURE_NOW / **/
+/*#define DOSUID / **/
/* PERL_USE_DEVEL:
* This symbol, if defined, indicates that Perl was configured with
* -Dusedevel, to enable development features. This should not be
* done for production builds.
*/
-/*#define PERL_USE_DEVEL /**/
+/*#define PERL_USE_DEVEL / **/
/* HAS_ATOLF:
* This symbol, if defined, indicates that the atolf routine is
* available to convert strings into long doubles.
*/
-/*#define HAS_ATOLF /**/
+/*#define HAS_ATOLF / **/
/* HAS_ATOLL:
* This symbol, if defined, indicates that the atoll routine is
* available to convert strings into long longs.
*/
-/*#define HAS_ATOLL /**/
+/*#define HAS_ATOLL / **/
/* HAS__FWALK:
* This symbol, if defined, indicates that the _fwalk system call is
* available to apply a function to all the file handles.
*/
-/*#define HAS__FWALK /**/
+/*#define HAS__FWALK / **/
/* HAS_AINTL:
* This symbol, if defined, indicates that the aintl routine is
* available. If copysignl is also present we can emulate modfl.
*/
-/*#define HAS_AINTL /**/
+/*#define HAS_AINTL / **/
/* HAS_BUILTIN_CHOOSE_EXPR:
* Can we handle GCC builtin for compile-time ternary-like expressions
* Can we handle GCC builtin for telling that certain values are more
* likely
*/
-/*#define HAS_BUILTIN_EXPECT /**/
-/*#define HAS_BUILTIN_CHOOSE_EXPR /**/
+/*#define HAS_BUILTIN_EXPECT / **/
+/*#define HAS_BUILTIN_CHOOSE_EXPR / **/
/* HAS_C99_VARIADIC_MACROS:
* If defined, the compiler supports C99 variadic macros.
*/
-/*#define HAS_C99_VARIADIC_MACROS /**/
+/*#define HAS_C99_VARIADIC_MACROS / **/
/* HAS_CLASS:
* This symbol, if defined, indicates that the class routine is
* FP_NANS Signaling Not a Number (NaNS)
* FP_NANQ Quiet Not a Number (NaNQ)
*/
-/*#define HAS_CLASS /**/
+/*#define HAS_CLASS / **/
/* HAS_CLEARENV:
* This symbol, if defined, indicates that the clearenv () routine is
* available for use.
*/
-/*#define HAS_CLEARENV /**/
+/*#define HAS_CLEARENV / **/
/* HAS_STRUCT_CMSGHDR:
* This symbol, if defined, indicates that the struct cmsghdr
* is supported.
*/
-/*#define HAS_STRUCT_CMSGHDR /**/
+/*#define HAS_STRUCT_CMSGHDR / **/
/* HAS_COPYSIGNL:
* This symbol, if defined, indicates that the copysignl routine is
* available. If aintl is also present we can emulate modfl.
*/
-/*#define HAS_COPYSIGNL /**/
+/*#define HAS_COPYSIGNL / **/
/* USE_CPLUSPLUS:
* This symbol, if defined, indicates that a C++ compiler was
* used to compiled Perl and will be used to compile extensions.
*/
-/*#define USE_CPLUSPLUS /**/
+/*#define USE_CPLUSPLUS / **/
/* HAS_DBMINIT_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. A good guess is
* extern int dbminit(char *);
*/
-/*#define HAS_DBMINIT_PROTO /**/
+/*#define HAS_DBMINIT_PROTO / **/
/* HAS_DIR_DD_FD:
* This symbol, if defined, indicates that the the DIR* dirstream
* structure contains a member variable named dd_fd.
*/
-/*#define HAS_DIR_DD_FD /**/
+/*#define HAS_DIR_DD_FD / **/
/* HAS_DIRFD:
* This manifest constant lets the C program know that dirfd
* is available.
*/
-/*#define HAS_DIRFD /**/
+/*#define HAS_DIRFD / **/
/* DLSYM_NEEDS_UNDERSCORE:
* This symbol, if defined, indicates that we need to prepend an
* makes sense if you *have* dlsym, which we will presume is the
* case if you're using dl_dlopen.xs.
*/
-/*#define DLSYM_NEEDS_UNDERSCORE /**/
+/*#define DLSYM_NEEDS_UNDERSCORE / **/
/* HAS_FAST_STDIO:
* This symbol, if defined, indicates that the "fast stdio"
* This symbol, if defined, indicates that the fchdir routine is
* available to change directory using a file descriptor.
*/
-/*#define HAS_FCHDIR /**/
+/*#define HAS_FCHDIR / **/
/* FCNTL_CAN_LOCK:
* This symbol, if defined, indicates that fcntl() can be used
* for file locking. Normally on Unix systems this is defined.
* It may be undefined on VMS.
*/
-/*#define FCNTL_CAN_LOCK /**/
+/*#define FCNTL_CAN_LOCK / **/
/* HAS_FINITE:
* This symbol, if defined, indicates that the finite routine is
* available to check whether a double is finite (non-infinity non-NaN).
*/
-/*#define HAS_FINITE /**/
+/*#define HAS_FINITE / **/
/* HAS_FINITEL:
* This symbol, if defined, indicates that the finitel routine is
* available to check whether a long double is finite
* (non-infinity non-NaN).
*/
-/*#define HAS_FINITEL /**/
+/*#define HAS_FINITEL / **/
/* HAS_FLOCK_PROTO:
* This symbol, if defined, indicates that the system provides
* FP_POS_ZERO +0.0 (positive zero)
* FP_NEG_ZERO -0.0 (negative zero)
*/
-/*#define HAS_FP_CLASS /**/
+/*#define HAS_FP_CLASS / **/
/* HAS_FPCLASS:
* This symbol, if defined, indicates that the fpclass routine is
* FP_NNORM negative normalized non-zero
* FP_PNORM positive normalized non-zero
*/
-/*#define HAS_FPCLASS /**/
+/*#define HAS_FPCLASS / **/
/* HAS_FPCLASSIFY:
* This symbol, if defined, indicates that the fpclassify routine is
* FP_NAN NaN
*
*/
-/*#define HAS_FPCLASSIFY /**/
+/*#define HAS_FPCLASSIFY / **/
/* HAS_FPCLASSL:
* This symbol, if defined, indicates that the fpclassl routine is
* FP_NNORM negative normalized non-zero
* FP_PNORM positive normalized non-zero
*/
-/*#define HAS_FPCLASSL /**/
+/*#define HAS_FPCLASSL / **/
/* HAS_FPOS64_T:
* This symbol will be defined if the C compiler supports fpos64_t.
*/
-/*#define HAS_FPOS64_T /**/
+/*#define HAS_FPOS64_T / **/
/* HAS_FREXPL:
* This symbol, if defined, indicates that the frexpl routine is
* available to break a long double floating-point number into
* a normalized fraction and an integral power of 2.
*/
-/*#define HAS_FREXPL /**/
+/*#define HAS_FREXPL / **/
/* HAS_STRUCT_FS_DATA:
* This symbol, if defined, indicates that the struct fs_data
* to do statfs() is supported.
*/
-/*#define HAS_STRUCT_FS_DATA /**/
+/*#define HAS_STRUCT_FS_DATA / **/
/* HAS_FSEEKO:
* This symbol, if defined, indicates that the fseeko routine is
* available to fseek beyond 32 bits (useful for ILP32 hosts).
*/
-/*#define HAS_FSEEKO /**/
+/*#define HAS_FSEEKO / **/
/* HAS_FSTATFS:
* This symbol, if defined, indicates that the fstatfs routine is
* available to stat filesystems by file descriptors.
*/
-/*#define HAS_FSTATFS /**/
+/*#define HAS_FSTATFS / **/
/* HAS_FSYNC:
* This symbol, if defined, indicates that the fsync routine is
* available to write a file's modified data and attributes to
* permanent storage.
*/
-/*#define HAS_FSYNC /**/
+/*#define HAS_FSYNC / **/
/* HAS_FTELLO:
* This symbol, if defined, indicates that the ftello routine is
* available to ftell beyond 32 bits (useful for ILP32 hosts).
*/
-/*#define HAS_FTELLO /**/
+/*#define HAS_FTELLO / **/
/* HAS_FUTIMES:
* This symbol, if defined, indicates that the futimes routine is
* available to change file descriptor time stamps with struct timevals.
*/
-/*#define HAS_FUTIMES /**/
+/*#define HAS_FUTIMES / **/
+
+/* HAS_GETADDRINFO:
+ * This symbol, if defined, indicates that the getaddrinfo() function
+ * is available for use.
+ */
+/*#define HAS_GETADDRINFO / **/
/* HAS_GETCWD:
* This symbol, if defined, indicates that the getcwd routine is
* This symbol, if defined, indicates that the getespwnam system call is
* available to retrieve enchanced (shadow) password entries by name.
*/
-/*#define HAS_GETESPWNAM /**/
+/*#define HAS_GETESPWNAM / **/
/* HAS_GETFSSTAT:
* This symbol, if defined, indicates that the getfsstat routine is
* available to stat filesystems in bulk.
*/
-/*#define HAS_GETFSSTAT /**/
+/*#define HAS_GETFSSTAT / **/
/* HAS_GETITIMER:
* This symbol, if defined, indicates that the getitimer routine is
* available to return interval timers.
*/
-/*#define HAS_GETITIMER /**/
+/*#define HAS_GETITIMER / **/
/* HAS_GETMNT:
* This symbol, if defined, indicates that the getmnt routine is
* available to get filesystem mount info by filename.
*/
-/*#define HAS_GETMNT /**/
+/*#define HAS_GETMNT / **/
/* HAS_GETMNTENT:
* This symbol, if defined, indicates that the getmntent routine is
* available to iterate through mounted file systems to get their info.
*/
-/*#define HAS_GETMNTENT /**/
+/*#define HAS_GETMNTENT / **/
+
+/* HAS_GETNAMEINFO:
+ * This symbol, if defined, indicates that the getnameinfo() function
+ * is available for use.
+ */
+/*#define HAS_GETNAMEINFO / **/
/* HAS_GETPRPWNAM:
* This symbol, if defined, indicates that the getprpwnam system call is
* available to retrieve protected (shadow) password entries by name.
*/
-/*#define HAS_GETPRPWNAM /**/
+/*#define HAS_GETPRPWNAM / **/
/* HAS_GETSPNAM:
* This symbol, if defined, indicates that the getspnam system call is
* available to retrieve SysV shadow password entries by name.
*/
-/*#define HAS_GETSPNAM /**/
+/*#define HAS_GETSPNAM / **/
/* HAS_HASMNTOPT:
* This symbol, if defined, indicates that the hasmntopt routine is
* available to query the mount options of file systems.
*/
-/*#define HAS_HASMNTOPT /**/
+/*#define HAS_HASMNTOPT / **/
/* HAS_ILOGBL:
* This symbol, if defined, indicates that the ilogbl routine is
* available. If scalbnl is also present we can emulate frexpl.
*/
-/*#define HAS_ILOGBL /**/
+/*#define HAS_ILOGBL / **/
+
+/* HAS_INETNTOP:
+ * This symbol, if defined, indicates that the inet_ntop() function
+ * is available to parse IPv4 and IPv6 strings.
+ */
+/*#define HAS_INETNTOP / **/
+
+/* HAS_INETPTON:
+ * This symbol, if defined, indicates that the inet_pton() function
+ * is available to parse IPv4 and IPv6 strings.
+ */
+/*#define HAS_INETPTON / **/
/* HAS_INT64_T:
* This symbol will defined if the C compiler supports int64_t.
* Usually the <inttypes.h> needs to be included, but sometimes
* <sys/types.h> is enough.
*/
-/*#define HAS_INT64_T /**/
+/*#define HAS_INT64_T / **/
/* HAS_ISFINITE:
* This symbol, if defined, indicates that the isfinite routine is
* available to check whether a double is finite (non-infinity non-NaN).
*/
-/*#define HAS_ISFINITE /**/
+/*#define HAS_ISFINITE / **/
/* HAS_ISINF:
* This symbol, if defined, indicates that the isinf routine is
* available to check whether a double is an infinity.
*/
-/*#define HAS_ISINF /**/
+/*#define HAS_ISINF / **/
/* HAS_ISNAN:
* This symbol, if defined, indicates that the isnan routine is
* This symbol, if defined, indicates that the isnanl routine is
* available to check whether a long double is a NaN.
*/
-/*#define HAS_ISNANL /**/
+/*#define HAS_ISNANL / **/
/* HAS_LDBL_DIG:
* This symbol, if defined, indicates that this system's <float.h>
* This symbol, if defined, indicates that libm exports _LIB_VERSION
* and that math.h defines the enum to manipulate it.
*/
-/*#define LIBM_LIB_VERSION /**/
+/*#define LIBM_LIB_VERSION / **/
/* HAS_MADVISE:
* This symbol, if defined, indicates that the madvise system call is
* available to map a file into memory.
*/
-/*#define HAS_MADVISE /**/
+/*#define HAS_MADVISE / **/
/* HAS_MALLOC_SIZE:
* This symbol, if defined, indicates that the malloc_size
* routine is available for use.
*/
-/*#define HAS_MALLOC_SIZE /**/
+/*#define HAS_MALLOC_SIZE / **/
/* HAS_MALLOC_GOOD_SIZE:
* This symbol, if defined, indicates that the malloc_good_size
* routine is available for use.
*/
-/*#define HAS_MALLOC_GOOD_SIZE /**/
+/*#define HAS_MALLOC_GOOD_SIZE / **/
/* HAS_MKDTEMP:
* This symbol, if defined, indicates that the mkdtemp routine is
* available to exclusively create a uniquely named temporary directory.
*/
-/*#define HAS_MKDTEMP /**/
+/*#define HAS_MKDTEMP / **/
/* HAS_MKSTEMPS:
* This symbol, if defined, indicates that the mkstemps routine is
* available to excluslvely create and open a uniquely named
* (with a suffix) temporary file.
*/
-/*#define HAS_MKSTEMPS /**/
+/*#define HAS_MKSTEMPS / **/
/* HAS_MODFL:
* This symbol, if defined, indicates that the modfl routine is
* and 1.150000. The bug has been seen in certain versions of glibc,
* release 2.2.2 is known to be okay.
*/
-/*#define HAS_MODFL /**/
-/*#define HAS_MODFL_PROTO /**/
-/*#define HAS_MODFL_POW32_BUG /**/
+/*#define HAS_MODFL / **/
+/*#define HAS_MODFL_PROTO / **/
+/*#define HAS_MODFL_POW32_BUG / **/
/* HAS_MPROTECT:
* This symbol, if defined, indicates that the mprotect system call is
* available to modify the access protection of a memory mapped file.
*/
-/*#define HAS_MPROTECT /**/
+/*#define HAS_MPROTECT / **/
/* HAS_STRUCT_MSGHDR:
* This symbol, if defined, indicates that the struct msghdr
* is supported.
*/
-/*#define HAS_STRUCT_MSGHDR /**/
+/*#define HAS_STRUCT_MSGHDR / **/
/* HAS_NL_LANGINFO:
* This symbol, if defined, indicates that the nl_langinfo routine is
* available to return local data. You will also need <langinfo.h>
* and therefore I_LANGINFO.
*/
-/*#define HAS_NL_LANGINFO /**/
+/*#define HAS_NL_LANGINFO / **/
/* HAS_OFF64_T:
* This symbol will be defined if the C compiler supports off64_t.
*/
-/*#define HAS_OFF64_T /**/
+/*#define HAS_OFF64_T / **/
/* HAS_PROCSELFEXE:
* This symbol is defined if PROCSELFEXE_PATH is a symlink
* of the symbolic link pointing to the absolute pathname of
* the executing program.
*/
-/*#define HAS_PROCSELFEXE /**/
+/*#define HAS_PROCSELFEXE / **/
#if defined(HAS_PROCSELFEXE) && !defined(PROCSELFEXE_PATH)
#define PROCSELFEXE_PATH /**/
#endif
* system call is available to set the contention scope attribute of
* a thread attribute object.
*/
-/*#define HAS_PTHREAD_ATTR_SETSCOPE /**/
+/*#define HAS_PTHREAD_ATTR_SETSCOPE / **/
/* HAS_READV:
* This symbol, if defined, indicates that the readv routine is
* available to do gather reads. You will also need <sys/uio.h>
* and there I_SYSUIO.
*/
-/*#define HAS_READV /**/
+/*#define HAS_READV / **/
/* HAS_RECVMSG:
* This symbol, if defined, indicates that the recvmsg routine is
* available to send structured socket messages.
*/
-/*#define HAS_RECVMSG /**/
+/*#define HAS_RECVMSG / **/
/* HAS_SBRK_PROTO:
* This symbol, if defined, indicates that the system provides
* extern void* sbrk(int);
* extern void* sbrk(size_t);
*/
-/*#define HAS_SBRK_PROTO /**/
+/*#define HAS_SBRK_PROTO / **/
/* HAS_SCALBNL:
* This symbol, if defined, indicates that the scalbnl routine is
* available. If ilogbl is also present we can emulate frexpl.
*/
-/*#define HAS_SCALBNL /**/
+/*#define HAS_SCALBNL / **/
/* HAS_SENDMSG:
* This symbol, if defined, indicates that the sendmsg routine is
* available to send structured socket messages.
*/
-/*#define HAS_SENDMSG /**/
+/*#define HAS_SENDMSG / **/
/* HAS_SETITIMER:
* This symbol, if defined, indicates that the setitimer routine is
* available to set interval timers.
*/
-/*#define HAS_SETITIMER /**/
+/*#define HAS_SETITIMER / **/
/* HAS_SETPROCTITLE:
* This symbol, if defined, indicates that the setproctitle routine is
* available to set process title.
*/
-/*#define HAS_SETPROCTITLE /**/
+/*#define HAS_SETPROCTITLE / **/
/* USE_SFIO:
* This symbol, if defined, indicates that sfio should
* be used.
*/
-/*#define USE_SFIO /**/
+/*#define USE_SFIO / **/
/* HAS_SIGNBIT:
* This symbol, if defined, indicates that the signbit routine is
* in perl. Users should call Perl_signbit(), which will be #defined to
* the system's signbit() function or macro if this symbol is defined.
*/
-/*#define HAS_SIGNBIT /**/
+/*#define HAS_SIGNBIT / **/
/* HAS_SIGPROCMASK:
* This symbol, if defined, indicates that the sigprocmask
* system call is available to examine or change the signal mask
* of the calling process.
*/
-/*#define HAS_SIGPROCMASK /**/
+/*#define HAS_SIGPROCMASK / **/
/* USE_SITECUSTOMIZE:
* This symbol, if defined, indicates that sitecustomize should
* be used.
*/
#ifndef USE_SITECUSTOMIZE
-/*#define USE_SITECUSTOMIZE /**/
+/*#define USE_SITECUSTOMIZE / **/
#endif
/* HAS_SNPRINTF:
* This symbol, if defined, indicates that the sockatmark routine is
* available to test whether a socket is at the out-of-band mark.
*/
-/*#define HAS_SOCKATMARK /**/
+/*#define HAS_SOCKATMARK / **/
/* HAS_SOCKATMARK_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. A good guess is
* extern int sockatmark(int);
*/
-/*#define HAS_SOCKATMARK_PROTO /**/
+/*#define HAS_SOCKATMARK_PROTO / **/
/* HAS_SOCKS5_INIT:
* This symbol, if defined, indicates that the socks5_init routine is
* available to initialize SOCKS 5.
*/
-/*#define HAS_SOCKS5_INIT /**/
+/*#define HAS_SOCKS5_INIT / **/
/* SPRINTF_RETURNS_STRLEN:
* This variable defines whether sprintf returns the length of the string
* This symbol, if defined, indicates that the sqrtl routine is
* available to do long double square roots.
*/
-/*#define HAS_SQRTL /**/
+/*#define HAS_SQRTL / **/
/* HAS_SETRESGID_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. Good guesses are
* extern int setresgid(uid_t ruid, uid_t euid, uid_t suid);
*/
-/*#define HAS_SETRESGID_PROTO /**/
+/*#define HAS_SETRESGID_PROTO / **/
/* HAS_SETRESUID_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. Good guesses are
* extern int setresuid(uid_t ruid, uid_t euid, uid_t suid);
*/
-/*#define HAS_SETRESUID_PROTO /**/
+/*#define HAS_SETRESUID_PROTO / **/
/* HAS_STRUCT_STATFS_F_FLAGS:
* This symbol, if defined, indicates that the struct statfs
* have statfs() and struct statfs, they have ustat() and getmnt()
* with struct ustat and struct fs_data.
*/
-/*#define HAS_STRUCT_STATFS_F_FLAGS /**/
+/*#define HAS_STRUCT_STATFS_F_FLAGS / **/
/* HAS_STRUCT_STATFS:
* This symbol, if defined, indicates that the struct statfs
* to do statfs() is supported.
*/
-/*#define HAS_STRUCT_STATFS /**/
+/*#define HAS_STRUCT_STATFS / **/
/* HAS_FSTATVFS:
* This symbol, if defined, indicates that the fstatvfs routine is
* available to stat filesystems by file descriptors.
*/
-/*#define HAS_FSTATVFS /**/
+/*#define HAS_FSTATVFS / **/
/* HAS_STRFTIME:
* This symbol, if defined, indicates that the strftime routine is
* This symbol, if defined, indicates that the strlcat () routine is
* available to do string concatenation.
*/
-/*#define HAS_STRLCAT /**/
+/*#define HAS_STRLCAT / **/
/* HAS_STRLCPY:
* This symbol, if defined, indicates that the strlcpy () routine is
* available to do string copying.
*/
-/*#define HAS_STRLCPY /**/
+/*#define HAS_STRLCPY / **/
/* HAS_STRTOLD:
* This symbol, if defined, indicates that the strtold routine is
* available to convert strings to long doubles.
*/
-/*#define HAS_STRTOLD /**/
+/*#define HAS_STRTOLD / **/
/* HAS_STRTOLL:
* This symbol, if defined, indicates that the strtoll routine is
* available to convert strings to long longs.
*/
-/*#define HAS_STRTOLL /**/
+/*#define HAS_STRTOLL / **/
/* HAS_STRTOQ:
* This symbol, if defined, indicates that the strtoq routine is
* available to convert strings to long longs (quads).
*/
-/*#define HAS_STRTOQ /**/
+/*#define HAS_STRTOQ / **/
/* HAS_STRTOULL:
* This symbol, if defined, indicates that the strtoull routine is
* available to convert strings to unsigned long longs.
*/
-/*#define HAS_STRTOULL /**/
+/*#define HAS_STRTOULL / **/
/* HAS_STRTOUQ:
* This symbol, if defined, indicates that the strtouq routine is
* available to convert strings to unsigned long longs (quads).
*/
-/*#define HAS_STRTOUQ /**/
+/*#define HAS_STRTOUQ / **/
/* HAS_SYSCALL_PROTO:
* This symbol, if defined, indicates that the system provides
* extern int syscall(int, ...);
* extern int syscall(long, ...);
*/
-/*#define HAS_SYSCALL_PROTO /**/
+/*#define HAS_SYSCALL_PROTO / **/
/* HAS_TELLDIR_PROTO:
* This symbol, if defined, indicates that the system provides
* This symbol, if defined, indicates that the asctime64 () routine is
* available to do the 64bit variant of asctime ()
*/
-/*#define HAS_CTIME64 /**/
-/*#define HAS_LOCALTIME64 /**/
-/*#define HAS_GMTIME64 /**/
-/*#define HAS_MKTIME64 /**/
-/*#define HAS_DIFFTIME64 /**/
-/*#define HAS_ASCTIME64 /**/
+/*#define HAS_CTIME64 / **/
+/*#define HAS_LOCALTIME64 / **/
+/*#define HAS_GMTIME64 / **/
+/*#define HAS_MKTIME64 / **/
+/*#define HAS_DIFFTIME64 / **/
+/*#define HAS_ASCTIME64 / **/
/* HAS_TIMEGM:
* This symbol, if defined, indicates that the timegm routine is
* available to do the opposite of gmtime ()
*/
-/*#define HAS_TIMEGM /**/
+/*#define HAS_TIMEGM / **/
/* U32_ALIGNMENT_REQUIRED:
* This symbol, if defined, indicates that you must access
* This symbol, if defined, indicates that the ualarm routine is
* available to do alarms with microsecond granularity.
*/
-/*#define HAS_UALARM /**/
+/*#define HAS_UALARM / **/
/* HAS_UNORDERED:
* This symbol, if defined, indicates that the unordered routine is
* available to check whether two doubles are unordered
* (effectively: whether either of them is NaN)
*/
-/*#define HAS_UNORDERED /**/
+/*#define HAS_UNORDERED / **/
/* HAS_UNSETENV:
* This symbol, if defined, indicates that the unsetenv () routine is
* available for use.
*/
-/*#define HAS_UNSETENV /**/
+/*#define HAS_UNSETENV / **/
/* HAS_USLEEP_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. A good guess is
* extern int usleep(useconds_t);
*/
-/*#define HAS_USLEEP_PROTO /**/
+/*#define HAS_USLEEP_PROTO / **/
/* HAS_USTAT:
* This symbol, if defined, indicates that the ustat system call is
* available to query file system statistics by dev_t.
*/
-/*#define HAS_USTAT /**/
+/*#define HAS_USTAT / **/
/* HAS_WRITEV:
* This symbol, if defined, indicates that the writev routine is
* available to do scatter writes.
*/
-/*#define HAS_WRITEV /**/
+/*#define HAS_WRITEV / **/
/* USE_DYNAMIC_LOADING:
* This symbol, if defined, indicates that dynamic loading of
* even be probed for and will be left undefined.
*/
#define FFLUSH_NULL /**/
-/*#define FFLUSH_ALL /**/
+/*#define FFLUSH_ALL / **/
/* I_ASSERT:
* This symbol, if defined, indicates that <assert.h> exists and
* This symbol, if defined, indicates that <crypt.h> exists and
* should be included.
*/
-/*#define I_CRYPT /**/
+/*#define I_CRYPT / **/
/* DB_Prefix_t:
* This symbol contains the type of the prefix structure element
* This symbol, if defined, indicates that <fp.h> exists and
* should be included.
*/
-/*#define I_FP /**/
+/*#define I_FP / **/
/* I_FP_CLASS:
* This symbol, if defined, indicates that <fp_class.h> exists and
* should be included.
*/
-/*#define I_FP_CLASS /**/
+/*#define I_FP_CLASS / **/
/* I_IEEEFP:
* This symbol, if defined, indicates that <ieeefp.h> exists and
* should be included.
*/
-/*#define I_IEEEFP /**/
+/*#define I_IEEEFP / **/
/* I_INTTYPES:
* This symbol, if defined, indicates to the C program that it should
* include <inttypes.h>.
*/
-/*#define I_INTTYPES /**/
+/*#define I_INTTYPES / **/
/* I_LANGINFO:
* This symbol, if defined, indicates that <langinfo.h> exists and
* should be included.
*/
-/*#define I_LANGINFO /**/
+/*#define I_LANGINFO / **/
/* I_LIBUTIL:
* This symbol, if defined, indicates that <libutil.h> exists and
* should be included.
*/
-/*#define I_LIBUTIL /**/
+/*#define I_LIBUTIL / **/
/* I_MALLOCMALLOC:
* This symbol, if defined, indicates to the C program that it should
* include <malloc/malloc.h>.
*/
-/*#define I_MALLOCMALLOC /**/
+/*#define I_MALLOCMALLOC / **/
/* I_MNTENT:
* This symbol, if defined, indicates that <mntent.h> exists and
* should be included.
*/
-/*#define I_MNTENT /**/
+/*#define I_MNTENT / **/
/* I_NETINET_TCP:
* This symbol, if defined, indicates to the C program that it should
* include <netinet/tcp.h>.
*/
-/*#define I_NETINET_TCP /**/
+/*#define I_NETINET_TCP / **/
/* I_POLL:
* This symbol, if defined, indicates that <poll.h> exists and
* should be included. (see also HAS_POLL)
*/
-/*#define I_POLL /**/
+/*#define I_POLL / **/
/* I_PROT:
* This symbol, if defined, indicates that <prot.h> exists and
* should be included.
*/
-/*#define I_PROT /**/
+/*#define I_PROT / **/
/* I_SHADOW:
* This symbol, if defined, indicates that <shadow.h> exists and
* should be included.
*/
-/*#define I_SHADOW /**/
+/*#define I_SHADOW / **/
/* I_SOCKS:
* This symbol, if defined, indicates that <socks.h> exists and
* should be included.
*/
-/*#define I_SOCKS /**/
+/*#define I_SOCKS / **/
/* I_SUNMATH:
* This symbol, if defined, indicates that <sunmath.h> exists and
* should be included.
*/
-/*#define I_SUNMATH /**/
+/*#define I_SUNMATH / **/
/* I_SYSLOG:
* This symbol, if defined, indicates that <syslog.h> exists and
* should be included.
*/
-/*#define I_SYSLOG /**/
+/*#define I_SYSLOG / **/
/* I_SYSMODE:
* This symbol, if defined, indicates that <sys/mode.h> exists and
* should be included.
*/
-/*#define I_SYSMODE /**/
+/*#define I_SYSMODE / **/
/* I_SYS_MOUNT:
* This symbol, if defined, indicates that <sys/mount.h> exists and
* should be included.
*/
-/*#define I_SYS_MOUNT /**/
+/*#define I_SYS_MOUNT / **/
/* I_SYS_STATFS:
* This symbol, if defined, indicates that <sys/statfs.h> exists.
*/
-/*#define I_SYS_STATFS /**/
+/*#define I_SYS_STATFS / **/
/* I_SYS_STATVFS:
* This symbol, if defined, indicates that <sys/statvfs.h> exists and
* should be included.
*/
-/*#define I_SYS_STATVFS /**/
+/*#define I_SYS_STATVFS / **/
/* I_SYSUTSNAME:
* This symbol, if defined, indicates that <sys/utsname.h> exists and
* should be included.
*/
-/*#define I_SYSUTSNAME /**/
+/*#define I_SYSUTSNAME / **/
/* I_SYS_VFS:
* This symbol, if defined, indicates that <sys/vfs.h> exists and
* should be included.
*/
-/*#define I_SYS_VFS /**/
+/*#define I_SYS_VFS / **/
/* I_USTAT:
* This symbol, if defined, indicates that <ustat.h> exists and
* should be included.
*/
-/*#define I_USTAT /**/
+/*#define I_USTAT / **/
/* PERL_PRIfldbl:
* This symbol, if defined, contains the string used by stdio to
* This symbol, if defined, contains the string used by stdio to
* format long doubles (format 'f') for input.
*/
-/*#define PERL_PRIfldbl "f" /**/
-/*#define PERL_PRIgldbl "g" /**/
-/*#define PERL_PRIeldbl "e" /**/
-/*#define PERL_SCNfldbl "f" /**/
+/*#define PERL_PRIfldbl "f" / **/
+/*#define PERL_PRIgldbl "g" / **/
+/*#define PERL_PRIeldbl "e" / **/
+/*#define PERL_SCNfldbl "f" / **/
/* PERL_MAD:
* This symbol, if defined, indicates that the Misc Attribution
* Declaration code should be conditionally compiled.
*/
-/*#define PERL_MAD /**/
+/*#define PERL_MAD / **/
/* NEED_VA_COPY:
* This symbol, if defined, indicates that the system stores
* of copying mechanisms, handy.h defines a platform-
* independent macro, Perl_va_copy(src, dst), to do the job.
*/
-/*#define NEED_VA_COPY /**/
+/*#define NEED_VA_COPY / **/
/* IVTYPE:
* This symbol defines the C type used for Perl's IV.
* This symbol tells the name of the array holding the stdio streams.
* Usual values include _iob, __iob, and __sF.
*/
-/*#define HAS_STDIO_STREAM_ARRAY /**/
+/*#define HAS_STDIO_STREAM_ARRAY / **/
#ifdef HAS_STDIO_STREAM_ARRAY
#define STDIO_STREAM_ARRAY
#endif
* This symbol contains the minimum value for the time_t offset that
* the system function localtime () accepts, and defaults to 0
*/
-#define GMTIME_MAX 2147483647 /**/
-#define GMTIME_MIN 0 /**/
+#define GMTIME_MAX 2147483647 /**/
+#define GMTIME_MIN 0 /**/
#define LOCALTIME_MAX 2147483647 /**/
#define LOCALTIME_MIN 0 /**/
* you may need at least to reboot your OS to 64-bit mode.
*/
#ifndef USE_64_BIT_INT
-/*#define USE_64_BIT_INT /**/
+/*#define USE_64_BIT_INT / **/
#endif
#ifndef USE_64_BIT_ALL
-/*#define USE_64_BIT_ALL /**/
+/*#define USE_64_BIT_ALL / **/
#endif
/* USE_DTRACE:
* This symbol, if defined, indicates that Perl should
* be built with support for DTrace.
*/
-/*#define USE_DTRACE /**/
+/*#define USE_DTRACE / **/
/* USE_FAST_STDIO:
* This symbol, if defined, indicates that Perl should
* Defaults to define in Perls 5.8 and earlier, to undef later.
*/
#ifndef USE_FAST_STDIO
-/*#define USE_FAST_STDIO /**/
+/*#define USE_FAST_STDIO / **/
#endif
/* USE_LARGE_FILES:
* should be used when available.
*/
#ifndef USE_LARGE_FILES
-/*#define USE_LARGE_FILES /**/
+/*#define USE_LARGE_FILES / **/
#endif
/* USE_LONG_DOUBLE:
* be used when available.
*/
#ifndef USE_LONG_DOUBLE
-/*#define USE_LONG_DOUBLE /**/
+/*#define USE_LONG_DOUBLE / **/
#endif
/* USE_MORE_BITS:
* long doubles should be used when available.
*/
#ifndef USE_MORE_BITS
-/*#define USE_MORE_BITS /**/
+/*#define USE_MORE_BITS / **/
#endif
/* MULTIPLICITY:
* be built to use multiplicity.
*/
#ifndef MULTIPLICITY
-/*#define MULTIPLICITY /**/
+/*#define MULTIPLICITY / **/
#endif
/* USE_PERLIO:
* used in a fully backward compatible manner.
*/
#ifndef USE_PERLIO
-/*#define USE_PERLIO /**/
+/*#define USE_PERLIO / **/
#endif
/* USE_SOCKS:
* be built to use socks.
*/
#ifndef USE_SOCKS
-/*#define USE_SOCKS /**/
+/*#define USE_SOCKS / **/
#endif
#endif
/*
* Package name : perl5
- * Source directory :
- * Configuration time: Fri Dec 12 15:19:23 2008
- * Configured by : shay
- * Target system :
+ * Source directory :
+ * Configuration time: Sun Jan 10 19:53:56 2010
+ * Configured by : Steve
+ * Target system :
*/
#ifndef _config_h_
* This symbol is defined if the bcmp() routine is available to
* compare blocks of memory.
*/
-/*#define HAS_BCMP /**/
+/*#define HAS_BCMP / **/
/* HAS_BCOPY:
* This symbol is defined if the bcopy() routine is available to
* copy blocks of memory.
*/
-/*#define HAS_BCOPY /**/
+/*#define HAS_BCOPY / **/
/* HAS_BZERO:
* This symbol is defined if the bzero() routine is available to
* set a memory block to 0.
*/
-/*#define HAS_BZERO /**/
+/*#define HAS_BZERO / **/
/* HAS_CHOWN:
* This symbol, if defined, indicates that the chown routine is
* available.
*/
-/*#define HAS_CHOWN /**/
+/*#define HAS_CHOWN / **/
/* HAS_CHROOT:
* This symbol, if defined, indicates that the chroot routine is
* available.
*/
-/*#define HAS_CHROOT /**/
+/*#define HAS_CHROOT / **/
/* HAS_CHSIZE:
* This symbol, if defined, indicates that the chsize routine is available
* This symbol, if defined, indicates that the crypt routine is available
* to encrypt passwords and the like.
*/
-/*#define HAS_CRYPT /**/
+/*#define HAS_CRYPT / **/
/* HAS_CTERMID:
* This symbol, if defined, indicates that the ctermid routine is
* available to generate filename for terminal.
*/
-/*#define HAS_CTERMID /**/
+/*#define HAS_CTERMID / **/
/* HAS_CUSERID:
* This symbol, if defined, indicates that the cuserid routine is
* available to get character login names.
*/
-/*#define HAS_CUSERID /**/
+/*#define HAS_CUSERID / **/
/* HAS_DBL_DIG:
* This symbol, if defined, indicates that this system's <float.h>
* This symbol, if defined, indicates that the fchmod routine is available
* to change mode of opened files. If unavailable, use chmod().
*/
-/*#define HAS_FCHMOD /**/
+/*#define HAS_FCHMOD / **/
/* HAS_FCHOWN:
* This symbol, if defined, indicates that the fchown routine is available
* to change ownership of opened files. If unavailable, use chown().
*/
-/*#define HAS_FCHOWN /**/
+/*#define HAS_FCHOWN / **/
/* HAS_FCNTL:
* This symbol, if defined, indicates to the C program that
* the fcntl() function exists.
*/
-/*#define HAS_FCNTL /**/
+/*#define HAS_FCNTL / **/
/* HAS_FGETPOS:
* This symbol, if defined, indicates that the fgetpos routine is
* This symbol, if defined, indicates that the fork routine is
* available.
*/
-/*#define HAS_FORK /**/
+/*#define HAS_FORK / **/
/* HAS_FSETPOS:
* This symbol, if defined, indicates that the fsetpos routine is
* available to get the list of process groups. If unavailable, multiple
* groups are probably not supported.
*/
-/*#define HAS_GETGROUPS /**/
+/*#define HAS_GETGROUPS / **/
/* HAS_GETLOGIN:
* This symbol, if defined, indicates that the getlogin routine is
#define HAS_GETLOGIN /**/
/* HAS_GETPGID:
- * This symbol, if defined, indicates to the C program that
+ * This symbol, if defined, indicates to the C program that
* the getpgid(pid) function is available to get the
* process group id.
*/
-/*#define HAS_GETPGID /**/
+/*#define HAS_GETPGID / **/
/* HAS_GETPGRP2:
* This symbol, if defined, indicates that the getpgrp2() (as in DG/UX)
* routine is available to get the current process group.
*/
-/*#define HAS_GETPGRP2 /**/
+/*#define HAS_GETPGRP2 / **/
/* HAS_GETPPID:
* This symbol, if defined, indicates that the getppid routine is
* available to get the parent process ID.
*/
-/*#define HAS_GETPPID /**/
+/*#define HAS_GETPPID / **/
/* HAS_GETPRIORITY:
* This symbol, if defined, indicates that the getpriority routine is
* available to get a process's priority.
*/
-/*#define HAS_GETPRIORITY /**/
+/*#define HAS_GETPRIORITY / **/
/* HAS_INET_ATON:
* This symbol, if defined, indicates to the C program that the
* inet_aton() function is available to parse IP address "dotted-quad"
* strings.
*/
-/*#define HAS_INET_ATON /**/
+/*#define HAS_INET_ATON / **/
/* HAS_KILLPG:
* This symbol, if defined, indicates that the killpg routine is available
* This symbol, if defined, indicates that the lockf routine is
* available to do file locking.
*/
-/*#define HAS_LOCKF /**/
+/*#define HAS_LOCKF / **/
/* HAS_LSTAT:
* This symbol, if defined, indicates that the lstat routine is
* available to do file stats on symbolic links.
*/
-/*#define HAS_LSTAT /**/
+/*#define HAS_LSTAT / **/
/* HAS_MBLEN:
* This symbol, if defined, indicates that the mblen routine is available
* do it for you. However, if mkfifo is there, mknod might require
* super-user privileges which mkfifo will not.
*/
-/*#define HAS_MKFIFO /**/
+/*#define HAS_MKFIFO / **/
/* HAS_MKTIME:
* This symbol, if defined, indicates that the mktime routine is
* This symbol, if defined, indicates that the msync system call is
* available to synchronize a mapped file.
*/
-/*#define HAS_MSYNC /**/
+/*#define HAS_MSYNC / **/
/* HAS_MUNMAP:
* This symbol, if defined, indicates that the munmap system call is
* available to unmap a region, usually mapped by mmap().
*/
-/*#define HAS_MUNMAP /**/
+/*#define HAS_MUNMAP / **/
/* HAS_NICE:
* This symbol, if defined, indicates that the nice routine is
* available.
*/
-/*#define HAS_NICE /**/
+/*#define HAS_NICE / **/
/* HAS_PATHCONF:
* This symbol, if defined, indicates that pathconf() is available
* to determine file-system related limits and options associated
* with a given open file descriptor.
*/
-/*#define HAS_PATHCONF /**/
-/*#define HAS_FPATHCONF /**/
+/*#define HAS_PATHCONF / **/
+/*#define HAS_FPATHCONF / **/
/* HAS_PAUSE:
* This symbol, if defined, indicates that the pause routine is
* available to poll active file descriptors. Please check I_POLL and
* I_SYS_POLL to know which header should be included as well.
*/
-/*#define HAS_POLL /**/
+/*#define HAS_POLL / **/
/* HAS_READDIR:
* This symbol, if defined, indicates that the readdir routine is
* This symbol, if defined, indicates that the readlink routine is
* available to read the value of a symbolic link.
*/
-/*#define HAS_READLINK /**/
+/*#define HAS_READLINK / **/
/* HAS_RENAME:
* This symbol, if defined, indicates that the rename routine is available
* This symbol, if defined, indicates that the setegid routine is available
* to change the effective gid of the current program.
*/
-/*#define HAS_SETEGID /**/
+/*#define HAS_SETEGID / **/
/* HAS_SETEUID:
* This symbol, if defined, indicates that the seteuid routine is available
* to change the effective uid of the current program.
*/
-/*#define HAS_SETEUID /**/
+/*#define HAS_SETEUID / **/
/* HAS_SETGROUPS:
* This symbol, if defined, indicates that the setgroups() routine is
* available to set the list of process groups. If unavailable, multiple
* groups are probably not supported.
*/
-/*#define HAS_SETGROUPS /**/
+/*#define HAS_SETGROUPS / **/
/* HAS_SETLINEBUF:
* This symbol, if defined, indicates that the setlinebuf routine is
* available to change stderr or stdout from block-buffered or unbuffered
* to a line-buffered mode.
*/
-/*#define HAS_SETLINEBUF /**/
+/*#define HAS_SETLINEBUF / **/
/* HAS_SETLOCALE:
* This symbol, if defined, indicates that the setlocale routine is
* This symbol, if defined, indicates that the setpgid(pid, gpid)
* routine is available to set process group ID.
*/
-/*#define HAS_SETPGID /**/
+/*#define HAS_SETPGID / **/
/* HAS_SETPGRP2:
* This symbol, if defined, indicates that the setpgrp2() (as in DG/UX)
* routine is available to set the current process group.
*/
-/*#define HAS_SETPGRP2 /**/
+/*#define HAS_SETPGRP2 / **/
/* HAS_SETPRIORITY:
* This symbol, if defined, indicates that the setpriority routine is
* available to set a process's priority.
*/
-/*#define HAS_SETPRIORITY /**/
+/*#define HAS_SETPRIORITY / **/
/* HAS_SETREGID:
* This symbol, if defined, indicates that the setregid routine is
* available to change the real, effective and saved gid of the current
* process.
*/
-/*#define HAS_SETREGID /**/
-/*#define HAS_SETRESGID /**/
+/*#define HAS_SETREGID / **/
+/*#define HAS_SETRESGID / **/
/* HAS_SETREUID:
* This symbol, if defined, indicates that the setreuid routine is
* available to change the real, effective and saved uid of the current
* process.
*/
-/*#define HAS_SETREUID /**/
-/*#define HAS_SETRESUID /**/
+/*#define HAS_SETREUID / **/
+/*#define HAS_SETRESUID / **/
/* HAS_SETRGID:
* This symbol, if defined, indicates that the setrgid routine is available
* to change the real gid of the current program.
*/
-/*#define HAS_SETRGID /**/
+/*#define HAS_SETRGID / **/
/* HAS_SETRUID:
* This symbol, if defined, indicates that the setruid routine is available
* to change the real uid of the current program.
*/
-/*#define HAS_SETRUID /**/
+/*#define HAS_SETRUID / **/
/* HAS_SETSID:
* This symbol, if defined, indicates that the setsid routine is
* available to set the process group ID.
*/
-/*#define HAS_SETSID /**/
+/*#define HAS_SETSID / **/
/* HAS_STRCHR:
* This symbol is defined to indicate that the strchr()/strrchr()
* functions are available for string searching.
*/
#define HAS_STRCHR /**/
-/*#define HAS_INDEX /**/
+/*#define HAS_INDEX / **/
/* HAS_STRCOLL:
* This symbol, if defined, indicates that the strcoll routine is
* This symbol, if defined, indicates that the symlink routine is available
* to create symbolic links.
*/
-/*#define HAS_SYMLINK /**/
+/*#define HAS_SYMLINK / **/
/* HAS_SYSCALL:
* This symbol, if defined, indicates that the syscall routine is
* available to call arbitrary system calls. If undefined, that's tough.
*/
-/*#define HAS_SYSCALL /**/
+/*#define HAS_SYSCALL / **/
/* HAS_SYSCONF:
* This symbol, if defined, indicates that sysconf() is available
* to determine system related limits and options.
*/
-/*#define HAS_SYSCONF /**/
+/*#define HAS_SYSCONF / **/
/* HAS_SYSTEM:
* This symbol, if defined, indicates that the system routine is
* This symbol, if defined, indicates that the tcgetpgrp routine is
* available to get foreground process group ID.
*/
-/*#define HAS_TCGETPGRP /**/
+/*#define HAS_TCGETPGRP / **/
/* HAS_TCSETPGRP:
* This symbol, if defined, indicates that the tcsetpgrp routine is
* available to set foreground process group ID.
*/
-/*#define HAS_TCSETPGRP /**/
+/*#define HAS_TCSETPGRP / **/
/* HAS_TRUNCATE:
* This symbol, if defined, indicates that the truncate routine is
* available to truncate files.
*/
-/*#define HAS_TRUNCATE /**/
+/*#define HAS_TRUNCATE / **/
/* HAS_TZNAME:
* This symbol, if defined, indicates that the tzname[] array is
* This symbol, if defined, indicates that the usleep routine is
* available to let the process sleep on a sub-second accuracy.
*/
-/*#define HAS_USLEEP /**/
+/*#define HAS_USLEEP / **/
/* HAS_WAIT4:
* This symbol, if defined, indicates that wait4() exists.
*/
-/*#define HAS_WAIT4 /**/
+/*#define HAS_WAIT4 / **/
/* HAS_WAITPID:
* This symbol, if defined, indicates that the waitpid routine is
* This symbol holds the type used for the second argument to
* getgroups() and setgroups(). Usually, this is the same as
* gidtype (gid_t) , but sometimes it isn't.
- * It can be int, ushort, gid_t, etc...
- * It may be necessary to include <sys/types.h> to get any
+ * It can be int, ushort, gid_t, etc...
+ * It may be necessary to include <sys/types.h> to get any
* typedef'ed information. This is only required if you have
* getgroups() or setgroups()..
*/
* This symbol, if defined, indicates that <rpcsvc/dbm.h> exists and
* should be included.
*/
-/*#define I_DBM /**/
+/*#define I_DBM / **/
#define I_RPCSVC_DBM /**/
/* I_DLFCN:
* This symbol, if defined, indicates that <gdbm.h> exists and should
* be included.
*/
-/*#define I_GDBM /**/
+/*#define I_GDBM / **/
/* I_LIMITS:
* This symbol, if defined, indicates to the C program that it should
* This symbol, if defined, indicates to the C program that it should
* include <memory.h>.
*/
-/*#define I_MEMORY /**/
+/*#define I_MEMORY / **/
/* I_NETINET_IN:
* This symbol, if defined, indicates to the C program that it should
* include <netinet/in.h>. Otherwise, you may try <sys/in.h>.
*/
-/*#define I_NETINET_IN /**/
+/*#define I_NETINET_IN / **/
/* I_SFIO:
* This symbol, if defined, indicates to the C program that it should
* include <sfio.h>.
*/
-/*#define I_SFIO /**/
+/*#define I_SFIO / **/
/* I_STDDEF:
* This symbol, if defined, indicates that <stddef.h> exists and should
* This symbol, if defined, indicates to the C program that it should
* include <sys/dir.h>.
*/
-/*#define I_SYS_DIR /**/
+/*#define I_SYS_DIR / **/
/* I_SYS_FILE:
* This symbol, if defined, indicates to the C program that it should
* include <sys/file.h> to get definition of R_OK and friends.
*/
-/*#define I_SYS_FILE /**/
+/*#define I_SYS_FILE / **/
/* I_SYS_IOCTL:
* This symbol, if defined, indicates that <sys/ioctl.h> exists and should
* This symbol, if defined, indicates the <sys/sockio.h> should be included
* to get socket ioctl options, like SIOCATMARK.
*/
-/*#define I_SYS_IOCTL /**/
-/*#define I_SYS_SOCKIO /**/
+/*#define I_SYS_IOCTL / **/
+/*#define I_SYS_SOCKIO / **/
/* I_SYS_NDIR:
* This symbol, if defined, indicates to the C program that it should
* include <sys/ndir.h>.
*/
-/*#define I_SYS_NDIR /**/
+/*#define I_SYS_NDIR / **/
/* I_SYS_PARAM:
* This symbol, if defined, indicates to the C program that it should
* include <sys/param.h>.
*/
-/*#define I_SYS_PARAM /**/
+/*#define I_SYS_PARAM / **/
/* I_SYS_POLL:
* This symbol, if defined, indicates that the program may include
* <sys/poll.h>. When I_POLL is also defined, it's probably safest
* to only include <poll.h>.
*/
-/*#define I_SYS_POLL /**/
+/*#define I_SYS_POLL / **/
/* I_SYS_RESOURCE:
* This symbol, if defined, indicates to the C program that it should
* include <sys/resource.h>.
*/
-/*#define I_SYS_RESOURCE /**/
+/*#define I_SYS_RESOURCE / **/
/* I_SYS_SELECT:
* This symbol, if defined, indicates to the C program that it should
* include <sys/select.h> in order to get definition of struct timeval.
*/
-/*#define I_SYS_SELECT /**/
+/*#define I_SYS_SELECT / **/
/* I_SYS_STAT:
* This symbol, if defined, indicates to the C program that it should
* This symbol, if defined, indicates to the C program that it should
* include <sys/times.h>.
*/
-/*#define I_SYS_TIMES /**/
+/*#define I_SYS_TIMES / **/
/* I_SYS_TYPES:
* This symbol, if defined, indicates to the C program that it should
* This symbol, if defined, indicates to the C program that it should
* include <sys/un.h> to get UNIX domain socket definitions.
*/
-/*#define I_SYS_UN /**/
+/*#define I_SYS_UN / **/
/* I_SYS_WAIT:
* This symbol, if defined, indicates to the C program that it should
* include <sys/wait.h>.
*/
-/*#define I_SYS_WAIT /**/
+/*#define I_SYS_WAIT / **/
/* I_TERMIO:
* This symbol, if defined, indicates that the program should include
* <sgtty.h> rather than <termio.h>. There are also differences in
* the ioctl() calls that depend on the value of this symbol.
*/
-/*#define I_TERMIO /**/
-/*#define I_TERMIOS /**/
-/*#define I_SGTTY /**/
+/*#define I_TERMIO / **/
+/*#define I_TERMIOS / **/
+/*#define I_SGTTY / **/
/* I_UNISTD:
* This symbol, if defined, indicates to the C program that it should
* include <unistd.h>.
*/
-/*#define I_UNISTD /**/
+/*#define I_UNISTD / **/
/* I_UTIME:
* This symbol, if defined, indicates to the C program that it should
* MAXLONG, i.e. machine dependant limitations. Probably, you
* should use <limits.h> instead, if it is available.
*/
-/*#define I_VALUES /**/
+/*#define I_VALUES / **/
/* I_VFORK:
* This symbol, if defined, indicates to the C program that it should
* include vfork.h.
*/
-/*#define I_VFORK /**/
+/*#define I_VFORK / **/
+
+/* CAN_VAPROTO:
+ * This variable is defined on systems supporting prototype declaration
+ * of functions with a variable number of arguments.
+ */
+/* _V:
+ * This macro is used to declare function parameters in prototypes for
+ * functions with a variable number of parameters. Use double parentheses.
+ * For example:
+ *
+ * int printf _V((char *fmt, ...));
+ *
+ * Remember to use the plain simple _() macro when declaring a function
+ * with no variable number of arguments, since it might be possible to
+ * have a non-effect _V() macro and still get prototypes via _().
+ */
+/*#define CAN_VAPROTO / **/
+#ifdef CAN_VAPROTO
+#define _V(args) args
+#else
+#define _V(args) ()
+#endif
/* INTSIZE:
* This symbol contains the value of sizeof(int) so that the C
* example with the NeXT "fat" binaries that contain executables
* for several CPUs.
*/
-/*#define MULTIARCH /**/
+/*#define MULTIARCH / **/
/* HAS_QUAD:
* This symbol, if defined, tells that there's a 64-bit integer type,
* Quad_t, and its unsigned counterpar, Uquad_t. QUADKIND will be one
- * of QUAD_IS_INT, QUAD_IS_LONG, QUAD_IS_LONG_LONG, QUAD_IS_INT64_T
+ * of QUAD_IS_INT, QUAD_IS_LONG, QUAD_IS_LONG_LONG, QUAD_IS_INT64_T,
* or QUAD_IS___INT64.
*/
#define HAS_QUAD /**/
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
#define ARCHLIB "c:\\perl\\lib" /**/
-/*#define ARCHLIB_EXP "" /**/
+/*#define ARCHLIB_EXP "" / **/
/* ARCHNAME:
* This symbol holds a string representing the architecture name.
* This symbol, if defined, indicates that the accessx routine is
* available to do extended access checks.
*/
-/*#define HAS_ACCESSX /**/
+/*#define HAS_ACCESSX / **/
/* HAS_ASCTIME_R:
* This symbol, if defined, indicates that the asctime_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_asctime_r
* is defined.
*/
-/*#define HAS_ASCTIME_R /**/
+/*#define HAS_ASCTIME_R / **/
#define ASCTIME_R_PROTO 0 /**/
+/* The HASATTRIBUTE_* defines are left undefined here because they vary from
+ * one version of GCC to another. Instead, they are defined on the basis of
+ * the compiler version in <perl.h>.
+ */
/* HASATTRIBUTE_FORMAT:
* Can we handle GCC attribute for checking printf-style formats
*/
/* HASATTRIBUTE_WARN_UNUSED_RESULT:
* Can we handle GCC attribute for warning on unused results
*/
-/*#define HASATTRIBUTE_DEPRECATED /**/
-/*#define HASATTRIBUTE_FORMAT /**/
-/*#define PRINTF_FORMAT_NULL_OK /**/
-/*#define HASATTRIBUTE_NORETURN /**/
-/*#define HASATTRIBUTE_MALLOC /**/
-/*#define HASATTRIBUTE_NONNULL /**/
-/*#define HASATTRIBUTE_PURE /**/
-/*#define HASATTRIBUTE_UNUSED /**/
-/*#define HASATTRIBUTE_WARN_UNUSED_RESULT /**/
+/*#define HASATTRIBUTE_DEPRECATED / **/
+/*#define HASATTRIBUTE_FORMAT / **/
+/*#define PRINTF_FORMAT_NULL_OK / **/
+/*#define HASATTRIBUTE_NORETURN / **/
+/*#define HASATTRIBUTE_MALLOC / **/
+/*#define HASATTRIBUTE_NONNULL / **/
+/*#define HASATTRIBUTE_PURE / **/
+/*#define HASATTRIBUTE_UNUSED / **/
+/*#define HASATTRIBUTE_WARN_UNUSED_RESULT / **/
/* HASCONST:
* This symbol, if defined, indicates that this C compiler knows about
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_crypt_r
* is defined.
*/
-/*#define HAS_CRYPT_R /**/
+/*#define HAS_CRYPT_R / **/
#define CRYPT_R_PROTO 0 /**/
/* HAS_CSH:
/* CSH:
* This symbol, if defined, contains the full pathname of csh.
*/
-/*#define HAS_CSH /**/
+/*#define HAS_CSH / **/
#ifdef HAS_CSH
#define CSH "" /**/
#endif
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_ctermid_r
* is defined.
*/
-/*#define HAS_CTERMID_R /**/
+/*#define HAS_CTERMID_R / **/
#define CTERMID_R_PROTO 0 /**/
/* HAS_CTIME_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_ctime_r
* is defined.
*/
-/*#define HAS_CTIME_R /**/
+/*#define HAS_CTIME_R / **/
#define CTIME_R_PROTO 0 /**/
/* HAS_DRAND48_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_drand48_r
* is defined.
*/
-/*#define HAS_DRAND48_R /**/
+/*#define HAS_DRAND48_R / **/
#define DRAND48_R_PROTO 0 /**/
/* HAS_DRAND48_PROTO:
* to the program to supply one. A good guess is
* extern double drand48(void);
*/
-/*#define HAS_DRAND48_PROTO /**/
+/*#define HAS_DRAND48_PROTO / **/
/* HAS_EACCESS:
* This symbol, if defined, indicates that the eaccess routine is
* available to do extended access checks.
*/
-/*#define HAS_EACCESS /**/
+/*#define HAS_EACCESS / **/
/* HAS_ENDGRENT:
* This symbol, if defined, indicates that the getgrent routine is
* available for finalizing sequential access of the group database.
*/
-/*#define HAS_ENDGRENT /**/
+/*#define HAS_ENDGRENT / **/
/* HAS_ENDGRENT_R:
* This symbol, if defined, indicates that the endgrent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endgrent_r
* is defined.
*/
-/*#define HAS_ENDGRENT_R /**/
+/*#define HAS_ENDGRENT_R / **/
#define ENDGRENT_R_PROTO 0 /**/
/* HAS_ENDHOSTENT:
* This symbol, if defined, indicates that the endhostent() routine is
* available to close whatever was being used for host queries.
*/
-/*#define HAS_ENDHOSTENT /**/
+/*#define HAS_ENDHOSTENT / **/
/* HAS_ENDHOSTENT_R:
* This symbol, if defined, indicates that the endhostent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endhostent_r
* is defined.
*/
-/*#define HAS_ENDHOSTENT_R /**/
+/*#define HAS_ENDHOSTENT_R / **/
#define ENDHOSTENT_R_PROTO 0 /**/
/* HAS_ENDNETENT:
* This symbol, if defined, indicates that the endnetent() routine is
* available to close whatever was being used for network queries.
*/
-/*#define HAS_ENDNETENT /**/
+/*#define HAS_ENDNETENT / **/
/* HAS_ENDNETENT_R:
* This symbol, if defined, indicates that the endnetent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endnetent_r
* is defined.
*/
-/*#define HAS_ENDNETENT_R /**/
+/*#define HAS_ENDNETENT_R / **/
#define ENDNETENT_R_PROTO 0 /**/
/* HAS_ENDPROTOENT:
* This symbol, if defined, indicates that the endprotoent() routine is
* available to close whatever was being used for protocol queries.
*/
-/*#define HAS_ENDPROTOENT /**/
+/*#define HAS_ENDPROTOENT / **/
/* HAS_ENDPROTOENT_R:
* This symbol, if defined, indicates that the endprotoent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endprotoent_r
* is defined.
*/
-/*#define HAS_ENDPROTOENT_R /**/
+/*#define HAS_ENDPROTOENT_R / **/
#define ENDPROTOENT_R_PROTO 0 /**/
/* HAS_ENDPWENT:
* This symbol, if defined, indicates that the getgrent routine is
* available for finalizing sequential access of the passwd database.
*/
-/*#define HAS_ENDPWENT /**/
+/*#define HAS_ENDPWENT / **/
/* HAS_ENDPWENT_R:
* This symbol, if defined, indicates that the endpwent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endpwent_r
* is defined.
*/
-/*#define HAS_ENDPWENT_R /**/
+/*#define HAS_ENDPWENT_R / **/
#define ENDPWENT_R_PROTO 0 /**/
/* HAS_ENDSERVENT:
* This symbol, if defined, indicates that the endservent() routine is
* available to close whatever was being used for service queries.
*/
-/*#define HAS_ENDSERVENT /**/
+/*#define HAS_ENDSERVENT / **/
/* HAS_ENDSERVENT_R:
* This symbol, if defined, indicates that the endservent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endservent_r
* is defined.
*/
-/*#define HAS_ENDSERVENT_R /**/
+/*#define HAS_ENDSERVENT_R / **/
#define ENDSERVENT_R_PROTO 0 /**/
/* FLEXFILENAMES:
* This symbol, if defined, indicates that the getgrent routine is
* available for sequential access of the group database.
*/
-/*#define HAS_GETGRENT /**/
+/*#define HAS_GETGRENT / **/
/* HAS_GETGRENT_R:
* This symbol, if defined, indicates that the getgrent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrent_r
* is defined.
*/
-/*#define HAS_GETGRENT_R /**/
+/*#define HAS_GETGRENT_R / **/
#define GETGRENT_R_PROTO 0 /**/
/* HAS_GETGRGID_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrgid_r
* is defined.
*/
-/*#define HAS_GETGRGID_R /**/
+/*#define HAS_GETGRGID_R / **/
#define GETGRGID_R_PROTO 0 /**/
/* HAS_GETGRNAM_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrnam_r
* is defined.
*/
-/*#define HAS_GETGRNAM_R /**/
+/*#define HAS_GETGRNAM_R / **/
#define GETGRNAM_R_PROTO 0 /**/
/* HAS_GETHOSTBYADDR:
* This symbol, if defined, indicates that the gethostent() routine is
* available to look up host names in some data base or another.
*/
-/*#define HAS_GETHOSTENT /**/
+/*#define HAS_GETHOSTENT / **/
/* HAS_GETHOSTNAME:
* This symbol, if defined, indicates that the C program may use the
*/
#define HAS_GETHOSTNAME /**/
#define HAS_UNAME /**/
-/*#define HAS_PHOSTNAME /**/
+/*#define HAS_PHOSTNAME / **/
#ifdef HAS_PHOSTNAME
#define PHOSTNAME "" /* How to get the host name */
#endif
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostbyaddr_r
* is defined.
*/
-/*#define HAS_GETHOSTBYADDR_R /**/
+/*#define HAS_GETHOSTBYADDR_R / **/
#define GETHOSTBYADDR_R_PROTO 0 /**/
/* HAS_GETHOSTBYNAME_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostbyname_r
* is defined.
*/
-/*#define HAS_GETHOSTBYNAME_R /**/
+/*#define HAS_GETHOSTBYNAME_R / **/
#define GETHOSTBYNAME_R_PROTO 0 /**/
/* HAS_GETHOSTENT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostent_r
* is defined.
*/
-/*#define HAS_GETHOSTENT_R /**/
+/*#define HAS_GETHOSTENT_R / **/
#define GETHOSTENT_R_PROTO 0 /**/
/* HAS_GETHOST_PROTOS:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getlogin_r
* is defined.
*/
-/*#define HAS_GETLOGIN_R /**/
+/*#define HAS_GETLOGIN_R / **/
#define GETLOGIN_R_PROTO 0 /**/
/* HAS_GETNETBYADDR:
* This symbol, if defined, indicates that the getnetbyaddr() routine is
* available to look up networks by their IP addresses.
*/
-/*#define HAS_GETNETBYADDR /**/
+/*#define HAS_GETNETBYADDR / **/
/* HAS_GETNETBYNAME:
* This symbol, if defined, indicates that the getnetbyname() routine is
* available to look up networks by their names.
*/
-/*#define HAS_GETNETBYNAME /**/
+/*#define HAS_GETNETBYNAME / **/
/* HAS_GETNETENT:
* This symbol, if defined, indicates that the getnetent() routine is
* available to look up network names in some data base or another.
*/
-/*#define HAS_GETNETENT /**/
+/*#define HAS_GETNETENT / **/
/* HAS_GETNETBYADDR_R:
* This symbol, if defined, indicates that the getnetbyaddr_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetbyaddr_r
* is defined.
*/
-/*#define HAS_GETNETBYADDR_R /**/
+/*#define HAS_GETNETBYADDR_R / **/
#define GETNETBYADDR_R_PROTO 0 /**/
/* HAS_GETNETBYNAME_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetbyname_r
* is defined.
*/
-/*#define HAS_GETNETBYNAME_R /**/
+/*#define HAS_GETNETBYNAME_R / **/
#define GETNETBYNAME_R_PROTO 0 /**/
/* HAS_GETNETENT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetent_r
* is defined.
*/
-/*#define HAS_GETNETENT_R /**/
+/*#define HAS_GETNETENT_R / **/
#define GETNETENT_R_PROTO 0 /**/
/* HAS_GETNET_PROTOS:
* getnetbyaddr(). Otherwise, it is up to the program to guess
* them. See netdbtype.U for probing for various Netdb_xxx_t types.
*/
-/*#define HAS_GETNET_PROTOS /**/
+/*#define HAS_GETNET_PROTOS / **/
/* HAS_GETPROTOENT:
* This symbol, if defined, indicates that the getprotoent() routine is
* available to look up protocols in some data base or another.
*/
-/*#define HAS_GETPROTOENT /**/
+/*#define HAS_GETPROTOENT / **/
/* HAS_GETPGRP:
* This symbol, if defined, indicates that the getpgrp routine is
* This symbol, if defined, indicates that getpgrp needs one
* arguments whereas USG one needs none.
*/
-/*#define HAS_GETPGRP /**/
-/*#define USE_BSD_GETPGRP /**/
+/*#define HAS_GETPGRP / **/
+/*#define USE_BSD_GETPGRP / **/
/* HAS_GETPROTOBYNAME:
* This symbol, if defined, indicates that the getprotobyname()
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotobyname_r
* is defined.
*/
-/*#define HAS_GETPROTOBYNAME_R /**/
+/*#define HAS_GETPROTOBYNAME_R / **/
#define GETPROTOBYNAME_R_PROTO 0 /**/
/* HAS_GETPROTOBYNUMBER_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotobynumber_r
* is defined.
*/
-/*#define HAS_GETPROTOBYNUMBER_R /**/
+/*#define HAS_GETPROTOBYNUMBER_R / **/
#define GETPROTOBYNUMBER_R_PROTO 0 /**/
/* HAS_GETPROTOENT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotoent_r
* is defined.
*/
-/*#define HAS_GETPROTOENT_R /**/
+/*#define HAS_GETPROTOENT_R / **/
#define GETPROTOENT_R_PROTO 0 /**/
/* HAS_GETPROTO_PROTOS:
* available for sequential access of the passwd database.
* If this is not available, the older getpw() function may be available.
*/
-/*#define HAS_GETPWENT /**/
+/*#define HAS_GETPWENT / **/
/* HAS_GETPWENT_R:
* This symbol, if defined, indicates that the getpwent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwent_r
* is defined.
*/
-/*#define HAS_GETPWENT_R /**/
+/*#define HAS_GETPWENT_R / **/
#define GETPWENT_R_PROTO 0 /**/
/* HAS_GETPWNAM_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwnam_r
* is defined.
*/
-/*#define HAS_GETPWNAM_R /**/
+/*#define HAS_GETPWNAM_R / **/
#define GETPWNAM_R_PROTO 0 /**/
/* HAS_GETPWUID_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwuid_r
* is defined.
*/
-/*#define HAS_GETPWUID_R /**/
+/*#define HAS_GETPWUID_R / **/
#define GETPWUID_R_PROTO 0 /**/
/* HAS_GETSERVENT:
* This symbol, if defined, indicates that the getservent() routine is
* available to look up network services in some data base or another.
*/
-/*#define HAS_GETSERVENT /**/
+/*#define HAS_GETSERVENT / **/
/* HAS_GETSERVBYNAME_R:
* This symbol, if defined, indicates that the getservbyname_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservbyname_r
* is defined.
*/
-/*#define HAS_GETSERVBYNAME_R /**/
+/*#define HAS_GETSERVBYNAME_R / **/
#define GETSERVBYNAME_R_PROTO 0 /**/
/* HAS_GETSERVBYPORT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservbyport_r
* is defined.
*/
-/*#define HAS_GETSERVBYPORT_R /**/
+/*#define HAS_GETSERVBYPORT_R / **/
#define GETSERVBYPORT_R_PROTO 0 /**/
/* HAS_GETSERVENT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservent_r
* is defined.
*/
-/*#define HAS_GETSERVENT_R /**/
+/*#define HAS_GETSERVENT_R / **/
#define GETSERVENT_R_PROTO 0 /**/
/* HAS_GETSERV_PROTOS:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getspnam_r
* is defined.
*/
-/*#define HAS_GETSPNAM_R /**/
+/*#define HAS_GETSPNAM_R / **/
#define GETSPNAM_R_PROTO 0 /**/
/* HAS_GETSERVBYNAME:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_gmtime_r
* is defined.
*/
-/*#define HAS_GMTIME_R /**/
+/*#define HAS_GMTIME_R / **/
#define GMTIME_R_PROTO 0 /**/
/* HAS_HTONL:
* changes using \undef{TZ} without explicitly calling tzset
* impossible. This symbol makes us call tzset before localtime_r
*/
-/*#define LOCALTIME_R_NEEDS_TZSET /**/
+/*#define LOCALTIME_R_NEEDS_TZSET / **/
#ifdef LOCALTIME_R_NEEDS_TZSET
#define L_R_TZSET tzset(),
#else
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_localtime_r
* is defined.
*/
-/*#define HAS_LOCALTIME_R /**/
+/*#define HAS_LOCALTIME_R / **/
#define LOCALTIME_R_PROTO 0 /**/
/* HAS_LONG_DOUBLE:
* available to exclusively create and open a uniquely named
* temporary file.
*/
-/*#define HAS_MKSTEMP /**/
+/*#define HAS_MKSTEMP / **/
/* HAS_MMAP:
* This symbol, if defined, indicates that the mmap system call is
* (and simultaneously the type of the first argument).
* Usually set to 'void *' or 'caddr_t'.
*/
-/*#define HAS_MMAP /**/
+/*#define HAS_MMAP / **/
#define Mmap_t void * /**/
/* HAS_MSG:
* This symbol, if defined, indicates that the entire msg*(2) library is
* supported (IPC mechanism based on message queues).
*/
-/*#define HAS_MSG /**/
+/*#define HAS_MSG / **/
/* OLD_PTHREAD_CREATE_JOINABLE:
* This symbol, if defined, indicates how to create pthread
* If defined, known values are PTHREAD_CREATE_UNDETACHED
* and __UNDETACHED.
*/
-/*#define OLD_PTHREAD_CREATE_JOINABLE /**/
+/*#define OLD_PTHREAD_CREATE_JOINABLE / **/
/* HAS_PTHREAD_ATFORK:
* This symbol, if defined, indicates that the pthread_atfork routine
* is available to setup fork handlers.
*/
-/*#define HAS_PTHREAD_ATFORK /**/
+/*#define HAS_PTHREAD_ATFORK / **/
/* HAS_PTHREAD_YIELD:
* This symbol, if defined, indicates that the pthread_yield
* routine is available to yield the execution of the current
* thread. sched_yield is preferable to pthread_yield.
*/
-/*#define HAS_PTHREAD_YIELD /**/
+/*#define HAS_PTHREAD_YIELD / **/
#define SCHED_YIELD /**/
-/*#define HAS_SCHED_YIELD /**/
+/*#define HAS_SCHED_YIELD / **/
/* HAS_RANDOM_R:
* This symbol, if defined, indicates that the random_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_random_r
* is defined.
*/
-/*#define HAS_RANDOM_R /**/
+/*#define HAS_RANDOM_R / **/
#define RANDOM_R_PROTO 0 /**/
/* HAS_READDIR64_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_readdir64_r
* is defined.
*/
-/*#define HAS_READDIR64_R /**/
+/*#define HAS_READDIR64_R / **/
#define READDIR64_R_PROTO 0 /**/
/* HAS_READDIR_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_readdir_r
* is defined.
*/
-/*#define HAS_READDIR_R /**/
+/*#define HAS_READDIR_R / **/
#define READDIR_R_PROTO 0 /**/
/* HAS_SEM:
* This symbol, if defined, indicates that the entire sem*(2) library is
* supported.
*/
-/*#define HAS_SEM /**/
+/*#define HAS_SEM / **/
/* HAS_SETGRENT:
* This symbol, if defined, indicates that the setgrent routine is
* available for initializing sequential access of the group database.
*/
-/*#define HAS_SETGRENT /**/
+/*#define HAS_SETGRENT / **/
/* HAS_SETGRENT_R:
* This symbol, if defined, indicates that the setgrent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setgrent_r
* is defined.
*/
-/*#define HAS_SETGRENT_R /**/
+/*#define HAS_SETGRENT_R / **/
#define SETGRENT_R_PROTO 0 /**/
/* HAS_SETHOSTENT:
* This symbol, if defined, indicates that the sethostent() routine is
* available.
*/
-/*#define HAS_SETHOSTENT /**/
+/*#define HAS_SETHOSTENT / **/
/* HAS_SETHOSTENT_R:
* This symbol, if defined, indicates that the sethostent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_sethostent_r
* is defined.
*/
-/*#define HAS_SETHOSTENT_R /**/
+/*#define HAS_SETHOSTENT_R / **/
#define SETHOSTENT_R_PROTO 0 /**/
/* HAS_SETLOCALE_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setlocale_r
* is defined.
*/
-/*#define HAS_SETLOCALE_R /**/
+/*#define HAS_SETLOCALE_R / **/
#define SETLOCALE_R_PROTO 0 /**/
/* HAS_SETNETENT:
* This symbol, if defined, indicates that the setnetent() routine is
* available.
*/
-/*#define HAS_SETNETENT /**/
+/*#define HAS_SETNETENT / **/
/* HAS_SETNETENT_R:
* This symbol, if defined, indicates that the setnetent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setnetent_r
* is defined.
*/
-/*#define HAS_SETNETENT_R /**/
+/*#define HAS_SETNETENT_R / **/
#define SETNETENT_R_PROTO 0 /**/
/* HAS_SETPROTOENT:
* This symbol, if defined, indicates that the setprotoent() routine is
* available.
*/
-/*#define HAS_SETPROTOENT /**/
+/*#define HAS_SETPROTOENT / **/
/* HAS_SETPGRP:
* This symbol, if defined, indicates that the setpgrp routine is
* arguments whereas USG one needs none. See also HAS_SETPGID
* for a POSIX interface.
*/
-/*#define HAS_SETPGRP /**/
-/*#define USE_BSD_SETPGRP /**/
+/*#define HAS_SETPGRP / **/
+/*#define USE_BSD_SETPGRP / **/
/* HAS_SETPROTOENT_R:
* This symbol, if defined, indicates that the setprotoent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setprotoent_r
* is defined.
*/
-/*#define HAS_SETPROTOENT_R /**/
+/*#define HAS_SETPROTOENT_R / **/
#define SETPROTOENT_R_PROTO 0 /**/
/* HAS_SETPWENT:
* This symbol, if defined, indicates that the setpwent routine is
* available for initializing sequential access of the passwd database.
*/
-/*#define HAS_SETPWENT /**/
+/*#define HAS_SETPWENT / **/
/* HAS_SETPWENT_R:
* This symbol, if defined, indicates that the setpwent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setpwent_r
* is defined.
*/
-/*#define HAS_SETPWENT_R /**/
+/*#define HAS_SETPWENT_R / **/
#define SETPWENT_R_PROTO 0 /**/
/* HAS_SETSERVENT:
* This symbol, if defined, indicates that the setservent() routine is
* available.
*/
-/*#define HAS_SETSERVENT /**/
+/*#define HAS_SETSERVENT / **/
/* HAS_SETSERVENT_R:
* This symbol, if defined, indicates that the setservent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setservent_r
* is defined.
*/
-/*#define HAS_SETSERVENT_R /**/
+/*#define HAS_SETSERVENT_R / **/
#define SETSERVENT_R_PROTO 0 /**/
/* HAS_SETVBUF:
* This symbol, if defined, indicates that the entire shm*(2) library is
* supported.
*/
-/*#define HAS_SHM /**/
+/*#define HAS_SHM / **/
/* Shmat_t:
* This symbol holds the return type of the shmat() system call.
* when HAS_SHMAT_PROTOTYPE is not defined to avoid conflicting defs.
*/
#define Shmat_t void * /**/
-/*#define HAS_SHMAT_PROTOTYPE /**/
+/*#define HAS_SHMAT_PROTOTYPE / **/
/* HAS_SOCKET:
* This symbol, if defined, indicates that the BSD socket interface is
* has been known to be an enum.
*/
#define HAS_SOCKET /**/
-/*#define HAS_SOCKETPAIR /**/
-/*#define HAS_MSG_CTRUNC /**/
-/*#define HAS_MSG_DONTROUTE /**/
-/*#define HAS_MSG_OOB /**/
-/*#define HAS_MSG_PEEK /**/
-/*#define HAS_MSG_PROXY /**/
-/*#define HAS_SCM_RIGHTS /**/
+/*#define HAS_SOCKETPAIR / **/
+/*#define HAS_MSG_CTRUNC / **/
+/*#define HAS_MSG_DONTROUTE / **/
+/*#define HAS_MSG_OOB / **/
+/*#define HAS_MSG_PEEK / **/
+/*#define HAS_MSG_PROXY / **/
+/*#define HAS_SCM_RIGHTS / **/
/* HAS_SRAND48_R:
* This symbol, if defined, indicates that the srand48_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_srand48_r
* is defined.
*/
-/*#define HAS_SRAND48_R /**/
+/*#define HAS_SRAND48_R / **/
#define SRAND48_R_PROTO 0 /**/
/* HAS_SRANDOM_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_srandom_r
* is defined.
*/
-/*#define HAS_SRANDOM_R /**/
+/*#define HAS_SRANDOM_R / **/
#define SRANDOM_R_PROTO 0 /**/
/* USE_STAT_BLOCKS:
* st_blksize and st_blocks.
*/
#ifndef USE_STAT_BLOCKS
-/*#define USE_STAT_BLOCKS /**/
+/*#define USE_STAT_BLOCKS / **/
#endif
/* USE_STRUCT_COPY:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_strerror_r
* is defined.
*/
-/*#define HAS_STRERROR_R /**/
+/*#define HAS_STRERROR_R / **/
#define STRERROR_R_PROTO 0 /**/
/* HAS_STRTOUL:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_tmpnam_r
* is defined.
*/
-/*#define HAS_TMPNAM_R /**/
+/*#define HAS_TMPNAM_R / **/
#define TMPNAM_R_PROTO 0 /**/
/* HAS_TTYNAME_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_ttyname_r
* is defined.
*/
-/*#define HAS_TTYNAME_R /**/
+/*#define HAS_TTYNAME_R / **/
#define TTYNAME_R_PROTO 0 /**/
/* HAS_UNION_SEMUN:
* used for semctl IPC_STAT.
*/
#define HAS_UNION_SEMUN /**/
-/*#define USE_SEMCTL_SEMUN /**/
-/*#define USE_SEMCTL_SEMID_DS /**/
+/*#define USE_SEMCTL_SEMUN / **/
+/*#define USE_SEMCTL_SEMID_DS / **/
/* HAS_VFORK:
* This symbol, if defined, indicates that vfork() exists.
*/
-/*#define HAS_VFORK /**/
+/*#define HAS_VFORK / **/
/* HAS_PSEUDOFORK:
* This symbol, if defined, indicates that an emulation of the
* fork routine is available.
*/
-/*#define HAS_PSEUDOFORK /**/
+/*#define HAS_PSEUDOFORK / **/
/* Signal_t:
* This symbol's value is either "void" or "int", corresponding to the
* This symbol, if defined, indicates to the C program that struct group
* in <grp.h> contains gr_passwd.
*/
-/*#define I_GRP /**/
-/*#define GRPASSWD /**/
+/*#define I_GRP / **/
+/*#define GRPASSWD / **/
/* I_MACH_CTHREADS:
* This symbol, if defined, indicates to the C program that it should
* include <mach/cthreads.h>.
*/
-/*#define I_MACH_CTHREADS /**/
+/*#define I_MACH_CTHREADS / **/
/* I_NDBM:
* This symbol, if defined, indicates that <ndbm.h> exists and should
* parameter information. While ANSI C prototypes are supported in C++,
* K&R style function declarations will yield errors.
*/
-/*#define I_NDBM /**/
-/*#define I_GDBMNDBM /**/
-/*#define I_GDBM_NDBM /**/
-/*#define NDBM_H_USES_PROTOTYPES /**/
-/*#define GDBMNDBM_H_USES_PROTOTYPES /**/
-/*#define GDBM_NDBM_H_USES_PROTOTYPES /**/
+/*#define I_NDBM / **/
+/*#define I_GDBMNDBM / **/
+/*#define I_GDBM_NDBM / **/
+/*#define NDBM_H_USES_PROTOTYPES / **/
+/*#define GDBMNDBM_H_USES_PROTOTYPES / **/
+/*#define GDBM_NDBM_H_USES_PROTOTYPES / **/
/* I_NETDB:
* This symbol, if defined, indicates that <netdb.h> exists and
* should be included.
*/
-/*#define I_NETDB /**/
+/*#define I_NETDB / **/
/* I_NET_ERRNO:
* This symbol, if defined, indicates that <net/errno.h> exists and
* should be included.
*/
-/*#define I_NET_ERRNO /**/
+/*#define I_NET_ERRNO / **/
/* I_PTHREAD:
* This symbol, if defined, indicates to the C program that it should
* include <pthread.h>.
*/
-/*#define I_PTHREAD /**/
+/*#define I_PTHREAD / **/
/* I_PWD:
* This symbol, if defined, indicates to the C program that it should
* This symbol, if defined, indicates to the C program that struct passwd
* contains pw_passwd.
*/
-/*#define I_PWD /**/
-/*#define PWQUOTA /**/
-/*#define PWAGE /**/
-/*#define PWCHANGE /**/
-/*#define PWCLASS /**/
-/*#define PWEXPIRE /**/
-/*#define PWCOMMENT /**/
-/*#define PWGECOS /**/
-/*#define PWPASSWD /**/
+/*#define I_PWD / **/
+/*#define PWQUOTA / **/
+/*#define PWAGE / **/
+/*#define PWCHANGE / **/
+/*#define PWCLASS / **/
+/*#define PWEXPIRE / **/
+/*#define PWCOMMENT / **/
+/*#define PWGECOS / **/
+/*#define PWPASSWD / **/
/* I_SYS_ACCESS:
* This symbol, if defined, indicates to the C program that it should
* include <sys/access.h>.
*/
-/*#define I_SYS_ACCESS /**/
+/*#define I_SYS_ACCESS / **/
/* I_SYS_SECURITY:
* This symbol, if defined, indicates to the C program that it should
* include <sys/security.h>.
*/
-/*#define I_SYS_SECURITY /**/
+/*#define I_SYS_SECURITY / **/
/* I_SYSUIO:
* This symbol, if defined, indicates that <sys/uio.h> exists and
* should be included.
*/
-/*#define I_SYSUIO /**/
+/*#define I_SYSUIO / **/
/* I_STDARG:
* This symbol, if defined, indicates that <stdarg.h> exists and should
* include <varargs.h>.
*/
#define I_STDARG /**/
-/*#define I_VARARGS /**/
+/*#define I_VARARGS / **/
/* PERL_INC_VERSION_LIST:
* This variable specifies the list of subdirectories in over
* for a C initialization string. See the inc_version_list entry
* in Porting/Glossary for more details.
*/
-/*#define PERL_INC_VERSION_LIST 0 /**/
+/*#define PERL_INC_VERSION_LIST 0 / **/
/* INSTALL_USR_BIN_PERL:
* This symbol, if defined, indicates that Perl is to be installed
* also as /usr/bin/perl.
*/
-/*#define INSTALL_USR_BIN_PERL /**/
+/*#define INSTALL_USR_BIN_PERL / **/
/* Off_t:
* This symbol holds the type used to declare offsets in the kernel.
/* MYMALLOC:
* This symbol, if defined, indicates that we're using our own malloc.
*/
-/*#define MYMALLOC /**/
+/*#define MYMALLOC / **/
/* Mode_t:
* This symbol holds the type used to declare file modes
* and architecture-specific directories. See PERL_INC_VERSION_LIST
* for more details.
*/
-/*#define PERL_OTHERLIBDIRS "" /**/
+/*#define PERL_OTHERLIBDIRS "" / **/
/* Pid_t:
* This symbol holds the type used to declare process ids in the kernel.
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
#define SITEARCH "c:\\perl\\site\\lib" /**/
-/*#define SITEARCH_EXP "" /**/
+/*#define SITEARCH_EXP "" / **/
/* SITELIB:
* This symbol contains the name of the private library for this package.
* try to use the various _r versions of library functions.
* This is extremely experimental.
*/
-/*#define USE_5005THREADS /**/
-/*#define USE_ITHREADS /**/
+/*#define USE_5005THREADS / **/
+/*#define USE_ITHREADS / **/
#if defined(USE_5005THREADS) && !defined(USE_ITHREADS)
#define USE_THREADS /* until src is revised*/
#endif
-/*#define OLD_PTHREADS_API /**/
-/*#define USE_REENTRANT_API /**/
+/*#define OLD_PTHREADS_API / **/
+/*#define USE_REENTRANT_API / **/
/* PERL_VENDORARCH:
* If defined, this symbol contains the name of a private library.
* This symbol contains the ~name expanded version of PERL_VENDORARCH, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-/*#define PERL_VENDORARCH "" /**/
-/*#define PERL_VENDORARCH_EXP "" /**/
+/*#define PERL_VENDORARCH "" / **/
+/*#define PERL_VENDORARCH_EXP "" / **/
/* PERL_VENDORLIB_EXP:
* This symbol contains the ~name expanded version of VENDORLIB, to be used
* removed. The elements in inc_version_list (inc_version_list.U) can
* be tacked onto this variable to generate a list of directories to search.
*/
-/*#define PERL_VENDORLIB_EXP "" /**/
-/*#define PERL_VENDORLIB_STEM "" /**/
+/*#define PERL_VENDORLIB_EXP "" / **/
+/*#define PERL_VENDORLIB_STEM "" / **/
/* VOIDFLAGS:
* This symbol indicates how much support of the void type is given by this
* Perl has been cross-compiled to. Undefined if not a cross-compile.
*/
#ifndef USE_CROSS_COMPILE
-/*#define USE_CROSS_COMPILE /**/
+/*#define USE_CROSS_COMPILE / **/
#define PERL_TARGETARCH "" /**/
#endif
#define BYTEORDER 0x1234 /* large digits for MSB */
#endif /* NeXT */
+/* CHARBITS:
+ * This symbol contains the size of a char, so that the C preprocessor
+ * can make decisions based on it.
+ */
+#define CHARBITS 8 /**/
+
/* CASTI32:
* This symbol is defined if the C compiler can cast negative
* or large floating point numbers to 32-bit ints.
*/
#ifndef _MSC_VER
-# define CASTI32 /**/
+# define CASTI32 /**/
#endif
/* CASTNEGFLOAT:
* This symbol, if defined, indicates that the closedir() routine
* does not return a value.
*/
-/*#define VOID_CLOSEDIR /**/
+/*#define VOID_CLOSEDIR / **/
/* HAS_FD_SET:
* This symbol, when defined, indicates presence of the fd_set typedef
* is available to get system page size, which is the granularity of
* many memory management calls.
*/
-/*#define HAS_GETPAGESIZE /**/
+/*#define HAS_GETPAGESIZE / **/
/* HAS_GNULIBC:
* This symbol, if defined, indicates to the C program that
* the GNU C library is being used. A better check is to use
* the __GLIBC__ and __GLIBC_MINOR__ symbols supplied with glibc.
*/
-/*#define HAS_GNULIBC /**/
+/*#define HAS_GNULIBC / **/
#if defined(HAS_GNULIBC) && !defined(_GNU_SOURCE)
# define _GNU_SOURCE
#endif
* available to operate on a symbolic link (instead of following the
* link).
*/
-/*#define HAS_LCHOWN /**/
+/*#define HAS_LCHOWN / **/
/* HAS_OPEN3:
* This manifest constant lets the C program know that the three
* argument form of open(2) is available.
*/
-/*#define HAS_OPEN3 /**/
+/*#define HAS_OPEN3 / **/
/* HAS_SAFE_BCOPY:
* This symbol, if defined, indicates that the bcopy routine is available
* probably use memmove() or memcpy(). If neither is defined, roll your
* own version.
*/
-/*#define HAS_SAFE_BCOPY /**/
+/*#define HAS_SAFE_BCOPY / **/
/* HAS_SAFE_MEMCPY:
* This symbol, if defined, indicates that the memcpy routine is available
* copy overlapping memory blocks, you should check HAS_MEMMOVE and
* use memmove() instead, if available.
*/
-/*#define HAS_SAFE_MEMCPY /**/
+/*#define HAS_SAFE_MEMCPY / **/
/* HAS_SANE_MEMCMP:
* This symbol, if defined, indicates that the memcmp routine is available
* This symbol, if defined, indicates that Vr4's sigaction() routine
* is available.
*/
-/*#define HAS_SIGACTION /**/
+/*#define HAS_SIGACTION / **/
/* HAS_SIGSETJMP:
* This variable indicates to the C program that the sigsetjmp()
* traditional longjmp() if siglongjmp isn't available.
* See HAS_SIGSETJMP.
*/
-/*#define HAS_SIGSETJMP /**/
+/*#define HAS_SIGSETJMP / **/
#ifdef HAS_SIGSETJMP
#define Sigjmp_buf sigjmp_buf
#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask))
#define STDIO_PTR_LVALUE /**/
#define FILE_cnt(fp) ((fp)->_cnt)
#define STDIO_CNT_LVALUE /**/
-/*#define STDIO_PTR_LVAL_SETS_CNT /**/
+/*#define STDIO_PTR_LVAL_SETS_CNT / **/
#define STDIO_PTR_LVAL_NOCHANGE_CNT /**/
#endif
* symbol.
*/
#define HAS_VPRINTF /**/
-/*#define USE_CHAR_VSPRINTF /**/
+/*#define USE_CHAR_VSPRINTF / **/
/* DOUBLESIZE:
* This symbol contains the size of a double, so that the C preprocessor
* the struct tm has a tm_gmtoff field.
*/
#define I_TIME /**/
-/*#define I_SYS_TIME /**/
-/*#define I_SYS_TIME_KERNEL /**/
-/*#define HAS_TM_TM_ZONE /**/
-/*#define HAS_TM_TM_GMTOFF /**/
+/*#define I_SYS_TIME / **/
+/*#define I_SYS_TIME_KERNEL / **/
+/*#define HAS_TM_TM_ZONE / **/
+/*#define HAS_TM_TM_GMTOFF / **/
/* VAL_O_NONBLOCK:
* This symbol is to be used during open() or fcntl(F_SETFL) to turn on
* This symbol, if defined, indicates that this system uses
* EBCDIC encoding.
*/
-/*#define EBCDIC /**/
+/*#define EBCDIC / **/
/* SETUID_SCRIPTS_ARE_SECURE_NOW:
* This symbol, if defined, indicates that the bug that prevents
* subprocesses to which it must pass the filename rather than the
* file descriptor of the script to be executed.
*/
-/*#define SETUID_SCRIPTS_ARE_SECURE_NOW /**/
-/*#define DOSUID /**/
+/*#define SETUID_SCRIPTS_ARE_SECURE_NOW / **/
+/*#define DOSUID / **/
/* PERL_USE_DEVEL:
* This symbol, if defined, indicates that Perl was configured with
* -Dusedevel, to enable development features. This should not be
* done for production builds.
*/
-/*#define PERL_USE_DEVEL /**/
+/*#define PERL_USE_DEVEL / **/
/* HAS_ATOLF:
* This symbol, if defined, indicates that the atolf routine is
* available to convert strings into long doubles.
*/
-/*#define HAS_ATOLF /**/
+/*#define HAS_ATOLF / **/
/* HAS_ATOLL:
* This symbol, if defined, indicates that the atoll routine is
* This symbol, if defined, indicates that the _fwalk system call is
* available to apply a function to all the file handles.
*/
-/*#define HAS__FWALK /**/
+/*#define HAS__FWALK / **/
/* HAS_AINTL:
* This symbol, if defined, indicates that the aintl routine is
* available. If copysignl is also present we can emulate modfl.
*/
-/*#define HAS_AINTL /**/
+/*#define HAS_AINTL / **/
/* HAS_BUILTIN_CHOOSE_EXPR:
* Can we handle GCC builtin for compile-time ternary-like expressions
* Can we handle GCC builtin for telling that certain values are more
* likely
*/
-/*#define HAS_BUILTIN_EXPECT /**/
-/*#define HAS_BUILTIN_CHOOSE_EXPR /**/
+/*#define HAS_BUILTIN_EXPECT / **/
+/*#define HAS_BUILTIN_CHOOSE_EXPR / **/
/* HAS_C99_VARIADIC_MACROS:
* If defined, the compiler supports C99 variadic macros.
*/
-/*#define HAS_C99_VARIADIC_MACROS /**/
+/*#define HAS_C99_VARIADIC_MACROS / **/
/* HAS_CLASS:
* This symbol, if defined, indicates that the class routine is
* FP_NANS Signaling Not a Number (NaNS)
* FP_NANQ Quiet Not a Number (NaNQ)
*/
-/*#define HAS_CLASS /**/
+/*#define HAS_CLASS / **/
/* HAS_CLEARENV:
* This symbol, if defined, indicates that the clearenv () routine is
* available for use.
*/
-/*#define HAS_CLEARENV /**/
+/*#define HAS_CLEARENV / **/
/* HAS_STRUCT_CMSGHDR:
* This symbol, if defined, indicates that the struct cmsghdr
* is supported.
*/
-/*#define HAS_STRUCT_CMSGHDR /**/
+/*#define HAS_STRUCT_CMSGHDR / **/
/* HAS_COPYSIGNL:
* This symbol, if defined, indicates that the copysignl routine is
* available. If aintl is also present we can emulate modfl.
*/
-/*#define HAS_COPYSIGNL /**/
+/*#define HAS_COPYSIGNL / **/
/* USE_CPLUSPLUS:
* This symbol, if defined, indicates that a C++ compiler was
* used to compiled Perl and will be used to compile extensions.
*/
-/*#define USE_CPLUSPLUS /**/
+/*#define USE_CPLUSPLUS / **/
/* HAS_DBMINIT_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. A good guess is
* extern int dbminit(char *);
*/
-/*#define HAS_DBMINIT_PROTO /**/
+/*#define HAS_DBMINIT_PROTO / **/
/* HAS_DIR_DD_FD:
* This symbol, if defined, indicates that the the DIR* dirstream
* structure contains a member variable named dd_fd.
*/
-/*#define HAS_DIR_DD_FD /**/
+/*#define HAS_DIR_DD_FD / **/
/* HAS_DIRFD:
* This manifest constant lets the C program know that dirfd
* is available.
*/
-/*#define HAS_DIRFD /**/
+/*#define HAS_DIRFD / **/
/* DLSYM_NEEDS_UNDERSCORE:
* This symbol, if defined, indicates that we need to prepend an
* makes sense if you *have* dlsym, which we will presume is the
* case if you're using dl_dlopen.xs.
*/
-/*#define DLSYM_NEEDS_UNDERSCORE /**/
+/*#define DLSYM_NEEDS_UNDERSCORE / **/
/* HAS_FAST_STDIO:
* This symbol, if defined, indicates that the "fast stdio"
* This symbol, if defined, indicates that the fchdir routine is
* available to change directory using a file descriptor.
*/
-/*#define HAS_FCHDIR /**/
+/*#define HAS_FCHDIR / **/
/* FCNTL_CAN_LOCK:
* This symbol, if defined, indicates that fcntl() can be used
* for file locking. Normally on Unix systems this is defined.
* It may be undefined on VMS.
*/
-/*#define FCNTL_CAN_LOCK /**/
+/*#define FCNTL_CAN_LOCK / **/
/* HAS_FINITE:
* This symbol, if defined, indicates that the finite routine is
* available to check whether a double is finite (non-infinity non-NaN).
*/
-/*#define HAS_FINITE /**/
+/*#define HAS_FINITE / **/
/* HAS_FINITEL:
* This symbol, if defined, indicates that the finitel routine is
* available to check whether a long double is finite
* (non-infinity non-NaN).
*/
-/*#define HAS_FINITEL /**/
+/*#define HAS_FINITEL / **/
/* HAS_FLOCK_PROTO:
* This symbol, if defined, indicates that the system provides
* FP_POS_ZERO +0.0 (positive zero)
* FP_NEG_ZERO -0.0 (negative zero)
*/
-/*#define HAS_FP_CLASS /**/
+/*#define HAS_FP_CLASS / **/
/* HAS_FPCLASS:
* This symbol, if defined, indicates that the fpclass routine is
* FP_NNORM negative normalized non-zero
* FP_PNORM positive normalized non-zero
*/
-/*#define HAS_FPCLASS /**/
+/*#define HAS_FPCLASS / **/
/* HAS_FPCLASSIFY:
* This symbol, if defined, indicates that the fpclassify routine is
* FP_NAN NaN
*
*/
-/*#define HAS_FPCLASSIFY /**/
+/*#define HAS_FPCLASSIFY / **/
/* HAS_FPCLASSL:
* This symbol, if defined, indicates that the fpclassl routine is
* FP_NNORM negative normalized non-zero
* FP_PNORM positive normalized non-zero
*/
-/*#define HAS_FPCLASSL /**/
+/*#define HAS_FPCLASSL / **/
/* HAS_FPOS64_T:
* This symbol will be defined if the C compiler supports fpos64_t.
*/
-/*#define HAS_FPOS64_T /**/
+/*#define HAS_FPOS64_T / **/
/* HAS_FREXPL:
* This symbol, if defined, indicates that the frexpl routine is
* available to break a long double floating-point number into
* a normalized fraction and an integral power of 2.
*/
-/*#define HAS_FREXPL /**/
+/*#define HAS_FREXPL / **/
/* HAS_STRUCT_FS_DATA:
* This symbol, if defined, indicates that the struct fs_data
* to do statfs() is supported.
*/
-/*#define HAS_STRUCT_FS_DATA /**/
+/*#define HAS_STRUCT_FS_DATA / **/
/* HAS_FSEEKO:
* This symbol, if defined, indicates that the fseeko routine is
* available to fseek beyond 32 bits (useful for ILP32 hosts).
*/
-/*#define HAS_FSEEKO /**/
+/*#define HAS_FSEEKO / **/
/* HAS_FSTATFS:
* This symbol, if defined, indicates that the fstatfs routine is
* available to stat filesystems by file descriptors.
*/
-/*#define HAS_FSTATFS /**/
+/*#define HAS_FSTATFS / **/
/* HAS_FSYNC:
* This symbol, if defined, indicates that the fsync routine is
* available to write a file's modified data and attributes to
* permanent storage.
*/
-/*#define HAS_FSYNC /**/
+/*#define HAS_FSYNC / **/
/* HAS_FTELLO:
* This symbol, if defined, indicates that the ftello routine is
* available to ftell beyond 32 bits (useful for ILP32 hosts).
*/
-/*#define HAS_FTELLO /**/
+/*#define HAS_FTELLO / **/
/* HAS_FUTIMES:
* This symbol, if defined, indicates that the futimes routine is
* available to change file descriptor time stamps with struct timevals.
*/
-/*#define HAS_FUTIMES /**/
+/*#define HAS_FUTIMES / **/
/* HAS_GETADDRINFO:
* This symbol, if defined, indicates that the getaddrinfo() function
* is available for use.
*/
-/*#define HAS_GETADDRINFO /**/
+/*#define HAS_GETADDRINFO / **/
/* HAS_GETCWD:
* This symbol, if defined, indicates that the getcwd routine is
* This symbol, if defined, indicates that the getespwnam system call is
* available to retrieve enchanced (shadow) password entries by name.
*/
-/*#define HAS_GETESPWNAM /**/
+/*#define HAS_GETESPWNAM / **/
/* HAS_GETFSSTAT:
* This symbol, if defined, indicates that the getfsstat routine is
* available to stat filesystems in bulk.
*/
-/*#define HAS_GETFSSTAT /**/
+/*#define HAS_GETFSSTAT / **/
/* HAS_GETITIMER:
* This symbol, if defined, indicates that the getitimer routine is
* available to return interval timers.
*/
-/*#define HAS_GETITIMER /**/
+/*#define HAS_GETITIMER / **/
/* HAS_GETMNT:
* This symbol, if defined, indicates that the getmnt routine is
* available to get filesystem mount info by filename.
*/
-/*#define HAS_GETMNT /**/
+/*#define HAS_GETMNT / **/
/* HAS_GETMNTENT:
* This symbol, if defined, indicates that the getmntent routine is
* available to iterate through mounted file systems to get their info.
*/
-/*#define HAS_GETMNTENT /**/
+/*#define HAS_GETMNTENT / **/
/* HAS_GETNAMEINFO:
* This symbol, if defined, indicates that the getnameinfo() function
* is available for use.
*/
-/*#define HAS_GETNAMEINFO /**/
+/*#define HAS_GETNAMEINFO / **/
/* HAS_GETPRPWNAM:
* This symbol, if defined, indicates that the getprpwnam system call is
* available to retrieve protected (shadow) password entries by name.
*/
-/*#define HAS_GETPRPWNAM /**/
+/*#define HAS_GETPRPWNAM / **/
/* HAS_GETSPNAM:
* This symbol, if defined, indicates that the getspnam system call is
* available to retrieve SysV shadow password entries by name.
*/
-/*#define HAS_GETSPNAM /**/
+/*#define HAS_GETSPNAM / **/
/* HAS_HASMNTOPT:
* This symbol, if defined, indicates that the hasmntopt routine is
* available to query the mount options of file systems.
*/
-/*#define HAS_HASMNTOPT /**/
+/*#define HAS_HASMNTOPT / **/
/* HAS_ILOGBL:
* This symbol, if defined, indicates that the ilogbl routine is
* available. If scalbnl is also present we can emulate frexpl.
*/
-/*#define HAS_ILOGBL /**/
+/*#define HAS_ILOGBL / **/
/* HAS_INETNTOP:
* This symbol, if defined, indicates that the inet_ntop() function
* is available to parse IPv4 and IPv6 strings.
*/
-/*#define HAS_INETNTOP /**/
+/*#define HAS_INETNTOP / **/
/* HAS_INETPTON:
* This symbol, if defined, indicates that the inet_pton() function
* is available to parse IPv4 and IPv6 strings.
*/
-/*#define HAS_INETPTON /**/
+/*#define HAS_INETPTON / **/
/* HAS_INT64_T:
* This symbol will defined if the C compiler supports int64_t.
* Usually the <inttypes.h> needs to be included, but sometimes
* <sys/types.h> is enough.
*/
-/*#define HAS_INT64_T /**/
+/*#define HAS_INT64_T / **/
/* HAS_ISFINITE:
* This symbol, if defined, indicates that the isfinite routine is
* available to check whether a double is finite (non-infinity non-NaN).
*/
-/*#define HAS_ISFINITE /**/
+/*#define HAS_ISFINITE / **/
/* HAS_ISINF:
* This symbol, if defined, indicates that the isinf routine is
* available to check whether a double is an infinity.
*/
-/*#define HAS_ISINF /**/
+/*#define HAS_ISINF / **/
/* HAS_ISNAN:
* This symbol, if defined, indicates that the isnan routine is
* This symbol, if defined, indicates that the isnanl routine is
* available to check whether a long double is a NaN.
*/
-/*#define HAS_ISNANL /**/
+/*#define HAS_ISNANL / **/
/* HAS_LDBL_DIG:
* This symbol, if defined, indicates that this system's <float.h>
* This symbol, if defined, indicates that libm exports _LIB_VERSION
* and that math.h defines the enum to manipulate it.
*/
-/*#define LIBM_LIB_VERSION /**/
+/*#define LIBM_LIB_VERSION / **/
/* HAS_MADVISE:
* This symbol, if defined, indicates that the madvise system call is
* available to map a file into memory.
*/
-/*#define HAS_MADVISE /**/
+/*#define HAS_MADVISE / **/
/* HAS_MALLOC_SIZE:
* This symbol, if defined, indicates that the malloc_size
* routine is available for use.
*/
-/*#define HAS_MALLOC_SIZE /**/
+/*#define HAS_MALLOC_SIZE / **/
/* HAS_MALLOC_GOOD_SIZE:
* This symbol, if defined, indicates that the malloc_good_size
* routine is available for use.
*/
-/*#define HAS_MALLOC_GOOD_SIZE /**/
+/*#define HAS_MALLOC_GOOD_SIZE / **/
/* HAS_MKDTEMP:
* This symbol, if defined, indicates that the mkdtemp routine is
* available to exclusively create a uniquely named temporary directory.
*/
-/*#define HAS_MKDTEMP /**/
+/*#define HAS_MKDTEMP / **/
/* HAS_MKSTEMPS:
* This symbol, if defined, indicates that the mkstemps routine is
* available to excluslvely create and open a uniquely named
* (with a suffix) temporary file.
*/
-/*#define HAS_MKSTEMPS /**/
+/*#define HAS_MKSTEMPS / **/
/* HAS_MODFL:
* This symbol, if defined, indicates that the modfl routine is
* and 1.150000. The bug has been seen in certain versions of glibc,
* release 2.2.2 is known to be okay.
*/
-/*#define HAS_MODFL /**/
-/*#define HAS_MODFL_PROTO /**/
-/*#define HAS_MODFL_POW32_BUG /**/
+/*#define HAS_MODFL / **/
+/*#define HAS_MODFL_PROTO / **/
+/*#define HAS_MODFL_POW32_BUG / **/
/* HAS_MPROTECT:
* This symbol, if defined, indicates that the mprotect system call is
* available to modify the access protection of a memory mapped file.
*/
-/*#define HAS_MPROTECT /**/
+/*#define HAS_MPROTECT / **/
/* HAS_STRUCT_MSGHDR:
* This symbol, if defined, indicates that the struct msghdr
* is supported.
*/
-/*#define HAS_STRUCT_MSGHDR /**/
+/*#define HAS_STRUCT_MSGHDR / **/
/* HAS_NL_LANGINFO:
* This symbol, if defined, indicates that the nl_langinfo routine is
* available to return local data. You will also need <langinfo.h>
* and therefore I_LANGINFO.
*/
-/*#define HAS_NL_LANGINFO /**/
+/*#define HAS_NL_LANGINFO / **/
/* HAS_OFF64_T:
* This symbol will be defined if the C compiler supports off64_t.
*/
-/*#define HAS_OFF64_T /**/
+/*#define HAS_OFF64_T / **/
/* HAS_PROCSELFEXE:
* This symbol is defined if PROCSELFEXE_PATH is a symlink
* of the symbolic link pointing to the absolute pathname of
* the executing program.
*/
-/*#define HAS_PROCSELFEXE /**/
+/*#define HAS_PROCSELFEXE / **/
#if defined(HAS_PROCSELFEXE) && !defined(PROCSELFEXE_PATH)
#define PROCSELFEXE_PATH /**/
#endif
* system call is available to set the contention scope attribute of
* a thread attribute object.
*/
-/*#define HAS_PTHREAD_ATTR_SETSCOPE /**/
+/*#define HAS_PTHREAD_ATTR_SETSCOPE / **/
/* HAS_READV:
* This symbol, if defined, indicates that the readv routine is
* available to do gather reads. You will also need <sys/uio.h>
* and there I_SYSUIO.
*/
-/*#define HAS_READV /**/
+/*#define HAS_READV / **/
/* HAS_RECVMSG:
* This symbol, if defined, indicates that the recvmsg routine is
* available to send structured socket messages.
*/
-/*#define HAS_RECVMSG /**/
+/*#define HAS_RECVMSG / **/
/* HAS_SBRK_PROTO:
* This symbol, if defined, indicates that the system provides
* extern void* sbrk(int);
* extern void* sbrk(size_t);
*/
-/*#define HAS_SBRK_PROTO /**/
+/*#define HAS_SBRK_PROTO / **/
/* HAS_SCALBNL:
* This symbol, if defined, indicates that the scalbnl routine is
* available. If ilogbl is also present we can emulate frexpl.
*/
-/*#define HAS_SCALBNL /**/
+/*#define HAS_SCALBNL / **/
/* HAS_SENDMSG:
* This symbol, if defined, indicates that the sendmsg routine is
* available to send structured socket messages.
*/
-/*#define HAS_SENDMSG /**/
+/*#define HAS_SENDMSG / **/
/* HAS_SETITIMER:
* This symbol, if defined, indicates that the setitimer routine is
* available to set interval timers.
*/
-/*#define HAS_SETITIMER /**/
+/*#define HAS_SETITIMER / **/
/* HAS_SETPROCTITLE:
* This symbol, if defined, indicates that the setproctitle routine is
* available to set process title.
*/
-/*#define HAS_SETPROCTITLE /**/
+/*#define HAS_SETPROCTITLE / **/
/* USE_SFIO:
* This symbol, if defined, indicates that sfio should
* be used.
*/
-/*#define USE_SFIO /**/
+/*#define USE_SFIO / **/
/* HAS_SIGNBIT:
* This symbol, if defined, indicates that the signbit routine is
* in perl. Users should call Perl_signbit(), which will be #defined to
* the system's signbit() function or macro if this symbol is defined.
*/
-/*#define HAS_SIGNBIT /**/
+/*#define HAS_SIGNBIT / **/
/* HAS_SIGPROCMASK:
* This symbol, if defined, indicates that the sigprocmask
* system call is available to examine or change the signal mask
* of the calling process.
*/
-/*#define HAS_SIGPROCMASK /**/
+/*#define HAS_SIGPROCMASK / **/
/* USE_SITECUSTOMIZE:
* This symbol, if defined, indicates that sitecustomize should
* be used.
*/
#ifndef USE_SITECUSTOMIZE
-/*#define USE_SITECUSTOMIZE /**/
+/*#define USE_SITECUSTOMIZE / **/
#endif
/* HAS_SNPRINTF:
* This symbol, if defined, indicates that the sockatmark routine is
* available to test whether a socket is at the out-of-band mark.
*/
-/*#define HAS_SOCKATMARK /**/
+/*#define HAS_SOCKATMARK / **/
/* HAS_SOCKATMARK_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. A good guess is
* extern int sockatmark(int);
*/
-/*#define HAS_SOCKATMARK_PROTO /**/
+/*#define HAS_SOCKATMARK_PROTO / **/
/* HAS_SOCKS5_INIT:
* This symbol, if defined, indicates that the socks5_init routine is
* available to initialize SOCKS 5.
*/
-/*#define HAS_SOCKS5_INIT /**/
+/*#define HAS_SOCKS5_INIT / **/
/* SPRINTF_RETURNS_STRLEN:
* This variable defines whether sprintf returns the length of the string
* This symbol, if defined, indicates that the sqrtl routine is
* available to do long double square roots.
*/
-/*#define HAS_SQRTL /**/
+/*#define HAS_SQRTL / **/
/* HAS_SETRESGID_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. Good guesses are
* extern int setresgid(uid_t ruid, uid_t euid, uid_t suid);
*/
-/*#define HAS_SETRESGID_PROTO /**/
+/*#define HAS_SETRESGID_PROTO / **/
/* HAS_SETRESUID_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. Good guesses are
* extern int setresuid(uid_t ruid, uid_t euid, uid_t suid);
*/
-/*#define HAS_SETRESUID_PROTO /**/
+/*#define HAS_SETRESUID_PROTO / **/
/* HAS_STRUCT_STATFS_F_FLAGS:
* This symbol, if defined, indicates that the struct statfs
* have statfs() and struct statfs, they have ustat() and getmnt()
* with struct ustat and struct fs_data.
*/
-/*#define HAS_STRUCT_STATFS_F_FLAGS /**/
+/*#define HAS_STRUCT_STATFS_F_FLAGS / **/
/* HAS_STRUCT_STATFS:
* This symbol, if defined, indicates that the struct statfs
* to do statfs() is supported.
*/
-/*#define HAS_STRUCT_STATFS /**/
+/*#define HAS_STRUCT_STATFS / **/
/* HAS_FSTATVFS:
* This symbol, if defined, indicates that the fstatvfs routine is
* available to stat filesystems by file descriptors.
*/
-/*#define HAS_FSTATVFS /**/
+/*#define HAS_FSTATVFS / **/
/* HAS_STRFTIME:
* This symbol, if defined, indicates that the strftime routine is
* This symbol, if defined, indicates that the strlcat () routine is
* available to do string concatenation.
*/
-/*#define HAS_STRLCAT /**/
+/*#define HAS_STRLCAT / **/
/* HAS_STRLCPY:
* This symbol, if defined, indicates that the strlcpy () routine is
* available to do string copying.
*/
-/*#define HAS_STRLCPY /**/
+/*#define HAS_STRLCPY / **/
/* HAS_STRTOLD:
* This symbol, if defined, indicates that the strtold routine is
* available to convert strings to long doubles.
*/
-/*#define HAS_STRTOLD /**/
+/*#define HAS_STRTOLD / **/
/* HAS_STRTOLL:
* This symbol, if defined, indicates that the strtoll routine is
* This symbol, if defined, indicates that the strtoq routine is
* available to convert strings to long longs (quads).
*/
-/*#define HAS_STRTOQ /**/
+/*#define HAS_STRTOQ / **/
/* HAS_STRTOULL:
* This symbol, if defined, indicates that the strtoull routine is
* This symbol, if defined, indicates that the strtouq routine is
* available to convert strings to unsigned long longs (quads).
*/
-/*#define HAS_STRTOUQ /**/
+/*#define HAS_STRTOUQ / **/
/* HAS_SYSCALL_PROTO:
* This symbol, if defined, indicates that the system provides
* extern int syscall(int, ...);
* extern int syscall(long, ...);
*/
-/*#define HAS_SYSCALL_PROTO /**/
+/*#define HAS_SYSCALL_PROTO / **/
/* HAS_TELLDIR_PROTO:
* This symbol, if defined, indicates that the system provides
* This symbol, if defined, indicates that the asctime64 () routine is
* available to do the 64bit variant of asctime ()
*/
-/*#define HAS_CTIME64 /**/
-/*#define HAS_LOCALTIME64 /**/
-/*#define HAS_GMTIME64 /**/
-/*#define HAS_MKTIME64 /**/
-/*#define HAS_DIFFTIME64 /**/
-/*#define HAS_ASCTIME64 /**/
+/*#define HAS_CTIME64 / **/
+/*#define HAS_LOCALTIME64 / **/
+/*#define HAS_GMTIME64 / **/
+/*#define HAS_MKTIME64 / **/
+/*#define HAS_DIFFTIME64 / **/
+/*#define HAS_ASCTIME64 / **/
/* HAS_TIMEGM:
* This symbol, if defined, indicates that the timegm routine is
* available to do the opposite of gmtime ()
*/
-/*#define HAS_TIMEGM /**/
+/*#define HAS_TIMEGM / **/
/* U32_ALIGNMENT_REQUIRED:
* This symbol, if defined, indicates that you must access
* This symbol, if defined, indicates that the ualarm routine is
* available to do alarms with microsecond granularity.
*/
-/*#define HAS_UALARM /**/
+/*#define HAS_UALARM / **/
/* HAS_UNORDERED:
* This symbol, if defined, indicates that the unordered routine is
* available to check whether two doubles are unordered
* (effectively: whether either of them is NaN)
*/
-/*#define HAS_UNORDERED /**/
+/*#define HAS_UNORDERED / **/
/* HAS_UNSETENV:
* This symbol, if defined, indicates that the unsetenv () routine is
* available for use.
*/
-/*#define HAS_UNSETENV /**/
+/*#define HAS_UNSETENV / **/
/* HAS_USLEEP_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. A good guess is
* extern int usleep(useconds_t);
*/
-/*#define HAS_USLEEP_PROTO /**/
+/*#define HAS_USLEEP_PROTO / **/
/* HAS_USTAT:
* This symbol, if defined, indicates that the ustat system call is
* available to query file system statistics by dev_t.
*/
-/*#define HAS_USTAT /**/
+/*#define HAS_USTAT / **/
/* HAS_WRITEV:
* This symbol, if defined, indicates that the writev routine is
* available to do scatter writes.
*/
-/*#define HAS_WRITEV /**/
+/*#define HAS_WRITEV / **/
/* USE_DYNAMIC_LOADING:
* This symbol, if defined, indicates that dynamic loading of
* even be probed for and will be left undefined.
*/
#define FFLUSH_NULL /**/
-/*#define FFLUSH_ALL /**/
+/*#define FFLUSH_ALL / **/
/* I_ASSERT:
* This symbol, if defined, indicates that <assert.h> exists and
* This symbol, if defined, indicates that <crypt.h> exists and
* should be included.
*/
-/*#define I_CRYPT /**/
+/*#define I_CRYPT / **/
/* DB_Prefix_t:
* This symbol contains the type of the prefix structure element
* This symbol, if defined, indicates that <fp.h> exists and
* should be included.
*/
-/*#define I_FP /**/
+/*#define I_FP / **/
/* I_FP_CLASS:
* This symbol, if defined, indicates that <fp_class.h> exists and
* should be included.
*/
-/*#define I_FP_CLASS /**/
+/*#define I_FP_CLASS / **/
/* I_IEEEFP:
* This symbol, if defined, indicates that <ieeefp.h> exists and
* should be included.
*/
-/*#define I_IEEEFP /**/
+/*#define I_IEEEFP / **/
/* I_INTTYPES:
* This symbol, if defined, indicates to the C program that it should
* include <inttypes.h>.
*/
-/*#define I_INTTYPES /**/
+/*#define I_INTTYPES / **/
/* I_LANGINFO:
* This symbol, if defined, indicates that <langinfo.h> exists and
* should be included.
*/
-/*#define I_LANGINFO /**/
+/*#define I_LANGINFO / **/
/* I_LIBUTIL:
* This symbol, if defined, indicates that <libutil.h> exists and
* should be included.
*/
-/*#define I_LIBUTIL /**/
+/*#define I_LIBUTIL / **/
/* I_MALLOCMALLOC:
* This symbol, if defined, indicates to the C program that it should
* include <malloc/malloc.h>.
*/
-/*#define I_MALLOCMALLOC /**/
+/*#define I_MALLOCMALLOC / **/
/* I_MNTENT:
* This symbol, if defined, indicates that <mntent.h> exists and
* should be included.
*/
-/*#define I_MNTENT /**/
+/*#define I_MNTENT / **/
/* I_NETINET_TCP:
* This symbol, if defined, indicates to the C program that it should
* include <netinet/tcp.h>.
*/
-/*#define I_NETINET_TCP /**/
+/*#define I_NETINET_TCP / **/
/* I_POLL:
* This symbol, if defined, indicates that <poll.h> exists and
* should be included. (see also HAS_POLL)
*/
-/*#define I_POLL /**/
+/*#define I_POLL / **/
/* I_PROT:
* This symbol, if defined, indicates that <prot.h> exists and
* should be included.
*/
-/*#define I_PROT /**/
+/*#define I_PROT / **/
/* I_SHADOW:
* This symbol, if defined, indicates that <shadow.h> exists and
* should be included.
*/
-/*#define I_SHADOW /**/
+/*#define I_SHADOW / **/
/* I_SOCKS:
* This symbol, if defined, indicates that <socks.h> exists and
* should be included.
*/
-/*#define I_SOCKS /**/
+/*#define I_SOCKS / **/
/* I_SUNMATH:
* This symbol, if defined, indicates that <sunmath.h> exists and
* should be included.
*/
-/*#define I_SUNMATH /**/
+/*#define I_SUNMATH / **/
/* I_SYSLOG:
* This symbol, if defined, indicates that <syslog.h> exists and
* should be included.
*/
-/*#define I_SYSLOG /**/
+/*#define I_SYSLOG / **/
/* I_SYSMODE:
* This symbol, if defined, indicates that <sys/mode.h> exists and
* should be included.
*/
-/*#define I_SYSMODE /**/
+/*#define I_SYSMODE / **/
/* I_SYS_MOUNT:
* This symbol, if defined, indicates that <sys/mount.h> exists and
* should be included.
*/
-/*#define I_SYS_MOUNT /**/
+/*#define I_SYS_MOUNT / **/
/* I_SYS_STATFS:
* This symbol, if defined, indicates that <sys/statfs.h> exists.
*/
-/*#define I_SYS_STATFS /**/
+/*#define I_SYS_STATFS / **/
/* I_SYS_STATVFS:
* This symbol, if defined, indicates that <sys/statvfs.h> exists and
* should be included.
*/
-/*#define I_SYS_STATVFS /**/
+/*#define I_SYS_STATVFS / **/
/* I_SYSUTSNAME:
* This symbol, if defined, indicates that <sys/utsname.h> exists and
* should be included.
*/
-/*#define I_SYSUTSNAME /**/
+/*#define I_SYSUTSNAME / **/
/* I_SYS_VFS:
* This symbol, if defined, indicates that <sys/vfs.h> exists and
* should be included.
*/
-/*#define I_SYS_VFS /**/
+/*#define I_SYS_VFS / **/
/* I_USTAT:
* This symbol, if defined, indicates that <ustat.h> exists and
* should be included.
*/
-/*#define I_USTAT /**/
+/*#define I_USTAT / **/
/* PERL_PRIfldbl:
* This symbol, if defined, contains the string used by stdio to
* This symbol, if defined, contains the string used by stdio to
* format long doubles (format 'f') for input.
*/
-/*#define PERL_PRIfldbl "f" /**/
-/*#define PERL_PRIgldbl "g" /**/
-/*#define PERL_PRIeldbl "e" /**/
-/*#define PERL_SCNfldbl "f" /**/
+/*#define PERL_PRIfldbl "f" / **/
+/*#define PERL_PRIgldbl "g" / **/
+/*#define PERL_PRIeldbl "e" / **/
+/*#define PERL_SCNfldbl "f" / **/
/* PERL_MAD:
* This symbol, if defined, indicates that the Misc Attribution
* Declaration code should be conditionally compiled.
*/
-/*#define PERL_MAD /**/
+/*#define PERL_MAD / **/
/* NEED_VA_COPY:
* This symbol, if defined, indicates that the system stores
* of copying mechanisms, handy.h defines a platform-
* independent macro, Perl_va_copy(src, dst), to do the job.
*/
-/*#define NEED_VA_COPY /**/
+/*#define NEED_VA_COPY / **/
/* IVTYPE:
* This symbol defines the C type used for Perl's IV.
* This symbol tells the name of the array holding the stdio streams.
* Usual values include _iob, __iob, and __sF.
*/
-/*#define HAS_STDIO_STREAM_ARRAY /**/
+/*#define HAS_STDIO_STREAM_ARRAY / **/
#ifdef HAS_STDIO_STREAM_ARRAY
-#define STDIO_STREAM_ARRAY
+#define STDIO_STREAM_ARRAY
#endif
/* GMTIME_MAX:
#define USE_64_BIT_INT /**/
#endif
#ifndef USE_64_BIT_ALL
-/*#define USE_64_BIT_ALL /**/
+/*#define USE_64_BIT_ALL / **/
#endif
/* USE_DTRACE:
* This symbol, if defined, indicates that Perl should
* be built with support for DTrace.
*/
-/*#define USE_DTRACE /**/
+/*#define USE_DTRACE / **/
/* USE_FAST_STDIO:
* This symbol, if defined, indicates that Perl should
* Defaults to define in Perls 5.8 and earlier, to undef later.
*/
#ifndef USE_FAST_STDIO
-/*#define USE_FAST_STDIO /**/
+/*#define USE_FAST_STDIO / **/
#endif
/* USE_LARGE_FILES:
* be used when available.
*/
#ifndef USE_LONG_DOUBLE
-/*#define USE_LONG_DOUBLE /**/
+/*#define USE_LONG_DOUBLE / **/
#endif
/* USE_MORE_BITS:
* long doubles should be used when available.
*/
#ifndef USE_MORE_BITS
-/*#define USE_MORE_BITS /**/
+/*#define USE_MORE_BITS / **/
#endif
/* MULTIPLICITY:
* be built to use socks.
*/
#ifndef USE_SOCKS
-/*#define USE_SOCKS /**/
+/*#define USE_SOCKS / **/
#endif
#endif
/*
* Package name : perl5
- * Source directory :
- * Configuration time: Fri Dec 12 15:19:23 2008
- * Configured by : shay
- * Target system :
+ * Source directory :
+ * Configuration time: Sun Jan 10 19:53:56 2010
+ * Configured by : Steve
+ * Target system :
*/
#ifndef _config_h_
* This symbol is defined if the bcmp() routine is available to
* compare blocks of memory.
*/
-/*#define HAS_BCMP /**/
+/*#define HAS_BCMP / **/
/* HAS_BCOPY:
* This symbol is defined if the bcopy() routine is available to
* copy blocks of memory.
*/
-/*#define HAS_BCOPY /**/
+/*#define HAS_BCOPY / **/
/* HAS_BZERO:
* This symbol is defined if the bzero() routine is available to
* set a memory block to 0.
*/
-/*#define HAS_BZERO /**/
+/*#define HAS_BZERO / **/
/* HAS_CHOWN:
* This symbol, if defined, indicates that the chown routine is
* available.
*/
-/*#define HAS_CHOWN /**/
+/*#define HAS_CHOWN / **/
/* HAS_CHROOT:
* This symbol, if defined, indicates that the chroot routine is
* available.
*/
-/*#define HAS_CHROOT /**/
+/*#define HAS_CHROOT / **/
/* HAS_CHSIZE:
* This symbol, if defined, indicates that the chsize routine is available
* This symbol, if defined, indicates that the crypt routine is available
* to encrypt passwords and the like.
*/
-/*#define HAS_CRYPT /**/
+/*#define HAS_CRYPT / **/
/* HAS_CTERMID:
* This symbol, if defined, indicates that the ctermid routine is
* available to generate filename for terminal.
*/
-/*#define HAS_CTERMID /**/
+/*#define HAS_CTERMID / **/
/* HAS_CUSERID:
* This symbol, if defined, indicates that the cuserid routine is
* available to get character login names.
*/
-/*#define HAS_CUSERID /**/
+/*#define HAS_CUSERID / **/
/* HAS_DBL_DIG:
* This symbol, if defined, indicates that this system's <float.h>
* This symbol, if defined, indicates that the fchmod routine is available
* to change mode of opened files. If unavailable, use chmod().
*/
-/*#define HAS_FCHMOD /**/
+/*#define HAS_FCHMOD / **/
/* HAS_FCHOWN:
* This symbol, if defined, indicates that the fchown routine is available
* to change ownership of opened files. If unavailable, use chown().
*/
-/*#define HAS_FCHOWN /**/
+/*#define HAS_FCHOWN / **/
/* HAS_FCNTL:
* This symbol, if defined, indicates to the C program that
* the fcntl() function exists.
*/
-/*#define HAS_FCNTL /**/
+/*#define HAS_FCNTL / **/
/* HAS_FGETPOS:
* This symbol, if defined, indicates that the fgetpos routine is
* This symbol, if defined, indicates that the fork routine is
* available.
*/
-/*#define HAS_FORK /**/
+/*#define HAS_FORK / **/
/* HAS_FSETPOS:
* This symbol, if defined, indicates that the fsetpos routine is
* available to get the list of process groups. If unavailable, multiple
* groups are probably not supported.
*/
-/*#define HAS_GETGROUPS /**/
+/*#define HAS_GETGROUPS / **/
/* HAS_GETLOGIN:
* This symbol, if defined, indicates that the getlogin routine is
#define HAS_GETLOGIN /**/
/* HAS_GETPGID:
- * This symbol, if defined, indicates to the C program that
+ * This symbol, if defined, indicates to the C program that
* the getpgid(pid) function is available to get the
* process group id.
*/
-/*#define HAS_GETPGID /**/
+/*#define HAS_GETPGID / **/
/* HAS_GETPGRP2:
* This symbol, if defined, indicates that the getpgrp2() (as in DG/UX)
* routine is available to get the current process group.
*/
-/*#define HAS_GETPGRP2 /**/
+/*#define HAS_GETPGRP2 / **/
/* HAS_GETPPID:
* This symbol, if defined, indicates that the getppid routine is
* available to get the parent process ID.
*/
-/*#define HAS_GETPPID /**/
+/*#define HAS_GETPPID / **/
/* HAS_GETPRIORITY:
* This symbol, if defined, indicates that the getpriority routine is
* available to get a process's priority.
*/
-/*#define HAS_GETPRIORITY /**/
+/*#define HAS_GETPRIORITY / **/
/* HAS_INET_ATON:
* This symbol, if defined, indicates to the C program that the
* inet_aton() function is available to parse IP address "dotted-quad"
* strings.
*/
-/*#define HAS_INET_ATON /**/
+/*#define HAS_INET_ATON / **/
/* HAS_KILLPG:
* This symbol, if defined, indicates that the killpg routine is available
* This symbol, if defined, indicates that the lockf routine is
* available to do file locking.
*/
-/*#define HAS_LOCKF /**/
+/*#define HAS_LOCKF / **/
/* HAS_LSTAT:
* This symbol, if defined, indicates that the lstat routine is
* available to do file stats on symbolic links.
*/
-/*#define HAS_LSTAT /**/
+/*#define HAS_LSTAT / **/
/* HAS_MBLEN:
* This symbol, if defined, indicates that the mblen routine is available
* do it for you. However, if mkfifo is there, mknod might require
* super-user privileges which mkfifo will not.
*/
-/*#define HAS_MKFIFO /**/
+/*#define HAS_MKFIFO / **/
/* HAS_MKTIME:
* This symbol, if defined, indicates that the mktime routine is
* This symbol, if defined, indicates that the msync system call is
* available to synchronize a mapped file.
*/
-/*#define HAS_MSYNC /**/
+/*#define HAS_MSYNC / **/
/* HAS_MUNMAP:
* This symbol, if defined, indicates that the munmap system call is
* available to unmap a region, usually mapped by mmap().
*/
-/*#define HAS_MUNMAP /**/
+/*#define HAS_MUNMAP / **/
/* HAS_NICE:
* This symbol, if defined, indicates that the nice routine is
* available.
*/
-/*#define HAS_NICE /**/
+/*#define HAS_NICE / **/
/* HAS_PATHCONF:
* This symbol, if defined, indicates that pathconf() is available
* to determine file-system related limits and options associated
* with a given open file descriptor.
*/
-/*#define HAS_PATHCONF /**/
-/*#define HAS_FPATHCONF /**/
+/*#define HAS_PATHCONF / **/
+/*#define HAS_FPATHCONF / **/
/* HAS_PAUSE:
* This symbol, if defined, indicates that the pause routine is
* available to poll active file descriptors. Please check I_POLL and
* I_SYS_POLL to know which header should be included as well.
*/
-/*#define HAS_POLL /**/
+/*#define HAS_POLL / **/
/* HAS_READDIR:
* This symbol, if defined, indicates that the readdir routine is
* This symbol, if defined, indicates that the readlink routine is
* available to read the value of a symbolic link.
*/
-/*#define HAS_READLINK /**/
+/*#define HAS_READLINK / **/
/* HAS_RENAME:
* This symbol, if defined, indicates that the rename routine is available
* This symbol, if defined, indicates that the setegid routine is available
* to change the effective gid of the current program.
*/
-/*#define HAS_SETEGID /**/
+/*#define HAS_SETEGID / **/
/* HAS_SETEUID:
* This symbol, if defined, indicates that the seteuid routine is available
* to change the effective uid of the current program.
*/
-/*#define HAS_SETEUID /**/
+/*#define HAS_SETEUID / **/
/* HAS_SETGROUPS:
* This symbol, if defined, indicates that the setgroups() routine is
* available to set the list of process groups. If unavailable, multiple
* groups are probably not supported.
*/
-/*#define HAS_SETGROUPS /**/
+/*#define HAS_SETGROUPS / **/
/* HAS_SETLINEBUF:
* This symbol, if defined, indicates that the setlinebuf routine is
* available to change stderr or stdout from block-buffered or unbuffered
* to a line-buffered mode.
*/
-/*#define HAS_SETLINEBUF /**/
+/*#define HAS_SETLINEBUF / **/
/* HAS_SETLOCALE:
* This symbol, if defined, indicates that the setlocale routine is
* This symbol, if defined, indicates that the setpgid(pid, gpid)
* routine is available to set process group ID.
*/
-/*#define HAS_SETPGID /**/
+/*#define HAS_SETPGID / **/
/* HAS_SETPGRP2:
* This symbol, if defined, indicates that the setpgrp2() (as in DG/UX)
* routine is available to set the current process group.
*/
-/*#define HAS_SETPGRP2 /**/
+/*#define HAS_SETPGRP2 / **/
/* HAS_SETPRIORITY:
* This symbol, if defined, indicates that the setpriority routine is
* available to set a process's priority.
*/
-/*#define HAS_SETPRIORITY /**/
+/*#define HAS_SETPRIORITY / **/
/* HAS_SETREGID:
* This symbol, if defined, indicates that the setregid routine is
* available to change the real, effective and saved gid of the current
* process.
*/
-/*#define HAS_SETREGID /**/
-/*#define HAS_SETRESGID /**/
+/*#define HAS_SETREGID / **/
+/*#define HAS_SETRESGID / **/
/* HAS_SETREUID:
* This symbol, if defined, indicates that the setreuid routine is
* available to change the real, effective and saved uid of the current
* process.
*/
-/*#define HAS_SETREUID /**/
-/*#define HAS_SETRESUID /**/
+/*#define HAS_SETREUID / **/
+/*#define HAS_SETRESUID / **/
/* HAS_SETRGID:
* This symbol, if defined, indicates that the setrgid routine is available
* to change the real gid of the current program.
*/
-/*#define HAS_SETRGID /**/
+/*#define HAS_SETRGID / **/
/* HAS_SETRUID:
* This symbol, if defined, indicates that the setruid routine is available
* to change the real uid of the current program.
*/
-/*#define HAS_SETRUID /**/
+/*#define HAS_SETRUID / **/
/* HAS_SETSID:
* This symbol, if defined, indicates that the setsid routine is
* available to set the process group ID.
*/
-/*#define HAS_SETSID /**/
+/*#define HAS_SETSID / **/
/* HAS_STRCHR:
* This symbol is defined to indicate that the strchr()/strrchr()
* functions are available for string searching.
*/
#define HAS_STRCHR /**/
-/*#define HAS_INDEX /**/
+/*#define HAS_INDEX / **/
/* HAS_STRCOLL:
* This symbol, if defined, indicates that the strcoll routine is
* This symbol, if defined, indicates that the symlink routine is available
* to create symbolic links.
*/
-/*#define HAS_SYMLINK /**/
+/*#define HAS_SYMLINK / **/
/* HAS_SYSCALL:
* This symbol, if defined, indicates that the syscall routine is
* available to call arbitrary system calls. If undefined, that's tough.
*/
-/*#define HAS_SYSCALL /**/
+/*#define HAS_SYSCALL / **/
/* HAS_SYSCONF:
* This symbol, if defined, indicates that sysconf() is available
* to determine system related limits and options.
*/
-/*#define HAS_SYSCONF /**/
+/*#define HAS_SYSCONF / **/
/* HAS_SYSTEM:
* This symbol, if defined, indicates that the system routine is
* This symbol, if defined, indicates that the tcgetpgrp routine is
* available to get foreground process group ID.
*/
-/*#define HAS_TCGETPGRP /**/
+/*#define HAS_TCGETPGRP / **/
/* HAS_TCSETPGRP:
* This symbol, if defined, indicates that the tcsetpgrp routine is
* available to set foreground process group ID.
*/
-/*#define HAS_TCSETPGRP /**/
+/*#define HAS_TCSETPGRP / **/
/* HAS_TRUNCATE:
* This symbol, if defined, indicates that the truncate routine is
* available to truncate files.
*/
-/*#define HAS_TRUNCATE /**/
+/*#define HAS_TRUNCATE / **/
/* HAS_TZNAME:
* This symbol, if defined, indicates that the tzname[] array is
* This symbol, if defined, indicates that the usleep routine is
* available to let the process sleep on a sub-second accuracy.
*/
-/*#define HAS_USLEEP /**/
+/*#define HAS_USLEEP / **/
/* HAS_WAIT4:
* This symbol, if defined, indicates that wait4() exists.
*/
-/*#define HAS_WAIT4 /**/
+/*#define HAS_WAIT4 / **/
/* HAS_WAITPID:
* This symbol, if defined, indicates that the waitpid routine is
* This symbol holds the type used for the second argument to
* getgroups() and setgroups(). Usually, this is the same as
* gidtype (gid_t) , but sometimes it isn't.
- * It can be int, ushort, gid_t, etc...
- * It may be necessary to include <sys/types.h> to get any
+ * It can be int, ushort, gid_t, etc...
+ * It may be necessary to include <sys/types.h> to get any
* typedef'ed information. This is only required if you have
* getgroups() or setgroups()..
*/
* This symbol, if defined, indicates that <rpcsvc/dbm.h> exists and
* should be included.
*/
-/*#define I_DBM /**/
+/*#define I_DBM / **/
#define I_RPCSVC_DBM /**/
/* I_DLFCN:
* This symbol, if defined, indicates that <gdbm.h> exists and should
* be included.
*/
-/*#define I_GDBM /**/
+/*#define I_GDBM / **/
/* I_LIMITS:
* This symbol, if defined, indicates to the C program that it should
* This symbol, if defined, indicates to the C program that it should
* include <memory.h>.
*/
-/*#define I_MEMORY /**/
+/*#define I_MEMORY / **/
/* I_NETINET_IN:
* This symbol, if defined, indicates to the C program that it should
* include <netinet/in.h>. Otherwise, you may try <sys/in.h>.
*/
-/*#define I_NETINET_IN /**/
+/*#define I_NETINET_IN / **/
/* I_SFIO:
* This symbol, if defined, indicates to the C program that it should
* include <sfio.h>.
*/
-/*#define I_SFIO /**/
+/*#define I_SFIO / **/
/* I_STDDEF:
* This symbol, if defined, indicates that <stddef.h> exists and should
* This symbol, if defined, indicates to the C program that it should
* include <sys/dir.h>.
*/
-/*#define I_SYS_DIR /**/
+/*#define I_SYS_DIR / **/
/* I_SYS_FILE:
* This symbol, if defined, indicates to the C program that it should
* include <sys/file.h> to get definition of R_OK and friends.
*/
-/*#define I_SYS_FILE /**/
+/*#define I_SYS_FILE / **/
/* I_SYS_IOCTL:
* This symbol, if defined, indicates that <sys/ioctl.h> exists and should
* This symbol, if defined, indicates the <sys/sockio.h> should be included
* to get socket ioctl options, like SIOCATMARK.
*/
-/*#define I_SYS_IOCTL /**/
-/*#define I_SYS_SOCKIO /**/
+/*#define I_SYS_IOCTL / **/
+/*#define I_SYS_SOCKIO / **/
/* I_SYS_NDIR:
* This symbol, if defined, indicates to the C program that it should
* include <sys/ndir.h>.
*/
-/*#define I_SYS_NDIR /**/
+/*#define I_SYS_NDIR / **/
/* I_SYS_PARAM:
* This symbol, if defined, indicates to the C program that it should
* include <sys/param.h>.
*/
-/*#define I_SYS_PARAM /**/
+/*#define I_SYS_PARAM / **/
/* I_SYS_POLL:
* This symbol, if defined, indicates that the program may include
* <sys/poll.h>. When I_POLL is also defined, it's probably safest
* to only include <poll.h>.
*/
-/*#define I_SYS_POLL /**/
+/*#define I_SYS_POLL / **/
/* I_SYS_RESOURCE:
* This symbol, if defined, indicates to the C program that it should
* include <sys/resource.h>.
*/
-/*#define I_SYS_RESOURCE /**/
+/*#define I_SYS_RESOURCE / **/
/* I_SYS_SELECT:
* This symbol, if defined, indicates to the C program that it should
* include <sys/select.h> in order to get definition of struct timeval.
*/
-/*#define I_SYS_SELECT /**/
+/*#define I_SYS_SELECT / **/
/* I_SYS_STAT:
* This symbol, if defined, indicates to the C program that it should
* This symbol, if defined, indicates to the C program that it should
* include <sys/times.h>.
*/
-/*#define I_SYS_TIMES /**/
+/*#define I_SYS_TIMES / **/
/* I_SYS_TYPES:
* This symbol, if defined, indicates to the C program that it should
* This symbol, if defined, indicates to the C program that it should
* include <sys/un.h> to get UNIX domain socket definitions.
*/
-/*#define I_SYS_UN /**/
+/*#define I_SYS_UN / **/
/* I_SYS_WAIT:
* This symbol, if defined, indicates to the C program that it should
* include <sys/wait.h>.
*/
-/*#define I_SYS_WAIT /**/
+/*#define I_SYS_WAIT / **/
/* I_TERMIO:
* This symbol, if defined, indicates that the program should include
* <sgtty.h> rather than <termio.h>. There are also differences in
* the ioctl() calls that depend on the value of this symbol.
*/
-/*#define I_TERMIO /**/
-/*#define I_TERMIOS /**/
-/*#define I_SGTTY /**/
+/*#define I_TERMIO / **/
+/*#define I_TERMIOS / **/
+/*#define I_SGTTY / **/
/* I_UNISTD:
* This symbol, if defined, indicates to the C program that it should
* include <unistd.h>.
*/
-/*#define I_UNISTD /**/
+/*#define I_UNISTD / **/
/* I_UTIME:
* This symbol, if defined, indicates to the C program that it should
* MAXLONG, i.e. machine dependant limitations. Probably, you
* should use <limits.h> instead, if it is available.
*/
-/*#define I_VALUES /**/
+/*#define I_VALUES / **/
/* I_VFORK:
* This symbol, if defined, indicates to the C program that it should
* include vfork.h.
*/
-/*#define I_VFORK /**/
+/*#define I_VFORK / **/
+
+/* CAN_VAPROTO:
+ * This variable is defined on systems supporting prototype declaration
+ * of functions with a variable number of arguments.
+ */
+/* _V:
+ * This macro is used to declare function parameters in prototypes for
+ * functions with a variable number of parameters. Use double parentheses.
+ * For example:
+ *
+ * int printf _V((char *fmt, ...));
+ *
+ * Remember to use the plain simple _() macro when declaring a function
+ * with no variable number of arguments, since it might be possible to
+ * have a non-effect _V() macro and still get prototypes via _().
+ */
+/*#define CAN_VAPROTO / **/
+#ifdef CAN_VAPROTO
+#define _V(args) args
+#else
+#define _V(args) ()
+#endif
/* INTSIZE:
* This symbol contains the value of sizeof(int) so that the C
* example with the NeXT "fat" binaries that contain executables
* for several CPUs.
*/
-/*#define MULTIARCH /**/
+/*#define MULTIARCH / **/
/* HAS_QUAD:
* This symbol, if defined, tells that there's a 64-bit integer type,
* Quad_t, and its unsigned counterpar, Uquad_t. QUADKIND will be one
- * of QUAD_IS_INT, QUAD_IS_LONG, QUAD_IS_LONG_LONG, QUAD_IS_INT64_T
+ * of QUAD_IS_INT, QUAD_IS_LONG, QUAD_IS_LONG_LONG, QUAD_IS_INT64_T,
* or QUAD_IS___INT64.
*/
#define HAS_QUAD /**/
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
#define ARCHLIB "c:\\perl\\lib" /**/
-/*#define ARCHLIB_EXP "" /**/
+/*#define ARCHLIB_EXP "" / **/
/* ARCHNAME:
* This symbol holds a string representing the architecture name.
* This symbol, if defined, indicates that the accessx routine is
* available to do extended access checks.
*/
-/*#define HAS_ACCESSX /**/
+/*#define HAS_ACCESSX / **/
/* HAS_ASCTIME_R:
* This symbol, if defined, indicates that the asctime_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_asctime_r
* is defined.
*/
-/*#define HAS_ASCTIME_R /**/
+/*#define HAS_ASCTIME_R / **/
#define ASCTIME_R_PROTO 0 /**/
+/* The HASATTRIBUTE_* defines are left undefined here because they vary from
+ * one version of GCC to another. Instead, they are defined on the basis of
+ * the compiler version in <perl.h>.
+ */
/* HASATTRIBUTE_FORMAT:
* Can we handle GCC attribute for checking printf-style formats
*/
/* HASATTRIBUTE_WARN_UNUSED_RESULT:
* Can we handle GCC attribute for warning on unused results
*/
-/*#define HASATTRIBUTE_DEPRECATED /**/
-/*#define HASATTRIBUTE_FORMAT /**/
-/*#define PRINTF_FORMAT_NULL_OK /**/
-/*#define HASATTRIBUTE_NORETURN /**/
-/*#define HASATTRIBUTE_MALLOC /**/
-/*#define HASATTRIBUTE_NONNULL /**/
-/*#define HASATTRIBUTE_PURE /**/
-/*#define HASATTRIBUTE_UNUSED /**/
-/*#define HASATTRIBUTE_WARN_UNUSED_RESULT /**/
+/*#define HASATTRIBUTE_DEPRECATED / **/
+/*#define HASATTRIBUTE_FORMAT / **/
+/*#define PRINTF_FORMAT_NULL_OK / **/
+/*#define HASATTRIBUTE_NORETURN / **/
+/*#define HASATTRIBUTE_MALLOC / **/
+/*#define HASATTRIBUTE_NONNULL / **/
+/*#define HASATTRIBUTE_PURE / **/
+/*#define HASATTRIBUTE_UNUSED / **/
+/*#define HASATTRIBUTE_WARN_UNUSED_RESULT / **/
/* HASCONST:
* This symbol, if defined, indicates that this C compiler knows about
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_crypt_r
* is defined.
*/
-/*#define HAS_CRYPT_R /**/
+/*#define HAS_CRYPT_R / **/
#define CRYPT_R_PROTO 0 /**/
/* HAS_CSH:
/* CSH:
* This symbol, if defined, contains the full pathname of csh.
*/
-/*#define HAS_CSH /**/
+/*#define HAS_CSH / **/
#ifdef HAS_CSH
#define CSH "" /**/
#endif
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_ctermid_r
* is defined.
*/
-/*#define HAS_CTERMID_R /**/
+/*#define HAS_CTERMID_R / **/
#define CTERMID_R_PROTO 0 /**/
/* HAS_CTIME_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_ctime_r
* is defined.
*/
-/*#define HAS_CTIME_R /**/
+/*#define HAS_CTIME_R / **/
#define CTIME_R_PROTO 0 /**/
/* HAS_DRAND48_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_drand48_r
* is defined.
*/
-/*#define HAS_DRAND48_R /**/
+/*#define HAS_DRAND48_R / **/
#define DRAND48_R_PROTO 0 /**/
/* HAS_DRAND48_PROTO:
* to the program to supply one. A good guess is
* extern double drand48(void);
*/
-/*#define HAS_DRAND48_PROTO /**/
+/*#define HAS_DRAND48_PROTO / **/
/* HAS_EACCESS:
* This symbol, if defined, indicates that the eaccess routine is
* available to do extended access checks.
*/
-/*#define HAS_EACCESS /**/
+/*#define HAS_EACCESS / **/
/* HAS_ENDGRENT:
* This symbol, if defined, indicates that the getgrent routine is
* available for finalizing sequential access of the group database.
*/
-/*#define HAS_ENDGRENT /**/
+/*#define HAS_ENDGRENT / **/
/* HAS_ENDGRENT_R:
* This symbol, if defined, indicates that the endgrent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endgrent_r
* is defined.
*/
-/*#define HAS_ENDGRENT_R /**/
+/*#define HAS_ENDGRENT_R / **/
#define ENDGRENT_R_PROTO 0 /**/
/* HAS_ENDHOSTENT:
* This symbol, if defined, indicates that the endhostent() routine is
* available to close whatever was being used for host queries.
*/
-/*#define HAS_ENDHOSTENT /**/
+/*#define HAS_ENDHOSTENT / **/
/* HAS_ENDHOSTENT_R:
* This symbol, if defined, indicates that the endhostent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endhostent_r
* is defined.
*/
-/*#define HAS_ENDHOSTENT_R /**/
+/*#define HAS_ENDHOSTENT_R / **/
#define ENDHOSTENT_R_PROTO 0 /**/
/* HAS_ENDNETENT:
* This symbol, if defined, indicates that the endnetent() routine is
* available to close whatever was being used for network queries.
*/
-/*#define HAS_ENDNETENT /**/
+/*#define HAS_ENDNETENT / **/
/* HAS_ENDNETENT_R:
* This symbol, if defined, indicates that the endnetent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endnetent_r
* is defined.
*/
-/*#define HAS_ENDNETENT_R /**/
+/*#define HAS_ENDNETENT_R / **/
#define ENDNETENT_R_PROTO 0 /**/
/* HAS_ENDPROTOENT:
* This symbol, if defined, indicates that the endprotoent() routine is
* available to close whatever was being used for protocol queries.
*/
-/*#define HAS_ENDPROTOENT /**/
+/*#define HAS_ENDPROTOENT / **/
/* HAS_ENDPROTOENT_R:
* This symbol, if defined, indicates that the endprotoent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endprotoent_r
* is defined.
*/
-/*#define HAS_ENDPROTOENT_R /**/
+/*#define HAS_ENDPROTOENT_R / **/
#define ENDPROTOENT_R_PROTO 0 /**/
/* HAS_ENDPWENT:
* This symbol, if defined, indicates that the getgrent routine is
* available for finalizing sequential access of the passwd database.
*/
-/*#define HAS_ENDPWENT /**/
+/*#define HAS_ENDPWENT / **/
/* HAS_ENDPWENT_R:
* This symbol, if defined, indicates that the endpwent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endpwent_r
* is defined.
*/
-/*#define HAS_ENDPWENT_R /**/
+/*#define HAS_ENDPWENT_R / **/
#define ENDPWENT_R_PROTO 0 /**/
/* HAS_ENDSERVENT:
* This symbol, if defined, indicates that the endservent() routine is
* available to close whatever was being used for service queries.
*/
-/*#define HAS_ENDSERVENT /**/
+/*#define HAS_ENDSERVENT / **/
/* HAS_ENDSERVENT_R:
* This symbol, if defined, indicates that the endservent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endservent_r
* is defined.
*/
-/*#define HAS_ENDSERVENT_R /**/
+/*#define HAS_ENDSERVENT_R / **/
#define ENDSERVENT_R_PROTO 0 /**/
/* FLEXFILENAMES:
* This symbol, if defined, indicates that the getgrent routine is
* available for sequential access of the group database.
*/
-/*#define HAS_GETGRENT /**/
+/*#define HAS_GETGRENT / **/
/* HAS_GETGRENT_R:
* This symbol, if defined, indicates that the getgrent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrent_r
* is defined.
*/
-/*#define HAS_GETGRENT_R /**/
+/*#define HAS_GETGRENT_R / **/
#define GETGRENT_R_PROTO 0 /**/
/* HAS_GETGRGID_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrgid_r
* is defined.
*/
-/*#define HAS_GETGRGID_R /**/
+/*#define HAS_GETGRGID_R / **/
#define GETGRGID_R_PROTO 0 /**/
/* HAS_GETGRNAM_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrnam_r
* is defined.
*/
-/*#define HAS_GETGRNAM_R /**/
+/*#define HAS_GETGRNAM_R / **/
#define GETGRNAM_R_PROTO 0 /**/
/* HAS_GETHOSTBYADDR:
* This symbol, if defined, indicates that the gethostent() routine is
* available to look up host names in some data base or another.
*/
-/*#define HAS_GETHOSTENT /**/
+/*#define HAS_GETHOSTENT / **/
/* HAS_GETHOSTNAME:
* This symbol, if defined, indicates that the C program may use the
*/
#define HAS_GETHOSTNAME /**/
#define HAS_UNAME /**/
-/*#define HAS_PHOSTNAME /**/
+/*#define HAS_PHOSTNAME / **/
#ifdef HAS_PHOSTNAME
#define PHOSTNAME "" /* How to get the host name */
#endif
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostbyaddr_r
* is defined.
*/
-/*#define HAS_GETHOSTBYADDR_R /**/
+/*#define HAS_GETHOSTBYADDR_R / **/
#define GETHOSTBYADDR_R_PROTO 0 /**/
/* HAS_GETHOSTBYNAME_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostbyname_r
* is defined.
*/
-/*#define HAS_GETHOSTBYNAME_R /**/
+/*#define HAS_GETHOSTBYNAME_R / **/
#define GETHOSTBYNAME_R_PROTO 0 /**/
/* HAS_GETHOSTENT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostent_r
* is defined.
*/
-/*#define HAS_GETHOSTENT_R /**/
+/*#define HAS_GETHOSTENT_R / **/
#define GETHOSTENT_R_PROTO 0 /**/
/* HAS_GETHOST_PROTOS:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getlogin_r
* is defined.
*/
-/*#define HAS_GETLOGIN_R /**/
+/*#define HAS_GETLOGIN_R / **/
#define GETLOGIN_R_PROTO 0 /**/
/* HAS_GETNETBYADDR:
* This symbol, if defined, indicates that the getnetbyaddr() routine is
* available to look up networks by their IP addresses.
*/
-/*#define HAS_GETNETBYADDR /**/
+/*#define HAS_GETNETBYADDR / **/
/* HAS_GETNETBYNAME:
* This symbol, if defined, indicates that the getnetbyname() routine is
* available to look up networks by their names.
*/
-/*#define HAS_GETNETBYNAME /**/
+/*#define HAS_GETNETBYNAME / **/
/* HAS_GETNETENT:
* This symbol, if defined, indicates that the getnetent() routine is
* available to look up network names in some data base or another.
*/
-/*#define HAS_GETNETENT /**/
+/*#define HAS_GETNETENT / **/
/* HAS_GETNETBYADDR_R:
* This symbol, if defined, indicates that the getnetbyaddr_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetbyaddr_r
* is defined.
*/
-/*#define HAS_GETNETBYADDR_R /**/
+/*#define HAS_GETNETBYADDR_R / **/
#define GETNETBYADDR_R_PROTO 0 /**/
/* HAS_GETNETBYNAME_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetbyname_r
* is defined.
*/
-/*#define HAS_GETNETBYNAME_R /**/
+/*#define HAS_GETNETBYNAME_R / **/
#define GETNETBYNAME_R_PROTO 0 /**/
/* HAS_GETNETENT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetent_r
* is defined.
*/
-/*#define HAS_GETNETENT_R /**/
+/*#define HAS_GETNETENT_R / **/
#define GETNETENT_R_PROTO 0 /**/
/* HAS_GETNET_PROTOS:
* getnetbyaddr(). Otherwise, it is up to the program to guess
* them. See netdbtype.U for probing for various Netdb_xxx_t types.
*/
-/*#define HAS_GETNET_PROTOS /**/
+/*#define HAS_GETNET_PROTOS / **/
/* HAS_GETPROTOENT:
* This symbol, if defined, indicates that the getprotoent() routine is
* available to look up protocols in some data base or another.
*/
-/*#define HAS_GETPROTOENT /**/
+/*#define HAS_GETPROTOENT / **/
/* HAS_GETPGRP:
* This symbol, if defined, indicates that the getpgrp routine is
* This symbol, if defined, indicates that getpgrp needs one
* arguments whereas USG one needs none.
*/
-/*#define HAS_GETPGRP /**/
-/*#define USE_BSD_GETPGRP /**/
+/*#define HAS_GETPGRP / **/
+/*#define USE_BSD_GETPGRP / **/
/* HAS_GETPROTOBYNAME:
* This symbol, if defined, indicates that the getprotobyname()
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotobyname_r
* is defined.
*/
-/*#define HAS_GETPROTOBYNAME_R /**/
+/*#define HAS_GETPROTOBYNAME_R / **/
#define GETPROTOBYNAME_R_PROTO 0 /**/
/* HAS_GETPROTOBYNUMBER_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotobynumber_r
* is defined.
*/
-/*#define HAS_GETPROTOBYNUMBER_R /**/
+/*#define HAS_GETPROTOBYNUMBER_R / **/
#define GETPROTOBYNUMBER_R_PROTO 0 /**/
/* HAS_GETPROTOENT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotoent_r
* is defined.
*/
-/*#define HAS_GETPROTOENT_R /**/
+/*#define HAS_GETPROTOENT_R / **/
#define GETPROTOENT_R_PROTO 0 /**/
/* HAS_GETPROTO_PROTOS:
* available for sequential access of the passwd database.
* If this is not available, the older getpw() function may be available.
*/
-/*#define HAS_GETPWENT /**/
+/*#define HAS_GETPWENT / **/
/* HAS_GETPWENT_R:
* This symbol, if defined, indicates that the getpwent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwent_r
* is defined.
*/
-/*#define HAS_GETPWENT_R /**/
+/*#define HAS_GETPWENT_R / **/
#define GETPWENT_R_PROTO 0 /**/
/* HAS_GETPWNAM_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwnam_r
* is defined.
*/
-/*#define HAS_GETPWNAM_R /**/
+/*#define HAS_GETPWNAM_R / **/
#define GETPWNAM_R_PROTO 0 /**/
/* HAS_GETPWUID_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwuid_r
* is defined.
*/
-/*#define HAS_GETPWUID_R /**/
+/*#define HAS_GETPWUID_R / **/
#define GETPWUID_R_PROTO 0 /**/
/* HAS_GETSERVENT:
* This symbol, if defined, indicates that the getservent() routine is
* available to look up network services in some data base or another.
*/
-/*#define HAS_GETSERVENT /**/
+/*#define HAS_GETSERVENT / **/
/* HAS_GETSERVBYNAME_R:
* This symbol, if defined, indicates that the getservbyname_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservbyname_r
* is defined.
*/
-/*#define HAS_GETSERVBYNAME_R /**/
+/*#define HAS_GETSERVBYNAME_R / **/
#define GETSERVBYNAME_R_PROTO 0 /**/
/* HAS_GETSERVBYPORT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservbyport_r
* is defined.
*/
-/*#define HAS_GETSERVBYPORT_R /**/
+/*#define HAS_GETSERVBYPORT_R / **/
#define GETSERVBYPORT_R_PROTO 0 /**/
/* HAS_GETSERVENT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservent_r
* is defined.
*/
-/*#define HAS_GETSERVENT_R /**/
+/*#define HAS_GETSERVENT_R / **/
#define GETSERVENT_R_PROTO 0 /**/
/* HAS_GETSERV_PROTOS:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getspnam_r
* is defined.
*/
-/*#define HAS_GETSPNAM_R /**/
+/*#define HAS_GETSPNAM_R / **/
#define GETSPNAM_R_PROTO 0 /**/
/* HAS_GETSERVBYNAME:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_gmtime_r
* is defined.
*/
-/*#define HAS_GMTIME_R /**/
+/*#define HAS_GMTIME_R / **/
#define GMTIME_R_PROTO 0 /**/
/* HAS_HTONL:
* changes using \undef{TZ} without explicitly calling tzset
* impossible. This symbol makes us call tzset before localtime_r
*/
-/*#define LOCALTIME_R_NEEDS_TZSET /**/
+/*#define LOCALTIME_R_NEEDS_TZSET / **/
#ifdef LOCALTIME_R_NEEDS_TZSET
#define L_R_TZSET tzset(),
#else
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_localtime_r
* is defined.
*/
-/*#define HAS_LOCALTIME_R /**/
+/*#define HAS_LOCALTIME_R / **/
#define LOCALTIME_R_PROTO 0 /**/
/* HAS_LONG_DOUBLE:
* available to exclusively create and open a uniquely named
* temporary file.
*/
-/*#define HAS_MKSTEMP /**/
+/*#define HAS_MKSTEMP / **/
/* HAS_MMAP:
* This symbol, if defined, indicates that the mmap system call is
* (and simultaneously the type of the first argument).
* Usually set to 'void *' or 'caddr_t'.
*/
-/*#define HAS_MMAP /**/
+/*#define HAS_MMAP / **/
#define Mmap_t void * /**/
/* HAS_MSG:
* This symbol, if defined, indicates that the entire msg*(2) library is
* supported (IPC mechanism based on message queues).
*/
-/*#define HAS_MSG /**/
+/*#define HAS_MSG / **/
/* OLD_PTHREAD_CREATE_JOINABLE:
* This symbol, if defined, indicates how to create pthread
* If defined, known values are PTHREAD_CREATE_UNDETACHED
* and __UNDETACHED.
*/
-/*#define OLD_PTHREAD_CREATE_JOINABLE /**/
+/*#define OLD_PTHREAD_CREATE_JOINABLE / **/
/* HAS_PTHREAD_ATFORK:
* This symbol, if defined, indicates that the pthread_atfork routine
* is available to setup fork handlers.
*/
-/*#define HAS_PTHREAD_ATFORK /**/
+/*#define HAS_PTHREAD_ATFORK / **/
/* HAS_PTHREAD_YIELD:
* This symbol, if defined, indicates that the pthread_yield
* routine is available to yield the execution of the current
* thread. sched_yield is preferable to pthread_yield.
*/
-/*#define HAS_PTHREAD_YIELD /**/
+/*#define HAS_PTHREAD_YIELD / **/
#define SCHED_YIELD /**/
-/*#define HAS_SCHED_YIELD /**/
+/*#define HAS_SCHED_YIELD / **/
/* HAS_RANDOM_R:
* This symbol, if defined, indicates that the random_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_random_r
* is defined.
*/
-/*#define HAS_RANDOM_R /**/
+/*#define HAS_RANDOM_R / **/
#define RANDOM_R_PROTO 0 /**/
/* HAS_READDIR64_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_readdir64_r
* is defined.
*/
-/*#define HAS_READDIR64_R /**/
+/*#define HAS_READDIR64_R / **/
#define READDIR64_R_PROTO 0 /**/
/* HAS_READDIR_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_readdir_r
* is defined.
*/
-/*#define HAS_READDIR_R /**/
+/*#define HAS_READDIR_R / **/
#define READDIR_R_PROTO 0 /**/
/* HAS_SEM:
* This symbol, if defined, indicates that the entire sem*(2) library is
* supported.
*/
-/*#define HAS_SEM /**/
+/*#define HAS_SEM / **/
/* HAS_SETGRENT:
* This symbol, if defined, indicates that the setgrent routine is
* available for initializing sequential access of the group database.
*/
-/*#define HAS_SETGRENT /**/
+/*#define HAS_SETGRENT / **/
/* HAS_SETGRENT_R:
* This symbol, if defined, indicates that the setgrent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setgrent_r
* is defined.
*/
-/*#define HAS_SETGRENT_R /**/
+/*#define HAS_SETGRENT_R / **/
#define SETGRENT_R_PROTO 0 /**/
/* HAS_SETHOSTENT:
* This symbol, if defined, indicates that the sethostent() routine is
* available.
*/
-/*#define HAS_SETHOSTENT /**/
+/*#define HAS_SETHOSTENT / **/
/* HAS_SETHOSTENT_R:
* This symbol, if defined, indicates that the sethostent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_sethostent_r
* is defined.
*/
-/*#define HAS_SETHOSTENT_R /**/
+/*#define HAS_SETHOSTENT_R / **/
#define SETHOSTENT_R_PROTO 0 /**/
/* HAS_SETLOCALE_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setlocale_r
* is defined.
*/
-/*#define HAS_SETLOCALE_R /**/
+/*#define HAS_SETLOCALE_R / **/
#define SETLOCALE_R_PROTO 0 /**/
/* HAS_SETNETENT:
* This symbol, if defined, indicates that the setnetent() routine is
* available.
*/
-/*#define HAS_SETNETENT /**/
+/*#define HAS_SETNETENT / **/
/* HAS_SETNETENT_R:
* This symbol, if defined, indicates that the setnetent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setnetent_r
* is defined.
*/
-/*#define HAS_SETNETENT_R /**/
+/*#define HAS_SETNETENT_R / **/
#define SETNETENT_R_PROTO 0 /**/
/* HAS_SETPROTOENT:
* This symbol, if defined, indicates that the setprotoent() routine is
* available.
*/
-/*#define HAS_SETPROTOENT /**/
+/*#define HAS_SETPROTOENT / **/
/* HAS_SETPGRP:
* This symbol, if defined, indicates that the setpgrp routine is
* arguments whereas USG one needs none. See also HAS_SETPGID
* for a POSIX interface.
*/
-/*#define HAS_SETPGRP /**/
-/*#define USE_BSD_SETPGRP /**/
+/*#define HAS_SETPGRP / **/
+/*#define USE_BSD_SETPGRP / **/
/* HAS_SETPROTOENT_R:
* This symbol, if defined, indicates that the setprotoent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setprotoent_r
* is defined.
*/
-/*#define HAS_SETPROTOENT_R /**/
+/*#define HAS_SETPROTOENT_R / **/
#define SETPROTOENT_R_PROTO 0 /**/
/* HAS_SETPWENT:
* This symbol, if defined, indicates that the setpwent routine is
* available for initializing sequential access of the passwd database.
*/
-/*#define HAS_SETPWENT /**/
+/*#define HAS_SETPWENT / **/
/* HAS_SETPWENT_R:
* This symbol, if defined, indicates that the setpwent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setpwent_r
* is defined.
*/
-/*#define HAS_SETPWENT_R /**/
+/*#define HAS_SETPWENT_R / **/
#define SETPWENT_R_PROTO 0 /**/
/* HAS_SETSERVENT:
* This symbol, if defined, indicates that the setservent() routine is
* available.
*/
-/*#define HAS_SETSERVENT /**/
+/*#define HAS_SETSERVENT / **/
/* HAS_SETSERVENT_R:
* This symbol, if defined, indicates that the setservent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setservent_r
* is defined.
*/
-/*#define HAS_SETSERVENT_R /**/
+/*#define HAS_SETSERVENT_R / **/
#define SETSERVENT_R_PROTO 0 /**/
/* HAS_SETVBUF:
* This symbol, if defined, indicates that the entire shm*(2) library is
* supported.
*/
-/*#define HAS_SHM /**/
+/*#define HAS_SHM / **/
/* Shmat_t:
* This symbol holds the return type of the shmat() system call.
* when HAS_SHMAT_PROTOTYPE is not defined to avoid conflicting defs.
*/
#define Shmat_t void * /**/
-/*#define HAS_SHMAT_PROTOTYPE /**/
+/*#define HAS_SHMAT_PROTOTYPE / **/
/* HAS_SOCKET:
* This symbol, if defined, indicates that the BSD socket interface is
* has been known to be an enum.
*/
#define HAS_SOCKET /**/
-/*#define HAS_SOCKETPAIR /**/
-/*#define HAS_MSG_CTRUNC /**/
-/*#define HAS_MSG_DONTROUTE /**/
-/*#define HAS_MSG_OOB /**/
-/*#define HAS_MSG_PEEK /**/
-/*#define HAS_MSG_PROXY /**/
-/*#define HAS_SCM_RIGHTS /**/
+/*#define HAS_SOCKETPAIR / **/
+/*#define HAS_MSG_CTRUNC / **/
+/*#define HAS_MSG_DONTROUTE / **/
+/*#define HAS_MSG_OOB / **/
+/*#define HAS_MSG_PEEK / **/
+/*#define HAS_MSG_PROXY / **/
+/*#define HAS_SCM_RIGHTS / **/
/* HAS_SRAND48_R:
* This symbol, if defined, indicates that the srand48_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_srand48_r
* is defined.
*/
-/*#define HAS_SRAND48_R /**/
+/*#define HAS_SRAND48_R / **/
#define SRAND48_R_PROTO 0 /**/
/* HAS_SRANDOM_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_srandom_r
* is defined.
*/
-/*#define HAS_SRANDOM_R /**/
+/*#define HAS_SRANDOM_R / **/
#define SRANDOM_R_PROTO 0 /**/
/* USE_STAT_BLOCKS:
* st_blksize and st_blocks.
*/
#ifndef USE_STAT_BLOCKS
-/*#define USE_STAT_BLOCKS /**/
+/*#define USE_STAT_BLOCKS / **/
#endif
/* USE_STRUCT_COPY:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_strerror_r
* is defined.
*/
-/*#define HAS_STRERROR_R /**/
+/*#define HAS_STRERROR_R / **/
#define STRERROR_R_PROTO 0 /**/
/* HAS_STRTOUL:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_tmpnam_r
* is defined.
*/
-/*#define HAS_TMPNAM_R /**/
+/*#define HAS_TMPNAM_R / **/
#define TMPNAM_R_PROTO 0 /**/
/* HAS_TTYNAME_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_ttyname_r
* is defined.
*/
-/*#define HAS_TTYNAME_R /**/
+/*#define HAS_TTYNAME_R / **/
#define TTYNAME_R_PROTO 0 /**/
/* HAS_UNION_SEMUN:
* used for semctl IPC_STAT.
*/
#define HAS_UNION_SEMUN /**/
-/*#define USE_SEMCTL_SEMUN /**/
-/*#define USE_SEMCTL_SEMID_DS /**/
+/*#define USE_SEMCTL_SEMUN / **/
+/*#define USE_SEMCTL_SEMID_DS / **/
/* HAS_VFORK:
* This symbol, if defined, indicates that vfork() exists.
*/
-/*#define HAS_VFORK /**/
+/*#define HAS_VFORK / **/
/* HAS_PSEUDOFORK:
* This symbol, if defined, indicates that an emulation of the
* fork routine is available.
*/
-/*#define HAS_PSEUDOFORK /**/
+/*#define HAS_PSEUDOFORK / **/
/* Signal_t:
* This symbol's value is either "void" or "int", corresponding to the
* This symbol, if defined, indicates to the C program that struct group
* in <grp.h> contains gr_passwd.
*/
-/*#define I_GRP /**/
-/*#define GRPASSWD /**/
+/*#define I_GRP / **/
+/*#define GRPASSWD / **/
/* I_MACH_CTHREADS:
* This symbol, if defined, indicates to the C program that it should
* include <mach/cthreads.h>.
*/
-/*#define I_MACH_CTHREADS /**/
+/*#define I_MACH_CTHREADS / **/
/* I_NDBM:
* This symbol, if defined, indicates that <ndbm.h> exists and should
* parameter information. While ANSI C prototypes are supported in C++,
* K&R style function declarations will yield errors.
*/
-/*#define I_NDBM /**/
-/*#define I_GDBMNDBM /**/
-/*#define I_GDBM_NDBM /**/
-/*#define NDBM_H_USES_PROTOTYPES /**/
-/*#define GDBMNDBM_H_USES_PROTOTYPES /**/
-/*#define GDBM_NDBM_H_USES_PROTOTYPES /**/
+/*#define I_NDBM / **/
+/*#define I_GDBMNDBM / **/
+/*#define I_GDBM_NDBM / **/
+/*#define NDBM_H_USES_PROTOTYPES / **/
+/*#define GDBMNDBM_H_USES_PROTOTYPES / **/
+/*#define GDBM_NDBM_H_USES_PROTOTYPES / **/
/* I_NETDB:
* This symbol, if defined, indicates that <netdb.h> exists and
* should be included.
*/
-/*#define I_NETDB /**/
+/*#define I_NETDB / **/
/* I_NET_ERRNO:
* This symbol, if defined, indicates that <net/errno.h> exists and
* should be included.
*/
-/*#define I_NET_ERRNO /**/
+/*#define I_NET_ERRNO / **/
/* I_PTHREAD:
* This symbol, if defined, indicates to the C program that it should
* include <pthread.h>.
*/
-/*#define I_PTHREAD /**/
+/*#define I_PTHREAD / **/
/* I_PWD:
* This symbol, if defined, indicates to the C program that it should
* This symbol, if defined, indicates to the C program that struct passwd
* contains pw_passwd.
*/
-/*#define I_PWD /**/
-/*#define PWQUOTA /**/
-/*#define PWAGE /**/
-/*#define PWCHANGE /**/
-/*#define PWCLASS /**/
-/*#define PWEXPIRE /**/
-/*#define PWCOMMENT /**/
-/*#define PWGECOS /**/
-/*#define PWPASSWD /**/
+/*#define I_PWD / **/
+/*#define PWQUOTA / **/
+/*#define PWAGE / **/
+/*#define PWCHANGE / **/
+/*#define PWCLASS / **/
+/*#define PWEXPIRE / **/
+/*#define PWCOMMENT / **/
+/*#define PWGECOS / **/
+/*#define PWPASSWD / **/
/* I_SYS_ACCESS:
* This symbol, if defined, indicates to the C program that it should
* include <sys/access.h>.
*/
-/*#define I_SYS_ACCESS /**/
+/*#define I_SYS_ACCESS / **/
/* I_SYS_SECURITY:
* This symbol, if defined, indicates to the C program that it should
* include <sys/security.h>.
*/
-/*#define I_SYS_SECURITY /**/
+/*#define I_SYS_SECURITY / **/
/* I_SYSUIO:
* This symbol, if defined, indicates that <sys/uio.h> exists and
* should be included.
*/
-/*#define I_SYSUIO /**/
+/*#define I_SYSUIO / **/
/* I_STDARG:
* This symbol, if defined, indicates that <stdarg.h> exists and should
* include <varargs.h>.
*/
#define I_STDARG /**/
-/*#define I_VARARGS /**/
+/*#define I_VARARGS / **/
/* PERL_INC_VERSION_LIST:
* This variable specifies the list of subdirectories in over
* for a C initialization string. See the inc_version_list entry
* in Porting/Glossary for more details.
*/
-/*#define PERL_INC_VERSION_LIST 0 /**/
+/*#define PERL_INC_VERSION_LIST 0 / **/
/* INSTALL_USR_BIN_PERL:
* This symbol, if defined, indicates that Perl is to be installed
* also as /usr/bin/perl.
*/
-/*#define INSTALL_USR_BIN_PERL /**/
+/*#define INSTALL_USR_BIN_PERL / **/
/* Off_t:
* This symbol holds the type used to declare offsets in the kernel.
/* MYMALLOC:
* This symbol, if defined, indicates that we're using our own malloc.
*/
-/*#define MYMALLOC /**/
+/*#define MYMALLOC / **/
/* Mode_t:
* This symbol holds the type used to declare file modes
* and architecture-specific directories. See PERL_INC_VERSION_LIST
* for more details.
*/
-/*#define PERL_OTHERLIBDIRS "" /**/
+/*#define PERL_OTHERLIBDIRS "" / **/
/* Pid_t:
* This symbol holds the type used to declare process ids in the kernel.
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
#define SITEARCH "c:\\perl\\site\\lib" /**/
-/*#define SITEARCH_EXP "" /**/
+/*#define SITEARCH_EXP "" / **/
/* SITELIB:
* This symbol contains the name of the private library for this package.
* try to use the various _r versions of library functions.
* This is extremely experimental.
*/
-/*#define USE_5005THREADS /**/
-/*#define USE_ITHREADS /**/
+/*#define USE_5005THREADS / **/
+/*#define USE_ITHREADS / **/
#if defined(USE_5005THREADS) && !defined(USE_ITHREADS)
#define USE_THREADS /* until src is revised*/
#endif
-/*#define OLD_PTHREADS_API /**/
-/*#define USE_REENTRANT_API /**/
+/*#define OLD_PTHREADS_API / **/
+/*#define USE_REENTRANT_API / **/
/* PERL_VENDORARCH:
* If defined, this symbol contains the name of a private library.
* This symbol contains the ~name expanded version of PERL_VENDORARCH, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-/*#define PERL_VENDORARCH "" /**/
-/*#define PERL_VENDORARCH_EXP "" /**/
+/*#define PERL_VENDORARCH "" / **/
+/*#define PERL_VENDORARCH_EXP "" / **/
/* PERL_VENDORLIB_EXP:
* This symbol contains the ~name expanded version of VENDORLIB, to be used
* removed. The elements in inc_version_list (inc_version_list.U) can
* be tacked onto this variable to generate a list of directories to search.
*/
-/*#define PERL_VENDORLIB_EXP "" /**/
-/*#define PERL_VENDORLIB_STEM "" /**/
+/*#define PERL_VENDORLIB_EXP "" / **/
+/*#define PERL_VENDORLIB_STEM "" / **/
/* VOIDFLAGS:
* This symbol indicates how much support of the void type is given by this
* Perl has been cross-compiled to. Undefined if not a cross-compile.
*/
#ifndef USE_CROSS_COMPILE
-/*#define USE_CROSS_COMPILE /**/
+/*#define USE_CROSS_COMPILE / **/
#define PERL_TARGETARCH "" /**/
#endif
#define BYTEORDER 0x1234 /* large digits for MSB */
#endif /* NeXT */
+/* CHARBITS:
+ * This symbol contains the size of a char, so that the C preprocessor
+ * can make decisions based on it.
+ */
+#define CHARBITS 8 /**/
+
/* CASTI32:
* This symbol is defined if the C compiler can cast negative
* or large floating point numbers to 32-bit ints.
*/
#ifndef _MSC_VER
-# define CASTI32 /**/
+# define CASTI32 /**/
#endif
/* CASTNEGFLOAT:
* This symbol, if defined, indicates that the closedir() routine
* does not return a value.
*/
-/*#define VOID_CLOSEDIR /**/
+/*#define VOID_CLOSEDIR / **/
/* HAS_FD_SET:
* This symbol, when defined, indicates presence of the fd_set typedef
* is available to get system page size, which is the granularity of
* many memory management calls.
*/
-/*#define HAS_GETPAGESIZE /**/
+/*#define HAS_GETPAGESIZE / **/
/* HAS_GNULIBC:
* This symbol, if defined, indicates to the C program that
* the GNU C library is being used. A better check is to use
* the __GLIBC__ and __GLIBC_MINOR__ symbols supplied with glibc.
*/
-/*#define HAS_GNULIBC /**/
+/*#define HAS_GNULIBC / **/
#if defined(HAS_GNULIBC) && !defined(_GNU_SOURCE)
# define _GNU_SOURCE
#endif
* available to operate on a symbolic link (instead of following the
* link).
*/
-/*#define HAS_LCHOWN /**/
+/*#define HAS_LCHOWN / **/
/* HAS_OPEN3:
* This manifest constant lets the C program know that the three
* argument form of open(2) is available.
*/
-/*#define HAS_OPEN3 /**/
+/*#define HAS_OPEN3 / **/
/* HAS_SAFE_BCOPY:
* This symbol, if defined, indicates that the bcopy routine is available
* probably use memmove() or memcpy(). If neither is defined, roll your
* own version.
*/
-/*#define HAS_SAFE_BCOPY /**/
+/*#define HAS_SAFE_BCOPY / **/
/* HAS_SAFE_MEMCPY:
* This symbol, if defined, indicates that the memcpy routine is available
* copy overlapping memory blocks, you should check HAS_MEMMOVE and
* use memmove() instead, if available.
*/
-/*#define HAS_SAFE_MEMCPY /**/
+/*#define HAS_SAFE_MEMCPY / **/
/* HAS_SANE_MEMCMP:
* This symbol, if defined, indicates that the memcmp routine is available
* This symbol, if defined, indicates that Vr4's sigaction() routine
* is available.
*/
-/*#define HAS_SIGACTION /**/
+/*#define HAS_SIGACTION / **/
/* HAS_SIGSETJMP:
* This variable indicates to the C program that the sigsetjmp()
* traditional longjmp() if siglongjmp isn't available.
* See HAS_SIGSETJMP.
*/
-/*#define HAS_SIGSETJMP /**/
+/*#define HAS_SIGSETJMP / **/
#ifdef HAS_SIGSETJMP
#define Sigjmp_buf sigjmp_buf
#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask))
#define STDIO_PTR_LVALUE /**/
#define FILE_cnt(fp) ((fp)->_cnt)
#define STDIO_CNT_LVALUE /**/
-/*#define STDIO_PTR_LVAL_SETS_CNT /**/
+/*#define STDIO_PTR_LVAL_SETS_CNT / **/
#define STDIO_PTR_LVAL_NOCHANGE_CNT /**/
#endif
* symbol.
*/
#define HAS_VPRINTF /**/
-/*#define USE_CHAR_VSPRINTF /**/
+/*#define USE_CHAR_VSPRINTF / **/
/* DOUBLESIZE:
* This symbol contains the size of a double, so that the C preprocessor
* the struct tm has a tm_gmtoff field.
*/
#define I_TIME /**/
-/*#define I_SYS_TIME /**/
-/*#define I_SYS_TIME_KERNEL /**/
-/*#define HAS_TM_TM_ZONE /**/
-/*#define HAS_TM_TM_GMTOFF /**/
+/*#define I_SYS_TIME / **/
+/*#define I_SYS_TIME_KERNEL / **/
+/*#define HAS_TM_TM_ZONE / **/
+/*#define HAS_TM_TM_GMTOFF / **/
/* VAL_O_NONBLOCK:
* This symbol is to be used during open() or fcntl(F_SETFL) to turn on
* This symbol, if defined, indicates that this system uses
* EBCDIC encoding.
*/
-/*#define EBCDIC /**/
+/*#define EBCDIC / **/
/* SETUID_SCRIPTS_ARE_SECURE_NOW:
* This symbol, if defined, indicates that the bug that prevents
* subprocesses to which it must pass the filename rather than the
* file descriptor of the script to be executed.
*/
-/*#define SETUID_SCRIPTS_ARE_SECURE_NOW /**/
-/*#define DOSUID /**/
+/*#define SETUID_SCRIPTS_ARE_SECURE_NOW / **/
+/*#define DOSUID / **/
/* PERL_USE_DEVEL:
* This symbol, if defined, indicates that Perl was configured with
* -Dusedevel, to enable development features. This should not be
* done for production builds.
*/
-/*#define PERL_USE_DEVEL /**/
+/*#define PERL_USE_DEVEL / **/
/* HAS_ATOLF:
* This symbol, if defined, indicates that the atolf routine is
* available to convert strings into long doubles.
*/
-/*#define HAS_ATOLF /**/
+/*#define HAS_ATOLF / **/
/* HAS_ATOLL:
* This symbol, if defined, indicates that the atoll routine is
* This symbol, if defined, indicates that the _fwalk system call is
* available to apply a function to all the file handles.
*/
-/*#define HAS__FWALK /**/
+/*#define HAS__FWALK / **/
/* HAS_AINTL:
* This symbol, if defined, indicates that the aintl routine is
* available. If copysignl is also present we can emulate modfl.
*/
-/*#define HAS_AINTL /**/
+/*#define HAS_AINTL / **/
/* HAS_BUILTIN_CHOOSE_EXPR:
* Can we handle GCC builtin for compile-time ternary-like expressions
* Can we handle GCC builtin for telling that certain values are more
* likely
*/
-/*#define HAS_BUILTIN_EXPECT /**/
-/*#define HAS_BUILTIN_CHOOSE_EXPR /**/
+/*#define HAS_BUILTIN_EXPECT / **/
+/*#define HAS_BUILTIN_CHOOSE_EXPR / **/
/* HAS_C99_VARIADIC_MACROS:
* If defined, the compiler supports C99 variadic macros.
*/
-/*#define HAS_C99_VARIADIC_MACROS /**/
+/*#define HAS_C99_VARIADIC_MACROS / **/
/* HAS_CLASS:
* This symbol, if defined, indicates that the class routine is
* FP_NANS Signaling Not a Number (NaNS)
* FP_NANQ Quiet Not a Number (NaNQ)
*/
-/*#define HAS_CLASS /**/
+/*#define HAS_CLASS / **/
/* HAS_CLEARENV:
* This symbol, if defined, indicates that the clearenv () routine is
* available for use.
*/
-/*#define HAS_CLEARENV /**/
+/*#define HAS_CLEARENV / **/
/* HAS_STRUCT_CMSGHDR:
* This symbol, if defined, indicates that the struct cmsghdr
* is supported.
*/
-/*#define HAS_STRUCT_CMSGHDR /**/
+/*#define HAS_STRUCT_CMSGHDR / **/
/* HAS_COPYSIGNL:
* This symbol, if defined, indicates that the copysignl routine is
* available. If aintl is also present we can emulate modfl.
*/
-/*#define HAS_COPYSIGNL /**/
+/*#define HAS_COPYSIGNL / **/
/* USE_CPLUSPLUS:
* This symbol, if defined, indicates that a C++ compiler was
* used to compiled Perl and will be used to compile extensions.
*/
-/*#define USE_CPLUSPLUS /**/
+/*#define USE_CPLUSPLUS / **/
/* HAS_DBMINIT_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. A good guess is
* extern int dbminit(char *);
*/
-/*#define HAS_DBMINIT_PROTO /**/
+/*#define HAS_DBMINIT_PROTO / **/
/* HAS_DIR_DD_FD:
* This symbol, if defined, indicates that the the DIR* dirstream
* structure contains a member variable named dd_fd.
*/
-/*#define HAS_DIR_DD_FD /**/
+/*#define HAS_DIR_DD_FD / **/
/* HAS_DIRFD:
* This manifest constant lets the C program know that dirfd
* is available.
*/
-/*#define HAS_DIRFD /**/
+/*#define HAS_DIRFD / **/
/* DLSYM_NEEDS_UNDERSCORE:
* This symbol, if defined, indicates that we need to prepend an
* makes sense if you *have* dlsym, which we will presume is the
* case if you're using dl_dlopen.xs.
*/
-/*#define DLSYM_NEEDS_UNDERSCORE /**/
+/*#define DLSYM_NEEDS_UNDERSCORE / **/
/* HAS_FAST_STDIO:
* This symbol, if defined, indicates that the "fast stdio"
* This symbol, if defined, indicates that the fchdir routine is
* available to change directory using a file descriptor.
*/
-/*#define HAS_FCHDIR /**/
+/*#define HAS_FCHDIR / **/
/* FCNTL_CAN_LOCK:
* This symbol, if defined, indicates that fcntl() can be used
* for file locking. Normally on Unix systems this is defined.
* It may be undefined on VMS.
*/
-/*#define FCNTL_CAN_LOCK /**/
+/*#define FCNTL_CAN_LOCK / **/
/* HAS_FINITE:
* This symbol, if defined, indicates that the finite routine is
* available to check whether a double is finite (non-infinity non-NaN).
*/
-/*#define HAS_FINITE /**/
+/*#define HAS_FINITE / **/
/* HAS_FINITEL:
* This symbol, if defined, indicates that the finitel routine is
* available to check whether a long double is finite
* (non-infinity non-NaN).
*/
-/*#define HAS_FINITEL /**/
+/*#define HAS_FINITEL / **/
/* HAS_FLOCK_PROTO:
* This symbol, if defined, indicates that the system provides
* FP_POS_ZERO +0.0 (positive zero)
* FP_NEG_ZERO -0.0 (negative zero)
*/
-/*#define HAS_FP_CLASS /**/
+/*#define HAS_FP_CLASS / **/
/* HAS_FPCLASS:
* This symbol, if defined, indicates that the fpclass routine is
* FP_NNORM negative normalized non-zero
* FP_PNORM positive normalized non-zero
*/
-/*#define HAS_FPCLASS /**/
+/*#define HAS_FPCLASS / **/
/* HAS_FPCLASSIFY:
* This symbol, if defined, indicates that the fpclassify routine is
* FP_NAN NaN
*
*/
-/*#define HAS_FPCLASSIFY /**/
+/*#define HAS_FPCLASSIFY / **/
/* HAS_FPCLASSL:
* This symbol, if defined, indicates that the fpclassl routine is
* FP_NNORM negative normalized non-zero
* FP_PNORM positive normalized non-zero
*/
-/*#define HAS_FPCLASSL /**/
+/*#define HAS_FPCLASSL / **/
/* HAS_FPOS64_T:
* This symbol will be defined if the C compiler supports fpos64_t.
*/
-/*#define HAS_FPOS64_T /**/
+/*#define HAS_FPOS64_T / **/
/* HAS_FREXPL:
* This symbol, if defined, indicates that the frexpl routine is
* available to break a long double floating-point number into
* a normalized fraction and an integral power of 2.
*/
-/*#define HAS_FREXPL /**/
+/*#define HAS_FREXPL / **/
/* HAS_STRUCT_FS_DATA:
* This symbol, if defined, indicates that the struct fs_data
* to do statfs() is supported.
*/
-/*#define HAS_STRUCT_FS_DATA /**/
+/*#define HAS_STRUCT_FS_DATA / **/
/* HAS_FSEEKO:
* This symbol, if defined, indicates that the fseeko routine is
* available to fseek beyond 32 bits (useful for ILP32 hosts).
*/
-/*#define HAS_FSEEKO /**/
+/*#define HAS_FSEEKO / **/
/* HAS_FSTATFS:
* This symbol, if defined, indicates that the fstatfs routine is
* available to stat filesystems by file descriptors.
*/
-/*#define HAS_FSTATFS /**/
+/*#define HAS_FSTATFS / **/
/* HAS_FSYNC:
* This symbol, if defined, indicates that the fsync routine is
* available to write a file's modified data and attributes to
* permanent storage.
*/
-/*#define HAS_FSYNC /**/
+/*#define HAS_FSYNC / **/
/* HAS_FTELLO:
* This symbol, if defined, indicates that the ftello routine is
* available to ftell beyond 32 bits (useful for ILP32 hosts).
*/
-/*#define HAS_FTELLO /**/
+/*#define HAS_FTELLO / **/
/* HAS_FUTIMES:
* This symbol, if defined, indicates that the futimes routine is
* available to change file descriptor time stamps with struct timevals.
*/
-/*#define HAS_FUTIMES /**/
+/*#define HAS_FUTIMES / **/
/* HAS_GETADDRINFO:
* This symbol, if defined, indicates that the getaddrinfo() function
* is available for use.
*/
-/*#define HAS_GETADDRINFO /**/
+/*#define HAS_GETADDRINFO / **/
/* HAS_GETCWD:
* This symbol, if defined, indicates that the getcwd routine is
* This symbol, if defined, indicates that the getespwnam system call is
* available to retrieve enchanced (shadow) password entries by name.
*/
-/*#define HAS_GETESPWNAM /**/
+/*#define HAS_GETESPWNAM / **/
/* HAS_GETFSSTAT:
* This symbol, if defined, indicates that the getfsstat routine is
* available to stat filesystems in bulk.
*/
-/*#define HAS_GETFSSTAT /**/
+/*#define HAS_GETFSSTAT / **/
/* HAS_GETITIMER:
* This symbol, if defined, indicates that the getitimer routine is
* available to return interval timers.
*/
-/*#define HAS_GETITIMER /**/
+/*#define HAS_GETITIMER / **/
/* HAS_GETMNT:
* This symbol, if defined, indicates that the getmnt routine is
* available to get filesystem mount info by filename.
*/
-/*#define HAS_GETMNT /**/
+/*#define HAS_GETMNT / **/
/* HAS_GETMNTENT:
* This symbol, if defined, indicates that the getmntent routine is
* available to iterate through mounted file systems to get their info.
*/
-/*#define HAS_GETMNTENT /**/
+/*#define HAS_GETMNTENT / **/
/* HAS_GETNAMEINFO:
* This symbol, if defined, indicates that the getnameinfo() function
* is available for use.
*/
-/*#define HAS_GETNAMEINFO /**/
+/*#define HAS_GETNAMEINFO / **/
/* HAS_GETPRPWNAM:
* This symbol, if defined, indicates that the getprpwnam system call is
* available to retrieve protected (shadow) password entries by name.
*/
-/*#define HAS_GETPRPWNAM /**/
+/*#define HAS_GETPRPWNAM / **/
/* HAS_GETSPNAM:
* This symbol, if defined, indicates that the getspnam system call is
* available to retrieve SysV shadow password entries by name.
*/
-/*#define HAS_GETSPNAM /**/
+/*#define HAS_GETSPNAM / **/
/* HAS_HASMNTOPT:
* This symbol, if defined, indicates that the hasmntopt routine is
* available to query the mount options of file systems.
*/
-/*#define HAS_HASMNTOPT /**/
+/*#define HAS_HASMNTOPT / **/
/* HAS_ILOGBL:
* This symbol, if defined, indicates that the ilogbl routine is
* available. If scalbnl is also present we can emulate frexpl.
*/
-/*#define HAS_ILOGBL /**/
+/*#define HAS_ILOGBL / **/
/* HAS_INETNTOP:
* This symbol, if defined, indicates that the inet_ntop() function
* is available to parse IPv4 and IPv6 strings.
*/
-/*#define HAS_INETNTOP /**/
+/*#define HAS_INETNTOP / **/
/* HAS_INETPTON:
* This symbol, if defined, indicates that the inet_pton() function
* is available to parse IPv4 and IPv6 strings.
*/
-/*#define HAS_INETPTON /**/
+/*#define HAS_INETPTON / **/
/* HAS_INT64_T:
* This symbol will defined if the C compiler supports int64_t.
* Usually the <inttypes.h> needs to be included, but sometimes
* <sys/types.h> is enough.
*/
-/*#define HAS_INT64_T /**/
+/*#define HAS_INT64_T / **/
/* HAS_ISFINITE:
* This symbol, if defined, indicates that the isfinite routine is
* available to check whether a double is finite (non-infinity non-NaN).
*/
-/*#define HAS_ISFINITE /**/
+/*#define HAS_ISFINITE / **/
/* HAS_ISINF:
* This symbol, if defined, indicates that the isinf routine is
* available to check whether a double is an infinity.
*/
-/*#define HAS_ISINF /**/
+/*#define HAS_ISINF / **/
/* HAS_ISNAN:
* This symbol, if defined, indicates that the isnan routine is
* This symbol, if defined, indicates that the isnanl routine is
* available to check whether a long double is a NaN.
*/
-/*#define HAS_ISNANL /**/
+/*#define HAS_ISNANL / **/
/* HAS_LDBL_DIG:
* This symbol, if defined, indicates that this system's <float.h>
* This symbol, if defined, indicates that libm exports _LIB_VERSION
* and that math.h defines the enum to manipulate it.
*/
-/*#define LIBM_LIB_VERSION /**/
+/*#define LIBM_LIB_VERSION / **/
/* HAS_MADVISE:
* This symbol, if defined, indicates that the madvise system call is
* available to map a file into memory.
*/
-/*#define HAS_MADVISE /**/
+/*#define HAS_MADVISE / **/
/* HAS_MALLOC_SIZE:
* This symbol, if defined, indicates that the malloc_size
* routine is available for use.
*/
-/*#define HAS_MALLOC_SIZE /**/
+/*#define HAS_MALLOC_SIZE / **/
/* HAS_MALLOC_GOOD_SIZE:
* This symbol, if defined, indicates that the malloc_good_size
* routine is available for use.
*/
-/*#define HAS_MALLOC_GOOD_SIZE /**/
+/*#define HAS_MALLOC_GOOD_SIZE / **/
/* HAS_MKDTEMP:
* This symbol, if defined, indicates that the mkdtemp routine is
* available to exclusively create a uniquely named temporary directory.
*/
-/*#define HAS_MKDTEMP /**/
+/*#define HAS_MKDTEMP / **/
/* HAS_MKSTEMPS:
* This symbol, if defined, indicates that the mkstemps routine is
* available to excluslvely create and open a uniquely named
* (with a suffix) temporary file.
*/
-/*#define HAS_MKSTEMPS /**/
+/*#define HAS_MKSTEMPS / **/
/* HAS_MODFL:
* This symbol, if defined, indicates that the modfl routine is
* and 1.150000. The bug has been seen in certain versions of glibc,
* release 2.2.2 is known to be okay.
*/
-/*#define HAS_MODFL /**/
-/*#define HAS_MODFL_PROTO /**/
-/*#define HAS_MODFL_POW32_BUG /**/
+/*#define HAS_MODFL / **/
+/*#define HAS_MODFL_PROTO / **/
+/*#define HAS_MODFL_POW32_BUG / **/
/* HAS_MPROTECT:
* This symbol, if defined, indicates that the mprotect system call is
* available to modify the access protection of a memory mapped file.
*/
-/*#define HAS_MPROTECT /**/
+/*#define HAS_MPROTECT / **/
/* HAS_STRUCT_MSGHDR:
* This symbol, if defined, indicates that the struct msghdr
* is supported.
*/
-/*#define HAS_STRUCT_MSGHDR /**/
+/*#define HAS_STRUCT_MSGHDR / **/
/* HAS_NL_LANGINFO:
* This symbol, if defined, indicates that the nl_langinfo routine is
* available to return local data. You will also need <langinfo.h>
* and therefore I_LANGINFO.
*/
-/*#define HAS_NL_LANGINFO /**/
+/*#define HAS_NL_LANGINFO / **/
/* HAS_OFF64_T:
* This symbol will be defined if the C compiler supports off64_t.
*/
-/*#define HAS_OFF64_T /**/
+/*#define HAS_OFF64_T / **/
/* HAS_PROCSELFEXE:
* This symbol is defined if PROCSELFEXE_PATH is a symlink
* of the symbolic link pointing to the absolute pathname of
* the executing program.
*/
-/*#define HAS_PROCSELFEXE /**/
+/*#define HAS_PROCSELFEXE / **/
#if defined(HAS_PROCSELFEXE) && !defined(PROCSELFEXE_PATH)
#define PROCSELFEXE_PATH /**/
#endif
* system call is available to set the contention scope attribute of
* a thread attribute object.
*/
-/*#define HAS_PTHREAD_ATTR_SETSCOPE /**/
+/*#define HAS_PTHREAD_ATTR_SETSCOPE / **/
/* HAS_READV:
* This symbol, if defined, indicates that the readv routine is
* available to do gather reads. You will also need <sys/uio.h>
* and there I_SYSUIO.
*/
-/*#define HAS_READV /**/
+/*#define HAS_READV / **/
/* HAS_RECVMSG:
* This symbol, if defined, indicates that the recvmsg routine is
* available to send structured socket messages.
*/
-/*#define HAS_RECVMSG /**/
+/*#define HAS_RECVMSG / **/
/* HAS_SBRK_PROTO:
* This symbol, if defined, indicates that the system provides
* extern void* sbrk(int);
* extern void* sbrk(size_t);
*/
-/*#define HAS_SBRK_PROTO /**/
+/*#define HAS_SBRK_PROTO / **/
/* HAS_SCALBNL:
* This symbol, if defined, indicates that the scalbnl routine is
* available. If ilogbl is also present we can emulate frexpl.
*/
-/*#define HAS_SCALBNL /**/
+/*#define HAS_SCALBNL / **/
/* HAS_SENDMSG:
* This symbol, if defined, indicates that the sendmsg routine is
* available to send structured socket messages.
*/
-/*#define HAS_SENDMSG /**/
+/*#define HAS_SENDMSG / **/
/* HAS_SETITIMER:
* This symbol, if defined, indicates that the setitimer routine is
* available to set interval timers.
*/
-/*#define HAS_SETITIMER /**/
+/*#define HAS_SETITIMER / **/
/* HAS_SETPROCTITLE:
* This symbol, if defined, indicates that the setproctitle routine is
* available to set process title.
*/
-/*#define HAS_SETPROCTITLE /**/
+/*#define HAS_SETPROCTITLE / **/
/* USE_SFIO:
* This symbol, if defined, indicates that sfio should
* be used.
*/
-/*#define USE_SFIO /**/
+/*#define USE_SFIO / **/
/* HAS_SIGNBIT:
* This symbol, if defined, indicates that the signbit routine is
* in perl. Users should call Perl_signbit(), which will be #defined to
* the system's signbit() function or macro if this symbol is defined.
*/
-/*#define HAS_SIGNBIT /**/
+/*#define HAS_SIGNBIT / **/
/* HAS_SIGPROCMASK:
* This symbol, if defined, indicates that the sigprocmask
* system call is available to examine or change the signal mask
* of the calling process.
*/
-/*#define HAS_SIGPROCMASK /**/
+/*#define HAS_SIGPROCMASK / **/
/* USE_SITECUSTOMIZE:
* This symbol, if defined, indicates that sitecustomize should
* be used.
*/
#ifndef USE_SITECUSTOMIZE
-/*#define USE_SITECUSTOMIZE /**/
+/*#define USE_SITECUSTOMIZE / **/
#endif
/* HAS_SNPRINTF:
* This symbol, if defined, indicates that the sockatmark routine is
* available to test whether a socket is at the out-of-band mark.
*/
-/*#define HAS_SOCKATMARK /**/
+/*#define HAS_SOCKATMARK / **/
/* HAS_SOCKATMARK_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. A good guess is
* extern int sockatmark(int);
*/
-/*#define HAS_SOCKATMARK_PROTO /**/
+/*#define HAS_SOCKATMARK_PROTO / **/
/* HAS_SOCKS5_INIT:
* This symbol, if defined, indicates that the socks5_init routine is
* available to initialize SOCKS 5.
*/
-/*#define HAS_SOCKS5_INIT /**/
+/*#define HAS_SOCKS5_INIT / **/
/* SPRINTF_RETURNS_STRLEN:
* This variable defines whether sprintf returns the length of the string
* This symbol, if defined, indicates that the sqrtl routine is
* available to do long double square roots.
*/
-/*#define HAS_SQRTL /**/
+/*#define HAS_SQRTL / **/
/* HAS_SETRESGID_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. Good guesses are
* extern int setresgid(uid_t ruid, uid_t euid, uid_t suid);
*/
-/*#define HAS_SETRESGID_PROTO /**/
+/*#define HAS_SETRESGID_PROTO / **/
/* HAS_SETRESUID_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. Good guesses are
* extern int setresuid(uid_t ruid, uid_t euid, uid_t suid);
*/
-/*#define HAS_SETRESUID_PROTO /**/
+/*#define HAS_SETRESUID_PROTO / **/
/* HAS_STRUCT_STATFS_F_FLAGS:
* This symbol, if defined, indicates that the struct statfs
* have statfs() and struct statfs, they have ustat() and getmnt()
* with struct ustat and struct fs_data.
*/
-/*#define HAS_STRUCT_STATFS_F_FLAGS /**/
+/*#define HAS_STRUCT_STATFS_F_FLAGS / **/
/* HAS_STRUCT_STATFS:
* This symbol, if defined, indicates that the struct statfs
* to do statfs() is supported.
*/
-/*#define HAS_STRUCT_STATFS /**/
+/*#define HAS_STRUCT_STATFS / **/
/* HAS_FSTATVFS:
* This symbol, if defined, indicates that the fstatvfs routine is
* available to stat filesystems by file descriptors.
*/
-/*#define HAS_FSTATVFS /**/
+/*#define HAS_FSTATVFS / **/
/* HAS_STRFTIME:
* This symbol, if defined, indicates that the strftime routine is
* This symbol, if defined, indicates that the strlcat () routine is
* available to do string concatenation.
*/
-/*#define HAS_STRLCAT /**/
+/*#define HAS_STRLCAT / **/
/* HAS_STRLCPY:
* This symbol, if defined, indicates that the strlcpy () routine is
* available to do string copying.
*/
-/*#define HAS_STRLCPY /**/
+/*#define HAS_STRLCPY / **/
/* HAS_STRTOLD:
* This symbol, if defined, indicates that the strtold routine is
* available to convert strings to long doubles.
*/
-/*#define HAS_STRTOLD /**/
+/*#define HAS_STRTOLD / **/
/* HAS_STRTOLL:
* This symbol, if defined, indicates that the strtoll routine is
* This symbol, if defined, indicates that the strtoq routine is
* available to convert strings to long longs (quads).
*/
-/*#define HAS_STRTOQ /**/
+/*#define HAS_STRTOQ / **/
/* HAS_STRTOULL:
* This symbol, if defined, indicates that the strtoull routine is
* This symbol, if defined, indicates that the strtouq routine is
* available to convert strings to unsigned long longs (quads).
*/
-/*#define HAS_STRTOUQ /**/
+/*#define HAS_STRTOUQ / **/
/* HAS_SYSCALL_PROTO:
* This symbol, if defined, indicates that the system provides
* extern int syscall(int, ...);
* extern int syscall(long, ...);
*/
-/*#define HAS_SYSCALL_PROTO /**/
+/*#define HAS_SYSCALL_PROTO / **/
/* HAS_TELLDIR_PROTO:
* This symbol, if defined, indicates that the system provides
* This symbol, if defined, indicates that the asctime64 () routine is
* available to do the 64bit variant of asctime ()
*/
-/*#define HAS_CTIME64 /**/
-/*#define HAS_LOCALTIME64 /**/
-/*#define HAS_GMTIME64 /**/
-/*#define HAS_MKTIME64 /**/
-/*#define HAS_DIFFTIME64 /**/
-/*#define HAS_ASCTIME64 /**/
+/*#define HAS_CTIME64 / **/
+/*#define HAS_LOCALTIME64 / **/
+/*#define HAS_GMTIME64 / **/
+/*#define HAS_MKTIME64 / **/
+/*#define HAS_DIFFTIME64 / **/
+/*#define HAS_ASCTIME64 / **/
/* HAS_TIMEGM:
* This symbol, if defined, indicates that the timegm routine is
* available to do the opposite of gmtime ()
*/
-/*#define HAS_TIMEGM /**/
+/*#define HAS_TIMEGM / **/
/* U32_ALIGNMENT_REQUIRED:
* This symbol, if defined, indicates that you must access
* This symbol, if defined, indicates that the ualarm routine is
* available to do alarms with microsecond granularity.
*/
-/*#define HAS_UALARM /**/
+/*#define HAS_UALARM / **/
/* HAS_UNORDERED:
* This symbol, if defined, indicates that the unordered routine is
* available to check whether two doubles are unordered
* (effectively: whether either of them is NaN)
*/
-/*#define HAS_UNORDERED /**/
+/*#define HAS_UNORDERED / **/
/* HAS_UNSETENV:
* This symbol, if defined, indicates that the unsetenv () routine is
* available for use.
*/
-/*#define HAS_UNSETENV /**/
+/*#define HAS_UNSETENV / **/
/* HAS_USLEEP_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. A good guess is
* extern int usleep(useconds_t);
*/
-/*#define HAS_USLEEP_PROTO /**/
+/*#define HAS_USLEEP_PROTO / **/
/* HAS_USTAT:
* This symbol, if defined, indicates that the ustat system call is
* available to query file system statistics by dev_t.
*/
-/*#define HAS_USTAT /**/
+/*#define HAS_USTAT / **/
/* HAS_WRITEV:
* This symbol, if defined, indicates that the writev routine is
* available to do scatter writes.
*/
-/*#define HAS_WRITEV /**/
+/*#define HAS_WRITEV / **/
/* USE_DYNAMIC_LOADING:
* This symbol, if defined, indicates that dynamic loading of
* even be probed for and will be left undefined.
*/
#define FFLUSH_NULL /**/
-/*#define FFLUSH_ALL /**/
+/*#define FFLUSH_ALL / **/
/* I_ASSERT:
* This symbol, if defined, indicates that <assert.h> exists and
* This symbol, if defined, indicates that <crypt.h> exists and
* should be included.
*/
-/*#define I_CRYPT /**/
+/*#define I_CRYPT / **/
/* DB_Prefix_t:
* This symbol contains the type of the prefix structure element
* This symbol, if defined, indicates that <fp.h> exists and
* should be included.
*/
-/*#define I_FP /**/
+/*#define I_FP / **/
/* I_FP_CLASS:
* This symbol, if defined, indicates that <fp_class.h> exists and
* should be included.
*/
-/*#define I_FP_CLASS /**/
+/*#define I_FP_CLASS / **/
/* I_IEEEFP:
* This symbol, if defined, indicates that <ieeefp.h> exists and
* should be included.
*/
-/*#define I_IEEEFP /**/
+/*#define I_IEEEFP / **/
/* I_INTTYPES:
* This symbol, if defined, indicates to the C program that it should
* include <inttypes.h>.
*/
-/*#define I_INTTYPES /**/
+/*#define I_INTTYPES / **/
/* I_LANGINFO:
* This symbol, if defined, indicates that <langinfo.h> exists and
* should be included.
*/
-/*#define I_LANGINFO /**/
+/*#define I_LANGINFO / **/
/* I_LIBUTIL:
* This symbol, if defined, indicates that <libutil.h> exists and
* should be included.
*/
-/*#define I_LIBUTIL /**/
+/*#define I_LIBUTIL / **/
/* I_MALLOCMALLOC:
* This symbol, if defined, indicates to the C program that it should
* include <malloc/malloc.h>.
*/
-/*#define I_MALLOCMALLOC /**/
+/*#define I_MALLOCMALLOC / **/
/* I_MNTENT:
* This symbol, if defined, indicates that <mntent.h> exists and
* should be included.
*/
-/*#define I_MNTENT /**/
+/*#define I_MNTENT / **/
/* I_NETINET_TCP:
* This symbol, if defined, indicates to the C program that it should
* include <netinet/tcp.h>.
*/
-/*#define I_NETINET_TCP /**/
+/*#define I_NETINET_TCP / **/
/* I_POLL:
* This symbol, if defined, indicates that <poll.h> exists and
* should be included. (see also HAS_POLL)
*/
-/*#define I_POLL /**/
+/*#define I_POLL / **/
/* I_PROT:
* This symbol, if defined, indicates that <prot.h> exists and
* should be included.
*/
-/*#define I_PROT /**/
+/*#define I_PROT / **/
/* I_SHADOW:
* This symbol, if defined, indicates that <shadow.h> exists and
* should be included.
*/
-/*#define I_SHADOW /**/
+/*#define I_SHADOW / **/
/* I_SOCKS:
* This symbol, if defined, indicates that <socks.h> exists and
* should be included.
*/
-/*#define I_SOCKS /**/
+/*#define I_SOCKS / **/
/* I_SUNMATH:
* This symbol, if defined, indicates that <sunmath.h> exists and
* should be included.
*/
-/*#define I_SUNMATH /**/
+/*#define I_SUNMATH / **/
/* I_SYSLOG:
* This symbol, if defined, indicates that <syslog.h> exists and
* should be included.
*/
-/*#define I_SYSLOG /**/
+/*#define I_SYSLOG / **/
/* I_SYSMODE:
* This symbol, if defined, indicates that <sys/mode.h> exists and
* should be included.
*/
-/*#define I_SYSMODE /**/
+/*#define I_SYSMODE / **/
/* I_SYS_MOUNT:
* This symbol, if defined, indicates that <sys/mount.h> exists and
* should be included.
*/
-/*#define I_SYS_MOUNT /**/
+/*#define I_SYS_MOUNT / **/
/* I_SYS_STATFS:
* This symbol, if defined, indicates that <sys/statfs.h> exists.
*/
-/*#define I_SYS_STATFS /**/
+/*#define I_SYS_STATFS / **/
/* I_SYS_STATVFS:
* This symbol, if defined, indicates that <sys/statvfs.h> exists and
* should be included.
*/
-/*#define I_SYS_STATVFS /**/
+/*#define I_SYS_STATVFS / **/
/* I_SYSUTSNAME:
* This symbol, if defined, indicates that <sys/utsname.h> exists and
* should be included.
*/
-/*#define I_SYSUTSNAME /**/
+/*#define I_SYSUTSNAME / **/
/* I_SYS_VFS:
* This symbol, if defined, indicates that <sys/vfs.h> exists and
* should be included.
*/
-/*#define I_SYS_VFS /**/
+/*#define I_SYS_VFS / **/
/* I_USTAT:
* This symbol, if defined, indicates that <ustat.h> exists and
* should be included.
*/
-/*#define I_USTAT /**/
+/*#define I_USTAT / **/
/* PERL_PRIfldbl:
* This symbol, if defined, contains the string used by stdio to
* This symbol, if defined, contains the string used by stdio to
* format long doubles (format 'f') for input.
*/
-/*#define PERL_PRIfldbl "f" /**/
-/*#define PERL_PRIgldbl "g" /**/
-/*#define PERL_PRIeldbl "e" /**/
-/*#define PERL_SCNfldbl "f" /**/
+/*#define PERL_PRIfldbl "f" / **/
+/*#define PERL_PRIgldbl "g" / **/
+/*#define PERL_PRIeldbl "e" / **/
+/*#define PERL_SCNfldbl "f" / **/
/* PERL_MAD:
* This symbol, if defined, indicates that the Misc Attribution
* Declaration code should be conditionally compiled.
*/
-/*#define PERL_MAD /**/
+/*#define PERL_MAD / **/
/* NEED_VA_COPY:
* This symbol, if defined, indicates that the system stores
* of copying mechanisms, handy.h defines a platform-
* independent macro, Perl_va_copy(src, dst), to do the job.
*/
-/*#define NEED_VA_COPY /**/
+/*#define NEED_VA_COPY / **/
/* IVTYPE:
* This symbol defines the C type used for Perl's IV.
* This symbol tells the name of the array holding the stdio streams.
* Usual values include _iob, __iob, and __sF.
*/
-/*#define HAS_STDIO_STREAM_ARRAY /**/
+/*#define HAS_STDIO_STREAM_ARRAY / **/
#ifdef HAS_STDIO_STREAM_ARRAY
-#define STDIO_STREAM_ARRAY
+#define STDIO_STREAM_ARRAY
#endif
/* GMTIME_MAX:
#define USE_64_BIT_INT /**/
#endif
#ifndef USE_64_BIT_ALL
-/*#define USE_64_BIT_ALL /**/
+/*#define USE_64_BIT_ALL / **/
#endif
/* USE_DTRACE:
* This symbol, if defined, indicates that Perl should
* be built with support for DTrace.
*/
-/*#define USE_DTRACE /**/
+/*#define USE_DTRACE / **/
/* USE_FAST_STDIO:
* This symbol, if defined, indicates that Perl should
* Defaults to define in Perls 5.8 and earlier, to undef later.
*/
#ifndef USE_FAST_STDIO
-/*#define USE_FAST_STDIO /**/
+/*#define USE_FAST_STDIO / **/
#endif
/* USE_LARGE_FILES:
* be used when available.
*/
#ifndef USE_LONG_DOUBLE
-/*#define USE_LONG_DOUBLE /**/
+/*#define USE_LONG_DOUBLE / **/
#endif
/* USE_MORE_BITS:
* long doubles should be used when available.
*/
#ifndef USE_MORE_BITS
-/*#define USE_MORE_BITS /**/
+/*#define USE_MORE_BITS / **/
#endif
/* MULTIPLICITY:
* be built to use socks.
*/
#ifndef USE_SOCKS
-/*#define USE_SOCKS /**/
+/*#define USE_SOCKS / **/
#endif
#endif
/*
* Package name : perl5
* Source directory :
- * Configuration time: Fri Dec 12 15:19:23 2008
- * Configured by : shay
+ * Configuration time: Sat Jan 9 17:22:03 2010
+ * Configured by : Steve
* Target system :
*/
* This symbol is defined if the bcmp() routine is available to
* compare blocks of memory.
*/
-/*#define HAS_BCMP /**/
+/*#define HAS_BCMP / **/
/* HAS_BCOPY:
* This symbol is defined if the bcopy() routine is available to
* copy blocks of memory.
*/
-/*#define HAS_BCOPY /**/
+/*#define HAS_BCOPY / **/
/* HAS_BZERO:
* This symbol is defined if the bzero() routine is available to
* set a memory block to 0.
*/
-/*#define HAS_BZERO /**/
+/*#define HAS_BZERO / **/
/* HAS_CHOWN:
* This symbol, if defined, indicates that the chown routine is
* available.
*/
-/*#define HAS_CHOWN /**/
+/*#define HAS_CHOWN / **/
/* HAS_CHROOT:
* This symbol, if defined, indicates that the chroot routine is
* available.
*/
-/*#define HAS_CHROOT /**/
+/*#define HAS_CHROOT / **/
/* HAS_CHSIZE:
* This symbol, if defined, indicates that the chsize routine is available
* This symbol, if defined, indicates that the crypt routine is available
* to encrypt passwords and the like.
*/
-/*#define HAS_CRYPT /**/
+/*#define HAS_CRYPT / **/
/* HAS_CTERMID:
* This symbol, if defined, indicates that the ctermid routine is
* available to generate filename for terminal.
*/
-/*#define HAS_CTERMID /**/
+/*#define HAS_CTERMID / **/
/* HAS_CUSERID:
* This symbol, if defined, indicates that the cuserid routine is
* available to get character login names.
*/
-/*#define HAS_CUSERID /**/
+/*#define HAS_CUSERID / **/
/* HAS_DBL_DIG:
* This symbol, if defined, indicates that this system's <float.h>
*/
#define HAS_DLERROR /**/
-/* SETUID_SCRIPTS_ARE_SECURE_NOW:
- * This symbol, if defined, indicates that the bug that prevents
- * setuid scripts from being secure is not present in this kernel.
- */
-/* DOSUID:
- * This symbol, if defined, indicates that the C program should
- * check the script that it is executing for setuid/setgid bits, and
- * attempt to emulate setuid/setgid on systems that have disabled
- * setuid #! scripts because the kernel can't do it securely.
- * It is up to the package designer to make sure that this emulation
- * is done securely. Among other things, it should do an fstat on
- * the script it just opened to make sure it really is a setuid/setgid
- * script, it should make sure the arguments passed correspond exactly
- * to the argument on the #! line, and it should not trust any
- * subprocesses to which it must pass the filename rather than the
- * file descriptor of the script to be executed.
- */
-/*#define SETUID_SCRIPTS_ARE_SECURE_NOW /**/
-/*#define DOSUID /**/
-
/* HAS_DUP2:
* This symbol, if defined, indicates that the dup2 routine is
* available to duplicate file descriptors.
* This symbol, if defined, indicates that the fchmod routine is available
* to change mode of opened files. If unavailable, use chmod().
*/
-/*#define HAS_FCHMOD /**/
+/*#define HAS_FCHMOD / **/
/* HAS_FCHOWN:
* This symbol, if defined, indicates that the fchown routine is available
* to change ownership of opened files. If unavailable, use chown().
*/
-/*#define HAS_FCHOWN /**/
+/*#define HAS_FCHOWN / **/
/* HAS_FCNTL:
* This symbol, if defined, indicates to the C program that
* the fcntl() function exists.
*/
-/*#define HAS_FCNTL /**/
+/*#define HAS_FCNTL / **/
/* HAS_FGETPOS:
* This symbol, if defined, indicates that the fgetpos routine is
* This symbol, if defined, indicates that the fork routine is
* available.
*/
-/*#define HAS_FORK /**/
+/*#define HAS_FORK / **/
/* HAS_FSETPOS:
* This symbol, if defined, indicates that the fsetpos routine is
* available to get the list of process groups. If unavailable, multiple
* groups are probably not supported.
*/
-/*#define HAS_GETGROUPS /**/
+/*#define HAS_GETGROUPS / **/
/* HAS_GETLOGIN:
* This symbol, if defined, indicates that the getlogin routine is
* the getpgid(pid) function is available to get the
* process group id.
*/
-/*#define HAS_GETPGID /**/
+/*#define HAS_GETPGID / **/
/* HAS_GETPGRP2:
* This symbol, if defined, indicates that the getpgrp2() (as in DG/UX)
* routine is available to get the current process group.
*/
-/*#define HAS_GETPGRP2 /**/
+/*#define HAS_GETPGRP2 / **/
/* HAS_GETPPID:
* This symbol, if defined, indicates that the getppid routine is
* available to get the parent process ID.
*/
-/*#define HAS_GETPPID /**/
+/*#define HAS_GETPPID / **/
/* HAS_GETPRIORITY:
* This symbol, if defined, indicates that the getpriority routine is
* available to get a process's priority.
*/
-/*#define HAS_GETPRIORITY /**/
+/*#define HAS_GETPRIORITY / **/
/* HAS_INET_ATON:
* This symbol, if defined, indicates to the C program that the
* inet_aton() function is available to parse IP address "dotted-quad"
* strings.
*/
-/*#define HAS_INET_ATON /**/
+/*#define HAS_INET_ATON / **/
/* HAS_KILLPG:
* This symbol, if defined, indicates that the killpg routine is available
* This symbol, if defined, indicates that the lockf routine is
* available to do file locking.
*/
-/*#define HAS_LOCKF /**/
+/*#define HAS_LOCKF / **/
/* HAS_LSTAT:
* This symbol, if defined, indicates that the lstat routine is
* available to do file stats on symbolic links.
*/
-/*#define HAS_LSTAT /**/
+/*#define HAS_LSTAT / **/
/* HAS_MBLEN:
* This symbol, if defined, indicates that the mblen routine is available
* do it for you. However, if mkfifo is there, mknod might require
* super-user privileges which mkfifo will not.
*/
-/*#define HAS_MKFIFO /**/
+/*#define HAS_MKFIFO / **/
/* HAS_MKTIME:
* This symbol, if defined, indicates that the mktime routine is
* This symbol, if defined, indicates that the msync system call is
* available to synchronize a mapped file.
*/
-/*#define HAS_MSYNC /**/
+/*#define HAS_MSYNC / **/
/* HAS_MUNMAP:
* This symbol, if defined, indicates that the munmap system call is
* available to unmap a region, usually mapped by mmap().
*/
-/*#define HAS_MUNMAP /**/
+/*#define HAS_MUNMAP / **/
/* HAS_NICE:
* This symbol, if defined, indicates that the nice routine is
* available.
*/
-/*#define HAS_NICE /**/
+/*#define HAS_NICE / **/
/* HAS_PATHCONF:
* This symbol, if defined, indicates that pathconf() is available
* to determine file-system related limits and options associated
* with a given open file descriptor.
*/
-/*#define HAS_PATHCONF /**/
-/*#define HAS_FPATHCONF /**/
+/*#define HAS_PATHCONF / **/
+/*#define HAS_FPATHCONF / **/
/* HAS_PAUSE:
* This symbol, if defined, indicates that the pause routine is
* available to poll active file descriptors. Please check I_POLL and
* I_SYS_POLL to know which header should be included as well.
*/
-/*#define HAS_POLL /**/
+/*#define HAS_POLL / **/
/* HAS_READDIR:
* This symbol, if defined, indicates that the readdir routine is
* This symbol, if defined, indicates that the readlink routine is
* available to read the value of a symbolic link.
*/
-/*#define HAS_READLINK /**/
+/*#define HAS_READLINK / **/
/* HAS_RENAME:
* This symbol, if defined, indicates that the rename routine is available
* This symbol, if defined, indicates that the setegid routine is available
* to change the effective gid of the current program.
*/
-/*#define HAS_SETEGID /**/
+/*#define HAS_SETEGID / **/
/* HAS_SETEUID:
* This symbol, if defined, indicates that the seteuid routine is available
* to change the effective uid of the current program.
*/
-/*#define HAS_SETEUID /**/
+/*#define HAS_SETEUID / **/
/* HAS_SETGROUPS:
* This symbol, if defined, indicates that the setgroups() routine is
* available to set the list of process groups. If unavailable, multiple
* groups are probably not supported.
*/
-/*#define HAS_SETGROUPS /**/
+/*#define HAS_SETGROUPS / **/
/* HAS_SETLINEBUF:
* This symbol, if defined, indicates that the setlinebuf routine is
* available to change stderr or stdout from block-buffered or unbuffered
* to a line-buffered mode.
*/
-/*#define HAS_SETLINEBUF /**/
+/*#define HAS_SETLINEBUF / **/
/* HAS_SETLOCALE:
* This symbol, if defined, indicates that the setlocale routine is
* This symbol, if defined, indicates that the setpgid(pid, gpid)
* routine is available to set process group ID.
*/
-/*#define HAS_SETPGID /**/
+/*#define HAS_SETPGID / **/
/* HAS_SETPGRP2:
* This symbol, if defined, indicates that the setpgrp2() (as in DG/UX)
* routine is available to set the current process group.
*/
-/*#define HAS_SETPGRP2 /**/
+/*#define HAS_SETPGRP2 / **/
/* HAS_SETPRIORITY:
* This symbol, if defined, indicates that the setpriority routine is
* available to set a process's priority.
*/
-/*#define HAS_SETPRIORITY /**/
+/*#define HAS_SETPRIORITY / **/
/* HAS_SETREGID:
* This symbol, if defined, indicates that the setregid routine is
* available to change the real, effective and saved gid of the current
* process.
*/
-/*#define HAS_SETREGID /**/
-/*#define HAS_SETRESGID /**/
+/*#define HAS_SETREGID / **/
+/*#define HAS_SETRESGID / **/
/* HAS_SETREUID:
* This symbol, if defined, indicates that the setreuid routine is
* available to change the real, effective and saved uid of the current
* process.
*/
-/*#define HAS_SETREUID /**/
-/*#define HAS_SETRESUID /**/
+/*#define HAS_SETREUID / **/
+/*#define HAS_SETRESUID / **/
/* HAS_SETRGID:
* This symbol, if defined, indicates that the setrgid routine is available
* to change the real gid of the current program.
*/
-/*#define HAS_SETRGID /**/
+/*#define HAS_SETRGID / **/
/* HAS_SETRUID:
* This symbol, if defined, indicates that the setruid routine is available
* to change the real uid of the current program.
*/
-/*#define HAS_SETRUID /**/
+/*#define HAS_SETRUID / **/
/* HAS_SETSID:
* This symbol, if defined, indicates that the setsid routine is
* available to set the process group ID.
*/
-/*#define HAS_SETSID /**/
+/*#define HAS_SETSID / **/
/* HAS_STRCHR:
* This symbol is defined to indicate that the strchr()/strrchr()
* functions are available for string searching.
*/
#define HAS_STRCHR /**/
-/*#define HAS_INDEX /**/
+/*#define HAS_INDEX / **/
/* HAS_STRCOLL:
* This symbol, if defined, indicates that the strcoll routine is
* This symbol, if defined, indicates that the symlink routine is available
* to create symbolic links.
*/
-/*#define HAS_SYMLINK /**/
+/*#define HAS_SYMLINK / **/
/* HAS_SYSCALL:
* This symbol, if defined, indicates that the syscall routine is
* available to call arbitrary system calls. If undefined, that's tough.
*/
-/*#define HAS_SYSCALL /**/
+/*#define HAS_SYSCALL / **/
/* HAS_SYSCONF:
* This symbol, if defined, indicates that sysconf() is available
* to determine system related limits and options.
*/
-/*#define HAS_SYSCONF /**/
+/*#define HAS_SYSCONF / **/
/* HAS_SYSTEM:
* This symbol, if defined, indicates that the system routine is
* This symbol, if defined, indicates that the tcgetpgrp routine is
* available to get foreground process group ID.
*/
-/*#define HAS_TCGETPGRP /**/
+/*#define HAS_TCGETPGRP / **/
/* HAS_TCSETPGRP:
* This symbol, if defined, indicates that the tcsetpgrp routine is
* available to set foreground process group ID.
*/
-/*#define HAS_TCSETPGRP /**/
+/*#define HAS_TCSETPGRP / **/
/* HAS_TRUNCATE:
* This symbol, if defined, indicates that the truncate routine is
* available to truncate files.
*/
-/*#define HAS_TRUNCATE /**/
+/*#define HAS_TRUNCATE / **/
/* HAS_TZNAME:
* This symbol, if defined, indicates that the tzname[] array is
* This symbol, if defined, indicates that the usleep routine is
* available to let the process sleep on a sub-second accuracy.
*/
-/*#define HAS_USLEEP /**/
+/*#define HAS_USLEEP / **/
/* HAS_WAIT4:
* This symbol, if defined, indicates that wait4() exists.
*/
-/*#define HAS_WAIT4 /**/
+/*#define HAS_WAIT4 / **/
/* HAS_WAITPID:
* This symbol, if defined, indicates that the waitpid routine is
* This symbol, if defined, indicates that <rpcsvc/dbm.h> exists and
* should be included.
*/
-/*#define I_DBM /**/
+/*#define I_DBM / **/
#define I_RPCSVC_DBM /**/
/* I_DLFCN:
* This symbol, if defined, indicates that <gdbm.h> exists and should
* be included.
*/
-/*#define I_GDBM /**/
+/*#define I_GDBM / **/
/* I_LIMITS:
* This symbol, if defined, indicates to the C program that it should
* This symbol, if defined, indicates to the C program that it should
* include <memory.h>.
*/
-/*#define I_MEMORY /**/
+/*#define I_MEMORY / **/
/* I_NETINET_IN:
* This symbol, if defined, indicates to the C program that it should
* include <netinet/in.h>. Otherwise, you may try <sys/in.h>.
*/
-/*#define I_NETINET_IN /**/
+/*#define I_NETINET_IN / **/
/* I_SFIO:
* This symbol, if defined, indicates to the C program that it should
* include <sfio.h>.
*/
-/*#define I_SFIO /**/
+/*#define I_SFIO / **/
/* I_STDDEF:
* This symbol, if defined, indicates that <stddef.h> exists and should
* This symbol, if defined, indicates to the C program that it should
* include <sys/dir.h>.
*/
-/*#define I_SYS_DIR /**/
+/*#define I_SYS_DIR / **/
/* I_SYS_FILE:
* This symbol, if defined, indicates to the C program that it should
* include <sys/file.h> to get definition of R_OK and friends.
*/
-/*#define I_SYS_FILE /**/
+/*#define I_SYS_FILE / **/
/* I_SYS_IOCTL:
* This symbol, if defined, indicates that <sys/ioctl.h> exists and should
* This symbol, if defined, indicates the <sys/sockio.h> should be included
* to get socket ioctl options, like SIOCATMARK.
*/
-/*#define I_SYS_IOCTL /**/
-/*#define I_SYS_SOCKIO /**/
+/*#define I_SYS_IOCTL / **/
+/*#define I_SYS_SOCKIO / **/
/* I_SYS_NDIR:
* This symbol, if defined, indicates to the C program that it should
* include <sys/ndir.h>.
*/
-/*#define I_SYS_NDIR /**/
+/*#define I_SYS_NDIR / **/
/* I_SYS_PARAM:
* This symbol, if defined, indicates to the C program that it should
* include <sys/param.h>.
*/
-/*#define I_SYS_PARAM /**/
+/*#define I_SYS_PARAM / **/
/* I_SYS_POLL:
* This symbol, if defined, indicates that the program may include
* <sys/poll.h>. When I_POLL is also defined, it's probably safest
* to only include <poll.h>.
*/
-/*#define I_SYS_POLL /**/
+/*#define I_SYS_POLL / **/
/* I_SYS_RESOURCE:
* This symbol, if defined, indicates to the C program that it should
* include <sys/resource.h>.
*/
-/*#define I_SYS_RESOURCE /**/
+/*#define I_SYS_RESOURCE / **/
/* I_SYS_SELECT:
* This symbol, if defined, indicates to the C program that it should
* include <sys/select.h> in order to get definition of struct timeval.
*/
-/*#define I_SYS_SELECT /**/
+/*#define I_SYS_SELECT / **/
/* I_SYS_STAT:
* This symbol, if defined, indicates to the C program that it should
* This symbol, if defined, indicates to the C program that it should
* include <sys/times.h>.
*/
-/*#define I_SYS_TIMES /**/
+/*#define I_SYS_TIMES / **/
/* I_SYS_TYPES:
* This symbol, if defined, indicates to the C program that it should
* This symbol, if defined, indicates to the C program that it should
* include <sys/un.h> to get UNIX domain socket definitions.
*/
-/*#define I_SYS_UN /**/
+/*#define I_SYS_UN / **/
/* I_SYS_WAIT:
* This symbol, if defined, indicates to the C program that it should
* include <sys/wait.h>.
*/
-/*#define I_SYS_WAIT /**/
+/*#define I_SYS_WAIT / **/
/* I_TERMIO:
* This symbol, if defined, indicates that the program should include
* <sgtty.h> rather than <termio.h>. There are also differences in
* the ioctl() calls that depend on the value of this symbol.
*/
-/*#define I_TERMIO /**/
-/*#define I_TERMIOS /**/
-/*#define I_SGTTY /**/
+/*#define I_TERMIO / **/
+/*#define I_TERMIOS / **/
+/*#define I_SGTTY / **/
/* I_UNISTD:
* This symbol, if defined, indicates to the C program that it should
* include <unistd.h>.
*/
-/*#define I_UNISTD /**/
+/*#define I_UNISTD / **/
/* I_UTIME:
* This symbol, if defined, indicates to the C program that it should
* MAXLONG, i.e. machine dependant limitations. Probably, you
* should use <limits.h> instead, if it is available.
*/
-/*#define I_VALUES /**/
+/*#define I_VALUES / **/
/* I_VFORK:
* This symbol, if defined, indicates to the C program that it should
* include vfork.h.
*/
-/*#define I_VFORK /**/
+/*#define I_VFORK / **/
+
+/* CAN_VAPROTO:
+ * This variable is defined on systems supporting prototype declaration
+ * of functions with a variable number of arguments.
+ */
+/* _V:
+ * This macro is used to declare function parameters in prototypes for
+ * functions with a variable number of parameters. Use double parentheses.
+ * For example:
+ *
+ * int printf _V((char *fmt, ...));
+ *
+ * Remember to use the plain simple _() macro when declaring a function
+ * with no variable number of arguments, since it might be possible to
+ * have a non-effect _V() macro and still get prototypes via _().
+ */
+/*#define CAN_VAPROTO / **/
+#ifdef CAN_VAPROTO
+#define _V(args) args
+#else
+#define _V(args) ()
+#endif
/* INTSIZE:
* This symbol contains the value of sizeof(int) so that the C
* example with the NeXT "fat" binaries that contain executables
* for several CPUs.
*/
-/*#define MULTIARCH /**/
+/*#define MULTIARCH / **/
/* HAS_QUAD:
* This symbol, if defined, tells that there's a 64-bit integer type,
* Quad_t, and its unsigned counterpar, Uquad_t. QUADKIND will be one
- * of QUAD_IS_INT, QUAD_IS_LONG, QUAD_IS_LONG_LONG, QUAD_IS_INT64_T.
+ * of QUAD_IS_INT, QUAD_IS_LONG, QUAD_IS_LONG_LONG, QUAD_IS_INT64_T
* or QUAD_IS___INT64.
*/
#define HAS_QUAD /**/
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
#define ARCHLIB "c:\\perl\\lib" /**/
-/*#define ARCHLIB_EXP "" /**/
+/*#define ARCHLIB_EXP "" / **/
/* ARCHNAME:
* This symbol holds a string representing the architecture name.
* This symbol, if defined, indicates that the accessx routine is
* available to do extended access checks.
*/
-/*#define HAS_ACCESSX /**/
+/*#define HAS_ACCESSX / **/
/* HAS_ASCTIME_R:
* This symbol, if defined, indicates that the asctime_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_asctime_r
* is defined.
*/
-/*#define HAS_ASCTIME_R /**/
+/*#define HAS_ASCTIME_R / **/
#define ASCTIME_R_PROTO 0 /**/
/* HASATTRIBUTE_FORMAT:
/* HASATTRIBUTE_WARN_UNUSED_RESULT:
* Can we handle GCC attribute for warning on unused results
*/
-/*#define HASATTRIBUTE_DEPRECATED /**/
-/*#define HASATTRIBUTE_FORMAT /**/
-/*#define PRINTF_FORMAT_NULL_OK /**/
-/*#define HASATTRIBUTE_NORETURN /**/
-/*#define HASATTRIBUTE_MALLOC /**/
-/*#define HASATTRIBUTE_NONNULL /**/
-/*#define HASATTRIBUTE_PURE /**/
-/*#define HASATTRIBUTE_UNUSED /**/
-/*#define HASATTRIBUTE_WARN_UNUSED_RESULT /**/
+/*#define HASATTRIBUTE_DEPRECATED / **/
+/*#define HASATTRIBUTE_FORMAT / **/
+/*#define PRINTF_FORMAT_NULL_OK / **/
+/*#define HASATTRIBUTE_NORETURN / **/
+/*#define HASATTRIBUTE_MALLOC / **/
+/*#define HASATTRIBUTE_NONNULL / **/
+/*#define HASATTRIBUTE_PURE / **/
+/*#define HASATTRIBUTE_UNUSED / **/
+/*#define HASATTRIBUTE_WARN_UNUSED_RESULT / **/
/* HASCONST:
* This symbol, if defined, indicates that this C compiler knows about
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_crypt_r
* is defined.
*/
-/*#define HAS_CRYPT_R /**/
+/*#define HAS_CRYPT_R / **/
#define CRYPT_R_PROTO 0 /**/
/* HAS_CSH:
/* CSH:
* This symbol, if defined, contains the full pathname of csh.
*/
-/*#define HAS_CSH /**/
+/*#define HAS_CSH / **/
#ifdef HAS_CSH
#define CSH "" /**/
#endif
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_ctermid_r
* is defined.
*/
-/*#define HAS_CTERMID_R /**/
+/*#define HAS_CTERMID_R / **/
#define CTERMID_R_PROTO 0 /**/
/* HAS_CTIME_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_ctime_r
* is defined.
*/
-/*#define HAS_CTIME_R /**/
+/*#define HAS_CTIME_R / **/
#define CTIME_R_PROTO 0 /**/
/* HAS_DRAND48_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_drand48_r
* is defined.
*/
-/*#define HAS_DRAND48_R /**/
+/*#define HAS_DRAND48_R / **/
#define DRAND48_R_PROTO 0 /**/
/* HAS_DRAND48_PROTO:
* to the program to supply one. A good guess is
* extern double drand48(void);
*/
-/*#define HAS_DRAND48_PROTO /**/
+/*#define HAS_DRAND48_PROTO / **/
/* HAS_EACCESS:
* This symbol, if defined, indicates that the eaccess routine is
* available to do extended access checks.
*/
-/*#define HAS_EACCESS /**/
+/*#define HAS_EACCESS / **/
/* HAS_ENDGRENT:
* This symbol, if defined, indicates that the getgrent routine is
* available for finalizing sequential access of the group database.
*/
-/*#define HAS_ENDGRENT /**/
+/*#define HAS_ENDGRENT / **/
/* HAS_ENDGRENT_R:
* This symbol, if defined, indicates that the endgrent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endgrent_r
* is defined.
*/
-/*#define HAS_ENDGRENT_R /**/
+/*#define HAS_ENDGRENT_R / **/
#define ENDGRENT_R_PROTO 0 /**/
/* HAS_ENDHOSTENT:
* This symbol, if defined, indicates that the endhostent() routine is
* available to close whatever was being used for host queries.
*/
-/*#define HAS_ENDHOSTENT /**/
+/*#define HAS_ENDHOSTENT / **/
/* HAS_ENDHOSTENT_R:
* This symbol, if defined, indicates that the endhostent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endhostent_r
* is defined.
*/
-/*#define HAS_ENDHOSTENT_R /**/
+/*#define HAS_ENDHOSTENT_R / **/
#define ENDHOSTENT_R_PROTO 0 /**/
/* HAS_ENDNETENT:
* This symbol, if defined, indicates that the endnetent() routine is
* available to close whatever was being used for network queries.
*/
-/*#define HAS_ENDNETENT /**/
+/*#define HAS_ENDNETENT / **/
/* HAS_ENDNETENT_R:
* This symbol, if defined, indicates that the endnetent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endnetent_r
* is defined.
*/
-/*#define HAS_ENDNETENT_R /**/
+/*#define HAS_ENDNETENT_R / **/
#define ENDNETENT_R_PROTO 0 /**/
/* HAS_ENDPROTOENT:
* This symbol, if defined, indicates that the endprotoent() routine is
* available to close whatever was being used for protocol queries.
*/
-/*#define HAS_ENDPROTOENT /**/
+/*#define HAS_ENDPROTOENT / **/
/* HAS_ENDPROTOENT_R:
* This symbol, if defined, indicates that the endprotoent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endprotoent_r
* is defined.
*/
-/*#define HAS_ENDPROTOENT_R /**/
+/*#define HAS_ENDPROTOENT_R / **/
#define ENDPROTOENT_R_PROTO 0 /**/
/* HAS_ENDPWENT:
* This symbol, if defined, indicates that the getgrent routine is
* available for finalizing sequential access of the passwd database.
*/
-/*#define HAS_ENDPWENT /**/
+/*#define HAS_ENDPWENT / **/
/* HAS_ENDPWENT_R:
* This symbol, if defined, indicates that the endpwent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endpwent_r
* is defined.
*/
-/*#define HAS_ENDPWENT_R /**/
+/*#define HAS_ENDPWENT_R / **/
#define ENDPWENT_R_PROTO 0 /**/
/* HAS_ENDSERVENT:
* This symbol, if defined, indicates that the endservent() routine is
* available to close whatever was being used for service queries.
*/
-/*#define HAS_ENDSERVENT /**/
+/*#define HAS_ENDSERVENT / **/
/* HAS_ENDSERVENT_R:
* This symbol, if defined, indicates that the endservent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endservent_r
* is defined.
*/
-/*#define HAS_ENDSERVENT_R /**/
+/*#define HAS_ENDSERVENT_R / **/
#define ENDSERVENT_R_PROTO 0 /**/
/* FLEXFILENAMES:
* This symbol, if defined, indicates that the getgrent routine is
* available for sequential access of the group database.
*/
-/*#define HAS_GETGRENT /**/
+/*#define HAS_GETGRENT / **/
/* HAS_GETGRENT_R:
* This symbol, if defined, indicates that the getgrent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrent_r
* is defined.
*/
-/*#define HAS_GETGRENT_R /**/
+/*#define HAS_GETGRENT_R / **/
#define GETGRENT_R_PROTO 0 /**/
/* HAS_GETGRGID_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrgid_r
* is defined.
*/
-/*#define HAS_GETGRGID_R /**/
+/*#define HAS_GETGRGID_R / **/
#define GETGRGID_R_PROTO 0 /**/
/* HAS_GETGRNAM_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrnam_r
* is defined.
*/
-/*#define HAS_GETGRNAM_R /**/
+/*#define HAS_GETGRNAM_R / **/
#define GETGRNAM_R_PROTO 0 /**/
/* HAS_GETHOSTBYADDR:
* This symbol, if defined, indicates that the gethostent() routine is
* available to look up host names in some data base or another.
*/
-/*#define HAS_GETHOSTENT /**/
+/*#define HAS_GETHOSTENT / **/
/* HAS_GETHOSTNAME:
* This symbol, if defined, indicates that the C program may use the
*/
#define HAS_GETHOSTNAME /**/
#define HAS_UNAME /**/
-/*#define HAS_PHOSTNAME /**/
+/*#define HAS_PHOSTNAME / **/
#ifdef HAS_PHOSTNAME
#define PHOSTNAME "" /* How to get the host name */
#endif
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostbyaddr_r
* is defined.
*/
-/*#define HAS_GETHOSTBYADDR_R /**/
+/*#define HAS_GETHOSTBYADDR_R / **/
#define GETHOSTBYADDR_R_PROTO 0 /**/
/* HAS_GETHOSTBYNAME_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostbyname_r
* is defined.
*/
-/*#define HAS_GETHOSTBYNAME_R /**/
+/*#define HAS_GETHOSTBYNAME_R / **/
#define GETHOSTBYNAME_R_PROTO 0 /**/
/* HAS_GETHOSTENT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostent_r
* is defined.
*/
-/*#define HAS_GETHOSTENT_R /**/
+/*#define HAS_GETHOSTENT_R / **/
#define GETHOSTENT_R_PROTO 0 /**/
/* HAS_GETHOST_PROTOS:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getlogin_r
* is defined.
*/
-/*#define HAS_GETLOGIN_R /**/
+/*#define HAS_GETLOGIN_R / **/
#define GETLOGIN_R_PROTO 0 /**/
/* HAS_GETNETBYADDR:
* This symbol, if defined, indicates that the getnetbyaddr() routine is
* available to look up networks by their IP addresses.
*/
-/*#define HAS_GETNETBYADDR /**/
+/*#define HAS_GETNETBYADDR / **/
/* HAS_GETNETBYNAME:
* This symbol, if defined, indicates that the getnetbyname() routine is
* available to look up networks by their names.
*/
-/*#define HAS_GETNETBYNAME /**/
+/*#define HAS_GETNETBYNAME / **/
/* HAS_GETNETENT:
* This symbol, if defined, indicates that the getnetent() routine is
* available to look up network names in some data base or another.
*/
-/*#define HAS_GETNETENT /**/
+/*#define HAS_GETNETENT / **/
/* HAS_GETNETBYADDR_R:
* This symbol, if defined, indicates that the getnetbyaddr_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetbyaddr_r
* is defined.
*/
-/*#define HAS_GETNETBYADDR_R /**/
+/*#define HAS_GETNETBYADDR_R / **/
#define GETNETBYADDR_R_PROTO 0 /**/
/* HAS_GETNETBYNAME_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetbyname_r
* is defined.
*/
-/*#define HAS_GETNETBYNAME_R /**/
+/*#define HAS_GETNETBYNAME_R / **/
#define GETNETBYNAME_R_PROTO 0 /**/
/* HAS_GETNETENT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetent_r
* is defined.
*/
-/*#define HAS_GETNETENT_R /**/
+/*#define HAS_GETNETENT_R / **/
#define GETNETENT_R_PROTO 0 /**/
/* HAS_GETNET_PROTOS:
* getnetbyaddr(). Otherwise, it is up to the program to guess
* them. See netdbtype.U for probing for various Netdb_xxx_t types.
*/
-/*#define HAS_GETNET_PROTOS /**/
+/*#define HAS_GETNET_PROTOS / **/
/* HAS_GETPROTOENT:
* This symbol, if defined, indicates that the getprotoent() routine is
* available to look up protocols in some data base or another.
*/
-/*#define HAS_GETPROTOENT /**/
+/*#define HAS_GETPROTOENT / **/
/* HAS_GETPGRP:
* This symbol, if defined, indicates that the getpgrp routine is
* This symbol, if defined, indicates that getpgrp needs one
* arguments whereas USG one needs none.
*/
-/*#define HAS_GETPGRP /**/
-/*#define USE_BSD_GETPGRP /**/
+/*#define HAS_GETPGRP / **/
+/*#define USE_BSD_GETPGRP / **/
/* HAS_GETPROTOBYNAME:
* This symbol, if defined, indicates that the getprotobyname()
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotobyname_r
* is defined.
*/
-/*#define HAS_GETPROTOBYNAME_R /**/
+/*#define HAS_GETPROTOBYNAME_R / **/
#define GETPROTOBYNAME_R_PROTO 0 /**/
/* HAS_GETPROTOBYNUMBER_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotobynumber_r
* is defined.
*/
-/*#define HAS_GETPROTOBYNUMBER_R /**/
+/*#define HAS_GETPROTOBYNUMBER_R / **/
#define GETPROTOBYNUMBER_R_PROTO 0 /**/
/* HAS_GETPROTOENT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotoent_r
* is defined.
*/
-/*#define HAS_GETPROTOENT_R /**/
+/*#define HAS_GETPROTOENT_R / **/
#define GETPROTOENT_R_PROTO 0 /**/
/* HAS_GETPROTO_PROTOS:
* available for sequential access of the passwd database.
* If this is not available, the older getpw() function may be available.
*/
-/*#define HAS_GETPWENT /**/
+/*#define HAS_GETPWENT / **/
/* HAS_GETPWENT_R:
* This symbol, if defined, indicates that the getpwent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwent_r
* is defined.
*/
-/*#define HAS_GETPWENT_R /**/
+/*#define HAS_GETPWENT_R / **/
#define GETPWENT_R_PROTO 0 /**/
/* HAS_GETPWNAM_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwnam_r
* is defined.
*/
-/*#define HAS_GETPWNAM_R /**/
+/*#define HAS_GETPWNAM_R / **/
#define GETPWNAM_R_PROTO 0 /**/
/* HAS_GETPWUID_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwuid_r
* is defined.
*/
-/*#define HAS_GETPWUID_R /**/
+/*#define HAS_GETPWUID_R / **/
#define GETPWUID_R_PROTO 0 /**/
/* HAS_GETSERVENT:
* This symbol, if defined, indicates that the getservent() routine is
* available to look up network services in some data base or another.
*/
-/*#define HAS_GETSERVENT /**/
+/*#define HAS_GETSERVENT / **/
/* HAS_GETSERVBYNAME_R:
* This symbol, if defined, indicates that the getservbyname_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservbyname_r
* is defined.
*/
-/*#define HAS_GETSERVBYNAME_R /**/
+/*#define HAS_GETSERVBYNAME_R / **/
#define GETSERVBYNAME_R_PROTO 0 /**/
/* HAS_GETSERVBYPORT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservbyport_r
* is defined.
*/
-/*#define HAS_GETSERVBYPORT_R /**/
+/*#define HAS_GETSERVBYPORT_R / **/
#define GETSERVBYPORT_R_PROTO 0 /**/
/* HAS_GETSERVENT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservent_r
* is defined.
*/
-/*#define HAS_GETSERVENT_R /**/
+/*#define HAS_GETSERVENT_R / **/
#define GETSERVENT_R_PROTO 0 /**/
/* HAS_GETSERV_PROTOS:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getspnam_r
* is defined.
*/
-/*#define HAS_GETSPNAM_R /**/
+/*#define HAS_GETSPNAM_R / **/
#define GETSPNAM_R_PROTO 0 /**/
/* HAS_GETSERVBYNAME:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_gmtime_r
* is defined.
*/
-/*#define HAS_GMTIME_R /**/
+/*#define HAS_GMTIME_R / **/
#define GMTIME_R_PROTO 0 /**/
/* HAS_HTONL:
* changes using \undef{TZ} without explicitly calling tzset
* impossible. This symbol makes us call tzset before localtime_r
*/
-/*#define LOCALTIME_R_NEEDS_TZSET /**/
+/*#define LOCALTIME_R_NEEDS_TZSET / **/
#ifdef LOCALTIME_R_NEEDS_TZSET
#define L_R_TZSET tzset(),
#else
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_localtime_r
* is defined.
*/
-/*#define HAS_LOCALTIME_R /**/
+/*#define HAS_LOCALTIME_R / **/
#define LOCALTIME_R_PROTO 0 /**/
/* HAS_LONG_DOUBLE:
* C preprocessor can make decisions based on it. It is only
* defined if the system supports long long.
*/
-/*#define HAS_LONG_LONG /**/
+/*#define HAS_LONG_LONG / **/
#ifdef HAS_LONG_LONG
#define LONGLONGSIZE 8 /**/
#endif
* available to exclusively create and open a uniquely named
* temporary file.
*/
-/*#define HAS_MKSTEMP /**/
+/*#define HAS_MKSTEMP / **/
/* HAS_MMAP:
* This symbol, if defined, indicates that the mmap system call is
* (and simultaneously the type of the first argument).
* Usually set to 'void *' or 'caddr_t'.
*/
-/*#define HAS_MMAP /**/
+/*#define HAS_MMAP / **/
#define Mmap_t void * /**/
/* HAS_MSG:
* This symbol, if defined, indicates that the entire msg*(2) library is
* supported (IPC mechanism based on message queues).
*/
-/*#define HAS_MSG /**/
+/*#define HAS_MSG / **/
/* OLD_PTHREAD_CREATE_JOINABLE:
* This symbol, if defined, indicates how to create pthread
* If defined, known values are PTHREAD_CREATE_UNDETACHED
* and __UNDETACHED.
*/
-/*#define OLD_PTHREAD_CREATE_JOINABLE /**/
+/*#define OLD_PTHREAD_CREATE_JOINABLE / **/
/* HAS_PTHREAD_ATFORK:
* This symbol, if defined, indicates that the pthread_atfork routine
* is available to setup fork handlers.
*/
-/*#define HAS_PTHREAD_ATFORK /**/
+/*#define HAS_PTHREAD_ATFORK / **/
/* HAS_PTHREAD_YIELD:
* This symbol, if defined, indicates that the pthread_yield
* routine is available to yield the execution of the current
* thread. sched_yield is preferable to pthread_yield.
*/
-/*#define HAS_PTHREAD_YIELD /**/
+/*#define HAS_PTHREAD_YIELD / **/
#define SCHED_YIELD /**/
-/*#define HAS_SCHED_YIELD /**/
+/*#define HAS_SCHED_YIELD / **/
/* HAS_RANDOM_R:
* This symbol, if defined, indicates that the random_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_random_r
* is defined.
*/
-/*#define HAS_RANDOM_R /**/
+/*#define HAS_RANDOM_R / **/
#define RANDOM_R_PROTO 0 /**/
/* HAS_READDIR64_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_readdir64_r
* is defined.
*/
-/*#define HAS_READDIR64_R /**/
+/*#define HAS_READDIR64_R / **/
#define READDIR64_R_PROTO 0 /**/
/* HAS_READDIR_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_readdir_r
* is defined.
*/
-/*#define HAS_READDIR_R /**/
+/*#define HAS_READDIR_R / **/
#define READDIR_R_PROTO 0 /**/
/* HAS_SEM:
* This symbol, if defined, indicates that the entire sem*(2) library is
* supported.
*/
-/*#define HAS_SEM /**/
+/*#define HAS_SEM / **/
/* HAS_SETGRENT:
* This symbol, if defined, indicates that the setgrent routine is
* available for initializing sequential access of the group database.
*/
-/*#define HAS_SETGRENT /**/
+/*#define HAS_SETGRENT / **/
/* HAS_SETGRENT_R:
* This symbol, if defined, indicates that the setgrent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setgrent_r
* is defined.
*/
-/*#define HAS_SETGRENT_R /**/
+/*#define HAS_SETGRENT_R / **/
#define SETGRENT_R_PROTO 0 /**/
/* HAS_SETHOSTENT:
* This symbol, if defined, indicates that the sethostent() routine is
* available.
*/
-/*#define HAS_SETHOSTENT /**/
+/*#define HAS_SETHOSTENT / **/
/* HAS_SETHOSTENT_R:
* This symbol, if defined, indicates that the sethostent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_sethostent_r
* is defined.
*/
-/*#define HAS_SETHOSTENT_R /**/
+/*#define HAS_SETHOSTENT_R / **/
#define SETHOSTENT_R_PROTO 0 /**/
/* HAS_SETLOCALE_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setlocale_r
* is defined.
*/
-/*#define HAS_SETLOCALE_R /**/
+/*#define HAS_SETLOCALE_R / **/
#define SETLOCALE_R_PROTO 0 /**/
/* HAS_SETNETENT:
* This symbol, if defined, indicates that the setnetent() routine is
* available.
*/
-/*#define HAS_SETNETENT /**/
+/*#define HAS_SETNETENT / **/
/* HAS_SETNETENT_R:
* This symbol, if defined, indicates that the setnetent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setnetent_r
* is defined.
*/
-/*#define HAS_SETNETENT_R /**/
+/*#define HAS_SETNETENT_R / **/
#define SETNETENT_R_PROTO 0 /**/
/* HAS_SETPROTOENT:
* This symbol, if defined, indicates that the setprotoent() routine is
* available.
*/
-/*#define HAS_SETPROTOENT /**/
+/*#define HAS_SETPROTOENT / **/
/* HAS_SETPGRP:
* This symbol, if defined, indicates that the setpgrp routine is
* arguments whereas USG one needs none. See also HAS_SETPGID
* for a POSIX interface.
*/
-/*#define HAS_SETPGRP /**/
-/*#define USE_BSD_SETPGRP /**/
+/*#define HAS_SETPGRP / **/
+/*#define USE_BSD_SETPGRP / **/
/* HAS_SETPROTOENT_R:
* This symbol, if defined, indicates that the setprotoent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setprotoent_r
* is defined.
*/
-/*#define HAS_SETPROTOENT_R /**/
+/*#define HAS_SETPROTOENT_R / **/
#define SETPROTOENT_R_PROTO 0 /**/
/* HAS_SETPWENT:
* This symbol, if defined, indicates that the setpwent routine is
* available for initializing sequential access of the passwd database.
*/
-/*#define HAS_SETPWENT /**/
+/*#define HAS_SETPWENT / **/
/* HAS_SETPWENT_R:
* This symbol, if defined, indicates that the setpwent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setpwent_r
* is defined.
*/
-/*#define HAS_SETPWENT_R /**/
+/*#define HAS_SETPWENT_R / **/
#define SETPWENT_R_PROTO 0 /**/
/* HAS_SETSERVENT:
* This symbol, if defined, indicates that the setservent() routine is
* available.
*/
-/*#define HAS_SETSERVENT /**/
+/*#define HAS_SETSERVENT / **/
/* HAS_SETSERVENT_R:
* This symbol, if defined, indicates that the setservent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setservent_r
* is defined.
*/
-/*#define HAS_SETSERVENT_R /**/
+/*#define HAS_SETSERVENT_R / **/
#define SETSERVENT_R_PROTO 0 /**/
/* HAS_SETVBUF:
* This symbol, if defined, indicates that the entire shm*(2) library is
* supported.
*/
-/*#define HAS_SHM /**/
+/*#define HAS_SHM / **/
/* Shmat_t:
* This symbol holds the return type of the shmat() system call.
* when HAS_SHMAT_PROTOTYPE is not defined to avoid conflicting defs.
*/
#define Shmat_t void * /**/
-/*#define HAS_SHMAT_PROTOTYPE /**/
+/*#define HAS_SHMAT_PROTOTYPE / **/
/* HAS_SOCKET:
* This symbol, if defined, indicates that the BSD socket interface is
* has been known to be an enum.
*/
#define HAS_SOCKET /**/
-/*#define HAS_SOCKETPAIR /**/
-/*#define HAS_MSG_CTRUNC /**/
-/*#define HAS_MSG_DONTROUTE /**/
-/*#define HAS_MSG_OOB /**/
-/*#define HAS_MSG_PEEK /**/
-/*#define HAS_MSG_PROXY /**/
-/*#define HAS_SCM_RIGHTS /**/
+/*#define HAS_SOCKETPAIR / **/
+/*#define HAS_MSG_CTRUNC / **/
+/*#define HAS_MSG_DONTROUTE / **/
+/*#define HAS_MSG_OOB / **/
+/*#define HAS_MSG_PEEK / **/
+/*#define HAS_MSG_PROXY / **/
+/*#define HAS_SCM_RIGHTS / **/
/* HAS_SRAND48_R:
* This symbol, if defined, indicates that the srand48_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_srand48_r
* is defined.
*/
-/*#define HAS_SRAND48_R /**/
+/*#define HAS_SRAND48_R / **/
#define SRAND48_R_PROTO 0 /**/
/* HAS_SRANDOM_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_srandom_r
* is defined.
*/
-/*#define HAS_SRANDOM_R /**/
+/*#define HAS_SRANDOM_R / **/
#define SRANDOM_R_PROTO 0 /**/
/* USE_STAT_BLOCKS:
* st_blksize and st_blocks.
*/
#ifndef USE_STAT_BLOCKS
-/*#define USE_STAT_BLOCKS /**/
+/*#define USE_STAT_BLOCKS / **/
#endif
/* USE_STRUCT_COPY:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_strerror_r
* is defined.
*/
-/*#define HAS_STRERROR_R /**/
+/*#define HAS_STRERROR_R / **/
#define STRERROR_R_PROTO 0 /**/
/* HAS_STRTOUL:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_tmpnam_r
* is defined.
*/
-/*#define HAS_TMPNAM_R /**/
+/*#define HAS_TMPNAM_R / **/
#define TMPNAM_R_PROTO 0 /**/
/* HAS_TTYNAME_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_ttyname_r
* is defined.
*/
-/*#define HAS_TTYNAME_R /**/
+/*#define HAS_TTYNAME_R / **/
#define TTYNAME_R_PROTO 0 /**/
/* HAS_UNION_SEMUN:
* used for semctl IPC_STAT.
*/
#define HAS_UNION_SEMUN /**/
-/*#define USE_SEMCTL_SEMUN /**/
-/*#define USE_SEMCTL_SEMID_DS /**/
+/*#define USE_SEMCTL_SEMUN / **/
+/*#define USE_SEMCTL_SEMID_DS / **/
/* HAS_VFORK:
* This symbol, if defined, indicates that vfork() exists.
*/
-/*#define HAS_VFORK /**/
+/*#define HAS_VFORK / **/
/* HAS_PSEUDOFORK:
* This symbol, if defined, indicates that an emulation of the
* fork routine is available.
*/
-/*#define HAS_PSEUDOFORK /**/
+/*#define HAS_PSEUDOFORK / **/
/* Signal_t:
* This symbol's value is either "void" or "int", corresponding to the
* This symbol, if defined, indicates to the C program that struct group
* in <grp.h> contains gr_passwd.
*/
-/*#define I_GRP /**/
-/*#define GRPASSWD /**/
+/*#define I_GRP / **/
+/*#define GRPASSWD / **/
/* I_MACH_CTHREADS:
* This symbol, if defined, indicates to the C program that it should
* include <mach/cthreads.h>.
*/
-/*#define I_MACH_CTHREADS /**/
+/*#define I_MACH_CTHREADS / **/
/* I_NDBM:
* This symbol, if defined, indicates that <ndbm.h> exists and should
* parameter information. While ANSI C prototypes are supported in C++,
* K&R style function declarations will yield errors.
*/
-/*#define I_NDBM /**/
-/*#define I_GDBMNDBM /**/
-/*#define I_GDBM_NDBM /**/
-/*#define NDBM_H_USES_PROTOTYPES /**/
-/*#define GDBMNDBM_H_USES_PROTOTYPES /**/
-/*#define GDBM_NDBM_H_USES_PROTOTYPES /**/
+/*#define I_NDBM / **/
+/*#define I_GDBMNDBM / **/
+/*#define I_GDBM_NDBM / **/
+/*#define NDBM_H_USES_PROTOTYPES / **/
+/*#define GDBMNDBM_H_USES_PROTOTYPES / **/
+/*#define GDBM_NDBM_H_USES_PROTOTYPES / **/
/* I_NETDB:
* This symbol, if defined, indicates that <netdb.h> exists and
* should be included.
*/
-/*#define I_NETDB /**/
+/*#define I_NETDB / **/
/* I_NET_ERRNO:
* This symbol, if defined, indicates that <net/errno.h> exists and
* should be included.
*/
-/*#define I_NET_ERRNO /**/
+/*#define I_NET_ERRNO / **/
/* I_PTHREAD:
* This symbol, if defined, indicates to the C program that it should
* include <pthread.h>.
*/
-/*#define I_PTHREAD /**/
+/*#define I_PTHREAD / **/
/* I_PWD:
* This symbol, if defined, indicates to the C program that it should
* This symbol, if defined, indicates to the C program that struct passwd
* contains pw_passwd.
*/
-/*#define I_PWD /**/
-/*#define PWQUOTA /**/
-/*#define PWAGE /**/
-/*#define PWCHANGE /**/
-/*#define PWCLASS /**/
-/*#define PWEXPIRE /**/
-/*#define PWCOMMENT /**/
-/*#define PWGECOS /**/
-/*#define PWPASSWD /**/
+/*#define I_PWD / **/
+/*#define PWQUOTA / **/
+/*#define PWAGE / **/
+/*#define PWCHANGE / **/
+/*#define PWCLASS / **/
+/*#define PWEXPIRE / **/
+/*#define PWCOMMENT / **/
+/*#define PWGECOS / **/
+/*#define PWPASSWD / **/
/* I_SYS_ACCESS:
* This symbol, if defined, indicates to the C program that it should
* include <sys/access.h>.
*/
-/*#define I_SYS_ACCESS /**/
+/*#define I_SYS_ACCESS / **/
/* I_SYS_SECURITY:
* This symbol, if defined, indicates to the C program that it should
* include <sys/security.h>.
*/
-/*#define I_SYS_SECURITY /**/
+/*#define I_SYS_SECURITY / **/
/* I_SYSUIO:
* This symbol, if defined, indicates that <sys/uio.h> exists and
* should be included.
*/
-/*#define I_SYSUIO /**/
+/*#define I_SYSUIO / **/
/* I_STDARG:
* This symbol, if defined, indicates that <stdarg.h> exists and should
* include <varargs.h>.
*/
#define I_STDARG /**/
-/*#define I_VARARGS /**/
+/*#define I_VARARGS / **/
/* PERL_INC_VERSION_LIST:
* This variable specifies the list of subdirectories in over
* for a C initialization string. See the inc_version_list entry
* in Porting/Glossary for more details.
*/
-/*#define PERL_INC_VERSION_LIST 0 /**/
+/*#define PERL_INC_VERSION_LIST 0 / **/
/* INSTALL_USR_BIN_PERL:
* This symbol, if defined, indicates that Perl is to be installed
* also as /usr/bin/perl.
*/
-/*#define INSTALL_USR_BIN_PERL /**/
+/*#define INSTALL_USR_BIN_PERL / **/
/* Off_t:
* This symbol holds the type used to declare offsets in the kernel.
/* MYMALLOC:
* This symbol, if defined, indicates that we're using our own malloc.
*/
-/*#define MYMALLOC /**/
+/*#define MYMALLOC / **/
/* Mode_t:
* This symbol holds the type used to declare file modes
* and architecture-specific directories. See PERL_INC_VERSION_LIST
* for more details.
*/
-/*#define PERL_OTHERLIBDIRS "" /**/
+/*#define PERL_OTHERLIBDIRS "" / **/
/* Pid_t:
* This symbol holds the type used to declare process ids in the kernel.
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
#define SITEARCH "c:\\perl\\site\\lib" /**/
-/*#define SITEARCH_EXP "" /**/
+/*#define SITEARCH_EXP "" / **/
/* SITELIB:
* This symbol contains the name of the private library for this package.
* try to use the various _r versions of library functions.
* This is extremely experimental.
*/
-/*#define USE_5005THREADS /**/
-/*#define USE_ITHREADS /**/
+/*#define USE_5005THREADS / **/
+/*#define USE_ITHREADS / **/
#if defined(USE_5005THREADS) && !defined(USE_ITHREADS)
#define USE_THREADS /* until src is revised*/
#endif
-/*#define OLD_PTHREADS_API /**/
-/*#define USE_REENTRANT_API /**/
+/*#define OLD_PTHREADS_API / **/
+/*#define USE_REENTRANT_API / **/
/* PERL_VENDORARCH:
* If defined, this symbol contains the name of a private library.
* This symbol contains the ~name expanded version of PERL_VENDORARCH, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-/*#define PERL_VENDORARCH "" /**/
-/*#define PERL_VENDORARCH_EXP "" /**/
+/*#define PERL_VENDORARCH "" / **/
+/*#define PERL_VENDORARCH_EXP "" / **/
/* PERL_VENDORLIB_EXP:
* This symbol contains the ~name expanded version of VENDORLIB, to be used
* removed. The elements in inc_version_list (inc_version_list.U) can
* be tacked onto this variable to generate a list of directories to search.
*/
-/*#define PERL_VENDORLIB_EXP "" /**/
-/*#define PERL_VENDORLIB_STEM "" /**/
+/*#define PERL_VENDORLIB_EXP "" / **/
+/*#define PERL_VENDORLIB_STEM "" / **/
/* VOIDFLAGS:
* This symbol indicates how much support of the void type is given by this
* Perl has been cross-compiled to. Undefined if not a cross-compile.
*/
#ifndef USE_CROSS_COMPILE
-/*#define USE_CROSS_COMPILE /**/
+/*#define USE_CROSS_COMPILE / **/
#define PERL_TARGETARCH "" /**/
#endif
#define BYTEORDER 0x1234 /* large digits for MSB */
#endif /* NeXT */
+/* CHARBITS:
+ * This symbol contains the size of a char, so that the C preprocessor
+ * can make decisions based on it.
+ */
+#define CHARBITS 8 /**/
+
/* CASTI32:
* This symbol is defined if the C compiler can cast negative
* or large floating point numbers to 32-bit ints.
* This symbol, if defined, indicates that the closedir() routine
* does not return a value.
*/
-/*#define VOID_CLOSEDIR /**/
+/*#define VOID_CLOSEDIR / **/
/* HAS_FD_SET:
* This symbol, when defined, indicates presence of the fd_set typedef
* is available to get system page size, which is the granularity of
* many memory management calls.
*/
-/*#define HAS_GETPAGESIZE /**/
+/*#define HAS_GETPAGESIZE / **/
/* HAS_GNULIBC:
* This symbol, if defined, indicates to the C program that
* the GNU C library is being used. A better check is to use
* the __GLIBC__ and __GLIBC_MINOR__ symbols supplied with glibc.
*/
-/*#define HAS_GNULIBC /**/
+/*#define HAS_GNULIBC / **/
#if defined(HAS_GNULIBC) && !defined(_GNU_SOURCE)
# define _GNU_SOURCE
#endif
* available to operate on a symbolic link (instead of following the
* link).
*/
-/*#define HAS_LCHOWN /**/
+/*#define HAS_LCHOWN / **/
/* HAS_OPEN3:
* This manifest constant lets the C program know that the three
* argument form of open(2) is available.
*/
-/*#define HAS_OPEN3 /**/
+/*#define HAS_OPEN3 / **/
/* HAS_SAFE_BCOPY:
* This symbol, if defined, indicates that the bcopy routine is available
* probably use memmove() or memcpy(). If neither is defined, roll your
* own version.
*/
-/*#define HAS_SAFE_BCOPY /**/
+/*#define HAS_SAFE_BCOPY / **/
/* HAS_SAFE_MEMCPY:
* This symbol, if defined, indicates that the memcpy routine is available
* copy overlapping memory blocks, you should check HAS_MEMMOVE and
* use memmove() instead, if available.
*/
-/*#define HAS_SAFE_MEMCPY /**/
+/*#define HAS_SAFE_MEMCPY / **/
/* HAS_SANE_MEMCMP:
* This symbol, if defined, indicates that the memcmp routine is available
* This symbol, if defined, indicates that Vr4's sigaction() routine
* is available.
*/
-/*#define HAS_SIGACTION /**/
+/*#define HAS_SIGACTION / **/
/* HAS_SIGSETJMP:
* This variable indicates to the C program that the sigsetjmp()
* traditional longjmp() if siglongjmp isn't available.
* See HAS_SIGSETJMP.
*/
-/*#define HAS_SIGSETJMP /**/
+/*#define HAS_SIGSETJMP / **/
#ifdef HAS_SIGSETJMP
#define Sigjmp_buf sigjmp_buf
#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask))
#define STDIO_PTR_LVALUE /**/
#define FILE_cnt(fp) ((fp)->_cnt)
#define STDIO_CNT_LVALUE /**/
-/*#define STDIO_PTR_LVAL_SETS_CNT /**/
+/*#define STDIO_PTR_LVAL_SETS_CNT / **/
#define STDIO_PTR_LVAL_NOCHANGE_CNT /**/
#endif
* symbol.
*/
#define HAS_VPRINTF /**/
-/*#define USE_CHAR_VSPRINTF /**/
+/*#define USE_CHAR_VSPRINTF / **/
/* DOUBLESIZE:
* This symbol contains the size of a double, so that the C preprocessor
* the struct tm has a tm_gmtoff field.
*/
#define I_TIME /**/
-/*#define I_SYS_TIME /**/
-/*#define I_SYS_TIME_KERNEL /**/
-/*#define HAS_TM_TM_ZONE /**/
-/*#define HAS_TM_TM_GMTOFF /**/
+/*#define I_SYS_TIME / **/
+/*#define I_SYS_TIME_KERNEL / **/
+/*#define HAS_TM_TM_ZONE / **/
+/*#define HAS_TM_TM_GMTOFF / **/
/* VAL_O_NONBLOCK:
* This symbol is to be used during open() or fcntl(F_SETFL) to turn on
* This symbol, if defined, indicates that this system uses
* EBCDIC encoding.
*/
-/*#define EBCDIC /**/
+/*#define EBCDIC / **/
+
+/* SETUID_SCRIPTS_ARE_SECURE_NOW:
+ * This symbol, if defined, indicates that the bug that prevents
+ * setuid scripts from being secure is not present in this kernel.
+ */
+/* DOSUID:
+ * This symbol, if defined, indicates that the C program should
+ * check the script that it is executing for setuid/setgid bits, and
+ * attempt to emulate setuid/setgid on systems that have disabled
+ * setuid #! scripts because the kernel can't do it securely.
+ * It is up to the package designer to make sure that this emulation
+ * is done securely. Among other things, it should do an fstat on
+ * the script it just opened to make sure it really is a setuid/setgid
+ * script, it should make sure the arguments passed correspond exactly
+ * to the argument on the #! line, and it should not trust any
+ * subprocesses to which it must pass the filename rather than the
+ * file descriptor of the script to be executed.
+ */
+/*#define SETUID_SCRIPTS_ARE_SECURE_NOW / **/
+/*#define DOSUID / **/
/* PERL_USE_DEVEL:
* This symbol, if defined, indicates that Perl was configured with
* -Dusedevel, to enable development features. This should not be
* done for production builds.
*/
-/*#define PERL_USE_DEVEL /**/
+/*#define PERL_USE_DEVEL / **/
/* HAS_ATOLF:
* This symbol, if defined, indicates that the atolf routine is
* available to convert strings into long doubles.
*/
-/*#define HAS_ATOLF /**/
+/*#define HAS_ATOLF / **/
/* HAS_ATOLL:
* This symbol, if defined, indicates that the atoll routine is
* available to convert strings into long longs.
*/
-/*#define HAS_ATOLL /**/
+/*#define HAS_ATOLL / **/
/* HAS__FWALK:
* This symbol, if defined, indicates that the _fwalk system call is
* available to apply a function to all the file handles.
*/
-/*#define HAS__FWALK /**/
+/*#define HAS__FWALK / **/
/* HAS_AINTL:
* This symbol, if defined, indicates that the aintl routine is
* available. If copysignl is also present we can emulate modfl.
*/
-/*#define HAS_AINTL /**/
+/*#define HAS_AINTL / **/
/* HAS_BUILTIN_CHOOSE_EXPR:
* Can we handle GCC builtin for compile-time ternary-like expressions
* Can we handle GCC builtin for telling that certain values are more
* likely
*/
-/*#define HAS_BUILTIN_EXPECT /**/
-/*#define HAS_BUILTIN_CHOOSE_EXPR /**/
+/*#define HAS_BUILTIN_EXPECT / **/
+/*#define HAS_BUILTIN_CHOOSE_EXPR / **/
/* HAS_C99_VARIADIC_MACROS:
* If defined, the compiler supports C99 variadic macros.
*/
-/*#define HAS_C99_VARIADIC_MACROS /**/
+/*#define HAS_C99_VARIADIC_MACROS / **/
/* HAS_CLASS:
* This symbol, if defined, indicates that the class routine is
* FP_NANS Signaling Not a Number (NaNS)
* FP_NANQ Quiet Not a Number (NaNQ)
*/
-/*#define HAS_CLASS /**/
+/*#define HAS_CLASS / **/
/* HAS_CLEARENV:
* This symbol, if defined, indicates that the clearenv () routine is
* available for use.
*/
-/*#define HAS_CLEARENV /**/
+/*#define HAS_CLEARENV / **/
/* HAS_STRUCT_CMSGHDR:
* This symbol, if defined, indicates that the struct cmsghdr
* is supported.
*/
-/*#define HAS_STRUCT_CMSGHDR /**/
+/*#define HAS_STRUCT_CMSGHDR / **/
/* HAS_COPYSIGNL:
* This symbol, if defined, indicates that the copysignl routine is
* available. If aintl is also present we can emulate modfl.
*/
-/*#define HAS_COPYSIGNL /**/
+/*#define HAS_COPYSIGNL / **/
/* USE_CPLUSPLUS:
* This symbol, if defined, indicates that a C++ compiler was
* used to compiled Perl and will be used to compile extensions.
*/
-/*#define USE_CPLUSPLUS /**/
+/*#define USE_CPLUSPLUS / **/
/* HAS_DBMINIT_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. A good guess is
* extern int dbminit(char *);
*/
-/*#define HAS_DBMINIT_PROTO /**/
+/*#define HAS_DBMINIT_PROTO / **/
/* HAS_DIR_DD_FD:
* This symbol, if defined, indicates that the the DIR* dirstream
* structure contains a member variable named dd_fd.
*/
-/*#define HAS_DIR_DD_FD /**/
+/*#define HAS_DIR_DD_FD / **/
/* HAS_DIRFD:
* This manifest constant lets the C program know that dirfd
* is available.
*/
-/*#define HAS_DIRFD /**/
+/*#define HAS_DIRFD / **/
/* DLSYM_NEEDS_UNDERSCORE:
* This symbol, if defined, indicates that we need to prepend an
* makes sense if you *have* dlsym, which we will presume is the
* case if you're using dl_dlopen.xs.
*/
-/*#define DLSYM_NEEDS_UNDERSCORE /**/
+/*#define DLSYM_NEEDS_UNDERSCORE / **/
/* HAS_FAST_STDIO:
* This symbol, if defined, indicates that the "fast stdio"
* This symbol, if defined, indicates that the fchdir routine is
* available to change directory using a file descriptor.
*/
-/*#define HAS_FCHDIR /**/
+/*#define HAS_FCHDIR / **/
/* FCNTL_CAN_LOCK:
* This symbol, if defined, indicates that fcntl() can be used
* for file locking. Normally on Unix systems this is defined.
* It may be undefined on VMS.
*/
-/*#define FCNTL_CAN_LOCK /**/
+/*#define FCNTL_CAN_LOCK / **/
/* HAS_FINITE:
* This symbol, if defined, indicates that the finite routine is
* available to check whether a double is finite (non-infinity non-NaN).
*/
-/*#define HAS_FINITE /**/
+/*#define HAS_FINITE / **/
/* HAS_FINITEL:
* This symbol, if defined, indicates that the finitel routine is
* available to check whether a long double is finite
* (non-infinity non-NaN).
*/
-/*#define HAS_FINITEL /**/
+/*#define HAS_FINITEL / **/
/* HAS_FLOCK_PROTO:
* This symbol, if defined, indicates that the system provides
* FP_POS_ZERO +0.0 (positive zero)
* FP_NEG_ZERO -0.0 (negative zero)
*/
-/*#define HAS_FP_CLASS /**/
+/*#define HAS_FP_CLASS / **/
/* HAS_FPCLASS:
* This symbol, if defined, indicates that the fpclass routine is
* FP_NNORM negative normalized non-zero
* FP_PNORM positive normalized non-zero
*/
-/*#define HAS_FPCLASS /**/
+/*#define HAS_FPCLASS / **/
/* HAS_FPCLASSIFY:
* This symbol, if defined, indicates that the fpclassify routine is
* FP_NAN NaN
*
*/
-/*#define HAS_FPCLASSIFY /**/
+/*#define HAS_FPCLASSIFY / **/
/* HAS_FPCLASSL:
* This symbol, if defined, indicates that the fpclassl routine is
* FP_NNORM negative normalized non-zero
* FP_PNORM positive normalized non-zero
*/
-/*#define HAS_FPCLASSL /**/
+/*#define HAS_FPCLASSL / **/
/* HAS_FPOS64_T:
* This symbol will be defined if the C compiler supports fpos64_t.
*/
-/*#define HAS_FPOS64_T /**/
+/*#define HAS_FPOS64_T / **/
/* HAS_FREXPL:
* This symbol, if defined, indicates that the frexpl routine is
* available to break a long double floating-point number into
* a normalized fraction and an integral power of 2.
*/
-/*#define HAS_FREXPL /**/
+/*#define HAS_FREXPL / **/
/* HAS_STRUCT_FS_DATA:
* This symbol, if defined, indicates that the struct fs_data
* to do statfs() is supported.
*/
-/*#define HAS_STRUCT_FS_DATA /**/
+/*#define HAS_STRUCT_FS_DATA / **/
/* HAS_FSEEKO:
* This symbol, if defined, indicates that the fseeko routine is
* available to fseek beyond 32 bits (useful for ILP32 hosts).
*/
-/*#define HAS_FSEEKO /**/
+/*#define HAS_FSEEKO / **/
/* HAS_FSTATFS:
* This symbol, if defined, indicates that the fstatfs routine is
* available to stat filesystems by file descriptors.
*/
-/*#define HAS_FSTATFS /**/
+/*#define HAS_FSTATFS / **/
/* HAS_FSYNC:
* This symbol, if defined, indicates that the fsync routine is
* available to write a file's modified data and attributes to
* permanent storage.
*/
-/*#define HAS_FSYNC /**/
+/*#define HAS_FSYNC / **/
/* HAS_FTELLO:
* This symbol, if defined, indicates that the ftello routine is
* available to ftell beyond 32 bits (useful for ILP32 hosts).
*/
-/*#define HAS_FTELLO /**/
+/*#define HAS_FTELLO / **/
/* HAS_FUTIMES:
* This symbol, if defined, indicates that the futimes routine is
* available to change file descriptor time stamps with struct timevals.
*/
-/*#define HAS_FUTIMES /**/
+/*#define HAS_FUTIMES / **/
+
+/* HAS_GETADDRINFO:
+ * This symbol, if defined, indicates that the getaddrinfo() function
+ * is available for use.
+ */
+/*#define HAS_GETADDRINFO / **/
/* HAS_GETCWD:
* This symbol, if defined, indicates that the getcwd routine is
* This symbol, if defined, indicates that the getespwnam system call is
* available to retrieve enchanced (shadow) password entries by name.
*/
-/*#define HAS_GETESPWNAM /**/
+/*#define HAS_GETESPWNAM / **/
/* HAS_GETFSSTAT:
* This symbol, if defined, indicates that the getfsstat routine is
* available to stat filesystems in bulk.
*/
-/*#define HAS_GETFSSTAT /**/
+/*#define HAS_GETFSSTAT / **/
/* HAS_GETITIMER:
* This symbol, if defined, indicates that the getitimer routine is
* available to return interval timers.
*/
-/*#define HAS_GETITIMER /**/
+/*#define HAS_GETITIMER / **/
/* HAS_GETMNT:
* This symbol, if defined, indicates that the getmnt routine is
* available to get filesystem mount info by filename.
*/
-/*#define HAS_GETMNT /**/
+/*#define HAS_GETMNT / **/
/* HAS_GETMNTENT:
* This symbol, if defined, indicates that the getmntent routine is
* available to iterate through mounted file systems to get their info.
*/
-/*#define HAS_GETMNTENT /**/
+/*#define HAS_GETMNTENT / **/
+
+/* HAS_GETNAMEINFO:
+ * This symbol, if defined, indicates that the getnameinfo() function
+ * is available for use.
+ */
+/*#define HAS_GETNAMEINFO / **/
/* HAS_GETPRPWNAM:
* This symbol, if defined, indicates that the getprpwnam system call is
* available to retrieve protected (shadow) password entries by name.
*/
-/*#define HAS_GETPRPWNAM /**/
+/*#define HAS_GETPRPWNAM / **/
/* HAS_GETSPNAM:
* This symbol, if defined, indicates that the getspnam system call is
* available to retrieve SysV shadow password entries by name.
*/
-/*#define HAS_GETSPNAM /**/
+/*#define HAS_GETSPNAM / **/
/* HAS_HASMNTOPT:
* This symbol, if defined, indicates that the hasmntopt routine is
* available to query the mount options of file systems.
*/
-/*#define HAS_HASMNTOPT /**/
+/*#define HAS_HASMNTOPT / **/
/* HAS_ILOGBL:
* This symbol, if defined, indicates that the ilogbl routine is
* available. If scalbnl is also present we can emulate frexpl.
*/
-/*#define HAS_ILOGBL /**/
+/*#define HAS_ILOGBL / **/
+
+/* HAS_INETNTOP:
+ * This symbol, if defined, indicates that the inet_ntop() function
+ * is available to parse IPv4 and IPv6 strings.
+ */
+/*#define HAS_INETNTOP / **/
+
+/* HAS_INETPTON:
+ * This symbol, if defined, indicates that the inet_pton() function
+ * is available to parse IPv4 and IPv6 strings.
+ */
+/*#define HAS_INETPTON / **/
/* HAS_INT64_T:
* This symbol will defined if the C compiler supports int64_t.
* Usually the <inttypes.h> needs to be included, but sometimes
* <sys/types.h> is enough.
*/
-/*#define HAS_INT64_T /**/
+/*#define HAS_INT64_T / **/
/* HAS_ISFINITE:
* This symbol, if defined, indicates that the isfinite routine is
* available to check whether a double is finite (non-infinity non-NaN).
*/
-/*#define HAS_ISFINITE /**/
+/*#define HAS_ISFINITE / **/
/* HAS_ISINF:
* This symbol, if defined, indicates that the isinf routine is
* available to check whether a double is an infinity.
*/
-/*#define HAS_ISINF /**/
+/*#define HAS_ISINF / **/
/* HAS_ISNAN:
* This symbol, if defined, indicates that the isnan routine is
* This symbol, if defined, indicates that the isnanl routine is
* available to check whether a long double is a NaN.
*/
-/*#define HAS_ISNANL /**/
+/*#define HAS_ISNANL / **/
/* HAS_LDBL_DIG:
* This symbol, if defined, indicates that this system's <float.h>
* This symbol, if defined, indicates that libm exports _LIB_VERSION
* and that math.h defines the enum to manipulate it.
*/
-/*#define LIBM_LIB_VERSION /**/
+/*#define LIBM_LIB_VERSION / **/
/* HAS_MADVISE:
* This symbol, if defined, indicates that the madvise system call is
* available to map a file into memory.
*/
-/*#define HAS_MADVISE /**/
+/*#define HAS_MADVISE / **/
/* HAS_MALLOC_SIZE:
* This symbol, if defined, indicates that the malloc_size
* routine is available for use.
*/
-/*#define HAS_MALLOC_SIZE /**/
+/*#define HAS_MALLOC_SIZE / **/
/* HAS_MALLOC_GOOD_SIZE:
* This symbol, if defined, indicates that the malloc_good_size
* routine is available for use.
*/
-/*#define HAS_MALLOC_GOOD_SIZE /**/
+/*#define HAS_MALLOC_GOOD_SIZE / **/
/* HAS_MKDTEMP:
* This symbol, if defined, indicates that the mkdtemp routine is
* available to exclusively create a uniquely named temporary directory.
*/
-/*#define HAS_MKDTEMP /**/
+/*#define HAS_MKDTEMP / **/
/* HAS_MKSTEMPS:
* This symbol, if defined, indicates that the mkstemps routine is
* available to excluslvely create and open a uniquely named
* (with a suffix) temporary file.
*/
-/*#define HAS_MKSTEMPS /**/
+/*#define HAS_MKSTEMPS / **/
/* HAS_MODFL:
* This symbol, if defined, indicates that the modfl routine is
* and 1.150000. The bug has been seen in certain versions of glibc,
* release 2.2.2 is known to be okay.
*/
-/*#define HAS_MODFL /**/
-/*#define HAS_MODFL_PROTO /**/
-/*#define HAS_MODFL_POW32_BUG /**/
+/*#define HAS_MODFL / **/
+/*#define HAS_MODFL_PROTO / **/
+/*#define HAS_MODFL_POW32_BUG / **/
/* HAS_MPROTECT:
* This symbol, if defined, indicates that the mprotect system call is
* available to modify the access protection of a memory mapped file.
*/
-/*#define HAS_MPROTECT /**/
+/*#define HAS_MPROTECT / **/
/* HAS_STRUCT_MSGHDR:
* This symbol, if defined, indicates that the struct msghdr
* is supported.
*/
-/*#define HAS_STRUCT_MSGHDR /**/
+/*#define HAS_STRUCT_MSGHDR / **/
/* HAS_NL_LANGINFO:
* This symbol, if defined, indicates that the nl_langinfo routine is
* available to return local data. You will also need <langinfo.h>
* and therefore I_LANGINFO.
*/
-/*#define HAS_NL_LANGINFO /**/
+/*#define HAS_NL_LANGINFO / **/
/* HAS_OFF64_T:
* This symbol will be defined if the C compiler supports off64_t.
*/
-/*#define HAS_OFF64_T /**/
+/*#define HAS_OFF64_T / **/
/* HAS_PROCSELFEXE:
* This symbol is defined if PROCSELFEXE_PATH is a symlink
* of the symbolic link pointing to the absolute pathname of
* the executing program.
*/
-/*#define HAS_PROCSELFEXE /**/
+/*#define HAS_PROCSELFEXE / **/
#if defined(HAS_PROCSELFEXE) && !defined(PROCSELFEXE_PATH)
#define PROCSELFEXE_PATH /**/
#endif
* system call is available to set the contention scope attribute of
* a thread attribute object.
*/
-/*#define HAS_PTHREAD_ATTR_SETSCOPE /**/
+/*#define HAS_PTHREAD_ATTR_SETSCOPE / **/
/* HAS_READV:
* This symbol, if defined, indicates that the readv routine is
* available to do gather reads. You will also need <sys/uio.h>
* and there I_SYSUIO.
*/
-/*#define HAS_READV /**/
+/*#define HAS_READV / **/
/* HAS_RECVMSG:
* This symbol, if defined, indicates that the recvmsg routine is
* available to send structured socket messages.
*/
-/*#define HAS_RECVMSG /**/
+/*#define HAS_RECVMSG / **/
/* HAS_SBRK_PROTO:
* This symbol, if defined, indicates that the system provides
* extern void* sbrk(int);
* extern void* sbrk(size_t);
*/
-/*#define HAS_SBRK_PROTO /**/
+/*#define HAS_SBRK_PROTO / **/
/* HAS_SCALBNL:
* This symbol, if defined, indicates that the scalbnl routine is
* available. If ilogbl is also present we can emulate frexpl.
*/
-/*#define HAS_SCALBNL /**/
+/*#define HAS_SCALBNL / **/
/* HAS_SENDMSG:
* This symbol, if defined, indicates that the sendmsg routine is
* available to send structured socket messages.
*/
-/*#define HAS_SENDMSG /**/
+/*#define HAS_SENDMSG / **/
/* HAS_SETITIMER:
* This symbol, if defined, indicates that the setitimer routine is
* available to set interval timers.
*/
-/*#define HAS_SETITIMER /**/
+/*#define HAS_SETITIMER / **/
/* HAS_SETPROCTITLE:
* This symbol, if defined, indicates that the setproctitle routine is
* available to set process title.
*/
-/*#define HAS_SETPROCTITLE /**/
+/*#define HAS_SETPROCTITLE / **/
/* USE_SFIO:
* This symbol, if defined, indicates that sfio should
* be used.
*/
-/*#define USE_SFIO /**/
+/*#define USE_SFIO / **/
/* HAS_SIGNBIT:
* This symbol, if defined, indicates that the signbit routine is
* in perl. Users should call Perl_signbit(), which will be #defined to
* the system's signbit() function or macro if this symbol is defined.
*/
-/*#define HAS_SIGNBIT /**/
+/*#define HAS_SIGNBIT / **/
/* HAS_SIGPROCMASK:
* This symbol, if defined, indicates that the sigprocmask
* system call is available to examine or change the signal mask
* of the calling process.
*/
-/*#define HAS_SIGPROCMASK /**/
+/*#define HAS_SIGPROCMASK / **/
/* USE_SITECUSTOMIZE:
* This symbol, if defined, indicates that sitecustomize should
* be used.
*/
#ifndef USE_SITECUSTOMIZE
-/*#define USE_SITECUSTOMIZE /**/
+/*#define USE_SITECUSTOMIZE / **/
#endif
/* HAS_SNPRINTF:
* This symbol, if defined, indicates that the sockatmark routine is
* available to test whether a socket is at the out-of-band mark.
*/
-/*#define HAS_SOCKATMARK /**/
+/*#define HAS_SOCKATMARK / **/
/* HAS_SOCKATMARK_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. A good guess is
* extern int sockatmark(int);
*/
-/*#define HAS_SOCKATMARK_PROTO /**/
+/*#define HAS_SOCKATMARK_PROTO / **/
/* HAS_SOCKS5_INIT:
* This symbol, if defined, indicates that the socks5_init routine is
* available to initialize SOCKS 5.
*/
-/*#define HAS_SOCKS5_INIT /**/
+/*#define HAS_SOCKS5_INIT / **/
/* SPRINTF_RETURNS_STRLEN:
* This variable defines whether sprintf returns the length of the string
* This symbol, if defined, indicates that the sqrtl routine is
* available to do long double square roots.
*/
-/*#define HAS_SQRTL /**/
+/*#define HAS_SQRTL / **/
/* HAS_SETRESGID_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. Good guesses are
* extern int setresgid(uid_t ruid, uid_t euid, uid_t suid);
*/
-/*#define HAS_SETRESGID_PROTO /**/
+/*#define HAS_SETRESGID_PROTO / **/
/* HAS_SETRESUID_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. Good guesses are
* extern int setresuid(uid_t ruid, uid_t euid, uid_t suid);
*/
-/*#define HAS_SETRESUID_PROTO /**/
+/*#define HAS_SETRESUID_PROTO / **/
/* HAS_STRUCT_STATFS_F_FLAGS:
* This symbol, if defined, indicates that the struct statfs
* have statfs() and struct statfs, they have ustat() and getmnt()
* with struct ustat and struct fs_data.
*/
-/*#define HAS_STRUCT_STATFS_F_FLAGS /**/
+/*#define HAS_STRUCT_STATFS_F_FLAGS / **/
/* HAS_STRUCT_STATFS:
* This symbol, if defined, indicates that the struct statfs
* to do statfs() is supported.
*/
-/*#define HAS_STRUCT_STATFS /**/
+/*#define HAS_STRUCT_STATFS / **/
/* HAS_FSTATVFS:
* This symbol, if defined, indicates that the fstatvfs routine is
* available to stat filesystems by file descriptors.
*/
-/*#define HAS_FSTATVFS /**/
+/*#define HAS_FSTATVFS / **/
/* HAS_STRFTIME:
* This symbol, if defined, indicates that the strftime routine is
* This symbol, if defined, indicates that the strlcat () routine is
* available to do string concatenation.
*/
-/*#define HAS_STRLCAT /**/
+/*#define HAS_STRLCAT / **/
/* HAS_STRLCPY:
* This symbol, if defined, indicates that the strlcpy () routine is
* available to do string copying.
*/
-/*#define HAS_STRLCPY /**/
+/*#define HAS_STRLCPY / **/
/* HAS_STRTOLD:
* This symbol, if defined, indicates that the strtold routine is
* available to convert strings to long doubles.
*/
-/*#define HAS_STRTOLD /**/
+/*#define HAS_STRTOLD / **/
/* HAS_STRTOLL:
* This symbol, if defined, indicates that the strtoll routine is
* available to convert strings to long longs.
*/
-/*#define HAS_STRTOLL /**/
+/*#define HAS_STRTOLL / **/
/* HAS_STRTOQ:
* This symbol, if defined, indicates that the strtoq routine is
* available to convert strings to long longs (quads).
*/
-/*#define HAS_STRTOQ /**/
+/*#define HAS_STRTOQ / **/
/* HAS_STRTOULL:
* This symbol, if defined, indicates that the strtoull routine is
* available to convert strings to unsigned long longs.
*/
-/*#define HAS_STRTOULL /**/
+/*#define HAS_STRTOULL / **/
/* HAS_STRTOUQ:
* This symbol, if defined, indicates that the strtouq routine is
* available to convert strings to unsigned long longs (quads).
*/
-/*#define HAS_STRTOUQ /**/
+/*#define HAS_STRTOUQ / **/
/* HAS_SYSCALL_PROTO:
* This symbol, if defined, indicates that the system provides
* extern int syscall(int, ...);
* extern int syscall(long, ...);
*/
-/*#define HAS_SYSCALL_PROTO /**/
+/*#define HAS_SYSCALL_PROTO / **/
/* HAS_TELLDIR_PROTO:
* This symbol, if defined, indicates that the system provides
* This symbol, if defined, indicates that the asctime64 () routine is
* available to do the 64bit variant of asctime ()
*/
-/*#define HAS_CTIME64 /**/
-/*#define HAS_LOCALTIME64 /**/
-/*#define HAS_GMTIME64 /**/
-/*#define HAS_MKTIME64 /**/
-/*#define HAS_DIFFTIME64 /**/
-/*#define HAS_ASCTIME64 /**/
+/*#define HAS_CTIME64 / **/
+/*#define HAS_LOCALTIME64 / **/
+/*#define HAS_GMTIME64 / **/
+/*#define HAS_MKTIME64 / **/
+/*#define HAS_DIFFTIME64 / **/
+/*#define HAS_ASCTIME64 / **/
/* HAS_TIMEGM:
* This symbol, if defined, indicates that the timegm routine is
* available to do the opposite of gmtime ()
*/
-/*#define HAS_TIMEGM /**/
+/*#define HAS_TIMEGM / **/
/* U32_ALIGNMENT_REQUIRED:
* This symbol, if defined, indicates that you must access
* This symbol, if defined, indicates that the ualarm routine is
* available to do alarms with microsecond granularity.
*/
-/*#define HAS_UALARM /**/
+/*#define HAS_UALARM / **/
/* HAS_UNORDERED:
* This symbol, if defined, indicates that the unordered routine is
* available to check whether two doubles are unordered
* (effectively: whether either of them is NaN)
*/
-/*#define HAS_UNORDERED /**/
+/*#define HAS_UNORDERED / **/
/* HAS_UNSETENV:
* This symbol, if defined, indicates that the unsetenv () routine is
* available for use.
*/
-/*#define HAS_UNSETENV /**/
+/*#define HAS_UNSETENV / **/
/* HAS_USLEEP_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. A good guess is
* extern int usleep(useconds_t);
*/
-/*#define HAS_USLEEP_PROTO /**/
+/*#define HAS_USLEEP_PROTO / **/
/* HAS_USTAT:
* This symbol, if defined, indicates that the ustat system call is
* available to query file system statistics by dev_t.
*/
-/*#define HAS_USTAT /**/
+/*#define HAS_USTAT / **/
/* HAS_WRITEV:
* This symbol, if defined, indicates that the writev routine is
* available to do scatter writes.
*/
-/*#define HAS_WRITEV /**/
+/*#define HAS_WRITEV / **/
/* USE_DYNAMIC_LOADING:
* This symbol, if defined, indicates that dynamic loading of
* even be probed for and will be left undefined.
*/
#define FFLUSH_NULL /**/
-/*#define FFLUSH_ALL /**/
+/*#define FFLUSH_ALL / **/
/* I_ASSERT:
* This symbol, if defined, indicates that <assert.h> exists and
* This symbol, if defined, indicates that <crypt.h> exists and
* should be included.
*/
-/*#define I_CRYPT /**/
+/*#define I_CRYPT / **/
/* DB_Prefix_t:
* This symbol contains the type of the prefix structure element
* This symbol, if defined, indicates that <fp.h> exists and
* should be included.
*/
-/*#define I_FP /**/
+/*#define I_FP / **/
/* I_FP_CLASS:
* This symbol, if defined, indicates that <fp_class.h> exists and
* should be included.
*/
-/*#define I_FP_CLASS /**/
+/*#define I_FP_CLASS / **/
/* I_IEEEFP:
* This symbol, if defined, indicates that <ieeefp.h> exists and
* should be included.
*/
-/*#define I_IEEEFP /**/
+/*#define I_IEEEFP / **/
/* I_INTTYPES:
* This symbol, if defined, indicates to the C program that it should
* include <inttypes.h>.
*/
-/*#define I_INTTYPES /**/
+/*#define I_INTTYPES / **/
/* I_LANGINFO:
* This symbol, if defined, indicates that <langinfo.h> exists and
* should be included.
*/
-/*#define I_LANGINFO /**/
+/*#define I_LANGINFO / **/
/* I_LIBUTIL:
* This symbol, if defined, indicates that <libutil.h> exists and
* should be included.
*/
-/*#define I_LIBUTIL /**/
+/*#define I_LIBUTIL / **/
/* I_MALLOCMALLOC:
* This symbol, if defined, indicates to the C program that it should
* include <malloc/malloc.h>.
*/
-/*#define I_MALLOCMALLOC /**/
+/*#define I_MALLOCMALLOC / **/
/* I_MNTENT:
* This symbol, if defined, indicates that <mntent.h> exists and
* should be included.
*/
-/*#define I_MNTENT /**/
+/*#define I_MNTENT / **/
/* I_NETINET_TCP:
* This symbol, if defined, indicates to the C program that it should
* include <netinet/tcp.h>.
*/
-/*#define I_NETINET_TCP /**/
+/*#define I_NETINET_TCP / **/
/* I_POLL:
* This symbol, if defined, indicates that <poll.h> exists and
* should be included. (see also HAS_POLL)
*/
-/*#define I_POLL /**/
+/*#define I_POLL / **/
/* I_PROT:
* This symbol, if defined, indicates that <prot.h> exists and
* should be included.
*/
-/*#define I_PROT /**/
+/*#define I_PROT / **/
/* I_SHADOW:
* This symbol, if defined, indicates that <shadow.h> exists and
* should be included.
*/
-/*#define I_SHADOW /**/
+/*#define I_SHADOW / **/
/* I_SOCKS:
* This symbol, if defined, indicates that <socks.h> exists and
* should be included.
*/
-/*#define I_SOCKS /**/
+/*#define I_SOCKS / **/
/* I_SUNMATH:
* This symbol, if defined, indicates that <sunmath.h> exists and
* should be included.
*/
-/*#define I_SUNMATH /**/
+/*#define I_SUNMATH / **/
/* I_SYSLOG:
* This symbol, if defined, indicates that <syslog.h> exists and
* should be included.
*/
-/*#define I_SYSLOG /**/
+/*#define I_SYSLOG / **/
/* I_SYSMODE:
* This symbol, if defined, indicates that <sys/mode.h> exists and
* should be included.
*/
-/*#define I_SYSMODE /**/
+/*#define I_SYSMODE / **/
/* I_SYS_MOUNT:
* This symbol, if defined, indicates that <sys/mount.h> exists and
* should be included.
*/
-/*#define I_SYS_MOUNT /**/
+/*#define I_SYS_MOUNT / **/
/* I_SYS_STATFS:
* This symbol, if defined, indicates that <sys/statfs.h> exists.
*/
-/*#define I_SYS_STATFS /**/
+/*#define I_SYS_STATFS / **/
/* I_SYS_STATVFS:
* This symbol, if defined, indicates that <sys/statvfs.h> exists and
* should be included.
*/
-/*#define I_SYS_STATVFS /**/
+/*#define I_SYS_STATVFS / **/
/* I_SYSUTSNAME:
* This symbol, if defined, indicates that <sys/utsname.h> exists and
* should be included.
*/
-/*#define I_SYSUTSNAME /**/
+/*#define I_SYSUTSNAME / **/
/* I_SYS_VFS:
* This symbol, if defined, indicates that <sys/vfs.h> exists and
* should be included.
*/
-/*#define I_SYS_VFS /**/
+/*#define I_SYS_VFS / **/
/* I_USTAT:
* This symbol, if defined, indicates that <ustat.h> exists and
* should be included.
*/
-/*#define I_USTAT /**/
+/*#define I_USTAT / **/
/* PERL_PRIfldbl:
* This symbol, if defined, contains the string used by stdio to
* This symbol, if defined, contains the string used by stdio to
* format long doubles (format 'f') for input.
*/
-/*#define PERL_PRIfldbl "f" /**/
-/*#define PERL_PRIgldbl "g" /**/
-/*#define PERL_PRIeldbl "e" /**/
-/*#define PERL_SCNfldbl "f" /**/
+/*#define PERL_PRIfldbl "f" / **/
+/*#define PERL_PRIgldbl "g" / **/
+/*#define PERL_PRIeldbl "e" / **/
+/*#define PERL_SCNfldbl "f" / **/
/* PERL_MAD:
* This symbol, if defined, indicates that the Misc Attribution
* Declaration code should be conditionally compiled.
*/
-/*#define PERL_MAD /**/
+/*#define PERL_MAD / **/
/* NEED_VA_COPY:
* This symbol, if defined, indicates that the system stores
* of copying mechanisms, handy.h defines a platform-
* independent macro, Perl_va_copy(src, dst), to do the job.
*/
-/*#define NEED_VA_COPY /**/
+/*#define NEED_VA_COPY / **/
/* IVTYPE:
* This symbol defines the C type used for Perl's IV.
* This symbol tells the name of the array holding the stdio streams.
* Usual values include _iob, __iob, and __sF.
*/
-/*#define HAS_STDIO_STREAM_ARRAY /**/
+/*#define HAS_STDIO_STREAM_ARRAY / **/
#ifdef HAS_STDIO_STREAM_ARRAY
#define STDIO_STREAM_ARRAY
#endif
* This symbol contains the minimum value for the time_t offset that
* the system function localtime () accepts, and defaults to 0
*/
-#define GMTIME_MAX 2147483647 /**/
-#define GMTIME_MIN 0 /**/
+#define GMTIME_MAX 2147483647 /**/
+#define GMTIME_MIN 0 /**/
#define LOCALTIME_MAX 2147483647 /**/
#define LOCALTIME_MIN 0 /**/
* you may need at least to reboot your OS to 64-bit mode.
*/
#ifndef USE_64_BIT_INT
-/*#define USE_64_BIT_INT /**/
+/*#define USE_64_BIT_INT / **/
#endif
#ifndef USE_64_BIT_ALL
-/*#define USE_64_BIT_ALL /**/
+/*#define USE_64_BIT_ALL / **/
#endif
/* USE_DTRACE:
* This symbol, if defined, indicates that Perl should
* be built with support for DTrace.
*/
-/*#define USE_DTRACE /**/
+/*#define USE_DTRACE / **/
/* USE_FAST_STDIO:
* This symbol, if defined, indicates that Perl should
* Defaults to define in Perls 5.8 and earlier, to undef later.
*/
#ifndef USE_FAST_STDIO
-/*#define USE_FAST_STDIO /**/
+/*#define USE_FAST_STDIO / **/
#endif
/* USE_LARGE_FILES:
* should be used when available.
*/
#ifndef USE_LARGE_FILES
-/*#define USE_LARGE_FILES /**/
+/*#define USE_LARGE_FILES / **/
#endif
/* USE_LONG_DOUBLE:
* be used when available.
*/
#ifndef USE_LONG_DOUBLE
-/*#define USE_LONG_DOUBLE /**/
+/*#define USE_LONG_DOUBLE / **/
#endif
/* USE_MORE_BITS:
* long doubles should be used when available.
*/
#ifndef USE_MORE_BITS
-/*#define USE_MORE_BITS /**/
+/*#define USE_MORE_BITS / **/
#endif
/* MULTIPLICITY:
* be built to use multiplicity.
*/
#ifndef MULTIPLICITY
-/*#define MULTIPLICITY /**/
+/*#define MULTIPLICITY / **/
#endif
/* USE_PERLIO:
* used in a fully backward compatible manner.
*/
#ifndef USE_PERLIO
-/*#define USE_PERLIO /**/
+/*#define USE_PERLIO / **/
#endif
/* USE_SOCKS:
* be built to use socks.
*/
#ifndef USE_SOCKS
-/*#define USE_SOCKS /**/
+/*#define USE_SOCKS / **/
#endif
#endif
/*
* Package name : perl5
* Source directory :
- * Configuration time: Fri Dec 12 15:19:23 2008
- * Configured by : shay
+ * Configuration time: Sat Jan 9 17:22:03 2010
+ * Configured by : Steve
* Target system :
*/
* This symbol is defined if the bcmp() routine is available to
* compare blocks of memory.
*/
-/*#define HAS_BCMP /**/
+/*#define HAS_BCMP / **/
/* HAS_BCOPY:
* This symbol is defined if the bcopy() routine is available to
* copy blocks of memory.
*/
-/*#define HAS_BCOPY /**/
+/*#define HAS_BCOPY / **/
/* HAS_BZERO:
* This symbol is defined if the bzero() routine is available to
* set a memory block to 0.
*/
-/*#define HAS_BZERO /**/
+/*#define HAS_BZERO / **/
/* HAS_CHOWN:
* This symbol, if defined, indicates that the chown routine is
* available.
*/
-/*#define HAS_CHOWN /**/
+/*#define HAS_CHOWN / **/
/* HAS_CHROOT:
* This symbol, if defined, indicates that the chroot routine is
* available.
*/
-/*#define HAS_CHROOT /**/
+/*#define HAS_CHROOT / **/
/* HAS_CHSIZE:
* This symbol, if defined, indicates that the chsize routine is available
* This symbol, if defined, indicates that the crypt routine is available
* to encrypt passwords and the like.
*/
-/*#define HAS_CRYPT /**/
+/*#define HAS_CRYPT / **/
/* HAS_CTERMID:
* This symbol, if defined, indicates that the ctermid routine is
* available to generate filename for terminal.
*/
-/*#define HAS_CTERMID /**/
+/*#define HAS_CTERMID / **/
/* HAS_CUSERID:
* This symbol, if defined, indicates that the cuserid routine is
* available to get character login names.
*/
-/*#define HAS_CUSERID /**/
+/*#define HAS_CUSERID / **/
/* HAS_DBL_DIG:
* This symbol, if defined, indicates that this system's <float.h>
*/
#define HAS_DLERROR /**/
-/* SETUID_SCRIPTS_ARE_SECURE_NOW:
- * This symbol, if defined, indicates that the bug that prevents
- * setuid scripts from being secure is not present in this kernel.
- */
-/* DOSUID:
- * This symbol, if defined, indicates that the C program should
- * check the script that it is executing for setuid/setgid bits, and
- * attempt to emulate setuid/setgid on systems that have disabled
- * setuid #! scripts because the kernel can't do it securely.
- * It is up to the package designer to make sure that this emulation
- * is done securely. Among other things, it should do an fstat on
- * the script it just opened to make sure it really is a setuid/setgid
- * script, it should make sure the arguments passed correspond exactly
- * to the argument on the #! line, and it should not trust any
- * subprocesses to which it must pass the filename rather than the
- * file descriptor of the script to be executed.
- */
-/*#define SETUID_SCRIPTS_ARE_SECURE_NOW /**/
-/*#define DOSUID /**/
-
/* HAS_DUP2:
* This symbol, if defined, indicates that the dup2 routine is
* available to duplicate file descriptors.
* This symbol, if defined, indicates that the fchmod routine is available
* to change mode of opened files. If unavailable, use chmod().
*/
-/*#define HAS_FCHMOD /**/
+/*#define HAS_FCHMOD / **/
/* HAS_FCHOWN:
* This symbol, if defined, indicates that the fchown routine is available
* to change ownership of opened files. If unavailable, use chown().
*/
-/*#define HAS_FCHOWN /**/
+/*#define HAS_FCHOWN / **/
/* HAS_FCNTL:
* This symbol, if defined, indicates to the C program that
* the fcntl() function exists.
*/
-/*#define HAS_FCNTL /**/
+/*#define HAS_FCNTL / **/
/* HAS_FGETPOS:
* This symbol, if defined, indicates that the fgetpos routine is
* This symbol, if defined, indicates that the fork routine is
* available.
*/
-/*#define HAS_FORK /**/
+/*#define HAS_FORK / **/
/* HAS_FSETPOS:
* This symbol, if defined, indicates that the fsetpos routine is
* available to get the list of process groups. If unavailable, multiple
* groups are probably not supported.
*/
-/*#define HAS_GETGROUPS /**/
+/*#define HAS_GETGROUPS / **/
/* HAS_GETLOGIN:
* This symbol, if defined, indicates that the getlogin routine is
* the getpgid(pid) function is available to get the
* process group id.
*/
-/*#define HAS_GETPGID /**/
+/*#define HAS_GETPGID / **/
/* HAS_GETPGRP2:
* This symbol, if defined, indicates that the getpgrp2() (as in DG/UX)
* routine is available to get the current process group.
*/
-/*#define HAS_GETPGRP2 /**/
+/*#define HAS_GETPGRP2 / **/
/* HAS_GETPPID:
* This symbol, if defined, indicates that the getppid routine is
* available to get the parent process ID.
*/
-/*#define HAS_GETPPID /**/
+/*#define HAS_GETPPID / **/
/* HAS_GETPRIORITY:
* This symbol, if defined, indicates that the getpriority routine is
* available to get a process's priority.
*/
-/*#define HAS_GETPRIORITY /**/
+/*#define HAS_GETPRIORITY / **/
/* HAS_INET_ATON:
* This symbol, if defined, indicates to the C program that the
* inet_aton() function is available to parse IP address "dotted-quad"
* strings.
*/
-/*#define HAS_INET_ATON /**/
+/*#define HAS_INET_ATON / **/
/* HAS_KILLPG:
* This symbol, if defined, indicates that the killpg routine is available
* This symbol, if defined, indicates that the lockf routine is
* available to do file locking.
*/
-/*#define HAS_LOCKF /**/
+/*#define HAS_LOCKF / **/
/* HAS_LSTAT:
* This symbol, if defined, indicates that the lstat routine is
* available to do file stats on symbolic links.
*/
-/*#define HAS_LSTAT /**/
+/*#define HAS_LSTAT / **/
/* HAS_MBLEN:
* This symbol, if defined, indicates that the mblen routine is available
* do it for you. However, if mkfifo is there, mknod might require
* super-user privileges which mkfifo will not.
*/
-/*#define HAS_MKFIFO /**/
+/*#define HAS_MKFIFO / **/
/* HAS_MKTIME:
* This symbol, if defined, indicates that the mktime routine is
* This symbol, if defined, indicates that the msync system call is
* available to synchronize a mapped file.
*/
-/*#define HAS_MSYNC /**/
+/*#define HAS_MSYNC / **/
/* HAS_MUNMAP:
* This symbol, if defined, indicates that the munmap system call is
* available to unmap a region, usually mapped by mmap().
*/
-/*#define HAS_MUNMAP /**/
+/*#define HAS_MUNMAP / **/
/* HAS_NICE:
* This symbol, if defined, indicates that the nice routine is
* available.
*/
-/*#define HAS_NICE /**/
+/*#define HAS_NICE / **/
/* HAS_PATHCONF:
* This symbol, if defined, indicates that pathconf() is available
* to determine file-system related limits and options associated
* with a given open file descriptor.
*/
-/*#define HAS_PATHCONF /**/
-/*#define HAS_FPATHCONF /**/
+/*#define HAS_PATHCONF / **/
+/*#define HAS_FPATHCONF / **/
/* HAS_PAUSE:
* This symbol, if defined, indicates that the pause routine is
* available to poll active file descriptors. Please check I_POLL and
* I_SYS_POLL to know which header should be included as well.
*/
-/*#define HAS_POLL /**/
+/*#define HAS_POLL / **/
/* HAS_READDIR:
* This symbol, if defined, indicates that the readdir routine is
* This symbol, if defined, indicates that the readlink routine is
* available to read the value of a symbolic link.
*/
-/*#define HAS_READLINK /**/
+/*#define HAS_READLINK / **/
/* HAS_RENAME:
* This symbol, if defined, indicates that the rename routine is available
* This symbol, if defined, indicates that the setegid routine is available
* to change the effective gid of the current program.
*/
-/*#define HAS_SETEGID /**/
+/*#define HAS_SETEGID / **/
/* HAS_SETEUID:
* This symbol, if defined, indicates that the seteuid routine is available
* to change the effective uid of the current program.
*/
-/*#define HAS_SETEUID /**/
+/*#define HAS_SETEUID / **/
/* HAS_SETGROUPS:
* This symbol, if defined, indicates that the setgroups() routine is
* available to set the list of process groups. If unavailable, multiple
* groups are probably not supported.
*/
-/*#define HAS_SETGROUPS /**/
+/*#define HAS_SETGROUPS / **/
/* HAS_SETLINEBUF:
* This symbol, if defined, indicates that the setlinebuf routine is
* available to change stderr or stdout from block-buffered or unbuffered
* to a line-buffered mode.
*/
-/*#define HAS_SETLINEBUF /**/
+/*#define HAS_SETLINEBUF / **/
/* HAS_SETLOCALE:
* This symbol, if defined, indicates that the setlocale routine is
* This symbol, if defined, indicates that the setpgid(pid, gpid)
* routine is available to set process group ID.
*/
-/*#define HAS_SETPGID /**/
+/*#define HAS_SETPGID / **/
/* HAS_SETPGRP2:
* This symbol, if defined, indicates that the setpgrp2() (as in DG/UX)
* routine is available to set the current process group.
*/
-/*#define HAS_SETPGRP2 /**/
+/*#define HAS_SETPGRP2 / **/
/* HAS_SETPRIORITY:
* This symbol, if defined, indicates that the setpriority routine is
* available to set a process's priority.
*/
-/*#define HAS_SETPRIORITY /**/
+/*#define HAS_SETPRIORITY / **/
/* HAS_SETREGID:
* This symbol, if defined, indicates that the setregid routine is
* available to change the real, effective and saved gid of the current
* process.
*/
-/*#define HAS_SETREGID /**/
-/*#define HAS_SETRESGID /**/
+/*#define HAS_SETREGID / **/
+/*#define HAS_SETRESGID / **/
/* HAS_SETREUID:
* This symbol, if defined, indicates that the setreuid routine is
* available to change the real, effective and saved uid of the current
* process.
*/
-/*#define HAS_SETREUID /**/
-/*#define HAS_SETRESUID /**/
+/*#define HAS_SETREUID / **/
+/*#define HAS_SETRESUID / **/
/* HAS_SETRGID:
* This symbol, if defined, indicates that the setrgid routine is available
* to change the real gid of the current program.
*/
-/*#define HAS_SETRGID /**/
+/*#define HAS_SETRGID / **/
/* HAS_SETRUID:
* This symbol, if defined, indicates that the setruid routine is available
* to change the real uid of the current program.
*/
-/*#define HAS_SETRUID /**/
+/*#define HAS_SETRUID / **/
/* HAS_SETSID:
* This symbol, if defined, indicates that the setsid routine is
* available to set the process group ID.
*/
-/*#define HAS_SETSID /**/
+/*#define HAS_SETSID / **/
/* HAS_STRCHR:
* This symbol is defined to indicate that the strchr()/strrchr()
* functions are available for string searching.
*/
#define HAS_STRCHR /**/
-/*#define HAS_INDEX /**/
+/*#define HAS_INDEX / **/
/* HAS_STRCOLL:
* This symbol, if defined, indicates that the strcoll routine is
* This symbol, if defined, indicates that the symlink routine is available
* to create symbolic links.
*/
-/*#define HAS_SYMLINK /**/
+/*#define HAS_SYMLINK / **/
/* HAS_SYSCALL:
* This symbol, if defined, indicates that the syscall routine is
* available to call arbitrary system calls. If undefined, that's tough.
*/
-/*#define HAS_SYSCALL /**/
+/*#define HAS_SYSCALL / **/
/* HAS_SYSCONF:
* This symbol, if defined, indicates that sysconf() is available
* to determine system related limits and options.
*/
-/*#define HAS_SYSCONF /**/
+/*#define HAS_SYSCONF / **/
/* HAS_SYSTEM:
* This symbol, if defined, indicates that the system routine is
* This symbol, if defined, indicates that the tcgetpgrp routine is
* available to get foreground process group ID.
*/
-/*#define HAS_TCGETPGRP /**/
+/*#define HAS_TCGETPGRP / **/
/* HAS_TCSETPGRP:
* This symbol, if defined, indicates that the tcsetpgrp routine is
* available to set foreground process group ID.
*/
-/*#define HAS_TCSETPGRP /**/
+/*#define HAS_TCSETPGRP / **/
/* HAS_TRUNCATE:
* This symbol, if defined, indicates that the truncate routine is
* available to truncate files.
*/
-/*#define HAS_TRUNCATE /**/
+/*#define HAS_TRUNCATE / **/
/* HAS_TZNAME:
* This symbol, if defined, indicates that the tzname[] array is
* This symbol, if defined, indicates that the usleep routine is
* available to let the process sleep on a sub-second accuracy.
*/
-/*#define HAS_USLEEP /**/
+/*#define HAS_USLEEP / **/
/* HAS_WAIT4:
* This symbol, if defined, indicates that wait4() exists.
*/
-/*#define HAS_WAIT4 /**/
+/*#define HAS_WAIT4 / **/
/* HAS_WAITPID:
* This symbol, if defined, indicates that the waitpid routine is
* This symbol, if defined, indicates that <rpcsvc/dbm.h> exists and
* should be included.
*/
-/*#define I_DBM /**/
+/*#define I_DBM / **/
#define I_RPCSVC_DBM /**/
/* I_DLFCN:
* This symbol, if defined, indicates that <gdbm.h> exists and should
* be included.
*/
-/*#define I_GDBM /**/
+/*#define I_GDBM / **/
/* I_LIMITS:
* This symbol, if defined, indicates to the C program that it should
* This symbol, if defined, indicates to the C program that it should
* include <memory.h>.
*/
-/*#define I_MEMORY /**/
+/*#define I_MEMORY / **/
/* I_NETINET_IN:
* This symbol, if defined, indicates to the C program that it should
* include <netinet/in.h>. Otherwise, you may try <sys/in.h>.
*/
-/*#define I_NETINET_IN /**/
+/*#define I_NETINET_IN / **/
/* I_SFIO:
* This symbol, if defined, indicates to the C program that it should
* include <sfio.h>.
*/
-/*#define I_SFIO /**/
+/*#define I_SFIO / **/
/* I_STDDEF:
* This symbol, if defined, indicates that <stddef.h> exists and should
* This symbol, if defined, indicates to the C program that it should
* include <sys/dir.h>.
*/
-/*#define I_SYS_DIR /**/
+/*#define I_SYS_DIR / **/
/* I_SYS_FILE:
* This symbol, if defined, indicates to the C program that it should
* include <sys/file.h> to get definition of R_OK and friends.
*/
-/*#define I_SYS_FILE /**/
+/*#define I_SYS_FILE / **/
/* I_SYS_IOCTL:
* This symbol, if defined, indicates that <sys/ioctl.h> exists and should
* This symbol, if defined, indicates the <sys/sockio.h> should be included
* to get socket ioctl options, like SIOCATMARK.
*/
-/*#define I_SYS_IOCTL /**/
-/*#define I_SYS_SOCKIO /**/
+/*#define I_SYS_IOCTL / **/
+/*#define I_SYS_SOCKIO / **/
/* I_SYS_NDIR:
* This symbol, if defined, indicates to the C program that it should
* include <sys/ndir.h>.
*/
-/*#define I_SYS_NDIR /**/
+/*#define I_SYS_NDIR / **/
/* I_SYS_PARAM:
* This symbol, if defined, indicates to the C program that it should
* include <sys/param.h>.
*/
-/*#define I_SYS_PARAM /**/
+/*#define I_SYS_PARAM / **/
/* I_SYS_POLL:
* This symbol, if defined, indicates that the program may include
* <sys/poll.h>. When I_POLL is also defined, it's probably safest
* to only include <poll.h>.
*/
-/*#define I_SYS_POLL /**/
+/*#define I_SYS_POLL / **/
/* I_SYS_RESOURCE:
* This symbol, if defined, indicates to the C program that it should
* include <sys/resource.h>.
*/
-/*#define I_SYS_RESOURCE /**/
+/*#define I_SYS_RESOURCE / **/
/* I_SYS_SELECT:
* This symbol, if defined, indicates to the C program that it should
* include <sys/select.h> in order to get definition of struct timeval.
*/
-/*#define I_SYS_SELECT /**/
+/*#define I_SYS_SELECT / **/
/* I_SYS_STAT:
* This symbol, if defined, indicates to the C program that it should
* This symbol, if defined, indicates to the C program that it should
* include <sys/times.h>.
*/
-/*#define I_SYS_TIMES /**/
+/*#define I_SYS_TIMES / **/
/* I_SYS_TYPES:
* This symbol, if defined, indicates to the C program that it should
* This symbol, if defined, indicates to the C program that it should
* include <sys/un.h> to get UNIX domain socket definitions.
*/
-/*#define I_SYS_UN /**/
+/*#define I_SYS_UN / **/
/* I_SYS_WAIT:
* This symbol, if defined, indicates to the C program that it should
* include <sys/wait.h>.
*/
-/*#define I_SYS_WAIT /**/
+/*#define I_SYS_WAIT / **/
/* I_TERMIO:
* This symbol, if defined, indicates that the program should include
* <sgtty.h> rather than <termio.h>. There are also differences in
* the ioctl() calls that depend on the value of this symbol.
*/
-/*#define I_TERMIO /**/
-/*#define I_TERMIOS /**/
-/*#define I_SGTTY /**/
+/*#define I_TERMIO / **/
+/*#define I_TERMIOS / **/
+/*#define I_SGTTY / **/
/* I_UNISTD:
* This symbol, if defined, indicates to the C program that it should
* include <unistd.h>.
*/
-/*#define I_UNISTD /**/
+/*#define I_UNISTD / **/
/* I_UTIME:
* This symbol, if defined, indicates to the C program that it should
* MAXLONG, i.e. machine dependant limitations. Probably, you
* should use <limits.h> instead, if it is available.
*/
-/*#define I_VALUES /**/
+/*#define I_VALUES / **/
/* I_VFORK:
* This symbol, if defined, indicates to the C program that it should
* include vfork.h.
*/
-/*#define I_VFORK /**/
+/*#define I_VFORK / **/
+
+/* CAN_VAPROTO:
+ * This variable is defined on systems supporting prototype declaration
+ * of functions with a variable number of arguments.
+ */
+/* _V:
+ * This macro is used to declare function parameters in prototypes for
+ * functions with a variable number of parameters. Use double parentheses.
+ * For example:
+ *
+ * int printf _V((char *fmt, ...));
+ *
+ * Remember to use the plain simple _() macro when declaring a function
+ * with no variable number of arguments, since it might be possible to
+ * have a non-effect _V() macro and still get prototypes via _().
+ */
+/*#define CAN_VAPROTO / **/
+#ifdef CAN_VAPROTO
+#define _V(args) args
+#else
+#define _V(args) ()
+#endif
/* INTSIZE:
* This symbol contains the value of sizeof(int) so that the C
* example with the NeXT "fat" binaries that contain executables
* for several CPUs.
*/
-/*#define MULTIARCH /**/
+/*#define MULTIARCH / **/
/* HAS_QUAD:
* This symbol, if defined, tells that there's a 64-bit integer type,
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
#define ARCHLIB "c:\\perl\\lib" /**/
-/*#define ARCHLIB_EXP "" /**/
+/*#define ARCHLIB_EXP "" / **/
/* ARCHNAME:
* This symbol holds a string representing the architecture name.
* This symbol, if defined, indicates that the accessx routine is
* available to do extended access checks.
*/
-/*#define HAS_ACCESSX /**/
+/*#define HAS_ACCESSX / **/
/* HAS_ASCTIME_R:
* This symbol, if defined, indicates that the asctime_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_asctime_r
* is defined.
*/
-/*#define HAS_ASCTIME_R /**/
+/*#define HAS_ASCTIME_R / **/
#define ASCTIME_R_PROTO 0 /**/
/* HASATTRIBUTE_FORMAT:
/* HASATTRIBUTE_WARN_UNUSED_RESULT:
* Can we handle GCC attribute for warning on unused results
*/
-/*#define HASATTRIBUTE_DEPRECATED /**/
-/*#define HASATTRIBUTE_FORMAT /**/
-/*#define PRINTF_FORMAT_NULL_OK /**/
-/*#define HASATTRIBUTE_NORETURN /**/
-/*#define HASATTRIBUTE_MALLOC /**/
-/*#define HASATTRIBUTE_NONNULL /**/
-/*#define HASATTRIBUTE_PURE /**/
-/*#define HASATTRIBUTE_UNUSED /**/
-/*#define HASATTRIBUTE_WARN_UNUSED_RESULT /**/
+/*#define HASATTRIBUTE_DEPRECATED / **/
+/*#define HASATTRIBUTE_FORMAT / **/
+/*#define PRINTF_FORMAT_NULL_OK / **/
+/*#define HASATTRIBUTE_NORETURN / **/
+/*#define HASATTRIBUTE_MALLOC / **/
+/*#define HASATTRIBUTE_NONNULL / **/
+/*#define HASATTRIBUTE_PURE / **/
+/*#define HASATTRIBUTE_UNUSED / **/
+/*#define HASATTRIBUTE_WARN_UNUSED_RESULT / **/
/* HASCONST:
* This symbol, if defined, indicates that this C compiler knows about
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_crypt_r
* is defined.
*/
-/*#define HAS_CRYPT_R /**/
+/*#define HAS_CRYPT_R / **/
#define CRYPT_R_PROTO 0 /**/
/* HAS_CSH:
/* CSH:
* This symbol, if defined, contains the full pathname of csh.
*/
-/*#define HAS_CSH /**/
+/*#define HAS_CSH / **/
#ifdef HAS_CSH
#define CSH "" /**/
#endif
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_ctermid_r
* is defined.
*/
-/*#define HAS_CTERMID_R /**/
+/*#define HAS_CTERMID_R / **/
#define CTERMID_R_PROTO 0 /**/
/* HAS_CTIME_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_ctime_r
* is defined.
*/
-/*#define HAS_CTIME_R /**/
+/*#define HAS_CTIME_R / **/
#define CTIME_R_PROTO 0 /**/
/* HAS_DRAND48_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_drand48_r
* is defined.
*/
-/*#define HAS_DRAND48_R /**/
+/*#define HAS_DRAND48_R / **/
#define DRAND48_R_PROTO 0 /**/
/* HAS_DRAND48_PROTO:
* to the program to supply one. A good guess is
* extern double drand48(void);
*/
-/*#define HAS_DRAND48_PROTO /**/
+/*#define HAS_DRAND48_PROTO / **/
/* HAS_EACCESS:
* This symbol, if defined, indicates that the eaccess routine is
* available to do extended access checks.
*/
-/*#define HAS_EACCESS /**/
+/*#define HAS_EACCESS / **/
/* HAS_ENDGRENT:
* This symbol, if defined, indicates that the getgrent routine is
* available for finalizing sequential access of the group database.
*/
-/*#define HAS_ENDGRENT /**/
+/*#define HAS_ENDGRENT / **/
/* HAS_ENDGRENT_R:
* This symbol, if defined, indicates that the endgrent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endgrent_r
* is defined.
*/
-/*#define HAS_ENDGRENT_R /**/
+/*#define HAS_ENDGRENT_R / **/
#define ENDGRENT_R_PROTO 0 /**/
/* HAS_ENDHOSTENT:
* This symbol, if defined, indicates that the endhostent() routine is
* available to close whatever was being used for host queries.
*/
-/*#define HAS_ENDHOSTENT /**/
+/*#define HAS_ENDHOSTENT / **/
/* HAS_ENDHOSTENT_R:
* This symbol, if defined, indicates that the endhostent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endhostent_r
* is defined.
*/
-/*#define HAS_ENDHOSTENT_R /**/
+/*#define HAS_ENDHOSTENT_R / **/
#define ENDHOSTENT_R_PROTO 0 /**/
/* HAS_ENDNETENT:
* This symbol, if defined, indicates that the endnetent() routine is
* available to close whatever was being used for network queries.
*/
-/*#define HAS_ENDNETENT /**/
+/*#define HAS_ENDNETENT / **/
/* HAS_ENDNETENT_R:
* This symbol, if defined, indicates that the endnetent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endnetent_r
* is defined.
*/
-/*#define HAS_ENDNETENT_R /**/
+/*#define HAS_ENDNETENT_R / **/
#define ENDNETENT_R_PROTO 0 /**/
/* HAS_ENDPROTOENT:
* This symbol, if defined, indicates that the endprotoent() routine is
* available to close whatever was being used for protocol queries.
*/
-/*#define HAS_ENDPROTOENT /**/
+/*#define HAS_ENDPROTOENT / **/
/* HAS_ENDPROTOENT_R:
* This symbol, if defined, indicates that the endprotoent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endprotoent_r
* is defined.
*/
-/*#define HAS_ENDPROTOENT_R /**/
+/*#define HAS_ENDPROTOENT_R / **/
#define ENDPROTOENT_R_PROTO 0 /**/
/* HAS_ENDPWENT:
* This symbol, if defined, indicates that the getgrent routine is
* available for finalizing sequential access of the passwd database.
*/
-/*#define HAS_ENDPWENT /**/
+/*#define HAS_ENDPWENT / **/
/* HAS_ENDPWENT_R:
* This symbol, if defined, indicates that the endpwent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endpwent_r
* is defined.
*/
-/*#define HAS_ENDPWENT_R /**/
+/*#define HAS_ENDPWENT_R / **/
#define ENDPWENT_R_PROTO 0 /**/
/* HAS_ENDSERVENT:
* This symbol, if defined, indicates that the endservent() routine is
* available to close whatever was being used for service queries.
*/
-/*#define HAS_ENDSERVENT /**/
+/*#define HAS_ENDSERVENT / **/
/* HAS_ENDSERVENT_R:
* This symbol, if defined, indicates that the endservent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_endservent_r
* is defined.
*/
-/*#define HAS_ENDSERVENT_R /**/
+/*#define HAS_ENDSERVENT_R / **/
#define ENDSERVENT_R_PROTO 0 /**/
/* FLEXFILENAMES:
* This symbol, if defined, indicates that the getgrent routine is
* available for sequential access of the group database.
*/
-/*#define HAS_GETGRENT /**/
+/*#define HAS_GETGRENT / **/
/* HAS_GETGRENT_R:
* This symbol, if defined, indicates that the getgrent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrent_r
* is defined.
*/
-/*#define HAS_GETGRENT_R /**/
+/*#define HAS_GETGRENT_R / **/
#define GETGRENT_R_PROTO 0 /**/
/* HAS_GETGRGID_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrgid_r
* is defined.
*/
-/*#define HAS_GETGRGID_R /**/
+/*#define HAS_GETGRGID_R / **/
#define GETGRGID_R_PROTO 0 /**/
/* HAS_GETGRNAM_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrnam_r
* is defined.
*/
-/*#define HAS_GETGRNAM_R /**/
+/*#define HAS_GETGRNAM_R / **/
#define GETGRNAM_R_PROTO 0 /**/
/* HAS_GETHOSTBYADDR:
* This symbol, if defined, indicates that the gethostent() routine is
* available to look up host names in some data base or another.
*/
-/*#define HAS_GETHOSTENT /**/
+/*#define HAS_GETHOSTENT / **/
/* HAS_GETHOSTNAME:
* This symbol, if defined, indicates that the C program may use the
*/
#define HAS_GETHOSTNAME /**/
#define HAS_UNAME /**/
-/*#define HAS_PHOSTNAME /**/
+/*#define HAS_PHOSTNAME / **/
#ifdef HAS_PHOSTNAME
#define PHOSTNAME "" /* How to get the host name */
#endif
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostbyaddr_r
* is defined.
*/
-/*#define HAS_GETHOSTBYADDR_R /**/
+/*#define HAS_GETHOSTBYADDR_R / **/
#define GETHOSTBYADDR_R_PROTO 0 /**/
/* HAS_GETHOSTBYNAME_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostbyname_r
* is defined.
*/
-/*#define HAS_GETHOSTBYNAME_R /**/
+/*#define HAS_GETHOSTBYNAME_R / **/
#define GETHOSTBYNAME_R_PROTO 0 /**/
/* HAS_GETHOSTENT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostent_r
* is defined.
*/
-/*#define HAS_GETHOSTENT_R /**/
+/*#define HAS_GETHOSTENT_R / **/
#define GETHOSTENT_R_PROTO 0 /**/
/* HAS_GETHOST_PROTOS:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getlogin_r
* is defined.
*/
-/*#define HAS_GETLOGIN_R /**/
+/*#define HAS_GETLOGIN_R / **/
#define GETLOGIN_R_PROTO 0 /**/
/* HAS_GETNETBYADDR:
* This symbol, if defined, indicates that the getnetbyaddr() routine is
* available to look up networks by their IP addresses.
*/
-/*#define HAS_GETNETBYADDR /**/
+/*#define HAS_GETNETBYADDR / **/
/* HAS_GETNETBYNAME:
* This symbol, if defined, indicates that the getnetbyname() routine is
* available to look up networks by their names.
*/
-/*#define HAS_GETNETBYNAME /**/
+/*#define HAS_GETNETBYNAME / **/
/* HAS_GETNETENT:
* This symbol, if defined, indicates that the getnetent() routine is
* available to look up network names in some data base or another.
*/
-/*#define HAS_GETNETENT /**/
+/*#define HAS_GETNETENT / **/
/* HAS_GETNETBYADDR_R:
* This symbol, if defined, indicates that the getnetbyaddr_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetbyaddr_r
* is defined.
*/
-/*#define HAS_GETNETBYADDR_R /**/
+/*#define HAS_GETNETBYADDR_R / **/
#define GETNETBYADDR_R_PROTO 0 /**/
/* HAS_GETNETBYNAME_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetbyname_r
* is defined.
*/
-/*#define HAS_GETNETBYNAME_R /**/
+/*#define HAS_GETNETBYNAME_R / **/
#define GETNETBYNAME_R_PROTO 0 /**/
/* HAS_GETNETENT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetent_r
* is defined.
*/
-/*#define HAS_GETNETENT_R /**/
+/*#define HAS_GETNETENT_R / **/
#define GETNETENT_R_PROTO 0 /**/
/* HAS_GETNET_PROTOS:
* getnetbyaddr(). Otherwise, it is up to the program to guess
* them. See netdbtype.U for probing for various Netdb_xxx_t types.
*/
-/*#define HAS_GETNET_PROTOS /**/
+/*#define HAS_GETNET_PROTOS / **/
/* HAS_GETPROTOENT:
* This symbol, if defined, indicates that the getprotoent() routine is
* available to look up protocols in some data base or another.
*/
-/*#define HAS_GETPROTOENT /**/
+/*#define HAS_GETPROTOENT / **/
/* HAS_GETPGRP:
* This symbol, if defined, indicates that the getpgrp routine is
* This symbol, if defined, indicates that getpgrp needs one
* arguments whereas USG one needs none.
*/
-/*#define HAS_GETPGRP /**/
-/*#define USE_BSD_GETPGRP /**/
+/*#define HAS_GETPGRP / **/
+/*#define USE_BSD_GETPGRP / **/
/* HAS_GETPROTOBYNAME:
* This symbol, if defined, indicates that the getprotobyname()
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotobyname_r
* is defined.
*/
-/*#define HAS_GETPROTOBYNAME_R /**/
+/*#define HAS_GETPROTOBYNAME_R / **/
#define GETPROTOBYNAME_R_PROTO 0 /**/
/* HAS_GETPROTOBYNUMBER_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotobynumber_r
* is defined.
*/
-/*#define HAS_GETPROTOBYNUMBER_R /**/
+/*#define HAS_GETPROTOBYNUMBER_R / **/
#define GETPROTOBYNUMBER_R_PROTO 0 /**/
/* HAS_GETPROTOENT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotoent_r
* is defined.
*/
-/*#define HAS_GETPROTOENT_R /**/
+/*#define HAS_GETPROTOENT_R / **/
#define GETPROTOENT_R_PROTO 0 /**/
/* HAS_GETPROTO_PROTOS:
* available for sequential access of the passwd database.
* If this is not available, the older getpw() function may be available.
*/
-/*#define HAS_GETPWENT /**/
+/*#define HAS_GETPWENT / **/
/* HAS_GETPWENT_R:
* This symbol, if defined, indicates that the getpwent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwent_r
* is defined.
*/
-/*#define HAS_GETPWENT_R /**/
+/*#define HAS_GETPWENT_R / **/
#define GETPWENT_R_PROTO 0 /**/
/* HAS_GETPWNAM_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwnam_r
* is defined.
*/
-/*#define HAS_GETPWNAM_R /**/
+/*#define HAS_GETPWNAM_R / **/
#define GETPWNAM_R_PROTO 0 /**/
/* HAS_GETPWUID_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwuid_r
* is defined.
*/
-/*#define HAS_GETPWUID_R /**/
+/*#define HAS_GETPWUID_R / **/
#define GETPWUID_R_PROTO 0 /**/
/* HAS_GETSERVENT:
* This symbol, if defined, indicates that the getservent() routine is
* available to look up network services in some data base or another.
*/
-/*#define HAS_GETSERVENT /**/
+/*#define HAS_GETSERVENT / **/
/* HAS_GETSERVBYNAME_R:
* This symbol, if defined, indicates that the getservbyname_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservbyname_r
* is defined.
*/
-/*#define HAS_GETSERVBYNAME_R /**/
+/*#define HAS_GETSERVBYNAME_R / **/
#define GETSERVBYNAME_R_PROTO 0 /**/
/* HAS_GETSERVBYPORT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservbyport_r
* is defined.
*/
-/*#define HAS_GETSERVBYPORT_R /**/
+/*#define HAS_GETSERVBYPORT_R / **/
#define GETSERVBYPORT_R_PROTO 0 /**/
/* HAS_GETSERVENT_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservent_r
* is defined.
*/
-/*#define HAS_GETSERVENT_R /**/
+/*#define HAS_GETSERVENT_R / **/
#define GETSERVENT_R_PROTO 0 /**/
/* HAS_GETSERV_PROTOS:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getspnam_r
* is defined.
*/
-/*#define HAS_GETSPNAM_R /**/
+/*#define HAS_GETSPNAM_R / **/
#define GETSPNAM_R_PROTO 0 /**/
/* HAS_GETSERVBYNAME:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_gmtime_r
* is defined.
*/
-/*#define HAS_GMTIME_R /**/
+/*#define HAS_GMTIME_R / **/
#define GMTIME_R_PROTO 0 /**/
/* HAS_HTONL:
* changes using \undef{TZ} without explicitly calling tzset
* impossible. This symbol makes us call tzset before localtime_r
*/
-/*#define LOCALTIME_R_NEEDS_TZSET /**/
+/*#define LOCALTIME_R_NEEDS_TZSET / **/
#ifdef LOCALTIME_R_NEEDS_TZSET
#define L_R_TZSET tzset(),
#else
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_localtime_r
* is defined.
*/
-/*#define HAS_LOCALTIME_R /**/
+/*#define HAS_LOCALTIME_R / **/
#define LOCALTIME_R_PROTO 0 /**/
/* HAS_LONG_DOUBLE:
* C preprocessor can make decisions based on it. It is only
* defined if the system supports long long.
*/
-/*#define HAS_LONG_LONG /**/
+/*#define HAS_LONG_LONG / **/
#ifdef HAS_LONG_LONG
#define LONGLONGSIZE 8 /**/
#endif
* available to exclusively create and open a uniquely named
* temporary file.
*/
-/*#define HAS_MKSTEMP /**/
+/*#define HAS_MKSTEMP / **/
/* HAS_MMAP:
* This symbol, if defined, indicates that the mmap system call is
* (and simultaneously the type of the first argument).
* Usually set to 'void *' or 'caddr_t'.
*/
-/*#define HAS_MMAP /**/
+/*#define HAS_MMAP / **/
#define Mmap_t void * /**/
/* HAS_MSG:
* This symbol, if defined, indicates that the entire msg*(2) library is
* supported (IPC mechanism based on message queues).
*/
-/*#define HAS_MSG /**/
+/*#define HAS_MSG / **/
/* OLD_PTHREAD_CREATE_JOINABLE:
* This symbol, if defined, indicates how to create pthread
* If defined, known values are PTHREAD_CREATE_UNDETACHED
* and __UNDETACHED.
*/
-/*#define OLD_PTHREAD_CREATE_JOINABLE /**/
+/*#define OLD_PTHREAD_CREATE_JOINABLE / **/
/* HAS_PTHREAD_ATFORK:
* This symbol, if defined, indicates that the pthread_atfork routine
* is available to setup fork handlers.
*/
-/*#define HAS_PTHREAD_ATFORK /**/
+/*#define HAS_PTHREAD_ATFORK / **/
/* HAS_PTHREAD_YIELD:
* This symbol, if defined, indicates that the pthread_yield
* routine is available to yield the execution of the current
* thread. sched_yield is preferable to pthread_yield.
*/
-/*#define HAS_PTHREAD_YIELD /**/
+/*#define HAS_PTHREAD_YIELD / **/
#define SCHED_YIELD /**/
-/*#define HAS_SCHED_YIELD /**/
+/*#define HAS_SCHED_YIELD / **/
/* HAS_RANDOM_R:
* This symbol, if defined, indicates that the random_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_random_r
* is defined.
*/
-/*#define HAS_RANDOM_R /**/
+/*#define HAS_RANDOM_R / **/
#define RANDOM_R_PROTO 0 /**/
/* HAS_READDIR64_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_readdir64_r
* is defined.
*/
-/*#define HAS_READDIR64_R /**/
+/*#define HAS_READDIR64_R / **/
#define READDIR64_R_PROTO 0 /**/
/* HAS_READDIR_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_readdir_r
* is defined.
*/
-/*#define HAS_READDIR_R /**/
+/*#define HAS_READDIR_R / **/
#define READDIR_R_PROTO 0 /**/
/* HAS_SEM:
* This symbol, if defined, indicates that the entire sem*(2) library is
* supported.
*/
-/*#define HAS_SEM /**/
+/*#define HAS_SEM / **/
/* HAS_SETGRENT:
* This symbol, if defined, indicates that the setgrent routine is
* available for initializing sequential access of the group database.
*/
-/*#define HAS_SETGRENT /**/
+/*#define HAS_SETGRENT / **/
/* HAS_SETGRENT_R:
* This symbol, if defined, indicates that the setgrent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setgrent_r
* is defined.
*/
-/*#define HAS_SETGRENT_R /**/
+/*#define HAS_SETGRENT_R / **/
#define SETGRENT_R_PROTO 0 /**/
/* HAS_SETHOSTENT:
* This symbol, if defined, indicates that the sethostent() routine is
* available.
*/
-/*#define HAS_SETHOSTENT /**/
+/*#define HAS_SETHOSTENT / **/
/* HAS_SETHOSTENT_R:
* This symbol, if defined, indicates that the sethostent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_sethostent_r
* is defined.
*/
-/*#define HAS_SETHOSTENT_R /**/
+/*#define HAS_SETHOSTENT_R / **/
#define SETHOSTENT_R_PROTO 0 /**/
/* HAS_SETLOCALE_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setlocale_r
* is defined.
*/
-/*#define HAS_SETLOCALE_R /**/
+/*#define HAS_SETLOCALE_R / **/
#define SETLOCALE_R_PROTO 0 /**/
/* HAS_SETNETENT:
* This symbol, if defined, indicates that the setnetent() routine is
* available.
*/
-/*#define HAS_SETNETENT /**/
+/*#define HAS_SETNETENT / **/
/* HAS_SETNETENT_R:
* This symbol, if defined, indicates that the setnetent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setnetent_r
* is defined.
*/
-/*#define HAS_SETNETENT_R /**/
+/*#define HAS_SETNETENT_R / **/
#define SETNETENT_R_PROTO 0 /**/
/* HAS_SETPROTOENT:
* This symbol, if defined, indicates that the setprotoent() routine is
* available.
*/
-/*#define HAS_SETPROTOENT /**/
+/*#define HAS_SETPROTOENT / **/
/* HAS_SETPGRP:
* This symbol, if defined, indicates that the setpgrp routine is
* arguments whereas USG one needs none. See also HAS_SETPGID
* for a POSIX interface.
*/
-/*#define HAS_SETPGRP /**/
-/*#define USE_BSD_SETPGRP /**/
+/*#define HAS_SETPGRP / **/
+/*#define USE_BSD_SETPGRP / **/
/* HAS_SETPROTOENT_R:
* This symbol, if defined, indicates that the setprotoent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setprotoent_r
* is defined.
*/
-/*#define HAS_SETPROTOENT_R /**/
+/*#define HAS_SETPROTOENT_R / **/
#define SETPROTOENT_R_PROTO 0 /**/
/* HAS_SETPWENT:
* This symbol, if defined, indicates that the setpwent routine is
* available for initializing sequential access of the passwd database.
*/
-/*#define HAS_SETPWENT /**/
+/*#define HAS_SETPWENT / **/
/* HAS_SETPWENT_R:
* This symbol, if defined, indicates that the setpwent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setpwent_r
* is defined.
*/
-/*#define HAS_SETPWENT_R /**/
+/*#define HAS_SETPWENT_R / **/
#define SETPWENT_R_PROTO 0 /**/
/* HAS_SETSERVENT:
* This symbol, if defined, indicates that the setservent() routine is
* available.
*/
-/*#define HAS_SETSERVENT /**/
+/*#define HAS_SETSERVENT / **/
/* HAS_SETSERVENT_R:
* This symbol, if defined, indicates that the setservent_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setservent_r
* is defined.
*/
-/*#define HAS_SETSERVENT_R /**/
+/*#define HAS_SETSERVENT_R / **/
#define SETSERVENT_R_PROTO 0 /**/
/* HAS_SETVBUF:
* This symbol, if defined, indicates that the entire shm*(2) library is
* supported.
*/
-/*#define HAS_SHM /**/
+/*#define HAS_SHM / **/
/* Shmat_t:
* This symbol holds the return type of the shmat() system call.
* when HAS_SHMAT_PROTOTYPE is not defined to avoid conflicting defs.
*/
#define Shmat_t void * /**/
-/*#define HAS_SHMAT_PROTOTYPE /**/
+/*#define HAS_SHMAT_PROTOTYPE / **/
/* HAS_SOCKET:
* This symbol, if defined, indicates that the BSD socket interface is
* has been known to be an enum.
*/
#define HAS_SOCKET /**/
-/*#define HAS_SOCKETPAIR /**/
-/*#define HAS_MSG_CTRUNC /**/
-/*#define HAS_MSG_DONTROUTE /**/
-/*#define HAS_MSG_OOB /**/
-/*#define HAS_MSG_PEEK /**/
-/*#define HAS_MSG_PROXY /**/
-/*#define HAS_SCM_RIGHTS /**/
+/*#define HAS_SOCKETPAIR / **/
+/*#define HAS_MSG_CTRUNC / **/
+/*#define HAS_MSG_DONTROUTE / **/
+/*#define HAS_MSG_OOB / **/
+/*#define HAS_MSG_PEEK / **/
+/*#define HAS_MSG_PROXY / **/
+/*#define HAS_SCM_RIGHTS / **/
/* HAS_SRAND48_R:
* This symbol, if defined, indicates that the srand48_r routine
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_srand48_r
* is defined.
*/
-/*#define HAS_SRAND48_R /**/
+/*#define HAS_SRAND48_R / **/
#define SRAND48_R_PROTO 0 /**/
/* HAS_SRANDOM_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_srandom_r
* is defined.
*/
-/*#define HAS_SRANDOM_R /**/
+/*#define HAS_SRANDOM_R / **/
#define SRANDOM_R_PROTO 0 /**/
/* USE_STAT_BLOCKS:
* st_blksize and st_blocks.
*/
#ifndef USE_STAT_BLOCKS
-/*#define USE_STAT_BLOCKS /**/
+/*#define USE_STAT_BLOCKS / **/
#endif
/* USE_STRUCT_COPY:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_strerror_r
* is defined.
*/
-/*#define HAS_STRERROR_R /**/
+/*#define HAS_STRERROR_R / **/
#define STRERROR_R_PROTO 0 /**/
/* HAS_STRTOUL:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_tmpnam_r
* is defined.
*/
-/*#define HAS_TMPNAM_R /**/
+/*#define HAS_TMPNAM_R / **/
#define TMPNAM_R_PROTO 0 /**/
/* HAS_TTYNAME_R:
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_ttyname_r
* is defined.
*/
-/*#define HAS_TTYNAME_R /**/
+/*#define HAS_TTYNAME_R / **/
#define TTYNAME_R_PROTO 0 /**/
/* HAS_UNION_SEMUN:
* used for semctl IPC_STAT.
*/
#define HAS_UNION_SEMUN /**/
-/*#define USE_SEMCTL_SEMUN /**/
-/*#define USE_SEMCTL_SEMID_DS /**/
+/*#define USE_SEMCTL_SEMUN / **/
+/*#define USE_SEMCTL_SEMID_DS / **/
/* HAS_VFORK:
* This symbol, if defined, indicates that vfork() exists.
*/
-/*#define HAS_VFORK /**/
+/*#define HAS_VFORK / **/
/* HAS_PSEUDOFORK:
* This symbol, if defined, indicates that an emulation of the
* fork routine is available.
*/
-/*#define HAS_PSEUDOFORK /**/
+/*#define HAS_PSEUDOFORK / **/
/* Signal_t:
* This symbol's value is either "void" or "int", corresponding to the
* This symbol, if defined, indicates to the C program that struct group
* in <grp.h> contains gr_passwd.
*/
-/*#define I_GRP /**/
-/*#define GRPASSWD /**/
+/*#define I_GRP / **/
+/*#define GRPASSWD / **/
/* I_MACH_CTHREADS:
* This symbol, if defined, indicates to the C program that it should
* include <mach/cthreads.h>.
*/
-/*#define I_MACH_CTHREADS /**/
+/*#define I_MACH_CTHREADS / **/
/* I_NDBM:
* This symbol, if defined, indicates that <ndbm.h> exists and should
* parameter information. While ANSI C prototypes are supported in C++,
* K&R style function declarations will yield errors.
*/
-/*#define I_NDBM /**/
-/*#define I_GDBMNDBM /**/
-/*#define I_GDBM_NDBM /**/
-/*#define NDBM_H_USES_PROTOTYPES /**/
-/*#define GDBMNDBM_H_USES_PROTOTYPES /**/
-/*#define GDBM_NDBM_H_USES_PROTOTYPES /**/
+/*#define I_NDBM / **/
+/*#define I_GDBMNDBM / **/
+/*#define I_GDBM_NDBM / **/
+/*#define NDBM_H_USES_PROTOTYPES / **/
+/*#define GDBMNDBM_H_USES_PROTOTYPES / **/
+/*#define GDBM_NDBM_H_USES_PROTOTYPES / **/
/* I_NETDB:
* This symbol, if defined, indicates that <netdb.h> exists and
* should be included.
*/
-/*#define I_NETDB /**/
+/*#define I_NETDB / **/
/* I_NET_ERRNO:
* This symbol, if defined, indicates that <net/errno.h> exists and
* should be included.
*/
-/*#define I_NET_ERRNO /**/
+/*#define I_NET_ERRNO / **/
/* I_PTHREAD:
* This symbol, if defined, indicates to the C program that it should
* include <pthread.h>.
*/
-/*#define I_PTHREAD /**/
+/*#define I_PTHREAD / **/
/* I_PWD:
* This symbol, if defined, indicates to the C program that it should
* This symbol, if defined, indicates to the C program that struct passwd
* contains pw_passwd.
*/
-/*#define I_PWD /**/
-/*#define PWQUOTA /**/
-/*#define PWAGE /**/
-/*#define PWCHANGE /**/
-/*#define PWCLASS /**/
-/*#define PWEXPIRE /**/
-/*#define PWCOMMENT /**/
-/*#define PWGECOS /**/
-/*#define PWPASSWD /**/
+/*#define I_PWD / **/
+/*#define PWQUOTA / **/
+/*#define PWAGE / **/
+/*#define PWCHANGE / **/
+/*#define PWCLASS / **/
+/*#define PWEXPIRE / **/
+/*#define PWCOMMENT / **/
+/*#define PWGECOS / **/
+/*#define PWPASSWD / **/
/* I_SYS_ACCESS:
* This symbol, if defined, indicates to the C program that it should
* include <sys/access.h>.
*/
-/*#define I_SYS_ACCESS /**/
+/*#define I_SYS_ACCESS / **/
/* I_SYS_SECURITY:
* This symbol, if defined, indicates to the C program that it should
* include <sys/security.h>.
*/
-/*#define I_SYS_SECURITY /**/
+/*#define I_SYS_SECURITY / **/
/* I_SYSUIO:
* This symbol, if defined, indicates that <sys/uio.h> exists and
* should be included.
*/
-/*#define I_SYSUIO /**/
+/*#define I_SYSUIO / **/
/* I_STDARG:
* This symbol, if defined, indicates that <stdarg.h> exists and should
* include <varargs.h>.
*/
#define I_STDARG /**/
-/*#define I_VARARGS /**/
+/*#define I_VARARGS / **/
/* PERL_INC_VERSION_LIST:
* This variable specifies the list of subdirectories in over
* for a C initialization string. See the inc_version_list entry
* in Porting/Glossary for more details.
*/
-/*#define PERL_INC_VERSION_LIST 0 /**/
+/*#define PERL_INC_VERSION_LIST 0 / **/
/* INSTALL_USR_BIN_PERL:
* This symbol, if defined, indicates that Perl is to be installed
* also as /usr/bin/perl.
*/
-/*#define INSTALL_USR_BIN_PERL /**/
+/*#define INSTALL_USR_BIN_PERL / **/
/* Off_t:
* This symbol holds the type used to declare offsets in the kernel.
/* MYMALLOC:
* This symbol, if defined, indicates that we're using our own malloc.
*/
-/*#define MYMALLOC /**/
+/*#define MYMALLOC / **/
/* Mode_t:
* This symbol holds the type used to declare file modes
* and architecture-specific directories. See PERL_INC_VERSION_LIST
* for more details.
*/
-/*#define PERL_OTHERLIBDIRS "" /**/
+/*#define PERL_OTHERLIBDIRS "" / **/
/* Pid_t:
* This symbol holds the type used to declare process ids in the kernel.
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
#define SITEARCH "c:\\perl\\site\\lib" /**/
-/*#define SITEARCH_EXP "" /**/
+/*#define SITEARCH_EXP "" / **/
/* SITELIB:
* This symbol contains the name of the private library for this package.
* try to use the various _r versions of library functions.
* This is extremely experimental.
*/
-/*#define USE_5005THREADS /**/
-/*#define USE_ITHREADS /**/
+/*#define USE_5005THREADS / **/
+/*#define USE_ITHREADS / **/
#if defined(USE_5005THREADS) && !defined(USE_ITHREADS)
#define USE_THREADS /* until src is revised*/
#endif
-/*#define OLD_PTHREADS_API /**/
-/*#define USE_REENTRANT_API /**/
+/*#define OLD_PTHREADS_API / **/
+/*#define USE_REENTRANT_API / **/
/* PERL_VENDORARCH:
* If defined, this symbol contains the name of a private library.
* This symbol contains the ~name expanded version of PERL_VENDORARCH, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-/*#define PERL_VENDORARCH "" /**/
-/*#define PERL_VENDORARCH_EXP "" /**/
+/*#define PERL_VENDORARCH "" / **/
+/*#define PERL_VENDORARCH_EXP "" / **/
/* PERL_VENDORLIB_EXP:
* This symbol contains the ~name expanded version of VENDORLIB, to be used
* removed. The elements in inc_version_list (inc_version_list.U) can
* be tacked onto this variable to generate a list of directories to search.
*/
-/*#define PERL_VENDORLIB_EXP "" /**/
-/*#define PERL_VENDORLIB_STEM "" /**/
+/*#define PERL_VENDORLIB_EXP "" / **/
+/*#define PERL_VENDORLIB_STEM "" / **/
/* VOIDFLAGS:
* This symbol indicates how much support of the void type is given by this
* Perl has been cross-compiled to. Undefined if not a cross-compile.
*/
#ifndef USE_CROSS_COMPILE
-/*#define USE_CROSS_COMPILE /**/
+/*#define USE_CROSS_COMPILE / **/
#define PERL_TARGETARCH "" /**/
#endif
#define BYTEORDER 0x1234 /* large digits for MSB */
#endif /* NeXT */
+/* CHARBITS:
+ * This symbol contains the size of a char, so that the C preprocessor
+ * can make decisions based on it.
+ */
+#define CHARBITS 8 /**/
+
/* CASTI32:
* This symbol is defined if the C compiler can cast negative
* or large floating point numbers to 32-bit ints.
*/
-/*#define CASTI32 /**/
+/*#define CASTI32 / **/
/* CASTNEGFLOAT:
* This symbol is defined if the C compiler can cast negative
* This symbol, if defined, indicates that the closedir() routine
* does not return a value.
*/
-/*#define VOID_CLOSEDIR /**/
+/*#define VOID_CLOSEDIR / **/
/* HAS_FD_SET:
* This symbol, when defined, indicates presence of the fd_set typedef
* is available to get system page size, which is the granularity of
* many memory management calls.
*/
-/*#define HAS_GETPAGESIZE /**/
+/*#define HAS_GETPAGESIZE / **/
/* HAS_GNULIBC:
* This symbol, if defined, indicates to the C program that
* the GNU C library is being used. A better check is to use
* the __GLIBC__ and __GLIBC_MINOR__ symbols supplied with glibc.
*/
-/*#define HAS_GNULIBC /**/
+/*#define HAS_GNULIBC / **/
#if defined(HAS_GNULIBC) && !defined(_GNU_SOURCE)
# define _GNU_SOURCE
#endif
* available to operate on a symbolic link (instead of following the
* link).
*/
-/*#define HAS_LCHOWN /**/
+/*#define HAS_LCHOWN / **/
/* HAS_OPEN3:
* This manifest constant lets the C program know that the three
* argument form of open(2) is available.
*/
-/*#define HAS_OPEN3 /**/
+/*#define HAS_OPEN3 / **/
/* HAS_SAFE_BCOPY:
* This symbol, if defined, indicates that the bcopy routine is available
* probably use memmove() or memcpy(). If neither is defined, roll your
* own version.
*/
-/*#define HAS_SAFE_BCOPY /**/
+/*#define HAS_SAFE_BCOPY / **/
/* HAS_SAFE_MEMCPY:
* This symbol, if defined, indicates that the memcpy routine is available
* copy overlapping memory blocks, you should check HAS_MEMMOVE and
* use memmove() instead, if available.
*/
-/*#define HAS_SAFE_MEMCPY /**/
+/*#define HAS_SAFE_MEMCPY / **/
/* HAS_SANE_MEMCMP:
* This symbol, if defined, indicates that the memcmp routine is available
* This symbol, if defined, indicates that Vr4's sigaction() routine
* is available.
*/
-/*#define HAS_SIGACTION /**/
+/*#define HAS_SIGACTION / **/
/* HAS_SIGSETJMP:
* This variable indicates to the C program that the sigsetjmp()
* traditional longjmp() if siglongjmp isn't available.
* See HAS_SIGSETJMP.
*/
-/*#define HAS_SIGSETJMP /**/
+/*#define HAS_SIGSETJMP / **/
#ifdef HAS_SIGSETJMP
#define Sigjmp_buf sigjmp_buf
#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask))
#define STDIO_PTR_LVALUE /**/
#define FILE_cnt(fp) ((fp)->_cnt)
#define STDIO_CNT_LVALUE /**/
-/*#define STDIO_PTR_LVAL_SETS_CNT /**/
+/*#define STDIO_PTR_LVAL_SETS_CNT / **/
#define STDIO_PTR_LVAL_NOCHANGE_CNT /**/
#endif
* symbol.
*/
#define HAS_VPRINTF /**/
-/*#define USE_CHAR_VSPRINTF /**/
+/*#define USE_CHAR_VSPRINTF / **/
/* DOUBLESIZE:
* This symbol contains the size of a double, so that the C preprocessor
* the struct tm has a tm_gmtoff field.
*/
#define I_TIME /**/
-/*#define I_SYS_TIME /**/
-/*#define I_SYS_TIME_KERNEL /**/
-/*#define HAS_TM_TM_ZONE /**/
-/*#define HAS_TM_TM_GMTOFF /**/
+/*#define I_SYS_TIME / **/
+/*#define I_SYS_TIME_KERNEL / **/
+/*#define HAS_TM_TM_ZONE / **/
+/*#define HAS_TM_TM_GMTOFF / **/
/* VAL_O_NONBLOCK:
* This symbol is to be used during open() or fcntl(F_SETFL) to turn on
* This symbol, if defined, indicates that this system uses
* EBCDIC encoding.
*/
-/*#define EBCDIC /**/
+/*#define EBCDIC / **/
+
+/* SETUID_SCRIPTS_ARE_SECURE_NOW:
+ * This symbol, if defined, indicates that the bug that prevents
+ * setuid scripts from being secure is not present in this kernel.
+ */
+/* DOSUID:
+ * This symbol, if defined, indicates that the C program should
+ * check the script that it is executing for setuid/setgid bits, and
+ * attempt to emulate setuid/setgid on systems that have disabled
+ * setuid #! scripts because the kernel can't do it securely.
+ * It is up to the package designer to make sure that this emulation
+ * is done securely. Among other things, it should do an fstat on
+ * the script it just opened to make sure it really is a setuid/setgid
+ * script, it should make sure the arguments passed correspond exactly
+ * to the argument on the #! line, and it should not trust any
+ * subprocesses to which it must pass the filename rather than the
+ * file descriptor of the script to be executed.
+ */
+/*#define SETUID_SCRIPTS_ARE_SECURE_NOW / **/
+/*#define DOSUID / **/
/* PERL_USE_DEVEL:
* This symbol, if defined, indicates that Perl was configured with
* -Dusedevel, to enable development features. This should not be
* done for production builds.
*/
-/*#define PERL_USE_DEVEL /**/
+/*#define PERL_USE_DEVEL / **/
/* HAS_ATOLF:
* This symbol, if defined, indicates that the atolf routine is
* available to convert strings into long doubles.
*/
-/*#define HAS_ATOLF /**/
+/*#define HAS_ATOLF / **/
/* HAS_ATOLL:
* This symbol, if defined, indicates that the atoll routine is
* This symbol, if defined, indicates that the _fwalk system call is
* available to apply a function to all the file handles.
*/
-/*#define HAS__FWALK /**/
+/*#define HAS__FWALK / **/
/* HAS_AINTL:
* This symbol, if defined, indicates that the aintl routine is
* available. If copysignl is also present we can emulate modfl.
*/
-/*#define HAS_AINTL /**/
+/*#define HAS_AINTL / **/
/* HAS_BUILTIN_CHOOSE_EXPR:
* Can we handle GCC builtin for compile-time ternary-like expressions
* Can we handle GCC builtin for telling that certain values are more
* likely
*/
-/*#define HAS_BUILTIN_EXPECT /**/
-/*#define HAS_BUILTIN_CHOOSE_EXPR /**/
+/*#define HAS_BUILTIN_EXPECT / **/
+/*#define HAS_BUILTIN_CHOOSE_EXPR / **/
/* HAS_C99_VARIADIC_MACROS:
* If defined, the compiler supports C99 variadic macros.
*/
-/*#define HAS_C99_VARIADIC_MACROS /**/
+/*#define HAS_C99_VARIADIC_MACROS / **/
/* HAS_CLASS:
* This symbol, if defined, indicates that the class routine is
* FP_NANS Signaling Not a Number (NaNS)
* FP_NANQ Quiet Not a Number (NaNQ)
*/
-/*#define HAS_CLASS /**/
+/*#define HAS_CLASS / **/
/* HAS_CLEARENV:
* This symbol, if defined, indicates that the clearenv () routine is
* available for use.
*/
-/*#define HAS_CLEARENV /**/
+/*#define HAS_CLEARENV / **/
/* HAS_STRUCT_CMSGHDR:
* This symbol, if defined, indicates that the struct cmsghdr
* is supported.
*/
-/*#define HAS_STRUCT_CMSGHDR /**/
+/*#define HAS_STRUCT_CMSGHDR / **/
/* HAS_COPYSIGNL:
* This symbol, if defined, indicates that the copysignl routine is
* available. If aintl is also present we can emulate modfl.
*/
-/*#define HAS_COPYSIGNL /**/
+/*#define HAS_COPYSIGNL / **/
/* USE_CPLUSPLUS:
* This symbol, if defined, indicates that a C++ compiler was
* used to compiled Perl and will be used to compile extensions.
*/
-/*#define USE_CPLUSPLUS /**/
+/*#define USE_CPLUSPLUS / **/
/* HAS_DBMINIT_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. A good guess is
* extern int dbminit(char *);
*/
-/*#define HAS_DBMINIT_PROTO /**/
+/*#define HAS_DBMINIT_PROTO / **/
/* HAS_DIR_DD_FD:
* This symbol, if defined, indicates that the the DIR* dirstream
* structure contains a member variable named dd_fd.
*/
-/*#define HAS_DIR_DD_FD /**/
+/*#define HAS_DIR_DD_FD / **/
/* HAS_DIRFD:
* This manifest constant lets the C program know that dirfd
* is available.
*/
-/*#define HAS_DIRFD /**/
+/*#define HAS_DIRFD / **/
/* DLSYM_NEEDS_UNDERSCORE:
* This symbol, if defined, indicates that we need to prepend an
* makes sense if you *have* dlsym, which we will presume is the
* case if you're using dl_dlopen.xs.
*/
-/*#define DLSYM_NEEDS_UNDERSCORE /**/
+/*#define DLSYM_NEEDS_UNDERSCORE / **/
/* HAS_FAST_STDIO:
* This symbol, if defined, indicates that the "fast stdio"
* This symbol, if defined, indicates that the fchdir routine is
* available to change directory using a file descriptor.
*/
-/*#define HAS_FCHDIR /**/
+/*#define HAS_FCHDIR / **/
/* FCNTL_CAN_LOCK:
* This symbol, if defined, indicates that fcntl() can be used
* for file locking. Normally on Unix systems this is defined.
* It may be undefined on VMS.
*/
-/*#define FCNTL_CAN_LOCK /**/
+/*#define FCNTL_CAN_LOCK / **/
/* HAS_FINITE:
* This symbol, if defined, indicates that the finite routine is
* available to check whether a double is finite (non-infinity non-NaN).
*/
-/*#define HAS_FINITE /**/
+/*#define HAS_FINITE / **/
/* HAS_FINITEL:
* This symbol, if defined, indicates that the finitel routine is
* available to check whether a long double is finite
* (non-infinity non-NaN).
*/
-/*#define HAS_FINITEL /**/
+/*#define HAS_FINITEL / **/
/* HAS_FLOCK_PROTO:
* This symbol, if defined, indicates that the system provides
* FP_POS_ZERO +0.0 (positive zero)
* FP_NEG_ZERO -0.0 (negative zero)
*/
-/*#define HAS_FP_CLASS /**/
+/*#define HAS_FP_CLASS / **/
/* HAS_FPCLASS:
* This symbol, if defined, indicates that the fpclass routine is
* FP_NNORM negative normalized non-zero
* FP_PNORM positive normalized non-zero
*/
-/*#define HAS_FPCLASS /**/
+/*#define HAS_FPCLASS / **/
/* HAS_FPCLASSIFY:
* This symbol, if defined, indicates that the fpclassify routine is
* FP_NAN NaN
*
*/
-/*#define HAS_FPCLASSIFY /**/
+/*#define HAS_FPCLASSIFY / **/
/* HAS_FPCLASSL:
* This symbol, if defined, indicates that the fpclassl routine is
* FP_NNORM negative normalized non-zero
* FP_PNORM positive normalized non-zero
*/
-/*#define HAS_FPCLASSL /**/
+/*#define HAS_FPCLASSL / **/
/* HAS_FPOS64_T:
* This symbol will be defined if the C compiler supports fpos64_t.
*/
-/*#define HAS_FPOS64_T /**/
+/*#define HAS_FPOS64_T / **/
/* HAS_FREXPL:
* This symbol, if defined, indicates that the frexpl routine is
* available to break a long double floating-point number into
* a normalized fraction and an integral power of 2.
*/
-/*#define HAS_FREXPL /**/
+/*#define HAS_FREXPL / **/
/* HAS_STRUCT_FS_DATA:
* This symbol, if defined, indicates that the struct fs_data
* to do statfs() is supported.
*/
-/*#define HAS_STRUCT_FS_DATA /**/
+/*#define HAS_STRUCT_FS_DATA / **/
/* HAS_FSEEKO:
* This symbol, if defined, indicates that the fseeko routine is
* available to fseek beyond 32 bits (useful for ILP32 hosts).
*/
-/*#define HAS_FSEEKO /**/
+/*#define HAS_FSEEKO / **/
/* HAS_FSTATFS:
* This symbol, if defined, indicates that the fstatfs routine is
* available to stat filesystems by file descriptors.
*/
-/*#define HAS_FSTATFS /**/
+/*#define HAS_FSTATFS / **/
/* HAS_FSYNC:
* This symbol, if defined, indicates that the fsync routine is
* available to write a file's modified data and attributes to
* permanent storage.
*/
-/*#define HAS_FSYNC /**/
+/*#define HAS_FSYNC / **/
/* HAS_FTELLO:
* This symbol, if defined, indicates that the ftello routine is
* available to ftell beyond 32 bits (useful for ILP32 hosts).
*/
-/*#define HAS_FTELLO /**/
+/*#define HAS_FTELLO / **/
/* HAS_FUTIMES:
* This symbol, if defined, indicates that the futimes routine is
* available to change file descriptor time stamps with struct timevals.
*/
-/*#define HAS_FUTIMES /**/
+/*#define HAS_FUTIMES / **/
+
+/* HAS_GETADDRINFO:
+ * This symbol, if defined, indicates that the getaddrinfo() function
+ * is available for use.
+ */
+/*#define HAS_GETADDRINFO / **/
/* HAS_GETCWD:
* This symbol, if defined, indicates that the getcwd routine is
* This symbol, if defined, indicates that the getespwnam system call is
* available to retrieve enchanced (shadow) password entries by name.
*/
-/*#define HAS_GETESPWNAM /**/
+/*#define HAS_GETESPWNAM / **/
/* HAS_GETFSSTAT:
* This symbol, if defined, indicates that the getfsstat routine is
* available to stat filesystems in bulk.
*/
-/*#define HAS_GETFSSTAT /**/
+/*#define HAS_GETFSSTAT / **/
/* HAS_GETITIMER:
* This symbol, if defined, indicates that the getitimer routine is
* available to return interval timers.
*/
-/*#define HAS_GETITIMER /**/
+/*#define HAS_GETITIMER / **/
/* HAS_GETMNT:
* This symbol, if defined, indicates that the getmnt routine is
* available to get filesystem mount info by filename.
*/
-/*#define HAS_GETMNT /**/
+/*#define HAS_GETMNT / **/
/* HAS_GETMNTENT:
* This symbol, if defined, indicates that the getmntent routine is
* available to iterate through mounted file systems to get their info.
*/
-/*#define HAS_GETMNTENT /**/
+/*#define HAS_GETMNTENT / **/
+
+/* HAS_GETNAMEINFO:
+ * This symbol, if defined, indicates that the getnameinfo() function
+ * is available for use.
+ */
+/*#define HAS_GETNAMEINFO / **/
/* HAS_GETPRPWNAM:
* This symbol, if defined, indicates that the getprpwnam system call is
* available to retrieve protected (shadow) password entries by name.
*/
-/*#define HAS_GETPRPWNAM /**/
+/*#define HAS_GETPRPWNAM / **/
/* HAS_GETSPNAM:
* This symbol, if defined, indicates that the getspnam system call is
* available to retrieve SysV shadow password entries by name.
*/
-/*#define HAS_GETSPNAM /**/
+/*#define HAS_GETSPNAM / **/
/* HAS_HASMNTOPT:
* This symbol, if defined, indicates that the hasmntopt routine is
* available to query the mount options of file systems.
*/
-/*#define HAS_HASMNTOPT /**/
+/*#define HAS_HASMNTOPT / **/
/* HAS_ILOGBL:
* This symbol, if defined, indicates that the ilogbl routine is
* available. If scalbnl is also present we can emulate frexpl.
*/
-/*#define HAS_ILOGBL /**/
+/*#define HAS_ILOGBL / **/
+
+/* HAS_INETNTOP:
+ * This symbol, if defined, indicates that the inet_ntop() function
+ * is available to parse IPv4 and IPv6 strings.
+ */
+/*#define HAS_INETNTOP / **/
+
+/* HAS_INETPTON:
+ * This symbol, if defined, indicates that the inet_pton() function
+ * is available to parse IPv4 and IPv6 strings.
+ */
+/*#define HAS_INETPTON / **/
/* HAS_INT64_T:
* This symbol will defined if the C compiler supports int64_t.
* Usually the <inttypes.h> needs to be included, but sometimes
* <sys/types.h> is enough.
*/
-/*#define HAS_INT64_T /**/
+/*#define HAS_INT64_T / **/
/* HAS_ISFINITE:
* This symbol, if defined, indicates that the isfinite routine is
* available to check whether a double is finite (non-infinity non-NaN).
*/
-/*#define HAS_ISFINITE /**/
+/*#define HAS_ISFINITE / **/
/* HAS_ISINF:
* This symbol, if defined, indicates that the isinf routine is
* available to check whether a double is an infinity.
*/
-/*#define HAS_ISINF /**/
+/*#define HAS_ISINF / **/
/* HAS_ISNAN:
* This symbol, if defined, indicates that the isnan routine is
* This symbol, if defined, indicates that the isnanl routine is
* available to check whether a long double is a NaN.
*/
-/*#define HAS_ISNANL /**/
+/*#define HAS_ISNANL / **/
/* HAS_LDBL_DIG:
* This symbol, if defined, indicates that this system's <float.h>
* This symbol, if defined, indicates that libm exports _LIB_VERSION
* and that math.h defines the enum to manipulate it.
*/
-/*#define LIBM_LIB_VERSION /**/
+/*#define LIBM_LIB_VERSION / **/
/* HAS_MADVISE:
* This symbol, if defined, indicates that the madvise system call is
* available to map a file into memory.
*/
-/*#define HAS_MADVISE /**/
+/*#define HAS_MADVISE / **/
/* HAS_MALLOC_SIZE:
* This symbol, if defined, indicates that the malloc_size
* routine is available for use.
*/
-/*#define HAS_MALLOC_SIZE /**/
+/*#define HAS_MALLOC_SIZE / **/
/* HAS_MALLOC_GOOD_SIZE:
* This symbol, if defined, indicates that the malloc_good_size
* routine is available for use.
*/
-/*#define HAS_MALLOC_GOOD_SIZE /**/
+/*#define HAS_MALLOC_GOOD_SIZE / **/
/* HAS_MKDTEMP:
* This symbol, if defined, indicates that the mkdtemp routine is
* available to exclusively create a uniquely named temporary directory.
*/
-/*#define HAS_MKDTEMP /**/
+/*#define HAS_MKDTEMP / **/
/* HAS_MKSTEMPS:
* This symbol, if defined, indicates that the mkstemps routine is
* available to excluslvely create and open a uniquely named
* (with a suffix) temporary file.
*/
-/*#define HAS_MKSTEMPS /**/
+/*#define HAS_MKSTEMPS / **/
/* HAS_MODFL:
* This symbol, if defined, indicates that the modfl routine is
* and 1.150000. The bug has been seen in certain versions of glibc,
* release 2.2.2 is known to be okay.
*/
-/*#define HAS_MODFL /**/
-/*#define HAS_MODFL_PROTO /**/
-/*#define HAS_MODFL_POW32_BUG /**/
+/*#define HAS_MODFL / **/
+/*#define HAS_MODFL_PROTO / **/
+/*#define HAS_MODFL_POW32_BUG / **/
/* HAS_MPROTECT:
* This symbol, if defined, indicates that the mprotect system call is
* available to modify the access protection of a memory mapped file.
*/
-/*#define HAS_MPROTECT /**/
+/*#define HAS_MPROTECT / **/
/* HAS_STRUCT_MSGHDR:
* This symbol, if defined, indicates that the struct msghdr
* is supported.
*/
-/*#define HAS_STRUCT_MSGHDR /**/
+/*#define HAS_STRUCT_MSGHDR / **/
/* HAS_NL_LANGINFO:
* This symbol, if defined, indicates that the nl_langinfo routine is
* available to return local data. You will also need <langinfo.h>
* and therefore I_LANGINFO.
*/
-/*#define HAS_NL_LANGINFO /**/
+/*#define HAS_NL_LANGINFO / **/
/* HAS_OFF64_T:
* This symbol will be defined if the C compiler supports off64_t.
*/
-/*#define HAS_OFF64_T /**/
+/*#define HAS_OFF64_T / **/
/* HAS_PROCSELFEXE:
* This symbol is defined if PROCSELFEXE_PATH is a symlink
* of the symbolic link pointing to the absolute pathname of
* the executing program.
*/
-/*#define HAS_PROCSELFEXE /**/
+/*#define HAS_PROCSELFEXE / **/
#if defined(HAS_PROCSELFEXE) && !defined(PROCSELFEXE_PATH)
#define PROCSELFEXE_PATH /**/
#endif
* system call is available to set the contention scope attribute of
* a thread attribute object.
*/
-/*#define HAS_PTHREAD_ATTR_SETSCOPE /**/
+/*#define HAS_PTHREAD_ATTR_SETSCOPE / **/
/* HAS_READV:
* This symbol, if defined, indicates that the readv routine is
* available to do gather reads. You will also need <sys/uio.h>
* and there I_SYSUIO.
*/
-/*#define HAS_READV /**/
+/*#define HAS_READV / **/
/* HAS_RECVMSG:
* This symbol, if defined, indicates that the recvmsg routine is
* available to send structured socket messages.
*/
-/*#define HAS_RECVMSG /**/
+/*#define HAS_RECVMSG / **/
/* HAS_SBRK_PROTO:
* This symbol, if defined, indicates that the system provides
* extern void* sbrk(int);
* extern void* sbrk(size_t);
*/
-/*#define HAS_SBRK_PROTO /**/
+/*#define HAS_SBRK_PROTO / **/
/* HAS_SCALBNL:
* This symbol, if defined, indicates that the scalbnl routine is
* available. If ilogbl is also present we can emulate frexpl.
*/
-/*#define HAS_SCALBNL /**/
+/*#define HAS_SCALBNL / **/
/* HAS_SENDMSG:
* This symbol, if defined, indicates that the sendmsg routine is
* available to send structured socket messages.
*/
-/*#define HAS_SENDMSG /**/
+/*#define HAS_SENDMSG / **/
/* HAS_SETITIMER:
* This symbol, if defined, indicates that the setitimer routine is
* available to set interval timers.
*/
-/*#define HAS_SETITIMER /**/
+/*#define HAS_SETITIMER / **/
/* HAS_SETPROCTITLE:
* This symbol, if defined, indicates that the setproctitle routine is
* available to set process title.
*/
-/*#define HAS_SETPROCTITLE /**/
+/*#define HAS_SETPROCTITLE / **/
/* USE_SFIO:
* This symbol, if defined, indicates that sfio should
* be used.
*/
-/*#define USE_SFIO /**/
+/*#define USE_SFIO / **/
/* HAS_SIGNBIT:
* This symbol, if defined, indicates that the signbit routine is
* in perl. Users should call Perl_signbit(), which will be #defined to
* the system's signbit() function or macro if this symbol is defined.
*/
-/*#define HAS_SIGNBIT /**/
+/*#define HAS_SIGNBIT / **/
/* HAS_SIGPROCMASK:
* This symbol, if defined, indicates that the sigprocmask
* system call is available to examine or change the signal mask
* of the calling process.
*/
-/*#define HAS_SIGPROCMASK /**/
+/*#define HAS_SIGPROCMASK / **/
/* USE_SITECUSTOMIZE:
* This symbol, if defined, indicates that sitecustomize should
* be used.
*/
#ifndef USE_SITECUSTOMIZE
-/*#define USE_SITECUSTOMIZE /**/
+/*#define USE_SITECUSTOMIZE / **/
#endif
/* HAS_SNPRINTF:
* This symbol, if defined, indicates that the sockatmark routine is
* available to test whether a socket is at the out-of-band mark.
*/
-/*#define HAS_SOCKATMARK /**/
+/*#define HAS_SOCKATMARK / **/
/* HAS_SOCKATMARK_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. A good guess is
* extern int sockatmark(int);
*/
-/*#define HAS_SOCKATMARK_PROTO /**/
+/*#define HAS_SOCKATMARK_PROTO / **/
/* HAS_SOCKS5_INIT:
* This symbol, if defined, indicates that the socks5_init routine is
* available to initialize SOCKS 5.
*/
-/*#define HAS_SOCKS5_INIT /**/
+/*#define HAS_SOCKS5_INIT / **/
/* SPRINTF_RETURNS_STRLEN:
* This variable defines whether sprintf returns the length of the string
* This symbol, if defined, indicates that the sqrtl routine is
* available to do long double square roots.
*/
-/*#define HAS_SQRTL /**/
+/*#define HAS_SQRTL / **/
/* HAS_SETRESGID_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. Good guesses are
* extern int setresgid(uid_t ruid, uid_t euid, uid_t suid);
*/
-/*#define HAS_SETRESGID_PROTO /**/
+/*#define HAS_SETRESGID_PROTO / **/
/* HAS_SETRESUID_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. Good guesses are
* extern int setresuid(uid_t ruid, uid_t euid, uid_t suid);
*/
-/*#define HAS_SETRESUID_PROTO /**/
+/*#define HAS_SETRESUID_PROTO / **/
/* HAS_STRUCT_STATFS_F_FLAGS:
* This symbol, if defined, indicates that the struct statfs
* have statfs() and struct statfs, they have ustat() and getmnt()
* with struct ustat and struct fs_data.
*/
-/*#define HAS_STRUCT_STATFS_F_FLAGS /**/
+/*#define HAS_STRUCT_STATFS_F_FLAGS / **/
/* HAS_STRUCT_STATFS:
* This symbol, if defined, indicates that the struct statfs
* to do statfs() is supported.
*/
-/*#define HAS_STRUCT_STATFS /**/
+/*#define HAS_STRUCT_STATFS / **/
/* HAS_FSTATVFS:
* This symbol, if defined, indicates that the fstatvfs routine is
* available to stat filesystems by file descriptors.
*/
-/*#define HAS_FSTATVFS /**/
+/*#define HAS_FSTATVFS / **/
/* HAS_STRFTIME:
* This symbol, if defined, indicates that the strftime routine is
* This symbol, if defined, indicates that the strlcat () routine is
* available to do string concatenation.
*/
-/*#define HAS_STRLCAT /**/
+/*#define HAS_STRLCAT / **/
/* HAS_STRLCPY:
* This symbol, if defined, indicates that the strlcpy () routine is
* available to do string copying.
*/
-/*#define HAS_STRLCPY /**/
+/*#define HAS_STRLCPY / **/
/* HAS_STRTOLD:
* This symbol, if defined, indicates that the strtold routine is
* available to convert strings to long doubles.
*/
-/*#define HAS_STRTOLD /**/
+/*#define HAS_STRTOLD / **/
/* HAS_STRTOLL:
* This symbol, if defined, indicates that the strtoll routine is
* This symbol, if defined, indicates that the strtoq routine is
* available to convert strings to long longs (quads).
*/
-/*#define HAS_STRTOQ /**/
+/*#define HAS_STRTOQ / **/
/* HAS_STRTOULL:
* This symbol, if defined, indicates that the strtoull routine is
* This symbol, if defined, indicates that the strtouq routine is
* available to convert strings to unsigned long longs (quads).
*/
-/*#define HAS_STRTOUQ /**/
+/*#define HAS_STRTOUQ / **/
/* HAS_SYSCALL_PROTO:
* This symbol, if defined, indicates that the system provides
* extern int syscall(int, ...);
* extern int syscall(long, ...);
*/
-/*#define HAS_SYSCALL_PROTO /**/
+/*#define HAS_SYSCALL_PROTO / **/
/* HAS_TELLDIR_PROTO:
* This symbol, if defined, indicates that the system provides
* This symbol, if defined, indicates that the asctime64 () routine is
* available to do the 64bit variant of asctime ()
*/
-/*#define HAS_CTIME64 /**/
-/*#define HAS_LOCALTIME64 /**/
-/*#define HAS_GMTIME64 /**/
-/*#define HAS_MKTIME64 /**/
-/*#define HAS_DIFFTIME64 /**/
-/*#define HAS_ASCTIME64 /**/
+/*#define HAS_CTIME64 / **/
+/*#define HAS_LOCALTIME64 / **/
+/*#define HAS_GMTIME64 / **/
+/*#define HAS_MKTIME64 / **/
+/*#define HAS_DIFFTIME64 / **/
+/*#define HAS_ASCTIME64 / **/
/* HAS_TIMEGM:
* This symbol, if defined, indicates that the timegm routine is
* available to do the opposite of gmtime ()
*/
-/*#define HAS_TIMEGM /**/
+/*#define HAS_TIMEGM / **/
/* U32_ALIGNMENT_REQUIRED:
* This symbol, if defined, indicates that you must access
* This symbol, if defined, indicates that the ualarm routine is
* available to do alarms with microsecond granularity.
*/
-/*#define HAS_UALARM /**/
+/*#define HAS_UALARM / **/
/* HAS_UNORDERED:
* This symbol, if defined, indicates that the unordered routine is
* available to check whether two doubles are unordered
* (effectively: whether either of them is NaN)
*/
-/*#define HAS_UNORDERED /**/
+/*#define HAS_UNORDERED / **/
/* HAS_UNSETENV:
* This symbol, if defined, indicates that the unsetenv () routine is
* available for use.
*/
-/*#define HAS_UNSETENV /**/
+/*#define HAS_UNSETENV / **/
/* HAS_USLEEP_PROTO:
* This symbol, if defined, indicates that the system provides
* to the program to supply one. A good guess is
* extern int usleep(useconds_t);
*/
-/*#define HAS_USLEEP_PROTO /**/
+/*#define HAS_USLEEP_PROTO / **/
/* HAS_USTAT:
* This symbol, if defined, indicates that the ustat system call is
* available to query file system statistics by dev_t.
*/
-/*#define HAS_USTAT /**/
+/*#define HAS_USTAT / **/
/* HAS_WRITEV:
* This symbol, if defined, indicates that the writev routine is
* available to do scatter writes.
*/
-/*#define HAS_WRITEV /**/
+/*#define HAS_WRITEV / **/
/* USE_DYNAMIC_LOADING:
* This symbol, if defined, indicates that dynamic loading of
* even be probed for and will be left undefined.
*/
#define FFLUSH_NULL /**/
-/*#define FFLUSH_ALL /**/
+/*#define FFLUSH_ALL / **/
/* I_ASSERT:
* This symbol, if defined, indicates that <assert.h> exists and
* This symbol, if defined, indicates that <crypt.h> exists and
* should be included.
*/
-/*#define I_CRYPT /**/
+/*#define I_CRYPT / **/
/* DB_Prefix_t:
* This symbol contains the type of the prefix structure element
* This symbol, if defined, indicates that <fp.h> exists and
* should be included.
*/
-/*#define I_FP /**/
+/*#define I_FP / **/
/* I_FP_CLASS:
* This symbol, if defined, indicates that <fp_class.h> exists and
* should be included.
*/
-/*#define I_FP_CLASS /**/
+/*#define I_FP_CLASS / **/
/* I_IEEEFP:
* This symbol, if defined, indicates that <ieeefp.h> exists and
* should be included.
*/
-/*#define I_IEEEFP /**/
+/*#define I_IEEEFP / **/
/* I_INTTYPES:
* This symbol, if defined, indicates to the C program that it should
* include <inttypes.h>.
*/
-/*#define I_INTTYPES /**/
+/*#define I_INTTYPES / **/
/* I_LANGINFO:
* This symbol, if defined, indicates that <langinfo.h> exists and
* should be included.
*/
-/*#define I_LANGINFO /**/
+/*#define I_LANGINFO / **/
/* I_LIBUTIL:
* This symbol, if defined, indicates that <libutil.h> exists and
* should be included.
*/
-/*#define I_LIBUTIL /**/
+/*#define I_LIBUTIL / **/
/* I_MALLOCMALLOC:
* This symbol, if defined, indicates to the C program that it should
* include <malloc/malloc.h>.
*/
-/*#define I_MALLOCMALLOC /**/
+/*#define I_MALLOCMALLOC / **/
/* I_MNTENT:
* This symbol, if defined, indicates that <mntent.h> exists and
* should be included.
*/
-/*#define I_MNTENT /**/
+/*#define I_MNTENT / **/
/* I_NETINET_TCP:
* This symbol, if defined, indicates to the C program that it should
* include <netinet/tcp.h>.
*/
-/*#define I_NETINET_TCP /**/
+/*#define I_NETINET_TCP / **/
/* I_POLL:
* This symbol, if defined, indicates that <poll.h> exists and
* should be included. (see also HAS_POLL)
*/
-/*#define I_POLL /**/
+/*#define I_POLL / **/
/* I_PROT:
* This symbol, if defined, indicates that <prot.h> exists and
* should be included.
*/
-/*#define I_PROT /**/
+/*#define I_PROT / **/
/* I_SHADOW:
* This symbol, if defined, indicates that <shadow.h> exists and
* should be included.
*/
-/*#define I_SHADOW /**/
+/*#define I_SHADOW / **/
/* I_SOCKS:
* This symbol, if defined, indicates that <socks.h> exists and
* should be included.
*/
-/*#define I_SOCKS /**/
+/*#define I_SOCKS / **/
/* I_SUNMATH:
* This symbol, if defined, indicates that <sunmath.h> exists and
* should be included.
*/
-/*#define I_SUNMATH /**/
+/*#define I_SUNMATH / **/
/* I_SYSLOG:
* This symbol, if defined, indicates that <syslog.h> exists and
* should be included.
*/
-/*#define I_SYSLOG /**/
+/*#define I_SYSLOG / **/
/* I_SYSMODE:
* This symbol, if defined, indicates that <sys/mode.h> exists and
* should be included.
*/
-/*#define I_SYSMODE /**/
+/*#define I_SYSMODE / **/
/* I_SYS_MOUNT:
* This symbol, if defined, indicates that <sys/mount.h> exists and
* should be included.
*/
-/*#define I_SYS_MOUNT /**/
+/*#define I_SYS_MOUNT / **/
/* I_SYS_STATFS:
* This symbol, if defined, indicates that <sys/statfs.h> exists.
*/
-/*#define I_SYS_STATFS /**/
+/*#define I_SYS_STATFS / **/
/* I_SYS_STATVFS:
* This symbol, if defined, indicates that <sys/statvfs.h> exists and
* should be included.
*/
-/*#define I_SYS_STATVFS /**/
+/*#define I_SYS_STATVFS / **/
/* I_SYSUTSNAME:
* This symbol, if defined, indicates that <sys/utsname.h> exists and
* should be included.
*/
-/*#define I_SYSUTSNAME /**/
+/*#define I_SYSUTSNAME / **/
/* I_SYS_VFS:
* This symbol, if defined, indicates that <sys/vfs.h> exists and
* should be included.
*/
-/*#define I_SYS_VFS /**/
+/*#define I_SYS_VFS / **/
/* I_USTAT:
* This symbol, if defined, indicates that <ustat.h> exists and
* should be included.
*/
-/*#define I_USTAT /**/
+/*#define I_USTAT / **/
/* PERL_PRIfldbl:
* This symbol, if defined, contains the string used by stdio to
* This symbol, if defined, contains the string used by stdio to
* format long doubles (format 'f') for input.
*/
-/*#define PERL_PRIfldbl "f" /**/
-/*#define PERL_PRIgldbl "g" /**/
-/*#define PERL_PRIeldbl "e" /**/
-/*#define PERL_SCNfldbl "f" /**/
+/*#define PERL_PRIfldbl "f" / **/
+/*#define PERL_PRIgldbl "g" / **/
+/*#define PERL_PRIeldbl "e" / **/
+/*#define PERL_SCNfldbl "f" / **/
/* PERL_MAD:
* This symbol, if defined, indicates that the Misc Attribution
* Declaration code should be conditionally compiled.
*/
-/*#define PERL_MAD /**/
+/*#define PERL_MAD / **/
/* NEED_VA_COPY:
* This symbol, if defined, indicates that the system stores
* of copying mechanisms, handy.h defines a platform-
* independent macro, Perl_va_copy(src, dst), to do the job.
*/
-/*#define NEED_VA_COPY /**/
+/*#define NEED_VA_COPY / **/
/* IVTYPE:
* This symbol defines the C type used for Perl's IV.
* This symbol tells the name of the array holding the stdio streams.
* Usual values include _iob, __iob, and __sF.
*/
-/*#define HAS_STDIO_STREAM_ARRAY /**/
+/*#define HAS_STDIO_STREAM_ARRAY / **/
#ifdef HAS_STDIO_STREAM_ARRAY
#define STDIO_STREAM_ARRAY
#endif
#define USE_64_BIT_INT /**/
#endif
#ifndef USE_64_BIT_ALL
-/*#define USE_64_BIT_ALL /**/
+/*#define USE_64_BIT_ALL / **/
#endif
/* USE_DTRACE:
* This symbol, if defined, indicates that Perl should
* be built with support for DTrace.
*/
-/*#define USE_DTRACE /**/
+/*#define USE_DTRACE / **/
/* USE_FAST_STDIO:
* This symbol, if defined, indicates that Perl should
* Defaults to define in Perls 5.8 and earlier, to undef later.
*/
#ifndef USE_FAST_STDIO
-/*#define USE_FAST_STDIO /**/
+/*#define USE_FAST_STDIO / **/
#endif
/* USE_LARGE_FILES:
* should be used when available.
*/
#ifndef USE_LARGE_FILES
-/*#define USE_LARGE_FILES /**/
+/*#define USE_LARGE_FILES / **/
#endif
/* USE_LONG_DOUBLE:
* be used when available.
*/
#ifndef USE_LONG_DOUBLE
-/*#define USE_LONG_DOUBLE /**/
+/*#define USE_LONG_DOUBLE / **/
#endif
/* USE_MORE_BITS:
* long doubles should be used when available.
*/
#ifndef USE_MORE_BITS
-/*#define USE_MORE_BITS /**/
+/*#define USE_MORE_BITS / **/
#endif
/* MULTIPLICITY:
* be built to use multiplicity.
*/
#ifndef MULTIPLICITY
-/*#define MULTIPLICITY /**/
+/*#define MULTIPLICITY / **/
#endif
/* USE_PERLIO:
* used in a fully backward compatible manner.
*/
#ifndef USE_PERLIO
-/*#define USE_PERLIO /**/
+/*#define USE_PERLIO / **/
#endif
/* USE_SOCKS:
* be built to use socks.
*/
#ifndef USE_SOCKS
-/*#define USE_SOCKS /**/
+/*#define USE_SOCKS / **/
#endif
#endif
}
use File::Compare qw(compare);
use File::Copy qw(copy);
-my $name = $0;
+use File::Basename qw(fileparse);
+my ($name, $dir) = fileparse($0);
$name =~ s#^(.*)\.PL$#../$1.SH#;
my %opt;
while (@ARGV && $ARGV[0] =~ /^([\w_]+)=(.*)$/)
munge();
s/\\\$/\$/g;
s#/[ *\*]*\*/#/**/#;
+ s#(.)/\*\*/#$1/ **/# if(/^\/\*/); #avoid "/*" inside comments
if (/^\s*#define\s+(PRIVLIB|SITELIB|VENDORLIB)_EXP/)
{
$_ = "#define ". $1 . "_EXP (win32_get_". lc($1) . "(PERL_VERSION_STRING, NULL))\t/**/\n";
# incpush() handles archlibs, so disable them
elsif (/^\s*#define\s+(ARCHLIB|SITEARCH|VENDORARCH)_EXP/)
{
- $_ = "/*#define ". $1 . "_EXP \"\"\t/**/\n";
+ $_ = "/*#define ". $1 . "_EXP \"\"\t/ **/\n";
}
print H;
}
# MS Platform SDK 64-bit compiler and tools **experimental**
#
# This is set up to build a perl.exe that runs off a shared library
-# (perl511.dll). Also makes individual DLLs for the XS extensions.
+# (perl513.dll). Also makes individual DLLs for the XS extensions.
#
##
# versioned installation can be obtained by setting INST_TOP above to a
# path that includes an arbitrary version string.
#
-#INST_VER *= \5.11.3
+#INST_VER *= \5.13.0
#
# Comment this out if you DON'T want your perl installation to have
# set this to additionally provide a statically linked perl-static.exe.
# Note that dynamic loading will not work with this perl, so you must
# include required modules statically using the STATIC_EXT or ALL_STATIC
-# variables below. A static library perl511s.lib will also be created.
+# variables below. A static library perl513s.lib will also be created.
# Ordinary perl.exe is not affected by this option.
#
#BUILD_STATIC *= define
CFGSH_TMPL = config.gc
CFGH_TMPL = config_H.gc
.ENDIF
-PERLIMPLIB = ..\libperl511$(a)
-PERLSTATICLIB = ..\libperl511s$(a)
+PERLIMPLIB = ..\libperl513$(a)
+PERLSTATICLIB = ..\libperl513s$(a)
.ELSE
# makedef.pl must be updated if this changes, and this should normally
# only change when there is an incompatible revision of the public API.
-PERLIMPLIB *= ..\perl511$(a)
-PERLSTATICLIB *= ..\perl511s$(a)
-PERLDLL = ..\perl511.dll
+PERLIMPLIB *= ..\perl513$(a)
+PERLSTATICLIB *= ..\perl513s$(a)
+PERLDLL = ..\perl513.dll
XCOPY = xcopy /f /r /i /d /y
RCOPY = xcopy /f /r /i /e /d /y
copy ..\README.vmesa ..\pod\perlvmesa.pod
copy ..\README.vos ..\pod\perlvos.pod
copy ..\README.win32 ..\pod\perlwin32.pod
- copy ..\pod\perl5113delta.pod ..\pod\perldelta.pod
+ copy ..\pod\perl5131delta.pod ..\pod\perldelta.pod
cd ..\pod && $(MAKE) -f ..\win32\pod.mak converters
$(PERLEXE) $(PL2BAT) $(UTILS)
$(PERLEXE) $(ICWD) ..\autodoc.pl ..
-del /f $(LIBDIR)\ops.pm $(LIBDIR)\Safe.pm
-del /f $(LIBDIR)\SDBM_File.pm $(LIBDIR)\Socket.pm $(LIBDIR)\POSIX.pm
-del /f $(LIBDIR)\B.pm $(LIBDIR)\O.pm $(LIBDIR)\re.pm
- -del /f $(LIBDIR)\Devel\Peek.pm $(LIBDIR)\Devel\DProf.pm
- -del /f $(LIBDIR)\Devel\PPPort.pm
-del /f $(LIBDIR)\File\Glob.pm
-del /f $(LIBDIR)\Storable.pm
- -del /f $(LIBDIR)\Digest\MD5.pm
- -del /f $(LIBDIR)\Digest\SHA.pm
- -del /f $(LIBDIR)\PerlIO\encoding.pm
- -del /f $(LIBDIR)\PerlIO\scalar.pm
- -del /f $(LIBDIR)\PerlIO\via.pm
-del /f $(LIBDIR)\Sys\Hostname.pm
- -del /f $(LIBDIR)\threads\shared.pm
-del /f $(LIBDIR)\Time\HiRes.pm
-del /f $(LIBDIR)\Unicode\Normalize.pm
-del /f $(LIBDIR)\Math\BigInt\FastCalc.pm
-del /f $(LIBDIR)\Win32API\File.pm
-del /f $(LIBDIR)\Win32API\File\cFile.pc
-del /f $(DISTDIR)\XSLoader\XSLoader.pm
+ -if exist $(LIBDIR)\App rmdir /s /q $(LIBDIR)\App
+ -if exist $(LIBDIR)\Archive rmdir /s /q $(LIBDIR)\Archive
+ -if exist $(LIBDIR)\Attribute rmdir /s /q $(LIBDIR)\Attribute
+ -if exist $(LIBDIR)\autodie rmdir /s /q $(LIBDIR)\autodie
-if exist $(LIBDIR)\B rmdir /s /q $(LIBDIR)\B
+ -if exist $(LIBDIR)\CGI rmdir /s /q $(LIBDIR)\CGI
+ -if exist $(LIBDIR)\CPAN rmdir /s /q $(LIBDIR)\CPAN
+ -if exist $(LIBDIR)\CPANPLUS rmdir /s /q $(LIBDIR)\CPANPLUS
-if exist $(LIBDIR)\Compress rmdir /s /q $(LIBDIR)\Compress
-if exist $(LIBDIR)\Data rmdir /s /q $(LIBDIR)\Data
+ -if exist $(LIBDIR)\Devel rmdir /s /q $(LIBDIR)\Devel
+ -if exist $(LIBDIR)\Digest rmdir /s /q $(LIBDIR)\Digest
-if exist $(LIBDIR)\Encode rmdir /s /q $(LIBDIR)\Encode
- -if exist $(LIBDIR)\Filter\Util rmdir /s /q $(LIBDIR)\Filter\Util
+ -if exist $(LIBDIR)\encoding rmdir /s /q $(LIBDIR)\encoding
+ -if exist $(LIBDIR)\ExtUtils\CBuilder rmdir /s /q $(LIBDIR)\ExtUtils\CBuilder
+ -if exist $(LIBDIR)\ExtUtils\Command rmdir /s /q $(LIBDIR)\ExtUtils\Command
+ -if exist $(LIBDIR)\ExtUtils\Constant rmdir /s /q $(LIBDIR)\ExtUtils\Constant
+ -if exist $(LIBDIR)\ExtUtils\Liblist rmdir /s /q $(LIBDIR)\ExtUtils\Liblist
+ -if exist $(LIBDIR)\ExtUtils\MakeMaker rmdir /s /q $(LIBDIR)\ExtUtils\MakeMaker
+ -if exist $(LIBDIR)\File\Spec rmdir /s /q $(LIBDIR)\File\Spec
+ -if exist $(LIBDIR)\Filter rmdir /s /q $(LIBDIR)\Filter
-if exist $(LIBDIR)\Hash rmdir /s /q $(LIBDIR)\Hash
- -if exist $(LIBDIR)\App rmdir /s /q $(LIBDIR)\App
+ -if exist $(LIBDIR)\I18N\LangTags rmdir /s /q $(LIBDIR)\I18N\LangTags
+ -if exist $(LIBDIR)\inc rmdir /s /q $(LIBDIR)\inc
-if exist $(LIBDIR)\Module\Pluggable rmdir /s /q $(LIBDIR)\Module\Pluggable
- -if exist $(LIBDIR)\TAP rmdir /s /q $(LIBDIR)\TAP
- -if exist $(LIBDIR)\mro rmdir /s /q $(LIBDIR)\mro
- -if exist $(LIBDIR)\IO\Compress rmdir /s /q $(LIBDIR)\IO\Compress
- -if exist $(LIBDIR)\IO\Socket rmdir /s /q $(LIBDIR)\IO\Socket
- -if exist $(LIBDIR)\IO\Uncompress rmdir /s /q $(LIBDIR)\IO\Uncompress
+ -if exist $(LIBDIR)\IO rmdir /s /q $(LIBDIR)\IO
+ -if exist $(LIBDIR)\IPC rmdir /s /q $(LIBDIR)\IPC
-if exist $(LIBDIR)\List rmdir /s /q $(LIBDIR)\List
+ -if exist $(LIBDIR)\Locale rmdir /s /q $(LIBDIR)\Locale
+ -if exist $(LIBDIR)\Log rmdir /s /q $(LIBDIR)\Log
+ -if exist $(LIBDIR)\Math rmdir /s /q $(LIBDIR)\Math
+ -if exist $(LIBDIR)\Memoize rmdir /s /q $(LIBDIR)\Memoize
-if exist $(LIBDIR)\MIME rmdir /s /q $(LIBDIR)\MIME
+ -if exist $(LIBDIR)\Module rmdir /s /q $(LIBDIR)\Module
+ -if exist $(LIBDIR)\mro rmdir /s /q $(LIBDIR)\mro
+ -if exist $(LIBDIR)\Net\FTP rmdir /s /q $(LIBDIR)\Net\FTP
+ -if exist $(LIBDIR)\Object rmdir /s /q $(LIBDIR)\Object
+ -if exist $(LIBDIR)\Package rmdir /s /q $(LIBDIR)\Package
+ -if exist $(LIBDIR)\Params rmdir /s /q $(LIBDIR)\Params
+ -if exist $(LIBDIR)\Parse rmdir /s /q $(LIBDIR)\Parse
+ -if exist $(LIBDIR)\PerlIO rmdir /s /q $(LIBDIR)\PerlIO
+ -if exist $(LIBDIR)\Pod\Perldoc rmdir /s /q $(LIBDIR)\Pod\Perldoc
+ -if exist $(LIBDIR)\Pod\Simple rmdir /s /q $(LIBDIR)\Pod\Simple
+ -if exist $(LIBDIR)\Pod\Text rmdir /s /q $(LIBDIR)\Pod\Text
-if exist $(LIBDIR)\re rmdir /s /q $(LIBDIR)\re
-if exist $(LIBDIR)\Scalar rmdir /s /q $(LIBDIR)\Scalar
-if exist $(LIBDIR)\Sys rmdir /s /q $(LIBDIR)\Sys
+ -if exist $(LIBDIR)\TAP rmdir /s /q $(LIBDIR)\TAP
+ -if exist $(LIBDIR)\Term\UI rmdir /s /q $(LIBDIR)\Term\UI
+ -if exist $(LIBDIR)\Test rmdir /s /q $(LIBDIR)\Test
+ -if exist $(LIBDIR)\Thread rmdir /s /q $(LIBDIR)\Thread
-if exist $(LIBDIR)\threads rmdir /s /q $(LIBDIR)\threads
+ -if exist $(LIBDIR)\Unicode\Collate rmdir /s /q $(LIBDIR)\Unicode\Collate
-if exist $(LIBDIR)\XS rmdir /s /q $(LIBDIR)\XS
-if exist $(LIBDIR)\Win32API rmdir /s /q $(LIBDIR)\Win32API
- -cd $(PODDIR) && del /f *.html *.bat podchecker \
+ -cd $(PODDIR) && del /f *.html *.bat \
perlaix.pod perlamiga.pod perlapi.pod perlapollo.pod \
perlbeos.pod perlbs2000.pod perlce.pod perlcn.pod \
perlcygwin.pod perldelta.pod perldgux.pod perldos.pod \
perltru64.pod perltw.pod perluniprops.pod perluts.pod \
perlvmesa.pod perlvos.pod perlwin32.pod \
pod2html pod2latex pod2man pod2text pod2usage \
- podselect
+ podchecker podselect
-cd ..\utils && del /f h2ph splain perlbug pl2pm c2ph pstruct h2xs \
perldoc perlivp dprofpp libnetcfg enc2xs piconv cpan *.bat \
xsubpp instmodsh prove ptar ptardiff cpanp-run-perl cpanp cpan2dist shasum corelist config_data
}
char*
-PerlStdIOGets(struct IPerlStdIO* piPerl, FILE* pf, char* s, int n)
+PerlStdIOGets(struct IPerlStdIO* piPerl, char* s, int n, FILE* pf)
{
return win32_fgets(s, n, pf);
}
int
-PerlStdIOPutc(struct IPerlStdIO* piPerl, FILE* pf, int c)
+PerlStdIOPutc(struct IPerlStdIO* piPerl, int c, FILE* pf)
{
return win32_fputc(c, pf);
}
int
-PerlStdIOPuts(struct IPerlStdIO* piPerl, FILE* pf, const char *s)
+PerlStdIOPuts(struct IPerlStdIO* piPerl, const char *s, FILE* pf)
{
return win32_fputs(s, pf);
}
perl5111delta.pod \
perl5112delta.pod \
perl5113delta.pod \
+ perl5114delta.pod \
+ perl5115delta.pod \
+ perl5120delta.pod \
+ perl5130delta.pod \
+ perl5131delta.pod \
perl561delta.pod \
perl56delta.pod \
perl570delta.pod \
perl5111delta.man \
perl5112delta.man \
perl5113delta.man \
+ perl5114delta.man \
+ perl5115delta.man \
+ perl5120delta.man \
+ perl5130delta.man \
+ perl5131delta.man \
perl561delta.man \
perl56delta.man \
perl570delta.man \
perl5111delta.html \
perl5112delta.html \
perl5113delta.html \
+ perl5114delta.html \
+ perl5115delta.html \
+ perl5120delta.html \
+ perl5130delta.html \
+ perl5131delta.html \
perl561delta.html \
perl56delta.html \
perl570delta.html \
perl5111delta.tex \
perl5112delta.tex \
perl5113delta.tex \
+ perl5114delta.tex \
+ perl5115delta.tex \
+ perl5120delta.tex \
+ perl5130delta.tex \
+ perl5131delta.tex \
perl561delta.tex \
perl56delta.tex \
perl570delta.tex \
projects / p5sagit/p5-mst-13.2.git / commitdiff