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