File Coverage

blib/lib/JSON/Typist.pm
Criterion Covered Total %
statement 55 63 87.3
branch 16 22 72.7
condition 9 12 75.0
subroutine 16 18 88.8
pod 5 5 100.0
total 101 120 84.1


line stmt bran cond sub pod time code
1 2     2   92527 use strict;
  2         9  
  2         61  
2 2     2   12 use warnings;
  2         3  
  2         114  
3              
4             package JSON::Typist;
5             # ABSTRACT: replace mushy strings and numbers with rigidly typed replacements
6             $JSON::Typist::VERSION = '0.007';
7             #pod =head1 OVERVIEW
8             #pod
9             #pod JSON is super useful and everybody loves it. Woo! Go JSON! Good job!
10             #pod
11             #pod In Perl, though, it's a bit of a pain sometimes. In Perl, strings and numbers
12             #pod mush all together and you're often not sure which you have. Did the C<5> in
13             #pod your C<$x> come from C<{"x":5}> or C<{"x":"5"}>? By the time you're checking,
14             #pod you very well may not know.
15             #pod
16             #pod Often, that's just fine, because it doesn't matter inside your Perl program,
17             #pod where numericality and stringicity are determined by operators, not values.
18             #pod Other times, you need to know. You might using JSON for interchange with a
19             #pod system that needs its types in its values. JSON::Typist is meant for this
20             #pod problem.
21             #pod
22             #pod L (in its many variant forms) always returns numbers and strings in
23             #pod distinguishable forms, but the distinction can be lost as the variables are
24             #pod used. (That's just a weird-o Perl problem.) JSON::Typist is meant to take the
25             #pod result of JSON-decoding I before you use it for anything else. It
26             #pod replaces numbers and strings with objects. These objects can be used like
27             #pod numbers and strings, and JSON will convert them to the right type if
28             #pod C is enabled.
29             #pod
30             #pod =head1 SYNOPSIS
31             #pod
32             #pod my $content = q<{ "number": 5, "string": "5" }>;
33             #pod
34             #pod my $json = JSON->new->convert_blessed->canonical;
35             #pod
36             #pod my $payload = $json->decode( $content );
37             #pod my $typed = JSON::Typist->new->apply_types( $payload );
38             #pod
39             #pod $typed->{string}->isa('JSON::Typist::String'); #true
40             #pod $typed->{number}->isa('JSON::Typist::Number'); # true
41             #pod
42             #pod say 0 + $payload->{string}; # prints 5
43             #pod say "$payload->{number}"; # prints 5
44             #pod
45             #pod say 0 + $typed->{string}; # prints 5
46             #pod say "$typed->{number}"; # prints 5
47             #pod
48             #pod say $json->encode($payload);
49             #pod say $json->encode($typed);
50             #pod
51             #pod =cut
52              
53 2     2   11 use B ();
  2         4  
  2         37  
54 2     2   1063 use Params::Util qw(_HASH0 _ARRAY0);
  2         9413  
  2         485  
55 2     2   16 use Scalar::Util qw(blessed);
  2         4  
  2         171  
56              
57             {
58             package JSON::Typist::Number;
59             $JSON::Typist::Number::VERSION = '0.007';
60 2     2   13 use overload '0+' => sub { ${ $_[0] } }, fallback => 1;
  2     6   4  
  2         17  
  6         2872  
  6         28  
61 8     8   46 sub new { my $x = $_[1]; bless \$x, $_[0] }
  8         47  
62 2     2   463 sub TO_JSON { 0 + ${$_[0]} }
  2         10  
63             }
64              
65             {
66             package JSON::Typist::String;
67             $JSON::Typist::String::VERSION = '0.007';
68 2     2   358 use overload '""' => sub { ${ $_[0] } }, fallback => 1;
  2     7   5  
  2         22  
  7         2376  
  7         40  
69 8     8   16 sub new { my $x = $_[1]; bless \$x, $_[0] }
  8         44  
70 1     1   50 sub TO_JSON { "${$_[0]}" }
  1         4  
71             }
72              
73             #pod =method new
74             #pod
75             #pod my $typist = JSON::Typist->new( \%arg );
76             #pod
77             #pod This returns a new JSON::Typist. There are no valid arguments to C yet.
78             #pod
79             #pod =cut
80              
81             sub new {
82 4     4 1 95490 my ($class) = @_;
83              
84 4         15 bless {}, $class;
85             }
86              
87             #pod =method apply_types
88             #pod
89             #pod my $typed = $json_typist->apply_types( $data );
90             #pod
91             #pod This returns a new variables that deeply copies the input C<$data>, replacing
92             #pod numbers and strings with objects. The logic used to test for number-or-string
93             #pod is subject to change, but is meant to track the logic used by JSON.pm and
94             #pod related JSON libraries. The behavior on weird-o scalars like globs I
95             #pod undefined>.
96             #pod
97             #pod Note that property names, which becomes hash keys, do not become objects. Hash
98             #pod keys are always strings.
99             #pod
100             #pod Strings become JSON::Typist::String objects. Numbers becomes
101             #pod JSON::Typist::Number objects.
102             #pod
103             #pod =cut
104              
105             sub apply_types {
106 18     18 1 4042 my ($self, $data) = @_;
107              
108 18 50       44 return $data unless defined $data;
109 18 100       41 unless (ref $data) {
110 7         41 my $b_obj = B::svref_2object(\$data); # for round trip problem
111 7         32 my $flags = $b_obj->FLAGS;
112 7 100 66     32 if ($flags & ( B::SVp_IOK | B::SVp_NOK ) and !( $flags & B::SVp_POK )) {
113 3         11 return JSON::Typist::Number->new($data);
114             } else {
115 4         24 return JSON::Typist::String->new($data);
116             }
117             }
118              
119 11 100 66     80 return JSON::Typist::Number->new($data)
      100        
120             if blessed $data
121             && ($data->isa('Math::BigInt') || $data->isa('Math::BigFloat'));
122              
123 10 50       37 return [ map {; $self->apply_types($_) } @$data ] if _ARRAY0($data);
  0         0  
124              
125 10 100       40 return { map {; $_ => $self->apply_types($data->{$_}) } keys %$data }
  13         38  
126             if _HASH0($data);
127              
128 5         15 return $data;
129             }
130              
131             #pod =method strip_types
132             #pod
133             #pod my $untyped = $json_typist->strip_types;
134             #pod
135             #pod This method deeply copies its input, replacing number and string objects with
136             #pod simple scalars that should become the proper JSON type. Using this method
137             #pod should not be needed if your JSON decoder has C enabled.
138             #pod
139             #pod Right now, boolean objects are left in place, because they will be there from
140             #pod JSON's behavior, not JSON::Typist. This may change in the future.
141             #pod
142             #pod =cut
143              
144             sub strip_types {
145 5     5 1 608 my ($self, $data) = @_;
146              
147 5 50       16 return $data unless defined $data;
148              
149 5 100       75 if (blessed $data) {
150 3 50 66     33 return $$data if $data->isa('JSON::Typist::Number')
151             or $data->isa('JSON::Typist::String');
152              
153 0         0 return $data;
154             }
155              
156 2 50       10 return [ map {; $self->strip_types($_) } @$data ] if _ARRAY0($data);
  0         0  
157              
158 2 50       24 return { map {; $_ => $self->strip_types($data->{$_}) } keys %$data }
  3         13  
159             if _HASH0($data);
160              
161 0           return $data;
162             }
163              
164             #pod =method number
165             #pod
166             #pod =method string
167             #pod
168             #pod my $jnum = $typist->number(123);
169             #pod my $jstr = $typist->string(123);
170             #pod
171             #pod These methods returns the same sorts of objects that would be returned in a
172             #pod typed JSON structure from C.
173             #pod
174             #pod =cut
175              
176 0     0 1   sub number { my ($self, $value) = @_; JSON::Typist::Number->new($value) }
  0            
177 0     0 1   sub string { my ($self, $value) = @_; JSON::Typist::String->new($value) }
  0            
178              
179             1;
180              
181             __END__