X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FPerlIO%2Fencoding%2Fencoding.xs;h=df911ed705a59884f0a79841c55fefa308d2b7d8;hb=15af043884e0520355045b5d53efce3cdf6f3094;hp=0a6ab1050febe0adaef173071518f0bbf1ba589d;hpb=1982da4048668033f4bb857b02c690606711056a;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/ext/PerlIO/encoding/encoding.xs b/ext/PerlIO/encoding/encoding.xs
index 0a6ab10..df911ed 100644
--- a/ext/PerlIO/encoding/encoding.xs
+++ b/ext/PerlIO/encoding/encoding.xs
@@ -8,6 +8,8 @@
 #include "XSUB.h"
 #define U8 U8
 
+#define OUR_DEFAULT_FB	"Encode::PERLQQ"
+
 #if defined(USE_PERLIO) && !defined(USE_SFIO)
 
 /* Define an encoding "layer" in the perliol.h sense.
@@ -49,7 +51,6 @@ typedef struct {
 } PerlIOEncode;
 
 #define NEEDS_LINES	1
-#define OUR_DEFAULT_FB	"Encode::PERLQQ"
 
 SV *
 PerlIOEncode_getarg(pTHX_ PerlIO * f, CLONE_PARAMS * param, int flags)
@@ -396,14 +397,14 @@ PerlIOEncode_flush(pTHX_ PerlIO * f)
     PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode);
     IV code = 0;
 
-    if (e->bufsv && (e->base.ptr > e->base.buf)) {
+    if (e->bufsv) {
 	dSP;
 	SV *str;
 	char *s;
 	STRLEN len;
 	SSize_t count = 0;
-	if (PerlIOBase(f)->flags & PERLIO_F_WRBUF) {
-	    /* Write case encode the buffer and write() to layer below */
+	if ((PerlIOBase(f)->flags & PERLIO_F_WRBUF) && (e->base.ptr > e->base.buf)) {
+	    /* Write case - encode the buffer and write() to layer below */
 	    PUSHSTACKi(PERLSI_MAGIC);
 	    SPAGAIN;
 	    ENTER;
@@ -438,15 +439,17 @@ PerlIOEncode_flush(pTHX_ PerlIO * f)
 		return code;
 	    }
 	}
-	else if (PerlIOBase(f)->flags & PERLIO_F_RDBUF) {
+	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) {
@@ -495,9 +498,18 @@ IV
 PerlIOEncode_close(pTHX_ PerlIO * f)
 {
     PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode);
-    IV code = PerlIOBase_close(aTHX_ f);
-
+    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");
 	}
@@ -578,6 +590,7 @@ PerlIO_funcs PerlIO_encode = {
     PerlIOEncode_pushed,
     PerlIOEncode_popped,
     PerlIOBuf_open,
+    NULL, /* binmode - always pop */
     PerlIOEncode_getarg,
     PerlIOBase_fileno,
     PerlIOEncode_dup,
@@ -615,7 +628,7 @@ BOOT:
      */
     PUSHSTACKi(PERLSI_MAGIC);
     SPAGAIN;
-    if (!gv_stashpvn("Encode", 6, FALSE)) {
+    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'");
@@ -628,7 +641,6 @@ BOOT:
 	SPAGAIN;
 	LEAVE;
     }
-#ifdef PERLIO_LAYERS
     PUSHMARK(sp);
     PUTBACK;
     if (call_pv(OUR_DEFAULT_FB, G_SCALAR) != 1) {
@@ -638,6 +650,7 @@ BOOT:
     SPAGAIN;
     sv_setsv(chk, POPs);
     PUTBACK;
+#ifdef PERLIO_LAYERS
     PerlIO_define_layer(aTHX_ &PerlIO_encode);
 #endif
     POPSTACK;