PUTBACK;	if (call_method("decode", G_SCALAR) != 1) {	    Perl_die(aTHX_ "panic: decode did not return a value");	}	SPAGAIN;	uni = POPs;	PUTBACK;	/* Now get translated string (forced to UTF-8) and use as buffer */	if (SvPOK(uni)) {	    s = SvPVutf8(uni, len);#ifdef PARANOID_ENCODE_CHECKS	    if (len && !is_utf8_string((U8*)s,len)) {		Perl_warn(aTHX_ "panic: decode did not return UTF-8 '%.*s'",(int) len,s);	    }#endif	}	if (len > 0) {	    /* Got _something */	    /* if decode gave us back dataSV then data may vanish when	       we do ptrcnt adjust - so take our copy now.	       (The copy is a pain - need a put-it-here option for decode.)	     */	    sv_setpvn(e->bufsv,s,len);	    e->base.ptr = e->base.buf = (STDCHAR*)SvPVX(e->bufsv);	    e->base.end = e->base.ptr + SvCUR(e->bufsv);	    PerlIOBase(f)->flags |= PERLIO_F_RDBUF;	    SvUTF8_on(e->bufsv);	    /* Adjust ptr/cnt not taking anything which	       did not translate - not clear this is a win */	    /* compute amount we took */	    use -= SvCUR(e->dataSV);	    PerlIO_set_ptrcnt(n, ptr+use, (avail-use));	    /* and as we did not take it it isn't pending */	    SvCUR_set(e->dataSV,0);	} else {	    /* Got nothing - assume partial character so we need some more */	    /* Make sure e->dataSV is a normal SV before re-filling as	       buffer alias will change under us	     */	    s = SvPV(e->dataSV,len);	    sv_setpvn(e->dataSV,s,len);	    PerlIO_set_ptrcnt(n, ptr+use, (avail-use));	    goto retry;	}    }    else {    end_of_file:	code = -1;	if (avail == 0)	    PerlIOBase(f)->flags |= PERLIO_F_EOF;	else	    PerlIOBase(f)->flags |= PERLIO_F_ERROR;    }    FREETMPS;    LEAVE;    POPSTACK;    return code;}IVPerlIOEncode_flush(pTHX_ PerlIO * f){    PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode);    IV code = 0;    if (e->bufsv) {	dSP;	SV *str;	char *s;	STRLEN len;	SSize_t count = 0;	if ((PerlIOBase(f)->flags & PERLIO_F_WRBUF) && (e->base.ptr > e->base.buf)) {	    if (e->inEncodeCall) return 0;	    /* Write case - encode the buffer and write() to layer below */	    PUSHSTACKi(PERLSI_MAGIC);	    SPAGAIN;	    ENTER;	    SAVETMPS;	    PUSHMARK(sp);	    XPUSHs(e->enc);	    SvCUR_set(e->bufsv, e->base.ptr - e->base.buf);	    SvUTF8_on(e->bufsv);	    XPUSHs(e->bufsv);	    XPUSHs(e->chk);	    PUTBACK;	    e->inEncodeCall = 1;	    if (call_method("encode", G_SCALAR) != 1) {		e->inEncodeCall = 0;		Perl_die(aTHX_ "panic: encode did not return a value");	    }	    e->inEncodeCall = 0;	    SPAGAIN;	    str = POPs;	    PUTBACK;	    s = SvPV(str, len);	    count = PerlIO_write(PerlIONext(f),s,len);	    if ((STRLEN)count != len) {		code = -1;	    }	    FREETMPS;	    LEAVE;	    POPSTACK;	    if (PerlIO_flush(PerlIONext(f)) != 0) {		code = -1;	    }	    if (SvCUR(e->bufsv)) {		/* Did not all translate */		e->base.ptr = e->base.buf+SvCUR(e->bufsv);		return code;	    }	}	else if ((PerlIOBase(f)->flags & PERLIO_F_RDBUF)) {	    /* read case */	    /* if we have any untranslated stuff then unread that first */	    /* FIXME - unread is fragile is there a better way ? */	    if (e->dataSV && SvCUR(e->dataSV)) {		s = SvPV(e->dataSV, len);		count = PerlIO_unread(PerlIONext(f),s,len);		if ((STRLEN)count != len) {		    code = -1;		}		SvCUR_set(e->dataSV,0);	    }	    /* See if there is anything left in the buffer */	    if (e->base.ptr < e->base.end) {		if (e->inEncodeCall) return 0;		/* Bother - have unread data.		   re-encode and unread() to layer below		 */		PUSHSTACKi(PERLSI_MAGIC);		SPAGAIN;		ENTER;		SAVETMPS;		str = sv_newmortal();		sv_upgrade(str, SVt_PV);		SvPV_set(str, (char*)e->base.ptr);		SvLEN_set(str, 0);		SvCUR_set(str, e->base.end - e->base.ptr);		SvPOK_only(str);		SvUTF8_on(str);		PUSHMARK(sp);		XPUSHs(e->enc);		XPUSHs(str);		XPUSHs(e->chk);		PUTBACK;		e->inEncodeCall = 1;		if (call_method("encode", G_SCALAR) != 1) {		    e->inEncodeCall = 0;		    Perl_die(aTHX_ "panic: encode did not return a value");		}		e->inEncodeCall = 0;		SPAGAIN;		str = POPs;		PUTBACK;		s = SvPV(str, len);		count = PerlIO_unread(PerlIONext(f),s,len);		if ((STRLEN)count != len) {		    code = -1;		}		FREETMPS;		LEAVE;		POPSTACK;	    }	}	e->base.ptr = e->base.end = e->base.buf;	PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF);    }    return code;}IVPerlIOEncode_close(pTHX_ PerlIO * f){    PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode);    IV code;    if (PerlIOBase(f)->flags & PERLIO_F_RDBUF) {	/* Discard partial character */	if (e->dataSV) {	    SvCUR_set(e->dataSV,0);	}	/* Don't back decode and unread any pending data */	e->base.ptr = e->base.end = e->base.buf;    }    code = PerlIOBase_close(aTHX_ f);    if (e->bufsv) {	/* This should only fire for write case */	if (e->base.buf && e->base.ptr > e->base.buf) {	    Perl_croak(aTHX_ "Close with partial character");	}	SvREFCNT_dec(e->bufsv);	e->bufsv = Nullsv;    }    e->base.buf = NULL;    e->base.ptr = NULL;    e->base.end = NULL;    PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF);    return code;}Off_tPerlIOEncode_tell(pTHX_ PerlIO * f){    PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);    /* Unfortunately the only way to get a postion is to (re-)translate,       the UTF8 we have in bufefr and then ask layer below     */    PerlIO_flush(f);    if (b->buf && b->ptr > b->buf) {	Perl_croak(aTHX_ "Cannot tell at partial character");    }    return PerlIO_tell(PerlIONext(f));}PerlIO *PerlIOEncode_dup(pTHX_ PerlIO * f, PerlIO * o,		 CLONE_PARAMS * params, int flags){    if ((f = PerlIOBase_dup(aTHX_ f, o, params, flags))) {	PerlIOEncode *fe = PerlIOSelf(f, PerlIOEncode);	PerlIOEncode *oe = PerlIOSelf(o, PerlIOEncode);	if (oe->enc) {	    fe->enc = PerlIO_sv_dup(aTHX_ oe->enc, params);	}    }    return f;}SSize_tPerlIOEncode_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count){    PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode);    if (e->flags & NEEDS_LINES) {	SSize_t done = 0;	const char *ptr = (const char *) vbuf;	const char *end = ptr+count;	while (ptr < end) {	    const char *nl = ptr;	    while (nl < end && *nl++ != '\n') /* empty body */;	    done = PerlIOBuf_write(aTHX_ f, ptr, nl-ptr);	    if (done != nl-ptr) {		if (done > 0) {		    ptr += done;		}		break;	    }	    ptr += done;	    if (ptr[-1] == '\n') {		if (PerlIOEncode_flush(aTHX_ f) != 0) {		    break;		}	    }	}	return (SSize_t) (ptr - (const char *) vbuf);    }    else {	return PerlIOBuf_write(aTHX_ f, vbuf, count);    }}PerlIO_funcs PerlIO_encode = {    sizeof(PerlIO_funcs),    "encoding",    sizeof(PerlIOEncode),    PERLIO_K_BUFFERED|PERLIO_K_DESTRUCT,    PerlIOEncode_pushed,    PerlIOEncode_popped,    PerlIOBuf_open,    NULL, /* binmode - always pop */    PerlIOEncode_getarg,    PerlIOBase_fileno,    PerlIOEncode_dup,    PerlIOBuf_read,    PerlIOBuf_unread,    PerlIOEncode_write,    PerlIOBuf_seek,    PerlIOEncode_tell,    PerlIOEncode_close,    PerlIOEncode_flush,    PerlIOEncode_fill,    PerlIOBase_eof,    PerlIOBase_error,    PerlIOBase_clearerr,    PerlIOBase_setlinebuf,    PerlIOEncode_get_base,    PerlIOBuf_bufsiz,    PerlIOBuf_get_ptr,    PerlIOBuf_get_cnt,    PerlIOBuf_set_ptrcnt,};#endif				/* encode layer */MODULE = PerlIO::encoding PACKAGE = PerlIO::encodingPROTOTYPES: ENABLEBOOT:{    SV *chk = get_sv("PerlIO::encoding::fallback", GV_ADD|GV_ADDMULTI);    /*     * we now "use Encode ()" here instead of     * PerlIO/encoding.pm.  This avoids SEGV when ":encoding()"     * is invoked without prior "use Encode". -- dankogai     */    PUSHSTACKi(PERLSI_MAGIC);    SPAGAIN;    if (!get_cv(OUR_DEFAULT_FB, 0)) {#if 0	/* This would just be an irritant now loading works */	Perl_warner(aTHX_ packWARN(WARN_IO), ":encoding without 'use Encode'");#endif	ENTER;	/* Encode needs a lot of stack - it is likely to move ... */	PUTBACK;	/* The SV is magically freed by load_module */	load_module(PERL_LOADMOD_NOIMPORT, newSVpvn("Encode", 6), Nullsv, Nullsv);	SPAGAIN;	LEAVE;    }    PUSHMARK(sp);    PUTBACK;    if (call_pv(OUR_DEFAULT_FB, G_SCALAR) != 1) {	    /* should never happen */	    Perl_die(aTHX_ "%s did not return a value",OUR_DEFAULT_FB);    }    SPAGAIN;    sv_setsv(chk, POPs);    PUTBACK;#ifdef PERLIO_LAYERS    PerlIO_define_layer(aTHX_ &PerlIO_encode);#endif    POPSTACK;}