typedef int (*sv_store_t)(pTHX_ stcxt_t *cxt, SV *sv);
-static sv_store_t sv_store[] = {
+static const sv_store_t sv_store[] = {
(sv_store_t)store_ref, /* svis_REF */
(sv_store_t)store_scalar, /* svis_SCALAR */
(sv_store_t)store_array, /* svis_ARRAY */
#else
tag = *svh;
#endif
- ary[i] = tag
+ ary[i] = tag;
TRACEME(("listed object %d at 0x%"UVxf" is tag #%"UVuf,
i-1, PTR2UV(xsv), PTR2UV(tag)));
}
* Hook not found. Maybe they did not require the module where this
* hook is defined yet?
*
- * If the require below succeeds, we'll be able to find the hook.
+ * If the load below succeeds, we'll be able to find the hook.
* Still, it only works reliably when each class is defined in a
* file of its own.
*/
- SV *psv = newSVpvn("require ", 8);
- sv_catpv(psv, classname);
-
TRACEME(("No STORABLE_thaw defined for objects of class %s", classname));
- TRACEME(("Going to require module '%s' with '%s'", classname, SvPVX(psv)));
-
- perl_eval_sv(psv, G_DISCARD);
- sv_free(psv);
+ TRACEME(("Going to load module '%s'", classname));
+ load_module(PERL_LOADMOD_NOIMPORT, newSVpv(classname, 0), Nullsv);
/*
* We cache results of pkg_can, so we need to uncache before attempting
PTR2UV(sv)));
}
if (!Gv_AMG(stash)) {
- SV *psv = newSVpvn("require ", 8);
- const char *package = HvNAME_get(stash);
- sv_catpv(psv, package);
-
+ const char *package = HvNAME_get(stash);
TRACEME(("No overloading defined for package %s", package));
- TRACEME(("Going to require module '%s' with '%s'", package, SvPVX(psv)));
-
- perl_eval_sv(psv, G_DISCARD);
- sv_free(psv);
+ TRACEME(("Going to load module '%s'", package));
+ load_module(PERL_LOADMOD_NOIMPORT, newSVpv(package, 0), Nullsv);
if (!Gv_AMG(stash)) {
CROAK(("Cannot restore overloading on %s(0x%"UVxf
") (package %s) (even after a \"require %s;\")",
sv = NEWSV(10002, len);
SEEN(sv, cname, 0); /* Associate this new scalar with tag "tagnum" */
+ if (len == 0) {
+ sv_setpvn(sv, "", 0);
+ return sv;
+ }
+
/*
* WARNING: duplicates parts of sv_setpv and breaks SV data encapsulation.
*
int length;
int use_network_order;
int use_NV_size;
+ int old_magic = 0;
int version_major;
int version_minor = 0;
if (memNE(buf, old_magicstr, old_len))
CROAK(("File is not a perl storable"));
+ old_magic++;
current = buf + old_len;
}
use_network_order = *current;
* indicate the version number of the binary, and therefore governs the
* setting of sv_retrieve_vtbl. See magic_write().
*/
-
- version_major = use_network_order >> 1;
- cxt->retrieve_vtbl = (SV*(**)(pTHX_ stcxt_t *cxt, const char *cname)) (version_major ? sv_retrieve : sv_old_retrieve);
+ if (old_magic && use_network_order > 1) {
+ /* 0.1 dump - use_network_order is really byte order length */
+ version_major = -1;
+ }
+ else {
+ version_major = use_network_order >> 1;
+ }
+ cxt->retrieve_vtbl = (SV*(**)(pTHX_ stcxt_t *cxt, const char *cname)) (version_major > 0 ? sv_retrieve : sv_old_retrieve);
TRACEME(("magic_check: netorder = 0x%x", use_network_order));
/* In C truth is 1, falsehood is 0. Very convienient. */
use_NV_size = version_major >= 2 && version_minor >= 2;
- GETMARK(c);
+ if (version_major >= 0) {
+ GETMARK(c);
+ }
+ else {
+ c = use_network_order;
+ }
length = c + 3 + use_NV_size;
READ(buf, length); /* Not null-terminated */
clean_context(aTHX_ cxt);
/*
+ * Tied elements seem to need special handling.
+ */
+
+ if (SvTYPE(sv) == SVt_PVLV && SvRMAGICAL(sv) && mg_find(sv, 'p')) {
+ mg_get(sv);
+ }
+
+ /*
* do_store() optimizes for dclone by not freeing its context, should
* we need to allocate one because we're deep cloning from a hook.
*/
PROTOTYPES: ENABLE
BOOT:
+{
+ HV *stash = gv_stashpvn("Storable", 8, TRUE);
+ newCONSTSUB(stash, "BIN_MAJOR", newSViv(STORABLE_BIN_MAJOR));
+ newCONSTSUB(stash, "BIN_MINOR", newSViv(STORABLE_BIN_MINOR));
+ newCONSTSUB(stash, "BIN_WRITE_MINOR", newSViv(STORABLE_BIN_WRITE_MINOR));
+
init_perinterp(aTHX);
gv_fetchpv("Storable::drop_utf8", GV_ADDMULTI, SVt_PV);
#ifdef DEBUGME
#ifdef USE_56_INTERWORK_KLUDGE
gv_fetchpv("Storable::interwork_56_64bit", GV_ADDMULTI, SVt_PV);
#endif
+}
void
init_perinterp()