* implement the unpack( $data, inject => {...} ) feature.
Jos Boumans [Wed, 24 Jun 2009 12:29:42 +0000 (14:29 +0200)]
  * add docs & tests

lib/MooseX/Storage.pm
lib/MooseX/Storage/Basic.pm
t/008_do_not_serialize.t

index a6e4c25..825376c 100644 (file)
@@ -151,6 +151,9 @@ class name and each instance attribute is stored. Very simple.
 This level is not optional, it is the bare minumum that 
 MooseX::Storage provides and all other levels build on top of this.
 
+See L<Moosex::Storage::Basic> for the fundamental implementation and
+options to C<pack> and C<unpack>
+
 =item B<format>
 
 The second (format) level is C<freeze> and C<thaw>. In this level the 
index 01e66dd..686772b 100644 (file)
@@ -17,7 +17,7 @@ sub unpack {
     my $e = $class->_storage_get_engine(class => $class);
     
     $class->_storage_construct_instance( 
-        [ $e->expand_object($data, %args) ], 
+        $e->expand_object($data, %args), 
         \%args 
     );
 }
@@ -29,15 +29,11 @@ sub _storage_get_engine {
 
 sub _storage_construct_instance {
     my ($class, $args, $opts) = @_;
-    
-    my @i = defined $opts->{'inject'} ? @{ $opts->{'inject'} } : ();
+    my %i = defined $opts->{'inject'} ? %{ $opts->{'inject'} } : ();
  
-    $class->new( @$args, @i );
+    $class->new( %$args, %i );
 }
 
-
-
-
 1;
 
 __END__
@@ -73,6 +69,9 @@ MooseX::Storage::Basic - The simplest level of serialization
   
   # unpack the hash into a class
   my $p2 = Point->unpack({ __CLASS__ => 'Point-0.01', x => 10, y => 10 });
+  
+  # unpack the hash, with insertion of paramaters
+  my $p3 = Point->unpack( $p->pack, inject => { x => 11 } );
 
 =head1 DESCRIPTION
 
@@ -85,7 +84,10 @@ but the exported C<Storage> function.
 
 =item B<pack>
 
-=item B<unpack ($data)>
+=item B<unpack ($data [, insert => { key => val, ... } ] )>
+
+Providing the C<insert> argument let's you supply additional arguments to
+the class' C<new> function, or override ones from the serialized data.
 
 =back
 
index e0ff4b3..4df3889 100644 (file)
@@ -65,7 +65,7 @@ BEGIN {
         metaclass   => 'DoNotSerialize',
         required    => 1,
         is          => 'rw',
-        isa         => 'Str',        # type constraint is important
+        isa         => 'Object',        # type constraint is important
     );
     
     has zot => (
@@ -74,10 +74,11 @@ BEGIN {
     );        
 }
 
-{   my $bar = Bar->new( foo => $$ );
+{   my $obj = bless {};
+    my $bar = Bar->new( foo => $obj );
     
     ok( $bar,                   "New object created" );
-    is( $bar->foo, $$,          "   ->foo => $$" );
+    is( $bar->foo, $obj,        "   ->foo => $obj" );
     is( $bar->zot, $$,          "   ->zot => $$" );
     
     my $bpack = $bar->pack;
@@ -91,8 +92,8 @@ BEGIN {
     ok( $@,                     "   Unpack without required attribute fails" );
     like( $@, qr/foo/,          "       Proper error recorded" );
         
-    my $bar2 = Bar->unpack({ %$bpack, foo => $$ });
-    ok( $bar2,                  "   Unpacked correctly with foo => $$"); 
+    my $bar2 = Bar->unpack( $bpack, inject => { foo => bless {} } );
+    ok( $bar2,                  "   Unpacked correctly with foo => Object"); 
 }