File Coverage

blib/lib/MooseX/Storage/Format/JSON.pm
Criterion Covered Total %
statement 19 19 100.0
branch 3 4 75.0
condition 1 3 33.3
subroutine 6 6 100.0
pod 2 2 100.0
total 31 34 91.1


line stmt bran cond sub pod time code
1             package MooseX::Storage::Format::JSON;
2             # ABSTRACT: A JSON serialization role
3              
4             our $VERSION = '0.50';
5              
6 11     11   8426 use Moose::Role;
  11         22  
  11         93  
7 11     11   52049 use JSON::MaybeXS 1.001000;
  11         383  
  11         748  
8 11     11   54 use namespace::autoclean;
  11         24  
  11         162  
9              
10             requires 'pack';
11             requires 'unpack';
12              
13             sub thaw {
14 17     17 1 25366 my ( $class, $json, @args ) = @_;
15              
16             # TODO ugh! this is surely wrong and should be fixed.
17 17 100       91 utf8::encode($json) if utf8::is_utf8($json);
18              
19 17         149 $class->unpack( JSON::MaybeXS->new({ utf8 => 1 })->decode( $json), @args );
20             }
21              
22             sub freeze {
23 19     19 1 35874 my ( $self, @args ) = @_;
24              
25 19         205 my $json = JSON::MaybeXS->new({ utf8 => 1, canonical => 1 })->encode($self->pack(@args));
26              
27             # if it's valid utf8 mark it as such
28             # TODO ugh! this is surely wrong and should be fixed.
29 19 50 33     1907 utf8::decode($json) if !utf8::is_utf8($json) and utf8::valid($json);
30              
31 19         102 return $json;
32             }
33              
34 11     11   2363 no Moose::Role;
  11         22  
  11         44  
35              
36             1;
37              
38             __END__
39              
40             =pod
41              
42             =encoding UTF-8
43              
44             =head1 NAME
45              
46             MooseX::Storage::Format::JSON - A JSON serialization role
47              
48             =head1 VERSION
49              
50             version 0.50
51              
52             =head1 SYNOPSIS
53              
54             package Point;
55             use Moose;
56             use MooseX::Storage;
57              
58             with Storage('format' => 'JSON');
59              
60             has 'x' => (is => 'rw', isa => 'Int');
61             has 'y' => (is => 'rw', isa => 'Int');
62              
63             1;
64              
65             my $p = Point->new(x => 10, y => 10);
66              
67             ## methods to freeze/thaw into
68             ## a specified serialization format
69             ## (in this case JSON)
70              
71             # pack the class into a JSON string
72             $p->freeze(); # { "__CLASS__" : "Point", "x" : 10, "y" : 10 }
73              
74             # unpack the JSON string into a class
75             my $p2 = Point->thaw('{ "__CLASS__" : "Point", "x" : 10, "y" : 10 }');
76              
77             =head1 METHODS
78              
79             =over 4
80              
81             =item B<freeze>
82              
83             =item B<thaw ($json)>
84              
85             =back
86              
87             =head2 Introspection
88              
89             =over 4
90              
91             =item B<meta>
92              
93             =back
94              
95             =head1 BUGS
96              
97             All complex software has bugs lurking in it, and this module is no
98             exception. If you find a bug please or add the bug to cpan-RT
99             at L<https://rt.cpan.org/Dist/Display.html?Queue=MooseX-Storage>.
100              
101             =head1 AUTHORS
102              
103             =over 4
104              
105             =item *
106              
107             Chris Prather <chris.prather@iinteractive.com>
108              
109             =item *
110              
111             Stevan Little <stevan.little@iinteractive.com>
112              
113             =item *
114              
115             יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
116              
117             =back
118              
119             =head1 COPYRIGHT AND LICENSE
120              
121             This software is copyright (c) 2007 by Infinity Interactive, Inc..
122              
123             This is free software; you can redistribute it and/or modify it under
124             the same terms as the Perl 5 programming language system itself.
125              
126             =cut