[Opensrf-commits] r1760 - trunk/src/perl/lib/OpenSRF/Utils (sboyette)

svn at svn.open-ils.org svn at svn.open-ils.org
Fri Aug 28 16:31:35 EDT 2009


Author: sboyette
Date: 2009-08-28 16:31:30 -0400 (Fri, 28 Aug 2009)
New Revision: 1760

Modified:
   trunk/src/perl/lib/OpenSRF/Utils/JSON.pm
Log:
more cleanup and documentation in progress

Modified: trunk/src/perl/lib/OpenSRF/Utils/JSON.pm
===================================================================
--- trunk/src/perl/lib/OpenSRF/Utils/JSON.pm	2009-08-28 20:31:29 UTC (rev 1759)
+++ trunk/src/perl/lib/OpenSRF/Utils/JSON.pm	2009-08-28 20:31:30 UTC (rev 1760)
@@ -33,8 +33,7 @@
 =cut
 
 sub register_class_hint {
-    my $class = shift;
-    my %args = @_;
+    my ($pkg, %args) = @_;
     $_class_map{hints}{$args{hint}} = \%args;
     $_class_map{classes}{$args{name}} = \%args;
 }
@@ -44,8 +43,7 @@
 =cut
 
 sub lookup_class {
-    my $self = shift;
-    my $hint = shift;
+    my ($pkg, $hint) = @_;
     return $_class_map{hints}{$hint}{name}
 }
 
@@ -54,8 +52,7 @@
 =cut
 
 sub lookup_hint {
-    my $self = shift;
-    my $class = shift;
+    my ($pkg, $class) = @_;
     return $_class_map{classes}{$class}{hint}
 }
 
@@ -64,7 +61,7 @@
 =cut
 
 sub JSON2perl {
-    my( $class, $string ) = @_;
+    my( $pkg, $string ) = @_;
     my $perl = $class->rawJSON2perl($string);
     return $class->JSONObject2Perl($perl);
 }
@@ -74,24 +71,29 @@
 =cut
 
 sub perl2JSON {
-    my( $class, $obj ) = @_;
-    my $json = $class->perl2JSONObject($obj);
-    return $class->rawPerl2JSON($json);
+    my( $pkg, $obj ) = @_;
+    my $json = $pkg->perl2JSONObject($obj);
+    return $pkg->rawPerl2JSON($json);
 }
 
 =head2 rawJSON2perl
 
+Internal routine used by L</JSON2Perl>. Wrapper around
+L<JSON::XS::decode>.
+
 =cut
 
 sub rawJSON2perl {
-    my $class = shift;
-    my $json = shift;
+    my ($class, $json) = @_;
     return undef unless defined $json and $json !~ /^\s*$/o;
     return $parser->decode($json);
 }
 
 =head2 rawPerl2JSON
 
+Internal routine used by L</Perl2JSON>. Wrapper around
+L<JSON::XS::encode>.
+
 =cut
 
 sub rawPerl2JSON {
@@ -104,28 +106,27 @@
 =cut
 
 sub JSONObject2Perl {
-    my $class = shift;
-    my $obj = shift;
-    my $ref = ref($obj);
+    my ($pkg, $obj) = @_;
+    my $ref = ref $obj;
     if( $ref eq 'HASH' ) {
         if( defined($obj->{$JSON_CLASS_KEY})) {
-            my $cls = $obj->{$JSON_CLASS_KEY};
-            $cls =~ s/^\s+//o;
-            $cls =~ s/\s+$//o;
-            if( $obj = $class->JSONObject2Perl($obj->{$JSON_PAYLOAD_KEY}) ) {
-                $cls = $class->lookup_class($cls) || $cls;
-                return bless(\$obj, $cls) unless ref($obj);
-                return bless($obj, $cls);
+            my $class = $obj->{$JSON_CLASS_KEY};
+            $class =~ s/^\s+//o;
+            $class =~ s/\s+$//o;
+            if( $obj = $pkg->JSONObject2Perl($obj->{$JSON_PAYLOAD_KEY}) ) {
+                $class = $pkg->lookup_class($class) || $class;
+                return bless(\$obj, $class) unless ref($obj);
+                return bless($obj, $class);
             }
             return undef;
         }
         for my $k (keys %$obj) {
-            $obj->{$k} = $class->JSONObject2Perl($obj->{$k})
+            $obj->{$k} = $pkg->JSONObject2Perl($obj->{$k})
               unless ref($obj->{$k}) eq 'JSON::XS::Boolean';
         }
     } elsif( $ref eq 'ARRAY' ) {
         for my $i (0..scalar(@$obj) - 1) {
-            $obj->[$i] = $class->JSONObject2Perl($obj->[$i])
+            $obj->[$i] = $pkg->JSONObject2Perl($obj->[$i])
               unless ref($obj->[$i]) eq 'JSON::XS::Boolean';
         }
     }
@@ -164,18 +165,21 @@
 
 =head2 true
 
+Wrapper for JSON::XS::true. J::X::true and J::X::false, according to
+its documentation, "are JSON atoms become JSON::XS::true and
+JSON::XS::false, respectively. They are overloaded to act almost
+exactly like the numbers 1 and 0"
+
 =cut
 
-sub true {
-    return $parser->true();
-}
+sub true { return $parser->true }
 
 =head2 false
 
+See L</true>
+
 =cut
 
-sub false {
-    return $parser->false();
-}
+sub false { return $parser->false }
 
 1;



More information about the opensrf-commits mailing list