--- /dev/null
+/Makefile
+*.o
+/MoPaQ.bs
+/MoPaQ.c
+/pm_to_blib
+/blib
--- /dev/null
+Revision history for Archive::MoPaQ
+
+0.01 2007-11-27
+- Preliminary interface to libmpq.
+- Open an archive with open($filename).
+- Can extract files with extract($number).
+
--- /dev/null
+Changes
+Makefile.PL
+MANIFEST
+MoPaQ.xs
+ppport.h
+README
+t/Archive-MoPaQ.t
+lib/Archive/MoPaQ.pm
--- /dev/null
+use 5.008008;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'Archive::MoPaQ',
+ VERSION_FROM => 'lib/Archive/MoPaQ.pm', # finds $VERSION
+ PREREQ_PM => {},
+ ABSTRACT_FROM => 'lib/Archive/MoPaQ.pm', # retrieve abstract from module
+ AUTHOR => 'Mischa POSLAWSKY <perl@shiar.org>',
+ LIBS => ['-lmpq -lz'],
+ INC => '-I.', # e.g., '-I. -I/usr/local/lib/mpq':
+);
--- /dev/null
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include "ppport.h"
+
+#include "libmpq/mpq.h"
+
+typedef PerlIO * OutputStream;
+typedef mpq_archive * Archive__MoPaQ;
+
+
+MODULE = Archive::MoPaQ PACKAGE = Archive::MoPaQ
+
+Archive::MoPaQ init(package)
+ char *package;
+ CODE:
+ RETVAL = malloc(sizeof(mpq_archive));
+ memset(RETVAL, 0, sizeof(mpq_archive));
+ OUTPUT:
+ RETVAL
+
+int open(mpqa,filename)
+ Archive::MoPaQ mpqa;
+ char *filename;
+ CODE:
+ RETVAL = libmpq_archive_open(mpqa, filename);
+ OUTPUT:
+ RETVAL
+
+int get_size(mpqa)
+ Archive::MoPaQ mpqa;
+ CODE:
+ RETVAL = libmpq_archive_info(mpqa, LIBMPQ_MPQ_ARCHIVE_SIZE);
+ OUTPUT:
+ RETVAL
+
+int get_numfiles(mpqa)
+ Archive::MoPaQ mpqa;
+ CODE:
+ RETVAL = libmpq_archive_info(mpqa, LIBMPQ_MPQ_NUMFILES);
+ OUTPUT:
+ RETVAL
+
+int listopen(mpqa,listfile)
+ Archive::MoPaQ mpqa;
+ char* listfile;
+ CODE:
+ RETVAL = 0;
+ switch (libmpq_listfile_open(mpqa, listfile)) {
+ case LIBMPQ_CONF_EFILE_OPEN:
+ warn("found filelist, but could not open, so disabling listfile\n");
+ break;
+ case LIBMPQ_CONF_EFILE_CORRUPT:
+ warn("found filelist with errors, so disabling listfile\n");
+ break;
+ case LIBMPQ_CONF_EFILE_LIST_CORRUPT:
+ warn("found filelist, header matches %s, but filelist is corrupt.\n", mpqa->mpq_l->mpq_name);
+ break;
+ case LIBMPQ_CONF_EFILE_VERSION:
+ warn("found filelist, but libmpq %s is required.\n", mpqa->mpq_l->mpq_version);
+ break;
+ case LIBMPQ_CONF_EFILE_NOT_FOUND:
+ warn("Filelist not found");
+ break;
+ default:
+// printf("game: %s, file: %s, version: %s\n", mpqa->mpq_l->mpq_game, mpqa->mpq_l->mpq_name, mpqa->mpq_l->mpq_game_version);
+ RETVAL = 1;
+ }
+ OUTPUT:
+ RETVAL
+
+int extract(mpqa,nr)
+ Archive::MoPaQ mpqa;
+ int nr;
+ CODE:
+ if (libmpq_file_check(mpqa, &nr, LIBMPQ_FILE_TYPE_INT)) {
+ warn("file %i not found\n", nr);
+ } else {
+ RETVAL = libmpq_file_extract(mpqa, nr);
+ }
+ OUTPUT:
+ RETVAL
+
+void DESTROY(mpqa)
+ Archive::MoPaQ mpqa;
+ CODE:
+ libmpq_listfile_close(mpqa);
+ libmpq_archive_close(mpqa);
+ free(mpqa);
+
--- /dev/null
+Archive-MoPaQ version 0.01
+==========================
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+ libmpq
+ zlib
+
+
--- /dev/null
+package Archive::MoPaQ;
+
+use 5.008008;
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+require XSLoader;
+XSLoader::load('Archive::MoPaQ', $VERSION);
+
+sub new {
+ my $class = shift;
+ my $self = Archive::MoPaQ->init;
+ bless $self, $class;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Archive::MoPaQ - Interface to libmpq archive library
+
+=head1 SYNOPSIS
+
+ use Archive::MoPaQ;
+ my $mpq = Archive::MoPaQ->new;
+ $mpq->open("ladder/(4)Lost Temple.scm" or die;
+ $mpq->extract(1); # write map to file000001.xxx
+
+=head1 DESCRIPTION
+
+Preliminary interface to libmpq, under development.
+
+=head1 SEE ALSO
+
+The I<libmpq> library.
+
+=head1 AUTHOR
+
+Mischa POSLAWSKY <perl@shiar.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+Undefined.
+
+=cut
--- /dev/null
+#if 0
+<<'SKIP';
+#endif
+/*
+----------------------------------------------------------------------
+
+ ppport.h -- Perl/Pollution/Portability Version 3.06_01
+
+ Automatically created by Devel::PPPort running under
+ perl 5.008008 on Sat Nov 24 20:54:03 2007.
+
+ 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.06_01
+
+=head1 SYNOPSIS
+
+ perl ppport.h [options] [source files]
+
+ Searches current directory for files if no [source files] are given
+
+ --help show short help
+
+ --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
+
+ --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.9.3.
+
+=head1 OPTIONS
+
+=head2 --help
+
+Display a brief usage summary.
+
+=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.
+
+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
+up 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.
+
+=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 --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 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 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 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, you want either C<static> or global variants.
+
+For a C<static> function, use:
+
+ #define NEED_function
+
+For a global function, use:
+
+ #define NEED_function_GLOBAL
+
+Note that you mustn't have more than one global request for one
+function in your project.
+
+ Function Static Request Global Request
+ -----------------------------------------------------------------------------------------
+ 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
+ newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
+ newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
+ sv_2pv_nolen() NEED_sv_2pv_nolen NEED_sv_2pv_nolen_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_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
+ vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
+
+To avoid namespace conflicts, you can change the namespace of the
+explicitly exported functions 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.
+
+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-2005, 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;
+
+my %opt = (
+ quiet => 0,
+ diag => 1,
+ hints => 1,
+ changes => 1,
+ cplusplus => 0,
+ filter => 1,
+);
+
+my($ppport) = $0 =~ /([\w.]+)$/;
+my $LF = '(?:\r\n|[\r\n])'; # line feed
+my $HS = "[ \t]"; # horizontal whitespace
+
+eval {
+ require Getopt::Long;
+ Getopt::Long::GetOptions(\%opt, qw(
+ help quiet diag! filter! hints! changes! cplusplus
+ 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";
+}
+
+usage() if $opt{help};
+
+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;
+}
+
+# Never use C comments in this file!!!!!
+my $ccs = '/'.'*';
+my $cce = '*'.'/';
+my $rccs = quotemeta $ccs;
+my $rcce = quotemeta $cce;
+
+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|||
+CLASS|||n
+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||p
+Copy|||
+CvPADLIST|||
+CvSTASH|||
+CvWEAKOUTSIDE|||
+DEFSV|5.004050||p
+END_EXTERN_C|5.005000||p
+ENTER|||
+ERRSV|5.004050||p
+EXTEND|||
+EXTERN_C|5.005000||p
+FREETMPS|||
+GIMME_V||5.004000|n
+GIMME|||n
+GROK_NUMERIC_RADIX|5.007002||p
+G_ARRAY|||
+G_DISCARD|||
+G_EVAL|||
+G_NOARGS|||
+G_SCALAR|||
+G_VOID||5.004000|
+GetVars|||
+GvSV|||
+Gv_AMupdate|||
+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|
+HeVAL||5.004000|
+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|||
+LVRET|||
+MARK|||
+MY_CXT_CLONE|5.009002||p
+MY_CXT_INIT|5.007003||p
+MY_CXT|5.007003||p
+MoveD|5.009002||p
+Move|||
+NEWSV|||
+NOOP|5.005000||p
+NUM2PTR|5.006000||p
+NVTYPE|5.006000||p
+NVef|5.006001||p
+NVff|5.006001||p
+NVgf|5.006001||p
+Newc|||
+Newz|||
+New|||
+Nullav|||
+Nullch|||
+Nullcv|||
+Nullhv|||
+Nullsv|||
+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|||
+PERL_BCDVERSION|5.009003||p
+PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||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.007002||p
+PERL_MAGIC_isaelem|5.007002||p
+PERL_MAGIC_isa|5.007002||p
+PERL_MAGIC_mutex|5.007002||p
+PERL_MAGIC_nkeys|5.007002||p
+PERL_MAGIC_overload_elem|5.007002||p
+PERL_MAGIC_overload_table|5.007002||p
+PERL_MAGIC_overload|5.007002||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_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_SUBVERSION|5.006000||p
+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_DECL|5.007002||p
+PERL_UQUAD_MAX|5.004000||p
+PERL_UQUAD_MIN|5.004000||p
+PERL_USHORT_MAX|5.004000||p
+PERL_USHORT_MIN|5.004000||p
+PERL_VERSION|5.006000||p
+PL_DBsingle|||pn
+PL_DBsub|||pn
+PL_DBtrace|||n
+PL_Sv|5.005000||p
+PL_compiling|5.004050||p
+PL_copline|5.005000||p
+PL_curcop|5.004050||p
+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_hexdigit|5.005000||p
+PL_hints|5.005000||p
+PL_last_in_gv|||n
+PL_modglobal||5.005000|n
+PL_na|5.004050||pn
+PL_no_modify|5.006000||p
+PL_ofs_sv|||n
+PL_perl_destruct_level|5.004050||p
+PL_perldb|5.004050||p
+PL_ppaddr|5.006000||p
+PL_rsfp_filters|5.004050||p
+PL_rsfp|5.004050||p
+PL_rs|||n
+PL_stack_base|5.004050||p
+PL_stack_sp|5.004050||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
+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
+PTR2ul|5.007001||p
+PTRV|5.006000||p
+PUSHMARK|||
+PUSHi|||
+PUSHmortal|5.009002||p
+PUSHn|||
+PUSHp|||
+PUSHs|||
+PUSHu|5.004000||p
+PUTBACK|||
+PerlIO_clearerr||5.007003|
+PerlIO_close||5.007003|
+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|
+Poison|5.008000||p
+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
+ST|||
+SVt_IV|||
+SVt_NV|||
+SVt_PVAV|||
+SVt_PVCV|||
+SVt_PVHV|||
+SVt_PVMG|||
+SVt_PV|||
+Safefree|||
+Slab_Alloc|||
+Slab_Free|||
+StructCopy|||
+SvCUR_set|||
+SvCUR|||
+SvEND|||
+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|
+SvNIOK_off|||
+SvNIOKp|||
+SvNIOK|||
+SvNOK_off|||
+SvNOK_only|||
+SvNOK_on|||
+SvNOKp|||
+SvNOK|||
+SvNVX|||
+SvNV_set|||
+SvNVx|||
+SvNV|||
+SvOK|||
+SvOOK|||
+SvPOK_off|||
+SvPOK_only_UTF8||5.006000|
+SvPOK_only|||
+SvPOK_on|||
+SvPOKp|||
+SvPOK|||
+SvPVX|||
+SvPV_force_nomg|5.007002||p
+SvPV_force|||
+SvPV_nolen|5.006000||p
+SvPV_nomg|5.007002||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|||
+SvREFCNT_inc|||
+SvREFCNT|||
+SvROK_off|||
+SvROK_on|||
+SvROK|||
+SvRV_set||5.009003|
+SvRV|||
+SvSETMAGIC|||
+SvSHARE||5.007003|
+SvSTASH_set||5.009003|
+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|||
+SvTRUE|||
+SvTYPE|||
+SvUNLOCK||5.007003|
+SvUOK||5.007001|
+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|
+SvUVx|5.004000||p
+SvUV|5.004000||p
+SvVOK||5.008001|
+THIS|||n
+UNDERBAR|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
+XCPT_CATCH|5.009002||p
+XCPT_RETHROW|5.009002||p
+XCPT_TRY_END|5.009002||p
+XCPT_TRY_START|5.009002||p
+XPUSHi|||
+XPUSHmortal|5.009002||p
+XPUSHn|||
+XPUSHp|||
+XPUSHs|||
+XPUSHu|5.004000||p
+XSRETURN_EMPTY|||
+XSRETURN_IV|||
+XSRETURN_NO|||
+XSRETURN_NV|||
+XSRETURN_PV|||
+XSRETURN_UNDEF|||
+XSRETURN_UV|5.008001||p
+XSRETURN_YES|||
+XSRETURN|||
+XST_mIV|||
+XST_mNO|||
+XST_mNV|||
+XST_mPV|||
+XST_mUNDEF|||
+XST_mUV|5.008001||p
+XST_mYES|||
+XS_VERSION_BOOTCHECK|||
+XS_VERSION|||
+XS|||
+ZeroD|5.009002||p
+Zero|||
+_aMY_CXT|5.007003||p
+_pMY_CXT|5.007003||p
+aMY_CXT_|5.007003||p
+aMY_CXT|5.007003||p
+aTHX_|5.006000||p
+aTHX|5.006000||p
+add_data|||
+allocmy|||
+amagic_call|||
+any_dup|||
+ao|||
+append_elem|||
+append_list|||
+apply_attrs_my|||
+apply_attrs_string||5.006001|
+apply_attrs|||
+apply|||
+asIV|||
+asUV|||
+atfork_lock||5.007003|n
+atfork_unlock||5.007003|n
+av_arylen_p||5.009003|
+av_clear|||
+av_delete||5.006000|
+av_exists||5.006000|
+av_extend|||
+av_fake|||
+av_fetch|||
+av_fill|||
+av_len|||
+av_make|||
+av_pop|||
+av_push|||
+av_reify|||
+av_shift|||
+av_store|||
+av_undef|||
+av_unshift|||
+ax|||n
+bad_type|||
+bind_match|||
+block_end|||
+block_gimme||5.004000|
+block_start|||
+boolSV|5.004000||p
+boot_core_PerlIO|||
+boot_core_UNIVERSAL|||
+boot_core_xsutils|||
+bytes_from_utf8||5.007001|
+bytes_to_utf8||5.006001|
+cache_re|||
+call_argv|5.006000||p
+call_atexit||5.006000|
+call_body|||
+call_list_body|||
+call_list||5.004000|
+call_method|5.006000||p
+call_pv|5.006000||p
+call_sv|5.006000||p
+calloc||5.007002|n
+cando|||
+cast_i32||5.006000|
+cast_iv||5.006000|
+cast_ulong||5.006000|
+cast_uv||5.006000|
+check_uni|||
+checkcomma|||
+checkposixcc|||
+ck_anoncode|||
+ck_bitop|||
+ck_concat|||
+ck_defined|||
+ck_delete|||
+ck_die|||
+ck_eof|||
+ck_eval|||
+ck_exec|||
+ck_exists|||
+ck_exit|||
+ck_ftst|||
+ck_fun|||
+ck_glob|||
+ck_grep|||
+ck_index|||
+ck_join|||
+ck_lengthconst|||
+ck_lfun|||
+ck_listiob|||
+ck_match|||
+ck_method|||
+ck_null|||
+ck_open|||
+ck_repeat|||
+ck_require|||
+ck_retarget|||
+ck_return|||
+ck_rfun|||
+ck_rvconst|||
+ck_sassign|||
+ck_select|||
+ck_shift|||
+ck_sort|||
+ck_spair|||
+ck_split|||
+ck_subr|||
+ck_substr|||
+ck_svconst|||
+ck_trunc|||
+ck_unpack|||
+cl_and|||
+cl_anything|||
+cl_init_zero|||
+cl_init|||
+cl_is_anything|||
+cl_or|||
+closest_cop|||
+convert|||
+cop_free|||
+cr_textfilter|||
+croak_nocontext|||vn
+croak|||v
+csighandler||5.007001|n
+custom_op_desc||5.007003|
+custom_op_name||5.007003|
+cv_ckproto|||
+cv_clone|||
+cv_const_sv||5.004000|
+cv_dump|||
+cv_undef|||
+cx_dump||5.005000|
+cx_dup|||
+cxinc|||
+dAXMARK||5.009003|
+dAX|5.007002||p
+dITEMS|5.007002||p
+dMARK|||
+dMY_CXT_SV|5.007003||p
+dMY_CXT|5.007003||p
+dNOOP|5.006000||p
+dORIGMARK|||
+dSP|||
+dTHR|5.004050||p
+dTHXa|5.006000||p
+dTHXoa|5.006000||p
+dTHX|5.006000||p
+dUNDERBAR|5.009002||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|
+deb||5.007003|v
+del_he|||
+del_sv|||
+delimcpy||5.004000|
+depcom|||
+deprecate_old|||
+deprecate|||
+despatch_signals||5.007001|
+die_nocontext|||vn
+die_where|||
+die|||v
+dirp_dup|||
+div128|||
+djSP|||
+do_aexec5|||
+do_aexec|||
+do_aspawn|||
+do_binmode||5.004050|
+do_chomp|||
+do_chop|||
+do_close|||
+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_kv|||
+do_magic_dump||5.006000|
+do_msgrcv|||
+do_msgsnd|||
+do_oddball|||
+do_op_dump||5.006000|
+do_open9||5.006000|
+do_openn||5.007001|
+do_open||5.004000|
+do_pipe|||
+do_pmop_dump||5.006000|
+do_print|||
+do_readline|||
+do_seek|||
+do_semop|||
+do_shmio|||
+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_body|||
+docatch|||
+doeval|||
+dofile|||
+dofindlabel|||
+doform|||
+doing_taint||5.008001|n
+dooneliner|||
+doopen_pm|||
+doparseform|||
+dopoptoeval|||
+dopoptolabel|||
+dopoptoloop|||
+dopoptosub_at|||
+dopoptosub|||
+dounwind|||
+dowantarray|||
+dump_all||5.006000|
+dump_eval||5.006000|
+dump_fds|||
+dump_form||5.006000|
+dump_indent||5.006000|v
+dump_mstats|||
+dump_packsubs||5.006000|
+dump_sub||5.006000|
+dump_vindent||5.006000|
+dumpuntil|||
+dup_attrlist|||
+emulate_eaccess|||
+eval_pv|5.006000||p
+eval_sv|5.006000||p
+expect_number|||
+fbm_compile||5.005000|
+fbm_instr||5.005000|
+fd_on_nosuid_fs|||
+filter_add|||
+filter_del|||
+filter_gets|||
+filter_read|||
+find_beginning|||
+find_byclass|||
+find_in_my_stash|||
+find_runcv|||
+find_rundefsvoffset||5.009002|
+find_script|||
+find_uninit_var|||
+fold_constants|||
+forbid_setid|||
+force_ident|||
+force_list|||
+force_next|||
+force_version|||
+force_word|||
+form_nocontext|||vn
+form||5.004000|v
+fp_dup|||
+fprintf_nocontext|||vn
+free_global_struct|||
+free_tied_hv_pool|||
+free_tmps|||
+gen_constant_list|||
+get_av|5.006000||p
+get_context||5.006000|n
+get_cv|5.006000||p
+get_db_sub|||
+get_debug_opts|||
+get_hash_seed|||
+get_hv|5.006000||p
+get_mstats|||
+get_no_modify|||
+get_num|||
+get_op_descs||5.005000|
+get_op_names||5.005000|
+get_opargs|||
+get_ppaddr||5.006000|
+get_sv|5.006000||p
+get_vtbl||5.005030|
+getcwd_sv||5.007002|
+getenv_len|||
+gp_dup|||
+gp_free|||
+gp_ref|||
+grok_bin|5.007003||p
+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_autoload4||5.004000|
+gv_check|||
+gv_dump||5.006000|
+gv_efullname3||5.004000|
+gv_efullname4||5.006001|
+gv_efullname|||
+gv_ename|||
+gv_fetchfile|||
+gv_fetchmeth_autoload||5.007003|
+gv_fetchmethod_autoload||5.004000|
+gv_fetchmethod|||
+gv_fetchmeth|||
+gv_fetchpvn_flags||5.009002|
+gv_fetchpv|||
+gv_fetchsv||5.009002|
+gv_fullname3||5.004000|
+gv_fullname4||5.006001|
+gv_fullname|||
+gv_handler||5.007001|
+gv_init_sv|||
+gv_init|||
+gv_share|||
+gv_stashpvn|5.006000||p
+gv_stashpv|||
+gv_stashsv|||
+he_dup|||
+hek_dup|||
+hfreeentries|||
+hsplit|||
+hv_assert||5.009001|
+hv_auxinit|||
+hv_clear_placeholders||5.009001|
+hv_clear|||
+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_exists_ent||5.004000|
+hv_exists|||
+hv_fetch_common|||
+hv_fetch_ent||5.004000|
+hv_fetch|||
+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_ksplit||5.004000|
+hv_magic_check|||
+hv_magic|||
+hv_name_set||5.009003|
+hv_notallowed|||
+hv_placeholders_get||5.009003|
+hv_placeholders_p||5.009003|
+hv_placeholders_set||5.009003|
+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_store|||
+hv_undef|||
+ibcmp_locale||5.004000|
+ibcmp_utf8||5.007003|
+ibcmp|||
+incl_perldb|||
+incline|||
+incpush|||
+ingroup|||
+init_argv_symbols|||
+init_debugger|||
+init_global_struct|||
+init_i18nl10n||5.006000|
+init_i18nl14n||5.006000|
+init_ids|||
+init_interp|||
+init_lexer|||
+init_main_stash|||
+init_perllib|||
+init_postdump_symbols|||
+init_predump_symbols|||
+init_stacks||5.005000|
+init_tm||5.007002|
+instr|||
+intro_my|||
+intuit_method|||
+intuit_more|||
+invert|||
+io_close|||
+isALNUM|||
+isALPHA|||
+isDIGIT|||
+isLOWER|||
+isSPACE|||
+isUPPER|||
+is_an_int|||
+is_gv_magical_sv|||
+is_gv_magical|||
+is_handle_constructor|||
+is_list_assignment|||
+is_lvalue_sub||5.007001|
+is_uni_alnum_lc||5.006000|
+is_uni_alnumc_lc||5.006000|
+is_uni_alnumc||5.006000|
+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_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.006000|
+is_utf8_alnum||5.006000|
+is_utf8_alpha||5.006000|
+is_utf8_ascii||5.006000|
+is_utf8_char_slow|||
+is_utf8_char||5.006000|
+is_utf8_cntrl||5.006000|
+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_print||5.006000|
+is_utf8_punct||5.006000|
+is_utf8_space||5.006000|
+is_utf8_string_loclen||5.009003|
+is_utf8_string_loc||5.008001|
+is_utf8_string||5.006001|
+is_utf8_upper||5.006000|
+is_utf8_xdigit||5.006000|
+isa_lookup|||
+items|||n
+ix|||n
+jmaybe|||
+keyword|||
+leave_scope|||
+lex_end|||
+lex_start|||
+linklist|||
+listkids|||
+list|||
+load_module_nocontext|||vn
+load_module||5.006000|v
+localize|||
+looks_like_number|||
+lop|||
+mPUSHi|5.009002||p
+mPUSHn|5.009002||p
+mPUSHp|5.009002||p
+mPUSHu|5.009002||p
+mXPUSHi|5.009002||p
+mXPUSHn|5.009002||p
+mXPUSHp|5.009002||p
+mXPUSHu|5.009002||p
+magic_clear_all_env|||
+magic_clearenv|||
+magic_clearpack|||
+magic_clearsig|||
+magic_dump||5.006000|
+magic_existspack|||
+magic_freearylen_p|||
+magic_freeovrld|||
+magic_freeregexp|||
+magic_getarylen|||
+magic_getdefelem|||
+magic_getglob|||
+magic_getnkeys|||
+magic_getpack|||
+magic_getpos|||
+magic_getsig|||
+magic_getsubstr|||
+magic_gettaint|||
+magic_getuvar|||
+magic_getvec|||
+magic_get|||
+magic_killbackrefs|||
+magic_len|||
+magic_methcall|||
+magic_methpack|||
+magic_nextpack|||
+magic_regdata_cnt|||
+magic_regdatum_get|||
+magic_regdatum_set|||
+magic_scalarpack|||
+magic_set_all_env|||
+magic_setamagic|||
+magic_setarylen|||
+magic_setbm|||
+magic_setcollxfrm|||
+magic_setdbline|||
+magic_setdefelem|||
+magic_setenv|||
+magic_setfm|||
+magic_setglob|||
+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|||
+magicname|||
+make_trie|||
+malloced_size|||n
+malloc||5.007002|n
+markstack_grow|||
+measure_struct|||
+memEQ|5.004000||p
+memNE|5.004000||p
+mem_collxfrm|||
+mess_alloc|||
+mess_nocontext|||vn
+mess||5.006000|v
+method_common|||
+mfree||5.007002|n
+mg_clear|||
+mg_copy|||
+mg_dup|||
+mg_find|||
+mg_free|||
+mg_get|||
+mg_length||5.005000|
+mg_localize|||
+mg_magical|||
+mg_set|||
+mg_size||5.005000|
+mini_mktime||5.007002|
+missingterm|||
+mode_from_discipline|||
+modkids|||
+mod|||
+moreswitches|||
+mul128|||
+mulexp10|||n
+my_atof2||5.007002|
+my_atof||5.006000|
+my_attrs|||
+my_bcopy|||n
+my_betoh16|||n
+my_betoh32|||n
+my_betoh64|||n
+my_betohi|||n
+my_betohl|||n
+my_betohs|||n
+my_bzero|||n
+my_chsize|||
+my_exit_jump|||
+my_exit|||
+my_failure_exit||5.004000|
+my_fflush_all||5.006000|
+my_fork||5.007003|n
+my_htobe16|||n
+my_htobe32|||n
+my_htobe64|||n
+my_htobei|||n
+my_htobel|||n
+my_htobes|||n
+my_htole16|||n
+my_htole32|||n
+my_htole64|||n
+my_htolei|||n
+my_htolel|||n
+my_htoles|||n
+my_htonl|||
+my_kid|||
+my_letoh16|||n
+my_letoh32|||n
+my_letoh64|||n
+my_letohi|||n
+my_letohl|||n
+my_letohs|||n
+my_lstat|||
+my_memcmp||5.004000|n
+my_memset|||n
+my_ntohl|||
+my_pclose||5.004000|
+my_popen_list||5.007001|
+my_popen||5.004000|
+my_setenv|||
+my_socketpair||5.007003|n
+my_stat|||
+my_strftime||5.007002|
+my_swabn|||n
+my_swap|||
+my_unexec|||
+my|||
+newANONATTRSUB||5.006000|
+newANONHASH|||
+newANONLIST|||
+newANONSUB|||
+newASSIGNOP|||
+newATTRSUB||5.006000|
+newAVREF|||
+newAV|||
+newBINOP|||
+newCONDOP|||
+newCONSTSUB|5.006000||p
+newCVREF|||
+newDEFSVOP|||
+newFORM|||
+newFOROP|||
+newGVOP|||
+newGVREF|||
+newGVgen|||
+newHVREF|||
+newHVhv||5.005000|
+newHV|||
+newIO|||
+newLISTOP|||
+newLOGOP|||
+newLOOPEX|||
+newLOOPOP|||
+newMYSUB||5.006000|
+newNULLLIST|||
+newOP|||
+newPADOP||5.006000|
+newPMOP|||
+newPROG|||
+newPVOP|||
+newRANGE|||
+newRV_inc|5.004000||p
+newRV_noinc|5.006000||p
+newRV|||
+newSLICEOP|||
+newSTATEOP|||
+newSUB|||
+newSVOP|||
+newSVREF|||
+newSVhek||5.009003|
+newSViv|||
+newSVnv|||
+newSVpvf_nocontext|||vn
+newSVpvf||5.004000|v
+newSVpvn_share||5.007001|
+newSVpvn|5.006000||p
+newSVpv|||
+newSVrv|||
+newSVsv|||
+newSVuv|5.006000||p
+newSV|||
+newUNOP|||
+newWHILEOP||5.009003|
+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|
+next_symbol|||
+nextargv|||
+nextchar|||
+ninstr|||
+no_bareword_allowed|||
+no_fh_allowed|||
+no_op|||
+not_a_number|||
+nothreadhook||5.008000|
+nuke_stacks|||
+num_overflow|||n
+oopsAV|||
+oopsCV|||
+oopsHV|||
+op_clear|||
+op_const_sv|||
+op_dump||5.006000|
+op_free|||
+op_null||5.007002|
+op_refcnt_lock||5.009002|
+op_refcnt_unlock||5.009002|
+open_script|||
+pMY_CXT_|5.007003||p
+pMY_CXT|5.007003||p
+pTHX_|5.006000||p
+pTHX|5.006000||p
+pack_cat||5.007003|
+pack_rec|||
+package|||
+packlist||5.008001|
+pad_add_anon|||
+pad_add_name|||
+pad_alloc|||
+pad_block_start|||
+pad_check_dup|||
+pad_compname_type|||
+pad_findlex|||
+pad_findmy|||
+pad_fixup_inner_anons|||
+pad_free|||
+pad_leavemy|||
+pad_new|||
+pad_push|||
+pad_reset|||
+pad_setsv|||
+pad_sv|||
+pad_swipe|||
+pad_tidy|||
+pad_undef|||
+parse_body|||
+parse_unicode_opts|||
+path_is_absolute|||
+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|||
+pmflag|||
+pmop_dump||5.006000|
+pmruntime|||
+pmtrans|||
+pop_scope|||
+pregcomp|||
+pregexec|||
+pregfree|||
+prepend_elem|||
+printf_nocontext|||vn
+ptr_table_clear|||
+ptr_table_fetch|||
+ptr_table_free|||
+ptr_table_new|||
+ptr_table_split|||
+ptr_table_store|||
+push_scope|||
+put_byte|||
+pv_display||5.006000|
+pv_uni_display||5.007003|
+qerror|||
+re_croak2|||
+re_dup|||
+re_intuit_start||5.006000|
+re_intuit_string||5.006000|
+realloc||5.007002|n
+reentrant_free|||
+reentrant_init|||
+reentrant_retry|||vn
+reentrant_size|||
+refkids|||
+refto|||
+ref|||
+reg_node|||
+reganode|||
+regatom|||
+regbranch|||
+regclass_swash||5.007003|
+regclass|||
+regcp_set_to|||
+regcppop|||
+regcppush|||
+regcurly|||
+regdump||5.005000|
+regexec_flags||5.005000|
+reghop3|||
+reghopmaybe3|||
+reghopmaybe|||
+reghop|||
+reginclass|||
+reginitcolors||5.006000|
+reginsert|||
+regmatch|||
+regnext||5.005000|
+regoptail|||
+regpiece|||
+regpposixcc|||
+regprop|||
+regrepeat_hard|||
+regrepeat|||
+regtail|||
+regtry|||
+reguni|||
+regwhite|||
+reg|||
+repeatcpy|||
+report_evil_fh|||
+report_uninit|||
+require_errno|||
+require_pv||5.006000|
+rninstr|||
+rsignal_restore|||
+rsignal_save|||
+rsignal_state||5.004000|
+rsignal||5.004000|
+run_body|||
+runops_debug||5.005000|
+runops_standard||5.005000|
+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_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_hek_flags|||
+save_helem||5.004050|
+save_hints||5.005000|
+save_hptr|||
+save_int|||
+save_item|||
+save_iv||5.005000|
+save_lines|||
+save_list|||
+save_long|||
+save_magic|||
+save_mortalizesv||5.007001|
+save_nogv|||
+save_op|||
+save_padsv||5.007001|
+save_pptr|||
+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_threadsv||5.005000|
+save_vptr||5.006000|
+savepvn|||
+savepv|||
+savesharedpv||5.007003|
+savestack_grow_cnt||5.008001|
+savestack_grow|||
+savesvpv||5.009002|
+sawparens|||
+scalar_mod_type|||
+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.008001|
+scan_word|||
+scope|||
+screaminstr||5.005000|
+seed|||
+set_context||5.006000|n
+set_csh|||
+set_numeric_local||5.006000|
+set_numeric_radix||5.006000|
+set_numeric_standard||5.006000|
+setdefout|||
+setenv_getix|||
+share_hek_flags|||
+share_hek|||
+si_dup|||
+sighandler|||n
+simplify_sort|||
+skipspace|||
+sortsv||5.007003|
+ss_dup|||
+stack_grow|||
+start_glob|||
+start_subparse||5.004000|
+stashpv_hvname_match||5.009003|
+stdize_locale|||
+strEQ|||
+strGE|||
+strGT|||
+strLE|||
+strLT|||
+strNE|||
+str_to_version||5.006000|
+strnEQ|||
+strnNE|||
+study_chunk|||
+sub_crush_depth|||
+sublex_done|||
+sublex_push|||
+sublex_start|||
+sv_2bool|||
+sv_2cv|||
+sv_2io|||
+sv_2iuv_non_preserve|||
+sv_2iv_flags||5.009001|
+sv_2iv|||
+sv_2mortal|||
+sv_2nv|||
+sv_2pv_flags||5.007002|
+sv_2pv_nolen|5.006000||p
+sv_2pvbyte_nolen|||
+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_mg|5.006000||p
+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.006000||p
+sv_catpvn_nomg|5.007002||p
+sv_catpvn|||
+sv_catpv|||
+sv_catsv_flags||5.007002|
+sv_catsv_mg|5.006000||p
+sv_catsv_nomg|5.007002||p
+sv_catsv|||
+sv_chop|||
+sv_clean_all|||
+sv_clean_objs|||
+sv_clear|||
+sv_cmp_locale||5.004000|
+sv_cmp|||
+sv_collxfrm|||
+sv_compile_2op||5.008001|
+sv_copypv||5.007003|
+sv_dec|||
+sv_del_backref|||
+sv_derived_from||5.004000|
+sv_dump|||
+sv_dup|||
+sv_eq|||
+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_inc|||
+sv_insert|||
+sv_isa|||
+sv_isobject|||
+sv_iv||5.005000|
+sv_len_utf8||5.006000|
+sv_len|||
+sv_magicext||5.007003|
+sv_magic|||
+sv_mortalcopy|||
+sv_newmortal|||
+sv_newref|||
+sv_nolocking||5.007003|
+sv_nosharing||5.007003|
+sv_nounlocking||5.007003|
+sv_nv||5.005000|
+sv_peek||5.005000|
+sv_pos_b2u||5.006000|
+sv_pos_u2b||5.006000|
+sv_pvbyten_force||5.006000|
+sv_pvbyten||5.006000|
+sv_pvbyte||5.006000|
+sv_pvn_force_flags||5.007002|
+sv_pvn_force|||p
+sv_pvn_nomg|5.007003||p
+sv_pvn|5.006000||p
+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_release_COW|||
+sv_release_IVX|||
+sv_replace|||
+sv_report_used|||
+sv_reset|||
+sv_rvweaken||5.006000|
+sv_setiv_mg|5.006000||p
+sv_setiv|||
+sv_setnv_mg|5.006000||p
+sv_setnv|||
+sv_setpv_mg|5.006000||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.006000||p
+sv_setpvn|||
+sv_setpv|||
+sv_setref_iv|||
+sv_setref_nv|||
+sv_setref_pvn|||
+sv_setref_pv|||
+sv_setref_uv||5.007001|
+sv_setsv_cow|||
+sv_setsv_flags||5.007002|
+sv_setsv_mg|5.006000||p
+sv_setsv_nomg|5.007002||p
+sv_setsv|||
+sv_setuv_mg|5.006000||p
+sv_setuv|5.006000||p
+sv_tainted||5.004000|
+sv_taint||5.004000|
+sv_true||5.005000|
+sv_unglob|||
+sv_uni_display||5.007003|
+sv_unmagic|||
+sv_unref_flags||5.007001|
+sv_unref|||
+sv_untaint||5.004000|
+sv_upgrade|||
+sv_usepvn_mg|5.006000||p
+sv_usepvn|||
+sv_utf8_decode||5.006000|
+sv_utf8_downgrade||5.006000|
+sv_utf8_encode||5.006000|
+sv_utf8_upgrade_flags||5.007002|
+sv_utf8_upgrade||5.007001|
+sv_uv|5.006000||p
+sv_vcatpvf_mg|5.006000|5.004000|p
+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
+svtype|||
+swallow_bom|||
+swash_fetch||5.007002|
+swash_init||5.006000|
+sys_intern_clear|||
+sys_intern_dup|||
+sys_intern_init|||
+taint_env|||
+taint_proper|||
+tmps_grow||5.006000|
+toLOWER|||
+toUPPER|||
+to_byte_substr|||
+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.007003|
+to_utf8_lower||5.007003|
+to_utf8_substr|||
+to_utf8_title||5.007003|
+to_utf8_upper||5.007003|
+tokeq|||
+tokereport|||
+too_few_arguments|||
+too_many_arguments|||
+unlnk|||
+unpack_rec|||
+unpack_str||5.007003|
+unpackstring||5.008001|
+unshare_hek_or_pvn|||
+unshare_hek|||
+unsharepvn||5.004000|
+upg_version||5.009000|
+usage|||
+utf16_textfilter|||
+utf16_to_utf8_reversed||5.006001|
+utf16_to_utf8||5.006001|
+utf16rev_textfilter|||
+utf8_distance||5.006000|
+utf8_hop||5.006000|
+utf8_length||5.007001|
+utf8_mg_pos_init|||
+utf8_mg_pos|||
+utf8_to_bytes||5.006001|
+utf8_to_uvchr||5.007001|
+utf8_to_uvuni||5.007001|
+utf8n_to_uvchr||5.007001|
+utf8n_to_uvuni||5.007001|
+utilize|||
+uvchr_to_utf8_flags||5.007003|
+uvchr_to_utf8||5.007001|
+uvuni_to_utf8_flags||5.007003|
+uvuni_to_utf8||5.007001|
+validate_suid|||
+varname|||
+vcmp||5.009000|
+vcroak||5.006000|
+vdeb||5.007003|
+vdie|||
+vform||5.006000|
+visit|||
+vivify_defelem|||
+vivify_ref|||
+vload_module||5.006000|
+vmess||5.006000|
+vnewSVpvf|5.006000|5.004000|p
+vnormal||5.009002|
+vnumify||5.009000|
+vstringify||5.009000|
+vwarner||5.006000|
+vwarn||5.006000|
+wait4pid|||
+warn_nocontext|||vn
+warner_nocontext|||vn
+warner||5.006000|v
+warn|||v
+watch|||
+whichsig|||
+write_to_stderr|||
+yyerror|||
+yylex|||
+yyparse|||
+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, %depends);
+my $replace = 0;
+my $hint = '';
+
+while (<DATA>) {
+ if ($hint) {
+ if (m{^\s*\*\s(.*?)\s*$}) {
+ $hints{$hint} ||= ''; # suppress warning with older perls
+ $hints{$hint} .= "$1\n";
+ }
+ else {
+ $hint = '';
+ }
+ }
+ $hint = $1 if m{^\s*$rccs\sHint:\s+(\w+)\s*$};
+
+ $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+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
+ push @{$depends{$1}}, map { s/\s+//g; $_ } split /,/, $2;
+ }
+
+ $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
+}
+
+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 "$hints{$f}" if exists $hints{$f};
+ $info++;
+ }
+ unless ($info) {
+ print "No portability information available.\n";
+ }
+ $count++;
+ }
+ if ($count > 0) {
+ print "\n";
+ }
+ else {
+ print "Found no API matching '$opt{'api-info'}'.\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};
+ my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
+ print "$f$flags\n";
+ }
+ exit 0;
+}
+
+my @files;
+my @srcext = qw( xs c h cc cpp );
+my $srcext = join '|', @srcext;
+
+if (@ARGV) {
+ my %seen;
+ @files = grep { -f && !exists $seen{$_} } map { glob $_ } @ARGV;
+}
+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;
+}
+
+unless (@files) {
+ die "No input files given!\n";
+}
+
+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 comments from the code
+ my @ccom;
+ $c =~ s{
+ (
+ [^"'/]+
+ |
+ (?:"[^"\\]*(?:\\.[^"\\]*)*" [^"'/]*)+
+ |
+ (?:'[^'\\]*(?:\\.[^'\\]*)*' [^"'/]*)+
+ )
+ |
+ (/ (?:
+ \*[^*]*\*+(?:[^$ccs][^*]*\*+)* /
+ |
+ /[^\r\n]*
+ ))
+ }{
+ defined $2 and push @ccom, $2;
+ defined $1 ? $1 : "$ccs$#ccom$cce";
+ }egsx;
+
+ $file{ccom} = \@ccom;
+ $file{code} = $c;
+ $file{has_inc_ppport} = ($c =~ /#.*include.*\Q$ppport\E/);
+
+ 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}) {
+ 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) {
+ if (exists $need{$_}) {
+ $file{needs}{$_} = 'static';
+ }
+ }
+ }
+ }
+ 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};
+
+ for $func (sort keys %{$file{uses_Perl}}) {
+ if ($API{$func}{varargs}) {
+ 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}}) {
+ next unless $file{uses}{$func}; # if it's only a dependency
+ if (exists $file{uses_deps}{$func}) {
+ diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
+ }
+ elsif (exists $replace{$func}) {
+ warning("Uses $func instead of $replace{$func}");
+ $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
+ }
+ else {
+ diag("Uses $func");
+ }
+ hint($func);
+ }
+
+ for $func (sort keys %{$file{uses_todo}}) {
+ warning("Uses $func, which may not be portable below perl ",
+ format_version($API{$func}{todo}));
+ }
+
+ 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");
+ }
+
+ 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 mydiff
+{
+ local *F = shift;
+ my($file, $str) = @_;
+ my $diff;
+
+ if (exists $opt{diff}) {
+ $diff = run_diff($opt{diff}, $file, $str);
+ }
+
+ if (!defined $diff and can_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 can_use
+{
+ eval "use @_;";
+ return $@ eq '';
+}
+
+sub rec_depend
+{
+ my $func = shift;
+ my %seen;
+ return () unless exists $depends{$func};
+ grep !$seen{$_}++, map { ($_, rec_depend($_)) } @{$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;
+sub hint
+{
+ $opt{quiet} and return;
+ $opt{hints} or return;
+ my $func = shift;
+ exists $hints{$func} or return;
+ $given_hints{$func}++ and return;
+ my $hint = $hints{$func};
+ $hint =~ s/^/ /mg;
+ print " --- hint for $func ---\n", $hint;
+}
+
+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;
+}
+
+__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 PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + 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 */
+
+#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 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 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
+#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
+
+#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
+/* Replace: 1 */
+# define PL_DBsingle DBsingle
+# define PL_DBsub DBsub
+# define PL_Sv Sv
+# 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_hexdigit hexdigit
+# define PL_hints hints
+# define PL_na na
+# define PL_no_modify no_modify
+# define PL_perl_destruct_level perl_destruct_level
+# define PL_perldb perldb
+# define PL_ppaddr ppaddr
+# define PL_rsfp_filters rsfp_filters
+# define PL_rsfp rsfp
+# define PL_stack_base stack_base
+# define PL_stack_sp stack_sp
+# 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
+/* Replace: 0 */
+#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 NOOP
+# define NOOP (void)0
+#endif
+
+#ifndef dNOOP
+# define dNOOP extern int 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
+
+# define NUM2PTR(any,d) (any)(PTRV)(d)
+# define PTR2IV(p) INT2PTR(IV,p)
+# define PTR2UV(p) INT2PTR(UV,p)
+# define PTR2NV(p) NUM2PTR(NV,p)
+
+# if PTRSIZE == LONGSIZE
+# define PTR2ul(p) (unsigned long)(p)
+# else
+# define PTR2ul(p) INT2PTR(unsigned long,p)
+# endif
+
+#endif /* !INT2PTR */
+
+#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
+
+#ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
+# if defined(__STRICT_ANSI__) && defined(PERL_GCC_PEDANTIC)
+# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
+# endif
+#endif
+
+#undef STMT_START
+#undef STMT_END
+#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
+# 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
+
+/* Older perls (<=5.003) lack AvFILLp */
+#ifndef AvFILLp
+# define AvFILLp AvFILL
+#endif
+#ifndef ERRSV
+# define ERRSV get_sv("@",FALSE)
+#endif
+#ifndef newSVpvn
+# define newSVpvn(data,len) ((data) \
+ ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
+ : newSV(0))
+#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 */
+
+#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 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 Poison
+# define Poison(d,n,t) (void)memset((char*)(d), 0xAB, (n) * sizeof(t))
+#endif
+#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 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
+#ifndef dTHXoa
+# define dTHXoa(x) dTHXa(x)
+#endif
+#ifndef PUSHmortal
+# define PUSHmortal PUSHs(sv_newmortal())
+#endif
+
+#ifndef mPUSHp
+# define mPUSHp(p,l) sv_setpvn_mg(PUSHmortal, (p), (l))
+#endif
+
+#ifndef mPUSHn
+# define mPUSHn(n) sv_setnv_mg(PUSHmortal, (NV)(n))
+#endif
+
+#ifndef mPUSHi
+# define mPUSHi(i) sv_setiv_mg(PUSHmortal, (IV)(i))
+#endif
+
+#ifndef mPUSHu
+# define mPUSHu(u) sv_setuv_mg(PUSHmortal, (UV)(u))
+#endif
+#ifndef XPUSHmortal
+# define XPUSHmortal XPUSHs(sv_newmortal())
+#endif
+
+#ifndef mXPUSHp
+# define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn_mg(PUSHmortal, (p), (l)); } STMT_END
+#endif
+
+#ifndef mXPUSHn
+# define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv_mg(PUSHmortal, (NV)(n)); } STMT_END
+#endif
+
+#ifndef mXPUSHi
+# define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv_mg(PUSHmortal, (IV)(i)); } STMT_END
+#endif
+
+#ifndef mXPUSHu
+# define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv_mg(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 */
+
+/* Replace perl_eval_pv with eval_pv */
+/* eval_pv depends on eval_sv */
+
+#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 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_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))) && ((PERL_VERSION != 4) || (PERL_SUBVERSION != 5))
+#if defined(NEED_newCONSTSUB)
+static void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
+static
+#else
+extern void DPPP_(my_newCONSTSUB)(HV *stash, 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)
+
+void
+DPPP_(my_newCONSTSUB)(HV *stash, 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 = PL_copline;
+
+ PL_hints &= ~HINT_BLOCK_SCOPE;
+ if (stash)
+ PL_curstash = PL_curcop->cop_stash = stash;
+
+ newSUB(
+
+#if ((PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22)))
+ start_subparse(),
+#elif ((PERL_VERSION == 3) && (PERL_SUBVERSION == 22))
+ start_subparse(0),
+#else /* 5.003_23 onwards */
+ start_subparse(FALSE, 0),
+#endif
+
+ newSVOP(OP_CONST, 0, newSVpv(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_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 ))
+/* 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"
+# else
+# if IVSIZE == INTSIZE
+# define IVdf "d"
+# define UVuf "u"
+# define UVof "o"
+# define UVxf "x"
+# define UVXf "X"
+# endif
+# endif
+#endif
+
+#ifndef NVef
+# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
+ defined(PERL_PRIfldbl) /* 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 SvPV_nolen
+
+#if defined(NEED_sv_2pv_nolen)
+static char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
+static
+#else
+extern char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
+#endif
+
+#ifdef sv_2pv_nolen
+# undef sv_2pv_nolen
+#endif
+#define sv_2pv_nolen(a) DPPP_(my_sv_2pv_nolen)(aTHX_ a)
+#define Perl_sv_2pv_nolen DPPP_(my_sv_2pv_nolen)
+
+#if defined(NEED_sv_2pv_nolen) || defined(NEED_sv_2pv_nolen_GLOBAL)
+
+char *
+DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv)
+{
+ STRLEN n_a;
+ return sv_2pv(sv, &n_a);
+}
+
+#endif
+
+/* Hint: sv_2pv_nolen
+ * Use the SvPV_nolen() macro instead of sv_2pv_nolen().
+ */
+
+/* SvPV_nolen depends on sv_2pv_nolen */
+#define SvPV_nolen(sv) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? SvPVX(sv) : sv_2pv_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_VERSION < 7) || ((PERL_VERSION == 7) && (PERL_SUBVERSION < 0)))
+
+#if defined(NEED_sv_2pvbyte)
+static char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
+static
+#else
+extern char * DPPP_(my_sv_2pvbyte)(pTHX_ register 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_ register 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
+
+/* SvPVbyte depends on sv_2pvbyte */
+#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
+
+/* sv_2pvbyte_nolen depends on sv_2pv_nolen */
+#ifndef sv_2pvbyte_nolen
+# define sv_2pvbyte_nolen sv_2pv_nolen
+#endif
+
+/* Hint: sv_pvn
+ * Always use the SvPV() macro instead of sv_pvn().
+ */
+#ifndef sv_pvn
+# define sv_pvn(sv, len) SvPV(sv, len)
+#endif
+
+/* Hint: sv_pvn_force
+ * Always use the SvPV_force() macro instead of sv_pvn_force().
+ */
+#ifndef sv_pvn_force
+# define sv_pvn_force(sv, len) SvPV_force(sv, len)
+#endif
+
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !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
+
+/* sv_vcatpvf depends on sv_vcatpvfn */
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf)
+# define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
+#endif
+
+/* sv_vsetpvf depends on sv_vsetpvfn */
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf)
+# define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
+#endif
+
+/* sv_catpvf_mg depends on sv_vcatpvfn, sv_catpvf_mg_nocontext */
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !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
+
+/* sv_catpvf_mg_nocontext depends on sv_vcatpvfn */
+#ifdef PERL_IMPLICIT_CONTEXT
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !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
+
+#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
+
+/* sv_vcatpvf_mg depends on sv_vcatpvfn */
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !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
+
+/* sv_setpvf_mg depends on sv_vsetpvfn, sv_setpvf_mg_nocontext */
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !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
+
+/* sv_setpvf_mg_nocontext depends on sv_vsetpvfn */
+#ifdef PERL_IMPLICIT_CONTEXT
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !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
+
+#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
+
+/* sv_vsetpvf_mg depends on sv_vsetpvfn */
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !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
+#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 SvPV_force_nomg
+# define SvPV_force_nomg SvPV_force
+#endif
+
+#ifndef SvPV_nomg
+# define SvPV_nomg SvPV
+#endif
+
+#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
+
+#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
+
+/* GROK_NUMERIC_RADIX depends on grok_numeric_radix */
+#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 /* PERL_VERSION */
+#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
+
+/* grok_number depends on grok_numeric_radix */
+
+#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_ char *start, STRLEN *len_p, I32 *flags, NV *result);
+static
+#else
+extern UV DPPP_(my_grok_bin)(pTHX_ 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_ 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_ char *start, STRLEN *len_p, I32 *flags, NV *result);
+static
+#else
+extern UV DPPP_(my_grok_hex)(pTHX_ 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_ 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_ char *start, STRLEN *len_p, I32 *flags, NV *result);
+static
+#else
+extern UV DPPP_(my_grok_oct)(pTHX_ 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_ 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
+
+#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
+
+#endif /* _P_P_PORTABILITY_H_ */
+
+/* End of File ppport.h */
--- /dev/null
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl Archive-MoPaQ.t'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use Test::More tests => 1;
+BEGIN { use_ok('Archive::MoPaQ') };
+
+#########################
+
+# Insert your test code below, the Test::More module is use()ed here so read
+# its man page ( perldoc Test::More ) for help writing this test script.
+
--- /dev/null
+Archive::MoPaQ T_PTROBJ
--- /dev/null
+package Data::StarCraft::Map;
+
+use strict;
+use warnings;
+use Data::Dumper;
+
+our $VERSION = "0.10";
+our $DEBUG = 0;
+
+sub new {
+ my ($class) = @_;
+ bless {}, $class;
+}
+
+sub _read {
+ my $self = shift;
+ my ($fh, $size, $seek) = @_;
+ seek *$fh, $seek, 0 if $seek;
+ read(*$fh, my $in, $size) eq $size or return undef;
+ return $in;
+}
+
+sub open {
+ my $self = shift;
+ my ($file) = @_;
+
+ while (not eof $file) {
+ local $_ = $self->_read($file, 8)
+ and my ($type, $size) = unpack "a4V", $_
+ or die "Couldn't chunk header\n";
+ $type =~ s/ +$//;
+#printf STDERR "%s: %s\n", $type, $size;
+ defined $self->{$type} and warn "duplicate map chunk $type\n";
+ $self->{$type} = $self->_read($file, $size);
+ }
+ return $self;
+}
+
+sub version {
+ my $self = shift;
+ return 'v' . ord $self->{VER};
+}
+
+sub info {
+ my $self = shift;
+ my ($x, $y) = unpack "vv", $self->{DIM};
+ return {
+ x => $x,
+ y => $y,
+ };
+}
+
+sub width {
+ return $_[0]->info->{x};
+}
+
+sub tiles {
+ my $self = shift;
+ my @map = unpack 'v*', $self->{MTXM};
+ @map == $#map + 1 or warn(sprintf
+ "couldn't parse map: only %d tiles\n", scalar @map
+ ), return;
+ return \@map;
+}
+
+my @maptile = (
+ '!' => [ 0.. 31],
+ 'd' => [ 32.. 62, 63], # dirt (verified)
+ 'h' => [ 64.. 94], # high dirt
+ "~" => [ 96..117, 118..127], # water
+ 'j' => [128..159], # jungle/crushed rock
+ 'o' => [160..186, 187..191], # rocky/shale (verified)
+ 'R' => [192..223], # raised jungle
+ 'l' => [224..252, 253..255], # lava/ruins (verified)/flagstones?
+ 'b' => [256..287], # basilica?
+ 'x' => [288..319], # high jungle
+# 'x' => [3745..3792], # high jungle
+ 'q' => [320..351], # high ruins
+ ' ' => [352..383],
+ 'a' => [384..415], # high basilica
+ 'm' => [416..447], # mud
+ ' ' => [448..479],
+ ' ' => [480..511],
+
+ ' ' => [512..543],
+ ' ' => [544..575],
+ '/' => [576..607], # high dirt -> dirt (top left)
+ '/' => [608..639], # dirt -> high dirt
+ '\\' => [640..671], # high dirt -> dirt (top right)
+ '\\' => [672..703], # dirt -> high dirt (bottom left)
+ '\\' => [704..735], # high dirt -> dirt (bottom left)
+ '\\' => [736..767], # dirt -> high dirt (top right)
+ '/' => [768..863],
+ '=' => [864..1055], # some edge (tmp)
+ '=' => [1056..1183],
+ '=' => [1184..1727],
+ 'D' => [1728..1780], # edge water
+ '/' => [1760..1791], # dirt -> water (top left)
+ '\\' => [1792..1823], # dirt -> water (top right)
+
+ 'd' => [609..611],
+ 'W' => [2048..2303],
+ '/' => [2304..2559],
+ 'W' => [2560..2815],
+ 'j' => [2816..3071],
+ 'd' => [3072..3327],
+ 'j' => [3328..3583],
+ 'x' => [3648..3839],
+ 'h' => [3840..4095],
+# 'x' => [4096..4351],
+ 'h' => [4096..4351],
+# 'x' => [4352..4607],
+# ' ' => [4608..4863],
+ 'l' => [4864..5311],
+ 'q' => [5312..5503],
+ 'x' => [5504..5631],
+ 'q' => [5632..5759],
+ 'j' => [5760..5823],
+# ' ' => [5824..5887],
+ '=' => [5888..6143], # raised jungle -> jungle
+# ' ' => [6144..6655],
+ '/' => [6656..7167],
+ '/' => [7168..7359], # basilica -> crushed rock
+ '/' => [7360..7551],
+ 'i' => [7552..7807], # high temple
+# ' ' => [7808..8959],
+# '=' => [8960..9087],
+# 'd' => [9088..9215],
+# ' ' => [9216..9727],
+# 'm' => [9728..9983],
+# # >= 9984 unencountered
+# ' ' => [19968..20480], # something here on twilight
+# ' ' => [20544..20736], # center thing on twilight
+# '~' => [20896..21023], # something in the water on twilight
+# 'x' => [23104..23231], # something on twilight (on X or H)
+#
+# 'm' => [9216..9776], # mud <-> dirt
+# 'r' => [5792..5875, 5888..5904], # raised jungle edge
+#
+# 'd' => [3042..3250], # dirt<->grass
+# 'P' => [4608..4977], # dirt<->shale (verified) [also seems to be rocks on mud]
+# #'=' => [768..1731], # dirt<->lava ridge (verified)
+
+ 'h' => [16389],
+ '1' => [16405, 16388],
+ '2' => [16421, 16404, 16387],
+ '3' => [16437, 16420, 16403, 16386],
+ '4' => [16453, 16436, 16419, 16402, 16385],
+ '5' => [ 16435, 16418, 16401, 16384],
+ '6' => [ 16434, 16417, 16400],
+ '7' => [ 16433, 16416],
+ 'd' => [16501, 16432],
+ '7' => [16485, 16500], # these ↕ aren't ramps in temple!!
+ '6' => [16469, 16484, 16499],
+ '5' => [16453, 16468, 16483, 16498],
+ '4' => [ 16452, 16467, 16482, 16497],
+ '3' => [ 16451, 16466, 16481, 16496],
+ '2' => [ 16450, 16465, 16480],
+ '1' => [ 16449, 16464],
+ 'h' => [17248, 16448],
+ '1' => [17264, 17249],
+ '1' => [17280, 17265, 17250],
+ '2' => [17296, 17281, 17266, 17251],
+ '3' => [17312, 17297, 17282, 17267, 17252],
+ '4' => [17328, 17313, 17298, 17283, 17268, 17253],
+ '5' => [ 17329, 17314, 17299, 17284, 17269],
+ '6' => [ 17330, 17315, 17300, 17285],
+ '7' => [ 17331, 17316, 17301],
+ '7' => [ 17332, 17317],
+ 'd' => [17232, 17333],
+ '7' => [17216, 17233],
+ '7' => [17200, 17217, 17234],
+ '6' => [17184, 17201, 17218, 17235],
+ '5' => [17168, 17185, 17202, 17219, 17236],
+ '4' => [17152, 17169, 17186, 17203, 17220, 17237],
+ '3' => [ 17153, 17170, 17187, 17204, 17221],
+ '2' => [ 17154, 17171, 17188, 17205],
+ '1' => [ 17155, 17172, 17189],
+ '1' => [ 17156, 17173],
+ 'h' => [ 17157],
+);
+
+my %eratile = (
+ 4 => [
+ # Longinus (by KuKulZa, modified MBCgame/iCCup)
+ # SPRP: 6,0,1,0
+ # TYPE: 82,65,87,66
+ # VER: 205,0
+ # SIDE: 5,5,5,1,2,0,1,2,7,7,7,4
+ 'd' => [
+ 19760..19761, 19792, 19793, 19680, 19681, 19712, 19713, 19664, 19665, 19728, 19729, # D→J
+ 19808,19809, 19776,19777, 19872,19873, 19920,19921,
+ 19744,19745, 19696,19697, 19632,19633, 19696,19697, 19952,19953,
+ 19568,19569, # below ridge
+ 3618,3634, 3586,3602, # D←J
+ 3601, # D→J(3585)
+ ],
+ 'j' => [
+ 21968, 21969, 21984, 21985,
+ 21824,21825,21840,21841, 21856,21857,21872,21873, 21792,21793,
+ 21808,21809, 21888,21889,21904,21905,
+ 3616,3632,3584,3600,3616,3632, # J→D
+ 3585, # J→D(3601)
+ ],
+ 'l' => [
+ 22608..22611, 22624..22627, 22640..22643,
+ ],
+ 'o' => [
+ 24850, # besides ladder
+ 20832,20833,20848,20849, 20768,20769,20784,20785,
+ 20864,20865,20880,20881,
+ 20704,20705,20720,20721, # large rock
+ 4432,4433,4434,4448,4449,4464,4465,
+ 4545,4561,4577,4593, 4544,4560,4576,4592,
+ ],
+ 'h' => [
+ 18000,18001, # H→X
+ 17952,17953, 17936,17937, 17920,17921, 17856,17857, 17888,17889, # H→X unsure
+ 17984,17985, 18160,18161, 18128,18129, 18048,18049,
+ 19648,19649,19616,19617, 18016,18017,
+ 17696,17697,17712,17713, # tree
+ 17872,17873,17904,17905, 18144,18145,
+ 18448,18449,18464,18465,18480,18481,
+ ],
+ 'm' => [ # mud hole
+ 9219,9235,9539,9555,
+ 9218,9234,9795,9235,9811,9571,9587,
+ 9472,9488,9250,9266,9635,9651,9280,9296,
+ 9504,9520,9665,9681,9344,9360,9760,9776,9539,9555,
+ 9475,9491,9889,9905,9376,9392,9440,9456,9571,9587,
+ 9507,9523,9377,9393,
+
+ 9537,9553,
+ 9569,9585,9474,9490,9283,9299,9216,9232,9536,9552,
+ 9536,9552,9923,9939,9283,9299,9506,9522,9827,9843,9728,9744,9568,9584,
+ 9283,9299,9217,9233,9731,9747,9568,9584,9699,9715,9315,9331,9284,9300,9217,9233,9955,9971,
+ 9763,9779,9793,9809,9379,9395,9664,9680,9316,9332,9249,9265,9536,9552,
+ 9443,9459,9921,9937,9284,9300,9216,9232,9284,9300,9216,9232,9696,9712,9345,9361,9409,9425,9604,9620,9568,9584,
+ 9216,9232,9764,9780,9248,9264,9316,9332,9248,9264,9346,9362,9441,9457,9860,9876,9537,9553,
+ 9728,9744,9444,9460,9667,9683,9348,9364,9411,9427,9602,9618,9378,9394,9444,9460,9569,9585,
+ 9891,9907,9380,9396,9443,9459,9858,9874,9540,9556,
+ 9379,9395,9442,9458,9572,9588,
+ ],
+ '/' => [
+ # Longinus (by KuKulZa, modified MBCgame/iCCup)
+ 9125, 9141, 9126, 9142, # D→~
+ 9120, 9136, # H→D
+ 9059,9075, 9189,9205, # D→~
+ 19824,19825, # D→~
+ 19200,19201,19216,19217, # object on D
+ ],
+ '/' => [
+ 17632,17633,17648,17649, # H rotating thing
+ 18208,18209, # H skull thing
+ 18224,18225,18240,18241, # H statuey thing
+ ],
+ 'q' => [
+ 23872,23873,23874,23875,23888,23889,23890,23891,23904,23905,23906,23907, # Q crater
+ 23680,23681,23696,23697,23712,23713,
+ ],
+ 'x' => [
+ 24336,24337,24352,24353, 24272,24273,24288,24289,
+ 24272,24273,24288,24289, 24368,24369,24384,24385,
+ 4353,4369, 4385,4401,4353,4369, 4386,4402, 4385,4401,
+ 4386,4402,4354,4370,4386,4402,
+ ],
+ '/' => [
+ 19856,19857,20144,20145, # D skeleton
+ ],
+ '/' => [21184], 'W' => [21185,21200,21201,21216,21217], # standing rock
+ '/' => [21232], 'W' => [21233,21248,21249,21264,21265], # standing rock
+ '7' => [25011, 25010], # M»H
+ '7' => [24699, 25143], 6 => [24716], # M»H
+ 'W' => # island o' rocks
+ [21120..21125, 21136..21141, 21152..21157, 21168..21173],
+ '/' => [21121,21122,21136..21139,21152..21154],
+ '~' => [21120,21124,21125,21141,21157,21171..21173],
+ '/' => [
+ # D→~ coast
+ 8997,9013,8963,8979, 8996,9012,8963,8979,8993,9009, 8997,9013,
+ 8998,9014, 8993,9009, 9187,9203, 9121,9137, 9131,9147, 8992,9008,
+ 9190,9206, 9062,9078, 8996,9012, 9090,9106,9194,9210,
+ 9061,9077,9029,9045,9184,9200,8998,9014, 9024,9040,8997,9013,
+ ],
+
+ # Lost Temple (default?)
+ # SPRP: 4,0,5,0
+ # VER: 59,0
+ # SIDE: 5,5,5,5,0,2,1,0,7,7,7,4
+ '/' => [
+ 9089,9105, # H←D
+ 9196,9212, # H←D→~
+ 8966,8982, 8962,8978, # H→~
+ 9088,9104, # D→D/~
+ 16832..16835,16848..16851,16864..16867,16880..16883, # H→D ridge (ramp elsewhere?)
+ 16384..16389, 16400..16405, 16416..16421, 16432..16437, # idem
+ 8961,8977,9155,9171, # H←D→~
+ 20160,20161,19984,19985,19986,19987,20000,20001,20002,20003, # D→H
+ 9124,9140, 9122,9138, 9002,9018, 8960,8976, 9168,9152, 8995,9011, # H→D→~
+ 9057,9073, # H→D→~ temple.6
+ 8968,8984, # D↔H
+ ],
+ 'j' => [
+ 21952,21953,
+ ],
+ 'x' => [
+ 4384,4400, 4352,4368, # X→H
+ ],
+ 'h' => [
+ 18096,18097, 17968,17969, 18032,18033,18176,18177,
+ ],
+ 'd' => [
+ 9347,9363,9953,9969,9473,9489,9251,9267,9633,9649,9505,9521,9410,9426,
+ 9347,9363, 19840,19841, 19888,19889, 20208,20209,20224,20225,
+ 20240,20241,20256,20257, 20272,20273,20288,20289, 19601,19600,
+ 20304,20305,20320,20321, # tree
+ ],
+ 'o' => [
+ 4673,4689,4737,4753,4705,4721,4769,4785, # rocks on D
+ 4674,4690,4706,4722,4674,4690,4480,4496,4706,4722,4832,4848,4640,4656,
+ 4736,4752,4768,4784,
+ 4482,4498, 4834,4850, 4642,4658,
+ ], 'd' => [4498,4642],
+ 'm' => [
+ # M→D mud holes
+ 9281,9297,9313,9329, 9281,9297,9313,9329, 9538,9554,9570,9586,
+ 9282,9298,9282,9298,9220,9236,9476,9492,9314,9330,9729,9745,9412,9428,9476,9492,9314,9330,9538,9554,9476,9492,9252,9268,
+ 9508,9524,9668,9684,9600,9616,9508,9524,9666,9682,9601,9617,9570,9586,9508,9524,9408,9424,9700,9716,9632,9648,9698,9714,9282,9298,9314,9330,
+ 9312,9328, 9412,9428, 9636,9652, 9634,9650,
+ 9730,9746, 9761,9777,9762,9778, 9794,9810,
+ 9732,9748, # temple.5
+ 9603,9619, # temple.6
+ ],
+ 'r' => [
+ 5859,5875, 5858,5874, # top edge
+ ],
+ 'O' => # temple center ornament
+ [
+ 22320,22321,22336,22337,22352,22353,
+ 22368,22369,22384,22385,22400,22401,
+ 22464..22467,22480..22483,22496..22499,
+ 22800,22801,22802,22803,22816,22817,22818,22819,22832,22833,22834,22835,
+ 22752,22753,22754,22755,22768,22769,22770,22771,22784,22785,22786,22787,
+ ],
+ 'l' => [ # cut out shapes
+ 22464,22467,22496,22499, 22321,22353, 22368,22400,
+ 22800,22802,22803,22832,22835, 22819,
+ 22752,22753,22755,22787,22784, 22768,
+ ],
+ 'D' => # underwater cave
+ [
+ 21440,21441,21442,21443, 21456,21457,21458,21459,
+ 21472,21473,21474,21475, 21488,21489,21490,21491,
+ ],
+ 'W' => [21456, 21472,21473,21474,21475],
+ 'o' => [21442,21443],
+ '~' => [21488,21489, 21490,21491],
+ 'i' => [
+ 23632,23633,23648,23649,23664,23665, 23584,23585,23600,23601,23616,23617, # statue things on Q
+ ],
+ 'D' => [1824..1839], 'W' => [1840..1855], # D→~ bright transition
+ 'D' => [1856..1871], 'd' => [1872..1887], # D→~ bleft ridge
+ 'W' => [1888..1903], 'D' => [1904..1919], # D→~ bleft transition
+ '~' => [1920..1935], 'W' => [1936..1951], # w→~ bleft transition
+ 'd' => [1952..1967], 'D' => [1968..1983],
+ 'D' => [1984..1999], 'W' => [2000..2015],
+ 'W' => [2016..2031], '~' => [2032..2047],
+ 'D' => [8965,8981, 8964,8980, 9174,9158, 9010,8994], # H→D→~
+ 'd' => [19936,19937], # D→~
+ '/' => [19905], 'd' => [19904], # H→D
+ 'r' => [
+ 5825,5841, 5857,5873, # J→R→map edge
+ 5826,5842, # J↔R
+ ],
+ 'q' => [
+ # gap
+ 23456,23457,23458,23459, 23472,23473,23474,23475,
+ 23488,23489,23490,23491, 23504,23505,23506,23507,
+ # towery thing
+ 23824,23825,23826,23827, 23840,23841,23842,23843, 23856,23857,23858,23859,
+ ],
+
+ # Plains to Hill (v2.00 by Sir.Lupin)
+ # VER: 59,0
+ # SPRP: 1,0,2,0
+ # SIDE: 5,5,5,5,0,2,1,0,7,7,7,4
+ # FORC: 0,0,0,0,1,1,1,1,31,0,30,0,29,0,28,0,1,11,0,0
+ '/' => [
+ # H→D bottom left side (may be a ramp elsewhere)
+ 16768,16769,16770,16771, 16784,16785,16786,16787,
+ 16800,16801,16802,16803, 16816,16817,16818,16819,
+ # idem bottom right side
+ 16960,16961,16962,16963, 16976,16977,16978,16979,
+ 16992,16993,16994,16995, 17008,17009,17010,17011,
+ # idem
+ 17088,17089,17090,17091, 17104,17105,17106,17107,
+ 17120,17121,17122,17123, 17136,17137,17138,17139,
+ ],
+
+ # Python (v1.3 by Terrance, modified by Forgotten_/KeSPA)
+ # ERA: 100,0
+ # TYPE: 82,65,87,66
+ # VER: 205,0
+ # SPRP: 1,0,7,0
+ # SIDE: 5,5,5,5,0,2,1,0,7,7,7,4
+ # FORC: 0,0,0,0,1,1,1,1,2,0,4,0,5,0,6,0,1,14,15,15
+ 'x' => [
+ 24464,24465, 24448,24449
+ ],
+ 'h' => [
+ 18064,18065,
+ ],
+ '/' => [
+ 9186,9202,
+ 18112,18113, # H→D
+ 9154,9170,9027,9043,9157,9173, # H↔D
+ ],
+ 'O' =>
+ [19504,19505,19520,19521, 18720,18721,18736,18737], # rock things
+ 'h' => [18737],
+ 'O' => # hole
+ [17488..17491,17504..17507,17520..17523,17536..17539],
+ 'h' => [17490,17491,17507,17523,17536..17539],
+ 'o' => [
+ 4610, 4610,4626, 4481,4497,4513,4529, 4514,4530,
+ 4417,4608,4624,4418, 4512,4528, 4450,4466,
+ 4609,4625,4546,4562, 4833,4849, 4801,4817, 4800,4816,
+ ],
+ 'd' => [
+ 4672,4688,4704,4720, # D↔O
+ 19584,19585,
+ 4416, # D→O
+ 4641,4657,4578,4594, 4802,4818, # O→D
+ ],
+ 'm' => [
+ 9824,9840,9952,9968,9920,9936,9888,9904, 9796,9812,9924,9940,
+ 9697,9713, 9890,9906, 9922,9938, 9792,9808,9856,9872,9826,9842,
+ ],
+ 'o' => [4738,4770], 'd' => [4754,4786],
+ '/' => [18256,18257,18272,18273], 'h' => [18288,18289], # obelisk
+ '/' => # sunken temple
+ [21024..21029, 21040..21045, 21056..21061, 21072..21077, 21088..21093,21104..21109],
+ '~' => [21024,21104,21109,21027,21059,21076,21072,21093,],
+ 'W' => [21029, 21060,21045,21073,21090,21106,21092,21107,21075,21108,21058, 21056,21088,21105,21077],
+ 'O' => # ruins similar to 22464
+ [22512..22515, 22528..22531, 22544..22547],
+ 'l' => [22512,22515, 22544,22547],
+ 'Q' => [17664,17665,17680,17681], # rock thing
+ 'Q' => [17728,17729,17744,17745], # tree
+ '/' => [17808,17824,17840], 'h' => [17809,17825,17841],
+ '6' => [25025], # D»H ramp (between D and 17328 = level 4)
+
+#}, 2 => {
+ # Twilight Star (default)
+ # (all guessed from low res thumb)
+ 'h' => [17584,17585], # H→D
+ 'r' => [5827,5843, 5824,5840,5856,5872],
+ 'W' => [
+ # water objects
+ 20912,20913,20928,20929, 20896,20897, 20944,
+ 19440,19441,19456,19457, 20945,20960,20961,
+ 20816,20817,
+ ],
+ 'h' => [17760,17761,17776,17777, 17600,17601],
+ 'D' => [9093,9109],
+ 'o' => [19472..19475, 19488..19491],
+ 'o' => [
+ 21728,21729, 21744,21745, 21760,21761,
+ 21776,21777, 19536,19537, 19538,19539, 19552..19555,
+ ],
+ 'j' => [3587,3603],
+ 'O' => [19232..19235, 19248..19251], 'j' => [19218,19219],
+ 'O' => [19938,19939,19954,19955],
+ 'h' => [17792,17793],
+ 'x' => [4356,4372],
+ 'O' => [ # exotic/shiny things and other objects
+ 18656,18657,18672,18673, 18496,18497,18512,18513,
+ 18560..18563, 18576..18579, 18592..18595,
+ 18528,18529,18544,18545, 18864,18865,
+ 18608..18611,18624..18627,18640..18643,
+ 18912..18915,18928..18931,18944..18947,
+ 18816..18819,18832..18835,18848..18851,
+ 18960..18963,18976..18979,18992..18995,
+ 19008..19011,19024..19027,
+ 19040..19043,19056..19059,
+ ],
+ 'A' => [ # X→A
+ 7811,7827,7873,7889,7809,7825,7875,7891,
+ 8707,8723,8737,8753,7874,7890,7808,7824,7872,7888,7904,
+ 8003,8019,8160,8176,7810,7826,
+ ],
+ 'a' => [ # A←X
+ 7843,7859,7905,7921,7841,7857,7907,7923,
+ 8705,8721,7971,7987,8065,8081,8738,8754,7840,7856,
+ 7920,7906,7922,7938,7954,7969,7985,8066,8082,8035,8051,
+ 7970,7986,8032,8048,
+ 8034,8050,7936,7952,8033,8049,7937,7953,
+ ],
+ 'R' => [6177,6193],
+ '/' => [18080,18081],
+ 'a' => [8032..8047], 'a' => [8048..8063], # #3 bottom left
+ 'A' => [7841..7843], 'a' => [7857..7859], # #2 top left
+ 'A' => [8000..8003], 'x' => [8016..8019], # #1 bottom right
+ 'A' => [8064..8067], 'a' => [8080..8083], # #2 bottom left
+ 'A' => [8224..8227], 'x' => [8240..8243], # #1 top right
+ 'A' => [8288..8291], 'x' => [8304..8307], # #1 bottom right
+ 'a' => [8355], 'A' => [8371], # #2 top right
+ 'a' => [8322], 'A' => [8338], # #2 top right
+ 'A' => [8512], 'x' => [8528], # #1 top right
+ 'x' => [7811], 'A' => [7827],
+ 'x' => [8096..8099], 'A' => [8112..8115],
+ 'x' => [8163], 'a' => [8179],
+ 'x' => [8192..8195], 'A' => [8208..8211],
+ 'x' => [8128..8131], 'A' => [8144..8147],
+ 'A' => [8258,8274],
+ 'a' => [7939,7955], # #3 bottom right
+ 'a' => [7968..7971], 'A' => [7984..7987],
+ 'A' => [8256,8272],
+ 'A' => [8257,8273, 8259,8275, 8162,8178],
+
+ '!' => [],
+
+ # tau cross (v1.1 by Rose.Of.Dream/BW4eVeR)
+ # ERA: 6
+ # FORC: 0,0,0,1,1,1,1,1,7,0,6,0,5,0,4,0,1,15,15,15
+ # SIDE: 5,5,5,1,0,2,1,0,7,7,7,4
+ # SPRP: 1,0,2,0
+ # TYPE: 82,65,87,66
+ # VER: 205
+ '?' => [
+ 6176,6192, 20976,20977, 20592,20593, 21392,21393, 20800,20801,
+ 20608,20609, 20624,20625, 20640,20641, 20992,20993, 21008,21009,
+ 19922,19923,22070,22071, 19968..19971, 22230,
+ 22133,22137,22272,22157,22288,22313,
+ 20592,20593,21392,21393,20800,20801,20608,20609,20624,20625,20640,20641,20992,20993,21008,21009,19922,19923,
+ 22070,22071,19968,19969,19970,19971,22230,22272,22157,22288,22313,6147,6163,6178,6194,3589,3605,22147,22162,22163,22164,
+ 22180,22315,18400,18401,18336,18337,18192,18193,17730,17731,17826,17827,17746,17747,17842,17843,
+ 17762,17763,17794,17795,17778,17779,17810,17811,17616,17617,
+ 20688,20689,6145,6161,20736,20737,21408,21409,21410,21411,
+ 20752,20753,21424,21425,21426,21427,21376,21377,20656,20657,
+ 21312,21313,21314,21315,20672,20673,21328,21329,21330,21331,
+ 6146,6162,21344,21345,21346,21347,21360,21361,21362,21363,6144,
+ 6160,
+ ],
+ '2' => # bridges
+ [
+ 22231..22235, 22246..22253, 22260..22269,
+ 22273..22285, 22289..22301, 22306..22312, 22324..22328,
+ ],
+ '4' => [22246..22253, 22273..22285, 22306..22312],
+ '2' => [
+ 22084..22086, 22096..22103, 22112..22121, 22128..22139,
+ 22144..22156, 22165..22171, 22181..22199,
+ ],
+ '4' => [22084..22086, 22112..22121, 22144..22156, 22181..22199],
+ 'r' => [22342,22343],
+
+ # Nostalgia (WGT13, v1.3 by Rose.of.Dream)
+ # ERA: 0,0
+ # FORC: 0,0,0,0,1,1,1,1,12,0,11,0,10,0,9,0,1,14,0,0
+ # SIDE: 5,5,5,5,0,2,1,0,7,7,7,4
+ # SPRP: 1,0,4,0
+ # TYPE: 82,65,87,66
+ # VER: 205
+ '!' => [],
+ ], # jungle
+);
+
+our %tilechar;
+while (my ($char, $matches) = splice @maptile, 0, 2) {
+ $tilechar{$_} = $char for @$matches;
+}
+while (my ($char, $matches) = splice @{$eratile{4}}, 0, 2) {
+ $tilechar{$_} = $char for @$matches;
+}
+
+my @mapunit = ( # character => width, height, ids
+ '$' => [2,1, 176..178], # minerals
+ '*' => [2,1, 188], # gas
+ '@' => [2,2, 214], # start pos
+);
+
+our %unitchar;
+while (my ($char, $matches) = splice @mapunit, 0, 2) {
+ my @charinfo = ($char, splice @$matches, 0, 2);
+ $unitchar{$_} = \@charinfo for @$matches;
+}
+
+sub tiles_parsed {
+ my $self = shift;
+ my $map = $self->tiles or return;
+ if ($self->{DEBUG}) {
+ use Tie::IxHash;
+ tie my %unknown, 'Tie::IxHash';
+ defined $tilechar{$map->[$_]} or warn(sprintf
+ "unknown tile %d at (%d,%d)\n",
+ $map->[$_], $_ % $self->width, $_ / $self->width
+ ), $unknown{$map->[$_]} = $_ for 0 .. $#$map;
+ warn sprintf "unknown: %s\n", join ",", keys %unknown if keys %unknown;
+ }
+ $_ = defined $tilechar{$_} ? $tilechar{$_} : '?' for @$map;
+ for ($self->units) {
+ my ($chr, $width, $height) = defined $unitchar{$_->{id}} ?
+ @{ $unitchar{$_->{id}} } : ('#', 1, 1);
+ for my $x ($_->{x} .. $_->{x} + $width - 1) {
+ for my $y ($_->{y} .. $_->{y} + $height - 1) {
+ $map->[$x + $y * $self->width] = $chr;
+ }
+ }
+ }
+ return $map;
+}
+
+sub units {
+ my $self = shift;
+ my @units;
+ for (my $i = 0; $i < length $self->{UNIT}; $i += 36) {
+ # d1, d2, x*32, y*32, unitid, bytes1, playerid, bytes2, mineral, bytes3
+ my @pack = unpack "v5x6Cx3vx14", substr $self->{UNIT}, $i, 36;
+ push @units, {
+ id => $pack[4],
+ player => $pack[5],
+ amount => $pack[6],
+ x => $pack[2] >> 5,
+ y => $pack[3] >> 5,
+# d1 => $pack[0],
+# d2 => $pack[1],
+ };
+ }
+ return @units;
+}
+
+sub units_parsed {
+ my $self = shift;
+ my @units;
+ for ($self->units) {
+ my ($chr, $width, $height) = defined $unitchar{$_->{id}} ?
+ @{ $unitchar{delete $_->{id}} } : ('#', 1, 1);
+ $_->{chr} = $chr;
+ $_->{width} = $width;
+ push @units, $_;
+ }
+ return @units;
+}
+
+sub colors {
+ my $self = shift;
+ my @colormap = (
+ qw(
+ FF0000 0000FF 209070 88409C E87824 5C2C14 FFFFFF DCDC3C
+ 0F930F FCFC8F EFCEBD 547CDC
+ ),
+ 12 => "pale green", "gray", "pale yellow", "cyan",
+ 17 => "black", "neon blue",
+ 21 => "lavender", "black",
+ 30 => "sky blue",
+ 33 => "purple",
+ );
+ my @players;
+ for (unpack "C*", $self->{COLR}) {
+ push @players, $colormap[$_] || "? (#$_)";
+ }
+ return \@players;
+}
+
+sub era {
+ my $self = shift;
+ return unpack "v", $self->{ERA};
+}
+
+1;
+
--- /dev/null
+package Data::StarCraft::Replay;
+
+use strict;
+use warnings;
+use Data::Dumper;
+
+use constant {
+ CMD_REPEAT => 4,
+};
+
+my %build = (
+ 0x19 => "morph",
+ 0x1E => "build",
+ 0x1F => "warp",
+ 0x24 => "add-on",
+ 0x2E => "evolve",
+ 0x47 => "land",
+);
+my %unit = (
+ 0x00 => "Marine",
+ 0x01 => "Ghost",
+ 0x02 => "Vulture",
+ 0x03 => "Goliath",
+ # undef,
+ 0x05 => "Siege Tank",
+ # undef,
+ 0x07 => "SCV",
+ 0x08 => "Wraith",
+ 0x09 => "Science Vessel",
+ # undef,
+ 0x0B => "Dropship",
+ 0x0C => "Battlecruiser",
+ # undef,
+ 0x0E => "Nuke",
+ # (undef) x 0x11,
+ 0x20 => "Firebat",
+ # undef,
+ 0x22 => "Medic",
+ # undef,
+ # undef,
+ 0x25 => "Zergling",
+ 0x26 => "Hydralisk",
+ 0x27 => "Ultralisk",
+ # undef,
+ 0x29 => "Drone",
+ 0x2A => "Overlord",
+ 0x2B => "Mutalisk",
+ 0x2C => "Guardian",
+ 0x2D => "Queen",
+ 0x2E => "Defiler",
+ 0x2F => "Scourge",
+ # undef,
+ # undef,
+ 0x32 => "Infested Terran",
+ # (undef) x 7,
+ 0x3A => "Valkyrie",
+ # undef,
+ 0x3C => "Corsair",
+ 0x3D => "Dark Templar",
+ 0x3E => "Devourer",
+ # undef,
+ 0x40 => "Probe",
+ 0x41 => "Zealot",
+ 0x42 => "Dragoon",
+ 0x43 => "High Templar",
+ # undef,
+ 0x45 => "Shuttle",
+ 0x46 => "Scout",
+ 0x47 => "Arbiter",
+ 0x48 => "Carrier",
+ # (undef) x 0x0A,
+ 0x53 => "Reaver",
+ 0x54 => "Observer",
+ # (undef) x 0x12,
+ 0x67 => "Lurker",
+ # undef,
+ # undef,
+ 0x6A => "Command Center",
+ 0x6B => "ComSat",
+ 0x6C => "Nuclear Silo",
+ 0x6D => "Supply Depot",
+ 0x6E => "Refinery", # refinery?
+ 0x6F => "Barracks",
+ 0x70 => "Academy", # Academy?
+ 0x71 => "Factory",
+ 0x72 => "Starport",
+ 0x73 => "Control Tower",
+ 0x74 => "Science Facility",
+ 0x75 => "Covert Ops",
+ 0x76 => "Physics Lab",
+ # undef,
+ 0x78 => "Machine Shop",
+ # undef,
+ 0x7A => "Engineering Bay",
+ 0x7B => "Armory",
+ 0x7C => "Missile Turret",
+ 0x7D => "Bunker",
+ # (undef) x 4,
+ 0x82 => "Infested CC",
+ 0x83 => "Hatchery",
+ 0x84 => "Lair",
+ 0x85 => "Hive",
+ 0x86 => "Nydus Canal",
+ 0x87 => "Hydralisk Den",
+ 0x88 => "Defiler Mound",
+ 0x89 => "Greater Spire",
+ 0x8A => "Queens Nest",
+ 0x8B => "Evolution Chamber",
+ 0x8C => "Ultralisk Cavern",
+ 0x8D => "Spire",
+ 0x8E => "Spawning Pool",
+ 0x8F => "Creep Colony",
+ 0x90 => "Spore Colony",
+ # undef,
+ 0x92 => "Sunken Colony",
+ # undef,
+ # undef,
+ 0x95 => "Extractor",
+ # (undef) x 4,
+ 0x9A => "Nexus",
+ 0x9B => "Robotics Facility",
+ 0x9C => "Pylon",
+ 0x9D => "Assimilator",
+ # undef,
+ 0x9F => "Observatory",
+ 0xA0 => "Gateway",
+ # undef,
+ 0xA2 => "Photon Cannon",
+ 0xA3 => "Citadel of Adun",
+ 0xA4 => "Cybernetics Core",
+ 0xA5 => "Templar Archives",
+ 0xA6 => "Forge",
+ 0xA7 => "Stargate",
+ # undef,
+ 0xA9 => "Fleet Beacon",
+ 0xAA => "Arbiter Tribunal",
+ 0xAB => "Robotics Support Bay",
+ 0xAC => "Shield Battery",
+ # (undef) x 0x14,
+ 0xC0 => "Larva",
+ 0xC1 => "Rine/Bat",
+ 0xC2 => "Dark Archon",
+ 0xC3 => "Archon",
+ 0xC4 => "Scarab",
+ 0xC5 => "Interceptor",
+ 0xC6 => "Interceptor/Scarab",
+);
+my @upgrade = (
+ "Terran Infantry Armor",
+ "Terran Vehicle Plating",
+ "Terran Ship Plating",
+ "Zerg Carapace",
+ "Zerg Flyer Carapace",
+ "Protoss Ground Armor",
+ "Protoss Air Armor",
+ "Terran Infantry Weapons",
+ "Terran Vehicle Weapons",
+ "Terran Ship Weapons",
+ "Zerg Melee Attacks",
+ "Zerg Missile Attacks",
+ "Zerg Flyer Attacks",
+ "Protoss Ground Weapons",
+ "Protoss Air Weapons",
+ "Protoss Plasma Shields",
+ # 0x10
+ "U-238 Shells (Marine Range)",
+ "Ion Thrusters (Vulture Speed)",
+ undef,
+ "Titan Reactor (Science Vessel Energy)",
+ "Ocular Implants (Ghost Sight)",
+ "Moebius Reactor (Ghost Energy)",
+ "Apollo Reactor (Wraith Energy)",
+ "Colossus Reactor (Battle Cruiser Energy)",
+ "Ventral Sacs (Overlord Transport)",
+ "Antennae (Overlord Sight)",
+ "Pneumatized Carapace (Overlord Speed)",
+ "Metabolic Boost (Zergling Speed)",
+ "Adrenal Glands (Zergling Attack)",
+ "Muscular Augments (Hydralisk Speed)",
+ "Grooved Spines (Hydralisk Range)",
+ "Gamete Meiosis (Queen Energy)",
+ # 0x20
+ "Defiler Energy",
+ "Singularity Charge (Dragoon Range)",
+ "Leg Enhancement (Zealot Speed)",
+ "Scarab Damage",
+ "Reaver Capacity",
+ "Gravitic Drive (Shuttle Speed)",
+ "Sensor Array (Observer Sight)",
+ "Gravitic Booster (Observer Speed)",
+ "Khaydarin Amulet (Templar Energy)",
+ "Apial Sensors (Scout Sight)",
+ "Gravitic Thrusters (Scout Speed)",
+ "Carrier Capacity",
+ "Khaydarin Core (Arbiter Energy)",
+ undef,
+ undef,
+ "Argus Jewel (Corsair Energy)",
+ # 0x30
+ undef,
+ "Argus Talisman (Dark Archon Energy)",
+ "Caduceus Reactor (Medic Energy)",
+ "Chitinous Plating (Ultralisk Armor)",
+ "Anabolic Synthesis (Ultralisk Speed)",
+ "Charon Boosters (Goliath Range)",
+);
+my @research = (
+ "Stim Pack",
+ "Lockdown",
+ "EMP Shockwave",
+ "Spider Mines",
+ undef,
+ "Siege Tank",
+ undef,
+ "Irradiate",
+ "Yamato Gun",
+ "Cloaking Field (wraith)",
+ "Personal Cloaking (ghost)",
+ "Burrow",
+ undef,
+ "Spawn Broodling",
+ undef,
+ "Plague",
+ # 0x10
+ "Consume",
+ "Ensnare",
+ undef,
+ "Psionic Storm",
+ "Hallucination",
+ "Recall",
+ "Stasis Field",
+ undef,
+ "Restoration",
+ "Disruption Web",
+ undef,
+ "Mind Control",
+ undef,
+ undef,
+ "Optical Flare",
+ "Maelstrom",
+ # 0x20
+ "Lurker Aspect",
+);
+my %action = (
+ 0x00 => "Move",
+ 0x02 => "Unallowed Move?",
+ 0x06 => "Force move",
+ 0x08 => "Attack",
+ 0x09 => "Gather",
+ 0x0E => "Attack Move",
+ 0x13 => "Failed Casting (?)",
+ 0x17 => "#23 (?)",
+ 0x1B => "Infest CC",
+ 0x22 => "Repair",
+ 0x27 => "Clear Rally",
+ 0x28 => "Set Rally",
+ 0x4F => "Gather",
+ 0x50 => "Gather",
+ 0x70 => "Unload",
+ 0x71 => "Yamato",
+ 0x73 => "Lockdown",
+ 0x77 => "Dark Swarm",
+ 0x78 => "Parasite",
+ 0x79 => "Spawn Broodling",
+ 0x7A => "EMP",
+ 0x7E => "Launch Nuke",
+ 0x84 => "Lay Mine",
+ 0x8B => "ComSat Scan",
+ 0x8D => "Defense Matrix",
+ 0x8E => "Psionic Storm",
+ 0x8F => "Recall",
+ 0x90 => "Plague",
+ 0x91 => "Consume",
+ 0x92 => "Ensnare",
+ 0x93 => "Stasis",
+ 0x94 => "Hallucination",
+ 0x98 => "Patrol",
+ 0xB1 => "Heal",
+ 0xB4 => "Restore",
+ 0xB5 => "Disruption Web",
+ 0xB6 => "Mind Control",
+ 0xB8 => "Feedback",
+ 0xB9 => "Optic Flare",
+ 0xBA => "Maelstrom",
+ 0xC0 => "Irradiate",
+);
+
+my %cmdread = (
+ 0x09 => ["select", 1, 2 | CMD_REPEAT],
+ 0x0A => ["add", 1, 2 | CMD_REPEAT],
+ 0x0B => ["deselect", 1, 2 | CMD_REPEAT],
+ 0x0C => ["build", 1, \%build, 2, 2, 2, \%unit],
+ 0x0D => ["vision", 2],
+ 0x0E => ["ally", 2, 2],
+ 0x13 => ["hotkey", 1, [qw"assign select"], 1],
+ 0x14 => ["move", 2, 2, 2, 2, 1], # 1 = queued?
+ 0x15 => ["action", 2, 2, 2, 2, 1, \%action, 1, [qw"normal queued"]],
+ 0x18 => ["cancel"],
+ 0x19 => ["cancel hatch"],
+ 0x1A => ["stop", 1],
+# 0x1B => ["move-thing??"], # tim: after hotkey (unit, reaver??) select; soon after reselected and moved
+ 0x1E => ["return cargo", 1],
+ 0x1F => ["train", 2, \%unit],
+ 0x20 => ["cancel train", 2], # == 254
+ 0x21 => ["cloak", 1],
+ 0x22 => ["decloak", 1],
+ 0x23 => ["hatch", 2, \%unit],
+ 0x25 => ["unsiege", 1],
+ 0x26 => ["siege", 1],
+ 0x27 => ["arm", 0], # scarab/interceptor
+ 0x28 => ["unload all", 1],
+ 0x29 => ["unload", 2],
+ 0x2A => ["merge archon", 0],
+ 0x2B => ["hold position", 1],
+ 0x2C => ["burrow", 1],
+ 0x2D => ["unburrow", 1],
+ 0x2E => ["cancel nuke", 0],
+ 0x2F => ["lift", 2, 2],
+ 0x30 => ["research", 1, \@research],
+ 0x31 => ["cancel research", 0],
+ 0x32 => ["upgrade", 1, \@upgrade],
+# 0x33 => ["forge-thing??"], # right after forge select: probably unpowered, iirc cancel research
+ 0x35 => ["morph", 2, \%unit],
+ 0x36 => ["stim", 0],
+ 0x57 => ["part", 1, {qw"1 quit 6 drop"}],
+ 0x5A => ["merge dark archon", 0],
+);
+
+sub new {
+ my ($class) = @_;
+ bless [], $class;
+}
+
+sub _read {
+ my $self = shift;
+ my ($fh, $size, $seek) = @_;
+ seek *$fh, $seek, 0 if $seek;
+ read(*$fh, my $in, $size) eq $size or return undef;
+ return $in;
+}
+
+sub open {
+ my $self = shift;
+ my ($file) = @_;
+
+ while (not eof $file) {
+ local $_ = $self->_read($file, 5)
+ and my ($time, $size) = unpack "VC", $_
+ or die "Couldn't read time block head\n";
+ local $_ = $self->_read($file, $size)
+ and my @block = unpack "C*", $_
+ or die "Couldn't read time block data\n";
+ while (@block) {
+ my $player = shift @block;
+ my $cmd = shift @block;
+ if (not defined $cmdread{$cmd}) {
+ warn sprintf "command #%X not defined: %d bytes ignored\n",
+ $cmd, scalar @block;
+ push @$self, [$time, $player, "??? $cmd"] if $SHOWWARN;
+ last;
+ }
+
+ sub readbyte {
+ my ($data, $byte) = @_;
+ my $out = shift @$data;
+ if (($byte & 3) == 2) {
+ @$data ? ($out += shift(@$data) << 8)
+ : warn "high byte not present\n";
+ }
+ return $out;
+ }
+
+ my @format = @{ $cmdread{$cmd} };
+ my $desc = shift @format;
+ my @data;
+ for my $bit (@format) {
+ if (ref $bit) {
+ if (ref $bit eq "ARRAY") {
+ $data[-1] = defined $bit->[$data[-1]] ? $bit->[$data[-1]]
+ : "? ($data[-1])";
+ } else {
+ $data[-1] = defined $bit->{$data[-1]} ? $bit->{$data[-1]}
+ : "? ($data[-1])";
+ }
+ next;
+ }
+ $bit & 3 or next;
+ if ($bit & CMD_REPEAT) {
+ push @data, readbyte(\@block, $bit) for 1 .. shift @data;
+ } else {
+ push @data, readbyte(\@block, $bit);
+ }
+ }
+ $desc eq "move" and $data[2] == 0 and $desc = "rally";
+ push @$self, [$time, $player, $desc, @data];
+ }
+ }
+ return $self;
+}
+
+1;
+
"color|c" => \$SHOWCOL,
);
-{
-
-package Data::StarCraft::Map;
-
-sub new {
- my ($class) = @_;
- bless {}, $class;
-}
-
-sub _read {
- my $self = shift;
- my ($fh, $size, $seek) = @_;
- seek *$fh, $seek, 0 if $seek;
- read(*$fh, my $in, $size) eq $size or return undef;
- return $in;
-}
-
-sub open {
- my $self = shift;
- my ($file) = @_;
-
- while (not eof $file) {
- local $_ = $self->_read($file, 8)
- and my ($type, $size) = unpack "a4V", $_
- or die "Couldn't chunk header\n";
- $type =~ s/ +$//;
-#printf STDERR "%s: %s\n", $type, $size;
- defined $self->{$type} and warn "duplicate map chunk $type\n";
- $self->{$type} = $self->_read($file, $size);
- }
- return $self;
-}
-
-sub version {
- my $self = shift;
- return 'v' . ord $self->{VER};
-}
-
-sub info {
- my $self = shift;
- my ($x, $y) = unpack "vv", $self->{DIM};
- return {
- x => $x,
- y => $y,
- };
-}
-
-sub width {
- return $_[0]->info->{x};
-}
-
-sub tiles {
- my $self = shift;
- my @map = unpack 'v*', $self->{MTXM};
- @map == $#map + 1 or warn(sprintf
- "couldn't parse map: only %d tiles\n", scalar @map
- ), return;
- return \@map;
-}
-
-my @maptile = (
- '!' => [ 0.. 31],
- 'd' => [ 32.. 62, 63], # dirt (verified)
- 'h' => [ 64.. 94], # high dirt
- "~" => [ 96..117, 118..127], # water
- 'j' => [128..159], # jungle/crushed rock
- 'o' => [160..186, 187..191], # rocky/shale (verified)
- 'R' => [192..223], # raised jungle
- 'l' => [224..252, 253..255], # lava/ruins (verified)/flagstones?
- 'b' => [256..287], # basilica?
- 'x' => [288..319], # high jungle
-# 'x' => [3745..3792], # high jungle
- 'q' => [320..351], # high ruins
- ' ' => [352..383],
- 'a' => [384..415], # high basilica
- 'm' => [416..447], # mud
- ' ' => [448..479],
- ' ' => [480..511],
-
- ' ' => [512..543],
- ' ' => [544..575],
- '/' => [576..607], # high dirt -> dirt (top left)
- '/' => [608..639], # dirt -> high dirt
- '\\' => [640..671], # high dirt -> dirt (top right)
- '\\' => [672..703], # dirt -> high dirt (bottom left)
- '\\' => [704..735], # high dirt -> dirt (bottom left)
- '\\' => [736..767], # dirt -> high dirt (top right)
- '/' => [768..863],
- '=' => [864..1055], # some edge (tmp)
- '=' => [1056..1183],
- '=' => [1184..1727],
- 'D' => [1728..1780], # edge water
- '/' => [1760..1791], # dirt -> water (top left)
- '\\' => [1792..1823], # dirt -> water (top right)
-
- 'd' => [609..611],
- 'W' => [2048..2303],
- '/' => [2304..2559],
- 'W' => [2560..2815],
- 'j' => [2816..3071],
- 'd' => [3072..3327],
- 'j' => [3328..3583],
- 'x' => [3648..3839],
- 'h' => [3840..4095],
-# 'x' => [4096..4351],
- 'h' => [4096..4351],
-# 'x' => [4352..4607],
-# ' ' => [4608..4863],
- 'l' => [4864..5311],
- 'q' => [5312..5503],
- 'x' => [5504..5631],
- 'q' => [5632..5759],
- 'j' => [5760..5823],
-# ' ' => [5824..5887],
- '=' => [5888..6143], # raised jungle -> jungle
-# ' ' => [6144..6655],
- '/' => [6656..7167],
- '/' => [7168..7359], # basilica -> crushed rock
- '/' => [7360..7551],
- 'i' => [7552..7807], # high temple
-# ' ' => [7808..8959],
-# '=' => [8960..9087],
-# 'd' => [9088..9215],
-# ' ' => [9216..9727],
-# 'm' => [9728..9983],
-# # >= 9984 unencountered
-# ' ' => [19968..20480], # something here on twilight
-# ' ' => [20544..20736], # center thing on twilight
-# '~' => [20896..21023], # something in the water on twilight
-# 'x' => [23104..23231], # something on twilight (on X or H)
-#
-# 'm' => [9216..9776], # mud <-> dirt
-# 'r' => [5792..5875, 5888..5904], # raised jungle edge
-#
-# 'd' => [3042..3250], # dirt<->grass
-# 'P' => [4608..4977], # dirt<->shale (verified) [also seems to be rocks on mud]
-# #'=' => [768..1731], # dirt<->lava ridge (verified)
-
- 'h' => [16389],
- '1' => [16405, 16388],
- '2' => [16421, 16404, 16387],
- '3' => [16437, 16420, 16403, 16386],
- '4' => [16453, 16436, 16419, 16402, 16385],
- '5' => [ 16435, 16418, 16401, 16384],
- '6' => [ 16434, 16417, 16400],
- '7' => [ 16433, 16416],
- 'd' => [16501, 16432],
- '7' => [16485, 16500], # these ↕ aren't ramps in temple!!
- '6' => [16469, 16484, 16499],
- '5' => [16453, 16468, 16483, 16498],
- '4' => [ 16452, 16467, 16482, 16497],
- '3' => [ 16451, 16466, 16481, 16496],
- '2' => [ 16450, 16465, 16480],
- '1' => [ 16449, 16464],
- 'h' => [17248, 16448],
- '1' => [17264, 17249],
- '1' => [17280, 17265, 17250],
- '2' => [17296, 17281, 17266, 17251],
- '3' => [17312, 17297, 17282, 17267, 17252],
- '4' => [17328, 17313, 17298, 17283, 17268, 17253],
- '5' => [ 17329, 17314, 17299, 17284, 17269],
- '6' => [ 17330, 17315, 17300, 17285],
- '7' => [ 17331, 17316, 17301],
- '7' => [ 17332, 17317],
- 'd' => [17232, 17333],
- '7' => [17216, 17233],
- '7' => [17200, 17217, 17234],
- '6' => [17184, 17201, 17218, 17235],
- '5' => [17168, 17185, 17202, 17219, 17236],
- '4' => [17152, 17169, 17186, 17203, 17220, 17237],
- '3' => [ 17153, 17170, 17187, 17204, 17221],
- '2' => [ 17154, 17171, 17188, 17205],
- '1' => [ 17155, 17172, 17189],
- '1' => [ 17156, 17173],
- 'h' => [ 17157],
-);
-
-my %eratile = (
- 4 => [
- # Longinus (by KuKulZa, modified MBCgame/iCCup)
- # SPRP: 6,0,1,0
- # TYPE: 82,65,87,66
- # VER: 205,0
- # SIDE: 5,5,5,1,2,0,1,2,7,7,7,4
- 'd' => [
- 19760..19761, 19792, 19793, 19680, 19681, 19712, 19713, 19664, 19665, 19728, 19729, # D→J
- 19808,19809, 19776,19777, 19872,19873, 19920,19921,
- 19744,19745, 19696,19697, 19632,19633, 19696,19697, 19952,19953,
- 19568,19569, # below ridge
- 3618,3634, 3586,3602, # D←J
- 3601, # D→J(3585)
- ],
- 'j' => [
- 21968, 21969, 21984, 21985,
- 21824,21825,21840,21841, 21856,21857,21872,21873, 21792,21793,
- 21808,21809, 21888,21889,21904,21905,
- 3616,3632,3584,3600,3616,3632, # J→D
- 3585, # J→D(3601)
- ],
- 'l' => [
- 22608..22611, 22624..22627, 22640..22643,
- ],
- 'o' => [
- 24850, # besides ladder
- 20832,20833,20848,20849, 20768,20769,20784,20785,
- 20864,20865,20880,20881,
- 20704,20705,20720,20721, # large rock
- 4432,4433,4434,4448,4449,4464,4465,
- 4545,4561,4577,4593, 4544,4560,4576,4592,
- ],
- 'h' => [
- 18000,18001, # H→X
- 17952,17953, 17936,17937, 17920,17921, 17856,17857, 17888,17889, # H→X unsure
- 17984,17985, 18160,18161, 18128,18129, 18048,18049,
- 19648,19649,19616,19617, 18016,18017,
- 17696,17697,17712,17713, # tree
- 17872,17873,17904,17905, 18144,18145,
- 18448,18449,18464,18465,18480,18481,
- ],
- 'm' => [ # mud hole
- 9219,9235,9539,9555,
- 9218,9234,9795,9235,9811,9571,9587,
- 9472,9488,9250,9266,9635,9651,9280,9296,
- 9504,9520,9665,9681,9344,9360,9760,9776,9539,9555,
- 9475,9491,9889,9905,9376,9392,9440,9456,9571,9587,
- 9507,9523,9377,9393,
-
- 9537,9553,
- 9569,9585,9474,9490,9283,9299,9216,9232,9536,9552,
- 9536,9552,9923,9939,9283,9299,9506,9522,9827,9843,9728,9744,9568,9584,
- 9283,9299,9217,9233,9731,9747,9568,9584,9699,9715,9315,9331,9284,9300,9217,9233,9955,9971,
- 9763,9779,9793,9809,9379,9395,9664,9680,9316,9332,9249,9265,9536,9552,
- 9443,9459,9921,9937,9284,9300,9216,9232,9284,9300,9216,9232,9696,9712,9345,9361,9409,9425,9604,9620,9568,9584,
- 9216,9232,9764,9780,9248,9264,9316,9332,9248,9264,9346,9362,9441,9457,9860,9876,9537,9553,
- 9728,9744,9444,9460,9667,9683,9348,9364,9411,9427,9602,9618,9378,9394,9444,9460,9569,9585,
- 9891,9907,9380,9396,9443,9459,9858,9874,9540,9556,
- 9379,9395,9442,9458,9572,9588,
- ],
- '/' => [
- # Longinus (by KuKulZa, modified MBCgame/iCCup)
- 9125, 9141, 9126, 9142, # D→~
- 9120, 9136, # H→D
- 9059,9075, 9189,9205, # D→~
- 19824,19825, # D→~
- 19200,19201,19216,19217, # object on D
- ],
- '/' => [
- 17632,17633,17648,17649, # H rotating thing
- 18208,18209, # H skull thing
- 18224,18225,18240,18241, # H statuey thing
- ],
- 'q' => [
- 23872,23873,23874,23875,23888,23889,23890,23891,23904,23905,23906,23907, # Q crater
- 23680,23681,23696,23697,23712,23713,
- ],
- 'x' => [
- 24336,24337,24352,24353, 24272,24273,24288,24289,
- 24272,24273,24288,24289, 24368,24369,24384,24385,
- 4353,4369, 4385,4401,4353,4369, 4386,4402, 4385,4401,
- 4386,4402,4354,4370,4386,4402,
- ],
- '/' => [
- 19856,19857,20144,20145, # D skeleton
- ],
- '/' => [21184], 'W' => [21185,21200,21201,21216,21217], # standing rock
- '/' => [21232], 'W' => [21233,21248,21249,21264,21265], # standing rock
- '7' => [25011, 25010], # M»H
- '7' => [24699, 25143], 6 => [24716], # M»H
- 'W' => # island o' rocks
- [21120..21125, 21136..21141, 21152..21157, 21168..21173],
- '/' => [21121,21122,21136..21139,21152..21154],
- '~' => [21120,21124,21125,21141,21157,21171..21173],
- '/' => [
- # D→~ coast
- 8997,9013,8963,8979, 8996,9012,8963,8979,8993,9009, 8997,9013,
- 8998,9014, 8993,9009, 9187,9203, 9121,9137, 9131,9147, 8992,9008,
- 9190,9206, 9062,9078, 8996,9012, 9090,9106,9194,9210,
- 9061,9077,9029,9045,9184,9200,8998,9014, 9024,9040,8997,9013,
- ],
-
- # Lost Temple (default?)
- # SPRP: 4,0,5,0
- # VER: 59,0
- # SIDE: 5,5,5,5,0,2,1,0,7,7,7,4
- '/' => [
- 9089,9105, # H←D
- 9196,9212, # H←D→~
- 8966,8982, 8962,8978, # H→~
- 9088,9104, # D→D/~
- 16832..16835,16848..16851,16864..16867,16880..16883, # H→D ridge (ramp elsewhere?)
- 16384..16389, 16400..16405, 16416..16421, 16432..16437, # idem
- 8961,8977,9155,9171, # H←D→~
- 20160,20161,19984,19985,19986,19987,20000,20001,20002,20003, # D→H
- 9124,9140, 9122,9138, 9002,9018, 8960,8976, 9168,9152, 8995,9011, # H→D→~
- 9057,9073, # H→D→~ temple.6
- 8968,8984, # D↔H
- ],
- 'j' => [
- 21952,21953,
- ],
- 'x' => [
- 4384,4400, 4352,4368, # X→H
- ],
- 'h' => [
- 18096,18097, 17968,17969, 18032,18033,18176,18177,
- ],
- 'd' => [
- 9347,9363,9953,9969,9473,9489,9251,9267,9633,9649,9505,9521,9410,9426,
- 9347,9363, 19840,19841, 19888,19889, 20208,20209,20224,20225,
- 20240,20241,20256,20257, 20272,20273,20288,20289, 19601,19600,
- 20304,20305,20320,20321, # tree
- ],
- 'o' => [
- 4673,4689,4737,4753,4705,4721,4769,4785, # rocks on D
- 4674,4690,4706,4722,4674,4690,4480,4496,4706,4722,4832,4848,4640,4656,
- 4736,4752,4768,4784,
- 4482,4498, 4834,4850, 4642,4658,
- ], 'd' => [4498,4642],
- 'm' => [
- # M→D mud holes
- 9281,9297,9313,9329, 9281,9297,9313,9329, 9538,9554,9570,9586,
- 9282,9298,9282,9298,9220,9236,9476,9492,9314,9330,9729,9745,9412,9428,9476,9492,9314,9330,9538,9554,9476,9492,9252,9268,
- 9508,9524,9668,9684,9600,9616,9508,9524,9666,9682,9601,9617,9570,9586,9508,9524,9408,9424,9700,9716,9632,9648,9698,9714,9282,9298,9314,9330,
- 9312,9328, 9412,9428, 9636,9652, 9634,9650,
- 9730,9746, 9761,9777,9762,9778, 9794,9810,
- 9732,9748, # temple.5
- 9603,9619, # temple.6
- ],
- 'r' => [
- 5859,5875, 5858,5874, # top edge
- ],
- 'O' => # temple center ornament
- [
- 22320,22321,22336,22337,22352,22353,
- 22368,22369,22384,22385,22400,22401,
- 22464..22467,22480..22483,22496..22499,
- 22800,22801,22802,22803,22816,22817,22818,22819,22832,22833,22834,22835,
- 22752,22753,22754,22755,22768,22769,22770,22771,22784,22785,22786,22787,
- ],
- 'l' => [ # cut out shapes
- 22464,22467,22496,22499, 22321,22353, 22368,22400,
- 22800,22802,22803,22832,22835, 22819,
- 22752,22753,22755,22787,22784, 22768,
- ],
- 'D' => # underwater cave
- [
- 21440,21441,21442,21443, 21456,21457,21458,21459,
- 21472,21473,21474,21475, 21488,21489,21490,21491,
- ],
- 'W' => [21456, 21472,21473,21474,21475],
- 'o' => [21442,21443],
- '~' => [21488,21489, 21490,21491],
- 'i' => [
- 23632,23633,23648,23649,23664,23665, 23584,23585,23600,23601,23616,23617, # statue things on Q
- ],
- 'D' => [1824..1839], 'W' => [1840..1855], # D→~ bright transition
- 'D' => [1856..1871], 'd' => [1872..1887], # D→~ bleft ridge
- 'W' => [1888..1903], 'D' => [1904..1919], # D→~ bleft transition
- '~' => [1920..1935], 'W' => [1936..1951], # w→~ bleft transition
- 'd' => [1952..1967], 'D' => [1968..1983],
- 'D' => [1984..1999], 'W' => [2000..2015],
- 'W' => [2016..2031], '~' => [2032..2047],
- 'D' => [8965,8981, 8964,8980, 9174,9158, 9010,8994], # H→D→~
- 'd' => [19936,19937], # D→~
- '/' => [19905], 'd' => [19904], # H→D
- 'r' => [
- 5825,5841, 5857,5873, # J→R→map edge
- 5826,5842, # J↔R
- ],
- 'q' => [
- # gap
- 23456,23457,23458,23459, 23472,23473,23474,23475,
- 23488,23489,23490,23491, 23504,23505,23506,23507,
- # towery thing
- 23824,23825,23826,23827, 23840,23841,23842,23843, 23856,23857,23858,23859,
- ],
-
- # Plains to Hill (v2.00 by Sir.Lupin)
- # VER: 59,0
- # SPRP: 1,0,2,0
- # SIDE: 5,5,5,5,0,2,1,0,7,7,7,4
- # FORC: 0,0,0,0,1,1,1,1,31,0,30,0,29,0,28,0,1,11,0,0
- '/' => [
- # H→D bottom left side (may be a ramp elsewhere)
- 16768,16769,16770,16771, 16784,16785,16786,16787,
- 16800,16801,16802,16803, 16816,16817,16818,16819,
- # idem bottom right side
- 16960,16961,16962,16963, 16976,16977,16978,16979,
- 16992,16993,16994,16995, 17008,17009,17010,17011,
- # idem
- 17088,17089,17090,17091, 17104,17105,17106,17107,
- 17120,17121,17122,17123, 17136,17137,17138,17139,
- ],
-
- # Python (v1.3 by Terrance, modified by Forgotten_/KeSPA)
- # ERA: 100,0
- # TYPE: 82,65,87,66
- # VER: 205,0
- # SPRP: 1,0,7,0
- # SIDE: 5,5,5,5,0,2,1,0,7,7,7,4
- # FORC: 0,0,0,0,1,1,1,1,2,0,4,0,5,0,6,0,1,14,15,15
- 'x' => [
- 24464,24465, 24448,24449
- ],
- 'h' => [
- 18064,18065,
- ],
- '/' => [
- 9186,9202,
- 18112,18113, # H→D
- 9154,9170,9027,9043,9157,9173, # H↔D
- ],
- 'O' =>
- [19504,19505,19520,19521, 18720,18721,18736,18737], # rock things
- 'h' => [18737],
- 'O' => # hole
- [17488..17491,17504..17507,17520..17523,17536..17539],
- 'h' => [17490,17491,17507,17523,17536..17539],
- 'o' => [
- 4610, 4610,4626, 4481,4497,4513,4529, 4514,4530,
- 4417,4608,4624,4418, 4512,4528, 4450,4466,
- 4609,4625,4546,4562, 4833,4849, 4801,4817, 4800,4816,
- ],
- 'd' => [
- 4672,4688,4704,4720, # D↔O
- 19584,19585,
- 4416, # D→O
- 4641,4657,4578,4594, 4802,4818, # O→D
- ],
- 'm' => [
- 9824,9840,9952,9968,9920,9936,9888,9904, 9796,9812,9924,9940,
- 9697,9713, 9890,9906, 9922,9938, 9792,9808,9856,9872,9826,9842,
- ],
- 'o' => [4738,4770], 'd' => [4754,4786],
- '/' => [18256,18257,18272,18273], 'h' => [18288,18289], # obelisk
- '/' => # sunken temple
- [21024..21029, 21040..21045, 21056..21061, 21072..21077, 21088..21093,21104..21109],
- '~' => [21024,21104,21109,21027,21059,21076,21072,21093,],
- 'W' => [21029, 21060,21045,21073,21090,21106,21092,21107,21075,21108,21058, 21056,21088,21105,21077],
- 'O' => # ruins similar to 22464
- [22512..22515, 22528..22531, 22544..22547],
- 'l' => [22512,22515, 22544,22547],
- 'Q' => [17664,17665,17680,17681], # rock thing
- 'Q' => [17728,17729,17744,17745], # tree
- '/' => [17808,17824,17840], 'h' => [17809,17825,17841],
- '6' => [25025], # D»H ramp (between D and 17328 = level 4)
-
-#}, 2 => {
- # Twilight Star (default)
- # (all guessed from low res thumb)
- 'h' => [17584,17585], # H→D
- 'r' => [5827,5843, 5824,5840,5856,5872],
- 'W' => [
- # water objects
- 20912,20913,20928,20929, 20896,20897, 20944,
- 19440,19441,19456,19457, 20945,20960,20961,
- 20816,20817,
- ],
- 'h' => [17760,17761,17776,17777, 17600,17601],
- 'D' => [9093,9109],
- 'o' => [19472..19475, 19488..19491],
- 'o' => [
- 21728,21729, 21744,21745, 21760,21761,
- 21776,21777, 19536,19537, 19538,19539, 19552..19555,
- ],
- 'j' => [3587,3603],
- 'O' => [19232..19235, 19248..19251], 'j' => [19218,19219],
- 'O' => [19938,19939,19954,19955],
- 'h' => [17792,17793],
- 'x' => [4356,4372],
- 'O' => [ # exotic/shiny things and other objects
- 18656,18657,18672,18673, 18496,18497,18512,18513,
- 18560..18563, 18576..18579, 18592..18595,
- 18528,18529,18544,18545, 18864,18865,
- 18608..18611,18624..18627,18640..18643,
- 18912..18915,18928..18931,18944..18947,
- 18816..18819,18832..18835,18848..18851,
- 18960..18963,18976..18979,18992..18995,
- 19008..19011,19024..19027,
- 19040..19043,19056..19059,
- ],
- 'A' => [ # X→A
- 7811,7827,7873,7889,7809,7825,7875,7891,
- 8707,8723,8737,8753,7874,7890,7808,7824,7872,7888,7904,
- 8003,8019,8160,8176,7810,7826,
- ],
- 'a' => [ # A←X
- 7843,7859,7905,7921,7841,7857,7907,7923,
- 8705,8721,7971,7987,8065,8081,8738,8754,7840,7856,
- 7920,7906,7922,7938,7954,7969,7985,8066,8082,8035,8051,
- 7970,7986,8032,8048,
- 8034,8050,7936,7952,8033,8049,7937,7953,
- ],
- 'R' => [6177,6193],
- '/' => [18080,18081],
- 'a' => [8032..8047], 'a' => [8048..8063], # #3 bottom left
- 'A' => [7841..7843], 'a' => [7857..7859], # #2 top left
- 'A' => [8000..8003], 'x' => [8016..8019], # #1 bottom right
- 'A' => [8064..8067], 'a' => [8080..8083], # #2 bottom left
- 'A' => [8224..8227], 'x' => [8240..8243], # #1 top right
- 'A' => [8288..8291], 'x' => [8304..8307], # #1 bottom right
- 'a' => [8355], 'A' => [8371], # #2 top right
- 'a' => [8322], 'A' => [8338], # #2 top right
- 'A' => [8512], 'x' => [8528], # #1 top right
- 'x' => [7811], 'A' => [7827],
- 'x' => [8096..8099], 'A' => [8112..8115],
- 'x' => [8163], 'a' => [8179],
- 'x' => [8192..8195], 'A' => [8208..8211],
- 'x' => [8128..8131], 'A' => [8144..8147],
- 'A' => [8258,8274],
- 'a' => [7939,7955], # #3 bottom right
- 'a' => [7968..7971], 'A' => [7984..7987],
- 'A' => [8256,8272],
- 'A' => [8257,8273, 8259,8275, 8162,8178],
-
- '!' => [],
-
- # tau cross (v1.1 by Rose.Of.Dream/BW4eVeR)
- # ERA: 6
- # FORC: 0,0,0,1,1,1,1,1,7,0,6,0,5,0,4,0,1,15,15,15
- # SIDE: 5,5,5,1,0,2,1,0,7,7,7,4
- # SPRP: 1,0,2,0
- # TYPE: 82,65,87,66
- # VER: 205
- '?' => [
- 6176,6192, 20976,20977, 20592,20593, 21392,21393, 20800,20801,
- 20608,20609, 20624,20625, 20640,20641, 20992,20993, 21008,21009,
- 19922,19923,22070,22071, 19968..19971, 22230,
- 22133,22137,22272,22157,22288,22313,
- 20592,20593,21392,21393,20800,20801,20608,20609,20624,20625,20640,20641,20992,20993,21008,21009,19922,19923,
- 22070,22071,19968,19969,19970,19971,22230,22272,22157,22288,22313,6147,6163,6178,6194,3589,3605,22147,22162,22163,22164,
- 22180,22315,18400,18401,18336,18337,18192,18193,17730,17731,17826,17827,17746,17747,17842,17843,
- 17762,17763,17794,17795,17778,17779,17810,17811,17616,17617,
- 20688,20689,6145,6161,20736,20737,21408,21409,21410,21411,
- 20752,20753,21424,21425,21426,21427,21376,21377,20656,20657,
- 21312,21313,21314,21315,20672,20673,21328,21329,21330,21331,
- 6146,6162,21344,21345,21346,21347,21360,21361,21362,21363,6144,
- 6160,
- ],
- '2' => # bridges
- [
- 22231..22235, 22246..22253, 22260..22269,
- 22273..22285, 22289..22301, 22306..22312, 22324..22328,
- ],
- '4' => [22246..22253, 22273..22285, 22306..22312],
- '2' => [
- 22084..22086, 22096..22103, 22112..22121, 22128..22139,
- 22144..22156, 22165..22171, 22181..22199,
- ],
- '4' => [22084..22086, 22112..22121, 22144..22156, 22181..22199],
- 'r' => [22342,22343],
-
- # Nostalgia (WGT13, v1.3 by Rose.of.Dream)
- # ERA: 0,0
- # FORC: 0,0,0,0,1,1,1,1,12,0,11,0,10,0,9,0,1,14,0,0
- # SIDE: 5,5,5,5,0,2,1,0,7,7,7,4
- # SPRP: 1,0,4,0
- # TYPE: 82,65,87,66
- # VER: 205
- '!' => [],
- ], # jungle
-);
-
-our %tilechar;
-while (my ($char, $matches) = splice @maptile, 0, 2) {
- $tilechar{$_} = $char for @$matches;
-}
-while (my ($char, $matches) = splice @{$eratile{4}}, 0, 2) {
- $tilechar{$_} = $char for @$matches;
-}
-
-my @mapunit = ( # character => width, height, ids
- '$' => [2,1, 176..178], # minerals
- '*' => [2,1, 188], # gas
- '@' => [2,2, 214], # start pos
-);
-
-our %unitchar;
-while (my ($char, $matches) = splice @mapunit, 0, 2) {
- my @charinfo = ($char, splice @$matches, 0, 2);
- $unitchar{$_} = \@charinfo for @$matches;
-}
-
-sub tiles_parsed {
- my $self = shift;
- my $map = $self->tiles or return;
- if ($SHOWWARN) {
- use Tie::IxHash;
- tie my %unknown, 'Tie::IxHash';
- defined $tilechar{$map->[$_]} or warn(sprintf
- "unknown tile %d at (%d,%d)\n",
- $map->[$_], $_ % $self->width, $_ / $self->width
- ), $unknown{$map->[$_]} = $_ for 0 .. $#$map;
- warn sprintf "unknown: %s\n", join ",", keys %unknown if keys %unknown;
- }
- $_ = defined $tilechar{$_} ? $tilechar{$_} : '?' for @$map;
- for ($self->units) {
- my ($chr, $width, $height) = defined $unitchar{$_->{id}} ?
- @{ $unitchar{$_->{id}} } : ('#', 1, 1);
- for my $x ($_->{x} .. $_->{x} + $width - 1) {
- for my $y ($_->{y} .. $_->{y} + $height - 1) {
- $map->[$x + $y * $self->width] = $chr;
- }
- }
- }
- return $map;
-}
-
-sub units {
- my $self = shift;
- my @units;
- for (my $i = 0; $i < length $self->{UNIT}; $i += 36) {
- # d1, d2, x*32, y*32, unitid, bytes1, playerid, bytes2, mineral, bytes3
- my @pack = unpack "v5x6Cx3vx14", substr $self->{UNIT}, $i, 36;
- push @units, {
- id => $pack[4],
- player => $pack[5],
- amount => $pack[6],
- x => $pack[2] >> 5,
- y => $pack[3] >> 5,
-# d1 => $pack[0],
-# d2 => $pack[1],
- };
- }
- return @units;
-}
-
-sub units_parsed {
- my $self = shift;
- my @units;
- for ($self->units) {
- my ($chr, $width, $height) = defined $unitchar{$_->{id}} ?
- @{ $unitchar{delete $_->{id}} } : ('#', 1, 1);
- $_->{chr} = $chr;
- $_->{width} = $width;
- push @units, $_;
- }
- return @units;
-}
-
-sub colors {
- my $self = shift;
- my @colormap = (
- qw(
- FF0000 0000FF 209070 88409C E87824 5C2C14 FFFFFF DCDC3C
- 0F930F FCFC8F EFCEBD 547CDC
- ),
- 12 => "pale green", "gray", "pale yellow", "cyan",
- 17 => "black", "neon blue",
- 21 => "lavender", "black",
- 30 => "sky blue",
- 33 => "purple",
- );
- my @players;
- for (unpack "C*", $self->{COLR}) {
- push @players, $colormap[$_] || "? (#$_)";
- }
- return \@players;
-}
-
-sub era {
- my $self = shift;
- return unpack "v", $self->{ERA};
-}
-
-}
-
+use Data::StarCraft::Map;
my $map = Data::StarCraft::Map->new->open(\*STDIN);
+$map->{DEBUG} = 1 if $SHOWWARN;
if ($SHOWMAP ne "ppm") {
printf("%s size %dx%d, %d player\n",
--- /dev/null
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Archive::MoPaQ;
+
+@ARGV or die "Usage: $0 filename.scm\n";
+
+my $mpq = Archive::MoPaQ->new or die;
+print $mpq->open($ARGV[0]);
+$mpq->listopen("");
+$mpq->extract(1);
+
use strict;
use warnings;
use Data::Dumper;
+use Data::StarCraft::Replay;
our $VERSION = '1.01';
my $SHOWWARN = 0;
+my $ACTGIF = undef;
my $APMSVG = undef;
my $DBNAME = undef;
my $DBGAME = undef;
GetOptions(
"verbose|v!" => \$SHOWWARN,
"apm|a=s" => \$APMSVG,
+ "act" => \$ACTGIF,
"dbname|D=s" => \$DBNAME,
"dbid|d=s" => \$DBGAME,
);
use constant { APM_FIRSTFRAME => 80 / .042 };
-{
-
-package Data::StarCraft::Replay;
-
-use Data::Dumper;
-
-use constant {
- CMD_REPEAT => 4,
-};
-
-my %build = (
- 0x19 => "morph",
- 0x1E => "build",
- 0x1F => "warp",
- 0x24 => "add-on",
- 0x2E => "evolve",
- 0x47 => "land",
-);
-my %unit = (
- 0x00 => "Marine",
- 0x01 => "Ghost",
- 0x02 => "Vulture",
- 0x03 => "Goliath",
- # undef,
- 0x05 => "Siege Tank",
- # undef,
- 0x07 => "SCV",
- 0x08 => "Wraith",
- 0x09 => "Science Vessel",
- # undef,
- 0x0B => "Dropship",
- 0x0C => "Battlecruiser",
- # undef,
- 0x0E => "Nuke",
- # (undef) x 0x11,
- 0x20 => "Firebat",
- # undef,
- 0x22 => "Medic",
- # undef,
- # undef,
- 0x25 => "Zergling",
- 0x26 => "Hydralisk",
- 0x27 => "Ultralisk",
- # undef,
- 0x29 => "Drone",
- 0x2A => "Overlord",
- 0x2B => "Mutalisk",
- 0x2C => "Guardian",
- 0x2D => "Queen",
- 0x2E => "Defiler",
- 0x2F => "Scourge",
- # undef,
- # undef,
- 0x32 => "Infested Terran",
- # (undef) x 7,
- 0x3A => "Valkyrie",
- # undef,
- 0x3C => "Corsair",
- 0x3D => "Dark Templar",
- 0x3E => "Devourer",
- # undef,
- 0x40 => "Probe",
- 0x41 => "Zealot",
- 0x42 => "Dragoon",
- 0x43 => "High Templar",
- # undef,
- 0x45 => "Shuttle",
- 0x46 => "Scout",
- 0x47 => "Arbiter",
- 0x48 => "Carrier",
- # (undef) x 0x0A,
- 0x53 => "Reaver",
- 0x54 => "Observer",
- # (undef) x 0x12,
- 0x67 => "Lurker",
- # undef,
- # undef,
- 0x6A => "Command Center",
- 0x6B => "ComSat",
- 0x6C => "Nuclear Silo",
- 0x6D => "Supply Depot",
- 0x6E => "Refinery", # refinery?
- 0x6F => "Barracks",
- 0x70 => "Academy", # Academy?
- 0x71 => "Factory",
- 0x72 => "Starport",
- 0x73 => "Control Tower",
- 0x74 => "Science Facility",
- 0x75 => "Covert Ops",
- 0x76 => "Physics Lab",
- # undef,
- 0x78 => "Machine Shop",
- # undef,
- 0x7A => "Engineering Bay",
- 0x7B => "Armory",
- 0x7C => "Missile Turret",
- 0x7D => "Bunker",
- # (undef) x 4,
- 0x82 => "Infested CC",
- 0x83 => "Hatchery",
- 0x84 => "Lair",
- 0x85 => "Hive",
- 0x86 => "Nydus Canal",
- 0x87 => "Hydralisk Den",
- 0x88 => "Defiler Mound",
- 0x89 => "Greater Spire",
- 0x8A => "Queens Nest",
- 0x8B => "Evolution Chamber",
- 0x8C => "Ultralisk Cavern",
- 0x8D => "Spire",
- 0x8E => "Spawning Pool",
- 0x8F => "Creep Colony",
- 0x90 => "Spore Colony",
- # undef,
- 0x92 => "Sunken Colony",
- # undef,
- # undef,
- 0x95 => "Extractor",
- # (undef) x 4,
- 0x9A => "Nexus",
- 0x9B => "Robotics Facility",
- 0x9C => "Pylon",
- 0x9D => "Assimilator",
- # undef,
- 0x9F => "Observatory",
- 0xA0 => "Gateway",
- # undef,
- 0xA2 => "Photon Cannon",
- 0xA3 => "Citadel of Adun",
- 0xA4 => "Cybernetics Core",
- 0xA5 => "Templar Archives",
- 0xA6 => "Forge",
- 0xA7 => "Stargate",
- # undef,
- 0xA9 => "Fleet Beacon",
- 0xAA => "Arbiter Tribunal",
- 0xAB => "Robotics Support Bay",
- 0xAC => "Shield Battery",
- # (undef) x 0x14,
- 0xC0 => "Larva",
- 0xC1 => "Rine/Bat",
- 0xC2 => "Dark Archon",
- 0xC3 => "Archon",
- 0xC4 => "Scarab",
- 0xC5 => "Interceptor",
- 0xC6 => "Interceptor/Scarab",
-);
-my @upgrade = (
- "Terran Infantry Armor",
- "Terran Vehicle Plating",
- "Terran Ship Plating",
- "Zerg Carapace",
- "Zerg Flyer Carapace",
- "Protoss Ground Armor",
- "Protoss Air Armor",
- "Terran Infantry Weapons",
- "Terran Vehicle Weapons",
- "Terran Ship Weapons",
- "Zerg Melee Attacks",
- "Zerg Missile Attacks",
- "Zerg Flyer Attacks",
- "Protoss Ground Weapons",
- "Protoss Air Weapons",
- "Protoss Plasma Shields",
- # 0x10
- "U-238 Shells (Marine Range)",
- "Ion Thrusters (Vulture Speed)",
- undef,
- "Titan Reactor (Science Vessel Energy)",
- "Ocular Implants (Ghost Sight)",
- "Moebius Reactor (Ghost Energy)",
- "Apollo Reactor (Wraith Energy)",
- "Colossus Reactor (Battle Cruiser Energy)",
- "Ventral Sacs (Overlord Transport)",
- "Antennae (Overlord Sight)",
- "Pneumatized Carapace (Overlord Speed)",
- "Metabolic Boost (Zergling Speed)",
- "Adrenal Glands (Zergling Attack)",
- "Muscular Augments (Hydralisk Speed)",
- "Grooved Spines (Hydralisk Range)",
- "Gamete Meiosis (Queen Energy)",
- # 0x20
- "Defiler Energy",
- "Singularity Charge (Dragoon Range)",
- "Leg Enhancement (Zealot Speed)",
- "Scarab Damage",
- "Reaver Capacity",
- "Gravitic Drive (Shuttle Speed)",
- "Sensor Array (Observer Sight)",
- "Gravitic Booster (Observer Speed)",
- "Khaydarin Amulet (Templar Energy)",
- "Apial Sensors (Scout Sight)",
- "Gravitic Thrusters (Scout Speed)",
- "Carrier Capacity",
- "Khaydarin Core (Arbiter Energy)",
- undef,
- undef,
- "Argus Jewel (Corsair Energy)",
- # 0x30
- undef,
- "Argus Talisman (Dark Archon Energy)",
- "Caduceus Reactor (Medic Energy)",
- "Chitinous Plating (Ultralisk Armor)",
- "Anabolic Synthesis (Ultralisk Speed)",
- "Charon Boosters (Goliath Range)",
-);
-my @research = (
- "Stim Pack",
- "Lockdown",
- "EMP Shockwave",
- "Spider Mines",
- undef,
- "Siege Tank",
- undef,
- "Irradiate",
- "Yamato Gun",
- "Cloaking Field (wraith)",
- "Personal Cloaking (ghost)",
- "Burrow",
- undef,
- "Spawn Broodling",
- undef,
- "Plague",
- # 0x10
- "Consume",
- "Ensnare",
- undef,
- "Psionic Storm",
- "Hallucination",
- "Recall",
- "Stasis Field",
- undef,
- "Restoration",
- "Disruption Web",
- undef,
- "Mind Control",
- undef,
- undef,
- "Optical Flare",
- "Maelstrom",
- # 0x20
- "Lurker Aspect",
-);
-my %action = (
- 0x00 => "Move",
- 0x02 => "Unallowed Move?",
- 0x06 => "Force move",
- 0x08 => "Attack",
- 0x09 => "Gather",
- 0x0E => "Attack Move",
- 0x13 => "Failed Casting (?)",
- 0x17 => "#23 (?)",
- 0x1B => "Infest CC",
- 0x22 => "Repair",
- 0x27 => "Clear Rally",
- 0x28 => "Set Rally",
- 0x4F => "Gather",
- 0x50 => "Gather",
- 0x70 => "Unload",
- 0x71 => "Yamato",
- 0x73 => "Lockdown",
- 0x77 => "Dark Swarm",
- 0x78 => "Parasite",
- 0x79 => "Spawn Broodling",
- 0x7A => "EMP",
- 0x7E => "Launch Nuke",
- 0x84 => "Lay Mine",
- 0x8B => "ComSat Scan",
- 0x8D => "Defense Matrix",
- 0x8E => "Psionic Storm",
- 0x8F => "Recall",
- 0x90 => "Plague",
- 0x91 => "Consume",
- 0x92 => "Ensnare",
- 0x93 => "Stasis",
- 0x94 => "Hallucination",
- 0x98 => "Patrol",
- 0xB1 => "Heal",
- 0xB4 => "Restore",
- 0xB5 => "Disruption Web",
- 0xB6 => "Mind Control",
- 0xB8 => "Feedback",
- 0xB9 => "Optic Flare",
- 0xBA => "Maelstrom",
- 0xC0 => "Irradiate",
-);
-
-my %cmdread = (
- 0x09 => ["select", 1, 2 | CMD_REPEAT],
- 0x0A => ["add", 1, 2 | CMD_REPEAT],
- 0x0B => ["deselect", 1, 2 | CMD_REPEAT],
- 0x0C => ["build", 1, \%build, 2, 2, 2, \%unit],
- 0x0D => ["vision", 2],
- 0x0E => ["ally", 2, 2],
- 0x13 => ["hotkey", 1, [qw"assign select"], 1],
- 0x14 => ["move", 2, 2, 2, 2, 1], # 1 = queued?
- 0x15 => ["action", 2, 2, 2, 2, 1, \%action, 1, [qw"normal queued"]],
- 0x18 => ["cancel"],
- 0x19 => ["cancel hatch"],
- 0x1A => ["stop", 1],
-# 0x1B => ["move-thing??"], # tim: after hotkey (unit, reaver??) select; soon after reselected and moved
- 0x1E => ["return cargo", 1],
- 0x1F => ["train", 2, \%unit],
- 0x20 => ["cancel train", 2], # == 254
- 0x21 => ["cloak", 1],
- 0x22 => ["decloak", 1],
- 0x23 => ["hatch", 2, \%unit],
- 0x25 => ["unsiege", 1],
- 0x26 => ["siege", 1],
- 0x27 => ["arm", 0], # scarab/interceptor
- 0x28 => ["unload all", 1],
- 0x29 => ["unload", 2],
- 0x2A => ["merge archon", 0],
- 0x2B => ["hold position", 1],
- 0x2C => ["burrow", 1],
- 0x2D => ["unburrow", 1],
- 0x2E => ["cancel nuke", 0],
- 0x2F => ["lift", 2, 2],
- 0x30 => ["research", 1, \@research],
- 0x31 => ["cancel research", 0],
- 0x32 => ["upgrade", 1, \@upgrade],
-# 0x33 => ["forge-thing??"], # right after forge select: probably unpowered, iirc cancel research
- 0x35 => ["morph", 2, \%unit],
- 0x36 => ["stim", 0],
- 0x57 => ["part", 1, {qw"1 quit 6 drop"}],
- 0x5A => ["merge dark archon", 0],
-);
-
-sub new {
- my ($class) = @_;
- bless [], $class;
-}
-
-sub _read {
- my $self = shift;
- my ($fh, $size, $seek) = @_;
- seek *$fh, $seek, 0 if $seek;
- read(*$fh, my $in, $size) eq $size or return undef;
- return $in;
-}
-
-sub open {
- my $self = shift;
- my ($file) = @_;
-
- while (not eof $file) {
- local $_ = $self->_read($file, 5)
- and my ($time, $size) = unpack "VC", $_
- or die "Couldn't read time block head\n";
- local $_ = $self->_read($file, $size)
- and my @block = unpack "C*", $_
- or die "Couldn't read time block data\n";
- while (@block) {
- my $player = shift @block;
- my $cmd = shift @block;
- if (not defined $cmdread{$cmd}) {
- warn sprintf "command #%X not defined: %d bytes ignored\n",
- $cmd, scalar @block;
- push @$self, [$time, $player, "??? $cmd"] if $SHOWWARN;
- last;
- }
-
- sub readbyte {
- my ($data, $byte) = @_;
- my $out = shift @$data;
- if (($byte & 3) == 2) {
- @$data ? ($out += shift(@$data) << 8)
- : warn "high byte not present\n";
- }
- return $out;
- }
-
- my @format = @{ $cmdread{$cmd} };
- my $desc = shift @format;
- my @data;
- for my $bit (@format) {
- if (ref $bit) {
- if (ref $bit eq "ARRAY") {
- $data[-1] = defined $bit->[$data[-1]] ? $bit->[$data[-1]]
- : "? ($data[-1])";
- } else {
- $data[-1] = defined $bit->{$data[-1]} ? $bit->{$data[-1]}
- : "? ($data[-1])";
- }
- next;
- }
- $bit & 3 or next;
- if ($bit & CMD_REPEAT) {
- push @data, readbyte(\@block, $bit) for 1 .. shift @data;
- } else {
- push @data, readbyte(\@block, $bit);
- }
- }
- $desc eq "move" and $data[2] == 0 and $desc = "rally";
- push @$self, [$time, $player, $desc, @data];
- }
- }
- return $self;
-}
-
-}
-
my @race = (qw(Z T P), (undef) x 3, '-');
sub showtime {
) if 0;
}
+if ($ACTGIF) {
+ open my $imgfile, '>', "test.gif" or die;
+ binmode $imgfile;
+ select $imgfile;
+
+ use GD;
+ my $ani = GD::Image->new($head->{width}, $head->{height});
+ my $bg = $ani->colorAllocate(0, 0, 0);
+ my @plot = (
+ $ani->colorAllocate(255, 0, 0),
+ $ani->colorAllocate(255, 255, 0),
+ $ani->colorAllocate(0, 255, 0),
+ $ani->colorAllocate(0, 255, 255),
+ $ani->colorAllocate(0, 0, 255),
+ $ani->colorAllocate(255, 0, 255),
+ );
+
+ print $ani->gifanimbegin;
+# print $ani->gifanimadd;
+ {
+ my $frame = GD::Image->new($ani->getBounds);
+ print $frame->gifanimadd;
+ my $length = 30 / .042;
+ my $last = 0;
+ for (@$map) {
+ my ($time, $player, $cmd, @data) = @$_;
+#$time < $length * 10 or last;
+ while ($time > $last + $length) {
+ $last += $length;
+ print $frame->gifanimadd(0, 0, 0, 32);
+# $frame = GD::Image->new($ani->getBounds);
+ }
+ if ($cmd eq "build") {
+ $frame->setPixel($data[1]>>5, $data[2]>>5, $plot[$player]);
+ }
+ elsif ($cmd eq "move" or $cmd eq "attack") {
+ $frame->setPixel($data[0]>>5, $data[1]>>5, $plot[$player]);
+# if $data[2] == 0xFFFF_FFFF;
+ }
+ }
+# add_frame_data($frame);
+ print $frame->gifanimadd;
+ }
+ print $ani->gifanimend;
+ select STDOUT;
+}
+
use Games::StarCraft::DB;
my $Db = Games::StarCraft::DB->connect({RaiseError => 1})
or die "No database: $DBI::errstr\n";
Options:
--verbose
--apm
+ --act
--dbname
--dbid
git.shiar.nl / perl / schtarr.git / commitdiff