[Opensrf-commits] r1754 - trunk/src/perl/lib/OpenSRF/Utils (sboyette)
svn at svn.open-ils.org
svn at svn.open-ils.org
Tue Aug 25 14:51:04 EDT 2009
Author: sboyette
Date: 2009-08-25 14:51:00 -0400 (Tue, 25 Aug 2009)
New Revision: 1754
Modified:
trunk/src/perl/lib/OpenSRF/Utils/JSON.pm
Log:
rearranging things a bit, docs. no actual code changes.
Modified: trunk/src/perl/lib/OpenSRF/Utils/JSON.pm
===================================================================
--- trunk/src/perl/lib/OpenSRF/Utils/JSON.pm 2009-08-25 15:45:01 UTC (rev 1753)
+++ trunk/src/perl/lib/OpenSRF/Utils/JSON.pm 2009-08-25 18:51:00 UTC (rev 1754)
@@ -1,106 +1,103 @@
package OpenSRF::Utils::JSON;
use JSON::XS;
-use vars qw/%_class_map/;
my $parser = JSON::XS->new;
-$parser->ascii(1); # output \u escaped strings
-$parser->allow_nonref(1);
+$parser->ascii(1); # output \u escaped strings for any char with a value over 127
+$parser->allow_nonref(1); # allows non-reference values to equate to themselves (see perldoc)
-sub true {
- return $parser->true();
-}
+my %_class_map = ();
+my $JSON_CLASS_KEY = '__c';
+my $JSON_PAYLOAD_KEY = '__p';
-sub false {
- return $parser->false();
-}
-sub register_class_hint {
- my $class = shift;
- my %args = @_;
- $_class_map{hints}{$args{hint}} = \%args;
- $_class_map{classes}{$args{name}} = \%args;
-}
+=head1 NAME
-sub lookup_class {
- my $self = shift;
- my $hint = shift;
- return $_class_map{hints}{$hint}{name}
-}
+OpenSRF::Utils::JSON - Bucket-o-Routines for JSON
-sub lookup_hint {
- my $self = shift;
- my $class = shift;
- return $_class_map{classes}{$class}{hint}
-}
+=head1 SYNOPSIS
-sub _json_hint_to_class {
- my $type = shift;
- my $hint = shift;
- return $_class_map{hints}{$hint}{name} if (exists $_class_map{hints}{$hint});
-
- $type = 'hash' if ($type eq '}');
- $type = 'array' if ($type eq ']');
- OpenSRF::Utils::JSON->register_class_hint(name => $hint, hint => $hint, type => $type);
+=head1 ROUTINES
- return $hint;
-}
+=head2 JSON2perl
+=cut
-my $JSON_CLASS_KEY = '__c';
-my $JSON_PAYLOAD_KEY = '__p';
-
sub JSON2perl {
- my( $class, $string ) = @_;
- my $perl = $class->rawJSON2perl($string);
- return $class->JSONObject2Perl($perl);
+ my( $class, $string ) = @_;
+ my $perl = $class->rawJSON2perl($string);
+ return $class->JSONObject2Perl($perl);
}
+=head2 perl2JSON
+
+=cut
+
sub perl2JSON {
- my( $class, $obj ) = @_;
- my $json = $class->perl2JSONObject($obj);
- return $class->rawPerl2JSON($json);
+ my( $class, $obj ) = @_;
+ my $json = $class->perl2JSONObject($obj);
+ return $class->rawPerl2JSON($json);
}
+=head2 rawJSON2perl
+
+=cut
+
+sub rawJSON2perl {
+ my $class = shift;
+ my $json = shift;
+ return undef unless defined $json and $json !~ /^\s*$/o;
+ return $parser->decode($json);
+}
+
+=head2 perl2JSON
+
+=cut
+
+sub rawPerl2JSON {
+ my ($class, $perl) = @_;
+ return $parser->encode($perl);
+}
+
sub JSONObject2Perl {
- my $class = shift;
- my $obj = shift;
- my $ref = ref($obj);
- if( $ref eq 'HASH' ) {
- if( defined($obj->{$JSON_CLASS_KEY})) {
- my $cls = $obj->{$JSON_CLASS_KEY};
+ my $class = shift;
+ my $obj = shift;
+ 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);
- }
- return undef;
- }
+ 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);
+ }
+ return undef;
+ }
for my $k (keys %$obj) {
- $obj->{$k} = $class->JSONObject2Perl($obj->{$k})
- unless ref($obj->{$k}) eq 'JSON::XS::Boolean';
+ $obj->{$k} = $class->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])
- unless ref($obj->[$i]) eq 'JSON::XS::Boolean';
+ } elsif( $ref eq 'ARRAY' ) {
+ for my $i (0..scalar(@$obj) - 1) {
+ $obj->[$i] = $class->JSONObject2Perl($obj->[$i])
+ unless ref($obj->[$i]) eq 'JSON::XS::Boolean';
}
- }
- return $obj;
+ }
+ return $obj;
}
sub perl2JSONObject {
- my $class = shift;
- my $obj = shift;
- my $ref = ref($obj);
+ my $class = shift;
+ my $obj = shift;
+ my $ref = ref($obj);
- return $obj unless $ref;
+ return $obj unless $ref;
return $obj if $ref eq 'JSON::XS::Boolean';
- my $newobj;
+ my $newobj;
if(UNIVERSAL::isa($obj, 'HASH')) {
$newobj = {};
@@ -111,24 +108,52 @@
}
if($ref ne 'HASH' and $ref ne 'ARRAY') {
- $ref = $class->lookup_hint($ref) || $ref;
- $newobj = {$JSON_CLASS_KEY => $ref, $JSON_PAYLOAD_KEY => $newobj};
+ $ref = $class->lookup_hint($ref) || $ref;
+ $newobj = {$JSON_CLASS_KEY => $ref, $JSON_PAYLOAD_KEY => $newobj};
}
- return $newobj;
+ return $newobj;
}
+sub true {
+ return $parser->true();
+}
-sub rawJSON2perl {
- my $class = shift;
- my $json = shift;
- return undef unless defined $json and $json !~ /^\s*$/o;
- return $parser->decode($json);
+sub false {
+ return $parser->false();
}
-sub rawPerl2JSON {
- my ($class, $perl) = @_;
- return $parser->encode($perl);
+sub register_class_hint {
+ my $class = shift;
+ my %args = @_;
+ $_class_map{hints}{$args{hint}} = \%args;
+ $_class_map{classes}{$args{name}} = \%args;
}
+sub lookup_class {
+ my $self = shift;
+ my $hint = shift;
+ return $_class_map{hints}{$hint}{name}
+}
+
+sub lookup_hint {
+ my $self = shift;
+ my $class = shift;
+ return $_class_map{classes}{$class}{hint}
+}
+
+sub _json_hint_to_class {
+ my $type = shift;
+ my $hint = shift;
+
+ return $_class_map{hints}{$hint}{name} if (exists $_class_map{hints}{$hint});
+
+ $type = 'hash' if ($type eq '}');
+ $type = 'array' if ($type eq ']');
+
+ OpenSRF::Utils::JSON->register_class_hint(name => $hint, hint => $hint, type => $type);
+
+ return $hint;
+}
+
1;
More information about the opensrf-commits
mailing list