view release on metacpan or  search on metacpan

Storable/Storable.xs  view on Meta::CPAN

	len = SvCUR(text);
	reallen = strlen(SvPV_nolen(text));

	/*
	 * Empty code references or XS functions are deparsed as
	 * "(prototype) ;" or ";".
	 */

	if (len == 0 || *(SvPV_nolen(text)+reallen-1) == ';') {
	    CROAK(("The result of B::Deparse::coderef2text was empty - maybe you're trying to serialize an XS function?\n"));
	}

	/* 
	 * Signal code by emitting SX_CODE.
	 */

	PUTMARK(SX_CODE);
	cxt->tagnum++;   /* necessary, as SX_CODE is a SEEN() candidate */
	TRACEME(("size = %d", len));
	TRACEME(("code = %s", SvPV_nolen(text)));

	/*
	 * Now store the source code.
	 */

	STORE_SCALAR(SvPV_nolen(text), len);

	FREETMPS;
	LEAVE;

	TRACEME(("ok (code)"));

	return 0;
#endif
}

/*
 * store_tied
 *
 * When storing a tied object (be it a tied scalar, array or hash), we lay out
 * a special mark, followed by the underlying tied object. For instance, when
 * dealing with a tied hash, we store SX_TIED_HASH <hash object>, where
 * <hash object> stands for the serialization of the tied hash.
 */
static int store_tied(pTHX_ stcxt_t *cxt, SV *sv)
{
	MAGIC *mg;
	SV *obj = NULL;
	int ret = 0;
	int svt = SvTYPE(sv);
	char mtype = 'P';

	TRACEME(("store_tied (0x%"UVxf")", PTR2UV(sv)));

	/*
	 * We have a small run-time penalty here because we chose to factorise
	 * all tieds objects into the same routine, and not have a store_tied_hash,
	 * a store_tied_array, etc...
	 *
	 * Don't use a switch() statement, as most compilers don't optimize that
	 * well for 2/3 values. An if() else if() cascade is just fine. We put
	 * tied hashes first, as they are the most likely beasts.
	 */

	if (svt == SVt_PVHV) {
		TRACEME(("tied hash"));
		PUTMARK(SX_TIED_HASH);			/* Introduces tied hash */
	} else if (svt == SVt_PVAV) {
		TRACEME(("tied array"));
		PUTMARK(SX_TIED_ARRAY);			/* Introduces tied array */
	} else {
		TRACEME(("tied scalar"));
		PUTMARK(SX_TIED_SCALAR);		/* Introduces tied scalar */
		mtype = 'q';
	}

	if (!(mg = mg_find(sv, mtype)))
		CROAK(("No magic '%c' found while storing tied %s", mtype,
			(svt == SVt_PVHV) ? "hash" :
				(svt == SVt_PVAV) ? "array" : "scalar"));

	/*
	 * The mg->mg_obj found by mg_find() above actually points to the
	 * underlying tied Perl object implementation. For instance, if the
	 * original SV was that of a tied array, then mg->mg_obj is an AV.
	 *
	 * Note that we store the Perl object as-is. We don't call its FETCH
	 * method along the way. At retrieval time, we won't call its STORE
	 * method either, but the tieing magic will be re-installed. In itself,
	 * that ensures that the tieing semantics are preserved since futher
	 * accesses on the retrieved object will indeed call the magic methods...
	 */

	/* [#17040] mg_obj is NULL for scalar self-ties. AMS 20030416 */
	obj = mg->mg_obj ? mg->mg_obj : newSV(0);
	if ((ret = store(aTHX_ cxt, obj)))
		return ret;

	TRACEME(("ok (tied)"));

	return 0;
}

/*
 * store_tied_item
 *
 * Stores a reference to an item within a tied structure:
 *
 *  . \$h{key}, stores both the (tied %h) object and 'key'.
 *  . \$a[idx], stores both the (tied @a) object and 'idx'.
 *
 * Layout is therefore either:
 *     SX_TIED_KEY <object> <key>
 *     SX_TIED_IDX <object> <index>
 */
static int store_tied_item(pTHX_ stcxt_t *cxt, SV *sv)
{
	MAGIC *mg;
	int ret;

	TRACEME(("store_tied_item (0x%"UVxf")", PTR2UV(sv)));