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
83 object. Callers should not expect that the JSON string has hash keys
84 sorted in any particular order.
89 my( $pkg, $obj ) = @_;
90 # FIXME no validation of any sort
91 my $json = $pkg->perl2JSONObject($obj);
92 return $pkg->rawPerl2JSON($json);
97 =head1 INTERNAL ROUTINES
101 Performs actual JSON -> data transformation, before
102 L</JSONObject2Perl> is called.
107 my ($pkg, $json) = @_;
108 return undef unless (defined $json and $json =~ /\S/o);
109 return $parser->decode($json);
115 Performs actual data -> JSON transformation, after L</perl2JSONObject>
121 # FIXME is there a reason this doesn't return undef with no
122 # content as rawJSON2perl does?
123 my ($pkg, $perl) = @_;
124 return $parser->encode($perl);
128 =head2 JSONObject2Perl
130 Routine called by L</JSON2perl> after L</rawJSON2perl> is called.
132 At this stage, the JSON string will have been vivified as data. This
133 routine's job is to turn it back into an OpenSRF system object of some
136 If it's not possible, the original data (structure), or one very much
137 like it will be returned.
141 sub JSONObject2Perl {
142 my ($pkg, $obj) = @_;
145 if ( ref $obj eq 'HASH' ) {
146 # and if it has the "I'm a class!" marker
147 if ( defined $obj->{$JSON_CLASS_KEY} ) {
149 my $vivobj = $pkg->JSONObject2Perl($obj->{$JSON_PAYLOAD_KEY});
150 return undef unless defined $vivobj;
152 # and bless it back into an object
153 my $class = $obj->{$JSON_CLASS_KEY};
154 $class =~ s/^\s+//; # FIXME pretty sure these lines could condense to 's/\s+//g'
156 $class = $pkg->lookup_class($class) if $pkg->lookup_class($class);
157 return bless(\$vivobj, $class) unless ref $vivobj;
158 return bless($vivobj, $class);
161 # is a hash, but no class marker; simply revivify innards
162 for my $k (keys %$obj) {
163 $obj->{$k} = $pkg->JSONObject2Perl($obj->{$k})
164 unless JSON::XS::is_bool $obj->{$k};
166 } elsif ( ref $obj eq 'ARRAY' ) {
167 # not a hash; an array. revivify.
168 for my $i (0..scalar(@$obj) - 1) {
169 $obj->[$i] = $pkg->JSONObject2Perl($obj->[$i])
170 unless JSON::XS::is_bool $obj->[$i];
171 # FIXME? This does nothing except leave any Booleans in
172 # place, without recursively calling this sub on
173 # them. I'm not sure if that's what's supposed to
174 # happen, or if they're supposed to be thrown out of the
179 # return vivified non-class hashes, all arrays, and anything that
180 # isn't a hash or array ref
185 =head2 perl2JSONObject
187 Routine called by L</perl2JSON> before L</rawPerl2JSON> is called.
189 For OpenSRF system objects which have had hints about their classes
190 stowed via L</register_class_hint>, this routine acts as a wrapper,
191 encapsulating the incoming object in metadata about itself. It is not
192 unlike the process of encoding IP datagrams.
194 The only metadata encoded at the moment is the class hint, which is
195 used to reinflate the data as an object of the appropriate type in the
196 L</JSONObject2perl> routine.
198 Other forms of data more-or-less come out as they went in, although
199 C<CODE> or C<SCALAR> references will return what looks like an OpenSRF
200 packet, but with a class hint of their reference type and an C<undef>
205 sub perl2JSONObject {
206 my ($pkg, $obj) = @_;
209 return $obj if !$ref or JSON::XS::is_bool $obj;
213 if(UNIVERSAL::isa($obj, 'HASH')) {
215 $jsonobj->{$_} = $pkg->perl2JSONObject($obj->{$_}) for (keys %$obj);
216 } elsif(UNIVERSAL::isa($obj, 'ARRAY')) {
218 $jsonobj->[$_] = $pkg->perl2JSONObject($obj->[$_]) for(0..scalar(@$obj) - 1);
221 if($ref ne 'HASH' and $ref ne 'ARRAY') {
222 $ref = $_class_map{classes}{$ref}{hint} || $ref;
223 $jsonobj = {$JSON_CLASS_KEY => $ref, $JSON_PAYLOAD_KEY => $jsonobj};
232 Given a class hint, returns the classname matching it. Returns undef
238 # FIXME when there are tests, see if these two routines can be
239 # rewritten as one, or at least made to do lookup in the structure
240 # they're named after. best case: flatten _class_map, since hints
241 # and classes are identical
242 my ($pkg, $hint) = @_;
243 return undef unless $hint;
244 return $_class_map{hints}{$hint}{name}
250 Given a classname, returns the class hint matching it. Returns undef
256 my ($pkg, $class) = @_;
257 return undef unless $class;
258 return $_class_map{classes}{$class}{hint}
263 Wrapper for JSON::XS::true. J::X::true and J::X::false, according to
264 its documentation, "are JSON atoms become JSON::XS::true and
265 JSON::XS::false, respectively. They are overloaded to act almost
266 exactly like the numbers 1 and 0"
270 sub true { return $parser->true }
278 sub false { return $parser->false }