Re: Encode-2.07 vs. PerlIO::encoding

On Oct 24, 2004, at 18:34, Rafael Garcia-Suarez wrote:
> Welcome to backward compatibility hell :)

Hell it was but seems like I came up with a way out (yay).

>> I just want Encode::utf8->decode() to make sure Encode:RETURN_ON_ERR 
>> is
>> on when the callar is PerlIO::encoding...
>
> Or, one could backport PerlIO::encoding (with your patch) to CPAN and
> require this latest version for Encode 2.08.

That was what came across my mind first but I found it was not good 
enough to coerce Encode:RETURN_ON_ERR since $PerlIO::encoding:fallback 
is open to the public (even documented!).

So far ->renew() is only used by PerlIO (and is meaningful only when 
the object is Encode::Unicode).  In other words, you can tell it's 
PerlIO that is calling you if the object is renewed.

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.

Thankfully Encode::XS needs no "real" ->renew so it is left as is 
(dummy ->renewed() was introduced just to be safe).

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 20:38:16 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->{clone}++ # so the caller knows it is renewed.
      return $clone;
  }

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()