1 package OpenSRF::Utils::JSON;
4 my $parser = JSON::XS->new;
5 $parser->ascii(1); # output \u escaped strings for any char with a value over 127
6 $parser->allow_nonref(1); # allows non-reference values to equate to themselves (see perldoc)
9 my $JSON_CLASS_KEY = '__c';
10 my $JSON_PAYLOAD_KEY = '__p';
15 OpenSRF::Utils::JSON - Bucket-o-Routines for JSON
19 C<O::U::JSON> is a functional-style package which exports nothing. All
20 calls to routines must use the fully-qualified name, and expect an
23 OpenSRF::Utils::JSON->JSON2perl($string);
25 Most routines are straightforward data<->JSON transformation wrappers
26 around L<JSON::XS>, but some (like L</register_class_hint>) provide
27 OpenSRF functionality.
31 =head2 register_class_hint
35 sub register_class_hint {
38 $_class_map{hints}{$args{hint}} = \%args;
39 $_class_map{classes}{$args{name}} = \%args;
49 return $_class_map{hints}{$hint}{name}
59 return $_class_map{classes}{$class}{hint}
67 my( $class, $string ) = @_;
68 my $perl = $class->rawJSON2perl($string);
69 return $class->JSONObject2Perl($perl);
77 my( $class, $obj ) = @_;
78 my $json = $class->perl2JSONObject($obj);
79 return $class->rawPerl2JSON($json);
89 return undef unless defined $json and $json !~ /^\s*$/o;
90 return $parser->decode($json);
98 my ($class, $perl) = @_;
99 return $parser->encode($perl);
102 =head2 JSONObject2Perl
106 sub JSONObject2Perl {
110 if( $ref eq 'HASH' ) {
111 if( defined($obj->{$JSON_CLASS_KEY})) {
112 my $cls = $obj->{$JSON_CLASS_KEY};
115 if( $obj = $class->JSONObject2Perl($obj->{$JSON_PAYLOAD_KEY}) ) {
116 $cls = $class->lookup_class($cls) || $cls;
117 return bless(\$obj, $cls) unless ref($obj);
118 return bless($obj, $cls);
122 for my $k (keys %$obj) {
123 $obj->{$k} = $class->JSONObject2Perl($obj->{$k})
124 unless ref($obj->{$k}) eq 'JSON::XS::Boolean';
126 } elsif( $ref eq 'ARRAY' ) {
127 for my $i (0..scalar(@$obj) - 1) {
128 $obj->[$i] = $class->JSONObject2Perl($obj->[$i])
129 unless ref($obj->[$i]) eq 'JSON::XS::Boolean';
135 =head2 perl2JSONObject
139 sub perl2JSONObject {
144 return $obj unless $ref;
146 return $obj if $ref eq 'JSON::XS::Boolean';
149 if(UNIVERSAL::isa($obj, 'HASH')) {
151 $newobj->{$_} = $class->perl2JSONObject($obj->{$_}) for (keys %$obj);
152 } elsif(UNIVERSAL::isa($obj, 'ARRAY')) {
154 $newobj->[$_] = $class->perl2JSONObject($obj->[$_]) for(0..scalar(@$obj) - 1);
157 if($ref ne 'HASH' and $ref ne 'ARRAY') {
158 $ref = $class->lookup_hint($ref) || $ref;
159 $newobj = {$JSON_CLASS_KEY => $ref, $JSON_PAYLOAD_KEY => $newobj};
170 return $parser->true();
178 return $parser->false();
181 sub _json_hint_to_class {
185 return $_class_map{hints}{$hint}{name} if (exists $_class_map{hints}{$hint});
187 $type = 'hash' if ($type eq '}');
188 $type = 'array' if ($type eq ']');
190 OpenSRF::Utils::JSON->register_class_hint(name => $hint, hint => $hint, type => $type);