Compress-LZF/LZF.xs

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

/* try to be compatible with older perls */
/* SvPV_nolen() macro first defined in 5.005_55 */
/* this is slow, not threadsafe, but works */
#include "patchlevel.h"
#if (PATCHLEVEL == 4) || ((PATCHLEVEL == 5) && (SUBVERSION < 55))
static STRLEN nolen_na;
# define SvPV_nolen(sv) SvPV ((sv), nolen_na)
#endif
#if PATCHLEVEL < 6
# define call_sv perl_call_sv
#endif

#include "lzf_c.c"
#include "lzf_d.c"

/* we re-use the storable header for our purposes */
#define MAGIC_LO        0
#define MAGIC_U         0 /* uncompressed data follows */
#define MAGIC_C         1 /* compressed data follows */
#define MAGIC_undef     2 /* the special value undef */
#define MAGIC_CR        3 /* storable (reference, freeze), compressed */
#define MAGIC_R         4 /* storable (reference, freeze) */
#define MAGIC_CR_deref  5 /* storable (NO reference, freeze), compressed */
#define MAGIC_R_deref   6 /* storable (NO reference, freeze) */
#define MAGIC_HI        7 /* room for one higher storable major */
/* for historical reasons, MAGIC_undef + MAGIC_R and MAGIC_undef + MAGIC_R_deref are used, too */

#define IN_RANGE(v,l,h) ((unsigned int)((unsigned)(v) - (unsigned)(l)) <= (unsigned)(h) - (unsigned)(l))

static SV *serializer_package, *serializer_mstore, *serializer_mretrieve;
static CV *storable_mstore, *storable_mretrieve;

#if Size_t_size > 4
# define MAX_LENGTH ((Size_t)0x80000000L)
#else
# define MAX_LENGTH ((Size_t) 0x8000000L)
#endif

static SV *
compress_sv (SV *data, char cprepend, int uprepend)
{
  STRLEN usize, csize;
  char *src = (char *)SvPV (data, usize);

  if (usize)
    {
      SV *ret = NEWSV (0, usize + 1);
      unsigned char *dst;
      int skip = 0;

      SvPOK_only (ret);
      dst = (unsigned char *)SvPVX (ret);

      if (cprepend)
        dst[skip++] = cprepend;

      if (usize <= 0x7f)
        {
          dst[skip++] = usize;
        }
      else if (usize <= 0x7ff) 
        {
          dst[skip++] = (( usize >>  6)         | 0xc0);
          dst[skip++] = (( usize        & 0x3f) | 0x80);
        }
      else if (usize <= 0xffff) 
        {
          dst[skip++] = (( usize >> 12)         | 0xe0);
          dst[skip++] = (((usize >>  6) & 0x3f) | 0x80);
          dst[skip++] = (( usize        & 0x3f) | 0x80);
        }
      else if (usize <= 0x1fffff) 
        {
          dst[skip++] = (( usize >> 18)         | 0xf0);
          dst[skip++] = (((usize >> 12) & 0x3f) | 0x80);
          dst[skip++] = (((usize >>  6) & 0x3f) | 0x80);
          dst[skip++] = (( usize        & 0x3f) | 0x80);
        }
      else if (usize <= 0x3ffffff) 
        {
          dst[skip++] = (( usize >> 24)         | 0xf8);
          dst[skip++] = (((usize >> 18) & 0x3f) | 0x80);
          dst[skip++] = (((usize >> 12) & 0x3f) | 0x80);
          dst[skip++] = (((usize >>  6) & 0x3f) | 0x80);
          dst[skip++] = (( usize        & 0x3f) | 0x80);
        }
      else if (usize <= 0x7fffffff) 
        {
          dst[skip++] = (( usize >> 30)         | 0xfc);
          dst[skip++] = (((usize >> 24) & 0x3f) | 0x80);
          dst[skip++] = (((usize >> 18) & 0x3f) | 0x80);
          dst[skip++] = (((usize >> 12) & 0x3f) | 0x80);
          dst[skip++] = (((usize >>  6) & 0x3f) | 0x80);
          dst[skip++] = (( usize        & 0x3f) | 0x80);
        }
      else
        croak ("compress can only compress up to %ld bytes", 0x7fffffffL);

      /* 11 bytes is the smallest compressible string */
      csize = usize < 11 ? 0 :
              lzf_compress (src, usize,
                                  dst + skip,
                                  usize - skip);

      if (csize)
        {
          SvCUR_set (ret, csize + skip);
        }
      else if (uprepend < 0)
        {
          SvREFCNT_dec (ret);
          ret = SvREFCNT_inc (data);
        }
      else
        {
          *dst++ = uprepend;

          Move ((void *)src, (void *)dst, usize, unsigned char);

          SvCUR_set (ret, usize + 1);
        }

      return ret;
    }
  else
    return newSVpv ("", 0);
}

static SV *
decompress_sv (SV *data, int skip)
{
  STRLEN usize, csize;
  unsigned char *src = (unsigned char *)SvPV (data, csize) + skip;

  if (csize)
    {
      void *dst;
      SV *ret;

      csize -= skip;

      if (src[0])
        {
          if (!(src[0] & 0x80) && csize >= 1)
            {
              csize -= 1;
              usize =                 *src++ & 0xff;
            }
          else if (!(src[0] & 0x20) && csize >= 2)
            {
              csize -= 2;
              usize =                 *src++ & 0x1f;
              usize = (usize << 6) | (*src++ & 0x3f);
            }
          else if (!(src[0] & 0x10) && csize >= 3)
            {
              csize -= 3;
              usize =                 *src++ & 0x0f;
              usize = (usize << 6) | (*src++ & 0x3f);
              usize = (usize << 6) | (*src++ & 0x3f);
            }
          else if (!(src[0] & 0x08) && csize >= 4)
            {
              csize -= 4;
              usize =                 *src++ & 0x07;
              usize = (usize << 6) | (*src++ & 0x3f);
              usize = (usize << 6) | (*src++ & 0x3f);
              usize = (usize << 6) | (*src++ & 0x3f);
            }
          else if (!(src[0] & 0x04) && csize >= 5)
            {
              csize -= 5;
              usize =                 *src++ & 0x03;
              usize = (usize << 6) | (*src++ & 0x3f);
              usize = (usize << 6) | (*src++ & 0x3f);
              usize = (usize << 6) | (*src++ & 0x3f);
              usize = (usize << 6) | (*src++ & 0x3f);
            }
          else if (!(src[0] & 0x02) && csize >= 6)
            {
              csize -= 6;
              usize =                 *src++ & 0x01;
              usize = (usize << 6) | (*src++ & 0x3f);
              usize = (usize << 6) | (*src++ & 0x3f);
              usize = (usize << 6) | (*src++ & 0x3f);
              usize = (usize << 6) | (*src++ & 0x3f);
              usize = (usize << 6) | (*src++ & 0x3f);
            }
          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 (lzf_decompress (src, csize, dst, usize) != usize)
            {
              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)
{
#if PATCHLEVEL < 6
  char req[8192];
  sprintf (req, "require %s;", SvPV_nolen (serializer_package));
  perl_eval_pv (req, 1);
#else
  load_module (PERL_LOADMOD_NOIMPORT, serializer_package, Nullsv);
#endif

  storable_mstore    = GvCV (gv_fetchpv (SvPV_nolen (serializer_mstore   ), TRUE, SVt_PVCV));
  storable_mretrieve = GvCV (gv_fetchpv (SvPV_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);
        storable_mstore =
        storable_mretrieve = 0;

void
compress(data)
        SV *    data
        PROTOTYPE: $
        PPCODE:
        XPUSHs (sv_2mortal (compress_sv (data, 0, MAGIC_U)));

void
decompress(data)
        SV *    data
        PROTOTYPE: $
        PPCODE:
        XPUSHs (sv_2mortal (decompress_sv (data, 0)));

void
sfreeze(sv)
        SV *    sv
        ALIAS:
        sfreeze_cr = 1
        sfreeze_c  = 2
        PROTOTYPE: $
        PPCODE:

        SvGETMAGIC (sv);

        if (!SvOK (sv))
          XPUSHs (sv_2mortal (newSVpvn ("\02", 1))); /* 02 == MAGIC_undef */
        else if (SvROK (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);

            if (!storable_mstore)
              need_storable ();

            if (deref)
              sv = newRV_noinc (sv);

            PUSHMARK (SP);
            XPUSHs (sv);
            PUTBACK;

            if (1 != call_sv ((SV *)storable_mstore, G_SCALAR))
              croak ("Storable::mstore didn't return a single scalar");

            SPAGAIN;

            sv = POPs;

            if (SvPVX (sv)[0] == MAGIC_R)
              {
                if (deref)
                  SvPVX (sv)[0] = 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));

            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))); /* need to prefix only */
        else if (ix == 2) /* compress always */
          XPUSHs (sv_2mortal (compress_sv (sv, MAGIC_C, -1)));
        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 (SvPV (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)
                        need_storable ();

                      PUSHMARK (SP);
                      XPUSHs (sv);
                      PUTBACK;

                      if (1 != call_sv ((SV *)storable_mretrieve, G_SCALAR))
                        croak ("Storable::mstore didn't return a single scalar");

                      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:
                  deref = 1;
                case MAGIC_CR:
                  sv = sv_2mortal (decompress_sv (sv, 1)); /* mortal could be optimized */
                  if (deref)
                    if (SvPVX (sv)[0] == MAGIC_R_deref)
                      SvPVX (sv)[0] = MAGIC_R;

                  goto redo;

                case MAGIC_R:
                handle_MAGIC_R:
                  if (!storable_mstore)
                    need_storable ();

                  PUSHMARK (SP);
                  XPUSHs (sv);
                  PUTBACK;

                  if (1 != call_sv ((SV *)storable_mretrieve, G_SCALAR))
                    croak ("Storable::mstore didn't return a single scalar");

                  SPAGAIN;

                  if (deref)
                    {
                      SETs (sv_2mortal (SvREFCNT_inc (SvRV (TOPs))));

                      if (SvPVX (sv)[0] == MAGIC_R)
                        SvPVX (sv)[0] = MAGIC_R_deref;
                    }
                  else
                    SETs (sv_2mortal (newSVsv (TOPs)));

                  break; 

                default:
                  croak ("Compress::LZF::sthaw(): invalid data, maybe you need a newer version of Compress::LZF?");
              }
          }
        else
          XPUSHs (sv_2mortal (newSVsv (sv)));
}

Revision:	1.22
Committed:	Wed Sep 27 19:01:48 2006 UTC (17 years, 7 months ago) by root
Branch:	MAIN
Changes since 1.21:	+4 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	#include "EXTERN.h"
2			#include "perl.h"
3			#include "XSUB.h"
4
5			/* try to be compatible with older perls */
6			/* SvPV_nolen() macro first defined in 5.005_55 */
7			/* this is slow, not threadsafe, but works */
8			#include "patchlevel.h"
9			#if (PATCHLEVEL == 4) \|\| ((PATCHLEVEL == 5) && (SUBVERSION < 55))
10			static STRLEN nolen_na;
11			# define SvPV_nolen(sv) SvPV ((sv), nolen_na)
12			#endif
13	root	1.2	#if PATCHLEVEL < 6
14			# define call_sv perl_call_sv
15			#endif
16	root	1.1
17			#include "lzf_c.c"
18			#include "lzf_d.c"
19
20			/* we re-use the storable header for our purposes */
21			#define MAGIC_LO 0
22			#define MAGIC_U 0 /* uncompressed data follows */
23			#define MAGIC_C 1 /* compressed data follows */
24	root	1.4	#define MAGIC_undef 2 /* the special value undef */
25			#define MAGIC_CR 3 /* storable (reference, freeze), compressed */
26	root	1.1	#define MAGIC_R 4 /* storable (reference, freeze) */
27	root	1.9	#define MAGIC_CR_deref 5 /* storable (NO reference, freeze), compressed */
28	root	1.10	#define MAGIC_R_deref 6 /* storable (NO reference, freeze) */
29	root	1.1	#define MAGIC_HI 7 /* room for one higher storable major */
30	root	1.20	/* for historical reasons, MAGIC_undef + MAGIC_R and MAGIC_undef + MAGIC_R_deref are used, too */
31	root	1.1
32			#define IN_RANGE(v,l,h) ((unsigned int)((unsigned)(v) - (unsigned)(l)) <= (unsigned)(h) - (unsigned)(l))
33
34	root	1.14	static SV serializer_package, serializer_mstore, *serializer_mretrieve;
35	root	1.1	static CV storable_mstore, storable_mretrieve;
36
37	root	1.20	#if Size_t_size > 4
38			# define MAX_LENGTH ((Size_t)0x80000000L)
39			#else
40			# define MAX_LENGTH ((Size_t) 0x8000000L)
41			#endif
42
43	root	1.1	static SV *
44	root	1.10	compress_sv (SV *data, char cprepend, int uprepend)
45	root	1.1	{
46			STRLEN usize, csize;
47			char src = (char )SvPV (data, usize);
48
49			if (usize)
50			{
51			SV *ret = NEWSV (0, usize + 1);
52			unsigned char *dst;
53			int skip = 0;
54
55			SvPOK_only (ret);
56			dst = (unsigned char *)SvPVX (ret);
57
58			if (cprepend)
59			dst[skip++] = cprepend;
60
61	root	1.20	if (usize <= 0x7f)
62	root	1.1	{
63			dst[skip++] = usize;
64			}
65	root	1.20	else if (usize <= 0x7ff)
66	root	1.1	{
67			dst[skip++] = (( usize >> 6) \| 0xc0);
68			dst[skip++] = (( usize & 0x3f) \| 0x80);
69			}
70	root	1.20	else if (usize <= 0xffff)
71	root	1.1	{
72			dst[skip++] = (( usize >> 12) \| 0xe0);
73			dst[skip++] = (((usize >> 6) & 0x3f) \| 0x80);
74			dst[skip++] = (( usize & 0x3f) \| 0x80);
75			}
76	root	1.20	else if (usize <= 0x1fffff)
77	root	1.1	{
78			dst[skip++] = (( usize >> 18) \| 0xf0);
79			dst[skip++] = (((usize >> 12) & 0x3f) \| 0x80);
80			dst[skip++] = (((usize >> 6) & 0x3f) \| 0x80);
81			dst[skip++] = (( usize & 0x3f) \| 0x80);
82			}
83	root	1.20	else if (usize <= 0x3ffffff)
84	root	1.1	{
85			dst[skip++] = (( usize >> 24) \| 0xf8);
86			dst[skip++] = (((usize >> 18) & 0x3f) \| 0x80);
87			dst[skip++] = (((usize >> 12) & 0x3f) \| 0x80);
88			dst[skip++] = (((usize >> 6) & 0x3f) \| 0x80);
89			dst[skip++] = (( usize & 0x3f) \| 0x80);
90			}
91	root	1.20	else if (usize <= 0x7fffffff)
92			{
93			dst[skip++] = (( usize >> 30) \| 0xfc);
94			dst[skip++] = (((usize >> 24) & 0x3f) \| 0x80);
95			dst[skip++] = (((usize >> 18) & 0x3f) \| 0x80);
96			dst[skip++] = (((usize >> 12) & 0x3f) \| 0x80);
97			dst[skip++] = (((usize >> 6) & 0x3f) \| 0x80);
98			dst[skip++] = (( usize & 0x3f) \| 0x80);
99			}
100	root	1.1	else
101	root	1.20	croak ("compress can only compress up to %ld bytes", 0x7fffffffL);
102	root	1.1
103			/* 11 bytes is the smallest compressible string */
104			csize = usize < 11 ? 0 :
105			lzf_compress (src, usize,
106			dst + skip,
107			usize - skip);
108
109			if (csize)
110			{
111			SvCUR_set (ret, csize + skip);
112			}
113	root	1.10	else if (uprepend < 0)
114	root	1.1	{
115			SvREFCNT_dec (ret);
116			ret = SvREFCNT_inc (data);
117			}
118			else
119			{
120	root	1.10	*dst++ = uprepend;
121	root	1.1
122			Move ((void )src, (void )dst, usize, unsigned char);
123
124			SvCUR_set (ret, usize + 1);
125			}
126
127			return ret;
128			}
129			else
130			return newSVpv ("", 0);
131			}
132
133			static SV *
134			decompress_sv (SV *data, int skip)
135			{
136			STRLEN usize, csize;
137			unsigned char src = (unsigned char )SvPV (data, csize) + skip;
138
139			if (csize)
140			{
141			void *dst;
142			SV *ret;
143
144			csize -= skip;
145
146			if (src[0])
147			{
148	root	1.21	if (!(src[0] & 0x80) && csize >= 1)
149	root	1.1	{
150			csize -= 1;
151			usize = *src++ & 0xff;
152			}
153	root	1.21	else if (!(src[0] & 0x20) && csize >= 2)
154	root	1.1	{
155			csize -= 2;
156			usize = *src++ & 0x1f;
157			usize = (usize << 6) \| (*src++ & 0x3f);
158			}
159	root	1.21	else if (!(src[0] & 0x10) && csize >= 3)
160	root	1.1	{
161			csize -= 3;
162			usize = *src++ & 0x0f;
163			usize = (usize << 6) \| (*src++ & 0x3f);
164			usize = (usize << 6) \| (*src++ & 0x3f);
165			}
166	root	1.21	else if (!(src[0] & 0x08) && csize >= 4)
167	root	1.1	{
168			csize -= 4;
169			usize = *src++ & 0x07;
170			usize = (usize << 6) \| (*src++ & 0x3f);
171			usize = (usize << 6) \| (*src++ & 0x3f);
172			usize = (usize << 6) \| (*src++ & 0x3f);
173			}
174	root	1.21	else if (!(src[0] & 0x04) && csize >= 5)
175	root	1.1	{
176			csize -= 5;
177			usize = *src++ & 0x03;
178			usize = (usize << 6) \| (*src++ & 0x3f);
179			usize = (usize << 6) \| (*src++ & 0x3f);
180			usize = (usize << 6) \| (*src++ & 0x3f);
181			usize = (usize << 6) \| (*src++ & 0x3f);
182			}
183	root	1.21	else if (!(src[0] & 0x02) && csize >= 6)
184	root	1.20	{
185			csize -= 6;
186			usize = *src++ & 0x01;
187			usize = (usize << 6) \| (*src++ & 0x3f);
188			usize = (usize << 6) \| (*src++ & 0x3f);
189			usize = (usize << 6) \| (*src++ & 0x3f);
190			usize = (usize << 6) \| (*src++ & 0x3f);
191			usize = (usize << 6) \| (*src++ & 0x3f);
192			}
193	root	1.1	else
194	root	1.13	croak ("compressed data corrupted (invalid length)");
195	root	1.21
196			if (!usize)
197			croak ("compressed data corrupted (invalid length)");
198	root	1.1
199			ret = NEWSV (0, usize);
200			SvPOK_only (ret);
201			dst = SvPVX (ret);
202
203			if (lzf_decompress (src, csize, dst, usize) != usize)
204	root	1.22	{
205			SvREFCNT_dec (ret);
206			croak ("compressed data corrupted (size mismatch)", csize, skip, usize);
207			}
208	root	1.1	}
209			else
210			{
211			usize = csize - 1;
212	root	1.21	ret = NEWSV (0, usize \| 1);
213	root	1.1	SvPOK_only (ret);
214
215			Move ((void )(src + 1), (void )SvPVX (ret), usize, unsigned char);
216			}
217
218			SvCUR_set (ret, usize);
219
220			return ret;
221			}
222			else
223			return newSVpvn ("", 0);
224			}
225
226			static void
227			need_storable(void)
228			{
229	root	1.2	#if PATCHLEVEL < 6
230	root	1.14	char req[8192];
231			sprintf (req, "require %s;", SvPV_nolen (serializer_package));
232			perl_eval_pv (req, 1);
233	root	1.2	#else
234	root	1.14	load_module (PERL_LOADMOD_NOIMPORT, serializer_package, Nullsv);
235	root	1.2	#endif
236	root	1.1
237	root	1.14	storable_mstore = GvCV (gv_fetchpv (SvPV_nolen (serializer_mstore ), TRUE, SVt_PVCV));
238			storable_mretrieve = GvCV (gv_fetchpv (SvPV_nolen (serializer_mretrieve), TRUE, SVt_PVCV));
239	root	1.1	}
240
241			MODULE = Compress::LZF PACKAGE = Compress::LZF
242	root	1.14
243			BOOT:
244			serializer_package = newSVpv ("Storable", 0);
245	root	1.20	serializer_mstore = newSVpv ("Storable::net_mstore", 0);
246	root	1.14	serializer_mretrieve = newSVpv ("Storable::mretrieve", 0);
247
248			void
249			set_serializer(package, mstore, mretrieve)
250			SV * package
251			SV * mstore
252			SV * mretrieve
253			PROTOTYPE: $$$
254			PPCODE:
255			SvSetSV (serializer_package , package );
256			SvSetSV (serializer_mstore , mstore );
257			SvSetSV (serializer_mretrieve, mretrieve);
258			storable_mstore =
259			storable_mretrieve = 0;
260	root	1.1
261			void
262			compress(data)
263			SV * data
264			PROTOTYPE: $
265			PPCODE:
266	root	1.10	XPUSHs (sv_2mortal (compress_sv (data, 0, MAGIC_U)));
267	root	1.1
268			void
269			decompress(data)
270			SV * data
271			PROTOTYPE: $
272			PPCODE:
273			XPUSHs (sv_2mortal (decompress_sv (data, 0)));
274
275			void
276			sfreeze(sv)
277			SV * sv
278			ALIAS:
279			sfreeze_cr = 1
280			sfreeze_c = 2
281			PROTOTYPE: $
282			PPCODE:
283
284	root	1.10	SvGETMAGIC (sv);
285
286	root	1.4	if (!SvOK (sv))
287			XPUSHs (sv_2mortal (newSVpvn ("\02", 1))); /* 02 == MAGIC_undef */
288	root	1.12	else if (SvROK (sv)
289			\|\| (SvTYPE(sv) != SVt_IV
290			&& SvTYPE(sv) != SVt_NV
291			&& SvTYPE(sv) != SVt_PV
292	root	1.15	&& SvTYPE(sv) != SVt_PVIV
293			&& SvTYPE(sv) != SVt_PVNV
294	root	1.12	&& SvTYPE(sv) != SVt_PVMG)) /* mstore */
295	root	1.1	{
296	root	1.9	int deref = !SvROK (sv);
297
298	root	1.1	if (!storable_mstore)
299			need_storable ();
300
301	root	1.9	if (deref)
302			sv = newRV_noinc (sv);
303
304	root	1.1	PUSHMARK (SP);
305			XPUSHs (sv);
306			PUTBACK;
307
308			if (1 != call_sv ((SV *)storable_mstore, G_SCALAR))
309			croak ("Storable::mstore didn't return a single scalar");
310
311			SPAGAIN;
312
313			sv = POPs;
314
315	root	1.20	if (SvPVX (sv)[0] == MAGIC_R)
316			{
317			if (deref)
318			SvPVX (sv)[0] = MAGIC_R_deref;
319			}
320			else
321			{
322			char pfx[2];
323
324			pfx[0] = MAGIC_undef;
325			pfx[1] = deref ? MAGIC_R_deref : MAGIC_R;
326	root	1.1
327	root	1.20	sv_insert (sv, 0, 0, pfx, 2);
328			}
329	root	1.10
330	root	1.1	if (ix) /* compress */
331	root	1.10	sv = sv_2mortal (compress_sv (sv, deref ? MAGIC_CR_deref : MAGIC_CR, -1));
332	root	1.9
333	root	1.10	XPUSHs (sv);
334	root	1.1	}
335	root	1.13	else if (SvPOKp (sv) && IN_RANGE (SvPVX (sv)[0], MAGIC_LO, MAGIC_HI))
336	root	1.10	XPUSHs (sv_2mortal (compress_sv (sv, MAGIC_C, MAGIC_U))); /* need to prefix only */
337	root	1.1	else if (ix == 2) /* compress always */
338	root	1.10	XPUSHs (sv_2mortal (compress_sv (sv, MAGIC_C, -1)));
339	root	1.15	else if (SvNIOK (sv)) /* don't compress */
340			{
341			STRLEN len;
342			char *s = SvPV (sv, len);
343			XPUSHs (sv_2mortal (newSVpvn (s, len)));
344			}
345	root	1.1	else /* don't compress */
346	root	1.15	XPUSHs (sv_2mortal (newSVsv (sv)));
347	root	1.1
348			void
349			sthaw(sv)
350			SV * sv
351			PROTOTYPE: $
352			PPCODE:
353	root	1.20	{
354			STRLEN svlen;
355	root	1.9	int deref = 0;
356
357	root	1.7	SvGETMAGIC (sv);
358	root	1.20	if (SvPOK (sv) && IN_RANGE (SvPV (sv, svlen)[0], MAGIC_LO, MAGIC_HI))
359	root	1.1	{
360	root	1.20	redo:
361
362	root	1.1	switch (SvPVX (sv)[0])
363			{
364	root	1.4	case MAGIC_undef:
365	root	1.20	if (svlen <= 1)
366			XPUSHs (sv_2mortal (NEWSV (0, 0)));
367			else
368			{
369			if (SvPVX (sv)[1] == MAGIC_R_deref)
370			deref = 1;
371			else if (SvPVX (sv)[1] != MAGIC_R)
372			croak ("Compress::LZF::sthaw(): invalid data, maybe you need a newer version of Compress::LZF?");
373
374			sv_chop (sv, SvPVX (sv) + 2);
375
376			if (!storable_mstore)
377			need_storable ();
378
379			PUSHMARK (SP);
380			XPUSHs (sv);
381			PUTBACK;
382
383			if (1 != call_sv ((SV *)storable_mretrieve, G_SCALAR))
384			croak ("Storable::mstore didn't return a single scalar");
385
386			SPAGAIN;
387
388			if (deref)
389			SETs (sv_2mortal (SvREFCNT_inc (SvRV (TOPs))));
390			else
391			SETs (sv_2mortal (newSVsv (TOPs)));
392			}
393	root	1.4	break;
394
395	root	1.1	case MAGIC_U:
396			XPUSHs (sv_2mortal (decompress_sv (sv, 0)));
397			break;
398
399			case MAGIC_C:
400			XPUSHs (sv_2mortal (decompress_sv (sv, 1)));
401			break;
402
403	root	1.10	case MAGIC_R_deref:
404			deref = 1;
405			SvPVX (sv)[0] = MAGIC_R;
406			goto handle_MAGIC_R;
407
408	root	1.9	case MAGIC_CR_deref:
409			deref = 1;
410	root	1.1	case MAGIC_CR:
411			sv = sv_2mortal (decompress_sv (sv, 1)); /* mortal could be optimized */
412	root	1.10	if (deref)
413			if (SvPVX (sv)[0] == MAGIC_R_deref)
414	root	1.9	SvPVX (sv)[0] = MAGIC_R;
415	root	1.20
416			goto redo;
417	root	1.10
418	root	1.1	case MAGIC_R:
419	root	1.10	handle_MAGIC_R:
420	root	1.1	if (!storable_mstore)
421			need_storable ();
422
423			PUSHMARK (SP);
424			XPUSHs (sv);
425			PUTBACK;
426
427			if (1 != call_sv ((SV *)storable_mretrieve, G_SCALAR))
428			croak ("Storable::mstore didn't return a single scalar");
429
430			SPAGAIN;
431
432	root	1.9	if (deref)
433			{
434	root	1.10	SETs (sv_2mortal (SvREFCNT_inc (SvRV (TOPs))));
435	root	1.9
436			if (SvPVX (sv)[0] == MAGIC_R)
437	root	1.10	SvPVX (sv)[0] = MAGIC_R_deref;
438	root	1.9	}
439	root	1.10	else
440	pcg	1.17	SETs (sv_2mortal (newSVsv (TOPs)));
441	root	1.1
442			break;
443
444			default:
445			croak ("Compress::LZF::sthaw(): invalid data, maybe you need a newer version of Compress::LZF?");
446			}
447			}
448			else
449	root	1.11	XPUSHs (sv_2mortal (newSVsv (sv)));
450	root	1.20	}
451	pcg	1.16