… | |
… | |
8 | #include "patchlevel.h" |
8 | #include "patchlevel.h" |
9 | #if (PATCHLEVEL == 4) || ((PATCHLEVEL == 5) && (SUBVERSION < 55)) |
9 | #if (PATCHLEVEL == 4) || ((PATCHLEVEL == 5) && (SUBVERSION < 55)) |
10 | static STRLEN nolen_na; |
10 | static STRLEN nolen_na; |
11 | # define SvPV_nolen(sv) SvPV ((sv), nolen_na) |
11 | # define SvPV_nolen(sv) SvPV ((sv), nolen_na) |
12 | #endif |
12 | #endif |
|
|
13 | #if PATCHLEVEL < 6 |
|
|
14 | # define call_sv perl_call_sv |
|
|
15 | #endif |
13 | |
16 | |
14 | #include "lzf_c.c" |
17 | #include "lzf_c.c" |
15 | #include "lzf_d.c" |
18 | #include "lzf_d.c" |
16 | |
19 | |
17 | /* we re-use the storable header for our purposes */ |
20 | /* we re-use the storable header for our purposes */ |
18 | #define MAGIC_LO 0 |
21 | #define MAGIC_LO 0 |
19 | #define MAGIC_U 0 /* uncompressed data follows */ |
22 | #define MAGIC_U 0 /* uncompressed data follows */ |
20 | #define MAGIC_C 1 /* compressed data follows */ |
23 | #define MAGIC_C 1 /* compressed data follows */ |
|
|
24 | #define MAGIC_undef 2 /* the special value undef */ |
|
|
25 | #define MAGIC_CR 3 /* storable (reference, freeze), compressed */ |
21 | #define MAGIC_R 4 /* storable (reference, freeze) */ |
26 | #define MAGIC_R 4 /* storable (reference, freeze) */ |
22 | #define MAGIC_CR 3 /* storable (reference, freeze), compressed */ |
|
|
23 | #define MAGIC_HI 7 /* room for one higher storable major */ |
27 | #define MAGIC_HI 7 /* room for one higher storable major */ |
24 | |
28 | |
25 | #define IN_RANGE(v,l,h) ((unsigned int)((unsigned)(v) - (unsigned)(l)) <= (unsigned)(h) - (unsigned)(l)) |
29 | #define IN_RANGE(v,l,h) ((unsigned int)((unsigned)(v) - (unsigned)(l)) <= (unsigned)(h) - (unsigned)(l)) |
26 | |
30 | |
27 | static CV *storable_mstore, *storable_mretrieve; |
31 | static CV *storable_mstore, *storable_mretrieve; |
… | |
… | |
185 | } |
189 | } |
186 | |
190 | |
187 | static void |
191 | static void |
188 | need_storable(void) |
192 | need_storable(void) |
189 | { |
193 | { |
|
|
194 | #if PATCHLEVEL < 6 |
|
|
195 | perl_eval_pv ("require Storable;", 1); |
|
|
196 | #else |
190 | load_module (PERL_LOADMOD_NOIMPORT, newSVpv ("Storable", 0), Nullsv); |
197 | load_module (PERL_LOADMOD_NOIMPORT, newSVpv ("Storable", 0), Nullsv); |
|
|
198 | #endif |
191 | |
199 | |
192 | storable_mstore = GvCV (gv_fetchpv ("Storable::mstore" , TRUE, SVt_PVCV)); |
200 | storable_mstore = GvCV (gv_fetchpv ("Storable::mstore" , TRUE, SVt_PVCV)); |
193 | storable_mretrieve = GvCV (gv_fetchpv ("Storable::mretrieve", TRUE, SVt_PVCV)); |
201 | storable_mretrieve = GvCV (gv_fetchpv ("Storable::mretrieve", TRUE, SVt_PVCV)); |
194 | } |
202 | } |
195 | |
203 | |
… | |
… | |
216 | sfreeze_cr = 1 |
224 | sfreeze_cr = 1 |
217 | sfreeze_c = 2 |
225 | sfreeze_c = 2 |
218 | PROTOTYPE: $ |
226 | PROTOTYPE: $ |
219 | PPCODE: |
227 | PPCODE: |
220 | |
228 | |
221 | if (SvROK (sv)) /* mstore */ |
229 | if (!SvOK (sv)) |
|
|
230 | XPUSHs (sv_2mortal (newSVpvn ("\02", 1))); /* 02 == MAGIC_undef */ |
|
|
231 | else if (SvTYPE(sv) != SVt_IV |
|
|
232 | && SvTYPE(sv) != SVt_NV |
|
|
233 | && SvTYPE(sv) != SVt_PV) /* mstore */ |
222 | { |
234 | { |
223 | if (!storable_mstore) |
235 | if (!storable_mstore) |
224 | need_storable (); |
236 | need_storable (); |
225 | |
237 | |
226 | PUSHMARK (SP); |
238 | PUSHMARK (SP); |
… | |
… | |
240 | if (ix) /* compress */ |
252 | if (ix) /* compress */ |
241 | XPUSHs (sv_2mortal (compress_sv (sv, MAGIC_CR, 0))); |
253 | XPUSHs (sv_2mortal (compress_sv (sv, MAGIC_CR, 0))); |
242 | else |
254 | else |
243 | XPUSHs (sv); |
255 | XPUSHs (sv); |
244 | } |
256 | } |
245 | else if (IN_RANGE (SvPVX (sv)[0], MAGIC_LO, MAGIC_HI)) |
257 | else if (sv && IN_RANGE (SvPVX (sv)[0], MAGIC_LO, MAGIC_HI)) |
246 | XPUSHs (sv_2mortal (compress_sv (sv, MAGIC_C, 1))); /* need to prefix only */ |
258 | XPUSHs (sv_2mortal (compress_sv (sv, MAGIC_C, 1))); /* need to prefix only */ |
247 | else if (ix == 2) /* compress always */ |
259 | else if (ix == 2) /* compress always */ |
248 | XPUSHs (sv_2mortal (compress_sv (sv, MAGIC_C, 0))); |
260 | XPUSHs (sv_2mortal (compress_sv (sv, MAGIC_C, 0))); |
249 | else /* don't compress */ |
261 | else /* don't compress */ |
250 | XPUSHs (sv_2mortal (SvREFCNT_inc (sv))); |
262 | XPUSHs (sv_2mortal (SvREFCNT_inc (sv))); |
… | |
… | |
252 | void |
264 | void |
253 | sthaw(sv) |
265 | sthaw(sv) |
254 | SV * sv |
266 | SV * sv |
255 | PROTOTYPE: $ |
267 | PROTOTYPE: $ |
256 | PPCODE: |
268 | PPCODE: |
257 | char hdr = SvPVX (sv)[0]; |
|
|
258 | |
269 | |
259 | if (IN_RANGE (hdr, MAGIC_LO, MAGIC_HI)) |
270 | SvGETMAGIC (sv); |
|
|
271 | if (SvPOK (sv) && IN_RANGE (SvPV_nolen (sv)[0], MAGIC_LO, MAGIC_HI)) |
260 | { |
272 | { |
261 | switch (SvPVX (sv)[0]) |
273 | switch (SvPVX (sv)[0]) |
262 | { |
274 | { |
|
|
275 | case MAGIC_undef: |
|
|
276 | XPUSHs (sv_2mortal (NEWSV (0, 0))); |
|
|
277 | break; |
|
|
278 | |
263 | case MAGIC_U: |
279 | case MAGIC_U: |
264 | XPUSHs (sv_2mortal (decompress_sv (sv, 0))); |
280 | XPUSHs (sv_2mortal (decompress_sv (sv, 0))); |
265 | break; |
281 | break; |
266 | |
282 | |
267 | case MAGIC_C: |
283 | case MAGIC_C: |
… | |
… | |
281 | if (1 != call_sv ((SV *)storable_mretrieve, G_SCALAR)) |
297 | if (1 != call_sv ((SV *)storable_mretrieve, G_SCALAR)) |
282 | croak ("Storable::mstore didn't return a single scalar"); |
298 | croak ("Storable::mstore didn't return a single scalar"); |
283 | |
299 | |
284 | SPAGAIN; |
300 | SPAGAIN; |
285 | |
301 | |
286 | /*XPUSHs (POPs);*/ |
302 | /*XPUSHs (POPs); this is a nop, hopefully */ |
287 | |
303 | |
288 | break; |
304 | break; |
289 | |
305 | |
290 | default: |
306 | default: |
291 | croak ("Compress::LZF::sthaw(): invalid data, maybe you need a newer version of Compress::LZF?"); |
307 | croak ("Compress::LZF::sthaw(): invalid data, maybe you need a newer version of Compress::LZF?"); |