2 $Id: Unicode.xs,v 1.2 2002/04/19 05:36:43 dankogai Exp $
5 #define PERL_NO_GET_CONTEXT
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) )
20 enc_unpack(pTHX_ U8 **sp,U8 *e,STRLEN size,U8 endian)
25 croak("Partial character %c",(char) endian);
45 croak("Unknown endian %c",(char) endian);
53 enc_pack(pTHX_ SV *result,STRLEN size,U8 endian,UV value)
55 U8 *d = (U8 *)SvGROW(result,SvCUR(result)+size);
60 SvCUR_set(result,SvCUR(result)+size);
68 SvCUR_set(result,SvCUR(result)+size);
76 croak("Unknown endian %c",(char) endian);
81 MODULE = Encode::Unicode PACKAGE = Encode::Unicode
84 decode_xs(obj, str, chk = &PL_sv_undef)
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);
95 U8 *s = (U8 *)SvPVbyte(str,ulen);
96 U8 *e = (U8 *)SvEND(str);
97 ST(0) = sv_2mortal(result);
100 if (!endian && s+size <= e) {
102 endian = (size == 4) ? 'N' : 'n';
103 bom = enc_unpack(aTHX_ &s,e,size,endian);
105 if (bom == BOM16LE) {
108 else if (bom == BOM32LE) {
112 croak("%s:Unregognised BOM %"UVxf,
113 SvPV_nolen(*hv_fetch((HV *)SvRV(obj),"Name",4,0)),
118 /* Update endian for this sequence */
119 hv_store((HV *)SvRV(obj),"endian",6,newSVpv((char *)&endian,1),0);
122 while (s < e && s+size <= e) {
123 UV ord = enc_unpack(aTHX_ &s,e,size,endian);
125 if (size != 4 && invalid_ucs2(ord)) {
128 croak("%s:no surrogates allowed %"UVxf,
129 SvPV_nolen(*hv_fetch((HV *)SvRV(obj),"Name",4,0)),
133 /* skip the next one as well */
134 enc_unpack(aTHX_ &s,e,size,endian);
140 if (!isHiSurrogate(ord)) {
141 croak("%s:Malformed HI surrogate %"UVxf,
142 SvPV_nolen(*hv_fetch((HV *)SvRV(obj),"Name",4,0)),
146 /* Partial character */
147 s -= size; /* back up to 1st half */
148 break; /* And exit loop */
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)),
156 ord = 0x10000 + ((ord - 0xD800) << 10) + (lo - 0xDC00);
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));
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));
179 encode_xs(obj, utf8, chk = &PL_sv_undef)
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);
190 U8 *s = (U8 *)SvPVutf8(utf8,ulen);
191 U8 *e = (U8 *)SvEND(utf8);
192 ST(0) = sv_2mortal(result);
194 endian = (size == 4) ? 'N' : 'n';
195 enc_pack(aTHX_ result,size,endian,BOM_BE);
197 /* Update endian for this sequence */
198 hv_store((HV *)SvRV(obj),"endian",6,newSVpv((char *)&endian,1),0);
201 while (s < e && s+UTF8SKIP(s) <= e) {
203 UV ord = utf8n_to_uvuni(s, e-s, &len, 0);
205 if (size != 4 && invalid_ucs2(ord)) {
206 if (!issurrogate(ord)){
209 croak("%s:code point \"\\x{"UVxf"}\" too high",
211 *hv_fetch((HV *)SvRV(obj),"Name",4,0))
214 enc_pack(aTHX_ result,size,endian,FBCHAR);
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);
223 /* not supposed to happen */
224 enc_pack(aTHX_ result,size,endian,FBCHAR);
228 enc_pack(aTHX_ result,size,endian,ord);
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));