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.20';
   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 1;
  55
  56 __END__
  57
  58 =pod
  59
  60 =head1 NAME
  61
  62 MooseX::Storage::Basic - The simplest level of serialization
  63
  64 =head1 SYNOPSIS
  65
  66   package Point;
  67   use Moose;
  68   use MooseX::Storage;
  69
  70   our $VERSION = '0.01';
  71
  72   with Storage;
  73
  74   has 'x' => (is => 'rw', isa => 'Int');
  75   has 'y' => (is => 'rw', isa => 'Int');
  76
  77   1;
  78
  79   my $p = Point->new(x => 10, y => 10);
  80
  81   ## methods to pack/unpack an
  82   ## object in perl data structures
  83
  84   # pack the class into a hash
  85   $p->pack(); # { __CLASS__ => 'Point-0.01', x => 10, y => 10 }
  86
  87   # unpack the hash into a class
  88   my $p2 = Point->unpack({ __CLASS__ => 'Point-0.01', x => 10, y => 10 });
  89
  90   # unpack the hash, with insertion of paramaters
  91   my $p3 = Point->unpack( $p->pack, inject => { x => 11 } );
  92
  93 =head1 DESCRIPTION
  94
  95 This is the most basic form of serialization. This is used by default
  96 but the exported C<Storage> function.
  97
  98 =head1 METHODS
  99
 100 =over 4
 101
 102 =item B<pack ([ disable_cycle_check => 1])>
 103
 104 Providing the C<disable_cycle_check> argument disables checks for any cyclical
 105 references. The current implementation for this check is rather naive, so if
 106 you know what you are doing, you can bypass this check.
 107
 108 This trait is applied on a perl-case basis. To set this flag for all objects
 109 that inherit from this role, see L<MooseX::Storage::Traits::DisableCycleDetection>.
 110
 111 =item B<unpack ($data [, insert => { key => val, ... } ] )>
 112
 113 Providing the C<insert> argument let's you supply additional arguments to
 114 the class' C<new> function, or override ones from the serialized data.
 115
 116 =back
 117
 118 =head2 Introspection
 119
 120 =over 4
 121
 122 =item B<meta>
 123
 124 =back
 125
 126 =head1 BUGS
 127
 128 All complex software has bugs lurking in it, and this module is no
 129 exception. If you find a bug please either email me, or add the bug
 130 to cpan-RT.
 131
 132 =head1 AUTHOR
 133
 134 Chris Prather E<lt>chris.prather@iinteractive.comE<gt>
 135
 136 Stevan Little E<lt>stevan.little@iinteractive.comE<gt>
 137
 138 =head1 COPYRIGHT AND LICENSE
 139
 140 Copyright 2007-2008 by Infinity Interactive, Inc.
 141
 142 L<http://www.iinteractive.com>
 143
 144 This library is free software; you can redistribute it and/or modify
 145 it under the same terms as Perl itself.
 146
 147 =cut