Compress-LZF/LZF.xs

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

#include "perlmulticore.h"

#define LZF_STANDALONE 1
#define LZF_STATE_ARG 1

#include "lzf_c.c"
#include "lzf_d.c"
#include "lzf_c_best.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, int best)
{
  LZF_STATE *state;
  STRLEN usize, csize;
  char *src = (char *)SvPVbyte (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);

      New (0, state, 1, LZF_STATE);
      if (!state)
        croak ("Compress::LZF unable to allocate memory for compression state");

      if (usize > 1000) perlinterp_release ();
      /* 11 bytes is the smallest compressible string */
      csize = usize < 11 ? 0 :
              (best ? lzf_compress_best (src, usize, dst + skip, usize - skip)
                    : lzf_compress (src, usize, dst + skip, usize - skip, *state));
      if (usize > 1000) perlinterp_acquire ();

      Safefree (state);

      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 *)SvPVbyte (data, csize) + skip;

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

      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 (usize > 2000) perlinterp_release ();
          res = lzf_decompress (src, csize, dst, usize) != usize;
          if (usize > 2000) 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:
                  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)
                    {
                      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))));

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