1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
#!/usr/bin/env perl
#
# rl - command-line interface to read a line from the standard input
# (or another fd) using readline.
#
# usage: rl [-p prompt] [-u unit] [-d default] [-n nchars]
#
# Copyright (C) 2024 Hiroo Hayashi
#
# Derived from: examples/rl.c in the GNU Readline Library
# Copyright (C) 1987-2023 Free Software Foundation, Inc.
use strict;
use warnings;
use Term::ReadLine;
use File::Basename;
use Getopt::Std;
$Getopt::Std::STANDARD_HELP_VERSION = 1;
my $VERSION = "1.0";
# default values
my $prompt = 'readline$ ';
my $fd = 0;
my $deftext = "";
my $nch = 0;
my $t = new Term::ReadLine 'rl';
my $a = $t->Attribs;
sub event_hook {
print STDERR "ding!\n";
sleep(1);
return 0;
}
sub set_deftext {
if ($deftext) {
$t->insert_text($deftext);
$deftext = "";
$a->{startup_hook} = undef;
}
return 0;
}
my $progname = basename($0);
sub HELP_MESSAGE {
my ($fh) = @_;
print $fh <<EOM;
"usage: $progname [-p prompt] [-u unit] [-d default] [-n nchars]
EOM
}
sub VERSION_MESSAGE {
my ($fh) = @_;
print $fh "version: $VERSION\n";
}
our ($opt_p, $opt_u, $opt_d, $opt_n);
getopts('p:u:d:n:');
$prompt = $opt_p if defined($opt_p);
$fd = $opt_u if defined($opt_u);
$deftext = $opt_d if defined($opt_d);
$nch = $opt_n if defined($opt_n);
if ($fd < 0) {
die "bad file descriptor $fd\n";
}
if ($nch < 0) {
die "bad value for -n: $nch\n";
}
if ($fd != 0) {
stat($fd) or die "$fd: $!\n";
open(my $ifp, "<&=", $fd) or die "$fd: $!\n";
$a->{instream} = $ifp;
}
if ($deftext && $deftext ne "") {
$a->{startup_hook} = \&set_deftext;
}
if ($nch > 0) {
$a->{num_chars_to_read} = $nch;
}
$a->{event_hook} = \&event_hook;
my $temp = $t->readline($prompt) or exit(1);
print "$temp\n";
exit(0);
|
