src/perl/lib/OpenSRF/Utils/JSON.pm

   1 package OpenSRF::Utils::JSON;
   2 use JSON::XS;
   3
   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)
   7
   8 my %_class_map = ();
   9 my $JSON_CLASS_KEY = '__c';
  10 my $JSON_PAYLOAD_KEY = '__p';
  11
  12
  13 =head1 NAME
  14
  15 OpenSRF::Utils::JSON - Bucket-o-Routines for JSON
  16
  17 =head1 SYNOPSIS
  18
  19
  20
  21 =head1 ROUTINES
  22
  23 =head2 JSON2perl
  24
  25 =cut
  26
  27 sub JSON2perl {
  28     my( $class, $string ) = @_;
  29     my $perl = $class->rawJSON2perl($string);
  30     return $class->JSONObject2Perl($perl);
  31 }
  32
  33 =head2 perl2JSON
  34
  35 =cut
  36
  37 sub perl2JSON {
  38     my( $class, $obj ) = @_;
  39     my $json = $class->perl2JSONObject($obj);
  40     return $class->rawPerl2JSON($json);
  41 }
  42
  43 =head2 rawJSON2perl
  44
  45 =cut
  46
  47 sub rawJSON2perl {
  48     my $class = shift;
  49     my $json = shift;
  50     return undef unless defined $json and $json !~ /^\s*$/o;
  51     return $parser->decode($json);
  52 }
  53
  54 =head2 perl2JSON
  55
  56 =cut
  57
  58 sub rawPerl2JSON {
  59     my ($class, $perl) = @_;
  60     return $parser->encode($perl);
  61 }
  62
  63 sub JSONObject2Perl {
  64     my $class = shift;
  65     my $obj = shift;
  66     my $ref = ref($obj);
  67     if( $ref eq 'HASH' ) {
  68         if( defined($obj->{$JSON_CLASS_KEY})) {
  69             my $cls = $obj->{$JSON_CLASS_KEY};
  70             $cls =~ s/^\s+//o;
  71             $cls =~ s/\s+$//o;
  72             if( $obj = $class->JSONObject2Perl($obj->{$JSON_PAYLOAD_KEY}) ) {
  73                 $cls = $class->lookup_class($cls) || $cls;
  74                 return bless(\$obj, $cls) unless ref($obj);
  75                 return bless($obj, $cls);
  76             }
  77             return undef;
  78         }
  79         for my $k (keys %$obj) {
  80             $obj->{$k} = $class->JSONObject2Perl($obj->{$k})
  81               unless ref($obj->{$k}) eq 'JSON::XS::Boolean';
  82         }
  83     } elsif( $ref eq 'ARRAY' ) {
  84         for my $i (0..scalar(@$obj) - 1) {
  85             $obj->[$i] = $class->JSONObject2Perl($obj->[$i])
  86               unless ref($obj->[$i]) eq 'JSON::XS::Boolean';
  87         }
  88     }
  89     return $obj;
  90 }
  91
  92 sub perl2JSONObject {
  93     my $class = shift;
  94     my $obj = shift;
  95     my $ref = ref($obj);
  96
  97     return $obj unless $ref;
  98
  99     return $obj if $ref eq 'JSON::XS::Boolean';
 100     my $newobj;
 101
 102     if(UNIVERSAL::isa($obj, 'HASH')) {
 103         $newobj = {};
 104         $newobj->{$_} = $class->perl2JSONObject($obj->{$_}) for (keys %$obj);
 105     } elsif(UNIVERSAL::isa($obj, 'ARRAY')) {
 106         $newobj = [];
 107         $newobj->[$_] = $class->perl2JSONObject($obj->[$_]) for(0..scalar(@$obj) - 1);
 108     }
 109
 110     if($ref ne 'HASH' and $ref ne 'ARRAY') {
 111         $ref = $class->lookup_hint($ref) || $ref;
 112         $newobj = {$JSON_CLASS_KEY => $ref, $JSON_PAYLOAD_KEY => $newobj};
 113     }
 114
 115     return $newobj;
 116 }
 117
 118 sub true {
 119     return $parser->true();
 120 }
 121
 122 sub false {
 123     return $parser->false();
 124 }
 125
 126 sub register_class_hint {
 127     my $class = shift;
 128     my %args = @_;
 129     $_class_map{hints}{$args{hint}} = \%args;
 130     $_class_map{classes}{$args{name}} = \%args;
 131 }
 132
 133 sub lookup_class {
 134     my $self = shift;
 135     my $hint = shift;
 136     return $_class_map{hints}{$hint}{name}
 137 }
 138
 139 sub lookup_hint {
 140     my $self = shift;
 141     my $class = shift;
 142     return $_class_map{classes}{$class}{hint}
 143 }
 144
 145 sub _json_hint_to_class {
 146     my $type = shift;
 147     my $hint = shift;
 148
 149     return $_class_map{hints}{$hint}{name} if (exists $_class_map{hints}{$hint});
 150
 151     $type = 'hash' if ($type eq '}');
 152     $type = 'array' if ($type eq ']');
 153
 154         OpenSRF::Utils::JSON->register_class_hint(name => $hint, hint => $hint, type => $type);
 155
 156     return $hint;
 157 }
 158
 159 1;