lib/MooseX/Storage/Basic.pm

   1 package MooseX::Storage::Basic;
   2 use Moose::Role;
   3
   4 use MooseX::Storage::Engine;
   5
   6 our $VERSION   = '0.27';
   7 our $AUTHORITY = 'cpan:STEVAN';
   8
   9 sub pack {
  10     my ( $self, %args ) = @_;
  11     my $e = $self->_storage_get_engine_class(%args)->new( object => $self );
  12     $e->collapse_object(%args);
  13 }
  14
  15 sub unpack {
  16     my ($class, $data, %args) = @_;
  17     my $e = $class->_storage_get_engine_class(%args)->new(class => $class);
  18
  19     $class->_storage_construct_instance(
  20         $e->expand_object($data, %args),
  21         \%args
  22     );
  23 }
  24
  25 sub _storage_get_engine_class {
  26     my ($self, %args) = @_;
  27
  28     my $default = 'MooseX::Storage::Engine';
  29
  30     return $default
  31         unless (
  32             exists $args{engine_traits}
  33          && ref($args{engine_traits}) eq 'ARRAY'
  34          && scalar(@{$args{engine_traits}})
  35     );
  36
  37     my @roles = map { sprintf("%s::Trait::%s", $default, $_) }
  38         @{$args{engine_traits}};
  39
  40     Moose::Meta::Class->create_anon_class(
  41         superclasses => [$default],
  42         roles => [ @roles ],
  43         cache => 1,
  44     )->name;
  45 }
  46
  47 sub _storage_construct_instance {
  48     my ($class, $args, $opts) = @_;
  49     my %i = defined $opts->{'inject'} ? %{ $opts->{'inject'} } : ();
  50
  51     $class->new( %$args, %i );
  52 }
  53
  54 no Moose::Role;
  55
  56 1;
  57
  58 __END__
  59
  60 =pod
  61
  62 =head1 NAME
  63
  64 MooseX::Storage::Basic - The simplest level of serialization
  65
  66 =head1 SYNOPSIS
  67
  68   package Point;
  69   use Moose;
  70   use MooseX::Storage;
  71
  72   our $VERSION = '0.01';
  73
  74   with Storage;
  75
  76   has 'x' => (is => 'rw', isa => 'Int');
  77   has 'y' => (is => 'rw', isa => 'Int');
  78
  79   1;
  80
  81   my $p = Point->new(x => 10, y => 10);
  82
  83   ## methods to pack/unpack an
  84   ## object in perl data structures
  85
  86   # pack the class into a hash
  87   $p->pack(); # { __CLASS__ => 'Point-0.01', x => 10, y => 10 }
  88
  89   # unpack the hash into a class
  90   my $p2 = Point->unpack({ __CLASS__ => 'Point-0.01', x => 10, y => 10 });
  91
  92   # unpack the hash, with insertion of paramaters
  93   my $p3 = Point->unpack( $p->pack, inject => { x => 11 } );
  94
  95 =head1 DESCRIPTION
  96
  97 This is the most basic form of serialization. This is used by default
  98 but the exported C<Storage> function.
  99
 100 =head1 METHODS
 101
 102 =over 4
 103
 104 =item B<pack ([ disable_cycle_check => 1])>
 105
 106 Providing the C<disable_cycle_check> argument disables checks for any cyclical
 107 references. The current implementation for this check is rather naive, so if
 108 you know what you are doing, you can bypass this check.
 109
 110 This trait is applied on a perl-case basis. To set this flag for all objects
 111 that inherit from this role, see L<MooseX::Storage::Traits::DisableCycleDetection>.
 112
 113 =item B<unpack ($data [, insert => { key => val, ... } ] )>
 114
 115 Providing the C<insert> argument let's you supply additional arguments to
 116 the class' C<new> function, or override ones from the serialized data.
 117
 118 =back
 119
 120 =head2 Introspection
 121
 122 =over 4
 123
 124 =item B<meta>
 125
 126 =back
 127
 128 =head1 BUGS
 129
 130 All complex software has bugs lurking in it, and this module is no
 131 exception. If you find a bug please either email me, or add the bug
 132 to cpan-RT.
 133
 134 =head1 AUTHOR
 135
 136 Chris Prather E<lt>chris.prather@iinteractive.comE<gt>
 137
 138 Stevan Little E<lt>stevan.little@iinteractive.comE<gt>
 139
 140 =head1 COPYRIGHT AND LICENSE
 141
 142 Copyright 2007-2008 by Infinity Interactive, Inc.
 143
 144 L<http://www.iinteractive.com>
 145
 146 This library is free software; you can redistribute it and/or modify
 147 it under the same terms as Perl itself.
 148
 149 =cut