bfefb86e074d976c212db5754bc1010e756000c7
[OpenSRF.git] / src / perlmods / OpenSRF / Utils / JSON.pm
1 package OpenSRF::Utils::JSON;
2 use JSON::XS;
3 use vars qw/%_class_map/;
4
5 my $parser = JSON::XS->new;
6 $parser->ascii(1); # output \u escaped strings
7 $parser->allow_nonref(1);
8
9 sub true {
10     return $parser->true();
11 }
12
13 sub false {
14     return $parser->false();
15 }
16
17 sub register_class_hint {
18         my $class = shift;
19         my %args = @_;
20         $_class_map{hints}{$args{hint}} = \%args;
21         $_class_map{classes}{$args{name}} = \%args;
22 }
23
24 sub lookup_class {
25         my $self = shift;
26         my $hint = shift;
27         return $_class_map{hints}{$hint}{name}
28 }
29
30 sub lookup_hint {
31         my $self = shift;
32         my $class = shift;
33         return $_class_map{classes}{$class}{hint}
34 }
35
36 sub _json_hint_to_class {
37         my $type = shift;
38         my $hint = shift;
39
40         return $_class_map{hints}{$hint}{name} if (exists $_class_map{hints}{$hint});
41         
42         $type = 'hash' if ($type eq '}');
43         $type = 'array' if ($type eq ']');
44
45         OpenSRF::Utils::JSON->register_class_hint(name => $hint, hint => $hint, type => $type);
46
47         return $hint;
48 }
49
50
51 my $JSON_CLASS_KEY = '__c';
52 my $JSON_PAYLOAD_KEY = '__p';
53
54 sub JSON2perl {
55         my( $class, $string ) = @_;
56         my $perl = $class->rawJSON2perl($string);
57         return $class->JSONObject2Perl($perl);
58 }
59
60 sub perl2JSON {
61         my( $class, $obj ) = @_;
62         my $json = $class->perl2JSONObject($obj);
63         return $class->rawPerl2JSON($json);
64 }
65
66 sub JSONObject2Perl {
67         my $class = shift;
68         my $obj = shift;
69         my $ref = ref($obj);
70         if( $ref eq 'HASH' ) {
71                 if( defined($obj->{$JSON_CLASS_KEY})) {
72                         my $cls = $obj->{$JSON_CLASS_KEY};
73             $cls =~ s/^\s+//o;
74             $cls =~ s/\s+$//o;
75                         if( $obj = $class->JSONObject2Perl($obj->{$JSON_PAYLOAD_KEY}) ) {
76                                 $cls = $class->lookup_class($cls) || $cls;
77                                 return bless(\$obj, $cls) unless ref($obj); 
78                                 return bless($obj, $cls);
79                         }
80                         return undef;
81                 }
82                 $obj->{$_} = $class->JSONObject2Perl($obj->{$_}) for (keys %$obj);
83         } elsif( $ref eq 'ARRAY' ) {
84                 $obj->[$_] = $class->JSONObject2Perl($obj->[$_]) for(0..scalar(@$obj) - 1);
85         }
86         return $obj;
87 }
88
89 sub perl2JSONObject {
90         my $class = shift;
91         my $obj = shift;
92         my $ref = ref($obj);
93
94         return $obj unless $ref;
95
96     return $obj if $ref eq 'JSON::XS::Boolean';
97         my $newobj;
98
99     if(UNIVERSAL::isa($obj, 'HASH')) {
100         $newobj = {};
101         $newobj->{$_} = $class->perl2JSONObject($obj->{$_}) for (keys %$obj);
102     } elsif(UNIVERSAL::isa($obj, 'ARRAY')) {
103         $newobj = [];
104         $newobj->[$_] = $class->perl2JSONObject($obj->[$_]) for(0..scalar(@$obj) - 1);
105     }
106
107     if($ref ne 'HASH' and $ref ne 'ARRAY') {
108                 $ref = $class->lookup_hint($ref) || $ref;
109                 $newobj = {$JSON_CLASS_KEY => $ref, $JSON_PAYLOAD_KEY => $newobj};
110     }
111
112         return $newobj; 
113 }
114
115
116 sub rawJSON2perl {
117         my $class = shift;
118     my $json = shift;
119     return undef unless defined $json and $json !~ /^\s*$/o;
120     return $parser->decode($json);
121 }
122
123 sub rawPerl2JSON {
124         my ($class, $perl) = @_;
125     return $parser->encode($perl);
126 }
127
128 1;