1 package OpenSRF::Utils::JSON;
7 our $parser = JSON::XS->new;
8 $parser->ascii(1); # output \u escaped strings for any char with a value over 127
9 $parser->allow_nonref(1); # allows non-reference values to equate to themselves (see perldoc)
12 our $JSON_CLASS_KEY = '__c'; # points to the classname of encoded objects
13 our $JSON_PAYLOAD_KEY = '__p'; # same, for payload
19 OpenSRF::Utils::JSON - Serialize/Vivify objects
23 C<O::U::JSON> is a functional-style package which exports nothing. All
24 calls to routines must use the fully-qualified name, and expect an
27 OpenSRF::Utils::JSON->JSON2perl($string);
29 The routines which are called by existing external code all deal with
30 the serialization/stringification of objects and their revivification.
36 =head2 register_class_hint
38 This routine is used by objects which wish to serialize themselves
39 with the L</perl2JSON> routine. It has two required arguments, C<name>
42 O::U::J->register_class_hint( hint => 'osrfException',
43 name => 'OpenSRF::DomainObject::oilsException');
45 Where C<hint> can be any unique string (but canonically is the name
46 from the IDL which matches the object being operated on), and C<name>
47 is the language-specific classname which objects will be revivified
52 sub register_class_hint {
53 # FIXME hint can't be a dupe?
54 # FIXME fail unless we have hint and name?
55 # FIXME validate hint against IDL?
56 my ($pkg, %args) = @_;
57 # FIXME maybe not just store a reference to %args; the lookup
58 # functions are really confusing at first glance as a side effect
60 $_class_map{hints}{$args{hint}} = \%args;
61 $_class_map{classes}{$args{name}} = \%args;
67 Given a JSON-encoded string, returns a vivified Perl object built from
73 # FIXME $string is not checked for any criteria, even existance
74 my( $pkg, $string ) = @_;
75 my $perl = $pkg->rawJSON2perl($string);
76 return $pkg->JSONObject2Perl($perl);
82 Given a Perl object, returns a JSON stringified representation of that
88 my( $pkg, $obj ) = @_;
89 # FIXME no validation of any sort
90 my $json = $pkg->perl2JSONObject($obj);
91 return $pkg->rawPerl2JSON($json);
96 =head1 INTERNAL ROUTINES
100 Intermediate routine called by L</JSON2Perl>.
105 my ($pkg, $json) = @_;
106 return undef unless (defined $json and $json =~ /\S/o);
107 return $parser->decode($json);
113 Intermediate routine used by L</Perl2JSON>.
118 # FIXME is there a reason this doesn't return undef with no
119 # content as rawJSON2perl does?
120 my ($pkg, $perl) = @_;
121 return $parser->encode($perl);
125 =head2 JSONObject2Perl
127 Intermediate routine called by L</rawJSON2perl>.
131 sub JSONObject2Perl {
132 my ($pkg, $obj) = @_;
135 if ( ref $obj eq 'HASH' ) {
136 # and if it has the "I'm a class!" marker
137 if ( defined $obj->{$JSON_CLASS_KEY} ) {
139 my $vivobj = $pkg->JSONObject2Perl($obj->{$JSON_PAYLOAD_KEY});
140 return undef unless defined $vivobj;
142 # and bless it back into an object
143 my $class = $obj->{$JSON_CLASS_KEY};
144 $class =~ s/^\s+//; # FIXME pretty sure these lines could condense to 's/\s+//g'
146 $class = $pkg->lookup_class($class) || $class;
147 return bless(\$vivobj, $class) unless ref $vivobj;
148 return bless($vivobj, $class);
151 # is a hash, but no class marker; simply revivify innards
152 for my $k (keys %$obj) {
153 $obj->{$k} = $pkg->JSONObject2Perl($obj->{$k})
154 unless ref $obj->{$k} eq 'JSON::XS::Boolean';
156 } elsif ( ref $obj eq 'ARRAY' ) {
157 # not a hash; an array. revivify.
158 for my $i (0..scalar(@$obj) - 1) {
159 $obj->[$i] = $pkg->JSONObject2Perl($obj->[$i])
160 unless (ref $obj->[$i] eq 'JSON::XS::Boolean');
161 # FIXME? This does nothing except leave any Booleans in
162 # place, without recursively calling this sub on
163 # them. I'm not sure if that's what's supposed to
164 # happen, or if they're supposed to be thrown out of the
169 # return vivified non-class hashes, all arrays, and anything that
170 # isn't a hash or array ref
175 =head2 perl2JSONObject
179 sub perl2JSONObject {
180 my ($pkg, $obj) = @_;
183 return $obj unless $ref;
184 return $obj if $ref eq 'JSON::XS::Boolean';
188 if(UNIVERSAL::isa($obj, 'HASH')) {
190 $jsonobj->{$_} = $pkg->perl2JSONObject($obj->{$_}) for (keys %$obj);
191 } elsif(UNIVERSAL::isa($obj, 'ARRAY')) {
193 $jsonobj->[$_] = $pkg->perl2JSONObject($obj->[$_]) for(0..scalar(@$obj) - 1);
196 if($ref ne 'HASH' and $ref ne 'ARRAY') {
197 $ref = $pkg->lookup_hint($ref) if $pkg->lookup_hint($ref);
198 $jsonobj = {$JSON_CLASS_KEY => $ref, $JSON_PAYLOAD_KEY => $jsonobj};
210 # FIXME when there are tests, see if these two routines can be
211 # rewritten as one, or at least made to do lookup in the structure
212 # they're named after. best case: flatten _class_map, since hints
213 # and classes are identical
214 my ($pkg, $hint) = @_;
215 return undef unless $hint;
216 return $_class_map{hints}{$hint}{name}
225 my ($pkg, $class) = @_;
226 return undef unless $class;
227 return $_class_map{classes}{$class}{hint}
232 Wrapper for JSON::XS::true. J::X::true and J::X::false, according to
233 its documentation, "are JSON atoms become JSON::XS::true and
234 JSON::XS::false, respectively. They are overloaded to act almost
235 exactly like the numbers 1 and 0"
239 sub true { return $parser->true }
247 sub false { return $parser->false }