3 Term::ReadLine - Perl interface to various C<readline> packages.
4 If no real package is found, substitutes stubs instead of basic functions.
9 my $term = Term::ReadLine->new('Simple Perl calc');
10 my $prompt = "Enter your arithmetic expression: ";
11 my $OUT = $term->OUT || \*STDOUT;
12 while ( defined ($_ = $term->readline($prompt)) ) {
15 print $OUT $res, "\n" unless $@;
16 $term->addhistory($_) if /\S/;
21 This package is just a front end to some other packages. It's a stub to
22 set up a common interface to the various ReadLine implementations found on
23 CPAN (under the C<Term::ReadLine::*> namespace).
25 =head1 Minimal set of supported functions
27 All the supported functions should be called as methods, i.e., either as
29 $term = Term::ReadLine->new('name');
33 $term->addhistory('row');
35 where $term is a return value of Term::ReadLine-E<gt>new().
41 returns the actual package that executes the commands. Among possible
42 values are C<Term::ReadLine::Gnu>, C<Term::ReadLine::Perl>,
43 C<Term::ReadLine::Stub>.
47 returns the handle for subsequent calls to following
48 functions. Argument is the name of the application. Optionally can be
49 followed by two arguments for C<IN> and C<OUT> filehandles. These
50 arguments should be globs.
54 gets an input line, I<possibly> with actual C<readline>
55 support. Trailing newline is removed. Returns C<undef> on C<EOF>.
59 adds the line to the history of input, from where it can be used if
60 the actual C<readline> is present.
64 return the filehandles for input and output or C<undef> if C<readline>
65 input and output cannot be used for Perl.
69 If argument is specified, it is an advice on minimal size of line to
70 be included into history. C<undef> means do not include anything into
71 history. Returns the old value.
75 returns an array with two strings that give most appropriate names for
76 files for input and output using conventions C<"E<lt>$in">, C<"E<gt>out">.
80 returns a reference to a hash which describes internal configuration
81 of the package. Names of keys in this hash conform to standard
82 conventions with the leading C<rl_> stripped.
86 Returns a reference to a hash with keys being features present in
87 current implementation. Several optional features are used in the
88 minimal interface: C<appname> should be present if the first argument
89 to C<new> is recognized, and C<minline> should be present if
90 C<MinLine> method is not dummy. C<autohistory> should be present if
91 lines are put into history automatically (maybe subject to
92 C<MinLine>), and C<addhistory> if C<addhistory> method is not dummy.
94 If C<Features> method reports a feature C<attribs> as present, the
95 method C<Attribs> is not dummy.
99 =head1 Additional supported functions
101 Actually C<Term::ReadLine> can use some other package, that will
102 support a richer set of commands.
104 All these commands are callable via method interface and have names
105 which conform to standard conventions with the leading C<rl_> stripped.
107 The stub package included with the perl distribution allows some
114 makes Tk event loop run when waiting for user input (i.e., during
119 Registers call-backs to wait for user input (i.e., during C<readline>
120 method). This supersedes tkRunning.
122 The first call-back registered is the call back for waiting. It is
123 expected that the callback will call the current event loop until
124 there is something waiting to get on the input filehandle. The parameter
125 passed in is the return value of the second call back.
127 The second call-back registered is the call back for registration. The
128 input filehandle (often STDIN, but not necessarily) will be passed in.
130 For example, with AnyEvent:
132 $term->event_loop(sub {
134 $data->[1] = AE::cv();
139 $data->[0] = AE::io($fh, 0, sub { $data->[1]->send() });
143 The second call-back is optional if the call back is registered prior to
144 the call to $term-E<gt>readline.
146 Deregistration is done in this case by calling event_loop with C<undef>
149 $term->event_loop(undef);
151 This will cause the data array ref to be removed, allowing normal garbage
152 collection to clean it up. With AnyEvent, that will cause $data->[0] to
153 be cleaned up, and AnyEvent will automatically cancel the watcher at that
154 time. If another loop requires more than that to clean up a file watcher,
155 that will be up to the caller to handle.
159 makes the command line stand out by using termcap data. The argument
160 to C<ornaments> should be 0, 1, or a string of a form
161 C<"aa,bb,cc,dd">. Four components of this string should be names of
162 I<terminal capacities>, first two will be issued to make the prompt
163 standout, last two to make the input line standout.
167 takes two arguments which are input filehandle and output filehandle.
168 Switches to use these filehandles.
172 One can check whether the currently loaded ReadLine package supports
173 these methods by checking for corresponding C<Features>.
181 The environment variable C<PERL_RL> governs which ReadLine clone is
182 loaded. If the value is false, a dummy interface is used. If the value
183 is true, it should be tail of the name of the package to use, such as
186 As a special case, if the value of this variable is space-separated,
187 the tail might be used to disable the ornaments by setting the tail to
188 be C<o=0> or C<ornaments=0>. The head should be as described above, say
190 If the variable is not set, or if the head of space-separated list is
191 empty, the best available package is loaded.
193 export "PERL_RL=Perl o=0" # Use Perl ReadLine sans ornaments
194 export "PERL_RL= o=0" # Use best available ReadLine sans ornaments
196 (Note that processing of C<PERL_RL> for ornaments is in the discretion of the
197 particular used C<Term::ReadLine::*> package).
203 package Term::ReadLine::Stub;
204 our @ISA = qw'Term::ReadLine::Tk Term::ReadLine::TermCap';
206 $DB::emacs = $DB::emacs; # To peacify -w
208 *rl_term_set = \@Term::ReadLine::TermCap::rl_term_set;
210 sub PERL_UNICODE_STDIN () { 0x0001 }
212 sub ReadLine {'Term::ReadLine::Stub'}
215 my ($in,$out,$str) = @$self;
217 print $out $rl_term_set[0], $prompt, $rl_term_set[1], $rl_term_set[2];
219 if not $Term::ReadLine::registered and $Term::ReadLine::toloop;
220 #$str = scalar <$in>;
221 $str = $self->get_line;
223 if (${^UNICODE} & PERL_UNICODE_STDIN || defined ${^ENCODING}) &&
225 print $out $rl_term_set[3];
226 # bug in 5.000: chomping empty string creats length -1:
227 chomp $str if defined $str;
236 if (-e "/dev/tty" and $^O ne 'MSWin32') {
237 $console = "/dev/tty";
238 } elsif (-e "con" or $^O eq 'MSWin32' or $^O eq 'msys') {
240 $consoleOUT = 'CONOUT$';
241 } elsif ($^O eq 'VMS') {
242 $console = "sys\$command";
243 } elsif ($^O eq 'os2' && !$DB::emacs) {
244 $console = "/dev/con";
249 $consoleOUT = $console unless defined $consoleOUT;
250 $console = "&STDIN" unless defined $console;
251 if ($console eq "/dev/tty" && !open(my $fh, "<", $console)) {
255 if (!defined $consoleOUT) {
256 $consoleOUT = defined fileno(STDERR) && $^O ne 'MSWin32' ? "&STDERR" : "&STDOUT";
258 ($console,$consoleOUT);
262 die "method new called with wrong number of arguments"
263 unless @_==2 or @_==4;
264 #local (*FIN, *FOUT);
265 my ($FIN, $FOUT, $ret);
267 my($console, $consoleOUT) = $_[0]->findConsole;
270 # the Windows CONIN$ needs GENERIC_WRITE mode to allow
271 # a SetConsoleMode() if we end up using Term::ReadKey
272 open FIN, ( $^O eq 'MSWin32' && $console eq 'CONIN$' ) ? "+<$console" :
274 open FOUT,">$consoleOUT";
276 #OUT->autoflush(1); # Conflicts with debugger?
277 my $sel = select(FOUT);
278 $| = 1; # for DB::OUT
280 $ret = bless [\*FIN, \*FOUT];
281 } else { # Filehandles supplied
282 $FIN = $_[2]; $FOUT = $_[3];
283 #OUT->autoflush(1); # Conflicts with debugger?
284 my $sel = select($FOUT);
285 $| = 1; # for DB::OUT
287 $ret = bless [$FIN, $FOUT];
289 if ($ret->Features->{ornaments}
290 and not ($ENV{PERL_RL} and $ENV{PERL_RL} =~ /\bo\w*=0/)) {
291 local $Term::ReadLine::termcap_nowarn = 1;
298 my ($self, $in, $out) = @_;
301 my $sel = select($out);
302 $| = 1; # for DB::OUT
306 sub IN { shift->[0] }
307 sub OUT { shift->[1] }
308 sub MinLine { undef }
311 my %features = (tkRunning => 1, ornaments => 1, 'newTTY' => 1);
312 sub Features { \%features }
316 # my $in = $self->IN;
318 # return scalar <$in>;
321 package Term::ReadLine; # So late to allow the above code be defined?
323 our $VERSION = '1.11';
325 my ($which) = exists $ENV{PERL_RL} ? split /\s+/, $ENV{PERL_RL} : undef;
327 if ($which =~ /\bgnu\b/i){
328 eval "use Term::ReadLine::Gnu;";
329 } elsif ($which =~ /\bperl\b/i) {
330 eval "use Term::ReadLine::Perl;";
331 } elsif ($which =~ /^(Stub|TermCap|Tk)$/) {
332 # it is already in memory to avoid false exception as seen in:
333 # PERL_RL=Stub perl -e'$SIG{__DIE__} = sub { print @_ }; require Term::ReadLine'
335 eval "use Term::ReadLine::$which;";
337 } elsif (defined $which and $which ne '') { # Defined but false
340 eval "use Term::ReadLine::Gnu; 1" or eval "use Term::ReadLine::Perl; 1";
345 # To make possible switch off RL in debugger: (Not needed, work done
348 if (defined &Term::ReadLine::Gnu::readline) {
349 @ISA = qw(Term::ReadLine::Gnu Term::ReadLine::Stub);
350 } elsif (defined &Term::ReadLine::Perl::readline) {
351 @ISA = qw(Term::ReadLine::Perl Term::ReadLine::Stub);
352 } elsif (defined $which && defined &{"Term::ReadLine::$which\::readline"}) {
353 @ISA = "Term::ReadLine::$which";
355 @ISA = qw(Term::ReadLine::Stub);
358 package Term::ReadLine::TermCap;
360 # Prompt-start, prompt-end, command-line-start, command-line-end
361 # -- zero-width beautifies to emit around prompt and the command line.
362 our @rl_term_set = ("","","","");
364 our $rl_term_set = ',,,';
368 return if defined $terminal;
371 $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning.
376 return $rl_term_set unless @_;
377 $rl_term_set = shift;
378 $rl_term_set ||= ',,,';
379 $rl_term_set = 'us,ue,md,me' if $rl_term_set eq '1';
380 my @ts = split /,/, $rl_term_set, 4;
381 eval { LoadTermCap };
382 unless (defined $terminal) {
383 warn("Cannot find termcap: $@\n") unless $Term::ReadLine::termcap_nowarn;
384 $rl_term_set = ',,,';
387 @rl_term_set = map {$_ ? $terminal->Tputs($_,1) || '' : ''} @ts;
392 package Term::ReadLine::Tk;
394 # This package inserts a Tk->fileevent() before the diamond operator.
395 # The Tk watcher dispatches Tk events until the filehandle returned by
396 # the$term->IN() accessor becomes ready for reading. It's assumed
397 # that the diamond operator will return a line of input immediately at
402 # maybe in the future the Tk-specific aspects will be removed.
404 if (ref $Term::ReadLine::toloop)
406 $Term::ReadLine::toloop->[0]->($Term::ReadLine::toloop->[2]);
410 Tk::DoOneEvent(0) until $giveup;
417 unless ($Term::ReadLine::registered++)
419 if (ref $Term::ReadLine::toloop)
421 $Term::ReadLine::toloop->[2] = $Term::ReadLine::toloop->[1]->($self->IN) if $Term::ReadLine::toloop->[1];
425 Tk->fileevent($self->IN,'readable',sub { $giveup = 1});
431 $Term::ReadLine::toloop = $_[1] if @_ > 1;
432 $Term::ReadLine::toloop;
438 # T::RL::Gnu and T::RL::Perl check that this exists, if not,
439 # it doesn't call the loop. Those modules will need to be
440 # fixed before this can be removed.
441 if (not defined &Tk::DoOneEvent)
443 *Tk::DoOneEvent = sub {
444 die "what?"; # this shouldn't be called.
448 # store the callback in toloop, again so that other modules will
449 # recognise it and call us for the loop.
450 $Term::ReadLine::toloop = [ @_ ] if @_ > 0; # 0 because we shifted off $self.
451 $Term::ReadLine::toloop;
454 sub PERL_UNICODE_STDIN () { 0x0001 }
458 my ($in,$out,$str) = @$self;
460 if ($Term::ReadLine::toloop) {
461 $self->register_Tk if not $Term::ReadLine::registered;
469 if (${^UNICODE} & PERL_UNICODE_STDIN || defined ${^ENCODING}) &&
471 print $out $rl_term_set[3];
472 # bug in 5.000: chomping empty string creats length -1:
473 chomp $str if defined $str;