line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package App::sh2p::Compound; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
24
|
|
4
|
1
|
|
|
1
|
|
3
|
use App::sh2p::Parser; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
20
|
|
5
|
1
|
|
|
1
|
|
4
|
use App::sh2p::Utils; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
226
|
|
6
|
1
|
|
|
1
|
|
641
|
use App::sh2p::Handlers; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
42
|
|
7
|
1
|
|
|
1
|
|
664
|
use App::sh2p::Trap; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
4531
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
sub App::sh2p::Parser::convert(\@\@); |
10
|
|
|
|
|
|
|
our $VERSION = '0.06'; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
my $g_not = 0; |
13
|
|
|
|
|
|
|
my $g_context = ''; |
14
|
|
|
|
|
|
|
my @g_case_statements; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
##################################################### |
17
|
|
|
|
|
|
|
# shell perl |
18
|
|
|
|
|
|
|
my %convert = ( '==' => 'eq', |
19
|
|
|
|
|
|
|
'=' => 'eq', |
20
|
|
|
|
|
|
|
'!=' => 'ne', |
21
|
|
|
|
|
|
|
'<' => 'lt', |
22
|
|
|
|
|
|
|
'>' => 'gt', |
23
|
|
|
|
|
|
|
'<=' => 'le', |
24
|
|
|
|
|
|
|
'>=' => 'ge', |
25
|
|
|
|
|
|
|
'-eq' => '==', |
26
|
|
|
|
|
|
|
'-ne' => '!=', |
27
|
|
|
|
|
|
|
'-lt' => '<', |
28
|
|
|
|
|
|
|
'-gt' => '>', |
29
|
|
|
|
|
|
|
'-ge' => '>=', |
30
|
|
|
|
|
|
|
'-le' => '<=', |
31
|
|
|
|
|
|
|
'-nt'=> undef, |
32
|
|
|
|
|
|
|
'-ot'=> undef, |
33
|
|
|
|
|
|
|
'-ef'=> undef, |
34
|
|
|
|
|
|
|
'-n' => '', # No value required |
35
|
|
|
|
|
|
|
'-z' => '!', |
36
|
|
|
|
|
|
|
'-a' => '-e', # see %sh_convert |
37
|
|
|
|
|
|
|
'-h' => '-l', |
38
|
|
|
|
|
|
|
'-o' => undef, # shell option, but see %sh_convert |
39
|
|
|
|
|
|
|
'-O' => '-o', # confused? |
40
|
|
|
|
|
|
|
'-G' => undef, # owned by egid |
41
|
|
|
|
|
|
|
'-L' => '-l', |
42
|
|
|
|
|
|
|
'-N' => undef); # modified since last read); |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
# Many options are the same as the Perl functions, but not all |
45
|
|
|
|
|
|
|
# Bourne shell syntax overlaps |
46
|
|
|
|
|
|
|
my %sh_convert = ('-o' => 'or', |
47
|
|
|
|
|
|
|
'-a' => 'and'); |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
##################################################### |
50
|
|
|
|
|
|
|
# (( |
51
|
|
|
|
|
|
|
sub arith { |
52
|
|
|
|
|
|
|
|
53
|
0
|
|
|
0
|
0
|
|
my ($statement, @rest) = @_; |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
# First 2 chars passed should be (( or $((, unless from let |
56
|
0
|
|
|
|
|
|
$statement =~ s/^\$?\(\(//; |
57
|
|
|
|
|
|
|
# Last 2 chars passed should be )), unless from let |
58
|
0
|
|
|
|
|
|
$statement =~ s/\)\)$//; |
59
|
|
|
|
|
|
|
|
60
|
0
|
|
|
|
|
|
my $out = '( '; |
61
|
0
|
|
|
|
|
|
my @tokens = App::sh2p::Parser::tokenise ($statement); |
62
|
|
|
|
|
|
|
|
63
|
0
|
|
|
|
|
|
my $pattern = '<<|>>|==|>=|<=|\/=|%=|\+=|-=|\*=|=|>|<|!=|\+\+|\+|--|-|\*|\/|%'; |
64
|
|
|
|
|
|
|
|
65
|
0
|
|
|
|
|
|
for my $token (@tokens) { |
66
|
|
|
|
|
|
|
# Further tokenise |
67
|
|
|
|
|
|
|
|
68
|
0
|
|
|
|
|
|
$token =~ s/($pattern)/$1 /; |
69
|
|
|
|
|
|
|
|
70
|
0
|
|
|
|
|
|
for my $subtok (split (/ /, $token)) { |
71
|
|
|
|
|
|
|
|
72
|
0
|
0
|
|
|
|
|
if ($subtok =~ /^[_A-Za-z]/) { |
|
|
0
|
|
|
|
|
|
73
|
|
|
|
|
|
|
# Must be a variable! |
74
|
0
|
|
|
|
|
|
$subtok = "\$$subtok"; |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
elsif ($subtok =~ /\$[A-Z0-9\?#\{\}\[\]]+/i) { |
77
|
0
|
|
|
|
|
|
my $special = get_special_var($subtok,0); |
78
|
0
|
0
|
|
|
|
|
$subtok = $special if (defined $special); |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
0
|
|
|
|
|
|
$out .= "$subtok " |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
0
|
0
|
|
|
|
|
if (query_semi_colon()) { |
87
|
0
|
|
|
|
|
|
out "$out);\n"; |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
else { |
90
|
0
|
|
|
|
|
|
out "$out)"; |
91
|
|
|
|
|
|
|
} |
92
|
0
|
|
|
|
|
|
return 1; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
##################################################### |
96
|
|
|
|
|
|
|
# identify_ksh_boolean ($tokens[$i], $types[$i]) |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub identify_ksh_boolean (\$\$){ |
99
|
|
|
|
|
|
|
|
100
|
0
|
|
|
0
|
0
|
|
my ($rtok, $rtype) = @_; |
101
|
0
|
|
|
|
|
|
my $retn = 1; |
102
|
|
|
|
|
|
|
|
103
|
0
|
0
|
|
|
|
|
if (exists $convert{$$rtok}) { # ksh options |
|
|
0
|
|
|
|
|
|
104
|
0
|
|
|
|
|
|
$$rtok = $convert{$$rtok}; |
105
|
0
|
|
|
|
|
|
$$rtype = [('OPERATOR', \&App::sh2p::Operators::boolean)]; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
elsif (substr($$rtok,0,1) eq '-') { |
108
|
0
|
|
|
|
|
|
$$rtype = [('OPERATOR', \&App::sh2p::Operators::boolean)]; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
else { |
111
|
0
|
|
|
|
|
|
$retn = 0; |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
0
|
|
|
|
|
|
return $retn; |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
} # identify_ksh_boolean |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
##################################################### |
119
|
|
|
|
|
|
|
# [[ |
120
|
|
|
|
|
|
|
sub ksh_test { |
121
|
|
|
|
|
|
|
|
122
|
0
|
|
|
0
|
0
|
|
my ($statement) = @_; |
123
|
|
|
|
|
|
|
#print STDERR "ksh_test: <$statement>\n"; |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
# First 2 chars passed should be [[ |
126
|
0
|
|
|
|
|
|
$statement =~ s/^\[\[//; |
127
|
|
|
|
|
|
|
# Last 2 chars passed should be ]] |
128
|
0
|
|
|
|
|
|
$statement =~ s/\]\](.*)$//; |
129
|
|
|
|
|
|
|
|
130
|
0
|
|
|
|
|
|
my $rest = $1; |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
# extglob |
133
|
0
|
|
|
|
|
|
my $specials = '\@|\+|\?|\*|\!'; |
134
|
|
|
|
|
|
|
|
135
|
0
|
|
|
|
|
|
my @tokens = App::sh2p::Parser::tokenise ($statement); |
136
|
0
|
|
|
|
|
|
my @types = App::sh2p::Parser::identify (1, @tokens); |
137
|
|
|
|
|
|
|
|
138
|
0
|
|
|
|
|
|
for (my $i = 0; $i < @tokens; $i++) { |
139
|
|
|
|
|
|
|
|
140
|
0
|
|
|
|
|
|
my $token = $tokens[$i]; |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
#print STDERR "ksh_test token: <$token>\n"; |
143
|
0
|
0
|
|
|
|
|
if (identify_ksh_boolean ($tokens[$i], $types[$i])) { |
144
|
|
|
|
|
|
|
|
145
|
0
|
0
|
0
|
|
|
|
if ( $i < $#tokens && $tokens[$i+1] !~ /^($specials)\(/ ) { |
146
|
|
|
|
|
|
|
|
147
|
0
|
|
|
|
|
|
$i++; |
148
|
0
|
|
0
|
|
|
|
while(!identify_ksh_boolean ($tokens[$i], $types[$i]) && |
149
|
|
|
|
|
|
|
$i < $#tokens) { |
150
|
|
|
|
|
|
|
|
151
|
0
|
|
|
|
|
|
$i++; |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
else { |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
# look for shell pattern matching constructs (extglob) |
159
|
0
|
0
|
|
|
|
|
if ($token =~ /^($specials)\(/) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
160
|
0
|
|
|
|
|
|
my $char = $1; |
161
|
|
|
|
|
|
|
|
162
|
0
|
0
|
0
|
|
|
|
if ($char eq '+' || $char eq '?' || $char eq '*') { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
163
|
0
|
|
|
|
|
|
$types[$i] = [('OPERATOR', \&App::sh2p::Operators::swap1stchar)]; |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
elsif ($char eq '@') { |
166
|
0
|
|
|
|
|
|
$types[$i] = [('OPERATOR', \&App::sh2p::Operators::chop1stchar)]; |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
elsif ($char eq '!') { |
169
|
0
|
0
|
|
|
|
|
if ($tokens[$i-1] eq 'eq') { |
170
|
0
|
|
|
|
|
|
$tokens[$i-1] = '!~'; |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
else { |
174
|
0
|
|
|
|
|
|
error_out ("Unable to convert shell pattern matching <$token>"); |
175
|
0
|
|
|
|
|
|
$types[$i] = [('OPERATOR', \&App::sh2p::Operators::no_change)]; |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
# Fix previous operator |
179
|
0
|
0
|
|
|
|
|
if ( $i > 0 ) { |
180
|
0
|
0
|
|
|
|
|
if ($tokens[$i-1] eq 'eq') { |
|
|
0
|
|
|
|
|
|
181
|
0
|
|
|
|
|
|
$tokens[$i-1] = '=~'; |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
elsif ($tokens[$i-1] eq 'ne') { |
184
|
0
|
|
|
|
|
|
$tokens[$i-1] = '!~'; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
elsif ($token eq '!') { |
189
|
0
|
|
|
|
|
|
$g_not = 1; |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
elsif ($types[$i][0] eq 'VARIABLE') { # January 2009 |
192
|
0
|
0
|
|
|
|
|
if (Register_variable($token, '$')) { |
193
|
0
|
|
|
|
|
|
pre_out "my $token;\n"; |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
|
201
|
0
|
0
|
|
|
|
|
if ($g_not) { |
202
|
0
|
|
|
|
|
|
out '( ! '; |
203
|
0
|
|
|
|
|
|
$g_not = 0; |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
else { |
206
|
0
|
|
|
|
|
|
out '( '; |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
# Operators & stuff |
210
|
|
|
|
|
|
|
#print_types_tokens (\@types, \@tokens); |
211
|
0
|
|
|
|
|
|
App::sh2p::Parser::convert (@tokens, @types); |
212
|
|
|
|
|
|
|
|
213
|
0
|
|
|
|
|
|
out ' ) '; |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
# We haven't finished yet! |
216
|
0
|
0
|
|
|
|
|
if ($rest) { |
217
|
0
|
|
|
|
|
|
my @tokens = App::sh2p::Parser::tokenise ($rest); |
218
|
0
|
|
|
|
|
|
my @types = App::sh2p::Parser::identify (2, @tokens); |
219
|
0
|
|
|
|
|
|
App::sh2p::Parser::convert (@tokens, @types); |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
|
222
|
0
|
|
|
|
|
|
return 1; |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
##################################################### |
226
|
|
|
|
|
|
|
# identify_sh_boolean ($tokens[$i], $types[$i]) |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
sub identify_sh_boolean (\$\$){ |
229
|
|
|
|
|
|
|
|
230
|
0
|
|
|
0
|
0
|
|
my ($rtok, $rtype) = @_; |
231
|
0
|
|
|
|
|
|
my $retn = 1; |
232
|
|
|
|
|
|
|
|
233
|
0
|
0
|
|
|
|
|
if (exists $sh_convert{$$rtok}) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
234
|
0
|
|
|
|
|
|
$$rtok = $sh_convert{$$rtok}; |
235
|
0
|
|
|
|
|
|
$$rtype = [('OPERATOR', \&App::sh2p::Operators::boolean)]; |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
elsif (exists $convert{$$rtok}) { # ksh options |
238
|
0
|
|
|
|
|
|
$$rtok = $convert{$$rtok}; |
239
|
0
|
|
|
|
|
|
$$rtype = [('OPERATOR', \&App::sh2p::Operators::boolean)]; |
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
elsif (substr($$rtok,0,1) eq '-') { |
242
|
0
|
|
|
|
|
|
$$rtype = [('OPERATOR', \&App::sh2p::Operators::boolean)]; |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
else { |
245
|
0
|
|
|
|
|
|
$retn = 0; |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
|
248
|
0
|
|
|
|
|
|
return $retn; |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
} # identify_sh_boolean |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
##################################################### |
253
|
|
|
|
|
|
|
# Not strictly a compound statement, but near enough |
254
|
|
|
|
|
|
|
# This is called for test and [ |
255
|
|
|
|
|
|
|
sub sh_test { |
256
|
|
|
|
|
|
|
|
257
|
0
|
|
|
0
|
0
|
|
my $ntok = 1; |
258
|
0
|
|
|
|
|
|
my ($statement, @rest) = @_; |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
# First char/s passed should be [ or test |
261
|
0
|
|
|
|
|
|
$statement =~ s/^\[|^test//; |
262
|
|
|
|
|
|
|
|
263
|
0
|
0
|
|
|
|
|
if (@rest) { |
264
|
|
|
|
|
|
|
|
265
|
0
|
|
|
|
|
|
my $i; |
266
|
0
|
|
|
|
|
|
for ($i = 0; $i < @rest; $i++) { |
267
|
|
|
|
|
|
|
|
268
|
0
|
0
|
0
|
|
|
|
last if is_break($rest[$i]) || $rest[$i] eq ';'; |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
|
271
|
0
|
0
|
|
|
|
|
if ( $i ) { |
272
|
0
|
|
|
|
|
|
$statement = join (' ', splice(@rest,0,$i)); |
273
|
0
|
|
|
|
|
|
$ntok += $i; |
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
# Last char passed may be ] (might not, because of 'test') |
278
|
0
|
|
|
|
|
|
$statement =~ s/\](.*)$//;; |
279
|
0
|
|
|
|
|
|
my $rest = $1; |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
# glob |
282
|
0
|
|
|
|
|
|
my $specials = '\[|\*|\?'; |
283
|
|
|
|
|
|
|
|
284
|
0
|
|
|
|
|
|
my @tokens = App::sh2p::Parser::tokenise ($statement); |
285
|
0
|
|
|
|
|
|
my @types = App::sh2p::Parser::identify (1, @tokens); |
286
|
|
|
|
|
|
|
|
287
|
0
|
|
|
|
|
|
my $index = 0; |
288
|
0
|
|
|
|
|
|
for (my $i = 0; $i < @tokens; $i++) { |
289
|
|
|
|
|
|
|
|
290
|
0
|
0
|
|
|
|
|
if (identify_sh_boolean ($tokens[$i], $types[$i])) { |
291
|
|
|
|
|
|
|
|
292
|
0
|
0
|
0
|
|
|
|
if ( $i < $#tokens && $tokens[$i+1] !~ /^($specials)\(/ ) { |
293
|
|
|
|
|
|
|
|
294
|
0
|
|
|
|
|
|
$i++; |
295
|
0
|
|
0
|
|
|
|
while(!identify_sh_boolean ($tokens[$i], $types[$i]) && |
296
|
|
|
|
|
|
|
$i < $#tokens) { |
297
|
|
|
|
|
|
|
|
298
|
0
|
|
|
|
|
|
$i++; |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
else { # [^\$] is to avoid matching $? |
304
|
0
|
0
|
|
|
|
|
if ($tokens[$i] =~ /[^\$]($specials)/) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
305
|
0
|
|
|
|
|
|
$types[$i] = [('OPERATOR', \&App::sh2p::Compound::convert_pattern)]; |
306
|
|
|
|
|
|
|
} |
307
|
|
|
|
|
|
|
elsif ($tokens[$i] eq '!') { |
308
|
0
|
|
|
|
|
|
$g_not = 1; |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
elsif ($types[$i][0] eq 'VARIABLE') { # January 2009 |
311
|
0
|
0
|
|
|
|
|
if (Register_variable($tokens[$i], '$')) { |
312
|
0
|
|
|
|
|
|
pre_out "my $tokens[$i];\n"; |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
} |
316
|
|
|
|
|
|
|
} |
317
|
|
|
|
|
|
|
|
318
|
0
|
0
|
|
|
|
|
if ($g_not) { |
319
|
0
|
|
|
|
|
|
out '( ! '; |
320
|
0
|
|
|
|
|
|
$g_not = 0; |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
else { |
323
|
0
|
|
|
|
|
|
out '( '; |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
#print_types_tokens (\@types, \@tokens); |
327
|
0
|
|
|
|
|
|
App::sh2p::Parser::convert (@tokens, @types); |
328
|
|
|
|
|
|
|
|
329
|
0
|
|
|
|
|
|
out ' )'; |
330
|
|
|
|
|
|
|
|
331
|
0
|
|
|
|
|
|
$g_not = 0; # This can be reset by the conversions above |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
# We haven't finished yet! |
334
|
0
|
0
|
0
|
|
|
|
if (defined $rest && $rest) { |
335
|
0
|
|
|
|
|
|
my @tokens = App::sh2p::Parser::tokenise ($rest); |
336
|
0
|
|
|
|
|
|
my @types = App::sh2p::Parser::identify (2, @tokens); |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
#print_types_tokens (\@types, \@tokens); |
339
|
|
|
|
|
|
|
|
340
|
0
|
|
|
|
|
|
App::sh2p::Parser::convert (@tokens, @types); |
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
|
343
|
0
|
|
|
|
|
|
return $ntok; |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
##################################################### |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
sub convert_pattern { |
349
|
|
|
|
|
|
|
|
350
|
0
|
|
|
0
|
0
|
|
my ($in) = @_; |
351
|
0
|
|
|
|
|
|
out ('/'.glob2pat ($in).'/'); |
352
|
0
|
|
|
|
|
|
return 1; |
353
|
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
##################################################### |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
sub Handle_if { |
358
|
|
|
|
|
|
|
|
359
|
0
|
|
|
0
|
0
|
|
my ($cmd, @statements) = @_; |
360
|
0
|
|
|
|
|
|
my $ntok = 1; |
361
|
|
|
|
|
|
|
|
362
|
0
|
|
|
|
|
|
$g_context = 'if'; |
363
|
|
|
|
|
|
|
|
364
|
0
|
|
|
|
|
|
for (my $i=0; $i < @statements; $i++) { |
365
|
0
|
0
|
|
|
|
|
if (substr($statements[$i],0,1) eq '#') { |
366
|
0
|
|
|
|
|
|
splice (@statements, $i); |
367
|
0
|
|
|
|
|
|
last; |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
} |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
# First token is 'if' |
372
|
0
|
|
|
|
|
|
iout "$cmd "; |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
# 2nd command? |
375
|
0
|
0
|
|
|
|
|
if (@statements) { |
376
|
0
|
|
|
|
|
|
$ntok += process_second_statement(1, @statements); |
377
|
|
|
|
|
|
|
} |
378
|
|
|
|
|
|
|
|
379
|
0
|
|
|
|
|
|
$g_context = ''; |
380
|
|
|
|
|
|
|
|
381
|
0
|
|
|
|
|
|
return $ntok; |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
##################################################### |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
sub Handle_fi { |
387
|
|
|
|
|
|
|
|
388
|
0
|
|
|
0
|
0
|
|
dec_indent(); |
389
|
0
|
|
|
|
|
|
dec_block_level(); |
390
|
|
|
|
|
|
|
#out "\n"; |
391
|
|
|
|
|
|
|
|
392
|
0
|
|
|
|
|
|
iout "}\n"; |
393
|
|
|
|
|
|
|
|
394
|
0
|
|
|
|
|
|
return 1; |
395
|
|
|
|
|
|
|
} |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
##################################################### |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
sub Handle_not { |
400
|
0
|
|
|
0
|
0
|
|
$g_not = 1; |
401
|
0
|
|
|
|
|
|
return 1; |
402
|
|
|
|
|
|
|
} |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
##################################################### |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
sub Handle_then { |
407
|
0
|
|
|
0
|
0
|
|
my ($cmd, @statements) = @_; |
408
|
0
|
|
|
|
|
|
my $ntok = 1; |
409
|
|
|
|
|
|
|
|
410
|
0
|
|
|
|
|
|
for (my $i=0; $i < @statements; $i++) { |
411
|
0
|
0
|
|
|
|
|
if (substr($statements[$i],0,1) eq '#') { |
412
|
0
|
|
|
|
|
|
splice (@statements, $i); |
413
|
0
|
|
|
|
|
|
last; |
414
|
|
|
|
|
|
|
} |
415
|
|
|
|
|
|
|
} |
416
|
|
|
|
|
|
|
|
417
|
0
|
|
|
|
|
|
iout "{\n"; |
418
|
0
|
|
|
|
|
|
inc_indent(); |
419
|
0
|
|
|
|
|
|
inc_block_level(); |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
# 2nd command? |
422
|
0
|
0
|
|
|
|
|
if (@statements) { |
423
|
0
|
|
|
|
|
|
$ntok += process_second_statement(0, @statements); |
424
|
|
|
|
|
|
|
} |
425
|
|
|
|
|
|
|
|
426
|
0
|
|
|
|
|
|
return $ntok; |
427
|
|
|
|
|
|
|
} |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
##################################################### |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
sub Handle_else { |
432
|
0
|
|
|
0
|
0
|
|
my ($cmd, @statements) = @_; |
433
|
0
|
|
|
|
|
|
my $ntok = 1; |
434
|
|
|
|
|
|
|
|
435
|
0
|
|
|
|
|
|
for (my $i=0; $i < @statements; $i++) { |
436
|
0
|
0
|
|
|
|
|
if (substr($statements[$i],0,1) eq '#') { |
437
|
0
|
|
|
|
|
|
splice (@statements, $i); |
438
|
0
|
|
|
|
|
|
last; |
439
|
|
|
|
|
|
|
} |
440
|
|
|
|
|
|
|
} |
441
|
|
|
|
|
|
|
|
442
|
0
|
|
|
|
|
|
dec_indent(); |
443
|
0
|
|
|
|
|
|
dec_block_level(); |
444
|
0
|
|
|
|
|
|
out "\n"; |
445
|
0
|
|
|
|
|
|
iout "}\n"; |
446
|
0
|
|
|
|
|
|
iout "else {\n"; |
447
|
0
|
|
|
|
|
|
inc_indent(); |
448
|
0
|
|
|
|
|
|
inc_block_level(); |
449
|
|
|
|
|
|
|
|
450
|
0
|
|
|
|
|
|
$g_context = 'else'; |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
# 2nd command? |
453
|
0
|
0
|
|
|
|
|
if (@statements) { |
454
|
0
|
|
|
|
|
|
$ntok += process_second_statement(0, @statements); |
455
|
|
|
|
|
|
|
} |
456
|
|
|
|
|
|
|
|
457
|
0
|
|
|
|
|
|
$g_context = ''; |
458
|
0
|
|
|
|
|
|
return $ntok; |
459
|
|
|
|
|
|
|
} |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
##################################################### |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
sub Handle_elif { |
464
|
0
|
|
|
0
|
0
|
|
my ($cmd, @statements) = @_; |
465
|
0
|
|
|
|
|
|
my $ntok = 1; |
466
|
|
|
|
|
|
|
|
467
|
0
|
|
|
|
|
|
for (my $i=0; $i < @statements; $i++) { |
468
|
0
|
0
|
|
|
|
|
if (substr($statements[$i],0,1) eq '#') { |
469
|
0
|
|
|
|
|
|
splice (@statements, $i); |
470
|
0
|
|
|
|
|
|
last; |
471
|
|
|
|
|
|
|
} |
472
|
|
|
|
|
|
|
} |
473
|
|
|
|
|
|
|
|
474
|
0
|
|
|
|
|
|
dec_indent(); |
475
|
0
|
|
|
|
|
|
dec_block_level(); |
476
|
0
|
|
|
|
|
|
out "\n"; |
477
|
0
|
|
|
|
|
|
iout "}\n"; |
478
|
0
|
|
|
|
|
|
iout 'elsif '; |
479
|
|
|
|
|
|
|
|
480
|
0
|
|
|
|
|
|
$g_context = 'if'; |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
# 2nd command? |
483
|
0
|
0
|
|
|
|
|
if (@statements) { |
484
|
0
|
|
|
|
|
|
$ntok += process_second_statement(1, @statements); |
485
|
|
|
|
|
|
|
} |
486
|
|
|
|
|
|
|
|
487
|
0
|
|
|
|
|
|
$g_context = ''; |
488
|
|
|
|
|
|
|
|
489
|
0
|
|
|
|
|
|
return $ntok; |
490
|
|
|
|
|
|
|
} |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
##################################################### |
493
|
|
|
|
|
|
|
# see http://www.perlmonks.com/?node_id=708493 |
494
|
|
|
|
|
|
|
# $globstr =~ s{(?:^|(?<=[^\\]))(.)} { $patmap{$1} || "\Q$1" }ge; |
495
|
|
|
|
|
|
|
# nested : 1 do not add ^ and $ |
496
|
|
|
|
|
|
|
# minimal: 1 do a minimal match |
497
|
|
|
|
|
|
|
sub glob2pat { |
498
|
0
|
|
|
0
|
0
|
|
my ($globstr, $nested, $minimal) = @_; |
499
|
0
|
|
|
|
|
|
my $inside_br = 0; |
500
|
0
|
|
|
|
|
|
my @chars = (split '', $globstr); |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
# C style used because I need to skip-ahead and look-behind |
503
|
0
|
|
|
|
|
|
for (my $i; $i < @chars; $i++) { |
504
|
0
|
0
|
0
|
|
|
|
if ($chars[$i] eq '\\') { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
505
|
0
|
|
|
|
|
|
$i++; # ignore next char |
506
|
|
|
|
|
|
|
} |
507
|
|
|
|
|
|
|
elsif ($chars[$i] eq '[') { |
508
|
0
|
|
|
|
|
|
$inside_br++; # Allow for nested [] |
509
|
|
|
|
|
|
|
} |
510
|
|
|
|
|
|
|
elsif ($chars[$i] eq ']' && $inside_br) { |
511
|
0
|
|
|
|
|
|
$inside_br--; |
512
|
|
|
|
|
|
|
} |
513
|
|
|
|
|
|
|
elsif ($chars[$i] eq '!' && $inside_br && $chars[$i-1] eq '[') { |
514
|
|
|
|
|
|
|
# ! only means 'not' at the front of the [] list |
515
|
0
|
|
|
|
|
|
$chars[$i] = '^' |
516
|
|
|
|
|
|
|
} |
517
|
|
|
|
|
|
|
elsif (! $inside_br) { |
518
|
0
|
0
|
|
|
|
|
if ($chars[$i] eq '*') { |
|
|
0
|
|
|
|
|
|
519
|
0
|
0
|
0
|
|
|
|
if (defined $minimal && $minimal) { |
520
|
0
|
|
|
|
|
|
$chars[$i] = '.*?' |
521
|
|
|
|
|
|
|
} |
522
|
|
|
|
|
|
|
else { |
523
|
0
|
|
|
|
|
|
$chars[$i] = '.*' |
524
|
|
|
|
|
|
|
} |
525
|
|
|
|
|
|
|
} |
526
|
|
|
|
|
|
|
elsif ($chars[$i] eq '?') { |
527
|
0
|
|
|
|
|
|
$chars[$i] = '.' |
528
|
|
|
|
|
|
|
} |
529
|
|
|
|
|
|
|
} |
530
|
|
|
|
|
|
|
} |
531
|
|
|
|
|
|
|
|
532
|
0
|
|
|
|
|
|
local $" = ''; |
533
|
0
|
0
|
0
|
|
|
|
if (defined $nested && $nested) { |
534
|
0
|
|
|
|
|
|
return "@chars"; |
535
|
|
|
|
|
|
|
} |
536
|
|
|
|
|
|
|
else { |
537
|
0
|
|
|
|
|
|
return "^@chars\$"; |
538
|
|
|
|
|
|
|
} |
539
|
|
|
|
|
|
|
} |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
##################################################### |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
sub push_case { |
544
|
|
|
|
|
|
|
|
545
|
0
|
|
|
0
|
0
|
|
push @g_case_statements, @_, set_break(); # 0.05 added break |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
} |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
##################################################### |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
sub Handle_case { |
552
|
|
|
|
|
|
|
|
553
|
0
|
|
|
0
|
0
|
|
my ($cmd, $var, $in, @rest) = @_; |
554
|
0
|
|
|
|
|
|
my $ntok = 3; |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
#print STDERR "Handle_case <$cmd> <$var> <$in> <@rest>\n"; |
557
|
|
|
|
|
|
|
|
558
|
0
|
|
|
|
|
|
$g_context = 'case'; |
559
|
|
|
|
|
|
|
|
560
|
0
|
0
|
|
|
|
|
if ($in ne 'in') { |
561
|
0
|
|
|
|
|
|
error_out ("Expected 'in', got <$in> "); |
562
|
|
|
|
|
|
|
} |
563
|
|
|
|
|
|
|
|
564
|
0
|
|
|
|
|
|
iout '$_ = '; |
565
|
0
|
|
|
|
|
|
App::sh2p::Handlers::interpolation ($var); |
566
|
0
|
|
|
|
|
|
out ";\n"; |
567
|
|
|
|
|
|
|
|
568
|
0
|
|
|
|
|
|
iout "SWITCH: {\n"; |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
# These are decremented in Handle_esac |
571
|
0
|
|
|
|
|
|
inc_indent(); |
572
|
0
|
|
|
|
|
|
inc_block_level(); |
573
|
|
|
|
|
|
|
|
574
|
0
|
|
|
|
|
|
my $i; |
575
|
|
|
|
|
|
|
|
576
|
0
|
|
|
|
|
|
for ($i = 0; $i < @rest; $i++) { |
577
|
|
|
|
|
|
|
|
578
|
0
|
|
|
|
|
|
my $condition = $rest[$i]; |
579
|
0
|
0
|
|
|
|
|
next if is_break($condition); # 0.05 |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
# January 2009 for case nested in other conditionals |
582
|
0
|
0
|
|
|
|
|
if ($condition eq 'esac') { |
583
|
0
|
|
|
|
|
|
dec_indent(); |
584
|
0
|
|
|
|
|
|
dec_block_level(); |
585
|
0
|
|
|
|
|
|
iout "}\n"; |
586
|
0
|
|
|
|
|
|
$i++; |
587
|
0
|
|
|
|
|
|
last; |
588
|
|
|
|
|
|
|
} |
589
|
|
|
|
|
|
|
|
590
|
0
|
|
|
|
|
|
$condition =~ s/^\(?(.*)\)$/$1/; |
591
|
0
|
|
|
|
|
|
$condition = glob2pat ($condition); |
592
|
0
|
|
|
|
|
|
iout ("/$condition/ && do {\n"); |
593
|
0
|
|
|
|
|
|
inc_indent(); |
594
|
0
|
|
|
|
|
|
inc_block_level(); |
595
|
|
|
|
|
|
|
|
596
|
0
|
|
|
|
|
|
my @tokens; |
597
|
|
|
|
|
|
|
|
598
|
0
|
|
|
|
|
|
for ( $i++; $i < @rest; $i++) { |
599
|
0
|
|
|
|
|
|
push @tokens,$rest[$i]; |
600
|
|
|
|
|
|
|
|
601
|
0
|
0
|
0
|
|
|
|
if ($rest[$i] eq ';' && $rest[$i+1] eq ';') { |
602
|
0
|
|
|
|
|
|
$i++; |
603
|
0
|
|
|
|
|
|
last; |
604
|
|
|
|
|
|
|
} |
605
|
|
|
|
|
|
|
} |
606
|
|
|
|
|
|
|
|
607
|
0
|
|
|
|
|
|
my @types = App::sh2p::Parser::identify (0, @tokens); |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
#print_types_tokens(\@types, \@tokens); |
610
|
|
|
|
|
|
|
|
611
|
0
|
|
|
|
|
|
App::sh2p::Parser::convert (@tokens, @types); |
612
|
|
|
|
|
|
|
|
613
|
0
|
|
|
|
|
|
iout ("last SWITCH;\n"); |
614
|
0
|
|
|
|
|
|
dec_indent(); |
615
|
0
|
|
|
|
|
|
dec_block_level(); |
616
|
0
|
|
|
|
|
|
iout ("};\n"); # Added ';' 0.05 |
617
|
|
|
|
|
|
|
} |
618
|
|
|
|
|
|
|
|
619
|
0
|
|
|
|
|
|
$ntok = $ntok + $i; # January 2009 |
620
|
|
|
|
|
|
|
|
621
|
0
|
|
|
|
|
|
$g_context = ''; |
622
|
|
|
|
|
|
|
|
623
|
0
|
|
|
|
|
|
return $ntok; |
624
|
|
|
|
|
|
|
} |
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
##################################################### |
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
sub Handle_esac { |
629
|
|
|
|
|
|
|
|
630
|
0
|
|
|
0
|
0
|
|
my ($cmd) = @_; |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
#print STDERR "Handle_esac\n"; |
633
|
|
|
|
|
|
|
|
634
|
0
|
|
|
|
|
|
Handle_case (@g_case_statements); |
635
|
|
|
|
|
|
|
|
636
|
0
|
|
|
|
|
|
dec_indent(); |
637
|
0
|
|
|
|
|
|
dec_block_level(); |
638
|
0
|
|
|
|
|
|
@g_case_statements = (); |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
# Fix January 2009 (was: iout "\n}\n") |
641
|
0
|
|
|
|
|
|
out "\n"; |
642
|
0
|
|
|
|
|
|
iout "}\n"; |
643
|
|
|
|
|
|
|
|
644
|
0
|
|
|
|
|
|
return 1; |
645
|
|
|
|
|
|
|
} |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
##################################################### |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
sub Handle_for { |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
# Format: for var in list |
652
|
0
|
|
|
0
|
0
|
|
my ($cmd, $var, $in, @list) = @_; |
653
|
|
|
|
|
|
|
|
654
|
0
|
|
|
|
|
|
$g_context = 'for'; |
655
|
|
|
|
|
|
|
|
656
|
0
|
|
|
|
|
|
my $ntok = 1; |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
# Using first argument because this is also used for select (temp) |
659
|
0
|
0
|
|
|
|
|
error_out ("No conversion for $cmd, consider Shell::POSIX::select") if $cmd eq 'select'; |
660
|
|
|
|
|
|
|
|
661
|
0
|
0
|
|
|
|
|
$ntok++ if defined $var; |
662
|
0
|
|
|
|
|
|
iout "$cmd my \$$var ("; |
663
|
|
|
|
|
|
|
|
664
|
0
|
0
|
|
|
|
|
$ntok++ if defined $in; |
665
|
|
|
|
|
|
|
|
666
|
0
|
|
|
|
|
|
my @for_tokens; |
667
|
|
|
|
|
|
|
|
668
|
0
|
|
|
|
|
|
for (my $i=0; $i < @list; $i++) { |
669
|
0
|
0
|
|
|
|
|
last if $list[$i] eq 'do'; |
670
|
0
|
0
|
|
|
|
|
last if $list[$i] eq ';'; |
671
|
0
|
0
|
|
|
|
|
last if substr($list[$i],0,1) eq '#'; |
672
|
|
|
|
|
|
|
|
673
|
0
|
|
|
|
|
|
push @for_tokens, $list[$i]; |
674
|
|
|
|
|
|
|
} |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
#print STDERR "Handle_for: for_tokens <@for_tokens>\n"; |
677
|
|
|
|
|
|
|
|
678
|
0
|
0
|
|
|
|
|
if (@for_tokens) { |
679
|
0
|
|
|
|
|
|
$ntok += @for_tokens; |
680
|
|
|
|
|
|
|
} |
681
|
|
|
|
|
|
|
else { |
682
|
0
|
0
|
|
|
|
|
if (ina_function()) { |
683
|
0
|
|
|
|
|
|
out '@_'; |
684
|
|
|
|
|
|
|
} |
685
|
|
|
|
|
|
|
else { |
686
|
0
|
|
|
|
|
|
out '@ARGV'; |
687
|
|
|
|
|
|
|
} |
688
|
|
|
|
|
|
|
} |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
# Often a variable to be converted to a list |
691
|
|
|
|
|
|
|
# Note: excludes @ and * which indicate an array |
692
|
0
|
0
|
|
|
|
|
if ($for_tokens[0] =~ /\$[A-Z0-9#\{\}\[\]]+/i) { |
693
|
0
|
|
|
|
|
|
my $IFS = App::sh2p::Utils::get_special_var('IFS',0); |
694
|
0
|
|
|
|
|
|
$IFS =~ s/^"(.*)"/$1/; |
695
|
0
|
|
|
|
|
|
out "split /$IFS/,$for_tokens[0]"; |
696
|
0
|
|
|
|
|
|
shift @for_tokens; |
697
|
|
|
|
|
|
|
} |
698
|
|
|
|
|
|
|
|
699
|
0
|
0
|
|
|
|
|
if (@for_tokens) { |
700
|
0
|
|
|
|
|
|
my @types = App::sh2p::Parser::identify (2, @for_tokens); |
701
|
0
|
|
|
|
|
|
App::sh2p::Parser::convert (@for_tokens, @types); |
702
|
|
|
|
|
|
|
} |
703
|
|
|
|
|
|
|
|
704
|
0
|
|
|
|
|
|
out ')'; |
705
|
|
|
|
|
|
|
|
706
|
0
|
|
|
|
|
|
$g_context = ''; |
707
|
|
|
|
|
|
|
|
708
|
0
|
|
|
|
|
|
return $ntok; |
709
|
|
|
|
|
|
|
} |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
##################################################### |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
sub Handle_while { |
714
|
|
|
|
|
|
|
|
715
|
0
|
|
|
0
|
0
|
|
my ($cmd, @statements) = @_; |
716
|
0
|
|
|
|
|
|
my $ntok = 1; |
717
|
|
|
|
|
|
|
|
718
|
0
|
|
|
|
|
|
for (my $i=0; $i < @statements; $i++) { |
719
|
0
|
0
|
|
|
|
|
if (substr($statements[$i],0,1) eq '#') { |
720
|
0
|
|
|
|
|
|
splice (@statements, $i); |
721
|
0
|
|
|
|
|
|
last; |
722
|
|
|
|
|
|
|
} |
723
|
|
|
|
|
|
|
} |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
#print STDERR "Handle_while: <@statements>\n"; |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
# First token is 'while' |
728
|
0
|
|
|
|
|
|
iout "$cmd "; |
729
|
|
|
|
|
|
|
|
730
|
0
|
|
|
|
|
|
$g_context = 'while'; |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
# 2nd command? |
733
|
0
|
0
|
|
|
|
|
if (@statements) { |
734
|
0
|
|
|
|
|
|
$ntok += process_second_statement(1, @statements); |
735
|
|
|
|
|
|
|
} |
736
|
|
|
|
|
|
|
|
737
|
0
|
|
|
|
|
|
$g_context = ''; |
738
|
0
|
|
|
|
|
|
return $ntok; |
739
|
|
|
|
|
|
|
} |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
##################################################### |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
sub Handle_until { |
744
|
|
|
|
|
|
|
|
745
|
0
|
|
|
0
|
0
|
|
my ($cmd, @statements) = @_; |
746
|
0
|
|
|
|
|
|
my $ntok = 1; |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
# First token is 'until' |
749
|
0
|
|
|
|
|
|
iout "$cmd "; |
750
|
|
|
|
|
|
|
|
751
|
0
|
|
|
|
|
|
$g_context = 'until'; |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
# 2nd command? |
754
|
0
|
0
|
|
|
|
|
if (@statements) { |
755
|
0
|
|
|
|
|
|
$ntok += process_second_statement(1, @statements); |
756
|
|
|
|
|
|
|
} |
757
|
|
|
|
|
|
|
|
758
|
0
|
|
|
|
|
|
$g_context = ''; |
759
|
0
|
|
|
|
|
|
return $ntok; |
760
|
|
|
|
|
|
|
} |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
##################################################### |
764
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
sub Ignore { |
766
|
0
|
|
|
0
|
0
|
|
return 1; |
767
|
|
|
|
|
|
|
} |
768
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
##################################################### |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
sub Handle_done { |
772
|
|
|
|
|
|
|
|
773
|
0
|
|
|
0
|
0
|
|
dec_indent(); |
774
|
0
|
|
|
|
|
|
dec_block_level(); |
775
|
0
|
|
|
|
|
|
out "\n"; |
776
|
0
|
|
|
|
|
|
iout "}\n"; |
777
|
|
|
|
|
|
|
|
778
|
0
|
|
|
|
|
|
return 1; |
779
|
|
|
|
|
|
|
} |
780
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
##################################################### |
783
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
sub Handle_do { |
785
|
|
|
|
|
|
|
|
786
|
0
|
|
|
0
|
0
|
|
iout "{\n"; |
787
|
0
|
|
|
|
|
|
inc_indent(); |
788
|
0
|
|
|
|
|
|
inc_block_level(); |
789
|
|
|
|
|
|
|
|
790
|
0
|
|
|
|
|
|
return 1; |
791
|
|
|
|
|
|
|
} |
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
##################################################### |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
sub Handle_function { |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
# Format: function name { |
798
|
|
|
|
|
|
|
|
799
|
0
|
|
|
0
|
0
|
|
my (undef, $name) = @_; |
800
|
|
|
|
|
|
|
|
801
|
0
|
|
|
|
|
|
out "sub $name "; |
802
|
|
|
|
|
|
|
|
803
|
0
|
|
|
|
|
|
set_user_function($name); |
804
|
|
|
|
|
|
|
|
805
|
0
|
|
|
|
|
|
return 2; |
806
|
|
|
|
|
|
|
} |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
##################################################### |
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
sub open_brace { |
811
|
|
|
|
|
|
|
|
812
|
0
|
|
|
0
|
0
|
|
iout "{\n"; |
813
|
0
|
|
|
|
|
|
inc_indent(); |
814
|
|
|
|
|
|
|
|
815
|
0
|
|
|
|
|
|
mark_function(); |
816
|
0
|
|
|
|
|
|
inc_block_level(); |
817
|
|
|
|
|
|
|
|
818
|
0
|
|
|
|
|
|
return 1; |
819
|
|
|
|
|
|
|
} |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
##################################################### |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
sub close_brace { |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
# Support for trap January 2009 |
826
|
|
|
|
|
|
|
|
827
|
0
|
|
|
0
|
0
|
|
App::sh2p::Trap::uninstall_function_traps(); |
828
|
|
|
|
|
|
|
|
829
|
0
|
|
|
|
|
|
dec_indent(); |
830
|
0
|
|
|
|
|
|
iout "\n}\n"; |
831
|
|
|
|
|
|
|
|
832
|
0
|
|
|
|
|
|
unmark_function(); |
833
|
0
|
|
|
|
|
|
dec_block_level(); |
834
|
|
|
|
|
|
|
|
835
|
0
|
|
|
|
|
|
return 1; |
836
|
|
|
|
|
|
|
} |
837
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
##################################################### |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
sub get_context { |
841
|
0
|
|
|
0
|
0
|
|
return $g_context; |
842
|
|
|
|
|
|
|
} |
843
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
##################################################### |
845
|
|
|
|
|
|
|
# Called by if, then, else, elif, while, until |
846
|
|
|
|
|
|
|
# First parameter set to true by if, elif, while, until |
847
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
sub process_second_statement { |
849
|
0
|
|
|
0
|
0
|
|
my ($cmd, @statements) = @_; |
850
|
0
|
|
|
|
|
|
my $statement; |
851
|
|
|
|
|
|
|
my $i; |
852
|
0
|
|
|
|
|
|
my $paren = 0; |
853
|
|
|
|
|
|
|
|
854
|
0
|
|
|
|
|
|
for ($i = 0; $i < @statements; $i++) { |
855
|
|
|
|
|
|
|
|
856
|
0
|
0
|
0
|
|
|
|
if (is_break($statements[$i]) || $statements[$i] eq ';') { |
857
|
0
|
|
|
|
|
|
last; |
858
|
|
|
|
|
|
|
} |
859
|
|
|
|
|
|
|
} |
860
|
|
|
|
|
|
|
|
861
|
0
|
0
|
|
|
|
|
return 0 unless $i > 0; |
862
|
|
|
|
|
|
|
|
863
|
0
|
|
|
|
|
|
$statement = join (' ', splice(@statements,0,$i)); |
864
|
|
|
|
|
|
|
#print STDERR "process_second_statement: <$statement>\n"; |
865
|
|
|
|
|
|
|
|
866
|
0
|
|
|
|
|
|
my @tokens = App::sh2p::Parser::tokenise ($statement); |
867
|
0
|
|
|
|
|
|
my @types = App::sh2p::Parser::identify (0, @tokens); |
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
#print_types_tokens (\@types, \@tokens); |
870
|
|
|
|
|
|
|
|
871
|
0
|
0
|
0
|
|
|
|
if ($cmd && $tokens[0] ne 'test' && |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
872
|
|
|
|
|
|
|
($types[0][0] eq 'EXTERNAL' || |
873
|
|
|
|
|
|
|
$types[0][0] eq 'BUILTIN' || |
874
|
|
|
|
|
|
|
$types[0][0] eq 'PERL_BUILTIN') |
875
|
|
|
|
|
|
|
) { |
876
|
0
|
|
|
|
|
|
$paren = 1; |
877
|
0
|
|
|
|
|
|
out '(' |
878
|
|
|
|
|
|
|
} |
879
|
|
|
|
|
|
|
|
880
|
0
|
0
|
|
|
|
|
App::sh2p::Handlers::no_semi_colon() if $cmd; |
881
|
0
|
|
|
|
|
|
App::sh2p::Parser::convert (@tokens, @types); |
882
|
0
|
0
|
|
|
|
|
App::sh2p::Handlers::reset_semi_colon() if $cmd; |
883
|
|
|
|
|
|
|
|
884
|
0
|
0
|
|
|
|
|
if ($paren) { |
885
|
0
|
|
|
|
|
|
out ')' |
886
|
|
|
|
|
|
|
} |
887
|
|
|
|
|
|
|
|
888
|
0
|
|
|
|
|
|
return $i; |
889
|
|
|
|
|
|
|
} |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
##################################################### |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
1; |