line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Term::DBPrompt;
|
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
23502
|
use strict;
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
41
|
|
4
|
1
|
|
|
1
|
|
5
|
use warnings;
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
28
|
|
5
|
1
|
|
|
1
|
|
23
|
use 5.010;
|
|
1
|
|
|
|
|
8
|
|
|
1
|
|
|
|
|
86
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our $VERSION = '0.05';
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our @EXPORT = qw( get_cmd_line page_open page_close set_prompt
|
10
|
|
|
|
|
|
|
set_banner set_command get_candidates set_opt
|
11
|
|
|
|
|
|
|
init_pipe fh);
|
12
|
|
|
|
|
|
|
|
13
|
1
|
|
|
1
|
|
6
|
use base qw(Exporter);
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
129
|
|
14
|
1
|
|
|
1
|
|
6
|
use File::Spec;
|
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
24
|
|
15
|
|
|
|
|
|
|
|
16
|
1
|
|
|
1
|
|
1383
|
use Text::Balanced qw(extract_delimited);
|
|
1
|
|
|
|
|
28160
|
|
|
1
|
|
|
|
|
170
|
|
17
|
|
|
|
|
|
|
|
18
|
1
|
|
|
1
|
|
12
|
use Fcntl qw(:seek);
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
5594
|
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
my @pipe;
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
my $opt_file;
|
23
|
|
|
|
|
|
|
my $opt_argv;
|
24
|
|
|
|
|
|
|
my $opt_interact;
|
25
|
|
|
|
|
|
|
my $opt_prompt;
|
26
|
|
|
|
|
|
|
my $opt_quiet;
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
my $tty_in;
|
29
|
|
|
|
|
|
|
my $tty_out;
|
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
my $inp_prv = '';
|
32
|
|
|
|
|
|
|
my $inp_fin;
|
33
|
|
|
|
|
|
|
my $inp_dat;
|
34
|
|
|
|
|
|
|
my $inp_ctr;
|
35
|
|
|
|
|
|
|
my $inp_tok;
|
36
|
|
|
|
|
|
|
my $inp_typ;
|
37
|
|
|
|
|
|
|
my $inp_fhd;
|
38
|
|
|
|
|
|
|
my $inp_eof = 0;
|
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
my @commands;
|
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
sub set_opt {
|
43
|
1
|
|
|
1
|
1
|
9
|
while (my ($k, $v) = each %{$_[0]}) {
|
|
3
|
|
|
|
|
16
|
|
44
|
2
|
|
|
|
|
5
|
given ($k) {
|
45
|
2
|
|
|
|
|
12
|
when ('file') { $opt_file = $v; }
|
|
1
|
|
|
|
|
4
|
|
46
|
1
|
|
|
|
|
3
|
when ('argv') { $opt_argv = $v; }
|
|
0
|
|
|
|
|
0
|
|
47
|
1
|
|
|
|
|
2
|
when ('inter') { $opt_interact = $v; }
|
|
0
|
|
|
|
|
0
|
|
48
|
1
|
|
|
|
|
2
|
when ('prompt') { $opt_prompt = $v; }
|
|
0
|
|
|
|
|
0
|
|
49
|
1
|
|
|
|
|
3
|
when ('quiet') { $opt_quiet = $v; }
|
|
1
|
|
|
|
|
3
|
|
50
|
0
|
|
|
|
|
0
|
when ('tty_in') { $tty_in = $v; }
|
|
0
|
|
|
|
|
0
|
|
51
|
0
|
|
|
|
|
0
|
when ('tty_out') { $tty_out = $v; }
|
|
0
|
|
|
|
|
0
|
|
52
|
0
|
|
|
|
|
0
|
default {
|
53
|
0
|
|
|
|
|
0
|
die "Error: in subroutine set_opt(), found invalid key {$k => '$v'} (not 'file', 'argv', 'inter', 'prompt', 'quiet', 'tty_in' or 'tty_out')";
|
54
|
|
|
|
|
|
|
}
|
55
|
|
|
|
|
|
|
}
|
56
|
|
|
|
|
|
|
}
|
57
|
|
|
|
|
|
|
}
|
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
sub init_pipe {
|
60
|
1
|
|
|
1
|
1
|
6
|
@pipe = ();
|
61
|
1
|
50
|
|
|
|
5
|
if (defined $opt_file) {
|
62
|
1
|
|
|
|
|
4
|
push @pipe, ['f', $opt_file]; # first read from a file (if any)
|
63
|
|
|
|
|
|
|
}
|
64
|
1
|
50
|
33
|
|
|
5
|
if (defined $opt_argv and $opt_argv =~ m{\S}xms) {
|
65
|
0
|
|
|
|
|
0
|
push @pipe, ['a', $opt_argv]; # then execute from the commandline
|
66
|
|
|
|
|
|
|
}
|
67
|
1
|
50
|
33
|
|
|
15
|
if (!@pipe or $opt_interact) { # if pipe is empty, or interactive has been forced...
|
68
|
0
|
|
|
|
|
0
|
push @pipe, ['i']; # ...then read from STDIN
|
69
|
|
|
|
|
|
|
}
|
70
|
|
|
|
|
|
|
|
71
|
1
|
|
|
|
|
2
|
$inp_prv = '';
|
72
|
1
|
|
|
|
|
2
|
$inp_fin = undef;
|
73
|
1
|
|
|
|
|
2
|
$inp_dat = undef;
|
74
|
1
|
|
|
|
|
2
|
$inp_ctr = undef;
|
75
|
1
|
|
|
|
|
2
|
$inp_tok = undef;
|
76
|
1
|
|
|
|
|
2
|
$inp_typ = undef;
|
77
|
1
|
|
|
|
|
2
|
$inp_fhd = undef;
|
78
|
1
|
|
|
|
|
2
|
$inp_eof = 0;
|
79
|
|
|
|
|
|
|
|
80
|
1
|
|
|
|
|
3
|
@commands = ();
|
81
|
|
|
|
|
|
|
}
|
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
# set up some parameters:
|
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
my $prompt = '?> ';
|
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
my $banner =
|
88
|
|
|
|
|
|
|
qq{\n}.
|
89
|
|
|
|
|
|
|
qq{**********\n}.
|
90
|
|
|
|
|
|
|
qq{** Test **\n}.
|
91
|
|
|
|
|
|
|
qq{**********\n}.
|
92
|
|
|
|
|
|
|
qq{\n};
|
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
my @cmd_available = qw( exit help );
|
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
# some setters and getters:
|
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub set_banner {
|
99
|
0
|
|
|
0
|
1
|
0
|
$banner = shift;
|
100
|
|
|
|
|
|
|
}
|
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
sub set_prompt {
|
103
|
0
|
|
|
0
|
1
|
0
|
$prompt = shift;
|
104
|
|
|
|
|
|
|
}
|
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
sub set_command {
|
107
|
1
|
|
|
1
|
1
|
11
|
@cmd_available = ();
|
108
|
1
|
|
|
|
|
3
|
for (@_) {
|
109
|
6
|
|
|
|
|
15
|
push @cmd_available, lc;
|
110
|
|
|
|
|
|
|
}
|
111
|
|
|
|
|
|
|
}
|
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
sub get_cmd_line {
|
114
|
26
|
|
66
|
26
|
1
|
13450
|
until ($inp_eof or @commands) {
|
115
|
24
|
|
|
|
|
48
|
getdata();
|
116
|
|
|
|
|
|
|
}
|
117
|
26
|
50
|
|
|
|
46
|
unless (@commands) { return; }
|
|
0
|
|
|
|
|
0
|
|
118
|
|
|
|
|
|
|
|
119
|
26
|
|
|
|
|
31
|
my $cmd = shift @commands;
|
120
|
26
|
|
|
|
|
43
|
my ($open, $close, $line) = @$cmd;
|
121
|
|
|
|
|
|
|
|
122
|
26
|
50
|
|
|
|
44
|
if ($opt_prompt) {
|
123
|
0
|
0
|
0
|
|
|
0
|
unless ($inp_typ eq 'i' and $tty_in) {
|
124
|
0
|
|
|
|
|
0
|
say $prompt, $line;
|
125
|
|
|
|
|
|
|
}
|
126
|
|
|
|
|
|
|
}
|
127
|
|
|
|
|
|
|
|
128
|
26
|
|
|
|
|
24
|
my @words;
|
129
|
26
|
|
|
|
|
27
|
while (1) {
|
130
|
28
|
|
|
|
|
76
|
my ($extracted, $new_line, $prefix) = extract_delimited $line, q{'"}, q{[^'"]*};
|
131
|
|
|
|
|
|
|
|
132
|
28
|
100
|
|
|
|
1282
|
unless (defined $extracted) {
|
133
|
26
|
|
|
|
|
54
|
$line =~ s{\A \s+}''xms; # remove leading spaces
|
134
|
26
|
100
|
|
|
|
97
|
push @words, split(m{\s+}xms, $line) if $line =~ m{\S}xms;
|
135
|
26
|
|
|
|
|
37
|
last;
|
136
|
|
|
|
|
|
|
}
|
137
|
|
|
|
|
|
|
|
138
|
2
|
|
|
|
|
3
|
$line = $new_line;
|
139
|
2
|
|
|
|
|
6
|
$extracted =~ s{\A ['"]}''xms;
|
140
|
2
|
|
|
|
|
6
|
$extracted =~ s{['"] \z}''xms;
|
141
|
2
|
|
|
|
|
3
|
$prefix =~ s{\A \s+}''xms; # remove leading spaces
|
142
|
2
|
50
|
|
|
|
11
|
push @words, split(m{\s+}xms, $prefix) if $prefix =~ m{\S}xms;;
|
143
|
2
|
|
|
|
|
4
|
push @words, $extracted;
|
144
|
|
|
|
|
|
|
}
|
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
# say "DEBUG words = ('@words') has ", scalar @words, " elements!";
|
147
|
|
|
|
|
|
|
|
148
|
26
|
100
|
|
|
|
48
|
unless (@words) {
|
149
|
5
|
|
|
|
|
24
|
return 'Empty', $open, $close, '';
|
150
|
|
|
|
|
|
|
}
|
151
|
|
|
|
|
|
|
|
152
|
21
|
|
|
|
|
35
|
$words[0] = lc $words[0];
|
153
|
|
|
|
|
|
|
|
154
|
21
|
|
|
|
|
41
|
my @candidates = get_candidates($words[0]);
|
155
|
|
|
|
|
|
|
|
156
|
21
|
100
|
|
|
|
40
|
if (@candidates > 1) {
|
157
|
1
|
|
|
|
|
7
|
return 'Dup', $open, $close, $words[0], @candidates;
|
158
|
|
|
|
|
|
|
}
|
159
|
|
|
|
|
|
|
|
160
|
20
|
100
|
|
|
|
38
|
if (@candidates == 1) {
|
161
|
17
|
|
|
|
|
19
|
$words[0] = $candidates[0];
|
162
|
17
|
|
|
|
|
93
|
return 'Found', $open, $close, @words;
|
163
|
|
|
|
|
|
|
}
|
164
|
|
|
|
|
|
|
|
165
|
3
|
|
|
|
|
19
|
return 'Not', $open, $close, @words;
|
166
|
|
|
|
|
|
|
}
|
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
sub getdata {
|
169
|
24
|
|
|
24
|
0
|
27
|
while (1) {
|
170
|
24
|
100
|
|
|
|
50
|
unless (defined $inp_tok) {
|
171
|
1
|
50
|
|
|
|
3
|
unless ($inp_prv eq '') {
|
172
|
0
|
|
|
|
|
0
|
$inp_dat = $inp_prv;
|
173
|
0
|
|
|
|
|
0
|
$inp_prv = '';
|
174
|
0
|
|
|
|
|
0
|
$inp_fin = 1;
|
175
|
0
|
|
|
|
|
0
|
last;
|
176
|
|
|
|
|
|
|
}
|
177
|
1
|
50
|
|
|
|
12
|
unless (@pipe) {
|
178
|
0
|
|
|
|
|
0
|
$inp_eof = 1;
|
179
|
0
|
|
|
|
|
0
|
return;
|
180
|
|
|
|
|
|
|
}
|
181
|
1
|
|
|
|
|
2
|
$inp_tok = shift @pipe;
|
182
|
1
|
|
|
|
|
2
|
$inp_typ = $inp_tok->[0];
|
183
|
1
|
|
|
|
|
3
|
$inp_ctr = 0;
|
184
|
|
|
|
|
|
|
|
185
|
1
|
50
|
|
|
|
3
|
if ($inp_typ eq 'f') {
|
186
|
1
|
50
|
|
1
|
|
10
|
open $inp_fhd, '<', $inp_tok->[1]
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
10
|
|
|
1
|
|
|
|
|
63
|
|
187
|
|
|
|
|
|
|
or die "Can't open < '".$inp_tok->[1]."' because $!";
|
188
|
|
|
|
|
|
|
}
|
189
|
|
|
|
|
|
|
}
|
190
|
|
|
|
|
|
|
|
191
|
24
|
|
|
|
|
1640
|
$inp_ctr++;
|
192
|
|
|
|
|
|
|
|
193
|
24
|
50
|
66
|
|
|
61
|
if ($inp_ctr == 1 and $inp_typ eq 'i' and $tty_in) {
|
|
|
|
33
|
|
|
|
|
194
|
0
|
|
|
|
|
0
|
say $banner;
|
195
|
|
|
|
|
|
|
}
|
196
|
|
|
|
|
|
|
|
197
|
24
|
|
|
|
|
38
|
given ($inp_typ) {
|
198
|
24
|
|
|
|
|
53
|
when ('f') {
|
199
|
24
|
|
|
|
|
70
|
$inp_dat = <$inp_fhd>;
|
200
|
24
|
50
|
|
|
|
44
|
unless (defined $inp_dat) {
|
201
|
0
|
|
|
|
|
0
|
close $inp_fhd;
|
202
|
0
|
|
|
|
|
0
|
$inp_tok = undef;
|
203
|
0
|
|
|
|
|
0
|
next;
|
204
|
|
|
|
|
|
|
}
|
205
|
24
|
|
|
|
|
30
|
chomp $inp_dat;
|
206
|
24
|
|
|
|
|
57
|
$inp_dat =~ s{\A \s+}''xms;
|
207
|
24
|
|
|
|
|
45
|
$inp_dat =~ s{\s+ \z}''xms;
|
208
|
|
|
|
|
|
|
|
209
|
24
|
100
|
|
|
|
45
|
unless ($inp_prv eq '') {
|
210
|
3
|
|
|
|
|
6
|
$inp_dat = $inp_prv.' '.$inp_dat;
|
211
|
3
|
|
|
|
|
4
|
$inp_prv = '';
|
212
|
|
|
|
|
|
|
}
|
213
|
24
|
|
|
|
|
26
|
$inp_fin = 0;
|
214
|
24
|
|
|
|
|
45
|
last;
|
215
|
|
|
|
|
|
|
}
|
216
|
0
|
|
|
|
|
0
|
when ('a') {
|
217
|
0
|
|
|
|
|
0
|
$inp_dat = $inp_tok->[1];
|
218
|
0
|
|
|
|
|
0
|
$inp_tok = undef;
|
219
|
0
|
|
|
|
|
0
|
$inp_fin = 0;
|
220
|
0
|
|
|
|
|
0
|
last;
|
221
|
|
|
|
|
|
|
}
|
222
|
0
|
|
|
|
|
0
|
when ('i') {
|
223
|
0
|
0
|
0
|
|
|
0
|
if ($tty_in and !$tty_out) {
|
224
|
0
|
|
|
|
|
0
|
die "STDOUT is redirected but STDIN is not";
|
225
|
|
|
|
|
|
|
}
|
226
|
0
|
0
|
|
|
|
0
|
if ($tty_in) {
|
227
|
0
|
|
|
|
|
0
|
print $prompt;
|
228
|
|
|
|
|
|
|
}
|
229
|
0
|
|
|
|
|
0
|
$inp_dat = ;
|
230
|
0
|
0
|
|
|
|
0
|
unless (defined $inp_dat) {
|
231
|
0
|
|
|
|
|
0
|
$inp_tok = undef;
|
232
|
0
|
|
|
|
|
0
|
next;
|
233
|
|
|
|
|
|
|
}
|
234
|
0
|
|
|
|
|
0
|
chomp $inp_dat;
|
235
|
|
|
|
|
|
|
|
236
|
0
|
0
|
0
|
|
|
0
|
if (!$tty_in and $opt_prompt) {
|
237
|
0
|
|
|
|
|
0
|
say $prompt, $inp_dat;
|
238
|
|
|
|
|
|
|
}
|
239
|
|
|
|
|
|
|
|
240
|
0
|
0
|
|
|
|
0
|
unless ($inp_prv eq '') {
|
241
|
0
|
|
|
|
|
0
|
$inp_dat = $inp_prv.' '.$inp_dat;
|
242
|
0
|
|
|
|
|
0
|
$inp_prv = '';
|
243
|
|
|
|
|
|
|
}
|
244
|
|
|
|
|
|
|
|
245
|
0
|
|
|
|
|
0
|
$inp_fin = 0;
|
246
|
0
|
|
|
|
|
0
|
last;
|
247
|
|
|
|
|
|
|
}
|
248
|
0
|
|
|
|
|
0
|
default {
|
249
|
0
|
|
|
|
|
0
|
die "Internal error: type = '$inp_typ' (not 'f', 'a' or 'i')";
|
250
|
|
|
|
|
|
|
}
|
251
|
|
|
|
|
|
|
}
|
252
|
|
|
|
|
|
|
}
|
253
|
|
|
|
|
|
|
|
254
|
24
|
100
|
|
|
|
71
|
unless ($inp_dat =~ m{\S}xms) {
|
255
|
5
|
|
|
|
|
16
|
push @commands, [1, 1, '']; # generate an empty line
|
256
|
5
|
|
|
|
|
22
|
return;
|
257
|
|
|
|
|
|
|
}
|
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
# here we translate 'any occurrence of ';' or '#' inside quotes into dummy characters
|
260
|
|
|
|
|
|
|
# in fact, inside quotes character ';' becomes \x{01}, character '#' becomes \x{02}
|
261
|
|
|
|
|
|
|
|
262
|
19
|
|
|
|
|
26
|
my $line = '';
|
263
|
|
|
|
|
|
|
|
264
|
19
|
|
|
|
|
18
|
while (1) {
|
265
|
21
|
|
|
|
|
56
|
my ($extracted, $new_dat, $prefix) = extract_delimited $inp_dat, q{'"}, q{[^'"]*};
|
266
|
|
|
|
|
|
|
|
267
|
21
|
100
|
|
|
|
986
|
unless (defined $extracted) {
|
268
|
19
|
|
|
|
|
22
|
$line .= $inp_dat;
|
269
|
19
|
|
|
|
|
22
|
last;
|
270
|
|
|
|
|
|
|
}
|
271
|
|
|
|
|
|
|
|
272
|
2
|
|
|
|
|
3
|
$inp_dat = $new_dat;
|
273
|
2
|
|
|
|
|
3
|
$extracted =~ tr{;\#}{\x{01}\x{02}}; # inside quotes: convert ';' into \x{01} and '#' into \x{02}
|
274
|
2
|
|
|
|
|
5
|
$line .= $prefix.$extracted;
|
275
|
|
|
|
|
|
|
}
|
276
|
|
|
|
|
|
|
|
277
|
19
|
100
|
|
|
|
46
|
if ($line =~ m{\A ([^\#]*) \#}xms) { $line = $1; } # remove comments
|
|
1
|
|
|
|
|
3
|
|
278
|
|
|
|
|
|
|
|
279
|
19
|
|
|
|
|
40
|
$line =~ s{\s+ \z}''xms; # remove trailing spaces
|
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
# here we find out if there is a trailing, half open command:
|
282
|
19
|
50
|
|
|
|
39
|
unless ($inp_fin) {
|
283
|
19
|
50
|
0
|
|
|
46
|
if ($inp_typ eq 'f' or ($inp_typ eq 'i' and !$tty_in)) {
|
|
|
|
33
|
|
|
|
|
284
|
19
|
|
|
|
|
20
|
my $rest;
|
285
|
19
|
100
|
|
|
|
103
|
if ($line =~ s{; ([^;]*) \z}';'xms) {
|
286
|
16
|
|
|
|
|
30
|
$rest = $1;
|
287
|
|
|
|
|
|
|
}
|
288
|
|
|
|
|
|
|
else {
|
289
|
3
|
|
|
|
|
4
|
$rest = $line; $line = '';
|
|
3
|
|
|
|
|
7
|
|
290
|
|
|
|
|
|
|
}
|
291
|
19
|
|
|
|
|
28
|
$rest =~ s{\A \s+}''xms;
|
292
|
19
|
|
|
|
|
21
|
$rest =~ s{\s+ \z}''xms;
|
293
|
19
|
|
|
|
|
25
|
$inp_prv = $rest;
|
294
|
|
|
|
|
|
|
}
|
295
|
|
|
|
|
|
|
}
|
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
# split up $line by ';' into @dat
|
298
|
19
|
|
|
|
|
20
|
my @dat;
|
299
|
19
|
|
|
|
|
51
|
for (split m{;}xms, $line) {
|
300
|
21
|
|
|
|
|
35
|
s{\A \s+}''xms;
|
301
|
21
|
|
|
|
|
27
|
tr{\x{01}\x{02}}{;\#}; # re-convert the dummy characters back into ';' and '#'
|
302
|
21
|
50
|
|
|
|
80
|
push @dat, $_ if m{\S}xms;
|
303
|
|
|
|
|
|
|
}
|
304
|
|
|
|
|
|
|
|
305
|
19
|
|
|
|
|
33
|
my $last = $#dat;
|
306
|
19
|
|
|
|
|
66
|
for my $i (0..$last) {
|
307
|
21
|
100
|
|
|
|
42
|
my $open = $i == 0 ? 1 : 0;
|
308
|
21
|
100
|
|
|
|
32
|
my $close = $i == $last ? 1 : 0;
|
309
|
|
|
|
|
|
|
|
310
|
21
|
|
|
|
|
127
|
push @commands, [$open, $close, $dat[$i]];
|
311
|
|
|
|
|
|
|
}
|
312
|
|
|
|
|
|
|
}
|
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
sub get_candidates {
|
315
|
21
|
|
|
21
|
1
|
25
|
my $word = lc $_[0];
|
316
|
|
|
|
|
|
|
|
317
|
21
|
100
|
|
|
|
26
|
return $word if grep {$_ eq $word} @cmd_available;
|
|
126
|
|
|
|
|
219
|
|
318
|
|
|
|
|
|
|
|
319
|
11
|
|
|
|
|
13
|
my $len = length $word;
|
320
|
|
|
|
|
|
|
|
321
|
11
|
|
|
|
|
12
|
my @cdt;
|
322
|
|
|
|
|
|
|
|
323
|
11
|
|
|
|
|
20
|
for my $c (@cmd_available) {
|
324
|
66
|
100
|
|
|
|
130
|
if (substr($c, 0, $len) eq $word) {
|
325
|
9
|
|
|
|
|
17
|
push @cdt, $c;
|
326
|
|
|
|
|
|
|
}
|
327
|
|
|
|
|
|
|
}
|
328
|
|
|
|
|
|
|
|
329
|
11
|
|
|
|
|
31
|
return @cdt;
|
330
|
|
|
|
|
|
|
}
|
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
open my $page_fh, '+>', undef or die "Error: Can't open '+>' undef because $!";
|
333
|
|
|
|
|
|
|
|
334
|
0
|
|
|
0
|
0
|
|
sub fh { $page_fh; }
|
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
sub page_open {
|
337
|
0
|
0
|
|
0
|
1
|
|
seek $page_fh, 0, SEEK_SET or die "Error: Can't seek tempfile to 0 for writing because $!";
|
338
|
0
|
0
|
|
|
|
|
truncate $page_fh, 0 or die "Error: Can't truncate tempfile to 0 because $!";
|
339
|
|
|
|
|
|
|
}
|
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
sub page_close {
|
342
|
0
|
0
|
|
0
|
1
|
|
seek $page_fh, 0, SEEK_SET or die "Error: Can't seek tempfile to 0 for reading because $!";
|
343
|
|
|
|
|
|
|
|
344
|
0
|
|
|
|
|
|
my $out_fh;
|
345
|
|
|
|
|
|
|
|
346
|
0
|
0
|
0
|
|
|
|
if ($inp_typ eq 'i' and $tty_in) {
|
|
|
0
|
|
|
|
|
|
347
|
0
|
0
|
|
|
|
|
open $out_fh, '|-', 'more' or die "Error: Can't open '|-' 'more' because $!";
|
348
|
|
|
|
|
|
|
}
|
349
|
|
|
|
|
|
|
elsif (!$opt_quiet) {
|
350
|
0
|
0
|
|
|
|
|
open $out_fh, '>&STDOUT' or die "Error: duplicate STDOUT because $!";
|
351
|
|
|
|
|
|
|
}
|
352
|
|
|
|
|
|
|
|
353
|
0
|
0
|
|
|
|
|
if (defined $out_fh) {
|
354
|
0
|
|
|
|
|
|
while (my $_ = <$page_fh>) {
|
355
|
0
|
|
|
|
|
|
print {$out_fh} $_;
|
|
0
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
}
|
357
|
|
|
|
|
|
|
|
358
|
0
|
|
|
|
|
|
close $out_fh;
|
359
|
|
|
|
|
|
|
}
|
360
|
|
|
|
|
|
|
}
|
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
1;
|
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
__END__
|