line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# -*- mode: perl; coding: utf-8 -*- |
2
|
3
|
|
|
3
|
|
11636
|
package YATT::Translator::Perl; use YATT::Inc; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
25
|
|
3
|
3
|
|
|
3
|
|
16
|
use strict; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
85
|
|
4
|
3
|
|
|
3
|
|
14
|
use warnings qw(FATAL all NONFATAL misc); |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
144
|
|
5
|
3
|
|
|
3
|
|
15
|
use Carp; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
266
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
#======================================== |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our %TYPE_MAP; |
10
|
|
|
|
|
|
|
|
11
|
3
|
|
|
3
|
|
15
|
use base qw(YATT::Registry); |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
1663
|
|
12
|
|
|
|
|
|
|
use YATT::Fields [cf_mode => 'render'] |
13
|
3
|
|
|
0
|
|
30
|
, [cf_product => sub {[]}] |
|
0
|
|
|
|
|
0
|
|
14
|
|
|
|
|
|
|
, qw(target_cache |
15
|
|
|
|
|
|
|
delayed_target |
16
|
|
|
|
|
|
|
generating_widget |
17
|
|
|
|
|
|
|
cf_pagevars |
18
|
3
|
|
|
3
|
|
15
|
cf_debug_translator); |
|
3
|
|
|
|
|
6
|
|
19
|
|
|
|
|
|
|
|
20
|
3
|
|
|
3
|
|
15
|
BEGIN {require Exporter; *import = \&Exporter::import} |
|
3
|
|
|
|
|
144
|
|
21
|
|
|
|
|
|
|
our @EXPORT_OK = qw(qqvalue qparen); |
22
|
|
|
|
|
|
|
our @EXPORT = @EXPORT_OK; |
23
|
|
|
|
|
|
|
|
24
|
3
|
|
|
3
|
|
16
|
use YATT::Registry::NS; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
189
|
|
25
|
3
|
|
|
3
|
|
15
|
use YATT::Widget; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
161
|
|
26
|
3
|
|
|
3
|
|
16
|
use YATT::Util qw(checked_eval add_arg_order_in terse_dump coalesce); |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
220
|
|
27
|
3
|
|
|
|
|
294
|
use YATT::LRXML::Node qw(node_path node_body node_name |
28
|
|
|
|
|
|
|
node_size node_flag |
29
|
|
|
|
|
|
|
node_children |
30
|
|
|
|
|
|
|
create_node |
31
|
|
|
|
|
|
|
stringify_node |
32
|
3
|
|
|
3
|
|
16
|
TEXT_TYPE ELEMENT_TYPE ENTITY_TYPE); |
|
3
|
|
|
|
|
4
|
|
33
|
|
|
|
|
|
|
|
34
|
3
|
|
|
3
|
|
1871
|
use YATT::LRXML::EntityPath; |
|
3
|
|
|
|
|
10
|
|
|
3
|
|
|
|
|
222
|
|
35
|
3
|
|
|
3
|
|
25
|
use YATT::Util::Taint; |
|
3
|
|
|
|
|
84
|
|
|
3
|
|
|
|
|
314
|
|
36
|
3
|
|
|
3
|
|
18
|
use YATT::Util::Symbol qw(declare_alias); |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
7605
|
|
37
|
|
|
|
|
|
|
require YATT::ArgMacro; |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
#======================================== |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
sub qqvalue ($); |
42
|
|
|
|
|
|
|
sub qparen ($); |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
#======================================== |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
sub after_configure { |
47
|
14
|
|
|
14
|
0
|
33
|
my MY $trans = shift; |
48
|
14
|
|
|
|
|
84
|
$trans->SUPER::after_configure; |
49
|
14
|
|
50
|
|
|
150
|
$trans->{cf_type_map} ||= \%TYPE_MAP; |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
sub emit { |
53
|
142
|
|
|
142
|
0
|
293
|
my MY $gen = shift; |
54
|
142
|
|
|
|
|
210
|
my $script = join "", @{$gen->{cf_product}}; |
|
142
|
|
|
|
|
503
|
|
55
|
142
|
|
|
|
|
327
|
$gen->{cf_product} = []; |
56
|
142
|
|
|
|
|
651
|
$script; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
#======================================== |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
sub call_handler { |
62
|
31
|
|
|
31
|
0
|
108
|
(my MY $trans, my ($method, $widget_path)) = splice @_, 0, 3; |
63
|
31
|
50
|
|
|
|
189
|
my ($handler, $pkg) = $trans->get_handler_to |
64
|
|
|
|
|
|
|
($method, ref $widget_path ? @$widget_path : split /[:\.]/, $widget_path); |
65
|
11
|
|
|
|
|
51
|
&YATT::break_handler; |
66
|
11
|
|
|
|
|
5388
|
$handler->($pkg, @_); |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
sub parse_elempath { |
70
|
161
|
|
|
161
|
0
|
405
|
my ($pack, @elpath) = @_; |
71
|
161
|
100
|
|
|
|
471
|
if (@elpath == 1) { |
72
|
142
|
50
|
|
|
|
332
|
if (ref $elpath[0]) { |
73
|
0
|
|
|
|
|
0
|
@elpath = @{$elpath[0]}; |
|
0
|
|
|
|
|
0
|
|
74
|
|
|
|
|
|
|
} else { |
75
|
142
|
|
|
|
|
421
|
@elpath = split '/', $elpath[0]; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
# root dir should be ignored. |
80
|
161
|
50
|
33
|
|
|
1068
|
shift @elpath if !defined $elpath[0] || $elpath[0] eq ''; |
81
|
|
|
|
|
|
|
|
82
|
161
|
|
|
|
|
565
|
@elpath; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
sub get_handler_to { |
86
|
161
|
|
|
161
|
0
|
401
|
(my MY $trans, my ($method)) = splice @_, 0, 2; |
87
|
161
|
|
|
|
|
559
|
my @elpath = $trans->parse_elempath(@_); |
88
|
|
|
|
|
|
|
|
89
|
161
|
|
|
|
|
231
|
my @result; |
90
|
161
|
50
|
|
|
|
315
|
if (wantarray) { |
91
|
161
|
|
|
|
|
488
|
@result = $trans->lookup_handler_to($method, @elpath); |
92
|
|
|
|
|
|
|
} else { |
93
|
0
|
|
|
|
|
0
|
$result[0] = $trans->lookup_handler_to($method, @elpath); |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
141
|
50
|
|
|
|
484
|
unless (@result) { |
97
|
0
|
|
|
|
|
0
|
croak "Can't find widget: " . join(":", @elpath); |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
|
100
|
141
|
50
|
|
|
|
893
|
wantarray ? @result : $result[0]; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
sub lookup_handler_to { |
104
|
161
|
|
|
161
|
0
|
473
|
(my MY $trans, my ($method, @elpath)) = @_; |
105
|
|
|
|
|
|
|
|
106
|
161
|
|
|
|
|
480
|
$trans->{cf_mode} = $method; # XXX: local |
107
|
161
|
|
|
|
|
226
|
@{$trans->{cf_product}} = (); |
|
161
|
|
|
|
|
473
|
|
108
|
|
|
|
|
|
|
|
109
|
161
|
50
|
|
|
|
692
|
my Widget $widget = $trans->get_widget(@elpath) |
110
|
|
|
|
|
|
|
or return; |
111
|
|
|
|
|
|
|
|
112
|
156
|
|
|
|
|
651
|
$trans->ensure_widget_is_generated($widget); |
113
|
142
|
100
|
|
|
|
545
|
if (my $script = $trans->emit) { |
114
|
117
|
50
|
|
|
|
319
|
print STDERR $script if $trans->{cf_debug_translator}; |
115
|
117
|
|
|
|
|
567
|
$trans->checked_eval |
116
|
|
|
|
|
|
|
(join(";" |
117
|
|
|
|
|
|
|
, 'use strict' |
118
|
|
|
|
|
|
|
, 'use warnings FATAL => qw(all)' |
119
|
|
|
|
|
|
|
# XXX: 何が redefine されるかは分からないから… |
120
|
|
|
|
|
|
|
, 'no warnings "redefine"' |
121
|
|
|
|
|
|
|
, untaint_any($script))); |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
} |
124
|
141
|
|
|
|
|
578
|
my ($pkg, $funcname) = $trans->get_funcname_to($method, $widget); |
125
|
141
|
|
|
|
|
1325
|
my $handler = $pkg->can($funcname); |
126
|
|
|
|
|
|
|
|
127
|
141
|
50
|
|
|
|
412
|
return $handler unless wantarray; |
128
|
141
|
|
|
|
|
497
|
($handler |
129
|
|
|
|
|
|
|
, scalar $trans->get_package_from_widget($widget) |
130
|
|
|
|
|
|
|
, $widget); |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
sub get_funcname_to { |
134
|
436
|
|
|
436
|
0
|
871
|
(my MY $trans, my ($mode), my Widget $widget) = @_; |
135
|
436
|
|
|
|
|
1056
|
my $pkg = $trans->get_package_from_widget($widget); |
136
|
436
|
|
|
|
|
1176
|
my $fname = "${mode}_$$widget{cf_name}"; |
137
|
436
|
100
|
|
|
|
1750
|
wantarray ? ($pkg, $fname) : join("::", $pkg, $fname); |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
sub get_package_from_widget { |
141
|
593
|
|
|
593
|
0
|
963
|
(my MY $trans, my Widget $widget) = @_; |
142
|
|
|
|
|
|
|
my $primary = $trans->get_package |
143
|
593
|
|
|
|
|
2160
|
(my Template $tmpl = $trans->nsobj($widget->{cf_template_nsid})); |
144
|
|
|
|
|
|
|
|
145
|
593
|
100
|
|
|
|
2431
|
return $primary unless wantarray; |
146
|
16
|
|
|
|
|
59
|
($primary, $trans->get_rc_package_from_template($tmpl)); |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
sub get_rc_package_from_template { |
150
|
153
|
|
|
153
|
0
|
260
|
(my MY $trans, my Template $tmpl) = @_; |
151
|
153
|
|
|
|
|
573
|
$trans->get_package($trans->nsobj($tmpl->{cf_parent_nsid})); |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
#---------------------------------------- |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
sub generate { |
157
|
0
|
|
|
0
|
0
|
0
|
my MY $gen = shift; |
158
|
0
|
|
|
|
|
0
|
foreach my $elempath (@_) { |
159
|
0
|
0
|
|
|
|
0
|
if (my $widget = $gen->get_widget(@$elempath)) { |
|
|
0
|
|
|
|
|
|
160
|
0
|
|
|
|
|
0
|
$gen->ensure_widget_is_generated($widget); |
161
|
|
|
|
|
|
|
} elsif (my $ns = $gen->get_ns($elempath)) { |
162
|
0
|
|
|
|
|
0
|
$gen->ensure_ns_is_generated($ns); |
163
|
|
|
|
|
|
|
} else { |
164
|
0
|
|
|
|
|
0
|
croak "Invalid widget path: " . join(":", @$elempath); |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
} |
167
|
0
|
|
|
|
|
0
|
$gen->emit; |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
sub mark_delayed_target { |
171
|
0
|
|
|
0
|
0
|
0
|
(my MY $gen, my Widget $widget) = @_; |
172
|
0
|
|
|
|
|
0
|
$gen->{delayed_target}{$widget->{cf_template_nsid}}++; |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
sub ensure_widget_is_generated { |
176
|
243
|
|
|
243
|
0
|
487
|
(my MY $gen, my Widget $widget) = @_; |
177
|
243
|
|
|
|
|
809
|
$gen->ensure_template_is_generated($widget->{cf_template_nsid}); |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
sub ensure_template_is_generated { |
181
|
|
|
|
|
|
|
# (my MY $gen, my $tmplid) = @_; |
182
|
|
|
|
|
|
|
# $tmplid = $tmplid->cget('nsid') if ref $tmplid; |
183
|
246
|
|
|
246
|
0
|
466
|
(my MY $gen, my $id_or_obj) = @_; |
184
|
246
|
|
|
|
|
429
|
(my $tmplid, my Template $tmpl) = do { |
185
|
246
|
50
|
|
|
|
591
|
if (ref $id_or_obj) { |
186
|
0
|
|
|
|
|
0
|
($id_or_obj->cget('nsid'), $id_or_obj) |
187
|
|
|
|
|
|
|
} else { |
188
|
246
|
|
|
|
|
867
|
($id_or_obj, $gen->nsobj($id_or_obj)); |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
}; |
191
|
246
|
100
|
|
|
|
856
|
if (my $baseid = $tmpl->{cf_base_template}) { |
192
|
3
|
|
|
|
|
13
|
$gen->ensure_template_is_generated($baseid); |
193
|
|
|
|
|
|
|
} |
194
|
246
|
100
|
|
|
|
1008
|
unless ($gen->{target_cache}{$tmplid}++) { |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
# eval は? |
197
|
141
|
|
|
|
|
226
|
push @{$$gen{cf_product}} |
|
141
|
|
|
|
|
653
|
|
198
|
|
|
|
|
|
|
, $gen->generate_template($gen->nsobj($tmplid)); |
199
|
|
|
|
|
|
|
} |
200
|
232
|
50
|
|
|
|
420
|
if (my @delayed = keys %{$gen->{delayed_target}}) { |
|
232
|
|
|
|
|
1230
|
|
201
|
0
|
|
|
|
|
0
|
foreach my $nsid (@delayed) { |
202
|
0
|
0
|
|
|
|
0
|
next if $gen->{target_cache}{$nsid}; |
203
|
0
|
|
|
|
|
0
|
delete $gen->{delayed_target}{$nsid}; |
204
|
0
|
|
|
|
|
0
|
$gen->ensure_template_is_generated($nsid); |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
sub forget_template { |
210
|
146
|
|
|
146
|
0
|
317
|
(my MY $gen, my $tmplid) = @_; |
211
|
146
|
50
|
|
|
|
800
|
$tmplid = $tmplid->cget('nsid') if ref $tmplid; |
212
|
146
|
50
|
|
|
|
750
|
delete $gen->{target_cache}{$tmplid} ? 1 : 0; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
my %calling_conv; |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
sub generate_template { |
218
|
141
|
|
|
141
|
0
|
403
|
(my MY $gen, my Template $tmpl) = @_; |
219
|
|
|
|
|
|
|
print STDERR "Generate: $tmpl->{cf_loadkey}\n" |
220
|
141
|
50
|
|
|
|
489
|
if $gen->{cf_debug_translator}; |
221
|
141
|
|
|
|
|
511
|
my $metainfo = $tmpl->metainfo; |
222
|
|
|
|
|
|
|
my @use = map { |
223
|
141
|
50
|
|
|
|
361
|
unless (defined $_) { |
224
|
|
|
|
|
|
|
() |
225
|
141
|
|
|
|
|
428
|
} else { |
226
|
0
|
0
|
|
|
|
0
|
map {"use $_;"} ref $_ ? @$_ : $_ |
|
0
|
|
|
|
|
0
|
|
227
|
|
|
|
|
|
|
} |
228
|
141
|
|
|
|
|
378
|
} $gen->{cf_use}; |
229
|
141
|
|
|
|
|
217
|
my @file_scope = do { |
230
|
141
|
100
|
|
|
|
497
|
if ($gen->{cf_pagevars}) { |
231
|
1
|
|
|
|
|
7
|
$gen->checked_eval(qq{require $gen->{cf_pagevars}}); |
232
|
1
|
|
|
|
|
6
|
push @use, "use $gen->{cf_pagevars} (qw($tmpl->{cf_name}), 1);"; |
233
|
|
|
|
|
|
|
($gen->{cf_pagevars}->build_scope_for($gen, $tmpl->{cf_name}) |
234
|
1
|
|
|
|
|
12
|
, [\%calling_conv]); |
235
|
|
|
|
|
|
|
} else { |
236
|
140
|
|
|
|
|
362
|
\%calling_conv; |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
}; |
239
|
141
|
|
|
|
|
238
|
my @script; |
240
|
141
|
|
|
|
|
230
|
foreach my $widget (@{$tmpl->widget_list}) { |
|
141
|
|
|
|
|
565
|
|
241
|
220
|
|
|
|
|
908
|
push @script, $gen->generate_widget($widget, $metainfo, \@file_scope); |
242
|
|
|
|
|
|
|
} |
243
|
127
|
|
|
|
|
496
|
join("", q{package } . $gen->get_package($tmpl) . ';' |
244
|
|
|
|
|
|
|
, join("",@use) |
245
|
|
|
|
|
|
|
, @script); |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
sub generate_lineinfo { |
249
|
406
|
|
|
406
|
0
|
986
|
(my MY $gen, my Widget $widget, my ($start, $prefix)) = @_; |
250
|
406
|
100
|
|
|
|
1904
|
return if $gen->{cf_no_lineinfo}; |
251
|
|
|
|
|
|
|
sprintf qq{%s#line %d "%s"\n}, $prefix || '' |
252
|
50
|
|
100
|
|
|
428
|
, $start, $widget->{cf_filename}; |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
sub generating_widget { |
256
|
0
|
|
|
0
|
0
|
0
|
my MY $gen = shift; |
257
|
0
|
|
|
|
|
0
|
$gen->{generating_widget}[0]; |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
sub generate_widget { |
261
|
220
|
|
|
220
|
0
|
460
|
(my MY $gen, my Widget $widget, my ($metainfo, $file_scope)) = @_; |
262
|
220
|
|
|
|
|
610
|
local $gen->{generating_widget}[0] = $widget; |
263
|
|
|
|
|
|
|
my @body = $gen->generate_body |
264
|
|
|
|
|
|
|
([{}, $widget->widget_scope($file_scope)] |
265
|
|
|
|
|
|
|
, $widget->cursor(metainfo => $metainfo->clone |
266
|
|
|
|
|
|
|
(startline => $widget->{cf_body_start} |
267
|
220
|
|
|
|
|
1099
|
, caller_widget => $widget))); |
268
|
|
|
|
|
|
|
# body が空の場合もありうる。 |
269
|
206
|
100
|
|
|
|
2410
|
return unless @body; |
270
|
203
|
|
|
|
|
778
|
my ($pkg, $funcname) = $gen->get_funcname_to($gen->{cf_mode}, $widget); |
271
|
|
|
|
|
|
|
join("" |
272
|
|
|
|
|
|
|
, $gen->generate_lineinfo($widget, $widget->{cf_decl_start}, "\n") |
273
|
|
|
|
|
|
|
, $gen->generate_getargs($widget, $metainfo) |
274
|
|
|
|
|
|
|
, $gen->generate_lineinfo($widget, $widget->{cf_body_start}) |
275
|
203
|
|
|
|
|
865
|
, $gen->as_sub |
276
|
|
|
|
|
|
|
($funcname |
277
|
|
|
|
|
|
|
, $gen->genprolog($widget) |
278
|
|
|
|
|
|
|
, $gen->as_statement_list(@body)) |
279
|
|
|
|
|
|
|
, "\n"); |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
sub generate_getargs { |
283
|
203
|
|
|
203
|
0
|
350
|
(my MY $gen, my Widget $widget, my ($metainfo)) = @_; |
284
|
203
|
|
|
|
|
893
|
$gen->as_sub("getargs_$$widget{cf_name}", sprintf q{ |
285
|
|
|
|
|
|
|
my ($call) = shift; |
286
|
|
|
|
|
|
|
$_[0] = shift @$call; shift; |
287
|
|
|
|
|
|
|
my $args = $_[0] = shift @$call; shift; |
288
|
|
|
|
|
|
|
if (ref $args eq 'ARRAY') { |
289
|
|
|
|
|
|
|
%s} else { |
290
|
|
|
|
|
|
|
%s |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
, $gen->gen_getargs_static($widget, $metainfo) |
294
|
|
|
|
|
|
|
, $gen->gen_getargs_dynamic($widget, $metainfo)); |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
sub genprolog { |
298
|
203
|
|
|
203
|
0
|
331
|
(my MY $gen, my Widget $widget) = @_; |
299
|
203
|
|
|
|
|
439
|
my @args = qw($this $args); |
300
|
203
|
100
|
66
|
|
|
750
|
if ($widget->{arg_order} && @{$widget->{arg_order}}) { |
|
161
|
|
|
|
|
808
|
|
301
|
161
|
|
|
|
|
279
|
foreach my $name (@{$widget->{arg_order}}) { |
|
161
|
|
|
|
|
417
|
|
302
|
391
|
|
|
|
|
1000
|
push @args, $widget->{arg_dict}{$name}->as_lvalue |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
sprintf q{getargs_%s(\@_, my (%s))} |
306
|
203
|
|
|
|
|
1384
|
, $$widget{cf_name}, join(", ", @args); |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
sub generate_body { |
310
|
285
|
|
|
285
|
0
|
607
|
(my MY $gen, my ($scope, $cursor)) = @_; |
311
|
285
|
|
|
|
|
826
|
my @code; |
312
|
285
|
|
|
|
|
902
|
for (; $cursor->readable; $cursor->next) { |
313
|
850
|
50
|
|
|
|
2413
|
if (my $sub = $gen->can("trans_" . (my $t = $cursor->node_type_name))) { |
314
|
850
|
|
|
|
|
2074
|
push @code, $sub->($gen, $scope, $cursor); |
315
|
|
|
|
|
|
|
} else { |
316
|
0
|
|
|
|
|
0
|
die $gen->node_error($cursor, "Can't handle node type: %s", $t); |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
} |
319
|
269
|
|
|
|
|
1146
|
@code; |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
sub as_sub { |
323
|
444
|
|
|
444
|
0
|
1202
|
my ($gen, $func_name) = splice @_, 0, 2; |
324
|
444
|
|
|
|
|
1341
|
"sub $func_name ". $gen->as_block(@_); |
325
|
|
|
|
|
|
|
} |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
sub as_block { |
328
|
460
|
|
|
460
|
0
|
796
|
my ($gen) = shift; |
329
|
460
|
50
|
|
|
|
1123
|
return '{}' unless @_; |
330
|
460
|
|
|
|
|
835
|
my $last = pop; |
331
|
460
|
|
|
|
|
666
|
$last .= do { |
332
|
460
|
100
|
|
|
|
2666
|
if ($last =~ s/(\n+)$//) { |
333
|
326
|
|
|
|
|
1038
|
"}$1"; |
334
|
|
|
|
|
|
|
} else { |
335
|
134
|
|
|
|
|
256
|
'}'; |
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
}; |
338
|
460
|
|
|
|
|
3813
|
'{ '.join("; ", @_, $last); |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
sub as_join { |
342
|
14
|
|
|
14
|
0
|
31
|
my MY $gen = shift; |
343
|
14
|
|
|
|
|
23
|
my (@result); |
344
|
14
|
|
|
|
|
34
|
foreach my $trans (@_) { |
345
|
35
|
50
|
|
|
|
70
|
if (ref $trans) { |
346
|
0
|
|
|
|
|
0
|
push @result, qq(YATT::capture {$$trans}); |
347
|
|
|
|
|
|
|
} else { |
348
|
35
|
|
|
|
|
78
|
push @result, $trans; |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
} |
351
|
14
|
|
|
|
|
127
|
sprintf q{join('', %s)}, join ", ", @result; |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
use YATT::Types |
355
|
3
|
|
|
3
|
|
19
|
[queued_joiner => [qw(queue printable last_ws)]]; |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
29
|
|
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
sub YATT::Translator::Perl::queued_joiner::joiner { |
358
|
|
|
|
|
|
|
# 行が変わらない限り、一つの print に入れる。 |
359
|
|
|
|
|
|
|
# 行が変われば、別の print にする。 |
360
|
|
|
|
|
|
|
# 印字可能要素が無いなら、空白をそのまま入れる。 |
361
|
279
|
|
|
279
|
0
|
640
|
(my queued_joiner $me, my ($head)) = splice @_, 0, 2; |
362
|
279
|
|
|
|
|
615
|
my ($line, $prenl, @result, $argc, $nlines) = ('', ''); |
363
|
279
|
|
|
|
|
516
|
foreach my $i (@_) { |
364
|
590
|
100
|
|
|
|
1937
|
unless ($i =~ /\S/) { |
365
|
44
|
50
|
|
|
|
240
|
push @result, $i |
366
|
|
|
|
|
|
|
and next; |
367
|
|
|
|
|
|
|
} |
368
|
546
|
100
|
|
|
|
1041
|
if ($line eq '') { |
369
|
|
|
|
|
|
|
# 先頭 |
370
|
306
|
100
|
|
|
|
1085
|
if ($i =~ s/^(\s+)//) { |
371
|
86
|
|
|
|
|
221
|
$prenl .= $1; |
372
|
|
|
|
|
|
|
} |
373
|
306
|
50
|
|
|
|
747
|
if ($i ne '') { |
374
|
306
|
|
|
|
|
763
|
$line .= $prenl . $head . $i; |
375
|
|
|
|
|
|
|
} |
376
|
|
|
|
|
|
|
} else { |
377
|
|
|
|
|
|
|
# 残り |
378
|
240
|
|
|
|
|
515
|
$line .= ', ' . $i; |
379
|
|
|
|
|
|
|
} |
380
|
546
|
100
|
|
|
|
1602
|
if ($i =~ /\n/) { |
381
|
246
|
|
|
|
|
415
|
push @result, $line; |
382
|
246
|
|
|
|
|
359
|
$line = ''; |
383
|
246
|
|
|
|
|
473
|
$prenl = ''; |
384
|
|
|
|
|
|
|
} |
385
|
|
|
|
|
|
|
} |
386
|
279
|
100
|
|
|
|
704
|
push @result, $line if $line ne ''; |
387
|
279
|
|
|
|
|
747
|
@result; |
388
|
|
|
|
|
|
|
} |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
sub YATT::Translator::Perl::queued_joiner::add { |
391
|
689
|
|
|
689
|
0
|
1066
|
(my queued_joiner $me, my $str) = @_; |
392
|
689
|
|
|
|
|
776
|
push @{$me->{queue}}, $str; |
|
689
|
|
|
|
|
1601
|
|
393
|
689
|
100
|
|
|
|
2024
|
if ($str =~ /\S/) { |
394
|
546
|
|
|
|
|
860
|
$me->{printable}++; |
395
|
546
|
|
|
|
|
1300
|
undef $me->{last_ws}; |
396
|
|
|
|
|
|
|
} else { |
397
|
143
|
|
|
|
|
462
|
$me->{last_ws} = 1; |
398
|
|
|
|
|
|
|
} |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
sub YATT::Translator::Perl::queued_joiner::emit_to { |
402
|
406
|
|
|
406
|
0
|
651
|
(my queued_joiner $me, my ($result)) = @_; |
403
|
406
|
100
|
|
|
|
1104
|
if ($me->{printable}) { |
404
|
279
|
100
|
|
|
|
336
|
my $ws; $ws = pop @{$me->{queue}} if $me->{last_ws}; |
|
279
|
|
|
|
|
790
|
|
|
20
|
|
|
|
|
62
|
|
405
|
279
|
50
|
|
|
|
399
|
push @$result, $me->joiner('print ', @{$me->{queue}}) if @{$me->{queue}}; |
|
279
|
|
|
|
|
841
|
|
|
279
|
|
|
|
|
934
|
|
406
|
279
|
100
|
|
|
|
845
|
$result->[-1] .= $ws if $me->{last_ws}; |
407
|
|
|
|
|
|
|
} else { |
408
|
127
|
100
|
|
|
|
412
|
push @$result, @{$me->{queue}} if $me->{queue}; |
|
87
|
|
|
|
|
247
|
|
409
|
|
|
|
|
|
|
} |
410
|
406
|
|
|
|
|
715
|
undef @{$me->{queue}}; |
|
406
|
|
|
|
|
1108
|
|
411
|
406
|
|
|
|
|
623
|
undef $me->{printable}; |
412
|
406
|
|
|
|
|
704
|
undef $me->{last_ws}; |
413
|
|
|
|
|
|
|
} |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
sub as_statement_list { |
416
|
256
|
|
|
256
|
0
|
401
|
my MY $gen = shift; |
417
|
256
|
|
|
|
|
1631
|
my queued_joiner $queue = queued_joiner->new; |
418
|
256
|
|
|
|
|
461
|
my (@result); |
419
|
256
|
|
|
|
|
555
|
foreach my $trans (@_) { |
420
|
839
|
100
|
|
|
|
1568
|
if (ref $trans) { |
421
|
150
|
|
|
|
|
514
|
$queue->emit_to(\@result); |
422
|
150
|
|
|
|
|
340
|
push @result, $$trans; |
423
|
|
|
|
|
|
|
} else { |
424
|
689
|
|
|
|
|
1533
|
$queue->add($trans); |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
} |
427
|
256
|
|
|
|
|
631
|
$queue->emit_to(\@result); |
428
|
256
|
50
|
|
|
|
1439
|
wantarray ? @result : join('', @result); |
429
|
|
|
|
|
|
|
} |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
#---------------------------------------- |
432
|
|
|
|
|
|
|
# trans_zzz |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
sub trans_comment { |
435
|
0
|
|
|
0
|
0
|
0
|
(my MY $trans, my ($scope, $node)) = @_; |
436
|
0
|
|
|
|
|
0
|
\ ("\n" x $node->node_nlines); |
437
|
|
|
|
|
|
|
} |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
sub trans_text { |
440
|
527
|
|
|
527
|
0
|
976
|
(my MY $trans, my ($scope, $node)) = @_; |
441
|
527
|
|
|
|
|
1577
|
my $body = $node->current; |
442
|
527
|
|
|
|
|
1216
|
my ($pre, $post) = ('', ''); |
443
|
527
|
|
|
|
|
1751
|
my $CRLF = qr{\r?\n}; |
444
|
527
|
100
|
|
|
|
1661
|
if ($node->node_is_beginning) { |
|
|
100
|
|
|
|
|
|
445
|
233
|
100
|
|
|
|
2595
|
$pre = $1 if $body =~ s/^($CRLF+)//; |
446
|
|
|
|
|
|
|
} elsif ($node->node_is_end) { |
447
|
211
|
100
|
100
|
|
|
862
|
if (not $node->has_parent |
448
|
|
|
|
|
|
|
and $node->metainfo->caller_widget->no_last_newline) { |
449
|
35
|
|
|
|
|
343
|
$body =~ s/($CRLF+)$//s; |
450
|
|
|
|
|
|
|
} else { |
451
|
176
|
100
|
|
|
|
1354
|
$post = $2 if $body =~ s/($CRLF)($CRLF+)$/$1/s; |
452
|
|
|
|
|
|
|
} |
453
|
|
|
|
|
|
|
} |
454
|
527
|
|
|
|
|
1052
|
$pre.do { |
455
|
527
|
100
|
|
|
|
2398
|
if ($body eq '') { |
|
|
100
|
|
|
|
|
|
456
|
146
|
|
|
|
|
964
|
'' |
457
|
|
|
|
|
|
|
} elsif ($body =~ /^$CRLF$/) { |
458
|
129
|
|
|
|
|
429
|
sprintf qq{"%s"\n}, qcrlf($body); |
459
|
|
|
|
|
|
|
} else { |
460
|
252
|
|
|
|
|
576
|
qparen($body); |
461
|
|
|
|
|
|
|
} |
462
|
|
|
|
|
|
|
}.$post; |
463
|
|
|
|
|
|
|
} |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
sub trans_pi { |
466
|
17
|
|
|
17
|
0
|
71
|
(my MY $trans, my ($scope, $node)) = @_; |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
# XXX: 処理を許すかどうか、選べるようにすべき。あるいは、mapping が欲しい。 |
469
|
17
|
50
|
|
|
|
66
|
if ($node->node_nsname ne 'perl') { |
470
|
0
|
|
|
|
|
0
|
return ''; |
471
|
|
|
|
|
|
|
} |
472
|
|
|
|
|
|
|
|
473
|
17
|
|
|
|
|
63
|
my $body = $trans->genexpr_node($scope, 0, $node->open); |
474
|
17
|
100
|
|
|
|
183
|
unless ($body =~ s/^(=+)//) { |
|
|
100
|
|
|
|
|
|
475
|
3
|
|
|
|
|
15
|
\ $body; |
476
|
|
|
|
|
|
|
} elsif (length($1) >= 3) { |
477
|
|
|
|
|
|
|
# print without escaping. |
478
|
6
|
|
|
|
|
35
|
\ qq{print $body}; |
479
|
|
|
|
|
|
|
} else { |
480
|
8
|
|
|
|
|
44
|
qq{YATT::escape(do {$body})} |
481
|
|
|
|
|
|
|
} |
482
|
|
|
|
|
|
|
} |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
sub genexpr_node { |
485
|
34
|
|
|
34
|
0
|
71
|
(my MY $trans, my ($scope, $early_escaped, $node)) = @_; |
486
|
34
|
100
|
|
|
|
136
|
join("", map { ref $_ ? $$_ : $trans->dots_for_arrows(my $cp = $_) } |
|
53
|
|
|
|
|
226
|
|
487
|
|
|
|
|
|
|
$trans->mark_vars($scope, $early_escaped, $node)); |
488
|
|
|
|
|
|
|
} |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
#======================================== |
491
|
|
|
|
|
|
|
|
492
|
3
|
|
|
3
|
|
19
|
use YATT::Util::Enum -prefix => 'ENT_', qw(RAW ESCAPED PRINTED); |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
30
|
|
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
sub trans_entity { |
495
|
158
|
|
|
158
|
0
|
359
|
(my MY $trans, my ($scope, $node)) = @_; |
496
|
158
|
|
|
|
|
568
|
$trans->generate_entref($scope, ENT_PRINTED, $node); |
497
|
|
|
|
|
|
|
} |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
sub trans_html { |
500
|
11
|
|
|
11
|
0
|
24
|
(my MY $trans, my ($scope, $node)) = @_; |
501
|
11
|
|
|
|
|
39
|
my $tag = $node->node_name; |
502
|
11
|
|
|
|
|
27
|
my ($string, $tagc, $end) = do { |
503
|
11
|
100
|
|
|
|
48
|
if ($node->is_empty_element) { |
504
|
9
|
|
|
|
|
32
|
("<$tag", " />", ''); |
505
|
|
|
|
|
|
|
} else { |
506
|
2
|
|
|
|
|
11
|
("<$tag", ">", "$tag>"); |
507
|
|
|
|
|
|
|
} |
508
|
|
|
|
|
|
|
}; |
509
|
|
|
|
|
|
|
|
510
|
11
|
|
|
|
|
45
|
my $item = $node->open; |
511
|
11
|
|
|
|
|
19
|
my @script; |
512
|
11
|
|
|
|
|
42
|
for (; $item->readable; $item->next) { |
513
|
24
|
100
|
|
|
|
80
|
last unless $item->is_primary_attribute; |
514
|
22
|
|
|
|
|
71
|
my $name = $item->node_name; |
515
|
22
|
50
|
|
|
|
78
|
if (my $var = $trans->has_pass_through_var($scope, $item, $name)) { |
516
|
0
|
|
|
|
|
0
|
push @script, qparen($string), $var->as_escaped; |
517
|
0
|
|
|
|
|
0
|
$string = ''; |
518
|
0
|
|
|
|
|
0
|
next; |
519
|
|
|
|
|
|
|
} |
520
|
22
|
|
|
|
|
46
|
$string .= ' '; |
521
|
22
|
|
|
|
|
72
|
my ($open, $close) = $item->node_attribute_format; |
522
|
22
|
|
|
|
|
36
|
$string .= $open; |
523
|
|
|
|
|
|
|
# XXX: quote されてないとき、変数推測をしても良いかも。 |
524
|
22
|
|
|
|
|
133
|
for (my $frag = $item->open; $frag->readable; $frag->next) { |
525
|
27
|
|
|
|
|
82
|
my $type = $frag->node_type; |
526
|
27
|
100
|
|
|
|
91
|
if ($type == TEXT_TYPE) { |
|
|
50
|
|
|
|
|
|
527
|
12
|
|
|
|
|
35
|
$string .= $frag->current; |
528
|
|
|
|
|
|
|
} elsif ($type == ENTITY_TYPE) { |
529
|
|
|
|
|
|
|
# should be entity |
530
|
15
|
|
|
|
|
43
|
push @script, qparen($string) |
531
|
|
|
|
|
|
|
, $trans->generate_entref($scope, ENT_ESCAPED, $frag); |
532
|
15
|
|
|
|
|
69
|
$string = ''; |
533
|
|
|
|
|
|
|
} else { |
534
|
0
|
|
|
|
|
0
|
die $trans->node_error($frag, "Invalid node in html attribute"); |
535
|
|
|
|
|
|
|
} |
536
|
|
|
|
|
|
|
} |
537
|
22
|
|
|
|
|
128
|
$string .= $close; |
538
|
|
|
|
|
|
|
} |
539
|
|
|
|
|
|
|
|
540
|
11
|
50
|
|
|
|
42
|
$string .= $tagc if $tagc ne ''; |
541
|
11
|
|
|
|
|
39
|
for (; $item->readable; $item->next) { |
542
|
4
|
100
|
|
|
|
14
|
if ($item->node_type == TEXT_TYPE) { |
543
|
2
|
|
|
|
|
9
|
$string .= $item->current; |
544
|
|
|
|
|
|
|
} else { |
545
|
2
|
|
|
|
|
12
|
push @script, qparen($string), $trans->generate_body($scope, $item); |
546
|
2
|
|
|
|
|
9
|
$string = ''; |
547
|
|
|
|
|
|
|
} |
548
|
|
|
|
|
|
|
} |
549
|
11
|
100
|
|
|
|
37
|
$string .= $end if $end; |
550
|
11
|
50
|
|
|
|
39
|
push @script, qparen($string) if $string ne ''; |
551
|
11
|
|
|
|
|
90
|
@script; |
552
|
|
|
|
|
|
|
} |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
#======================================== |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
my %control = (if => undef, unless => undef); |
557
|
|
|
|
|
|
|
sub trans_element { |
558
|
137
|
|
|
137
|
0
|
380
|
(my MY $trans, my ($scope, $node)) = @_; |
559
|
137
|
|
|
|
|
607
|
my $tmpl = $trans->get_template_from_node($node); |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
# ■ 最初に要素マクロ ← RC から検索。 |
562
|
137
|
100
|
|
|
|
600
|
if (my $macro = $trans->has_element_macro($tmpl, $node, $node->node_path)) { |
563
|
|
|
|
|
|
|
# XXX: ssri:foreach → yatt:foreach も。 |
564
|
23
|
|
|
|
|
107
|
return $macro->($trans, $scope, $node->open); |
565
|
|
|
|
|
|
|
} |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
# ■ 次に if/unless/else, |
568
|
114
|
100
|
|
|
|
545
|
if (my @arm = $trans->collect_arms($node, else => \%control)) { |
569
|
5
|
|
|
|
|
21
|
return $trans->gencall_conditional($scope, @arm); |
570
|
|
|
|
|
|
|
} |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
# ■ 無条件呼び出し |
573
|
109
|
|
|
|
|
392
|
$trans->gencall_always($scope, $node); |
574
|
|
|
|
|
|
|
} |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
sub gencall_conditional { |
577
|
5
|
|
|
5
|
0
|
15
|
(my MY $trans, my ($scope, $ifunless, @elses)) = @_; |
578
|
5
|
|
|
|
|
14
|
my $pkg; |
579
|
5
|
|
|
|
|
10
|
my $script = do { |
580
|
5
|
|
|
|
|
11
|
my ($cond, $action) = @$ifunless; # (node, cursor) |
581
|
|
|
|
|
|
|
sprintf(q{%s (%s) {%s}} |
582
|
|
|
|
|
|
|
, $cond->node_name |
583
|
|
|
|
|
|
|
, $trans->genexpr_node($scope, 0, $cond->open) |
584
|
5
|
|
|
|
|
16
|
, ${ $trans->gencall_always($scope, $action->make_wrapped) }); |
|
5
|
|
|
|
|
24
|
|
585
|
|
|
|
|
|
|
}; |
586
|
|
|
|
|
|
|
|
587
|
5
|
|
|
|
|
49
|
foreach my $arm (@elses) { |
588
|
5
|
|
|
|
|
14
|
my ($cond, $action) = @$arm; |
589
|
5
|
|
|
|
|
9
|
$script .= do { |
590
|
5
|
100
|
|
|
|
18
|
if ($cond) { |
591
|
2
|
|
|
|
|
10
|
sprintf q{ elsif (%s) } |
592
|
|
|
|
|
|
|
, $trans->genexpr_node($scope, 0, $cond->open); |
593
|
|
|
|
|
|
|
} else { |
594
|
3
|
|
|
|
|
8
|
q{ else } |
595
|
|
|
|
|
|
|
} |
596
|
|
|
|
|
|
|
}; |
597
|
|
|
|
|
|
|
$script .= sprintf q{{%s}} |
598
|
5
|
|
|
|
|
17
|
, ${ $trans->gencall_always($scope, $action->make_wrapped) }; |
|
5
|
|
|
|
|
21
|
|
599
|
|
|
|
|
|
|
} |
600
|
5
|
|
|
|
|
35
|
\ $script; |
601
|
|
|
|
|
|
|
} |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
sub gencall_always { |
604
|
119
|
|
|
119
|
0
|
253
|
(my MY $trans, my ($scope, $node)) = @_; |
605
|
|
|
|
|
|
|
|
606
|
119
|
|
|
|
|
408
|
my $tmpl = $trans->get_template_from_node($node); |
607
|
119
|
50
|
|
|
|
424
|
my @elempath = $node->node_path or do { |
608
|
0
|
|
|
|
|
0
|
die $trans->node_error($node, "Empty element path"); |
609
|
|
|
|
|
|
|
}; |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
# ■ 局所引数… これも、型の固有処理に任せる. delegate もここで。 |
612
|
119
|
100
|
|
|
|
479
|
if (my $codevar = $trans->find_codearg($scope, @elempath)) { |
613
|
|
|
|
|
|
|
# ← 特に、親の call の body の中で、 で |
614
|
|
|
|
|
|
|
# 呼ばれるとき, だよね? |
615
|
30
|
|
|
|
|
104
|
return $codevar->gen_call($trans, $scope, $node); |
616
|
|
|
|
|
|
|
} |
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
# ■ さもなければ、通常の Widget の呼び出し |
619
|
89
|
|
|
|
|
367
|
my Widget $widget = $trans->get_widget_from_template($tmpl, @elempath); |
620
|
89
|
100
|
|
|
|
299
|
unless ($widget) { |
621
|
2
|
|
|
|
|
10
|
die $trans->node_error($node, "No such widget"); |
622
|
|
|
|
|
|
|
} |
623
|
87
|
|
|
|
|
343
|
$trans->gencall($widget, $scope, $node->open); |
624
|
|
|
|
|
|
|
} |
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
sub has_unique_argmacro { |
627
|
87
|
|
|
87
|
0
|
175
|
(my MY $trans, my Widget $callee, my Widget $caller) = @_; |
628
|
87
|
100
|
|
|
|
466
|
return unless $callee->{argmacro_dict}; |
629
|
|
|
|
|
|
|
# 現状では、name の重複は無いはず。 |
630
|
19
|
|
|
|
|
43
|
my %suppress; $suppress{$_->call_spec} = 1 for @{$caller->{argmacro_order}}; |
|
19
|
|
|
|
|
40
|
|
|
19
|
|
|
|
|
82
|
|
631
|
19
|
100
|
|
|
|
39
|
my @order = grep {not $suppress{$_->call_spec}} @{$callee->{argmacro_order}} |
|
16
|
|
|
|
|
73
|
|
|
19
|
|
|
|
|
80
|
|
632
|
|
|
|
|
|
|
or return; |
633
|
11
|
|
|
|
|
21
|
my %dict; |
634
|
11
|
|
|
|
|
24
|
foreach my $arg (keys %{$callee->{argmacro_dict}}) { |
|
11
|
|
|
|
|
48
|
|
635
|
45
|
|
|
|
|
104
|
$dict{$arg} = $callee->{argmacro_dict}{$arg}; |
636
|
|
|
|
|
|
|
} |
637
|
11
|
|
|
|
|
69
|
(\%dict, \@order); |
638
|
|
|
|
|
|
|
} |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
sub gencall { |
641
|
87
|
|
|
87
|
0
|
336
|
(my MY $trans, my Widget $widget, my ($scope, $node)) = @_; |
642
|
87
|
|
|
|
|
325
|
$trans->ensure_widget_is_generated($widget); |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
# 引数マクロの抜き出し |
645
|
87
|
100
|
|
|
|
354
|
if (my ($dict, $order) = $trans->has_unique_argmacro |
646
|
|
|
|
|
|
|
($widget, $node->metainfo->caller_widget)) { |
647
|
11
|
|
|
|
|
86
|
$node = YATT::ArgMacro->expand_all_macros |
648
|
|
|
|
|
|
|
($trans, $scope, $node, $widget, $dict, $order); |
649
|
|
|
|
|
|
|
} |
650
|
|
|
|
|
|
|
|
651
|
87
|
|
|
|
|
387
|
my $func = $trans->get_funcname_to($trans->{cf_mode}, $widget); |
652
|
|
|
|
|
|
|
# actual 一覧の作成 |
653
|
87
|
|
|
|
|
403
|
my ($post, @args) = $trans->genargs_static |
654
|
|
|
|
|
|
|
($scope, $node, $widget->arg_specs); |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
# XXX: calling convention 周り |
657
|
|
|
|
|
|
|
return \ sprintf(' %s($this, [%s])%s', $func |
658
|
83
|
100
|
|
|
|
353
|
, join(", ", map {defined $_ ? $_ : 'undef'} @args) |
|
127
|
|
|
|
|
1169
|
|
659
|
|
|
|
|
|
|
, $post); |
660
|
|
|
|
|
|
|
} |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
sub has_single_bare_varexpr { |
663
|
6
|
|
|
6
|
0
|
14
|
(my MY $trans, my ($scope, $node)) = @_; |
664
|
6
|
|
|
|
|
23
|
my $clone = $node->clone($node->clone_path); |
665
|
6
|
|
|
|
|
27
|
my $parent = $clone->parent; |
666
|
6
|
100
|
66
|
|
|
25
|
return unless $parent->is_bare_attribute and $parent->node_size == 1; |
667
|
1
|
|
|
|
|
6
|
my (@expr) = ($trans->mark_vars($scope, ENT_RAW, $clone)); |
668
|
1
|
50
|
33
|
|
|
10
|
return unless @expr and ref $expr[0] eq 'SCALAR'; |
669
|
1
|
|
|
|
|
9
|
$expr[0]; |
670
|
|
|
|
|
|
|
} |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
sub has_pass_through_var { |
673
|
133
|
|
|
133
|
0
|
353
|
(my MY $trans, my ($scope, $args, $name)) = @_; |
674
|
133
|
100
|
|
|
|
452
|
return if $args->node_size >= 2; |
675
|
118
|
100
|
100
|
|
|
353
|
if ($args->node_size == 1 and ($args->node_flag || 0) == 0) { |
|
|
100
|
100
|
|
|
|
|
676
|
|
|
|
|
|
|
# bareword 渡し。 |
677
|
20
|
|
|
|
|
90
|
$trans->find_var($scope, $args->node_body); |
678
|
|
|
|
|
|
|
} elsif ($args->node_size == 0) { |
679
|
|
|
|
|
|
|
# value less 渡し |
680
|
43
|
|
|
|
|
106
|
$trans->find_var($scope, $name); |
681
|
|
|
|
|
|
|
} |
682
|
|
|
|
|
|
|
} |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
sub genargs_static { |
685
|
117
|
|
|
117
|
0
|
303
|
(my MY $trans, my ($scope, $args, $arg_dict, $arg_order, $delegate_vars)) = @_; |
686
|
117
|
|
|
|
|
466
|
my ($body, @actual) = $args->variant_builder; |
687
|
117
|
|
|
|
|
554
|
my ($postnl, $startline) = ('', $args->linenum); |
688
|
117
|
|
|
|
|
437
|
for (my $nth = 0; $args->readable; $args->next) { |
689
|
177
|
100
|
|
|
|
654
|
unless ($args->is_attribute) { |
690
|
75
|
|
|
|
|
212
|
$body->add_node($args->current); |
691
|
75
|
|
|
|
|
241
|
next; |
692
|
|
|
|
|
|
|
} |
693
|
|
|
|
|
|
|
|
694
|
102
|
|
|
|
|
355
|
my ($name, $typename) = $trans->arg_name_types($args); |
695
|
102
|
100
|
|
|
|
290
|
unless (defined $name) { |
696
|
2
|
50
|
|
|
|
10
|
$name = $arg_order->[$nth++] |
697
|
|
|
|
|
|
|
or die $trans->node_error($args, "Too many args"); |
698
|
|
|
|
|
|
|
} |
699
|
102
|
|
|
|
|
225
|
my $argdecl = $arg_dict->{$name}; |
700
|
102
|
50
|
|
|
|
249
|
unless ($argdecl) { |
701
|
0
|
|
|
|
|
0
|
die $trans->node_error($args, "Unknown arg '%s'", $name); |
702
|
|
|
|
|
|
|
} |
703
|
|
|
|
|
|
|
# XXX: $typename (attname:type の type) を活用していない。 |
704
|
|
|
|
|
|
|
# XXX: code 型引数を primary で渡したときにまで、 print が作られてる。 |
705
|
|
|
|
|
|
|
# $args->is_quoted_by_element で判別せよ。 |
706
|
102
|
|
|
|
|
134
|
$actual[$argdecl->argno] = do { |
707
|
102
|
100
|
|
|
|
328
|
if (my $var = $trans->has_pass_through_var($scope, $args, $name)) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
708
|
|
|
|
|
|
|
# XXX: early_escaped が一致するか、検査せよ。 |
709
|
38
|
100
|
|
|
|
130
|
$argdecl->early_escaped ? $var->as_escaped : $var->as_lvalue; |
710
|
|
|
|
|
|
|
} elsif (defined $args->node_body) { |
711
|
60
|
|
|
|
|
255
|
$argdecl->gen_assignable_node($trans, $scope, $args); |
712
|
|
|
|
|
|
|
} elsif ($argdecl->isa($trans->t_scalar)) { |
713
|
3
|
|
|
|
|
13
|
$argdecl->quote_assignable(my $copy = 1); |
714
|
|
|
|
|
|
|
} else { |
715
|
1
|
|
|
|
|
6
|
die $trans->node_error($args, "valueless arg '%s'", $name); |
716
|
|
|
|
|
|
|
} |
717
|
|
|
|
|
|
|
}; |
718
|
|
|
|
|
|
|
} |
719
|
116
|
100
|
66
|
|
|
489
|
if ($body->array_size |
720
|
|
|
|
|
|
|
and my $bodydecl = $arg_dict->{body}) { |
721
|
|
|
|
|
|
|
# if $actual[$bodydecl->argno]; なら、エラーを報告すべきでは? |
722
|
|
|
|
|
|
|
# code か、html か。 |
723
|
35
|
|
|
|
|
130
|
$actual[$bodydecl->argno] |
724
|
|
|
|
|
|
|
= $bodydecl->gen_assignable_node($trans, $scope, $body, 1); |
725
|
|
|
|
|
|
|
} |
726
|
|
|
|
|
|
|
|
727
|
114
|
|
|
|
|
514
|
for (my $i = 0; $i < @$arg_order; $i++) { |
728
|
212
|
100
|
|
|
|
686
|
next if defined $actual[$i]; |
729
|
79
|
|
|
|
|
145
|
my $name = $arg_order->[$i]; |
730
|
79
|
100
|
|
|
|
382
|
if ($delegate_vars->{$name}) { |
|
|
100
|
|
|
|
|
|
731
|
|
|
|
|
|
|
# delegate 宣言では、型は同じになるはず。 |
732
|
|
|
|
|
|
|
# XXX: 引数rename |
733
|
17
|
|
|
|
|
42
|
$actual[$i] = $arg_dict->{$name}->as_lvalue; |
734
|
|
|
|
|
|
|
} elsif ($arg_dict->{$name}->is_required) { |
735
|
1
|
|
|
|
|
5
|
die $trans->node_error($args->parent |
736
|
|
|
|
|
|
|
, "Argument '%s' is missing", $name); |
737
|
|
|
|
|
|
|
} |
738
|
|
|
|
|
|
|
} |
739
|
|
|
|
|
|
|
|
740
|
113
|
100
|
|
|
|
633
|
if ($args->parent->is_empty_element) { |
741
|
80
|
|
|
|
|
273
|
my $diff = $args->parent->linenum(+1) |
742
|
|
|
|
|
|
|
- $startline - $args->count_lines_of(@actual); |
743
|
80
|
100
|
|
|
|
375
|
$postnl = "\n" x $diff if $diff; |
744
|
|
|
|
|
|
|
} else { |
745
|
|
|
|
|
|
|
# XXX: どうする? |
746
|
|
|
|
|
|
|
} |
747
|
113
|
|
|
|
|
1048
|
($postnl, @actual); |
748
|
|
|
|
|
|
|
} |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
sub collect_arms { |
751
|
114
|
|
|
114
|
0
|
262
|
my ($pack, $call, $key, $dict) = @_; |
752
|
114
|
|
|
|
|
459
|
my ($type, $name) = $call->node_headings; |
753
|
114
|
|
|
|
|
445
|
my $args = $call->open; |
754
|
114
|
|
|
|
|
518
|
my ($cond, $body) = $pack->consume_arm($args, $dict, $type, $name |
755
|
|
|
|
|
|
|
, primary_only => 1); |
756
|
114
|
100
|
|
|
|
1068
|
return unless $cond; |
757
|
5
|
|
|
|
|
17
|
my @case = [$cond, $body]; |
758
|
5
|
|
|
|
|
23
|
for (; $args->readable; $args->next) { |
759
|
9
|
100
|
66
|
|
|
30
|
if ($args->is_attribute && $args->node_name eq $key) { |
760
|
5
|
|
|
|
|
21
|
push @case, [$pack->consume_arm($args->open, $dict, $type, $name)]; |
761
|
|
|
|
|
|
|
} else { |
762
|
|
|
|
|
|
|
# XXX: 多分、$case[0] (== $body) |
763
|
4
|
|
|
|
|
17
|
$case[-1][-1]->add_node($args->current); |
764
|
|
|
|
|
|
|
} |
765
|
|
|
|
|
|
|
} |
766
|
5
|
|
|
|
|
37
|
@case; |
767
|
|
|
|
|
|
|
} |
768
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
sub consume_arm { |
770
|
119
|
|
|
119
|
0
|
346
|
my ($trans, $node, $dict, $type, $name, @opts) = @_; |
771
|
119
|
|
|
|
|
509
|
my $arm = $node->variant_builder($type, $name); |
772
|
119
|
|
|
|
|
599
|
my @cond = $arm->filter_or_add_from($node, $dict, @opts); |
773
|
119
|
50
|
|
|
|
372
|
if (@cond >= 2) { |
774
|
|
|
|
|
|
|
die $trans->node_error |
775
|
|
|
|
|
|
|
($node, "Too many condtitions: %s" |
776
|
0
|
|
|
|
|
0
|
, join("", map {stringify_node($_)} @cond)); |
|
0
|
|
|
|
|
0
|
|
777
|
|
|
|
|
|
|
} |
778
|
|
|
|
|
|
|
# $cond[0] は undef かもしれない。 ex. <:else/> |
779
|
|
|
|
|
|
|
|
780
|
119
|
100
|
|
|
|
198
|
my $cond; $cond = $trans->fake_cursor_from($arm, $cond[0]) if defined $cond[0]; |
|
119
|
|
|
|
|
344
|
|
781
|
119
|
|
|
|
|
346
|
($cond, $arm); |
782
|
|
|
|
|
|
|
} |
783
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
#---------------------------------------- |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
sub has_element_macro { |
787
|
137
|
|
|
137
|
0
|
448
|
(my MY $trans, my Template $tmpl, my ($node, @elempath)) = @_; |
788
|
|
|
|
|
|
|
# XXX: macro の一覧は、ちゃんと取り出せるか? |
789
|
|
|
|
|
|
|
|
790
|
137
|
50
|
|
|
|
571
|
if (@elempath > 2) { |
791
|
|
|
|
|
|
|
# Not implemented. |
792
|
0
|
|
|
|
|
0
|
return; |
793
|
|
|
|
|
|
|
} |
794
|
|
|
|
|
|
|
|
795
|
137
|
|
|
|
|
489
|
my $pkg = $trans->get_rc_package_from_template($tmpl); |
796
|
137
|
|
|
|
|
223
|
my $ns; |
797
|
137
|
|
|
|
|
311
|
foreach my $shift (0, 1) { |
798
|
251
|
100
|
|
|
|
811
|
$ns = $trans->strip_ns(\@elempath) if $shift; |
799
|
251
|
|
|
|
|
715
|
my $macro_name = join("_", macro => @elempath); |
800
|
251
|
100
|
66
|
|
|
4056
|
if (my $sub = $pkg->can($macro_name) || $trans->can($macro_name)) { |
801
|
23
|
|
|
|
|
122
|
return $sub; |
802
|
|
|
|
|
|
|
} |
803
|
|
|
|
|
|
|
} |
804
|
|
|
|
|
|
|
} |
805
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
#======================================== |
807
|
|
|
|
|
|
|
# 宣言関連 |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
# XXX: use は perl 固有だから、ここに持たせるのは理にかなう。 |
810
|
|
|
|
0
|
0
|
|
sub declare_use { |
811
|
|
|
|
|
|
|
} |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
sub attr_declare_delegate { |
814
|
7
|
|
|
7
|
0
|
37
|
(my MY $trans, my ($widget, $args, $argname, $subtype, @param)) = @_; |
815
|
7
|
100
|
|
|
|
39
|
my @elempath = $subtype ? @$subtype : $argname; |
816
|
7
|
|
|
|
|
36
|
my Template $tmpl = $trans->get_template_from_node($args); |
817
|
7
|
|
|
|
|
40
|
my Widget $base = $trans->get_widget_from_template($tmpl, @elempath); |
818
|
7
|
50
|
|
|
|
29
|
unless ($base) { |
819
|
0
|
|
|
|
|
0
|
die $trans->node_error($args, "No such widget %s" |
820
|
|
|
|
|
|
|
, join(":", @elempath)); |
821
|
|
|
|
|
|
|
} |
822
|
7
|
50
|
|
|
|
31
|
if ($tmpl->{cf_nsid} != $base->template_nsid) { |
823
|
0
|
|
|
|
|
0
|
$trans->mark_delayed_target($base); |
824
|
|
|
|
|
|
|
} |
825
|
|
|
|
|
|
|
|
826
|
7
|
100
|
|
|
|
29
|
if ($base->{arg_dict}{$argname}) { |
827
|
1
|
|
|
|
|
7
|
die $trans->node_error($args, q{delegate '%1$s' hides argument '%1$s' of widget %2$s} |
828
|
|
|
|
|
|
|
, $argname, join(":", @elempath)); |
829
|
|
|
|
|
|
|
} |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
# pass thru する変数名の一覧。 |
832
|
|
|
|
|
|
|
# でも、未指定なものだけね。 |
833
|
|
|
|
|
|
|
# XXX: 引数rename |
834
|
6
|
|
|
|
|
11
|
my %vars; $vars{$_} = 1 for $widget->copy_specs_from($base); |
|
6
|
|
|
|
|
32
|
|
835
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
# |
837
|
|
|
|
|
|
|
# arg とは別の、コンパイル時のみの仮想的な変数として登録。 |
838
|
|
|
|
|
|
|
# |
839
|
6
|
50
|
|
|
|
29
|
if ($widget->has_virtual_var($argname)) { |
840
|
0
|
|
|
|
|
0
|
die $trans->node_error($args, "Duplicate delegate? %s", $argname); |
841
|
|
|
|
|
|
|
} |
842
|
|
|
|
|
|
|
$widget->add_virtual_var |
843
|
6
|
|
|
|
|
34
|
($argname, $trans->create_var(delegate => $args |
844
|
|
|
|
|
|
|
, base_path => \@elempath |
845
|
|
|
|
|
|
|
, base_widget => $base |
846
|
|
|
|
|
|
|
, delegate_vars => \%vars, @param)); |
847
|
|
|
|
|
|
|
} |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
sub after_define_args { |
850
|
173
|
|
|
173
|
0
|
299
|
(my MY $trans, my ($target)) = @_; |
851
|
173
|
100
|
|
|
|
532
|
unless ($target->has_arg('body')) { |
852
|
154
|
|
|
|
|
550
|
$target->add_arg(body => $trans->create_var('code')); |
853
|
|
|
|
|
|
|
} |
854
|
173
|
|
|
|
|
517
|
$trans; |
855
|
|
|
|
|
|
|
} |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
sub decode_decl_entpath { |
858
|
16
|
|
|
16
|
0
|
33
|
(my MY $trans, my $node) = @_; |
859
|
16
|
|
|
|
|
57
|
my ($has_body, @entpath) |
860
|
|
|
|
|
|
|
= $trans->decode_entpath($node, my $entns = [$node->node_path]); |
861
|
|
|
|
|
|
|
|
862
|
16
|
100
|
|
|
|
56
|
unless ($has_body) { |
863
|
10
|
|
|
|
|
40
|
return $node->node_nsname('', '_'); |
864
|
|
|
|
|
|
|
} |
865
|
|
|
|
|
|
|
|
866
|
6
|
|
|
|
|
12
|
my (@macro_name, $rename_spec); |
867
|
6
|
|
|
|
|
19
|
while (@entpath) { |
868
|
6
|
|
|
|
|
9
|
my ($type, $name, @args) = @{shift @entpath}; |
|
6
|
|
|
|
|
20
|
|
869
|
6
|
50
|
|
|
|
28
|
if ($type eq 'var') { |
|
|
50
|
|
|
|
|
|
870
|
0
|
0
|
|
|
|
0
|
if (@args) { |
871
|
|
|
|
|
|
|
# foo{name,name,...} case. |
872
|
0
|
|
|
|
|
0
|
die $trans->node_nimpl($node); |
873
|
|
|
|
|
|
|
} else { |
874
|
0
|
|
|
|
|
0
|
push @macro_name, $name; |
875
|
|
|
|
|
|
|
} |
876
|
|
|
|
|
|
|
} elsif ($type eq 'call') { |
877
|
6
|
|
|
|
|
13
|
push @macro_name, $name; |
878
|
6
|
|
|
|
|
20
|
foreach my $arg (@args) { |
879
|
6
|
|
|
|
|
16
|
my ($type, $name, @args) = @$arg; |
880
|
6
|
50
|
|
|
|
23
|
if ($type ne 'text') { |
|
|
50
|
|
|
|
|
|
881
|
0
|
|
|
|
|
0
|
die $trans->node_nimpl($node); |
882
|
|
|
|
|
|
|
} elsif ($rename_spec) { |
883
|
0
|
|
|
|
|
0
|
die $trans->node_nimpl($node); # Error: ()() |
884
|
|
|
|
|
|
|
} else { |
885
|
6
|
|
|
|
|
50
|
$rename_spec = [split /=/, $name, 2]; |
886
|
|
|
|
|
|
|
} |
887
|
|
|
|
|
|
|
} |
888
|
|
|
|
|
|
|
} else { |
889
|
0
|
|
|
|
|
0
|
die $trans->nimpl($node); |
890
|
|
|
|
|
|
|
} |
891
|
|
|
|
|
|
|
} |
892
|
|
|
|
|
|
|
|
893
|
6
|
|
|
|
|
29
|
(join("_", @macro_name), $rename_spec); |
894
|
|
|
|
|
|
|
} |
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
# For ArgMacro |
897
|
|
|
|
|
|
|
sub add_decl_entity { |
898
|
51
|
|
|
51
|
0
|
108
|
(my MY $trans, my Widget $widget, my ($node)) = @_; |
899
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
# Widget の configure を呼ぶだけ、のケース ← config(value) でどう? |
901
|
|
|
|
|
|
|
{ |
902
|
51
|
|
|
|
|
200
|
my $is_sysns = $trans->shift_ns_by(yatt => |
903
|
|
|
|
|
|
|
my $entns = [$node->node_path]); |
904
|
51
|
100
|
66
|
|
|
311
|
if ($is_sysns && @$entns == 1) { |
905
|
35
|
50
|
|
|
|
179
|
if ($widget->can_configure($entns->[0])) { |
906
|
35
|
|
|
|
|
126
|
$widget->configure($entns->[0], 1); |
907
|
35
|
|
|
|
|
161
|
return; |
908
|
|
|
|
|
|
|
} |
909
|
|
|
|
|
|
|
} |
910
|
|
|
|
|
|
|
} |
911
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
{ |
913
|
51
|
|
|
|
|
95
|
my ($macro_name, @args) = $trans->decode_decl_entpath($node); |
|
16
|
|
|
|
|
24
|
|
|
16
|
|
|
|
|
58
|
|
914
|
|
|
|
|
|
|
|
915
|
16
|
|
|
|
|
69
|
foreach my $pkg ($trans->get_package_from_widget($widget)) { |
916
|
16
|
|
|
|
|
27
|
my $macro_class = do { |
917
|
16
|
50
|
|
|
|
238
|
my $sub = $pkg->can($macro_name) |
918
|
|
|
|
|
|
|
or next; |
919
|
16
|
|
|
|
|
47
|
$sub->(); |
920
|
|
|
|
|
|
|
}; |
921
|
16
|
50
|
|
|
|
151
|
unless ($macro_class->can('handle')) { |
922
|
0
|
|
|
|
|
0
|
die $trans->node_error |
923
|
|
|
|
|
|
|
($node, "ArgMacro doesn't implement ->handle method: %s" |
924
|
|
|
|
|
|
|
, $node->node_name); |
925
|
|
|
|
|
|
|
} |
926
|
16
|
|
|
|
|
97
|
return $macro_class->register_in($trans, $node, $widget, @args); |
927
|
|
|
|
|
|
|
} |
928
|
|
|
|
|
|
|
} |
929
|
0
|
|
|
|
|
0
|
die $trans->node_error($node, "No such ArgMacro: %s" |
930
|
|
|
|
|
|
|
, $node->node_nsname); |
931
|
|
|
|
|
|
|
} |
932
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
#======================================== |
934
|
|
|
|
|
|
|
# 変数関連 |
935
|
|
|
|
|
|
|
|
936
|
3
|
|
|
|
|
24
|
use YATT::Types [VarType => |
937
|
|
|
|
|
|
|
[qw(cf_varname ^cf_argno ^cf_subtype |
938
|
|
|
|
|
|
|
cf_default cf_default_mode |
939
|
|
|
|
|
|
|
cf_filename cf_linenum |
940
|
|
|
|
|
|
|
)]] |
941
|
3
|
|
|
3
|
|
20
|
, qw(:export_alias); |
|
3
|
|
|
|
|
6
|
|
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
sub find_var { |
944
|
414
|
|
|
414
|
0
|
1074
|
(my MY $trans, my ($scope, $varName)) = @_; |
945
|
414
|
|
|
|
|
1155
|
for (; $scope; $scope = $scope->[1]) { |
946
|
987
|
50
|
|
|
|
2203
|
croak "Undefined varName!" unless defined $varName; |
947
|
987
|
100
|
|
|
|
3810
|
if (defined (my $value = $scope->[0]{$varName})) { |
948
|
275
|
|
|
|
|
1021
|
return $value; |
949
|
|
|
|
|
|
|
} |
950
|
|
|
|
|
|
|
} |
951
|
139
|
|
|
|
|
747
|
return; |
952
|
|
|
|
|
|
|
} |
953
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
sub find_codearg { |
955
|
145
|
|
|
145
|
0
|
546
|
(my MY $trans, my ($scope, @elempath)) = @_; |
956
|
145
|
50
|
|
|
|
453
|
return if @elempath >= 3; |
957
|
145
|
|
|
|
|
551
|
$trans->strip_ns(\@elempath); |
958
|
145
|
50
|
|
|
|
408
|
return unless @elempath == 1; |
959
|
145
|
100
|
|
|
|
526
|
my $var = $trans->find_var($scope, $elempath[0]) |
960
|
|
|
|
|
|
|
or return; |
961
|
40
|
100
|
66
|
|
|
416
|
return unless ref $var and $var->can('arg_specs'); |
962
|
38
|
|
|
|
|
142
|
$var; |
963
|
|
|
|
|
|
|
} |
964
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
sub gen_getargs_static { |
966
|
203
|
|
|
203
|
0
|
515
|
(my MY $gen, my Widget $widget, my ($metainfo)) = @_; |
967
|
203
|
|
|
|
|
293
|
my (@args, %scope); |
968
|
203
|
100
|
|
|
|
637
|
foreach my $name ($widget->{arg_order} ? @{$widget->{arg_order}} : ()) { |
|
161
|
|
|
|
|
539
|
|
969
|
391
|
|
|
|
|
879
|
my VarType $var = $widget->{arg_dict}{$name}; |
970
|
391
|
|
|
|
|
787
|
$scope{$name} = $var; |
971
|
391
|
|
|
|
|
989
|
my $decl = sprintf q{my %s = $_[%d]}, $var->as_lvalue, $$var{cf_argno}; |
972
|
391
|
|
|
|
|
2058
|
my $value = $var->gen_getarg |
973
|
|
|
|
|
|
|
($gen, [\%scope], $widget, $metainfo, qq{\$args->[$$var{cf_argno}]}); |
974
|
391
|
|
|
|
|
1456
|
push @args, "$decl = $value;\n"; |
975
|
|
|
|
|
|
|
} |
976
|
203
|
|
|
|
|
1176
|
join "", @args; |
977
|
|
|
|
|
|
|
} |
978
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
sub gen_getargs_dynamic { |
980
|
203
|
|
|
203
|
0
|
1190
|
''; |
981
|
|
|
|
|
|
|
} |
982
|
|
|
|
|
|
|
|
983
|
|
|
|
|
|
|
sub gen_pass_through_arg_typed { |
984
|
0
|
|
|
0
|
0
|
0
|
(my MY $gen, my ($type, $scope, $baseNC, $targetNode)) = @_; |
985
|
0
|
0
|
|
|
|
0
|
my $node = $targetNode |
986
|
|
|
|
|
|
|
? $gen->fake_cursor_from($baseNC, $targetNode) |
987
|
|
|
|
|
|
|
: $baseNC; |
988
|
0
|
|
|
|
|
0
|
my $name = $node->node_name; |
989
|
0
|
0
|
|
|
|
0
|
if (my $var = $gen->has_pass_through_var($scope, $node, $name)) { |
990
|
0
|
|
|
|
|
0
|
$var->as_lvalue; |
991
|
|
|
|
|
|
|
} else { |
992
|
0
|
|
|
|
|
0
|
$gen->faked_gentype($type => $scope, $node) |
993
|
|
|
|
|
|
|
} |
994
|
|
|
|
|
|
|
} |
995
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
sub try_pass_through { |
997
|
0
|
|
|
0
|
0
|
0
|
(my MY $trans, my ($scope, $cursor, $rawNode, $defaultFlag)) = @_; |
998
|
0
|
0
|
0
|
|
|
0
|
if (node_size($rawNode) == 1 and node_flag($rawNode) == 0 |
|
|
0
|
0
|
|
|
|
|
999
|
|
|
|
|
|
|
and (my $nm = node_body($rawNode)) =~ /^\w+$/) { |
1000
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
# [name=bareword_ident] |
1002
|
|
|
|
|
|
|
# Must be an existing variable. |
1003
|
0
|
0
|
|
|
|
0
|
if (my $var = $trans->find_var($scope, $nm)) { |
1004
|
0
|
|
|
|
|
0
|
$var->as_lvalue; |
1005
|
|
|
|
|
|
|
} else { |
1006
|
0
|
|
|
|
|
0
|
die $trans->node_error($cursor, "No such variable '%s'", $nm); |
1007
|
|
|
|
|
|
|
} |
1008
|
|
|
|
|
|
|
} elsif (node_size($rawNode) == 0) { |
1009
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
# [name] |
1011
|
|
|
|
|
|
|
# variable or flag. |
1012
|
0
|
0
|
|
|
|
0
|
if (my $var = $trans->find_var($scope, my $nm = node_name($rawNode))) { |
|
|
0
|
|
|
|
|
|
1013
|
0
|
|
|
|
|
0
|
$var->as_lvalue; |
1014
|
|
|
|
|
|
|
} elsif (defined $defaultFlag) { |
1015
|
0
|
|
|
|
|
0
|
$defaultFlag |
1016
|
|
|
|
|
|
|
} else { |
1017
|
0
|
|
|
|
|
0
|
die $trans->node_error($cursor, "No such variable '%s'", $nm); |
1018
|
|
|
|
|
|
|
} |
1019
|
|
|
|
|
|
|
} else { |
1020
|
0
|
|
|
|
|
0
|
undef; |
1021
|
|
|
|
|
|
|
} |
1022
|
|
|
|
|
|
|
} |
1023
|
|
|
|
|
|
|
|
1024
|
|
|
|
|
|
|
sub mark_vars { |
1025
|
102
|
|
|
102
|
0
|
233
|
(my MY $trans, my ($scope, $early_escaped, $node)) = @_; |
1026
|
102
|
|
|
|
|
173
|
my @result; |
1027
|
102
|
|
|
|
|
343
|
for (; $node->readable; $node->next) { |
1028
|
149
|
100
|
|
|
|
485
|
if ($node->node_type == TEXT_TYPE) { |
|
|
50
|
|
|
|
|
|
1029
|
|
|
|
|
|
|
# XXX: dots_for_arrows |
1030
|
109
|
|
|
|
|
280
|
push @result, $node->current; |
1031
|
|
|
|
|
|
|
} elsif ($node->node_type == ELEMENT_TYPE) { |
1032
|
0
|
|
|
|
|
0
|
push @result, \ $trans->generate_captured($scope, $node); |
1033
|
|
|
|
|
|
|
} else { |
1034
|
40
|
|
|
|
|
153
|
push @result, \ $trans->generate_entref($scope, $early_escaped, $node); |
1035
|
|
|
|
|
|
|
} |
1036
|
|
|
|
|
|
|
} |
1037
|
102
|
|
|
|
|
463
|
@result; |
1038
|
|
|
|
|
|
|
} |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
sub feed_array_if { |
1041
|
283
|
|
|
283
|
0
|
544
|
(my MY $trans, my ($name, $array)) = @_; |
1042
|
283
|
50
|
|
|
|
652
|
return unless @$array >= 1; |
1043
|
283
|
100
|
|
|
|
1229
|
return unless $array->[0][0] eq $name; |
1044
|
90
|
|
|
|
|
164
|
my $desc = shift @$array; |
1045
|
90
|
50
|
|
|
|
261
|
wantarray ? @{$desc}[1..$#$desc] : $desc; |
|
90
|
|
|
|
|
433
|
|
1046
|
|
|
|
|
|
|
} |
1047
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
# $node の情報を借りながら、@_ を generate. |
1049
|
|
|
|
|
|
|
sub gen_entref_list { |
1050
|
32
|
|
|
32
|
0
|
95
|
(my MY $trans, my ($scope, $node)) = splice @_, 0, 3; |
1051
|
32
|
|
|
|
|
62
|
my @result; |
1052
|
32
|
|
|
|
|
75
|
foreach my $item (@_) { |
1053
|
50
|
100
|
|
|
|
177
|
push @result, $trans->gen_entref_path |
1054
|
|
|
|
|
|
|
($scope, $node |
1055
|
|
|
|
|
|
|
, is_nested_entpath($item) ? @$item : $item); |
1056
|
|
|
|
|
|
|
} |
1057
|
32
|
|
|
|
|
184
|
@result; |
1058
|
|
|
|
|
|
|
} |
1059
|
|
|
|
|
|
|
|
1060
|
|
|
|
|
|
|
sub gen_entref_path { |
1061
|
90
|
|
|
90
|
0
|
262
|
(my MY $trans, my ($scope, $node)) = splice @_, 0, 3; |
1062
|
90
|
|
|
|
|
137
|
my $var; |
1063
|
90
|
|
|
|
|
130
|
my @expr = do { |
1064
|
90
|
100
|
|
|
|
313
|
if (my ($name, @args) = $trans->feed_array_if(call => \@_)) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1065
|
16
|
|
|
|
|
101
|
my $pkg = $trans->get_package_from_node($node); |
1066
|
16
|
|
|
|
|
32
|
my $dont_call; |
1067
|
16
|
|
|
|
|
31
|
my $call = do { |
1068
|
|
|
|
|
|
|
# XXX: codevar は、path の先頭だけ。 |
1069
|
|
|
|
|
|
|
# 引数にも現れるから、 |
1070
|
16
|
100
|
|
|
|
203
|
if ($pkg->can(my $en = "entity_$name")) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1071
|
8
|
|
|
|
|
55
|
sprintf('%s->%s', $pkg, $en); |
1072
|
|
|
|
|
|
|
} elsif ($var = $trans->find_codearg($scope, $name)) { |
1073
|
1
|
|
|
|
|
4
|
sprintf('%1$s && %1$s->', $var->as_lvalue); |
1074
|
|
|
|
|
|
|
} elsif ($var = $trans->find_var($scope, $name)) { |
1075
|
1
|
50
|
|
|
|
7
|
if (my $handler = $var->can("entmacro_")) { |
1076
|
1
|
|
|
|
|
2
|
$dont_call++; |
1077
|
1
|
|
|
|
|
6
|
$handler->($var, $trans, $scope, $node, \@_, [], @args); |
1078
|
|
|
|
|
|
|
} else { |
1079
|
|
|
|
|
|
|
# XXX: 本当は $pkg よりもファイル名を出すべき。 |
1080
|
0
|
|
|
|
|
0
|
die $trans->node_error |
1081
|
|
|
|
|
|
|
($node, "not implemented call '%s' for %s in %s" |
1082
|
|
|
|
|
|
|
, $name, $pkg, $node->node_body); |
1083
|
|
|
|
|
|
|
} |
1084
|
|
|
|
|
|
|
} elsif (my $handler = $trans->can("entmacro_$name")) { |
1085
|
|
|
|
|
|
|
# XXX: $pkg->can の方が、拡張向きで良いのだが… |
1086
|
|
|
|
|
|
|
# 予約語も持ちたい。 |
1087
|
6
|
|
|
|
|
13
|
$dont_call++; |
1088
|
6
|
|
|
|
|
29
|
$handler->($pkg, $trans, $scope, $node, \@_, [], @args); |
1089
|
|
|
|
|
|
|
} else { |
1090
|
0
|
|
|
|
|
0
|
die $trans->node_error($node, "not implemented call '%s' in %s" |
1091
|
|
|
|
|
|
|
, $name, $node->node_body); |
1092
|
|
|
|
|
|
|
} |
1093
|
|
|
|
|
|
|
}; |
1094
|
|
|
|
|
|
|
|
1095
|
16
|
100
|
66
|
|
|
141
|
($dont_call || ref $call) ? $call : sprintf q{(%s(%s))}, $call, join ", " |
1096
|
|
|
|
|
|
|
, $trans->gen_entref_list($scope, $node, @args); |
1097
|
|
|
|
|
|
|
} elsif (($name) = $trans->feed_array_if(var => \@_)) { |
1098
|
35
|
50
|
|
|
|
112
|
unless ($var = $trans->find_var($scope, $name)) { |
1099
|
0
|
|
|
|
|
0
|
die $trans->node_error($node, "No such variable '%s'", $name); |
1100
|
|
|
|
|
|
|
} else { |
1101
|
35
|
|
|
|
|
119
|
$var->as_lvalue; |
1102
|
|
|
|
|
|
|
} |
1103
|
|
|
|
|
|
|
} elsif (($name) = $trans->feed_array_if(expr => \@_)) { |
1104
|
11
|
|
|
|
|
33
|
$name; |
1105
|
|
|
|
|
|
|
} elsif (my @items = $trans->feed_array_if(array => \@_)) { |
1106
|
2
|
|
|
|
|
11
|
'['.join(", ", $trans->gen_entref_list($scope, $node, @items)).']'; |
1107
|
|
|
|
|
|
|
} elsif (my @pairs = $trans->feed_array_if(hash => \@_)) { |
1108
|
|
|
|
|
|
|
# XXX: '=>' is better. |
1109
|
0
|
|
|
|
|
0
|
'{'.join(", ", $trans->gen_entref_list($scope, $node, @pairs)).'}'; |
1110
|
|
|
|
|
|
|
} elsif (($name) = $trans->feed_array_if(text => \@_)) { |
1111
|
26
|
|
|
|
|
77
|
qqvalue($name); |
1112
|
|
|
|
|
|
|
} else { |
1113
|
0
|
|
|
|
|
0
|
die $trans->node_error($node, "NIMPL(%s)", terse_dump(@_)); |
1114
|
|
|
|
|
|
|
} |
1115
|
|
|
|
|
|
|
}; |
1116
|
|
|
|
|
|
|
|
1117
|
90
|
|
|
|
|
341
|
while (@_) { |
1118
|
33
|
|
|
|
|
72
|
my $item = shift; |
1119
|
33
|
|
|
|
|
54
|
push @expr, do { |
1120
|
33
|
|
|
|
|
75
|
my ($type, $name, @args) = @$item; |
1121
|
33
|
100
|
|
|
|
120
|
if ($type eq 'call') { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1122
|
|
|
|
|
|
|
# 先頭の変数が確定している場合の、特殊処理。 |
1123
|
|
|
|
|
|
|
# XXX: 同じ名前のメソッドが呼べなくなる、というデメリットが有る。 |
1124
|
20
|
100
|
33
|
|
|
240
|
if ($var and not ref $name |
|
|
|
66
|
|
|
|
|
1125
|
|
|
|
|
|
|
and my $handler = $var->can("entmacro_$name")) { |
1126
|
|
|
|
|
|
|
# ここまでの式を reset する必要が有る時がある。 |
1127
|
19
|
|
|
|
|
69
|
$handler->($var, $trans, $scope, $node, \@_, \@expr, @args); |
1128
|
|
|
|
|
|
|
} else { |
1129
|
1
|
|
|
|
|
4
|
sprintf q{%s(%s)}, $name, join ", " |
1130
|
|
|
|
|
|
|
, $trans->gen_entref_list($scope, $node, @args); |
1131
|
|
|
|
|
|
|
} |
1132
|
|
|
|
|
|
|
} elsif ($type eq 'var') { |
1133
|
2
|
50
|
|
|
|
10
|
sprintf '{%s}', join ", ", ref $name |
1134
|
|
|
|
|
|
|
? $trans->gen_entref_list($scope, $node, $name, @args) |
1135
|
|
|
|
|
|
|
: qqvalue($name); |
1136
|
|
|
|
|
|
|
} elsif ($type eq 'aref') { |
1137
|
|
|
|
|
|
|
# list は本来冗長だが、nest の処理のため。 |
1138
|
11
|
50
|
|
|
|
54
|
sprintf '[%s]', join", ", ref $name |
1139
|
|
|
|
|
|
|
? $trans->gen_entref_list($scope, $node, $name, @args) |
1140
|
|
|
|
|
|
|
: $name; |
1141
|
|
|
|
|
|
|
} else { |
1142
|
0
|
|
|
|
|
0
|
die $trans->node_error($node, "NIMPL(type=$type)"); |
1143
|
|
|
|
|
|
|
} |
1144
|
|
|
|
|
|
|
}; |
1145
|
|
|
|
|
|
|
} |
1146
|
|
|
|
|
|
|
|
1147
|
90
|
100
|
|
|
|
405
|
@expr > 1 ? join("->", @expr) : $expr[0]; |
1148
|
|
|
|
|
|
|
} |
1149
|
|
|
|
|
|
|
|
1150
|
|
|
|
|
|
|
sub find_if_codearg { |
1151
|
156
|
|
|
156
|
0
|
392
|
(my MY $trans, my ($scope, $node, $entpath)) = @_; |
1152
|
156
|
|
|
|
|
527
|
my @entns = $node->node_path; |
1153
|
156
|
100
|
|
|
|
555
|
return unless $trans->strip_ns(\@entns); |
1154
|
155
|
100
|
|
|
|
922
|
return if @entns; |
1155
|
24
|
100
|
|
|
|
91
|
return unless @$entpath == 1; |
1156
|
18
|
50
|
|
|
|
59
|
return unless $entpath->[0][0] eq 'call'; |
1157
|
18
|
|
|
|
|
30
|
my ($op, $name, @args) = @{$entpath->[0]}; |
|
18
|
|
|
|
|
56
|
|
1158
|
18
|
100
|
|
|
|
66
|
my $codearg = $trans->find_codearg($scope, $name) |
1159
|
|
|
|
|
|
|
or return; |
1160
|
7
|
|
|
|
|
43
|
($codearg, @args); |
1161
|
|
|
|
|
|
|
} |
1162
|
|
|
|
|
|
|
|
1163
|
|
|
|
|
|
|
sub decode_entpath { |
1164
|
229
|
|
|
229
|
0
|
480
|
(my MY $trans, my ($node, $entns)) = @_; |
1165
|
229
|
|
|
|
|
437
|
my $has_entns = defined $entns; |
1166
|
229
|
100
|
|
|
|
508
|
unless ($has_entns) { |
1167
|
213
|
|
|
|
|
696
|
$trans->strip_ns($entns = [$node->node_path]); |
1168
|
|
|
|
|
|
|
} |
1169
|
229
|
|
|
|
|
992
|
my $body = $node->node_body; |
1170
|
229
|
100
|
100
|
|
|
890
|
substr($body, 0, 0) = ':' if defined $body and not defined $node->node_name; |
1171
|
229
|
|
|
|
|
638
|
my @entpath = $trans->parse_entpath(join('', map {':'.$_} @$entns) |
|
194
|
|
|
|
|
1051
|
|
1172
|
|
|
|
|
|
|
. coalesce($body, '') |
1173
|
|
|
|
|
|
|
, $trans, $node); |
1174
|
|
|
|
|
|
|
|
1175
|
227
|
100
|
|
|
|
646
|
my $has_body = $body ? 1 : 0; |
1176
|
|
|
|
|
|
|
|
1177
|
227
|
100
|
|
|
|
931
|
$has_entns ? ($has_body, @entpath) : ($entns, $has_body, @entpath); |
1178
|
|
|
|
|
|
|
} |
1179
|
|
|
|
|
|
|
|
1180
|
|
|
|
|
|
|
sub generate_entref { |
1181
|
213
|
|
|
213
|
0
|
540
|
(my MY $trans, my ($scope, $escaped, $node)) = @_; |
1182
|
|
|
|
|
|
|
|
1183
|
213
|
|
|
|
|
767
|
my ($entns, $has_body, @entpath) = $trans->decode_entpath($node); |
1184
|
|
|
|
|
|
|
|
1185
|
|
|
|
|
|
|
# 特例。&yatt:codevar(); は、副作用で print. |
1186
|
211
|
100
|
100
|
|
|
1099
|
if ($escaped == ENT_PRINTED |
1187
|
|
|
|
|
|
|
and my ($codearg, @args) |
1188
|
|
|
|
|
|
|
= $trans->find_if_codearg($scope, $node, \@entpath)) { |
1189
|
|
|
|
|
|
|
return \ sprintf('%1$s && %1$s->(%2$s)', $codearg->as_lvalue |
1190
|
|
|
|
|
|
|
, join(", ", map { |
1191
|
7
|
|
|
|
|
22
|
$trans->gen_entref_path($scope, $node, $_) |
|
0
|
|
|
|
|
0
|
|
1192
|
|
|
|
|
|
|
} @args)); |
1193
|
|
|
|
|
|
|
# 引数。 |
1194
|
|
|
|
|
|
|
} |
1195
|
204
|
100
|
66
|
|
|
1142
|
if ($has_body || @$entns > 1) { |
1196
|
|
|
|
|
|
|
# path が有る。 |
1197
|
40
|
|
|
|
|
179
|
my $expr = $trans->gen_entref_path($scope, $node, @entpath); |
1198
|
|
|
|
|
|
|
# XXX: sub { print } なら \ $expr にすべきだが、 |
1199
|
|
|
|
|
|
|
# sub { value } などは、むしろ YATT::escape(do {$expr}) すべき。 |
1200
|
40
|
100
|
|
|
|
139
|
return $expr if ref $expr; |
1201
|
38
|
100
|
|
|
|
367
|
return $escaped ? qq(YATT::escape($expr)) : $expr; |
1202
|
|
|
|
|
|
|
} |
1203
|
|
|
|
|
|
|
|
1204
|
164
|
|
|
|
|
311
|
my $varName = shift @$entns; |
1205
|
164
|
100
|
|
|
|
538
|
unless (my $vardecl = $trans->find_var($scope, $varName)) { |
1206
|
7
|
|
|
|
|
38
|
die $trans->node_error($node, "No such variable '%s'", $varName); |
1207
|
|
|
|
|
|
|
} else { |
1208
|
157
|
100
|
|
|
|
601
|
$escaped ? $vardecl->as_escaped : $vardecl->as_lvalue; |
1209
|
|
|
|
|
|
|
} |
1210
|
|
|
|
|
|
|
} |
1211
|
|
|
|
|
|
|
|
1212
|
|
|
|
|
|
|
#======================================== |
1213
|
|
|
|
|
|
|
# マクロなどで、cursor になっていない targetNode を入手した後で、 |
1214
|
|
|
|
|
|
|
# それを再び cursor にして、指定の型のソースを生成する仕組み。 |
1215
|
|
|
|
|
|
|
|
1216
|
|
|
|
|
|
|
# デフォルト値を最初に指定。 |
1217
|
|
|
|
|
|
|
sub default_gentype { |
1218
|
0
|
|
|
0
|
0
|
0
|
(my MY $trans, my ($default, $type, $scope, $baseNC, $targetNode)) = @_; |
1219
|
0
|
0
|
|
|
|
0
|
if (ref $type) { |
1220
|
0
|
|
|
|
|
0
|
croak "Type mismatch: \$type should be string for default_gentype: $type"; |
1221
|
|
|
|
|
|
|
} |
1222
|
0
|
0
|
0
|
|
|
0
|
unless (defined $targetNode and node_body($targetNode)) { |
1223
|
0
|
|
|
|
|
0
|
return $default; |
1224
|
|
|
|
|
|
|
} |
1225
|
|
|
|
|
|
|
# my $name = node_name($targetNode); |
1226
|
|
|
|
|
|
|
# if (my $var |
1227
|
|
|
|
|
|
|
# = $trans->has_pass_through_var($scope, $targetNode, $name)) { |
1228
|
|
|
|
|
|
|
# $var->as_lvalue; |
1229
|
|
|
|
|
|
|
# } else { |
1230
|
0
|
|
|
|
|
0
|
$trans->faked_gentype($type, $scope, $baseNC, $targetNode); |
1231
|
|
|
|
|
|
|
# } |
1232
|
|
|
|
|
|
|
} |
1233
|
|
|
|
|
|
|
|
1234
|
|
|
|
|
|
|
sub faked_gentype { |
1235
|
2
|
|
|
2
|
0
|
5
|
(my MY $trans, my ($type, $scope, $baseNC, $targetNode)) = @_; |
1236
|
2
|
50
|
|
|
|
7
|
my $node = $targetNode ? $trans->fake_cursor_from($baseNC, $targetNode) |
1237
|
|
|
|
|
|
|
: $baseNC; |
1238
|
2
|
50
|
|
|
|
14
|
my $sub = $trans->can("t_$type") |
1239
|
|
|
|
|
|
|
or die $trans->node_error($node, "No such argtype: %s", $type); |
1240
|
2
|
|
|
|
|
15
|
$sub->()->gen_assignable_node($trans, $scope, $node); |
1241
|
|
|
|
|
|
|
} |
1242
|
|
|
|
|
|
|
|
1243
|
|
|
|
|
|
|
# expr 専用。デフォルト値も渡せる。 |
1244
|
|
|
|
|
|
|
sub faked_genexpr { |
1245
|
0
|
|
|
0
|
0
|
0
|
(my MY $trans, my ($scope, $baseNC, $targetNode, $default, $ent_flag)) = @_; |
1246
|
0
|
0
|
0
|
|
|
0
|
unless (defined $targetNode and node_body($targetNode)) { |
1247
|
0
|
|
|
|
|
0
|
return $default; |
1248
|
|
|
|
|
|
|
} |
1249
|
|
|
|
|
|
|
# open するのが、faked_gentype(scalar) とも違う所、のはず。 |
1250
|
0
|
|
|
|
|
0
|
my $nc = $trans->fake_cursor_from($baseNC, $targetNode)->open; |
1251
|
0
|
0
|
|
|
|
0
|
$trans->genexpr_node($scope, defined $ent_flag ? $ent_flag : ENT_RAW |
1252
|
|
|
|
|
|
|
, $nc); |
1253
|
|
|
|
|
|
|
} |
1254
|
|
|
|
|
|
|
|
1255
|
|
|
|
|
|
|
#======================================== |
1256
|
|
|
|
|
|
|
|
1257
|
|
|
|
|
|
|
sub YATT::Translator::Perl::VarType::gen_getarg { |
1258
|
391
|
|
|
391
|
0
|
934
|
(my VarType $var, my MY $gen |
1259
|
|
|
|
|
|
|
, my ($scope, $widget, $metainfo, $actual)) = @_; |
1260
|
|
|
|
|
|
|
return $actual unless defined $var->{cf_default} |
1261
|
391
|
100
|
100
|
|
|
1842
|
and defined (my $mode = $var->{cf_default_mode}); |
1262
|
|
|
|
|
|
|
|
1263
|
12
|
100
|
|
|
|
41
|
if ($mode eq "!") { |
1264
|
2
|
|
|
|
|
12
|
return qq{defined $actual ? $actual : } |
1265
|
|
|
|
|
|
|
. qq{die "Argument '$var->{cf_varname}' is undef!"} |
1266
|
|
|
|
|
|
|
} |
1267
|
|
|
|
|
|
|
|
1268
|
10
|
|
|
|
|
16
|
my ($cond) = do { |
1269
|
10
|
100
|
|
|
|
52
|
if ($mode eq "|") { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1270
|
2
|
|
|
|
|
4
|
qq{$actual} |
1271
|
|
|
|
|
|
|
} elsif ($mode eq "?") { |
1272
|
6
|
|
|
|
|
21
|
qq{defined $actual && $actual ne ""} |
1273
|
|
|
|
|
|
|
} elsif ($mode eq "/") { |
1274
|
2
|
|
|
|
|
5
|
qq{defined $actual} |
1275
|
|
|
|
|
|
|
} else { |
1276
|
0
|
|
|
|
|
0
|
die "Unknown defaulting mode: $mode" |
1277
|
|
|
|
|
|
|
} |
1278
|
|
|
|
|
|
|
}; |
1279
|
|
|
|
|
|
|
|
1280
|
|
|
|
|
|
|
my $default = $var->gen_assignable_node |
1281
|
|
|
|
|
|
|
($gen, $scope |
1282
|
|
|
|
|
|
|
, $gen->fake_cursor($widget, $metainfo |
1283
|
10
|
100
|
|
|
|
64
|
, map {ref $_ ? @$_ : $_} $var->{cf_default}) |
1284
|
10
|
|
|
|
|
27
|
, 1); |
1285
|
|
|
|
|
|
|
|
1286
|
10
|
|
|
|
|
81
|
qq{($cond ? $actual : $default)}; |
1287
|
|
|
|
|
|
|
} |
1288
|
|
|
|
|
|
|
|
1289
|
|
|
|
|
|
|
sub YATT::Translator::Perl::VarType::gen_assignable_node { |
1290
|
67
|
|
|
67
|
0
|
205
|
(my VarType $var, my MY $trans, my ($scope, $node, $is_opened)) = @_; |
1291
|
|
|
|
|
|
|
# early escaped な変数への代入値は、代入前に escape される。 |
1292
|
67
|
|
|
|
|
228
|
my $escaped = $var->early_escaped; |
1293
|
67
|
100
|
|
|
|
309
|
$var->quote_assignable |
1294
|
|
|
|
|
|
|
($trans->mark_vars($scope, $escaped, $is_opened ? $node : $node->open)); |
1295
|
|
|
|
|
|
|
} |
1296
|
|
|
|
|
|
|
|
1297
|
|
|
|
|
|
|
sub YATT::Translator::Perl::VarType::is_required { |
1298
|
62
|
|
|
62
|
0
|
98
|
my VarType $var = shift; |
1299
|
62
|
100
|
|
|
|
424
|
defined $var->{cf_default_mode} && $var->{cf_default_mode} eq '!'; |
1300
|
|
|
|
|
|
|
} |
1301
|
|
|
|
|
|
|
|
1302
|
0
|
|
|
0
|
0
|
0
|
sub YATT::Translator::Perl::VarType::can_call { 0 } |
1303
|
103
|
|
|
103
|
0
|
247
|
sub YATT::Translator::Perl::VarType::early_escaped { 0 } |
1304
|
929
|
|
|
929
|
0
|
4571
|
sub YATT::Translator::Perl::VarType::lvalue_format {'$%s'} |
1305
|
|
|
|
|
|
|
sub YATT::Translator::Perl::VarType::as_lvalue { |
1306
|
956
|
|
|
956
|
0
|
1309
|
my VarType $var = shift; |
1307
|
956
|
|
|
|
|
2136
|
sprintf $var->lvalue_format, $var->{cf_varname}; |
1308
|
|
|
|
|
|
|
} |
1309
|
|
|
|
|
|
|
|
1310
|
107
|
|
|
107
|
0
|
1013
|
sub YATT::Translator::Perl::VarType::escaped_format {'YATT::escape($%s)'} |
1311
|
|
|
|
|
|
|
|
1312
|
|
|
|
|
|
|
sub YATT::Translator::Perl::VarType::as_escaped { |
1313
|
123
|
|
|
123
|
0
|
180
|
my VarType $var = shift; |
1314
|
123
|
|
|
|
|
342
|
sprintf $var->escaped_format, $var->{cf_varname}; |
1315
|
|
|
|
|
|
|
} |
1316
|
|
|
|
|
|
|
|
1317
|
|
|
|
|
|
|
sub YATT::Translator::Perl::VarType::as_typespec { |
1318
|
0
|
|
|
0
|
0
|
0
|
shift->type_name; |
1319
|
|
|
|
|
|
|
} |
1320
|
|
|
|
|
|
|
|
1321
|
|
|
|
|
|
|
sub YATT::Translator::Perl::VarType::as_argspec { |
1322
|
0
|
|
|
0
|
0
|
0
|
(my VarType $var) = @_; |
1323
|
0
|
|
|
|
|
0
|
my $spec = $var->as_typespec; |
1324
|
0
|
0
|
|
|
|
0
|
if (my $mode = $var->{cf_default_mode}) { |
1325
|
0
|
|
|
|
|
0
|
$spec .= $mode; |
1326
|
0
|
0
|
|
|
|
0
|
if (defined (my $default = $var->{cf_default})) { |
1327
|
|
|
|
|
|
|
$spec .= join "", map { |
1328
|
0
|
0
|
|
|
|
0
|
ref $_ ? map(ref $_ ? stringify_node($_) : $_, @$_) : $_ |
|
0
|
0
|
|
|
|
0
|
|
1329
|
|
|
|
|
|
|
} $default; |
1330
|
|
|
|
|
|
|
} |
1331
|
|
|
|
|
|
|
} |
1332
|
0
|
|
|
|
|
0
|
$spec; |
1333
|
|
|
|
|
|
|
} |
1334
|
|
|
|
|
|
|
|
1335
|
|
|
|
|
|
|
use YATT::ArgTypes |
1336
|
3
|
|
|
|
|
49
|
(-type_map => \%TYPE_MAP |
1337
|
|
|
|
|
|
|
, -base => VarType |
1338
|
|
|
|
|
|
|
, -type_fmt => join("::", MY, 't_%s') |
1339
|
|
|
|
|
|
|
, [text => -alias => ''] |
1340
|
|
|
|
|
|
|
, [html => \ lvalue_format => '$html_%s', \ early_escaped => 1] |
1341
|
|
|
|
|
|
|
, [scalar => -alias => ['value', 'flag']] |
1342
|
|
|
|
|
|
|
, ['list'] |
1343
|
|
|
|
|
|
|
, [attr => -base => 'text'] |
1344
|
|
|
|
|
|
|
, [code => -alias => 'expr', \ can_call => 1 |
1345
|
|
|
|
|
|
|
# 引数の型情報 |
1346
|
|
|
|
|
|
|
, -fields => [qw(arg_dict arg_order)]] |
1347
|
|
|
|
|
|
|
, [delegate => -fields => [qw(cf_base_path |
1348
|
|
|
|
|
|
|
cf_base_widget |
1349
|
|
|
|
|
|
|
cf_delegate_vars)]] |
1350
|
|
|
|
|
|
|
, qw(:type_name) |
1351
|
3
|
|
|
3
|
|
1310
|
); |
|
3
|
|
|
|
|
8
|
|
1352
|
|
|
|
|
|
|
|
1353
|
|
|
|
|
|
|
$calling_conv{this} = t_scalar->new(varname => 'this'); |
1354
|
|
|
|
|
|
|
$calling_conv{args} = t_scalar->new(varname => 'args'); |
1355
|
|
|
|
|
|
|
$calling_conv{_} = t_scalar->new(varname => '_'); |
1356
|
|
|
|
|
|
|
|
1357
|
|
|
|
|
|
|
sub YATT::Translator::Perl::t_text::quote_assignable { |
1358
|
45
|
|
|
45
|
|
75
|
shift; |
1359
|
45
|
|
|
|
|
82
|
my ($nvars); |
1360
|
|
|
|
|
|
|
my @items = map { |
1361
|
45
|
100
|
|
|
|
89
|
if (ref $_) { |
|
53
|
|
|
|
|
129
|
|
1362
|
7
|
|
|
|
|
15
|
$nvars++; |
1363
|
7
|
|
|
|
|
19
|
$$_ |
1364
|
|
|
|
|
|
|
} else { |
1365
|
|
|
|
|
|
|
# $var is prohibited. |
1366
|
46
|
|
|
|
|
141
|
qparen($_); |
1367
|
|
|
|
|
|
|
} |
1368
|
|
|
|
|
|
|
} @_; |
1369
|
45
|
100
|
100
|
|
|
243
|
if (@items == 1 && !$nvars) { |
1370
|
39
|
|
|
|
|
202
|
$items[0]; |
1371
|
|
|
|
|
|
|
} else { |
1372
|
6
|
|
|
|
|
43
|
MY->as_join(@items); |
1373
|
|
|
|
|
|
|
} |
1374
|
|
|
|
|
|
|
} |
1375
|
|
|
|
|
|
|
|
1376
|
|
|
|
|
|
|
# XXX: 本当に良いのか? |
1377
|
|
|
|
|
|
|
sub YATT::Translator::Perl::t_html::quote_assignable { |
1378
|
0
|
|
|
0
|
|
0
|
shift; |
1379
|
0
|
|
|
|
|
0
|
sprintf q{YATT::escape(%s)}, t_text->quote_assignable(@_); |
1380
|
|
|
|
|
|
|
} |
1381
|
|
|
|
|
|
|
|
1382
|
16
|
|
|
16
|
|
186
|
sub YATT::Translator::Perl::t_html::escaped_format {shift->lvalue_format} |
1383
|
|
|
|
|
|
|
|
1384
|
|
|
|
|
|
|
sub YATT::Translator::Perl::t_html::gen_assignable_node { |
1385
|
6
|
|
|
6
|
|
16
|
(my VarType $var, my MY $trans, my ($scope, $node, $is_opened)) = @_; |
1386
|
|
|
|
|
|
|
# XXX: フラグがダサい。 |
1387
|
6
|
100
|
|
|
|
22
|
my $n = $is_opened ? $node : $node->open; |
1388
|
6
|
100
|
|
|
|
26
|
if (my $expr = $trans->has_single_bare_varexpr($scope, $n)) { |
1389
|
1
|
|
|
|
|
5
|
t_scalar->quote_assignable($expr); |
1390
|
|
|
|
|
|
|
} else { |
1391
|
5
|
|
|
|
|
17
|
$trans->as_join($trans->generate_body($scope, $n)); |
1392
|
|
|
|
|
|
|
} |
1393
|
|
|
|
|
|
|
} |
1394
|
|
|
|
|
|
|
|
1395
|
|
|
|
|
|
|
sub YATT::Translator::Perl::t_attr::as_typespec { |
1396
|
0
|
|
|
0
|
|
0
|
my t_attr $var = shift; |
1397
|
0
|
|
0
|
|
|
0
|
join(":", $var->type_name, $var->{cf_subtype} || $var->{cf_varname}); |
1398
|
|
|
|
|
|
|
} |
1399
|
|
|
|
|
|
|
|
1400
|
|
|
|
|
|
|
|
1401
|
|
|
|
|
|
|
sub YATT::Translator::Perl::t_attr::entmacro_ { |
1402
|
1
|
|
|
1
|
|
3
|
(my t_attr $var, my MY $trans |
1403
|
|
|
|
|
|
|
, my ($scope, $node, $restExpr, $queue, @args)) = @_; |
1404
|
1
|
50
|
|
|
|
5
|
if (@$restExpr) { |
1405
|
0
|
|
|
|
|
0
|
die $trans->node_error($node, "attr() should be last call."); |
1406
|
|
|
|
|
|
|
} |
1407
|
1
|
50
|
|
|
|
5
|
if (ref $var->{cf_subtype}) { |
1408
|
0
|
|
|
|
|
0
|
die $trans->node_error($node, "nested subtype for attr"); |
1409
|
|
|
|
|
|
|
} |
1410
|
1
|
|
|
|
|
6
|
my @expr = $trans->gen_entref_list($scope, $node, @args); |
1411
|
|
|
|
|
|
|
sprintf(q{YATT::attr('%s', %s)} |
1412
|
|
|
|
|
|
|
, $var->{cf_subtype} || $var->{cf_varname} |
1413
|
1
|
|
33
|
|
|
8
|
, join(", ", $var->as_lvalue, @expr)); |
1414
|
|
|
|
|
|
|
} |
1415
|
|
|
|
|
|
|
|
1416
|
|
|
|
|
|
|
sub YATT::Translator::Perl::t_attr::as_escaped { |
1417
|
4
|
|
|
4
|
|
8
|
my t_attr $var = shift; |
1418
|
4
|
50
|
|
|
|
16
|
if (ref $var->{cf_subtype}) { |
1419
|
0
|
|
|
|
|
0
|
die "nested subtype for attr: $var->{cf_varname}"; |
1420
|
|
|
|
|
|
|
} |
1421
|
4
|
|
|
|
|
18
|
my $realvar = sprintf $var->lvalue_format, $var->{cf_varname}; |
1422
|
|
|
|
|
|
|
sprintf(q{YATT::named_attr('%s', %s)} |
1423
|
|
|
|
|
|
|
, $var->{cf_subtype} || $var->{cf_varname} |
1424
|
4
|
|
33
|
|
|
38
|
, $realvar); |
1425
|
|
|
|
|
|
|
} |
1426
|
|
|
|
|
|
|
|
1427
|
|
|
|
|
|
|
sub YATT::Translator::Perl::t_scalar::quote_assignable { |
1428
|
13
|
|
|
13
|
|
26
|
shift; |
1429
|
13
|
100
|
|
|
|
34
|
'scalar(do {'.join("", map { ref $_ ? $$_ : $_ } @_).'})'; |
|
21
|
|
|
|
|
141
|
|
1430
|
|
|
|
|
|
|
} |
1431
|
|
|
|
|
|
|
|
1432
|
|
|
|
|
|
|
sub YATT::Translator::Perl::t_list::quote_assignable { |
1433
|
13
|
|
|
13
|
|
28
|
shift; |
1434
|
13
|
100
|
|
|
|
38
|
'['.join("", map { ref $_ ? $$_ : $_ } @_).']'; |
|
25
|
|
|
|
|
151
|
|
1435
|
|
|
|
|
|
|
} |
1436
|
|
|
|
|
|
|
|
1437
|
|
|
|
|
|
|
sub YATT::Translator::Perl::t_list::entmacro_expand { |
1438
|
17
|
|
|
17
|
|
45
|
(my t_list $var, my MY $trans |
1439
|
|
|
|
|
|
|
, my ($scope, $node, $restExpr, $queue, @args)) = @_; |
1440
|
17
|
|
|
|
|
55
|
my $was = join "->", splice @$queue, 0; |
1441
|
17
|
|
|
|
|
117
|
sprintf q{map($_ ? @$_ : (), %s)}, $was; |
1442
|
|
|
|
|
|
|
} |
1443
|
|
|
|
|
|
|
|
1444
|
|
|
|
|
|
|
sub YATT::Translator::Perl::t_list::entmacro_size { |
1445
|
2
|
|
|
2
|
|
6
|
(my t_list $var, my MY $trans |
1446
|
|
|
|
|
|
|
, my ($scope, $node, $restExpr, $queue, @args)) = @_; |
1447
|
2
|
|
|
|
|
8
|
my $was = join "->", splice @$queue, 0; |
1448
|
2
|
|
|
|
|
15
|
sprintf q{scalar(map(defined $_ ? @$_ : (), %s))}, $was; |
1449
|
|
|
|
|
|
|
} |
1450
|
|
|
|
|
|
|
|
1451
|
|
|
|
|
|
|
# XXX: head($n), tail($n) |
1452
|
|
|
|
|
|
|
|
1453
|
|
|
|
|
|
|
sub YATT::Translator::Perl::t_list::entmacro_head { |
1454
|
0
|
|
|
0
|
|
0
|
(my t_list $var, my MY $trans |
1455
|
|
|
|
|
|
|
, my ($scope, $node, $restExpr, $queue, @args)) = @_; |
1456
|
0
|
|
|
|
|
0
|
my $was = join "->", splice @$queue, 0; |
1457
|
0
|
|
|
|
|
0
|
sprintf q{map($_ ? $$_[0] : (), %s)}, $was; |
1458
|
|
|
|
|
|
|
} |
1459
|
|
|
|
|
|
|
|
1460
|
|
|
|
|
|
|
sub YATT::Translator::Perl::t_list::entmacro_tail { |
1461
|
0
|
|
|
0
|
|
0
|
(my t_list $var, my MY $trans |
1462
|
|
|
|
|
|
|
, my ($scope, $node, $restExpr, $queue, @args)) = @_; |
1463
|
0
|
|
|
|
|
0
|
my $was = join "->", splice @$queue, 0; |
1464
|
0
|
|
|
|
|
0
|
sprintf q{map($_ ? @{$_}[1..$#$_] : (), %s)}, $was; |
1465
|
|
|
|
|
|
|
} |
1466
|
|
|
|
|
|
|
|
1467
|
|
|
|
|
|
|
sub YATT::Translator::Perl::t_code::gen_call { |
1468
|
25
|
|
|
25
|
|
54
|
(my t_code $argdecl, my MY $trans, my ($scope, $node)) = @_; |
1469
|
25
|
|
|
|
|
112
|
my ($post, @args) = $trans->genargs_static |
1470
|
|
|
|
|
|
|
($scope, $node->open, $argdecl->arg_specs); |
1471
|
|
|
|
|
|
|
# XXX: こっちを () しなくて済むのはなぜ? => の call だから? |
1472
|
25
|
|
|
|
|
145
|
return \ sprintf '%1$s && %1$s->(%2$s)%3$s', $argdecl->as_lvalue |
1473
|
|
|
|
|
|
|
, join(", ", @args), $post; |
1474
|
|
|
|
|
|
|
} |
1475
|
|
|
|
|
|
|
|
1476
|
|
|
|
|
|
|
sub YATT::Translator::Perl::t_code::arg_specs { |
1477
|
31
|
|
|
31
|
|
64
|
my t_code $argdecl = shift; |
1478
|
31
|
|
100
|
|
|
325
|
($argdecl->{arg_dict} ||= {}, $argdecl->{arg_order} ||= []); |
|
|
|
100
|
|
|
|
|
1479
|
|
|
|
|
|
|
} |
1480
|
|
|
|
|
|
|
|
1481
|
|
|
|
|
|
|
sub YATT::Translator::Perl::t_code::gen_args { |
1482
|
39
|
|
|
39
|
|
160
|
(my t_code $argdecl) = @_; |
1483
|
|
|
|
|
|
|
return unless $argdecl->{arg_order} |
1484
|
39
|
100
|
100
|
|
|
219
|
&& (my @args = @{$argdecl->{arg_order}}); |
|
16
|
|
|
|
|
126
|
|
1485
|
|
|
|
|
|
|
\ sprintf('my (%s) = @_', join(", ", map { |
1486
|
9
|
|
|
|
|
30
|
$argdecl->{arg_dict}{$_}->as_lvalue; |
|
10
|
|
|
|
|
46
|
|
1487
|
|
|
|
|
|
|
} @args)); |
1488
|
|
|
|
|
|
|
} |
1489
|
|
|
|
|
|
|
|
1490
|
|
|
|
|
|
|
sub YATT::Translator::Perl::t_code::gen_body { |
1491
|
40
|
|
|
40
|
|
119
|
(my t_code $argdecl, my MY $trans, my ($scope, $is_expr, $node)) = @_; |
1492
|
40
|
50
|
|
|
|
153
|
return unless $node->array_size; |
1493
|
40
|
100
|
|
|
|
110
|
if ($is_expr) { |
1494
|
1
|
|
|
|
|
4
|
$trans->genexpr_node($scope, ENT_RAW, $node); |
1495
|
|
|
|
|
|
|
} else { |
1496
|
|
|
|
|
|
|
$trans->as_statement_list |
1497
|
|
|
|
|
|
|
($argdecl->gen_args |
1498
|
39
|
|
|
|
|
116
|
, $trans->generate_body([{}, [$argdecl->{arg_dict}, $scope]], $node)); |
1499
|
|
|
|
|
|
|
} |
1500
|
|
|
|
|
|
|
} |
1501
|
|
|
|
|
|
|
|
1502
|
|
|
|
|
|
|
sub YATT::Translator::Perl::t_code::gen_assignable_node { |
1503
|
40
|
|
|
40
|
|
101
|
(my t_code $argdecl, my MY $trans, my ($scope, $node, $is_opened)) = @_; |
1504
|
40
|
|
100
|
|
|
143
|
my $is_expr = !$is_opened && !$node->is_quoted_by_element; |
1505
|
40
|
100
|
|
|
|
182
|
$trans->as_sub('', $argdecl->gen_body($trans, $scope, $is_expr |
1506
|
|
|
|
|
|
|
, $is_opened ? $node : $node->open)); |
1507
|
|
|
|
|
|
|
} |
1508
|
|
|
|
|
|
|
|
1509
|
|
|
|
|
|
|
sub YATT::Translator::Perl::t_code::has_arg { |
1510
|
12
|
|
|
12
|
|
26
|
(my t_code $argdecl, my ($name)) = @_; |
1511
|
12
|
|
|
|
|
54
|
defined $argdecl->{arg_dict}{$name}; |
1512
|
|
|
|
|
|
|
} |
1513
|
|
|
|
|
|
|
|
1514
|
|
|
|
|
|
|
sub YATT::Translator::Perl::t_code::add_arg { |
1515
|
13
|
|
|
13
|
|
41
|
(my t_code $codevar, my ($name, $arg)) = @_; |
1516
|
13
|
|
|
|
|
72
|
add_arg_order_in($codevar->{arg_dict}, $codevar->{arg_order}, $name, $arg); |
1517
|
13
|
|
|
|
|
64
|
$codevar; |
1518
|
|
|
|
|
|
|
} |
1519
|
|
|
|
|
|
|
|
1520
|
|
|
|
|
|
|
sub YATT::Translator::Perl::t_code::clone { |
1521
|
6
|
|
|
6
|
|
15
|
(my t_code $orig) = @_; |
1522
|
6
|
|
|
|
|
38
|
my t_code $new = $orig->SUPER::clone; |
1523
|
6
|
|
|
|
|
37
|
my ($dict, $order) = $orig->arg_specs; |
1524
|
6
|
|
|
|
|
21
|
foreach my $name (@$order) { |
1525
|
1
|
|
|
|
|
6
|
$new->add_arg($name, $dict->{$name}->clone); |
1526
|
|
|
|
|
|
|
} |
1527
|
|
|
|
|
|
|
$new |
1528
|
6
|
|
|
|
|
23
|
} |
1529
|
|
|
|
|
|
|
|
1530
|
|
|
|
|
|
|
# code 型の変数宣言の生成 |
1531
|
|
|
|
|
|
|
sub create_var_code { |
1532
|
172
|
|
|
172
|
0
|
384
|
(my MY $trans, my ($node, @param)) = @_; |
1533
|
172
|
|
|
|
|
1450
|
my t_code $codevar = $trans->t_code->new(@param); |
1534
|
172
|
100
|
|
|
|
449
|
$trans->define_args($codevar, $node->open) if $node; |
1535
|
172
|
|
|
|
|
847
|
$codevar; |
1536
|
|
|
|
|
|
|
} |
1537
|
|
|
|
|
|
|
|
1538
|
|
|
|
|
|
|
sub YATT::Translator::Perl::t_delegate::gen_call { |
1539
|
5
|
|
|
5
|
|
16
|
(my t_delegate $argdecl, my MY $trans, my ($scope, $node)) = @_; |
1540
|
|
|
|
|
|
|
my $func = $trans->get_funcname_to($trans->{cf_mode} |
1541
|
5
|
|
|
|
|
21
|
, $argdecl->{cf_base_widget}); |
1542
|
|
|
|
|
|
|
# XXX: テストを書け。body が code か html か、だ。 |
1543
|
|
|
|
|
|
|
# my $body_dict = $argdecl->{cf_base_widget}->get_arg_spec(body => undef); |
1544
|
5
|
|
|
|
|
12
|
my $body_spec = $argdecl->{cf_base_widget}->{arg_dict}->{body}; |
1545
|
5
|
|
|
|
|
12
|
my $body_scope = do { |
1546
|
5
|
50
|
|
|
|
26
|
if ($body_spec->type_name eq 'code') { |
1547
|
5
|
|
|
|
|
18
|
[$body_spec->{arg_dict}, $scope] |
1548
|
|
|
|
|
|
|
} else { |
1549
|
0
|
|
|
|
|
0
|
$scope |
1550
|
|
|
|
|
|
|
} |
1551
|
|
|
|
|
|
|
}; |
1552
|
5
|
|
|
|
|
26
|
my ($post, @args) = $trans->genargs_static |
1553
|
|
|
|
|
|
|
([{}, $body_scope] |
1554
|
|
|
|
|
|
|
, $node->open, $argdecl->arg_specs); |
1555
|
|
|
|
|
|
|
return \ sprintf(' %s($this, [%s])%s', $func |
1556
|
5
|
50
|
|
|
|
27
|
, join(", ", map {defined $_ ? $_ : 'undef'} @args) |
|
18
|
|
|
|
|
93
|
|
1557
|
|
|
|
|
|
|
, $post); |
1558
|
|
|
|
|
|
|
} |
1559
|
|
|
|
|
|
|
|
1560
|
|
|
|
|
|
|
sub YATT::Translator::Perl::t_delegate::arg_specs { |
1561
|
5
|
|
|
5
|
|
14
|
my t_delegate $argdecl = shift; |
1562
|
|
|
|
|
|
|
($argdecl->{cf_base_widget}->arg_specs |
1563
|
5
|
|
|
|
|
28
|
, $argdecl->{cf_delegate_vars}); |
1564
|
|
|
|
|
|
|
} |
1565
|
|
|
|
|
|
|
|
1566
|
|
|
|
|
|
|
#======================================== |
1567
|
|
|
|
|
|
|
|
1568
|
|
|
|
|
|
|
sub make_arg_spec { |
1569
|
7
|
|
|
7
|
0
|
19
|
my ($dict, $order) = splice @_, 0, 2; |
1570
|
7
|
|
|
|
|
14
|
foreach my $name (@_) { |
1571
|
19
|
|
|
|
|
41
|
$dict->{$name} = @$order; |
1572
|
19
|
|
|
|
|
40
|
push @$order, $name; |
1573
|
|
|
|
|
|
|
} |
1574
|
|
|
|
|
|
|
} |
1575
|
|
|
|
|
|
|
|
1576
|
|
|
|
|
|
|
sub arg_name_types { |
1577
|
109
|
|
|
109
|
0
|
200
|
(my MY $trans, my ($args)) = @_; |
1578
|
109
|
|
|
|
|
335
|
my (@path) = $args->node_path; |
1579
|
109
|
100
|
66
|
|
|
347
|
if ($args->is_attribute and $args->is_quoted_by_element) { |
1580
|
8
|
|
|
|
|
15
|
shift @path; |
1581
|
|
|
|
|
|
|
} |
1582
|
109
|
|
|
|
|
259
|
my ($name) = shift @path; |
1583
|
109
|
50
|
|
|
|
476
|
@path >= 2 ? ($name, \@path) : ($name, $path[0]); |
1584
|
|
|
|
|
|
|
} |
1585
|
|
|
|
|
|
|
|
1586
|
|
|
|
|
|
|
# macro の、 my:type=var など専用。 |
1587
|
|
|
|
|
|
|
sub feed_arg_spec { |
1588
|
14
|
|
|
14
|
0
|
46
|
(my MY $trans, my ($args, $arg_dict, $arg_order)) = splice @_, 0, 4; |
1589
|
14
|
|
|
|
|
27
|
my $found; |
1590
|
14
|
|
|
|
|
58
|
for (my $nth = 0; $args->readable; $args->next) { |
1591
|
31
|
100
|
|
|
|
103
|
last unless $args->is_primary_attribute; |
1592
|
17
|
|
|
|
|
57
|
my ($name, @ext) = $args->node_path; |
1593
|
17
|
100
|
|
|
|
48
|
unless (defined $name) { |
1594
|
4
|
50
|
|
|
|
21
|
$name = $arg_order->[$nth++] |
1595
|
|
|
|
|
|
|
or die $trans->node_error($args, "Too many args"); |
1596
|
|
|
|
|
|
|
} |
1597
|
17
|
50
|
|
|
|
65
|
defined (my $argno = $arg_dict->{$name}) |
1598
|
|
|
|
|
|
|
or die $trans->node_error($args, "Unknown arg '%s'", $name); |
1599
|
|
|
|
|
|
|
|
1600
|
17
|
|
|
|
|
54
|
$_[$argno] = $args->current; |
1601
|
17
|
|
|
|
|
64
|
$found++; |
1602
|
|
|
|
|
|
|
} |
1603
|
14
|
|
|
|
|
52
|
$found; |
1604
|
|
|
|
|
|
|
} |
1605
|
|
|
|
|
|
|
|
1606
|
|
|
|
|
|
|
{ |
1607
|
|
|
|
|
|
|
# list=list/value, my=text, ith=text |
1608
|
|
|
|
|
|
|
make_arg_spec(\ my %arg_dict, \ my @arg_order |
1609
|
|
|
|
|
|
|
, qw(list my ith)); |
1610
|
|
|
|
|
|
|
|
1611
|
|
|
|
|
|
|
declare_alias macro_yatt_foreach => \¯o_foreach; |
1612
|
|
|
|
|
|
|
sub macro_foreach { |
1613
|
6
|
|
|
6
|
0
|
17
|
(my MY $trans, my ($scope, $args, $fragment)) = @_; |
1614
|
|
|
|
|
|
|
|
1615
|
6
|
50
|
|
|
|
34
|
$trans->feed_arg_spec($args, \%arg_dict, \@arg_order |
1616
|
|
|
|
|
|
|
, my ($list, $my, $ith)) |
1617
|
|
|
|
|
|
|
or die $trans->node_error($args, "Not enough arguments"); |
1618
|
|
|
|
|
|
|
|
1619
|
6
|
50
|
|
|
|
24
|
unless (defined $list) { |
1620
|
0
|
|
|
|
|
0
|
die $trans->node_error($args, "no list= is given"); |
1621
|
|
|
|
|
|
|
} |
1622
|
|
|
|
|
|
|
|
1623
|
|
|
|
|
|
|
# $ith をまだ使っていない。 |
1624
|
6
|
|
|
|
|
13
|
my %local; |
1625
|
6
|
|
|
|
|
12
|
my $loopvar = do { |
1626
|
6
|
100
|
|
|
|
32
|
if ($my) { |
1627
|
5
|
|
|
|
|
20
|
my ($x, @type) = node_path($my); |
1628
|
5
|
|
|
|
|
26
|
my $varname = node_body($my); |
1629
|
5
|
|
50
|
|
|
54
|
$local{$varname} = $trans->create_var |
1630
|
|
|
|
|
|
|
($type[0] || '', undef, varname => $varname); |
1631
|
5
|
|
|
|
|
19
|
'my $' . $varname; |
1632
|
|
|
|
|
|
|
} else { |
1633
|
|
|
|
|
|
|
# _ は? entity 自体に処理させるか… |
1634
|
1
|
|
|
|
|
3
|
'' |
1635
|
|
|
|
|
|
|
} |
1636
|
|
|
|
|
|
|
}; |
1637
|
|
|
|
|
|
|
|
1638
|
6
|
|
|
|
|
13
|
my $fmt = q{foreach %1$s (%2$s) %3$s}; |
1639
|
6
|
|
|
|
|
11
|
my $listexpr = do { |
1640
|
6
|
|
|
|
|
8
|
if (0) { |
1641
|
|
|
|
|
|
|
print STDERR "# foreach list: " |
1642
|
|
|
|
|
|
|
, YATT::LRXML::Node::stringify_node($list), "\n"; |
1643
|
|
|
|
|
|
|
} |
1644
|
|
|
|
|
|
|
# XXX: 何故使い分けが必要になってしまうのか? |
1645
|
|
|
|
|
|
|
# my $fc = $args->adopter_for($list); |
1646
|
|
|
|
|
|
|
# my $fc = $trans->fake_cursor_from($args, $list); |
1647
|
6
|
100
|
|
|
|
30
|
if (my $var = $trans->has_pass_through_var |
1648
|
|
|
|
|
|
|
($scope, my $fc = $trans->fake_cursor_from($args, $list), 'list')) { |
1649
|
3
|
100
|
|
|
|
20
|
unless ($var->type_name eq 'list') { |
1650
|
1
|
|
|
|
|
7
|
my $path = $args->parent->node_path; |
1651
|
1
|
|
|
|
|
10
|
die $trans->node_error($fc, "$path - should be list type") |
1652
|
|
|
|
|
|
|
} |
1653
|
2
|
|
|
|
|
8
|
'@'.$var->as_lvalue; |
1654
|
|
|
|
|
|
|
} else { |
1655
|
3
|
|
|
|
|
16
|
$trans->genexpr_node($scope, 0, $args->adopter_for($list)); |
1656
|
|
|
|
|
|
|
} |
1657
|
|
|
|
|
|
|
}; |
1658
|
5
|
|
|
|
|
59
|
my @statements = $trans->as_statement_list |
1659
|
|
|
|
|
|
|
($trans->generate_body([\%local, $scope], $args)); |
1660
|
|
|
|
|
|
|
|
1661
|
5
|
50
|
|
|
|
24
|
if ($fragment) { |
1662
|
0
|
|
|
|
|
0
|
($fmt, $loopvar, $listexpr, \@statements); |
1663
|
|
|
|
|
|
|
} else { |
1664
|
5
|
|
|
|
|
20
|
\ sprintf $fmt, $loopvar, $listexpr, $trans->as_block(@statements); |
1665
|
|
|
|
|
|
|
} |
1666
|
|
|
|
|
|
|
} |
1667
|
|
|
|
|
|
|
} |
1668
|
|
|
|
|
|
|
|
1669
|
|
|
|
|
|
|
{ |
1670
|
|
|
|
|
|
|
# if |
1671
|
|
|
|
|
|
|
make_arg_spec(\ my %arg_dict, \ my @arg_order |
1672
|
|
|
|
|
|
|
, qw(if unless)); |
1673
|
|
|
|
|
|
|
sub gen_macro_if_arm { |
1674
|
8
|
|
|
8
|
0
|
23
|
(my MY $trans, my ($scope, $primary, $pkg, $if, $unless, $body)) = @_; |
1675
|
8
|
|
|
|
|
16
|
my $header = do { |
1676
|
8
|
100
|
|
|
|
17
|
if ($primary) { |
1677
|
5
|
|
|
|
|
10
|
my ($kw, $cond) = do { |
1678
|
5
|
50
|
|
|
|
15
|
if ($if) { (if => $if) } |
|
5
|
0
|
|
|
|
13
|
|
1679
|
0
|
|
|
|
|
0
|
elsif ($unless) { (unless => $unless) } |
1680
|
0
|
|
|
|
|
0
|
else { die "??" } |
1681
|
|
|
|
|
|
|
}; |
1682
|
5
|
|
|
|
|
31
|
sprintf q{%s (%s) }, $kw |
1683
|
|
|
|
|
|
|
, $trans->genexpr_node($scope, 0 |
1684
|
|
|
|
|
|
|
, $trans->fake_cursor_from($body, $cond, 1)); |
1685
|
|
|
|
|
|
|
} else { |
1686
|
3
|
|
|
|
|
4
|
my ($cond, $true) = do { |
1687
|
3
|
100
|
|
|
|
13
|
if ($if) { ($if, 1) } |
|
1
|
50
|
|
|
|
3
|
|
1688
|
0
|
|
|
|
|
0
|
elsif ($unless) { ($unless, 0) } |
1689
|
|
|
|
|
|
|
else {} |
1690
|
|
|
|
|
|
|
}; |
1691
|
3
|
100
|
|
|
|
8
|
unless (defined $cond) { |
1692
|
2
|
|
|
|
|
7
|
q{else } |
1693
|
|
|
|
|
|
|
} else { |
1694
|
1
|
|
|
|
|
5
|
my $expr = $trans->genexpr_node |
1695
|
|
|
|
|
|
|
($scope, 0 |
1696
|
|
|
|
|
|
|
, $trans->fake_cursor_from($body, $cond, 1)); |
1697
|
1
|
50
|
|
|
|
9
|
sprintf q{elsif (%s) }, $true ? $expr : qq{not($expr)}; |
1698
|
|
|
|
|
|
|
} |
1699
|
|
|
|
|
|
|
} |
1700
|
|
|
|
|
|
|
}; |
1701
|
8
|
|
|
|
|
45
|
$header . $trans->as_block |
1702
|
|
|
|
|
|
|
($trans->as_statement_list |
1703
|
|
|
|
|
|
|
($trans->generate_body($scope, $body))); |
1704
|
|
|
|
|
|
|
} |
1705
|
|
|
|
|
|
|
|
1706
|
|
|
|
|
|
|
declare_alias macro_yatt_if => \¯o_if; |
1707
|
|
|
|
|
|
|
sub macro_if { |
1708
|
5
|
|
|
5
|
0
|
14
|
(my MY $trans, my ($scope, $args)) = @_; |
1709
|
|
|
|
|
|
|
|
1710
|
5
|
|
|
|
|
10
|
my @case = do { |
1711
|
5
|
50
|
|
|
|
29
|
$trans->feed_arg_spec($args, \%arg_dict, \@arg_order |
1712
|
|
|
|
|
|
|
, my ($if, $unless)) |
1713
|
|
|
|
|
|
|
or die $trans->node_error($args, "Not enough arguments"); |
1714
|
5
|
|
|
|
|
20
|
([$if, $unless, $args->variant_builder]); |
1715
|
|
|
|
|
|
|
}; |
1716
|
5
|
|
|
|
|
23
|
for (; $args->readable; $args->next) { |
1717
|
12
|
100
|
66
|
|
|
37
|
if ($args->is_attribute && $args->node_name eq 'else') { |
1718
|
3
|
|
|
|
|
10
|
my $kid = $args->open; |
1719
|
3
|
|
|
|
|
12
|
$trans->feed_arg_spec($kid, \%arg_dict, \@arg_order |
1720
|
|
|
|
|
|
|
, my ($if, $unless)); |
1721
|
3
|
|
|
|
|
16
|
push @case, [$if, $unless, $kid]; |
1722
|
|
|
|
|
|
|
} else { |
1723
|
|
|
|
|
|
|
# XXX: 多分、$case[0] |
1724
|
9
|
|
|
|
|
33
|
$case[-1][-1]->add_node($args->current); |
1725
|
|
|
|
|
|
|
} |
1726
|
|
|
|
|
|
|
} |
1727
|
|
|
|
|
|
|
|
1728
|
5
|
|
|
|
|
30
|
my $pkg = $trans->get_package_from_node($args); |
1729
|
5
|
|
|
|
|
11
|
my @script = $trans->gen_macro_if_arm($scope, 1, $pkg, @{shift @case}); |
|
5
|
|
|
|
|
23
|
|
1730
|
5
|
|
|
|
|
43
|
while (my $arm = shift @case) { |
1731
|
3
|
|
|
|
|
11
|
push @script, $trans->gen_macro_if_arm($scope, 0, $pkg, @$arm); |
1732
|
|
|
|
|
|
|
} |
1733
|
5
|
|
|
|
|
36
|
\ join " ", @script; |
1734
|
|
|
|
|
|
|
} |
1735
|
|
|
|
|
|
|
} |
1736
|
|
|
|
|
|
|
|
1737
|
|
|
|
|
|
|
{ |
1738
|
|
|
|
|
|
|
declare_alias macro_yatt_block => \¯o_block; |
1739
|
|
|
|
|
|
|
sub macro_block { |
1740
|
3
|
|
|
3
|
0
|
7
|
(my MY $trans, my ($scope, $args)) = @_; |
1741
|
3
|
|
|
|
|
14
|
\ $trans->as_block |
1742
|
|
|
|
|
|
|
($trans->as_statement_list |
1743
|
|
|
|
|
|
|
($trans->generate_body([{}, $scope], $args))); |
1744
|
|
|
|
|
|
|
} |
1745
|
|
|
|
|
|
|
|
1746
|
|
|
|
|
|
|
declare_alias macro_yatt_my => \¯o_my; |
1747
|
|
|
|
|
|
|
sub macro_my { |
1748
|
6
|
|
|
6
|
0
|
16
|
(my MY $trans, my ($scope, $args)) = @_; |
1749
|
6
|
|
|
|
|
13
|
my @assign; |
1750
|
6
|
|
|
|
|
23
|
my $filename = $args->metainfo->filename; |
1751
|
6
|
|
|
|
|
39
|
for (; $args->readable; $args->next) { |
1752
|
8
|
100
|
|
|
|
36
|
last unless $args->is_primary_attribute; |
1753
|
7
|
|
|
|
|
32
|
my ($name, $typename) = $trans->arg_name_types($args); |
1754
|
7
|
100
|
66
|
|
|
47
|
$typename ||= $args->next_is_body ? 'html' : 'text'; |
1755
|
7
|
50
|
|
|
|
26
|
if (my VarType $old = $scope->[0]{$name}) { |
1756
|
|
|
|
|
|
|
die $trans->node_error |
1757
|
|
|
|
|
|
|
($args, "Variable '%s' redefined (previously at file %s line %s)" |
1758
|
|
|
|
|
|
|
, $name, $old->{cf_filename} || '(unknown)' |
1759
|
0
|
|
0
|
|
|
0
|
, $old->{cf_linenum} || '(unknown)'); |
|
|
|
0
|
|
|
|
|
1760
|
|
|
|
|
|
|
} |
1761
|
7
|
|
|
|
|
35
|
my $var = $scope->[0]{$name} |
1762
|
|
|
|
|
|
|
= $trans->create_var($typename, $args |
1763
|
|
|
|
|
|
|
, varname => $name |
1764
|
|
|
|
|
|
|
, filename => $filename |
1765
|
|
|
|
|
|
|
, linenum => $args->linenum); |
1766
|
|
|
|
|
|
|
|
1767
|
7
|
100
|
|
|
|
35
|
push @assign, [$var, $args->node_size |
1768
|
|
|
|
|
|
|
? $var->gen_assignable_node($trans, $scope, $args) |
1769
|
|
|
|
|
|
|
: ()]; |
1770
|
|
|
|
|
|
|
} |
1771
|
|
|
|
|
|
|
|
1772
|
6
|
100
|
|
|
|
22
|
if ($args->readable) { |
1773
|
1
|
|
|
|
|
4
|
my $var = $assign[-1][0]; |
1774
|
1
|
|
33
|
|
|
14
|
$assign[-1][1] ||= $var->gen_assignable_node($trans, $scope, $args, 1); |
1775
|
|
|
|
|
|
|
} |
1776
|
|
|
|
|
|
|
|
1777
|
6
|
|
|
|
|
11
|
my @script; |
1778
|
6
|
|
|
|
|
15
|
foreach my $desc (@assign) { |
1779
|
7
|
|
|
|
|
17
|
my ($var, $value) = @$desc; |
1780
|
7
|
|
|
|
|
23
|
my $script = sprintf q{my %s}, $var->as_lvalue; |
1781
|
7
|
100
|
|
|
|
25
|
$script .= q{ = } . $value if defined $value; |
1782
|
7
|
|
|
|
|
44
|
push @script, \ $script; |
1783
|
|
|
|
|
|
|
} |
1784
|
6
|
|
|
|
|
37
|
@script; |
1785
|
|
|
|
|
|
|
} |
1786
|
|
|
|
|
|
|
} |
1787
|
|
|
|
|
|
|
|
1788
|
|
|
|
|
|
|
{ |
1789
|
|
|
|
|
|
|
declare_alias macro_yatt_format => \¯o_format; |
1790
|
|
|
|
|
|
|
sub macro_format { |
1791
|
3
|
|
|
3
|
0
|
7
|
(my MY $trans, my ($scope, $args)) = @_; |
1792
|
|
|
|
|
|
|
|
1793
|
3
|
50
|
33
|
|
|
12
|
unless ($args->readable && $args->is_primary_attribute) { |
1794
|
0
|
|
|
|
|
0
|
die $trans->node_error($args, "format parameter is missing"); |
1795
|
|
|
|
|
|
|
} |
1796
|
|
|
|
|
|
|
|
1797
|
3
|
|
|
|
|
12
|
my $name = $args->node_name; |
1798
|
|
|
|
|
|
|
|
1799
|
3
|
|
|
|
|
5
|
my $format = do { |
1800
|
3
|
100
|
|
|
|
15
|
if (my $var = $trans->has_pass_through_var($scope, $args, $name)) { |
1801
|
1
|
|
|
|
|
5
|
$var->as_lvalue; |
1802
|
|
|
|
|
|
|
} else { |
1803
|
2
|
|
|
|
|
12
|
$trans->faked_gentype(text => $scope, $args); |
1804
|
|
|
|
|
|
|
} |
1805
|
|
|
|
|
|
|
}; |
1806
|
|
|
|
|
|
|
|
1807
|
3
|
|
|
|
|
22
|
$args->next; |
1808
|
|
|
|
|
|
|
|
1809
|
3
|
|
|
|
|
15
|
sprintf(q|sprintf(%s, %s)| |
1810
|
|
|
|
|
|
|
, $format |
1811
|
|
|
|
|
|
|
, $trans->as_join($trans->generate_body([{}, $scope], $args))); |
1812
|
|
|
|
|
|
|
} |
1813
|
|
|
|
|
|
|
} |
1814
|
|
|
|
|
|
|
|
1815
|
|
|
|
|
|
|
sub macro_dbfetch { |
1816
|
0
|
|
|
0
|
0
|
0
|
require YATT::Translator::Perl::macro_dbfetch; |
1817
|
0
|
|
|
|
|
0
|
shift->YATT::Translator::Perl::macro_dbfetch::macro(@_); |
1818
|
|
|
|
|
|
|
} |
1819
|
|
|
|
|
|
|
|
1820
|
|
|
|
|
|
|
sub feed_arg_or_make_hash_of { |
1821
|
0
|
|
|
0
|
0
|
0
|
(my $trans |
1822
|
|
|
|
|
|
|
, my ($type, $scope, $args, $arg_dict, $arg_order)) = splice @_, 0, 6; |
1823
|
0
|
|
|
|
|
0
|
my (@primary, @secondary); |
1824
|
0
|
|
|
|
|
0
|
for (my $nth = 0; $args->readable; $args->next) { |
1825
|
0
|
0
|
|
|
|
0
|
last unless $args->is_primary_attribute; |
1826
|
0
|
|
|
|
|
0
|
my ($name, @ext) = $args->node_path; |
1827
|
0
|
0
|
|
|
|
0
|
unless (defined $name) { |
1828
|
0
|
0
|
|
|
|
0
|
$name = $arg_order->[$nth++] |
1829
|
|
|
|
|
|
|
or die $trans->node_error($args, "Too many args"); |
1830
|
|
|
|
|
|
|
} |
1831
|
0
|
0
|
|
|
|
0
|
if ($name =~ /^-(.*)/) { |
1832
|
|
|
|
|
|
|
# XXX: そもそも -name=[...] で構造化したかった |
1833
|
0
|
|
|
|
|
0
|
push @secondary, [$name, $trans->faked_gentype |
1834
|
|
|
|
|
|
|
($type => $scope, $args, $args->current)]; |
1835
|
0
|
|
|
|
|
0
|
next; |
1836
|
|
|
|
|
|
|
} |
1837
|
0
|
0
|
|
|
|
0
|
defined (my $argno = $arg_dict->{$name}) or do { |
1838
|
0
|
|
|
|
|
0
|
push @primary, [$name, $trans->faked_gentype |
1839
|
|
|
|
|
|
|
($type => $scope, $args, $args->current)]; |
1840
|
0
|
|
|
|
|
0
|
next; |
1841
|
|
|
|
|
|
|
}; |
1842
|
|
|
|
|
|
|
|
1843
|
0
|
|
|
|
|
0
|
$_[$argno] = $args->current; |
1844
|
|
|
|
|
|
|
} |
1845
|
0
|
0
|
|
|
|
0
|
grep {@$_ ? $_ : ()} (\@primary, \@secondary); |
|
0
|
|
|
|
|
0
|
|
1846
|
|
|
|
|
|
|
} |
1847
|
|
|
|
|
|
|
|
1848
|
|
|
|
|
|
|
#======================================== |
1849
|
|
|
|
|
|
|
sub entmacro_if { |
1850
|
4
|
|
|
4
|
0
|
13
|
my ($this, $trans |
1851
|
|
|
|
|
|
|
, $scope, $node, $restExpr, $queue, @args) = @_; |
1852
|
|
|
|
|
|
|
# XXX: $cond を文字列にするのは不便。 |
1853
|
4
|
|
|
|
|
18
|
my ($cond, $then, $else) |
1854
|
|
|
|
|
|
|
= $trans->gen_entref_list($scope, $node, @args); |
1855
|
|
|
|
|
|
|
# XXX: 三項演算だと、狂いが出そうな。 |
1856
|
|
|
|
|
|
|
sprintf q{((%s) ? %s : %s)} |
1857
|
4
|
50
|
50
|
|
|
19
|
, map {ref $_ ? $$_ : $_} $cond, $then, $else || q{''}; |
|
12
|
|
|
|
|
63
|
|
1858
|
|
|
|
|
|
|
}; |
1859
|
|
|
|
|
|
|
|
1860
|
|
|
|
|
|
|
sub entmacro_render { |
1861
|
2
|
|
|
2
|
0
|
6
|
my ($this, $trans |
1862
|
|
|
|
|
|
|
, $scope, $node, $restExpr, $queue, @args) = @_; |
1863
|
2
|
|
|
|
|
9
|
my ($type, @expr) |
1864
|
|
|
|
|
|
|
= $trans->gen_entref_list($scope, $node, @args); |
1865
|
2
|
|
|
|
|
16
|
\ sprintf q{__PACKAGE__->can('render_'.%s)->($this, [%s])} |
1866
|
|
|
|
|
|
|
, $type, join(", ", @expr); |
1867
|
|
|
|
|
|
|
}; |
1868
|
|
|
|
|
|
|
#======================================== |
1869
|
|
|
|
|
|
|
|
1870
|
|
|
|
|
|
|
sub paren_escape ($) { |
1871
|
352
|
50
|
|
352
|
0
|
838
|
unless (defined $_[0]) { |
1872
|
0
|
|
|
|
|
0
|
confess "Undefined text"; |
1873
|
|
|
|
|
|
|
} |
1874
|
352
|
|
|
|
|
769
|
$_[0] =~ s{([\(\)\\])}{\\$1}g; |
1875
|
352
|
|
|
|
|
2445
|
$_[0] |
1876
|
|
|
|
|
|
|
} |
1877
|
|
|
|
|
|
|
|
1878
|
|
|
|
|
|
|
sub qparen ($) { |
1879
|
352
|
|
|
352
|
0
|
884
|
'q('.paren_escape($_[0]).')' |
1880
|
|
|
|
|
|
|
} |
1881
|
|
|
|
|
|
|
|
1882
|
|
|
|
|
|
|
sub qqvalue ($) { |
1883
|
26
|
|
|
26
|
0
|
72
|
'q'.qparen($_[0]); |
1884
|
|
|
|
|
|
|
} |
1885
|
|
|
|
|
|
|
|
1886
|
|
|
|
|
|
|
{ |
1887
|
|
|
|
|
|
|
my %map = ("\r", "r", "\n", "n"); |
1888
|
|
|
|
|
|
|
sub qcrlf ($) { |
1889
|
129
|
|
|
129
|
0
|
241
|
my ($crlf) = @_; |
1890
|
129
|
|
|
|
|
924
|
$crlf =~ s{([\r\n])}{\\$map{$1}}g; |
1891
|
129
|
|
|
|
|
1094
|
$crlf; |
1892
|
|
|
|
|
|
|
} |
1893
|
|
|
|
|
|
|
} |
1894
|
|
|
|
|
|
|
|
1895
|
|
|
|
|
|
|
sub dots_for_arrows { |
1896
|
31
|
|
|
31
|
0
|
49
|
shift; |
1897
|
31
|
50
|
|
|
|
92
|
return unless defined $_[0]; |
1898
|
31
|
|
|
|
|
73
|
$_[0] =~ s{\b\.(?=\w+\()}{->}g; |
1899
|
31
|
|
|
|
|
122
|
$_[0]; |
1900
|
|
|
|
|
|
|
} |
1901
|
|
|
|
|
|
|
|
1902
|
|
|
|
|
|
|
1; |