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