| OLD | NEW | 
|---|
|  | (Empty) | 
| 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 reference
     s) |  | 
| 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; |  | 
| OLD | NEW | 
|---|