Chromium Code Reviews| 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 # Convert the intermediate representation of IDLs between Perl and JSON, for: | |
|
dominicc (has gone to gerrit)
2013/06/12 13:39:53
Convert => Converts
since this is just a library;
Nils Barth (inactive)
2013/06/13 04:33:38
Done.
| |
| 31 # 1. Modularity between frontend parser and backend code generator; and | |
|
dominicc (has gone to gerrit)
2013/06/12 13:39:53
frontend parser => parser
backend code generator =
Nils Barth (inactive)
2013/06/13 04:33:38
Done.
(I've been using "Frontend" b/c in Python,
| |
| 32 # 2. Porting to Python, so can connect Perl scripts and Python scripts. | |
|
dominicc (has gone to gerrit)
2013/06/12 13:39:53
"so can connect" is ungrammatical; maybe
Piecemea
Nils Barth (inactive)
2013/06/13 04:33:38
Done.
| |
| 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 | |
| 41 sub serializeJSON | |
| 42 { | |
| 43 my $document = shift; | |
| 44 my $json = JSON->new->utf8; | |
| 45 # JSON.pm defaults to dying on objects (blessed references) and returning | |
|
dominicc (has gone to gerrit)
2013/06/12 13:39:53
Nice comment.
| |
| 46 # keys in indeterminate order. We set options to change this: | |
| 47 # allow_blessed: don't die when encounter a blessed reference | |
| 48 # (but default to return null) | |
| 49 # convert_blessed: convert blessed reference as if unblessed | |
| 50 # (rather than returning null) | |
| 51 # canonical: sort keys when writing JSON, so JSON always in same order, | |
| 52 # so can compare output between runs or between Perl and Python | |
| 53 $json = $json->allow_blessed->convert_blessed->canonical(); | |
| 54 return $json->encode($document); | |
| 55 } | |
| 56 | |
| 57 sub deserializeJSON | |
| 58 { | |
| 59 my $jsonText = shift; | |
| 60 my $json = JSON->new->utf8; | |
| 61 my $jsonHash = $json->decode($jsonText); | |
| 62 return jsonToPerl($jsonHash); | |
| 63 } | |
| 64 | |
| 65 sub jsonToPerl | |
| 66 { | |
| 67 # JSON.pm serializes Perl objects as a type of hash, so need to rebuild | |
|
dominicc (has gone to gerrit)
2013/06/12 13:39:53
type of hash => hash
is simpler and no less preci
Nils Barth (inactive)
2013/06/13 04:33:38
I've reworded;
point is that it's a hash of a cert
| |
| 68 # objects when deserializing | |
| 69 my $jsonData = shift; | |
| 70 | |
| 71 if (ref $jsonData eq "ARRAY") { | |
| 72 my $perlData = []; | |
|
dominicc (has gone to gerrit)
2013/06/12 13:39:53
Ich nicht bin ein Perliner, but could this just be
Nils Barth (inactive)
2013/06/13 04:33:38
Good point, done!
Perl being Perl, syntax is actu
| |
| 73 foreach my $element (@$jsonData) { | |
| 74 push(@$perlData, jsonToPerl($element)); | |
| 75 } | |
| 76 return $perlData; | |
| 77 } | |
| 78 | |
| 79 if (ref $jsonData eq "HASH") { | |
| 80 my @keys = keys %$jsonData; | |
| 81 return {} unless @keys; | |
| 82 | |
| 83 my $class = determineClassFromKeys(@keys); | |
| 84 return jsonHashToPerlObject($jsonData, $class) if $class; | |
| 85 | |
| 86 # just a hash | |
| 87 my $hashRef = {}; | |
| 88 foreach my $key (@keys) { | |
| 89 $hashRef->{$key} = jsonToPerl($jsonData->{$key}); | |
| 90 } | |
| 91 return $hashRef; | |
| 92 } | |
| 93 | |
| 94 die "Unexpected reference type: " . ref $jsonData . "\n" if ref $jsonData; | |
| 95 | |
| 96 return $jsonData; | |
| 97 } | |
| 98 | |
| 99 sub determineClassFromKeys | |
| 100 { | |
| 101 my @keys = shift; | |
| 102 | |
| 103 # Detect objects as hashes where all keys are of the form CLASS::KEY. | |
| 104 # One exception: overloadedIndex is not part of domFunction struct, | |
| 105 # (just a hash key, not an object member), so need to special case. | |
| 106 my $firstKey = $keys[0]; | |
| 107 $firstKey = $keys[1] if $firstKey eq "overloadedIndex"; | |
| 108 my $isObject = $firstKey =~ /::/; | |
| 109 | |
| 110 return unless $isObject; | |
| 111 | |
| 112 my $class = (split('::', $firstKey))[0]; | |
| 113 return $class; | |
| 114 } | |
| 115 | |
| 116 sub jsonHashToPerlObject | |
| 117 { | |
| 118 # JSON.pm serializes hash objects of class CLASS as a hash with keys | |
| 119 # CLASS::KEY1, CLASS::KEY2, etc. | |
| 120 # When deserializing, need to rebuild objects by stripping prefix | |
| 121 # and calling the constructor. | |
| 122 my $jsonHash = shift; | |
| 123 my $class = shift; | |
| 124 | |
| 125 my %keysValues = (); | |
| 126 foreach my $classAndKey (keys %{$jsonHash}) { | |
| 127 next if $classAndKey eq "overloadedIndex"; | |
| 128 my $key = (split('::', $classAndKey))[1]; | |
| 129 $keysValues{$key} = jsonToPerl($jsonHash->{$classAndKey}); | |
| 130 } | |
| 131 my $object = $class->new(%keysValues); # Build object | |
| 132 # overloadedIndex not part of constructor; add separately | |
| 133 $object->{overloadedIndex} = $jsonHash->{overloadedIndex} if exists $jsonHas h->{overloadedIndex}; | |
| 134 return $object; | |
| 135 } | |
| 136 | |
| 137 1; | |
| OLD | NEW |