This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
In S_validate_suid(), move declarations after the first statement.
[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
b60dd402
DM
114makes an event loop run when waiting for user input (i.e., during
115C<readline> method). If AnyEvent is loaded, it is used, otherwise Tk
116is used.
f36776d9
IZ
117
118=item C<ornaments>
119
120makes the command line stand out by using termcap data. The argument
121to C<ornaments> should be 0, 1, or a string of a form
122C<"aa,bb,cc,dd">. Four components of this string should be names of
123I<terminal capacities>, first two will be issued to make the prompt
124standout, last two to make the input line standout.
125
126=item C<newTTY>
127
128takes two arguments which are input filehandle and output filehandle.
129Switches to use these filehandles.
130
131=back
132
133One can check whether the currently loaded ReadLine package supports
134these methods by checking for corresponding C<Features>.
7a2e2cd6 135
cb31d310 136=head1 EXPORTS
137
138None
139
a737e074
CS
140=head1 ENVIRONMENT
141
8dcee03e 142The environment variable C<PERL_RL> governs which ReadLine clone is
405ff068
IZ
143loaded. If the value is false, a dummy interface is used. If the value
144is true, it should be tail of the name of the package to use, such as
145C<Perl> or C<Gnu>.
a737e074 146
405ff068
IZ
147As a special case, if the value of this variable is space-separated,
148the tail might be used to disable the ornaments by setting the tail to
149be C<o=0> or C<ornaments=0>. The head should be as described above, say
150
151If the variable is not set, or if the head of space-separated list is
152empty, the best available package is loaded.
153
154 export "PERL_RL=Perl o=0" # Use Perl ReadLine without ornaments
155 export "PERL_RL= o=0" # Use best available ReadLine without ornaments
156
157(Note that processing of C<PERL_RL> for ornaments is in the discretion of the
158particular used C<Term::ReadLine::*> package).
a737e074 159
cb31d310 160=cut
161
b75c8c73
MS
162use strict;
163
cb31d310 164package Term::ReadLine::Stub;
b75c8c73 165our @ISA = qw'Term::ReadLine::Tk Term::ReadLine::TermCap';
cb31d310 166
167$DB::emacs = $DB::emacs; # To peacify -w
b75c8c73 168our @rl_term_set;
7a2e2cd6 169*rl_term_set = \@Term::ReadLine::TermCap::rl_term_set;
cb31d310 170
2499d329
JH
171sub PERL_UNICODE_STDIN () { 0x0001 }
172
cb31d310 173sub ReadLine {'Term::ReadLine::Stub'}
174sub readline {
a737e074
CS
175 my $self = shift;
176 my ($in,$out,$str) = @$self;
6d697788
JH
177 my $prompt = shift;
178 print $out $rl_term_set[0], $prompt, $rl_term_set[1], $rl_term_set[2];
a737e074 179 $self->register_Tk
b60dd402 180 if not $Term::ReadLine::registered and $Term::ReadLine::toloop;
a737e074
CS
181 #$str = scalar <$in>;
182 $str = $self->get_line;
2499d329 183 utf8::upgrade($str)
11412ee6
JH
184 if (${^UNICODE} & PERL_UNICODE_STDIN || defined ${^ENCODING}) &&
185 utf8::valid($str);
7a2e2cd6 186 print $out $rl_term_set[3];
cb31d310 187 # bug in 5.000: chomping empty string creats length -1:
188 chomp $str if defined $str;
189 $str;
190}
191sub addhistory {}
192
193sub findConsole {
194 my $console;
3b2be7b3 195 my $consoleOUT;
cb31d310 196
f64e7edf 197 if (-e "/dev/tty") {
cb31d310 198 $console = "/dev/tty";
8878e869 199 } elsif (-e "con" or $^O eq 'MSWin32') {
3b2be7b3
JS
200 $console = 'CONIN$';
201 $consoleOUT = 'CONOUT$';
cb31d310 202 } else {
203 $console = "sys\$command";
204 }
205
4d2c4e07 206 if (($^O eq 'amigaos') || ($^O eq 'beos') || ($^O eq 'epoc')) {
287f63d2
CS
207 $console = undef;
208 }
209 elsif ($^O eq 'os2') {
cb31d310 210 if ($DB::emacs) {
211 $console = undef;
212 } else {
213 $console = "/dev/con";
214 }
215 }
216
3b2be7b3 217 $consoleOUT = $console unless defined $consoleOUT;
cb31d310 218 $console = "&STDIN" unless defined $console;
d956618a
GA
219 if ($console eq "/dev/tty" && !open(my $fh, "<", $console)) {
220 $console = "&STDIN";
221 undef($consoleOUT);
222 }
cb31d310 223 if (!defined $consoleOUT) {
3b2be7b3 224 $consoleOUT = defined fileno(STDERR) && $^O ne 'MSWin32' ? "&STDERR" : "&STDOUT";
cb31d310 225 }
226 ($console,$consoleOUT);
227}
228
229sub new {
230 die "method new called with wrong number of arguments"
231 unless @_==2 or @_==4;
232 #local (*FIN, *FOUT);
405ff068 233 my ($FIN, $FOUT, $ret);
cb31d310 234 if (@_==2) {
4c3ccbe1 235 my($console, $consoleOUT) = $_[0]->findConsole;
cb31d310 236
3b2be7b3
JS
237
238 # the Windows CONIN$ needs GENERIC_WRITE mode to allow
239 # a SetConsoleMode() if we end up using Term::ReadKey
240 open FIN, ( $^O eq 'MSWin32' && $console eq 'CONIN$' ) ? "+<$console" :
241 "<$console";
242 open FOUT,">$consoleOUT";
243
cb31d310 244 #OUT->autoflush(1); # Conflicts with debugger?
b75c8c73 245 my $sel = select(FOUT);
cb31d310 246 $| = 1; # for DB::OUT
247 select($sel);
405ff068 248 $ret = bless [\*FIN, \*FOUT];
cb31d310 249 } else { # Filehandles supplied
250 $FIN = $_[2]; $FOUT = $_[3];
251 #OUT->autoflush(1); # Conflicts with debugger?
b75c8c73 252 my $sel = select($FOUT);
cb31d310 253 $| = 1; # for DB::OUT
254 select($sel);
405ff068 255 $ret = bless [$FIN, $FOUT];
cb31d310 256 }
405ff068
IZ
257 if ($ret->Features->{ornaments}
258 and not ($ENV{PERL_RL} and $ENV{PERL_RL} =~ /\bo\w*=0/)) {
259 local $Term::ReadLine::termcap_nowarn = 1;
260 $ret->ornaments(1);
261 }
262 return $ret;
cb31d310 263}
f36776d9
IZ
264
265sub newTTY {
266 my ($self, $in, $out) = @_;
267 $self->[0] = $in;
268 $self->[1] = $out;
269 my $sel = select($out);
270 $| = 1; # for DB::OUT
271 select($sel);
272}
273
cb31d310 274sub IN { shift->[0] }
275sub OUT { shift->[1] }
276sub MinLine { undef }
a737e074
CS
277sub Attribs { {} }
278
84902520 279my %features = (tkRunning => 1, ornaments => 1, 'newTTY' => 1);
a737e074 280sub Features { \%features }
cb31d310 281
b60dd402
DM
282#sub get_line {
283# my $self = shift;
284# my $in = $self->IN;
285# local ($/) = "\n";
286# return scalar <$in>;
287#}
4471601f 288
cb31d310 289package Term::ReadLine; # So late to allow the above code be defined?
a737e074 290
5055469f 291our $VERSION = '1.08';
b75c8c73 292
405ff068 293my ($which) = exists $ENV{PERL_RL} ? split /\s+/, $ENV{PERL_RL} : undef;
a737e074
CS
294if ($which) {
295 if ($which =~ /\bgnu\b/i){
296 eval "use Term::ReadLine::Gnu;";
297 } elsif ($which =~ /\bperl\b/i) {
298 eval "use Term::ReadLine::Perl;";
aeeb1390
GS
299 } elsif ($which =~ /^(Stub|TermCap|Tk)$/) {
300 # it is already in memory to avoid false exception as seen in:
301 # PERL_RL=Stub perl -e'$SIG{__DIE__} = sub { print @_ }; require Term::ReadLine'
a737e074
CS
302 } else {
303 eval "use Term::ReadLine::$which;";
304 }
405ff068 305} elsif (defined $which and $which ne '') { # Defined but false
a737e074
CS
306 # Do nothing fancy
307} else {
308 eval "use Term::ReadLine::Gnu; 1" or eval "use Term::ReadLine::Perl; 1";
309}
cb31d310 310
311#require FileHandle;
312
313# To make possible switch off RL in debugger: (Not needed, work done
314# in debugger).
b75c8c73 315our @ISA;
cb31d310 316if (defined &Term::ReadLine::Gnu::readline) {
317 @ISA = qw(Term::ReadLine::Gnu Term::ReadLine::Stub);
318} elsif (defined &Term::ReadLine::Perl::readline) {
319 @ISA = qw(Term::ReadLine::Perl Term::ReadLine::Stub);
e15d0a48
RC
320} elsif (defined $which && defined &{"Term::ReadLine::$which\::readline"}) {
321 @ISA = "Term::ReadLine::$which";
cb31d310 322} else {
323 @ISA = qw(Term::ReadLine::Stub);
324}
325
7a2e2cd6 326package Term::ReadLine::TermCap;
327
328# Prompt-start, prompt-end, command-line-start, command-line-end
329# -- zero-width beautifies to emit around prompt and the command line.
b75c8c73 330our @rl_term_set = ("","","","");
7a2e2cd6 331# string encoded:
b75c8c73 332our $rl_term_set = ',,,';
7a2e2cd6 333
b75c8c73 334our $terminal;
7a2e2cd6 335sub LoadTermCap {
336 return if defined $terminal;
337
338 require Term::Cap;
339 $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning.
340}
341
342sub ornaments {
343 shift;
344 return $rl_term_set unless @_;
345 $rl_term_set = shift;
346 $rl_term_set ||= ',,,';
7b8d334a 347 $rl_term_set = 'us,ue,md,me' if $rl_term_set eq '1';
7a2e2cd6 348 my @ts = split /,/, $rl_term_set, 4;
349 eval { LoadTermCap };
405ff068
IZ
350 unless (defined $terminal) {
351 warn("Cannot find termcap: $@\n") unless $Term::ReadLine::termcap_nowarn;
352 $rl_term_set = ',,,';
353 return;
354 }
7a2e2cd6 355 @rl_term_set = map {$_ ? $terminal->Tputs($_,1) || '' : ''} @ts;
356 return $rl_term_set;
357}
358
359
a737e074
CS
360package Term::ReadLine::Tk;
361
b60dd402
DM
362# if AnyEvent is loaded, use it.
363#use Enbugger; Enbugger->stop;
364if (defined &AE::cv)
365{
366 my ($cv, $fe);
367
368 # maintain old name for backward-compatibility
369 *AE_loop = *Tk_loop = sub {
370 my $self = shift;
371 $cv = AE::cv();
372 $cv->recv();
373 };
374
375 *register_AE = *register_Tk = sub {
376 my $self = shift;
377 $fe ||= AE::io($self->IN, 0, sub { $cv->send() });
378 };
379
380 # just because AE is loaded doesn't mean Tk isn't.
381 if (not defined &Tk::DoOneEvent)
382 {
383 # create the stub as some T::RL implementations still check
384 # this directly. This should eventually be removed.
385 *Tk::DoOneEvent = sub {
386 die "should not happen";
387 };
388 }
a737e074 389}
b60dd402
DM
390else
391{
392 my ($giveup);
393
394 # technically, not AE, but maybe in the future the Tk-specific
395 # aspects will be removed.
396 *AE_loop = *Tk_loop = sub {
397 Tk::DoOneEvent(0) until $giveup;
398 $giveup = 0;
399 };
400
401 *register_AE = *register_Tk = sub {
402 my $self = shift;
403 $Term::ReadLine::registered++
404 or Tk->fileevent($self->IN,'readable',sub { $giveup = 1});
405 };
a737e074 406
a737e074
CS
407}
408
409sub tkRunning {
410 $Term::ReadLine::toloop = $_[1] if @_ > 1;
411 $Term::ReadLine::toloop;
412}
413
414sub get_c {
415 my $self = shift;
b60dd402 416 $self->Tk_loop if $Term::ReadLine::toloop;
a737e074
CS
417 return getc $self->IN;
418}
419
420sub get_line {
421 my $self = shift;
b60dd402 422 $self->Tk_loop if $Term::ReadLine::toloop;
a737e074 423 my $in = $self->IN;
4e83e451 424 local ($/) = "\n";
a737e074
CS
425 return scalar <$in>;
426}
cb31d310 427
4281;
429