disallow eval { goto &foo }

[p5sagit/p5-mst-13.2.git] / lib / Term / ReadLine.pm

diff --git a/lib/Term/ReadLine.pm b/lib/Term/ReadLine.pm
index 491ce79..8cb6ab3 100644 (file)
--- a/lib/Term/ReadLine.pm
+++ b/lib/Term/ReadLine.pm
@@ -1,16 +1,16 @@
 =head1 NAME
 
-Term::ReadLine - Perl interface to various C<readline> packages. If
-no real package is found, substitutes stubs instead of basic functions.
+Term::ReadLine - Perl interface to various C<readline> packages.
+If no real package is found, substitutes stubs instead of basic functions.
 
 =head1 SYNOPSIS
 
   use Term::ReadLine;
-  $term = new Term::ReadLine 'Simple Perl calc';
-  $prompt = "Enter your arithmetic expression: ";
-  $OUT = $term->OUT || STDOUT;
+  my $term = new Term::ReadLine 'Simple Perl calc';
+  my $prompt = "Enter your arithmetic expression: ";
+  my $OUT = $term->OUT || \*STDOUT;
   while ( defined ($_ = $term->readline($prompt)) ) {
-    $res = eval($_), "\n";
+    my $res = eval($_);
     warn $@ if $@;
     print $OUT $res, "\n" unless $@;
     $term->addhistory($_) if /\S/;
@@ -33,7 +33,7 @@ or as
 
   $term->addhistory('row');
 
-where $term is a return value of Term::ReadLine-E<gt>Init.
+where $term is a return value of Term::ReadLine-E<gt>new().
 
 =over 12
 
@@ -41,7 +41,7 @@ where $term is a return value of Term::ReadLine-E<gt>Init.
 
 returns the actual package that executes the commands. Among possible
 values are C<Term::ReadLine::Gnu>, C<Term::ReadLine::Perl>,
-C<Term::ReadLine::Stub Exporter>.
+C<Term::ReadLine::Stub>.
 
 =item C<new>
 
@@ -60,7 +60,7 @@ support. Trailing newline is removed. Returns C<undef> on C<EOF>.
 adds the line to the history of input, from where it can be used if
 the actual C<readline> is present.
 
-=item C<IN>, $C<OUT>
+=item C<IN>, C<OUT>
 
 return the filehandles for input and output or C<undef> if C<readline>
 input and output cannot be used for Perl.
@@ -157,6 +157,22 @@ empty, the best available package is loaded.
 (Note that processing of C<PERL_RL> for ornaments is in the discretion of the 
 particular used C<Term::ReadLine::*> package).
 
+=head1 CAVEATS
+
+It seems that using Term::ReadLine from Emacs minibuffer doesn't work
+quite right and one will get an error message like
+
+    Cannot open /dev/tty for read at ...
+
+One possible workaround for this is to explicitly open /dev/tty like this
+
+    open (FH, "/dev/tty" )
+      or eval 'sub Term::ReadLine::findConsole { ("&STDIN", "&STDERR") }';
+    die $@ if $@;
+    close (FH);
+
+or you can try using the 4-argument form of Term::ReadLine->new().
+
 =cut
 
 use strict;
@@ -168,6 +184,8 @@ $DB::emacs = $DB::emacs;    # To peacify -w
 our @rl_term_set;
 *rl_term_set = \@Term::ReadLine::TermCap::rl_term_set;
 
+sub PERL_UNICODE_STDIN () { 0x0001 }
+
 sub ReadLine {'Term::ReadLine::Stub'}
 sub readline {
   my $self = shift;
@@ -180,6 +198,9 @@ sub readline {
   #$str = scalar <$in>;
   $str = $self->get_line;
   $str =~ s/^\s*\Q$prompt\E// if ($^O eq 'MacOS');
+  utf8::upgrade($str)
+      if (${^UNICODE} & PERL_UNICODE_STDIN || defined ${^ENCODING}) &&
+         utf8::valid($str);
   print $out $rl_term_set[3]; 
   # bug in 5.000: chomping empty string creats length -1:
   chomp $str if defined $str;
@@ -225,7 +246,7 @@ sub new {
   #local (*FIN, *FOUT);
   my ($FIN, $FOUT, $ret);
   if (@_==2) {
-    my($console, $consoleOUT) = findConsole;
+    my($console, $consoleOUT) = $_[0]->findConsole;
 
     open(FIN, "<$console"); 
     open(FOUT,">$consoleOUT");
@@ -269,7 +290,7 @@ sub Features { \%features }
 
 package Term::ReadLine;                # So late to allow the above code be defined?
 
-our $VERSION = '1.00';
+our $VERSION = '1.01';
 
 my ($which) = exists $ENV{PERL_RL} ? split /\s+/, $ENV{PERL_RL} : undef;
 if ($which) {
@@ -295,6 +316,8 @@ if (defined &Term::ReadLine::Gnu::readline) {
   @ISA = qw(Term::ReadLine::Gnu Term::ReadLine::Stub);
 } elsif (defined &Term::ReadLine::Perl::readline) {
   @ISA = qw(Term::ReadLine::Perl Term::ReadLine::Stub);
+} elsif (defined $which && defined &{"Term::ReadLine::$which\::readline"}) {
+  @ISA = "Term::ReadLine::$which";
 } else {
   @ISA = qw(Term::ReadLine::Stub);
 }