1521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# Copyright (C) 2013 Google Inc. All rights reserved. 2521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# 3521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# Redistribution and use in source and binary forms, with or without 4521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# modification, are permitted provided that the following conditions are 5521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# met: 6521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# 7521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# * Redistributions of source code must retain the above copyright 8521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# notice, this list of conditions and the following disclaimer. 9521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# * Redistributions in binary form must reproduce the above 10521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# copyright notice, this list of conditions and the following disclaimer 11521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# in the documentation and/or other materials provided with the 12521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# distribution. 13521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# * Neither the name of Google Inc. nor the names of its 14521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# contributors may be used to endorse or promote products derived from 15521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# this software without specific prior written permission. 16521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# 17521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 18521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 19521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 20521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 21521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 22521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 23521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 24521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 25521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 26521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 27521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) 29521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) 30521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# Converts the intermediate representation of IDLs between Perl and JSON, for: 31521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# 1. Modularity between parser and code generator; and 32521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)# 2. Piecemeal porting to Python, by letting us connect Perl and Python scripts. 33521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) 34521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)use strict; 35521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)use warnings; 36521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) 37521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)use Class::Struct; 38521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)use JSON -convert_blessed_universally; # IR contains objects (blessed references) 39521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) 40521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)sub serializeJSON 41521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles){ 42521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) my $document = shift; 43521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) my $json = JSON->new->utf8; 44521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) # JSON.pm defaults to dying on objects (blessed references) and returning 45521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) # keys in indeterminate order. We set options to change this: 46521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) # allow_blessed: don't die when encounter a blessed reference 47521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) # (but default to return null) 48521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) # convert_blessed: convert blessed reference as if unblessed 49521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) # (rather than returning null) 50521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) # canonical: sort keys when writing JSON, so JSON always in same order, 51521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) # so can compare output between runs or between Perl and Python 52521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) $json = $json->allow_blessed->convert_blessed->canonical(); 53521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) return $json->encode($document); 54521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)} 55521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) 56521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)sub deserializeJSON 57521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles){ 58521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) my $jsonText = shift; 59521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) my $json = JSON->new->utf8; 60521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) my $jsonHash = $json->decode($jsonText); 61521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) return jsonToPerl($jsonHash); 62521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)} 63521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) 64521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)sub jsonToPerl 65521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles){ 66521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) # JSON.pm serializes Perl objects as hashes (with keys CLASS::KEY), 67521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) # so we need to rebuild objects when deserializing 68521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) my $jsonData = shift; 69521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) 70521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) if (ref $jsonData eq "ARRAY") { 71521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) return [map(jsonToPerl($_), @$jsonData)]; 72521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) } 73521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) 74521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) if (ref $jsonData eq "HASH") { 75521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) my @keys = keys %$jsonData; 76521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) return {} unless @keys; 77521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) 78521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) my $class = determineClassFromKeys(@keys); 79521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) return jsonHashToPerlObject($jsonData, $class) if $class; 80521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) 81521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) # just a hash 82521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) my $hashRef = {}; 83521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) foreach my $key (@keys) { 84521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) $hashRef->{$key} = jsonToPerl($jsonData->{$key}); 85521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) } 86521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) return $hashRef; 87521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) } 88521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) 89521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) die "Unexpected reference type: " . ref $jsonData . "\n" if ref $jsonData; 90521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) 91521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) return $jsonData; 92521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)} 93521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) 94521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)sub determineClassFromKeys 95521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles){ 96521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) my @keys = shift; 97521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) 98521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) # Detect objects as hashes where all keys are of the form CLASS::KEY. 99521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) my $firstKey = $keys[0]; 100521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) my $isObject = $firstKey =~ /::/; 101521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) 102521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) return unless $isObject; 103521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) 104521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) my $class = (split('::', $firstKey))[0]; 105521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) return $class; 106521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)} 107521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) 108521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)sub jsonHashToPerlObject 109521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles){ 110521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) # JSON.pm serializes hash objects of class CLASS as a hash with keys 111521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) # CLASS::KEY1, CLASS::KEY2, etc. 112521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) # When deserializing, need to rebuild objects by stripping prefix 113521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) # and calling the constructor. 114521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) my $jsonHash = shift; 115521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) my $class = shift; 116521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) 117521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) my %keysValues = (); 118521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) foreach my $classAndKey (keys %{$jsonHash}) { 119521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) my $key = (split('::', $classAndKey))[1]; 120521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) $keysValues{$key} = jsonToPerl($jsonHash->{$classAndKey}); 121521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) } 122521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) my $object = $class->new(%keysValues); # Build object 123521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) return $object; 124521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)} 125521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles) 126521d96ec04ace82590870fb04353ec4f82bb150fTorne (Richard Coles)1; 127