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 Performs actual JSON -> data transformation, before
101 L</JSONObject2Perl> is called.
106 my ($pkg, $json) = @_;
107 return undef unless (defined $json and $json =~ /\S/o);
108 return $parser->decode($json);
114 Performs actual data -> JSON transformation, after L</perl2JSONObject>
120 # FIXME is there a reason this doesn't return undef with no
121 # content as rawJSON2perl does?
122 my ($pkg, $perl) = @_;
123 return $parser->encode($perl);
127 =head2 JSONObject2Perl
129 Routine called by L</JSON2perl> after L</rawJSON2perl> is called.
131 At this stage, the JSON string will have been vivified as data. This
132 routine's job is to turn it back into an OpenSRF system object of some
135 If it's not possible, the original data (structure), or one very much
136 like it will be returned.
140 sub JSONObject2Perl {
141 my ($pkg, $obj) = @_;
144 if ( ref $obj eq 'HASH' ) {
145 # and if it has the "I'm a class!" marker
146 if ( defined $obj->{$JSON_CLASS_KEY} ) {
148 my $vivobj = $pkg->JSONObject2Perl($obj->{$JSON_PAYLOAD_KEY});
149 return undef unless defined $vivobj;
151 # and bless it back into an object
152 my $class = $obj->{$JSON_CLASS_KEY};
153 $class =~ s/^\s+//; # FIXME pretty sure these lines could condense to 's/\s+//g'
155 $class = $pkg->lookup_class($class) if $pkg->lookup_class($class);
156 return bless(\$vivobj, $class) unless ref $vivobj;
157 return bless($vivobj, $class);
160 # is a hash, but no class marker; simply revivify innards
161 for my $k (keys %$obj) {
162 $obj->{$k} = $pkg->JSONObject2Perl($obj->{$k})
163 unless JSON::XS::is_bool $obj->{$k};
165 } elsif ( ref $obj eq 'ARRAY' ) {
166 # not a hash; an array. revivify.
167 for my $i (0..scalar(@$obj) - 1) {
168 $obj->[$i] = $pkg->JSONObject2Perl($obj->[$i])
169 unless JSON::XS::is_bool $obj->[$i];
170 # FIXME? This does nothing except leave any Booleans in
171 # place, without recursively calling this sub on
172 # them. I'm not sure if that's what's supposed to
173 # happen, or if they're supposed to be thrown out of the
178 # return vivified non-class hashes, all arrays, and anything that
179 # isn't a hash or array ref
184 =head2 perl2JSONObject
186 Routine called by L</perl2JSON> before L</rawPerl2JSON> is called.
188 For OpenSRF system objects which have had hints about their classes
189 stowed via L</register_class_hint>, this routine acts as a wrapper,
190 encapsulating the incoming object in metadata about itself. It is not
191 unlike the process of encoding IP datagrams.
193 The only metadata encoded at the moment is the class hint, which is
194 used to reinflate the data as an object of the appropriate type in the
195 L</JSONObject2perl> routine.
197 Other forms of data more-or-less come out as they went in, although
198 C<CODE> or C<SCALAR> references will return what looks like an OpenSRF
199 packet, but with a class hint of their reference type and an C<undef>
204 sub perl2JSONObject {
205 my ($pkg, $obj) = @_;
208 return $obj if !$ref or JSON::XS::is_bool $obj;
212 if(UNIVERSAL::isa($obj, 'HASH')) {
214 $jsonobj->{$_} = $pkg->perl2JSONObject($obj->{$_}) for (keys %$obj);
215 } elsif(UNIVERSAL::isa($obj, 'ARRAY')) {
217 $jsonobj->[$_] = $pkg->perl2JSONObject($obj->[$_]) for(0..scalar(@$obj) - 1);
220 if($ref ne 'HASH' and $ref ne 'ARRAY') {
221 $ref = $_class_map{classes}{$ref}{hint} || $ref;
222 $jsonobj = {$JSON_CLASS_KEY => $ref, $JSON_PAYLOAD_KEY => $jsonobj};
231 Given a class hint, returns the classname matching it. Returns undef
237 # FIXME when there are tests, see if these two routines can be
238 # rewritten as one, or at least made to do lookup in the structure
239 # they're named after. best case: flatten _class_map, since hints
240 # and classes are identical
241 my ($pkg, $hint) = @_;
242 return undef unless $hint;
243 return $_class_map{hints}{$hint}{name}
249 Given a classname, returns the class hint matching it. Returns undef
255 my ($pkg, $class) = @_;
256 return undef unless $class;
257 return $_class_map{classes}{$class}{hint}
262 Wrapper for JSON::XS::true. J::X::true and J::X::false, according to
263 its documentation, "are JSON atoms become JSON::XS::true and
264 JSON::XS::false, respectively. They are overloaded to act almost
265 exactly like the numbers 1 and 0"
269 sub true { return $parser->true }
277 sub false { return $parser->false }