[dic] r25 committed - Added SOAP-Lite and Data-Dumper CPAN Modules and dic_dev_build.sh to S...

[d...@googlecode.com]

Revision: 25
Author: christian...@owasp.org
Date: Wed Sep 1 22:51:40 2010
Log: Added SOAP-Lite and Data-Dumper CPAN Modules and dic_dev_build.sh to
SVN
http://code.google.com/p/dic/source/detail?r=25

Added:
/trunk/Data-Dumper-2.126.tar
/trunk/SOAP-Lite-0.52.zip
/trunk/dic_dev_build.sh

=======================================
--- /dev/null
+++ /trunk/Data-Dumper-2.126.tar Wed Sep 1 22:51:40 2010
@@ -0,0 +1,11628 @@
+Data-Dumper-2.126/ 0000755 0001750 0001750 00000000000 11361667404 012321
5 ustar
tsee tsee Data-Dumper-2.126/Todo 0000644 0001750 0001750 00000001400 11332011450 013122
0 ustar
tsee tsee =head1
NAME
+
+TODO - seeds germane, yet not germinated
+
+=head1 DESCRIPTION
+
+The following functionality will be supported in the next few releases.
+
+=over 4
+
+=item $Data::Dumper::Expdepth I<or> $I<OBJ>->Expdepth(I<NEWVAL>)
+
+Dump contents explicitly up to a certain depth and then use names for
+cross-referencing identical references. (useful in debugger, in situations
+where we don't care so much for cross-references).
+
+=item Make C<Dumpxs()> honor C<$Useqq>
+
+=item Fix formatting when Terse is set and Indent >= 2
+
+=item Output space after '\' (ref constructor) for high enough Indent
+
+=item Implement redesign that allows various backends (Perl, Lisp,
+some-binary-data-format, graph-description-languages, etc.)
+
+=item Dump traversal in breadth-first order
+
+=back
+ Data-Dumper-2.126/Changes 0000644 0001750 0001750 00000013762 11361667305 013625
0 ustar
tsee tsee =head1
NAME
+
+HISTORY - public release history for Data::Dumper
+
+=head1 DESCRIPTION
+
+=over 8
+
+=item 2.126 (Apr 15 2010)
+
+Fix Data::Dumper's Fix Terse(1) + Indent(2):
+perl-RT #73604: When $Data::Dumper::Terse is true, the indentation is
thrown
+off. It appears to be acting as if the $VAR1 = is still there.
+
+=item 2.125 (Aug 8 2009)
+
+CPAN distribution fixes (meta information for META.yml).
+
+=item 2.124 (Jun 13 2009)
+
+Add three missing test files.
+
+=item 2.123 (Jun 11 2009)
+
+Re-add the INSTALLDIRS => 'perl' directive to Makefile.PL
+of the CPAN release.
+
+=item 2.122 (Jun 9 2009)
+
+Promote previous developer release to stable release.
+
+=item 2.121_20 (Jun 6 2009)
+
+A host of bug fixes and improvements that have
+accumulated in the perl core
+
+Updated backport to 5.6.1 by Steffen Mueller <smue...@cpan.org>.
+
+=item 2.121 (Aug 24 2003)
+
+Backport to 5.6.1 by Ilya Martynov <il...@martynov.org>.
+
+=item 2.11 (unreleased)
+
+C<0> is now dumped as such, not as C<'0'>.
+
+qr// objects are now dumped correctly (provided a post-5.005_58)
+overload.pm exists).
+
+Implemented $Data::Dumper::Maxdepth, which was on the Todo list.
+Thanks to John Nolan <jpn...@Op.Net>.
+
+=item 2.101 (30 Apr 1999)
+
+Minor release to sync with version in 5.005_03. Fixes dump of
+dummy coderefs.
+
+=item 2.10 (31 Oct 1998)
+
+Bugfixes for dumping related undef values, globs, and better double
+quoting: three patches suggested by Gisle Aas <gi...@aas.no>.
+
+Escaping of single quotes in the XS version could get tripped up
+by the presence of nulls in the string. Fix suggested by
+Slaven Rezic <ese...@cs.tu-berlin.de>.
+
+Rather large scale reworking of the logic in how seen values
+are stashed. Anonymous scalars that may be encountered while
+traversing the structure are properly tracked, in case they become
+used in data dumped in a later pass. There used to be a problem
+with the previous logic that prevented such structures from being
+dumped correctly.
+
+Various additions to the testsuite.
+
+=item 2.09 (9 July 1998)
+
+Implement $Data::Dumper::Bless, suggested by Mark Daku <da...@nortel.ca>.
+
+=item 2.081 (15 January 1998)
+
+Minor release to fix Makefile.PL not accepting MakeMaker args.
+
+=item 2.08 (7 December 1997)
+
+Glob dumps don't output superflous 'undef' anymore.
+
+Fixes from Gisle Aas <gi...@aas.no> to make Dumper() work with
+overloaded strings in recent perls, and his new testsuite.
+
+require 5.004.
+
+A separate flag to always quote hash keys (on by default).
+
+Recreating known CODE refs is now better supported.
+
+Changed flawed constant SCALAR bless workaround.
+
+=item 2.07 (7 December 1996)
+
+Dumpxs output is now exactly the same as Dump. It still doesn't
+honor C<Useqq> though.
+
+Regression tests test for identical output and C<eval>-ability.
+
+Bug in *GLOB{THING} output fixed.
+
+Other small enhancements.
+
+=item 2.06 (2 December 1996)
+
+Bugfix that was serious enough for new release--the bug cripples
+MLDBM. Problem was "Attempt to modify readonly value..." failures
+that stemmed for a misguided SvPV_force() instead of a SvPV().)
+
+=item 2.05 (2 December 1996)
+
+Fixed the type mismatch that was causing Dumpxs test to fail
+on 64-bit platforms.
+
+GLOB elements are dumped now when C<Purity> is set (using the
+*GLOB{THING} syntax).
+
+The C<Freezer> option can be set to a method name to call
+before probing objects for dumping. Some applications: objects with
+external data, can re-bless themselves into a transitional package;
+Objects the maintain ephemeral state (like open files) can put
+additional information in the object to facilitate persistence.
+
+The corresponding C<Toaster> option, if set, specifies
+the method call that will revive the frozen object.
+
+The C<Deepcopy> flag has been added to do just that.
+
+Dumper does more aggressive cataloging of SCALARs encountered
+within ARRAY/HASH structures. Thanks to Norman Gaywood
+<no...@godel.une.edu.au> for reporting the problem.
+
+Objects that C<overload> the '""' operator are now handled
+properly by the C<Dump> method.
+
+Significant additions to the testsuite.
+
+More documentation.
+
+=item 2.04beta (28 August 1996)
+
+Made dump of glob names respect C<Useqq> setting.
+
+[@$%] are now escaped now when in double quotes.
+
+=item 2.03beta (26 August 1996)
+
+Fixed Dumpxs. It was appending trailing nulls to globnames.
+(reported by Randal Schwartz <mer...@teleport.com>).
+
+Calling the C<Indent()> method on a dumper object now correctly
+resets the internal separator (reported by Curt Tilmes
+<cu...@ltpmail.gsfc.nasa.gov>).
+
+New C<Terse> option to suppress the 'C<VARI<n> = >' prefix
+introduced. If the option is set, they are output only when
+absolutely essential.
+
+The C<Useqq> flag is supported (but not by the XSUB version
+yet).
+
+Embedded nulls in keys are now handled properly by Dumpxs.
+
+Dumper.xs now use various integer types in perl.h (should
+make it compile without noises on 64 bit platforms, although
+I haven't been able to test this).
+
+All the dump methods now return a list of strings in a list
+context.
+
+
+=item 2.02beta (13 April 1996)
+
+Non portable sprintf usage in XS code fixed (thanks to
+Ulrich Pfeifer <pfe...@charly.informatik.uni-dortmund.de>).
+
+
+=item 2.01beta (10 April 1996)
+
+Minor bugfix (single digit numbers were always getting quoted).
+
+
+=item 2.00beta (9 April 1996)
+
+C<Dumpxs> is now the exact XSUB equivalent of C<Dump>. The XS version
+is 4-5 times faster.
+
+C<require 5.002>.
+
+MLDBM example removed (as its own module, it has a separate CPAN
+reality now).
+
+Fixed bugs in handling keys with wierd characters. Perl can be
+tripped up in its implicit quoting of the word before '=>'. The
+fix: C<Data::Dumper::Purity>, when set, always triggers quotes
+around hash keys.
+
+Andreas Koenig <k...@anna.in-berlin.de> pointed out that handling octals
+is busted. His patch added.
+
+Dead code removed, other minor documentation fixes.
+
+
+=item 1.23 (3 Dec 1995)
+
+MLDBM example added.
+
+Several folks pointed out that quoting of ticks and backslashes
+in strings is missing. Added.
+
+Ian Phillipps <i...@pipex.net> pointed out that numerics may lose
+precision without quotes. Fixed.
+
+
+=item 1.21 (20 Nov 1995)
+
+Last stable version I can remember.
+
+=back
+
+=cut
+ Data-Dumper-2.126/Dumper.xs 0000644 0001750 0001750 00000103667 11361667052 014145
0 ustar
tsee tsee #define
PERL_NO_GET_CONTEXT
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#ifdef USE_PPPORT_H
+# define NEED_my_snprintf
+# define NEED_sv_2pv_flags
+# include "ppport.h"
+#endif
+
+#if PERL_VERSION < 8
+# define DD_USE_OLD_ID_FORMAT
+#endif
+
+static I32 num_q (const char *s, STRLEN slen);
+static I32 esc_q (char *dest, const char *src, STRLEN slen);
+static I32 esc_q_utf8 (pTHX_ SV *sv, const char *src, STRLEN slen);
+static I32 needs_quote(register const char *s);
+static SV *sv_x (pTHX_ SV *sv, const char *str, STRLEN len, I32 n);
+static I32 DD_dump (pTHX_ SV *val, const char *name, STRLEN namelen, SV
*retval,
+ HV *seenhv, AV *postav, I32 *levelp, I32 indent,
+ SV *pad, SV *xpad, SV *apad, SV *sep, SV *pair,
+ SV *freezer, SV *toaster,
+ I32 purity, I32 deepcopy, I32 quotekeys, SV *bless,
+ I32 maxdepth, SV *sortkeys);
+
+#ifndef HvNAME_get
+#define HvNAME_get HvNAME
+#endif
+
+#if PERL_VERSION <= 6 /* Perl 5.6 and earlier */
+
+# ifdef EBCDIC
+# define UNI_TO_NATIVE(ch) (((ch) > 255) ? (ch) : ASCII_TO_NATIVE(ch))
+# else
+# define UNI_TO_NATIVE(ch) (ch)
+# endif
+
+UV
+Perl_utf8_to_uvchr(pTHX_ U8 *s, STRLEN *retlen)
+{
+ const UV uv = utf8_to_uv(s, UTF8_MAXLEN, retlen,
+ ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
+ return UNI_TO_NATIVE(uv);
+}
+
+# if !defined(PERL_IMPLICIT_CONTEXT)
+# define utf8_to_uvchr Perl_utf8_to_uvchr
+# else
+# define utf8_to_uvchr(a,b) Perl_utf8_to_uvchr(aTHX_ a,b)
+# endif
+
+#endif /* PERL_VERSION <= 6 */
+
+/* Changes in 5.7 series mean that now IOK is only set if scalar is
+ precisely integer but in 5.6 and earlier we need to do a more
+ complex test */
+#if PERL_VERSION <= 6
+#define DD_is_integer(sv) (SvIOK(sv) && (SvIsUV(val) ? SvUV(sv) ==
SvNV(sv) : SvIV(sv) == SvNV(sv)))
+#else
+#define DD_is_integer(sv) SvIOK(sv)
+#endif
+
+/* does a string need to be protected? */
+static I32
+needs_quote(register const char *s)
+{
+TOP:
+ if (s[0] == ':') {
+ if (*++s) {
+ if (*s++ != ':')
+ return 1;
+ }
+ else
+ return 1;
+ }
+ if (isIDFIRST(*s)) {
+ while (*++s)
+ if (!isALNUM(*s)) {
+ if (*s == ':')
+ goto TOP;
+ else
+ return 1;
+ }
+ }
+ else
+ return 1;
+ return 0;
+}
+
+/* count the number of "'"s and "\"s in string */
+static I32
+num_q(register const char *s, register STRLEN slen)
+{
+ register I32 ret = 0;
+
+ while (slen > 0) {
+ if (*s == '\'' || *s == '\\')
+ ++ret;
+ ++s;
+ --slen;
+ }
+ return ret;
+}
+
+
+/* returns number of chars added to escape "'"s and "\"s in s */
+/* slen number of characters in s will be escaped */
+/* destination must be long enough for additional chars */
+static I32
+esc_q(register char *d, register const char *s, register STRLEN slen)
+{
+ register I32 ret = 0;
+
+ while (slen > 0) {
+ switch (*s) {
+ case '\'':
+ case '\\':
+ *d = '\\';
+ ++d; ++ret;
+ default:
+ *d = *s;
+ ++d; ++s; --slen;
+ break;
+ }
+ }
+ return ret;
+}
+
+static I32
+esc_q_utf8(pTHX_ SV* sv, register const char *src, register STRLEN slen)
+{
+ char *r, *rstart;
+ const char *s = src;
+ const char * const send = src + slen;
+ STRLEN j, cur = SvCUR(sv);
+ /* Could count 128-255 and 256+ in two variables, if we want to
+ be like &qquote and make a distinction. */
+ STRLEN grow = 0; /* bytes needed to represent chars 128+ */
+ /* STRLEN topbit_grow = 0; bytes needed to represent chars 128-255 */
+ STRLEN backslashes = 0;
+ STRLEN single_quotes = 0;
+ STRLEN qq_escapables = 0; /* " $ @ will need a \ in "" strings. */
+ STRLEN normal = 0;
+
+ /* this will need EBCDICification */
+ for (s = src; s < send; s += UTF8SKIP(s)) {
+ const UV k = utf8_to_uvchr((U8*)s, NULL);
+
+#ifdef EBCDIC
+ if (!isprint(k) || k > 256) {
+#else
+ if (k > 127) {
+#endif
+ /* 4: \x{} then count the number of hex digits. */
+ grow += 4 + (k <= 0xFF ? 2 : k <= 0xFFF ? 3 : k <= 0xFFFF ? 4 :
+#if UVSIZE == 4
+ 8 /* We may allocate a bit more than the minimum here. */
+#else
+ k <= 0xFFFFFFFF ? 8 : UVSIZE * 4
+#endif
+ );
+ } else if (k == '\\') {
+ backslashes++;
+ } else if (k == '\'') {
+ single_quotes++;
+ } else if (k == '"' || k == '$' || k == '@') {
+ qq_escapables++;
+ } else {
+ normal++;
+ }
+ }
+ if (grow) {
+ /* We have something needing hex. 3 is ""\0 */
+ sv_grow(sv, cur + 3 + grow + 2*backslashes + single_quotes
+ + 2*qq_escapables + normal);
+ rstart = r = SvPVX(sv) + cur;
+
+ *r++ = '"';
+
+ for (s = src; s < send; s += UTF8SKIP(s)) {
+ const UV k = utf8_to_uvchr((U8*)s, NULL);
+
+ if (k == '"' || k == '\\' || k == '$' || k == '@') {
+ *r++ = '\\';
+ *r++ = (char)k;
+ }
+ else
+#ifdef EBCDIC
+ if (isprint(k) && k < 256)
+#else
+ if (k < 0x80)
+#endif
+ *r++ = (char)k;
+ else {
+#if PERL_VERSION < 10
+ sprintf(r, "\\x{%"UVxf"}", k);
+ r += strlen(r);
+ /* my_sprintf is not supported by ppport.h */
+#else
+ r = r + my_sprintf(r, "\\x{%"UVxf"}", k);
+#endif
+ }
+ }
+ *r++ = '"';
+ } else {
+ /* Single quotes. */
+ sv_grow(sv, cur + 3 + 2*backslashes + 2*single_quotes
+ + qq_escapables + normal);
+ rstart = r = SvPVX(sv) + cur;
+ *r++ = '\'';
+ for (s = src; s < send; s ++) {
+ const char k = *s;
+ if (k == '\'' || k == '\\')
+ *r++ = '\\';
+ *r++ = k;
+ }
+ *r++ = '\'';
+ }
+ *r = '\0';
+ j = r - rstart;
+ SvCUR_set(sv, cur + j);
+
+ return j;
+}
+
+/* append a repeated string to an SV */
+static SV *
+sv_x(pTHX_ SV *sv, const char *str, STRLEN len, I32 n)
+{
+ if (!sv)
+ sv = newSVpvn("", 0);
+#ifdef DEBUGGING
+ else
+ assert(SvTYPE(sv) >= SVt_PV);
+#endif
+
+ if (n > 0) {
+ SvGROW(sv, len*n + SvCUR(sv) + 1);
+ if (len == 1) {
+ char * const start = SvPVX(sv) + SvCUR(sv);
+ SvCUR_set(sv, SvCUR(sv) + n);
+ start[n] = '\0';
+ while (n > 0)
+ start[--n] = str[0];
+ }
+ else
+ while (n > 0) {
+ sv_catpvn(sv, str, len);
+ --n;
+ }
+ }
+ return sv;
+}
+
+/*
+ * This ought to be split into smaller functions. (it is one long function
since
+ * it exactly parallels the perl version, which was one long thing for
+ * efficiency raisins.) Ugggh!
+ */
+static I32
+DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV
*seenhv,
+ AV *postav, I32 *levelp, I32 indent, SV *pad, SV *xpad,
+ SV *apad, SV *sep, SV *pair, SV *freezer, SV *toaster, I32 purity,
+ I32 deepcopy, I32 quotekeys, SV *bless, I32 maxdepth, SV *sortkeys)
+{
+ char tmpbuf[128];
+ U32 i;
+ char *c, *r, *realpack;
+#ifdef DD_USE_OLD_ID_FORMAT
+ char id[128];
+#else
+ UV id_buffer;
+ char *const id = (char *)&id_buffer;
+#endif
+ SV **svp;
+ SV *sv, *ipad, *ival;
+ SV *blesspad = Nullsv;
+ AV *seenentry = NULL;
+ char *iname;
+ STRLEN inamelen, idlen = 0;
+ U32 realtype;
+ bool no_bless = 0; /* when a qr// is blessed into Regexp we dont want
to bless it.
+ in later perls we should actually check the
classname of the
+ engine. this gets tricky as it involves lexical
issues that arent so
+ easy to resolve */
+ bool is_regex = 0; /* we are dumping a regex, we need to know this
before we bless */
+
+ if (!val)
+ return 0;
+
+ /* If the ouput buffer has less than some arbitary amount of space
+ remaining, then enlarge it. For the test case (25M of output),
+ *1.1 was slower, *2.0 was the same, so the first guess of 1.5 is
+ deemed to be good enough. */
+ if (SvTYPE(retval) >= SVt_PV && (SvLEN(retval) - SvCUR(retval)) < 42) {
+ sv_grow(retval, SvCUR(retval) * 3 / 2);
+ }
+
+ realtype = SvTYPE(val);
+
+ if (SvGMAGICAL(val))
+ mg_get(val);
+ if (SvROK(val)) {
+
+ /* If a freeze method is provided and the object has it, call
+ it. Warn on errors. */
+ if (SvOBJECT(SvRV(val)) && freezer &&
+ SvPOK(freezer) && SvCUR(freezer) &&
+ gv_fetchmeth(SvSTASH(SvRV(val)), SvPVX_const(freezer),
+ SvCUR(freezer), -1) != NULL)
+ {
+ dSP; ENTER; SAVETMPS; PUSHMARK(sp);
+ XPUSHs(val); PUTBACK;
+ i = perl_call_method(SvPVX_const(freezer), G_EVAL|G_VOID);
+ SPAGAIN;
+ if (SvTRUE(ERRSV))
+ warn("WARNING(Freezer method call failed): %"SVf"", ERRSV);
+ PUTBACK; FREETMPS; LEAVE;
+ }
+
+ ival = SvRV(val);
+ realtype = SvTYPE(ival);
+#ifdef DD_USE_OLD_ID_FORMAT
+ idlen = my_snprintf(id, sizeof(id), "0x%"UVxf, PTR2UV(ival));
+#else
+ id_buffer = PTR2UV(ival);
+ idlen = sizeof(id_buffer);
+#endif
+ if (SvOBJECT(ival))
+ realpack = HvNAME_get(SvSTASH(ival));
+ else
+ realpack = NULL;
+
+ /* if it has a name, we need to either look it up, or keep a tab
+ * on it so we know when we hit it later
+ */
+ if (namelen) {
+ if ((svp = hv_fetch(seenhv, id, idlen, FALSE))
+ && (sv = *svp) && SvROK(sv) && (seenentry = (AV*)SvRV(sv)))
+ {
+ SV *othername;
+ if ((svp = av_fetch(seenentry, 0, FALSE))
+ && (othername = *svp))
+ {
+ if (purity && *levelp > 0) {
+ SV *postentry;
+
+ if (realtype == SVt_PVHV)
+ sv_catpvn(retval, "{}", 2);
+ else if (realtype == SVt_PVAV)
+ sv_catpvn(retval, "[]", 2);
+ else
+ sv_catpvn(retval, "do{my $o}", 9);
+ postentry = newSVpvn(name, namelen);
+ sv_catpvn(postentry, " = ", 3);
+ sv_catsv(postentry, othername);
+ av_push(postav, postentry);
+ }
+ else {
+ if (name[0] == '@' || name[0] == '%') {
+ if ((SvPVX_const(othername))[0] == '\\' &&
+ (SvPVX_const(othername))[1] == name[0]) {
+ sv_catpvn(retval, SvPVX_const(othername)+1,
+ SvCUR(othername)-1);
+ }
+ else {
+ sv_catpvn(retval, name, 1);
+ sv_catpvn(retval, "{", 1);
+ sv_catsv(retval, othername);
+ sv_catpvn(retval, "}", 1);
+ }
+ }
+ else
+ sv_catsv(retval, othername);
+ }
+ return 1;
+ }
+ else {
+#ifdef DD_USE_OLD_ID_FORMAT
+ warn("ref name not found for %s", id);
+#else
+ warn("ref name not found for 0x%"UVxf, PTR2UV(ival));
+#endif
+ return 0;
+ }
+ }
+ else { /* store our name and continue */
+ SV *namesv;
+ if (name[0] == '@' || name[0] == '%') {
+ namesv = newSVpvn("\\", 1);
+ sv_catpvn(namesv, name, namelen);
+ }
+ else if (realtype == SVt_PVCV && name[0] == '*') {
+ namesv = newSVpvn("\\", 2);
+ sv_catpvn(namesv, name, namelen);
+ (SvPVX(namesv))[1] = '&';
+ }
+ else
+ namesv = newSVpvn(name, namelen);
+ seenentry = newAV();
+ av_push(seenentry, namesv);
+ (void)SvREFCNT_inc(val);
+ av_push(seenentry, val);
+ (void)hv_store(seenhv, id, idlen,
+ newRV_inc((SV*)seenentry), 0);
+ SvREFCNT_dec(seenentry);
+ }
+ }
+ /* regexps dont have to be blessed into package "Regexp"
+ * they can be blessed into any package.
+ */
+#if PERL_VERSION < 8
+ if (realpack && *realpack == 'R' && strEQ(realpack, "Regexp"))
+#elif PERL_VERSION < 11
+ if (realpack && realtype == SVt_PVMG && mg_find(ival,
PERL_MAGIC_qr))
+#else
+ if (realpack && realtype == SVt_REGEXP)
+#endif
+ {
+ is_regex = 1;
+ if (strEQ(realpack, "Regexp"))
+ no_bless = 1;
+ else
+ no_bless = 0;
+ }
+
+ /* If purity is not set and maxdepth is set, then check depth:
+ * if we have reached maximum depth, return the string
+ * representation of the thing we are currently examining
+ * at this depth (i.e., 'Foo=ARRAY(0xdeadbeef)').
+ */
+ if (!purity && maxdepth > 0 && *levelp >= maxdepth) {
+ STRLEN vallen;
+ const char * const valstr = SvPV(val,vallen);
+ sv_catpvn(retval, "'", 1);
+ sv_catpvn(retval, valstr, vallen);
+ sv_catpvn(retval, "'", 1);
+ return 1;
+ }
+
+ if (realpack && !no_bless) { /* we have a blessed ref */
+ STRLEN blesslen;
+ const char * const blessstr = SvPV(bless, blesslen);
+ sv_catpvn(retval, blessstr, blesslen);
+ sv_catpvn(retval, "( ", 2);
+ if (indent >= 2) {
+ blesspad = apad;
+ apad = newSVsv(apad);
+ sv_x(aTHX_ apad, " ", 1, blesslen+2);
+ }
+ }
+
+ (*levelp)++;
+ ipad = sv_x(aTHX_ Nullsv, SvPVX_const(xpad), SvCUR(xpad), *levelp);
+
+ if (is_regex)
+ {
+ STRLEN rlen;
+ const char *rval = SvPV(val, rlen);
+ const char *slash = strchr(rval, '/');
+ sv_catpvn(retval, "qr/", 3);
+ while (slash) {
+ sv_catpvn(retval, rval, slash-rval);
+ sv_catpvn(retval, "\\/", 2);
+ rlen -= slash-rval+1;
+ rval = slash+1;
+ slash = strchr(rval, '/');
+ }
+ sv_catpvn(retval, rval, rlen);
+ sv_catpvn(retval, "/", 1);
+ }
+ else if (
+#if PERL_VERSION < 9
+ realtype <= SVt_PVBM
+#else
+ realtype <= SVt_PVMG
+#endif
+ ) { /* scalar ref */
+ SV * const namesv = newSVpvn("${", 2);
+ sv_catpvn(namesv, name, namelen);
+ sv_catpvn(namesv, "}", 1);
+ if (realpack) { /* blessed */
+ sv_catpvn(retval, "do{\\(my $o = ", 13);
+ DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval, seenhv,
+ postav, levelp, indent, pad, xpad, apad, sep, pair,
+ freezer, toaster, purity, deepcopy, quotekeys, bless,
+ maxdepth, sortkeys);
+ sv_catpvn(retval, ")}", 2);
+ } /* plain */
+ else {
+ sv_catpvn(retval, "\\", 1);
+ DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval, seenhv,
+ postav, levelp, indent, pad, xpad, apad, sep, pair,
+ freezer, toaster, purity, deepcopy, quotekeys, bless,
+ maxdepth, sortkeys);
+ }
+ SvREFCNT_dec(namesv);
+ }
+ else if (realtype == SVt_PVGV) { /* glob ref */
+ SV * const namesv = newSVpvn("*{", 2);
+ sv_catpvn(namesv, name, namelen);
+ sv_catpvn(namesv, "}", 1);
+ sv_catpvn(retval, "\\", 1);
+ DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval,
seenhv,
+ postav, levelp, indent, pad, xpad, apad, sep, pair,
+ freezer, toaster, purity, deepcopy, quotekeys, bless,
+ maxdepth, sortkeys);
+ SvREFCNT_dec(namesv);
+ }
+ else if (realtype == SVt_PVAV) {
+ SV *totpad;
+ I32 ix = 0;
+ const I32 ixmax = av_len((AV *)ival);
+
+ SV * const ixsv = newSViv(0);
+ /* allowing for a 24 char wide array index */
+ New(0, iname, namelen+28, char);
+ (void)strcpy(iname, name);
+ inamelen = namelen;
+ if (name[0] == '@') {
+ sv_catpvn(retval, "(", 1);
+ iname[0] = '$';
+ }
+ else {
+ sv_catpvn(retval, "[", 1);
+ /* omit "->" in $foo{bar}->[0], but not in ${$foo}->[0] */
+ /*if (namelen > 0
+ && name[namelen-1] != ']' && name[namelen-1] != '}'
+ && (namelen < 4 || (name[1] != '{' && name[2] != '{')))*/
+ if ((namelen > 0
+ && name[namelen-1] != ']' && name[namelen-1] != '}')
+ || (namelen > 4
+ && (name[1] == '{'
+ || (name[0] == '\\' && name[2] == '{'))))
+ {
+ iname[inamelen++] = '-'; iname[inamelen++] = '>';
+ iname[inamelen] = '\0';
+ }
+ }
+ if (iname[0] == '*' && iname[inamelen-1] == '}' && inamelen >= 8 &&
+ (instr(iname+inamelen-8, "{SCALAR}") ||
+ instr(iname+inamelen-7, "{ARRAY}") ||
+ instr(iname+inamelen-6, "{HASH}"))) {
+ iname[inamelen++] = '-'; iname[inamelen++] = '>';
+ }
+ iname[inamelen++] = '['; iname[inamelen] = '\0';
+ totpad = newSVsv(sep);
+ sv_catsv(totpad, pad);
+ sv_catsv(totpad, apad);
+
+ for (ix = 0; ix <= ixmax; ++ix) {
+ STRLEN ilen;
+ SV *elem;
+ svp = av_fetch((AV*)ival, ix, FALSE);
+ if (svp)
+ elem = *svp;
+ else
+ elem = &PL_sv_undef;
+
+ ilen = inamelen;
+ sv_setiv(ixsv, ix);
+#if PERL_VERSION < 10
+ (void) sprintf(iname+ilen, "%"IVdf, (IV)ix);
+ ilen = strlen(iname);
+#else
+ ilen = ilen + my_sprintf(iname+ilen, "%"IVdf, (IV)ix);
+#endif
+ iname[ilen++] = ']'; iname[ilen] = '\0';
+ if (indent >= 3) {
+ sv_catsv(retval, totpad);
+ sv_catsv(retval, ipad);
+ sv_catpvn(retval, "#", 1);
+ sv_catsv(retval, ixsv);
+ }
+ sv_catsv(retval, totpad);
+ sv_catsv(retval, ipad);
+ DD_dump(aTHX_ elem, iname, ilen, retval, seenhv, postav,
+ levelp, indent, pad, xpad, apad, sep, pair,
+ freezer, toaster, purity, deepcopy, quotekeys, bless,
+ maxdepth, sortkeys);
+ if (ix < ixmax)
+ sv_catpvn(retval, ",", 1);
+ }
+ if (ixmax >= 0) {
+ SV * const opad = sv_x(aTHX_ Nullsv, SvPVX_const(xpad), SvCUR(xpad),
(*levelp)-1);
+ sv_catsv(retval, totpad);
+ sv_catsv(retval, opad);
+ SvREFCNT_dec(opad);
+ }
+ if (name[0] == '@')
+ sv_catpvn(retval, ")", 1);
+ else
+ sv_catpvn(retval, "]", 1);
+ SvREFCNT_dec(ixsv);
+ SvREFCNT_dec(totpad);
+ Safefree(iname);
+ }
+ else if (realtype == SVt_PVHV) {
+ SV *totpad, *newapad;
+ SV *sname;
+ HE *entry;
+ char *key;
+ I32 klen;
+ SV *hval;
+ AV *keys = NULL;
+
+ SV * const iname = newSVpvn(name, namelen);
+ if (name[0] == '%') {
+ sv_catpvn(retval, "(", 1);
+ (SvPVX(iname))[0] = '$';
+ }
+ else {
+ sv_catpvn(retval, "{", 1);
+ /* omit "->" in $foo[0]->{bar}, but not in ${$foo}->{bar} */
+ if ((namelen > 0
+ && name[namelen-1] != ']' && name[namelen-1] != '}')
+ || (namelen > 4
+ && (name[1] == '{'
+ || (name[0] == '\\' && name[2] == '{'))))
+ {
+ sv_catpvn(iname, "->", 2);
+ }
+ }
+ if (name[0] == '*' && name[namelen-1] == '}' && namelen >= 8 &&
+ (instr(name+namelen-8, "{SCALAR}") ||
+ instr(name+namelen-7, "{ARRAY}") ||
+ instr(name+namelen-6, "{HASH}"))) {
+ sv_catpvn(iname, "->", 2);
+ }
+ sv_catpvn(iname, "{", 1);
+ totpad = newSVsv(sep);
+ sv_catsv(totpad, pad);
+ sv_catsv(totpad, apad);
+
+ /* If requested, get a sorted/filtered array of hash keys */
+ if (sortkeys) {
+ if (sortkeys == &PL_sv_yes) {
+#if PERL_VERSION < 8
+ sortkeys =
sv_2mortal(newSVpvn("Data::Dumper::_sortkeys", 23));
+#else
+ keys = newAV();
+ (void)hv_iterinit((HV*)ival);
+ while ((entry = hv_iternext((HV*)ival))) {
+ sv = hv_iterkeysv(entry);
+ SvREFCNT_inc(sv);
+ av_push(keys, sv);
+ }
+# ifdef USE_LOCALE_NUMERIC
+ sortsv(AvARRAY(keys),
+ av_len(keys)+1,
+ IN_LOCALE ? Perl_sv_cmp_locale : Perl_sv_cmp);
+# else
+ sortsv(AvARRAY(keys),
+ av_len(keys)+1,
+ Perl_sv_cmp);
+# endif
+#endif
+ }
+ if (sortkeys != &PL_sv_yes) {
+ dSP; ENTER; SAVETMPS; PUSHMARK(sp);
+ XPUSHs(sv_2mortal(newRV_inc(ival))); PUTBACK;
+ i = perl_call_sv(sortkeys, G_SCALAR | G_EVAL);
+ SPAGAIN;
+ if (i) {
+ sv = POPs;
+ if (SvROK(sv) && (SvTYPE(SvRV(sv)) == SVt_PVAV))
+ keys = (AV*)SvREFCNT_inc(SvRV(sv));
+ }
+ if (! keys)
+ warn("Sortkeys subroutine did not return ARRAYREF\n");
+ PUTBACK; FREETMPS; LEAVE;
+ }
+ if (keys)
+ sv_2mortal((SV*)keys);
+ }
+ else
+ (void)hv_iterinit((HV*)ival);
+
+ /* foreach (keys %hash) */
+ for (i = 0; 1; i++) {
+ char *nkey;
+ char *nkey_buffer = NULL;
+ I32 nticks = 0;
+ SV* keysv;
+ STRLEN keylen;
+ I32 nlen;
+ bool do_utf8 = FALSE;
+
+ if (sortkeys) {
+ if (!(keys && (I32)i <= av_len(keys))) break;
+ } else {
+ if (!(entry = hv_iternext((HV *)ival))) break;
+ }
+
+ if (i)
+ sv_catpvn(retval, ",", 1);
+
+ if (sortkeys) {
+ char *key;
+ svp = av_fetch(keys, i, FALSE);
+ keysv = svp ? *svp : sv_mortalcopy(&PL_sv_undef);
+ key = SvPV(keysv, keylen);
+ svp = hv_fetch((HV*)ival, key,
+ SvUTF8(keysv) ? -(I32)keylen : keylen,
0);
+ hval = svp ? *svp : sv_mortalcopy(&PL_sv_undef);
+ }
+ else {
+ keysv = hv_iterkeysv(entry);
+ hval = hv_iterval((HV*)ival, entry);
+ }
+
+ key = SvPV(keysv, keylen);
+ do_utf8 = DO_UTF8(keysv);
+ klen = keylen;
+
+ sv_catsv(retval, totpad);
+ sv_catsv(retval, ipad);
+ /* old logic was first to check utf8 flag, and if utf8
always
+ call esc_q_utf8. This caused test to break under
-Mutf8,
+ because there even strings like 'c' have utf8 flag on.
+ Hence with quotekeys == 0 the XS code would still ''
quote
+ them based on flags, whereas the perl code would not,
+ based on regexps.
+ The perl code is correct.
+ needs_quote() decides that anything that isn't a valid
+ perl identifier needs to be quoted, hence only correctly
+ formed strings with no characters outside [A-Za-z0-9_:]
+ won't need quoting. None of those characters are used
in
+ the byte encoding of utf8, so anything with utf8
+ encoded characters in will need quoting. Hence strings
+ with utf8 encoded characters in will end up inside
do_utf8
+ just like before, but now strings with utf8 flag set but
+ only ascii characters will end up in the unquoted
section.
+
+ There should also be less tests for the (probably
currently)
+ more common doesn't need quoting case.
+ The code is also smaller (22044 vs 22260) because I've
been
+ able to pull the common logic out to both sides. */
+ if (quotekeys || needs_quote(key)) {
+ if (do_utf8) {
+ STRLEN ocur = SvCUR(retval);
+ nlen = esc_q_utf8(aTHX_ retval, key, klen);
***The diff for this file has been truncated for email.***
=======================================
--- /dev/null
+++ /trunk/SOAP-Lite-0.52.zip Wed Sep 1 22:51:40 2010
Binary file, no diff available.
=======================================
--- /dev/null
+++ /trunk/dic_dev_build.sh Wed Sep 1 22:51:40 2010
@@ -0,0 +1,30 @@
+#!/bin/sh
+#
+# Build the related CPAN Modules for TCPInputText
+#
+# SUBVERSION PROPERTIES
+#
+# $LastChangedDate$
+# $Rev$
+# $Author$
+# $URL$
+# $Id$
+#
+# TODO Check the existance of unzip, perl and make binaries
+#
+unzip SOAP-Lite-0.52.zip
+cd SOAP-Lite-0.52
+perl Makefile.PL
+make
+make test
+make install
+cd ..
+#
+gunzip Data-Dumper-2.126.tar.gz
+tar -xvf Data-Dumper-2.126.tar
+cd Data-Dumper-2.126
+perl Makefile.PL
+sed 's/-fstack-protector//g' Makefile > Makefile.sed
+mv Makefile.sed Makefile
+make
+cd ..