Home | History | Annotate | Download | only in scripts 
      1 # Copyright (C) 2013 Google Inc. All rights reserved.
      2 #
      3 # Redistribution and use in source and binary forms, with or without
      4 # modification, are permitted provided that the following conditions are
      5 # met:
      6 #
      7 #     * Redistributions of source code must retain the above copyright
      8 # notice, this list of conditions and the following disclaimer.
      9 #     * Redistributions in binary form must reproduce the above
     10 # copyright notice, this list of conditions and the following disclaimer
     11 # in the documentation and/or other materials provided with the
     12 # distribution.
     13 #     * Neither the name of Google Inc. nor the names of its
     14 # contributors may be used to endorse or promote products derived from
     15 # this software without specific prior written permission.
     16 #
     17 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
     18 # "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
     19 # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
     20 # A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
     21 # OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
     22 # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
     23 # LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
     24 # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
     25 # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
     26 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
     27 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
     28 
     29 
     30 # Converts the intermediate representation of IDLs between Perl and JSON, for:
     31 # 1. Modularity between parser and code generator; and
     32 # 2. Piecemeal porting to Python, by letting us connect Perl and Python scripts.
     33 
     34 use strict;
     35 use warnings;
     36 
     37 use Class::Struct;
     38 use JSON -convert_blessed_universally;  # IR contains objects (blessed references)
     39 
     40 sub serializeJSON
     41 {
     42     my $document = shift;
     43     my $json = JSON->new->utf8;
     44     # JSON.pm defaults to dying on objects (blessed references) and returning
     45     # keys in indeterminate order. We set options to change this:
     46     # allow_blessed: don't die when encounter a blessed reference
     47     #                (but default to return null)
     48     # convert_blessed: convert blessed reference as if unblessed
     49     #                  (rather than returning null)
     50     # canonical: sort keys when writing JSON, so JSON always in same order,
     51     #            so can compare output between runs or between Perl and Python
     52     $json = $json->allow_blessed->convert_blessed->canonical();
     53     return $json->encode($document);
     54 }
     55 
     56 sub deserializeJSON
     57 {
     58     my $jsonText = shift;
     59     my $json = JSON->new->utf8;
     60     my $jsonHash = $json->decode($jsonText);
     61     return jsonToPerl($jsonHash);
     62 }
     63 
     64 sub jsonToPerl
     65 {
     66     # JSON.pm serializes Perl objects as hashes (with keys CLASS::KEY),
     67     # so we need to rebuild objects when deserializing
     68     my $jsonData = shift;
     69 
     70     if (ref $jsonData eq "ARRAY") {
     71         return [map(jsonToPerl($_), @$jsonData)];
     72     }
     73 
     74     if (ref $jsonData eq "HASH") {
     75         my @keys = keys %$jsonData;
     76         return {} unless @keys;
     77 
     78         my $class = determineClassFromKeys(@keys);
     79         return jsonHashToPerlObject($jsonData, $class) if $class;
     80 
     81         # just a hash
     82         my $hashRef = {};
     83         foreach my $key (@keys) {
     84             $hashRef->{$key} = jsonToPerl($jsonData->{$key});
     85         }
     86         return $hashRef;
     87     }
     88 
     89     die "Unexpected reference type: " . ref $jsonData . "\n" if ref $jsonData;
     90 
     91     return $jsonData;
     92 }
     93 
     94 sub determineClassFromKeys
     95 {
     96     my @keys = shift;
     97 
     98     # Detect objects as hashes where all keys are of the form CLASS::KEY.
     99     my $firstKey = $keys[0];
    100     my $isObject = $firstKey =~ /::/;
    101 
    102     return unless $isObject;
    103 
    104     my $class = (split('::', $firstKey))[0];
    105     return $class;
    106 }
    107 
    108 sub jsonHashToPerlObject
    109 {
    110     # JSON.pm serializes hash objects of class CLASS as a hash with keys
    111     # CLASS::KEY1, CLASS::KEY2, etc.
    112     # When deserializing, need to rebuild objects by stripping prefix
    113     # and calling the constructor.
    114     my $jsonHash = shift;
    115     my $class = shift;
    116 
    117     my %keysValues = ();
    118     foreach my $classAndKey (keys %{$jsonHash}) {
    119         my $key = (split('::', $classAndKey))[1];
    120         $keysValues{$key} = jsonToPerl($jsonHash->{$classAndKey});
    121     }
    122     my $object = $class->new(%keysValues);  # Build object
    123     return $object;
    124 }
    125 
    126 1;
    127