File Coverage

blib/lib/MooseX/Storage/Traits/OnlyWhenBuilt.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


line stmt bran cond sub pod time code
1             package MooseX::Storage::Traits::OnlyWhenBuilt;
2             # ABSTRACT: A custom trait to bypass serialization
3              
4             our $VERSION = '0.52';
5              
6 1     1   731 use Moose::Role;
  1         1  
  1         11  
7 1     1   5684 use namespace::autoclean;
  1         2  
  1         11  
8              
9             requires 'pack';
10             requires 'unpack';
11              
12             around 'pack' => sub {
13             my ($orig, $self, %args) = @_;
14             $args{engine_traits} ||= [];
15             push(@{$args{engine_traits}}, 'OnlyWhenBuilt');
16             $self->$orig(%args);
17             };
18              
19             around 'unpack' => sub {
20             my ($orig, $self, $data, %args) = @_;
21             $args{engine_traits} ||= [];
22             push(@{$args{engine_traits}}, 'OnlyWhenBuilt');
23             $self->$orig($data, %args);
24             };
25              
26 1     1   258 no Moose::Role;
  1         2  
  1         6  
27              
28             1;
29              
30             __END__
31              
32             =pod
33              
34             =encoding UTF-8
35              
36             =head1 NAME
37              
38             MooseX::Storage::Traits::OnlyWhenBuilt - A custom trait to bypass serialization
39              
40             =head1 VERSION
41              
42             version 0.52
43              
44             =head1 SYNOPSIS
45              
46             { package Point;
47             use Moose;
48             use MooseX::Storage;
49              
50             with Storage( traits => [qw|OnlyWhenBuilt|] );
51              
52             has 'x' => (is => 'rw', lazy_build => 1 );
53             has 'y' => (is => 'rw', predicate => '_has_y' );
54             has 'z' => (is => 'rw', builder => '_build_z' );
55              
56             sub _build_x { 3 }
57             sub _build_y { expensive_computation() }
58             sub _build_z { 3 }
59              
60             }
61              
62             my $p = Point->new( 'x' => 4 );
63              
64             # the result of ->pack will contain:
65             # { x => 4, z => 3 }
66             $p->pack;
67              
68             =head1 DESCRIPTION
69              
70             Sometimes you don't want a particular attribute to be part of the
71             serialization if it has not been built yet. If you invoke C<Storage()>
72             as outlined in the C<Synopsis>, only attributes that have been built
73             (i.e., where the predicate returns 'true') will be serialized.
74             This avoids any potentially expensive computations.
75              
76             =for stopwords culted
77              
78             See the SYNOPSIS for a nice example that can be easily cargo-culted.
79              
80             =head1 SUPPORT
81              
82             Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-Storage>
83             (or L<bug-MooseX-Storage@rt.cpan.org|mailto:bug-MooseX-Storage@rt.cpan.org>).
84              
85             There is also a mailing list available for users of this distribution, at
86             L<http://lists.perl.org/list/moose.html>.
87              
88             There is also an irc channel available for users of this distribution, at
89             L<C<#moose> on C<irc.perl.org>|irc://irc.perl.org/#moose>.
90              
91             =head1 AUTHORS
92              
93             =over 4
94              
95             =item *
96              
97             Chris Prather <chris.prather@iinteractive.com>
98              
99             =item *
100              
101             Stevan Little <stevan.little@iinteractive.com>
102              
103             =item *
104              
105             יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
106              
107             =back
108              
109             =head1 COPYRIGHT AND LICENSE
110              
111             This software is copyright (c) 2007 by Infinity Interactive, Inc.
112              
113             This is free software; you can redistribute it and/or modify it under
114             the same terms as the Perl 5 programming language system itself.
115              
116             =cut