* add support for Storage( traits => [...] ) to alter the behaviour of the

  storage engine. One trait has been added: OnlyWhenBuilt, which only
  serializes attributes whose predicate returns 'true'.
* docs & tests added

diff --git a/lib/MooseX/Storage.pm b/lib/MooseX/Storage.pm
index 2686d56..e74a606 100644 (file)
--- a/lib/MooseX/Storage.pm
+++ b/lib/MooseX/Storage.pm
@@ -52,6 +52,13 @@ sub _injected_storage_role_generator {
         #    || confess "You must specify a format role in order to use an IO role";
         push @roles => 'MooseX::Storage::IO::' . $params{'io'};
     }
+    
+    # Note:
+    # These traits alter the behaviour of the engine, the user can
+    # specify these per role-usage
+    for my $trait ( @{ $params{'traits'} ||= [] } ) {
+        push @roles, 'MooseX::Storage::Traits::'.$trait;
+    }
         
     Class::MOP::load_class($_) 
         || die "Could not load role (" . $_ . ")"
@@ -164,6 +171,27 @@ to also be used, the expection being the C<StorableFile> role.
 
 =back
 
+=head2 Behaviour modifiers
+
+The serialization behaviour can be changed by supplying C<traits>.
+This can be done as follows:
+
+  use MooseX::Storage;
+  with Storage( traits => [Trait1, Trait2,...] );
+  
+The following traits are currently bundled with C<MooseX::Storage>:
+
+=over 4
+
+=item OnlyWhenBuilt
+
+Only attributes that have been built (ie, where the predicate returns 
+'true') will be serialized. This avoids any potentially expensive computations.
+
+See L<MooseX::Storage::Traits::OnlyWhenBuilt> for details.
+
+=back
+
 =head2 How we serialize
 
 There are always limits to any serialization framework, there are just 

diff --git a/lib/MooseX/Storage/Engine.pm b/lib/MooseX/Storage/Engine.pm
index dc2fb9c..20247e0 100644 (file)
--- a/lib/MooseX/Storage/Engine.pm
+++ b/lib/MooseX/Storage/Engine.pm
@@ -139,6 +139,22 @@ sub map_attributes {
     } grep {
         # Skip our special skip attribute :)
         !$_->does('MooseX::Storage::Meta::Attribute::Trait::DoNotSerialize') 
+        and     
+        # If we're invoked with the 'OnlyWhenBuilt' trait, we should
+        # only serialize the attribute if it's already built. So, go ahead
+        # and check if the attribute has a predicate. If so, check if it's set 
+        # and then go ahead and look it up.
+        # The $self->object check is here to differentiate a ->pack from a 
+        # ->unpack; ->object is only defined for a ->pack
+        do { 
+            if( $self->object and my $pred = $_->predicate and
+                $self->object->does('MooseX::Storage::Traits::OnlyWhenBuilt') 
+            ) { 
+                $self->object->$pred ? 1 : 0; 
+            } else {
+                1 
+            } 
+        }  
     } ($self->object || $self->class)->meta->get_all_attributes;
 }
 

diff --git a/lib/MooseX/Storage/Traits/OnlyWhenBuilt.pm b/lib/MooseX/Storage/Traits/OnlyWhenBuilt.pm
new file mode 100644 (file)
index 0000000..a3b9752
--- /dev/null
+++ b/lib/MooseX/Storage/Traits/OnlyWhenBuilt.pm
@@ -0,0 +1,82 @@
+package MooseX::Storage::Traits::OnlyWhenBuilt;
+use Moose::Role;
+
+our $VERSION   = '0.18';
+our $AUTHORITY = 'cpan:STEVAN';
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+MooseX::Storage::Traits::OnlyWhenBuilt - A custom trait to bypass serialization
+
+=head1 SYNOPSIS
+
+
+    {   package Point;
+        use Moose;
+        use MooseX::Storage;
+    
+        with Storage( traits => [qw|OnlyWhenBuilt|] );
+    
+        has 'x' => (is => 'rw', lazy_build => 1 );
+        has 'y' => (is => 'rw', lazy_build => 1 );
+        has 'z' => (is => 'rw', builder => '_build_z' );
+        
+        
+        sub _build_x { 3 }
+        sub _build_y { expensive_computation() }
+        sub _build_z { 3 }
+    
+    }
+    
+    my $p = Point->new( 'x' => 4 );
+ 
+    # the result of ->pack will contain:
+    # { x => 4, z => 3 }
+    $p->pack;
+ 
+=head1 DESCRIPTION
+
+Sometimes you don't want a particular attribute to be part of the 
+serialization if it has not been built yet. If you invoke C<Storage()>
+as outlined in the C<Synopsis>, only attributes that have been built
+(ie, where the predicate returns 'true') will be serialized.
+This avoids any potentially expensive computations.
+
+See the SYNOPSIS for a nice example that can be easily cargo-culted.
+
+=head1 METHODS
+
+=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-2008 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/009_do_not_serialize_lazy.t b/t/009_do_not_serialize_lazy.t
new file mode 100644 (file)
index 0000000..54331bf
--- /dev/null
+++ b/t/009_do_not_serialize_lazy.t
@@ -0,0 +1,45 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';#tests => 6;
+use Test::Exception;
+
+BEGIN {
+    use_ok('MooseX::Storage');
+}
+
+{   package Point;
+    use Moose;
+    use MooseX::Storage;
+
+    with Storage( traits => [qw|OnlyWhenBuilt|] );
+
+    has 'x' => (is => 'rw', lazy_build => 1 );
+    has 'y' => (is => 'rw', lazy_build => 1 );
+    has 'z' => (is => 'rw', builder => '_build_z' );
+    
+    
+    sub _build_x { 'x' }
+    sub _build_y { 'y' }
+    sub _build_z { 'z' }
+
+}
+
+my $p = Point->new( 'x' => $$ );
+ok( $p,                         "New object created" );
+
+my $href = $p->pack;
+
+ok( $href,                      "   Object packed" );
+is( $href->{'x'}, $$,           "       x => $$" );
+is( $href->{'z'}, 'z',          "       z => z" );
+ok( not(exists($href->{'y'})),  "       y does not exist" );
+
+is_deeply( 
+    $href, 
+    { '__CLASS__' => 'Point',
+      'x' => $$,
+      'z' => 'z'
+    },                          "   Deep check passed" );