File Coverage

blib/lib/MooseX/Storage/Traits/WithRoles.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::WithRoles;
2             our $AUTHORITY = 'cpan:YANICK';
3             # ABSTRACT: A custom trait to include roles in serialization
4             $MooseX::Storage::Traits::WithRoles::VERSION = '0.2.0';
5 3     3   14593 use Moose::Role;
  3         6  
  3         28  
6 3     3   16569 use namespace::autoclean;
  3         6  
  3         29  
7              
8             requires 'pack';
9             requires 'unpack';
10              
11             around 'pack' => sub {
12             my ($orig, $self, %args) = @_;
13              
14             $args{engine_traits} ||= [];
15              
16             push @{$args{engine_traits}}, 'WithRoles';
17              
18             $self->$orig(%args);
19             };
20              
21             around 'unpack' => sub {
22             my ($orig, $self, $data, %args) = @_;
23              
24             $args{engine_traits} ||= [];
25              
26             push @{$args{engine_traits}}, 'WithRoles';
27              
28             $self->$orig($data, %args);
29             };
30              
31 3     3   680 no Moose::Role;
  3         6  
  3         15  
32              
33             1;
34              
35             __END__
36              
37             =pod
38              
39             =encoding UTF-8
40              
41             =head1 NAME
42              
43             MooseX::Storage::Traits::WithRoles - A custom trait to include roles in serialization
44              
45             =head1 VERSION
46              
47             version 0.2.0
48              
49             =head1 SYNOPSIS
50              
51             package ThirdDimension;
52             use Moose::Role;
53              
54             has 'z' => (is => 'rw', isa => 'Int');
55              
56             package Point;
57             use Moose;
58             use MooseX::Storage;
59              
60             with Storage( base => 'SerializedClass', traits => [ 'WithRoles' ] );
61              
62             has 'x' => (is => 'rw', isa => 'Int');
63             has 'y' => (is => 'rw', isa => 'Int');
64              
65             1;
66              
67             use Moose::Util qw/ with_traits /;
68              
69             my $p = with_traits( 'Point', 'ThirdDimension' )->new(x => 10, y => 10, z => 10);
70              
71             my $packed = $p->pack();
72             # { __CLASS__ => 'Point', '__ROLES__' => [ 'ThirdDimension' ], x => 10, y => 10, z => 10 }
73              
74             # unpack the hash into a class
75             my $p2 = Point->unpack($packed);
76              
77             print $p2->z;
78              
79             =head1 DESCRIPTION
80              
81             This trait is meant to be used when a base class will be consuming roles at runtime
82             via (for example) C<with_traits>.
83             Without this trait, the '__CLASS__' attribute of the serialized object would be the name
84             of the resulting anonymous class, which is useless to reconstruct the class after the fact.
85              
86             When this trait is used, the serialized C<__CLASS__> value will be the base
87             class, and C<__ROLES__> will contain the list of roles that it consumes. If used
88             in conjecture with L<MooseX::Storage::Base::SerializedClass>, C<unpack()> will reinflate the data
89             in the right class augmented by the given roles.
90              
91             Oh yeah, and the trait also works with L<MooseX::Role::Parameterized> roles. You're
92             welcome, Sartak. ;-)
93              
94             =head1 AUTHOR
95              
96             Yanick Champoux <yanick@babyl.dyndns.org>
97              
98             =head1 COPYRIGHT AND LICENSE
99              
100             This software is copyright (c) 2015 by Yanick Champoux.
101              
102             This is free software; you can redistribute it and/or modify it under
103             the same terms as the Perl 5 programming language system itself.
104              
105             =cut