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__ |