line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Sub::Multi::Tiny::Util; |
2
|
|
|
|
|
|
|
|
3
|
19
|
|
|
19
|
|
2280162
|
use 5.006; |
|
19
|
|
|
|
|
140
|
|
4
|
19
|
|
|
19
|
|
99
|
use strict; |
|
19
|
|
|
|
|
36
|
|
|
19
|
|
|
|
|
313
|
|
5
|
19
|
|
|
19
|
|
248
|
use warnings; |
|
19
|
|
|
|
|
55
|
|
|
19
|
|
|
|
|
591
|
|
6
|
|
|
|
|
|
|
|
7
|
19
|
|
|
19
|
|
112
|
use Exporter qw(import); |
|
19
|
|
|
|
|
35
|
|
|
19
|
|
|
|
|
881
|
|
8
|
|
|
|
|
|
|
use vars::i [ |
9
|
18
|
|
|
|
|
143
|
'$VERBOSE' => 0, # Set this to a positive int for extra output on STDERR |
10
|
|
|
|
|
|
|
'@EXPORT' => [], |
11
|
|
|
|
|
|
|
'@EXPORT_OK' => [qw(_carp _croak _hlog _line_mark_string |
12
|
|
|
|
|
|
|
_make_positional_copier _complete_dispatcher |
13
|
|
|
|
|
|
|
*VERBOSE)], |
14
|
19
|
|
|
18
|
|
2220
|
]; |
|
18
|
|
|
|
|
3821
|
|
15
|
18
|
|
|
18
|
|
18054
|
use vars::i '%EXPORT_TAGS' => { all => [@EXPORT, @EXPORT_OK] }; |
|
18
|
|
|
|
|
33
|
|
|
18
|
|
|
|
|
98
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
our $VERSION = '0.000012'; # TRIAL |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# Documentation {{{1 |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 NAME |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
Sub::Multi::Tiny::Util - Internal utilities for Sub::Multi::Tiny |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=head1 SYNOPSIS |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
Used by L<Sub::Multi::Tiny>. |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=head1 VARIABLES |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
=head2 $VERBOSE |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
Set this truthy for extra debug output. L<Sub::Multi::Tiny/import> sets this |
35
|
|
|
|
|
|
|
based on environment variable C<SUB_MULTI_TINY_VERBOSE>. |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
=head1 FUNCTIONS |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=cut |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
# }}}1 |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=head2 _croak |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
As L<Carp/croak>, but lazily loads L<Carp>. |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=cut |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
sub _croak { |
50
|
0
|
|
|
0
|
|
0
|
require Carp; |
51
|
0
|
|
|
|
|
0
|
goto &Carp::croak; |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
=head2 _carp |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
As L<Carp/carp>, but lazily loads L<Carp>. |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
=cut |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub _carp { |
61
|
0
|
|
|
0
|
|
0
|
require Carp; |
62
|
0
|
|
|
|
|
0
|
goto &Carp::carp; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=head2 _line_mark_string |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
Add a C<#line> directive to a string. Usage: |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
my $str = _line_mark_string <<EOT ; |
70
|
|
|
|
|
|
|
$contents |
71
|
|
|
|
|
|
|
EOT |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
or |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
my $str = _line_mark_string __FILE__, __LINE__, <<EOT ; |
76
|
|
|
|
|
|
|
$contents |
77
|
|
|
|
|
|
|
EOT |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
In the first form, information from C<caller> will be used for the filename |
80
|
|
|
|
|
|
|
and line number. |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
The C<#line> directive will point to the line after the C<_line_mark_string> |
83
|
|
|
|
|
|
|
invocation, i.e., the first line of C<$contents>. Generally, C<$contents> will |
84
|
|
|
|
|
|
|
be source code, although this is not required. |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
C<$contents> must be defined, but can be empty. |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
=cut |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
sub _line_mark_string { |
91
|
305
|
|
|
305
|
|
416
|
my ($contents, $filename, $line); |
92
|
305
|
50
|
|
|
|
513
|
if(@_ == 1) { |
|
|
0
|
|
|
|
|
|
93
|
305
|
|
|
|
|
380
|
$contents = $_[0]; |
94
|
305
|
|
|
|
|
787
|
(undef, $filename, $line) = caller; |
95
|
|
|
|
|
|
|
} elsif(@_ == 3) { |
96
|
0
|
|
|
|
|
0
|
($filename, $line, $contents) = @_; |
97
|
|
|
|
|
|
|
} else { |
98
|
0
|
|
|
|
|
0
|
_croak "Invalid invocation"; |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
305
|
50
|
|
|
|
615
|
_croak "Need text" unless defined $contents; |
102
|
305
|
50
|
33
|
|
|
781
|
die "Couldn't get location information" unless $filename && $line; |
103
|
|
|
|
|
|
|
|
104
|
305
|
|
|
|
|
1548
|
$filename =~ s/"/-/g; |
105
|
305
|
|
|
|
|
344
|
++$line; |
106
|
|
|
|
|
|
|
|
107
|
305
|
|
|
|
|
3002
|
return <<EOT; |
108
|
|
|
|
|
|
|
#line $line "$filename" |
109
|
|
|
|
|
|
|
$contents |
110
|
|
|
|
|
|
|
EOT |
111
|
|
|
|
|
|
|
} #_line_mark_string() |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=head2 _hlog |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
Log information if L</$VERBOSE> is set. Usage: |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
_hlog { <list of things to log> } [optional min verbosity level (default 1)]; |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
The items in the list are joined by C<' '> on output, and a C<'\n'> is added. |
120
|
|
|
|
|
|
|
Each line is prefixed with C<'# '> for the benefit of test runs. |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
The list is in C<{}> so that it won't be evaluated if logging is turned off. |
123
|
|
|
|
|
|
|
It is a full block, so you can run arbitrary code to decide what to log. |
124
|
|
|
|
|
|
|
If the block returns an empty list, C<_hlog> will not produce any output. |
125
|
|
|
|
|
|
|
However, if the block returns at least one element, C<_hlog> will produce at |
126
|
|
|
|
|
|
|
least a C<'# '>. |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
The message will be output only if L</$VERBOSE> is at least the given minimum |
129
|
|
|
|
|
|
|
verbosity level (1 by default). |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
If C<< $VERBOSE > 2 >>, the filename and line from which C<_hlog> was called |
132
|
|
|
|
|
|
|
will also be printed. |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
B<Caution:> Within the C<{ }> block, C<@_> is the arguments I<to that block>, |
135
|
|
|
|
|
|
|
not the arguments to the calling function. To log C<@_>, use something like: |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
my $argref = \@_; |
138
|
|
|
|
|
|
|
_hlog { @$argref }; |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=cut |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
sub _hlog (&;$) { |
143
|
285
|
100
|
100
|
285
|
|
942
|
return unless $VERBOSE >= ($_[1] || 1); |
144
|
|
|
|
|
|
|
|
145
|
227
|
|
|
|
|
296
|
my @log = &{$_[0]}(); |
|
227
|
|
|
|
|
5362
|
|
146
|
227
|
50
|
|
|
|
16268
|
return unless @log; |
147
|
|
|
|
|
|
|
|
148
|
227
|
50
|
|
|
|
731
|
chomp $log[$#log] if $log[$#log]; |
149
|
|
|
|
|
|
|
# TODO add an option to number the lines of the output |
150
|
227
|
|
|
|
|
4811
|
(my $msg = join(' ', @log)) =~ s/^/# /gm; |
151
|
227
|
50
|
|
|
|
983
|
if($VERBOSE>2) { |
152
|
227
|
|
|
|
|
656
|
my ($package, $filename, $line) = caller; |
153
|
227
|
|
|
|
|
633
|
$msg .= " (at $filename:$line)"; |
154
|
|
|
|
|
|
|
} |
155
|
227
|
|
|
|
|
99922
|
print STDERR "$msg\n"; |
156
|
|
|
|
|
|
|
} #_hlog() |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
=head2 _complete_dispatcher |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
Makes a standard dispatcher, given code to initialize certain variables. |
161
|
|
|
|
|
|
|
Usage: |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
my $code = "..."; # See requirements below |
164
|
|
|
|
|
|
|
my $subref = _complete_dispatcher($multisub_hashref, $code[, ...]); |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
The C<$code> argument will be inlined as-is into the generated dispatcher. |
167
|
|
|
|
|
|
|
The C<$code> must: |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
=over |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=item * |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
Pick which multisub candidate to use, given args in C<@_>; |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
=item * |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
Put the subref of that candidate in C<$candidate>; and |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=item * |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
Put a subref in C<$copier> of a routine that will copy from C<@_> into |
182
|
|
|
|
|
|
|
the package variables created by L<Sub::Multi::Tiny/import>. |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
Any arguments to C<_complete_dispatcher> after C<$code> are saved in C<my @data>, |
185
|
|
|
|
|
|
|
which C<$code> can access. |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
=back |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
C<$code> is run under L<strict> and L<warnings> by default. If you don't |
190
|
|
|
|
|
|
|
want those, you need to expressly turn them off. |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=cut |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
sub _complete_dispatcher { |
195
|
10
|
|
|
10
|
|
30
|
my ($hr, $inner_code, @data) = @_; |
196
|
10
|
|
|
|
|
22
|
my $argref = \@_; |
197
|
10
|
|
|
|
|
20
|
my $caller = caller; |
198
|
10
|
|
|
10
|
|
48
|
_hlog { require Data::Dumper; |
199
|
10
|
|
|
|
|
66
|
"_complete_dispatcher making $caller dispatcher with args:", |
200
|
10
|
|
|
|
|
47
|
Data::Dumper->Dump($argref, [qw(multisub inner_code data)]) }; |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
# Make the dispatcher |
203
|
10
|
|
|
|
|
105
|
my $code = _line_mark_string <<EOT; |
204
|
7
|
|
|
7
|
|
45
|
use strict; |
|
7
|
|
|
1
|
|
13
|
|
|
7
|
|
|
1
|
|
131
|
|
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
119
|
|
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
97
|
|
205
|
33
|
|
|
7
|
|
184
|
use warnings; |
|
33
|
|
|
1
|
|
134
|
|
|
33
|
|
|
1
|
|
1158
|
|
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
16
|
|
206
|
|
|
|
|
|
|
sub { |
207
|
|
|
|
|
|
|
# Find the candidate |
208
|
27
|
|
|
1
|
|
62
|
my (\$candidate, \$copier); |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
$inner_code |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
# Save the present values of the parameters |
213
|
|
|
|
|
|
|
EOT |
214
|
|
|
|
|
|
|
|
215
|
10
|
|
|
|
|
21
|
my $restore = ''; |
216
|
10
|
|
|
|
|
18
|
foreach(keys %{$hr->{possible_params}}) { |
|
10
|
|
|
|
|
38
|
|
217
|
15
|
|
|
|
|
75
|
my ($sigil, $name) = /^(.)(.+)$/; |
218
|
15
|
|
|
|
|
81
|
$code .= _line_mark_string |
219
|
27
|
|
|
|
|
10138
|
"my ${sigil}saved_${name} = ${sigil}$hr->{defined_in}\::${name};\n"; |
|
27
|
|
|
|
|
120
|
|
220
|
15
|
|
|
|
|
68
|
$restore .= _line_mark_string |
221
|
1
|
|
|
1
|
|
2
|
"${sigil}$hr->{defined_in}\::${name} = ${sigil}saved_${name};\n"; |
|
1
|
|
|
|
|
134
|
|
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
|
224
|
10
|
|
|
|
|
86
|
$code .= _line_mark_string <<EOT; |
225
|
1
|
|
|
|
|
4
|
# Create the guard |
226
|
|
|
|
|
|
|
my \$guard = Guard::guard { |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
$restore |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
}; #End of guard |
231
|
|
|
|
|
|
|
EOT |
232
|
|
|
|
|
|
|
|
233
|
10
|
|
|
|
|
27
|
$code .= _line_mark_string <<'EOT'; |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
# Copy the parameters into the variables the candidate |
236
|
|
|
|
|
|
|
# will access them from |
237
|
1
|
|
|
|
|
6
|
&$copier; # $copier gets @_ automatically |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
# Pass the guard so the parameters will be reset once \$candidate |
240
|
|
|
|
|
|
|
# finishes running. |
241
|
1
|
|
|
|
|
2
|
@_ = ($guard); |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
# Invoke the selected candidate |
244
|
1
|
|
|
|
|
16
|
goto &$candidate; |
245
|
|
|
|
|
|
|
} #dispatcher |
246
|
|
|
|
|
|
|
EOT |
247
|
|
|
|
|
|
|
|
248
|
10
|
|
|
47
|
|
55
|
_hlog { $caller, "dispatcher for $hr->{defined_in}\():\n$code\n" } 2; |
|
10
|
|
|
|
|
61
|
|
249
|
10
|
|
|
|
|
434
|
my $sub = eval $code; |
250
|
10
|
50
|
|
|
|
43
|
die "Could not create dispatcher for $hr->{defined_in}: $@" if $@; |
251
|
10
|
|
|
|
|
78
|
return $sub; |
252
|
|
|
|
|
|
|
} # _complete_dispatcher |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
=head2 _make_positional_copier |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
Make a sub to copy from @_ into package variables. The resulting sub copies |
257
|
|
|
|
|
|
|
positional parameters. Usage: |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
my $coderef = _make_positional_copier($defined_in, $impl_hashref); |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
The copier is run under L<strict> and L<warnings>, for what it's worth. |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
=cut |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
our $_positional_copier_invocation_number = 0; # DEBUG |
266
|
|
|
|
|
|
|
sub _make_positional_copier { |
267
|
62
|
|
|
83
|
|
6874
|
my ($defined_in, $impl) = @_; |
268
|
25
|
|
|
|
|
62
|
my $argref = \@_; # For hlogging |
269
|
|
|
|
|
|
|
|
270
|
25
|
|
|
|
|
38
|
my @vars; #DEBUG |
271
|
|
|
|
|
|
|
|
272
|
44
|
|
|
25
|
|
169
|
_hlog { require Data::Dumper; |
273
|
25
|
|
|
|
|
104
|
Data::Dumper->Dump($argref,[qw(mpc_defined_in mpc_impl)]) } 2; |
|
57
|
|
|
|
|
221
|
|
274
|
|
|
|
|
|
|
|
275
|
60
|
|
|
|
|
343
|
my $code = _line_mark_string <<'EOT'; |
276
|
14
|
|
|
10
|
|
76
|
use strict; |
|
13
|
|
|
7
|
|
1080
|
|
|
10
|
|
|
1
|
|
219
|
|
|
10
|
|
|
1
|
|
61
|
|
|
10
|
|
|
1
|
|
54
|
|
|
10
|
|
|
1
|
|
173
|
|
|
1
|
|
|
1
|
|
4
|
|
|
1
|
|
|
1
|
|
2
|
|
|
1
|
|
|
|
|
124
|
|
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
105
|
|
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
143
|
|
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
139
|
|
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
131
|
|
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
122
|
|
277
|
10
|
|
|
10
|
|
41
|
use warnings; |
|
10
|
|
|
7
|
|
16
|
|
|
13
|
|
|
1
|
|
1754
|
|
|
10
|
|
|
1
|
|
1188
|
|
|
10
|
|
|
1
|
|
28
|
|
|
33
|
|
|
1
|
|
11225
|
|
|
1
|
|
|
1
|
|
6
|
|
|
1
|
|
|
1
|
|
2
|
|
|
1
|
|
|
|
|
15
|
|
|
1
|
|
|
|
|
6
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
16
|
|
|
1
|
|
|
|
|
6
|
|
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
15
|
|
|
1
|
|
|
|
|
6
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
16
|
|
|
1
|
|
|
|
|
6
|
|
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
17
|
|
|
1
|
|
|
|
|
6
|
|
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
18
|
|
278
|
|
|
|
|
|
|
sub { |
279
|
|
|
|
|
|
|
EOT |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
# XXX DEBUG: Some extra output to try to debug failures on earlier Perls. |
282
|
60
|
|
|
|
|
259
|
$code .= _line_mark_string <<'EOT'; |
283
|
|
|
|
|
|
|
if( $] lt '5.018' || $VERBOSE > 1) { |
284
|
|
|
|
|
|
|
require Data::Dumper; |
285
|
|
|
|
|
|
|
require Test::More; |
286
|
|
|
|
|
|
|
Test::More::diag(sprintf("Positional copier invocation %d:\n%s", |
287
|
|
|
|
|
|
|
++$Sub::Multi::Tiny::Util::_positional_copier_invocation_number, |
288
|
|
|
|
|
|
|
Data::Dumper->Dump([\@_],['copier_args']))); |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
EOT |
291
|
|
|
|
|
|
|
|
292
|
60
|
|
|
|
|
5733
|
$code .= _line_mark_string <<'EOT'; |
293
|
|
|
|
|
|
|
( |
294
|
|
|
|
|
|
|
EOT |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
@vars = map { |
297
|
49
|
|
|
|
|
2892
|
my ($sigil, $name) = $_->{name} =~ m/^(.)(.+)$/; |
298
|
49
|
|
|
|
|
6122
|
"${sigil}$defined_in\::${name}" |
299
|
60
|
|
|
|
|
192
|
} @{$impl->{args}}; |
|
42
|
|
|
|
|
846
|
|
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
$code .= join ",\n", |
302
|
25
|
|
|
|
|
98
|
map { _line_mark_string |
|
29
|
|
|
|
|
66
|
|
303
|
|
|
|
|
|
|
" $_" } @vars; |
304
|
|
|
|
|
|
|
|
305
|
25
|
|
|
|
|
59
|
$code .= _line_mark_string <<'EOT'; |
306
|
|
|
|
|
|
|
) = @_; |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
if( $] lt '5.018' || $VERBOSE > 1) { |
309
|
|
|
|
|
|
|
Test::More::diag(sprintf("After positional copier invocation %d:", |
310
|
|
|
|
|
|
|
$Sub::Multi::Tiny::Util::_positional_copier_invocation_number)); |
311
|
|
|
|
|
|
|
Test::More::diag(join "\n", map { |
312
|
|
|
|
|
|
|
sprintf("%s = %s", $_, eval($_)) |
313
|
|
|
|
|
|
|
} @vars); |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
} #copier |
317
|
|
|
|
|
|
|
EOT |
318
|
|
|
|
|
|
|
|
319
|
29
|
|
|
22
|
|
133
|
_hlog { "Copier for $impl->{candidate_name}\():\n", $code } 2; |
|
26
|
|
|
|
|
88
|
|
320
|
29
|
|
|
|
|
1150
|
my $sub = eval $code; |
321
|
29
|
50
|
|
|
|
94
|
die "Could not create copier for $impl->{candidate_name}: $@" if $@; |
322
|
29
|
|
|
|
|
1614
|
return $sub; |
323
|
|
|
|
|
|
|
} #_make_positional_copier |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
1; |
326
|
|
|
|
|
|
|
__END__ |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
# Rest of documentation {{{1 |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
=head1 AUTHOR |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
Chris White E<lt>cxw@cpan.orgE<gt> |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
=head1 LICENSE |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
Copyright (C) 2019 Chris White E<lt>cxw@cpan.orgE<gt> |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
339
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
=cut |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
# }}}1 |
344
|
|
|
|
|
|
|
# vi: set fdm=marker: # |