This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 5.002beta2 patch: lib/Term/ReadLine.pm
[perl5.git] / lib / Term / ReadLine.pm
CommitLineData
cb31d310 1=head1 NAME
2
3C<Term::ReadLine>: Perl interface to various C<readline> packages. If
4no real package is found, substitutes stubs instead of basic functions.
5
6=head1 SYNOPSIS
7
8 use Term::ReadLine;
9 $term = new Term::ReadLine 'Simple Perl calc';
10 $prompt = "Enter your arithmetic expression: ";
11 $OUT = $term->OUT || STDOUT;
12 while ( defined ($_ = $term->readline($prompt)) ) {
13 $res = eval($_), "\n";
14 warn $@ if $@;
15 print $OUT $res, "\n" unless $@;
16 $term->addhistory($_) if /\S/;
17 }
18
19=head1 Minimal set of supported functions
20
21All the supported functions should be called as methods, i.e., either as
22
23 $term = new Term::ReadLine 'name';
24
25or as
26
27 $term->addhistory('row');
28
29where $term is a return value of Term::ReadLine->Init.
30
31=over 12
32
33=item C<ReadLine>
34
35returns the actual package that executes the commands. Among possible
36values are C<Term::ReadLine::Gnu>, C<Term::ReadLine::Perl>,
37C<Term::ReadLine::Stub Exporter>.
38
39=item C<new>
40
41returns the handle for subsequent calls to following
42functions. Argument is the name of the application. Optionally can be
43followed by two arguments for C<IN> and C<OUT> filehandles. These
44arguments should be globs.
45
46=item C<readline>
47
48gets an input line, I<possibly> with actual C<readline>
49support. Trailing newline is removed. Returns C<undef> on C<EOF>.
50
51=item C<addhistory>
52
53adds the line to the history of input, from where it can be used if
54the actual C<readline> is present.
55
56=item C<IN>, $C<OUT>
57
58return the filehandles for input and output or C<undef> if C<readline>
59input and output cannot be used for Perl.
60
61=item C<MinLine>
62
63If argument is specified, it is an advice on minimal size of line to
64be included into history. C<undef> means do not include anything into
65history. Returns the old value.
66
67=item C<findConsole>
68
69returns an array with two strings that give most appropriate names for
70files for input and output using conventions C<"<$in">, C<"E<gt>out">.
71
72=item C<Features>
73
74Returns a reference to a hash with keys being features present in
75current implementation. Several optional features are used in the
76minimal interface: C<appname> should be present if the first argument
77to C<new> is recognized, and C<minline> should be present if
78C<MinLine> method is not dummy. C<autohistory> should be present if
79lines are put into history automatically (maybe subject to
80C<MinLine>), and C<addhistory> if C<addhistory> method is not dummy.
81
82=back
83
84Actually C<Term::ReadLine> can use some other package, that will
85support reacher set of commands.
86
87=head1 EXPORTS
88
89None
90
91=cut
92
93package Term::ReadLine::Stub;
94
95$DB::emacs = $DB::emacs; # To peacify -w
96
97sub ReadLine {'Term::ReadLine::Stub'}
98sub readline {
99 my ($in,$out,$str) = @{shift()};
100 print $out shift;
101 $str = scalar <$in>;
102 # bug in 5.000: chomping empty string creats length -1:
103 chomp $str if defined $str;
104 $str;
105}
106sub addhistory {}
107
108sub findConsole {
109 my $console;
110
111 if (-e "/dev/tty") {
112 $console = "/dev/tty";
113 } elsif (-e "con") {
114 $console = "con";
115 } else {
116 $console = "sys\$command";
117 }
118
119 if (defined $ENV{'OS2_SHELL'}) { # In OS/2
120 if ($DB::emacs) {
121 $console = undef;
122 } else {
123 $console = "/dev/con";
124 }
125 }
126
127 $consoleOUT = $console;
128 $console = "&STDIN" unless defined $console;
129 if (!defined $consoleOUT) {
130 $consoleOUT = defined fileno(STDERR) ? "&STDERR" : "&STDOUT";
131 }
132 ($console,$consoleOUT);
133}
134
135sub new {
136 die "method new called with wrong number of arguments"
137 unless @_==2 or @_==4;
138 #local (*FIN, *FOUT);
139 my ($FIN, $FOUT);
140 if (@_==2) {
141 ($console, $consoleOUT) = findConsole;
142
143 open(FIN, "<$console");
144 open(FOUT,">$consoleOUT");
145 #OUT->autoflush(1); # Conflicts with debugger?
146 $sel = select(FOUT);
147 $| = 1; # for DB::OUT
148 select($sel);
149 bless [\*FIN, \*FOUT];
150 } else { # Filehandles supplied
151 $FIN = $_[2]; $FOUT = $_[3];
152 #OUT->autoflush(1); # Conflicts with debugger?
153 $sel = select($FOUT);
154 $| = 1; # for DB::OUT
155 select($sel);
156 bless [$FIN, $FOUT];
157 }
158}
159sub IN { shift->[0] }
160sub OUT { shift->[1] }
161sub MinLine { undef }
162sub Features { {} }
163
164package Term::ReadLine; # So late to allow the above code be defined?
165eval "use Term::ReadLine::Gnu;" or eval "use Term::ReadLine::Perl;";
166
167#require FileHandle;
168
169# To make possible switch off RL in debugger: (Not needed, work done
170# in debugger).
171
172if (defined &Term::ReadLine::Gnu::readline) {
173 @ISA = qw(Term::ReadLine::Gnu Term::ReadLine::Stub);
174} elsif (defined &Term::ReadLine::Perl::readline) {
175 @ISA = qw(Term::ReadLine::Perl Term::ReadLine::Stub);
176} else {
177 @ISA = qw(Term::ReadLine::Stub);
178}
179
180
1811;
182