line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package App::sh2p::Handlers; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
27
|
|
4
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
562
|
use App::sh2p::Parser; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
19
|
|
6
|
1
|
|
|
1
|
|
4
|
use App::sh2p::Utils; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
215
|
|
7
|
1
|
|
|
1
|
|
494
|
use App::sh2p::Here; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
7223
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our $VERSION = '0.06'; |
10
|
|
|
|
|
|
|
sub App::sh2p::Parser::convert(\@\@); |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
my $g_unterminated_backtick = 0; |
13
|
|
|
|
|
|
|
my $g_redirect_filename_w; |
14
|
|
|
|
|
|
|
my $g_redirect_filename_r; |
15
|
|
|
|
|
|
|
my %g_subs; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
# For use by App::sh2p only |
18
|
|
|
|
|
|
|
############################################################################ |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub Handle_assignment { |
21
|
|
|
|
|
|
|
|
22
|
0
|
|
|
0
|
0
|
|
my $ntok = 1; |
23
|
0
|
|
|
|
|
|
my ($in, @rest) = @_; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
#print STDERR "Handle_assignment: <$in>\n"; |
26
|
|
|
|
|
|
|
|
27
|
0
|
|
|
|
|
|
$in =~ /^(\w+)(\+?=?)(.*)$/; |
28
|
0
|
|
|
|
|
|
my $lhs = $1; |
29
|
0
|
|
|
|
|
|
my $sign = $2; |
30
|
0
|
|
|
|
|
|
my $rhs = $3; |
31
|
|
|
|
|
|
|
|
32
|
0
|
|
|
|
|
|
my $special_var = get_special_var($lhs,0); # January 2009 |
33
|
|
|
|
|
|
|
|
34
|
0
|
0
|
|
|
|
|
if (defined $special_var) { |
35
|
0
|
|
|
|
|
|
set_special_var ($lhs, $rhs); |
36
|
0
|
0
|
|
|
|
|
if ($special_var =~ s/^\$//) { |
37
|
0
|
|
|
|
|
|
$lhs = $special_var; # Converted special variable |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
else { |
40
|
0
|
|
|
|
|
|
$special_var = undef; |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
# Bash 3.0, ksh93 array initialisation |
45
|
0
|
0
|
|
|
|
|
if (substr($rhs,0,1) eq '(') { |
46
|
0
|
|
|
|
|
|
return Handle_list_assign($lhs, $sign, $rhs, @rest); |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
|
49
|
0
|
|
|
|
|
|
my $name = "\$$lhs"; |
50
|
|
|
|
|
|
|
|
51
|
0
|
0
|
0
|
|
|
|
if (!defined $special_var && Register_variable ($name) ) { |
52
|
0
|
|
|
|
|
|
iout "my $name"; |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
else { |
55
|
0
|
|
|
|
|
|
iout "$name"; |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
|
58
|
0
|
0
|
|
|
|
|
if ( ! defined $rhs ) { |
59
|
0
|
|
|
|
|
|
out ';'; |
60
|
0
|
0
|
|
|
|
|
if ($ntok == @_) { |
61
|
0
|
|
|
|
|
|
out "\n"; |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
0
|
|
|
|
|
|
return $ntok; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
else { |
67
|
0
|
|
|
|
|
|
out ' = '; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
0
|
|
|
|
|
|
my $isa_int = 0; |
71
|
0
|
0
|
|
|
|
|
if (get_variable_type($name) eq 'int') { |
72
|
0
|
|
|
|
|
|
$isa_int = 1; |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
0
|
0
|
|
|
|
|
if ( $rhs eq '' ) { |
|
|
0
|
|
|
|
|
|
76
|
0
|
0
|
|
|
|
|
if ($isa_int) { |
77
|
0
|
|
|
|
|
|
out 0 |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
else { |
80
|
0
|
|
|
|
|
|
out '""' |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
elsif ($rhs =~ /^\d+$/) { |
84
|
0
|
|
|
|
|
|
out $rhs |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
else { |
87
|
|
|
|
|
|
|
# Process the rhs |
88
|
|
|
|
|
|
|
|
89
|
0
|
0
|
|
|
|
|
if ($isa_int) { |
90
|
0
|
|
|
|
|
|
out "int("; |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
0
|
|
|
|
|
|
for my $tok (@rest) { |
94
|
0
|
0
|
0
|
|
|
|
last if substr($tok,0,1) eq '#' || is_break($tok); |
95
|
0
|
|
|
|
|
|
$rhs .= "$tok "; |
96
|
0
|
|
|
|
|
|
$ntok++; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
0
|
|
|
|
|
|
no_semi_colon(); |
100
|
0
|
|
|
|
|
|
my @tokens = App::sh2p::Parser::tokenise ($rhs); |
101
|
0
|
|
|
|
|
|
my @types = App::sh2p::Parser::identify (1, @tokens); |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
#print_types_tokens (\@types, \@tokens); |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
# Avoid recursion |
106
|
0
|
0
|
|
|
|
|
die "Nested assignment $in" if $types[0] eq 'ASSIGNMENT'; |
107
|
|
|
|
|
|
|
|
108
|
0
|
|
|
|
|
|
App::sh2p::Parser::convert (@tokens, @types); |
109
|
0
|
|
|
|
|
|
reset_semi_colon(); |
110
|
|
|
|
|
|
|
|
111
|
0
|
0
|
|
|
|
|
if ($isa_int) { |
112
|
0
|
|
|
|
|
|
out ")"; |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
|
116
|
0
|
|
|
|
|
|
out ';'; |
117
|
|
|
|
|
|
|
#if ($ntok == @_) { 0.05 (regression OK) |
118
|
0
|
|
|
|
|
|
out "\n"; |
119
|
|
|
|
|
|
|
#} |
120
|
|
|
|
|
|
|
|
121
|
0
|
|
|
|
|
|
return $ntok; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
############################################################################ |
125
|
|
|
|
|
|
|
# Bash 3.0, ksh93 array initialisation (inc. += ) |
126
|
|
|
|
|
|
|
sub Handle_list_assign { |
127
|
0
|
|
|
0
|
0
|
|
my ($lhs, $sign, $rhs, @rest) = @_; |
128
|
0
|
|
|
|
|
|
my $ntok = 1; |
129
|
0
|
|
|
|
|
|
my $name = "\@$lhs"; |
130
|
0
|
|
|
|
|
|
my $new = 0; |
131
|
0
|
|
|
|
|
|
my $start_index = 0; |
132
|
|
|
|
|
|
|
|
133
|
0
|
0
|
|
|
|
|
if (Register_variable ($name, '@')) { |
134
|
0
|
|
|
|
|
|
$new = 1; |
135
|
0
|
|
|
|
|
|
iout "my $name"; |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
# Process the rhs |
139
|
|
|
|
|
|
|
#print STDERR "Handle_list_assign: <$lhs> <$sign> <$rhs> <@rest>\n"; |
140
|
0
|
|
|
|
|
|
$rhs =~ s/^\((.*)\)$/$1/; # strip out the () |
141
|
|
|
|
|
|
|
|
142
|
0
|
|
|
|
|
|
my @elements = split (/\s+/, $rhs); |
143
|
0
|
|
|
|
|
|
my @initial; |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
# Get first set of elements without [] (might be all, or none) |
146
|
0
|
|
|
|
|
|
while (@elements) { |
147
|
0
|
0
|
|
|
|
|
last if ($elements[0] =~ /^\s*\[\d+\]=/); |
148
|
|
|
|
|
|
|
|
149
|
0
|
|
|
|
|
|
push @initial,(shift @elements); |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
0
|
0
|
|
|
|
|
if (@initial) { |
153
|
|
|
|
|
|
|
|
154
|
0
|
0
|
|
|
|
|
if ($sign eq '+=') { |
155
|
0
|
0
|
|
|
|
|
if ($new) { |
156
|
0
|
|
|
|
|
|
out ";\n"; |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
0
|
|
|
|
|
|
iout "push $name,("; |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
else { |
162
|
0
|
0
|
|
|
|
|
if (!$new) { |
163
|
0
|
|
|
|
|
|
iout "$name"; |
164
|
|
|
|
|
|
|
} |
165
|
0
|
|
|
|
|
|
out ' = ('; |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
|
168
|
0
|
|
|
|
|
|
App::sh2p::Parser::join_parse_tokens (',', @initial); |
169
|
0
|
|
|
|
|
|
out ");\n"; |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
else { |
172
|
0
|
|
|
|
|
|
out ";\n"; |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
# indexed elements |
176
|
|
|
|
|
|
|
# Start the index at the end of the initial array |
177
|
|
|
|
|
|
|
# Is this a problem with += ?? |
178
|
0
|
|
|
|
|
|
my $index = @initial; |
179
|
|
|
|
|
|
|
|
180
|
0
|
|
|
|
|
|
for (my $i = 0; $i < @elements; $i++) { |
181
|
|
|
|
|
|
|
|
182
|
0
|
|
|
|
|
|
my $rhs; |
183
|
0
|
0
|
|
|
|
|
if ($elements[$i] =~ /^\s*\[(\d+)\]=(.*)/) { |
184
|
0
|
|
|
|
|
|
$index = $1; |
185
|
0
|
|
|
|
|
|
$rhs = $2; |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
else { |
188
|
0
|
|
|
|
|
|
$index++; |
189
|
0
|
|
|
|
|
|
$rhs = $elements[$i]; |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
0
|
|
|
|
|
|
iout "\$$lhs\[$index\] = "; |
193
|
0
|
|
|
|
|
|
my @tokens = ($rhs); |
194
|
0
|
|
|
|
|
|
my @types = App::sh2p::Parser::identify (1, @tokens); |
195
|
0
|
|
|
|
|
|
App::sh2p::Parser::convert (@tokens, @types); |
196
|
0
|
|
|
|
|
|
out ";\n" |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
# No processing of @rest |
200
|
|
|
|
|
|
|
|
201
|
0
|
|
|
|
|
|
return 1; |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
############################################################################ |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
sub define_idx_var { |
207
|
|
|
|
|
|
|
|
208
|
0
|
|
|
0
|
0
|
|
my $var = shift; |
209
|
|
|
|
|
|
|
|
210
|
0
|
|
|
|
|
|
$var =~ s/^\$//; # remove leading $, if any |
211
|
|
|
|
|
|
|
|
212
|
0
|
|
|
|
|
|
$var =~ s/\s*[\+\-\*\/]?\s*\d+\s*//; # remove arithmetic |
213
|
|
|
|
|
|
|
|
214
|
0
|
0
|
|
|
|
|
if (Register_variable ($var, '$') ) { |
215
|
0
|
|
|
|
|
|
iout "my \$$var;\n"; |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
sub Handle_array_assignment { |
220
|
0
|
|
|
0
|
0
|
|
my $ntok = @_; |
221
|
0
|
|
|
|
|
|
my $in = shift; |
222
|
|
|
|
|
|
|
|
223
|
0
|
|
|
|
|
|
$in =~ /^(\w+)\[(.*)\]=(.*)$/; |
224
|
|
|
|
|
|
|
|
225
|
0
|
|
|
|
|
|
my $arr = $1; |
226
|
0
|
|
|
|
|
|
my $idx = $2; |
227
|
0
|
|
|
|
|
|
my $rhs = $3; |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
#print STDERR "Handle_array_assignment: <$arr> <$idx> <$rhs>\n"; |
230
|
|
|
|
|
|
|
|
231
|
0
|
0
|
|
|
|
|
if ( !defined $rhs) { |
232
|
0
|
|
|
|
|
|
die "++++ Internal error No rhs in array assignment. <$in>" |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
0
|
0
|
|
|
|
|
if (Register_variable ("\@$arr", '@') ) { |
236
|
0
|
|
|
|
|
|
iout "my \@$arr;\n"; |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
# The shell allows a variable index without a '$' |
240
|
0
|
0
|
|
|
|
|
if ($idx =~ /^[[:alpha:]_]/) { # No '$' [count + 1], or [i] ([1 + count] is illegal) |
|
|
0
|
|
|
|
|
|
241
|
|
|
|
|
|
|
|
242
|
0
|
|
|
|
|
|
define_idx_var ($idx); |
243
|
|
|
|
|
|
|
|
244
|
0
|
|
|
|
|
|
iout "\$$arr\[\$$idx\] = "; |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
elsif ( $idx =~ /^\D+$/) { # \D is non-digit |
247
|
|
|
|
|
|
|
# Process the lhs |
248
|
|
|
|
|
|
|
|
249
|
0
|
|
|
|
|
|
my @tokens = App::sh2p::Parser::tokenise ($idx); |
250
|
0
|
|
|
|
|
|
my @types = App::sh2p::Parser::identify (1, @tokens); |
251
|
|
|
|
|
|
|
|
252
|
0
|
|
|
|
|
|
iout "\$$arr\["; |
253
|
0
|
|
|
|
|
|
App::sh2p::Parser::convert (@tokens, @types); |
254
|
0
|
|
|
|
|
|
out "] = "; |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
else { |
257
|
0
|
0
|
|
|
|
|
if ( $idx =~ /^\s*\$/ ) { |
258
|
0
|
|
|
|
|
|
define_idx_var ($idx); |
259
|
|
|
|
|
|
|
} |
260
|
|
|
|
|
|
|
|
261
|
0
|
|
|
|
|
|
iout "\$$arr\[$idx\] = "; |
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
|
264
|
0
|
0
|
|
|
|
|
if ( !defined $rhs ) { |
265
|
0
|
|
|
|
|
|
out 'undef' |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
else { |
268
|
|
|
|
|
|
|
# Process the rhs |
269
|
|
|
|
|
|
|
|
270
|
0
|
|
|
|
|
|
my @tokens = App::sh2p::Parser::tokenise ($rhs); |
271
|
0
|
|
|
|
|
|
my @types = App::sh2p::Parser::identify (1, @tokens); |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
# Avoid recursion |
274
|
0
|
0
|
|
|
|
|
die "++++ Internal error: Nested array assignment $in" if $types[0] eq 'ARRAY_ASSIGNMENT'; |
275
|
|
|
|
|
|
|
#print_types_tokens (\@types, \@tokens); |
276
|
|
|
|
|
|
|
|
277
|
0
|
|
|
|
|
|
App::sh2p::Parser::convert (@tokens, @types); |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
|
280
|
0
|
|
|
|
|
|
out ";\n"; |
281
|
0
|
|
|
|
|
|
return $ntok; |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
} |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
############################################################################ |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
sub Handle_break { |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
# Maybe check to see if we are in a heredoc? |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
# 0.05 |
292
|
|
|
|
|
|
|
#if (!App::sh2p::Utils::new_line()) { |
293
|
|
|
|
|
|
|
# out "\n"; |
294
|
|
|
|
|
|
|
#} |
295
|
|
|
|
|
|
|
|
296
|
0
|
|
|
0
|
0
|
|
return 1; |
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
############################################################################ |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
sub Handle_open_redirection { |
302
|
0
|
|
|
0
|
0
|
|
my ($type, $filename) = @_; |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
#print STDERR "Handle_open_redirection: <$type> <$filename>\n"; |
305
|
0
|
|
|
|
|
|
my @caller = caller(); |
306
|
|
|
|
|
|
|
#print STDERR "Handle_open_redirection: @caller\n"; |
307
|
|
|
|
|
|
|
|
308
|
0
|
|
|
|
|
|
out ("\n"); |
309
|
|
|
|
|
|
|
|
310
|
0
|
|
|
|
|
|
my $var = 'sh2p_handle'; |
311
|
0
|
0
|
|
|
|
|
if (Register_variable($var, '$')) { |
312
|
0
|
|
|
|
|
|
rd_iout "my \$$var;\n"; |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
|
315
|
0
|
|
|
|
|
|
rd_iout ("open(\$$var,'$type',\"$filename\") or\n"); |
316
|
0
|
|
|
|
|
|
rd_iout (" die \"Unable to open $filename: \$!\";\n"); |
317
|
|
|
|
|
|
|
|
318
|
0
|
0
|
0
|
|
|
|
if ( $type eq '>' || $type eq '>>' ) { |
319
|
0
|
|
|
|
|
|
$g_redirect_filename_w = $filename; |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
else { |
322
|
0
|
|
|
|
|
|
$g_redirect_filename_r = $filename; |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
############################################################################ |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
sub Handle_close_redirection { |
329
|
|
|
|
|
|
|
|
330
|
0
|
|
|
0
|
0
|
|
my ($mode) = @_; |
331
|
0
|
|
|
|
|
|
my $filename; |
332
|
|
|
|
|
|
|
|
333
|
0
|
0
|
|
|
|
|
if ($mode eq 'w') { |
334
|
0
|
|
|
|
|
|
$filename = $g_redirect_filename_w; |
335
|
0
|
|
|
|
|
|
$g_redirect_filename_w = undef; |
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
else { |
338
|
0
|
|
|
|
|
|
$filename = $g_redirect_filename_r; |
339
|
0
|
|
|
|
|
|
$g_redirect_filename_r = undef; |
340
|
|
|
|
|
|
|
} |
341
|
|
|
|
|
|
|
|
342
|
0
|
0
|
|
|
|
|
if (defined $filename) { |
343
|
0
|
|
|
|
|
|
iout ("close(\$sh2p_handle);\n"); |
344
|
0
|
|
|
|
|
|
iout ("undef \$sh2p_handle;\n\n"); |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
|
347
|
0
|
|
|
|
|
|
return 1; # In case it gets used as a token |
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
############################################################################ |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
sub Query_redirection { |
353
|
0
|
|
|
0
|
0
|
|
my ($mode) = @_; |
354
|
|
|
|
|
|
|
|
355
|
0
|
0
|
|
|
|
|
if ($mode eq 'w') { |
356
|
0
|
|
|
|
|
|
return $g_redirect_filename_w; |
357
|
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
else { |
359
|
0
|
|
|
|
|
|
return $g_redirect_filename_r; |
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
############################################################################ |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
sub Handle_variable { |
366
|
0
|
|
|
0
|
0
|
|
my ($token, $join) = @_; |
367
|
0
|
|
|
|
|
|
my $new_token; |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
#print STDERR "Handle_variable: <$token> ".query_in_quotes()." context: <". |
370
|
|
|
|
|
|
|
# App::sh2p::Compound::get_context().">\n"; |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
# Check for specials |
373
|
0
|
0
|
|
|
|
|
if ($new_token = get_special_var($token)) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
374
|
0
|
|
|
|
|
|
$token = $new_token; |
375
|
|
|
|
|
|
|
} |
376
|
|
|
|
|
|
|
elsif ( $token =~ s/^\$#(\w+)(.*)/\$$1/ ) { # length |
377
|
0
|
|
|
|
|
|
my $suffix = $2; |
378
|
0
|
0
|
|
|
|
|
if ( $suffix =~ /\[\s*[\*\@]\s*\]/ ) { # [*] or [@] |
379
|
0
|
|
|
|
|
|
$token =~ s/^\$/\@/; |
380
|
0
|
|
|
|
|
|
out "scalar($token)"; |
381
|
|
|
|
|
|
|
} |
382
|
|
|
|
|
|
|
else { |
383
|
0
|
|
|
|
|
|
out "length($token)"; |
384
|
|
|
|
|
|
|
} |
385
|
0
|
|
|
|
|
|
return 1; |
386
|
|
|
|
|
|
|
} |
387
|
|
|
|
|
|
|
elsif ( $token =~ s/^\$!(\w+)\[.*\]/\@$1/ ) { # ksh92 & bash ! |
388
|
|
|
|
|
|
|
# Find indexes of set variables |
389
|
0
|
|
|
|
|
|
iout "sh2p_array_count($token)"; |
390
|
0
|
|
|
|
|
|
store_sh2p_array_count ($token); |
391
|
|
|
|
|
|
|
|
392
|
0
|
|
|
|
|
|
return 1; |
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
elsif ( substr($token, 0, 3) eq '$((' ) { |
395
|
|
|
|
|
|
|
# Calculation |
396
|
0
|
|
|
|
|
|
$token =~ s/\$\(\((.*)\)\)/$1/g; |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
} |
399
|
|
|
|
|
|
|
elsif ( substr($token, 0, 2) eq '$(' ) { |
400
|
|
|
|
|
|
|
# Back-ticks |
401
|
|
|
|
|
|
|
|
402
|
0
|
|
|
|
|
|
$token =~ s/\$\((.*)\)/`$1`/g; |
403
|
|
|
|
|
|
|
} |
404
|
|
|
|
|
|
|
elsif ( $token =~ /\[(.+)\]/) { |
405
|
|
|
|
|
|
|
#print STDERR "Handle_variable array <$1>\n"; |
406
|
0
|
|
|
|
|
|
my $idx = $1; |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
# The shell allows a variable index without a '$' |
409
|
0
|
0
|
0
|
|
|
|
if ($idx =~ /^[[:alpha:]_]/) { # No '$' [count + 1] or even [i] |
|
|
0
|
|
|
|
|
|
410
|
0
|
|
|
|
|
|
$idx = "\$$idx"; |
411
|
|
|
|
|
|
|
|
412
|
0
|
|
|
|
|
|
$token =~ s/\[(.+)\]/[$idx]/; |
413
|
|
|
|
|
|
|
} |
414
|
|
|
|
|
|
|
elsif ( $idx eq '*' || $idx eq '@' ) { |
415
|
|
|
|
|
|
|
# How do we find if we are quoted? |
416
|
0
|
|
|
|
|
|
$token =~ s/\$(.+)\[.*\]/$1/; |
417
|
|
|
|
|
|
|
|
418
|
0
|
0
|
|
|
|
|
if (query_in_quotes()) { |
419
|
0
|
0
|
|
|
|
|
if ($idx eq '@') { |
420
|
0
|
|
|
|
|
|
$token = "\"\@$token\""; |
421
|
|
|
|
|
|
|
} |
422
|
|
|
|
|
|
|
else { |
423
|
0
|
|
|
|
|
|
my $glue = get_special_var('IFS'); |
424
|
0
|
|
|
|
|
|
$glue =~ s/^([\"\'])(.*)\1$/$2/; # Not certain there are quotes |
425
|
0
|
|
|
|
|
|
$glue = substr($glue,0,1); |
426
|
0
|
|
|
|
|
|
$token = "join(\"$glue\",\@$token)"; |
427
|
|
|
|
|
|
|
} |
428
|
|
|
|
|
|
|
} |
429
|
|
|
|
|
|
|
else { |
430
|
0
|
|
|
|
|
|
$token = "\@$token"; |
431
|
|
|
|
|
|
|
} |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
} |
435
|
|
|
|
|
|
|
|
436
|
0
|
|
|
|
|
|
out $token; |
437
|
|
|
|
|
|
|
|
438
|
0
|
|
|
|
|
|
return 1; |
439
|
|
|
|
|
|
|
} |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
############################################################################ |
442
|
|
|
|
|
|
|
sub Handle_expansion { |
443
|
0
|
|
|
0
|
0
|
|
my ($token) = @_; |
444
|
0
|
|
|
|
|
|
my $ntok; |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
#print STDERR "Handle_expansion: <$token>\n"; |
447
|
|
|
|
|
|
|
# my @caller = caller(); |
448
|
|
|
|
|
|
|
# print STDERR "Called from @caller\n"; |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
# Strip out the braces |
451
|
|
|
|
|
|
|
# $2: (.*?) replaced with (.*) 0.04 |
452
|
0
|
|
|
|
|
|
$token =~ s/\$\{(.*?)\}(.*)/\$$1/; |
453
|
0
|
|
|
|
|
|
my $suffix = $2; |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
# Arrays |
456
|
0
|
0
|
|
|
|
|
if ($token =~ /\w+\[.*\]/) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
457
|
0
|
|
|
|
|
|
$ntok = Handle_variable($token); |
458
|
|
|
|
|
|
|
} |
459
|
|
|
|
|
|
|
elsif ( $token =~ /(\w+)([:?\-=+]{1,2})([^:?\-=+]+)/ ) { |
460
|
0
|
|
|
|
|
|
my $var = '$'.$1; |
461
|
0
|
|
|
|
|
|
my $qual = $2; |
462
|
0
|
|
|
|
|
|
my $extras = $3; |
463
|
|
|
|
|
|
|
#print STDERR "Handle_expansion <$var><$2><$3>\n"; |
464
|
|
|
|
|
|
|
|
465
|
0
|
0
|
|
|
|
|
if (my $new_var = get_special_var($var)) { |
466
|
0
|
|
|
|
|
|
$var = $new_var; |
467
|
|
|
|
|
|
|
} |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
# Remove the : |
470
|
|
|
|
|
|
|
# Done this way in case further modification is required |
471
|
0
|
|
|
|
|
|
$qual =~ s/^://; |
472
|
|
|
|
|
|
|
|
473
|
0
|
0
|
|
|
|
|
if ($qual eq '?') { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
474
|
0
|
0
|
|
|
|
|
if (! $extras) { |
475
|
0
|
|
|
|
|
|
$extras = "'$var undef or not set'"; |
476
|
|
|
|
|
|
|
} |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
# $extras should already be quoted |
479
|
0
|
|
|
|
|
|
out ("print STDERR $extras,\"\\n\" if (! defined $var or ! $var);"); |
480
|
|
|
|
|
|
|
} |
481
|
|
|
|
|
|
|
elsif ($qual eq '=') { |
482
|
0
|
|
|
|
|
|
out ("(defined $var or $var) || $var = "); |
483
|
0
|
|
|
|
|
|
my @tmp = ($extras); |
484
|
0
|
|
|
|
|
|
my @types = App::sh2p::Parser::identify (1, @tmp); |
485
|
0
|
|
|
|
|
|
App::sh2p::Parser::convert (@tmp, @types); |
486
|
|
|
|
|
|
|
} |
487
|
|
|
|
|
|
|
elsif ($qual eq '-') { |
488
|
0
|
|
|
|
|
|
out ("(defined $var or $var) || "); |
489
|
0
|
|
|
|
|
|
my @tmp = ($extras); |
490
|
0
|
|
|
|
|
|
my @types = App::sh2p::Parser::identify (1, @tmp); |
491
|
0
|
|
|
|
|
|
App::sh2p::Parser::convert (@tmp, @types); |
492
|
|
|
|
|
|
|
} |
493
|
|
|
|
|
|
|
elsif ($qual eq '+') { |
494
|
0
|
|
|
|
|
|
out ("(! defined $var or ! $var) || "); |
495
|
0
|
|
|
|
|
|
my @tmp = ($extras); |
496
|
0
|
|
|
|
|
|
my @types = App::sh2p::Parser::identify (1, @tmp); |
497
|
0
|
|
|
|
|
|
App::sh2p::Parser::convert (@tmp, @types); |
498
|
|
|
|
|
|
|
} |
499
|
|
|
|
|
|
|
else { |
500
|
0
|
|
|
|
|
|
error_out ("Pattern $qual not currently supported"); |
501
|
0
|
|
|
|
|
|
out ($token); |
502
|
|
|
|
|
|
|
} |
503
|
0
|
|
|
|
|
|
$ntok = 1; |
504
|
|
|
|
|
|
|
} |
505
|
|
|
|
|
|
|
elsif ( $token =~ s/^\$#(.+)/\$$1/ ) { |
506
|
0
|
|
|
|
|
|
out "length($token)"; |
507
|
0
|
|
|
|
|
|
$ntok = 1; |
508
|
|
|
|
|
|
|
} |
509
|
|
|
|
|
|
|
elsif ($token =~ /^(\$\w+)([%#]{1,2})(.*)/) { |
510
|
0
|
|
|
|
|
|
my $var = $1; |
511
|
0
|
|
|
|
|
|
my $mod = $2; |
512
|
0
|
|
|
|
|
|
my $pattern = $3; |
513
|
|
|
|
|
|
|
#print STDERR "Handle_expansion <$var><$2><$3>\n"; |
514
|
|
|
|
|
|
|
|
515
|
0
|
0
|
|
|
|
|
if (my $new_var = get_special_var($var)) { |
516
|
0
|
|
|
|
|
|
$var = $new_var; |
517
|
|
|
|
|
|
|
} |
518
|
|
|
|
|
|
|
|
519
|
0
|
0
|
|
|
|
|
if ($mod eq '#') { # delete the shortest on the left |
|
|
0
|
|
|
|
|
|
520
|
0
|
|
|
|
|
|
$pattern = App::sh2p::Compound::glob2pat($pattern,1,1); |
521
|
0
|
|
|
|
|
|
out "($var =~ /^(?:$pattern)+?(.*)/)[0]"; |
522
|
|
|
|
|
|
|
} |
523
|
|
|
|
|
|
|
elsif ($mod eq '##') { # delete the longest on the left |
524
|
0
|
|
|
|
|
|
$pattern = App::sh2p::Compound::glob2pat($pattern,1,0); |
525
|
0
|
|
|
|
|
|
out "($var =~ /^(?:$pattern)+(.*)/)[0]"; |
526
|
|
|
|
|
|
|
} |
527
|
0
|
0
|
|
|
|
|
if ($mod eq '%') { # delete the shortest on the right |
|
|
0
|
|
|
|
|
|
528
|
0
|
|
|
|
|
|
$pattern = App::sh2p::Compound::glob2pat($pattern,1,1); |
529
|
0
|
|
|
|
|
|
out "($var =~ /^(.*)(?:$pattern)+?\$/)[0]"; |
530
|
|
|
|
|
|
|
} |
531
|
|
|
|
|
|
|
elsif ($mod eq '%%') { # delete the longest on the right |
532
|
0
|
|
|
|
|
|
$pattern = App::sh2p::Compound::glob2pat($pattern,1,0); |
533
|
0
|
|
|
|
|
|
out "($var =~ /^(.*?)$pattern\$/)[0]"; |
534
|
|
|
|
|
|
|
} |
535
|
|
|
|
|
|
|
|
536
|
0
|
|
|
|
|
|
$ntok = 1; |
537
|
|
|
|
|
|
|
} |
538
|
|
|
|
|
|
|
else { |
539
|
0
|
|
|
|
|
|
$ntok = Handle_variable($token); |
540
|
|
|
|
|
|
|
} |
541
|
|
|
|
|
|
|
|
542
|
0
|
0
|
|
|
|
|
if ($suffix) { |
543
|
0
|
|
|
|
|
|
out '.'; |
544
|
0
|
|
|
|
|
|
my @tokens = App::sh2p::Parser::tokenise ($suffix); |
545
|
0
|
|
|
|
|
|
my @types = App::sh2p::Parser::identify (1, @tokens); |
546
|
|
|
|
|
|
|
|
547
|
0
|
|
|
|
|
|
App::sh2p::Handlers::no_semi_colon(); |
548
|
0
|
|
|
|
|
|
App::sh2p::Parser::convert (@tokens, @types); |
549
|
0
|
|
|
|
|
|
App::sh2p::Handlers::reset_semi_colon(); |
550
|
|
|
|
|
|
|
} |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
# Suffix was in the same token |
553
|
0
|
|
|
|
|
|
return $ntok; |
554
|
|
|
|
|
|
|
} |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
############################################################################ |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
sub Handle_delimiter { |
559
|
|
|
|
|
|
|
|
560
|
0
|
|
|
0
|
0
|
|
my $ntok = 1; |
561
|
0
|
|
|
|
|
|
my ($tok) = @_; |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
#print STDERR "Handle_delimiter: <$tok>\n"; |
564
|
|
|
|
|
|
|
|
565
|
0
|
0
|
0
|
|
|
|
if ($tok =~ /^\(\((.+)=(.+)\)\)$/) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
566
|
0
|
|
|
|
|
|
my $lhs = $1; |
567
|
0
|
|
|
|
|
|
my $rhs = $2; |
568
|
|
|
|
|
|
|
# Could be compound assignment (like +=) |
569
|
0
|
|
|
|
|
|
out "\$$lhs= $rhs;\n"; |
570
|
|
|
|
|
|
|
} |
571
|
|
|
|
|
|
|
elsif (substr($tok,0,1) eq '"') { |
572
|
|
|
|
|
|
|
# Special case for an empty string January 2009 |
573
|
0
|
0
|
|
|
|
|
if ($tok eq '""') { |
574
|
0
|
|
|
|
|
|
out $tok; |
575
|
|
|
|
|
|
|
} |
576
|
|
|
|
|
|
|
else { |
577
|
0
|
|
|
|
|
|
interpolation($tok); |
578
|
|
|
|
|
|
|
} |
579
|
|
|
|
|
|
|
} |
580
|
|
|
|
|
|
|
elsif (substr($tok,0,1) eq "'") { |
581
|
0
|
|
|
|
|
|
out $tok; |
582
|
|
|
|
|
|
|
} |
583
|
|
|
|
|
|
|
elsif ($tok =~ s/^\((.+)\)/$1/) { # subshell |
584
|
0
|
|
|
|
|
|
Handle_subshell ($tok); |
585
|
|
|
|
|
|
|
} |
586
|
|
|
|
|
|
|
elsif ($tok eq ')' && $g_unterminated_backtick) { |
587
|
0
|
|
|
|
|
|
out '`'; |
588
|
0
|
|
|
|
|
|
$g_unterminated_backtick = 0; |
589
|
0
|
|
|
|
|
|
dec_indent(); |
590
|
|
|
|
|
|
|
} |
591
|
|
|
|
|
|
|
elsif ($tok eq ';') { |
592
|
0
|
|
|
|
|
|
out "\n"; |
593
|
|
|
|
|
|
|
} |
594
|
|
|
|
|
|
|
elsif ( $tok =~ /\|[^\|]/) { # RE change 0.05 |
595
|
0
|
|
|
|
|
|
shift @_; |
596
|
0
|
|
|
|
|
|
out $tok; |
597
|
0
|
0
|
|
|
|
|
if ( @_ ) { |
598
|
0
|
|
|
|
|
|
$ntok += App::sh2p::Parser::analyse_pipeline (@_); |
599
|
|
|
|
|
|
|
} |
600
|
|
|
|
|
|
|
} |
601
|
|
|
|
|
|
|
elsif ($tok =~ /^#/ && App::sh2p::Utils::new_line()) { |
602
|
0
|
|
|
|
|
|
out $tok; |
603
|
|
|
|
|
|
|
} |
604
|
|
|
|
|
|
|
elsif ($tok =~ /^(.*)\`\s*(.*)\s*\`(.*)/ && substr($tok,0,1) ne '"') { |
605
|
0
|
|
|
|
|
|
my $preamble = $1; # Added January 2009 |
606
|
0
|
|
|
|
|
|
my $cmd = $2; |
607
|
0
|
|
|
|
|
|
my $rest = $3; |
608
|
0
|
|
|
|
|
|
my @cmd = split (/\s+/, $cmd); |
609
|
0
|
|
|
|
|
|
my @perlbi; |
610
|
|
|
|
|
|
|
|
611
|
0
|
0
|
|
|
|
|
if (@perlbi = App::sh2p::Parser::get_perl_builtin($cmd[0])) { |
612
|
|
|
|
|
|
|
# print STDERR "Handle_delimiter2: <@cmd> <$rest>\n"; |
613
|
|
|
|
|
|
|
# Do my best to trap unnecessary child processes |
614
|
0
|
0
|
|
|
|
|
out "\n" if query_semi_colon(); # For tidy messages |
615
|
|
|
|
|
|
|
#&{$perlbi[0]}(@cmd,$rest); |
616
|
0
|
|
|
|
|
|
&{$perlbi[0]}(@cmd); |
|
0
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
|
618
|
0
|
0
|
|
|
|
|
if ($rest) { |
619
|
0
|
0
|
0
|
|
|
|
unless ($preamble eq $rest && |
|
|
|
0
|
|
|
|
|
620
|
|
|
|
|
|
|
($rest eq '"' or $rest eq "'")) |
621
|
|
|
|
|
|
|
{ |
622
|
0
|
|
|
|
|
|
out '.'; |
623
|
0
|
|
|
|
|
|
interpolation ($rest); |
624
|
|
|
|
|
|
|
} |
625
|
|
|
|
|
|
|
} |
626
|
|
|
|
|
|
|
} |
627
|
|
|
|
|
|
|
else { |
628
|
0
|
|
|
|
|
|
out " $tok "; |
629
|
|
|
|
|
|
|
} |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
else { |
632
|
0
|
|
|
|
|
|
out " $tok"; |
633
|
0
|
0
|
|
|
|
|
out ' ' unless substr($tok,-1) eq "\n"; # 0.04 |
634
|
|
|
|
|
|
|
} |
635
|
|
|
|
|
|
|
|
636
|
0
|
|
|
|
|
|
return $ntok; |
637
|
|
|
|
|
|
|
} |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
############################################################################ |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
sub Handle_subshell { |
642
|
|
|
|
|
|
|
|
643
|
0
|
|
|
0
|
0
|
|
my ($subshell) = @_; |
644
|
|
|
|
|
|
|
|
645
|
0
|
|
|
|
|
|
error_out "Subshell: ($subshell)"; |
646
|
0
|
|
|
|
|
|
iout "{\n"; |
647
|
0
|
|
|
|
|
|
inc_indent(); |
648
|
0
|
|
|
|
|
|
inc_block_level(); # 0.05 |
649
|
0
|
|
|
|
|
|
mark_subshell(); |
650
|
0
|
|
|
|
|
|
iout "local \%ENV;\n"; # one of the features of a subshell |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
# Search for different statements |
653
|
|
|
|
|
|
|
|
654
|
0
|
|
|
|
|
|
for my $tok (split (';', $subshell)) { |
655
|
|
|
|
|
|
|
# should probably be done in sh2p |
656
|
0
|
|
|
|
|
|
my @tokens = App::sh2p::Parser::tokenise ($tok); |
657
|
0
|
|
|
|
|
|
my @types = App::sh2p::Parser::identify (0, @tokens); |
658
|
|
|
|
|
|
|
#print_types_tokens (\@types,\@tokens); |
659
|
0
|
|
|
|
|
|
App::sh2p::Parser::convert (@tokens, @types); |
660
|
|
|
|
|
|
|
} |
661
|
|
|
|
|
|
|
|
662
|
0
|
|
|
|
|
|
dec_indent(); |
663
|
0
|
|
|
|
|
|
dec_block_level(); # 0.05 |
664
|
0
|
|
|
|
|
|
unmark_subshell(); |
665
|
0
|
|
|
|
|
|
out "}\n"; |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
} |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
############################################################################ |
670
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
sub interpolation { |
672
|
0
|
|
|
0
|
0
|
|
my ($string) = @_; |
673
|
0
|
|
|
|
|
|
my $delimiter = ''; |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
#print STDERR "interpolation: <$string>\n"; |
676
|
|
|
|
|
|
|
#my @caller = caller(); |
677
|
|
|
|
|
|
|
#print STDERR "@caller\n"; |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
# single quoted string |
680
|
0
|
0
|
|
|
|
|
if ($string =~ /^(\'.*\')(.*)/) { |
681
|
0
|
|
|
|
|
|
my $single = $1; |
682
|
0
|
|
|
|
|
|
$string = $2; |
683
|
|
|
|
|
|
|
|
684
|
0
|
0
|
|
|
|
|
if ($string) { |
685
|
0
|
|
|
|
|
|
out "$single."; |
686
|
|
|
|
|
|
|
} |
687
|
|
|
|
|
|
|
else { |
688
|
0
|
|
|
|
|
|
out "$single"; |
689
|
0
|
|
|
|
|
|
return; |
690
|
|
|
|
|
|
|
} |
691
|
|
|
|
|
|
|
} |
692
|
|
|
|
|
|
|
|
693
|
0
|
0
|
|
|
|
|
if ( substr($string,0,1) eq '"') { |
694
|
|
|
|
|
|
|
# strip out leading & trailing double quotes |
695
|
0
|
|
|
|
|
|
$string =~ s/^\"(.*)\"$/$1/; |
696
|
0
|
|
|
|
|
|
set_in_quotes(); |
697
|
|
|
|
|
|
|
} |
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
# Insert leading quote to balance end |
700
|
|
|
|
|
|
|
# Why? Because the string might not be quoted |
701
|
0
|
|
|
|
|
|
out ('"'); |
702
|
|
|
|
|
|
|
|
703
|
0
|
|
|
|
|
|
my @chars = split '', $string; |
704
|
|
|
|
|
|
|
|
705
|
0
|
|
|
|
|
|
for (my $i = 0; $i < @chars; $i++) { |
706
|
|
|
|
|
|
|
|
707
|
0
|
0
|
0
|
|
|
|
if ($chars[$i] eq '\\') { # esc |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
708
|
0
|
|
|
|
|
|
out $chars[$i]; |
709
|
0
|
|
|
|
|
|
$i++; |
710
|
0
|
|
|
|
|
|
out $chars[$i]; |
711
|
|
|
|
|
|
|
} |
712
|
|
|
|
|
|
|
elsif ($chars[$i] eq '"' and !query_in_quotes()) { |
713
|
|
|
|
|
|
|
# embedded quote 0.04 |
714
|
0
|
|
|
|
|
|
out '\\"'; |
715
|
|
|
|
|
|
|
} |
716
|
|
|
|
|
|
|
elsif ($chars[$i] eq '`') { |
717
|
0
|
|
|
|
|
|
out '".'; |
718
|
0
|
|
|
|
|
|
$delimiter = '`'; |
719
|
|
|
|
|
|
|
|
720
|
0
|
|
|
|
|
|
my $cmd = $chars[$i]; |
721
|
0
|
|
|
|
|
|
$i++; |
722
|
|
|
|
|
|
|
|
723
|
0
|
|
|
|
|
|
while ($i < @chars) { |
724
|
0
|
|
|
|
|
|
$cmd .= $chars[$i]; |
725
|
0
|
0
|
|
|
|
|
last if ($chars[$i] eq $delimiter); |
726
|
0
|
|
|
|
|
|
$i++; # Position change January 2009 |
727
|
|
|
|
|
|
|
} |
728
|
|
|
|
|
|
|
|
729
|
0
|
|
|
|
|
|
Handle_delimiter ($cmd); |
730
|
0
|
0
|
|
|
|
|
out '."' if $i < (@chars-1); |
731
|
|
|
|
|
|
|
} |
732
|
|
|
|
|
|
|
elsif ($chars[$i] eq '$') { |
733
|
0
|
|
|
|
|
|
my $token = $chars[$i]; |
734
|
0
|
|
|
|
|
|
$i++; |
735
|
|
|
|
|
|
|
|
736
|
0
|
0
|
|
|
|
|
if ($chars[$i] eq '(') { |
|
|
0
|
|
|
|
|
|
737
|
0
|
|
|
|
|
|
out '".'; |
738
|
0
|
|
|
|
|
|
$delimiter = ')'; |
739
|
0
|
|
|
|
|
|
while ($i < @chars) { |
740
|
0
|
|
|
|
|
|
$token .= $chars[$i]; |
741
|
0
|
|
|
|
|
|
$i++; |
742
|
0
|
0
|
|
|
|
|
if ($chars[$i] eq $delimiter) { |
743
|
0
|
|
|
|
|
|
$token .= $chars[$i]; |
744
|
|
|
|
|
|
|
last |
745
|
0
|
|
|
|
|
|
} |
746
|
|
|
|
|
|
|
} |
747
|
0
|
|
|
|
|
|
Handle_2char_qx ($token); |
748
|
0
|
0
|
|
|
|
|
out '."' if $i < (@chars-1); |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
} |
751
|
|
|
|
|
|
|
elsif ($chars[$i] eq '{') { |
752
|
|
|
|
|
|
|
|
753
|
0
|
|
|
|
|
|
out '".'; |
754
|
0
|
|
|
|
|
|
$delimiter = '}'; |
755
|
0
|
|
|
|
|
|
while ($i < @chars) { |
756
|
0
|
|
|
|
|
|
$token .= $chars[$i]; |
757
|
0
|
|
|
|
|
|
$i++; |
758
|
0
|
0
|
|
|
|
|
if ($chars[$i] eq '}') { |
759
|
0
|
|
|
|
|
|
$token .= $chars[$i]; |
760
|
|
|
|
|
|
|
last |
761
|
0
|
|
|
|
|
|
} |
762
|
|
|
|
|
|
|
} |
763
|
0
|
|
|
|
|
|
Handle_expansion ($token); |
764
|
0
|
0
|
|
|
|
|
out '."' if $i < (@chars-1); |
765
|
|
|
|
|
|
|
} |
766
|
|
|
|
|
|
|
else { |
767
|
0
|
|
|
|
|
|
$delimiter = ''; |
768
|
|
|
|
|
|
|
|
769
|
0
|
|
|
|
|
|
while ($i < @chars) { |
770
|
0
|
|
|
|
|
|
$token .= $chars[$i]; |
771
|
0
|
0
|
|
|
|
|
last if ($chars[$i+1] !~ /[a-z0-9\#\[\]\@\*]/i); # 0.04 |
772
|
0
|
|
|
|
|
|
$i++; |
773
|
|
|
|
|
|
|
} |
774
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
# Remove trailing whitespace, then put it back |
776
|
0
|
|
|
|
|
|
my $whitespace = ''; |
777
|
|
|
|
|
|
|
|
778
|
0
|
0
|
|
|
|
|
if ($token =~ s/(\s+)$//) { |
779
|
0
|
|
|
|
|
|
$whitespace = $1; |
780
|
|
|
|
|
|
|
} |
781
|
|
|
|
|
|
|
|
782
|
0
|
0
|
|
|
|
|
out '".' if ! can_var_interpolate($token); |
783
|
|
|
|
|
|
|
|
784
|
0
|
|
|
|
|
|
Handle_variable ($token); |
785
|
|
|
|
|
|
|
|
786
|
0
|
0
|
|
|
|
|
out '."' if ! can_var_interpolate($token); |
787
|
|
|
|
|
|
|
|
788
|
0
|
0
|
|
|
|
|
out $whitespace if ($whitespace); |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
} |
791
|
|
|
|
|
|
|
} |
792
|
|
|
|
|
|
|
else { |
793
|
0
|
|
|
|
|
|
$delimiter = ''; |
794
|
0
|
|
|
|
|
|
out $chars[$i]; |
795
|
|
|
|
|
|
|
} |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
} |
798
|
|
|
|
|
|
|
|
799
|
0
|
0
|
|
|
|
|
if ($chars[-1] ne $delimiter) { |
800
|
0
|
|
|
|
|
|
out '"'; |
801
|
|
|
|
|
|
|
} |
802
|
|
|
|
|
|
|
|
803
|
0
|
|
|
|
|
|
unset_in_quotes(); |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
# Not my favorite hack (in Utils) |
806
|
0
|
|
|
|
|
|
rem_empty_string(); |
807
|
|
|
|
|
|
|
} |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
############################################################################ |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
sub Handle_2char_qx { |
812
|
|
|
|
|
|
|
|
813
|
0
|
|
|
0
|
0
|
|
my $ntok; |
814
|
0
|
|
|
|
|
|
my ($tok) = @_; |
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
#print STDERR "Handle_2char_qx token: <$tok>\n"; |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
# Simple case first |
819
|
0
|
0
|
|
|
|
|
if ($tok =~ /^\$\((.*)\)(.*)$/) { |
|
|
0
|
|
|
|
|
|
820
|
0
|
|
|
|
|
|
my $cmd = $1; |
821
|
0
|
|
|
|
|
|
my $rest = $2; |
822
|
0
|
|
|
|
|
|
my @cmd = split (/\s+/, $cmd); |
823
|
0
|
|
|
|
|
|
my @perlbi; |
824
|
0
|
|
|
|
|
|
my $shell = 0; |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
# Any shell meta-characters? |
827
|
0
|
0
|
|
|
|
|
$shell = 1 if ($tok =~ /[|><&]/); |
828
|
|
|
|
|
|
|
|
829
|
0
|
0
|
0
|
|
|
|
if (!$shell and @perlbi = App::sh2p::Parser::get_perl_builtin($cmd[0])) { |
|
|
0
|
|
|
|
|
|
830
|
|
|
|
|
|
|
# Do my best to trap unnecessary child processes |
831
|
0
|
0
|
|
|
|
|
out "\n" if query_semi_colon(); # For tidy messages |
832
|
0
|
|
|
|
|
|
&{$perlbi[0]}(@cmd,$rest); |
|
0
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
} |
834
|
|
|
|
|
|
|
elsif (is_user_function($cmd[0])) { |
835
|
0
|
|
|
|
|
|
error_out "User function '$cmd[0]' called in back-ticks"; |
836
|
0
|
|
|
|
|
|
iout "`$cmd`$rest"; |
837
|
|
|
|
|
|
|
} |
838
|
|
|
|
|
|
|
else { |
839
|
0
|
|
|
|
|
|
my $pipe = 0; |
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
# Is this really a pipe, or is | embeded in a string? January 2009 |
842
|
0
|
0
|
|
|
|
|
if ( $cmd =~ /\|[^\|]/) { # RE change 0.05 |
843
|
0
|
|
|
|
|
|
my $quote = 0; |
844
|
0
|
|
|
|
|
|
for my $char (split '',$cmd) { |
845
|
|
|
|
|
|
|
|
846
|
0
|
0
|
0
|
|
|
|
if ($char eq "'" || $char eq '"') { |
847
|
0
|
0
|
|
|
|
|
$quote = $quote?0:1; |
848
|
|
|
|
|
|
|
} |
849
|
|
|
|
|
|
|
|
850
|
0
|
0
|
|
|
|
|
next if $quote; |
851
|
0
|
0
|
|
|
|
|
if ($char eq '|') { |
852
|
0
|
|
|
|
|
|
$pipe = 1; |
853
|
0
|
|
|
|
|
|
last; |
854
|
|
|
|
|
|
|
} |
855
|
|
|
|
|
|
|
} |
856
|
|
|
|
|
|
|
} |
857
|
|
|
|
|
|
|
|
858
|
0
|
0
|
|
|
|
|
if ($pipe) { |
859
|
0
|
0
|
|
|
|
|
if ( substr($tok, 0, 2) eq '$(' ) { |
860
|
0
|
|
|
|
|
|
$tok =~ s/^\$\((.*)\)$/$1/; |
861
|
|
|
|
|
|
|
} |
862
|
|
|
|
|
|
|
else { |
863
|
0
|
|
|
|
|
|
$tok =~ s/^`(.*)`$/$1/; |
864
|
|
|
|
|
|
|
} |
865
|
|
|
|
|
|
|
|
866
|
0
|
|
|
|
|
|
App::sh2p::Parser::analyse_pipeline ($tok); |
867
|
0
|
|
|
|
|
|
out " $rest"; |
868
|
|
|
|
|
|
|
} |
869
|
|
|
|
|
|
|
else { |
870
|
0
|
|
|
|
|
|
iout "`$cmd`$rest"; |
871
|
|
|
|
|
|
|
} |
872
|
|
|
|
|
|
|
} |
873
|
|
|
|
|
|
|
|
874
|
0
|
|
|
|
|
|
$ntok = 1; |
875
|
|
|
|
|
|
|
} |
876
|
|
|
|
|
|
|
elsif ( substr($tok, 0, 2) eq '$(' ) { |
877
|
0
|
|
|
|
|
|
$tok =~ s/\$\(/`/; |
878
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
# This is the ONLY place this is set, and might now be obsolete |
880
|
0
|
|
|
|
|
|
$g_unterminated_backtick = 1; |
881
|
|
|
|
|
|
|
|
882
|
0
|
|
|
|
|
|
my @tokens = App::sh2p::Parser::tokenise ($tok); |
883
|
0
|
|
|
|
|
|
my @types = App::sh2p::Parser::identify (1, @tokens); |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
#print_types_tokens (\@types,\@tokens); |
886
|
0
|
|
|
|
|
|
App::sh2p::Parser::convert (@tokens, @types); |
887
|
|
|
|
|
|
|
|
888
|
0
|
|
|
|
|
|
inc_indent(); |
889
|
0
|
|
|
|
|
|
$ntok = @_; |
890
|
|
|
|
|
|
|
} |
891
|
|
|
|
|
|
|
else { |
892
|
0
|
|
|
|
|
|
iout "@_"; |
893
|
0
|
|
|
|
|
|
$ntok = @_; |
894
|
|
|
|
|
|
|
} |
895
|
|
|
|
|
|
|
|
896
|
0
|
|
|
|
|
|
return $ntok; |
897
|
|
|
|
|
|
|
} |
898
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
############################################################################ |
900
|
|
|
|
|
|
|
# Simplistic call to external program, should this be converted? |
901
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
sub Handle_external { |
903
|
|
|
|
|
|
|
|
904
|
0
|
|
|
0
|
0
|
|
my $ntok = 0; |
905
|
0
|
|
|
|
|
|
my (@args) = @_; |
906
|
0
|
|
|
|
|
|
my $func = 'system'; |
907
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
#{local $" = '*'; print STDERR "Handle_external <@args>\n";} |
909
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
# Is final token a comment? |
911
|
0
|
|
|
|
|
|
my $last = ''; |
912
|
|
|
|
|
|
|
|
913
|
0
|
0
|
|
|
|
|
if (substr($args[-1],0,1) eq '#') { |
914
|
0
|
|
|
|
|
|
pop @args; |
915
|
|
|
|
|
|
|
} |
916
|
|
|
|
|
|
|
|
917
|
0
|
0
|
|
|
|
|
if ($g_unterminated_backtick) { |
918
|
0
|
0
|
|
|
|
|
if ($args[-1] eq ')') { |
919
|
0
|
|
|
|
|
|
$args[-1] = '`'; |
920
|
0
|
|
|
|
|
|
$g_unterminated_backtick = 0; |
921
|
0
|
|
|
|
|
|
iout "@args $last"; |
922
|
0
|
|
|
|
|
|
dec_indent(); |
923
|
|
|
|
|
|
|
} |
924
|
|
|
|
|
|
|
else { |
925
|
0
|
|
|
|
|
|
iout "@args $last"; |
926
|
|
|
|
|
|
|
} |
927
|
|
|
|
|
|
|
|
928
|
0
|
|
|
|
|
|
$ntok += @args; # January 2009 |
929
|
|
|
|
|
|
|
} |
930
|
|
|
|
|
|
|
else { |
931
|
0
|
|
|
|
|
|
my @perlbi; |
932
|
0
|
|
|
|
|
|
my $user_function = 0; |
933
|
|
|
|
|
|
|
|
934
|
|
|
|
|
|
|
# pipes? |
935
|
|
|
|
|
|
|
# This loop replaces the grep below (it was detecting | inside quotes) |
936
|
0
|
|
|
|
|
|
for my $tok (@args) { |
937
|
0
|
0
|
|
|
|
|
next if $tok =~ /^([\'\"]).*\1$/; |
938
|
0
|
0
|
|
|
|
|
if ($tok =~ /\|[^\|]/) { # RE change 0.05 |
939
|
0
|
|
|
|
|
|
$ntok = App::sh2p::Parser::analyse_pipeline (@args); |
940
|
0
|
|
|
|
|
|
return $ntok; |
941
|
|
|
|
|
|
|
} |
942
|
|
|
|
|
|
|
} |
943
|
|
|
|
|
|
|
|
944
|
|
|
|
|
|
|
#if ( grep /\|[^\|]/, @args) { # RE change 0.05 |
945
|
|
|
|
|
|
|
# $ntok = App::sh2p::Parser::analyse_pipeline (@args); |
946
|
|
|
|
|
|
|
# return $ntok; |
947
|
|
|
|
|
|
|
#} |
948
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
# shortcuts or break? 0.05 |
950
|
0
|
|
|
|
|
|
my @types = App::sh2p::Parser::identify (1, @args); |
951
|
0
|
|
|
|
|
|
my $i; |
952
|
0
|
|
|
|
|
|
for ($i = 0;$i < @types; $i++) { |
953
|
0
|
0
|
|
|
|
|
if ($types[$i][0] eq 'OPERATOR') { |
|
|
0
|
|
|
|
|
|
954
|
0
|
|
|
|
|
|
no_semi_colon(); |
955
|
0
|
|
|
|
|
|
splice (@args, $i); |
956
|
|
|
|
|
|
|
last |
957
|
0
|
|
|
|
|
|
} |
958
|
|
|
|
|
|
|
elsif ($types[$i][0] eq 'BREAK') { |
959
|
0
|
|
|
|
|
|
splice (@args, $i); |
960
|
|
|
|
|
|
|
last |
961
|
0
|
|
|
|
|
|
} |
962
|
|
|
|
|
|
|
} |
963
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
# Strip quotes January 2009 |
965
|
0
|
|
|
|
|
|
my $name = $args[0]; |
966
|
0
|
|
|
|
|
|
$name =~ s/^([\"\'])(.*)\1$/$2/; |
967
|
|
|
|
|
|
|
#print STDERR "Handle_external: <$name>\n"; |
968
|
|
|
|
|
|
|
|
969
|
|
|
|
|
|
|
# If a user function, then call it as a subroutine |
970
|
0
|
0
|
|
|
|
|
if (is_user_function($name)) { |
|
|
0
|
|
|
|
|
|
971
|
0
|
|
|
|
|
|
$func = $name; |
972
|
0
|
|
|
|
|
|
shift @args; |
973
|
0
|
|
|
|
|
|
$user_function = 1; |
974
|
0
|
|
|
|
|
|
$ntok++; |
975
|
|
|
|
|
|
|
} |
976
|
|
|
|
|
|
|
elsif (@perlbi = App::sh2p::Parser::get_perl_builtin($name)) { |
977
|
|
|
|
|
|
|
# Do my best to trap unnecessary child processes |
978
|
0
|
|
|
|
|
|
$ntok = &{$perlbi[0]}(@_); |
|
0
|
|
|
|
|
|
|
979
|
0
|
|
|
|
|
|
return $ntok; |
980
|
|
|
|
|
|
|
} |
981
|
|
|
|
|
|
|
|
982
|
0
|
0
|
|
|
|
|
if (is_break($args[0])) { |
983
|
0
|
|
|
|
|
|
my @caller = caller(); |
984
|
0
|
|
|
|
|
|
print STDERR "@caller\n"; |
985
|
0
|
|
|
|
|
|
error_out ("++++ Internal error: Invalid break in Handle_external"); |
986
|
|
|
|
|
|
|
} |
987
|
|
|
|
|
|
|
|
988
|
0
|
|
|
|
|
|
my $append = ''; |
989
|
0
|
0
|
|
|
|
|
$append = ';' if query_semi_colon(); |
990
|
|
|
|
|
|
|
|
991
|
0
|
|
|
|
|
|
iout "$func ("; |
992
|
|
|
|
|
|
|
|
993
|
|
|
|
|
|
|
# Parse arguments |
994
|
0
|
0
|
|
|
|
|
if ( $user_function ) { |
995
|
|
|
|
|
|
|
|
996
|
0
|
0
|
|
|
|
|
if (@args) { |
997
|
|
|
|
|
|
|
|
998
|
0
|
|
|
|
|
|
for (my $i = 0; $i < @args; $i++) { |
999
|
0
|
|
|
|
|
|
$ntok++; |
1000
|
|
|
|
|
|
|
# Escape embedded quotes |
1001
|
0
|
|
|
|
|
|
$args[$i] =~ s/\"/\\\"/g; |
1002
|
|
|
|
|
|
|
#"help syntax highlighter |
1003
|
0
|
|
|
|
|
|
$args[$i] = "\"$args[$i]\""; |
1004
|
0
|
0
|
|
|
|
|
$args[$i] .= ',' if $i < $#args; |
1005
|
|
|
|
|
|
|
} |
1006
|
|
|
|
|
|
|
|
1007
|
0
|
|
|
|
|
|
interpolation ("@args"); |
1008
|
|
|
|
|
|
|
} |
1009
|
|
|
|
|
|
|
} |
1010
|
|
|
|
|
|
|
else { |
1011
|
0
|
|
|
|
|
|
for my $arg (@args) { |
1012
|
0
|
|
|
|
|
|
$ntok++; |
1013
|
|
|
|
|
|
|
# Escape embedded quotes |
1014
|
0
|
|
|
|
|
|
$arg =~ s/\"/\\\"/g; |
1015
|
|
|
|
|
|
|
#"help syntax highlighter |
1016
|
|
|
|
|
|
|
} |
1017
|
|
|
|
|
|
|
|
1018
|
0
|
|
|
|
|
|
interpolation ("@args"); |
1019
|
|
|
|
|
|
|
} |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
# Added 0.03 |
1022
|
0
|
0
|
|
|
|
|
if ($func eq 'system') { |
1023
|
0
|
|
|
|
|
|
my $context = App::sh2p::Compound::get_context(); |
1024
|
0
|
0
|
0
|
|
|
|
if ($context eq 'if' || $context eq 'while') { |
|
|
0
|
|
|
|
|
|
1025
|
0
|
|
|
|
|
|
$append .= '== 0'; |
1026
|
|
|
|
|
|
|
} |
1027
|
|
|
|
|
|
|
elsif ($context eq 'until') { |
1028
|
0
|
|
|
|
|
|
$append .= '!= 0'; |
1029
|
|
|
|
|
|
|
} |
1030
|
|
|
|
|
|
|
} |
1031
|
|
|
|
|
|
|
|
1032
|
0
|
|
|
|
|
|
out ")$append $last"; # Moved 0.04 |
1033
|
|
|
|
|
|
|
|
1034
|
0
|
0
|
|
|
|
|
out "\n" if query_semi_colon(); |
1035
|
|
|
|
|
|
|
} |
1036
|
|
|
|
|
|
|
|
1037
|
0
|
|
|
|
|
|
return $ntok; |
1038
|
|
|
|
|
|
|
} |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
############################################################## |
1041
|
|
|
|
|
|
|
|
1042
|
|
|
|
|
|
|
sub Handle_Glob { |
1043
|
|
|
|
|
|
|
|
1044
|
0
|
|
|
0
|
0
|
|
my (@tokens) = @_; |
1045
|
0
|
|
|
|
|
|
my $ntok = @tokens; |
1046
|
|
|
|
|
|
|
|
1047
|
0
|
|
|
|
|
|
local $" = ''; |
1048
|
0
|
|
|
|
|
|
iout "(glob(\"@tokens\"))"; |
1049
|
|
|
|
|
|
|
|
1050
|
0
|
|
|
|
|
|
return $ntok; |
1051
|
|
|
|
|
|
|
} |
1052
|
|
|
|
|
|
|
|
1053
|
|
|
|
|
|
|
############################################################################ |
1054
|
|
|
|
|
|
|
|
1055
|
|
|
|
|
|
|
sub Handle_unknown { |
1056
|
|
|
|
|
|
|
|
1057
|
0
|
|
|
0
|
0
|
|
my ($token) = @_; |
1058
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
# Don't quote if numeric or already has quotes |
1060
|
0
|
0
|
0
|
|
|
|
if ($token =~ /^[-+]?\d+$/ || $token =~ /^\".*\"$/) { |
1061
|
0
|
|
|
|
|
|
out "$token"; |
1062
|
|
|
|
|
|
|
} |
1063
|
|
|
|
|
|
|
else { |
1064
|
|
|
|
|
|
|
#my @caller = caller(); |
1065
|
|
|
|
|
|
|
#print STDERR "Handle_unknown token: <$token> @caller\n"; |
1066
|
0
|
|
|
|
|
|
out "\"$token\""; |
1067
|
|
|
|
|
|
|
} |
1068
|
|
|
|
|
|
|
|
1069
|
0
|
|
|
|
|
|
return 1; |
1070
|
|
|
|
|
|
|
} |
1071
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
############################################################################ |
1073
|
|
|
|
|
|
|
sub store_subs { |
1074
|
|
|
|
|
|
|
|
1075
|
0
|
|
|
0
|
0
|
|
my ($name, $subroutine) = @_; |
1076
|
|
|
|
|
|
|
|
1077
|
0
|
|
|
|
|
|
$g_subs{$name} = $subroutine; |
1078
|
|
|
|
|
|
|
|
1079
|
|
|
|
|
|
|
} |
1080
|
|
|
|
|
|
|
|
1081
|
|
|
|
|
|
|
sub write_subs { |
1082
|
|
|
|
|
|
|
|
1083
|
0
|
0
|
|
0
|
0
|
|
if (%g_subs) { |
1084
|
0
|
|
|
|
|
|
out "\n#\n# Subroutines added by sh2p\n#\n"; |
1085
|
|
|
|
|
|
|
} |
1086
|
|
|
|
|
|
|
|
1087
|
0
|
|
|
|
|
|
for my $sub (sort keys %g_subs) { |
1088
|
0
|
|
|
|
|
|
out $g_subs{$sub}; |
1089
|
|
|
|
|
|
|
} |
1090
|
|
|
|
|
|
|
} |
1091
|
|
|
|
|
|
|
|
1092
|
|
|
|
|
|
|
############################################################################ |
1093
|
|
|
|
|
|
|
|
1094
|
|
|
|
|
|
|
sub store_sh2p_array_count { |
1095
|
0
|
0
|
|
0
|
0
|
|
return if exists $g_subs{sh2p_array_count}; |
1096
|
|
|
|
|
|
|
|
1097
|
0
|
|
|
|
|
|
$g_subs{sh2p_array_count} = << 'AC_HERE'; |
1098
|
|
|
|
|
|
|
|
1099
|
|
|
|
|
|
|
############################################################################ |
1100
|
|
|
|
|
|
|
# Generated when ${!array[@]} is used |
1101
|
|
|
|
|
|
|
sub sh2p_array_count { |
1102
|
|
|
|
|
|
|
my @array = @_; |
1103
|
|
|
|
|
|
|
my $result = ''; |
1104
|
|
|
|
|
|
|
|
1105
|
|
|
|
|
|
|
for (my $i=0; $i < @array; $i++) { |
1106
|
|
|
|
|
|
|
$result .= "$i " if defined $array[$i]; |
1107
|
|
|
|
|
|
|
} |
1108
|
|
|
|
|
|
|
|
1109
|
|
|
|
|
|
|
# Should return a space separated scalar |
1110
|
|
|
|
|
|
|
chop $result; # remove final space |
1111
|
|
|
|
|
|
|
return $result; |
1112
|
|
|
|
|
|
|
} |
1113
|
|
|
|
|
|
|
|
1114
|
|
|
|
|
|
|
AC_HERE |
1115
|
|
|
|
|
|
|
} |
1116
|
|
|
|
|
|
|
|
1117
|
|
|
|
|
|
|
############################################################################ |
1118
|
|
|
|
|
|
|
|
1119
|
|
|
|
|
|
|
1; |
1120
|
|
|
|
|
|
|
|
1121
|
|
|
|
|
|
|
__END__ |