The following patch does that. The new Encode::utf8->decode() checks $self->renewed and if so it sets Encode:RETURN_ON_ERR. Here is the patch or you can wait for Encode-2.08.
One patch to Unicode/Unicode.xs was missing and Unicode/Unicode.pm was garbled. Here we go again, the patch against 2.07. Forget the previous patch.
Or wait for Encode-2.08
Dan the Encode Maintainer
diff -ruN ext/Encode-2.07/Encode.xs ext/Encode/Encode.xs --- ext/Encode-2.07/Encode.xs Sat Oct 23 04:37:13 2004 +++ ext/Encode/Encode.xs Sun Oct 24 20:31:06 2004 @@ -252,14 +252,6 @@ PROTOTYPES: DISABLE
void -Method_renew(obj) -SV * obj -CODE: -{ - XSRETURN(1); -} - -void Method_decode_xs(obj,src,check = 0) SV * obj SV * src @@ -270,6 +262,28 @@ U8 *s = (U8 *) SvPV(src, slen); U8 *e = (U8 *) SvEND(src); SV *dst = newSV(slen>0?slen:1); /* newSV() abhors 0 -- inaba */ + + /* + * PerlO check -- we assume the object is of PerlIO if renewed + * and if so, we set RETURN_ON_ERR for partial character + */ + int renewed = 0; + dSP; ENTER; SAVETMPS; + PUSHMARK(sp); + XPUSHs(obj); + PUTBACK; + if (call_method("renewed",G_SCALAR) == 1) { + SPAGAIN; + renewed = POPi; + PUTBACK; +#if 0 + fprintf(stderr, "renewed == %d\n", renewed); +#endif + if (renewed){ check |= ENCODE_RETURN_ON_ERR; } + } + FREETMPS; LEAVE; + /* end PerlIO check */ + SvPOK_only(dst); SvCUR_set(dst,0); if (SvUTF8(src)) { @@ -397,6 +411,14 @@ { XSRETURN(1); } + +int +Method_renewed(obj) +SV * obj +CODE: + RETVAL = 0; +OUTPUT: + RETVAL
void
Method_name(obj)
diff -ruN ext/Encode-2.07/Unicode/Unicode.pm ext/Encode/Unicode/Unicode.pm
--- ext/Encode-2.07/Unicode/Unicode.pm Sat Oct 23 04:37:17 2004
+++ ext/Encode/Unicode/Unicode.pm Sun Oct 24 21:20:22 2004
@@ -46,7 +46,7 @@
my $self = shift;
$BOM_Unknown{$self->name} or return $self;
my $clone = bless { %$self } => ref($self);
- $clone->{clone} = 1; # so the caller knows it is renewed.
+ $clone->{renewed}++; # so the caller knows it is renewed.
return $clone;
}
diff -ruN ext/Encode-2.07/Unicode/Unicode.xs ext/Encode/Unicode/Unicode.xs
--- ext/Encode-2.07/Unicode/Unicode.xs Sat Oct 23 04:37:21 2004
+++ ext/Encode/Unicode/Unicode.xs Sun Oct 24 21:20:22 2004
@@ -1,5 +1,5 @@
/*
- $Id: Unicode.xs,v 2.0 2004/05/16 20:55:16 dankogai Exp $
+ $Id: Unicode.xs,v 2.0 2004/05/16 20:55:16 dankogai Exp dankogai $
*/
#define PERL_NO_GET_CONTEXT
@@ -97,7 +97,7 @@
U8 endian = *((U8 *)SvPV_nolen(attr("endian", 6)));
int size = SvIV(attr("size", 4));
int ucs2 = SvTRUE(attr("ucs2", 4));
- int clone = SvTRUE(attr("clone", 5));
+ int renewed = SvTRUE(attr("renewed", 7));
SV *result = newSVpvn("",0);
STRLEN ulen;
U8 *s = (U8 *)SvPVbyte(str,ulen);
@@ -124,7 +124,7 @@
}
#if 1
/* Update endian for next sequence */
- if (clone) {
+ if (renewed) {
hv_store((HV *)SvRV(obj),"endian",6,newSVpv((char *)&endian,1),0);
}
#endif
@@ -200,7 +200,7 @@
U8 endian = *((U8 *)SvPV_nolen(attr("endian", 6)));
int size = SvIV(attr("size", 4));
int ucs2 = SvTRUE(attr("ucs2", 4));
- int clone = SvTRUE(attr("clone", 5));
+ int renewed = SvTRUE(attr("renewed", 7));
SV *result = newSVpvn("",0);
STRLEN ulen;
U8 *s = (U8 *)SvPVutf8(utf8,ulen);
@@ -211,7 +211,7 @@
enc_pack(aTHX_ result,size,endian,BOM_BE);
#if 1
/* Update endian for next sequence */
- if (clone){
+ if (renewed){
hv_store((HV *)SvRV(obj),"endian",6,newSVpv((char *)&endian,1),0);
}
#endif
diff -ruN ext/Encode-2.07/lib/Encode/Encoding.pm ext/Encode/lib/Encode/Encoding.pm
--- ext/Encode-2.07/lib/Encode/Encoding.pm Sat Oct 23 04:37:13 2004
+++ ext/Encode/lib/Encode/Encoding.pm Sun Oct 24 20:25:13 2004
@@ -5,6 +5,7 @@
require Encode;
+sub DEBUG { 0 } sub Define { my $obj = shift; @@ -16,7 +17,18 @@
sub name { return shift->{'Name'} }
-sub renew { return $_[0] } +# sub renew { return $_[0] } + +sub renew { + my $self = shift; + my $clone = bless { %$self } => ref($self); + $clone->{renewed}++; # so the caller can see it + DEBUG and warn $clone->{renewed}; + return $clone; +} + +sub renewed{ return $_[0]->{renewed} || 0 } + *new_sequence = \&renew;
sub needs_lines { 0 }; @@ -167,24 +179,28 @@
Predefined As:
- sub renew { return $_[0] } + sub renew { + my $self = shift; + my $clone = bless { %$self } => ref($self); + $clone->{renewed}++; + return $clone; + }
This method reconstructs the encoding object if necessary. If you need
to store the state during encoding, this is where you clone your object.
-Here is an example:
-
- sub renew {
- my $self = shift;
- my $clone = bless { %$self } => ref($self);
- $clone->{clone} = 1; # so the caller can see it
- return $clone;
- }
-
-Since most encodings are stateless the default behavior is just return
-itself as shown above.
PerlIO ALWAYS calls this method to make sure it has its own private encoding object. + +=item -E<gt>renewed + +Predefined As: + + sub renewed { $_[0]->{renewed} || 0 } + +Tells whether the object is renewed (and how many times). Some +modules emit C<Use of uninitialized value in null operation> warning +unless the value is numeric so return 0 for false.
=item -E<gt>perlio_ok()