/* pp_pack.c
*
- * Copyright (c) 1991-2003, Larry Wall
+ * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ * 2000, 2001, 2002, 2003, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
if (strchr(natstr, code))
code |= TYPE_IS_SHRIEKING;
else
- Perl_croak(aTHX_ "'!' allowed only after types %s in pack/unpack",
+ Perl_croak(aTHX_ "'!' allowed only after types %s in %s",
natstr, symptr->flags & FLAG_PACK ? "pack" : "unpack" );
}
/*
=for apidoc unpack_str
-The engine implementing unpack() Perl function.
+The engine implementing unpack() Perl function. Note: parameters strbeg, new_s
+and ocnt are not used. This call should not be used, use unpackstring instead.
=cut */
return unpack_rec(&sym, s, s, strend, NULL );
}
+/*
+=for apidoc unpackstring
+
+The engine implementing unpack() Perl function.
+
+=cut */
+
+I32
+Perl_unpackstring(pTHX_ char *pat, register char *patend, register char *s, char *strend, U32 flags)
+{
+ tempsym_t sym = { 0 };
+ sym.patptr = pat;
+ sym.patend = patend;
+ sym.flags = flags;
+
+ return unpack_rec(&sym, s, s, strend, NULL );
+}
+
STATIC
I32
S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, char *strend, char **new_s )
}
}
else {
+ short ashort;
if (len && unpack_only_one)
len = 1;
EXTEND(SP, len);
EXTEND_MORTAL(len);
- short ashort;
while (len-- > 0) {
COPYNN(s, &ashort, sizeof(short));
s += sizeof(short);
break;
case 'S' | TYPE_IS_SHRIEKING:
#if SHORTSIZE != SIZE16
- along = (strend - s) / SIZE16;
+ along = (strend - s) / sizeof(unsigned short);
if (len > along)
len = along;
if (checksum) {
register I32 cnt;
PUTBACK;
- cnt = unpack_str(pat, patend, s, s, strend, NULL, 0,
+ cnt = unpackstring(pat, patend, s, strend,
((gimme == G_SCALAR) ? FLAG_UNPACK_ONLY_ONE : 0)
| (DO_UTF8(right) ? FLAG_UNPACK_DO_UTF8 : 0));
/*
=for apidoc pack_cat
-The engine implementing pack() Perl function.
+The engine implementing pack() Perl function. Note: parameters next_in_list and
+flags are not used. This call should not be used; use packlist instead.
=cut */
tempsym_t sym = { 0 };
sym.patptr = pat;
sym.patend = patend;
- sym.flags = flags;
+ sym.flags = FLAG_PACK;
+
+ (void)pack_rec( cat, &sym, beglist, endlist );
+}
+
+
+/*
+=for apidoc packlist
+
+The engine implementing pack() Perl function.
+
+=cut */
+
+
+void
+Perl_packlist(pTHX_ SV *cat, char *pat, register char *patend, register SV **beglist, SV **endlist )
+{
+ tempsym_t sym = { 0 };
+ sym.patptr = pat;
+ sym.patend = patend;
+ sym.flags = FLAG_PACK;
(void)pack_rec( cat, &sym, beglist, endlist );
}
MARK++;
sv_setpvn(cat, "", 0);
- pack_cat(cat, pat, patend, MARK, SP + 1, NULL, FLAG_PACK);
+ packlist(cat, pat, patend, MARK, SP + 1);
SvSETMAGIC(cat);
SP = ORIGMARK;