#include <EXTERN.h>
#include <perl.h>
-#include <patchlevel.h> /* Perl's one, needed since 5.6 */
#include <XSUB.h>
+#ifndef PATCHLEVEL
+# include <patchlevel.h> /* Perl's one, needed since 5.6 */
+# if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL)))
+# include <could_not_find_Perl_patchlevel.h>
+# endif
+#endif
+
#ifndef NETWARE
#if 0
#define DEBUGME /* Debug mode, turns assertions on as well */
text = POPs;
len = SvLEN(text);
- reallen = strlen(SvPV(text,PL_na));
+ reallen = strlen(SvPV_nolen(text));
/*
* Empty code references or XS functions are deparsed as
* "(prototype) ;" or ";".
*/
- if (len == 0 || *(SvPV(text,PL_na)+reallen-1) == ';') {
+ 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"));
}
PUTMARK(SX_CODE);
TRACEME(("size = %d", len));
- TRACEME(("code = %s", SvPV(text,PL_na)));
+ TRACEME(("code = %s", SvPV_nolen(text)));
/*
* Now store the source code.
*/
- STORE_SCALAR(SvPV(text,PL_na), len);
+ STORE_SCALAR(SvPV_nolen(text), len);
FREETMPS;
LEAVE;
length -= sizeof (magicstr) - 1;
}
- WRITE(header, length);
+ WRITE( (unsigned char*) header, length);
if (!cxt->netorder) {
TRACEME(("ok (magic_write byteorder = 0x%lx [%d], I%d L%d P%d D%d)",
* an SX_OBJECT indication, a ref count increment was done.
*/
- sv_upgrade(rv, SVt_RV);
+ if (cname) {
+ /* Do not use sv_upgrade to preserve STASH */
+ SvFLAGS(rv) &= ~SVTYPEMASK;
+ SvFLAGS(rv) |= SVt_RV;
+ } else {
+ sv_upgrade(rv, SVt_RV);
+ }
+
SvRV(rv) = sv; /* $rv = \$sv */
SvROK_on(rv);
*/
sub = newSVpvn("sub ", 4);
- sv_catpv(sub, SvPV(text, PL_na)); /* XXX no sv_catsv! */
+ sv_catpv(sub, SvPV_nolen(text)); /* XXX no sv_catsv! */
SvREFCNT_dec(text);
/*
CROAK(("Unexpected return value from $Storable::Eval callback\n"));
cv = POPs;
if (SvTRUE(errsv)) {
- CROAK(("code %s caused an error: %s", SvPV(sub, PL_na), SvPV(errsv, PL_na)));
+ CROAK(("code %s caused an error: %s",
+ SvPV_nolen(sub), SvPV_nolen(errsv)));
}
PUTBACK;
} else {
- cv = eval_pv(SvPV(sub, PL_na), TRUE);
+ cv = eval_pv(SvPV_nolen(sub), TRUE);
}
if (cv && SvROK(cv) && SvTYPE(SvRV(cv)) == SVt_PVCV) {
sv = SvRV(cv);
} else {
- CROAK(("code %s did not evaluate to a subroutine reference\n", SvPV(sub, PL_na)));
+ CROAK(("code %s did not evaluate to a subroutine reference\n", SvPV_nolen(sub)));
}
SvREFCNT_inc(sv); /* XXX seems to be necessary */
/* sizeof(char *) */
if ((int) *current != sizeof(char *))
- CROAK(("Pointer integer size is not compatible"));
+ CROAK(("Pointer size is not compatible"));
if (use_NV_size) {
/* sizeof(NV) */
if (!sv) {
TRACEME(("retrieve ERROR"));
+#if (PATCHLEVEL <= 4)
+ /* perl 5.00405 seems to screw up at this point with an
+ 'attempt to modify a read only value' error reported in the
+ eval { $self = pretrieve(*FILE) } in _retrieve.
+ I can't see what the cause of this error is, but I suspect a
+ bug in 5.004, as it seems to be capable of issuing spurious
+ errors or core dumping with matches on $@. I'm not going to
+ spend time on what could be a fruitless search for the cause,
+ so here's a bodge. If you're running 5.004 and don't like
+ this inefficiency, either upgrade to a newer perl, or you are
+ welcome to find the problem and send in a patch.
+ */
+ return newSV(0);
+#else
return &PL_sv_undef; /* Something went wrong, return undef */
+#endif
}
TRACEME(("retrieve got %s(0x%"UVxf")",