make EOL tests pass
[gitmo/MooseX-Storage.git] / lib / MooseX / Storage / Format / JSON.pm
1 package MooseX::Storage::Format::JSON;
2 use Moose::Role;
3
4 no warnings 'once';
5
6 use JSON::Any;
7 use utf8 ();
8
9 requires 'pack';
10 requires 'unpack';
11
12 sub thaw {
13     my ( $class, $json, @args ) = @_;
14     utf8::encode($json) if utf8::is_utf8($json);
15     $class->unpack( JSON::Any->new->jsonToObj($json), @args );
16 }
17
18 sub freeze {
19     my ( $self, @args ) = @_;
20     my $json = JSON::Any->new(canonical => 1)->objToJson( $self->pack(@args) );
21     utf8::decode($json) if !utf8::is_utf8($json) and utf8::valid($json); # if it's valid utf8 mark it as such
22     return $json;
23 }
24
25 no Moose::Role;
26
27 1;
28
29 __END__
30
31 =pod
32
33 =head1 NAME
34
35 MooseX::Storage::Format::JSON - A JSON serialization role
36
37 =head1 SYNOPSIS
38
39   package Point;
40   use Moose;
41   use MooseX::Storage;
42
43   with Storage('format' => 'JSON');
44
45   has 'x' => (is => 'rw', isa => 'Int');
46   has 'y' => (is => 'rw', isa => 'Int');
47
48   1;
49
50   my $p = Point->new(x => 10, y => 10);
51
52   ## methods to freeze/thaw into
53   ## a specified serialization format
54   ## (in this case JSON)
55
56   # pack the class into a JSON string
57   $p->freeze(); # { "__CLASS__" : "Point", "x" : 10, "y" : 10 }
58
59   # unpack the JSON string into a class
60   my $p2 = Point->thaw('{ "__CLASS__" : "Point", "x" : 10, "y" : 10 }');
61
62 =head1 METHODS
63
64 =over 4
65
66 =item B<freeze>
67
68 =item B<thaw ($json)>
69
70 =back
71
72 =head2 Introspection
73
74 =over 4
75
76 =item B<meta>
77
78 =back
79
80 =head1 BUGS
81
82 All complex software has bugs lurking in it, and this module is no
83 exception. If you find a bug please either email me, or add the bug
84 to cpan-RT.
85
86 =head1 AUTHOR
87
88 Chris Prather E<lt>chris.prather@iinteractive.comE<gt>
89
90 Stevan Little E<lt>stevan.little@iinteractive.comE<gt>
91
92 Yuval Kogman E<lt>yuval.kogman@iinteractive.comE<gt>
93
94 =head1 COPYRIGHT AND LICENSE
95
96 Copyright 2007-2008 by Infinity Interactive, Inc.
97
98 L<http://www.iinteractive.com>
99
100 This library is free software; you can redistribute it and/or modify
101 it under the same terms as Perl itself.
102
103 =cut
104
105