[Slim-Checkins] r11734 - in /trunk/server/CPAN: JSON.pm JSON/Converter.pm

fred at svn.slimdevices.com fred at svn.slimdevices.com
Sat Apr 7 11:17:55 PDT 2007


Author: fred
Date: Sat Apr  7 11:17:54 2007
New Revision: 11734

URL: http://svn.slimdevices.com?rev=11734&view=rev
Log:
Bug: N/A
Description: Update JSON to latest 1.09.


Modified:
    trunk/server/CPAN/JSON.pm
    trunk/server/CPAN/JSON/Converter.pm

Modified: trunk/server/CPAN/JSON.pm
URL: http://svn.slimdevices.com/trunk/server/CPAN/JSON.pm?rev=11734&r1=11733&r2=11734&view=diff
==============================================================================
--- trunk/server/CPAN/JSON.pm (original)
+++ trunk/server/CPAN/JSON.pm Sat Apr  7 11:17:54 2007
@@ -9,7 +9,7 @@
             $ExecCoderef $SkipInvalid $Pretty $Indent $Delimiter
             $KeySort $ConvBlessed $SelfConvert $UTF8 $SingleQuote);
 
-$VERSION = '1.07';
+$VERSION = '1.09';
 
 $AUTOCONVERT = 1;
 $SkipInvalid = 0;

Modified: trunk/server/CPAN/JSON/Converter.pm
URL: http://svn.slimdevices.com/trunk/server/CPAN/JSON/Converter.pm?rev=11734&r1=11733&r2=11734&view=diff
==============================================================================
--- trunk/server/CPAN/JSON/Converter.pm (original)
+++ trunk/server/CPAN/JSON/Converter.pm Sat Apr  7 11:17:54 2007
@@ -8,7 +8,7 @@
 use JSON ();
 
 
-$VERSION = '1.09';
+$VERSION = '1.11';
 
 BEGIN {
     eval 'require Scalar::Util';
@@ -99,22 +99,27 @@
     my ($k,$v);
     my %res;
 
+    if (my $class = tied %$obj) { # by ddascalescu+perl [at] gmail.com
+        $class =~ s/=.*//;
+        tie %res, $class;
+    }
+
     my ($pre,$post) = $self->_upIndent() if($JSON::Converter::pretty);
 
-    if(grep { $_ == $obj } @JSON::Converter::obj_addr){
+    if (grep { $_ == $obj } @JSON::Converter::obj_addr) {
         die "circle ref!";
     }
 
     push @JSON::Converter::obj_addr,$obj;
 
-    for my $k (keys %$obj){
+    for my $k (keys %$obj) {
         my $v = $obj->{$k};
         $res{$k} = $self->_toJson($v) || $self->_valueToJson($v);
     }
 
     pop @JSON::Converter::obj_addr;
 
-    if($JSON::Converter::pretty){
+    if ($JSON::Converter::pretty) {
         $self->_downIndent();
         my $del = $self->{_delstr};
         return "{$pre"
@@ -133,8 +138,13 @@
 
 
 sub _arrayToJson {
-	my ($self, $obj) = @_;
+    my ($self, $obj) = @_;
     my @res;
+
+    if (my $class = tied @$obj) {
+        $class =~ s/=.*//;
+        tie @res, $class;
+    }
 
     my ($pre,$post) = $self->_upIndent() if($JSON::Converter::pretty);
 
@@ -150,11 +160,11 @@
 
     pop @JSON::Converter::obj_addr;
 
-    if($JSON::Converter::pretty){
+    if ($JSON::Converter::pretty) {
         $self->_downIndent();
         return "[$pre" . join(",$pre" , at res) . "$post]";
     }
-    else{
+    else {
         return '[' . join(',' , at res) . ']';
     }
 }
@@ -177,11 +187,8 @@
 
     if(!ref($value)){
         if($JSON::Converter::autoconv){
-
             return $value  if($value =~ /^-?(?:0|[1-9][\d]*)(?:\.\d*)?(?:[eE][-+]?\d+)?$/);
-#            return $value  if($value =~ /^-?(?:0|[1-9][\d]*)(?:\.[\d]*)?$/);
-#            return $value  if($value =~ /^-?(?:\d+)(?:\.\d*)?(?:[eE][-+]?\d+)?$/);
-            return $value  if($value =~ /^0[xX](?:[0-9a-zA-Z])+$/);
+            return $value  if($value =~ /^0[xX](?:[0-9a-fA-F])+$/);
             return 'true'  if($value =~ /^[Tt][Rr][Uu][Ee]$/);
             return 'false' if($value =~ /^[Ff][Aa][Ll][Ss][Ee]$/);
         }
@@ -195,7 +202,7 @@
     elsif( blessed($value) and  $value->isa('JSON::NotString') ){
         return defined $value->{value} ? $value->{value} : 'null';
     }
-    else{
+    else {
         die "Invalid value" unless($self->{skipinvalid});
         return 'null';
     }
@@ -212,13 +219,30 @@
     "\"" => '\"',
     "\\" => '\\\\',
     "\'" => '\\\'',
+#    "/"  => '\\/', # TODO
 );
 
 
 sub _stringfy {
     my ($arg) = @_;
     $arg =~ s/([\\"\n\r\t\f\b])/$esc{$1}/eg;
-    $arg =~ s/([\x00-\x07\x0b\x0e-\x1f])/'\\u00' . unpack('H2',$1)/eg;
+
+    unless (JSON->USE_UTF8) {
+        $arg =~ s/([\x00-\x07\x0b\x0e-\x1f])/'\\u00' . unpack('H2',$1)/eg;
+        return '"' . $arg . '"';
+    }
+
+    # suggestion from rt#25727
+    $arg = join('',
+        map {
+            chr($_) =~ /[\x00-\x07\x0b\x0e-\x1f]/ ?
+                sprintf('\u%04x', $_) :
+            $_ <= 255 ?
+                chr($_) :
+            $_ <= 65535 ?
+                sprintf('\u%04x', $_) : sprintf('\u%04x', $_)
+        } unpack('U*', $arg)
+    );
 
     $JSON::Converter::utf8 and utf8::decode($arg);
 
@@ -229,7 +253,22 @@
 sub _stringfy_single_quote {
     my $arg = shift;
     $arg =~ s/([\\\n'\r\t\f\b])/$esc{$1}/eg;
-    $arg =~ s/([\x00-\x07\x0b\x0e-\x1f])/'\\u00' . unpack('H2',$1)/eg;
+
+    unless (JSON->USE_UTF8) {
+        $arg =~ s/([\x00-\x07\x0b\x0e-\x1f])/'\\u00' . unpack('H2',$1)/eg;
+        return "'" . $arg ."'";
+    }
+
+    $arg = join('',
+        map {
+            chr($_) =~ /[\x00-\x07\x0b\x0e-\x1f]/ ?
+                sprintf('\u%04x', $_) :
+            $_ <= 255 ?
+                chr($_) :
+            $_ <= 65535 ?
+                sprintf('\u%04x', $_) : sprintf('\u%04x', $_)
+        } unpack('U*', $arg)
+    );
 
     $JSON::Converter::utf8 and utf8::decode($arg);
 
@@ -317,8 +356,9 @@
 
 sub _blessedToNormal {
     my $type  = _getObjType($_[0]);
-    return $type eq 'HASH'  ? _blessedToNormalHash($_[0])  : 
-           $type eq 'ARRAY' ? _blessedToNormalArray($_[0]) : $_[0];
+    return $type eq 'HASH'   ? _blessedToNormalHash($_[0])   : 
+           $type eq 'ARRAY'  ? _blessedToNormalArray($_[0])  : 
+           $type eq 'SCALAR' ? _blessedToNormalScalar($_[0]) : $_[0];
 }
 
 
@@ -359,6 +399,23 @@
     return \@res;
 }
 
+
+sub _blessedToNormalScalar {
+    my ($obj) = @_;
+    my $res;
+
+    die "circle ref!" if(grep { overload::AddrRef($_) eq overload::AddrRef($obj) }
+    @JSON::Converter::_blessedToNormal::obj_addr);
+
+    push @JSON::Converter::_blessedToNormal::obj_addr, $obj;
+
+    $res = _blessedToNormal($$obj);
+
+    pop @JSON::Converter::_blessedToNormal::obj_addr;
+
+    return $res; # JSON can't really do scalar refs so it can't be \$res
+}
+
 ##############################################################################
 1;
 __END__



More information about the checkins mailing list