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