adding new tests
Stevan Little [Fri, 22 Jun 2007 17:24:57 +0000 (17:24 +0000)]
Changes
MANIFEST
README
lib/MooseX/Storage.pm
lib/MooseX/Storage/Engine.pm
t/006_w_custom_type_handlers.t [new file with mode: 0644]

diff --git a/Changes b/Changes
index 0f90c1e..d6afb77 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,7 @@
 Revision history for MooseX-Storage
 
+0.03
+
 0.02 Fri. June 8, 2007
     * MooseX::Storage::Base::WithChecksum
       - added a simple base role which makes a checksum of 
index d8a7447..c59667b 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -22,6 +22,7 @@ t/002_basic_w_subtypes.t
 t/003_basic_w_embedded_objects.t
 t/004_w_cycles.t
 t/005_w_versions_and_authority_check.t
+t/006_w_custom_type_handlers.t
 t/010_basic_json.t
 t/020_basic_yaml.t
 t/030_with_checksum.t
diff --git a/README b/README
index 8b26945..d8e92b9 100644 (file)
--- a/README
+++ b/README
@@ -1,4 +1,4 @@
-MooseX-Storage version 0.02
+MooseX-Storage version 0.03
 
 INSTALLATION
 
index c543fc8..b58562f 100644 (file)
@@ -4,7 +4,7 @@ use Moose qw(confess);
 
 use MooseX::Storage::Meta::Attribute::DoNotSerialize;
 
-our $VERSION = '0.02';
+our $VERSION = '0.03';
 
 sub import {
     my $pkg = caller();
index fb172e8..a90c3ea 100644 (file)
@@ -191,6 +191,8 @@ my %OBJECT_HANDLERS = (
         my ( $obj, $options ) = @_;
 #        ($obj->can('does') && $obj->does('MooseX::Storage::Basic'))
 #            || confess "Bad object ($obj) does not do MooseX::Storage::Basic role";
+        ($obj->can('pack'))
+            || confess "Object does not have a &pack method, cannot collapse";
         $obj->pack(%$options);
     },
 );
diff --git a/t/006_w_custom_type_handlers.t b/t/006_w_custom_type_handlers.t
new file mode 100644 (file)
index 0000000..d4f19b8
--- /dev/null
@@ -0,0 +1,94 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 9;
+use Test::Exception;
+
+BEGIN {
+    use_ok('MooseX::Storage');
+    use_ok('MooseX::Storage::Engine');    
+}
+
+=pod
+
+This is just a simple example of defining 
+a custom type handler to take care of custom
+inflate and deflate needs. 
+
+=cut
+
+{
+    package Bar;
+    use Moose;
+    
+    has 'baz' => (is => 'rw', isa => 'Str');
+    has 'boo' => (is => 'rw', isa => 'Str');    
+    
+    sub encode {
+        my $self = shift;
+        $self->baz . '|' . $self->boo;
+    }
+    
+    sub decode {
+        my ($class, $packed) = @_;
+        my ($baz, $boo) = split /\|/ => $packed;
+        $class->new(
+            baz => $baz,
+            boo => $boo,
+        );
+    }
+    
+    MooseX::Storage::Engine->add_custom_type_handler(
+        'Bar' => (
+            expand   => sub { Bar->decode(shift) },
+            collapse => sub { (shift)->encode    },
+        )
+    );
+    
+    package Foo;
+    use Moose;
+    use MooseX::Storage;
+    
+    with Storage;
+    
+    has 'bar' => (
+        is      => 'ro',
+        isa     => 'Bar',
+        default => sub {
+            Bar->new(baz => 'BAZ', boo => 'BOO')
+        }
+    );
+}
+
+my $foo = Foo->new;
+isa_ok($foo, 'Foo');
+
+isa_ok($foo->bar, 'Bar');
+
+is_deeply(
+$foo->pack,
+{
+    __CLASS__ => "Foo",
+    bar       => "BAZ|BOO",
+},
+'... got correct packed structure');
+
+{
+    my $foo = Foo->unpack({
+        __CLASS__ => "Foo",
+        bar       => "BAZ|BOO",
+    });
+    isa_ok($foo, 'Foo');
+    
+    isa_ok($foo->bar, 'Bar'); 
+    
+    is($foo->bar->baz, 'BAZ', '... got the right stuff');
+    is($foo->bar->boo, 'BOO', '... got the right stuff');
+}
+
+
+
+
+