From: Jos Boumans Date: Tue, 23 Jun 2009 19:31:33 +0000 (+0200) Subject: * add support for Storage( traits => [...] ) to alter the behaviour of the X-Git-Tag: 0.20~19 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=76218b465af423661a8b711a20e3e458f9adbb08;p=gitmo%2FMooseX-Storage.git * 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 --- 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 role. =back +=head2 Behaviour modifiers + +The serialization behaviour can be changed by supplying C. +This can be done as follows: + + use MooseX::Storage; + with Storage( traits => [Trait1, Trait2,...] ); + +The following traits are currently bundled with C: + +=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 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 --- 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 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 +as outlined in the C, 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 + +=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 Estevan.little@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2007-2008 by Infinity Interactive, Inc. + +L + +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 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" );