summaryrefslogtreecommitdiff
path: root/gnu/usr.bin/perl/cpan/Term-ReadKey
diff options
context:
space:
mode:
authorMarc Espie <espie@cvs.openbsd.org>2016-05-07 16:03:10 +0000
committerMarc Espie <espie@cvs.openbsd.org>2016-05-07 16:03:10 +0000
commit528bc123dfcffa2ab49f3c6ac842d0e3d22acc59 (patch)
tree866f871d286c9fa875a2fa75f634b67fe76d2403 /gnu/usr.bin/perl/cpan/Term-ReadKey
parent0ea13db40b46a680b41482fd8a7501a118aefcab (diff)
Term::ReadKey vendor import, as discussed with millert@ and afresh1@
Diffstat (limited to 'gnu/usr.bin/perl/cpan/Term-ReadKey')
-rw-r--r--gnu/usr.bin/perl/cpan/Term-ReadKey/Changes314
-rw-r--r--gnu/usr.bin/perl/cpan/Term-ReadKey/Configure.pm871
-rw-r--r--gnu/usr.bin/perl/cpan/Term-ReadKey/MANIFEST15
-rw-r--r--gnu/usr.bin/perl/cpan/Term-ReadKey/MANIFEST.SKIP3
-rw-r--r--gnu/usr.bin/perl/cpan/Term-ReadKey/META.json49
-rw-r--r--gnu/usr.bin/perl/cpan/Term-ReadKey/META.yml26
-rw-r--r--gnu/usr.bin/perl/cpan/Term-ReadKey/Makefile.PL86
-rw-r--r--gnu/usr.bin/perl/cpan/Term-ReadKey/README145
-rw-r--r--gnu/usr.bin/perl/cpan/Term-ReadKey/ReadKey.pm654
-rw-r--r--gnu/usr.bin/perl/cpan/Term-ReadKey/ReadKey.xs1923
-rw-r--r--gnu/usr.bin/perl/cpan/Term-ReadKey/example/test.pl366
-rw-r--r--gnu/usr.bin/perl/cpan/Term-ReadKey/genchars.pl488
-rw-r--r--gnu/usr.bin/perl/cpan/Term-ReadKey/ppport.h7452
-rw-r--r--gnu/usr.bin/perl/cpan/Term-ReadKey/t/01_basic.t7
-rw-r--r--gnu/usr.bin/perl/cpan/Term-ReadKey/t/02_terminal_functions.t86
15 files changed, 12485 insertions, 0 deletions
diff --git a/gnu/usr.bin/perl/cpan/Term-ReadKey/Changes b/gnu/usr.bin/perl/cpan/Term-ReadKey/Changes
new file mode 100644
index 00000000000..6372ca39004
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/Term-ReadKey/Changes
@@ -0,0 +1,314 @@
+2015-06-04 Jonathan Stowe <jns+git@gellyfish.co.uk>
+
+ * .gitignore, Changes, META.yml, README, ReadKey.pm: Up version
+
+2015-06-04 Jonathan Stowe <jns+git@gellyfish.co.uk>
+
+ * .gitignore: Add .bs file to .gitignore
+
+2015-06-04 Jonathan Stowe <jns@gellyfish.co.uk>
+
+ * : Merge pull request #6 from ntyni/master Make genchars.pl output reproducible by sorting hash keys
+
+2015-04-30 Jonathan Stowe <jns+git@gellyfish.co.uk>
+
+ * Makefile.PL: Fix for "[rt.cpan.org #100932] Parallel build fails"
+ from Petr Pisar
+
+2015-04-30 Jonathan Stowe <jns+git@gellyfish.co.uk>
+
+ * MANIFEST.SKIP: Add .git directory to the MANIFEST.SKIP
+
+2015-04-13 Jonathan Stowe <jns+git@gellyfish.co.uk>
+
+ * MANIFEST, MANIFEST.SKIP: Add new artefacts
+
+2015-04-13 Jonathan Stowe <jns+git@gellyfish.co.uk>
+
+ * .travis.yml: Add travis-ci testing
+
+2015-04-13 Jonathan Stowe <jns+git@gellyfish.co.uk>
+
+ * .gitignore: Add .gitignore
+
+2015-04-13 Jonathan Stowe <jns@gellyfish.co.uk>
+
+ * : Merge pull request #5 from
+ sdeseille/Create_T_directory_and_split_test.pl Create t directory and split test.pl
+
+2015-04-11 Sébastien Deseille <sebastien.deseille@gmail.com>
+
+ * README: Update README to reflect the move of test.pl in example
+ subdirectory
+
+2015-04-11 Sébastien Deseille <sebastien.deseille@gmail.com>
+
+ * README: Revert "Update README to reflect the move of test.pl in
+ example subdirectory" This reverts commit 09402dcd68d8d0417e0eb2f9ea0aeaf4b4c72e9a.
+
+2015-04-11 Sébastien Deseille <sebastien.deseille@gmail.com>
+
+ * README: Update README to reflect the move of test.pl in example
+ subdirectory
+
+2015-04-11 Sébastien Deseille <sebastien.deseille@gmail.com>
+
+ * example/test.pl, test.pl: Move test.pl in example's subdirectory
+ in order to keep the possibility to use its interactive mode
+
+2015-04-11 Sébastien Deseille <sebastien.deseille@gmail.com>
+
+ * t/02_terminal_functions.t: Finished to implement all tests from
+ test.pl
+
+2015-04-11 Sébastien Deseille <sebastien.deseille@gmail.com>
+
+ * t/02_terminal_functions.t: Add test to Check TerminalSize OUT
+
+2015-04-11 Sébastien Deseille <sebastien.deseille@gmail.com>
+
+ * t/02_terminal_functions.t: Add test to Check non-blocking read
+
+2015-04-10 Sébastien Deseille <sebastien.deseille@gmail.com>
+
+ * t/02_terminal_functions.t: Add second test about Comparing
+ TerminalSize
+
+2015-04-10 Sébastien Deseille <sebastien.deseille@gmail.com>
+
+ * t/01_basic.t: Add first test to validate module loading
+
+2015-04-03 Jonathan Stowe <jns@gellyfish.co.uk>
+
+ * : Merge pull request #3 from kmx/master no resize, no stty on MS Windows
+
+2014-05-10 Jonathan Stowe <jns+git@gellyfish.co.uk>
+
+ * Changes: Update changes with git2cl (some manual reordering)
+
+2014-05-10 Jonathan Stowe <jns+git@gellyfish.co.uk>
+
+ * Makefile.PL: Makefile.PL more specific
+
+2014-05-10 Jonathan Stowe <jns+git@gellyfish.co.uk>
+
+ * : Merge pull request #2 from jacquesg/warnings Fix some warnings
+
+2014-03-09 Jonathan Stowe <jns+git@gellyfish.co.uk>
+
+ * Configure.pm, META.yml, Makefile.PL: Don't index Configure.pm
+
+2014-03-03 Jonathan Stowe <jns+git@gellyfish.co.uk>
+
+ * Changes, README, ReadKey.pm: Added documentation patch as per
+ Chris Marshall Bumped version
+
+2013-10-28 Jonathan Stowe <jns+git@gellyfish.co.uk>
+
+ * README: Some changes to README
+
+2013-10-28 Brian Wightman <MidLifeXis@wightmanfam.org>
+
+ * ReadKey.pm: Promote SUPPORT and LICENSE to top-level head sections SUPPORT and LICENSE sections were in item sections, but outside of
+ an over/back block.
+
+2013-10-27 Jonathan Stowe <jns@gellyfish.co.uk>
+
+ * Makefile.PL, README, ReadKey.pm, ReadKey.xs, genchars.pl: Change
+ licensing Fix some warnings
+
+2013-10-26 Jonathan Stowe <jns@gellyfish.co.uk>
+
+ * ReadKey.pm: Applied patch from rt #35669
+
+2013-10-26 Jonathan Stowe <jns@gellyfish.co.uk>
+
+ * Makefile.PL, ReadKey.xs: Applied change from rt #26235 Also fixed
+ repo name
+
+2013-10-26 Jonathan Stowe <jns@gellyfish.co.uk>
+
+ * ReadKey.pm: Patch from rt #35671
+
+2013-10-26 Jonathan Stowe <jns@gellyfish.co.uk>
+
+ * ppport.h: Updated ppport.h as per #78831
+
+2013-10-26 Jonathan Stowe <jns@gellyfish.co.uk>
+
+ * Makefile.PL: Changed distname per RT #87885 Added additional
+ metadata
+
+2013-10-26 Jonathan Stowe <jns@gellyfish.co.uk>
+
+ * ReadKey.pm: Added changes for RT #86584
+
+2013-10-26 Jonathan Stowe <jns@gellyfish.co.uk>
+
+ * ReadKey.pm: Added patch from jpeacock@cpan.org for RT #88266
+
+2011-04-19 Jonathan Stowe <jns@gellyfish.co.uk>
+
+ * Changes: Added Changes
+
+2011-04-19 Jonathan Stowe <jns@gellyfish.co.uk>
+
+ * : commit 40ba6a2a80ae495b921ab416f6b024014daac25e Author: Stas
+ Grabois <CENSORED> Date: Tue Jun 24 01:57:37 2008 -0800
+
+2006-01-13 jonathan <jonathan@d4a3e428-c23c-0410-a93a-b1ce904c0fb3>
+
+ * MANIFEST, Makefile.PL: Added Changes git-svn-id: http://jstowe.googlecode.com/svn/trunk/TermReadKey@74
+ d4a3e428-c23c-0410-a93a-b1ce904c0fb3
+
+2005-01-11 jonathan <jonathan@d4a3e428-c23c-0410-a93a-b1ce904c0fb3>
+
+ * test.pl: Skip tests if /dev/tty for automated testing git-svn-id: http://jstowe.googlecode.com/svn/trunk/TermReadKey@53
+ d4a3e428-c23c-0410-a93a-b1ce904c0fb3
+
+2005-01-11 jonathan <jonathan@d4a3e428-c23c-0410-a93a-b1ce904c0fb3>
+
+ * ReadKey.pm: Fixed POD git-svn-id: http://jstowe.googlecode.com/svn/trunk/TermReadKey@52
+ d4a3e428-c23c-0410-a93a-b1ce904c0fb3
+
+2005-01-11 jonathan <jonathan@d4a3e428-c23c-0410-a93a-b1ce904c0fb3>
+
+ * README, ReadKey.pm, ReadKey.xs, genchars.pl, ppport.h: * Updated ppport.h * Fixed example in synopsis * termio branch not updated git-svn-id: http://jstowe.googlecode.com/svn/trunk/TermReadKey@51
+ d4a3e428-c23c-0410-a93a-b1ce904c0fb3
+
+2004-03-02 jonathan <jonathan@d4a3e428-c23c-0410-a93a-b1ce904c0fb3>
+
+ * Put back in CVS git-svn-id: http://jstowe.googlecode.com/svn/trunk/TermReadKey@19
+ d4a3e428-c23c-0410-a93a-b1ce904c0fb3
+
+2005-01-12 Jonathan Stowe <jns@gellyfish.co.uk>
+
+ * Configure.pm, MANIFEST, META.yml, Makefile.PL, README,
+ ReadKey.pm, ReadKey.xs, genchars.pl, ppport.h, test.pl: import
+ TermReadKey 2.30 from CPAN git-cpan-module: TermReadKey git-cpan-version: 2.30
+ git-cpan-authorid: JSTOWE git-cpan-file:
+ authors/id/J/JS/JSTOWE/TermReadKey-2.30.tar.gz
+
+2002-07-28 Jonathan Stowe <jns@gellyfish.co.uk>
+
+ * README, ReadKey.pm, ReadKey.xs, ppport.h, test.pl: import
+ TermReadKey 2.21 from CPAN git-cpan-module: TermReadKey git-cpan-version: 2.21
+ git-cpan-authorid: JSTOWE git-cpan-file:
+ authors/id/J/JS/JSTOWE/TermReadKey-2.21.tar.gz
+
+2002-05-24 Jonathan Stowe <jns@gellyfish.co.uk>
+
+ * README, ReadKey.pm, ReadKey.xs: import TermReadKey 2.20 from CPAN git-cpan-module: TermReadKey git-cpan-version: 2.20
+ git-cpan-authorid: JSTOWE git-cpan-file:
+ authors/id/J/JS/JSTOWE/TermReadKey-2.20.tar.gz
+
+2002-03-21 Jonathan Stowe <jns@gellyfish.co.uk>
+
+ * README, ReadKey.pm, ReadKey.xs: import TermReadKey 2.19 from CPAN git-cpan-module: TermReadKey git-cpan-version: 2.19
+ git-cpan-authorid: JSTOWE git-cpan-file:
+ authors/id/J/JS/JSTOWE/TermReadKey-2.19.tar.gz
+
+2002-02-10 Jonathan Stowe <jns@gellyfish.co.uk>
+
+ * Configure.pm, Makefile.PL, README, ReadKey.pm, ReadKey.xs,
+ genchars.pl: import TermReadKey 2.18 from CPAN git-cpan-module: TermReadKey git-cpan-version: 2.18
+ git-cpan-authorid: JSTOWE git-cpan-file:
+ authors/id/J/JS/JSTOWE/TermReadKey-2.18.tar.gz
+
+2002-01-25 Jonathan Stowe <jns@gellyfish.co.uk>
+
+ * Makefile.PL, README, ReadKey.pm, ReadKey.xs, test.pl: import
+ TermReadKey 2.17 from CPAN git-cpan-module: TermReadKey git-cpan-version: 2.17
+ git-cpan-authorid: JSTOWE git-cpan-file:
+ authors/id/J/JS/JSTOWE/TermReadKey-2.17.tar.gz
+
+2001-11-29 Jonathan Stowe <jns@gellyfish.co.uk>
+
+ * ReadKey.pm, ReadKey.xs, genchars.pl, ppport.h: import TermReadKey
+ 2.16 from CPAN git-cpan-module: TermReadKey git-cpan-version: 2.16
+ git-cpan-authorid: JSTOWE git-cpan-file:
+ authors/id/J/JS/JSTOWE/TermReadKey-2.16.tar.gz
+
+2001-11-07 Jonathan Stowe <jns@gellyfish.co.uk>
+
+ * ReadKey.pm, ReadKey.xs: import TermReadKey 2.15 from CPAN git-cpan-module: TermReadKey git-cpan-version: 2.15
+ git-cpan-authorid: JSTOWE git-cpan-file:
+ authors/id/J/JS/JSTOWE/TermReadKey-2.15.tar.gz
+
+1999-03-29 Kenneth Albanowski <kjahds@kjahds.com>
+
+ * Makefile.PL, ReadKey.pm, ReadKey.xs, ppport.h: import TermReadKey
+ 2.14 from CPAN git-cpan-module: TermReadKey git-cpan-version: 2.14
+ git-cpan-authorid: KJALB git-cpan-file:
+ authors/id/K/KJ/KJALB/TermReadKey-2.14.tar.gz
+
+1999-03-24 Kenneth Albanowski <kjahds@kjahds.com>
+
+ * MANIFEST, Makefile.PL, README, ReadKey.pm, ReadKey.xs,
+ genchars.pl, ppport.h: import TermReadKey 2.13 from CPAN git-cpan-module: TermReadKey git-cpan-version: 2.13
+ git-cpan-authorid: KJALB git-cpan-file:
+ authors/id/K/KJ/KJALB/TermReadKey-2.13.tar.gz
+
+1998-01-07 Kenneth Albanowski <kjahds@kjahds.com>
+
+ * Makefile.PL, README, ReadKey.pm, ReadKey.xs, test.pl: import
+ TermReadKey 2.12 from CPAN git-cpan-module: TermReadKey git-cpan-version: 2.12
+ git-cpan-authorid: KJALB git-cpan-file:
+ authors/id/K/KJ/KJALB/TermReadKey-2.12.tar.gz
+
+1997-12-13 Kenneth Albanowski <kjahds@kjahds.com>
+
+ * Makefile.PL, README, ReadKey.pm, ReadKey.xs, test.pl: import
+ TermReadKey 2.11 from CPAN git-cpan-module: TermReadKey git-cpan-version: 2.11
+ git-cpan-authorid: KJALB git-cpan-file:
+ authors/id/K/KJ/KJALB/TermReadKey-2.11.tar.gz
+
+1997-10-07 Kenneth Albanowski <kjahds@kjahds.com>
+
+ * Makefile.PL, ReadKey.pm, ReadKey.xs, genchars.pl: import
+ TermReadKey 2.09 from CPAN git-cpan-module: TermReadKey git-cpan-version: 2.09
+ git-cpan-authorid: KJALB git-cpan-file:
+ authors/id/K/KJ/KJALB/TermReadKey-2.09.tar.gz
+
+1997-10-06 Kenneth Albanowski <kjahds@kjahds.com>
+
+ * Makefile.PL, README, ReadKey.pm, ReadKey.xs: import TermReadKey
+ 2.08 from CPAN git-cpan-module: TermReadKey git-cpan-version: 2.08
+ git-cpan-authorid: KJALB git-cpan-file:
+ authors/id/K/KJ/KJALB/TermReadKey-2.08.tar.gz
+
+1997-01-27 Kenneth Albanowski <kjahds@kjahds.com>
+
+ * Makefile.PL, ReadKey.pm, ReadKey.xs: import TermReadKey 2.07 from
+ CPAN git-cpan-module: TermReadKey git-cpan-version: 2.07
+ git-cpan-authorid: KJALB git-cpan-file:
+ authors/id/K/KJ/KJALB/TermReadKey-2.07.tar.gz
+
+1996-11-25 Kenneth Albanowski <kjahds@kjahds.com>
+
+ * Makefile.PL, README, ReadKey.pm, ReadKey.xs, test.pl: import
+ TermReadKey 2.06 from CPAN git-cpan-module: TermReadKey git-cpan-version: 2.06
+ git-cpan-authorid: KJALB git-cpan-file:
+ authors/id/K/KJ/KJALB/TermReadKey-2.06.tar.gz
+
+1996-03-14 Kenneth Albanowski <kjahds@kjahds.com>
+
+ * Makefile.PL, README, ReadKey.pm, ReadKey.xs: import TermReadKey
+ 2.05 from CPAN git-cpan-module: TermReadKey git-cpan-version: 2.05
+ git-cpan-authorid: KJALB git-cpan-file:
+ authors/id/K/KJ/KJALB/TermReadKey-2.05.tar.gz
+
+1995-10-11 Kenneth Albanowski <kjahds@kjahds.com>
+
+ * Makefile.PL, README, ReadKey.xs: import TermReadKey 2.04 from CPAN git-cpan-module: TermReadKey git-cpan-version: 2.04
+ git-cpan-authorid: KJALB git-cpan-file:
+ authors/id/K/KJ/KJALB/TermReadKey-2.04.tar.gz
+
+1995-09-29 Kenneth Albanowski <kjahds@kjahds.com>
+
+ * Configure.pm, MANIFEST, Makefile.PL, README, ReadKey.pm,
+ ReadKey.xs, genchars.pl, test.pl: initial import of TermReadKey 2.03
+ from CPAN git-cpan-module: TermReadKey git-cpan-version: 2.03
+ git-cpan-authorid: KJALB git-cpan-file:
+ authors/id/K/KJ/KJALB/TermReadKey-2.03.tar.gz
+
diff --git a/gnu/usr.bin/perl/cpan/Term-ReadKey/Configure.pm b/gnu/usr.bin/perl/cpan/Term-ReadKey/Configure.pm
new file mode 100644
index 00000000000..98fa0d413fd
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/Term-ReadKey/Configure.pm
@@ -0,0 +1,871 @@
+#!/usr/bin/perl
+
+# Configure.pm. Version 1.00 Copyright (C) 1995, Kenneth Albanowski
+#
+# You are welcome to use this code in your own perl modules, I just
+# request that you don't distribute modified copies without making it clear
+# that you have changed something. If you have a change you think is worth
+# merging into the original, please contact me at kjahds@kjahds.com or
+# CIS:70705,126
+#
+# $Id: Configure.pm,v 1.1 2016/05/07 16:03:09 espie Exp $
+#
+
+# Todo: clean up redudant code in CPP, Compile, Link, and Execute
+#
+
+# for when no_index is not enough
+package
+Configure;
+
+use strict;
+
+use vars qw(@EXPORT @ISA);
+
+use Carp;
+require Exporter;
+@ISA = qw(Exporter);
+
+@EXPORT = qw( CPP
+ Compile
+ Link
+ Execute
+ FindHeader
+ FindLib
+ Apply
+ ApplyHeaders
+ ApplyLibs
+ ApplyHeadersAndLibs
+ ApplyHeadersAndLibsAndExecute
+ CheckHeader
+ CheckStructure
+ CheckField
+ CheckHSymbol
+ CheckSymbol
+ CheckLSymbol
+ GetSymbol
+ GetTextSymbol
+ GetNumericSymbol
+ GetConstants);
+
+use Cwd;
+use Config;
+
+my ($C_usrinc, $C_libpth, $C_cppstdin, $C_cppflags, $C_cppminus,
+$C_ccflags,$C_ldflags,$C_cc,$C_libs) =
+ @Config{qw( usrinc libpth cppstdin cppflags cppminus
+ ccflags ldflags cc libs)};
+
+my $Verbose = 0;
+
+=head1 NAME
+
+Configure.pm - provide auto-configuration utilities
+
+=head1 SUMMARY
+
+This perl module provides tools to figure out what is present in the C
+compilation environment. This is intended mostly for perl extensions to use
+to configure themselves. There are a number of functions, with widely varying
+levels of specificity, so here is a summary of what the functions can do:
+
+
+CheckHeader: Look for headers.
+
+CheckStructure: Look for a structure.
+
+CheckField: Look for a field in a structure.
+
+CheckHSymbol: Look for a symbol in a header.
+
+CheckLSymbol: Look for a symbol in a library.
+
+CheckSymbol: Look for a symbol in a header and library.
+
+GetTextSymbol: Get the contents of a symbol as text.
+
+GetNumericSymbol: Get the contents of a symbol as a number.
+
+Apply: Try compiling code with a set of headers and libs.
+
+ApplyHeaders: Try compiling code with a set of headers.
+
+ApplyLibraries: Try linking code with a set of libraries.
+
+ApplyHeadersAndLibaries: You get the idea.
+
+ApplyHeadersAndLibariesAnExecute: You get the idea.
+
+CPP: Feed some code through the C preproccessor.
+
+Compile: Try to compile some C code.
+
+Link: Try to compile & link some C code.
+
+Execute: Try to compile, link, & execute some C code.
+
+=head1 FUNCTIONS
+
+=cut
+
+# Here we go into the actual functions
+
+=head2 CPP
+
+Takes one or more arguments. The first is a string containing a C program.
+Embedded newlines are legal, the text simply being stuffed into a temporary
+file. The result is then fed to the C preproccessor (that preproccessor being
+previously determined by perl's Configure script.) Any additional arguments
+provided are passed to the preprocessing command.
+
+In a scalar context, the return value is either undef, if something went wrong,
+or the text returned by the preprocessor. In an array context, two values are
+returned: the numeric exit status and the output of the preproccessor.
+
+=cut
+
+sub CPP { # Feed code to preproccessor, returning error value and output
+
+ my($code,@options) = @_;
+ my($options) = join(" ",@options);
+ my($file) = "tmp$$";
+ my($in,$out) = ($file.".c",$file.".o");
+
+ open(F,">$in");
+ print F $code;
+ close(F);
+
+ print "Preprocessing |$code|\n" if $Verbose;
+ my($result) = scalar(`$C_cppstdin $C_cppflags $C_cppminus $options < $in 2>/dev/null`);
+ print "Executing '$C_cppstdin $C_cppflags $C_cppminus $options < $in 2>/dev/null'\n" if $Verbose;
+
+
+ my($error) = $?;
+ print "Returned |$result|\n" if $Verbose;
+ unlink($in,$out);
+ return ($error ? undef : $result) unless wantarray;
+ ($error,$result);
+}
+
+=head2 Compile
+
+Takes one or more arguments. The first is a string containing a C program.
+Embedded newlines are legal, the text simply being stuffed into a temporary
+file. The result is then fed to the C compiler (that compiler being
+previously determined by perl's Configure script.) Any additional arguments
+provided are passed to the compiler command.
+
+In a scalar context, either 0 or 1 will be returned, with 1 indicating a
+successful compilation. In an array context, three values are returned: the
+numeric exit status of the compiler, a string consisting of the output
+generated by the compiler, and a numeric value that is false if a ".o" file
+wasn't produced by the compiler, error status or no.
+
+=cut
+
+sub Compile { # Feed code to compiler. On error, return status and text
+ my($code,@options) = @_;
+ my($options)=join(" ",@options);
+ my($file) = "tmp$$";
+ my($in,$out) = ($file.".c",$file.".o");
+
+ open(F,">$in");
+ print F $code;
+ close(F);
+ print "Compiling |$code|\n" if $Verbose;
+ my($result) = scalar(`$C_cc $C_ccflags -c $in $C_ldflags $C_libs $options 2>&1`);
+ print "Executing '$C_cc $C_ccflags -c $in $C_ldflags $C_libs $options 2>&1'\n" if $Verbose;
+ my($error) = $?;
+ my($error2) = ! -e $out;
+ unlink($in,$out);
+ return (($error || $error2) ? 0 : 1) unless wantarray;
+ ($error,$result,$error2);
+}
+
+=head2 Link
+
+Takes one or more arguments. The first is a string containing a C program.
+Embedded newlines are legal, the text simply being stuffed into a temporary
+file. The result is then fed to the C compiler and linker (that compiler and
+linker being previously determined by perl's Configure script.) Any
+additional arguments provided are passed to the compilation/link command.
+
+In a scalar context, either 0 or 1 is returned, with 1 indicating a
+successful compilation. In an array context, two values are returned: the
+numeric exit status of the compiler/linker, and a string consisting of the
+output generated by the compiler/linker.
+
+Note that this command I<only> compiles and links the C code. It does not
+attempt to execute it.
+
+=cut
+
+sub Link { # Feed code to compiler and linker. On error, return status and text
+ my($code,@options) = @_;
+ my($options) = join(" ",@options);
+ my($file) = "tmp$$";
+ my($in,$out) = $file.".c",$file.".o";
+
+ open(F,">$in");
+ print F $code;
+ close(F);
+ print "Linking |$code|\n" if $Verbose;
+ my($result) = scalar(`$C_cc $C_ccflags -o $file $in $C_ldflags $C_libs $options 2>&1`);
+ print "Executing '$C_cc $C_ccflags -o $file $in $C_ldflags $C_libs $options 2>&1'\n" if $Verbose;
+ my($error)=$?;
+ print "Error linking: $error, |$result|\n" if $Verbose;
+ unlink($in,$out,$file);
+ return (($error || $result ne "")?0:1) unless wantarray;
+ ($error,$result);
+}
+
+=head2 Execute
+
+Takes one or more arguments. The first is a string containing a C program.
+Embedded newlines are legal, the text simply being stuffed into a temporary
+file. The result is then fed to the C compiler and linker (that compiler and
+linker being previously determined by perl's metaconfig script.) and then
+executed. Any additional arguments provided are passed to the
+compilation/link command. (There is no way to feed arguments to the program
+being executed.)
+
+In a scalar context, the return value is either undef, indicating the
+compilation or link failed, or that the executed program returned a nonzero
+status. Otherwise, the return value is the text output by the program.
+
+In an array context, an array consisting of three values is returned: the
+first value is 0 or 1, 1 if the compile/link succeeded. The second value either
+the exist status of the compiler or program, and the third is the output text.
+
+=cut
+
+sub Execute { #Compile, link, and execute.
+
+ my($code,@options) = @_;
+ my($options)=join(" ",@options);
+ my($file) = "tmp$$";
+ my($in,$out) = $file.".c",$file.".o";
+
+ open(F,">$in");
+ print F $code;
+ close(F);
+ print "Executing |$code|\n" if $Verbose;
+ my($result) = scalar(`$C_cc $C_ccflags -o $file $in $C_ldflags $C_libs $options 2>&1`);
+ print "Executing '$C_cc $C_ccflags -o $file $in $C_ldflags $C_libs $options 2>&1'\n" if $Verbose;
+ my($error) = $?;
+ unlink($in,$out);
+ if(!$error) {
+ my($result2) = scalar(`./$file`);
+ $error = $?;
+ unlink($file);
+ return ($error?undef:$result2) unless wantarray;
+ print "Executed successfully, status $error, link $result, exec |$result2|\n" if $Verbose;
+ (1,$error,$result2);
+ } else {
+ print "Link failed, status $error, message |$result|\n" if $Verbose;
+ return undef unless wantarray;
+ (0,$error,$result);
+ }
+}
+
+=head2 FindHeader
+
+Takes an unlimited number of arguments, consisting of both header names in
+the form "header.h", or directory specifications such as "-I/usr/include/bsd".
+For each supplied header, FindHeader will attempt to find the complete path.
+The return value is an array consisting of all the headers that were located.
+
+=cut
+
+sub FindHeader { #For each supplied header name, find full path
+ my(@headers) = grep(!/^-I/,@_);
+ my(@I) = grep(/^-I/,@_);
+ my($h);
+ for $h (@headers) {
+ print "Searching for $h... " if $Verbose;
+ if($h eq "") {$h=undef; next}
+ if( -f $h) {next}
+ if( -f $Config{"usrinc"}."/".$h) {
+ $h = $Config{"usrinc"}."/".$h;
+ print "Found as $h.\n" if $Verbose;
+ } else {
+ my $text;
+ if($text = CPP("#include <$h>",join(" ",@I))) {
+ grepcpp:
+ for (split(/\s+/,(grep(/^\s*#.*$h/,split(/\n/,$text)))[0])) {
+ if(/$h/) {
+ s/^\"(.*)\"$/$1/;
+ s/^\'(.*)\'$/$1/;
+ $h = $_;
+ print "Found as $h.\n" if $Verbose;
+ last grepcpp;
+ }
+ }
+ } else {
+ $h = undef; # remove header from resulting list
+ print "Not found.\n" if $Verbose;
+ }
+ }
+ }
+ grep($_,@headers);
+}
+
+=head2 FindLib
+
+Takes an unlimited number of arguments, consisting of both library names in
+the form "-llibname", "/usr/lib/libxyz.a" or "dld", or directory
+specifications such as "-L/usr/lib/foo". For each supplied library, FindLib
+will attempt to find the complete path. The return value is an array
+consisting of the full paths to all of the libraries that were located.
+
+=cut
+
+sub FindLib { #For each supplied library name, find full path
+ my(@libs) = grep(!/^-L/,@_);
+ my(@L) = (grep(/^-L/,@_),split(" ",$Config{"libpth"}));
+ grep(s/^-L//,@L);
+ my($l);
+ my($so) = $Config{"so"};
+ my($found);
+ #print "Libaries I am searching for: ",join(",",@libs),"\n";
+ #print "Directories: ",join(",",@L),"\n";
+ my $lib;
+ for $lib (@libs) {
+ print "Searching for $lib... " if $Verbose;
+ $found=0;
+ $lib =~ s/^-l//;
+ if($lib eq "") {$lib=undef; next}
+ next if -f $lib;
+ my $path;
+ for $path (@L) {
+ my ( $fullname, @fullname );
+ print "Searching $path for $lib...\n" if $Verbose;
+ if (@fullname=<${path}/lib${lib}.${so}.[0-9]*>){
+ $fullname=$fullname[-1]; #ATTN: 10 looses against 9!
+ } elsif (-f ($fullname="$path/lib$lib.$so")){
+ } elsif (-f ($fullname="$path/lib${lib}_s.a")
+ && ($lib .= "_s") ){ # we must explicitly ask for _s version
+ } elsif (-f ($fullname="$path/lib$lib.a")){
+ } elsif (-f ($fullname="$path/Slib$lib.a")){
+ } else {
+ warn "$lib not found in $path\n" if $Verbose;
+ next;
+ }
+ warn "'-l$lib' found at $fullname\n" if $Verbose;
+ $lib = $fullname;
+ $found=1;
+ }
+ if(!$found) {
+ $lib = undef; # Remove lib if not found
+ print "Not found.\n" if $Verbose;
+ }
+ }
+ grep($_,@libs);
+}
+
+
+=head2
+
+Apply takes a chunk of code, a series of libraries and headers, and attempts
+to apply them, in series, to a given perl command. In a scalar context, the
+return value of the first set of headers and libraries that produces a
+non-zero return value from the command is returned. In an array context, the
+header and library set it returned.
+
+This is best explained by some examples:
+
+ Apply(\&Compile,"main(){}","sgtty.h","");
+
+In a scalar context either C<undef> or C<1>. In an array context,
+this returns C<()> or C<("sgtty.h","")>.
+
+ Apply(\&Link,"main(){int i=COLOR_PAIRS;}","curses.h","-lcurses",
+ "ncurses.h","-lncurses","ncurses/ncurses.h","-lncurses");
+
+In a scalar context, this returns either C<undef>, C<1>. In an array context,
+this returns C<("curses.h","-lcurses")>, C<("ncurses.h","-lncurses")>,
+C<("ncurses/ncurses.h","-lncurses")>, or C<()>.
+
+If we had instead said
+C<Apply(\&Execute,'main(){printf("%d",(int)COLOR_PAIRS)',...)> then in a scalar
+context either C<undef> or the value of COLOR_PAIRS would be returned.
+
+Note that you can also supply multiple headers and/or libraries at one time,
+like this:
+
+ Apply(\&Compile,"main(){fcntl(0,F_GETFD);}","fcntl.h","",
+ "ioctl.h fcntl.h","","sys/ioctl.h fcntl.h"","");
+
+So if fcntl needs ioctl or sys/ioctl loaded first, this will catch it. In an
+array context, C<()>, C<("fcntl.h","")>, C<("ioctl.h fcntl.h","")>, or
+C<("sys/ioctl.h fcntl.h","")> could be returned.
+
+You can also use nested arrays to get exactly the same effect. The returned
+array will always consist of a string, though, with elements separated by
+spaces.
+
+ Apply(\&Compile,"main(){fcntl(0,F_GETFD);}",["fcntl.h"],"",
+ ["ioctl.h","fcntl.h"],"",["sys/ioctl.h","fcntl.h"],"");
+
+Note that there are many functions that provide simpler ways of doing these
+things, from GetNumericSymbol to get the value of a symbol, to ApplyHeaders
+which doesn't ask for libraries.
+
+=cut
+
+sub Apply { #
+ my($cmd,$code,@lookup) = @_;
+ my(@l,@h,$i,$ret);
+ for ($i=0;$i<@lookup;$i+=2) {
+ if( ref($lookup[$i]) eq "ARRAY" ) {
+ @h = @{$lookup[$i]};
+ } else {
+ @h = split(/\s+/,$lookup[$i]);
+ }
+ if( ref($lookup[$i+1]) eq "ARRAY" ) {
+ @l = @{$lookup[$i+1]};
+ } else {
+ @l = split(/\s+/,$lookup[$i+1]);
+ }
+
+ if($ret=&{$cmd == \&Link && !@l?\&Compile:$cmd}(join("",map($_?"#include <$_>\n":"",grep(!/^-I/,@h))).
+ $code,grep(/^-I/,@h),@l)) {
+ print "Ret=|$ret|\n" if $Verbose;
+ return $ret unless wantarray;
+ return (join(" ",@h),join(" ",@l));
+ }
+ }
+ return 0 unless wantarray;
+ ();
+}
+
+=head2 ApplyHeadersAndLibs
+
+This function takes the same sort of arguments as Apply, it just sends them
+directly to Link.
+
+=cut
+
+sub ApplyHeadersAndLibs { #
+ my($code,@lookup) = @_;
+ Apply \&Link,$code,@lookup;
+}
+
+=head2 ApplyHeadersAndLibsAndExecute
+
+This function is similar to Apply and ApplyHeadersAndLibs, but it always
+uses Execute.
+
+=cut
+
+sub ApplyHeadersAndLibsAndExecute { #
+ my($code,@lookup) = @_;
+ Apply \&Execute,$code,@lookup;
+}
+
+=head2 ApplyHeaders
+
+If you are only checking headers, and don't need to look at libs, then
+you will probably want to use ApplyHeaders. The return value is the same
+in a scalar context, but in an array context the returned array will only
+consists of the headers, spread out.
+
+=cut
+
+sub ApplyHeaders {
+ my($code,@headers) = @_;
+ return scalar(ApplyHeadersAndLibs $code, map(($_,""),@headers))
+ unless wantarray;
+ split(/\s+/,(ApplyHeadersAndLibs $code, map(($_,""),@headers))[0]);
+}
+
+=head2 ApplyLibs
+
+If you are only checking libraries, and don't need to look at headers, then
+you will probably want to use ApplyLibs. The return value is the same
+in a scalar context, but in an array context the returned array will only
+consists of the libraries, spread out.
+
+=cut
+
+sub ApplyLibs {
+ my($code,@libs) = @_;
+ return scalar(ApplyHeadersAndLibs $code, map(("",$_),@libs))
+ unless wantarray;
+ split(/\s+/,(ApplyHeadersAndLibs $code, map(("",$_),@libs))[0]);
+}
+
+=head2 CheckHeader
+
+Takes an unlimited number of arguments, consiting of headers in the
+Apply style. The first set that is fully accepted
+by the compiler is returned.
+
+=cut
+
+sub CheckHeader { #Find a header (or set of headers) that exists
+ ApplyHeaders("main(){}",@_);
+}
+
+=head2 CheckStructure
+
+Takes the name of a structure, and an unlimited number of further arguments
+consisting of header groups. The first group that defines that structure
+properly will be returned. B<undef> will be returned if nothing succeeds.
+
+=cut
+
+sub CheckStructure { # Check existance of a structure.
+ my($structname,@headers) = @_;
+ ApplyHeaders("main(){ struct $structname s;}",@headers);
+}
+
+=head2 CheckField
+
+Takes the name of a structure, the name of a field, and an unlimited number
+of further arguments consisting of header groups. The first group that
+defines a structure that contains the field will be returned. B<undef> will
+be returned if nothing succeeds.
+
+=cut
+
+sub CheckField { # Check for the existance of specified field in structure
+ my($structname,$fieldname,@headers) = @_;
+ ApplyHeaders("main(){ struct $structname s1; struct $structname s2;
+ s1.$fieldname = s2.$fieldname; }",@headers);
+}
+
+=head2 CheckLSymbol
+
+Takes the name of a symbol, and an unlimited number of further arguments
+consisting of library groups. The first group of libraries that defines
+that symbol will be returned. B<undef> will be returned if nothing succeeds.
+
+=cut
+
+sub CheckLSymbol { # Check for linkable symbol
+ my($symbol,@libs) = @_;
+ ApplyLibs("main() { void * f = (void *)($symbol); }",@libs);
+}
+
+=head2 CheckSymbol
+
+Takes the name of a symbol, and an unlimited number of further arguments
+consisting of header and library groups, in the Apply format. The first
+group of headers and libraries that defines that symbol will be returned.
+B<undef> will be returned if nothing succeeds.
+
+=cut
+
+sub CheckSymbol { # Check for linkable/header symbol
+ my($symbol,@lookup) = @_;
+ ApplyHeadersAndLibs("main() { void * f = (void *)($symbol); }",@lookup);
+}
+
+=head2 CheckHSymbol
+
+Takes the name of a symbol, and an unlimited number of further arguments
+consisting of header groups. The first group of headers that defines
+that symbol will be returned. B<undef> will be returned if nothing succeeds.
+
+=cut
+
+sub CheckHSymbol { # Check for header symbol
+ my($symbol,@headers) = @_;
+ ApplyHeaders("main() { void * f = (void *)($symbol); }",@headers);
+}
+
+=head2 CheckHPrototype (unexported)
+
+An experimental routine that takes a name of a function, a nested array
+consisting of the prototype, and then the normal header groups. It attempts
+to deduce whether the given prototype matches what the header supplies.
+Basically, it doesn't work. Or maybe it does. I wouldn't reccomend it,
+though.
+
+=cut
+
+sub CheckHPrototype { # Check for header prototype.
+ # Note: This function is extremely picky about "const int" versus "int",
+ # and depends on having an extremely snotty compiler. Anything but GCC
+ # may fail, and even GCC may not work properly. In any case, if the
+ # names function doesn't exist, this call will _succeed_. Caveat Utilitor.
+ my($function,$proto,@headers) = @_;
+ my(@proto) = @{$proto};
+ ApplyHeaders("main() { extern ".$proto[0]." $function(".
+ join(",",@proto[1..$#proto])."); }",@headers);
+}
+
+=head2 GetSymbol
+
+Takes the name of a symbol, a printf command, a cast, and an unlimited
+number of further arguments consisting of header and library groups, in the
+Apply. The first group of headers and libraries that defines that symbol
+will be used to get the contents of the symbol in the format, and return it.
+B<undef> will be returned if nothing defines that symbol.
+
+Example:
+
+ GetSymbol("__LINE__","ld","long","","");
+
+=cut
+
+sub GetSymbol { # Check for linkable/header symbol
+ my($symbol,$printf,$cast,@lookup) = @_,"","";
+ scalar(ApplyHeadersAndLibsAndExecute(
+ "main(){ printf(\"\%$printf\",($cast)($symbol));exit(0);}",@lookup));
+}
+
+=head2 GetTextSymbol
+
+Takes the name of a symbol, and an unlimited number of further arguments
+consisting of header and library groups, in the ApplyHeadersAndLibs format.
+The first group of headers and libraries that defines that symbol will be
+used to get the contents of the symbol in text format, and return it.
+B<undef> will be returned if nothing defines that symbol.
+
+Note that the symbol I<must> actually be text, either a char* or a constant
+string. Otherwise, the results are undefined.
+
+=cut
+
+sub GetTextSymbol { # Check for linkable/header symbol
+ my($symbol,@lookup) = @_,"","";
+ my($result) = GetSymbol($symbol,"s","char*",@lookup);
+ $result .= "" if defined($result);
+ $result;
+}
+
+=head2 GetNumericSymbol
+
+Takes the name of a symbol, and an unlimited number of further arguments
+consisting of header and library groups, in the ApplyHeadersAndLibs format.
+The first group of headers and libraries that defines that symbol will be
+used to get the contents of the symbol in numeric format, and return it.
+B<undef> will be returned if nothing defines that symbol.
+
+Note that the symbol I<must> actually be numeric, in a format compatible
+with a float. Otherwise, the results are undefined.
+
+=cut
+
+sub GetNumericSymbol { # Check for linkable/header symbol
+ my($symbol,@lookup) = @_,"","";
+ my($result) = GetSymbol($symbol,"f","float",@lookup);
+ $result += 0 if defined($result);
+ $result;
+}
+
+=head2 GetConstants
+
+Takes a list of header names (possibly including -I directives) and attempts
+to grep the specified files for constants, a constant being something #defined
+with a name that matches /[A-Z0-9_]+/. Returns the list of names.
+
+=cut
+
+sub GetConstants { # Try to grep constants out of a header
+ my(@headers) = @_;
+ @headers = FindHeader(@headers);
+ my %seen;
+ my(%results);
+ map($seen{$_}=1,@headers);
+ while(@headers) {
+ $_=shift(@headers);
+ next if !defined($_);
+ open(SEARCHHEADER,"<$_");
+ while(<SEARCHHEADER>) {
+ if(/^\s*#\s*define\s+([A-Z_][A-Za-z0-9_]+)\s+/) {
+ $results{$1} = 1;
+ } elsif(/^\s*#\s*include\s+[<"]?([^">]+)[>"]?/) {
+ my(@include) = FindHeader($1);
+ @include = grep(!$seen{$_},map(defined($_)?$_:(),@include));
+ push(@headers,@include);
+ map($seen{$_}=1,@include);
+ }
+ }
+ close(SEARCHHEADER);
+ }
+ keys %results;
+}
+
+
+=head2 DeducePrototype (unexported)
+
+This one is B<really> experimental. The idea is to figure out some basic
+characteristics of the compiler, and then attempt to "feel out" the prototype
+of a function. Eventually, it may work. It is guaranteed to be very slow,
+and it may simply not be capable of working on some systems.
+
+=cut
+
+my $firstdeduce = 1;
+sub DeducePrototype {
+
+ my (@types, $checkreturn, $checknilargs, $checkniletcargs, $checkreturnnil);
+
+ if($firstdeduce) {
+ $firstdeduce=0;
+ my $checknumber=!Compile("extern int func(int a,int b);
+ extern int func(int a,int b,int c);
+ main(){}");
+ $checkreturn=!Compile("extern int func(int a,int b);
+ extern long func(int a,int b);
+ main(){}");
+ my $checketc= !Compile("extern int func(int a,int b);
+ extern long func(int a,...);
+ main(){}");
+ my $checknumberetc=!Compile("extern int func(int a,int b);
+ extern int func(int a,int b,...);
+ main(){}");
+ my $checketcnumber=!Compile("extern int func(int a,int b,int c,...);
+ extern int func(int a,int b,...);
+ main(){}");
+ my $checkargtypes=!Compile("extern int func(int a);
+ extern int func(long a);
+ main(){}");
+ my $checkargsnil=!Compile("extern int func();
+ extern int func(int a,int b,int c);
+ main(){}");
+ $checknilargs=!Compile("extern int func(int a,int b,int c);
+ extern int func();
+ main(){}");
+ my $checkargsniletc=!Compile("extern int func(...);
+ extern int func(int a,int b,int c);
+ main(){}");
+ $checkniletcargs=!Compile("extern int func(int a,int b,int c);
+ extern int func(...);
+ main(){}");
+
+ my $checkconst=!Compile("extern int func(const int * a);
+ extern int func(int * a);
+ main(){ }");
+
+ my $checksign=!Compile("extern int func(int a);
+ extern int func(unsigned int a);
+ main(){ }");
+
+ $checkreturnnil=!Compile("extern func(int a);
+ extern void func(int a);
+ main(){ }");
+
+ @types = sort grep(Compile("main(){$_ a;}"),
+ "void","int","long int","unsigned int","unsigned long int","long long int",
+ "long long","unsigned long long",
+ "unsigned long long int","float","long float",
+ "double","long double",
+ "char","unsigned char","short int","unsigned short int");
+
+ if(Compile("main(){flurfie a;}")) { @types = (); }
+
+ $Verbose=0;
+
+ # Attempt to remove duplicate types (if any) from type list
+ my ( $i, $j );
+ if($checkargtypes) {
+ for ($i=0;$i<=$#types;$i++) {
+ for ($j=$i+1;$j<=$#types;$j++) {
+ next if $j==$i;
+ if(Compile("extern void func($types[$i]);
+ extern void func($types[$j]); main(){}")) {
+ print "Removing type $types[$j] because it equals $types[$i]\n";
+ splice(@types,$j,1);
+ $j--;
+ }
+ }
+ }
+ } elsif($checkreturn) {
+ for ($i=0;$i<=$#types;$i++) {
+ for ($j=$i+1;$j<=$#types;$j++) {
+ next if $j==$i;
+ if(Compile("$types[$i] func(void);
+ extern $types[$j] func(void); main(){}")) {
+ print "Removing type $types[$j] because it equals $types[$i]\n";
+ splice(@types,$j,1);
+ $j--;
+ }
+ }
+ }
+ }
+ $Verbose=1;
+
+ print "Detect differing numbers of arguments: $checknumber\n";
+ print "Detect differing return types: $checkreturn\n";
+ print "Detect differing argument types if one is ...: $checketc\n";
+ print "Detect differing numbers of arguments if ... is involved: $checknumberetc\n";
+ print "Detect differing numbers of arguments if ... is involved #2: $checketcnumber\n";
+ print "Detect differing argument types: $checkargtypes\n";
+ print "Detect differing argument types if first has no defined args: $checkargsnil\n";
+ print "Detect differing argument types if second has no defined args: $checknilargs\n";
+ print "Detect differing argument types if first has only ...: $checkargsniletc\n";
+ print "Detect differing argument types if second has only ...: $checkniletcargs\n";
+ print "Detect differing argument types by constness: $checkconst\n";
+ print "Detect differing argument types by signedness: $checksign\n";
+ print "Detect differing return types if one is not defined: $checkreturnnil\n";
+ print "Types known: ",join(",",@types),"\n";
+
+ }
+
+ my($function,@headers) = @_;
+ @headers = CheckHSymbol($function,@headers);
+ return undef if !@headers;
+
+ my $rettype = undef;
+ my @args = ();
+ my @validcount = ();
+
+ # Can we check the return type without worry about arguements?
+ if($checkreturn and (!$checknilargs or !$checkniletcargs)) {
+ for (@types) {
+ if(ApplyHeaders("extern $_ $function(". ($checknilargs?"...":"").");main(){}",[@headers])) {
+ $rettype = $_; # Great, we found the return type.
+ last;
+ }
+ }
+ }
+
+ if(!defined($rettype) and $checkreturnnil) {
+ die "No way to deduce function prototype in a rational amount of time";
+ }
+
+ my $numargs=-1;
+ my $varargs=0;
+ for (0..32) {
+ if(ApplyHeaders("main(){ $function(".join(",",("0") x $_).");}",@headers)) {
+ $numargs=$_;
+ if(ApplyHeaders("main(){ $function(".join(",",("0") x ($_+1)).");}",@headers)) {
+ $varargs=1;
+ }
+ last
+ }
+ }
+
+ die "Unable to deduce number of arguments" if $numargs==-1;
+
+ if($varargs) { $args[$numargs]="..."; }
+
+ # OK, now we know how many arguments the thing takes.
+
+
+ if(@args>0 and !defined($rettype)) {
+ for (@types) {
+ if(defined(ApplyHeaders("extern $_ $function(".join(",",@args).");main(){}",[@headers]))) {
+ $rettype = $_; # Great, we found the return type.
+ last;
+ }
+ }
+ }
+
+ print "Return type: $rettype\nArguments: ",join(",",@args),"\n";
+ print "Valid number of arguments: $numargs\n";
+ print "Accepts variable number of args: $varargs\n";
+}
+
+
+#$Verbose=1;
+
+#print scalar(join("|",CheckHeader("sgtty.h"))),"\n";
+#print scalar(join("|",FindHeader(CheckHeader("sgtty.h")))),"\n";
+#print scalar(join("|",CheckSymbol("COLOR_PAIRS","curses.h","-lcurses","ncurses.h","-lncurses","ncurses/ncurses.h","ncurses/libncurses.a"))),"\n";
+#print scalar(join("|",GetNumericSymbol("PRIO_USER","sys/resource.h",""))),"\n";
+
diff --git a/gnu/usr.bin/perl/cpan/Term-ReadKey/MANIFEST b/gnu/usr.bin/perl/cpan/Term-ReadKey/MANIFEST
new file mode 100644
index 00000000000..b4c40774254
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/Term-ReadKey/MANIFEST
@@ -0,0 +1,15 @@
+Configure.pm
+MANIFEST
+MANIFEST.SKIP
+Makefile.PL
+README
+ReadKey.pm
+ReadKey.xs
+genchars.pl
+ppport.h
+example/test.pl
+t/01_basic.t
+t/02_terminal_functions.t
+Changes
+META.yml Module meta-data (added by MakeMaker)
+META.json Module JSON meta-data (added by MakeMaker)
diff --git a/gnu/usr.bin/perl/cpan/Term-ReadKey/MANIFEST.SKIP b/gnu/usr.bin/perl/cpan/Term-ReadKey/MANIFEST.SKIP
new file mode 100644
index 00000000000..422a152da8d
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/Term-ReadKey/MANIFEST.SKIP
@@ -0,0 +1,3 @@
+.gitignore
+.travis.yml
+.git
diff --git a/gnu/usr.bin/perl/cpan/Term-ReadKey/META.json b/gnu/usr.bin/perl/cpan/Term-ReadKey/META.json
new file mode 100644
index 00000000000..bcc2fdac4e9
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/Term-ReadKey/META.json
@@ -0,0 +1,49 @@
+{
+ "abstract" : "unknown",
+ "author" : [
+ "unknown"
+ ],
+ "dynamic_config" : 1,
+ "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142060",
+ "license" : [
+ "perl_5"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "TermReadKey",
+ "no_index" : {
+ "directory" : [
+ "t",
+ "inc"
+ ],
+ "file" : [
+ "Configure.pm"
+ ],
+ "package" : [
+ "Configure"
+ ]
+ },
+ "prereqs" : {
+ "build" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "configure" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "repository" : {
+ "type" : "git",
+ "url" : "https://github.com/jonathanstowe/TermReadKey.git",
+ "web" : "https://github.com/jonathanstowe/TermReadKey"
+ }
+ },
+ "version" : "2.33"
+}
diff --git a/gnu/usr.bin/perl/cpan/Term-ReadKey/META.yml b/gnu/usr.bin/perl/cpan/Term-ReadKey/META.yml
new file mode 100644
index 00000000000..89dde468ca5
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/Term-ReadKey/META.yml
@@ -0,0 +1,26 @@
+---
+abstract: unknown
+author:
+ - unknown
+build_requires:
+ ExtUtils::MakeMaker: '0'
+configure_requires:
+ ExtUtils::MakeMaker: '0'
+dynamic_config: 1
+generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142060'
+license: perl
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: '1.4'
+name: TermReadKey
+no_index:
+ directory:
+ - t
+ - inc
+ file:
+ - Configure.pm
+ package:
+ - Configure
+resources:
+ repository: https://github.com/jonathanstowe/TermReadKey.git
+version: '2.33'
diff --git a/gnu/usr.bin/perl/cpan/Term-ReadKey/Makefile.PL b/gnu/usr.bin/perl/cpan/Term-ReadKey/Makefile.PL
new file mode 100644
index 00000000000..4c97e22a897
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/Term-ReadKey/Makefile.PL
@@ -0,0 +1,86 @@
+
+use ExtUtils::MakeMaker;
+use Carp;
+
+my $mm_version = $ExtUtils::MakeMaker::VERSION || $ExtUtils::MakeMaker::Version;
+if( $mm_version < 3.5 ) {
+ croak("Sorry, but MakeMaker 3.5 or better is needed to build this package.");
+}
+
+&WriteMakefile(
+ NAME => 'Term::ReadKey',
+ DISTNAME => 'TermReadKey',
+ LICENSE => 'perl',
+ META_MERGE => {
+ no_index => {
+ file => [qw(Configure.pm)],
+ package => [qw(Configure)],
+ },
+ 'meta-spec' => { version => 2 },
+ resources => {
+ repository => {
+ type => 'git',
+ url => 'https://github.com/jonathanstowe/TermReadKey.git',
+ web => 'https://github.com/jonathanstowe/TermReadKey',
+ },
+ },
+ },
+ VERSION_FROM => 'ReadKey.pm',
+ XSPROTOARG => '-noprototypes',
+ PM => { "ReadKey.pm" => '$(INST_LIBDIR)/ReadKey.pm'},
+
+ 'dist' => { COMPRESS=>"gzip", SUFFIX=>"gz" },
+ "test" => {
+ "TESTS" => "t/*.t"
+ }
+
+# Uncomment these to allow testing of sgtty under Linux. Not needed normally.
+# INC => "-I/usr/include/bsd",
+# LIBS => "-lbsd"
+);
+
+sub MY::realclean {
+ my $self = shift;
+ $_ = $self->MM::realclean();
+ s/\t/\trm -f cchars.h\n\t/;
+ $_;
+}
+
+sub MY::top_targets {
+ my $self = shift;
+ $_ = $self->MM::top_targets();
+ $_ .= "
+
+sgtty cchars.h: genchars.pl
+ \$(PERL) -I. -I\$(PERL_LIB) genchars.pl
+
+distcc: genchars.pl
+ \$(PERL) -I. -I\$(PERL_LIB) genchars.pl dist
+
+ReadKey.c: cchars.h
+
+";
+ $_;
+
+}
+
+sub MY::test {
+ my $self = shift;
+ $_ = $self->MM::test();
+ s#example/test.pl#-w example/test.pl#;
+ $_;
+}
+
+sub MY::test_interactive
+{
+ return "Fooo";
+}
+
+sub MY::pure_site_install
+{
+ my $self = shift;
+ my $new = $self->MM::test();
+
+ $new .= "\n\t./register_module Your::Module";
+ return $new;
+}
diff --git a/gnu/usr.bin/perl/cpan/Term-ReadKey/README b/gnu/usr.bin/perl/cpan/Term-ReadKey/README
new file mode 100644
index 00000000000..8769c8d1da3
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/Term-ReadKey/README
@@ -0,0 +1,145 @@
+ Term::ReadKey 2.33 - Change terminal modes, and perform non-blocking reads.
+
+ Copyright (C) 1994-1999 Kenneth Albanowski.
+ 2001-2015 Jonathan Stowe and others
+
+This package is dual licensed. You can either choose to license it under
+the original terms which were:
+
+ Unlimited distribution and/or modification is allowed as long as this
+ copyright notice remains intact.
+
+Or the standard Perl terms:
+
+ This module is free software; you can redistribute it and/or modify it
+ under the terms of the Artistic License. For details, see the full
+ text of the license in the file "Artistic" that should have been provided
+ with the version of perl you are using.
+
+ 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.
+
+
+
+This module, ReadKey, provides ioctl control for terminals and Win32
+consoles so the input modes can be changed (thus allowing reads of a single
+character at a time), and also provides non-blocking reads of stdin, as well
+as several other terminal related features, including retrieval/modification
+of the screen size, and retrieval/modification of the control characters.
+Installation requires MakeMaker 3.5 or higher (MakeMaker 3.7 is included
+with perl 5.001, so now is a good time to upgrade if you haven't already.)
+
+To install, unpack somewhere, type "perl Makefile.PL", and then "make test".
+If the compilation and the tests are successful, then change to root and run
+"make install".
+
+As of 2.17 the interactive test has been removed as the default for the
+convenience of automated installers, CPAN-Testers and so on. The non
+interactive tests whilst confirming that the module has built correctly
+and has a good chance of working correctly cannot determine whether the
+effect as observed on the screen is correct so you might want to run:
+
+ perl -Mblib example/test.pl interactive
+
+before you run 'make install'.
+
+Also from 2.17 this module has to provide its own support for compilers
+that can't take function prototypes as with Perl 5.8.0 this last vestige
+of support for non-ANSI compilers will disappear. The requirement for
+an ANSI C compiler has been present since Perl 5.005 so it is likely that
+at some point in the future this module will follow that requirement too.
+If you have any difficulties with older Perl's please contact the maintainer.
+
+The module has support for Win32 since version 2.10. Version 2.17 has been
+tested with ActivePerl build 623 and Visual Studio 6 and found to work
+as expected, but do not be surprised if it fails with another compiler
+or distribution. There are some limitations, with the ReadLine call
+being unavailable, and ReadKey possibly generating bad results if you
+are reading from multiple consoles, and key repeat is used. For Win32
+users without a C compiler there is a precompiled version of this module
+available as a package for ActivePerl, it is probably a few versions
+behind the latest release but has been reported to work well.
+
+VERY IMPORTANT: In 2.00, the ReadKey/ReadLine arguments changed. Now, if
+you want a call that is non-blocking and returns immediately if no
+character is waiting, please call it with -1, instead of 1. Positive
+arguments now indicate a timeout, so 1 would wait a second before timing
+out.
+
+As older versions will accept -1, it is reccomended to change all code
+that uses ReadMode.
+
+
+The terminal mode function is controlled by the "ReadMode" function, which
+takes a single numeric argument, and an optional filehandle. This argument
+should be one of the following:
+
+ 0: (Reset) Restore original settings.
+
+ 1: (Cooked) Change to what is commonly the default mode, echo on,
+ buffered, signals enabled, Xon/Xoff possibly enabled, and 8-bit mode
+ possibly disabled.
+
+ 2: (Cooked-Invisible) Same as 1, just with echo off. Nice for reading
+ passwords.
+
+ 3: (CBreak) Echo off, unbuffered, signals enabled, Xon/Xoff possibly
+ enabled, and 8-bit mode possibly enabled.
+
+ 4: (Raw) Echo off, unbuffered, signals disabled, Xon/Xoff disabled,
+ and 8-bit mode possibly disabled.
+
+ 5: (Really-Raw) Echo off, unbuffered, signals disabled, Xon/Xoff
+ disabled, 8-bit mode enabled if parity permits, and CR to CR/LF
+ translation turned off.
+
+If you just need to read a key at a time, then modes 3 or 4 are probably
+sufficient. Mode 4 is a tad more flexible, but needs a bit more work to
+control. If you use ReadMode 3, then you should install a SIGINT or END
+handler to reset the terminal (via ReadMode 0) if the user aborts the
+program via ^C. (For any mode, an END handler consisting of "ReadMode 0" is
+actually a good idea.)
+
+Non-blocking support is provided via the ReadKey and ReadLine functions. If
+they are passed no argument, or an argument of zero, they will act like a
+normal getc(STDIN) or scalar(<STDIN>). If they are passed a negative
+argument, then they will immediatly return undef if no input is present. If
+passed a positive argument, then they will wait until that time in seconds
+has passed before returning undef. In most situations, you will probably
+want to use "ReadKey -1".
+
+Note that a non-blocking ReadLine probably won't do what you expect,
+although it is perfectly predictable, and that the ReadMode will have to be
+1 or 0 for it to make sense at all.
+
+A routine is also provided to get the current terminal size,
+"GetTerminalSize". This will either return a four value array containing the
+width and height of the screen in characters and then in pixels, or nothing
+( if the OS can't return that info). SetTerminalSize allows the stored
+settings to be modified. Note that this does _not_ change the physical size
+of the screen, it will only change the size reported by GetTerminalSize, and
+other programs that check the terminal size in the same manner.
+
+GetControlChars returns a hash containing all of the valid control
+characters, such as ("INTERRUPT" => "\x3", etc.). SetControlChars takes an
+array (or a hash) as a parameter that should consist of similar name/value
+pairs and will modify the control character settings.
+
+Note that it is entirely possible that there are portability problems with
+the routines in ReadKey.xs. If you find any problems, including compilation
+failures, or control characters not supported by Set/GetControlChars,
+_please_ tell me about them, by mailing the maintainer at jns@gellyfish.co.uk,
+ or lastly contacting perl5-porters@perl.org. Any problems
+will get fixed if at all possible, but that's not going to happen if I don't
+know about them.
+
+The code is available at https://github.com/jonathanstowe/TermReadKey so
+as ever patches are kindly welcomed, especially for platforms such as
+Windows that I am unable to test on.
+
+Oh, you may also be interested in the Configure.pm module. It provides tools
+to make porting stuff easier -- calling the compiler, finding headers, etc.
+It contains documentation inside it, and you are welcome to use it in your
+own modules. If you make use of it, I'd be grateful for a message sent to
+the above address.
diff --git a/gnu/usr.bin/perl/cpan/Term-ReadKey/ReadKey.pm b/gnu/usr.bin/perl/cpan/Term-ReadKey/ReadKey.pm
new file mode 100644
index 00000000000..a2642e130cc
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/Term-ReadKey/ReadKey.pm
@@ -0,0 +1,654 @@
+package Term::ReadKey;
+
+=head1 NAME
+
+Term::ReadKey - A perl module for simple terminal control
+
+=head1 SYNOPSIS
+
+ use Term::ReadKey;
+ ReadMode 4; # Turn off controls keys
+ while (not defined ($key = ReadKey(-1))) {
+ # No key yet
+ }
+ print "Get key $key\n";
+ ReadMode 0; # Reset tty mode before exiting
+
+=head1 DESCRIPTION
+
+Term::ReadKey is a compiled perl module dedicated to providing simple
+control over terminal driver modes (cbreak, raw, cooked, etc.,) support for
+non-blocking reads, if the architecture allows, and some generalized handy
+functions for working with terminals. One of the main goals is to have the
+functions as portable as possible, so you can just plug in "use
+Term::ReadKey" on any architecture and have a good likelihood of it working.
+
+Version 2.30.01:
+Added handling of arrows, page up/down, home/end, insert/delete keys
+under Win32. These keys emit xterm-compatible sequences.
+Works with Term::ReadLine::Perl.
+
+=over 4
+
+=item ReadMode MODE [, Filehandle]
+
+Takes an integer argument or a string synonym (case insensitive), which
+can currently be one of the following values:
+
+ INT SYNONYM DESCRIPTION
+
+ 0 'restore' Restore original settings.
+
+ 1 'normal' Change to what is commonly the default mode,
+ echo on, buffered, signals enabled, Xon/Xoff
+ possibly enabled, and 8-bit mode possibly disabled.
+
+ 2 'noecho' Same as 1, just with echo off. Nice for
+ reading passwords.
+
+ 3 'cbreak' Echo off, unbuffered, signals enabled, Xon/Xoff
+ possibly enabled, and 8-bit mode possibly enabled.
+
+ 4 'raw' Echo off, unbuffered, signals disabled, Xon/Xoff
+ disabled, and 8-bit mode possibly disabled.
+
+ 5 'ultra-raw' Echo off, unbuffered, signals disabled, Xon/Xoff
+ disabled, 8-bit mode enabled if parity permits,
+ and CR to CR/LF translation turned off.
+
+
+These functions are automatically applied to the STDIN handle if no
+other handle is supplied. Modes 0 and 5 have some special properties
+worth mentioning: not only will mode 0 restore original settings, but it
+cause the next ReadMode call to save a new set of default settings. Mode
+5 is similar to mode 4, except no CR/LF translation is performed, and if
+possible, parity will be disabled (only if not being used by the terminal,
+however. It is no different from mode 4 under Windows.)
+
+If you just need to read a key at a time, then modes 3 or 4 are probably
+sufficient. Mode 4 is a tad more flexible, but needs a bit more work to
+control. If you use ReadMode 3, then you should install a SIGINT or END
+handler to reset the terminal (via ReadMode 0) if the user aborts the
+program via C<^C>. (For any mode, an END handler consisting of "ReadMode 0"
+is actually a good idea.)
+
+If you are executing another program that may be changing the terminal mode,
+you will either want to say
+
+ ReadMode 1; # same as ReadMode 'normal'
+ system('someprogram');
+ ReadMode 1;
+
+which resets the settings after the program has run, or:
+
+ $somemode=1;
+ ReadMode 0; # same as ReadMode 'restore'
+ system('someprogram');
+ ReadMode 1;
+
+which records any changes the program may have made, before resetting the
+mode.
+
+=item ReadKey MODE [, Filehandle]
+
+Takes an integer argument, which can currently be one of the following
+values:
+
+ 0 Perform a normal read using getc
+ -1 Perform a non-blocked read
+ >0 Perform a timed read
+
+If the filehandle is not supplied, it will default to STDIN. If there is
+nothing waiting in the buffer during a non-blocked read, then undef will be
+returned. In most situations, you will probably want to use C<ReadKey -1>.
+
+I<NOTE> that if the OS does not provide any known mechanism for non-blocking
+reads, then a C<ReadKey -1> can die with a fatal error. This will hopefully
+not be common.
+
+If MODE is greater then zero, then ReadKey will use it as a timeout value in
+seconds (fractional seconds are allowed), and won't return C<undef> until
+that time expires.
+
+I<NOTE>, again, that some OS's may not support this timeout behaviour.
+
+If MODE is less then zero, then this is treated as a timeout
+of zero, and thus will return immediately if no character is waiting. A MODE
+of zero, however, will act like a normal getc.
+
+I<NOTE>, there are currently some limitations with this call under Windows.
+It may be possible that non-blocking reads will fail when reading repeating
+keys from more then one console.
+
+
+=item ReadLine MODE [, Filehandle]
+
+Takes an integer argument, which can currently be one of the following
+values:
+
+ 0 Perform a normal read using scalar(<FileHandle>)
+ -1 Perform a non-blocked read
+ >0 Perform a timed read
+
+If there is nothing waiting in the buffer during a non-blocked read, then
+undef will be returned.
+
+I<NOTE>, that if the OS does not provide any known mechanism for
+non-blocking reads, then a C<ReadLine 1> can die with a fatal
+error. This will hopefully not be common.
+
+I<NOTE> that a non-blocking test is only performed for the first character
+in the line, not the entire line. This call will probably B<not> do what
+you assume, especially with C<ReadMode> MODE values higher then 1. For
+example, pressing Space and then Backspace would appear to leave you
+where you started, but any timeouts would now be suspended.
+
+B<This call is currently not available under Windows>.
+
+=item GetTerminalSize [Filehandle]
+
+Returns either an empty array if this operation is unsupported, or a four
+element array containing: the width of the terminal in characters, the
+height of the terminal in character, the width in pixels, and the height in
+pixels. (The pixel size will only be valid in some environments.)
+
+I<NOTE>, under Windows, this function must be called with an B<output>
+filehandle, such as C<STDOUT>, or a handle opened to C<CONOUT$>.
+
+=item SetTerminalSize WIDTH,HEIGHT,XPIX,YPIX [, Filehandle]
+
+Return -1 on failure, 0 otherwise.
+
+I<NOTE> that this terminal size is only for B<informative> value, and
+changing the size via this mechanism will B<not> change the size of
+the screen. For example, XTerm uses a call like this when
+it resizes the screen. If any of the new measurements vary from the old, the
+OS will probably send a SIGWINCH signal to anything reading that tty or pty.
+
+B<This call does not work under Windows>.
+
+=item GetSpeeds [, Filehandle]
+
+Returns either an empty array if the operation is unsupported, or a two
+value array containing the terminal in and out speeds, in B<decimal>. E.g,
+an in speed of 9600 baud and an out speed of 4800 baud would be returned as
+(9600,4800). Note that currently the in and out speeds will always be
+identical in some OS's.
+
+B<No speeds are reported under Windows>.
+
+=item GetControlChars [, Filehandle]
+
+Returns an array containing key/value pairs suitable for a hash. The pairs
+consist of a key, the name of the control character/signal, and the value
+of that character, as a single character.
+
+B<This call does nothing under Windows>.
+
+Each key will be an entry from the following list:
+
+ DISCARD
+ DSUSPEND
+ EOF
+ EOL
+ EOL2
+ ERASE
+ ERASEWORD
+ INTERRUPT
+ KILL
+ MIN
+ QUIT
+ QUOTENEXT
+ REPRINT
+ START
+ STATUS
+ STOP
+ SUSPEND
+ SWITCH
+ TIME
+
+Thus, the following will always return the current interrupt character,
+regardless of platform.
+
+ %keys = GetControlChars;
+ $int = $keys{INTERRUPT};
+
+=item SetControlChars [, Filehandle]
+
+Takes an array containing key/value pairs, as a hash will produce. The pairs
+should consist of a key that is the name of a legal control
+character/signal, and the value should be either a single character, or a
+number in the range 0-255. SetControlChars will die with a runtime error if
+an invalid character name is passed or there is an error changing the
+settings. The list of valid names is easily available via
+
+ %cchars = GetControlChars();
+ @cnames = keys %cchars;
+
+B<This call does nothing under Windows>.
+
+=back
+
+=head1 AUTHOR
+
+Kenneth Albanowski <kjahds@kjahds.com>
+
+Currently maintained by Jonathan Stowe <jns@gellyfish.co.uk>
+
+=head1 SUPPORT
+
+The code is maintained at
+
+ https://github.com/jonathanstowe/TermReadKey
+
+Please feel free to fork and suggest patches.
+
+
+=head1 LICENSE
+
+Prior to the 2.31 release the license statement was:
+
+ Copyright (C) 1994-1999 Kenneth Albanowski.
+ 2001-2005 Jonathan Stowe and others
+
+ Unlimited distribution and/or modification is allowed as long as this
+ copyright notice remains intact.
+
+And was only stated in the README file.
+
+Because I believe the original author's intent was to be more open than the
+other commonly used licenses I would like to leave that in place. However if
+you or your lawyers require something with some more words you can optionally
+choose to license this under the standard Perl license:
+
+ This module is free software; you can redistribute it and/or modify it
+ under the terms of the Artistic License. For details, see the full
+ text of the license in the file "Artistic" that should have been provided
+ with the version of perl you are using.
+
+ 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.
+
+
+=cut
+
+use vars qw($VERSION);
+
+$VERSION = '2.33';
+
+require Exporter;
+require AutoLoader;
+require DynaLoader;
+use Carp;
+
+@ISA = qw(Exporter AutoLoader DynaLoader);
+
+# Items to export into callers namespace by default
+# (move infrequently used names to @EXPORT_OK below)
+
+@EXPORT = qw(
+ ReadKey
+ ReadMode
+ ReadLine
+ GetTerminalSize
+ SetTerminalSize
+ GetSpeed
+ GetControlChars
+ SetControlChars
+);
+
+@EXPORT_OK = qw();
+
+bootstrap Term::ReadKey;
+
+# Preloaded methods go here. Autoload methods go after __END__, and are
+# processed by the autosplit program.
+
+# Should we use LINES and COLUMNS to try and get the terminal size?
+# Change this to zero if you have systems where these are commonly
+# set to erroneous values. (But if either are near zero, they won't be
+# used anyhow.)
+
+$UseEnv = 1;
+
+$CurrentMode = 0;
+
+%modes = ( # lowercase is canonical
+ original => 0,
+ restore => 0,
+ normal => 1,
+ noecho => 2,
+ cbreak => 3,
+ raw => 4,
+ 'ultra-raw' => 5
+);
+
+sub ReadMode
+{
+ my ($mode) = $modes{ lc $_[0] }; # lowercase is canonical
+ my ($fh) = normalizehandle( ( @_ > 1 ? $_[1] : \*STDIN ) );
+ if ( defined($mode) ) { $CurrentMode = $mode }
+ elsif ( $_[0] =~ /^\d/ ) { $CurrentMode = $_[0] }
+ else { croak("Unknown terminal mode `$_[0]'"); }
+ SetReadMode($CurrentMode, $fh);
+}
+
+sub normalizehandle
+{
+ my ($file) = @_;
+
+ # print "Handle = $file\n";
+ if ( ref($file) ) { return $file; } # Reference is fine
+
+ # if($file =~ /^\*/) { return $file; } # Type glob is good
+ if ( ref( \$file ) eq 'GLOB' ) { return $file; } # Glob is good
+
+ # print "Caller = ",(caller(1))[0],"\n";
+ return \*{ ( ( caller(1) )[0] ) . "::$file" };
+}
+
+sub GetTerminalSize
+{
+ my ($file) = normalizehandle( ( @_ > 1 ? $_[1] : \*STDOUT ) );
+ my (@results) = ();
+ my (@fail);
+
+ if ( &termsizeoptions() & 1 ) # VIO
+ {
+ @results = GetTermSizeVIO($file);
+ push( @fail, "VIOGetMode call" );
+ }
+ elsif ( &termsizeoptions() & 2 ) # GWINSZ
+ {
+ @results = GetTermSizeGWINSZ($file);
+ push( @fail, "TIOCGWINSZ ioctl" );
+ }
+ elsif ( &termsizeoptions() & 4 ) # GSIZE
+ {
+ @results = GetTermSizeGSIZE($file);
+ push( @fail, "TIOCGSIZE ioctl" );
+ }
+ elsif ( &termsizeoptions() & 8 ) # WIN32
+ {
+ @results = GetTermSizeWin32($file);
+ push( @fail, "Win32 GetConsoleScreenBufferInfo call" );
+ }
+ else
+ {
+ @results = ();
+ }
+
+ if ( @results < 4 and $UseEnv )
+ {
+ my ($C) = defined( $ENV{COLUMNS} ) ? $ENV{COLUMNS} : 0;
+ my ($L) = defined( $ENV{LINES} ) ? $ENV{LINES} : 0;
+ if ( ( $C >= 2 ) and ( $L >= 2 ) )
+ {
+ @results = ( $C + 0, $L + 0, 0, 0 );
+ }
+ push( @fail, "COLUMNS and LINES environment variables" );
+ }
+
+ if ( @results < 4 && $^O ne 'MSWin32')
+ {
+ my ($prog) = "resize";
+
+ # Workaround for Solaris path silliness
+ if ( -f "/usr/openwin/bin/resize" ) {
+ $prog = "/usr/openwin/bin/resize";
+ }
+
+ my ($resize) = scalar(`$prog 2>/dev/null`);
+ if (
+ defined $resize
+ and ( $resize =~ /COLUMNS\s*=\s*(\d+)/
+ or $resize =~ /setenv\s+COLUMNS\s+'?(\d+)/ )
+ )
+ {
+ $results[0] = $1;
+ if ( $resize =~ /LINES\s*=\s*(\d+)/
+ or $resize =~ /setenv\s+LINES\s+'?(\d+)/ )
+ {
+ $results[1] = $1;
+ @results[ 2, 3 ] = ( 0, 0 );
+ }
+ else
+ {
+ @results = ();
+ }
+ }
+ else
+ {
+ @results = ();
+ }
+ push( @fail, "resize program" );
+ }
+
+ if ( @results < 4 && $^O ne 'MSWin32' )
+ {
+ my ($prog) = "stty size";
+
+ my ($stty) = scalar(`$prog 2>/dev/null`);
+ if (
+ defined $stty
+ and ( $stty =~ /(\d+) (\d+)/ )
+ )
+ {
+ $results[0] = $2;
+ $results[1] = $1;
+ @results[ 2, 3 ] = ( 0, 0 );
+ }
+ else
+ {
+ @results = ();
+ }
+ push( @fail, "stty program" );
+ }
+
+ if ( @results != 4 )
+ {
+ warn "Unable to get Terminal Size."
+ . join( "", map( " The $_ didn't work.", @fail ) );
+ return undef;
+ }
+
+ @results;
+}
+
+if ( &blockoptions() & 1 ) # Use nodelay
+{
+ if ( &blockoptions() & 2 ) #poll
+ {
+ eval <<'DONE';
+ sub ReadKey {
+ my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
+ if (defined $_[0] && $_[0] > 0) {
+ if ($_[0]) {
+ return undef if &pollfile($File,$_[0]) == 0;
+ }
+ }
+ if (defined $_[0] && $_[0] < 0) {
+ &setnodelay($File,1);
+ }
+ my ($value) = getc $File;
+ if (defined $_[0] && $_[0] < 0) {
+ &setnodelay($File,0);
+ }
+ $value;
+ }
+ sub ReadLine {
+ my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
+
+ if (defined $_[0] && $_[0] > 0) {
+ if ($_[0]) {
+ return undef if &pollfile($File,$_[0]) == 0;
+ }
+ }
+ if (defined $_[0] && $_[0] < 0) {
+ &setnodelay($File,1)
+ };
+ my ($value) = scalar(<$File>);
+ if ( defined $_[0] && $_[0]<0 ) {
+ &setnodelay($File,0)
+ };
+ $value;
+ }
+DONE
+ }
+ elsif ( &blockoptions() & 4 ) #select
+ {
+ eval <<'DONE';
+ sub ReadKey {
+ my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
+ if(defined $_[0] && $_[0]>0) {
+ if($_[0]) {return undef if &selectfile($File,$_[0])==0}
+ }
+ if(defined $_[0] && $_[0]<0) {&setnodelay($File,1);}
+ my($value) = getc $File;
+ if(defined $_[0] && $_[0]<0) {&setnodelay($File,0);}
+ $value;
+ }
+ sub ReadLine {
+ my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
+ if(defined $_[0] && $_[0]>0) {
+ if($_[0]) {return undef if &selectfile($File,$_[0])==0}
+ }
+ if(defined $_[0] && $_[0]<0) {&setnodelay($File,1)};
+ my($value)=scalar(<$File>);
+ if(defined $_[0] && $_[0]<0) {&setnodelay($File,0)};
+ $value;
+ }
+DONE
+ }
+ else
+ { #nothing
+ eval <<'DONE';
+ sub ReadKey {
+ my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
+ if(defined $_[0] && $_[0]>0) {
+ # Nothing better seems to exist, so I just use time-of-day
+ # to timeout the read. This isn't very exact, though.
+ $starttime=time;
+ $endtime=$starttime+$_[0];
+ &setnodelay($File,1);
+ my($value)=undef;
+ while(time<$endtime) { # This won't catch wraparound!
+ $value = getc $File;
+ last if defined($value);
+ }
+ &setnodelay($File,0);
+ return $value;
+ }
+ if(defined $_[0] && $_[0]<0) {&setnodelay($File,1);}
+ my($value) = getc $File;
+ if(defined $_[0] && $_[0]<0) {&setnodelay($File,0);}
+ $value;
+ }
+ sub ReadLine {
+ my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
+ if(defined $_[0] && $_[0]>0) {
+ # Nothing better seems to exist, so I just use time-of-day
+ # to timeout the read. This isn't very exact, though.
+ $starttime=time;
+ $endtime=$starttime+$_[0];
+ &setnodelay($File,1);
+ my($value)=undef;
+ while(time<$endtime) { # This won't catch wraparound!
+ $value = scalar(<$File>);
+ last if defined($value);
+ }
+ &setnodelay($File,0);
+ return $value;
+ }
+ if(defined $_[0] && $_[0]<0) {&setnodelay($File,1)};
+ my($value)=scalar(<$File>);
+ if(defined $_[0] && $_[0]<0) {&setnodelay($File,0)};
+ $value;
+ }
+DONE
+ }
+}
+elsif ( &blockoptions() & 2 ) # Use poll
+{
+ eval <<'DONE';
+ sub ReadKey {
+ my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
+ if(defined $_[0] && $_[0] != 0) {
+ return undef if &pollfile($File,$_[0]) == 0
+ }
+ getc $File;
+ }
+ sub ReadLine {
+ my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
+ if(defined $_[0] && $_[0]!=0) {
+ return undef if &pollfile($File,$_[0]) == 0;
+ }
+ scalar(<$File>);
+ }
+DONE
+}
+elsif ( &blockoptions() & 4 ) # Use select
+{
+ eval <<'DONE';
+ sub ReadKey {
+ my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
+ if(defined $_[0] && $_[0] !=0 ) {
+ return undef if &selectfile($File,$_[0])==0
+ }
+ getc $File;
+ }
+ sub ReadLine {
+ my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
+ if(defined $_[0] && $_[0] != 0) {
+ return undef if &selectfile($File,$_[0]) == 0;
+ }
+ scalar(<$File>);
+ }
+DONE
+}
+elsif ( &blockoptions() & 8 ) # Use Win32
+{
+ eval <<'DONE';
+ sub ReadKey {
+ my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
+ if ($_[0] || $CurrentMode >= 3) {
+ Win32PeekChar($File, $_[0]);
+ } else {
+ getc $File;
+ }
+ #if ($_[0]!=0) {return undef if !Win32PeekChar($File, $_[0])};
+ #getc $File;
+ }
+ sub ReadLine {
+ my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
+ #if ($_[0]!=0) {return undef if !Win32PeekChar($File, $_[0])};
+ #scalar(<$File>);
+ if($_[0])
+ {croak("Non-blocking ReadLine is not supported on this architecture")}
+ scalar(<$File>);
+ }
+DONE
+}
+else
+{
+ eval <<'DONE';
+ sub ReadKey {
+ my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
+ if($_[0])
+ {croak("Non-blocking ReadKey is not supported on this architecture")}
+ getc $File;
+ }
+ sub ReadLine {
+ my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
+ if($_[0])
+ {croak("Non-blocking ReadLine is not supported on this architecture")}
+ scalar(<$File>);
+ }
+DONE
+}
+
+package Term::ReadKey; # return to package ReadKey so AutoSplit is happy
+1;
+
+__END__;
diff --git a/gnu/usr.bin/perl/cpan/Term-ReadKey/ReadKey.xs b/gnu/usr.bin/perl/cpan/Term-ReadKey/ReadKey.xs
new file mode 100644
index 00000000000..29c83b9ad4b
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/Term-ReadKey/ReadKey.xs
@@ -0,0 +1,1923 @@
+/* -*-C-*- */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "ppport.h"
+
+#define InputStream PerlIO *
+
+/*******************************************************************
+
+ Copyright (C) 1994,1995,1996,1997 Kenneth Albanowski. Unlimited
+ distribution and/or modification is allowed as long as this copyright
+ notice remains intact.
+
+ Written by Kenneth Albanowski on Thu Oct 6 11:42:20 EDT 1994
+ Contact at kjahds@kjahds.com or CIS:70705,126
+
+ Maintained by Jonathan Stowe <jns@gellyfish.com>
+
+ $Id: ReadKey.xs,v 1.1.1.1 2016/05/07 16:03:09 espie Exp $
+
+ Version 2.21, Sun Jul 28 12:57:56 BST 2002
+ Fix to improve the chances of automated testing succeeding
+
+ Version 2.20, Tue May 21 07:52:47 BST 2002
+ Patch from Autrijus Tang fixing Win32 Breakage with bleadperl
+
+ Version 2.19, Thu Mar 21 07:25:31 GMT 2002
+ Added check for definedness of $_[0] in comparisons in ReadKey, ReadLine
+ after reports of warnings.
+
+ Version 2.18, Sun Feb 10 13:06:57 GMT 2002
+ Altered prototyping style after reports of compile failures on
+ Windows.
+
+ Version 2.17, Fri Jan 25 06:58:47 GMT 2002
+ The '_' macro for non-ANSI compatibility was removed in 5.7.2
+
+ Version 2.16, Thu Nov 29 21:19:03 GMT 2001
+ It appears that the genchars.pl bit of the patch didnt apply
+ Applied the new ppport.h from Devel::PPPort
+
+ Version 2.15, Sun Nov 4 15:02:37 GMT 2001 (jns)
+ Applied the patch in
+ http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2001-01/msg01588.html
+ for PerlIO compatibility.
+
+ Version 2.14, Sun Mar 28 23:26:13 EST 1999
+ ppport.h 1.007 fixed for 5.005_55.
+
+ Version 2.13, Wed Mar 24 20:46:06 EST 1999
+ Adapted to ppport.h 1.006.
+
+ Version 2.12, Wed Jan 7 10:33:11 EST 1998
+ Slightly modified test and error reporting for Win32.
+
+ Version 2.11, Sun Dec 14 00:39:12 EST 1997
+ First attempt at Win32 support.
+
+ Version 2.10, skipped
+
+ Version 2.09, Tue Oct 7 13:07:43 EDT 1997
+ Grr. Added explicit detection of sys/poll.h and poll.h.
+
+ Version 2.08, Mon Oct 6 16:07:44 EDT 1997
+ Changed poll.h to sys/poll.h.
+
+ Version 2.07, Sun Jan 26 19:11:56 EST 1997
+ Added $VERSION to .pm.
+
+ Version 2.06, Tue Nov 26 01:47:09 EST 1996
+ Added PERLIO support and removed duplicate declaration in .pm.
+
+ Version 2.05, Tue Mar 12 19:08:33 EST 1996
+ Changed poll support so it works. Cleaned up .pm a little.
+
+ Version 2.04, Tue Oct 10 05:35:48 EDT 1995
+ Whoops. Changed GetTermSize back so that GSIZE code won't be
+ compiled if GWINSZ is being used. Also took ts_xxx and ts_yyy
+ out of GSIZE.
+
+ Version 2.03, Thu Sep 21 21:53:16 EDT 1995
+ Fixed up debugging info in Readkey.pm, and changed TermSizeVIO
+ to use _scrsize(). Hopefully this is GO for both Solaris and OS/2.
+
+ Version 2.02, Mon Sep 18 22:17:57 EDT 1995
+ Workaround for Solaris bug wasn't sufficient. Modularlized
+ GetTermSize into perl code, and added support for the
+ `resize` executable. Hard coded path for Solaris machines.
+
+ Version 2.01, Wed Sep 13 22:22:23 EDT 1995
+ Change error reporting around in getscreensize so that if
+ an ioctl fails but getenv succeeds, no warning will be
+ printed. This is an attempt to work around a Solaris bug where
+ TIOCGWINSZ fails in telnet sessions.
+
+ Version 2.00, Mon Sep 4 06:37:24 EDT 1995
+ Added timeouts to select/poll, added USE_STDIO_PTR support
+ (required for recent perl revisions), and fixed up compilation
+ under OS/2.
+
+ Version 1.99, Fri Aug 11 20:18:11 EDT 1995
+ Add file handles to ReadMode.
+
+ Version 1.97, Mon Apr 10 21:41:52 EDT 1995
+ Changed mode 5 to disable UC & delays. Added more ECHO flags.
+ Tested termio[s] & sgtty.
+ Added termoptions so test.pl can give more info.
+
+ Version 1.96,
+ Mucked with filehandle selection in ReadKey.pm.
+
+ Version 1.95,
+ Cleaning up for distribution.
+
+ Version 1.94,
+ Dealt with get/settermsize sillyness.
+
+ Version 1.91, Sat Mar 11 23:47:04 EST 1995:
+ Andy's patches, and a bit of termsize finesse.
+
+ Version 1.9, Thu Mar 9 14:11:49 EST 1995:
+ Modifying for portability. Prototypes, singed chars, etc.
+
+ Version 1.8, Mon Jan 9 23:18:14 EST 1995:
+ Added use of Configure.pm. No changes to ReadKey.
+
+ Version 1.7, Fri Dec 16 13:48:14 EST 1994:
+ Getting closer to release. Added new readmode 2. Had to bump up other
+ modes, unfortunately. This is the _last_ time I do that. If I have to
+ bump up the modes again, I'm switching to a different scheme.
+
+ Version 1.6, Wed Dec 14 17:36:59 EST 1994:
+ Completly reorganized the control-char support (twice!) so that
+ it is automatically ported by the preproccessor for termio[s], or
+ by an included script for sgtty. Logical defaults for sgtty are included
+ too. Added Sun TermSize support. (Hope I got it right.)
+
+ Version 1.5, Fri Dec 9 16:07:49 EST 1994:
+ Added SetTermSize, GetSpeeds, Get/SetControlChars, PerlIO support.
+
+ Version 1.01, Thu Oct 20 23:32:39 EDT 1994:
+ Added Select_fd_set_t casts to select() call.
+
+ Version 1.0: First "real" release. Everything seems cool.
+
+
+*******************************************************************/
+
+/***
+
+ Things to do:
+
+ Make sure the GetSpeed function is doing it's best to separate ispeed
+ from ospeed.
+
+ Separate the stty stuff from ReadMode, so that stty -a can be easily
+ used, among other things.
+
+***/
+
+
+
+/* Using these defines, you can elide anything you know
+ won't work properly */
+
+/* Methods of doing non-blocking reads */
+
+/*#define DONT_USE_SELECT*/
+/*#define DONT_USE_POLL*/
+/*#define DONT_USE_NODELAY*/
+
+
+/* Terminal I/O packages */
+
+/*#define DONT_USE_TERMIOS*/
+/*#define DONT_USE_TERMIO*/
+/*#define DONT_USE_SGTTY*/
+
+/* IOCTLs that can be used for GetTerminalSize */
+
+/*#define DONT_USE_GWINSZ*/
+/*#define DONT_USE_GSIZE*/
+
+/* IOCTLs that can be used for SetTerminalSize */
+
+/*#define DONT_USE_SWINSZ*/
+/*#define DONT_USE_SSIZE*/
+
+
+/* This bit is for OS/2 */
+
+#ifdef OS2
+# define I_FCNTL
+# define HAS_FCNTL
+
+# define O_NODELAY O_NDELAY
+
+# define DONT_USE_SELECT
+# define DONT_USE_POLL
+
+# define DONT_USE_TERMIOS
+# define DONT_USE_SGTTY
+# define I_TERMIO
+# define CC_TERMIO
+
+/* This flag should be off in the lflags when we enable termio mode */
+# define TRK_IDEFAULT IDEFAULT
+
+# define INCL_SUB
+# define INCL_DOS
+
+# include <os2.h>
+# include <stdlib.h>
+
+# define VIOMODE
+#else
+ /* no os2 */
+#endif
+
+/* This bit is for Windows 95/NT */
+
+#ifdef WIN32
+# define DONT_USE_TERMIO
+# define DONT_USE_TERMIOS
+# define DONT_USE_SGTTY
+# define DONT_USE_POLL
+# define DONT_USE_SELECT
+# define DONT_USE_NODELAY
+# define USE_WIN32
+# include <io.h>
+# if defined(_get_osfhandle) && (PERL_VERSION == 4) && (PERL_SUBVERSION < 5)
+# undef _get_osfhandle
+# if defined(_MSC_VER)
+# define level _cnt
+# endif
+# endif
+#endif
+
+/* This bit for NeXT */
+
+#ifdef _NEXT_SOURCE
+ /* fcntl with O_NDELAY (FNDELAY, actually) is broken on NeXT */
+# define DONT_USE_NODELAY
+#endif
+
+#if !defined(DONT_USE_NODELAY)
+# ifdef HAS_FCNTL
+# define Have_nodelay
+# ifdef I_FCNTL
+# include <fcntl.h>
+# endif
+# ifdef I_SYS_FILE
+# include <sys/file.h>
+# endif
+# ifdef I_UNISTD
+# include <unistd.h>
+# endif
+
+/* If any other headers are needed for fcntl or O_NODELAY, they need to get
+ included right here */
+
+# if !defined(O_NODELAY)
+# if !defined(FNDELAY)
+# undef Have_nodelay
+# else
+# define O_NODELAY FNDELAY
+# endif
+# else
+# define O_NODELAY O_NDELAY
+# endif
+# endif
+#endif
+
+#if !defined(DONT_USE_SELECT)
+# ifdef HAS_SELECT
+# ifdef I_SYS_SELECT
+# include <sys/select.h>
+# endif
+
+/* If any other headers are likely to be needed for select, they need to be
+ included right here */
+
+# define Have_select
+# endif
+#endif
+
+#if !defined(DONT_USE_POLL)
+# ifdef HAS_POLL
+# ifdef HAVE_POLL_H
+# include <poll.h>
+# define Have_poll
+# endif
+# ifdef HAVE_SYS_POLL_H
+# include <sys/poll.h>
+# define Have_poll
+# endif
+# endif
+#endif
+
+#ifdef DONT_USE_TERMIOS
+# ifdef I_TERMIOS
+# undef I_TERMIOS
+# endif
+#endif
+#ifdef DONT_USE_TERMIO
+# ifdef I_TERMIO
+# undef I_TERMIO
+# endif
+#endif
+#ifdef DONT_USE_SGTTY
+# ifdef I_SGTTY
+# undef I_SGTTY
+# endif
+#endif
+
+/* Pre-POSIX SVR3 systems sometimes define struct winsize in
+ sys/ptem.h. However, sys/ptem.h needs a type mblk_t (?) which
+ is defined in <sys/stream.h>.
+ No, Configure (dist3.051) doesn't know how to check for this.
+*/
+#ifdef I_SYS_STREAM
+# include <sys/stream.h>
+#endif
+#ifdef I_SYS_PTEM
+# include <sys/ptem.h>
+#endif
+
+#ifdef I_TERMIOS
+# include <termios.h>
+#else
+# ifdef I_TERMIO
+# include <termio.h>
+# else
+# ifdef I_SGTTY
+# include <sgtty.h>
+# endif
+# endif
+#endif
+
+#ifdef I_TERMIOS
+# define CC_TERMIOS
+#else
+# ifdef I_TERMIO
+# define CC_TERMIO
+# else
+# ifdef I_SGTTY
+# define CC_SGTTY
+# endif
+# endif
+#endif
+
+#ifndef TRK_IDEFAULT
+/* This flag should be off in the lflags when we enable termio mode */
+# define TRK_IDEFAULT 0
+#endif
+
+/* Fix up the disappearance of the '_' macro in Perl 5.7.2 */
+
+#ifndef _
+# ifdef CAN_PROTOTYPE
+# define _(args) args
+# else
+# define _(args) ()
+# endif
+#endif
+
+#define DisableFlush (1) /* Should flushing mode changes be enabled?
+ I think not for now. */
+
+
+#define STDIN PerlIO_stdin()
+
+#include "cchars.h"
+
+
+int GetTermSizeVIO _((PerlIO * file,
+ int * retwidth, int * retheight,
+ int * xpix, int * ypix));
+
+int GetTermSizeGWINSZ _((PerlIO * file,
+ int * retwidth, int * retheight,
+ int * xpix, int * ypix));
+
+int GetTermSizeGSIZE _((PerlIO * file,
+ int * retwidth, int * retheight,
+ int * xpix, int * ypix));
+
+int GetTermSizeWin32 _((PerlIO * file,
+ int * retwidth, int * retheight,
+ int * xpix, int * ypix));
+
+int SetTerminalSize _((PerlIO * file,
+ int width, int height,
+ int xpix, int ypix));
+
+void ReadMode _((PerlIO * file,int mode));
+
+int pollfile _((PerlIO * file, double delay));
+
+int setnodelay _((PerlIO * file, int mode));
+
+int selectfile _((PerlIO * file, double delay));
+
+int Win32PeekChar _((PerlIO * file, double delay, char * key));
+
+int getspeed _((PerlIO * file, I32 *in, I32 * out ));
+
+
+#ifdef VIOMODE
+int GetTermSizeVIO(PerlIO *file,int *retwidth,int *retheight,int *xpix,int *ypix)
+{
+ /*int handle=PerlIO_fileno(file);
+
+ static VIOMODEINFO *modeinfo = NULL;
+
+ if (modeinfo == NULL)
+ modeinfo = (VIOMODEINFO *)malloc(sizeof(VIOMODEINFO));
+
+ VioGetMode(modeinfo,0);
+ *retheight = modeinfo->row ?: 25;
+ *retwidth = modeinfo->col ?: 80;*/
+ int buf[2];
+
+ _scrsize(&buf[0]);
+
+ *retwidth = buf[0]; *retheight = buf[1];
+
+ *xpix = *ypix = 0;
+ return 0;
+}
+#else
+int GetTermSizeVIO(PerlIO *file,int * retwidth,int *retheight, int *xpix,int *ypix)
+{
+ croak("TermSizeVIO is not implemented on this architecture");
+ return 0;
+}
+#endif
+
+
+#if defined(TIOCGWINSZ) && !defined(DONT_USE_GWINSZ)
+int GetTermSizeGWINSZ(PerlIO *file,int *retwidth,int *retheight,int *xpix,int *ypix)
+{
+ int handle=PerlIO_fileno(file);
+ struct winsize w;
+
+ if (ioctl (handle, TIOCGWINSZ, &w) == 0) {
+ *retwidth=w.ws_col; *retheight=w.ws_row;
+ *xpix=w.ws_xpixel; *ypix=w.ws_ypixel; return 0;
+ }
+ else {
+ return -1; /* failure */
+ }
+
+}
+#else
+int GetTermSizeGWINSZ(PerlIO *file,int *retwidth,int *retheight,int *xpix,int *ypix)
+{
+ croak("TermSizeGWINSZ is not implemented on this architecture");
+ return 0;
+}
+#endif
+
+#if (!defined(TIOCGWINSZ) || defined(DONT_USE_GWINSZ)) && (defined(TIOCGSIZE) && !defined(DONT_USE_GSIZE))
+int GetTermSizeGSIZE(PerlIO *file,int *retwidth,int *retheight,int *xpix,int *ypix)
+{
+ int handle=PerlIO_fileno(file);
+
+ struct ttysize w;
+
+ if (ioctl (handle, TIOCGSIZE, &w) == 0) {
+ *retwidth=w.ts_cols; *retheight=w.ts_lines;
+ *xpix=0/*w.ts_xxx*/; *ypix=0/*w.ts_yyy*/; return 0;
+ }
+ else {
+ return -1; /* failure */
+ }
+}
+#else
+int GetTermSizeGSIZE(PerlIO *file,int *retwidth,int *retheight,int *xpix,int *ypix)
+{
+ croak("TermSizeGSIZE is not implemented on this architecture");
+ return 0;
+}
+#endif
+
+#ifdef USE_WIN32
+int GetTermSizeWin32(PerlIO *file,int *retwidth,int *retheight,int *xpix,int *ypix)
+{
+ int handle=PerlIO_fileno(file);
+ HANDLE whnd = (HANDLE)_get_osfhandle(handle);
+ CONSOLE_SCREEN_BUFFER_INFO info;
+
+ if (GetConsoleScreenBufferInfo(whnd, &info)) {
+ /* Logic: return maximum possible screen width, but return
+ only currently selected height */
+ if (retwidth)
+ *retwidth = info.dwMaximumWindowSize.X;
+ /*info.srWindow.Right - info.srWindow.Left;*/
+ if (retheight)
+ *retheight = info.srWindow.Bottom - info.srWindow.Top;
+ if (xpix)
+ *xpix = 0;
+ if (ypix)
+ *ypix = 0;
+ return 0;
+ } else
+ return -1;
+}
+#else
+int GetTermSizeWin32(PerlIO *file,int *retwidth,int *retheight,int *xpix,int *ypix)
+{
+ croak("TermSizeWin32 is not implemented on this architecture");
+ return 0;
+}
+#endif /* USE_WIN32 */
+
+
+int termsizeoptions() {
+ return 0
+#ifdef VIOMODE
+ | 1
+#endif
+#if defined(TIOCGWINSZ) && !defined(DONT_USE_GWINSZ)
+ | 2
+#endif
+#if defined(TIOCGSIZE) && !defined(DONT_USE_GSIZE)
+ | 4
+#endif
+#if defined(USE_WIN32)
+ | 8
+#endif
+ ;
+}
+
+
+int SetTerminalSize(PerlIO *file,int width,int height,int xpix,int ypix)
+{
+ char buffer[10];
+ int handle=PerlIO_fileno(file);
+
+#ifdef VIOMODE
+ return -1;
+#else
+
+#if defined(TIOCSWINSZ) && !defined(DONT_USE_SWINSZ)
+ struct winsize w;
+
+ w.ws_col=width;
+ w.ws_row=height;
+ w.ws_xpixel=xpix;
+ w.ws_ypixel=ypix;
+ if (ioctl (handle, TIOCSWINSZ, &w) == 0) {
+ sprintf(buffer,"%d",width); /* Be polite to our children */
+ my_setenv("COLUMNS",buffer);
+ sprintf(buffer,"%d",height);
+ my_setenv("LINES",buffer);
+ return 0;
+ }
+ else {
+ croak("TIOCSWINSZ ioctl call to set terminal size failed: %s",Strerror(errno));
+ return -1;
+ }
+#else
+# if defined(TIOCSSIZE) && !defined(DONT_USE_SSIZE)
+ struct ttysize w;
+
+ w.ts_lines=height;
+ w.ts_cols=width;
+ w.ts_xxx=xpix;
+ w.ts_yyy=ypix;
+ if (ioctl (handle, TIOCSSIZE, &w) == 0) {
+ sprintf(buffer,"%d",width);
+ my_setenv("COLUMNS",buffer);
+ sprintf(buffer,"%d",height);
+ my_setenv("LINES",buffer);
+ return 0;
+ }
+ else {
+ croak("TIOCSSIZE ioctl call to set terminal size failed: %s",Strerror(errno));
+ return -1;
+ }
+# else
+ /*sprintf(buffer,"%d",width) * Should we could do this and then *
+ my_setenv("COLUMNS",buffer) * said we succeeded? *
+ sprintf(buffer,"%d",height);
+ my_setenv("LINES",buffer)*/
+
+ return -1; /* Fail */
+# endif
+#endif
+#endif
+
+}
+
+I32 terminal_speeds[] = {
+#ifdef B50
+ 50, B50,
+#endif
+#ifdef B75
+ 75, B75,
+#endif
+#ifdef B110
+ 110, B110,
+#endif
+#ifdef B134
+ 134, B134,
+#endif
+#ifdef B150
+ 150, B150,
+#endif
+#ifdef B200
+ 200, B200,
+#endif
+#ifdef B300
+ 300, B300,
+#endif
+#ifdef B600
+ 600, B600,
+#endif
+#ifdef B1200
+ 1200, B1200,
+#endif
+#ifdef B1800
+ 1800, B1800,
+#endif
+#ifdef B2400
+ 2400, B2400,
+#endif
+#ifdef B4800
+ 4800, B4800,
+#endif
+#ifdef B9600
+ 9600, B9600,
+#endif
+#ifdef B19200
+ 19200, B19200,
+#endif
+#ifdef B38400
+ 38400, B38400,
+#endif
+#ifdef B57600
+ 57600, B57600,
+#endif
+#ifdef B115200
+ 115200, B115200,
+#endif
+#ifdef EXTA
+ 19200, EXTA,
+#endif
+#ifdef EXTB
+ 38400, EXTB,
+#endif
+#ifdef B0
+ 0, B0,
+#endif
+ -1,-1
+};
+
+int getspeed(PerlIO *file,I32 *in, I32 *out)
+{
+ int handle=PerlIO_fileno(file);
+ int i;
+# ifdef I_TERMIOS
+ /* Posixy stuff */
+
+ struct termios buf;
+ tcgetattr(handle,&buf);
+
+ *in = *out = -1;
+ *in = cfgetispeed(&buf);
+ *out = cfgetospeed(&buf);
+ for(i=0;terminal_speeds[i]!=-1;i+=2) {
+ if(*in == terminal_speeds[i+1])
+ { *in = terminal_speeds[i]; break; }
+ }
+ for(i=0;terminal_speeds[i]!=-1;i+=2) {
+ if(*out == terminal_speeds[i+1])
+ { *out = terminal_speeds[i]; break; }
+ }
+ return 0;
+
+# else
+# ifdef I_TERMIO
+ /* SysV stuff */
+ struct termio buf;
+
+ ioctl(handle,TCGETA,&buf);
+
+ *in=*out=-1;
+ for(i=0;terminal_speeds[i]!=-1;i+=2) {
+ if((buf.c_cflag & CBAUD) == terminal_speeds[i+1])
+ { *in=*out=terminal_speeds[i]; break; }
+ }
+ return 0;
+
+# else
+# ifdef I_SGTTY
+ /* BSD stuff */
+ struct sgttyb buf;
+
+ ioctl(handle,TIOCGETP,&buf);
+
+ *in=*out=-1;
+
+ for(i=0;terminal_speeds[i]!=-1;i+=2)
+ if(buf.sg_ospeed == terminal_speeds[i+1])
+ { *out = terminal_speeds[i]; break; }
+
+ for(i=0;terminal_speeds[i]!=-1;i+=2)
+ if(buf.sg_ispeed == terminal_speeds[i+1])
+ { *in = terminal_speeds[i]; break; }
+
+ return 0;
+
+
+# else
+
+ /* No termio, termios or sgtty. I suppose we can try stty,
+ but it would be nice if you could get a better OS */
+
+ return -1;
+
+# endif
+# endif
+# endif
+}
+
+#ifdef WIN32
+struct tbuffer { DWORD Mode; };
+#else
+#ifdef I_TERMIOS
+#define USE_TERMIOS
+#define tbuffer termios
+#else
+#ifdef I_TERMIO
+#define USE_TERMIO
+#define tbuffer termio
+#else
+#ifdef I_SGTTY
+#define USE_SGTTY
+struct tbuffer {
+ struct sgttyb buf;
+#if defined(TIOCGETC)
+ struct tchars tchar;
+#endif
+#if defined(TIOCGLTC)
+ struct ltchars ltchar;
+#endif
+#if defined(TIOCLGET)
+ int local;
+#endif
+};
+#else
+#define USE_STTY
+struct tbuffer {
+ int dummy;
+};
+#endif
+#endif
+#endif
+#endif
+
+HV * filehash; /* Used to store the original terminal settings for each handle*/
+HV * modehash; /* Used to record the current terminal "mode" for each handle*/
+
+void ReadMode(PerlIO *file,int mode)
+{
+ dTHR;
+ int handle;
+ int firsttime;
+ int oldmode;
+ struct tbuffer work;
+ struct tbuffer savebuf;
+
+
+ handle=PerlIO_fileno(file);
+
+ firsttime=!hv_exists(filehash, (char*)&handle, sizeof(int));
+
+
+# ifdef WIN32
+
+ if (!GetConsoleMode((HANDLE)_get_osfhandle(handle), &work.Mode))
+ croak("GetConsoleMode failed, LastError=|%d|",GetLastError());
+
+# endif /* WIN32 */
+
+# ifdef USE_TERMIOS
+ /* Posixy stuff */
+
+ tcgetattr(handle,&work);
+
+
+
+#endif
+#ifdef USE_TERMIO
+ /* SysV stuff */
+
+ ioctl(handle,TCGETA,&work);
+
+
+#endif
+#ifdef USE_SGTTY
+ /* BSD stuff */
+
+ ioctl(handle,TIOCGETP,&work.buf);
+# if defined(TIOCGETC)
+ ioctl(handle,TIOCGETC,&work.tchar);
+# endif
+# if defined(TIOCLGET)
+ ioctl(handle,TIOCLGET,&work.local);
+# endif
+# if defined(TIOCGLTC)
+ ioctl(handle,TIOCGLTC,&work.ltchar);
+# endif
+
+
+#endif
+
+
+ if(firsttime) {
+ firsttime=0;
+ memcpy((void*)&savebuf,(void*)&work,sizeof(struct tbuffer));
+ if(!hv_store(filehash,(char*)&handle,sizeof(int),
+ newSVpv((char*)&savebuf,sizeof(struct tbuffer)),0))
+ croak("Unable to stash terminal settings.\n");
+ if(!hv_store(modehash,(char*)&handle,sizeof(int),newSViv(0),0))
+ croak("Unable to stash terminal settings.\n");
+ } else {
+ SV ** temp;
+ if(!(temp=hv_fetch(filehash,(char*)&handle,sizeof(int),0)))
+ croak("Unable to retrieve stashed terminal settings.\n");
+ memcpy(&savebuf,SvPV(*temp,PL_na),sizeof(struct tbuffer));
+ if(!(temp=hv_fetch(modehash,(char*)&handle,sizeof(int),0)))
+ croak("Unable to retrieve stashed terminal mode.\n");
+ oldmode=SvIV(*temp);
+ }
+
+#ifdef WIN32
+
+ switch (mode) {
+ case 5:
+ /* Should 5 disable ENABLE_WRAP_AT_EOL_OUTPUT? */
+ case 4:
+ work.Mode &= ~(ENABLE_ECHO_INPUT|ENABLE_PROCESSED_INPUT|ENABLE_LINE_INPUT|ENABLE_PROCESSED_OUTPUT);
+ work.Mode |= 0;
+ break;
+ case 3:
+ work.Mode &= ~(ENABLE_LINE_INPUT|ENABLE_ECHO_INPUT);
+ work.Mode |= ENABLE_PROCESSED_INPUT|ENABLE_PROCESSED_OUTPUT;
+ break;
+ case 2:
+ work.Mode &= ~(ENABLE_ECHO_INPUT);
+ work.Mode |= ENABLE_LINE_INPUT|ENABLE_PROCESSED_INPUT|ENABLE_PROCESSED_OUTPUT;
+ break;
+ case 1:
+ work.Mode &= ~(0);
+ work.Mode |= ENABLE_ECHO_INPUT|ENABLE_LINE_INPUT|ENABLE_PROCESSED_INPUT|ENABLE_PROCESSED_OUTPUT;
+ break;
+ case 0:
+ work = savebuf;
+ firsttime = 1;
+ break;
+ }
+
+ if (!SetConsoleMode((HANDLE)_get_osfhandle(handle), work.Mode))
+ croak("SetConsoleMode failed, LastError=|%d|",GetLastError());
+
+#endif /* WIN32 */
+
+
+#ifdef USE_TERMIOS
+
+
+/* What, me worry about standards? */
+
+# if !defined (VMIN)
+# define VMIN VEOF
+# endif
+
+# if !defined (VTIME)
+# define VTIME VEOL
+# endif
+
+# if !defined (IXANY)
+# define IXANY (0)
+# endif
+
+#ifndef IEXTEN
+#ifdef IDEFAULT
+#define IEXTEN IDEFAULT
+#endif
+#endif
+
+/* XXX Is ONLCR in POSIX?. The value of '4' seems to be the same for
+ both SysV and Sun, so it's probably rather general, and I'm not
+ aware of a POSIX way to do this otherwise.
+*/
+#ifndef ONLCR
+# define ONLCR 4
+#endif
+
+#ifndef IMAXBEL
+#define IMAXBEL 0
+#endif
+#ifndef ECHOE
+#define ECHOE 0
+#endif
+#ifndef ECHOK
+#define ECHOK 0
+#endif
+#ifndef ECHONL
+#define ECHONL 0
+#endif
+#ifndef ECHOPRT
+#define ECHOPRT 0
+#endif
+#ifndef FLUSHO
+#define FLUSHO 0
+#endif
+#ifndef PENDIN
+#define PENDIN 0
+#endif
+#ifndef ECHOKE
+#define ECHOKE 0
+#endif
+#ifndef ONLCR
+#define ONLCR 0
+#endif
+#ifndef OCRNL
+#define OCRNL 0
+#endif
+#ifndef ONLRET
+#define ONLRET 0
+#endif
+#ifndef IUCLC
+#define IUCLC 0
+#endif
+#ifndef OPOST
+#define OPOST 0
+#endif
+#ifndef OLCUC
+#define OLCUC 0
+#endif
+#ifndef ECHOCTL
+#define ECHOCTL 0
+#endif
+#ifndef XCASE
+#define XCASE 0
+#endif
+#ifndef BRKINT
+#define BRKINT 0
+#endif
+
+
+ if(mode==5) {
+ /*\
+ * Disable everything except parity if needed.
+ \*/
+
+ /* Hopefully, this should put the tty into unbuffered mode
+ with signals and control characters (both posixy and normal)
+ disabled, along with flow control. Echo should be off.
+ CR/LF is not translated, along with 8-bit/parity */
+
+ memcpy((void*)&work,(void*)&savebuf,sizeof(struct tbuffer));
+
+ work.c_lflag &= ~(ICANON|ISIG|IEXTEN );
+ work.c_lflag &= ~(ECHO|ECHOE|ECHOK|ECHONL|ECHOCTL);
+ work.c_lflag &= ~(ECHOPRT|ECHOKE|FLUSHO|PENDIN|XCASE);
+ work.c_lflag |= NOFLSH;
+ work.c_iflag &= ~(IXOFF|IXON|IXANY|ICRNL|IMAXBEL|BRKINT);
+
+ if(((work.c_iflag & INPCK) != INPCK) ||
+ ((work.c_cflag & PARENB) != PARENB)) {
+ work.c_iflag &= ~ISTRIP;
+ work.c_iflag |= IGNPAR;
+ work.c_iflag &= ~PARMRK;
+ }
+ work.c_oflag &= ~(OPOST |ONLCR|OCRNL|ONLRET);
+
+ work.c_cc[VTIME] = 0;
+ work.c_cc[VMIN] = 1;
+ }
+ else if(mode==4) {
+ /* Hopefully, this should put the tty into unbuffered mode
+ with signals and control characters (both posixy and normal)
+ disabled, along with flow control. Echo should be off.
+ About the only thing left unchanged is 8-bit/parity */
+
+ memcpy((void*)&work,(void*)&savebuf,sizeof(struct tbuffer));
+
+ /*work.c_iflag = savebuf.c_iflag;*/
+ work.c_lflag &= ~(ICANON | ISIG | IEXTEN | ECHO);
+ work.c_lflag &= ~(ECHOE | ECHOK | ECHONL|ECHOCTL|ECHOPRT|ECHOKE);
+ work.c_iflag &= ~(IXON | IXANY | BRKINT);
+ work.c_oflag = savebuf.c_oflag;
+ work.c_cc[VTIME] = 0;
+ work.c_cc[VMIN] = 1;
+ }
+ else if(mode==3)
+ {
+ /* This should be an unbuffered mode with signals and control
+ characters enabled, as should be flow control. Echo should
+ still be off */
+
+ memcpy((void*)&work,(void*)&savebuf,sizeof(struct tbuffer));
+
+ work.c_iflag = savebuf.c_iflag;
+ work.c_lflag &= ~(ICANON | ECHO);
+ work.c_lflag &= ~(ECHOE | ECHOK | ECHONL|ECHOCTL|ECHOPRT|ECHOKE);
+ work.c_lflag |= ISIG | IEXTEN;
+ /*work.c_iflag &= ~(IXON | IXOFF | IXANY);
+ work.c_iflag |= savebuf.c_iflag & (IXON|IXOFF|IXANY);
+ work.c_oflag = savebuf.c_oflag;*/
+ work.c_cc[VTIME] = 0;
+ work.c_cc[VMIN] = 1;
+ }
+ else if(mode==2)
+ {
+ /* This should be an unbuffered mode with signals and control
+ characters enabled, as should be flow control. Echo should
+ still be off */
+
+ memcpy((void*)&work,(void*)&savebuf,sizeof(struct tbuffer));
+
+ work.c_iflag = savebuf.c_iflag;
+ work.c_lflag |= ICANON|ISIG|IEXTEN;
+ work.c_lflag &= ~ECHO;
+ work.c_lflag &= ~(ECHOE | ECHOK | ECHONL|ECHOCTL|ECHOPRT|ECHOKE);
+ /*work.c_iflag &= ~(IXON |IXOFF|IXANY);
+ work.c_iflag |= savebuf.c_iflag & (IXON|IXOFF|IXANY);
+ work.c_oflag = savebuf.c_oflag;
+ work.c_cc[VTIME] = savebuf.c_cc[VTIME];
+ work.c_cc[VMIN] = savebuf.c_cc[VMIN];*/
+ }
+ else if(mode==1)
+ {
+ /* This should be an unbuffered mode with signals and control
+ characters enabled, as should be flow control. Echo should
+ still be off */
+
+ memcpy((void*)&work,(void*)&savebuf,sizeof(struct tbuffer));
+
+ work.c_iflag = savebuf.c_iflag;
+ work.c_lflag |= ICANON|ECHO|ISIG|IEXTEN;
+ /*work.c_iflag &= ~(IXON |IXOFF|IXANY);
+ work.c_iflag |= savebuf.c_iflag & (IXON|IXOFF|IXANY);
+ work.c_oflag = savebuf.c_oflag;
+ work.c_cc[VTIME] = savebuf.c_cc[VTIME];
+ work.c_cc[VMIN] = savebuf.c_cc[VMIN];*/
+ }
+ else if(mode==0){
+ /*work.c_lflag &= ~BITMASK;
+ work.c_lflag |= savebuf.c_lflag & BITMASK;
+ work.c_oflag = savebuf.c_oflag;
+ work.c_cc[VTIME] = savebuf.c_cc[VTIME];
+ work.c_cc[VMIN] = savebuf.c_cc[VMIN];
+ work.c_iflag = savebuf.c_iflag;
+ work.c_iflag &= ~(IXON|IXOFF|IXANY);
+ work.c_iflag |= savebuf.c_iflag & (IXON|IXOFF|IXANY);*/
+ memcpy((void*)&work,(void*)&savebuf,sizeof(struct tbuffer));
+ /*Copy(&work,&savebuf,1,sizeof(struct tbuffer));*/
+
+ firsttime=1;
+ }
+ else
+ {
+ croak("ReadMode %d is not implemented on this architecture.",mode);
+ return;
+ }
+
+
+ /* If switching from a "lower power" mode to a higher one, keep the
+ data that may be in the queue, as it can easily be type-ahead. On
+ switching to a lower mode from a higher one, however, flush the queue
+ so that raw keystrokes won't hit an unexpecting program */
+
+ if(DisableFlush || oldmode<=mode)
+ tcsetattr(handle,TCSANOW,&work);
+ else
+ tcsetattr(handle,TCSAFLUSH,&work);
+
+ /*tcsetattr(handle,TCSANOW,&work);*/ /* It might be better to FLUSH
+ when changing gears to a lower mode,
+ and only use NOW for higher modes.
+ */
+
+
+#endif
+#ifdef USE_TERMIO
+
+/* What, me worry about standards? */
+
+# if !defined (IXANY)
+# define IXANY (0)
+# endif
+
+#ifndef ECHOE
+#define ECHOE 0
+#endif
+#ifndef ECHOK
+#define ECHOK 0
+#endif
+#ifndef ECHONL
+#define ECHONL 0
+#endif
+#ifndef XCASE
+#define XCASE 0
+#endif
+#ifndef BRKINT
+#define BRKINT 0
+#endif
+
+
+
+ if(mode==5) {
+ /* This mode should be echo disabled, signals disabled,
+ flow control disabled, and unbuffered. CR/LF translation
+ is off, and 8 bits if possible */
+
+ memcpy((void*)&work,(void*)&savebuf,sizeof(struct tbuffer));
+
+ work.c_lflag &= ~(ECHO | ISIG | ICANON | XCASE);
+ work.c_lflag &= ~(ECHOE | ECHOK | ECHONL | TRK_IDEFAULT);
+ work.c_iflag &= ~(IXON | IXOFF | IXANY | ICRNL | BRKINT);
+ if((work.c_cflag | PARENB)!=PARENB ) {
+ work.c_iflag &= ~(ISTRIP|INPCK);
+ work.c_iflag |= IGNPAR;
+ }
+ work.c_oflag &= ~(OPOST|ONLCR);
+ work.c_cc[VMIN] = 1;
+ work.c_cc[VTIME] = 1;
+ }
+ else if(mode==4) {
+ /* This mode should be echo disabled, signals disabled,
+ flow control disabled, and unbuffered. Parity is not
+ touched. */
+
+ memcpy((void*)&work,(void*)&savebuf,sizeof(struct tbuffer));
+
+ work.c_lflag &= ~(ECHO | ISIG | ICANON);
+ work.c_lflag &= ~(ECHOE | ECHOK | ECHONL TRK_IDEFAULT);
+ work.c_iflag = savebuf.c_iflag;
+ work.c_iflag &= ~(IXON | IXOFF | IXANY | BRKINT);
+ work.c_oflag = savebuf.c_oflag;
+ work.c_cc[VMIN] = 1;
+ work.c_cc[VTIME] = 1;
+ }
+ else if(mode==3) {
+ /* This mode tries to have echo off, signals enabled,
+ flow control as per the original setting, and unbuffered. */
+
+ memcpy((void*)&work,(void*)&savebuf,sizeof(struct tbuffer));
+
+ work.c_lflag &= ~(ECHO | ICANON);
+ work.c_lflag &= ~(ECHOE | ECHOK | ECHONL | TRK_IDEFAULT);
+ work.c_lflag |= ISIG;
+ work.c_iflag = savebuf.c_iflag;
+ work.c_iflag &= ~(IXON | IXOFF | IXANY);
+ work.c_iflag |= savebuf.c_iflag & (IXON|IXOFF|IXANY);
+ work.c_oflag = savebuf.c_oflag;
+ work.c_cc[VMIN] = 1;
+ work.c_cc[VTIME] = 1;
+ }
+ else if(mode==2) {
+ /* This mode tries to set echo on, signals on, and buffering
+ on, with flow control set to whatever it was originally. */
+
+ memcpy((void*)&work,(void*)&savebuf,sizeof(struct tbuffer));
+
+ work.c_lflag |= (ISIG | ICANON);
+ work.c_lflag &= ~ECHO;
+ work.c_lflag &= ~(ECHOE | ECHOK | ECHONL | TRK_IDEFAULT);
+ work.c_iflag = savebuf.c_iflag;
+ work.c_iflag &= ~(IXON | IXOFF | IXANY);
+ work.c_iflag |= savebuf.c_iflag & (IXON|IXOFF|IXANY);
+ work.c_oflag = savebuf.c_oflag;
+ work.c_cc[VMIN] = savebuf.c_cc[VMIN];
+ work.c_cc[VTIME] = savebuf.c_cc[VTIME];
+
+ /* This assumes turning ECHO and ICANON back on is
+ sufficient to re-enable cooked mode. If this is a
+ problem, complain to me */
+
+ /* What the heck. We're already saving the entire buf, so
+ I'm now going to reset VMIN and VTIME too. Hope this works
+ properly */
+
+ }
+ else if(mode==1) {
+ /* This mode tries to set echo on, signals on, and buffering
+ on, with flow control set to whatever it was originally. */
+
+ memcpy((void*)&work,(void*)&savebuf,sizeof(struct tbuffer));
+
+ work.c_lflag |= (ECHO | ISIG | ICANON);
+ work.c_iflag &= ~TRK_IDEFAULT;
+ work.c_iflag = savebuf.c_iflag;
+ work.c_iflag &= ~(IXON | IXOFF | IXANY);
+ work.c_iflag |= savebuf.c_iflag & (IXON|IXOFF|IXANY);
+ work.c_oflag = savebuf.c_oflag;
+ work.c_cc[VMIN] = savebuf.c_cc[VMIN];
+ work.c_cc[VTIME] = savebuf.c_cc[VTIME];
+
+ /* This assumes turning ECHO and ICANON back on is
+ sufficient to re-enable cooked mode. If this is a
+ problem, complain to me */
+
+ /* What the heck. We're already saving the entire buf, so
+ I'm now going to reset VMIN and VTIME too. Hope this works
+ properly */
+ }
+ else if(mode==0) {
+ /* Put things back the way they were */
+
+ /*work.c_lflag = savebuf.c_lflag;
+ work.c_iflag = savebuf.c_iflag;
+ work.c_oflag = savebuf.c_oflag;
+ work.c_cc[VMIN] = savebuf.c_cc[VMIN];
+ work.c_cc[VTIME] = savebuf.c_cc[VTIME];*/
+ memcpy((void*)&work,(void*)&savebuf,sizeof(struct tbuffer));
+ firsttime=1;
+ }
+ else
+ {
+ croak("ReadMode %d is not implemented on this architecture.",mode);
+ return;
+ }
+
+
+ if(DisableFlush || oldmode<=mode)
+ ioctl(handle,TCSETA,&work);
+ else
+ ioctl(handle,TCSETAF,&work);
+
+#endif
+#ifdef USE_SGTTY
+
+
+ if(mode==5) {
+ /* Unbuffered, echo off, signals off, flow control off */
+ /* CR-CR/LF mode off too, and 8-bit path enabled. */
+# if defined(TIOCLGET) && defined(LPASS8)
+ if((work.buf.sg_flags & (EVENP|ODDP))==0 ||
+ (work.buf.sg_flags & (EVENP|ODDP))==(EVENP|ODDP))
+ work.local |= LPASS8; /* If parity isn't being used, use 8 bits */
+# endif
+ work.buf.sg_flags &= ~(ECHO|CRMOD);
+ work.buf.sg_flags |= (RAW|CBREAK);
+# if defined(TIOCGETC)
+ work.tchar.t_intrc = -1;
+ work.tchar.t_quitc = -1;
+ work.tchar.t_startc= -1;
+ work.tchar.t_stopc = -1;
+ work.tchar.t_eofc = -1;
+ work.tchar.t_brkc = -1;
+# endif
+# if defined(TIOCGLTC)
+ work.ltchar.t_suspc= -1;
+ work.ltchar.t_dsuspc= -1;
+ work.ltchar.t_rprntc= -1;
+ work.ltchar.t_flushc= -1;
+ work.ltchar.t_werasc= -1;
+ work.ltchar.t_lnextc= -1;
+# endif
+ }
+ else if(mode==4) {
+ /* Unbuffered, echo off, signals off, flow control off */
+ work.buf.sg_flags &= ~(ECHO|RAW);
+ work.buf.sg_flags |= (CBREAK|CRMOD);
+# if defined(TIOCLGET)
+ work.local=savebuf.local;
+# endif
+# if defined(TIOCGETC)
+ work.tchar.t_intrc = -1;
+ work.tchar.t_quitc = -1;
+ work.tchar.t_startc= -1;
+ work.tchar.t_stopc = -1;
+ work.tchar.t_eofc = -1;
+ work.tchar.t_brkc = -1;
+# endif
+# if defined(TIOCGLTC)
+ work.ltchar.t_suspc= -1;
+ work.ltchar.t_dsuspc= -1;
+ work.ltchar.t_rprntc= -1;
+ work.ltchar.t_flushc= -1;
+ work.ltchar.t_werasc= -1;
+ work.ltchar.t_lnextc= -1;
+# endif
+ }
+ else if(mode==3) {
+ /* Unbuffered, echo off, signals on, flow control on */
+ work.buf.sg_flags &= ~(RAW|ECHO);
+ work.buf.sg_flags |= CBREAK|CRMOD;
+# if defined(TIOCLGET)
+ work.local=savebuf.local;
+# endif
+# if defined(TIOCGLTC)
+ work.tchar = savebuf.tchar;
+# endif
+# if defined(TIOCGLTC)
+ work.ltchar = savebuf.ltchar;
+# endif
+ }
+ else if(mode==2) {
+ /* Buffered, echo on, signals on, flow control on */
+ work.buf.sg_flags &= ~(RAW|CBREAK);
+ work.buf.sg_flags |= CRMOD;
+ work.buf.sg_flags &= ~ECHO;
+# if defined(TIOCLGET)
+ work.local=savebuf.local;
+# endif
+# if defined(TIOCGLTC)
+ work.tchar = savebuf.tchar;
+# endif
+# if defined(TIOCGLTC)
+ work.ltchar = savebuf.ltchar;
+# endif
+ }
+ else if(mode==1) {
+ /* Buffered, echo on, signals on, flow control on */
+ work.buf.sg_flags &= ~(RAW|CBREAK);
+ work.buf.sg_flags |= ECHO|CRMOD;
+# if defined(TIOCLGET)
+ work.local=savebuf.local;
+# endif
+# if defined(TIOCGLTC)
+ work.tchar = savebuf.tchar;
+# endif
+# if defined(TIOCGLTC)
+ work.ltchar = savebuf.ltchar;
+# endif
+ }
+ else if(mode==0){
+ /* Original settings */
+#if 0
+ work.buf.sg_flags &= ~(RAW|CBREAK|ECHO|CRMOD);
+ work.buf.sg_flags |= savebuf.sg_flags & (RAW|CBREAK|ECHO|CRMOD);
+# if defined(TIOCLGET)
+ work.local=savebuf.local;
+# endif
+# if defined(TIOCGLTC)
+ work.tchar = savebuf.tchar;
+# endif
+# if defined(TIOCGLTC)
+ work.ltchar = savebuf.ltchar;
+# endif
+#endif
+ memcpy((void*)&work,(void*)&savebuf,sizeof(struct tbuffer));
+ firsttime=1;
+ }
+ else
+ {
+ croak("ReadMode %d is not implemented on this architecture.",mode);
+ return;
+ }
+#if defined(TIOCLSET)
+ ioctl(handle,TIOCLSET,&work.local);
+#endif
+#if defined(TIOCSETC)
+ ioctl(handle,TIOCSETC,&work.tchar);
+#endif
+# if defined(TIOCGLTC)
+ ioctl(handle,TIOCSLTC,&work.ltchar);
+# endif
+ if(DisableFlush || oldmode<=mode)
+ ioctl(handle,TIOCSETN,&work.buf);
+ else
+ ioctl(handle,TIOCSETP,&work.buf);
+#endif
+#ifdef USE_STTY
+
+ /* No termio, termios or sgtty. I suppose we can try stty,
+ but it would be nice if you could get a better OS */
+
+ if(mode==5)
+ system("/bin/stty raw -cbreak -isig -echo -ixon -onlcr -icrnl -brkint");
+ else if(mode==4)
+ system("/bin/stty -raw cbreak -isig -echo -ixon onlcr icrnl -brkint");
+ else if(mode==3)
+ system("/bin/stty -raw cbreak isig -echo ixon onlcr icrnl brkint");
+ else if(mode==2)
+ system("/bin/stty -raw -cbreak isig echo ixon onlcr icrnl brkint");
+ else if(mode==1)
+ system("/bin/stty -raw -cbreak isig -echo ixon onlcr icrnl brkint");
+ else if(mode==0)
+ system("/bin/stty -raw -cbreak isig echo ixon onlcr icrnl brkint");
+
+ /* Those probably won't work, but they couldn't hurt
+ at this point */
+
+#endif
+
+ /*warn("Mode set to %d.\n",mode);*/
+
+ if( firsttime ) {
+ (void)hv_delete(filehash,(char*)&handle,sizeof(int),0);
+ (void)hv_delete(modehash,(char*)&handle,sizeof(int),0);
+ } else {
+ if(!hv_store(modehash,(char*)&handle,sizeof(int),
+ newSViv(mode),0))
+ croak("Unable to stash terminal settings.\n");
+ }
+
+}
+
+#ifdef USE_PERLIO
+
+/* Make use of a recent addition to Perl, if possible */
+# define FCOUNT(f) PerlIO_get_cnt(f)
+#else
+
+ /* Make use of a recent addition to Configure, if possible */
+# ifdef USE_STDIO_PTR
+# define FCOUNT(f) PerlIO_get_cnt(f)
+# else
+ /* This bit borrowed from pp_sys.c. Complain to Larry if it's broken. */
+ /* If any of this works PerlIO_get_cnt() will too ... NI-S */
+# if defined(USE_STD_STDIO) || defined(atarist) /* this will work with atariST */
+# define FBASE(f) ((f)->_base)
+# define FSIZE(f) ((f)->_cnt + ((f)->_ptr - (f)->_base))
+# define FPTR(f) ((f)->_ptr)
+# define FCOUNT(f) ((f)->_cnt)
+# else
+# if defined(USE_LINUX_STDIO)
+# define FBASE(f) ((f)->_IO_read_base)
+# define FSIZE(f) ((f)->_IO_read_end - FBASE(f))
+# define FPTR(f) ((f)->_IO_read_ptr)
+# define FCOUNT(f) ((f)->_IO_read_end - FPTR(f))
+# endif
+# endif
+# endif
+#endif
+
+/* This is for the best, I'm afraid. */
+#if !defined(FCOUNT)
+# ifdef Have_select
+# undef Have_select
+# endif
+# ifdef Have_poll
+# undef Have_poll
+# endif
+#endif
+
+/* Note! If your machine has a bolixed up select() call that doesn't
+understand this syntax, either fix the checkwaiting call below, or define
+DONT_USE_SELECT. */
+
+#ifdef Have_select
+int selectfile(PerlIO *file,double delay)
+{
+ struct timeval t;
+ int handle=PerlIO_fileno(file);
+
+ /*char buf[32];
+ Select_fd_set_t fd=(Select_fd_set_t)&buf[0];*/
+
+ fd_set fd;
+ if (PerlIO_fast_gets(file) && PerlIO_get_cnt(file) > 0)
+ return 1;
+
+ /*t.tv_sec=t.tv_usec=0;*/
+
+ if (delay < 0.0)
+ delay = 0.0;
+ t.tv_sec = (long)delay;
+ delay -= (double)t.tv_sec;
+ t.tv_usec = (long)(delay * 1000000.0);
+
+ FD_ZERO(&fd);
+ FD_SET(handle,&fd);
+ if(select(handle+1,(Select_fd_set_t)&fd,
+ (Select_fd_set_t)0,
+ (Select_fd_set_t)&fd, &t)) return -1;
+ else return 0;
+}
+
+#else
+int selectfile(PerlIO *file, double delay)
+{
+ croak("select is not supported on this architecture");
+ return 0;
+}
+#endif
+
+#ifdef Have_nodelay
+int setnodelay(PerlIO *file, int mode)
+{
+ int handle=PerlIO_fileno(file);
+ int flags;
+ flags=fcntl(handle,F_GETFL,0);
+ if(mode)
+ flags|=O_NODELAY;
+ else
+ flags&=~O_NODELAY;
+ fcntl(handle,F_SETFL,flags);
+ return 0;
+}
+
+#else
+int setnodelay(PerlIO *file, int mode)
+{
+ croak("setnodelay is not supported on this architecture");
+ return 0;
+}
+#endif
+
+#ifdef Have_poll
+int pollfile(PerlIO *file,double delay)
+{
+ int handle=PerlIO_fileno(file);
+ struct pollfd fds;
+ if (PerlIO_fast_gets(f) && PerlIO_get_cnt(f) > 0)
+ return 1;
+ if(delay<0.0) delay = 0.0;
+ fds.fd=handle;
+ fds.events=POLLIN;
+ fds.revents=0;
+ return (poll(&fds,1,(long)(delay * 1000.0))>0);
+}
+#else
+int pollfile(PerlIO *file,double delay)
+{
+ croak("pollfile is not supported on this architecture");
+ return 0;
+}
+#endif
+
+#ifdef WIN32
+
+/*
+
+ This portion of the Win32 code is partially borrowed from a version of PDCurses.
+
+*/
+
+typedef struct {
+ int repeatCount;
+ int vKey;
+ int vScan;
+ int ascii;
+ int control;
+} win32_key_event_t;
+
+#define KEY_PUSH(I, K) { events[I].repeatCount = 1; events[I].ascii = K; }
+#define KEY_PUSH3(K1, K2, K3) \
+ do { \
+ eventCount = 0; \
+ KEY_PUSH(2, K1); \
+ KEY_PUSH(1, K2); \
+ KEY_PUSH(0, K3); \
+ eventCount = 3; \
+ goto again; \
+ } while (0)
+
+#define KEY_PUSH4(K1, K2, K3, K4) \
+ do { \
+ eventCount = 0; \
+ KEY_PUSH(3, K1); \
+ KEY_PUSH(2, K2); \
+ KEY_PUSH(1, K3); \
+ KEY_PUSH(0, K4); \
+ eventCount = 4; \
+ goto again; \
+ } while (0)
+
+int Win32PeekChar(PerlIO *file,double delay,char *key)
+{
+ int handle;
+ HANDLE whnd;
+ INPUT_RECORD record;
+ DWORD readRecords;
+
+#if 0
+ static int keyCount = 0;
+ static char lastKey = 0;
+#endif
+
+#define MAX_EVENTS 4
+ static int eventCount = 0;
+ static win32_key_event_t events[MAX_EVENTS];
+ int keyCount;
+
+ file = STDIN;
+
+ handle = PerlIO_fileno(file);
+ whnd = /*GetStdHandle(STD_INPUT_HANDLE)*/(HANDLE)_get_osfhandle(handle);
+
+
+again:
+#if 0
+ if (keyCount > 0) {
+ keyCount--;
+ *key = lastKey;
+ return TRUE;
+ }
+#endif
+
+ /* printf("eventCount: %d\n", eventCount); */
+ if (eventCount) {
+ /* printf("key %d; repeatCount %d\n", *key, events[eventCount - 1].repeatCount); */
+ *key = events[eventCount - 1].ascii;
+ events[eventCount - 1].repeatCount--;
+ if (events[eventCount - 1].repeatCount <= 0) {
+ eventCount--;
+ }
+ return TRUE;
+ }
+
+ if (delay > 0) {
+ if (WaitForSingleObject(whnd, delay * 1000.0) != WAIT_OBJECT_0)
+ {
+ return FALSE;
+ }
+ }
+
+ if (delay != 0) {
+ PeekConsoleInput(whnd, &record, 1, &readRecords);
+ if (readRecords == 0) {
+ return(FALSE);
+ }
+ }
+
+ ReadConsoleInput(whnd, &record, 1, &readRecords);
+ switch(record.EventType)
+ {
+ case KEY_EVENT:
+ /* printf("\nkeyDown = %d, repeat = %d, vKey = %d, vScan = %d, ASCII = %d, Control = %d\n",
+ record.Event.KeyEvent.bKeyDown,
+ record.Event.KeyEvent.wRepeatCount,
+ record.Event.KeyEvent.wVirtualKeyCode,
+ record.Event.KeyEvent.wVirtualScanCode,
+ record.Event.KeyEvent.uChar.AsciiChar,
+ record.Event.KeyEvent.dwControlKeyState); */
+
+ if (record.Event.KeyEvent.bKeyDown == FALSE)
+ goto again; /* throw away KeyUp events */
+
+ if (record.Event.KeyEvent.wVirtualKeyCode == 38) { /* up */
+ KEY_PUSH3(27, 91, 65);
+ }
+ if (record.Event.KeyEvent.wVirtualKeyCode == 40) { /* down */
+ KEY_PUSH3(27, 91, 66);
+ }
+ if (record.Event.KeyEvent.wVirtualKeyCode == 39) { /* right */
+ KEY_PUSH3(27, 91, 67);
+ }
+ if (record.Event.KeyEvent.wVirtualKeyCode == 37) { /* left */
+ KEY_PUSH3(27, 91, 68);
+ }
+ if (record.Event.KeyEvent.wVirtualKeyCode == 33) { /* page up */
+ KEY_PUSH3(27, 79, 121);
+ }
+ if (record.Event.KeyEvent.wVirtualKeyCode == 34) { /* page down */
+ KEY_PUSH3(27, 79, 115);
+ }
+ if (record.Event.KeyEvent.wVirtualKeyCode == 36) { /* home */
+ KEY_PUSH4(27, 91, 49, 126);
+ }
+ if (record.Event.KeyEvent.wVirtualKeyCode == 35) { /* end */
+ KEY_PUSH4(27, 91, 52, 126);
+ }
+ if (record.Event.KeyEvent.wVirtualKeyCode == 45) { /* insert */
+ KEY_PUSH4(27, 91, 50, 126);
+ }
+ if (record.Event.KeyEvent.wVirtualKeyCode == 46) { /* delete */
+ KEY_PUSH4(27, 91, 51, 126);
+ }
+
+ if (record.Event.KeyEvent.wVirtualKeyCode == 16
+ || record.Event.KeyEvent.wVirtualKeyCode == 17
+ || record.Event.KeyEvent.wVirtualKeyCode == 18
+ || record.Event.KeyEvent.wVirtualKeyCode == 20
+ || record.Event.KeyEvent.wVirtualKeyCode == 144
+ || record.Event.KeyEvent.wVirtualKeyCode == 145)
+ goto again; /* throw away shift/alt/ctrl key only key events */
+ keyCount = record.Event.KeyEvent.wRepeatCount;
+ break;
+ default:
+ keyCount = 0;
+ goto again;
+ break;
+ }
+
+ *key = record.Event.KeyEvent.uChar.AsciiChar;
+ keyCount--;
+
+ if (keyCount) {
+ events[0].repeatCount = keyCount;
+ events[0].ascii = *key;
+ eventCount = 1;
+ }
+
+ return(TRUE);
+
+ /* again:
+ return (FALSE);
+ */
+
+
+}
+#else
+int Win32PeekChar(PerlIO *file, double delay,char *key)
+{
+ croak("Win32PeekChar is not supported on this architecture");
+ return 0;
+}
+#endif
+
+
+int blockoptions() {
+ return 0
+#ifdef Have_nodelay
+ | 1
+#endif
+#ifdef Have_poll
+ | 2
+#endif
+#ifdef Have_select
+ | 4
+#endif
+#ifdef USE_WIN32
+ | 8
+#endif
+ ;
+}
+
+int termoptions() {
+ int i=0;
+#ifdef USE_TERMIOS
+ i=1;
+#endif
+#ifdef USE_TERMIO
+ i=2;
+#endif
+#ifdef USE_SGTTY
+ i=3;
+#endif
+#ifdef USE_STTY
+ i=4;
+#endif
+#ifdef USE_WIN32
+ i=5;
+#endif
+ return i;
+}
+
+
+
+MODULE = Term::ReadKey PACKAGE = Term::ReadKey
+
+int
+selectfile(file,delay)
+ InputStream file
+ double delay
+
+# Clever, eh?
+void
+SetReadMode(mode,file=STDIN)
+ int mode
+ InputStream file
+ CODE:
+ {
+ ReadMode(file,mode);
+ }
+
+int
+setnodelay(file,mode)
+ InputStream file
+ int mode
+
+int
+pollfile(file,delay)
+ InputStream file
+ double delay
+
+SV *
+Win32PeekChar(file, delay)
+ InputStream file
+ double delay
+ CODE:
+ {
+ char key;
+ if (Win32PeekChar(file, delay, &key))
+ RETVAL = newSVpv(&key, 1);
+ else
+ RETVAL = newSVsv(&PL_sv_undef);
+ }
+ OUTPUT:
+ RETVAL
+
+int
+blockoptions()
+
+int
+termoptions()
+
+int
+termsizeoptions()
+
+void
+GetTermSizeWin32(file=STDIN)
+ InputStream file
+ PPCODE:
+ {
+ int x,y,xpix,ypix;
+ if( GetTermSizeWin32(file,&x,&y,&xpix,&ypix)==0)
+ {
+ EXTEND(sp, 4);
+ PUSHs(sv_2mortal(newSViv((IV)x)));
+ PUSHs(sv_2mortal(newSViv((IV)y)));
+ PUSHs(sv_2mortal(newSViv((IV)xpix)));
+ PUSHs(sv_2mortal(newSViv((IV)ypix)));
+ }
+ else
+ {
+ ST(0) = sv_newmortal();
+ }
+ }
+
+void
+GetTermSizeVIO(file=STDIN)
+ InputStream file
+ PPCODE:
+ {
+ int x,y,xpix,ypix;
+ if( GetTermSizeVIO(file,&x,&y,&xpix,&ypix)==0)
+ {
+ EXTEND(sp, 4);
+ PUSHs(sv_2mortal(newSViv((IV)x)));
+ PUSHs(sv_2mortal(newSViv((IV)y)));
+ PUSHs(sv_2mortal(newSViv((IV)xpix)));
+ PUSHs(sv_2mortal(newSViv((IV)ypix)));
+ }
+ else
+ {
+ ST(0) = sv_newmortal();
+ }
+ }
+
+void
+GetTermSizeGWINSZ(file=STDIN)
+ InputStream file
+ PPCODE:
+ {
+ int x,y,xpix,ypix;
+ if( GetTermSizeGWINSZ(file,&x,&y,&xpix,&ypix)==0)
+ {
+ EXTEND(sp, 4);
+ PUSHs(sv_2mortal(newSViv((IV)x)));
+ PUSHs(sv_2mortal(newSViv((IV)y)));
+ PUSHs(sv_2mortal(newSViv((IV)xpix)));
+ PUSHs(sv_2mortal(newSViv((IV)ypix)));
+ }
+ else
+ {
+ ST(0) = sv_newmortal();
+ }
+ }
+
+void
+GetTermSizeGSIZE(file=STDIN)
+ InputStream file
+ PPCODE:
+ {
+ int x,y,xpix,ypix;
+ if( GetTermSizeGSIZE(file,&x,&y,&xpix,&ypix)==0)
+ {
+ EXTEND(sp, 4);
+ PUSHs(sv_2mortal(newSViv((IV)x)));
+ PUSHs(sv_2mortal(newSViv((IV)y)));
+ PUSHs(sv_2mortal(newSViv((IV)xpix)));
+ PUSHs(sv_2mortal(newSViv((IV)ypix)));
+ }
+ else
+ {
+ ST(0) = sv_newmortal();
+ }
+ }
+
+int
+SetTerminalSize(width,height,xpix,ypix,file=STDIN)
+ int width
+ int height
+ int xpix
+ int ypix
+ InputStream file
+ CODE:
+ {
+ RETVAL=SetTerminalSize(file,width,height,xpix,ypix);
+ }
+ OUTPUT:
+ RETVAL
+
+void
+GetSpeed(file=STDIN)
+ InputStream file
+ PPCODE:
+ {
+ I32 in,out;
+ if(items!=0) {
+ croak("Usage: Term::ReadKey::GetSpeed()");
+ }
+ if(getspeed(file,&in,&out)) {
+ /* Failure */
+ ST( 0) = sv_newmortal();
+ } else {
+ EXTEND(sp, 2);
+ PUSHs(sv_2mortal(newSViv((IV)in)));
+ PUSHs(sv_2mortal(newSViv((IV)out)));
+ }
+ }
+
+
+
+BOOT:
+newXS("Term::ReadKey::GetControlChars", XS_Term__ReadKey_GetControlChars, file);
+newXS("Term::ReadKey::SetControlChars", XS_Term__ReadKey_SetControlChars, file);
+filehash=newHV();
+modehash=newHV();
diff --git a/gnu/usr.bin/perl/cpan/Term-ReadKey/example/test.pl b/gnu/usr.bin/perl/cpan/Term-ReadKey/example/test.pl
new file mode 100644
index 00000000000..359e75bad08
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/Term-ReadKey/example/test.pl
@@ -0,0 +1,366 @@
+#!/usr/bin/perl -w
+
+#use strict vars;
+
+#use Term::ReadKey qw( ReadMode ReadKey );
+#my $x;
+#ReadMode 3;
+#print "Read 1\n";
+#$x = ReadKey(0);
+#print "X=$x\n";
+#print "Read 2\n";
+#$x = ReadKey(0);
+#print "X=$x\n";
+#ReadMode 0;
+#__END__;
+
+my $interactive = ( @ARGV && $ARGV[0] =~ /interactive/ );
+
+BEGIN { print "1 .. 8\n"; }
+END { print "not ok 1\n" unless $loaded }
+use Term::ReadKey;
+
+$loaded = 1;
+print "ok 1\n";
+
+use Fcntl;
+
+if ( not exists $ENV{COLUMNS} )
+{
+ $ENV{COLUMNS} = 80;
+ $ENV{LINES} = 24;
+}
+
+if ( $^O =~ /Win32/i )
+{
+ sysopen( IN, 'CONIN$', O_RDWR ) or die "Unable to open console input:$!";
+ sysopen( OUT, 'CONOUT$', O_RDWR ) or die "Unable to open console output:$!";
+}
+else
+{
+
+ if ( open( IN, "</dev/tty" ) )
+ {
+ *OUT = *IN;
+ die "Foo" unless -t OUT;
+ }
+ else
+ {
+
+ # Okay we are going to cheat a skip
+ foreach my $skip ( 2 .. 8 )
+ {
+ print "ok $skip # skip /dev/tty is absent\n";
+ }
+ exit;
+ }
+}
+
+*IN = *IN; # Make single-use warning go away
+$| = 1;
+
+my $size1 = join( ",", GetTerminalSize( \IN ) );
+my $size2 = join( ",", GetTerminalSize("IN") );
+my $size3 = join( ",", GetTerminalSize(*IN) );
+my $size4 = join( ",", GetTerminalSize( \*IN ) );
+
+if ( ( $size1 eq $size2 ) && ( $size2 eq $size3 ) && ( $size3 eq $size4 ) )
+{
+ print "ok 2\n";
+}
+else
+{
+ print "not ok 2\n";
+}
+
+sub makenicelist
+{
+ my (@list) = @_;
+ my ( $i, $result );
+ $result = "";
+ for ( $i = 0 ; $i < @list ; $i++ )
+ {
+ $result .= ", " if $i > 0;
+ $result .= "and " if $i == @list - 1 and @list > 1;
+ $result .= $list[$i];
+ }
+ $result;
+}
+
+sub makenice
+{
+ my ($char) = $_[0];
+ if ( ord($char) < 32 ) { $char = "^" . pack( "c", ord($char) + 64 ) }
+ elsif ( ord($char) > 126 ) { $char = ord($char) }
+ $char;
+}
+
+sub makeunnice
+{
+ my ($char) = $_[0];
+ $char =~ s/^\^(.)$/pack("c",ord($1)-64)/eg;
+ $char =~ s/(\d{1,3})/pack("c",$1+0)/eg;
+ $char;
+}
+
+my $response;
+
+eval {
+
+ if ( &Term::ReadKey::termoptions() == 1 )
+ {
+ $response =
+ "Term::ReadKey is using TERMIOS, as opposed to TERMIO or SGTTY.\n";
+ }
+ elsif ( &Term::ReadKey::termoptions() == 2 )
+ {
+ $response =
+ "Term::ReadKey is using TERMIO, as opposed to TERMIOS or SGTTY.\n";
+ }
+ elsif ( &Term::ReadKey::termoptions() == 3 )
+ {
+ $response =
+ "Term::ReadKey is using SGTTY, as opposed to TERMIOS or TERMIO.\n";
+ }
+ elsif ( &Term::ReadKey::termoptions() == 4 )
+ {
+ $response =
+"Term::ReadKey is trying to make do with stty; facilites may be limited.\n";
+ }
+ elsif ( &Term::ReadKey::termoptions() == 5 )
+ {
+ $response = "Term::ReadKey is using Win32 functions.\n";
+ }
+ else
+ {
+ $response =
+ "Term::ReadKey could not find any way to manipulate the terminal.\n";
+ }
+
+ print "ok 3\n";
+};
+
+print "not ok 3\n" if $@;
+
+print $response if $interactive;
+
+eval {
+ push( @modes, "O_NODELAY" ) if &Term::ReadKey::blockoptions() & 1;
+ push( @modes, "poll()" ) if &Term::ReadKey::blockoptions() & 2;
+ push( @modes, "select()" ) if &Term::ReadKey::blockoptions() & 4;
+ push( @modes, "Win32" ) if &Term::ReadKey::blockoptions() & 8;
+
+ print "ok 4\n";
+};
+
+print "not ok 4\n" if $@;
+
+if ($interactive)
+{
+ if ( &Term::ReadKey::blockoptions() == 0 )
+ {
+ print "No methods found to implement non-blocking reads.\n";
+ print
+" (If your computer supports poll(), you might like to read through ReadKey.xs)\n";
+ }
+ else
+ {
+ print "Non-blocking reads possible via ", makenicelist(@modes), ".\n";
+ print $modes[0] . " will be used. " if @modes > 0;
+ print $modes[1] . " will be used for timed reads."
+ if @modes > 1
+ and $modes[0] eq "O_NODELAY";
+ print "\n";
+ }
+}
+
+eval {
+ @size = GetTerminalSize(OUT);
+ print "ok 5\n";
+};
+
+print "not ok 5\n" if $@;
+
+if ($interactive)
+{
+ if ( !@size )
+ {
+ print
+ "GetTerminalSize was incapable of finding the size of your terminal.";
+ }
+ else
+ {
+ print "Using GetTerminalSize, it appears that your terminal is\n";
+ print "$size[0] characters wide by $size[1] high.\n\n";
+ }
+
+}
+
+eval {
+ @speeds = GetSpeed();
+ print "ok 6\n";
+};
+
+print "not ok 6\n" if $@;
+
+if ($interactive)
+{
+ if (@speeds)
+ {
+ print "Apparently, you are connected at ", join( "/", @speeds ),
+ " baud.\n";
+ }
+ else
+ {
+ print "GetSpeed couldn't tell your connection baud rate.\n\n";
+ }
+ print "\n";
+}
+
+eval {
+ %chars = GetControlChars(IN);
+ print "ok 7\n";
+};
+
+print "not ok 7\n" if $@;
+
+%origchars = %chars;
+
+if ($interactive)
+{
+ for $c ( keys %chars ) { $chars{$c} = makenice( $chars{$c} ) }
+
+ print "Control chars = (",
+ join( ', ', map( "$_ => $chars{$_}", keys %chars ) ), ")\n";
+}
+
+eval {
+ SetControlChars( %origchars, IN );
+ print "ok 8\n";
+};
+
+print "not ok 8\n" if $@;
+
+#SetControlChars("FOOFOO"=>"Q");
+#SetControlChars("INTERRUPT"=>"\x5");
+
+END { ReadMode 0, IN; } # Just if something goes weird
+
+exit(0) unless $interactive;
+
+print "\nAnd now for the interactive tests.\n";
+
+print
+ "\nThis is ReadMode 1. It's guarranteed to give you cooked input. All the\n";
+print "signals and editing characters may be used as usual.\n";
+
+ReadMode 1, IN;
+
+print "\nYou may enter some text here: ";
+
+$t = ReadLine 0, IN;
+
+chop $t;
+
+print "\nYou entered `$t'.\n";
+
+ReadMode 2, IN;
+
+print
+ "\nThis is ReadMode 2. It's just like #1, but echo is turned off. Great\n";
+print "for passwords.\n";
+
+print "\nYou may enter some invisible text here: ";
+
+$t = ReadLine 0, IN;
+
+chop $t;
+
+print "\nYou entered `$t'.\n";
+
+ReadMode 3, IN;
+
+print
+ "\nI won't demonstrate ReadMode 3 here. It's your standard cbreak mode,\n";
+print
+ "with editing characters disabled, single character at a time input, but\n";
+print "with the control characters still enabled.\n";
+
+print "\n";
+
+print
+"I'm now putting the terminal into ReadMode 4 and using non-blocking reads.\n";
+print
+ "All signals should be disabled, including xon-xoff. You should only be\n";
+print "able to exit this loop via 'q'.\n";
+
+ReadMode 4, IN;
+$k = "";
+
+#$in = *STDIN;
+$in = \*IN; # or *IN or "IN"
+while ( $k ne "q" )
+{
+ print "Press a key, or \"q\" to stop: ";
+ $count = 0;
+
+ #print "IN = $in\n";
+ $count++ while !defined( $k = ReadKey( -1, $in ) );
+
+ #print "IN2 = $in\n";
+ print "\nYou pressed `", makenice($k),
+ "' after the loop rolled over $count times\n";
+}
+ReadMode 0, IN;
+
+print "\nHere is a similar loop which times out after two seconds:\n";
+
+ReadMode 4, IN;
+$k = "";
+
+#$in = *STDIN;
+$in = \*IN; # or *IN or "IN"
+while ( $k ne "q" )
+{
+ print "Press a key, or \"q\" to stop: ";
+ $count = 0;
+
+ #print "IN = $in\n";
+ print "Timeout! " while !defined( $k = ReadKey( 2, $in ) );
+
+ #print "IN2 = $in\n";
+ print "\nYou pressed `", makenice($k), "'\n";
+}
+
+print
+ "\nLastly, ReadMode 5, which also affects output (except under Win32).\n\n";
+
+ReadMode 5, IN;
+
+print
+"This should be a diagonal line (except under Win32): *\n*\n*\n\*\n*\n*\r\n\r\n";
+print "And this should be a moving spot:\r\n\r\n";
+
+$width = ( GetTerminalSize(OUT) )[0];
+$width /= 2;
+$width--;
+if ( $width < 10 ) { $width = 10; }
+
+for ( $i = 0 ; $i < 20 ; $i += .15 )
+{
+ print "\r";
+ print( " " x ( ( cos($i) + 1 ) * $width ) );
+ print "*";
+ select( undef, undef, undef, 0.01 );
+ print "\r";
+ print( " " x ( ( cos($i) + 1 ) * $width ) );
+ print " ";
+}
+print "\r ";
+
+print "\n\r\n";
+
+ReadMode 0, IN;
+
+print "That's all, folks!\n";
+
diff --git a/gnu/usr.bin/perl/cpan/Term-ReadKey/genchars.pl b/gnu/usr.bin/perl/cpan/Term-ReadKey/genchars.pl
new file mode 100644
index 00000000000..696c55b929c
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/Term-ReadKey/genchars.pl
@@ -0,0 +1,488 @@
+#!/usr/bin/perl
+
+#
+# $Id: genchars.pl,v 1.1.1.1 2016/05/07 16:03:08 espie Exp $
+#
+##############################
+$version="1.97";
+##############################
+use Config;
+
+use Configure;
+
+#sub report {
+# my($prog)=join(" ",@_);
+#
+# my($ccflags, $ldflags, $cc, $rm) = @Config{'ccflags', 'ldflags', 'cc', 'rm'};
+# my($command, $ret);
+#
+# $command = $prog;
+# open(F, ">temp$$.c") || die "Can't make temp file temp$$.c! $!\n";
+# print F $command;
+# close F;
+#
+# $command = "$cc $ccflags -o temp$$ temp$$.c $ldfcrs $libcrs $ldflags -lbsd";
+# $command .= " >/dev/null 2>&1";
+# $ret = system $command;
+# #if(!$ret) { system "temp$$" }
+# unlink "temp$$", "temp$$.o", "temp$$.c";
+#
+# return $ret;
+#}
+
+open(CCHARS,">cchars.h") || die "Fatal error, Unable to write to cchars.h!";
+
+#print "Checking for termio...\n";
+#$TERMIO = !report( "#include <termio.h>\n struct termios s; main(){}");
+#print " Termio ",($TERMIO?"":"NOT "),"found.\n";
+
+#print "Checking for termios...\n";
+#$TERMIOS = !report( "#include <termios.h>\n struct termio s; main(){}");
+#print " Termios ",($TERMIOS?"":"NOT "),"found.\n";
+
+#print "Checking for sgtty...\n";
+#$SGTTY = !report( "#include <sgtty.h>\n struct sgttyb s; main(){}");
+#print " Sgtty ",($SGTTY?"":"NOT "),"found.\n";
+
+#print "Termio=$TERMIO, Termios=$TERMIOS, Sgtty=$SGTTY\n";
+
+# Control characters used for termio and termios
+%possible = ( VINTR => "INTERRUPT",
+ VQUIT => "QUIT",
+ VERASE => "ERASE",
+ VKILL => "KILL",
+ VEOF => "EOF",
+ VTIME => "TIME",
+ VMIN => "MIN",
+ VSWTC => "SWITCH",
+ VSWTCH => "SWITCH",
+ VSTART => "START",
+ VSTOP => "STOP",
+ VSUSP => "SUSPEND",
+ VDSUSP => "DSUSPEND",
+ VEOL => "EOL",
+ VREPRINT => "REPRINT",
+ VDISCARD => "DISCARD",
+ VFLUSH => "DISCARD",
+ VWERASE => "ERASEWORD",
+ VLNEXT => "QUOTENEXT",
+ VQUOTE => "QUOTENEXT",
+ VEOL2 => "EOL2",
+ VSTATUS => "STATUS",
+);
+
+# Control characters for sgtty
+%possible2 = ( "intrc" => "INTERRUPT",
+ "quitc" => "QUIT",
+ "eofc" => "EOF",
+ "startc"=> "START",
+ "stopc" => "STOP",
+ "brkc" => "EOL",
+ "eolc" => "EOL",
+ "suspc" => "SUSPEND",
+ "dsuspc"=> "DSUSPEND",
+ "rprntc"=> "REPRINT",
+ "flushc"=> "DISCARD",
+ "lnextc"=> "QUOTENEXT",
+ "werasc"=> "ERASEWORD",
+);
+
+print CCHARS "
+
+/* Written by genchars.pl version $version */
+
+";
+
+print CCHARS "#define HAVE_POLL_H\n" if CheckHeader("poll.h");
+print CCHARS "#define HAVE_SYS_POLL_H\n" if CheckHeader("sys/poll.h");
+
+print "\n";
+if(1) {
+ @values = sort { $possible{$a} cmp $possible{$b} or $a cmp $b } keys %possible;
+
+ print "Writing termio/termios section of cchars.h... ";
+ print CCHARS "
+
+#ifdef CC_TERMIOS
+# define TermStructure struct termios
+# ifdef NCCS
+# define LEGALMAXCC NCCS
+# else
+# ifdef NCC
+# define LEGALMAXCC NCC
+# endif
+# endif
+#else
+# ifdef CC_TERMIO
+# define TermStructure struct termio
+# ifdef NCC
+# define LEGALMAXCC NCC
+# else
+# ifdef NCCS
+# define LEGALMAXCC NCCS
+# endif
+# endif
+# endif
+#endif
+
+#if !defined(LEGALMAXCC)
+# define LEGALMAXCC 126
+#endif
+
+#if defined(CC_TERMIO) || defined(CC_TERMIOS)
+
+char * cc_names[] = { ".join('',map("
+#if defined($_) && ($_ < LEGALMAXCC)
+ \"$possible{$_}\", "."
+#else "."
+ \"\", "."
+#endif ", @values ))."
+};
+
+const int MAXCC = 0 ",join('',map("
+#if defined($_) && ($_ < LEGALMAXCC)
+ +1 /* $possible{$_} */
+#endif ", @values ))."
+ ;
+
+XS(XS_Term__ReadKey_GetControlChars)
+{
+ dXSARGS;
+ if (items < 0 || items > 1) {
+ croak(\"Usage: Term::ReadKey::GetControlChars()\");
+ }
+ SP -= items;
+ {
+ PerlIO * file;
+ TermStructure s;
+ if (items < 1)
+ file = STDIN;
+ else {
+ file = IoIFP(sv_2io(ST(0)));
+ }
+
+#ifdef CC_TERMIOS
+ if(tcgetattr(PerlIO_fileno(file),&s))
+#else
+# ifdef CC_TERMIO
+ if(ioctl(PerlIO_fileno(file),TCGETA,&s))
+# endif
+#endif
+ croak(\"Unable to read terminal settings in GetControlChars\");
+ else {
+ EXTEND(sp,MAXCC*2); ".join('',map("
+#if defined($values[$_]) && ($values[$_] < LEGALMAXCC) "."
+PUSHs(sv_2mortal(newSVpv(cc_names[$_],strlen(cc_names[$_])))); /* $possible{$values[$_]} */
+PUSHs(sv_2mortal(newSVpv((char*)&s.c_cc[$values[$_]],1))); "."
+#endif " ,0..$#values))."
+
+ }
+ PUTBACK;
+ return;
+ }
+}
+
+XS(XS_Term__ReadKey_SetControlChars)
+{
+ dXSARGS;
+ /*if ((items % 2) != 0) {
+ croak(\"Usage: Term::ReadKey::SetControlChars(%charpairs,file=STDIN)\");
+ }*/
+ SP -= items;
+ {
+ TermStructure s;
+ PerlIO * file;
+ if ((items % 2) == 1)
+ file = IoIFP(sv_2io(ST(items-1)));
+ else {
+ file = STDIN;
+ }
+
+#ifdef CC_TERMIOS
+ if(tcgetattr(PerlIO_fileno(file),&s))
+#else
+# ifdef CC_TERMIO
+ if(ioctl(PerlIO_fileno(file),TCGETA,&s))
+# endif
+#endif
+ croak(\"Unable to read terminal settings in SetControlChars\");
+ else {
+ int i;
+ char * name, value;
+ for(i=0;i+1<items;i+=2) {
+ name = SvPV(ST(i),PL_na);
+ if( SvIOKp(ST(i+1)) || SvNOKp(ST(i+1)) )/* If Int or Float */
+ value = (char)SvIV(ST(i+1)); /* Store int value */
+ else /* Otherwise */
+ value = SvPV(ST(i+1),PL_na)[0]; /* Use first char of PV */
+
+ if (0) ; ".join('',map("
+#if defined($values[$_]) && ($values[$_] < LEGALMAXCC) "."
+ else if(strcmp(name,cc_names[$_])==0) /* $possible{$values[$_]} */
+ s.c_cc[$values[$_]] = value; "."
+#endif ",0..$#values))."
+ else
+ croak(\"Invalid control character passed to SetControlChars\");
+
+ }
+#ifdef CC_TERMIOS
+ if(tcsetattr(PerlIO_fileno(file),TCSANOW,&s))
+#else
+# ifdef CC_TERMIO
+ if(ioctl(PerlIO_fileno(file),TCSETA,&s))
+# endif
+#endif
+ croak(\"Unable to write terminal settings in SetControlChars\");
+ }
+ }
+ XSRETURN(1);
+}
+
+
+#endif
+
+";
+
+ print "Done.\n";
+
+}
+
+undef %billy;
+
+if(@ARGV) { # If any argument is supplied on the command-line don't check sgtty
+ $SGTTY=0; #skip tests
+} else {
+ print "Checking for sgtty...\n";
+
+ $SGTTY = CheckStructure "sgttyb","sgtty.h";
+# $SGTTY = !Compile("
+##include <sgtty.h>
+#struct sgttyb s;
+#main(){
+#ioctl(0,TIOCGETP,&s);
+#}");
+
+#}
+
+# $SGTTY = !report("
+##include <sgtty.h>
+#struct sgttyb s;
+#main(){
+#ioctl(0,TIOCGETP,&s);
+#}");
+
+ print " Sgtty ",($SGTTY?"":"NOT "),"found.\n";
+}
+
+$billy{"ERASE"} = "s1.sg_erase";
+$billy{"KILL"} = "s1.sg_kill";
+$tchars=$ltchars=0;
+
+if($SGTTY) {
+
+ print "Checking sgtty...\n";
+
+ $tchars = CheckStructure "tchars","sgtty.h";
+# $tchars = !report( '
+##include <sgtty.h>
+#struct tchars t;
+#main() { ioctl(0,TIOCGETC,&t); }
+#');
+ print " tchars structure found.\n" if $tchars;
+
+ $ltchars = CheckStructure "ltchars","sgtty.h";
+# $ltchars = !report( '
+##include <sgtty.h>
+#struct ltchars t;
+#main() { ioctl(0,TIOCGLTC,&t); }
+#');
+
+ print " ltchars structure found.\n" if $ltchars;
+
+
+ print "Checking symbols\n";
+
+
+ for $c (sort keys %possible2) {
+
+# if($tchars and !report("
+##include <sgtty.h>
+#struct tchars s2;
+#main () { char c = s2.t_$c; }
+#")) {
+ if($tchars and CheckField("tchars","t_$c","sgtty.h")) {
+
+ print " t_$c ($possible2{$c}) found in tchars\n";
+ $billy{$possible2{$c}} = "s2.t_$c";
+ }
+
+# elsif($ltchars and !report("
+##include <sgtty.h>
+#struct ltchars s3;
+#main () { char c = s3.t_$c; }
+#")) {
+ elsif($ltchars and CheckField("ltchars","t_$c","sgtty.h")) {
+ print " t_$c ($possible2{$c}) found in ltchars\n";
+ $billy{$possible2{$c}} = "s3.t_$c";
+ }
+
+ }
+
+
+ #undef @names;
+ #undef @values;
+ #for $v (sort keys %billy) {
+ # push(@names,$billy{$v});
+ # push(@values,$v);
+ #}
+
+ #$numchars = keys %billy;
+
+}
+
+@values = sort keys %billy;
+
+ $struct = "
+struct termstruct {
+ struct sgttyb s1;
+";
+ $struct .= "
+ struct tchars s2;
+" if $tchars;
+ $struct .= "
+ struct ltchars s3;
+" if $ltchars;
+ $struct .= "
+};";
+
+print "Writing sgtty section of cchars.h... ";
+
+ print CCHARS "
+
+#ifdef CC_SGTTY
+$struct
+#define TermStructure struct termstruct
+
+char * cc_names[] = { ".join('',map("
+ \"$_\", ", @values ))."
+};
+
+#define MAXCC ". ($#values+1)."
+
+XS(XS_Term__ReadKey_GetControlChars)
+{
+ dXSARGS;
+ if (items < 0 || items > 1) {
+ croak(\"Usage: Term::ReadKey::GetControlChars()\");
+ }
+ SP -= items;
+ {
+ PerlIO * file;
+ TermStructure s;
+ if (items < 1)
+ file = STDIN;
+ else {
+ file = IoIFP(sv_2io(ST(0)));
+ }
+ if(ioctl(fileno(PerlIO_file),TIOCGETP,&s.s1) ".($tchars?"
+ ||ioctl(fileno(PerlIO_file),TIOCGETC,&s.s2) ":'').($ltchars?"
+ ||ioctl(fileno(PerlIO_file),TIOCGLTC,&s.s3) ":'')."
+ )
+ croak(\"Unable to read terminal settings in GetControlChars\");
+ else {
+ int i;
+ EXTEND(sp,MAXCC*2); ".join('',map("
+PUSHs(sv_2mortal(newSVpv(cc_names[$_],strlen(cc_names[$_])))); /* $values[$_] */
+PUSHs(sv_2mortal(newSVpv(&s.$billy{$values[$_]},1))); ",0..$#values))."
+
+ }
+ PUTBACK;
+ return;
+ }
+}
+
+XS(XS_Term__ReadKey_SetControlChars)
+{
+ dXSARGS;
+ /*if ((items % 2) != 0) {
+ croak(\"Usage: Term::ReadKey::SetControlChars(%charpairs,file=STDIN)\");
+ }*/
+ SP -= items;
+ {
+ PerlIO * file;
+ TermStructure s;
+ if ((items%2)==0)
+ file = STDIN;
+ else {
+ file = IoIFP(sv_2io(ST(items-1)));
+ }
+
+ if(ioctl(PerlIO_fileno(file),TIOCGETP,&s.s1) ".($tchars?"
+ ||ioctl(fileno(PerlIO_file),TIOCGETC,&s.s2) ":'').($ltchars?"
+ ||ioctl(fileno(PerlIO_file),TIOCGLTC,&s.s3) ":'')."
+ )
+ croak(\"Unable to read terminal settings in SetControlChars\");
+ else {
+ int i;
+ char * name, value;
+ for(i=0;i+1<items;i+=2) {
+ name = SvPV(ST(i),PL_na);
+ if( SvIOKp(ST(i+1)) || SvNOKp(ST(i+1)) )/* If Int or Float */
+ value = (char)SvIV(ST(i+1)); /* Store int value */
+ else /* Otherwise */
+ value = SvPV(ST(i+1),PL_na)[0]; /* Use first char of PV */
+
+ if (0) ; ".join('',map("
+ else if(strcmp(name,cc_names[$_])==0) /* $values[$_] */
+ s.$billy{$values[$_]} = value; ",0..$#values))."
+ else
+ croak(\"Invalid control character passed to SetControlChars\");
+
+ }
+ if(ioctl(fileno(PerlIO_file),TIOCSETN,&s.s1) ".($tchars?"
+ ||ioctl(fileno(PerlIO_file),TIOCSETC,&s.s2) ":'').($ltchars?"
+ ||ioctl(fileno(PerlIO_file),TIOCSLTC,&s.s3) ":'')."
+ ) croak(\"Unable to write terminal settings in SetControlChars\");
+ }
+ }
+ XSRETURN(1);
+}
+
+#endif
+
+#if !defined(CC_TERMIO) && !defined(CC_TERMIOS) && !defined(CC_SGTTY)
+#define TermStructure int
+XS(XS_Term__ReadKey_GetControlChars)
+{
+ dXSARGS;
+ if (items <0 || items>1) {
+ croak(\"Usage: Term::ReadKey::GetControlChars([FileHandle])\");
+ }
+ SP -= items;
+ {
+ ST(0) = sv_newmortal();
+ PUTBACK;
+ return;
+ }
+}
+
+XS(XS_Term__ReadKey_SetControlChars)
+{
+ dXSARGS;
+ if (items < 0 || items > 1) {
+ croak(\"Invalid control character passed to SetControlChars\");
+ }
+ SP -= items;
+ XSRETURN(1);
+}
+
+#endif
+
+";
+
+print "Done.\n";
+
+
+
+
+
diff --git a/gnu/usr.bin/perl/cpan/Term-ReadKey/ppport.h b/gnu/usr.bin/perl/cpan/Term-ReadKey/ppport.h
new file mode 100644
index 00000000000..99b6fa6e351
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/Term-ReadKey/ppport.h
@@ -0,0 +1,7452 @@
+#if 0
+<<'SKIP';
+#endif
+/*
+----------------------------------------------------------------------
+
+ ppport.h -- Perl/Pollution/Portability Version 3.21
+
+ Automatically created by Devel::PPPort running under perl 5.014004.
+
+ Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
+ includes in parts/inc/ instead.
+
+ Use 'perldoc ppport.h' to view the documentation below.
+
+----------------------------------------------------------------------
+
+SKIP
+
+=pod
+
+=head1 NAME
+
+ppport.h - Perl/Pollution/Portability version 3.21
+
+=head1 SYNOPSIS
+
+ perl ppport.h [options] [source files]
+
+ Searches current directory for files if no [source files] are given
+
+ --help show short help
+
+ --version show version
+
+ --patch=file write one patch file with changes
+ --copy=suffix write changed copies with suffix
+ --diff=program use diff program and options
+
+ --compat-version=version provide compatibility with Perl version
+ --cplusplus accept C++ comments
+
+ --quiet don't output anything except fatal errors
+ --nodiag don't show diagnostics
+ --nohints don't show hints
+ --nochanges don't suggest changes
+ --nofilter don't filter input files
+
+ --strip strip all script and doc functionality from
+ ppport.h
+
+ --list-provided list provided API
+ --list-unsupported list unsupported API
+ --api-info=name show Perl API portability information
+
+=head1 COMPATIBILITY
+
+This version of F<ppport.h> is designed to support operation with Perl
+installations back to 5.003, and has been tested up to 5.11.5.
+
+=head1 OPTIONS
+
+=head2 --help
+
+Display a brief usage summary.
+
+=head2 --version
+
+Display the version of F<ppport.h>.
+
+=head2 --patch=I<file>
+
+If this option is given, a single patch file will be created if
+any changes are suggested. This requires a working diff program
+to be installed on your system.
+
+=head2 --copy=I<suffix>
+
+If this option is given, a copy of each file will be saved with
+the given suffix that contains the suggested changes. This does
+not require any external programs. Note that this does not
+automagially add a dot between the original filename and the
+suffix. If you want the dot, you have to include it in the option
+argument.
+
+If neither C<--patch> or C<--copy> are given, the default is to
+simply print the diffs for each file. This requires either
+C<Text::Diff> or a C<diff> program to be installed.
+
+=head2 --diff=I<program>
+
+Manually set the diff program and options to use. The default
+is to use C<Text::Diff>, when installed, and output unified
+context diffs.
+
+=head2 --compat-version=I<version>
+
+Tell F<ppport.h> to check for compatibility with the given
+Perl version. The default is to check for compatibility with Perl
+version 5.003. You can use this option to reduce the output
+of F<ppport.h> if you intend to be backward compatible only
+down to a certain Perl version.
+
+=head2 --cplusplus
+
+Usually, F<ppport.h> will detect C++ style comments and
+replace them with C style comments for portability reasons.
+Using this option instructs F<ppport.h> to leave C++
+comments untouched.
+
+=head2 --quiet
+
+Be quiet. Don't print anything except fatal errors.
+
+=head2 --nodiag
+
+Don't output any diagnostic messages. Only portability
+alerts will be printed.
+
+=head2 --nohints
+
+Don't output any hints. Hints often contain useful portability
+notes. Warnings will still be displayed.
+
+=head2 --nochanges
+
+Don't suggest any changes. Only give diagnostic output and hints
+unless these are also deactivated.
+
+=head2 --nofilter
+
+Don't filter the list of input files. By default, files not looking
+like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped.
+
+=head2 --strip
+
+Strip all script and documentation functionality from F<ppport.h>.
+This reduces the size of F<ppport.h> dramatically and may be useful
+if you want to include F<ppport.h> in smaller modules without
+increasing their distribution size too much.
+
+The stripped F<ppport.h> will have a C<--unstrip> option that allows
+you to undo the stripping, but only if an appropriate C<Devel::PPPort>
+module is installed.
+
+=head2 --list-provided
+
+Lists the API elements for which compatibility is provided by
+F<ppport.h>. Also lists if it must be explicitly requested,
+if it has dependencies, and if there are hints or warnings for it.
+
+=head2 --list-unsupported
+
+Lists the API elements that are known not to be supported by
+F<ppport.h> and below which version of Perl they probably
+won't be available or work.
+
+=head2 --api-info=I<name>
+
+Show portability information for API elements matching I<name>.
+If I<name> is surrounded by slashes, it is interpreted as a regular
+expression.
+
+=head1 DESCRIPTION
+
+In order for a Perl extension (XS) module to be as portable as possible
+across differing versions of Perl itself, certain steps need to be taken.
+
+=over 4
+
+=item *
+
+Including this header is the first major one. This alone will give you
+access to a large part of the Perl API that hasn't been available in
+earlier Perl releases. Use
+
+ perl ppport.h --list-provided
+
+to see which API elements are provided by ppport.h.
+
+=item *
+
+You should avoid using deprecated parts of the API. For example, using
+global Perl variables without the C<PL_> prefix is deprecated. Also,
+some API functions used to have a C<perl_> prefix. Using this form is
+also deprecated. You can safely use the supported API, as F<ppport.h>
+will provide wrappers for older Perl versions.
+
+=item *
+
+If you use one of a few functions or variables that were not present in
+earlier versions of Perl, and that can't be provided using a macro, you
+have to explicitly request support for these functions by adding one or
+more C<#define>s in your source code before the inclusion of F<ppport.h>.
+
+These functions or variables will be marked C<explicit> in the list shown
+by C<--list-provided>.
+
+Depending on whether you module has a single or multiple files that
+use such functions or variables, you want either C<static> or global
+variants.
+
+For a C<static> function or variable (used only in a single source
+file), use:
+
+ #define NEED_function
+ #define NEED_variable
+
+For a global function or variable (used in multiple source files),
+use:
+
+ #define NEED_function_GLOBAL
+ #define NEED_variable_GLOBAL
+
+Note that you mustn't have more than one global request for the
+same function or variable in your project.
+
+ Function / Variable Static Request Global Request
+ -----------------------------------------------------------------------------------------
+ PL_parser NEED_PL_parser NEED_PL_parser_GLOBAL
+ PL_signals NEED_PL_signals NEED_PL_signals_GLOBAL
+ eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
+ grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
+ grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
+ grok_number() NEED_grok_number NEED_grok_number_GLOBAL
+ grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
+ grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
+ load_module() NEED_load_module NEED_load_module_GLOBAL
+ my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL
+ my_sprintf() NEED_my_sprintf NEED_my_sprintf_GLOBAL
+ my_strlcat() NEED_my_strlcat NEED_my_strlcat_GLOBAL
+ my_strlcpy() NEED_my_strlcpy NEED_my_strlcpy_GLOBAL
+ newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
+ newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
+ newSV_type() NEED_newSV_type NEED_newSV_type_GLOBAL
+ newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL
+ newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
+ pv_display() NEED_pv_display NEED_pv_display_GLOBAL
+ pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL
+ pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL
+ sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL
+ sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
+ sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
+ sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
+ sv_pvn_force_flags() NEED_sv_pvn_force_flags NEED_sv_pvn_force_flags_GLOBAL
+ sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
+ sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
+ vload_module() NEED_vload_module NEED_vload_module_GLOBAL
+ vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
+ warner() NEED_warner NEED_warner_GLOBAL
+
+To avoid namespace conflicts, you can change the namespace of the
+explicitly exported functions / variables using the C<DPPP_NAMESPACE>
+macro. Just C<#define> the macro before including C<ppport.h>:
+
+ #define DPPP_NAMESPACE MyOwnNamespace_
+ #include "ppport.h"
+
+The default namespace is C<DPPP_>.
+
+=back
+
+The good thing is that most of the above can be checked by running
+F<ppport.h> on your source code. See the next section for
+details.
+
+=head1 EXAMPLES
+
+To verify whether F<ppport.h> is needed for your module, whether you
+should make any changes to your code, and whether any special defines
+should be used, F<ppport.h> can be run as a Perl script to check your
+source code. Simply say:
+
+ perl ppport.h
+
+The result will usually be a list of patches suggesting changes
+that should at least be acceptable, if not necessarily the most
+efficient solution, or a fix for all possible problems.
+
+If you know that your XS module uses features only available in
+newer Perl releases, if you're aware that it uses C++ comments,
+and if you want all suggestions as a single patch file, you could
+use something like this:
+
+ perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
+
+If you only want your code to be scanned without any suggestions
+for changes, use:
+
+ perl ppport.h --nochanges
+
+You can specify a different C<diff> program or options, using
+the C<--diff> option:
+
+ perl ppport.h --diff='diff -C 10'
+
+This would output context diffs with 10 lines of context.
+
+If you want to create patched copies of your files instead, use:
+
+ perl ppport.h --copy=.new
+
+To display portability information for the C<newSVpvn> function,
+use:
+
+ perl ppport.h --api-info=newSVpvn
+
+Since the argument to C<--api-info> can be a regular expression,
+you can use
+
+ perl ppport.h --api-info=/_nomg$/
+
+to display portability information for all C<_nomg> functions or
+
+ perl ppport.h --api-info=/./
+
+to display information for all known API elements.
+
+=head1 BUGS
+
+If this version of F<ppport.h> is causing failure during
+the compilation of this module, please check if newer versions
+of either this module or C<Devel::PPPort> are available on CPAN
+before sending a bug report.
+
+If F<ppport.h> was generated using the latest version of
+C<Devel::PPPort> and is causing failure of this module, please
+file a bug report using the CPAN Request Tracker at L<http://rt.cpan.org/>.
+
+Please include the following information:
+
+=over 4
+
+=item 1.
+
+The complete output from running "perl -V"
+
+=item 2.
+
+This file.
+
+=item 3.
+
+The name and version of the module you were trying to build.
+
+=item 4.
+
+A full log of the build that failed.
+
+=item 5.
+
+Any other information that you think could be relevant.
+
+=back
+
+For the latest version of this code, please get the C<Devel::PPPort>
+module from CPAN.
+
+=head1 COPYRIGHT
+
+Version 3.x, Copyright (c) 2004-2013, Marcus Holland-Moritz.
+
+Version 2.x, Copyright (C) 2001, Paul Marquess.
+
+Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+See L<Devel::PPPort>.
+
+=cut
+
+use strict;
+
+# Disable broken TRIE-optimization
+BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 }
+
+my $VERSION = 3.21;
+
+my %opt = (
+ quiet => 0,
+ diag => 1,
+ hints => 1,
+ changes => 1,
+ cplusplus => 0,
+ filter => 1,
+ strip => 0,
+ version => 0,
+);
+
+my($ppport) = $0 =~ /([\w.]+)$/;
+my $LF = '(?:\r\n|[\r\n])'; # line feed
+my $HS = "[ \t]"; # horizontal whitespace
+
+# Never use C comments in this file!
+my $ccs = '/'.'*';
+my $cce = '*'.'/';
+my $rccs = quotemeta $ccs;
+my $rcce = quotemeta $cce;
+
+eval {
+ require Getopt::Long;
+ Getopt::Long::GetOptions(\%opt, qw(
+ help quiet diag! filter! hints! changes! cplusplus strip version
+ patch=s copy=s diff=s compat-version=s
+ list-provided list-unsupported api-info=s
+ )) or usage();
+};
+
+if ($@ and grep /^-/, @ARGV) {
+ usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
+ die "Getopt::Long not found. Please don't use any options.\n";
+}
+
+if ($opt{version}) {
+ print "This is $0 $VERSION.\n";
+ exit 0;
+}
+
+usage() if $opt{help};
+strip() if $opt{strip};
+
+if (exists $opt{'compat-version'}) {
+ my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
+ if ($@) {
+ die "Invalid version number format: '$opt{'compat-version'}'\n";
+ }
+ die "Only Perl 5 is supported\n" if $r != 5;
+ die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
+ $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
+}
+else {
+ $opt{'compat-version'} = 5;
+}
+
+my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
+ ? ( $1 => {
+ ($2 ? ( base => $2 ) : ()),
+ ($3 ? ( todo => $3 ) : ()),
+ (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
+ (index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
+ (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
+ } )
+ : die "invalid spec: $_" } qw(
+AvFILLp|5.004050||p
+AvFILL|||
+BhkDISABLE||5.019003|
+BhkENABLE||5.019003|
+BhkENTRY_set||5.019003|
+BhkENTRY|||
+BhkFLAGS|||
+CALL_BLOCK_HOOKS|||
+CLASS|||n
+CPERLscope|5.005000||p
+CX_CURPAD_SAVE|||
+CX_CURPAD_SV|||
+CopFILEAV|5.006000||p
+CopFILEGV_set|5.006000||p
+CopFILEGV|5.006000||p
+CopFILESV|5.006000||p
+CopFILE_set|5.006000||p
+CopFILE|5.006000||p
+CopSTASHPV_set|5.006000||p
+CopSTASHPV|5.006000||p
+CopSTASH_eq|5.006000||p
+CopSTASH_set|5.006000||p
+CopSTASH|5.006000||p
+CopyD|5.009002|5.004050|p
+Copy||5.004050|
+CvPADLIST||5.008001|
+CvSTASH|||
+CvWEAKOUTSIDE|||
+DEFSV_set|5.010001||p
+DEFSV|5.004050||p
+END_EXTERN_C|5.005000||p
+ENTER|||
+ERRSV|5.004050||p
+EXTEND|||
+EXTERN_C|5.005000||p
+F0convert|||n
+FREETMPS|||
+GIMME_V||5.004000|n
+GIMME|||n
+GROK_NUMERIC_RADIX|5.007002||p
+G_ARRAY|||
+G_DISCARD|||
+G_EVAL|||
+G_METHOD|5.006001||p
+G_NOARGS|||
+G_SCALAR|||
+G_VOID||5.004000|
+GetVars|||
+GvAV|||
+GvCV|||
+GvHV|||
+GvSVn|5.009003||p
+GvSV|||
+Gv_AMupdate||5.011000|
+HEf_SVKEY||5.004000|
+HeHASH||5.004000|
+HeKEY||5.004000|
+HeKLEN||5.004000|
+HePV||5.004000|
+HeSVKEY_force||5.004000|
+HeSVKEY_set||5.004000|
+HeSVKEY||5.004000|
+HeUTF8||5.010001|
+HeVAL||5.004000|
+HvENAMELEN||5.015004|
+HvENAMEUTF8||5.015004|
+HvENAME||5.013007|
+HvNAMELEN_get|5.009003||p
+HvNAMELEN||5.015004|
+HvNAMEUTF8||5.015004|
+HvNAME_get|5.009003||p
+HvNAME|||
+INT2PTR|5.006000||p
+IN_LOCALE_COMPILETIME|5.007002||p
+IN_LOCALE_RUNTIME|5.007002||p
+IN_LOCALE|5.007002||p
+IN_PERL_COMPILETIME|5.008001||p
+IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
+IS_NUMBER_INFINITY|5.007002||p
+IS_NUMBER_IN_UV|5.007002||p
+IS_NUMBER_NAN|5.007003||p
+IS_NUMBER_NEG|5.007002||p
+IS_NUMBER_NOT_INT|5.007002||p
+IVSIZE|5.006000||p
+IVTYPE|5.006000||p
+IVdf|5.006000||p
+LEAVE|||
+LINKLIST||5.013006|
+LVRET|||
+MARK|||
+MULTICALL||5.019003|
+MY_CXT_CLONE|5.009002||p
+MY_CXT_INIT|5.007003||p
+MY_CXT|5.007003||p
+MoveD|5.009002|5.004050|p
+Move||5.004050|
+NOOP|5.005000||p
+NUM2PTR|5.006000||p
+NVTYPE|5.006000||p
+NVef|5.006001||p
+NVff|5.006001||p
+NVgf|5.006001||p
+Newxc|5.009003||p
+Newxz|5.009003||p
+Newx|5.009003||p
+Nullav|||
+Nullch|||
+Nullcv|||
+Nullhv|||
+Nullsv|||
+OP_CLASS||5.013007|
+OP_DESC||5.007003|
+OP_NAME||5.007003|
+ORIGMARK|||
+PAD_BASE_SV|||
+PAD_CLONE_VARS|||
+PAD_COMPNAME_FLAGS|||
+PAD_COMPNAME_GEN_set|||
+PAD_COMPNAME_GEN|||
+PAD_COMPNAME_OURSTASH|||
+PAD_COMPNAME_PV|||
+PAD_COMPNAME_TYPE|||
+PAD_RESTORE_LOCAL|||
+PAD_SAVE_LOCAL|||
+PAD_SAVE_SETNULLPAD|||
+PAD_SETSV|||
+PAD_SET_CUR_NOSAVE|||
+PAD_SET_CUR|||
+PAD_SVl|||
+PAD_SV|||
+PERLIO_FUNCS_CAST|5.009003||p
+PERLIO_FUNCS_DECL|5.009003||p
+PERL_ABS|5.008001||p
+PERL_BCDVERSION|5.019002||p
+PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
+PERL_HASH|5.004000||p
+PERL_INT_MAX|5.004000||p
+PERL_INT_MIN|5.004000||p
+PERL_LONG_MAX|5.004000||p
+PERL_LONG_MIN|5.004000||p
+PERL_MAGIC_arylen|5.007002||p
+PERL_MAGIC_backref|5.007002||p
+PERL_MAGIC_bm|5.007002||p
+PERL_MAGIC_collxfrm|5.007002||p
+PERL_MAGIC_dbfile|5.007002||p
+PERL_MAGIC_dbline|5.007002||p
+PERL_MAGIC_defelem|5.007002||p
+PERL_MAGIC_envelem|5.007002||p
+PERL_MAGIC_env|5.007002||p
+PERL_MAGIC_ext|5.007002||p
+PERL_MAGIC_fm|5.007002||p
+PERL_MAGIC_glob|5.019002||p
+PERL_MAGIC_isaelem|5.007002||p
+PERL_MAGIC_isa|5.007002||p
+PERL_MAGIC_mutex|5.019002||p
+PERL_MAGIC_nkeys|5.007002||p
+PERL_MAGIC_overload_elem|5.019002||p
+PERL_MAGIC_overload_table|5.007002||p
+PERL_MAGIC_overload|5.019002||p
+PERL_MAGIC_pos|5.007002||p
+PERL_MAGIC_qr|5.007002||p
+PERL_MAGIC_regdata|5.007002||p
+PERL_MAGIC_regdatum|5.007002||p
+PERL_MAGIC_regex_global|5.007002||p
+PERL_MAGIC_shared_scalar|5.007003||p
+PERL_MAGIC_shared|5.007003||p
+PERL_MAGIC_sigelem|5.007002||p
+PERL_MAGIC_sig|5.007002||p
+PERL_MAGIC_substr|5.007002||p
+PERL_MAGIC_sv|5.007002||p
+PERL_MAGIC_taint|5.007002||p
+PERL_MAGIC_tiedelem|5.007002||p
+PERL_MAGIC_tiedscalar|5.007002||p
+PERL_MAGIC_tied|5.007002||p
+PERL_MAGIC_utf8|5.008001||p
+PERL_MAGIC_uvar_elem|5.007003||p
+PERL_MAGIC_uvar|5.007002||p
+PERL_MAGIC_vec|5.007002||p
+PERL_MAGIC_vstring|5.008001||p
+PERL_PV_ESCAPE_ALL|5.009004||p
+PERL_PV_ESCAPE_FIRSTCHAR|5.009004||p
+PERL_PV_ESCAPE_NOBACKSLASH|5.009004||p
+PERL_PV_ESCAPE_NOCLEAR|5.009004||p
+PERL_PV_ESCAPE_QUOTE|5.009004||p
+PERL_PV_ESCAPE_RE|5.009005||p
+PERL_PV_ESCAPE_UNI_DETECT|5.009004||p
+PERL_PV_ESCAPE_UNI|5.009004||p
+PERL_PV_PRETTY_DUMP|5.009004||p
+PERL_PV_PRETTY_ELLIPSES|5.010000||p
+PERL_PV_PRETTY_LTGT|5.009004||p
+PERL_PV_PRETTY_NOCLEAR|5.010000||p
+PERL_PV_PRETTY_QUOTE|5.009004||p
+PERL_PV_PRETTY_REGPROP|5.009004||p
+PERL_QUAD_MAX|5.004000||p
+PERL_QUAD_MIN|5.004000||p
+PERL_REVISION|5.006000||p
+PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
+PERL_SCAN_DISALLOW_PREFIX|5.007003||p
+PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
+PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
+PERL_SHORT_MAX|5.004000||p
+PERL_SHORT_MIN|5.004000||p
+PERL_SIGNALS_UNSAFE_FLAG|5.008001||p
+PERL_SUBVERSION|5.006000||p
+PERL_SYS_INIT3||5.010000|
+PERL_SYS_INIT||5.010000|
+PERL_SYS_TERM||5.019003|
+PERL_UCHAR_MAX|5.004000||p
+PERL_UCHAR_MIN|5.004000||p
+PERL_UINT_MAX|5.004000||p
+PERL_UINT_MIN|5.004000||p
+PERL_ULONG_MAX|5.004000||p
+PERL_ULONG_MIN|5.004000||p
+PERL_UNUSED_ARG|5.009003||p
+PERL_UNUSED_CONTEXT|5.009004||p
+PERL_UNUSED_DECL|5.007002||p
+PERL_UNUSED_VAR|5.007002||p
+PERL_UQUAD_MAX|5.004000||p
+PERL_UQUAD_MIN|5.004000||p
+PERL_USE_GCC_BRACE_GROUPS|5.009004||p
+PERL_USHORT_MAX|5.004000||p
+PERL_USHORT_MIN|5.004000||p
+PERL_VERSION|5.006000||p
+PL_DBsignal|5.005000||p
+PL_DBsingle|||pn
+PL_DBsub|||pn
+PL_DBtrace|||pn
+PL_Sv|5.005000||p
+PL_bufend|5.019002||p
+PL_bufptr|5.019002||p
+PL_check||5.006000|
+PL_compiling|5.004050||p
+PL_comppad_name||5.017004|
+PL_comppad||5.008001|
+PL_copline|5.019002||p
+PL_curcop|5.004050||p
+PL_curpad||5.005000|
+PL_curstash|5.004050||p
+PL_debstash|5.004050||p
+PL_defgv|5.004050||p
+PL_diehook|5.004050||p
+PL_dirty|5.004050||p
+PL_dowarn|||pn
+PL_errgv|5.004050||p
+PL_error_count|5.019002||p
+PL_expect|5.019002||p
+PL_hexdigit|5.005000||p
+PL_hints|5.005000||p
+PL_in_my_stash|5.019002||p
+PL_in_my|5.019002||p
+PL_keyword_plugin||5.011002|
+PL_last_in_gv|||n
+PL_laststatval|5.005000||p
+PL_lex_state|5.019002||p
+PL_lex_stuff|5.019002||p
+PL_linestr|5.019002||p
+PL_modglobal||5.005000|n
+PL_na|5.004050||pn
+PL_no_modify|5.006000||p
+PL_ofsgv|||n
+PL_opfreehook||5.011000|n
+PL_parser|5.009005|5.009005|p
+PL_peepp||5.007003|n
+PL_perl_destruct_level|5.004050||p
+PL_perldb|5.004050||p
+PL_ppaddr|5.006000||p
+PL_rpeepp||5.013005|n
+PL_rsfp_filters|5.019002||p
+PL_rsfp|5.019002||p
+PL_rs|||n
+PL_signals|5.008001||p
+PL_stack_base|5.004050||p
+PL_stack_sp|5.004050||p
+PL_statcache|5.005000||p
+PL_stdingv|5.004050||p
+PL_sv_arenaroot|5.004050||p
+PL_sv_no|5.004050||pn
+PL_sv_undef|5.004050||pn
+PL_sv_yes|5.004050||pn
+PL_tainted|5.004050||p
+PL_tainting|5.004050||p
+PL_tokenbuf|5.019002||p
+POP_MULTICALL||5.019003|
+POPi|||n
+POPl|||n
+POPn|||n
+POPpbytex||5.007001|n
+POPpx||5.005030|n
+POPp|||n
+POPs|||n
+PTR2IV|5.006000||p
+PTR2NV|5.006000||p
+PTR2UV|5.006000||p
+PTR2nat|5.009003||p
+PTR2ul|5.007001||p
+PTRV|5.006000||p
+PUSHMARK|||
+PUSH_MULTICALL||5.019003|
+PUSHi|||
+PUSHmortal|5.009002||p
+PUSHn|||
+PUSHp|||
+PUSHs|||
+PUSHu|5.004000||p
+PUTBACK|||
+PadARRAY||5.019003|
+PadMAX||5.019003|
+PadlistARRAY||5.019003|
+PadlistMAX||5.019003|
+PadlistNAMESARRAY||5.019003|
+PadlistNAMESMAX||5.019003|
+PadlistNAMES||5.019003|
+PadlistREFCNT||5.017004|
+PadnameIsOUR|||
+PadnameIsSTATE|||
+PadnameLEN||5.019003|
+PadnameOURSTASH|||
+PadnameOUTER|||
+PadnamePV||5.019003|
+PadnameSV||5.019003|
+PadnameTYPE|||
+PadnameUTF8||5.019003|
+PadnamelistARRAY||5.019003|
+PadnamelistMAX||5.019003|
+PerlIO_clearerr||5.007003|
+PerlIO_close||5.007003|
+PerlIO_context_layers||5.009004|
+PerlIO_eof||5.007003|
+PerlIO_error||5.007003|
+PerlIO_fileno||5.007003|
+PerlIO_fill||5.007003|
+PerlIO_flush||5.007003|
+PerlIO_get_base||5.007003|
+PerlIO_get_bufsiz||5.007003|
+PerlIO_get_cnt||5.007003|
+PerlIO_get_ptr||5.007003|
+PerlIO_read||5.007003|
+PerlIO_seek||5.007003|
+PerlIO_set_cnt||5.007003|
+PerlIO_set_ptrcnt||5.007003|
+PerlIO_setlinebuf||5.007003|
+PerlIO_stderr||5.007003|
+PerlIO_stdin||5.007003|
+PerlIO_stdout||5.007003|
+PerlIO_tell||5.007003|
+PerlIO_unread||5.007003|
+PerlIO_write||5.007003|
+Perl_signbit||5.009005|n
+PoisonFree|5.009004||p
+PoisonNew|5.009004||p
+PoisonWith|5.009004||p
+Poison|5.008000||p
+READ_XDIGIT||5.017006|
+RETVAL|||n
+Renewc|||
+Renew|||
+SAVECLEARSV|||
+SAVECOMPPAD|||
+SAVEPADSV|||
+SAVETMPS|||
+SAVE_DEFSV|5.004050||p
+SPAGAIN|||
+SP|||
+START_EXTERN_C|5.005000||p
+START_MY_CXT|5.007003||p
+STMT_END|||p
+STMT_START|||p
+STR_WITH_LEN|5.009003||p
+ST|||
+SV_CONST_RETURN|5.009003||p
+SV_COW_DROP_PV|5.008001||p
+SV_COW_SHARED_HASH_KEYS|5.009005||p
+SV_GMAGIC|5.007002||p
+SV_HAS_TRAILING_NUL|5.009004||p
+SV_IMMEDIATE_UNREF|5.007001||p
+SV_MUTABLE_RETURN|5.009003||p
+SV_NOSTEAL|5.009002||p
+SV_SMAGIC|5.009003||p
+SV_UTF8_NO_ENCODING|5.008001||p
+SVfARG|5.009005||p
+SVf_UTF8|5.006000||p
+SVf|5.006000||p
+SVt_INVLIST||5.019002|
+SVt_IV|||
+SVt_NULL|||
+SVt_NV|||
+SVt_PVAV|||
+SVt_PVCV|||
+SVt_PVFM|||
+SVt_PVGV|||
+SVt_PVHV|||
+SVt_PVIO|||
+SVt_PVIV|||
+SVt_PVLV|||
+SVt_PVMG|||
+SVt_PVNV|||
+SVt_PV|||
+SVt_REGEXP||5.011000|
+Safefree|||
+Slab_Alloc|||
+Slab_Free|||
+Slab_to_ro|||
+Slab_to_rw|||
+StructCopy|||
+SvCUR_set|||
+SvCUR|||
+SvEND|||
+SvGAMAGIC||5.006001|
+SvGETMAGIC|5.004050||p
+SvGROW|||
+SvIOK_UV||5.006000|
+SvIOK_notUV||5.006000|
+SvIOK_off|||
+SvIOK_only_UV||5.006000|
+SvIOK_only|||
+SvIOK_on|||
+SvIOKp|||
+SvIOK|||
+SvIVX|||
+SvIV_nomg|5.009001||p
+SvIV_set|||
+SvIVx|||
+SvIV|||
+SvIsCOW_shared_hash||5.008003|
+SvIsCOW||5.008003|
+SvLEN_set|||
+SvLEN|||
+SvLOCK||5.007003|
+SvMAGIC_set|5.009003||p
+SvNIOK_off|||
+SvNIOKp|||
+SvNIOK|||
+SvNOK_off|||
+SvNOK_only|||
+SvNOK_on|||
+SvNOKp|||
+SvNOK|||
+SvNVX|||
+SvNV_nomg||5.013002|
+SvNV_set|||
+SvNVx|||
+SvNV|||
+SvOK|||
+SvOOK_offset||5.011000|
+SvOOK|||
+SvPOK_off|||
+SvPOK_only_UTF8||5.006000|
+SvPOK_only|||
+SvPOK_on|||
+SvPOKp|||
+SvPOK|||
+SvPVX_const|5.009003||p
+SvPVX_mutable|5.009003||p
+SvPVX|||
+SvPV_const|5.009003||p
+SvPV_flags_const_nolen|5.009003||p
+SvPV_flags_const|5.009003||p
+SvPV_flags_mutable|5.009003||p
+SvPV_flags|5.007002||p
+SvPV_force_flags_mutable|5.009003||p
+SvPV_force_flags_nolen|5.009003||p
+SvPV_force_flags|5.007002||p
+SvPV_force_mutable|5.009003||p
+SvPV_force_nolen|5.009003||p
+SvPV_force_nomg_nolen|5.009003||p
+SvPV_force_nomg|5.007002||p
+SvPV_force|||p
+SvPV_mutable|5.009003||p
+SvPV_nolen_const|5.009003||p
+SvPV_nolen|5.006000||p
+SvPV_nomg_const_nolen|5.009003||p
+SvPV_nomg_const|5.009003||p
+SvPV_nomg_nolen|5.013007||p
+SvPV_nomg|5.007002||p
+SvPV_renew|5.009003||p
+SvPV_set|||
+SvPVbyte_force||5.009002|
+SvPVbyte_nolen||5.006000|
+SvPVbytex_force||5.006000|
+SvPVbytex||5.006000|
+SvPVbyte|5.006000||p
+SvPVutf8_force||5.006000|
+SvPVutf8_nolen||5.006000|
+SvPVutf8x_force||5.006000|
+SvPVutf8x||5.006000|
+SvPVutf8||5.006000|
+SvPVx|||
+SvPV|||
+SvREFCNT_dec_NN||5.017007|
+SvREFCNT_dec|||
+SvREFCNT_inc_NN|5.009004||p
+SvREFCNT_inc_simple_NN|5.009004||p
+SvREFCNT_inc_simple_void_NN|5.009004||p
+SvREFCNT_inc_simple_void|5.009004||p
+SvREFCNT_inc_simple|5.009004||p
+SvREFCNT_inc_void_NN|5.009004||p
+SvREFCNT_inc_void|5.009004||p
+SvREFCNT_inc|||p
+SvREFCNT|||
+SvROK_off|||
+SvROK_on|||
+SvROK|||
+SvRV_set|5.009003||p
+SvRV|||
+SvRXOK||5.009005|
+SvRX||5.009005|
+SvSETMAGIC|||
+SvSHARED_HASH|5.009003||p
+SvSHARE||5.007003|
+SvSTASH_set|5.009003||p
+SvSTASH|||
+SvSetMagicSV_nosteal||5.004000|
+SvSetMagicSV||5.004000|
+SvSetSV_nosteal||5.004000|
+SvSetSV|||
+SvTAINTED_off||5.004000|
+SvTAINTED_on||5.004000|
+SvTAINTED||5.004000|
+SvTAINT|||
+SvTHINKFIRST|||
+SvTRUE_nomg||5.013006|
+SvTRUE|||
+SvTYPE|||
+SvUNLOCK||5.007003|
+SvUOK|5.007001|5.006000|p
+SvUPGRADE|||
+SvUTF8_off||5.006000|
+SvUTF8_on||5.006000|
+SvUTF8||5.006000|
+SvUVXx|5.004000||p
+SvUVX|5.004000||p
+SvUV_nomg|5.009001||p
+SvUV_set|5.009003||p
+SvUVx|5.004000||p
+SvUV|5.004000||p
+SvVOK||5.008001|
+SvVSTRING_mg|5.009004||p
+THIS|||n
+UNDERBAR|5.009002||p
+UTF8_MAXBYTES|5.009002||p
+UVSIZE|5.006000||p
+UVTYPE|5.006000||p
+UVXf|5.007001||p
+UVof|5.006000||p
+UVuf|5.006000||p
+UVxf|5.006000||p
+WARN_ALL|5.006000||p
+WARN_AMBIGUOUS|5.006000||p
+WARN_ASSERTIONS|5.019002||p
+WARN_BAREWORD|5.006000||p
+WARN_CLOSED|5.006000||p
+WARN_CLOSURE|5.006000||p
+WARN_DEBUGGING|5.006000||p
+WARN_DEPRECATED|5.006000||p
+WARN_DIGIT|5.006000||p
+WARN_EXEC|5.006000||p
+WARN_EXITING|5.006000||p
+WARN_GLOB|5.006000||p
+WARN_INPLACE|5.006000||p
+WARN_INTERNAL|5.006000||p
+WARN_IO|5.006000||p
+WARN_LAYER|5.008000||p
+WARN_MALLOC|5.006000||p
+WARN_MISC|5.006000||p
+WARN_NEWLINE|5.006000||p
+WARN_NUMERIC|5.006000||p
+WARN_ONCE|5.006000||p
+WARN_OVERFLOW|5.006000||p
+WARN_PACK|5.006000||p
+WARN_PARENTHESIS|5.006000||p
+WARN_PIPE|5.006000||p
+WARN_PORTABLE|5.006000||p
+WARN_PRECEDENCE|5.006000||p
+WARN_PRINTF|5.006000||p
+WARN_PROTOTYPE|5.006000||p
+WARN_QW|5.006000||p
+WARN_RECURSION|5.006000||p
+WARN_REDEFINE|5.006000||p
+WARN_REGEXP|5.006000||p
+WARN_RESERVED|5.006000||p
+WARN_SEMICOLON|5.006000||p
+WARN_SEVERE|5.006000||p
+WARN_SIGNAL|5.006000||p
+WARN_SUBSTR|5.006000||p
+WARN_SYNTAX|5.006000||p
+WARN_TAINT|5.006000||p
+WARN_THREADS|5.008000||p
+WARN_UNINITIALIZED|5.006000||p
+WARN_UNOPENED|5.006000||p
+WARN_UNPACK|5.006000||p
+WARN_UNTIE|5.006000||p
+WARN_UTF8|5.006000||p
+WARN_VOID|5.006000||p
+WIDEST_UTYPE|5.015004||p
+XCPT_CATCH|5.009002||p
+XCPT_RETHROW|5.009002|5.007001|p
+XCPT_TRY_END|5.009002|5.004000|p
+XCPT_TRY_START|5.009002|5.004000|p
+XPUSHi|||
+XPUSHmortal|5.009002||p
+XPUSHn|||
+XPUSHp|||
+XPUSHs|||
+XPUSHu|5.004000||p
+XSPROTO|5.010000||p
+XSRETURN_EMPTY|||
+XSRETURN_IV|||
+XSRETURN_NO|||
+XSRETURN_NV|||
+XSRETURN_PV|||
+XSRETURN_UNDEF|||
+XSRETURN_UV|5.008001||p
+XSRETURN_YES|||
+XSRETURN|||p
+XST_mIV|||
+XST_mNO|||
+XST_mNV|||
+XST_mPV|||
+XST_mUNDEF|||
+XST_mUV|5.008001||p
+XST_mYES|||
+XS_APIVERSION_BOOTCHECK||5.013004|
+XS_EXTERNAL||5.019003|
+XS_INTERNAL||5.019003|
+XS_VERSION_BOOTCHECK|||
+XS_VERSION|||
+XSprePUSH|5.006000||p
+XS|||
+XopDISABLE||5.019003|
+XopENABLE||5.019003|
+XopENTRY_set||5.019003|
+XopENTRY||5.019003|
+XopFLAGS||5.013007|
+ZeroD|5.009002||p
+Zero|||
+_aMY_CXT|5.007003||p
+_add_range_to_invlist|||
+_append_range_to_invlist|||
+_core_swash_init|||
+_get_swash_invlist|||
+_invlist_array_init|||
+_invlist_contains_cp|||
+_invlist_contents|||
+_invlist_dump|||
+_invlist_intersection_maybe_complement_2nd|||
+_invlist_intersection|||
+_invlist_invert_prop|||
+_invlist_invert|||
+_invlist_len|||
+_invlist_populate_swatch|||
+_invlist_search|||
+_invlist_subtract|||
+_invlist_union_maybe_complement_2nd|||
+_invlist_union|||
+_is_uni_FOO||5.017008|
+_is_uni_perl_idcont||5.017008|
+_is_uni_perl_idstart||5.017007|
+_is_utf8_FOO||5.017008|
+_is_utf8_mark||5.017008|
+_is_utf8_perl_idcont||5.017008|
+_is_utf8_perl_idstart||5.017007|
+_new_invlist_C_array|||
+_new_invlist|||
+_pMY_CXT|5.007003||p
+_swash_inversion_hash|||
+_swash_to_invlist|||
+_to_fold_latin1|||
+_to_uni_fold_flags||5.013011|
+_to_upper_title_latin1|||
+_to_utf8_fold_flags||5.015006|
+_to_utf8_lower_flags||5.015006|
+_to_utf8_title_flags||5.015006|
+_to_utf8_upper_flags||5.015006|
+aMY_CXT_|5.007003||p
+aMY_CXT|5.007003||p
+aTHXR_|5.019002||p
+aTHXR|5.019002||p
+aTHX_|5.006000||p
+aTHX|5.006000||p
+aassign_common_vars|||
+add_cp_to_invlist|||
+add_data|||n
+add_utf16_textfilter|||
+addmad|||
+adjust_size_and_find_bucket|||n
+adjust_stack_on_leave|||
+alloc_maybe_populate_EXACT|||
+alloccopstash|||
+allocmy|||
+amagic_call|||
+amagic_cmp_locale|||
+amagic_cmp|||
+amagic_deref_call||5.013007|
+amagic_i_ncmp|||
+amagic_is_enabled|||
+amagic_ncmp|||
+anonymise_cv_maybe|||
+any_dup|||
+ao|||
+append_madprops|||
+apply_attrs_my|||
+apply_attrs_string||5.006001|
+apply_attrs|||
+apply|||
+assert_uft8_cache_coherent|||
+atfork_lock||5.007003|n
+atfork_unlock||5.007003|n
+av_arylen_p||5.009003|
+av_clear|||
+av_create_and_push||5.009005|
+av_create_and_unshift_one||5.009005|
+av_delete||5.006000|
+av_exists||5.006000|
+av_extend_guts|||
+av_extend|||
+av_fetch|||
+av_fill|||
+av_iter_p||5.011000|
+av_len|||
+av_make|||
+av_pop|||
+av_push|||
+av_reify|||
+av_shift|||
+av_store|||
+av_tindex||5.017009|
+av_top_index||5.017009|
+av_undef|||
+av_unshift|||
+ax|||n
+bad_type_gv|||
+bad_type_pv|||
+bind_match|||
+block_end|||
+block_gimme||5.004000|
+block_start|||
+blockhook_register||5.013003|
+boolSV|5.004000||p
+boot_core_PerlIO|||
+boot_core_UNIVERSAL|||
+boot_core_mro|||
+bytes_cmp_utf8||5.013007|
+bytes_from_utf8||5.007001|
+bytes_to_uni|||n
+bytes_to_utf8||5.006001|
+call_argv|5.006000||p
+call_atexit||5.006000|
+call_list||5.004000|
+call_method|5.006000||p
+call_pv|5.006000||p
+call_sv|5.006000||p
+caller_cx||5.013005|
+calloc||5.007002|n
+cando|||
+cast_i32||5.006000|
+cast_iv||5.006000|
+cast_ulong||5.006000|
+cast_uv||5.006000|
+check_locale_boundary_crossing|||
+check_type_and_open|||
+check_uni|||
+check_utf8_print|||
+checkcomma|||
+ckWARN|5.006000||p
+ck_entersub_args_core|||
+ck_entersub_args_list||5.013006|
+ck_entersub_args_proto_or_list||5.013006|
+ck_entersub_args_proto||5.013006|
+ck_warner_d||5.011001|v
+ck_warner||5.011001|v
+ckwarn_common|||
+ckwarn_d||5.009003|
+ckwarn||5.009003|
+cl_and|||n
+cl_anything|||n
+cl_init|||n
+cl_is_anything|||n
+cl_or|||n
+clear_placeholders|||
+clone_params_del|||n
+clone_params_new|||n
+closest_cop|||
+compute_EXACTish|||
+convert|||
+cop_fetch_label||5.015001|
+cop_free|||
+cop_hints_2hv||5.013007|
+cop_hints_fetch_pvn||5.013007|
+cop_hints_fetch_pvs||5.013007|
+cop_hints_fetch_pv||5.013007|
+cop_hints_fetch_sv||5.013007|
+cop_store_label||5.015001|
+cophh_2hv||5.013007|
+cophh_copy||5.013007|
+cophh_delete_pvn||5.013007|
+cophh_delete_pvs||5.013007|
+cophh_delete_pv||5.013007|
+cophh_delete_sv||5.013007|
+cophh_fetch_pvn||5.013007|
+cophh_fetch_pvs||5.013007|
+cophh_fetch_pv||5.013007|
+cophh_fetch_sv||5.013007|
+cophh_free||5.013007|
+cophh_new_empty||5.019003|
+cophh_store_pvn||5.013007|
+cophh_store_pvs||5.013007|
+cophh_store_pv||5.013007|
+cophh_store_sv||5.013007|
+core_prototype|||
+core_regclass_swash|||
+coresub_op|||
+could_it_be_a_POSIX_class|||
+cr_textfilter|||
+create_eval_scope|||
+croak_memory_wrap||5.019003|n
+croak_no_mem|||n
+croak_no_modify||5.013003|n
+croak_nocontext|||vn
+croak_popstack|||n
+croak_sv||5.013001|
+croak_xs_usage||5.010001|n
+croak|||v
+csighandler||5.009003|n
+curmad|||
+current_re_engine|||
+curse|||
+custom_op_desc||5.007003|
+custom_op_name||5.007003|
+custom_op_register||5.013007|
+custom_op_xop||5.013007|
+cv_ckproto_len_flags|||
+cv_clone_into|||
+cv_clone|||
+cv_const_sv_or_av|||
+cv_const_sv||5.004000|
+cv_dump|||
+cv_forget_slab|||
+cv_get_call_checker||5.013006|
+cv_set_call_checker||5.013006|
+cv_undef|||
+cvgv_set|||
+cvstash_set|||
+cx_dump||5.005000|
+cx_dup|||
+cxinc|||
+dAXMARK|5.009003||p
+dAX|5.007002||p
+dITEMS|5.007002||p
+dMARK|||
+dMULTICALL||5.009003|
+dMY_CXT_SV|5.007003||p
+dMY_CXT|5.007003||p
+dNOOP|5.006000||p
+dORIGMARK|||
+dSP|||
+dTHR|5.004050||p
+dTHXR|5.019002||p
+dTHXa|5.006000||p
+dTHXoa|5.006000||p
+dTHX|5.006000||p
+dUNDERBAR|5.009002||p
+dVAR|5.009003||p
+dXCPT|5.009002||p
+dXSARGS|||
+dXSI32|||
+dXSTARG|5.006000||p
+deb_curcv|||
+deb_nocontext|||vn
+deb_stack_all|||
+deb_stack_n|||
+debop||5.005000|
+debprofdump||5.005000|
+debprof|||
+debstackptrs||5.007003|
+debstack||5.007003|
+debug_start_match|||
+deb||5.007003|v
+defelem_target|||
+del_sv|||
+delete_eval_scope|||
+delimcpy||5.004000|n
+deprecate_commaless_var_list|||
+despatch_signals||5.007001|
+destroy_matcher|||
+die_nocontext|||vn
+die_sv||5.013001|
+die_unwind|||
+die|||v
+dirp_dup|||
+div128|||
+djSP|||
+do_aexec5|||
+do_aexec|||
+do_aspawn|||
+do_binmode||5.004050|
+do_chomp|||
+do_close|||
+do_delete_local|||
+do_dump_pad|||
+do_eof|||
+do_exec3|||
+do_execfree|||
+do_exec|||
+do_gv_dump||5.006000|
+do_gvgv_dump||5.006000|
+do_hv_dump||5.006000|
+do_ipcctl|||
+do_ipcget|||
+do_join|||
+do_magic_dump||5.006000|
+do_msgrcv|||
+do_msgsnd|||
+do_ncmp|||
+do_oddball|||
+do_op_dump||5.006000|
+do_op_xmldump|||
+do_open9||5.006000|
+do_openn||5.007001|
+do_open||5.004000|
+do_pmop_dump||5.006000|
+do_pmop_xmldump|||
+do_print|||
+do_readline|||
+do_seek|||
+do_semop|||
+do_shmio|||
+do_smartmatch|||
+do_spawn_nowait|||
+do_spawn|||
+do_sprintf|||
+do_sv_dump||5.006000|
+do_sysseek|||
+do_tell|||
+do_trans_complex_utf8|||
+do_trans_complex|||
+do_trans_count_utf8|||
+do_trans_count|||
+do_trans_simple_utf8|||
+do_trans_simple|||
+do_trans|||
+do_vecget|||
+do_vecset|||
+do_vop|||
+docatch|||
+doeval|||
+dofile|||
+dofindlabel|||
+doform|||
+doing_taint||5.008001|n
+dooneliner|||
+doopen_pm|||
+doparseform|||
+dopoptoeval|||
+dopoptogiven|||
+dopoptolabel|||
+dopoptoloop|||
+dopoptosub_at|||
+dopoptowhen|||
+doref||5.009003|
+dounwind|||
+dowantarray|||
+dump_all_perl|||
+dump_all||5.006000|
+dump_eval||5.006000|
+dump_exec_pos|||
+dump_fds|||
+dump_form||5.006000|
+dump_indent||5.006000|v
+dump_mstats|||
+dump_packsubs_perl|||
+dump_packsubs||5.006000|
+dump_sub_perl|||
+dump_sub||5.006000|
+dump_sv_child|||
+dump_trie_interim_list|||
+dump_trie_interim_table|||
+dump_trie|||
+dump_vindent||5.006000|
+dumpuntil|||
+dup_attrlist|||
+emulate_cop_io|||
+eval_pv|5.006000||p
+eval_sv|5.006000||p
+exec_failed|||
+expect_number|||
+fbm_compile||5.005000|
+fbm_instr||5.005000|
+feature_is_enabled|||
+filter_add|||
+filter_del|||
+filter_gets|||
+filter_read|||
+finalize_optree|||
+finalize_op|||
+find_and_forget_pmops|||
+find_array_subscript|||
+find_beginning|||
+find_byclass|||
+find_hash_subscript|||
+find_in_my_stash|||
+find_lexical_cv|||
+find_runcv_where|||
+find_runcv||5.008001|
+find_rundefsv2|||
+find_rundefsvoffset||5.009002|
+find_rundefsv||5.013002|
+find_script|||
+find_uninit_var|||
+first_symbol|||n
+foldEQ_latin1||5.013008|n
+foldEQ_locale||5.013002|n
+foldEQ_utf8_flags||5.013010|
+foldEQ_utf8||5.013002|
+foldEQ||5.013002|n
+fold_constants|||
+forbid_setid|||
+force_ident_maybe_lex|||
+force_ident|||
+force_list|||
+force_next|||
+force_strict_version|||
+force_version|||
+force_word|||
+forget_pmop|||
+form_nocontext|||vn
+form_short_octal_warning|||
+form||5.004000|v
+fp_dup|||
+fprintf_nocontext|||vn
+free_global_struct|||
+free_tied_hv_pool|||
+free_tmps|||
+gen_constant_list|||
+get_and_check_backslash_N_name|||
+get_aux_mg|||
+get_av|5.006000||p
+get_context||5.006000|n
+get_cvn_flags|5.009005||p
+get_cvs|5.011000||p
+get_cv|5.006000||p
+get_db_sub|||
+get_debug_opts|||
+get_hash_seed|||
+get_hv|5.006000||p
+get_invlist_iter_addr|||
+get_invlist_offset_addr|||
+get_invlist_previous_index_addr|||
+get_mstats|||
+get_no_modify|||
+get_num|||
+get_op_descs||5.005000|
+get_op_names||5.005000|
+get_opargs|||
+get_ppaddr||5.006000|
+get_re_arg|||
+get_sv|5.006000||p
+get_vtbl||5.005030|
+getcwd_sv||5.007002|
+getenv_len|||
+glob_2number|||
+glob_assign_glob|||
+glob_assign_ref|||
+gp_dup|||
+gp_free|||
+gp_ref|||
+grok_bin|5.007003||p
+grok_bslash_N|||
+grok_bslash_c|||
+grok_bslash_o|||
+grok_bslash_x|||
+grok_hex|5.007003||p
+grok_number|5.007002||p
+grok_numeric_radix|5.007002||p
+grok_oct|5.007003||p
+group_end|||
+gv_AVadd|||
+gv_HVadd|||
+gv_IOadd|||
+gv_SVadd|||
+gv_add_by_type||5.011000|
+gv_autoload4||5.004000|
+gv_autoload_pvn||5.015004|
+gv_autoload_pv||5.015004|
+gv_autoload_sv||5.015004|
+gv_check|||
+gv_const_sv||5.009003|
+gv_dump||5.006000|
+gv_efullname3||5.004000|
+gv_efullname4||5.006001|
+gv_efullname|||
+gv_ename|||
+gv_fetchfile_flags||5.009005|
+gv_fetchfile|||
+gv_fetchmeth_autoload||5.007003|
+gv_fetchmeth_pv_autoload||5.015004|
+gv_fetchmeth_pvn_autoload||5.015004|
+gv_fetchmeth_pvn||5.015004|
+gv_fetchmeth_pv||5.015004|
+gv_fetchmeth_sv_autoload||5.015004|
+gv_fetchmeth_sv||5.015004|
+gv_fetchmethod_autoload||5.004000|
+gv_fetchmethod_pv_flags||5.015004|
+gv_fetchmethod_pvn_flags||5.015004|
+gv_fetchmethod_sv_flags||5.015004|
+gv_fetchmethod|||
+gv_fetchmeth|||
+gv_fetchpvn_flags|5.009002||p
+gv_fetchpvs|5.009004||p
+gv_fetchpv|||
+gv_fetchsv|5.009002||p
+gv_fullname3||5.004000|
+gv_fullname4||5.006001|
+gv_fullname|||
+gv_handler||5.007001|
+gv_init_pvn||5.015004|
+gv_init_pv||5.015004|
+gv_init_svtype|||
+gv_init_sv||5.015004|
+gv_init|||
+gv_magicalize_isa|||
+gv_name_set||5.009004|
+gv_stashpvn|5.004000||p
+gv_stashpvs|5.009003||p
+gv_stashpv|||
+gv_stashsv|||
+gv_try_downgrade|||
+handle_regex_sets|||
+he_dup|||
+hek_dup|||
+hfree_next_entry|||
+hfreeentries|||
+hsplit|||
+hv_assert|||
+hv_auxinit|||
+hv_backreferences_p|||
+hv_clear_placeholders||5.009001|
+hv_clear|||
+hv_common_key_len||5.010000|
+hv_common||5.010000|
+hv_copy_hints_hv||5.009004|
+hv_delayfree_ent||5.004000|
+hv_delete_common|||
+hv_delete_ent||5.004000|
+hv_delete|||
+hv_eiter_p||5.009003|
+hv_eiter_set||5.009003|
+hv_ename_add|||
+hv_ename_delete|||
+hv_exists_ent||5.004000|
+hv_exists|||
+hv_fetch_ent||5.004000|
+hv_fetchs|5.009003||p
+hv_fetch|||
+hv_fill||5.013002|
+hv_free_ent_ret|||
+hv_free_ent||5.004000|
+hv_iterinit|||
+hv_iterkeysv||5.004000|
+hv_iterkey|||
+hv_iternext_flags||5.008000|
+hv_iternextsv|||
+hv_iternext|||
+hv_iterval|||
+hv_kill_backrefs|||
+hv_ksplit||5.004000|
+hv_magic_check|||n
+hv_magic|||
+hv_name_set||5.009003|
+hv_notallowed|||
+hv_placeholders_get||5.009003|
+hv_placeholders_p|||
+hv_placeholders_set||5.009003|
+hv_rand_set||5.017011|
+hv_riter_p||5.009003|
+hv_riter_set||5.009003|
+hv_scalar||5.009001|
+hv_store_ent||5.004000|
+hv_store_flags||5.008000|
+hv_stores|5.009004||p
+hv_store|||
+hv_undef_flags|||
+hv_undef|||
+ibcmp_locale||5.004000|
+ibcmp_utf8||5.007003|
+ibcmp|||
+incline|||
+incpush_if_exists|||
+incpush_use_sep|||
+incpush|||
+ingroup|||
+init_argv_symbols|||
+init_constants|||
+init_dbargs|||
+init_debugger|||
+init_global_struct|||
+init_i18nl10n||5.006000|
+init_i18nl14n||5.006000|
+init_ids|||
+init_interp|||
+init_main_stash|||
+init_perllib|||
+init_postdump_symbols|||
+init_predump_symbols|||
+init_stacks||5.005000|
+init_tm||5.007002|
+inplace_aassign|||
+instr|||n
+intro_my|||
+intuit_method|||
+intuit_more|||
+invert|||
+invlist_array|||
+invlist_clone|||
+invlist_extend|||
+invlist_highest|||
+invlist_is_iterating|||
+invlist_iterfinish|||
+invlist_iterinit|||
+invlist_iternext|||
+invlist_max|||
+invlist_previous_index|||
+invlist_set_len|||
+invlist_set_previous_index|||
+invlist_trim|||
+invoke_exception_hook|||
+io_close|||
+isALNUMC|5.006000||p
+isALNUM_lazy|||
+isALPHANUMERIC||5.017008|
+isALPHA|||
+isASCII|5.006000|5.006000|p
+isBLANK|5.006001||p
+isCNTRL|5.006000|5.006000|p
+isDIGIT|||
+isFOO_lc|||
+isFOO_utf8_lc|||
+isGRAPH|5.006000||p
+isGV_with_GP|5.009004||p
+isIDCONT||5.017008|
+isIDFIRST_lazy|||
+isIDFIRST|||
+isLOWER|||
+isOCTAL||5.013005|
+isPRINT|5.004000||p
+isPSXSPC|5.006001||p
+isPUNCT|5.006000||p
+isSPACE|||
+isUPPER|||
+isWORDCHAR||5.013006|
+isXDIGIT|5.006000||p
+is_an_int|||
+is_ascii_string||5.011000|n
+is_cur_LC_category_utf8|||
+is_handle_constructor|||n
+is_list_assignment|||
+is_lvalue_sub||5.007001|
+is_uni_alnum_lc||5.006000|
+is_uni_alnumc_lc||5.017007|
+is_uni_alnumc||5.017007|
+is_uni_alnum||5.006000|
+is_uni_alpha_lc||5.006000|
+is_uni_alpha||5.006000|
+is_uni_ascii_lc||5.006000|
+is_uni_ascii||5.006000|
+is_uni_blank_lc||5.017002|
+is_uni_blank||5.017002|
+is_uni_cntrl_lc||5.006000|
+is_uni_cntrl||5.006000|
+is_uni_digit_lc||5.006000|
+is_uni_digit||5.006000|
+is_uni_graph_lc||5.006000|
+is_uni_graph||5.006000|
+is_uni_idfirst_lc||5.006000|
+is_uni_idfirst||5.006000|
+is_uni_lower_lc||5.006000|
+is_uni_lower||5.006000|
+is_uni_print_lc||5.006000|
+is_uni_print||5.006000|
+is_uni_punct_lc||5.006000|
+is_uni_punct||5.006000|
+is_uni_space_lc||5.006000|
+is_uni_space||5.006000|
+is_uni_upper_lc||5.006000|
+is_uni_upper||5.006000|
+is_uni_xdigit_lc||5.006000|
+is_uni_xdigit||5.006000|
+is_utf8_alnumc||5.017007|
+is_utf8_alnum||5.006000|
+is_utf8_alpha||5.006000|
+is_utf8_ascii||5.006000|
+is_utf8_blank||5.017002|
+is_utf8_char_buf||5.015008|n
+is_utf8_char_slow|||n
+is_utf8_char||5.006000|n
+is_utf8_cntrl||5.006000|
+is_utf8_common|||
+is_utf8_digit||5.006000|
+is_utf8_graph||5.006000|
+is_utf8_idcont||5.008000|
+is_utf8_idfirst||5.006000|
+is_utf8_lower||5.006000|
+is_utf8_mark||5.006000|
+is_utf8_perl_space||5.011001|
+is_utf8_perl_word||5.011001|
+is_utf8_posix_digit||5.011001|
+is_utf8_print||5.006000|
+is_utf8_punct||5.006000|
+is_utf8_space||5.006000|
+is_utf8_string_loclen||5.009003|n
+is_utf8_string_loc||5.008001|n
+is_utf8_string||5.006001|n
+is_utf8_upper||5.006000|
+is_utf8_xdigit||5.006000|
+is_utf8_xidcont||5.013010|
+is_utf8_xidfirst||5.013010|
+isa_lookup|||
+items|||n
+ix|||n
+jmaybe|||
+join_exact|||
+keyword_plugin_standard|||
+keyword|||
+leave_scope|||
+lex_bufutf8||5.011002|
+lex_discard_to||5.011002|
+lex_grow_linestr||5.011002|
+lex_next_chunk||5.011002|
+lex_peek_unichar||5.011002|
+lex_read_space||5.011002|
+lex_read_to||5.011002|
+lex_read_unichar||5.011002|
+lex_start||5.009005|
+lex_stuff_pvn||5.011002|
+lex_stuff_pvs||5.013005|
+lex_stuff_pv||5.013006|
+lex_stuff_sv||5.011002|
+lex_unstuff||5.011002|
+listkids|||
+list|||
+load_module_nocontext|||vn
+load_module|5.006000||pv
+localize|||
+looks_like_bool|||
+looks_like_number|||
+lop|||
+mPUSHi|5.009002||p
+mPUSHn|5.009002||p
+mPUSHp|5.009002||p
+mPUSHs|5.010001||p
+mPUSHu|5.009002||p
+mXPUSHi|5.009002||p
+mXPUSHn|5.009002||p
+mXPUSHp|5.009002||p
+mXPUSHs|5.010001||p
+mXPUSHu|5.009002||p
+mad_free|||
+madlex|||
+madparse|||
+magic_clear_all_env|||
+magic_cleararylen_p|||
+magic_clearenv|||
+magic_clearhints|||
+magic_clearhint|||
+magic_clearisa|||
+magic_clearpack|||
+magic_clearsig|||
+magic_copycallchecker|||
+magic_dump||5.006000|
+magic_existspack|||
+magic_freearylen_p|||
+magic_freeovrld|||
+magic_getarylen|||
+magic_getdefelem|||
+magic_getnkeys|||
+magic_getpack|||
+magic_getpos|||
+magic_getsig|||
+magic_getsubstr|||
+magic_gettaint|||
+magic_getuvar|||
+magic_getvec|||
+magic_get|||
+magic_killbackrefs|||
+magic_methcall1|||
+magic_methcall|||v
+magic_methpack|||
+magic_nextpack|||
+magic_regdata_cnt|||
+magic_regdatum_get|||
+magic_regdatum_set|||
+magic_scalarpack|||
+magic_set_all_env|||
+magic_setarylen|||
+magic_setcollxfrm|||
+magic_setdbline|||
+magic_setdefelem|||
+magic_setenv|||
+magic_sethint|||
+magic_setisa|||
+magic_setmglob|||
+magic_setnkeys|||
+magic_setpack|||
+magic_setpos|||
+magic_setregexp|||
+magic_setsig|||
+magic_setsubstr|||
+magic_settaint|||
+magic_setutf8|||
+magic_setuvar|||
+magic_setvec|||
+magic_set|||
+magic_sizepack|||
+magic_wipepack|||
+make_matcher|||
+make_trie_failtable|||
+make_trie|||
+malloc_good_size|||n
+malloced_size|||n
+malloc||5.007002|n
+markstack_grow|||
+matcher_matches_sv|||
+mayberelocate|||
+measure_struct|||
+memEQs|5.009005||p
+memEQ|5.004000||p
+memNEs|5.009005||p
+memNE|5.004000||p
+mem_collxfrm|||
+mem_log_common|||n
+mess_alloc|||
+mess_nocontext|||vn
+mess_sv||5.013001|
+mess||5.006000|v
+method_common|||
+mfree||5.007002|n
+mg_clear|||
+mg_copy|||
+mg_dup|||
+mg_find_mglob|||
+mg_findext||5.013008|
+mg_find|||
+mg_free_type||5.013006|
+mg_free|||
+mg_get|||
+mg_length||5.005000|
+mg_localize|||
+mg_magical|||
+mg_set|||
+mg_size||5.005000|
+mini_mktime||5.007002|
+minus_v|||
+missingterm|||
+mode_from_discipline|||
+modkids|||
+more_bodies|||
+more_sv|||
+moreswitches|||
+mro_clean_isarev|||
+mro_gather_and_rename|||
+mro_get_from_name||5.010001|
+mro_get_linear_isa_dfs|||
+mro_get_linear_isa||5.009005|
+mro_get_private_data||5.010001|
+mro_isa_changed_in|||
+mro_meta_dup|||
+mro_meta_init|||
+mro_method_changed_in||5.009005|
+mro_package_moved|||
+mro_register||5.010001|
+mro_set_mro||5.010001|
+mro_set_private_data||5.010001|
+mul128|||
+mulexp10|||n
+my_atof2||5.007002|
+my_atof||5.006000|
+my_attrs|||
+my_bcopy|||n
+my_bzero|||n
+my_chsize|||
+my_clearenv|||
+my_cxt_index|||
+my_cxt_init|||
+my_dirfd||5.009005|
+my_exit_jump|||
+my_exit|||
+my_failure_exit||5.004000|
+my_fflush_all||5.006000|
+my_fork||5.007003|n
+my_kid|||
+my_lstat_flags|||
+my_lstat||5.019003|
+my_memcmp|||n
+my_memset||5.004000|n
+my_pclose||5.004000|
+my_popen_list||5.007001|
+my_popen||5.004000|
+my_setenv|||
+my_snprintf|5.009004||pvn
+my_socketpair||5.007003|n
+my_sprintf|5.009003||pvn
+my_stat_flags|||
+my_stat||5.019003|
+my_strftime||5.007002|
+my_strlcat|5.009004||pn
+my_strlcpy|5.009004||pn
+my_unexec|||
+my_vsnprintf||5.009004|n
+need_utf8|||n
+newANONATTRSUB||5.006000|
+newANONHASH|||
+newANONLIST|||
+newANONSUB|||
+newASSIGNOP|||
+newATTRSUB_flags|||
+newATTRSUB||5.006000|
+newAVREF|||
+newAV|||
+newBINOP|||
+newCONDOP|||
+newCONSTSUB_flags||5.015006|
+newCONSTSUB|5.004050||p
+newCVREF|||
+newDEFSVOP|||
+newFORM|||
+newFOROP||5.013007|
+newGIVENOP||5.009003|
+newGIVWHENOP|||
+newGP|||
+newGVOP|||
+newGVREF|||
+newGVgen_flags||5.015004|
+newGVgen|||
+newHVREF|||
+newHVhv||5.005000|
+newHV|||
+newIO|||
+newLISTOP|||
+newLOGOP|||
+newLOOPEX|||
+newLOOPOP|||
+newMADPROP|||
+newMADsv|||
+newMYSUB||5.017004|
+newNULLLIST|||
+newOP|||
+newPADOP|||
+newPMOP|||
+newPROG|||
+newPVOP|||
+newRANGE|||
+newRV_inc|5.004000||p
+newRV_noinc|5.004000||p
+newRV|||
+newSLICEOP|||
+newSTATEOP|||
+newSTUB|||
+newSUB|||
+newSVOP|||
+newSVREF|||
+newSV_type|5.009005||p
+newSVhek||5.009003|
+newSViv|||
+newSVnv|||
+newSVpadname||5.017004|
+newSVpv_share||5.013006|
+newSVpvf_nocontext|||vn
+newSVpvf||5.004000|v
+newSVpvn_flags|5.010001||p
+newSVpvn_share|5.007001||p
+newSVpvn_utf8|5.010001||p
+newSVpvn|5.004050||p
+newSVpvs_flags|5.010001||p
+newSVpvs_share|5.009003||p
+newSVpvs|5.009003||p
+newSVpv|||
+newSVrv|||
+newSVsv|||
+newSVuv|5.006000||p
+newSV|||
+newTOKEN|||
+newUNOP|||
+newWHENOP||5.009003|
+newWHILEOP||5.013007|
+newXS_flags||5.009004|
+newXS_len_flags|||
+newXSproto||5.006000|
+newXS||5.006000|
+new_collate||5.006000|
+new_constant|||
+new_ctype||5.006000|
+new_he|||
+new_logop|||
+new_numeric||5.006000|
+new_stackinfo||5.005000|
+new_version||5.009000|
+new_warnings_bitfield|||
+next_symbol|||
+nextargv|||
+nextchar|||
+ninstr|||n
+no_bareword_allowed|||
+no_fh_allowed|||
+no_op|||
+not_a_number|||
+not_incrementable|||
+nothreadhook||5.008000|
+nuke_stacks|||
+num_overflow|||n
+oopsAV|||
+oopsHV|||
+op_append_elem||5.013006|
+op_append_list||5.013006|
+op_clear|||
+op_const_sv|||
+op_contextualize||5.013006|
+op_dump||5.006000|
+op_free|||
+op_getmad_weak|||
+op_getmad|||
+op_integerize|||
+op_linklist||5.013006|
+op_lvalue_flags|||
+op_lvalue||5.013007|
+op_null||5.007002|
+op_prepend_elem||5.013006|
+op_refcnt_dec|||
+op_refcnt_inc|||
+op_refcnt_lock||5.009002|
+op_refcnt_unlock||5.009002|
+op_scope||5.013007|
+op_std_init|||
+op_unscope|||
+op_xmldump|||
+open_script|||
+opslab_force_free|||
+opslab_free_nopad|||
+opslab_free|||
+pMY_CXT_|5.007003||p
+pMY_CXT|5.007003||p
+pTHX_|5.006000||p
+pTHX|5.006000||p
+packWARN|5.007003||p
+pack_cat||5.007003|
+pack_rec|||
+package_version|||
+package|||
+packlist||5.008001|
+pad_add_anon||5.008001|
+pad_add_name_pvn||5.015001|
+pad_add_name_pvs||5.015001|
+pad_add_name_pv||5.015001|
+pad_add_name_sv||5.015001|
+pad_alloc_name|||
+pad_alloc|||
+pad_block_start|||
+pad_check_dup|||
+pad_compname_type||5.009003|
+pad_findlex|||
+pad_findmy_pvn||5.015001|
+pad_findmy_pvs||5.015001|
+pad_findmy_pv||5.015001|
+pad_findmy_sv||5.015001|
+pad_fixup_inner_anons|||
+pad_free|||
+pad_leavemy|||
+pad_new||5.008001|
+pad_peg|||n
+pad_push|||
+pad_reset|||
+pad_setsv|||
+pad_sv|||
+pad_swipe|||
+pad_tidy||5.008001|
+padlist_dup|||
+padlist_store|||
+parse_arithexpr||5.013008|
+parse_barestmt||5.013007|
+parse_block||5.013007|
+parse_body|||
+parse_fullexpr||5.013008|
+parse_fullstmt||5.013005|
+parse_ident|||
+parse_label||5.013007|
+parse_listexpr||5.013008|
+parse_lparen_question_flags|||
+parse_stmtseq||5.013006|
+parse_termexpr||5.013008|
+parse_unicode_opts|||
+parser_dup|||
+parser_free_nexttoke_ops|||
+parser_free|||
+path_is_searchable|||n
+peep|||
+pending_ident|||
+perl_alloc_using|||n
+perl_alloc|||n
+perl_clone_using|||n
+perl_clone|||n
+perl_construct|||n
+perl_destruct||5.007003|n
+perl_free|||n
+perl_parse||5.006000|n
+perl_run|||n
+pidgone|||
+pm_description|||
+pmop_dump||5.006000|
+pmop_xmldump|||
+pmruntime|||
+pmtrans|||
+pop_scope|||
+populate_isa|||v
+pregcomp||5.009005|
+pregexec|||
+pregfree2||5.011000|
+pregfree|||
+prepend_madprops|||
+prescan_version||5.011004|
+printbuf|||
+printf_nocontext|||vn
+process_special_blocks|||
+ptr_hash|||n
+ptr_table_clear||5.009005|
+ptr_table_fetch||5.009005|
+ptr_table_find|||n
+ptr_table_free||5.009005|
+ptr_table_new||5.009005|
+ptr_table_split||5.009005|
+ptr_table_store||5.009005|
+push_scope|||
+put_byte|||
+put_latin1_charclass_innards|||
+pv_display|5.006000||p
+pv_escape|5.009004||p
+pv_pretty|5.009004||p
+pv_uni_display||5.007003|
+qerror|||
+qsortsvu|||
+re_compile||5.009005|
+re_croak2|||
+re_dup_guts|||
+re_intuit_start||5.019001|
+re_intuit_string||5.006000|
+re_op_compile|||
+readpipe_override|||
+realloc||5.007002|n
+reentrant_free||5.019003|
+reentrant_init||5.019003|
+reentrant_retry||5.019003|vn
+reentrant_size||5.019003|
+ref_array_or_hash|||
+refcounted_he_chain_2hv|||
+refcounted_he_fetch_pvn|||
+refcounted_he_fetch_pvs|||
+refcounted_he_fetch_pv|||
+refcounted_he_fetch_sv|||
+refcounted_he_free|||
+refcounted_he_inc|||
+refcounted_he_new_pvn|||
+refcounted_he_new_pvs|||
+refcounted_he_new_pv|||
+refcounted_he_new_sv|||
+refcounted_he_value|||
+refkids|||
+refto|||
+ref||5.019003|
+reg_check_named_buff_matched|||
+reg_named_buff_all||5.009005|
+reg_named_buff_exists||5.009005|
+reg_named_buff_fetch||5.009005|
+reg_named_buff_firstkey||5.009005|
+reg_named_buff_iter|||
+reg_named_buff_nextkey||5.009005|
+reg_named_buff_scalar||5.009005|
+reg_named_buff|||
+reg_node|||
+reg_numbered_buff_fetch|||
+reg_numbered_buff_length|||
+reg_numbered_buff_store|||
+reg_qr_package|||
+reg_recode|||
+reg_scan_name|||
+reg_skipcomment|||
+reg_temp_copy|||
+reganode|||
+regatom|||
+regbranch|||
+regclass_swash||5.009004|
+regclass|||
+regcppop|||
+regcppush|||
+regcurly|||
+regdump_extflags|||
+regdump_intflags|||
+regdump||5.005000|
+regdupe_internal|||
+regexec_flags||5.005000|
+regfree_internal||5.009005|
+reghop3|||n
+reghop4|||n
+reghopmaybe3|||n
+reginclass|||
+reginitcolors||5.006000|
+reginsert|||
+regmatch|||
+regnext||5.005000|
+regpatws|||n
+regpiece|||
+regpposixcc|||
+regprop|||
+regrepeat|||
+regtail_study|||
+regtail|||
+regtry|||
+reguni|||
+regwhite|||n
+reg|||
+repeatcpy|||n
+report_evil_fh|||
+report_redefined_cv|||
+report_uninit|||
+report_wrongway_fh|||
+require_pv||5.006000|
+require_tie_mod|||
+restore_magic|||
+rninstr|||n
+rpeep|||
+rsignal_restore|||
+rsignal_save|||
+rsignal_state||5.004000|
+rsignal||5.004000|
+run_body|||
+run_user_filter|||
+runops_debug||5.005000|
+runops_standard||5.005000|
+rv2cv_op_cv||5.013006|
+rvpv_dup|||
+rxres_free|||
+rxres_restore|||
+rxres_save|||
+safesyscalloc||5.006000|n
+safesysfree||5.006000|n
+safesysmalloc||5.006000|n
+safesysrealloc||5.006000|n
+same_dirent|||
+save_I16||5.004000|
+save_I32|||
+save_I8||5.006000|
+save_adelete||5.011000|
+save_aelem_flags||5.011000|
+save_aelem||5.004050|
+save_alloc||5.006000|
+save_aptr|||
+save_ary|||
+save_bool||5.008001|
+save_clearsv|||
+save_delete|||
+save_destructor_x||5.006000|
+save_destructor||5.006000|
+save_freeop|||
+save_freepv|||
+save_freesv|||
+save_generic_pvref||5.006001|
+save_generic_svref||5.005030|
+save_gp||5.004000|
+save_hash|||
+save_hdelete||5.011000|
+save_hek_flags|||n
+save_helem_flags||5.011000|
+save_helem||5.004050|
+save_hints||5.010001|
+save_hptr|||
+save_int|||
+save_item|||
+save_iv||5.005000|
+save_lines|||
+save_list|||
+save_long|||
+save_magic_flags|||
+save_mortalizesv||5.007001|
+save_nogv|||
+save_op||5.005000|
+save_padsv_and_mortalize||5.010001|
+save_pptr|||
+save_pushi32ptr||5.010001|
+save_pushptri32ptr|||
+save_pushptrptr||5.010001|
+save_pushptr||5.010001|
+save_re_context||5.006000|
+save_scalar_at|||
+save_scalar|||
+save_set_svflags||5.009000|
+save_shared_pvref||5.007003|
+save_sptr|||
+save_svref|||
+save_vptr||5.006000|
+savepvn|||
+savepvs||5.009003|
+savepv|||
+savesharedpvn||5.009005|
+savesharedpvs||5.013006|
+savesharedpv||5.007003|
+savesharedsvpv||5.013006|
+savestack_grow_cnt||5.008001|
+savestack_grow|||
+savesvpv||5.009002|
+sawparens|||
+scalar_mod_type|||n
+scalarboolean|||
+scalarkids|||
+scalarseq|||
+scalarvoid|||
+scalar|||
+scan_bin||5.006000|
+scan_commit|||
+scan_const|||
+scan_formline|||
+scan_heredoc|||
+scan_hex|||
+scan_ident|||
+scan_inputsymbol|||
+scan_num||5.007001|
+scan_oct|||
+scan_pat|||
+scan_str|||
+scan_subst|||
+scan_trans|||
+scan_version||5.009001|
+scan_vstring||5.009005|
+scan_word|||
+screaminstr||5.005000|
+search_const|||
+seed||5.008001|
+sequence_num|||
+set_context||5.006000|n
+set_numeric_local||5.006000|
+set_numeric_radix||5.006000|
+set_numeric_standard||5.006000|
+setdefout|||
+share_hek_flags|||
+share_hek||5.004000|
+si_dup|||
+sighandler|||n
+simplify_sort|||
+skipspace0|||
+skipspace1|||
+skipspace2|||
+skipspace_flags|||
+softref2xv|||
+sortcv_stacked|||
+sortcv_xsub|||
+sortcv|||
+sortsv_flags||5.009003|
+sortsv||5.007003|
+space_join_names_mortal|||
+ss_dup|||
+stack_grow|||
+start_force|||
+start_glob|||
+start_subparse||5.004000|
+stdize_locale|||
+strEQ|||
+strGE|||
+strGT|||
+strLE|||
+strLT|||
+strNE|||
+str_to_version||5.006000|
+strip_return|||
+strnEQ|||
+strnNE|||
+study_chunk|||
+sub_crush_depth|||
+sublex_done|||
+sublex_push|||
+sublex_start|||
+sv_2bool_flags||5.013006|
+sv_2bool|||
+sv_2cv|||
+sv_2io|||
+sv_2iuv_common|||
+sv_2iuv_non_preserve|||
+sv_2iv_flags||5.009001|
+sv_2iv|||
+sv_2mortal|||
+sv_2num|||
+sv_2nv_flags||5.013001|
+sv_2pv_flags|5.007002||p
+sv_2pv_nolen|5.006000||p
+sv_2pvbyte_nolen|5.006000||p
+sv_2pvbyte|5.006000||p
+sv_2pvutf8_nolen||5.006000|
+sv_2pvutf8||5.006000|
+sv_2pv|||
+sv_2uv_flags||5.009001|
+sv_2uv|5.004000||p
+sv_add_arena|||
+sv_add_backref|||
+sv_backoff|||
+sv_bless|||
+sv_cat_decode||5.008001|
+sv_catpv_flags||5.013006|
+sv_catpv_mg|5.004050||p
+sv_catpv_nomg||5.013006|
+sv_catpvf_mg_nocontext|||pvn
+sv_catpvf_mg|5.006000|5.004000|pv
+sv_catpvf_nocontext|||vn
+sv_catpvf||5.004000|v
+sv_catpvn_flags||5.007002|
+sv_catpvn_mg|5.004050||p
+sv_catpvn_nomg|5.007002||p
+sv_catpvn|||
+sv_catpvs_flags||5.013006|
+sv_catpvs_mg||5.013006|
+sv_catpvs_nomg||5.013006|
+sv_catpvs|5.009003||p
+sv_catpv|||
+sv_catsv_flags||5.007002|
+sv_catsv_mg|5.004050||p
+sv_catsv_nomg|5.007002||p
+sv_catsv|||
+sv_catxmlpvn|||
+sv_catxmlpv|||
+sv_catxmlsv|||
+sv_chop|||
+sv_clean_all|||
+sv_clean_objs|||
+sv_clear|||
+sv_cmp_flags||5.013006|
+sv_cmp_locale_flags||5.013006|
+sv_cmp_locale||5.004000|
+sv_cmp|||
+sv_collxfrm_flags||5.013006|
+sv_collxfrm|||
+sv_copypv_flags||5.017002|
+sv_copypv_nomg||5.017002|
+sv_copypv|||
+sv_dec_nomg||5.013002|
+sv_dec|||
+sv_del_backref|||
+sv_derived_from_pvn||5.015004|
+sv_derived_from_pv||5.015004|
+sv_derived_from_sv||5.015004|
+sv_derived_from||5.004000|
+sv_destroyable||5.010000|
+sv_display|||
+sv_does_pvn||5.015004|
+sv_does_pv||5.015004|
+sv_does_sv||5.015004|
+sv_does||5.009004|
+sv_dump|||
+sv_dup_common|||
+sv_dup_inc_multiple|||
+sv_dup_inc|||
+sv_dup|||
+sv_eq_flags||5.013006|
+sv_eq|||
+sv_exp_grow|||
+sv_force_normal_flags||5.007001|
+sv_force_normal||5.006000|
+sv_free2|||
+sv_free_arenas|||
+sv_free|||
+sv_gets||5.004000|
+sv_grow|||
+sv_i_ncmp|||
+sv_inc_nomg||5.013002|
+sv_inc|||
+sv_insert_flags||5.010001|
+sv_insert|||
+sv_isa|||
+sv_isobject|||
+sv_iv||5.005000|
+sv_kill_backrefs|||
+sv_len_utf8_nomg|||
+sv_len_utf8||5.006000|
+sv_len|||
+sv_magic_portable|5.019003|5.004000|p
+sv_magicext_mglob|||
+sv_magicext||5.007003|
+sv_magic|||
+sv_mortalcopy_flags|||
+sv_mortalcopy|||
+sv_ncmp|||
+sv_newmortal|||
+sv_newref|||
+sv_nolocking||5.007003|
+sv_nosharing||5.007003|
+sv_nounlocking|||
+sv_nv||5.005000|
+sv_peek||5.005000|
+sv_pos_b2u_flags||5.019003|
+sv_pos_b2u_midway|||
+sv_pos_b2u||5.006000|
+sv_pos_u2b_cached|||
+sv_pos_u2b_flags||5.011005|
+sv_pos_u2b_forwards|||n
+sv_pos_u2b_midway|||n
+sv_pos_u2b||5.006000|
+sv_pvbyten_force||5.006000|
+sv_pvbyten||5.006000|
+sv_pvbyte||5.006000|
+sv_pvn_force_flags|5.007002||p
+sv_pvn_force|||
+sv_pvn_nomg|5.007003|5.005000|p
+sv_pvn||5.005000|
+sv_pvutf8n_force||5.006000|
+sv_pvutf8n||5.006000|
+sv_pvutf8||5.006000|
+sv_pv||5.006000|
+sv_recode_to_utf8||5.007003|
+sv_reftype|||
+sv_ref|||
+sv_release_COW|||
+sv_replace|||
+sv_report_used|||
+sv_resetpvn|||
+sv_reset|||
+sv_rvweaken||5.006000|
+sv_sethek|||
+sv_setiv_mg|5.004050||p
+sv_setiv|||
+sv_setnv_mg|5.006000||p
+sv_setnv|||
+sv_setpv_mg|5.004050||p
+sv_setpvf_mg_nocontext|||pvn
+sv_setpvf_mg|5.006000|5.004000|pv
+sv_setpvf_nocontext|||vn
+sv_setpvf||5.004000|v
+sv_setpviv_mg||5.008001|
+sv_setpviv||5.008001|
+sv_setpvn_mg|5.004050||p
+sv_setpvn|||
+sv_setpvs_mg||5.013006|
+sv_setpvs|5.009004||p
+sv_setpv|||
+sv_setref_iv|||
+sv_setref_nv|||
+sv_setref_pvn|||
+sv_setref_pvs||5.019003|
+sv_setref_pv|||
+sv_setref_uv||5.007001|
+sv_setsv_cow|||
+sv_setsv_flags||5.007002|
+sv_setsv_mg|5.004050||p
+sv_setsv_nomg|5.007002||p
+sv_setsv|||
+sv_setuv_mg|5.004050||p
+sv_setuv|5.004000||p
+sv_tainted||5.004000|
+sv_taint||5.004000|
+sv_true||5.005000|
+sv_unglob|||
+sv_uni_display||5.007003|
+sv_unmagicext||5.013008|
+sv_unmagic|||
+sv_unref_flags||5.007001|
+sv_unref|||
+sv_untaint||5.004000|
+sv_upgrade|||
+sv_usepvn_flags||5.009004|
+sv_usepvn_mg|5.004050||p
+sv_usepvn|||
+sv_utf8_decode||5.006000|
+sv_utf8_downgrade||5.006000|
+sv_utf8_encode||5.006000|
+sv_utf8_upgrade_flags_grow||5.011000|
+sv_utf8_upgrade_flags||5.007002|
+sv_utf8_upgrade_nomg||5.007002|
+sv_utf8_upgrade||5.007001|
+sv_uv|5.005000||p
+sv_vcatpvf_mg|5.006000|5.004000|p
+sv_vcatpvfn_flags||5.017002|
+sv_vcatpvfn||5.004000|
+sv_vcatpvf|5.006000|5.004000|p
+sv_vsetpvf_mg|5.006000|5.004000|p
+sv_vsetpvfn||5.004000|
+sv_vsetpvf|5.006000|5.004000|p
+sv_xmlpeek|||
+svtype|||
+swallow_bom|||
+swash_fetch||5.007002|
+swash_init||5.006000|
+swatch_get|||
+sys_init3||5.010000|n
+sys_init||5.010000|n
+sys_intern_clear|||
+sys_intern_dup|||
+sys_intern_init|||
+sys_term||5.010000|n
+taint_env|||
+taint_proper|||
+tied_method|||v
+tmps_grow||5.006000|
+toFOLD_uni||5.007003|
+toFOLD_utf8||5.019001|
+toFOLD||5.019001|
+toLOWER_L1||5.019001|
+toLOWER_LC||5.004000|
+toLOWER_uni||5.007003|
+toLOWER_utf8||5.015007|
+toLOWER|||
+toTITLE_uni||5.007003|
+toTITLE_utf8||5.015007|
+toTITLE||5.019001|
+toUPPER_uni||5.007003|
+toUPPER_utf8||5.015007|
+toUPPER||5.004000|
+to_byte_substr|||
+to_lower_latin1|||
+to_uni_fold||5.007003|
+to_uni_lower_lc||5.006000|
+to_uni_lower||5.007003|
+to_uni_title_lc||5.006000|
+to_uni_title||5.007003|
+to_uni_upper_lc||5.006000|
+to_uni_upper||5.007003|
+to_utf8_case||5.007003|
+to_utf8_fold||5.015007|
+to_utf8_lower||5.015007|
+to_utf8_substr|||
+to_utf8_title||5.015007|
+to_utf8_upper||5.015007|
+token_free|||
+token_getmad|||
+tokenize_use|||
+tokeq|||
+tokereport|||
+too_few_arguments_pv|||
+too_few_arguments_sv|||
+too_many_arguments_pv|||
+too_many_arguments_sv|||
+translate_substr_offsets|||
+try_amagic_bin|||
+try_amagic_un|||
+uiv_2buf|||n
+unlnk|||
+unpack_rec|||
+unpack_str||5.007003|
+unpackstring||5.008001|
+unreferenced_to_tmp_stack|||
+unshare_hek_or_pvn|||
+unshare_hek|||
+unsharepvn||5.004000|
+unwind_handler_stack|||
+update_debugger_info|||
+upg_version||5.009005|
+usage|||
+utf16_textfilter|||
+utf16_to_utf8_reversed||5.006001|
+utf16_to_utf8||5.006001|
+utf8_distance||5.006000|
+utf8_hop||5.006000|
+utf8_length||5.007001|
+utf8_mg_len_cache_update|||
+utf8_mg_pos_cache_update|||
+utf8_to_bytes||5.006001|
+utf8_to_uvchr_buf||5.015009|
+utf8_to_uvchr||5.007001|
+utf8_to_uvuni_buf||5.015009|
+utf8_to_uvuni||5.007001|
+utf8n_to_uvchr|||
+utf8n_to_uvuni||5.007001|
+utilize|||
+uvchr_to_utf8_flags||5.007003|
+uvchr_to_utf8|||
+uvuni_to_utf8_flags||5.007003|
+uvuni_to_utf8||5.007001|
+valid_utf8_to_uvchr|||
+valid_utf8_to_uvuni||5.015009|
+validate_proto|||
+validate_suid|||
+varname|||
+vcmp||5.009000|
+vcroak||5.006000|
+vdeb||5.007003|
+vform||5.006000|
+visit|||
+vivify_defelem|||
+vivify_ref|||
+vload_module|5.006000||p
+vmess||5.006000|
+vnewSVpvf|5.006000|5.004000|p
+vnormal||5.009002|
+vnumify||5.009000|
+vstringify||5.009000|
+vverify||5.009003|
+vwarner||5.006000|
+vwarn||5.006000|
+wait4pid|||
+warn_nocontext|||vn
+warn_sv||5.013001|
+warner_nocontext|||vn
+warner|5.006000|5.004000|pv
+warn|||v
+was_lvalue_sub|||
+watch|||
+whichsig_pvn||5.015004|
+whichsig_pv||5.015004|
+whichsig_sv||5.015004|
+whichsig|||
+win32_croak_not_implemented|||n
+with_queued_errors|||
+wrap_op_checker||5.015008|
+write_to_stderr|||
+xmldump_all_perl|||
+xmldump_all|||
+xmldump_attr|||
+xmldump_eval|||
+xmldump_form|||
+xmldump_indent|||v
+xmldump_packsubs_perl|||
+xmldump_packsubs|||
+xmldump_sub_perl|||
+xmldump_sub|||
+xmldump_vindent|||
+xs_apiversion_bootcheck|||
+xs_version_bootcheck|||
+yyerror_pvn|||
+yyerror_pv|||
+yyerror|||
+yylex|||
+yyparse|||
+yyunlex|||
+yywarn|||
+);
+
+if (exists $opt{'list-unsupported'}) {
+ my $f;
+ for $f (sort { lc $a cmp lc $b } keys %API) {
+ next unless $API{$f}{todo};
+ print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
+ }
+ exit 0;
+}
+
+# Scan for possible replacement candidates
+
+my(%replace, %need, %hints, %warnings, %depends);
+my $replace = 0;
+my($hint, $define, $function);
+
+sub find_api
+{
+ my $code = shift;
+ $code =~ s{
+ / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
+ | "[^"\\]*(?:\\.[^"\\]*)*"
+ | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
+ grep { exists $API{$_} } $code =~ /(\w+)/mg;
+}
+
+while (<DATA>) {
+ if ($hint) {
+ my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
+ if (m{^\s*\*\s(.*?)\s*$}) {
+ for (@{$hint->[1]}) {
+ $h->{$_} ||= ''; # suppress warning with older perls
+ $h->{$_} .= "$1\n";
+ }
+ }
+ else { undef $hint }
+ }
+
+ $hint = [$1, [split /,?\s+/, $2]]
+ if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$};
+
+ if ($define) {
+ if ($define->[1] =~ /\\$/) {
+ $define->[1] .= $_;
+ }
+ else {
+ if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) {
+ my @n = find_api($define->[1]);
+ push @{$depends{$define->[0]}}, @n if @n
+ }
+ undef $define;
+ }
+ }
+
+ $define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)};
+
+ if ($function) {
+ if (/^}/) {
+ if (exists $API{$function->[0]}) {
+ my @n = find_api($function->[1]);
+ push @{$depends{$function->[0]}}, @n if @n
+ }
+ undef $function;
+ }
+ else {
+ $function->[1] .= $_;
+ }
+ }
+
+ $function = [$1, ''] if m{^DPPP_\(my_(\w+)\)};
+
+ $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
+ $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
+ $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
+ $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
+
+ if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
+ my @deps = map { s/\s+//g; $_ } split /,/, $3;
+ my $d;
+ for $d (map { s/\s+//g; $_ } split /,/, $1) {
+ push @{$depends{$d}}, @deps;
+ }
+ }
+
+ $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
+}
+
+for (values %depends) {
+ my %s;
+ $_ = [sort grep !$s{$_}++, @$_];
+}
+
+if (exists $opt{'api-info'}) {
+ my $f;
+ my $count = 0;
+ my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
+ for $f (sort { lc $a cmp lc $b } keys %API) {
+ next unless $f =~ /$match/;
+ print "\n=== $f ===\n\n";
+ my $info = 0;
+ if ($API{$f}{base} || $API{$f}{todo}) {
+ my $base = format_version($API{$f}{base} || $API{$f}{todo});
+ print "Supported at least starting from perl-$base.\n";
+ $info++;
+ }
+ if ($API{$f}{provided}) {
+ my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
+ print "Support by $ppport provided back to perl-$todo.\n";
+ print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
+ print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
+ print "\n$hints{$f}" if exists $hints{$f};
+ print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
+ $info++;
+ }
+ print "No portability information available.\n" unless $info;
+ $count++;
+ }
+ $count or print "Found no API matching '$opt{'api-info'}'.";
+ print "\n";
+ exit 0;
+}
+
+if (exists $opt{'list-provided'}) {
+ my $f;
+ for $f (sort { lc $a cmp lc $b } keys %API) {
+ next unless $API{$f}{provided};
+ my @flags;
+ push @flags, 'explicit' if exists $need{$f};
+ push @flags, 'depend' if exists $depends{$f};
+ push @flags, 'hint' if exists $hints{$f};
+ push @flags, 'warning' if exists $warnings{$f};
+ my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
+ print "$f$flags\n";
+ }
+ exit 0;
+}
+
+my @files;
+my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc );
+my $srcext = join '|', map { quotemeta $_ } @srcext;
+
+if (@ARGV) {
+ my %seen;
+ for (@ARGV) {
+ if (-e) {
+ if (-f) {
+ push @files, $_ unless $seen{$_}++;
+ }
+ else { warn "'$_' is not a file.\n" }
+ }
+ else {
+ my @new = grep { -f } glob $_
+ or warn "'$_' does not exist.\n";
+ push @files, grep { !$seen{$_}++ } @new;
+ }
+ }
+}
+else {
+ eval {
+ require File::Find;
+ File::Find::find(sub {
+ $File::Find::name =~ /($srcext)$/i
+ and push @files, $File::Find::name;
+ }, '.');
+ };
+ if ($@) {
+ @files = map { glob "*$_" } @srcext;
+ }
+}
+
+if (!@ARGV || $opt{filter}) {
+ my(@in, @out);
+ my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
+ for (@files) {
+ my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i;
+ push @{ $out ? \@out : \@in }, $_;
+ }
+ if (@ARGV && @out) {
+ warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
+ }
+ @files = @in;
+}
+
+die "No input files given!\n" unless @files;
+
+my(%files, %global, %revreplace);
+%revreplace = reverse %replace;
+my $filename;
+my $patch_opened = 0;
+
+for $filename (@files) {
+ unless (open IN, "<$filename") {
+ warn "Unable to read from $filename: $!\n";
+ next;
+ }
+
+ info("Scanning $filename ...");
+
+ my $c = do { local $/; <IN> };
+ close IN;
+
+ my %file = (orig => $c, changes => 0);
+
+ # Temporarily remove C/XS comments and strings from the code
+ my @ccom;
+
+ $c =~ s{
+ ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]*
+ | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* )
+ | ( ^$HS*\#[^\r\n]*
+ | "[^"\\]*(?:\\.[^"\\]*)*"
+ | '[^'\\]*(?:\\.[^'\\]*)*'
+ | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) )
+ }{ defined $2 and push @ccom, $2;
+ defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex;
+
+ $file{ccom} = \@ccom;
+ $file{code} = $c;
+ $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m;
+
+ my $func;
+
+ for $func (keys %API) {
+ my $match = $func;
+ $match .= "|$revreplace{$func}" if exists $revreplace{$func};
+ if ($c =~ /\b(?:Perl_)?($match)\b/) {
+ $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
+ $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
+ if (exists $API{$func}{provided}) {
+ $file{uses_provided}{$func}++;
+ if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
+ $file{uses}{$func}++;
+ my @deps = rec_depend($func);
+ if (@deps) {
+ $file{uses_deps}{$func} = \@deps;
+ for (@deps) {
+ $file{uses}{$_} = 0 unless exists $file{uses}{$_};
+ }
+ }
+ for ($func, @deps) {
+ $file{needs}{$_} = 'static' if exists $need{$_};
+ }
+ }
+ }
+ if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
+ if ($c =~ /\b$func\b/) {
+ $file{uses_todo}{$func}++;
+ }
+ }
+ }
+ }
+
+ while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
+ if (exists $need{$2}) {
+ $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
+ }
+ else { warning("Possibly wrong #define $1 in $filename") }
+ }
+
+ for (qw(uses needs uses_todo needed_global needed_static)) {
+ for $func (keys %{$file{$_}}) {
+ push @{$global{$_}{$func}}, $filename;
+ }
+ }
+
+ $files{$filename} = \%file;
+}
+
+# Globally resolve NEED_'s
+my $need;
+for $need (keys %{$global{needs}}) {
+ if (@{$global{needs}{$need}} > 1) {
+ my @targets = @{$global{needs}{$need}};
+ my @t = grep $files{$_}{needed_global}{$need}, @targets;
+ @targets = @t if @t;
+ @t = grep /\.xs$/i, @targets;
+ @targets = @t if @t;
+ my $target = shift @targets;
+ $files{$target}{needs}{$need} = 'global';
+ for (@{$global{needs}{$need}}) {
+ $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
+ }
+ }
+}
+
+for $filename (@files) {
+ exists $files{$filename} or next;
+
+ info("=== Analyzing $filename ===");
+
+ my %file = %{$files{$filename}};
+ my $func;
+ my $c = $file{code};
+ my $warnings = 0;
+
+ for $func (sort keys %{$file{uses_Perl}}) {
+ if ($API{$func}{varargs}) {
+ unless ($API{$func}{nothxarg}) {
+ my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
+ { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
+ if ($changes) {
+ warning("Doesn't pass interpreter argument aTHX to Perl_$func");
+ $file{changes} += $changes;
+ }
+ }
+ }
+ else {
+ warning("Uses Perl_$func instead of $func");
+ $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
+ {$func$1(}g);
+ }
+ }
+
+ for $func (sort keys %{$file{uses_replace}}) {
+ warning("Uses $func instead of $replace{$func}");
+ $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
+ }
+
+ for $func (sort keys %{$file{uses_provided}}) {
+ if ($file{uses}{$func}) {
+ if (exists $file{uses_deps}{$func}) {
+ diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
+ }
+ else {
+ diag("Uses $func");
+ }
+ }
+ $warnings += hint($func);
+ }
+
+ unless ($opt{quiet}) {
+ for $func (sort keys %{$file{uses_todo}}) {
+ print "*** WARNING: Uses $func, which may not be portable below perl ",
+ format_version($API{$func}{todo}), ", even with '$ppport'\n";
+ $warnings++;
+ }
+ }
+
+ for $func (sort keys %{$file{needed_static}}) {
+ my $message = '';
+ if (not exists $file{uses}{$func}) {
+ $message = "No need to define NEED_$func if $func is never used";
+ }
+ elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
+ $message = "No need to define NEED_$func when already needed globally";
+ }
+ if ($message) {
+ diag($message);
+ $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
+ }
+ }
+
+ for $func (sort keys %{$file{needed_global}}) {
+ my $message = '';
+ if (not exists $global{uses}{$func}) {
+ $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
+ }
+ elsif (exists $file{needs}{$func}) {
+ if ($file{needs}{$func} eq 'extern') {
+ $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
+ }
+ elsif ($file{needs}{$func} eq 'static') {
+ $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
+ }
+ }
+ if ($message) {
+ diag($message);
+ $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
+ }
+ }
+
+ $file{needs_inc_ppport} = keys %{$file{uses}};
+
+ if ($file{needs_inc_ppport}) {
+ my $pp = '';
+
+ for $func (sort keys %{$file{needs}}) {
+ my $type = $file{needs}{$func};
+ next if $type eq 'extern';
+ my $suffix = $type eq 'global' ? '_GLOBAL' : '';
+ unless (exists $file{"needed_$type"}{$func}) {
+ if ($type eq 'global') {
+ diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
+ }
+ else {
+ diag("File needs $func, adding static request");
+ }
+ $pp .= "#define NEED_$func$suffix\n";
+ }
+ }
+
+ if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
+ $pp = '';
+ $file{changes}++;
+ }
+
+ unless ($file{has_inc_ppport}) {
+ diag("Needs to include '$ppport'");
+ $pp .= qq(#include "$ppport"\n)
+ }
+
+ if ($pp) {
+ $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
+ || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
+ || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
+ || ($c =~ s/^/$pp/);
+ }
+ }
+ else {
+ if ($file{has_inc_ppport}) {
+ diag("No need to include '$ppport'");
+ $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
+ }
+ }
+
+ # put back in our C comments
+ my $ix;
+ my $cppc = 0;
+ my @ccom = @{$file{ccom}};
+ for $ix (0 .. $#ccom) {
+ if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
+ $cppc++;
+ $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
+ }
+ else {
+ $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
+ }
+ }
+
+ if ($cppc) {
+ my $s = $cppc != 1 ? 's' : '';
+ warning("Uses $cppc C++ style comment$s, which is not portable");
+ }
+
+ my $s = $warnings != 1 ? 's' : '';
+ my $warn = $warnings ? " ($warnings warning$s)" : '';
+ info("Analysis completed$warn");
+
+ if ($file{changes}) {
+ if (exists $opt{copy}) {
+ my $newfile = "$filename$opt{copy}";
+ if (-e $newfile) {
+ error("'$newfile' already exists, refusing to write copy of '$filename'");
+ }
+ else {
+ local *F;
+ if (open F, ">$newfile") {
+ info("Writing copy of '$filename' with changes to '$newfile'");
+ print F $c;
+ close F;
+ }
+ else {
+ error("Cannot open '$newfile' for writing: $!");
+ }
+ }
+ }
+ elsif (exists $opt{patch} || $opt{changes}) {
+ if (exists $opt{patch}) {
+ unless ($patch_opened) {
+ if (open PATCH, ">$opt{patch}") {
+ $patch_opened = 1;
+ }
+ else {
+ error("Cannot open '$opt{patch}' for writing: $!");
+ delete $opt{patch};
+ $opt{changes} = 1;
+ goto fallback;
+ }
+ }
+ mydiff(\*PATCH, $filename, $c);
+ }
+ else {
+fallback:
+ info("Suggested changes:");
+ mydiff(\*STDOUT, $filename, $c);
+ }
+ }
+ else {
+ my $s = $file{changes} == 1 ? '' : 's';
+ info("$file{changes} potentially required change$s detected");
+ }
+ }
+ else {
+ info("Looks good");
+ }
+}
+
+close PATCH if $patch_opened;
+
+exit 0;
+
+
+sub try_use { eval "use @_;"; return $@ eq '' }
+
+sub mydiff
+{
+ local *F = shift;
+ my($file, $str) = @_;
+ my $diff;
+
+ if (exists $opt{diff}) {
+ $diff = run_diff($opt{diff}, $file, $str);
+ }
+
+ if (!defined $diff and try_use('Text::Diff')) {
+ $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
+ $diff = <<HEADER . $diff;
+--- $file
++++ $file.patched
+HEADER
+ }
+
+ if (!defined $diff) {
+ $diff = run_diff('diff -u', $file, $str);
+ }
+
+ if (!defined $diff) {
+ $diff = run_diff('diff', $file, $str);
+ }
+
+ if (!defined $diff) {
+ error("Cannot generate a diff. Please install Text::Diff or use --copy.");
+ return;
+ }
+
+ print F $diff;
+}
+
+sub run_diff
+{
+ my($prog, $file, $str) = @_;
+ my $tmp = 'dppptemp';
+ my $suf = 'aaa';
+ my $diff = '';
+ local *F;
+
+ while (-e "$tmp.$suf") { $suf++ }
+ $tmp = "$tmp.$suf";
+
+ if (open F, ">$tmp") {
+ print F $str;
+ close F;
+
+ if (open F, "$prog $file $tmp |") {
+ while (<F>) {
+ s/\Q$tmp\E/$file.patched/;
+ $diff .= $_;
+ }
+ close F;
+ unlink $tmp;
+ return $diff;
+ }
+
+ unlink $tmp;
+ }
+ else {
+ error("Cannot open '$tmp' for writing: $!");
+ }
+
+ return undef;
+}
+
+sub rec_depend
+{
+ my($func, $seen) = @_;
+ return () unless exists $depends{$func};
+ $seen = {%{$seen||{}}};
+ return () if $seen->{$func}++;
+ my %s;
+ grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
+}
+
+sub parse_version
+{
+ my $ver = shift;
+
+ if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
+ return ($1, $2, $3);
+ }
+ elsif ($ver !~ /^\d+\.[\d_]+$/) {
+ die "cannot parse version '$ver'\n";
+ }
+
+ $ver =~ s/_//g;
+ $ver =~ s/$/000000/;
+
+ my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
+
+ $v = int $v;
+ $s = int $s;
+
+ if ($r < 5 || ($r == 5 && $v < 6)) {
+ if ($s % 10) {
+ die "cannot parse version '$ver'\n";
+ }
+ }
+
+ return ($r, $v, $s);
+}
+
+sub format_version
+{
+ my $ver = shift;
+
+ $ver =~ s/$/000000/;
+ my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
+
+ $v = int $v;
+ $s = int $s;
+
+ if ($r < 5 || ($r == 5 && $v < 6)) {
+ if ($s % 10) {
+ die "invalid version '$ver'\n";
+ }
+ $s /= 10;
+
+ $ver = sprintf "%d.%03d", $r, $v;
+ $s > 0 and $ver .= sprintf "_%02d", $s;
+
+ return $ver;
+ }
+
+ return sprintf "%d.%d.%d", $r, $v, $s;
+}
+
+sub info
+{
+ $opt{quiet} and return;
+ print @_, "\n";
+}
+
+sub diag
+{
+ $opt{quiet} and return;
+ $opt{diag} and print @_, "\n";
+}
+
+sub warning
+{
+ $opt{quiet} and return;
+ print "*** ", @_, "\n";
+}
+
+sub error
+{
+ print "*** ERROR: ", @_, "\n";
+}
+
+my %given_hints;
+my %given_warnings;
+sub hint
+{
+ $opt{quiet} and return;
+ my $func = shift;
+ my $rv = 0;
+ if (exists $warnings{$func} && !$given_warnings{$func}++) {
+ my $warn = $warnings{$func};
+ $warn =~ s!^!*** !mg;
+ print "*** WARNING: $func\n", $warn;
+ $rv++;
+ }
+ if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) {
+ my $hint = $hints{$func};
+ $hint =~ s/^/ /mg;
+ print " --- hint for $func ---\n", $hint;
+ }
+ $rv;
+}
+
+sub usage
+{
+ my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
+ my %M = ( 'I' => '*' );
+ $usage =~ s/^\s*perl\s+\S+/$^X $0/;
+ $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
+
+ print <<ENDUSAGE;
+
+Usage: $usage
+
+See perldoc $0 for details.
+
+ENDUSAGE
+
+ exit 2;
+}
+
+sub strip
+{
+ my $self = do { local(@ARGV,$/)=($0); <> };
+ my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
+ $copy =~ s/^(?=\S+)/ /gms;
+ $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
+ $self =~ s/^SKIP.*(?=^__DATA__)/SKIP
+if (\@ARGV && \$ARGV[0] eq '--unstrip') {
+ eval { require Devel::PPPort };
+ \$@ and die "Cannot require Devel::PPPort, please install.\\n";
+ if (eval \$Devel::PPPort::VERSION < $VERSION) {
+ die "$0 was originally generated with Devel::PPPort $VERSION.\\n"
+ . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n"
+ . "Please install a newer version, or --unstrip will not work.\\n";
+ }
+ Devel::PPPort::WriteFile(\$0);
+ exit 0;
+}
+print <<END;
+
+Sorry, but this is a stripped version of \$0.
+
+To be able to use its original script and doc functionality,
+please try to regenerate this file using:
+
+ \$^X \$0 --unstrip
+
+END
+/ms;
+ my($pl, $c) = $self =~ /(.*^__DATA__)(.*)/ms;
+ $c =~ s{
+ / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
+ | ( "[^"\\]*(?:\\.[^"\\]*)*"
+ | '[^'\\]*(?:\\.[^'\\]*)*' )
+ | ($HS+) }{ defined $2 ? ' ' : ($1 || '') }gsex;
+ $c =~ s!\s+$!!mg;
+ $c =~ s!^$LF!!mg;
+ $c =~ s!^\s*#\s*!#!mg;
+ $c =~ s!^\s+!!mg;
+
+ open OUT, ">$0" or die "cannot strip $0: $!\n";
+ print OUT "$pl$c\n";
+
+ exit 0;
+}
+
+__DATA__
+*/
+
+#ifndef _P_P_PORTABILITY_H_
+#define _P_P_PORTABILITY_H_
+
+#ifndef DPPP_NAMESPACE
+# define DPPP_NAMESPACE DPPP_
+#endif
+
+#define DPPP_CAT2(x,y) CAT2(x,y)
+#define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
+
+#ifndef PERL_REVISION
+# if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
+# define PERL_PATCHLEVEL_H_IMPLICIT
+# include <patchlevel.h>
+# endif
+# if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
+# include <could_not_find_Perl_patchlevel.h>
+# endif
+# ifndef PERL_REVISION
+# define PERL_REVISION (5)
+ /* Replace: 1 */
+# define PERL_VERSION PATCHLEVEL
+# define PERL_SUBVERSION SUBVERSION
+ /* Replace PERL_PATCHLEVEL with PERL_VERSION */
+ /* Replace: 0 */
+# endif
+#endif
+
+#define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
+#define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION))
+
+/* It is very unlikely that anyone will try to use this with Perl 6
+ (or greater), but who knows.
+ */
+#if PERL_REVISION != 5
+# error ppport.h only works with Perl version 5
+#endif /* PERL_REVISION != 5 */
+#ifndef dTHR
+# define dTHR dNOOP
+#endif
+#ifndef dTHX
+# define dTHX dNOOP
+#endif
+
+#ifndef dTHXa
+# define dTHXa(x) dNOOP
+#endif
+#ifndef pTHX
+# define pTHX void
+#endif
+
+#ifndef pTHX_
+# define pTHX_
+#endif
+
+#ifndef aTHX
+# define aTHX
+#endif
+
+#ifndef aTHX_
+# define aTHX_
+#endif
+
+#if (PERL_BCDVERSION < 0x5006000)
+# ifdef USE_THREADS
+# define aTHXR thr
+# define aTHXR_ thr,
+# else
+# define aTHXR
+# define aTHXR_
+# endif
+# define dTHXR dTHR
+#else
+# define aTHXR aTHX
+# define aTHXR_ aTHX_
+# define dTHXR dTHX
+#endif
+#ifndef dTHXoa
+# define dTHXoa(x) dTHXa(x)
+#endif
+
+#ifdef I_LIMITS
+# include <limits.h>
+#endif
+
+#ifndef PERL_UCHAR_MIN
+# define PERL_UCHAR_MIN ((unsigned char)0)
+#endif
+
+#ifndef PERL_UCHAR_MAX
+# ifdef UCHAR_MAX
+# define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
+# else
+# ifdef MAXUCHAR
+# define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
+# else
+# define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
+# endif
+# endif
+#endif
+
+#ifndef PERL_USHORT_MIN
+# define PERL_USHORT_MIN ((unsigned short)0)
+#endif
+
+#ifndef PERL_USHORT_MAX
+# ifdef USHORT_MAX
+# define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
+# else
+# ifdef MAXUSHORT
+# define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
+# else
+# ifdef USHRT_MAX
+# define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
+# else
+# define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
+# endif
+# endif
+# endif
+#endif
+
+#ifndef PERL_SHORT_MAX
+# ifdef SHORT_MAX
+# define PERL_SHORT_MAX ((short)SHORT_MAX)
+# else
+# ifdef MAXSHORT /* Often used in <values.h> */
+# define PERL_SHORT_MAX ((short)MAXSHORT)
+# else
+# ifdef SHRT_MAX
+# define PERL_SHORT_MAX ((short)SHRT_MAX)
+# else
+# define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
+# endif
+# endif
+# endif
+#endif
+
+#ifndef PERL_SHORT_MIN
+# ifdef SHORT_MIN
+# define PERL_SHORT_MIN ((short)SHORT_MIN)
+# else
+# ifdef MINSHORT
+# define PERL_SHORT_MIN ((short)MINSHORT)
+# else
+# ifdef SHRT_MIN
+# define PERL_SHORT_MIN ((short)SHRT_MIN)
+# else
+# define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
+# endif
+# endif
+# endif
+#endif
+
+#ifndef PERL_UINT_MAX
+# ifdef UINT_MAX
+# define PERL_UINT_MAX ((unsigned int)UINT_MAX)
+# else
+# ifdef MAXUINT
+# define PERL_UINT_MAX ((unsigned int)MAXUINT)
+# else
+# define PERL_UINT_MAX (~(unsigned int)0)
+# endif
+# endif
+#endif
+
+#ifndef PERL_UINT_MIN
+# define PERL_UINT_MIN ((unsigned int)0)
+#endif
+
+#ifndef PERL_INT_MAX
+# ifdef INT_MAX
+# define PERL_INT_MAX ((int)INT_MAX)
+# else
+# ifdef MAXINT /* Often used in <values.h> */
+# define PERL_INT_MAX ((int)MAXINT)
+# else
+# define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
+# endif
+# endif
+#endif
+
+#ifndef PERL_INT_MIN
+# ifdef INT_MIN
+# define PERL_INT_MIN ((int)INT_MIN)
+# else
+# ifdef MININT
+# define PERL_INT_MIN ((int)MININT)
+# else
+# define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
+# endif
+# endif
+#endif
+
+#ifndef PERL_ULONG_MAX
+# ifdef ULONG_MAX
+# define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
+# else
+# ifdef MAXULONG
+# define PERL_ULONG_MAX ((unsigned long)MAXULONG)
+# else
+# define PERL_ULONG_MAX (~(unsigned long)0)
+# endif
+# endif
+#endif
+
+#ifndef PERL_ULONG_MIN
+# define PERL_ULONG_MIN ((unsigned long)0L)
+#endif
+
+#ifndef PERL_LONG_MAX
+# ifdef LONG_MAX
+# define PERL_LONG_MAX ((long)LONG_MAX)
+# else
+# ifdef MAXLONG
+# define PERL_LONG_MAX ((long)MAXLONG)
+# else
+# define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
+# endif
+# endif
+#endif
+
+#ifndef PERL_LONG_MIN
+# ifdef LONG_MIN
+# define PERL_LONG_MIN ((long)LONG_MIN)
+# else
+# ifdef MINLONG
+# define PERL_LONG_MIN ((long)MINLONG)
+# else
+# define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
+# endif
+# endif
+#endif
+
+#if defined(HAS_QUAD) && (defined(convex) || defined(uts))
+# ifndef PERL_UQUAD_MAX
+# ifdef ULONGLONG_MAX
+# define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
+# else
+# ifdef MAXULONGLONG
+# define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
+# else
+# define PERL_UQUAD_MAX (~(unsigned long long)0)
+# endif
+# endif
+# endif
+
+# ifndef PERL_UQUAD_MIN
+# define PERL_UQUAD_MIN ((unsigned long long)0L)
+# endif
+
+# ifndef PERL_QUAD_MAX
+# ifdef LONGLONG_MAX
+# define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
+# else
+# ifdef MAXLONGLONG
+# define PERL_QUAD_MAX ((long long)MAXLONGLONG)
+# else
+# define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
+# endif
+# endif
+# endif
+
+# ifndef PERL_QUAD_MIN
+# ifdef LONGLONG_MIN
+# define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
+# else
+# ifdef MINLONGLONG
+# define PERL_QUAD_MIN ((long long)MINLONGLONG)
+# else
+# define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
+# endif
+# endif
+# endif
+#endif
+
+/* This is based on code from 5.003 perl.h */
+#ifdef HAS_QUAD
+# ifdef cray
+#ifndef IVTYPE
+# define IVTYPE int
+#endif
+
+#ifndef IV_MIN
+# define IV_MIN PERL_INT_MIN
+#endif
+
+#ifndef IV_MAX
+# define IV_MAX PERL_INT_MAX
+#endif
+
+#ifndef UV_MIN
+# define UV_MIN PERL_UINT_MIN
+#endif
+
+#ifndef UV_MAX
+# define UV_MAX PERL_UINT_MAX
+#endif
+
+# ifdef INTSIZE
+#ifndef IVSIZE
+# define IVSIZE INTSIZE
+#endif
+
+# endif
+# else
+# if defined(convex) || defined(uts)
+#ifndef IVTYPE
+# define IVTYPE long long
+#endif
+
+#ifndef IV_MIN
+# define IV_MIN PERL_QUAD_MIN
+#endif
+
+#ifndef IV_MAX
+# define IV_MAX PERL_QUAD_MAX
+#endif
+
+#ifndef UV_MIN
+# define UV_MIN PERL_UQUAD_MIN
+#endif
+
+#ifndef UV_MAX
+# define UV_MAX PERL_UQUAD_MAX
+#endif
+
+# ifdef LONGLONGSIZE
+#ifndef IVSIZE
+# define IVSIZE LONGLONGSIZE
+#endif
+
+# endif
+# else
+#ifndef IVTYPE
+# define IVTYPE long
+#endif
+
+#ifndef IV_MIN
+# define IV_MIN PERL_LONG_MIN
+#endif
+
+#ifndef IV_MAX
+# define IV_MAX PERL_LONG_MAX
+#endif
+
+#ifndef UV_MIN
+# define UV_MIN PERL_ULONG_MIN
+#endif
+
+#ifndef UV_MAX
+# define UV_MAX PERL_ULONG_MAX
+#endif
+
+# ifdef LONGSIZE
+#ifndef IVSIZE
+# define IVSIZE LONGSIZE
+#endif
+
+# endif
+# endif
+# endif
+#ifndef IVSIZE
+# define IVSIZE 8
+#endif
+
+#ifndef LONGSIZE
+# define LONGSIZE 8
+#endif
+
+#ifndef PERL_QUAD_MIN
+# define PERL_QUAD_MIN IV_MIN
+#endif
+
+#ifndef PERL_QUAD_MAX
+# define PERL_QUAD_MAX IV_MAX
+#endif
+
+#ifndef PERL_UQUAD_MIN
+# define PERL_UQUAD_MIN UV_MIN
+#endif
+
+#ifndef PERL_UQUAD_MAX
+# define PERL_UQUAD_MAX UV_MAX
+#endif
+
+#else
+#ifndef IVTYPE
+# define IVTYPE long
+#endif
+
+#ifndef LONGSIZE
+# define LONGSIZE 4
+#endif
+
+#ifndef IV_MIN
+# define IV_MIN PERL_LONG_MIN
+#endif
+
+#ifndef IV_MAX
+# define IV_MAX PERL_LONG_MAX
+#endif
+
+#ifndef UV_MIN
+# define UV_MIN PERL_ULONG_MIN
+#endif
+
+#ifndef UV_MAX
+# define UV_MAX PERL_ULONG_MAX
+#endif
+
+#endif
+
+#ifndef IVSIZE
+# ifdef LONGSIZE
+# define IVSIZE LONGSIZE
+# else
+# define IVSIZE 4 /* A bold guess, but the best we can make. */
+# endif
+#endif
+#ifndef UVTYPE
+# define UVTYPE unsigned IVTYPE
+#endif
+
+#ifndef UVSIZE
+# define UVSIZE IVSIZE
+#endif
+#ifndef sv_setuv
+# define sv_setuv(sv, uv) \
+ STMT_START { \
+ UV TeMpUv = uv; \
+ if (TeMpUv <= IV_MAX) \
+ sv_setiv(sv, TeMpUv); \
+ else \
+ sv_setnv(sv, (double)TeMpUv); \
+ } STMT_END
+#endif
+#ifndef newSVuv
+# define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
+#endif
+#ifndef sv_2uv
+# define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
+#endif
+
+#ifndef SvUVX
+# define SvUVX(sv) ((UV)SvIVX(sv))
+#endif
+
+#ifndef SvUVXx
+# define SvUVXx(sv) SvUVX(sv)
+#endif
+
+#ifndef SvUV
+# define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
+#endif
+
+#ifndef SvUVx
+# define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
+#endif
+
+/* Hint: sv_uv
+ * Always use the SvUVx() macro instead of sv_uv().
+ */
+#ifndef sv_uv
+# define sv_uv(sv) SvUVx(sv)
+#endif
+
+#if !defined(SvUOK) && defined(SvIOK_UV)
+# define SvUOK(sv) SvIOK_UV(sv)
+#endif
+#ifndef XST_mUV
+# define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
+#endif
+
+#ifndef XSRETURN_UV
+# define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
+#endif
+#ifndef PUSHu
+# define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
+#endif
+
+#ifndef XPUSHu
+# define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
+#endif
+
+#ifdef HAS_MEMCMP
+#ifndef memNE
+# define memNE(s1,s2,l) (memcmp(s1,s2,l))
+#endif
+
+#ifndef memEQ
+# define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
+#endif
+
+#else
+#ifndef memNE
+# define memNE(s1,s2,l) (bcmp(s1,s2,l))
+#endif
+
+#ifndef memEQ
+# define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
+#endif
+
+#endif
+#ifndef memEQs
+# define memEQs(s1, l, s2) \
+ (sizeof(s2)-1 == l && memEQ(s1, (s2 ""), (sizeof(s2)-1)))
+#endif
+
+#ifndef memNEs
+# define memNEs(s1, l, s2) !memEQs(s1, l, s2)
+#endif
+#ifndef MoveD
+# define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
+#endif
+
+#ifndef CopyD
+# define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
+#endif
+
+#ifdef HAS_MEMSET
+#ifndef ZeroD
+# define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
+#endif
+
+#else
+#ifndef ZeroD
+# define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
+#endif
+
+#endif
+#ifndef PoisonWith
+# define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
+#endif
+
+#ifndef PoisonNew
+# define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
+#endif
+
+#ifndef PoisonFree
+# define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
+#endif
+
+#ifndef Poison
+# define Poison(d,n,t) PoisonFree(d,n,t)
+#endif
+#ifndef Newx
+# define Newx(v,n,t) New(0,v,n,t)
+#endif
+
+#ifndef Newxc
+# define Newxc(v,n,t,c) Newc(0,v,n,t,c)
+#endif
+
+#ifndef Newxz
+# define Newxz(v,n,t) Newz(0,v,n,t)
+#endif
+
+#ifndef PERL_UNUSED_DECL
+# ifdef HASATTRIBUTE
+# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
+# define PERL_UNUSED_DECL
+# else
+# define PERL_UNUSED_DECL __attribute__((unused))
+# endif
+# else
+# define PERL_UNUSED_DECL
+# endif
+#endif
+
+#ifndef PERL_UNUSED_ARG
+# if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
+# include <note.h>
+# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
+# else
+# define PERL_UNUSED_ARG(x) ((void)x)
+# endif
+#endif
+
+#ifndef PERL_UNUSED_VAR
+# define PERL_UNUSED_VAR(x) ((void)x)
+#endif
+
+#ifndef PERL_UNUSED_CONTEXT
+# ifdef USE_ITHREADS
+# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
+# else
+# define PERL_UNUSED_CONTEXT
+# endif
+#endif
+#ifndef NOOP
+# define NOOP /*EMPTY*/(void)0
+#endif
+
+#ifndef dNOOP
+# define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
+#endif
+
+#ifndef NVTYPE
+# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
+# define NVTYPE long double
+# else
+# define NVTYPE double
+# endif
+typedef NVTYPE NV;
+#endif
+
+#ifndef INT2PTR
+# if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
+# define PTRV UV
+# define INT2PTR(any,d) (any)(d)
+# else
+# if PTRSIZE == LONGSIZE
+# define PTRV unsigned long
+# else
+# define PTRV unsigned
+# endif
+# define INT2PTR(any,d) (any)(PTRV)(d)
+# endif
+#endif
+
+#ifndef PTR2ul
+# if PTRSIZE == LONGSIZE
+# define PTR2ul(p) (unsigned long)(p)
+# else
+# define PTR2ul(p) INT2PTR(unsigned long,p)
+# endif
+#endif
+#ifndef PTR2nat
+# define PTR2nat(p) (PTRV)(p)
+#endif
+
+#ifndef NUM2PTR
+# define NUM2PTR(any,d) (any)PTR2nat(d)
+#endif
+
+#ifndef PTR2IV
+# define PTR2IV(p) INT2PTR(IV,p)
+#endif
+
+#ifndef PTR2UV
+# define PTR2UV(p) INT2PTR(UV,p)
+#endif
+
+#ifndef PTR2NV
+# define PTR2NV(p) NUM2PTR(NV,p)
+#endif
+
+#undef START_EXTERN_C
+#undef END_EXTERN_C
+#undef EXTERN_C
+#ifdef __cplusplus
+# define START_EXTERN_C extern "C" {
+# define END_EXTERN_C }
+# define EXTERN_C extern "C"
+#else
+# define START_EXTERN_C
+# define END_EXTERN_C
+# define EXTERN_C extern
+#endif
+
+#if defined(PERL_GCC_PEDANTIC)
+# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
+# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
+# endif
+#endif
+
+#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
+# ifndef PERL_USE_GCC_BRACE_GROUPS
+# define PERL_USE_GCC_BRACE_GROUPS
+# endif
+#endif
+
+#undef STMT_START
+#undef STMT_END
+#ifdef PERL_USE_GCC_BRACE_GROUPS
+# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
+# define STMT_END )
+#else
+# if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
+# define STMT_START if (1)
+# define STMT_END else (void)0
+# else
+# define STMT_START do
+# define STMT_END while (0)
+# endif
+#endif
+#ifndef boolSV
+# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
+#endif
+
+/* DEFSV appears first in 5.004_56 */
+#ifndef DEFSV
+# define DEFSV GvSV(PL_defgv)
+#endif
+
+#ifndef SAVE_DEFSV
+# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
+#endif
+
+#ifndef DEFSV_set
+# define DEFSV_set(sv) (DEFSV = (sv))
+#endif
+
+/* Older perls (<=5.003) lack AvFILLp */
+#ifndef AvFILLp
+# define AvFILLp AvFILL
+#endif
+#ifndef ERRSV
+# define ERRSV get_sv("@",FALSE)
+#endif
+
+/* Hint: gv_stashpvn
+ * This function's backport doesn't support the length parameter, but
+ * rather ignores it. Portability can only be ensured if the length
+ * parameter is used for speed reasons, but the length can always be
+ * correctly computed from the string argument.
+ */
+#ifndef gv_stashpvn
+# define gv_stashpvn(str,len,create) gv_stashpv(str,create)
+#endif
+
+/* Replace: 1 */
+#ifndef get_cv
+# define get_cv perl_get_cv
+#endif
+
+#ifndef get_sv
+# define get_sv perl_get_sv
+#endif
+
+#ifndef get_av
+# define get_av perl_get_av
+#endif
+
+#ifndef get_hv
+# define get_hv perl_get_hv
+#endif
+
+/* Replace: 0 */
+#ifndef dUNDERBAR
+# define dUNDERBAR dNOOP
+#endif
+
+#ifndef UNDERBAR
+# define UNDERBAR DEFSV
+#endif
+#ifndef dAX
+# define dAX I32 ax = MARK - PL_stack_base + 1
+#endif
+
+#ifndef dITEMS
+# define dITEMS I32 items = SP - MARK
+#endif
+#ifndef dXSTARG
+# define dXSTARG SV * targ = sv_newmortal()
+#endif
+#ifndef dAXMARK
+# define dAXMARK I32 ax = POPMARK; \
+ register SV ** const mark = PL_stack_base + ax++
+#endif
+#ifndef XSprePUSH
+# define XSprePUSH (sp = PL_stack_base + ax - 1)
+#endif
+
+#if (PERL_BCDVERSION < 0x5005000)
+# undef XSRETURN
+# define XSRETURN(off) \
+ STMT_START { \
+ PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
+ return; \
+ } STMT_END
+#endif
+#ifndef XSPROTO
+# define XSPROTO(name) void name(pTHX_ CV* cv)
+#endif
+
+#ifndef SVfARG
+# define SVfARG(p) ((void*)(p))
+#endif
+#ifndef PERL_ABS
+# define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
+#endif
+#ifndef dVAR
+# define dVAR dNOOP
+#endif
+#ifndef SVf
+# define SVf "_"
+#endif
+#ifndef UTF8_MAXBYTES
+# define UTF8_MAXBYTES UTF8_MAXLEN
+#endif
+#ifndef CPERLscope
+# define CPERLscope(x) x
+#endif
+#ifndef PERL_HASH
+# define PERL_HASH(hash,str,len) \
+ STMT_START { \
+ const char *s_PeRlHaSh = str; \
+ I32 i_PeRlHaSh = len; \
+ U32 hash_PeRlHaSh = 0; \
+ while (i_PeRlHaSh--) \
+ hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
+ (hash) = hash_PeRlHaSh; \
+ } STMT_END
+#endif
+
+#ifndef PERLIO_FUNCS_DECL
+# ifdef PERLIO_FUNCS_CONST
+# define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
+# define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
+# else
+# define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
+# define PERLIO_FUNCS_CAST(funcs) (funcs)
+# endif
+#endif
+
+/* provide these typedefs for older perls */
+#if (PERL_BCDVERSION < 0x5009003)
+
+# ifdef ARGSproto
+typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
+# else
+typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
+# endif
+
+typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
+
+#endif
+#ifndef isPSXSPC
+# define isPSXSPC(c) (isSPACE(c) || (c) == '\v')
+#endif
+
+#ifndef isBLANK
+# define isBLANK(c) ((c) == ' ' || (c) == '\t')
+#endif
+
+#ifdef EBCDIC
+#ifndef isALNUMC
+# define isALNUMC(c) isalnum(c)
+#endif
+
+#ifndef isASCII
+# define isASCII(c) isascii(c)
+#endif
+
+#ifndef isCNTRL
+# define isCNTRL(c) iscntrl(c)
+#endif
+
+#ifndef isGRAPH
+# define isGRAPH(c) isgraph(c)
+#endif
+
+#ifndef isPRINT
+# define isPRINT(c) isprint(c)
+#endif
+
+#ifndef isPUNCT
+# define isPUNCT(c) ispunct(c)
+#endif
+
+#ifndef isXDIGIT
+# define isXDIGIT(c) isxdigit(c)
+#endif
+
+#else
+# if (PERL_BCDVERSION < 0x5010000)
+/* Hint: isPRINT
+ * The implementation in older perl versions includes all of the
+ * isSPACE() characters, which is wrong. The version provided by
+ * Devel::PPPort always overrides a present buggy version.
+ */
+# undef isPRINT
+# endif
+
+#ifdef HAS_QUAD
+# define WIDEST_UTYPE U64TYPE
+#else
+# define WIDEST_UTYPE U32
+#endif
+#ifndef isALNUMC
+# define isALNUMC(c) (isALPHA(c) || isDIGIT(c))
+#endif
+
+#ifndef isASCII
+# define isASCII(c) ((WIDEST_UTYPE) (c) <= 127)
+#endif
+
+#ifndef isCNTRL
+# define isCNTRL(c) ((WIDEST_UTYPE) (c) < ' ' || (c) == 127)
+#endif
+
+#ifndef isGRAPH
+# define isGRAPH(c) (isALNUM(c) || isPUNCT(c))
+#endif
+
+#ifndef isPRINT
+# define isPRINT(c) (((c) >= 32 && (c) < 127))
+#endif
+
+#ifndef isPUNCT
+# define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
+#endif
+
+#ifndef isXDIGIT
+# define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
+#endif
+
+#endif
+
+#ifndef PERL_SIGNALS_UNSAFE_FLAG
+
+#define PERL_SIGNALS_UNSAFE_FLAG 0x0001
+
+#if (PERL_BCDVERSION < 0x5008000)
+# define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
+#else
+# define D_PPP_PERL_SIGNALS_INIT 0
+#endif
+
+#if defined(NEED_PL_signals)
+static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
+#elif defined(NEED_PL_signals_GLOBAL)
+U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
+#else
+extern U32 DPPP_(my_PL_signals);
+#endif
+#define PL_signals DPPP_(my_PL_signals)
+
+#endif
+
+/* Hint: PL_ppaddr
+ * Calling an op via PL_ppaddr requires passing a context argument
+ * for threaded builds. Since the context argument is different for
+ * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
+ * automatically be defined as the correct argument.
+ */
+
+#if (PERL_BCDVERSION <= 0x5005005)
+/* Replace: 1 */
+# define PL_ppaddr ppaddr
+# define PL_no_modify no_modify
+/* Replace: 0 */
+#endif
+
+#if (PERL_BCDVERSION <= 0x5004005)
+/* Replace: 1 */
+# define PL_DBsignal DBsignal
+# define PL_DBsingle DBsingle
+# define PL_DBsub DBsub
+# define PL_DBtrace DBtrace
+# define PL_Sv Sv
+# define PL_bufend bufend
+# define PL_bufptr bufptr
+# define PL_compiling compiling
+# define PL_copline copline
+# define PL_curcop curcop
+# define PL_curstash curstash
+# define PL_debstash debstash
+# define PL_defgv defgv
+# define PL_diehook diehook
+# define PL_dirty dirty
+# define PL_dowarn dowarn
+# define PL_errgv errgv
+# define PL_error_count error_count
+# define PL_expect expect
+# define PL_hexdigit hexdigit
+# define PL_hints hints
+# define PL_in_my in_my
+# define PL_laststatval laststatval
+# define PL_lex_state lex_state
+# define PL_lex_stuff lex_stuff
+# define PL_linestr linestr
+# define PL_na na
+# define PL_perl_destruct_level perl_destruct_level
+# define PL_perldb perldb
+# define PL_rsfp_filters rsfp_filters
+# define PL_rsfp rsfp
+# define PL_stack_base stack_base
+# define PL_stack_sp stack_sp
+# define PL_statcache statcache
+# define PL_stdingv stdingv
+# define PL_sv_arenaroot sv_arenaroot
+# define PL_sv_no sv_no
+# define PL_sv_undef sv_undef
+# define PL_sv_yes sv_yes
+# define PL_tainted tainted
+# define PL_tainting tainting
+# define PL_tokenbuf tokenbuf
+/* Replace: 0 */
+#endif
+
+/* Warning: PL_parser
+ * For perl versions earlier than 5.9.5, this is an always
+ * non-NULL dummy. Also, it cannot be dereferenced. Don't
+ * use it if you can avoid is and unless you absolutely know
+ * what you're doing.
+ * If you always check that PL_parser is non-NULL, you can
+ * define DPPP_PL_parser_NO_DUMMY to avoid the creation of
+ * a dummy parser structure.
+ */
+
+#if (PERL_BCDVERSION >= 0x5009005)
+# ifdef DPPP_PL_parser_NO_DUMMY
+# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
+ (croak("panic: PL_parser == NULL in %s:%d", \
+ __FILE__, __LINE__), (yy_parser *) NULL))->var)
+# else
+# ifdef DPPP_PL_parser_NO_DUMMY_WARNING
+# define D_PPP_parser_dummy_warning(var)
+# else
+# define D_PPP_parser_dummy_warning(var) \
+ warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
+# endif
+# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
+ (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
+#if defined(NEED_PL_parser)
+static yy_parser DPPP_(dummy_PL_parser);
+#elif defined(NEED_PL_parser_GLOBAL)
+yy_parser DPPP_(dummy_PL_parser);
+#else
+extern yy_parser DPPP_(dummy_PL_parser);
+#endif
+
+# endif
+
+/* PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf depends on PL_parser */
+/* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
+ * Do not use this variable unless you know exactly what you're
+ * doint. It is internal to the perl parser and may change or even
+ * be removed in the future. As of perl 5.9.5, you have to check
+ * for (PL_parser != NULL) for this variable to have any effect.
+ * An always non-NULL PL_parser dummy is provided for earlier
+ * perl versions.
+ * If PL_parser is NULL when you try to access this variable, a
+ * dummy is being accessed instead and a warning is issued unless
+ * you define DPPP_PL_parser_NO_DUMMY_WARNING.
+ * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
+ * this variable will croak with a panic message.
+ */
+
+# define PL_expect D_PPP_my_PL_parser_var(expect)
+# define PL_copline D_PPP_my_PL_parser_var(copline)
+# define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
+# define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
+# define PL_linestr D_PPP_my_PL_parser_var(linestr)
+# define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
+# define PL_bufend D_PPP_my_PL_parser_var(bufend)
+# define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
+# define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
+# define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
+# define PL_in_my D_PPP_my_PL_parser_var(in_my)
+# define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
+# define PL_error_count D_PPP_my_PL_parser_var(error_count)
+
+
+#else
+
+/* ensure that PL_parser != NULL and cannot be dereferenced */
+# define PL_parser ((void *) 1)
+
+#endif
+#ifndef mPUSHs
+# define mPUSHs(s) PUSHs(sv_2mortal(s))
+#endif
+
+#ifndef PUSHmortal
+# define PUSHmortal PUSHs(sv_newmortal())
+#endif
+
+#ifndef mPUSHp
+# define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
+#endif
+
+#ifndef mPUSHn
+# define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
+#endif
+
+#ifndef mPUSHi
+# define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
+#endif
+
+#ifndef mPUSHu
+# define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
+#endif
+#ifndef mXPUSHs
+# define mXPUSHs(s) XPUSHs(sv_2mortal(s))
+#endif
+
+#ifndef XPUSHmortal
+# define XPUSHmortal XPUSHs(sv_newmortal())
+#endif
+
+#ifndef mXPUSHp
+# define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
+#endif
+
+#ifndef mXPUSHn
+# define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
+#endif
+
+#ifndef mXPUSHi
+# define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
+#endif
+
+#ifndef mXPUSHu
+# define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
+#endif
+
+/* Replace: 1 */
+#ifndef call_sv
+# define call_sv perl_call_sv
+#endif
+
+#ifndef call_pv
+# define call_pv perl_call_pv
+#endif
+
+#ifndef call_argv
+# define call_argv perl_call_argv
+#endif
+
+#ifndef call_method
+# define call_method perl_call_method
+#endif
+#ifndef eval_sv
+# define eval_sv perl_eval_sv
+#endif
+
+/* Replace: 0 */
+#ifndef PERL_LOADMOD_DENY
+# define PERL_LOADMOD_DENY 0x1
+#endif
+
+#ifndef PERL_LOADMOD_NOIMPORT
+# define PERL_LOADMOD_NOIMPORT 0x2
+#endif
+
+#ifndef PERL_LOADMOD_IMPORT_OPS
+# define PERL_LOADMOD_IMPORT_OPS 0x4
+#endif
+
+#ifndef G_METHOD
+# define G_METHOD 64
+# ifdef call_sv
+# undef call_sv
+# endif
+# if (PERL_BCDVERSION < 0x5006000)
+# define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
+ (flags) & ~G_METHOD) : perl_call_sv(sv, flags))
+# else
+# define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
+ (flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
+# endif
+#endif
+
+/* Replace perl_eval_pv with eval_pv */
+
+#ifndef eval_pv
+#if defined(NEED_eval_pv)
+static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
+static
+#else
+extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
+#endif
+
+#ifdef eval_pv
+# undef eval_pv
+#endif
+#define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
+#define Perl_eval_pv DPPP_(my_eval_pv)
+
+#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
+
+SV*
+DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
+{
+ dSP;
+ SV* sv = newSVpv(p, 0);
+
+ PUSHMARK(sp);
+ eval_sv(sv, G_SCALAR);
+ SvREFCNT_dec(sv);
+
+ SPAGAIN;
+ sv = POPs;
+ PUTBACK;
+
+ if (croak_on_error && SvTRUE(GvSV(errgv)))
+ croak(SvPVx(GvSV(errgv), na));
+
+ return sv;
+}
+
+#endif
+#endif
+
+#ifndef vload_module
+#if defined(NEED_vload_module)
+static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
+static
+#else
+extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
+#endif
+
+#ifdef vload_module
+# undef vload_module
+#endif
+#define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
+#define Perl_vload_module DPPP_(my_vload_module)
+
+#if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
+
+void
+DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args)
+{
+ dTHR;
+ dVAR;
+ OP *veop, *imop;
+
+ OP * const modname = newSVOP(OP_CONST, 0, name);
+ /* 5.005 has a somewhat hacky force_normal that doesn't croak on
+ SvREADONLY() if PL_compling is true. Current perls take care in
+ ck_require() to correctly turn off SvREADONLY before calling
+ force_normal_flags(). This seems a better fix than fudging PL_compling
+ */
+ SvREADONLY_off(((SVOP*)modname)->op_sv);
+ modname->op_private |= OPpCONST_BARE;
+ if (ver) {
+ veop = newSVOP(OP_CONST, 0, ver);
+ }
+ else
+ veop = NULL;
+ if (flags & PERL_LOADMOD_NOIMPORT) {
+ imop = sawparens(newNULLLIST());
+ }
+ else if (flags & PERL_LOADMOD_IMPORT_OPS) {
+ imop = va_arg(*args, OP*);
+ }
+ else {
+ SV *sv;
+ imop = NULL;
+ sv = va_arg(*args, SV*);
+ while (sv) {
+ imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
+ sv = va_arg(*args, SV*);
+ }
+ }
+ {
+ const line_t ocopline = PL_copline;
+ COP * const ocurcop = PL_curcop;
+ const int oexpect = PL_expect;
+
+#if (PERL_BCDVERSION >= 0x5004000)
+ utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
+ veop, modname, imop);
+#else
+ utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
+ modname, imop);
+#endif
+ PL_expect = oexpect;
+ PL_copline = ocopline;
+ PL_curcop = ocurcop;
+ }
+}
+
+#endif
+#endif
+
+#ifndef load_module
+#if defined(NEED_load_module)
+static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
+static
+#else
+extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
+#endif
+
+#ifdef load_module
+# undef load_module
+#endif
+#define load_module DPPP_(my_load_module)
+#define Perl_load_module DPPP_(my_load_module)
+
+#if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
+
+void
+DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
+{
+ va_list args;
+ va_start(args, ver);
+ vload_module(flags, name, ver, &args);
+ va_end(args);
+}
+
+#endif
+#endif
+#ifndef newRV_inc
+# define newRV_inc(sv) newRV(sv) /* Replace */
+#endif
+
+#ifndef newRV_noinc
+#if defined(NEED_newRV_noinc)
+static SV * DPPP_(my_newRV_noinc)(SV *sv);
+static
+#else
+extern SV * DPPP_(my_newRV_noinc)(SV *sv);
+#endif
+
+#ifdef newRV_noinc
+# undef newRV_noinc
+#endif
+#define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
+#define Perl_newRV_noinc DPPP_(my_newRV_noinc)
+
+#if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
+SV *
+DPPP_(my_newRV_noinc)(SV *sv)
+{
+ SV *rv = (SV *)newRV(sv);
+ SvREFCNT_dec(sv);
+ return rv;
+}
+#endif
+#endif
+
+/* Hint: newCONSTSUB
+ * Returns a CV* as of perl-5.7.1. This return value is not supported
+ * by Devel::PPPort.
+ */
+
+/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
+#if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
+#if defined(NEED_newCONSTSUB)
+static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
+static
+#else
+extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
+#endif
+
+#ifdef newCONSTSUB
+# undef newCONSTSUB
+#endif
+#define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
+#define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
+
+#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
+
+/* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */
+/* (There's no PL_parser in perl < 5.005, so this is completely safe) */
+#define D_PPP_PL_copline PL_copline
+
+void
+DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv)
+{
+ U32 oldhints = PL_hints;
+ HV *old_cop_stash = PL_curcop->cop_stash;
+ HV *old_curstash = PL_curstash;
+ line_t oldline = PL_curcop->cop_line;
+ PL_curcop->cop_line = D_PPP_PL_copline;
+
+ PL_hints &= ~HINT_BLOCK_SCOPE;
+ if (stash)
+ PL_curstash = PL_curcop->cop_stash = stash;
+
+ newSUB(
+
+#if (PERL_BCDVERSION < 0x5003022)
+ start_subparse(),
+#elif (PERL_BCDVERSION == 0x5003022)
+ start_subparse(0),
+#else /* 5.003_23 onwards */
+ start_subparse(FALSE, 0),
+#endif
+
+ newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
+ newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
+ newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
+ );
+
+ PL_hints = oldhints;
+ PL_curcop->cop_stash = old_cop_stash;
+ PL_curstash = old_curstash;
+ PL_curcop->cop_line = oldline;
+}
+#endif
+#endif
+
+/*
+ * Boilerplate macros for initializing and accessing interpreter-local
+ * data from C. All statics in extensions should be reworked to use
+ * this, if you want to make the extension thread-safe. See ext/re/re.xs
+ * for an example of the use of these macros.
+ *
+ * Code that uses these macros is responsible for the following:
+ * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
+ * 2. Declare a typedef named my_cxt_t that is a structure that contains
+ * all the data that needs to be interpreter-local.
+ * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
+ * 4. Use the MY_CXT_INIT macro such that it is called exactly once
+ * (typically put in the BOOT: section).
+ * 5. Use the members of the my_cxt_t structure everywhere as
+ * MY_CXT.member.
+ * 6. Use the dMY_CXT macro (a declaration) in all the functions that
+ * access MY_CXT.
+ */
+
+#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
+ defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
+
+#ifndef START_MY_CXT
+
+/* This must appear in all extensions that define a my_cxt_t structure,
+ * right after the definition (i.e. at file scope). The non-threads
+ * case below uses it to declare the data as static. */
+#define START_MY_CXT
+
+#if (PERL_BCDVERSION < 0x5004068)
+/* Fetches the SV that keeps the per-interpreter data. */
+#define dMY_CXT_SV \
+ SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
+#else /* >= perl5.004_68 */
+#define dMY_CXT_SV \
+ SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
+ sizeof(MY_CXT_KEY)-1, TRUE)
+#endif /* < perl5.004_68 */
+
+/* This declaration should be used within all functions that use the
+ * interpreter-local data. */
+#define dMY_CXT \
+ dMY_CXT_SV; \
+ my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
+
+/* Creates and zeroes the per-interpreter data.
+ * (We allocate my_cxtp in a Perl SV so that it will be released when
+ * the interpreter goes away.) */
+#define MY_CXT_INIT \
+ dMY_CXT_SV; \
+ /* newSV() allocates one more than needed */ \
+ my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
+ Zero(my_cxtp, 1, my_cxt_t); \
+ sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
+
+/* This macro must be used to access members of the my_cxt_t structure.
+ * e.g. MYCXT.some_data */
+#define MY_CXT (*my_cxtp)
+
+/* Judicious use of these macros can reduce the number of times dMY_CXT
+ * is used. Use is similar to pTHX, aTHX etc. */
+#define pMY_CXT my_cxt_t *my_cxtp
+#define pMY_CXT_ pMY_CXT,
+#define _pMY_CXT ,pMY_CXT
+#define aMY_CXT my_cxtp
+#define aMY_CXT_ aMY_CXT,
+#define _aMY_CXT ,aMY_CXT
+
+#endif /* START_MY_CXT */
+
+#ifndef MY_CXT_CLONE
+/* Clones the per-interpreter data. */
+#define MY_CXT_CLONE \
+ dMY_CXT_SV; \
+ my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
+ Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
+ sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
+#endif
+
+#else /* single interpreter */
+
+#ifndef START_MY_CXT
+
+#define START_MY_CXT static my_cxt_t my_cxt;
+#define dMY_CXT_SV dNOOP
+#define dMY_CXT dNOOP
+#define MY_CXT_INIT NOOP
+#define MY_CXT my_cxt
+
+#define pMY_CXT void
+#define pMY_CXT_
+#define _pMY_CXT
+#define aMY_CXT
+#define aMY_CXT_
+#define _aMY_CXT
+
+#endif /* START_MY_CXT */
+
+#ifndef MY_CXT_CLONE
+#define MY_CXT_CLONE NOOP
+#endif
+
+#endif
+
+#ifndef IVdf
+# if IVSIZE == LONGSIZE
+# define IVdf "ld"
+# define UVuf "lu"
+# define UVof "lo"
+# define UVxf "lx"
+# define UVXf "lX"
+# elif IVSIZE == INTSIZE
+# define IVdf "d"
+# define UVuf "u"
+# define UVof "o"
+# define UVxf "x"
+# define UVXf "X"
+# else
+# error "cannot define IV/UV formats"
+# endif
+#endif
+
+#ifndef NVef
+# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
+ defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
+ /* Not very likely, but let's try anyway. */
+# define NVef PERL_PRIeldbl
+# define NVff PERL_PRIfldbl
+# define NVgf PERL_PRIgldbl
+# else
+# define NVef "e"
+# define NVff "f"
+# define NVgf "g"
+# endif
+#endif
+
+#ifndef SvREFCNT_inc
+# ifdef PERL_USE_GCC_BRACE_GROUPS
+# define SvREFCNT_inc(sv) \
+ ({ \
+ SV * const _sv = (SV*)(sv); \
+ if (_sv) \
+ (SvREFCNT(_sv))++; \
+ _sv; \
+ })
+# else
+# define SvREFCNT_inc(sv) \
+ ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
+# endif
+#endif
+
+#ifndef SvREFCNT_inc_simple
+# ifdef PERL_USE_GCC_BRACE_GROUPS
+# define SvREFCNT_inc_simple(sv) \
+ ({ \
+ if (sv) \
+ (SvREFCNT(sv))++; \
+ (SV *)(sv); \
+ })
+# else
+# define SvREFCNT_inc_simple(sv) \
+ ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
+# endif
+#endif
+
+#ifndef SvREFCNT_inc_NN
+# ifdef PERL_USE_GCC_BRACE_GROUPS
+# define SvREFCNT_inc_NN(sv) \
+ ({ \
+ SV * const _sv = (SV*)(sv); \
+ SvREFCNT(_sv)++; \
+ _sv; \
+ })
+# else
+# define SvREFCNT_inc_NN(sv) \
+ (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
+# endif
+#endif
+
+#ifndef SvREFCNT_inc_void
+# ifdef PERL_USE_GCC_BRACE_GROUPS
+# define SvREFCNT_inc_void(sv) \
+ ({ \
+ SV * const _sv = (SV*)(sv); \
+ if (_sv) \
+ (void)(SvREFCNT(_sv)++); \
+ })
+# else
+# define SvREFCNT_inc_void(sv) \
+ (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
+# endif
+#endif
+#ifndef SvREFCNT_inc_simple_void
+# define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
+#endif
+
+#ifndef SvREFCNT_inc_simple_NN
+# define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
+#endif
+
+#ifndef SvREFCNT_inc_void_NN
+# define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
+#endif
+
+#ifndef SvREFCNT_inc_simple_void_NN
+# define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
+#endif
+
+#ifndef newSV_type
+
+#if defined(NEED_newSV_type)
+static SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
+static
+#else
+extern SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
+#endif
+
+#ifdef newSV_type
+# undef newSV_type
+#endif
+#define newSV_type(a) DPPP_(my_newSV_type)(aTHX_ a)
+#define Perl_newSV_type DPPP_(my_newSV_type)
+
+#if defined(NEED_newSV_type) || defined(NEED_newSV_type_GLOBAL)
+
+SV*
+DPPP_(my_newSV_type)(pTHX_ svtype const t)
+{
+ SV* const sv = newSV(0);
+ sv_upgrade(sv, t);
+ return sv;
+}
+
+#endif
+
+#endif
+
+#if (PERL_BCDVERSION < 0x5006000)
+# define D_PPP_CONSTPV_ARG(x) ((char *) (x))
+#else
+# define D_PPP_CONSTPV_ARG(x) (x)
+#endif
+#ifndef newSVpvn
+# define newSVpvn(data,len) ((data) \
+ ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
+ : newSV(0))
+#endif
+#ifndef newSVpvn_utf8
+# define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
+#endif
+#ifndef SVf_UTF8
+# define SVf_UTF8 0
+#endif
+
+#ifndef newSVpvn_flags
+
+#if defined(NEED_newSVpvn_flags)
+static SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
+static
+#else
+extern SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
+#endif
+
+#ifdef newSVpvn_flags
+# undef newSVpvn_flags
+#endif
+#define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c)
+#define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags)
+
+#if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
+
+SV *
+DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags)
+{
+ SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len);
+ SvFLAGS(sv) |= (flags & SVf_UTF8);
+ return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
+}
+
+#endif
+
+#endif
+
+/* Backwards compatibility stuff... :-( */
+#if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen)
+# define NEED_sv_2pv_flags
+#endif
+#if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL)
+# define NEED_sv_2pv_flags_GLOBAL
+#endif
+
+/* Hint: sv_2pv_nolen
+ * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen().
+ */
+#ifndef sv_2pv_nolen
+# define sv_2pv_nolen(sv) SvPV_nolen(sv)
+#endif
+
+#ifdef SvPVbyte
+
+/* Hint: SvPVbyte
+ * Does not work in perl-5.6.1, ppport.h implements a version
+ * borrowed from perl-5.7.3.
+ */
+
+#if (PERL_BCDVERSION < 0x5007000)
+
+#if defined(NEED_sv_2pvbyte)
+static char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
+static
+#else
+extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
+#endif
+
+#ifdef sv_2pvbyte
+# undef sv_2pvbyte
+#endif
+#define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
+#define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
+
+#if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
+
+char *
+DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp)
+{
+ sv_utf8_downgrade(sv,0);
+ return SvPV(sv,*lp);
+}
+
+#endif
+
+/* Hint: sv_2pvbyte
+ * Use the SvPVbyte() macro instead of sv_2pvbyte().
+ */
+
+#undef SvPVbyte
+
+#define SvPVbyte(sv, lp) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
+ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
+
+#endif
+
+#else
+
+# define SvPVbyte SvPV
+# define sv_2pvbyte sv_2pv
+
+#endif
+#ifndef sv_2pvbyte_nolen
+# define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
+#endif
+
+/* Hint: sv_pvn
+ * Always use the SvPV() macro instead of sv_pvn().
+ */
+
+/* Hint: sv_pvn_force
+ * Always use the SvPV_force() macro instead of sv_pvn_force().
+ */
+
+/* If these are undefined, they're not handled by the core anyway */
+#ifndef SV_IMMEDIATE_UNREF
+# define SV_IMMEDIATE_UNREF 0
+#endif
+
+#ifndef SV_GMAGIC
+# define SV_GMAGIC 0
+#endif
+
+#ifndef SV_COW_DROP_PV
+# define SV_COW_DROP_PV 0
+#endif
+
+#ifndef SV_UTF8_NO_ENCODING
+# define SV_UTF8_NO_ENCODING 0
+#endif
+
+#ifndef SV_NOSTEAL
+# define SV_NOSTEAL 0
+#endif
+
+#ifndef SV_CONST_RETURN
+# define SV_CONST_RETURN 0
+#endif
+
+#ifndef SV_MUTABLE_RETURN
+# define SV_MUTABLE_RETURN 0
+#endif
+
+#ifndef SV_SMAGIC
+# define SV_SMAGIC 0
+#endif
+
+#ifndef SV_HAS_TRAILING_NUL
+# define SV_HAS_TRAILING_NUL 0
+#endif
+
+#ifndef SV_COW_SHARED_HASH_KEYS
+# define SV_COW_SHARED_HASH_KEYS 0
+#endif
+
+#if (PERL_BCDVERSION < 0x5007002)
+
+#if defined(NEED_sv_2pv_flags)
+static char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
+static
+#else
+extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
+#endif
+
+#ifdef sv_2pv_flags
+# undef sv_2pv_flags
+#endif
+#define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
+#define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
+
+#if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
+
+char *
+DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
+{
+ STRLEN n_a = (STRLEN) flags;
+ return sv_2pv(sv, lp ? lp : &n_a);
+}
+
+#endif
+
+#if defined(NEED_sv_pvn_force_flags)
+static char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
+static
+#else
+extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
+#endif
+
+#ifdef sv_pvn_force_flags
+# undef sv_pvn_force_flags
+#endif
+#define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
+#define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
+
+#if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
+
+char *
+DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
+{
+ STRLEN n_a = (STRLEN) flags;
+ return sv_pvn_force(sv, lp ? lp : &n_a);
+}
+
+#endif
+
+#endif
+
+#if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
+# define DPPP_SVPV_NOLEN_LP_ARG &PL_na
+#else
+# define DPPP_SVPV_NOLEN_LP_ARG 0
+#endif
+#ifndef SvPV_const
+# define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
+#endif
+
+#ifndef SvPV_mutable
+# define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
+#endif
+#ifndef SvPV_flags
+# define SvPV_flags(sv, lp, flags) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
+#endif
+#ifndef SvPV_flags_const
+# define SvPV_flags_const(sv, lp, flags) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
+ (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
+#endif
+#ifndef SvPV_flags_const_nolen
+# define SvPV_flags_const_nolen(sv, flags) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? SvPVX_const(sv) : \
+ (const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
+#endif
+#ifndef SvPV_flags_mutable
+# define SvPV_flags_mutable(sv, lp, flags) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
+ sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
+#endif
+#ifndef SvPV_force
+# define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
+#endif
+
+#ifndef SvPV_force_nolen
+# define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
+#endif
+
+#ifndef SvPV_force_mutable
+# define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
+#endif
+
+#ifndef SvPV_force_nomg
+# define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
+#endif
+
+#ifndef SvPV_force_nomg_nolen
+# define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
+#endif
+#ifndef SvPV_force_flags
+# define SvPV_force_flags(sv, lp, flags) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
+ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
+#endif
+#ifndef SvPV_force_flags_nolen
+# define SvPV_force_flags_nolen(sv, flags) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
+ ? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags))
+#endif
+#ifndef SvPV_force_flags_mutable
+# define SvPV_force_flags_mutable(sv, lp, flags) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
+ ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
+ : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
+#endif
+#ifndef SvPV_nolen
+# define SvPV_nolen(sv) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
+#endif
+#ifndef SvPV_nolen_const
+# define SvPV_nolen_const(sv) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
+#endif
+#ifndef SvPV_nomg
+# define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
+#endif
+
+#ifndef SvPV_nomg_const
+# define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
+#endif
+
+#ifndef SvPV_nomg_const_nolen
+# define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
+#endif
+
+#ifndef SvPV_nomg_nolen
+# define SvPV_nomg_nolen(sv) ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, 0))
+#endif
+#ifndef SvPV_renew
+# define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \
+ SvPV_set((sv), (char *) saferealloc( \
+ (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
+ } STMT_END
+#endif
+#ifndef SvMAGIC_set
+# define SvMAGIC_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
+ (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
+#endif
+
+#if (PERL_BCDVERSION < 0x5009003)
+#ifndef SvPVX_const
+# define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
+#endif
+
+#ifndef SvPVX_mutable
+# define SvPVX_mutable(sv) (0 + SvPVX(sv))
+#endif
+#ifndef SvRV_set
+# define SvRV_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
+ (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
+#endif
+
+#else
+#ifndef SvPVX_const
+# define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
+#endif
+
+#ifndef SvPVX_mutable
+# define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
+#endif
+#ifndef SvRV_set
+# define SvRV_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
+ ((sv)->sv_u.svu_rv = (val)); } STMT_END
+#endif
+
+#endif
+#ifndef SvSTASH_set
+# define SvSTASH_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
+ (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
+#endif
+
+#if (PERL_BCDVERSION < 0x5004000)
+#ifndef SvUV_set
+# define SvUV_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
+ (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
+#endif
+
+#else
+#ifndef SvUV_set
+# define SvUV_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
+ (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
+#endif
+
+#endif
+
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
+#if defined(NEED_vnewSVpvf)
+static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
+static
+#else
+extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
+#endif
+
+#ifdef vnewSVpvf
+# undef vnewSVpvf
+#endif
+#define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
+#define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
+
+#if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
+
+SV *
+DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
+{
+ register SV *sv = newSV(0);
+ sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
+ return sv;
+}
+
+#endif
+#endif
+
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
+# define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
+#endif
+
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
+# define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
+#endif
+
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
+#if defined(NEED_sv_catpvf_mg)
+static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
+static
+#else
+extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
+#endif
+
+#define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
+
+#if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
+
+void
+DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
+{
+ va_list args;
+ va_start(args, pat);
+ sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ SvSETMAGIC(sv);
+ va_end(args);
+}
+
+#endif
+#endif
+
+#ifdef PERL_IMPLICIT_CONTEXT
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
+#if defined(NEED_sv_catpvf_mg_nocontext)
+static void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
+static
+#else
+extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
+#endif
+
+#define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
+#define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
+
+#if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
+
+void
+DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
+{
+ dTHX;
+ va_list args;
+ va_start(args, pat);
+ sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ SvSETMAGIC(sv);
+ va_end(args);
+}
+
+#endif
+#endif
+#endif
+
+/* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
+#ifndef sv_catpvf_mg
+# ifdef PERL_IMPLICIT_CONTEXT
+# define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
+# else
+# define sv_catpvf_mg Perl_sv_catpvf_mg
+# endif
+#endif
+
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg)
+# define sv_vcatpvf_mg(sv, pat, args) \
+ STMT_START { \
+ sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
+ SvSETMAGIC(sv); \
+ } STMT_END
+#endif
+
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
+#if defined(NEED_sv_setpvf_mg)
+static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
+static
+#else
+extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
+#endif
+
+#define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
+
+#if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
+
+void
+DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
+{
+ va_list args;
+ va_start(args, pat);
+ sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ SvSETMAGIC(sv);
+ va_end(args);
+}
+
+#endif
+#endif
+
+#ifdef PERL_IMPLICIT_CONTEXT
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
+#if defined(NEED_sv_setpvf_mg_nocontext)
+static void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
+static
+#else
+extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
+#endif
+
+#define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
+#define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
+
+#if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
+
+void
+DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
+{
+ dTHX;
+ va_list args;
+ va_start(args, pat);
+ sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ SvSETMAGIC(sv);
+ va_end(args);
+}
+
+#endif
+#endif
+#endif
+
+/* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
+#ifndef sv_setpvf_mg
+# ifdef PERL_IMPLICIT_CONTEXT
+# define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
+# else
+# define sv_setpvf_mg Perl_sv_setpvf_mg
+# endif
+#endif
+
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg)
+# define sv_vsetpvf_mg(sv, pat, args) \
+ STMT_START { \
+ sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
+ SvSETMAGIC(sv); \
+ } STMT_END
+#endif
+
+/* Hint: newSVpvn_share
+ * The SVs created by this function only mimic the behaviour of
+ * shared PVs without really being shared. Only use if you know
+ * what you're doing.
+ */
+
+#ifndef newSVpvn_share
+
+#if defined(NEED_newSVpvn_share)
+static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
+static
+#else
+extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
+#endif
+
+#ifdef newSVpvn_share
+# undef newSVpvn_share
+#endif
+#define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
+#define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
+
+#if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
+
+SV *
+DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash)
+{
+ SV *sv;
+ if (len < 0)
+ len = -len;
+ if (!hash)
+ PERL_HASH(hash, (char*) src, len);
+ sv = newSVpvn((char *) src, len);
+ sv_upgrade(sv, SVt_PVIV);
+ SvIVX(sv) = hash;
+ SvREADONLY_on(sv);
+ SvPOK_on(sv);
+ return sv;
+}
+
+#endif
+
+#endif
+#ifndef SvSHARED_HASH
+# define SvSHARED_HASH(sv) (0 + SvUVX(sv))
+#endif
+#ifndef HvNAME_get
+# define HvNAME_get(hv) HvNAME(hv)
+#endif
+#ifndef HvNAMELEN_get
+# define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
+#endif
+#ifndef GvSVn
+# define GvSVn(gv) GvSV(gv)
+#endif
+
+#ifndef isGV_with_GP
+# define isGV_with_GP(gv) isGV(gv)
+#endif
+
+#ifndef gv_fetchpvn_flags
+# define gv_fetchpvn_flags(name, len, flags, svt) gv_fetchpv(name, flags, svt)
+#endif
+
+#ifndef gv_fetchsv
+# define gv_fetchsv(name, flags, svt) gv_fetchpv(SvPV_nolen_const(name), flags, svt)
+#endif
+#ifndef get_cvn_flags
+# define get_cvn_flags(name, namelen, flags) get_cv(name, flags)
+#endif
+#ifndef WARN_ALL
+# define WARN_ALL 0
+#endif
+
+#ifndef WARN_CLOSURE
+# define WARN_CLOSURE 1
+#endif
+
+#ifndef WARN_DEPRECATED
+# define WARN_DEPRECATED 2
+#endif
+
+#ifndef WARN_EXITING
+# define WARN_EXITING 3
+#endif
+
+#ifndef WARN_GLOB
+# define WARN_GLOB 4
+#endif
+
+#ifndef WARN_IO
+# define WARN_IO 5
+#endif
+
+#ifndef WARN_CLOSED
+# define WARN_CLOSED 6
+#endif
+
+#ifndef WARN_EXEC
+# define WARN_EXEC 7
+#endif
+
+#ifndef WARN_LAYER
+# define WARN_LAYER 8
+#endif
+
+#ifndef WARN_NEWLINE
+# define WARN_NEWLINE 9
+#endif
+
+#ifndef WARN_PIPE
+# define WARN_PIPE 10
+#endif
+
+#ifndef WARN_UNOPENED
+# define WARN_UNOPENED 11
+#endif
+
+#ifndef WARN_MISC
+# define WARN_MISC 12
+#endif
+
+#ifndef WARN_NUMERIC
+# define WARN_NUMERIC 13
+#endif
+
+#ifndef WARN_ONCE
+# define WARN_ONCE 14
+#endif
+
+#ifndef WARN_OVERFLOW
+# define WARN_OVERFLOW 15
+#endif
+
+#ifndef WARN_PACK
+# define WARN_PACK 16
+#endif
+
+#ifndef WARN_PORTABLE
+# define WARN_PORTABLE 17
+#endif
+
+#ifndef WARN_RECURSION
+# define WARN_RECURSION 18
+#endif
+
+#ifndef WARN_REDEFINE
+# define WARN_REDEFINE 19
+#endif
+
+#ifndef WARN_REGEXP
+# define WARN_REGEXP 20
+#endif
+
+#ifndef WARN_SEVERE
+# define WARN_SEVERE 21
+#endif
+
+#ifndef WARN_DEBUGGING
+# define WARN_DEBUGGING 22
+#endif
+
+#ifndef WARN_INPLACE
+# define WARN_INPLACE 23
+#endif
+
+#ifndef WARN_INTERNAL
+# define WARN_INTERNAL 24
+#endif
+
+#ifndef WARN_MALLOC
+# define WARN_MALLOC 25
+#endif
+
+#ifndef WARN_SIGNAL
+# define WARN_SIGNAL 26
+#endif
+
+#ifndef WARN_SUBSTR
+# define WARN_SUBSTR 27
+#endif
+
+#ifndef WARN_SYNTAX
+# define WARN_SYNTAX 28
+#endif
+
+#ifndef WARN_AMBIGUOUS
+# define WARN_AMBIGUOUS 29
+#endif
+
+#ifndef WARN_BAREWORD
+# define WARN_BAREWORD 30
+#endif
+
+#ifndef WARN_DIGIT
+# define WARN_DIGIT 31
+#endif
+
+#ifndef WARN_PARENTHESIS
+# define WARN_PARENTHESIS 32
+#endif
+
+#ifndef WARN_PRECEDENCE
+# define WARN_PRECEDENCE 33
+#endif
+
+#ifndef WARN_PRINTF
+# define WARN_PRINTF 34
+#endif
+
+#ifndef WARN_PROTOTYPE
+# define WARN_PROTOTYPE 35
+#endif
+
+#ifndef WARN_QW
+# define WARN_QW 36
+#endif
+
+#ifndef WARN_RESERVED
+# define WARN_RESERVED 37
+#endif
+
+#ifndef WARN_SEMICOLON
+# define WARN_SEMICOLON 38
+#endif
+
+#ifndef WARN_TAINT
+# define WARN_TAINT 39
+#endif
+
+#ifndef WARN_THREADS
+# define WARN_THREADS 40
+#endif
+
+#ifndef WARN_UNINITIALIZED
+# define WARN_UNINITIALIZED 41
+#endif
+
+#ifndef WARN_UNPACK
+# define WARN_UNPACK 42
+#endif
+
+#ifndef WARN_UNTIE
+# define WARN_UNTIE 43
+#endif
+
+#ifndef WARN_UTF8
+# define WARN_UTF8 44
+#endif
+
+#ifndef WARN_VOID
+# define WARN_VOID 45
+#endif
+
+#ifndef WARN_ASSERTIONS
+# define WARN_ASSERTIONS 46
+#endif
+#ifndef packWARN
+# define packWARN(a) (a)
+#endif
+
+#ifndef ckWARN
+# ifdef G_WARN_ON
+# define ckWARN(a) (PL_dowarn & G_WARN_ON)
+# else
+# define ckWARN(a) PL_dowarn
+# endif
+#endif
+
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
+#if defined(NEED_warner)
+static void DPPP_(my_warner)(U32 err, const char *pat, ...);
+static
+#else
+extern void DPPP_(my_warner)(U32 err, const char *pat, ...);
+#endif
+
+#define Perl_warner DPPP_(my_warner)
+
+#if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
+
+void
+DPPP_(my_warner)(U32 err, const char *pat, ...)
+{
+ SV *sv;
+ va_list args;
+
+ PERL_UNUSED_ARG(err);
+
+ va_start(args, pat);
+ sv = vnewSVpvf(pat, &args);
+ va_end(args);
+ sv_2mortal(sv);
+ warn("%s", SvPV_nolen(sv));
+}
+
+#define warner Perl_warner
+
+#define Perl_warner_nocontext Perl_warner
+
+#endif
+#endif
+
+/* concatenating with "" ensures that only literal strings are accepted as argument
+ * note that STR_WITH_LEN() can't be used as argument to macros or functions that
+ * under some configurations might be macros
+ */
+#ifndef STR_WITH_LEN
+# define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
+#endif
+#ifndef newSVpvs
+# define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
+#endif
+
+#ifndef newSVpvs_flags
+# define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
+#endif
+
+#ifndef newSVpvs_share
+# define newSVpvs_share(str) newSVpvn_share(str "", sizeof(str) - 1, 0)
+#endif
+
+#ifndef sv_catpvs
+# define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
+#endif
+
+#ifndef sv_setpvs
+# define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
+#endif
+
+#ifndef hv_fetchs
+# define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
+#endif
+
+#ifndef hv_stores
+# define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
+#endif
+#ifndef gv_fetchpvs
+# define gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt)
+#endif
+
+#ifndef gv_stashpvs
+# define gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags)
+#endif
+#ifndef get_cvs
+# define get_cvs(name, flags) get_cvn_flags(name "", sizeof(name)-1, flags)
+#endif
+#ifndef SvGETMAGIC
+# define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
+#endif
+#ifndef PERL_MAGIC_sv
+# define PERL_MAGIC_sv '\0'
+#endif
+
+#ifndef PERL_MAGIC_overload
+# define PERL_MAGIC_overload 'A'
+#endif
+
+#ifndef PERL_MAGIC_overload_elem
+# define PERL_MAGIC_overload_elem 'a'
+#endif
+
+#ifndef PERL_MAGIC_overload_table
+# define PERL_MAGIC_overload_table 'c'
+#endif
+
+#ifndef PERL_MAGIC_bm
+# define PERL_MAGIC_bm 'B'
+#endif
+
+#ifndef PERL_MAGIC_regdata
+# define PERL_MAGIC_regdata 'D'
+#endif
+
+#ifndef PERL_MAGIC_regdatum
+# define PERL_MAGIC_regdatum 'd'
+#endif
+
+#ifndef PERL_MAGIC_env
+# define PERL_MAGIC_env 'E'
+#endif
+
+#ifndef PERL_MAGIC_envelem
+# define PERL_MAGIC_envelem 'e'
+#endif
+
+#ifndef PERL_MAGIC_fm
+# define PERL_MAGIC_fm 'f'
+#endif
+
+#ifndef PERL_MAGIC_regex_global
+# define PERL_MAGIC_regex_global 'g'
+#endif
+
+#ifndef PERL_MAGIC_isa
+# define PERL_MAGIC_isa 'I'
+#endif
+
+#ifndef PERL_MAGIC_isaelem
+# define PERL_MAGIC_isaelem 'i'
+#endif
+
+#ifndef PERL_MAGIC_nkeys
+# define PERL_MAGIC_nkeys 'k'
+#endif
+
+#ifndef PERL_MAGIC_dbfile
+# define PERL_MAGIC_dbfile 'L'
+#endif
+
+#ifndef PERL_MAGIC_dbline
+# define PERL_MAGIC_dbline 'l'
+#endif
+
+#ifndef PERL_MAGIC_mutex
+# define PERL_MAGIC_mutex 'm'
+#endif
+
+#ifndef PERL_MAGIC_shared
+# define PERL_MAGIC_shared 'N'
+#endif
+
+#ifndef PERL_MAGIC_shared_scalar
+# define PERL_MAGIC_shared_scalar 'n'
+#endif
+
+#ifndef PERL_MAGIC_collxfrm
+# define PERL_MAGIC_collxfrm 'o'
+#endif
+
+#ifndef PERL_MAGIC_tied
+# define PERL_MAGIC_tied 'P'
+#endif
+
+#ifndef PERL_MAGIC_tiedelem
+# define PERL_MAGIC_tiedelem 'p'
+#endif
+
+#ifndef PERL_MAGIC_tiedscalar
+# define PERL_MAGIC_tiedscalar 'q'
+#endif
+
+#ifndef PERL_MAGIC_qr
+# define PERL_MAGIC_qr 'r'
+#endif
+
+#ifndef PERL_MAGIC_sig
+# define PERL_MAGIC_sig 'S'
+#endif
+
+#ifndef PERL_MAGIC_sigelem
+# define PERL_MAGIC_sigelem 's'
+#endif
+
+#ifndef PERL_MAGIC_taint
+# define PERL_MAGIC_taint 't'
+#endif
+
+#ifndef PERL_MAGIC_uvar
+# define PERL_MAGIC_uvar 'U'
+#endif
+
+#ifndef PERL_MAGIC_uvar_elem
+# define PERL_MAGIC_uvar_elem 'u'
+#endif
+
+#ifndef PERL_MAGIC_vstring
+# define PERL_MAGIC_vstring 'V'
+#endif
+
+#ifndef PERL_MAGIC_vec
+# define PERL_MAGIC_vec 'v'
+#endif
+
+#ifndef PERL_MAGIC_utf8
+# define PERL_MAGIC_utf8 'w'
+#endif
+
+#ifndef PERL_MAGIC_substr
+# define PERL_MAGIC_substr 'x'
+#endif
+
+#ifndef PERL_MAGIC_defelem
+# define PERL_MAGIC_defelem 'y'
+#endif
+
+#ifndef PERL_MAGIC_glob
+# define PERL_MAGIC_glob '*'
+#endif
+
+#ifndef PERL_MAGIC_arylen
+# define PERL_MAGIC_arylen '#'
+#endif
+
+#ifndef PERL_MAGIC_pos
+# define PERL_MAGIC_pos '.'
+#endif
+
+#ifndef PERL_MAGIC_backref
+# define PERL_MAGIC_backref '<'
+#endif
+
+#ifndef PERL_MAGIC_ext
+# define PERL_MAGIC_ext '~'
+#endif
+
+/* That's the best we can do... */
+#ifndef sv_catpvn_nomg
+# define sv_catpvn_nomg sv_catpvn
+#endif
+
+#ifndef sv_catsv_nomg
+# define sv_catsv_nomg sv_catsv
+#endif
+
+#ifndef sv_setsv_nomg
+# define sv_setsv_nomg sv_setsv
+#endif
+
+#ifndef sv_pvn_nomg
+# define sv_pvn_nomg sv_pvn
+#endif
+
+#ifndef SvIV_nomg
+# define SvIV_nomg SvIV
+#endif
+
+#ifndef SvUV_nomg
+# define SvUV_nomg SvUV
+#endif
+
+#ifndef sv_catpv_mg
+# define sv_catpv_mg(sv, ptr) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_catpv(TeMpSv,ptr); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+
+#ifndef sv_catpvn_mg
+# define sv_catpvn_mg(sv, ptr, len) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_catpvn(TeMpSv,ptr,len); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+
+#ifndef sv_catsv_mg
+# define sv_catsv_mg(dsv, ssv) \
+ STMT_START { \
+ SV *TeMpSv = dsv; \
+ sv_catsv(TeMpSv,ssv); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+
+#ifndef sv_setiv_mg
+# define sv_setiv_mg(sv, i) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_setiv(TeMpSv,i); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+
+#ifndef sv_setnv_mg
+# define sv_setnv_mg(sv, num) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_setnv(TeMpSv,num); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+
+#ifndef sv_setpv_mg
+# define sv_setpv_mg(sv, ptr) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_setpv(TeMpSv,ptr); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+
+#ifndef sv_setpvn_mg
+# define sv_setpvn_mg(sv, ptr, len) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_setpvn(TeMpSv,ptr,len); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+
+#ifndef sv_setsv_mg
+# define sv_setsv_mg(dsv, ssv) \
+ STMT_START { \
+ SV *TeMpSv = dsv; \
+ sv_setsv(TeMpSv,ssv); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+
+#ifndef sv_setuv_mg
+# define sv_setuv_mg(sv, i) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_setuv(TeMpSv,i); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+
+#ifndef sv_usepvn_mg
+# define sv_usepvn_mg(sv, ptr, len) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_usepvn(TeMpSv,ptr,len); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+#ifndef SvVSTRING_mg
+# define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
+#endif
+
+/* Hint: sv_magic_portable
+ * This is a compatibility function that is only available with
+ * Devel::PPPort. It is NOT in the perl core.
+ * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when
+ * it is being passed a name pointer with namlen == 0. In that
+ * case, perl 5.8.0 and later store the pointer, not a copy of it.
+ * The compatibility can be provided back to perl 5.004. With
+ * earlier versions, the code will not compile.
+ */
+
+#if (PERL_BCDVERSION < 0x5004000)
+
+ /* code that uses sv_magic_portable will not compile */
+
+#elif (PERL_BCDVERSION < 0x5008000)
+
+# define sv_magic_portable(sv, obj, how, name, namlen) \
+ STMT_START { \
+ SV *SvMp_sv = (sv); \
+ char *SvMp_name = (char *) (name); \
+ I32 SvMp_namlen = (namlen); \
+ if (SvMp_name && SvMp_namlen == 0) \
+ { \
+ MAGIC *mg; \
+ sv_magic(SvMp_sv, obj, how, 0, 0); \
+ mg = SvMAGIC(SvMp_sv); \
+ mg->mg_len = -42; /* XXX: this is the tricky part */ \
+ mg->mg_ptr = SvMp_name; \
+ } \
+ else \
+ { \
+ sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
+ } \
+ } STMT_END
+
+#else
+
+# define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
+
+#endif
+
+#ifdef USE_ITHREADS
+#ifndef CopFILE
+# define CopFILE(c) ((c)->cop_file)
+#endif
+
+#ifndef CopFILEGV
+# define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
+#endif
+
+#ifndef CopFILE_set
+# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
+#endif
+
+#ifndef CopFILESV
+# define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
+#endif
+
+#ifndef CopFILEAV
+# define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
+#endif
+
+#ifndef CopSTASHPV
+# define CopSTASHPV(c) ((c)->cop_stashpv)
+#endif
+
+#ifndef CopSTASHPV_set
+# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
+#endif
+
+#ifndef CopSTASH
+# define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
+#endif
+
+#ifndef CopSTASH_set
+# define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
+#endif
+
+#ifndef CopSTASH_eq
+# define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
+ || (CopSTASHPV(c) && HvNAME(hv) \
+ && strEQ(CopSTASHPV(c), HvNAME(hv)))))
+#endif
+
+#else
+#ifndef CopFILEGV
+# define CopFILEGV(c) ((c)->cop_filegv)
+#endif
+
+#ifndef CopFILEGV_set
+# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
+#endif
+
+#ifndef CopFILE_set
+# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
+#endif
+
+#ifndef CopFILESV
+# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
+#endif
+
+#ifndef CopFILEAV
+# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
+#endif
+
+#ifndef CopFILE
+# define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
+#endif
+
+#ifndef CopSTASH
+# define CopSTASH(c) ((c)->cop_stash)
+#endif
+
+#ifndef CopSTASH_set
+# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
+#endif
+
+#ifndef CopSTASHPV
+# define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
+#endif
+
+#ifndef CopSTASHPV_set
+# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
+#endif
+
+#ifndef CopSTASH_eq
+# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
+#endif
+
+#endif /* USE_ITHREADS */
+#ifndef IN_PERL_COMPILETIME
+# define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
+#endif
+
+#ifndef IN_LOCALE_RUNTIME
+# define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
+#endif
+
+#ifndef IN_LOCALE_COMPILETIME
+# define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
+#endif
+
+#ifndef IN_LOCALE
+# define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
+#endif
+#ifndef IS_NUMBER_IN_UV
+# define IS_NUMBER_IN_UV 0x01
+#endif
+
+#ifndef IS_NUMBER_GREATER_THAN_UV_MAX
+# define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
+#endif
+
+#ifndef IS_NUMBER_NOT_INT
+# define IS_NUMBER_NOT_INT 0x04
+#endif
+
+#ifndef IS_NUMBER_NEG
+# define IS_NUMBER_NEG 0x08
+#endif
+
+#ifndef IS_NUMBER_INFINITY
+# define IS_NUMBER_INFINITY 0x10
+#endif
+
+#ifndef IS_NUMBER_NAN
+# define IS_NUMBER_NAN 0x20
+#endif
+#ifndef GROK_NUMERIC_RADIX
+# define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
+#endif
+#ifndef PERL_SCAN_GREATER_THAN_UV_MAX
+# define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
+#endif
+
+#ifndef PERL_SCAN_SILENT_ILLDIGIT
+# define PERL_SCAN_SILENT_ILLDIGIT 0x04
+#endif
+
+#ifndef PERL_SCAN_ALLOW_UNDERSCORES
+# define PERL_SCAN_ALLOW_UNDERSCORES 0x01
+#endif
+
+#ifndef PERL_SCAN_DISALLOW_PREFIX
+# define PERL_SCAN_DISALLOW_PREFIX 0x02
+#endif
+
+#ifndef grok_numeric_radix
+#if defined(NEED_grok_numeric_radix)
+static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
+static
+#else
+extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
+#endif
+
+#ifdef grok_numeric_radix
+# undef grok_numeric_radix
+#endif
+#define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
+#define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
+
+#if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
+bool
+DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
+{
+#ifdef USE_LOCALE_NUMERIC
+#ifdef PL_numeric_radix_sv
+ if (PL_numeric_radix_sv && IN_LOCALE) {
+ STRLEN len;
+ char* radix = SvPV(PL_numeric_radix_sv, len);
+ if (*sp + len <= send && memEQ(*sp, radix, len)) {
+ *sp += len;
+ return TRUE;
+ }
+ }
+#else
+ /* older perls don't have PL_numeric_radix_sv so the radix
+ * must manually be requested from locale.h
+ */
+#include <locale.h>
+ dTHR; /* needed for older threaded perls */
+ struct lconv *lc = localeconv();
+ char *radix = lc->decimal_point;
+ if (radix && IN_LOCALE) {
+ STRLEN len = strlen(radix);
+ if (*sp + len <= send && memEQ(*sp, radix, len)) {
+ *sp += len;
+ return TRUE;
+ }
+ }
+#endif
+#endif /* USE_LOCALE_NUMERIC */
+ /* always try "." if numeric radix didn't match because
+ * we may have data from different locales mixed */
+ if (*sp < send && **sp == '.') {
+ ++*sp;
+ return TRUE;
+ }
+ return FALSE;
+}
+#endif
+#endif
+
+#ifndef grok_number
+#if defined(NEED_grok_number)
+static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
+static
+#else
+extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
+#endif
+
+#ifdef grok_number
+# undef grok_number
+#endif
+#define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
+#define Perl_grok_number DPPP_(my_grok_number)
+
+#if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
+int
+DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
+{
+ const char *s = pv;
+ const char *send = pv + len;
+ const UV max_div_10 = UV_MAX / 10;
+ const char max_mod_10 = UV_MAX % 10;
+ int numtype = 0;
+ int sawinf = 0;
+ int sawnan = 0;
+
+ while (s < send && isSPACE(*s))
+ s++;
+ if (s == send) {
+ return 0;
+ } else if (*s == '-') {
+ s++;
+ numtype = IS_NUMBER_NEG;
+ }
+ else if (*s == '+')
+ s++;
+
+ if (s == send)
+ return 0;
+
+ /* next must be digit or the radix separator or beginning of infinity */
+ if (isDIGIT(*s)) {
+ /* UVs are at least 32 bits, so the first 9 decimal digits cannot
+ overflow. */
+ UV value = *s - '0';
+ /* This construction seems to be more optimiser friendly.
+ (without it gcc does the isDIGIT test and the *s - '0' separately)
+ With it gcc on arm is managing 6 instructions (6 cycles) per digit.
+ In theory the optimiser could deduce how far to unroll the loop
+ before checking for overflow. */
+ if (++s < send) {
+ int digit = *s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ if (++s < send) {
+ digit = *s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ if (++s < send) {
+ digit = *s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ if (++s < send) {
+ digit = *s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ if (++s < send) {
+ digit = *s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ if (++s < send) {
+ digit = *s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ if (++s < send) {
+ digit = *s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ if (++s < send) {
+ digit = *s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ if (++s < send) {
+ /* Now got 9 digits, so need to check
+ each time for overflow. */
+ digit = *s - '0';
+ while (digit >= 0 && digit <= 9
+ && (value < max_div_10
+ || (value == max_div_10
+ && digit <= max_mod_10))) {
+ value = value * 10 + digit;
+ if (++s < send)
+ digit = *s - '0';
+ else
+ break;
+ }
+ if (digit >= 0 && digit <= 9
+ && (s < send)) {
+ /* value overflowed.
+ skip the remaining digits, don't
+ worry about setting *valuep. */
+ do {
+ s++;
+ } while (s < send && isDIGIT(*s));
+ numtype |=
+ IS_NUMBER_GREATER_THAN_UV_MAX;
+ goto skip_value;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ numtype |= IS_NUMBER_IN_UV;
+ if (valuep)
+ *valuep = value;
+
+ skip_value:
+ if (GROK_NUMERIC_RADIX(&s, send)) {
+ numtype |= IS_NUMBER_NOT_INT;
+ while (s < send && isDIGIT(*s)) /* optional digits after the radix */
+ s++;
+ }
+ }
+ else if (GROK_NUMERIC_RADIX(&s, send)) {
+ numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
+ /* no digits before the radix means we need digits after it */
+ if (s < send && isDIGIT(*s)) {
+ do {
+ s++;
+ } while (s < send && isDIGIT(*s));
+ if (valuep) {
+ /* integer approximation is valid - it's 0. */
+ *valuep = 0;
+ }
+ }
+ else
+ return 0;
+ } else if (*s == 'I' || *s == 'i') {
+ s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
+ s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
+ s++; if (s < send && (*s == 'I' || *s == 'i')) {
+ s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
+ s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
+ s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
+ s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
+ s++;
+ }
+ sawinf = 1;
+ } else if (*s == 'N' || *s == 'n') {
+ /* XXX TODO: There are signaling NaNs and quiet NaNs. */
+ s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
+ s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
+ s++;
+ sawnan = 1;
+ } else
+ return 0;
+
+ if (sawinf) {
+ numtype &= IS_NUMBER_NEG; /* Keep track of sign */
+ numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
+ } else if (sawnan) {
+ numtype &= IS_NUMBER_NEG; /* Keep track of sign */
+ numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
+ } else if (s < send) {
+ /* we can have an optional exponent part */
+ if (*s == 'e' || *s == 'E') {
+ /* The only flag we keep is sign. Blow away any "it's UV" */
+ numtype &= IS_NUMBER_NEG;
+ numtype |= IS_NUMBER_NOT_INT;
+ s++;
+ if (s < send && (*s == '-' || *s == '+'))
+ s++;
+ if (s < send && isDIGIT(*s)) {
+ do {
+ s++;
+ } while (s < send && isDIGIT(*s));
+ }
+ else
+ return 0;
+ }
+ }
+ while (s < send && isSPACE(*s))
+ s++;
+ if (s >= send)
+ return numtype;
+ if (len == 10 && memEQ(pv, "0 but true", 10)) {
+ if (valuep)
+ *valuep = 0;
+ return IS_NUMBER_IN_UV;
+ }
+ return 0;
+}
+#endif
+#endif
+
+/*
+ * The grok_* routines have been modified to use warn() instead of
+ * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
+ * which is why the stack variable has been renamed to 'xdigit'.
+ */
+
+#ifndef grok_bin
+#if defined(NEED_grok_bin)
+static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
+static
+#else
+extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
+#endif
+
+#ifdef grok_bin
+# undef grok_bin
+#endif
+#define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
+#define Perl_grok_bin DPPP_(my_grok_bin)
+
+#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
+UV
+DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
+{
+ const char *s = start;
+ STRLEN len = *len_p;
+ UV value = 0;
+ NV value_nv = 0;
+
+ const UV max_div_2 = UV_MAX / 2;
+ bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
+ bool overflowed = FALSE;
+
+ if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
+ /* strip off leading b or 0b.
+ for compatibility silently suffer "b" and "0b" as valid binary
+ numbers. */
+ if (len >= 1) {
+ if (s[0] == 'b') {
+ s++;
+ len--;
+ }
+ else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
+ s+=2;
+ len-=2;
+ }
+ }
+ }
+
+ for (; len-- && *s; s++) {
+ char bit = *s;
+ if (bit == '0' || bit == '1') {
+ /* Write it in this wonky order with a goto to attempt to get the
+ compiler to make the common case integer-only loop pretty tight.
+ With gcc seems to be much straighter code than old scan_bin. */
+ redo:
+ if (!overflowed) {
+ if (value <= max_div_2) {
+ value = (value << 1) | (bit - '0');
+ continue;
+ }
+ /* Bah. We're just overflowed. */
+ warn("Integer overflow in binary number");
+ overflowed = TRUE;
+ value_nv = (NV) value;
+ }
+ value_nv *= 2.0;
+ /* If an NV has not enough bits in its mantissa to
+ * represent a UV this summing of small low-order numbers
+ * is a waste of time (because the NV cannot preserve
+ * the low-order bits anyway): we could just remember when
+ * did we overflow and in the end just multiply value_nv by the
+ * right amount. */
+ value_nv += (NV)(bit - '0');
+ continue;
+ }
+ if (bit == '_' && len && allow_underscores && (bit = s[1])
+ && (bit == '0' || bit == '1'))
+ {
+ --len;
+ ++s;
+ goto redo;
+ }
+ if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
+ warn("Illegal binary digit '%c' ignored", *s);
+ break;
+ }
+
+ if ( ( overflowed && value_nv > 4294967295.0)
+#if UVSIZE > 4
+ || (!overflowed && value > 0xffffffff )
+#endif
+ ) {
+ warn("Binary number > 0b11111111111111111111111111111111 non-portable");
+ }
+ *len_p = s - start;
+ if (!overflowed) {
+ *flags = 0;
+ return value;
+ }
+ *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
+ if (result)
+ *result = value_nv;
+ return UV_MAX;
+}
+#endif
+#endif
+
+#ifndef grok_hex
+#if defined(NEED_grok_hex)
+static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
+static
+#else
+extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
+#endif
+
+#ifdef grok_hex
+# undef grok_hex
+#endif
+#define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
+#define Perl_grok_hex DPPP_(my_grok_hex)
+
+#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
+UV
+DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
+{
+ const char *s = start;
+ STRLEN len = *len_p;
+ UV value = 0;
+ NV value_nv = 0;
+
+ const UV max_div_16 = UV_MAX / 16;
+ bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
+ bool overflowed = FALSE;
+ const char *xdigit;
+
+ if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
+ /* strip off leading x or 0x.
+ for compatibility silently suffer "x" and "0x" as valid hex numbers.
+ */
+ if (len >= 1) {
+ if (s[0] == 'x') {
+ s++;
+ len--;
+ }
+ else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
+ s+=2;
+ len-=2;
+ }
+ }
+ }
+
+ for (; len-- && *s; s++) {
+ xdigit = strchr((char *) PL_hexdigit, *s);
+ if (xdigit) {
+ /* Write it in this wonky order with a goto to attempt to get the
+ compiler to make the common case integer-only loop pretty tight.
+ With gcc seems to be much straighter code than old scan_hex. */
+ redo:
+ if (!overflowed) {
+ if (value <= max_div_16) {
+ value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
+ continue;
+ }
+ warn("Integer overflow in hexadecimal number");
+ overflowed = TRUE;
+ value_nv = (NV) value;
+ }
+ value_nv *= 16.0;
+ /* If an NV has not enough bits in its mantissa to
+ * represent a UV this summing of small low-order numbers
+ * is a waste of time (because the NV cannot preserve
+ * the low-order bits anyway): we could just remember when
+ * did we overflow and in the end just multiply value_nv by the
+ * right amount of 16-tuples. */
+ value_nv += (NV)((xdigit - PL_hexdigit) & 15);
+ continue;
+ }
+ if (*s == '_' && len && allow_underscores && s[1]
+ && (xdigit = strchr((char *) PL_hexdigit, s[1])))
+ {
+ --len;
+ ++s;
+ goto redo;
+ }
+ if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
+ warn("Illegal hexadecimal digit '%c' ignored", *s);
+ break;
+ }
+
+ if ( ( overflowed && value_nv > 4294967295.0)
+#if UVSIZE > 4
+ || (!overflowed && value > 0xffffffff )
+#endif
+ ) {
+ warn("Hexadecimal number > 0xffffffff non-portable");
+ }
+ *len_p = s - start;
+ if (!overflowed) {
+ *flags = 0;
+ return value;
+ }
+ *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
+ if (result)
+ *result = value_nv;
+ return UV_MAX;
+}
+#endif
+#endif
+
+#ifndef grok_oct
+#if defined(NEED_grok_oct)
+static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
+static
+#else
+extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
+#endif
+
+#ifdef grok_oct
+# undef grok_oct
+#endif
+#define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
+#define Perl_grok_oct DPPP_(my_grok_oct)
+
+#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
+UV
+DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
+{
+ const char *s = start;
+ STRLEN len = *len_p;
+ UV value = 0;
+ NV value_nv = 0;
+
+ const UV max_div_8 = UV_MAX / 8;
+ bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
+ bool overflowed = FALSE;
+
+ for (; len-- && *s; s++) {
+ /* gcc 2.95 optimiser not smart enough to figure that this subtraction
+ out front allows slicker code. */
+ int digit = *s - '0';
+ if (digit >= 0 && digit <= 7) {
+ /* Write it in this wonky order with a goto to attempt to get the
+ compiler to make the common case integer-only loop pretty tight.
+ */
+ redo:
+ if (!overflowed) {
+ if (value <= max_div_8) {
+ value = (value << 3) | digit;
+ continue;
+ }
+ /* Bah. We're just overflowed. */
+ warn("Integer overflow in octal number");
+ overflowed = TRUE;
+ value_nv = (NV) value;
+ }
+ value_nv *= 8.0;
+ /* If an NV has not enough bits in its mantissa to
+ * represent a UV this summing of small low-order numbers
+ * is a waste of time (because the NV cannot preserve
+ * the low-order bits anyway): we could just remember when
+ * did we overflow and in the end just multiply value_nv by the
+ * right amount of 8-tuples. */
+ value_nv += (NV)digit;
+ continue;
+ }
+ if (digit == ('_' - '0') && len && allow_underscores
+ && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
+ {
+ --len;
+ ++s;
+ goto redo;
+ }
+ /* Allow \octal to work the DWIM way (that is, stop scanning
+ * as soon as non-octal characters are seen, complain only iff
+ * someone seems to want to use the digits eight and nine). */
+ if (digit == 8 || digit == 9) {
+ if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
+ warn("Illegal octal digit '%c' ignored", *s);
+ }
+ break;
+ }
+
+ if ( ( overflowed && value_nv > 4294967295.0)
+#if UVSIZE > 4
+ || (!overflowed && value > 0xffffffff )
+#endif
+ ) {
+ warn("Octal number > 037777777777 non-portable");
+ }
+ *len_p = s - start;
+ if (!overflowed) {
+ *flags = 0;
+ return value;
+ }
+ *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
+ if (result)
+ *result = value_nv;
+ return UV_MAX;
+}
+#endif
+#endif
+
+#if !defined(my_snprintf)
+#if defined(NEED_my_snprintf)
+static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
+static
+#else
+extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
+#endif
+
+#define my_snprintf DPPP_(my_my_snprintf)
+#define Perl_my_snprintf DPPP_(my_my_snprintf)
+
+#if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
+
+int
+DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
+{
+ dTHX;
+ int retval;
+ va_list ap;
+ va_start(ap, format);
+#ifdef HAS_VSNPRINTF
+ retval = vsnprintf(buffer, len, format, ap);
+#else
+ retval = vsprintf(buffer, format, ap);
+#endif
+ va_end(ap);
+ if (retval < 0 || (len > 0 && (Size_t)retval >= len))
+ Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
+ return retval;
+}
+
+#endif
+#endif
+
+#if !defined(my_sprintf)
+#if defined(NEED_my_sprintf)
+static int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
+static
+#else
+extern int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
+#endif
+
+#define my_sprintf DPPP_(my_my_sprintf)
+#define Perl_my_sprintf DPPP_(my_my_sprintf)
+
+#if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL)
+
+int
+DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...)
+{
+ va_list args;
+ va_start(args, pat);
+ vsprintf(buffer, pat, args);
+ va_end(args);
+ return strlen(buffer);
+}
+
+#endif
+#endif
+
+#ifdef NO_XSLOCKS
+# ifdef dJMPENV
+# define dXCPT dJMPENV; int rEtV = 0
+# define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
+# define XCPT_TRY_END JMPENV_POP;
+# define XCPT_CATCH if (rEtV != 0)
+# define XCPT_RETHROW JMPENV_JUMP(rEtV)
+# else
+# define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
+# define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
+# define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
+# define XCPT_CATCH if (rEtV != 0)
+# define XCPT_RETHROW Siglongjmp(top_env, rEtV)
+# endif
+#endif
+
+#if !defined(my_strlcat)
+#if defined(NEED_my_strlcat)
+static Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
+static
+#else
+extern Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
+#endif
+
+#define my_strlcat DPPP_(my_my_strlcat)
+#define Perl_my_strlcat DPPP_(my_my_strlcat)
+
+#if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
+
+Size_t
+DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
+{
+ Size_t used, length, copy;
+
+ used = strlen(dst);
+ length = strlen(src);
+ if (size > 0 && used < size - 1) {
+ copy = (length >= size - used) ? size - used - 1 : length;
+ memcpy(dst + used, src, copy);
+ dst[used + copy] = '\0';
+ }
+ return used + length;
+}
+#endif
+#endif
+
+#if !defined(my_strlcpy)
+#if defined(NEED_my_strlcpy)
+static Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
+static
+#else
+extern Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
+#endif
+
+#define my_strlcpy DPPP_(my_my_strlcpy)
+#define Perl_my_strlcpy DPPP_(my_my_strlcpy)
+
+#if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
+
+Size_t
+DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
+{
+ Size_t length, copy;
+
+ length = strlen(src);
+ if (size > 0) {
+ copy = (length >= size) ? size - 1 : length;
+ memcpy(dst, src, copy);
+ dst[copy] = '\0';
+ }
+ return length;
+}
+
+#endif
+#endif
+#ifndef PERL_PV_ESCAPE_QUOTE
+# define PERL_PV_ESCAPE_QUOTE 0x0001
+#endif
+
+#ifndef PERL_PV_PRETTY_QUOTE
+# define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
+#endif
+
+#ifndef PERL_PV_PRETTY_ELLIPSES
+# define PERL_PV_PRETTY_ELLIPSES 0x0002
+#endif
+
+#ifndef PERL_PV_PRETTY_LTGT
+# define PERL_PV_PRETTY_LTGT 0x0004
+#endif
+
+#ifndef PERL_PV_ESCAPE_FIRSTCHAR
+# define PERL_PV_ESCAPE_FIRSTCHAR 0x0008
+#endif
+
+#ifndef PERL_PV_ESCAPE_UNI
+# define PERL_PV_ESCAPE_UNI 0x0100
+#endif
+
+#ifndef PERL_PV_ESCAPE_UNI_DETECT
+# define PERL_PV_ESCAPE_UNI_DETECT 0x0200
+#endif
+
+#ifndef PERL_PV_ESCAPE_ALL
+# define PERL_PV_ESCAPE_ALL 0x1000
+#endif
+
+#ifndef PERL_PV_ESCAPE_NOBACKSLASH
+# define PERL_PV_ESCAPE_NOBACKSLASH 0x2000
+#endif
+
+#ifndef PERL_PV_ESCAPE_NOCLEAR
+# define PERL_PV_ESCAPE_NOCLEAR 0x4000
+#endif
+
+#ifndef PERL_PV_ESCAPE_RE
+# define PERL_PV_ESCAPE_RE 0x8000
+#endif
+
+#ifndef PERL_PV_PRETTY_NOCLEAR
+# define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
+#endif
+#ifndef PERL_PV_PRETTY_DUMP
+# define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
+#endif
+
+#ifndef PERL_PV_PRETTY_REGPROP
+# define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
+#endif
+
+/* Hint: pv_escape
+ * Note that unicode functionality is only backported to
+ * those perl versions that support it. For older perl
+ * versions, the implementation will fall back to bytes.
+ */
+
+#ifndef pv_escape
+#if defined(NEED_pv_escape)
+static char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
+static
+#else
+extern char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
+#endif
+
+#ifdef pv_escape
+# undef pv_escape
+#endif
+#define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
+#define Perl_pv_escape DPPP_(my_pv_escape)
+
+#if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
+
+char *
+DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str,
+ const STRLEN count, const STRLEN max,
+ STRLEN * const escaped, const U32 flags)
+{
+ const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\';
+ const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc;
+ char octbuf[32] = "%123456789ABCDF";
+ STRLEN wrote = 0;
+ STRLEN chsize = 0;
+ STRLEN readsize = 1;
+#if defined(is_utf8_string) && defined(utf8_to_uvchr)
+ bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0;
+#endif
+ const char *pv = str;
+ const char * const end = pv + count;
+ octbuf[0] = esc;
+
+ if (!(flags & PERL_PV_ESCAPE_NOCLEAR))
+ sv_setpvs(dsv, "");
+
+#if defined(is_utf8_string) && defined(utf8_to_uvchr)
+ if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
+ isuni = 1;
+#endif
+
+ for (; pv < end && (!max || wrote < max) ; pv += readsize) {
+ const UV u =
+#if defined(is_utf8_string) && defined(utf8_to_uvchr)
+ isuni ? utf8_to_uvchr((U8*)pv, &readsize) :
+#endif
+ (U8)*pv;
+ const U8 c = (U8)u & 0xFF;
+
+ if (u > 255 || (flags & PERL_PV_ESCAPE_ALL)) {
+ if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
+ chsize = my_snprintf(octbuf, sizeof octbuf,
+ "%"UVxf, u);
+ else
+ chsize = my_snprintf(octbuf, sizeof octbuf,
+ "%cx{%"UVxf"}", esc, u);
+ } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
+ chsize = 1;
+ } else {
+ if (c == dq || c == esc || !isPRINT(c)) {
+ chsize = 2;
+ switch (c) {
+ case '\\' : /* fallthrough */
+ case '%' : if (c == esc)
+ octbuf[1] = esc;
+ else
+ chsize = 1;
+ break;
+ case '\v' : octbuf[1] = 'v'; break;
+ case '\t' : octbuf[1] = 't'; break;
+ case '\r' : octbuf[1] = 'r'; break;
+ case '\n' : octbuf[1] = 'n'; break;
+ case '\f' : octbuf[1] = 'f'; break;
+ case '"' : if (dq == '"')
+ octbuf[1] = '"';
+ else
+ chsize = 1;
+ break;
+ default: chsize = my_snprintf(octbuf, sizeof octbuf,
+ pv < end && isDIGIT((U8)*(pv+readsize))
+ ? "%c%03o" : "%c%o", esc, c);
+ }
+ } else {
+ chsize = 1;
+ }
+ }
+ if (max && wrote + chsize > max) {
+ break;
+ } else if (chsize > 1) {
+ sv_catpvn(dsv, octbuf, chsize);
+ wrote += chsize;
+ } else {
+ char tmp[2];
+ my_snprintf(tmp, sizeof tmp, "%c", c);
+ sv_catpvn(dsv, tmp, 1);
+ wrote++;
+ }
+ if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
+ break;
+ }
+ if (escaped != NULL)
+ *escaped= pv - str;
+ return SvPVX(dsv);
+}
+
+#endif
+#endif
+
+#ifndef pv_pretty
+#if defined(NEED_pv_pretty)
+static char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
+static
+#else
+extern char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
+#endif
+
+#ifdef pv_pretty
+# undef pv_pretty
+#endif
+#define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
+#define Perl_pv_pretty DPPP_(my_pv_pretty)
+
+#if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
+
+char *
+DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
+ const STRLEN max, char const * const start_color, char const * const end_color,
+ const U32 flags)
+{
+ const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
+ STRLEN escaped;
+
+ if (!(flags & PERL_PV_PRETTY_NOCLEAR))
+ sv_setpvs(dsv, "");
+
+ if (dq == '"')
+ sv_catpvs(dsv, "\"");
+ else if (flags & PERL_PV_PRETTY_LTGT)
+ sv_catpvs(dsv, "<");
+
+ if (start_color != NULL)
+ sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
+
+ pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
+
+ if (end_color != NULL)
+ sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
+
+ if (dq == '"')
+ sv_catpvs(dsv, "\"");
+ else if (flags & PERL_PV_PRETTY_LTGT)
+ sv_catpvs(dsv, ">");
+
+ if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count)
+ sv_catpvs(dsv, "...");
+
+ return SvPVX(dsv);
+}
+
+#endif
+#endif
+
+#ifndef pv_display
+#if defined(NEED_pv_display)
+static char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
+static
+#else
+extern char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
+#endif
+
+#ifdef pv_display
+# undef pv_display
+#endif
+#define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e)
+#define Perl_pv_display DPPP_(my_pv_display)
+
+#if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL)
+
+char *
+DPPP_(my_pv_display)(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
+{
+ pv_pretty(dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
+ if (len > cur && pv[cur] == '\0')
+ sv_catpvs(dsv, "\\0");
+ return SvPVX(dsv);
+}
+
+#endif
+#endif
+
+#endif /* _P_P_PORTABILITY_H_ */
+
+/* End of File ppport.h */
diff --git a/gnu/usr.bin/perl/cpan/Term-ReadKey/t/01_basic.t b/gnu/usr.bin/perl/cpan/Term-ReadKey/t/01_basic.t
new file mode 100644
index 00000000000..292f96b792c
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/Term-ReadKey/t/01_basic.t
@@ -0,0 +1,7 @@
+use strict;
+use warnings;
+
+
+use Test::More tests => 1;
+
+use_ok 'Term::ReadKey';
diff --git a/gnu/usr.bin/perl/cpan/Term-ReadKey/t/02_terminal_functions.t b/gnu/usr.bin/perl/cpan/Term-ReadKey/t/02_terminal_functions.t
new file mode 100644
index 00000000000..09fe2e4b67d
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/Term-ReadKey/t/02_terminal_functions.t
@@ -0,0 +1,86 @@
+use strict;
+use warnings;
+
+
+use Test::More tests => 7;
+
+use Term::ReadKey;
+use Fcntl;
+
+if ( not exists $ENV{COLUMNS} ){
+ $ENV{COLUMNS} = 80;
+ $ENV{LINES} = 24;
+}
+
+SKIP:
+{
+ eval {
+ if ( $^O =~ /Win32/i ){
+ sysopen( IN, 'CONIN$', O_RDWR ) or die "Unable to open console input:$!";
+ sysopen( OUT, 'CONOUT$', O_RDWR ) or die "Unable to open console output:$!";
+ }
+ else{
+ if ( open( IN, "</dev/tty" ) ){
+ *OUT = *IN;
+ die "Foo" unless -t OUT;
+ }
+ else{
+ die "/dev/tty is absent\n";
+ }
+ }
+ };
+ skip( 'Because Term::ReadKey need at least a tty to be useful', 1 ) if $@;
+ *IN = *IN; # Make single-use warning go away
+ $| = 1;
+ no strict "subs";
+ my $size1 = join( ",", GetTerminalSize( \IN ) );
+ my $size2 = join( ",", GetTerminalSize("IN") );
+ my $size3 = join( ",", GetTerminalSize(*IN) );
+ my $size4 = join( ",", GetTerminalSize( \*IN ) );
+
+ my $size_result=0;
+ if ( ( $size1 eq $size2 ) && ( $size2 eq $size3 ) && ( $size3 eq $size4 ) ){
+ $size_result = 1;
+ }
+ is($size_result, 1, "Comparing TerminalSize IN");
+
+ my $usable_terminal=0;
+ for (my $i = 1; $i < 6; $i++){
+ if ( &Term::ReadKey::termoptions() == $i ){
+ $usable_terminal = 1;
+ last;
+ }
+ }
+ is($usable_terminal, 1, "Manipulating the terminal.");
+
+ my @modes;
+ eval {
+ push( @modes, "O_NODELAY" ) if &Term::ReadKey::blockoptions() & 1;
+ push( @modes, "poll()" ) if &Term::ReadKey::blockoptions() & 2;
+ push( @modes, "select()" ) if &Term::ReadKey::blockoptions() & 4;
+ push( @modes, "Win32" ) if &Term::ReadKey::blockoptions() & 8;
+ };
+ is($@, '', "Check non-blocking read");
+
+ eval {
+ my @size = GetTerminalSize(OUT);
+ };
+ is($@, '', "Check TerminalSize OUT");
+
+ eval {
+ my @speeds = GetSpeed();
+ };
+ is($@, '', "Check Terminal communication speed");
+
+ my %chars;
+ eval {
+ %chars = GetControlChars(IN);
+ };
+ is($@, '', "Validate GetControlChars function");
+
+ my %origchars = %chars;
+ eval {
+ SetControlChars( %origchars, IN );
+ };
+ is($@, '', "Validate SetControlChars function");
+}