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