lib/Term/ReadLine.pm

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