[p5sagit/p5-mst-13.2.git] / ext / Encode / Unicode / Unicode.xs

/*
 $Id: Unicode.xs,v 1.2 2002/04/19 05:36:43 dankogai Exp $
 */

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

#define FBCHAR			0xFFFd
#define BOM_BE			0xFeFF
#define BOM16LE			0xFFFe
#define BOM32LE			0xFFFe0000
#define issurrogate(x)		(0xD800 <= (x)  && (x) <= 0xDFFF )
#define isHiSurrogate(x)	(0xD800 <= (x)  && (x) <  0xDC00 )
#define isLoSurrogate(x)	(0xDC00 <= (x)  && (x) <= 0xDFFF )
#define invalid_ucs2(x)         ( issurrogate(x) || 0xFFFF < (x) )

static UV
enc_unpack(pTHX_ U8 **sp,U8 *e,STRLEN size,U8 endian)
{
    U8 *s = *sp;
    UV v = 0;
    if (s+size > e) {
	croak("Partial character %c",(char) endian);
    }
    switch(endian) {
    case 'N':
	v = *s++;
	v = (v << 8) | *s++;
    case 'n':
	v = (v << 8) | *s++;
	v = (v << 8) | *s++;
	break;
    case 'V':
    case 'v':
	v |= *s++;
	v |= (*s++ << 8);
	if (endian == 'v')
	    break;
	v |= (*s++ << 16);
	v |= (*s++ << 24);
	break;
    default:
	croak("Unknown endian %c",(char) endian);
	break;
    }
    *sp = s;
    return v;
}

void
enc_pack(pTHX_ SV *result,STRLEN size,U8 endian,UV value)
{
    U8 *d = (U8 *)SvGROW(result,SvCUR(result)+size);
    switch(endian) {
    case 'v':
    case 'V':
	d += SvCUR(result);
	SvCUR_set(result,SvCUR(result)+size);
	while (size--) {
	    *d++ = value & 0xFF;
	    value >>= 8;
	}
	break;
    case 'n':
    case 'N':
	SvCUR_set(result,SvCUR(result)+size);
	d += SvCUR(result);
	while (size--) {
	    *--d = value & 0xFF;
	    value >>= 8;
	}
	break;
    default:
	croak("Unknown endian %c",(char) endian);
	break;
    }
}

MODULE = Encode::Unicode PACKAGE = Encode::Unicode

void
decode_xs(obj, str, chk = &PL_sv_undef)
SV *	obj
SV *	str
SV *	chk
CODE:
{
    int size    = SvIV(*hv_fetch((HV *)SvRV(obj),"size",4,0));
    U8 endian   = *((U8 *)SvPV_nolen(*hv_fetch((HV *)SvRV(obj),"endian",6,0)));
    int ucs2    = SvTRUE(*hv_fetch((HV *)SvRV(obj),"ucs2",4,0));
    SV *result = newSVpvn("",0);
    STRLEN ulen;
    U8 *s = (U8 *)SvPVbyte(str,ulen);
    U8 *e = (U8 *)SvEND(str);
    ST(0) = sv_2mortal(result);
    SvUTF8_on(result);

    if (!endian && s+size <= e) {
	UV bom;
	endian = (size == 4) ? 'N' : 'n';
	bom = enc_unpack(aTHX_ &s,e,size,endian);
        if (bom != BOM_BE) {
	    if (bom == BOM16LE) {
		endian = 'v';
	    }
	    else if (bom == BOM32LE) {
		endian = 'V';
	    }
	    else {
		croak("%s:Unregognised BOM %"UVxf,
                      SvPV_nolen(*hv_fetch((HV *)SvRV(obj),"Name",4,0)),
		      bom);
	    }
	}
#if 0
	/* Update endian for this sequence */
	hv_store((HV *)SvRV(obj),"endian",6,newSVpv((char *)&endian,1),0);
#endif
    }
    while (s < e && s+size <= e) {
	UV ord = enc_unpack(aTHX_ &s,e,size,endian);
	U8 *d;
	if (size != 4 && invalid_ucs2(ord)) {
	    if (ucs2) {
		if (SvTRUE(chk)) {
		    croak("%s:no surrogates allowed %"UVxf,
			  SvPV_nolen(*hv_fetch((HV *)SvRV(obj),"Name",4,0)),
			  ord);
		}
		if (s+size <= e) {
                    /* skip the next one as well */
		    enc_unpack(aTHX_ &s,e,size,endian); 
		}
		ord = FBCHAR;
	    }
	    else {
		UV lo;
		if (!isHiSurrogate(ord)) {
		    croak("%s:Malformed HI surrogate %"UVxf,
			  SvPV_nolen(*hv_fetch((HV *)SvRV(obj),"Name",4,0)),
			  ord);
		}
		if (s+size > e) {
		    /* Partial character */
		    s -= size;   /* back up to 1st half */
		    break;       /* And exit loop */
		}
		lo = enc_unpack(aTHX_ &s,e,size,endian);
		if (!isLoSurrogate(lo)){
		    croak("%s:Malformed LO surrogate %"UVxf,
			  SvPV_nolen(*hv_fetch((HV *)SvRV(obj),"Name",4,0)),
			  ord);
		}
		ord = 0x10000 + ((ord - 0xD800) << 10) + (lo - 0xDC00);
	    }
	}
	d = (U8 *) SvGROW(result,SvCUR(result)+UTF8_MAXLEN+1);
	d = uvuni_to_utf8_flags(d+SvCUR(result), ord, 0);
	SvCUR_set(result,d - (U8 *)SvPVX(result));
    }
    if (SvTRUE(chk)) {
	if (s < e) {
	    Perl_warner(aTHX_ packWARN(WARN_UTF8),"%s:Partial character",
			SvPV_nolen(*hv_fetch((HV *)SvRV(obj),"Name",4,0)));
	    Move(s,SvPVX(str),e-s,U8);
	    SvCUR_set(str,(e-s));
	}
	else {
	    SvCUR_set(str,0);
	}
	*SvEND(str) = '\0';
    }
    XSRETURN(1);
}

void
encode_xs(obj, utf8, chk = &PL_sv_undef)
    SV *	obj
SV *	utf8
SV *	chk
CODE:
{
    int size   = SvIV(*hv_fetch((HV *)SvRV(obj),"size",4,0));
    U8 endian = *((U8 *)SvPV_nolen(*hv_fetch((HV *)SvRV(obj),"endian",6,0)));
    int ucs2   = SvTRUE(*hv_fetch((HV *)SvRV(obj),"ucs2",4,0));
    SV *result = newSVpvn("",0);
    STRLEN ulen;
    U8 *s = (U8 *)SvPVutf8(utf8,ulen);
    U8 *e = (U8 *)SvEND(utf8);
    ST(0) = sv_2mortal(result);
    if (!endian) {
	endian = (size == 4) ? 'N' : 'n';
	enc_pack(aTHX_ result,size,endian,BOM_BE);
#if 0
	/* Update endian for this sequence */
	hv_store((HV *)SvRV(obj),"endian",6,newSVpv((char *)&endian,1),0);
#endif
    }
    while (s < e && s+UTF8SKIP(s) <= e) {
	STRLEN len;
	UV ord = utf8n_to_uvuni(s, e-s, &len, 0);
        s += len;
	if (size != 4 && invalid_ucs2(ord)) {
	    if (!issurrogate(ord)){
		if (ucs2) {
		    if (SvTRUE(chk)) {
			croak("%s:code point \"\\x{"UVxf"}\" too high",
			      SvPV_nolen(
				  *hv_fetch((HV *)SvRV(obj),"Name",4,0))
			      ,ord);
		    }
		    enc_pack(aTHX_ result,size,endian,FBCHAR);
		}else{
		    UV hi = ((ord - 0x10000) >> 10)   + 0xD800;
		    UV lo = ((ord - 0x10000) & 0x3FF) + 0xDC00;
		    enc_pack(aTHX_ result,size,endian,hi);
		    enc_pack(aTHX_ result,size,endian,lo);
		}
	    }
	    else {
		/* not supposed to happen */
		enc_pack(aTHX_ result,size,endian,FBCHAR);
	    }
	}
	else {
	    enc_pack(aTHX_ result,size,endian,ord);
	}
    }
    if (SvTRUE(chk)) {
	if (s < e) {
	    Perl_warner(aTHX_ packWARN(WARN_UTF8),"%s:Partial character",
			SvPV_nolen(*hv_fetch((HV *)SvRV(obj),"Name",4,0)));
	    Move(s,SvPVX(utf8),e-s,U8);
	    SvCUR_set(utf8,(e-s));
	}
	else {
	    SvCUR_set(utf8,0);
	}
	*SvEND(utf8) = '\0';
    }
    XSRETURN(1);
}
Commit	Line	Data
85982a32	1	/*
	2	$Id: Unicode.xs,v 1.2 2002/04/19 05:36:43 dankogai Exp $
	3	*/
	4
	5	#define PERL_NO_GET_CONTEXT
	6	#include "EXTERN.h"
	7	#include "perl.h"
	8	#include "XSUB.h"
	9
	10	#define FBCHAR 0xFFFd
	11	#define BOM_BE 0xFeFF
	12	#define BOM16LE 0xFFFe
	13	#define BOM32LE 0xFFFe0000
	14	#define issurrogate(x) (0xD800 <= (x) && (x) <= 0xDFFF )
	15	#define isHiSurrogate(x) (0xD800 <= (x) && (x) < 0xDC00 )
	16	#define isLoSurrogate(x) (0xDC00 <= (x) && (x) <= 0xDFFF )
	17	#define invalid_ucs2(x) ( issurrogate(x) \|\| 0xFFFF < (x) )
	18
	19	static UV
	20	enc_unpack(pTHX_ U8 *sp,U8 e,STRLEN size,U8 endian)
	21	{
	22	U8 s = sp;
	23	UV v = 0;
	24	if (s+size > e) {
	25	croak("Partial character %c",(char) endian);
	26	}
	27	switch(endian) {
	28	case 'N':
	29	v = *s++;
	30	v = (v << 8) \| *s++;
	31	case 'n':
	32	v = (v << 8) \| *s++;
	33	v = (v << 8) \| *s++;
	34	break;
	35	case 'V':
	36	case 'v':
	37	v \|= *s++;
	38	v \|= (*s++ << 8);
	39	if (endian == 'v')
	40	break;
	41	v \|= (*s++ << 16);
	42	v \|= (*s++ << 24);
	43	break;
	44	default:
	45	croak("Unknown endian %c",(char) endian);
	46	break;
	47	}
	48	*sp = s;
	49	return v;
	50	}
	51
	52	void
	53	enc_pack(pTHX_ SV *result,STRLEN size,U8 endian,UV value)
	54	{
	55	U8 d = (U8 )SvGROW(result,SvCUR(result)+size);
	56	switch(endian) {
	57	case 'v':
	58	case 'V':
	59	d += SvCUR(result);
	60	SvCUR_set(result,SvCUR(result)+size);
	61	while (size--) {
	62	*d++ = value & 0xFF;
	63	value >>= 8;
	64	}
65	break;
66	case 'n':
67	case 'N':
68	SvCUR_set(result,SvCUR(result)+size);
69	d += SvCUR(result);
70	while (size--) {
71	*--d = value & 0xFF;
72	value >>= 8;
73	}
74	break;
75	default:
76	croak("Unknown endian %c",(char) endian);
77	break;
78	}
79	}
80
81	MODULE = Encode::Unicode PACKAGE = Encode::Unicode
82
83	void
84	decode_xs(obj, str, chk = &PL_sv_undef)
85	SV * obj
86	SV * str
87	SV * chk
88	CODE:
89	{
90	int size = SvIV(hv_fetch((HV )SvRV(obj),"size",4,0));
91	U8 endian = ((U8 )SvPV_nolen(hv_fetch((HV )SvRV(obj),"endian",6,0)));
92	int ucs2 = SvTRUE(hv_fetch((HV )SvRV(obj),"ucs2",4,0));
93	SV *result = newSVpvn("",0);
94	STRLEN ulen;
95	U8 s = (U8 )SvPVbyte(str,ulen);
96	U8 e = (U8 )SvEND(str);
97	ST(0) = sv_2mortal(result);
98	SvUTF8_on(result);
99
100	if (!endian && s+size <= e) {
101	UV bom;
102	endian = (size == 4) ? 'N' : 'n';
103	bom = enc_unpack(aTHX_ &s,e,size,endian);
104	if (bom != BOM_BE) {
105	if (bom == BOM16LE) {
106	endian = 'v';
107	}
108	else if (bom == BOM32LE) {
109	endian = 'V';
110	}
111	else {
112	croak("%s:Unregognised BOM %"UVxf,
113	SvPV_nolen(hv_fetch((HV )SvRV(obj),"Name",4,0)),
114	bom);
115	}
116	}
117	#if 0
118	/* Update endian for this sequence */
119	hv_store((HV )SvRV(obj),"endian",6,newSVpv((char )&endian,1),0);
120	#endif
121	}
122	while (s < e && s+size <= e) {
123	UV ord = enc_unpack(aTHX_ &s,e,size,endian);
124	U8 *d;
125	if (size != 4 && invalid_ucs2(ord)) {
126	if (ucs2) {
127	if (SvTRUE(chk)) {
128	croak("%s:no surrogates allowed %"UVxf,
129	SvPV_nolen(hv_fetch((HV )SvRV(obj),"Name",4,0)),
130	ord);
131	}
132	if (s+size <= e) {
133	/* skip the next one as well */
134	enc_unpack(aTHX_ &s,e,size,endian);
135	}
136	ord = FBCHAR;
137	}
138	else {
139	UV lo;
140	if (!isHiSurrogate(ord)) {
141	croak("%s:Malformed HI surrogate %"UVxf,
142	SvPV_nolen(hv_fetch((HV )SvRV(obj),"Name",4,0)),
143	ord);
144	}
145	if (s+size > e) {
146	/* Partial character */
147	s -= size; /* back up to 1st half */
148	break; /* And exit loop */
149	}
150	lo = enc_unpack(aTHX_ &s,e,size,endian);
151	if (!isLoSurrogate(lo)){
152	croak("%s:Malformed LO surrogate %"UVxf,
153	SvPV_nolen(hv_fetch((HV )SvRV(obj),"Name",4,0)),
154	ord);
155	}
156	ord = 0x10000 + ((ord - 0xD800) << 10) + (lo - 0xDC00);
157	}
158	}
159	d = (U8 *) SvGROW(result,SvCUR(result)+UTF8_MAXLEN+1);
160	d = uvuni_to_utf8_flags(d+SvCUR(result), ord, 0);
161	SvCUR_set(result,d - (U8 *)SvPVX(result));
162	}
163	if (SvTRUE(chk)) {
164	if (s < e) {
165	Perl_warner(aTHX_ packWARN(WARN_UTF8),"%s:Partial character",
166	SvPV_nolen(hv_fetch((HV )SvRV(obj),"Name",4,0)));
167	Move(s,SvPVX(str),e-s,U8);
168	SvCUR_set(str,(e-s));
169	}
170	else {
171	SvCUR_set(str,0);
172	}
173	*SvEND(str) = '\0';
174	}
175	XSRETURN(1);
176	}
177
178	void
179	encode_xs(obj, utf8, chk = &PL_sv_undef)
180	SV * obj
181	SV * utf8
182	SV * chk
183	CODE:
184	{
185	int size = SvIV(hv_fetch((HV )SvRV(obj),"size",4,0));
186	U8 endian = ((U8 )SvPV_nolen(hv_fetch((HV )SvRV(obj),"endian",6,0)));
187	int ucs2 = SvTRUE(hv_fetch((HV )SvRV(obj),"ucs2",4,0));
188	SV *result = newSVpvn("",0);
189	STRLEN ulen;
190	U8 s = (U8 )SvPVutf8(utf8,ulen);
191	U8 e = (U8 )SvEND(utf8);
192	ST(0) = sv_2mortal(result);
193	if (!endian) {
194	endian = (size == 4) ? 'N' : 'n';
195	enc_pack(aTHX_ result,size,endian,BOM_BE);
196	#if 0
197	/* Update endian for this sequence */
198	hv_store((HV )SvRV(obj),"endian",6,newSVpv((char )&endian,1),0);
199	#endif
200	}
201	while (s < e && s+UTF8SKIP(s) <= e) {
202	STRLEN len;
203	UV ord = utf8n_to_uvuni(s, e-s, &len, 0);
204	s += len;
205	if (size != 4 && invalid_ucs2(ord)) {
206	if (!issurrogate(ord)){
207	if (ucs2) {
208	if (SvTRUE(chk)) {
209	croak("%s:code point \"\\x{"UVxf"}\" too high",
210	SvPV_nolen(
211	hv_fetch((HV )SvRV(obj),"Name",4,0))
212	,ord);
213	}
214	enc_pack(aTHX_ result,size,endian,FBCHAR);
215	}else{
216	UV hi = ((ord - 0x10000) >> 10) + 0xD800;
217	UV lo = ((ord - 0x10000) & 0x3FF) + 0xDC00;
218	enc_pack(aTHX_ result,size,endian,hi);
219	enc_pack(aTHX_ result,size,endian,lo);
220	}
221	}
222	else {
223	/* not supposed to happen */
224	enc_pack(aTHX_ result,size,endian,FBCHAR);
225	}
226	}
227	else {
228	enc_pack(aTHX_ result,size,endian,ord);
229	}
230	}
231	if (SvTRUE(chk)) {
232	if (s < e) {
233	Perl_warner(aTHX_ packWARN(WARN_UTF8),"%s:Partial character",
234	SvPV_nolen(hv_fetch((HV )SvRV(obj),"Name",4,0)));
235	Move(s,SvPVX(utf8),e-s,U8);
236	SvCUR_set(utf8,(e-s));
237	}
238	else {
239	SvCUR_set(utf8,0);
240	}
241	*SvEND(utf8) = '\0';
242	}
243	XSRETURN(1);
244	}
245