line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
94
|
|
|
94
|
|
2593
|
use 5.008; |
|
94
|
|
|
|
|
575
|
|
2
|
94
|
|
|
94
|
|
592
|
use strict; |
|
94
|
|
|
|
|
241
|
|
|
94
|
|
|
|
|
2614
|
|
3
|
94
|
|
|
94
|
|
705
|
use warnings; |
|
94
|
|
|
|
|
1452
|
|
|
94
|
|
|
|
|
7764
|
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:TOBYINK'; |
7
|
|
|
|
|
|
|
our $VERSION = '0.045'; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
use Sub::HandlesVia::Mite -all; |
10
|
94
|
|
|
94
|
|
1185
|
|
|
94
|
|
|
|
|
243
|
|
|
94
|
|
|
|
|
1308
|
|
11
|
|
|
|
|
|
|
has name => ( |
12
|
|
|
|
|
|
|
is => ro, |
13
|
|
|
|
|
|
|
isa => 'Str', |
14
|
|
|
|
|
|
|
); |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
has template => ( |
17
|
|
|
|
|
|
|
is => ro, |
18
|
|
|
|
|
|
|
isa => 'Str', |
19
|
|
|
|
|
|
|
); |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
has lvalue_template => ( |
22
|
|
|
|
|
|
|
is => ro, |
23
|
|
|
|
|
|
|
isa => 'Str', |
24
|
|
|
|
|
|
|
); |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
has args => ( |
27
|
|
|
|
|
|
|
is => ro, |
28
|
|
|
|
|
|
|
isa => 'Int|Undef', |
29
|
|
|
|
|
|
|
default => undef, |
30
|
|
|
|
|
|
|
); |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
has [ 'min_args', 'max_args' ] => ( |
33
|
|
|
|
|
|
|
is => lazy, |
34
|
|
|
|
|
|
|
isa => 'Int|Undef', |
35
|
|
|
|
|
|
|
builder => sub { shift->args }, |
36
|
4514
|
|
|
4514
|
|
11598
|
); |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
# Not proper predicates because they check definedness |
39
|
|
|
|
|
|
|
|
40
|
1389
|
|
|
1389
|
1
|
3464
|
has signature => ( |
41
|
5049
|
|
|
5049
|
1
|
11986
|
is => ro, |
42
|
|
|
|
|
|
|
isa => 'ArrayRef|Undef', |
43
|
|
|
|
|
|
|
); |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
has usage => ( |
46
|
|
|
|
|
|
|
is => lazy, |
47
|
|
|
|
|
|
|
isa => 'Str', |
48
|
|
|
|
|
|
|
builder => true, |
49
|
|
|
|
|
|
|
); |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
has curried => ( |
52
|
|
|
|
|
|
|
is => ro, |
53
|
|
|
|
|
|
|
isa => 'ArrayRef', |
54
|
|
|
|
|
|
|
); |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
has [ 'is_chainable', 'no_validation_needed' ] => ( |
57
|
|
|
|
|
|
|
is => ro, |
58
|
|
|
|
|
|
|
isa => 'Bool', |
59
|
|
|
|
|
|
|
coerce => true, |
60
|
|
|
|
|
|
|
); |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
has is_mutator => ( |
63
|
|
|
|
|
|
|
is => lazy, |
64
|
|
|
|
|
|
|
isa => 'Bool', |
65
|
|
|
|
|
|
|
coerce => true, |
66
|
|
|
|
|
|
|
default => sub { defined $_[0]{lvalue_template} or $_[0]{template} =~ /«/ } |
67
|
|
|
|
|
|
|
); |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
has allow_getter_shortcuts => ( |
70
|
|
|
|
|
|
|
is => ro, |
71
|
|
|
|
|
|
|
isa => 'Bool', |
72
|
|
|
|
|
|
|
coerce => true, |
73
|
|
|
|
|
|
|
default => true, |
74
|
|
|
|
|
|
|
); |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
has prefer_shift_self => ( |
77
|
|
|
|
|
|
|
is => ro, |
78
|
|
|
|
|
|
|
isa => 'Bool', |
79
|
|
|
|
|
|
|
coerce => true, |
80
|
|
|
|
|
|
|
default => false, |
81
|
|
|
|
|
|
|
); |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
has additional_validation => ( |
84
|
|
|
|
|
|
|
is => ro, |
85
|
|
|
|
|
|
|
isa => 'CodeRef|Str|Undef', |
86
|
|
|
|
|
|
|
); |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
has default_for_reset => ( |
89
|
|
|
|
|
|
|
is => ro, |
90
|
|
|
|
|
|
|
isa => 'CodeRef', |
91
|
|
|
|
|
|
|
); |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
has documentation => ( |
94
|
|
|
|
|
|
|
is => ro, |
95
|
|
|
|
|
|
|
isa => 'Str', |
96
|
|
|
|
|
|
|
); |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
has _examples => ( |
99
|
|
|
|
|
|
|
is => ro, |
100
|
|
|
|
|
|
|
isa => 'CodeRef', |
101
|
|
|
|
|
|
|
); |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
no warnings 'uninitialized'; |
104
|
|
|
|
|
|
|
my $self = shift; |
105
|
|
|
|
|
|
|
if ($self->has_max_args and $self->max_args==0) { |
106
|
|
|
|
|
|
|
return ''; |
107
|
94
|
|
|
94
|
|
40088
|
} |
|
94
|
|
|
|
|
231
|
|
|
94
|
|
|
|
|
130972
|
|
108
|
2271
|
|
|
2271
|
|
3985
|
elsif ($self->min_args==0 and $self->max_args==1) { |
109
|
2271
|
100
|
66
|
|
|
5071
|
return '$arg?'; |
|
|
50
|
66
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
|
|
50
|
|
|
|
|
|
110
|
2053
|
|
|
|
|
6691
|
} |
111
|
|
|
|
|
|
|
elsif ($self->min_args==1 and $self->max_args==1) { |
112
|
|
|
|
|
|
|
return '$arg'; |
113
|
0
|
|
|
|
|
0
|
} |
114
|
|
|
|
|
|
|
elsif ($self->min_args > 0 and $self->max_args > 0) { |
115
|
|
|
|
|
|
|
return sprintf('@min_%d_max_%d_args', $self->min_args, $self->max_args); |
116
|
0
|
|
|
|
|
0
|
} |
117
|
|
|
|
|
|
|
elsif ($self->max_args > 0) { |
118
|
|
|
|
|
|
|
return sprintf('@max_%d_args', $self->max_args); |
119
|
0
|
|
|
|
|
0
|
} |
120
|
|
|
|
|
|
|
return '@args'; |
121
|
|
|
|
|
|
|
} |
122
|
0
|
|
|
|
|
0
|
|
123
|
|
|
|
|
|
|
my ($self, @curried) = @_; |
124
|
218
|
|
|
|
|
679
|
if ($self->has_max_args and @curried > $self->max_args) { |
125
|
|
|
|
|
|
|
die "too many arguments to curry"; |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
my %copy = %$self; |
128
|
1389
|
|
|
1389
|
1
|
4167
|
delete $copy{usage}; |
129
|
1389
|
50
|
66
|
|
|
3690
|
ref($self)->new( |
130
|
0
|
|
|
|
|
0
|
%copy, |
131
|
|
|
|
|
|
|
name => sprintf('%s[curried]', $self->name), |
132
|
1389
|
|
|
|
|
9940
|
max_args => $self->has_max_args ? $self->max_args - @curried : undef, |
133
|
1389
|
|
|
|
|
3948
|
min_args => $self->has_min_args ? $self->min_args - @curried : undef, |
134
|
|
|
|
|
|
|
signature => $self->signature ? do { my @sig = @{$self->{signature}}; splice(@sig,0,scalar(@curried)); \@sig } : undef, |
135
|
|
|
|
|
|
|
curried => \@curried, |
136
|
|
|
|
|
|
|
); |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
1389
|
100
|
|
|
|
8737
|
my $self = shift; |
|
1175
|
100
|
|
|
|
2001
|
|
|
1175
|
100
|
|
|
|
3035
|
|
|
1175
|
|
|
|
|
2710
|
|
|
1175
|
|
|
|
|
5087
|
|
140
|
|
|
|
|
|
|
ref($self)->new(%$self, signature => undef); |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
my $self = shift; |
144
|
|
|
|
|
|
|
ref($self)->new(%$self, is_chainable => 1); |
145
|
0
|
|
|
0
|
1
|
0
|
} |
146
|
0
|
|
|
|
|
0
|
|
147
|
|
|
|
|
|
|
my $me = shift; |
148
|
|
|
|
|
|
|
my $av = $me->additional_validation; |
149
|
|
|
|
|
|
|
return $av if ref $av; |
150
|
18
|
|
|
18
|
1
|
56
|
|
151
|
18
|
|
|
|
|
158
|
my ($lib) = split /:/, $me->name; |
152
|
|
|
|
|
|
|
return sub { |
153
|
|
|
|
|
|
|
my $self = shift; |
154
|
|
|
|
|
|
|
my ($sig_was_checked, $callbacks) = @_; |
155
|
1377
|
|
|
1377
|
|
2416
|
my $ti = "Sub::HandlesVia::HandlerLibrary::$lib"->_type_inspector($callbacks->{isa}); |
156
|
1377
|
|
|
|
|
2689
|
if ($ti and $ti->{trust_mutated} eq 'always') { |
157
|
1377
|
100
|
|
|
|
4088
|
return { code => '1;', env => {} }; |
158
|
|
|
|
|
|
|
} |
159
|
553
|
|
|
|
|
2628
|
if ($ti and $ti->{trust_mutated} eq 'maybe') { |
160
|
|
|
|
|
|
|
return { code => '1;', env => {} }; |
161
|
553
|
|
|
553
|
|
1048
|
} |
162
|
553
|
|
|
|
|
1443
|
return; |
163
|
553
|
|
|
|
|
2857
|
} if $av eq 'no incoming values'; |
164
|
553
|
100
|
66
|
|
|
4355
|
|
165
|
168
|
|
|
|
|
826
|
return; |
166
|
|
|
|
|
|
|
} |
167
|
385
|
100
|
66
|
|
|
1744
|
|
168
|
150
|
|
|
|
|
845
|
my $class = shift; |
169
|
|
|
|
|
|
|
my ($method, $traits) = map { ref($_) eq 'ARRAY' ? $_ : [$_] } @_; |
170
|
235
|
|
|
|
|
837
|
my ($method_name, @curry) = @$method; |
171
|
553
|
50
|
|
|
|
4231
|
|
172
|
|
|
|
|
|
|
my $handler; |
173
|
0
|
|
|
|
|
0
|
my $make_chainable = 0; |
174
|
|
|
|
|
|
|
my $make_loose = 0; |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
if (ref $method_name eq 'CODE') { |
177
|
4219
|
|
|
4219
|
1
|
7882
|
$handler = Sub::HandlesVia::Handler::CodeRef->new( |
178
|
4219
|
100
|
|
|
|
8919
|
name => '__ANON__', |
|
8438
|
|
|
|
|
28414
|
|
179
|
4219
|
|
|
|
|
11853
|
delegated_coderef => $method_name, |
180
|
|
|
|
|
|
|
); |
181
|
4219
|
|
|
|
|
6520
|
} |
182
|
4219
|
|
|
|
|
6449
|
else { |
183
|
4219
|
|
|
|
|
6240
|
if ($method_name =~ /\s*\.\.\.$/) { |
184
|
|
|
|
|
|
|
$method_name =~ s/\s*\.\.\.$//; |
185
|
4219
|
100
|
|
|
|
8605
|
++$make_chainable; |
186
|
1
|
|
|
|
|
13
|
} |
187
|
|
|
|
|
|
|
if ($method_name =~ /^\~\s*/) { |
188
|
|
|
|
|
|
|
$method_name =~ s/^\~\s*//; |
189
|
|
|
|
|
|
|
++$make_loose; |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
if ($method_name =~ /^(.+?)\s*\-\>\s*(.+?)$/) { |
192
|
4218
|
100
|
|
|
|
12455
|
$traits = [$1]; |
193
|
18
|
|
|
|
|
114
|
$method_name = $2; |
194
|
18
|
|
|
|
|
49
|
} |
195
|
|
|
|
|
|
|
} |
196
|
4218
|
50
|
|
|
|
9533
|
|
197
|
0
|
|
|
|
|
0
|
if (not $handler) { |
198
|
0
|
|
|
|
|
0
|
SEARCH: for my $trait (@$traits) { |
199
|
|
|
|
|
|
|
my $class = $trait =~ /:/ |
200
|
4218
|
100
|
|
|
|
10128
|
? $trait |
201
|
3
|
|
|
|
|
12
|
: "Sub::HandlesVia::HandlerLibrary::$trait"; |
202
|
3
|
|
|
|
|
10
|
if ( $class ne $trait ) { |
203
|
|
|
|
|
|
|
local $@; |
204
|
|
|
|
|
|
|
eval "require $class; 1" |
205
|
|
|
|
|
|
|
or warn $@; |
206
|
4219
|
100
|
|
|
|
8827
|
} |
207
|
4218
|
|
|
|
|
8378
|
if ($class->isa('Sub::HandlesVia::HandlerLibrary') and $class->has_handler($method_name)) { |
208
|
4218
|
50
|
|
|
|
12489
|
$handler = $class->get_handler($method_name); |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
} |
211
|
4218
|
50
|
|
|
|
9747
|
} |
212
|
4218
|
|
|
|
|
6521
|
|
213
|
4218
|
50
|
|
|
|
275688
|
if (not $handler) { |
214
|
|
|
|
|
|
|
$handler = Sub::HandlesVia::Handler::Traditional->new(name => $method_name); |
215
|
|
|
|
|
|
|
} |
216
|
4218
|
100
|
66
|
|
|
36285
|
|
217
|
4217
|
|
|
|
|
12062
|
$handler = $handler->curry(@curry) if @curry; |
218
|
|
|
|
|
|
|
$handler = $handler->loose if $make_loose; |
219
|
|
|
|
|
|
|
$handler = $handler->chainable if $make_chainable; |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
return $handler; |
222
|
4219
|
100
|
|
|
|
11104
|
} |
223
|
1
|
|
|
|
|
7
|
|
224
|
|
|
|
|
|
|
my ( $self, %arg ) = @_; |
225
|
|
|
|
|
|
|
my $gen = $arg{code_generator} or die; |
226
|
4219
|
100
|
|
|
|
11873
|
|
227
|
4219
|
50
|
|
|
|
12041
|
$gen->generate_and_install_method( $arg{method_name}, $self ); |
228
|
4219
|
100
|
|
|
|
8214
|
|
229
|
|
|
|
|
|
|
return; |
230
|
4219
|
|
|
|
|
13567
|
} |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
my ($self, %arg ) = @_; |
233
|
|
|
|
|
|
|
my $gen = $arg{code_generator} or die; |
234
|
4219
|
|
|
4219
|
1
|
15341
|
|
235
|
4219
|
50
|
|
|
|
11310
|
my $eval = $gen->_generate_ec_args_for_handler( $arg{method_name}, $self ); |
236
|
|
|
|
|
|
|
my $code = join "\n", @{$eval->{source}}; |
237
|
4219
|
|
|
|
|
15828
|
if ($arg{method_name}) { |
238
|
|
|
|
|
|
|
$code =~ s/sub/sub $arg{method_name}/xs; |
239
|
4219
|
|
|
|
|
83169
|
} |
240
|
|
|
|
|
|
|
if (eval { require Perl::Tidy }) { |
241
|
|
|
|
|
|
|
my $tidy = ''; |
242
|
|
|
|
|
|
|
Perl::Tidy::perltidy( |
243
|
0
|
|
|
0
|
1
|
0
|
source => \$code, |
244
|
0
|
0
|
|
|
|
0
|
destination => \$tidy, |
245
|
|
|
|
|
|
|
); |
246
|
0
|
|
|
|
|
0
|
$code = $tidy; |
247
|
0
|
|
|
|
|
0
|
} |
|
0
|
|
|
|
|
0
|
|
248
|
0
|
0
|
|
|
|
0
|
$code; |
249
|
0
|
|
|
|
|
0
|
} |
250
|
|
|
|
|
|
|
|
251
|
0
|
0
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
252
|
0
|
|
|
|
|
0
|
use Exporter::Shiny qw( handler ); |
253
|
0
|
|
|
|
|
0
|
my $me = shift; |
254
|
|
|
|
|
|
|
return sub { |
255
|
|
|
|
|
|
|
my (%args) = @_%2 ? (template=>@_) : @_; |
256
|
|
|
|
|
|
|
$me->new(%args); |
257
|
0
|
|
|
|
|
0
|
}; |
258
|
|
|
|
|
|
|
} |
259
|
0
|
|
|
|
|
0
|
|
260
|
|
|
|
|
|
|
# XXX: can this be replaced by Blessed trait? |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
4220
|
|
|
our $AUTHORITY = 'cpan:TOBYINK'; |
263
|
|
|
|
|
|
|
our $VERSION = '0.045'; |
264
|
94
|
|
|
94
|
|
1827
|
|
|
94
|
|
|
|
|
1204
|
|
|
94
|
|
|
|
|
1091
|
|
265
|
|
|
|
|
|
|
use Sub::HandlesVia::Mite -all; |
266
|
105
|
|
|
105
|
|
16913
|
extends 'Sub::HandlesVia::Handler'; |
267
|
|
|
|
|
|
|
|
268
|
4374
|
50
|
|
4374
|
|
279362
|
has '+name' => ( required => true ); |
269
|
4374
|
|
|
|
|
22776
|
|
270
|
105
|
|
|
|
|
1199
|
|
271
|
|
|
|
|
|
|
my $self = shift; |
272
|
|
|
|
|
|
|
require B; |
273
|
|
|
|
|
|
|
my $q_name = B::perlstring( $self->name ); |
274
|
|
|
|
|
|
|
return sprintf( |
275
|
|
|
|
|
|
|
'$GET->${\\ '.$q_name.'}( @ARG )', |
276
|
|
|
|
|
|
|
); |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
|
279
|
94
|
|
|
94
|
|
22022
|
|
|
94
|
|
|
|
|
276
|
|
|
94
|
|
|
|
|
832
|
|
280
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:TOBYINK'; |
281
|
|
|
|
|
|
|
our $VERSION = '0.045'; |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
use Sub::HandlesVia::Mite -all; |
284
|
1
|
|
|
1
|
|
4
|
extends 'Sub::HandlesVia::Handler'; |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
has delegated_coderef => ( |
287
|
1
|
|
|
1
|
|
3
|
is => 'ro', |
288
|
1
|
|
|
|
|
7
|
isa => 'CodeRef', |
289
|
1
|
|
|
|
|
7
|
required => true, |
290
|
1
|
|
|
|
|
6
|
); |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
$_[1]{delegated_coderef} or die 'delegated_coderef required'; |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
my ( $self, $env ) = @_; |
297
|
|
|
|
|
|
|
$env->{'$shv_callback'} = \($self->delegated_coderef); |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
|
300
|
94
|
|
|
94
|
|
19020
|
return '$shv_callback->(my $shvtmp = $GET, @ARG)'; |
|
94
|
|
|
|
|
261
|
|
|
94
|
|
|
|
|
1813
|
|
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
1; |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
=pod |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
=encoding utf-8 |
309
|
1
|
|
|
1
|
|
3
|
|
310
|
|
|
|
|
|
|
=head1 NAME |
311
|
|
|
|
|
|
|
|
312
|
2
|
50
|
|
2
|
|
12
|
Sub::HandlesVia::Handler - template for a method that can be delegated to |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
=head1 DESCRIPTION |
315
|
|
|
|
|
|
|
|
316
|
1
|
|
|
1
|
|
4
|
B<< This module is part of Sub::HandlesVia's internal API. >> |
317
|
1
|
|
|
|
|
5
|
It is mostly of interest to people extending Sub::HandlesVia. |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
This module works in conjunction with L<Sub::HandlesVia::CodeGenerator> |
320
|
|
|
|
|
|
|
and subclasses of L<Sub::HandlesVia::Toolkit> to build a string of Perl |
321
|
1
|
|
|
1
|
|
3
|
code which can be compiled into a method to install into your class. |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
=head1 CONSTRUCTORS |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
=head2 C<< new( %attributes ) >> |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
Standard Moose-like constructor. |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
=head2 C<< lookup( $method, $trait ) >> |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
Looks up a method from existing handler libraries. |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
my $h = Sub::HandlesVia::Handler->lookup( 'get', 'Array' ); |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
Curried version: |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
my $h = Sub::HandlesVia::Handler->lookup( [ 'get', 0 ], 'Array' ); |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
The C<< $trait >> may be an arrayref of possible traits. |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
=head1 EXPORTS |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
Nothing is exported by default. |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
=head2 C<< handler %attributes >> |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
Shortcut for the C<new> constructor. |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
use Sub::HandlesVia::Handler 'handler'; |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
my $h = handler( %attr ); |
352
|
|
|
|
|
|
|
# is the same as |
353
|
|
|
|
|
|
|
my $h = Sub::HandlesVia::Handler->new( %attr ); |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
=head2 C<< name >> B<< Str >> |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
The name of the function being delegated to. |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
=head2 C<< is_mutator >> B<Bool> |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
Indicates whether this handler might mutate an attribute value. |
364
|
|
|
|
|
|
|
The default is to try to detect it based on analysis of the templates. |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
=head2 C<< template >> B<< Str >> |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
Specially formatted string (see section below) containing the Perl code |
369
|
|
|
|
|
|
|
to implement the method. |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
=head2 C<< lvalue_template >> B<< Maybe[Str] >> |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
If defined, a shortcut for implementing it when the attribute slot |
374
|
|
|
|
|
|
|
value can be used as an lvalue. |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
=head2 C<< args >> B<< Maybe[PositiveOrZeroInt] >> |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
The number of arguments which the method being generated expects |
379
|
|
|
|
|
|
|
(does not include the attibute value itself). |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
=head2 C<< min_args >> and C<< max_args >> B<< Maybe[PositiveOrZeroInt] >> |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
For methods which take a variable number of arguments. If omitted, default |
384
|
|
|
|
|
|
|
to C<args>. |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
=head2 C<< signature >> B<< Maybe[ArrayRef[TypeTiny]] >> |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
A signature for said arguments. |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
=head2 C<< usage >> B<< Str >> |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
A signature to show in documentation, like C<< '$index, $value' >>. |
393
|
|
|
|
|
|
|
If not provided, will be generated magically from C<args>, C<min_args>, |
394
|
|
|
|
|
|
|
and C<max_args>. |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
=head2 C<< curried >> B<< Maybe[ArrayRef[Item]] >> |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
An arrayref of curried arguments. |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
=head2 C<< is_chainable >> B<Bool> |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
Whether to force the generated method to be chainable. |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
=head2 C<< no_validation_needed >> B<Bool> |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
Whether to do less validation of input data. |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
=head2 C<< default_for_reset >> B<< Maybe[Str] >> |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
If this handler has to "reset" an attribute value to its default, |
411
|
|
|
|
|
|
|
and the attribute doesn't have a default, this string of Perl code |
412
|
|
|
|
|
|
|
is evaluated to provide a default. An example might be C<< "[]" >>. |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
=head2 C<< prefer_shift_self >> B<Bool> |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
Indicates this handler would prefer the code generator to shift |
417
|
|
|
|
|
|
|
C<< $self >> off C<< @_ >>. |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
=head2 C<< documentation >> B<< Maybe[Str] >> |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
String of pod to describe the handler. |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
=head2 C<< _examples >> B<< Maybe[CodeRef] >> |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
This coderef, if called with parameters C<< $class >>, C<< $attr >>, and |
426
|
|
|
|
|
|
|
C<< $method >>, will generate a code example to insert into the pod. |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
=head2 C<< additional_validation >> B<< Maybe[CodeRef] >> |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
Coderef providing a slightly annoying API. To be described later. |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
=head2 C<< allow_getter_shortcuts >> B<Bool> |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
Defaults to true. Rarely useful to override. |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
=head1 METHODS |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
=head2 C<< has_min_args() >> and C<< has_max_args() >> |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
Indicate whether this handler has a defined min or max args. |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
=head2 C<< install_method( %args ) >> |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
The required arguments are C<method_name> and C<code_generator>. |
445
|
|
|
|
|
|
|
Installs the delegated method into the target class (taken from |
446
|
|
|
|
|
|
|
the code generator). |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
=head2 C<< code_as_string( %args ) >> |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
Same required arguments as C<install_method>, but returns the Perl |
451
|
|
|
|
|
|
|
code for the method as a string. |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
=head2 C<< curry( @args ) >> |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
Pseudo-constructor. |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
Creates a new Sub::HandlesVia::Handler object like this one, but |
458
|
|
|
|
|
|
|
with the given arguments curried. |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
=head2 C<< loose >> |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
Pseudo-constructor. |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
Creates a new Sub::HandlesVia::Handler object like this one, but |
465
|
|
|
|
|
|
|
with looser argument validation. |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
=head2 C<< chainable >> |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
Pseudo-constructor. |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
Creates a new Sub::HandlesVia::Handler object like this one, but |
472
|
|
|
|
|
|
|
chainable. |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
=head1 TEMPLATE FORMAT |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
The template is a string of Perl code, except if the following special |
477
|
|
|
|
|
|
|
things are found in it, they are substituted. |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
=over |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
=item C<< $SELF >> |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
The invocant. |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
=item C<< $SLOT >> |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
Direct hashref access for the attribute. |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
=item C<< $GET >> |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
The current value of the attribute. |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
=item C<< @ARG >> |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
Any additional arguments passed to the delegated method. |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
C<< $ARG[$n] >> will also work. |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
=item C<< #ARG >> |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
The number of additional arguments passed to the delegated method. |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
=item C<< $ARG >> |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
The first element in C<< @ARG >>. |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
=item C<< $DEFAULT >> |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
The attribute's default value, if known. |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
=item C<< « EXPR » >> |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
An expression in double angled quotes sets the attribute's value to the |
514
|
|
|
|
|
|
|
expression. |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
=back |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
For example, a handler to halve the value of a numeric attribute might be: |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
'Sub::HandlesVia::Handler'->new( |
521
|
|
|
|
|
|
|
name => 'MyNumber:halve', |
522
|
|
|
|
|
|
|
args => 0, |
523
|
|
|
|
|
|
|
template => '« $GET / 2 »', |
524
|
|
|
|
|
|
|
lvalue_template => '$GET /= 2', |
525
|
|
|
|
|
|
|
); |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
=head1 SUBCLASSES |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
Sub::HandlesVia::Handler::Traditional and Sub::HandlesVia::Handler::CodeRef |
530
|
|
|
|
|
|
|
are provided. See source code for this module for more info. |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
=head1 BUGS |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
Please report any bugs to |
535
|
|
|
|
|
|
|
L<https://github.com/tobyink/p5-sub-handlesvia/issues>. |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
=head1 SEE ALSO |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
L<Sub::HandlesVia>. |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
=head1 AUTHOR |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
Toby Inkster E<lt>tobyink@cpan.orgE<gt>. |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENCE |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
This software is copyright (c) 2020, 2022 by Toby Inkster. |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
550
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
=head1 DISCLAIMER OF WARRANTIES |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED |
555
|
|
|
|
|
|
|
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF |
556
|
|
|
|
|
|
|
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. |
557
|
|
|
|
|
|
|
|