From: Stevan Little Date: Thu, 10 Jan 2008 01:28:07 +0000 (+0000) Subject: Deferred is done X-Git-Tag: 0.14~13 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bf33d7c7a646b2ddc69b7f662e91ebb001f4ff37;hp=1f3074ea2b80c4c8dfc081414f87285bc7892c82;p=gitmo%2FMooseX-Storage.git Deferred is done --- diff --git a/lib/MooseX/Storage/Deferred.pm b/lib/MooseX/Storage/Deferred.pm index 586aef7..2326daf 100644 --- a/lib/MooseX/Storage/Deferred.pm +++ b/lib/MooseX/Storage/Deferred.pm @@ -8,30 +8,58 @@ with 'MooseX::Storage::Basic'; sub thaw { my ( $class, $packed, $type, @args ) = @_; - - (exists $type->{format}) + + (exists $type->{format}) || confess "You must specify a format type to thaw from"; my $class_to_load = 'MooseX::Storage::Format::' . $type->{format}; Class::MOP::load_class($class_to_load); - + my $method_to_call = $class_to_load . '::thaw'; - + $class->$method_to_call($packed, @args); } sub freeze { my ( $self, $type, @args ) = @_; - - (exists $type->{format}) - || confess "You must specify a format type to freeze into"; - + + (exists $type->{format}) + || confess "You must specify a format type to freeze into"; + my $class_to_load = 'MooseX::Storage::Format::' . $type->{format}; Class::MOP::load_class($class_to_load); my $method_to_call = $class_to_load . '::freeze'; - - $self->$method_to_call(@args); + + $self->$method_to_call(@args); +} + +sub load { + my ( $class, $filename, $type, @args ) = @_; + + (exists $type->{io}) + || confess "You must specify an I/O type to load with"; + + my $class_to_load = 'MooseX::Storage::IO::' . $type->{io}; + Class::MOP::load_class($class_to_load); + + my $method_to_call = $class_to_load . '::load'; + + $class->$method_to_call($filename, $type, @args); +} + +sub store { + my ( $self, $filename, $type, @args ) = @_; + + (exists $type->{io}) + || confess "You must specify an I/O type to store with"; + + my $class_to_load = 'MooseX::Storage::IO::' . $type->{io}; + Class::MOP::load_class($class_to_load); + + my $method_to_call = $class_to_load . '::store'; + + $self->$method_to_call($filename, $type, @args); } 1; @@ -49,39 +77,69 @@ MooseX::Storage::Deferred - A role for undecisive programmers package Point; use Moose; use MooseX::Storage; - + our $VERSION = '0.01'; - + with 'MooseX::Storage::Deferred'; - + 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 + + ## methods to freeze/thaw into ## a specified serialization format ## (in this case JSON) - + # pack the class into a JSON string $p->freeze({ format => 'JSON' }); # { "__CLASS__" : "Point", "x" : 10, "y" : 10 } - + # unpack the JSON string into a class my $p2 = Point->thaw( '{ "__CLASS__" : "Point", "x" : 10, "y" : 10 }', { format => 'JSON' } - ); + ); =head1 DESCRIPTION -This role is designed for those times when you need to -serialize into many different formats or I/O options. -It basically allows you to choose the format and IO -options only when you actually use them (see the +This role is designed for those times when you need to +serialize into many different formats or I/O options. + +It basically allows you to choose the format and IO +options only when you actually use them (see the SYNOPSIS for more info) +=head1 SUPPORTED FORMATS + +=over 4 + +=item I + +=item I + +=item I + +=back + +=head1 SUPPORTED I/O + +=over 4 + +=item I + +=item I + +=back + +B The B I/O option is not supported, +this is because it does not mix well with options who also +have a C and C methods like this. It is possible +to probably work around this issue, but I don't currently +have the need for it. If you need this supported, talk to me +and I will see what I can do. + =head1 METHODS =over 4 @@ -90,6 +148,10 @@ SYNOPSIS for more info) =item B +=item B + +=item B + =back =head2 Introspection @@ -102,7 +164,7 @@ SYNOPSIS for more info) =head1 BUGS -All complex software has bugs lurking in it, and this module is no +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. diff --git a/lib/MooseX/Storage/IO/AtomicFile.pm b/lib/MooseX/Storage/IO/AtomicFile.pm index d0da088..f932254 100644 --- a/lib/MooseX/Storage/IO/AtomicFile.pm +++ b/lib/MooseX/Storage/IO/AtomicFile.pm @@ -10,8 +10,8 @@ our $AUTHORITY = 'cpan:STEVAN'; with 'MooseX::Storage::IO::File'; sub store { - my ( $self, $filename ) = @_; - MooseX::Storage::Engine::IO::AtomicFile->new( file => $filename )->store( $self->freeze() ); + my ( $self, $filename, @args ) = @_; + MooseX::Storage::Engine::IO::AtomicFile->new( file => $filename )->store( $self->freeze(@args) ); } 1; diff --git a/lib/MooseX/Storage/IO/File.pm b/lib/MooseX/Storage/IO/File.pm index b8c646d..0bf379f 100644 --- a/lib/MooseX/Storage/IO/File.pm +++ b/lib/MooseX/Storage/IO/File.pm @@ -11,13 +11,13 @@ requires 'thaw'; requires 'freeze'; sub load { - my ( $class, $filename ) = @_; - $class->thaw( MooseX::Storage::Engine::IO::File->new( file => $filename )->load() ); + my ( $class, $filename, @args ) = @_; + $class->thaw( MooseX::Storage::Engine::IO::File->new( file => $filename )->load(), @args ); } sub store { - my ( $self, $filename ) = @_; - MooseX::Storage::Engine::IO::File->new( file => $filename )->store( $self->freeze() ); + my ( $self, $filename, @args ) = @_; + MooseX::Storage::Engine::IO::File->new( file => $filename )->store( $self->freeze(@args) ); } 1; diff --git a/lib/MooseX/Storage/IO/StorableFile.pm b/lib/MooseX/Storage/IO/StorableFile.pm index d261fcd..7688d0c 100644 --- a/lib/MooseX/Storage/IO/StorableFile.pm +++ b/lib/MooseX/Storage/IO/StorableFile.pm @@ -11,19 +11,19 @@ requires 'pack'; requires 'unpack'; sub load { - my ( $class, $filename ) = @_; + my ( $class, $filename, @args ) = @_; # try thawing - return $class->thaw( Storable::retrieve($filename) ) + return $class->thaw( Storable::retrieve($filename), @args ) if $class->can('thaw'); # otherwise just unpack - $class->unpack( Storable::retrieve($filename) ); + $class->unpack( Storable::retrieve($filename), @args ); } sub store { - my ( $self, $filename ) = @_; + my ( $self, $filename, @args ) = @_; Storable::nstore( # try freezing, otherwise just pack - ($self->can('freeze') ? $self->freeze() : $self->pack()), + ($self->can('freeze') ? $self->freeze(@args) : $self->pack(@args)), $filename ); } diff --git a/t/061_basic_deferred_w_io.t b/t/061_basic_deferred_w_io.t new file mode 100644 index 0000000..38722b1 --- /dev/null +++ b/t/061_basic_deferred_w_io.t @@ -0,0 +1,90 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 21; + +BEGIN { + use_ok('MooseX::Storage'); +} + +{ + package Foo; + use Moose; + use MooseX::Storage; + + with 'MooseX::Storage::Deferred'; + + 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.json'; + +{ + 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, { format => 'JSON', io => 'File' }); +} + +{ + my $foo = Foo->load($file, { format => 'JSON', io => '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; +ok(!(-e $file), '... the file has been deleted'); + +{ + 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, { format => 'JSON', io => 'AtomicFile' }); +} + +{ + my $foo = Foo->load($file, { format => 'JSON', io => 'AtomicFile' }); + 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; +ok(!(-e $file), '... the file has been deleted'); +