home *** CD-ROM | disk | FTP | other *** search
/ c't freeware shareware 1997 / CT_SW_97.ISO / mac / Software / entwickl / win95 / pw32i306.exe / lib / Term / readline.pm < prev   
Text File  |  1996-10-03  |  5KB  |  190 lines
  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.  
  190.