File Coverage

blib/lib/MooX/HandlesVia.pm
Criterion Covered Total %
statement 38 42 90.4
branch 16 20 80.0
condition 4 9 44.4
subroutine 7 8 87.5
pod 1 1 100.0
total 66 80 82.5


line stmt bran cond sub pod time code
1             package MooX::HandlesVia;
2             # ABSTRACT: NativeTrait-like behavior for Moo.
3             $MooX::HandlesVia::VERSION = '0.001007';
4 12     12   250307 use strictures 1;
  12         74  
  12         282  
5 12     12   863 use Module::Runtime qw/require_module/;
  12         20  
  12         89  
6              
7             # reserved hardcoded mappings for classname shortcuts.
8             my %RESERVED = (
9             'Array' => 'Data::Perl::Collection::Array::MooseLike',
10             'Hash' => 'Data::Perl::Collection::Hash::MooseLike',
11             'String' => 'Data::Perl::String::MooseLike',
12             'Bool' => 'Data::Perl::Bool::MooseLike',
13             'Number' => 'Data::Perl::Number::MooseLike',
14             'Code' => 'Data::Perl::Code',
15             );
16             my %REVERSED = reverse %RESERVED;
17              
18             sub import {
19 30     30   220339 my ($class) = @_;
20              
21 12     12   1150 no strict 'refs';
  12         14  
  12         386  
22 12     12   49 no warnings 'redefine';
  12         19  
  12         5149  
23              
24 30         89 my $target = caller;
25 30 100       492 if(my $has = $target->can('has')) {
26             my $newsub = sub {
27 35     35   129498 $has->(process_has(@_));
28 29         174 };
29 29 100       300 if($target->isa("Moo::Object")){
30 26         97 Moo::_install_tracked($target, "has", $newsub);
31             }
32             else{
33 3         11 Moo::Role::_install_tracked($target, "has", $newsub);
34             }
35             }
36             }
37              
38             sub process_has {
39 35     35 1 307 my ($name, %opts) = @_;
40 35         84 my $handles = $opts{handles};
41 35 100 100     365 return ($name, %opts) if not $handles or ref $handles ne 'HASH';
42              
43 33 100       171 if (my $via = delete $opts{handles_via}) {
44 29 50       104 $via = ref $via eq 'ARRAY' ? $via->[0] : $via;
45              
46             # try to load the reserved mapping, if it exists, else the full name
47 29   33     113 $via = $RESERVED{$via} || $via;
48 29         110 require_module($via);
49              
50             # clone handles for HandlesMoose support
51 29         16668 my %handles_clone = %$handles;
52              
53 29         190 while (my ($target, $delegation) = each %$handles) {
54             # if passed an array, handle the curry
55 323 100       773 if (ref $delegation eq 'ARRAY') {
    50          
56 107         245 my ($method, @curry) = @$delegation;
57 107 100       810 if ($via->can($method)) {
58 33         197 $handles->{$target} = ['${\\'.$via.'->can("'.$method.'")}', @curry];
59             }
60             }
61             elsif (ref $delegation eq '') {
62 216 100       1485 if ($via->can($delegation)) {
63 74         333 $handles->{$target} = '${\\'.$via.'->can("'.$delegation.'")}';
64             }
65             }
66             }
67              
68             # install our support for moose upgrading of class/role
69             # we deleted the handles_via key above, but install it as a native trait
70 29         112 my $inflator = $opts{moosify};
71             $opts{moosify} = sub {
72 0     0   0 my ($spec) = @_;
73              
74 0         0 $spec->{handles} = \%handles_clone;
75 0   0     0 $spec->{traits} = [$REVERSED{$via} || $via];
76              
77             # pass through if needed
78 0 0       0 $inflator->($spec) if ref($inflator) eq 'CODE';
79 29         240 };
80             }
81              
82 33         304 ($name, %opts);
83             }
84              
85             1;
86              
87             =pod
88              
89             =encoding UTF-8
90              
91             =head1 NAME
92              
93             MooX::HandlesVia - NativeTrait-like behavior for Moo.
94              
95             =head1 VERSION
96              
97             version 0.001007
98              
99             =head1 SYNOPSIS
100              
101             {
102             package Hashy;
103             use Moo;
104             use MooX::HandlesVia;
105              
106             has hash => (
107             is => 'rw',
108             handles_via => 'Hash',
109             handles => {
110             get_val => 'get',
111             set_val => 'set',
112             all_keys => 'keys'
113             }
114             );
115             }
116              
117             my $h = Hashy->new(hash => { a => 1, b => 2});
118              
119             $h->get_val('b'); # 2
120              
121             $h->set_val('a', 'BAR'); # sets a to BAR
122              
123             my @keys = $h->all_keys; # returns a, b
124              
125             =head1 DESCRIPTION
126              
127             MooX::HandlesVia is an extension of Moo's 'handles' attribute functionality. It
128             provides a means of proxying functionality from an external class to the given
129             atttribute. This is most commonly used as a way to emulate 'Native Trait'
130             behavior that has become commonplace in Moose code, for which there was no Moo
131             alternative.
132              
133             =head1 SHORTCOMINGS
134              
135             Due to current Moo implementation details there are some deficiencies in how
136             MooX::HandlesVia in comparison to what you would expect from Moose native
137             traits.
138              
139             =over 4
140              
141             =item * methods delegated via the Moo 'handles' interface are passed the
142             attribue value directly. and there is no way to access the parent class. This
143             means if an attribute is updated any triggers or type coercions B
144             fire.
145              
146             =item * Moo attribute method delegations are passed the attribute value. This
147             is fine for references (objects, arrays, hashrefs..) it means simple scalar
148             types are B. This unfortunately means Number, String, Counter, Bool
149             cannot modify the attributes value, rendering them largely useless.
150              
151             =back
152              
153             =head1 PROVIDED INTERFACE/FUNCTIONS
154              
155             =over 4
156              
157             =item B
158              
159             MooX::HandlesVia preprocesses arguments passed to has() attribute declarations
160             via the process_has function. In a given Moo class, If 'handles_via' is set to
161             a ClassName string, and 'handles' is set with a hashref mapping of desired moo
162             class methods that should map to ClassName methods, process_has() will create
163             the appropriate binding to create the mapping IF ClassName provides that named
164             method.
165              
166             has options => (
167             is => 'rw',
168             handles_via => 'Array',
169             handles => {
170             mixup => 'shuffle',
171             unique_options => 'uniq',
172             all_options => 'elements'
173             }
174             );
175              
176             =back
177              
178             The following handles_via keywords are reserved as shorthand for mapping to
179             L:
180              
181             =over 4
182              
183             =item * B maps to L
184              
185             =item * B maps to L
186              
187             =item * B maps to L
188              
189             =item * B maps to L
190              
191             =item * B maps to L
192              
193             =item * B maps to L
194              
195             =back
196              
197             =head1 SEE ALSO
198              
199             =over 4
200              
201             =item * L
202              
203             =item * L
204              
205             =back
206              
207             =head1 AUTHOR
208              
209             Matthew Phillips
210              
211             =head1 COPYRIGHT AND LICENSE
212              
213             This software is copyright (c) 2015 by Matthew Phillips .
214              
215             This is free software; you can redistribute it and/or modify it under
216             the same terms as the Perl 5 programming language system itself.
217              
218             =cut
219              
220             __END__