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