From: Rafael Garcia-Suarez Date: Mon, 25 Oct 2004 07:29:50 +0000 (+0000) Subject: Upgrade to Encode 2.08. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cc836e956f1f965d89e75825961e461d4c4efb8a;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Encode 2.08. p4raw-id: //depot/perl@23421 --- diff --git a/ext/Encode/Changes b/ext/Encode/Changes index 56e5f1b..4991796 100644 --- a/ext/Encode/Changes +++ b/ext/Encode/Changes @@ -1,8 +1,17 @@ # Revision history for Perl extension Encode. # -# $Id: Changes,v 2.7 2004/10/22 19:35:52 dankogai Exp $ +# $Id: Changes,v 2.8 2004/10/24 13:00:29 dankogai Exp dankogai $ # -$Revision: 2.7 $ $Date: 2004/10/22 19:35:52 $ +$Revision: 2.8 $ $Date: 2004/10/24 13:00:29 $ +! Encode.xs lib/Encode/Encoding.pm Unicode/Unicode.{pm,xs} + Resolved the issue that was raised by the Encode::utf8 fallbacks vs. + PerlIO::encoding issue that was introduced in 2.07. This is done by + making use of ->renew() method that used to be used only by + Encode::Unicode. ->renewed() method was also introduced to fetch + the value thereof. + Message-Id: <94B2EB12-25B7-11D9-9E6A-000A95DBB50A@dan.co.jp> + +2.07 2004/10/22 19:35:52 ! lib/Encode/Encoding.pm "Remove Carp from warnings.pm" that influences Encode, by Tels. Message-Id: <200410161618.29779@bloodgate.com> diff --git a/ext/Encode/Encode.pm b/ext/Encode/Encode.pm index 97b5f07..29dde91 100644 --- a/ext/Encode/Encode.pm +++ b/ext/Encode/Encode.pm @@ -1,9 +1,9 @@ # -# $Id: Encode.pm,v 2.7 2004/10/22 19:35:52 dankogai Exp $ +# $Id: Encode.pm,v 2.8 2004/10/24 12:32:06 dankogai Exp $ # package Encode; use strict; -our $VERSION = do { my @r = (q$Revision: 2.7 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +our $VERSION = do { my @r = (q$Revision: 2.8 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; sub DEBUG () { 0 } use XSLoader (); XSLoader::load(__PACKAGE__, $VERSION); diff --git a/ext/Encode/Encode.xs b/ext/Encode/Encode.xs index 3747b6d..d7a25ff 100644 --- a/ext/Encode/Encode.xs +++ b/ext/Encode/Encode.xs @@ -1,5 +1,5 @@ /* - $Id: Encode.xs,v 2.1 2004/10/22 19:35:52 dankogai Exp $ + $Id: Encode.xs,v 2.2 2004/10/24 13:00:29 dankogai Exp dankogai $ */ #define PERL_NO_GET_CONTEXT @@ -252,14 +252,6 @@ MODULE = Encode PACKAGE = Encode::utf8 PREFIX = Method_ 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 @@ CODE: 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)) { @@ -398,6 +412,14 @@ CODE: XSRETURN(1); } +int +Method_renewed(obj) +SV * obj +CODE: + RETVAL = 0; +OUTPUT: + RETVAL + void Method_name(obj) SV * obj diff --git a/ext/Encode/META.yml b/ext/Encode/META.yml index 32cb504..cea68e5 100644 --- a/ext/Encode/META.yml +++ b/ext/Encode/META.yml @@ -1,7 +1,7 @@ # http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Encode -version: 2.07 +version: 2.08 version_from: Encode.pm installdirs: perl requires: diff --git a/ext/Encode/Unicode/Unicode.pm b/ext/Encode/Unicode/Unicode.pm index bd9c188..4d0c31d 100644 --- a/ext/Encode/Unicode/Unicode.pm +++ b/ext/Encode/Unicode/Unicode.pm @@ -4,7 +4,7 @@ use strict; use warnings; no warnings 'redefine'; -our $VERSION = do { my @r = (q$Revision: 2.1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +our $VERSION = do { my @r = (q$Revision: 2.2 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; use XSLoader; XSLoader::load(__PACKAGE__,$VERSION); @@ -46,7 +46,7 @@ sub renew { 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 --git a/ext/Encode/Unicode/Unicode.xs b/ext/Encode/Unicode/Unicode.xs index 6dadbdc..acecd9c 100644 --- a/ext/Encode/Unicode/Unicode.xs +++ b/ext/Encode/Unicode/Unicode.xs @@ -1,5 +1,5 @@ /* - $Id: Unicode.xs,v 2.0 2004/05/16 20:55:16 dankogai Exp $ + $Id: Unicode.xs,v 2.1 2004/10/24 13:00:29 dankogai Exp dankogai $ */ #define PERL_NO_GET_CONTEXT @@ -97,7 +97,7 @@ CODE: 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 @@ CODE: } #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 @@ CODE: 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 @@ CODE: 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 --git a/ext/Encode/lib/Encode/Encoding.pm b/ext/Encode/lib/Encode/Encoding.pm index 1fad60a..06af9fb 100644 --- a/ext/Encode/lib/Encode/Encoding.pm +++ b/ext/Encode/lib/Encode/Encoding.pm @@ -1,10 +1,11 @@ package Encode::Encoding; # Base class for classes which implement encodings use strict; -our $VERSION = do { my @r = (q$Revision: 2.1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +our $VERSION = do { my @r = (q$Revision: 2.2 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; require Encode; +sub DEBUG { 0 } sub Define { my $obj = shift; @@ -16,7 +17,18 @@ sub Define 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,25 +179,29 @@ MUST return the string representing the canonical name of the encoding. 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 -Erenewed + +Predefined As: + + sub renewed { $_[0]->{renewed} || 0 } + +Tells whether the object is renewed (and how many times). Some +modules emit C warning +unless the value is numeric so return 0 for false. + =item -Eperlio_ok() Predefined As: