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