r31018 - in /branches/upstream/libjson-perl/current: Changes MANIFEST META.yml Makefile.PL README lib/JSON.pm lib/JSON/PP.pm lib/JSON/PP5005.pm lib/JSON/PP56.pm t/e12_upgrade.t t/x02_error.t

ansgar-guest at users.alioth.debian.org ansgar-guest at users.alioth.debian.org
Sun Feb 22 13:46:36 UTC 2009


Author: ansgar-guest
Date: Sun Feb 22 13:46:18 2009
New Revision: 31018

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=31018
Log:
[svn-upgrade] Integrating new upstream version, libjson-perl (2.13)

Added:
    branches/upstream/libjson-perl/current/t/e12_upgrade.t
Modified:
    branches/upstream/libjson-perl/current/Changes
    branches/upstream/libjson-perl/current/MANIFEST
    branches/upstream/libjson-perl/current/META.yml
    branches/upstream/libjson-perl/current/Makefile.PL
    branches/upstream/libjson-perl/current/README
    branches/upstream/libjson-perl/current/lib/JSON.pm
    branches/upstream/libjson-perl/current/lib/JSON/PP.pm
    branches/upstream/libjson-perl/current/lib/JSON/PP5005.pm
    branches/upstream/libjson-perl/current/lib/JSON/PP56.pm
    branches/upstream/libjson-perl/current/t/x02_error.t

Modified: branches/upstream/libjson-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjson-perl/current/Changes?rev=31018&op=diff
==============================================================================
--- branches/upstream/libjson-perl/current/Changes (original)
+++ branches/upstream/libjson-perl/current/Changes Sun Feb 22 13:46:18 2009
@@ -12,6 +12,20 @@
      Please check JSON::RPC (supports JSON-RPC protocol v1.1 and 1.0).
 
 ##########################################################################
+
+2.13  Sat Feb 21 17:01:05 2009
+	[JSON::PP]
+	- decode() didn't upgrade unicode escaped charcters \u0080-\u00ff.
+	  this problem was pointed by rt#43424 (Mika Raento)
+	[JSON::PP::56]
+	- fixed utf8::encode/decode emulators bugs.
+	- defined a missing B module constant in Perl 5.6.0.
+	  (reported by Clinton Pierce)
+	[JSON::PP::5005]
+	- _decode_unicode() returned a 0x80-0xff value as UTF8 encoded byte.
+	[JSON]
+	- added a refference to JSON::XS's document "JSON and ECMAscript".
+	- fixed a typo in the document (pointed by Jim Cromie).
 
 2.12  Wed Jul 16 11:14:35 2008
 	[JSON]

Modified: branches/upstream/libjson-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjson-perl/current/MANIFEST?rev=31018&op=diff
==============================================================================
--- branches/upstream/libjson-perl/current/MANIFEST (original)
+++ branches/upstream/libjson-perl/current/MANIFEST Sun Feb 22 13:46:18 2009
@@ -45,6 +45,7 @@
 t/e09_encode.t
 t/e10_bignum.t
 t/e11_conv_blessed_univ.t
+t/e12_upgrade.t
 
 t/x00_load.t
 t/x02_error.t

Modified: branches/upstream/libjson-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjson-perl/current/META.yml?rev=31018&op=diff
==============================================================================
--- branches/upstream/libjson-perl/current/META.yml (original)
+++ branches/upstream/libjson-perl/current/META.yml Sun Feb 22 13:46:18 2009
@@ -1,8 +1,8 @@
 --- #YAML:1.0
 name:                JSON
-version:             2.12
+version:             2.13
 abstract:            JSON (JavaScript Object Notation) encoder/decoder
-license:             ~
+license:             perl
 author:              
     - Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
 generated_by:        ExtUtils::MakeMaker version 6.42

Modified: branches/upstream/libjson-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjson-perl/current/Makefile.PL?rev=31018&op=diff
==============================================================================
--- branches/upstream/libjson-perl/current/Makefile.PL (original)
+++ branches/upstream/libjson-perl/current/Makefile.PL Sun Feb 22 13:46:18 2009
@@ -43,7 +43,7 @@
 }
 
 print <<EOF;
-Wellcome to JSON (v.$version)
+Welcome to JSON (v.$version)
 =============================
 $message
 
@@ -67,6 +67,7 @@
     ($] >= 5.005 ?    ## Add these new keywords supported since 5.005
       (ABSTRACT_FROM => 'lib/JSON.pm', # retrieve abstract from module
        AUTHOR     => 'Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>') : ()),
+    ( $ExtUtils::MakeMaker::VERSION >= 6.3002 ? ('LICENSE' => 'perl', ) : () ),
 );
 
 

Modified: branches/upstream/libjson-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjson-perl/current/README?rev=31018&op=diff
==============================================================================
--- branches/upstream/libjson-perl/current/README (original)
+++ branches/upstream/libjson-perl/current/README Sun Feb 22 13:46:18 2009
@@ -1,4 +1,4 @@
-JSON version 2.12
+JSON version 2.13
 =================
 
 INSTALLATION
@@ -42,7 +42,7 @@
      use JSON -support_by_pp;
 
 VERSION
-        2.10
+        2.13
 
     This version is compatible with JSON::XS 2.21.
 

Modified: branches/upstream/libjson-perl/current/lib/JSON.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjson-perl/current/lib/JSON.pm?rev=31018&op=diff
==============================================================================
--- branches/upstream/libjson-perl/current/lib/JSON.pm (original)
+++ branches/upstream/libjson-perl/current/lib/JSON.pm Sun Feb 22 13:46:18 2009
@@ -7,7 +7,7 @@
 @JSON::EXPORT = qw(from_json to_json jsonToObj objToJson encode_json decode_json);
 
 BEGIN {
-    $JSON::VERSION = '2.12';
+    $JSON::VERSION = '2.13';
     $JSON::DEBUG   = 0 unless (defined $JSON::DEBUG);
 }
 
@@ -1275,8 +1275,8 @@
 to a hash or array) to its JSON representation. Simple scalars will be
 converted into JSON string or number sequences, while references to arrays
 become JSON arrays and references to hashes become JSON objects. Undefined
-Perl values (e.g. C<undef>) become JSON C<null> values. Neither C<true>
-nor C<false> values will be generated.
+Perl values (e.g. C<undef>) become JSON C<null> values.
+References to the integers C<0> and C<1> are converted into C<true> and C<false>.
 
 =head2 decode
 
@@ -1287,7 +1287,8 @@
 
 JSON numbers and strings become simple Perl scalars. JSON arrays become
 Perl arrayrefs and JSON objects become Perl hashrefs. C<true> becomes
-C<1>, C<false> becomes C<0> and C<null> becomes C<undef>.
+C<1> (C<JSON::true>), C<false> becomes C<0> (C<JSON::false>) and
+C<null> becomes C<undef>.
 
 =head2 decode_prefix
 
@@ -1711,6 +1712,10 @@
 
 =back
 
+=head1 JSON and ECMAscript
+
+See to L<JSON::XS/JSON and ECMAscript>.
+
 =head1 JSON and YAML
 
 JSON is not a subset of YAML.
@@ -1783,7 +1788,7 @@
 it makes a part of those unupported methods available.
 This feature is achieved by using JSON::PP in C<de/encode>.
 
-   BEING { $ENV{PERL_JSON_BACKEND} = 2 } # with JSON::XS
+   BEGIN { $ENV{PERL_JSON_BACKEND} = 2 } # with JSON::XS
    use JSON -support_by_pp;
    my $json = new JSON;
    $json->allow_nonref->escape_slash->encode("/");

Modified: branches/upstream/libjson-perl/current/lib/JSON/PP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjson-perl/current/lib/JSON/PP.pm?rev=31018&op=diff
==============================================================================
--- branches/upstream/libjson-perl/current/lib/JSON/PP.pm (original)
+++ branches/upstream/libjson-perl/current/lib/JSON/PP.pm Sun Feb 22 13:46:18 2009
@@ -11,7 +11,7 @@
 use B ();
 #use Devel::Peek;
 
-$JSON::PP::VERSION = '2.22000';
+$JSON::PP::VERSION = '2.22010';
 
 @JSON::PP::EXPORT = qw(encode_json decode_json from_json to_json);
 
@@ -636,7 +636,6 @@
     my $ch;   # 1chracter
     my $len;  # text length (changed according to UTF8 or NON UTF8)
     # INTERNAL
-    my $is_utf8;        # must be with UTF8 flag
     my $depth;          # nest counter
     my $encoding;       # json text encoding
     my $is_valid_utf8;  # temp variable
@@ -675,8 +674,6 @@
         ($utf8, $relaxed, $loose, $allow_bigint, $allow_barekey, $singlequote)
             = @{$idx}[P_UTF8, P_RELAXED, P_LOOSE .. P_ALLOW_SINGLEQUOTE];
 
-        $is_utf8 = 1 if ( $utf8 or utf8::is_utf8( $text ) );
-
         if ( $utf8 ) {
             utf8::downgrade( $text, 1 ) or Carp::croak("Wide character in subroutine entry");
         }
@@ -748,6 +745,7 @@
     sub string {
         my ($i, $s, $t, $u);
         my $utf16;
+        my $is_utf8;
 
         ($is_valid_utf8, $utf8_len) = ('', 0);
 
@@ -801,7 +799,7 @@
                                 decode_error("surrogate pair expected");
                             }
 
-                            if ((my $hex = hex( $u )) > 255) {
+                            if ( ( my $hex = hex( $u ) ) > 127 ) {
                                 $is_utf8 = 1;
                                 $s .= JSON_PP_decode_unicode($u) || next;
                             }
@@ -819,11 +817,22 @@
                     }
                 }
                 else{
-                    if ($utf8) {
-                        if( !is_valid_utf8($ch) ) {
-                            $at -= $utf8_len;
-                            decode_error("malformed UTF-8 character in JSON string");
+
+                    if ( ord $ch  > 127 ) {
+                        if ( $utf8 ) {
+                            unless( $ch = is_valid_utf8($ch) ) {
+                                $at -= 1;
+                                decode_error("malformed UTF-8 character in JSON string");
+                            }
+                            else {
+                                $at += $utf8_len - 1;
+                            }
                         }
+                        else {
+                            utf8::encode( $ch );
+                        }
+
+                        $is_utf8 = 1;
                     }
 
                     if (!$loose) {
@@ -1155,20 +1164,19 @@
 
 
     sub is_valid_utf8 {
-        unless ( $utf8_len ) {
-            $utf8_len = $_[0] =~ /[\x00-\x7F]/  ? 1
-                      : $_[0] =~ /[\xC2-\xDF]/  ? 2
-                      : $_[0] =~ /[\xE0-\xEF]/  ? 3
-                      : $_[0] =~ /[\xF0-\xF4]/  ? 4
-                      : 0
-                      ;
-        }
-
-        return !($utf8_len = 1) unless ( $utf8_len );
-
-        return 1 if (length ($is_valid_utf8 .= $_[0] ) < $utf8_len); # continued
-
-        return ( $is_valid_utf8 =~ s/^(?:
+
+        $utf8_len = $_[0] =~ /[\x00-\x7F]/  ? 1
+                  : $_[0] =~ /[\xC2-\xDF]/  ? 2
+                  : $_[0] =~ /[\xE0-\xEF]/  ? 3
+                  : $_[0] =~ /[\xF0-\xF4]/  ? 4
+                  : 0
+                  ;
+
+        return unless $utf8_len;
+
+        my $is_valid_utf8 = substr($text, $at - 1, $utf8_len);
+
+        return ( $is_valid_utf8 =~ /^(?:
              [\x00-\x7F]
             |[\xC2-\xDF][\x80-\xBF]
             |[\xE0][\xA0-\xBF][\x80-\xBF]
@@ -1178,8 +1186,7 @@
             |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF]
             |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF]
             |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF]
-        )$//x and !($utf8_len = 0) ); # if valid, make $is_valid_utf8 empty and rest $utf8_len.
-
+        )$/x )  ? $is_valid_utf8 : '';
     }
 
 
@@ -1247,7 +1254,6 @@
             at      => $at,
             ch      => $ch,
             len     => $len,
-            is_utf8 => $is_utf8,
             depth   => $depth,
             encoding      => $encoding,
             is_valid_utf8 => $is_valid_utf8,
@@ -1259,12 +1265,16 @@
 
 sub _decode_surrogates { # from perlunicode
     my $uni = 0x10000 + (hex($_[0]) - 0xD800) * 0x400 + (hex($_[1]) - 0xDC00);
-    return pack('U*', $uni);
+    my $un  = pack('U*', $uni);
+    utf8::encode( $un );
+    return $un;
 }
 
 
 sub _decode_unicode {
-    return pack("U", hex shift);
+    my $un = pack('U', hex shift);
+    utf8::encode( $un );
+    return $un;
 }
 
 
@@ -2009,7 +2019,6 @@
             at      => $at,
             ch      => $ch,
             len     => $len,
-            is_utf8 => $is_utf8,
             depth   => $depth,
             encoding      => $encoding,
             is_valid_utf8 => $is_valid_utf8,

Modified: branches/upstream/libjson-perl/current/lib/JSON/PP5005.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjson-perl/current/lib/JSON/PP5005.pm?rev=31018&op=diff
==============================================================================
--- branches/upstream/libjson-perl/current/lib/JSON/PP5005.pm (original)
+++ branches/upstream/libjson-perl/current/lib/JSON/PP5005.pm Sun Feb 22 13:46:18 2009
@@ -5,14 +5,9 @@
 
 my @properties;
 
-$JSON::PP5005::VERSION = '1.07';
+$JSON::PP5005::VERSION = '1.08';
 
 BEGIN {
-    *JSON::PP::JSON_PP_encode_ascii      = \&_encode_ascii;
-    *JSON::PP::JSON_PP_encode_latin1     = \&_encode_latin1;
-    *JSON::PP::JSON_PP_decode_surrogates = \&_decode_surrogates;
-    *JSON::PP::JSON_PP_decode_unicode    = \&_decode_unicode;
-
 
     sub utf8::is_utf8 {
         0; # It is considered that UTF8 flag off for Perl 5.005.
@@ -30,6 +25,11 @@
 
     sub utf8::decode {
     }
+
+    *JSON::PP::JSON_PP_encode_ascii      = \&_encode_ascii;
+    *JSON::PP::JSON_PP_encode_latin1     = \&_encode_latin1;
+    *JSON::PP::JSON_PP_decode_surrogates = \&_decode_surrogates;
+    *JSON::PP::JSON_PP_decode_unicode    = \&_decode_unicode;
 
     # missing in B module.
     sub B::SVf_IOK () { 0x00010000; }
@@ -70,6 +70,11 @@
 sub _decode_unicode {
     my ($u) = @_;
     my ($utf8bit);
+
+    if ( $u =~ /^00([89a-f][0-9a-f])$/i ) { # 0x80-0xff
+         return pack( 'H2', $1 );
+    }
+
     my $bit = unpack("B*", pack("H*", $u));
 
     if ( $bit =~ /^00000(.....)(......)$/ ) {
@@ -83,40 +88,6 @@
     }
 
     return pack('B*', $utf8bit);
-}
-
-
-sub _is_valid_utf8 {
-    my $str = $_[0];
-    my $is_utf8;
-
-    while ($str =~ /(?:
-          (
-             [\x00-\x7F]
-            |[\xC2-\xDF][\x80-\xBF]
-            |[\xE0][\xA0-\xBF][\x80-\xBF]
-            |[\xE1-\xEC][\x80-\xBF][\x80-\xBF]
-            |[\xED][\x80-\x9F][\x80-\xBF]
-            |[\xEE-\xEF][\x80-\xBF][\x80-\xBF]
-            |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF]
-            |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF]
-            |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF]
-          )
-        | (.)
-    )/xg)
-    {
-        if (defined $1) {
-            $is_utf8 = 1 if (!defined $is_utf8);
-        }
-        else {
-            $is_utf8 = 0 if (!defined $is_utf8);
-            if ($is_utf8) { # eventually, not utf8
-                return;
-            }
-        }
-    }
-
-    return $is_utf8;
 }
 
 

Modified: branches/upstream/libjson-perl/current/lib/JSON/PP56.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjson-perl/current/lib/JSON/PP56.pm?rev=31018&op=diff
==============================================================================
--- branches/upstream/libjson-perl/current/lib/JSON/PP56.pm (original)
+++ branches/upstream/libjson-perl/current/lib/JSON/PP56.pm Sun Feb 22 13:46:18 2009
@@ -5,9 +5,10 @@
 
 my @properties;
 
-$JSON::PP56::VERSION = '1.06';
+$JSON::PP56::VERSION = '1.07';
 
 BEGIN {
+
     sub utf8::is_utf8 {
         my $len =  length $_[0]; # char length
         {
@@ -22,12 +23,12 @@
     }
 
 
-    sub utf8::downgrade (\$;$) {
-        return 1 unless ( utf8::is_utf8( ${$_[0]} ) );
+    sub utf8::downgrade ($;$) {
+        return 1 unless ( utf8::is_utf8( $_[0] ) );
 
-        if ( _is_valid_utf8(${$_[0]}) ) {
+        if ( _is_valid_utf8( $_[0] ) ) {
             my $downgrade;
-            for my $c ( unpack("U*", ${$_[0]}) ) {
+            for my $c ( unpack( "U*", $_[0] ) ) {
                 if ( $c < 256 ) {
                     $downgrade .= pack("C", $c);
                 }
@@ -35,7 +36,7 @@
                     $downgrade .= pack("U", $c);
                 }
             }
-            ${$_[0]} = $downgrade;
+            $_[0] = $downgrade;
             return 1;
         }
         else {
@@ -45,26 +46,21 @@
     }
 
 
-    sub utf8::encode (\$) { # UTF8 flag off
-        if ( utf8::is_utf8( ${$_[0]} ) ) {
-            ${$_[0]} = pack( "C*", unpack( "C*", ${$_[0]} ) );
+    sub utf8::encode ($) { # UTF8 flag off
+        if ( utf8::is_utf8( $_[0] ) ) {
+            $_[0] = pack( "C*", unpack( "C*", $_[0] ) );
         }
         else {
-            ${$_[0]} = pack( "U*", map {
-                if ( $_ > 127 ) {
-                    unpack ( "C*", pack("U*", $_) );
-                }
-                else {
-                    $_;
-                }
-            } unpack( "C*", ${$_[0]} ) );
+            $_[0] = pack( "U*", unpack( "C*", $_[0] ) );
+            $_[0] = pack( "C*", unpack( "C*", $_[0] ) );
         }
     }
 
 
-    sub utf8::decode (\$) { # UTF8 flag on
-        if ( _is_valid_utf8(${$_[0]}) ) {
-            ${$_[0]} = pack("U*", unpack("U*", ${$_[0]}));
+    sub utf8::decode ($) { # UTF8 flag on
+        if ( _is_valid_utf8( $_[0] ) ) {
+            utf8::downgrade( $_[0] );
+            $_[0] = pack( "U*", unpack( "U*", $_[0] ) );
         }
     }
 
@@ -73,6 +69,11 @@
     *JSON::PP::JSON_PP_encode_latin1     = \&_encode_latin1;
     *JSON::PP::JSON_PP_decode_surrogates = \&JSON::PP::_decode_surrogates;
     *JSON::PP::JSON_PP_decode_unicode    = \&JSON::PP::_decode_unicode;
+
+    unless ( defined &B::SVp_NOK ) { # missing in B module.
+        eval q{ sub B::SVp_NOK () { 0x02000000; } };
+    }
+
 }
 
 

Added: branches/upstream/libjson-perl/current/t/e12_upgrade.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjson-perl/current/t/e12_upgrade.t?rev=31018&op=file
==============================================================================
--- branches/upstream/libjson-perl/current/t/e12_upgrade.t (added)
+++ branches/upstream/libjson-perl/current/t/e12_upgrade.t Sun Feb 22 13:46:18 2009
@@ -1,0 +1,32 @@
+use strict;
+use Test::More;
+
+BEGIN { plan tests => 3 };
+
+BEGIN { $ENV{PERL_JSON_BACKEND} = 0; }
+
+use JSON;
+
+BEGIN {
+    use lib qw(t);
+    use _unicode_handling;
+}
+
+my $json = JSON->new->allow_nonref->utf8;
+my $str  = '\\u00c8';
+
+my $value = $json->decode( '"\\u00c8"' );
+
+#use Devel::Peek;
+#Dump( $value );
+
+is( $value, chr 0xc8 );
+
+SKIP: {
+    skip "UNICODE handling is disabale.", 1 unless $JSON::can_handle_UTF16_and_utf8;
+    ok( utf8::is_utf8( $value ) );
+}
+
+eval { $json->decode( '"' . chr(0xc8) . '"' ) };
+ok( $@ =~ /malformed UTF-8 character in JSON string/ );
+

Modified: branches/upstream/libjson-perl/current/t/x02_error.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjson-perl/current/t/x02_error.t?rev=31018&op=diff
==============================================================================
--- branches/upstream/libjson-perl/current/t/x02_error.t (original)
+++ branches/upstream/libjson-perl/current/t/x02_error.t Sun Feb 22 13:46:18 2009
@@ -4,6 +4,7 @@
 
 BEGIN { $ENV{PERL_JSON_BACKEND} = 1; }
 
+local $^W;
 
 BEGIN {
     use lib qw(t);




More information about the Pkg-perl-cvs-commits mailing list