view release on metacpan or  search on metacpan

Storable.xs  view on Meta::CPAN

    PERL_UNUSED_ARG(mg);
#ifdef USE_PTR_TABLE
    if (cxt->pseen)
        ptr_table_free(cxt->pseen);
#endif
    if (kbuf)
        Safefree(kbuf);
    if (!cxt->membuf_ro && mbase)
        Safefree(mbase);
    if (cxt->membuf_ro && (cxt->msaved).arena)
        Safefree((cxt->msaved).arena);
    return 0;
}

MODULE = Storable       PACKAGE = Storable

PROTOTYPES: ENABLE

BOOT:
{
    HV *stash = gv_stashpvn("Storable", 8, GV_ADD);
    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));

    newCONSTSUB(stash, "CAN_FLOCK", CAN_FLOCK);

    init_perinterp(aTHX);
    gv_fetchpv("Storable::drop_utf8",   GV_ADDMULTI, SVt_PV);
#ifdef DEBUGME
    /* Only disable the used only once warning if we are in debugging mode.  */
    gv_fetchpv("Storable::DEBUGME",   GV_ADDMULTI, SVt_PV);
#endif
#ifdef USE_56_INTERWORK_KLUDGE
    gv_fetchpv("Storable::interwork_56_64bit",   GV_ADDMULTI, SVt_PV);
#endif
    }

void
init_perinterp()
CODE:
    init_perinterp(aTHX);

# pstore
#
# Store the transitive data closure of given object to disk.
# Returns undef on error, a true value otherwise.

# net_pstore
#
# Same as pstore(), but network order is used for integers and doubles are
# emitted as strings.

SV *
pstore(f,obj)
    OutputStream f
    SV*         obj
ALIAS:
    net_pstore = 1
PPCODE:
    RETVAL = do_store(aTHX_ f, obj, 0, ix, (SV **)0) ? &PL_sv_yes : &PL_sv_undef;
    /* do_store() can reallocate the stack, so need a sequence point to ensure
       that ST(0) knows about it. Hence using two statements.  */
    ST(0) = RETVAL;
    XSRETURN(1);

# mstore
#
# Store the transitive data closure of given object to memory.
# Returns undef on error, a scalar value containing the data otherwise.

# net_mstore
#
# Same as mstore(), but network order is used for integers and doubles are
# emitted as strings.

SV *
mstore(obj)
    SV* obj
ALIAS:
    net_mstore = 1
CODE:
    RETVAL = &PL_sv_undef;
    if (!do_store(aTHX_ (PerlIO*) 0, obj, 0, ix, &RETVAL))
        RETVAL = &PL_sv_undef;
OUTPUT:
    RETVAL

SV *
pretrieve(f, flag = 6)
    InputStream f
    IV          flag
CODE:
    RETVAL = pretrieve(aTHX_ f, flag);
OUTPUT:
    RETVAL

SV *
mretrieve(sv, flag = 6)
    SV* sv
    IV  flag
CODE:
    RETVAL = mretrieve(aTHX_ sv, flag);
OUTPUT:
    RETVAL

SV *
dclone(sv)
    SV* sv
CODE:
    RETVAL = dclone(aTHX_ sv);
OUTPUT:
    RETVAL

SV*
last_op_in_netorder()
ALIAS:
    is_storing = ST_STORE
    is_retrieving = ST_RETRIEVE
PREINIT: