view release on metacpan or  search on metacpan

Dumper.xs  view on Meta::CPAN

	    scan_vstring(mg->mg_ptr, vecsv);
#  else
	    scan_vstring(mg->mg_ptr, mg->mg_ptr + mg->mg_len, vecsv);
#  endif
	    if (!sv_eq(vecsv, val)) goto integer_came_from_string;
# endif
	    sv_catpvn(retval, (const char *)mg->mg_ptr, mg->mg_len);
	}
#endif

	else {
        integer_came_from_string:
            c = SvPV(val, i);
            /* the pure perl and XS non-qq outputs have historically been
             * different in this case, but for useqq, let's try to match
             * the pure perl code.
             * see [perl #74798]
             */
            if (style->useqq && safe_decimal_number(c, i)) {
                sv_catsv(retval, val);
            }
            else if (DO_UTF8(val) || style->useqq)
                i += esc_q_utf8(aTHX_ retval, c, i, DO_UTF8(val), style->useqq);
	    else {
		sv_grow(retval, SvCUR(retval)+3+2*i); /* 3: ""\0 */
		r = SvPVX(retval) + SvCUR(retval);
		r[0] = '\'';
		i += esc_q(r+1, c, i);
		++i;
		r[i++] = '\'';
		r[i] = '\0';
		SvCUR_set(retval, SvCUR(retval)+i);
	    }
	}
    }

    if (idlen) {
        if (style->deepcopy)
	    (void)hv_delete(seenhv, id, idlen, G_DISCARD);
	else if (namelen && seenentry) {
	    SV *mark = *av_fetch(seenentry, 2, TRUE);
	    sv_setiv(mark,1);
	}
    }
    return 1;
}


MODULE = Data::Dumper		PACKAGE = Data::Dumper         PREFIX = Data_Dumper_

#
# This is the exact equivalent of Dump.  Well, almost. The things that are
# different as of now (due to Laziness):
#   * doesn't do deparse yet.'
#

void
Data_Dumper_Dumpxs(href, ...)
	SV	*href;
	PROTOTYPE: $;$$
	PPCODE:
	{
	    HV *hv;
	    SV *retval, *valstr;
	    HV *seenhv = NULL;
	    AV *postav, *todumpav, *namesav;
	    I32 terse = 0;
	    SSize_t i, imax, postlen;
	    SV **svp;
            SV *apad = &PL_sv_undef;
            Style style;

            SV *name_sv, *val = &PL_sv_undef, *varname = &PL_sv_undef;
	    I32 gimme = GIMME_V;

	    if (!SvROK(href)) {		/* call new to get an object first */
		if (items < 2)
		    croak("Usage: Data::Dumper::Dumpxs(PACKAGE, VAL_ARY_REF, [NAME_ARY_REF])");
		
		ENTER;
		SAVETMPS;
		
		PUSHMARK(sp);
                EXTEND(SP, 3); /* 3 == max of all branches below */
		PUSHs(href);
		PUSHs(sv_2mortal(newSVsv(ST(1))));
		if (items >= 3)
		    PUSHs(sv_2mortal(newSVsv(ST(2))));
		PUTBACK;
		i = perl_call_method("new", G_SCALAR);
		SPAGAIN;
		if (i)
		    href = newSVsv(POPs);

		PUTBACK;
		FREETMPS;
		LEAVE;
		if (i)
		    (void)sv_2mortal(href);
	    }

	    todumpav = namesav = NULL;
            style.indent = 2;
            style.quotekeys = 1;
            style.maxrecurse = 1000;
            style.maxrecursed = FALSE;
            style.purity = style.deepcopy = style.useqq = style.maxdepth
                = style.use_sparse_seen_hash = style.trailingcomma = 0;
            style.pad = style.xpad = style.sep = style.pair = style.sortkeys
                = style.freezer = style.toaster = style.bless = &PL_sv_undef;
	    seenhv = NULL;
            name_sv = sv_newmortal();
	
	    retval = newSVpvs_flags("", SVs_TEMP);
	    if (SvROK(href)
		&& (hv = (HV*)SvRV((SV*)href))
		&& SvTYPE(hv) == SVt_PVHV)		{

		if ((svp = hv_fetchs(hv, "seen", FALSE)) && SvROK(*svp))
		    seenhv = (HV*)SvRV(*svp);
                else