# serialization format
'JSON::Any' => '0',
'Best' => '0', # << this if for loading YAML
+ 'Storable' => '0',
# and the ability to save the
# file to disk
'IO::File' => '0',
Revision history for MooseX-Storage
-0.07
+0.07 Thurs. Sept. 27, 2007
+ + MooseX::Storage::Format::Storable
+ - this will use Storable to freeze/thaw objects
+ - added tests for this
+
+ + MooseX::Storage::IO::StorableFile
+ - this will use Storable to load/store objects
+ - added tests for this
* t/
- fixed tests in 030_with_checksum.t
Build.PL
Changes
-META.yml
Makefile.PL
+META.yml
MANIFEST
MANIFEST.SKIP
README
lib/MooseX/Storage.pm
lib/MooseX/Storage/Basic.pm
-lib/MooseX/Storage/Base/WithChecksum.pm
lib/MooseX/Storage/Engine.pm
+lib/MooseX/Storage/Util.pm
+lib/MooseX/Storage/Base/WithChecksum.pm
lib/MooseX/Storage/Engine/IO/AtomicFile.pm
lib/MooseX/Storage/Engine/IO/File.pm
lib/MooseX/Storage/Format/JSON.pm
+lib/MooseX/Storage/Format/Storable.pm
lib/MooseX/Storage/Format/YAML.pm
lib/MooseX/Storage/IO/AtomicFile.pm
lib/MooseX/Storage/IO/File.pm
+lib/MooseX/Storage/IO/StorableFile.pm
lib/MooseX/Storage/Meta/Attribute/DoNotSerialize.pm
-lib/MooseX/Storage/Util.pm
t/000_load.t
t/001_basic.t
+t/002_basic_io.t
t/002_basic_w_subtypes.t
t/003_basic_w_embedded_objects.t
t/004_w_cycles.t
t/020_basic_yaml.t
t/030_with_checksum.t
t/040_basic_utils.t
+t/050_basic_storable.t
t/100_io.t
t/101_io_atomic.t
+t/102_io_storable_file.t
+t/103_io_storable_file_custom.t
t/pod-coverage.t
t/pod.t
if exists $params{'format'};
# NOTE:
- # if you do choose an IO role, then
- # you *must* have a format role chosen
- # since load/store require freeze/thaw
+ # many IO roles don't make sense unless
+ # you have also have a format role chosen
+ # too, the exception being StorableFile
if (exists $params{'io'}) {
- (exists $params{'format'})
- || confess "You must specify a format role in order to use an IO role";
+ # NOTE:
+ # we dont need this code anymore, cause
+ # the role composition will catch it for
+ # us. This allows the StorableFile to work
+ #(exists $params{'format'})
+ # || confess "You must specify a format role in order to use an IO role";
push @roles => 'MooseX::Storage::IO::' . $params{'io'};
}
The third (io) level is C<load> and C<store>. In this level we are reading
and writing data to file/network/database/etc.
-This level is also optional, it does however require the C<format> level
-to be present (at least the current state does).
+This level is also optional, in most cases it does require a C<format> role
+to also be used, the expection being the C<StorableFile> role.
=back
--- /dev/null
+
+package MooseX::Storage::Format::Storable;
+use Moose::Role;
+
+use Storable ();
+
+our $VERSION = '0.01';
+our $AUTHORITY = 'cpan:STEVAN';
+
+requires 'pack';
+requires 'unpack';
+
+sub thaw {
+ my ( $class, $stored, @args ) = @_;
+ $class->unpack( Storable::thaw($stored), @args );
+}
+
+sub freeze {
+ my ( $self, @args ) = @_;
+ Storable::nfreeze( $self->pack(@args) );
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+MooseX::Storage::Format::Storable
+
+=head1 SYNOPSIS
+
+ package Point;
+ use Moose;
+ use MooseX::Storage;
+
+ with Storage('format' => 'Storable');
+
+ has 'x' => (is => 'rw', isa => 'Int');
+ has 'y' => (is => 'rw', isa => 'Int');
+
+ 1;
+
+ my $p = Point->new(x => 10, y => 10);
+
+ ## methods to freeze/thaw into
+ ## a specified serialization format
+
+ # pack the class with Storable
+ my $storable_data = $p->freeze();
+
+ # unpack the storable data into the class
+ my $p2 = Point->thaw($storable_data);
+
+=head1 DESCRIPTION
+
+This module will C<thaw> and C<freeze> Moose classes using Storable. It
+uses C<Storable::nfreeze> by default so that it can be easily used
+in IPC scenarios across machines or just locally.
+
+One important thing to note is that this module does not mix well
+with the IO modules. The structures that C<freeze> and C<thaw> deal with
+are Storable's memory representation, and (as far as I know) that
+is not easily just written onto a file. If you want file based
+serialization with Storable, the please look at the
+L<MooseX::Storage::IO::StorableFile> role instead.
+
+=head1 METHODS
+
+=over 4
+
+=item B<freeze>
+
+=item B<thaw ($stored)>
+
+=back
+
+=head2 Introspection
+
+=over 4
+
+=item B<meta>
+
+=back
+
+=head1 BUGS
+
+All complex software has bugs lurking in it, and this module is no
+exception. If you find a bug please either email me, or add the bug
+to cpan-RT.
+
+=head1 AUTHOR
+
+Stevan Little E<lt>stevan.little@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+
--- /dev/null
+
+package MooseX::Storage::IO::StorableFile;
+use Moose::Role;
+
+use Storable ();
+
+our $VERSION = '0.01';
+our $AUTHORITY = 'cpan:STEVAN';
+
+requires 'pack';
+requires 'unpack';
+
+sub load {
+ my ( $class, $filename ) = @_;
+ # try thawing
+ return $class->thaw( Storable::retrieve($filename) )
+ if $class->can('thaw');
+ # otherwise just unpack
+ $class->unpack( Storable::retrieve($filename) );
+}
+
+sub store {
+ my ( $self, $filename ) = @_;
+ Storable::nstore(
+ # try freezing, otherwise just pack
+ ($self->can('freeze') ? $self->freeze() : $self->pack()),
+ $filename
+ );
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+MooseX::Storage::IO::StorableFile
+
+=head1 SYNOPSIS
+
+ package Point;
+ use Moose;
+ use MooseX::Storage;
+
+ with Storage('io' => 'StorableFile');
+
+ has 'x' => (is => 'rw', isa => 'Int');
+ has 'y' => (is => 'rw', isa => 'Int');
+
+ 1;
+
+ my $p = Point->new(x => 10, y => 10);
+
+ ## methods to load/store a class
+ ## on the file system
+
+ $p->store('my_point');
+
+ my $p2 = Point->load('my_point');
+
+=head1 DESCRIPTION
+
+This module will C<load> and C<store> Moose classes using Storable. It
+uses C<Storable::nstore> by default so that it can be easily used
+across machines or just locally.
+
+One important thing to note is that this module does not mix well
+with the other Format modules. Since Storable serialized perl data
+structures in it's own format, those roles are lagely unnecessary.
+
+However, there is always the possibility that having a set of
+C<freeze/thaw> hooks can be useful, so because of that this module
+will attempt to use C<freeze> or C<thaw> if that method is available.
+Of course, you should be careful when doing this as it could lead to
+all sorts of hairy issues. But you have been warned.
+
+=head1 METHODS
+
+=over 4
+
+=item B<load ($filename)>
+
+=item B<store ($filename)>
+
+=back
+
+=head2 Introspection
+
+=over 4
+
+=item B<meta>
+
+=back
+
+=head1 BUGS
+
+All complex software has bugs lurking in it, and this module is no
+exception. If you find a bug please either email me, or add the bug
+to cpan-RT.
+
+=head1 AUTHOR
+
+Stevan Little E<lt>stevan.little@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+
--- /dev/null
+#!/usr/bin/perl
+$|++;
+use strict;
+use warnings;
+
+use Test::More tests => 11;
+use Storable;
+
+BEGIN {
+ use_ok('MooseX::Storage');
+}
+
+{
+
+ package Foo;
+ use Moose;
+ use MooseX::Storage;
+
+ with Storage( 'format' => 'Storable' );
+
+ has 'number' => ( is => 'ro', isa => 'Int' );
+ has 'string' => ( is => 'ro', isa => 'Str' );
+ has 'float' => ( is => 'ro', isa => 'Num' );
+ has 'array' => ( is => 'ro', isa => 'ArrayRef' );
+ has 'hash' => ( is => 'ro', isa => 'HashRef' );
+ has 'object' => ( is => 'ro', isa => 'Object' );
+}
+
+{
+ my $foo = Foo->new(
+ number => 10,
+ string => 'foo',
+ float => 10.5,
+ array => [ 1 .. 10 ],
+ hash => { map { $_ => undef } ( 1 .. 10 ) },
+ object => Foo->new( number => 2 ),
+ );
+ isa_ok( $foo, 'Foo' );
+
+ my $stored = $foo->freeze;
+
+ my $struct = Storable::thaw($stored);
+ is_deeply(
+ $struct,
+ {
+ '__CLASS__' => 'Foo',
+ 'float' => 10.5,
+ 'number' => 10,
+ 'string' => 'foo',
+ 'array' => [ 1 .. 10],
+ 'hash' => { map { $_ => undef } 1 .. 10 },
+ 'object' => {
+ '__CLASS__' => 'Foo',
+ 'number' => 2
+ },
+ },
+ '... got the data struct we expected'
+ );
+}
+
+{
+ my $stored = Storable::nfreeze({
+ '__CLASS__' => 'Foo',
+ 'float' => 10.5,
+ 'number' => 10,
+ 'string' => 'foo',
+ 'array' => [ 1 .. 10],
+ 'hash' => { map { $_ => undef } 1 .. 10 },
+ 'object' => {
+ '__CLASS__' => 'Foo',
+ 'number' => 2
+ },
+ });
+
+ my $foo = Foo->thaw($stored);
+ isa_ok( $foo, 'Foo' );
+
+ is( $foo->number, 10, '... got the right number' );
+ is( $foo->string, 'foo', '... got the right string' );
+ is( $foo->float, 10.5, '... got the right float' );
+ is_deeply( $foo->array, [ 1 .. 10 ], '... got the right array' );
+ is_deeply(
+ $foo->hash,
+ { map { $_ => undef } ( 1 .. 10 ) },
+ '... got the right hash'
+ );
+
+ isa_ok( $foo->object, 'Foo' );
+ is( $foo->object->number, 2,
+ '... got the right number (in the embedded object)' );
+}
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 10;
+
+BEGIN {
+ use_ok('MooseX::Storage');
+}
+
+{
+ package Foo;
+ use Moose;
+ use MooseX::Storage;
+
+ with Storage(io => 'StorableFile');
+
+ has 'number' => (is => 'ro', isa => 'Int');
+ has 'string' => (is => 'ro', isa => 'Str');
+ has 'float' => (is => 'ro', isa => 'Num');
+ has 'array' => (is => 'ro', isa => 'ArrayRef');
+ has 'hash' => (is => 'ro', isa => 'HashRef');
+ has 'object' => (is => 'ro', isa => 'Object');
+}
+
+my $file = 'temp.storable';
+
+{
+ my $foo = Foo->new(
+ number => 10,
+ string => 'foo',
+ float => 10.5,
+ array => [ 1 .. 10 ],
+ hash => { map { $_ => undef } (1 .. 10) },
+ object => Foo->new( number => 2 ),
+ );
+ isa_ok($foo, 'Foo');
+
+ $foo->store($file);
+}
+
+{
+ my $foo = Foo->load($file);
+ isa_ok($foo, 'Foo');
+
+ is($foo->number, 10, '... got the right number');
+ is($foo->string, 'foo', '... got the right string');
+ is($foo->float, 10.5, '... got the right float');
+ is_deeply($foo->array, [ 1 .. 10], '... got the right array');
+ is_deeply($foo->hash, { map { $_ => undef } (1 .. 10) }, '... got the right hash');
+
+ isa_ok($foo->object, 'Foo');
+ is($foo->object->number, 2, '... got the right number (in the embedded object)');
+}
+
+unlink $file;
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 11;
+use Storable ();
+
+BEGIN {
+ use_ok('MooseX::Storage');
+}
+
+{
+ package Foo;
+ use Moose;
+ use MooseX::Storage;
+
+ with Storage(io => 'StorableFile');
+
+ has 'number' => (is => 'ro', isa => 'Int');
+ has 'string' => (is => 'rw', isa => 'Str');
+ has 'float' => (is => 'ro', isa => 'Num');
+ has 'array' => (is => 'ro', isa => 'ArrayRef');
+ has 'hash' => (is => 'ro', isa => 'HashRef');
+ has 'object' => (is => 'ro', isa => 'Object');
+
+ ## add some custom freeze/thaw hooks here ...
+
+ sub thaw {
+ my ( $class, $data ) = @_;
+ my $self = $class->unpack( $data );
+ $self->string("Hello World");
+ $self;
+ }
+
+ sub freeze {
+ my ( $self, @args ) = @_;
+ my $data = $self->pack(@args);
+ $data->{string} = "HELLO WORLD";
+ $data;
+ }
+
+}
+
+my $file = 'temp.storable';
+
+{
+ my $foo = Foo->new(
+ number => 10,
+ string => 'foo',
+ float => 10.5,
+ array => [ 1 .. 10 ],
+ hash => { map { $_ => undef } (1 .. 10) },
+ object => Foo->new( number => 2 ),
+ );
+ isa_ok($foo, 'Foo');
+
+ $foo->store($file);
+
+ # check our custom freeze hook fired ...
+ my $data = Storable::retrieve($file);
+ is_deeply(
+ $data,
+ {
+ '__CLASS__' => 'Foo',
+ 'float' => 10.5,
+ 'number' => 10,
+ 'string' => 'HELLO WORLD',
+ 'array' => [ 1 .. 10],
+ 'hash' => { map { $_ => undef } 1 .. 10 },
+ 'object' => {
+ '__CLASS__' => 'Foo',
+ 'number' => 2
+ },
+ },
+ '... got the data struct we expected'
+ );
+
+}
+
+{
+ my $foo = Foo->load($file);
+ isa_ok($foo, 'Foo');
+
+ ## check our custom thaw hook fired
+ is($foo->string, 'Hello World', '... got the right string');
+
+ is($foo->number, 10, '... got the right number');
+ is($foo->float, 10.5, '... got the right float');
+ is_deeply($foo->array, [ 1 .. 10], '... got the right array');
+ is_deeply($foo->hash, { map { $_ => undef } (1 .. 10) }, '... got the right hash');
+
+ isa_ok($foo->object, 'Foo');
+ is($foo->object->number, 2, '... got the right number (in the embedded object)');
+}
+
+unlink $file;
projects / gitmo/MooseX-Storage.git / commitdiff