From: Stevan Little <stevan.little@iinteractive.com>
Date: Thu, 27 Sep 2007 20:50:56 +0000 (+0000)
Subject: 0.07 adding in the Storable role
X-Git-Tag: 0_07^0
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=refs%2Ftags%2F0_07;hp=4747c531e32782b51fca0f2744698bfb6c1bcd05;p=gitmo%2FMooseX-Storage.git

0.07 adding in the Storable role
---

diff --git a/Build.PL b/Build.PL
index ddb1700..cabbc90 100644
--- a/Build.PL
+++ b/Build.PL
@@ -13,6 +13,7 @@ my $build = Module::Build->new(
         # 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',    
diff --git a/Changes b/Changes
index ef0d60b..2ac55c0 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,13 @@
 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
diff --git a/MANIFEST b/MANIFEST
index e086a59..e1f3b91 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,24 +1,27 @@
 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
@@ -29,7 +32,10 @@ t/010_basic_json.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
diff --git a/lib/MooseX/Storage.pm b/lib/MooseX/Storage.pm
index 72a0b74..3dffa54 100644
--- a/lib/MooseX/Storage.pm
+++ b/lib/MooseX/Storage.pm
@@ -37,12 +37,16 @@ sub import {
             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'};
         }
         
@@ -153,8 +157,8 @@ have it. You can just use C<pack>/C<unpack> instead.
 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
 
diff --git a/lib/MooseX/Storage/Format/Storable.pm b/lib/MooseX/Storage/Format/Storable.pm
new file mode 100644
index 0000000..760d74e
--- /dev/null
+++ b/lib/MooseX/Storage/Format/Storable.pm
@@ -0,0 +1,109 @@
+
+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
+
+
diff --git a/lib/MooseX/Storage/IO/StorableFile.pm b/lib/MooseX/Storage/IO/StorableFile.pm
new file mode 100644
index 0000000..eb5d5af
--- /dev/null
+++ b/lib/MooseX/Storage/IO/StorableFile.pm
@@ -0,0 +1,118 @@
+
+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
+
+
diff --git a/t/050_basic_storable.t b/t/050_basic_storable.t
new file mode 100644
index 0000000..7c98748
--- /dev/null
+++ b/t/050_basic_storable.t
@@ -0,0 +1,92 @@
+#!/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)' );
+}
+
diff --git a/t/102_io_storable_file.t b/t/102_io_storable_file.t
new file mode 100644
index 0000000..e0a90a0
--- /dev/null
+++ b/t/102_io_storable_file.t
@@ -0,0 +1,57 @@
+#!/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;
diff --git a/t/103_io_storable_file_custom.t b/t/103_io_storable_file_custom.t
new file mode 100644
index 0000000..a94abb7
--- /dev/null
+++ b/t/103_io_storable_file_custom.t
@@ -0,0 +1,97 @@
+#!/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;