LP#1285915: document that perl2JSON doesn't order hash keys
[OpenSRF.git] / src / perl / t / 09-Utils-JSON.t
1 #!perl -T
2 use strict;
3 use warnings;
4
5 use Test::More tests => 54;
6
7 use OpenSRF::Utils::JSON;
8
9
10 #
11 # initial state from use
12 #
13
14 # do we have a JSON::XS object?
15 is (ref $OpenSRF::Utils::JSON::parser,   'JSON::XS');
16
17 # make sure the class and payload keys are as expected
18 is ($OpenSRF::Utils::JSON::JSON_CLASS_KEY,   '__c');
19 is ($OpenSRF::Utils::JSON::JSON_PAYLOAD_KEY, '__p');
20
21 # start with the simplest bits possible
22 is (OpenSRF::Utils::JSON::true, 1);
23 is (OpenSRF::Utils::JSON->true, 1);
24 is (OpenSRF::Utils::JSON::false, 0);
25 is (OpenSRF::Utils::JSON->false, 0);
26
27
28 #
29 # register_class_hint
30 my $testmap =  { hints   => { osrfException =>
31                               { hint => 'osrfException',
32                                 name => 'OpenSRF::DomainObject::oilsException' }
33                             },
34                  classes => { 'OpenSRF::DomainObject::oilsException' =>
35                               { hint => 'osrfException',
36                                 name => 'OpenSRF::DomainObject::oilsException' }
37                             }
38                };
39 OpenSRF::Utils::JSON->register_class_hint( hint => 'osrfException',
40                                            name => 'OpenSRF::DomainObject::oilsException');
41 is_deeply (\%OpenSRF::Utils::JSON::_class_map, $testmap);
42
43
44 #
45 # lookup_class
46 is (OpenSRF::Utils::JSON->lookup_class('osrfException'), 'OpenSRF::DomainObject::oilsException');
47 is (OpenSRF::Utils::JSON->lookup_class(37), undef, "Argument doesn't exist");
48 is (OpenSRF::Utils::JSON->lookup_class(''), undef, "Null string lookup");
49 is (OpenSRF::Utils::JSON->lookup_class(), undef, "Null request");
50
51
52 #
53 # lookup_hint
54 is (OpenSRF::Utils::JSON->lookup_hint('OpenSRF::DomainObject::oilsException'), 'osrfException');
55 is (OpenSRF::Utils::JSON->lookup_hint(37), undef, "Argument doesn't exist");
56 is (OpenSRF::Utils::JSON->lookup_hint(''), undef, "Null string lookup");
57 is (OpenSRF::Utils::JSON->lookup_hint(), undef, "Null request");
58
59
60 #
61 # rawPerl2JSON
62 my $struct = [ { foo => 'bar' }, 'baz', 'quux', 'x'];
63 is (OpenSRF::Utils::JSON->rawPerl2JSON($struct),
64     '[{"foo":"bar"},"baz","quux","x"]');
65 is (OpenSRF::Utils::JSON->rawPerl2JSON(''), '""', "Null string as argument");
66
67
68 #
69 # rawJSON2perl
70 is_deeply (OpenSRF::Utils::JSON->rawJSON2perl(OpenSRF::Utils::JSON->rawPerl2JSON($struct)),
71            [ { foo => 'bar' }, 'baz', 'quux', 'x']);
72 is (OpenSRF::Utils::JSON->rawJSON2perl(), undef, "Null argument");
73 is (OpenSRF::Utils::JSON->rawJSON2perl(''), undef, "Null string as argument"); # note inconsistency with above
74
75
76 #
77 # perl2JSONObject
78 is (OpenSRF::Utils::JSON->perl2JSONObject(),      undef, "Returns argument unless it's a ref");
79 is (OpenSRF::Utils::JSON->perl2JSONObject(3),     3,     "Returns argument unless it's a ref");
80 is (OpenSRF::Utils::JSON->perl2JSONObject('foo'), 'foo', "Returns argument unless it's a ref");
81
82 ok (JSON::XS::is_bool(OpenSRF::Utils::JSON->true), 'OpenSRF::Utils::JSON->true is a Boolean according to JSON::XS');
83 ok (JSON::XS::is_bool(OpenSRF::Utils::JSON->false), 'OpenSRF::Utils::JSON->false is a Boolean according to JSON::XS');
84 ok (!JSON::XS::is_bool 1, "1 is not a boolean according to JSON::XS");
85 ok (!JSON::XS::is_bool 0, "0 is not a boolean according to JSON::XS");
86 is (OpenSRF::Utils::JSON->perl2JSONObject(OpenSRF::Utils::JSON->true), '1', "Returns argument if it's a Boolean according to JSON::XS");
87 is (OpenSRF::Utils::JSON->perl2JSONObject(OpenSRF::Utils::JSON->false), '0', "Returns argument if it's a Boolean according to JSON::XS");
88
89 my $hashref = { foo => 'bar' };
90 is (UNIVERSAL::isa($hashref,'HASH'), 1);
91 is_deeply (OpenSRF::Utils::JSON->perl2JSONObject($hashref), { foo => 'bar' }, "Passing in unblessed hashref");
92
93 my $arryref = [ 11, 12 ];
94 is (UNIVERSAL::isa($arryref,'ARRAY'), 1);
95 is_deeply (OpenSRF::Utils::JSON->perl2JSONObject($arryref), [ 11, 12 ], "Passing in unblessed arrayref");
96
97 my $coderef = sub { return 0 };            # this is almost certainly undesired behavior, but the
98 is (UNIVERSAL::isa($coderef,'CODE'), 1);   # code doesn't stop me from doing it
99 is_deeply (OpenSRF::Utils::JSON->perl2JSONObject($coderef),
100            { __c => 'CODE', __p => undef }, "Passing in coderef");
101
102 my $fakeobj = bless { foo => 'bar' }, 'OpenSRF::DomainObject::oilsException';
103 is (UNIVERSAL::isa($fakeobj,'HASH'), 1);
104 my $jsonobj = OpenSRF::Utils::JSON->perl2JSONObject($fakeobj);
105 is_deeply ($jsonobj, { __c => 'osrfException', __p => { foo => 'bar' } },
106            "Wrap object into an OpenSRF-shaped packet");
107
108
109 #
110 # perl2JSON
111 my $jsonstr = OpenSRF::Utils::JSON->perl2JSON($fakeobj);
112 ok (
113     ($jsonstr eq '{"__c":"osrfException","__p":{"foo":"bar"}}' ||
114      $jsonstr eq '{"__p":{"foo":"bar"},"__c":"osrfException"}'),
115     'JSON corresponds to Perl object (though hash key order by vary)'
116 );
117
118
119 #
120 # JSONObject2Perl
121 is (OpenSRF::Utils::JSON->JSONObject2Perl(),      undef, "Returns argument unless it's a ref");
122 is (OpenSRF::Utils::JSON->JSONObject2Perl(3),     3,     "Returns argument unless it's a ref");
123 is (OpenSRF::Utils::JSON->JSONObject2Perl('foo'), 'foo', "Returns argument unless it's a ref");
124 is (OpenSRF::Utils::JSON->JSONObject2Perl($coderef), $coderef, "Returns argument unless it's a ref");
125
126 is_deeply (OpenSRF::Utils::JSON->JSONObject2Perl([11, 12]), [11, 12], "Arrayrefs get reconstructed as themselves");
127 is_deeply (OpenSRF::Utils::JSON->JSONObject2Perl([11, OpenSRF::Utils::JSON->true, 12]), [11, OpenSRF::Utils::JSON->true, 12],
128            "Even when they contain JSON::XS Booleans; those just don't get recursed upon");
129            # note: [11, 1, 12] doesn't work here, even though you can do math on J::X Booleans
130
131 is_deeply (OpenSRF::Utils::JSON->JSONObject2Perl($hashref), { foo => 'bar' }, "Hashrefs without the class flag also get turned into themselves");
132 is_deeply (OpenSRF::Utils::JSON->JSONObject2Perl({ foo => OpenSRF::Utils::JSON->true, bar => 'baz' }), 
133            { foo => OpenSRF::Utils::JSON->true, bar => 'baz'},
134            "Even when they contain JSON::XS Booleans; those just don't get recursed upon");
135
136 my $vivobj = OpenSRF::Utils::JSON->JSONObject2Perl($jsonobj);
137 is (ref $vivobj, 'OpenSRF::DomainObject::oilsException');
138 is_deeply ($vivobj, { foo => 'bar' }, "perl2JSONObject-packaged things get blessed to their original contents and class");
139
140 my $codeobj = OpenSRF::Utils::JSON->perl2JSONObject($coderef);
141 is_deeply (OpenSRF::Utils::JSON->JSONObject2Perl($codeobj), undef, "Things with undefined payloads (see above)return undef");
142
143 $vivobj = OpenSRF::Utils::JSON->JSONObject2Perl({ __c => 'foo', __p => 'bar' });
144 is (ref $vivobj, 'foo');
145 is_deeply ($vivobj, \'bar', "Scalar payload and non-resolvable class hint vivifies to a scalar *ref* and a class of the class flag");
146
147
148 #
149 # json2Perl
150 my $perlobj = OpenSRF::Utils::JSON->JSON2perl($jsonstr);
151 is (ref $perlobj, 'OpenSRF::DomainObject::oilsException');
152 is_deeply ($perlobj,  { foo => 'bar' }, "Successful revivification from JSON in one step");