lib/MooseX/Storage/Traits/OnlyWhenBuilt.pm

   1 package MooseX::Storage::Traits::OnlyWhenBuilt;
   2 use Moose::Role;
   3
   4 requires 'pack';
   5 requires 'unpack';
   6
   7 around 'pack' => sub {
   8     my ($orig, $self, %args) = @_;
   9     $args{engine_traits} ||= [];
  10     push(@{$args{engine_traits}}, 'OnlyWhenBuilt');
  11     $self->$orig(%args);
  12 };
  13
  14 around 'unpack' => sub {
  15     my ($orig, $self, $data, %args) = @_;
  16     $args{engine_traits} ||= [];
  17     push(@{$args{engine_traits}}, 'OnlyWhenBuilt');
  18     $self->$orig($data, %args);
  19 };
  20
  21 no Moose::Role;
  22
  23 1;
  24
  25 __END__
  26
  27 =pod
  28
  29 =head1 NAME
  30
  31 MooseX::Storage::Traits::OnlyWhenBuilt - A custom trait to bypass serialization
  32
  33 =head1 SYNOPSIS
  34
  35
  36     {   package Point;
  37         use Moose;
  38         use MooseX::Storage;
  39
  40         with Storage( traits => [qw|OnlyWhenBuilt|] );
  41
  42         has 'x' => (is => 'rw', lazy_build => 1 );
  43         has 'y' => (is => 'rw', lazy_build => 1 );
  44         has 'z' => (is => 'rw', builder => '_build_z' );
  45
  46         sub _build_x { 3 }
  47         sub _build_y { expensive_computation() }
  48         sub _build_z { 3 }
  49
  50     }
  51
  52     my $p = Point->new( 'x' => 4 );
  53
  54     # the result of ->pack will contain:
  55     # { x => 4, z => 3 }
  56     $p->pack;
  57
  58 =head1 DESCRIPTION
  59
  60 Sometimes you don't want a particular attribute to be part of the
  61 serialization if it has not been built yet. If you invoke C<Storage()>
  62 as outlined in the C<Synopsis>, only attributes that have been built
  63 (ie, where the predicate returns 'true') will be serialized.
  64 This avoids any potentially expensive computations.
  65
  66 See the SYNOPSIS for a nice example that can be easily cargo-culted.
  67
  68 =head1 METHODS
  69
  70 =head2 Introspection
  71
  72 =over 4
  73
  74 =item B<meta>
  75
  76 =back
  77
  78 =head1 BUGS
  79
  80 All complex software has bugs lurking in it, and this module is no
  81 exception. If you find a bug please either email me, or add the bug
  82 to cpan-RT.
  83
  84 =head1 AUTHOR
  85
  86 Stevan Little E<lt>stevan.little@iinteractive.comE<gt>
  87
  88 =head1 COPYRIGHT AND LICENSE
  89
  90 Copyright 2007-2008 by Infinity Interactive, Inc.
  91
  92 L<http://www.iinteractive.com>
  93
  94 This library is free software; you can redistribute it and/or modify
  95 it under the same terms as Perl itself.
  96
  97 =cut