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 # Library to convert the Perl Intermediate Representation (IR) of IDLs | |
| 31 # to and from JSON, for: | |
| 32 # 1. Modularity between frontend parser and backend code generator; | |
| 33 # 2. Porting to Python, so can connect Perl scripts and Python scripts. | |
| 34 | |
| 35 package IRToFromJSON; | |
|
haraken
2013/06/12 03:20:21
I'd call this JSONSerializer.pm. IR sounds unclear
Nils Barth (inactive)
2013/06/12 03:57:43
Done.
| |
| 36 | |
| 37 use strict; | |
| 38 use warnings; | |
| 39 | |
| 40 require Exporter; | |
| 41 use vars qw(@ISA @EXPORT_OK); | |
| 42 @ISA = qw(Exporter); | |
| 43 @EXPORT_OK = qw(IRToJSON JSONToIR); | |
|
haraken
2013/06/12 03:20:21
I'd remove the code for controlling exports. You c
Nils Barth (inactive)
2013/06/12 03:57:43
Done.
| |
| 44 | |
| 45 use Class::Struct; | |
| 46 use JSON -convert_blessed_universally; # IR contains blessed references | |
| 47 use Data::Dumper; | |
|
haraken
2013/06/12 03:20:21
Remove this.
Nils Barth (inactive)
2013/06/12 03:57:43
Oops (>.<)
Done.
| |
| 48 | |
| 49 use IDLParser; | |
|
haraken
2013/06/12 03:20:21
Remove this.
Nils Barth (inactive)
2013/06/12 03:57:43
Ok.
Needed so we have classes for object construct
| |
| 50 | |
| 51 | |
| 52 sub IRToJSON | |
|
haraken
2013/06/12 03:20:21
SerializeJSON might be a better name.
Nils Barth (inactive)
2013/06/12 03:57:43
Done.
| |
| 53 { | |
| 54 my $document = shift; | |
| 55 my $json = JSON->new->utf8; | |
| 56 # Blessed references for objects, canonical to order (so can compare) | |
|
dominicc (has gone to gerrit)
2013/06/11 22:56:30
What does this mean?
"Blessed references for obje
Nils Barth (inactive)
2013/06/12 02:56:12
Clarified.
| |
| 57 $json = $json->allow_blessed->convert_blessed->canonical(); | |
| 58 return $json->encode($document); | |
| 59 } | |
| 60 | |
| 61 sub rawIRToCleanIR | |
|
dominicc (has gone to gerrit)
2013/06/11 22:56:30
How about a brief comment (one line) explaining wh
Nils Barth (inactive)
2013/06/12 02:56:12
I've renamed "rawIR" and "cleanIR" to "jsonIR" and
| |
| 62 { | |
| 63 my $rawIR = shift; | |
| 64 if (ref $rawIR eq "ARRAY") { | |
| 65 my $cleanIR = []; | |
| 66 foreach my $element (@$rawIR) { | |
| 67 push(@$cleanIR, rawIRToCleanIR($element)); | |
| 68 } | |
| 69 return $cleanIR; | |
| 70 } | |
| 71 if (ref $rawIR eq "HASH") { | |
| 72 if (!scalar %{$rawIR}) { | |
| 73 return {}; | |
| 74 } | |
| 75 # overloadedIndex is not part of domFunction struct, | |
| 76 # (just a hash key, not an object member), so special case | |
| 77 my $overload = -1; | |
| 78 my $classAndKeyFirst = (keys %{$rawIR})[0]; | |
|
dominicc (has gone to gerrit)
2013/06/11 22:56:30
I think this code can be made much simpler.
This
Nils Barth (inactive)
2013/06/12 02:56:12
Rewritten, with helper function.
It's still a bit
| |
| 79 if ($classAndKeyFirst eq "overloadedIndex") { | |
|
dominicc (has gone to gerrit)
2013/06/11 22:56:30
Why special-case overloadedIndex *only* if it is t
Nils Barth (inactive)
2013/06/12 02:56:12
We're just looking for the class name here, so we
| |
| 80 $overload = $rawIR->{$classAndKeyFirst}; | |
| 81 $classAndKeyFirst = (keys %{$rawIR})[1]; | |
| 82 } | |
| 83 (my $class, my $firstKey) = (split('::', $classAndKeyFirst)); | |
| 84 my $keysValuesRef = {}; | |
| 85 if ($class ne $classAndKeyFirst) { # object | |
|
dominicc (has gone to gerrit)
2013/06/11 22:56:30
I'm having trouble understanding this. It looks li
Nils Barth (inactive)
2013/06/12 02:56:12
This tests if the splitting achieved anything (i.e
| |
| 86 foreach my $classAndKey (keys %{$rawIR}) { | |
| 87 if ($classAndKey eq "overloadedIndex") { | |
| 88 $overload = $rawIR->{$classAndKey}; | |
| 89 } else { | |
| 90 (my $newClass, my $key) = split('::', $classAndKey); | |
| 91 $keysValuesRef->{$key} = rawIRToCleanIR($rawIR->{$classAndKe y}); | |
| 92 } | |
| 93 } | |
| 94 my $object = $class->new(%$keysValuesRef); # Build object | |
| 95 if ($overload != -1) { | |
| 96 $object->{overloadedIndex} = $overload; | |
| 97 } | |
| 98 return $object; | |
| 99 } else { # just hash | |
| 100 foreach my $key (keys %{$rawIR}) { | |
| 101 $keysValuesRef->{$key} = rawIRToCleanIR($rawIR->{$key}); | |
| 102 } | |
| 103 return $keysValuesRef; | |
| 104 } | |
| 105 } | |
| 106 die "Unexpected reference type: " . ref $rawIR . "\n" if ref $rawIR; | |
| 107 return $rawIR; | |
| 108 } | |
| 109 | |
| 110 sub JSONToIR | |
|
haraken
2013/06/12 03:20:21
deserializeJSON might be a better name.
| |
| 111 { | |
| 112 my $jsonText = shift; | |
| 113 my $json = JSON->new->utf8; | |
| 114 my $rawIR = $json->decode($jsonText); | |
| 115 return rawIRToCleanIR($rawIR); | |
| 116 } | |
| 117 | |
| 118 1; | |
| OLD | NEW |