/*
- $Id: Encode.xs,v 1.31 2002/04/20 23:43:47 dankogai Exp dankogai $
+ $Id: Encode.xs,v 1.42 2002/04/29 06:54:06 dankogai Exp $
*/
#define PERL_NO_GET_CONTEXT
#define U8 U8
#include "encode.h"
+# define PERLIO_MODNAME "PerlIO::encoding"
+# define PERLIO_FILENAME "PerlIO/encoding.pm"
+
/* set 1 or more to profile. t/encoding.t dumps core because of
Perl_warner and PerlIO don't work well */
#define ENCODE_XS_PROFILE 0
return (y)0; /* fool picky compilers */ \
}
/**/
-UNIMPLEMENTED(_encoded_utf8_to_bytes, I32);
-UNIMPLEMENTED(_encoded_bytes_to_utf8, I32);
+
+UNIMPLEMENTED(_encoded_utf8_to_bytes, I32)
+UNIMPLEMENTED(_encoded_bytes_to_utf8, I32)
void
Encode_XSEncoding(pTHX_ encode_t * enc)
goto ENCODE_SET_SRC;
}else if (check & ENCODE_PERLQQ){
SV* perlqq =
- sv_2mortal(newSVpvf("\\x{%04x}", ch));
+ sv_2mortal(newSVpvf("\\x{%04"UVxf"}", ch));
sdone += slen + clen;
ddone += dlen + SvCUR(perlqq);
sv_catsv(dst, perlqq);
+ }else if (check & ENCODE_HTMLCREF){
+ SV* htmlcref =
+ sv_2mortal(newSVpvf("&#%" UVuf ";", ch));
+ sdone += slen + clen;
+ ddone += dlen + SvCUR(htmlcref);
+ sv_catsv(dst, htmlcref);
+ }else if (check & ENCODE_XMLCREF){
+ SV* xmlcref =
+ sv_2mortal(newSVpvf("&#x%" UVxf ";", ch));
+ sdone += slen + clen;
+ ddone += dlen + SvCUR(xmlcref);
+ sv_catsv(dst, xmlcref);
} else {
/* fallback char */
sdone += slen + clen;
else {
if (check & ENCODE_DIE_ON_ERR){
Perl_croak(
- aTHX_ "%s \"\\x%02X\" does not map to Unicode (%d)",
+ aTHX_ "%s \"\\x%02" UVXf
+ "\" does not map to Unicode (%d)",
enc->name[0], (U8) s[slen], code);
}else{
if (check & ENCODE_RETURN_ON_ERR){
if (check & ENCODE_WARN_ON_ERR){
Perl_warner(
aTHX_ packWARN(WARN_UTF8),
- "%s \"\\x%02X\" does not map to Unicode (%d)",
+ "%s \"\\x%02" UVXf
+ "\" does not map to Unicode (%d)",
enc->name[0], (U8) s[slen], code);
}
goto ENCODE_SET_SRC;
- }else if (check & ENCODE_PERLQQ){
+ }else if (check &
+ (ENCODE_PERLQQ|ENCODE_HTMLCREF|ENCODE_XMLCREF)){
SV* perlqq =
- sv_2mortal(newSVpvf("\\x%02X", s[slen]));
+ sv_2mortal(newSVpvf("\\x%02" UVXf, s[slen]));
sdone += slen + 1;
ddone += dlen + SvCUR(perlqq);
sv_catsv(dst, perlqq);
}
/* settle variables when fallback */
d = (U8 *)SvEND(dst);
- dlen = SvLEN(dst) - ddone - 1;
+ dlen = SvLEN(dst) - ddone - 1;
s = (U8*)SvPVX(src) + sdone;
slen = tlen - sdone;
break;
SvCUR_set(src, sdone);
}
/* warn("check = 0x%X, code = 0x%d\n", check, code); */
- if (code && !(check & ENCODE_RETURN_ON_ERR)) {
- return &PL_sv_undef;
- }
SvCUR_set(dst, dlen+ddone);
SvPOK_only(dst);
XSRETURN(1);
}
+void
+Method_needs_lines(obj)
+SV * obj
+CODE:
+{
+ encode_t *enc = INT2PTR(encode_t *, SvIV(SvRV(obj)));
+ ST(0) = &PL_sv_no;
+ XSRETURN(1);
+}
+
+void
+Method_perlio_ok(obj)
+SV * obj
+CODE:
+{
+ encode_t *enc = INT2PTR(encode_t *, SvIV(SvRV(obj)));
+ /* require_pv(PERLIO_FILENAME); */
+
+ eval_pv("require PerlIO::encoding", 0);
+
+ if (SvTRUE(get_sv("@", 0))) {
+ ST(0) = &PL_sv_no;
+ }else{
+ ST(0) = &PL_sv_yes;
+ }
+ XSRETURN(1);
+}
+
MODULE = Encode PACKAGE = Encode
PROTOTYPES: ENABLE
OUTPUT:
RETVAL
-PROTOTYPES: DISABLE
-
-
int
DIE_ON_ERR()
CODE:
RETVAL
int
+HTMLCREF()
+CODE:
+ RETVAL = ENCODE_HTMLCREF;
+OUTPUT:
+ RETVAL
+
+int
+XMLCREF()
+CODE:
+ RETVAL = ENCODE_XMLCREF;
+OUTPUT:
+ RETVAL
+
+int
FB_DEFAULT()
CODE:
RETVAL = ENCODE_FB_DEFAULT;
OUTPUT:
RETVAL
+int
+FB_HTMLCREF()
+CODE:
+ RETVAL = ENCODE_FB_HTMLCREF;
+OUTPUT:
+ RETVAL
+
+int
+FB_XMLCREF()
+CODE:
+ RETVAL = ENCODE_FB_XMLCREF;
+OUTPUT:
+ RETVAL
+
BOOT:
{
#include "def_t.h"