Compress-LZF
view release on metacpan or search on metacpan
}
else
croak ("compressed data corrupted (invalid length)");
if (!usize)
croak ("compressed data corrupted (invalid length)");
ret = NEWSV (0, usize);
SvPOK_only (ret);
dst = SvPVX (ret);
if (usize > 4000) perlinterp_release ();
res = lzf_decompress (src, csize, dst, usize) != usize;
if (usize > 4000) perlinterp_acquire ();
if (res)
{
SvREFCNT_dec (ret);
croak ("compressed data corrupted (size mismatch)", csize, skip, usize);
}
}
else
{
usize = csize - 1;
ret = NEWSV (0, usize | 1);
SvPOK_only (ret);
Move ((void *)(src + 1), (void *)SvPVX (ret), usize, unsigned char);
}
SvCUR_set (ret, usize);
return ret;
}
else
return newSVpvn ("", 0);
}
static void
need_storable (void)
{
eval_sv (sv_2mortal (newSVpvf ("require %s", SvPVbyte_nolen (serializer_package))), G_VOID | G_DISCARD);
storable_mstore = (CV *)SvREFCNT_inc (GvCV (gv_fetchpv (SvPVbyte_nolen (serializer_mstore ), TRUE, SVt_PVCV)));
storable_mretrieve = (CV *)SvREFCNT_inc (GvCV (gv_fetchpv (SvPVbyte_nolen (serializer_mretrieve), TRUE, SVt_PVCV)));
}
MODULE = Compress::LZF PACKAGE = Compress::LZF
BOOT:
serializer_package = newSVpv ("Storable", 0);
serializer_mstore = newSVpv ("Storable::net_mstore", 0);
serializer_mretrieve = newSVpv ("Storable::mretrieve", 0);
void
set_serializer(package, mstore, mretrieve)
SV * package
SV * mstore
SV * mretrieve
PROTOTYPE: $$$
PPCODE:
SvSetSV (serializer_package , package );
SvSetSV (serializer_mstore , mstore );
SvSetSV (serializer_mretrieve, mretrieve);
SvREFCNT_dec (storable_mstore ); storable_mstore = 0;
SvREFCNT_dec (storable_mretrieve); storable_mretrieve = 0;
void
compress(data)
SV * data
ALIAS:
compress_best = 1
PROTOTYPE: $
PPCODE:
XPUSHs (sv_2mortal (compress_sv (data, 0, MAGIC_U, ix)));
void
decompress(data)
SV * data
PROTOTYPE: $
PPCODE:
XPUSHs (sv_2mortal (decompress_sv (data, 0)));
void
sfreeze(sv)
SV * sv
ALIAS:
sfreeze = 0
sfreeze_cr = 1
sfreeze_c = 2
sfreeze_best = 4
sfreeze_cr_best = 5
sfreeze_c_best = 6
PROTOTYPE: $
PPCODE:
{
int best = ix & 4;
ix &= 3;
SvGETMAGIC (sv);
if (!SvOK (sv))
XPUSHs (sv_2mortal (newSVpvn ("\02", 1))); /* 02 == MAGIC_undef */
else if (SvROK (sv)
|| SvUTF8 (sv)
|| (SvTYPE(sv) != SVt_IV
&& SvTYPE(sv) != SVt_NV
&& SvTYPE(sv) != SVt_PV
&& SvTYPE(sv) != SVt_PVIV
&& SvTYPE(sv) != SVt_PVNV
&& SvTYPE(sv) != SVt_PVMG)) /* mstore */
{
int deref = !SvROK (sv);
char *pv;
if (!storable_mstore)
{
PUTBACK;
need_storable ();
SPAGAIN;
}
if (deref)
sv = newRV_noinc (sv);
PUSHMARK (SP);
XPUSHs (sv);
PUTBACK;
if (1 != call_sv ((SV *)storable_mstore, G_SCALAR))
croak ("%s didn't return a single scalar", SvPVbyte_nolen (serializer_mstore));
SPAGAIN;
sv = POPs;
pv = SvPV_nolen (sv);
if (*pv == MAGIC_R)
{
if (deref)
*pv = MAGIC_R_deref;
}
else
{
char pfx[2];
pfx[0] = MAGIC_undef;
pfx[1] = deref ? MAGIC_R_deref : MAGIC_R;
sv_insert (sv, 0, 0, pfx, 2);
}
if (ix) /* compress */
sv = sv_2mortal (compress_sv (sv, deref ? MAGIC_CR_deref : MAGIC_CR, -1, best));
XPUSHs (sv);
}
else if (SvPOKp (sv) && IN_RANGE (SvPVX (sv)[0], MAGIC_LO, MAGIC_HI))
XPUSHs (sv_2mortal (compress_sv (sv, MAGIC_C, MAGIC_U, best))); /* need to prefix only */
else if (ix == 2) /* compress always */
XPUSHs (sv_2mortal (compress_sv (sv, MAGIC_C, -1, best)));
else if (SvNIOK (sv)) /* don't compress */
{
STRLEN len;
char *s = SvPV (sv, len);
XPUSHs (sv_2mortal (newSVpvn (s, len)));
}
else /* don't compress */
XPUSHs (sv_2mortal (newSVsv (sv)));
}
void
sthaw(sv)
SV * sv
PROTOTYPE: $
PPCODE:
{
STRLEN svlen;
int deref = 0;
SvGETMAGIC (sv);
if (SvPOK (sv) && IN_RANGE (SvPVbyte (sv, svlen)[0], MAGIC_LO, MAGIC_HI))
{
redo:
switch (SvPVX (sv)[0])
{
case MAGIC_undef:
if (svlen <= 1)
XPUSHs (sv_2mortal (NEWSV (0, 0)));
else
{
if (SvPVX (sv)[1] == MAGIC_R_deref)
deref = 1;
else if (SvPVX (sv)[1] != MAGIC_R)
croak ("Compress::LZF::sthaw(): invalid data, maybe you need a newer version of Compress::LZF?");
sv_chop (sv, SvPVX (sv) + 2);
if (!storable_mstore)
{
PUTBACK;
need_storable ();
SPAGAIN;
}
PUSHMARK (SP);
XPUSHs (sv);
PUTBACK;
if (1 != call_sv ((SV *)storable_mretrieve, G_SCALAR))
croak ("%s didn't return a single scalar", SvPVbyte_nolen (serializer_mretrieve));
SPAGAIN;
if (deref)
SETs (sv_2mortal (SvREFCNT_inc (SvRV (TOPs))));
else
SETs (sv_2mortal (newSVsv (TOPs)));
}
break;
case MAGIC_U:
XPUSHs (sv_2mortal (decompress_sv (sv, 0)));
break;
case MAGIC_C:
XPUSHs (sv_2mortal (decompress_sv (sv, 1)));
break;
case MAGIC_R_deref:
deref = 1;
SvPVX (sv)[0] = MAGIC_R;
goto handle_MAGIC_R;
case MAGIC_CR_deref:
( run in 0.683 second using v1.01-cache-2.11-cpan-71847e10f99 )