This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
make the pod2html tests work with fs with vols
[perl5.git] / dist / Term-ReadLine / lib / Term / ReadLine.pm
CommitLineData
cb31d310 1=head1 NAME
2
7ef5744c
RGS
3Term::ReadLine - Perl interface to various C<readline> packages.
4If no real package is found, substitutes stubs instead of basic functions.
cb31d310 5
6=head1 SYNOPSIS
7
8 use Term::ReadLine;
2b393bf4 9 my $term = Term::ReadLine->new('Simple Perl calc');
7824b127
IM
10 my $prompt = "Enter your arithmetic expression: ";
11 my $OUT = $term->OUT || \*STDOUT;
cb31d310 12 while ( defined ($_ = $term->readline($prompt)) ) {
d49f26d4 13 my $res = eval($_);
cb31d310 14 warn $@ if $@;
15 print $OUT $res, "\n" unless $@;
16 $term->addhistory($_) if /\S/;
17 }
18
c07a80fd 19=head1 DESCRIPTION
20
bbb077f8
WY
21This package is just a front end to some other packages. It's a stub to
22set up a common interface to the various ReadLine implementations found on
23CPAN (under the C<Term::ReadLine::*> namespace).
c07a80fd 24
cb31d310 25=head1 Minimal set of supported functions
26
27All the supported functions should be called as methods, i.e., either as
28
2b393bf4 29 $term = Term::ReadLine->new('name');
cb31d310 30
31or as
32
33 $term->addhistory('row');
34
d49f26d4 35where $term is a return value of Term::ReadLine-E<gt>new().
cb31d310 36
37=over 12
38
39=item C<ReadLine>
40
41returns the actual package that executes the commands. Among possible
42values are C<Term::ReadLine::Gnu>, C<Term::ReadLine::Perl>,
e15d0a48 43C<Term::ReadLine::Stub>.
cb31d310 44
45=item C<new>
46
47returns the handle for subsequent calls to following
48functions. Argument is the name of the application. Optionally can be
49followed by two arguments for C<IN> and C<OUT> filehandles. These
50arguments should be globs.
51
52=item C<readline>
53
54gets an input line, I<possibly> with actual C<readline>
55support. Trailing newline is removed. Returns C<undef> on C<EOF>.
56
57=item C<addhistory>
58
59adds the line to the history of input, from where it can be used if
60the actual C<readline> is present.
61
d49f26d4 62=item C<IN>, C<OUT>
cb31d310 63
64return the filehandles for input and output or C<undef> if C<readline>
65input and output cannot be used for Perl.
66
67=item C<MinLine>
68
69If argument is specified, it is an advice on minimal size of line to
70be included into history. C<undef> means do not include anything into
71history. Returns the old value.
72
73=item C<findConsole>
74
75returns an array with two strings that give most appropriate names for
1fef88e7 76files for input and output using conventions C<"E<lt>$in">, C<"E<gt>out">.
cb31d310 77
a737e074
CS
78=item Attribs
79
80returns a reference to a hash which describes internal configuration
81of the package. Names of keys in this hash conform to standard
82conventions with the leading C<rl_> stripped.
83
cb31d310 84=item C<Features>
85
86Returns a reference to a hash with keys being features present in
87current implementation. Several optional features are used in the
88minimal interface: C<appname> should be present if the first argument
89to C<new> is recognized, and C<minline> should be present if
90C<MinLine> method is not dummy. C<autohistory> should be present if
91lines are put into history automatically (maybe subject to
92C<MinLine>), and C<addhistory> if C<addhistory> method is not dummy.
93
a737e074
CS
94If C<Features> method reports a feature C<attribs> as present, the
95method C<Attribs> is not dummy.
96
cb31d310 97=back
98
a737e074
CS
99=head1 Additional supported functions
100
cb31d310 101Actually C<Term::ReadLine> can use some other package, that will
bbb077f8 102support a richer set of commands.
cb31d310 103
a737e074
CS
104All these commands are callable via method interface and have names
105which conform to standard conventions with the leading C<rl_> stripped.
106
f36776d9
IZ
107The stub package included with the perl distribution allows some
108additional methods:
109
110=over 12
111
112=item C<tkRunning>
113
fc013e91
MM
114makes Tk's event loop run when waiting for user input (i.e., during
115the C<readline> method).
116
117Term::ReadLine supports any event loop, including unpubished ones and
118simple IO::Select loops without the need to rewrite existing code for
119any particular framework. See IN(), print_prompt(), and get_line().
f36776d9
IZ
120
121=item C<ornaments>
122
123makes the command line stand out by using termcap data. The argument
124to C<ornaments> should be 0, 1, or a string of a form
125C<"aa,bb,cc,dd">. Four components of this string should be names of
126I<terminal capacities>, first two will be issued to make the prompt
127standout, last two to make the input line standout.
128
129=item C<newTTY>
130
131takes two arguments which are input filehandle and output filehandle.
132Switches to use these filehandles.
133
fc013e91
MM
134=item C<print_prompt>
135
136prints a prompt and returns immediately. readline() uses it to print
137its prompt before calling get_line(). See L</"Using Event Loops"> for
138an example of its use.
139
140=item C<get_line>
141
142gets a line of input from the terminal. If Tk is used and tkRunning()
143has been set, then get_line() will dispatch Tk events while waiting
144for a line of input. The full readline() API is a print_prompt() call
145followed immediately by get_input(). See L</"Using Event Loops">.
146
f36776d9
IZ
147=back
148
149One can check whether the currently loaded ReadLine package supports
150these methods by checking for corresponding C<Features>.
7a2e2cd6 151
fc013e91
MM
152=head1 Using Event Loops
153
154Term::ReadLine provides IN(), print_prompt(), and get_line() so that
155it may be used by any event loop that can watch for input on a file
156handle. This includes most event loops including ones that haven't
157been published.
158
159Term::ReadLine's readline() method prints a prompt and returns a line
160of input got from its input filehandle:
161
162 sub readline {
163 my ($self,$prompt) = @_;
164 $self->print_prompt($prompt);
165 $self->get_line();
166 }
167
168A Tk readline function may be implemented by having Tk dispatch its
169own events between the time the prompt is printed and the line is got.
170This example function dispatches Tk events while Term::ReadLine waits
171for console input. It can completely replace Term::ReadLine's
172existing Tk support.
173
174 sub tk_read_line {
175 my ($term, $prompt) = @_;
176 $term->print_prompt($prompt);
177
178 my $got_input;
179 Tk->fileevent($term->IN, 'readable', sub { $got_input = 1 });
180 Tk::DoOneEvent(0) until $got_input;
181
182 return $term->get_line();
183 }
184
185Other event loops are equally possible.
186
cb31d310 187=head1 EXPORTS
188
189None
190
a737e074
CS
191=head1 ENVIRONMENT
192
8dcee03e 193The environment variable C<PERL_RL> governs which ReadLine clone is
405ff068
IZ
194loaded. If the value is false, a dummy interface is used. If the value
195is true, it should be tail of the name of the package to use, such as
196C<Perl> or C<Gnu>.
a737e074 197
405ff068
IZ
198As a special case, if the value of this variable is space-separated,
199the tail might be used to disable the ornaments by setting the tail to
200be C<o=0> or C<ornaments=0>. The head should be as described above, say
201
202If the variable is not set, or if the head of space-separated list is
203empty, the best available package is loaded.
204
205 export "PERL_RL=Perl o=0" # Use Perl ReadLine without ornaments
206 export "PERL_RL= o=0" # Use best available ReadLine without ornaments
207
208(Note that processing of C<PERL_RL> for ornaments is in the discretion of the
209particular used C<Term::ReadLine::*> package).
a737e074 210
cb31d310 211=cut
212
b75c8c73
MS
213use strict;
214
cb31d310 215package Term::ReadLine::Stub;
b75c8c73 216our @ISA = qw'Term::ReadLine::Tk Term::ReadLine::TermCap';
cb31d310 217
218$DB::emacs = $DB::emacs; # To peacify -w
b75c8c73 219our @rl_term_set;
7a2e2cd6 220*rl_term_set = \@Term::ReadLine::TermCap::rl_term_set;
cb31d310 221
fc013e91
MM
222sub print_prompt {
223 my ($self, $prompt) = @_;
224 my $out = $self->[1];
225 print $out $rl_term_set[0], $prompt, $rl_term_set[1], $rl_term_set[2];
226}
2499d329 227
cb31d310 228sub ReadLine {'Term::ReadLine::Stub'}
229sub readline {
fc013e91
MM
230 my ($self,$prompt) = @_;
231 $self->print_prompt($prompt);
232 $self->get_line();
cb31d310 233}
234sub addhistory {}
235
236sub findConsole {
237 my $console;
3b2be7b3 238 my $consoleOUT;
cb31d310 239
f64e7edf 240 if (-e "/dev/tty") {
cb31d310 241 $console = "/dev/tty";
8878e869 242 } elsif (-e "con" or $^O eq 'MSWin32') {
3b2be7b3
JS
243 $console = 'CONIN$';
244 $consoleOUT = 'CONOUT$';
cb31d310 245 } else {
246 $console = "sys\$command";
247 }
248
4d2c4e07 249 if (($^O eq 'amigaos') || ($^O eq 'beos') || ($^O eq 'epoc')) {
287f63d2
CS
250 $console = undef;
251 }
252 elsif ($^O eq 'os2') {
cb31d310 253 if ($DB::emacs) {
254 $console = undef;
255 } else {
256 $console = "/dev/con";
257 }
258 }
259
3b2be7b3 260 $consoleOUT = $console unless defined $consoleOUT;
cb31d310 261 $console = "&STDIN" unless defined $console;
d956618a
GA
262 if ($console eq "/dev/tty" && !open(my $fh, "<", $console)) {
263 $console = "&STDIN";
264 undef($consoleOUT);
265 }
cb31d310 266 if (!defined $consoleOUT) {
3b2be7b3 267 $consoleOUT = defined fileno(STDERR) && $^O ne 'MSWin32' ? "&STDERR" : "&STDOUT";
cb31d310 268 }
269 ($console,$consoleOUT);
270}
271
272sub new {
273 die "method new called with wrong number of arguments"
274 unless @_==2 or @_==4;
275 #local (*FIN, *FOUT);
405ff068 276 my ($FIN, $FOUT, $ret);
cb31d310 277 if (@_==2) {
4c3ccbe1 278 my($console, $consoleOUT) = $_[0]->findConsole;
cb31d310 279
3b2be7b3
JS
280
281 # the Windows CONIN$ needs GENERIC_WRITE mode to allow
282 # a SetConsoleMode() if we end up using Term::ReadKey
283 open FIN, ( $^O eq 'MSWin32' && $console eq 'CONIN$' ) ? "+<$console" :
284 "<$console";
285 open FOUT,">$consoleOUT";
286
cb31d310 287 #OUT->autoflush(1); # Conflicts with debugger?
b75c8c73 288 my $sel = select(FOUT);
cb31d310 289 $| = 1; # for DB::OUT
290 select($sel);
405ff068 291 $ret = bless [\*FIN, \*FOUT];
cb31d310 292 } else { # Filehandles supplied
293 $FIN = $_[2]; $FOUT = $_[3];
294 #OUT->autoflush(1); # Conflicts with debugger?
b75c8c73 295 my $sel = select($FOUT);
cb31d310 296 $| = 1; # for DB::OUT
297 select($sel);
405ff068 298 $ret = bless [$FIN, $FOUT];
cb31d310 299 }
405ff068
IZ
300 if ($ret->Features->{ornaments}
301 and not ($ENV{PERL_RL} and $ENV{PERL_RL} =~ /\bo\w*=0/)) {
302 local $Term::ReadLine::termcap_nowarn = 1;
303 $ret->ornaments(1);
304 }
305 return $ret;
cb31d310 306}
f36776d9
IZ
307
308sub newTTY {
309 my ($self, $in, $out) = @_;
310 $self->[0] = $in;
311 $self->[1] = $out;
312 my $sel = select($out);
313 $| = 1; # for DB::OUT
314 select($sel);
315}
316
cb31d310 317sub IN { shift->[0] }
318sub OUT { shift->[1] }
319sub MinLine { undef }
a737e074
CS
320sub Attribs { {} }
321
84902520 322my %features = (tkRunning => 1, ornaments => 1, 'newTTY' => 1);
a737e074 323sub Features { \%features }
cb31d310 324
b60dd402
DM
325#sub get_line {
326# my $self = shift;
327# my $in = $self->IN;
328# local ($/) = "\n";
329# return scalar <$in>;
330#}
4471601f 331
cb31d310 332package Term::ReadLine; # So late to allow the above code be defined?
a737e074 333
5055469f 334our $VERSION = '1.08';
b75c8c73 335
405ff068 336my ($which) = exists $ENV{PERL_RL} ? split /\s+/, $ENV{PERL_RL} : undef;
a737e074
CS
337if ($which) {
338 if ($which =~ /\bgnu\b/i){
339 eval "use Term::ReadLine::Gnu;";
340 } elsif ($which =~ /\bperl\b/i) {
341 eval "use Term::ReadLine::Perl;";
aeeb1390
GS
342 } elsif ($which =~ /^(Stub|TermCap|Tk)$/) {
343 # it is already in memory to avoid false exception as seen in:
344 # PERL_RL=Stub perl -e'$SIG{__DIE__} = sub { print @_ }; require Term::ReadLine'
a737e074
CS
345 } else {
346 eval "use Term::ReadLine::$which;";
347 }
405ff068 348} elsif (defined $which and $which ne '') { # Defined but false
a737e074
CS
349 # Do nothing fancy
350} else {
351 eval "use Term::ReadLine::Gnu; 1" or eval "use Term::ReadLine::Perl; 1";
352}
cb31d310 353
354#require FileHandle;
355
356# To make possible switch off RL in debugger: (Not needed, work done
357# in debugger).
b75c8c73 358our @ISA;
cb31d310 359if (defined &Term::ReadLine::Gnu::readline) {
360 @ISA = qw(Term::ReadLine::Gnu Term::ReadLine::Stub);
361} elsif (defined &Term::ReadLine::Perl::readline) {
362 @ISA = qw(Term::ReadLine::Perl Term::ReadLine::Stub);
e15d0a48
RC
363} elsif (defined $which && defined &{"Term::ReadLine::$which\::readline"}) {
364 @ISA = "Term::ReadLine::$which";
cb31d310 365} else {
366 @ISA = qw(Term::ReadLine::Stub);
367}
368
7a2e2cd6 369package Term::ReadLine::TermCap;
370
371# Prompt-start, prompt-end, command-line-start, command-line-end
372# -- zero-width beautifies to emit around prompt and the command line.
b75c8c73 373our @rl_term_set = ("","","","");
7a2e2cd6 374# string encoded:
b75c8c73 375our $rl_term_set = ',,,';
7a2e2cd6 376
b75c8c73 377our $terminal;
7a2e2cd6 378sub LoadTermCap {
379 return if defined $terminal;
380
381 require Term::Cap;
382 $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning.
383}
384
385sub ornaments {
386 shift;
387 return $rl_term_set unless @_;
388 $rl_term_set = shift;
389 $rl_term_set ||= ',,,';
7b8d334a 390 $rl_term_set = 'us,ue,md,me' if $rl_term_set eq '1';
7a2e2cd6 391 my @ts = split /,/, $rl_term_set, 4;
392 eval { LoadTermCap };
405ff068
IZ
393 unless (defined $terminal) {
394 warn("Cannot find termcap: $@\n") unless $Term::ReadLine::termcap_nowarn;
395 $rl_term_set = ',,,';
396 return;
397 }
7a2e2cd6 398 @rl_term_set = map {$_ ? $terminal->Tputs($_,1) || '' : ''} @ts;
399 return $rl_term_set;
400}
401
402
a737e074
CS
403package Term::ReadLine::Tk;
404
fc013e91
MM
405# This package inserts a Tk->fileevent() before the diamond operator.
406# The Tk watcher dispatches Tk events until the filehandle returned by
407# the$term->IN() accessor becomes ready for reading. It's assumed
408# that the diamond operator will return a line of input immediately at
409# that point.
410#
411# Any event loop can use $term-IN() and $term->readline() directly
412# without adding code for any event loop specifically to this.
413
414my ($giveup);
415
416# maybe in the future the Tk-specific aspects will be removed.
417sub Tk_loop{
418 Tk::DoOneEvent(0) until $giveup;
419 $giveup = 0;
420};
421
422sub register_Tk {
423 my $self = shift;
424 $Term::ReadLine::registered++
425 or Tk->fileevent($self->IN,'readable',sub { $giveup = 1});
426};
a737e074
CS
427
428sub tkRunning {
429 $Term::ReadLine::toloop = $_[1] if @_ > 1;
430 $Term::ReadLine::toloop;
431}
432
fc013e91 433sub PERL_UNICODE_STDIN () { 0x0001 }
a737e074
CS
434
435sub get_line {
436 my $self = shift;
fc013e91
MM
437 my ($in,$out,$str) = @$self;
438
439 if ($Term::ReadLine::toloop) {
440 $self->register_Tk if not $Term::ReadLine::registered;
441 $self->Tk_loop;
442 }
443
4e83e451 444 local ($/) = "\n";
fc013e91
MM
445 $str = <$in>;
446
447 utf8::upgrade($str)
448 if (${^UNICODE} & PERL_UNICODE_STDIN || defined ${^ENCODING}) &&
449 utf8::valid($str);
450 print $out $rl_term_set[3];
451 # bug in 5.000: chomping empty string creats length -1:
452 chomp $str if defined $str;
453
454 $str;
a737e074 455}
cb31d310 456
4571;
458