[perl #108470] Make Term::ReadLine use AE if available

Term::ReadLine only allows the Tk event loop to be called during
a readline call. This should be updated to use AnyEvent which will
still work with Tk, as well as any other event loop the user may need.

With this patch, T::RL now uses AnyEvent if it is loaded, falling back
to Tk otherwise; so the Tk mode won't be affected.

T::RL::Stub has its own get_line. This does not honour the tkRunning
flag at all. If I remove it, it's fine. This patch does so.

4 files changed, 172 insertions, 27 deletions

diff --git a/dist/Term-ReadLine/lib/Term/ReadLine.pm b/dist/Term-ReadLine/lib/Term/ReadLine.pm
index 0121cdfd06..71af9d02a9 100644
--- a/dist/Term-ReadLine/lib/Term/ReadLine.pm
+++ b/dist/Term-ReadLine/lib/Term/ReadLine.pm
@@ -111,8 +111,9 @@ additional methods:
 
 =item C<tkRunning>
 
-makes Tk event loop run when waiting for user input (i.e., during
-C<readline> method).
+makes an event loop run when waiting for user input (i.e., during
+C<readline> method).  If AnyEvent is loaded, it is used, otherwise Tk
+is used.
 
 =item C<ornaments>
 
@@ -176,8 +177,7 @@ sub readline {
   my $prompt = shift;
   print $out $rl_term_set[0], $prompt, $rl_term_set[1], $rl_term_set[2]; 
   $self->register_Tk 
-     if not $Term::ReadLine::registered and $Term::ReadLine::toloop
-	and defined &Tk::DoOneEvent;
+     if not $Term::ReadLine::registered and $Term::ReadLine::toloop;
   #$str = scalar <$in>;
   $str = $self->get_line;
   utf8::upgrade($str)
@@ -279,12 +279,12 @@ sub Attribs { {} }
 my %features = (tkRunning => 1, ornaments => 1, 'newTTY' => 1);
 sub Features { \%features }
 
-sub get_line {
-  my $self = shift;
-  my $in = $self->IN;
-  local ($/) = "\n";
-  return scalar <$in>;
-}
+#sub get_line {
+#  my $self = shift;
+#  my $in = $self->IN;
+#  local ($/) = "\n";
+#  return scalar <$in>;
+#}
 
 package Term::ReadLine;		# So late to allow the above code be defined?
 
@@ -359,23 +359,51 @@ sub ornaments {
 
 package Term::ReadLine::Tk;
 
-our($count_handle, $count_DoOne, $count_loop);
-$count_handle = $count_DoOne = $count_loop = 0;
-
-our($giveup);
-sub handle {$giveup = 1; $count_handle++}
-
-sub Tk_loop {
-  # Tk->tkwait('variable',\$giveup);	# needs Widget
-  $count_DoOne++, Tk::DoOneEvent(0) until $giveup;
-  $count_loop++;
-  $giveup = 0;
+# if AnyEvent is loaded, use it.
+#use Enbugger; Enbugger->stop;
+if (defined &AE::cv)
+{
+    my ($cv, $fe);
+
+    # maintain old name for backward-compatibility
+    *AE_loop = *Tk_loop = sub {
+        my $self = shift;
+        $cv = AE::cv();
+        $cv->recv();
+    };
+    
+    *register_AE = *register_Tk = sub {
+        my $self = shift;
+        $fe ||= AE::io($self->IN, 0, sub { $cv->send() });
+    };
+
+    # just because AE is loaded doesn't mean Tk isn't.
+    if (not defined &Tk::DoOneEvent)
+    {
+        # create the stub as some T::RL implementations still check
+        # this directly.  This should eventually be removed.
+        *Tk::DoOneEvent = sub {
+            die "should not happen";
+        };
+    }
 }
+else
+{
+    my ($giveup);
+
+    # technically, not AE, but maybe in the future the Tk-specific
+    # aspects will be removed.
+    *AE_loop = *Tk_loop = sub {
+        Tk::DoOneEvent(0) until $giveup;
+        $giveup = 0;
+    };
+    
+    *register_AE = *register_Tk = sub {
+        my $self = shift;
+        $Term::ReadLine::registered++
+            or Tk->fileevent($self->IN,'readable',sub { $giveup = 1});
+    };
 
-sub register_Tk {
-  my $self = shift;
-  $Term::ReadLine::registered++ 
-    or Tk->fileevent($self->IN,'readable',\&handle);
 }
 
 sub tkRunning {
@@ -385,13 +413,13 @@ sub tkRunning {
 
 sub get_c {
   my $self = shift;
-  $self->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent;
+  $self->Tk_loop if $Term::ReadLine::toloop;
   return getc $self->IN;
 }
 
 sub get_line {
   my $self = shift;
-  $self->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent;
+  $self->Tk_loop if $Term::ReadLine::toloop;
   my $in = $self->IN;
   local ($/) = "\n";
   return scalar <$in>;
diff --git a/dist/Term-ReadLine/t/AE.t b/dist/Term-ReadLine/t/AE.t
new file mode 100644
index 0000000000..d0515dc8b5
--- /dev/null
+++ b/dist/Term-ReadLine/t/AE.t
@@ -0,0 +1,33 @@
+#!perl
+
+use Test::More;
+
+eval "use AnyEvent; 1" or
+    plan skip_all => "AnyEvent is not installed.";
+
+# seeing as the entire point of this test is to test the event handler,
+# we need to mock as little as possible.  To keep things tightly controlled,
+# we'll use the Stub directly.
+BEGIN {
+    $ENV{PERL_RL} = 'Stub o=0';
+}
+plan tests => 3;
+
+# need to delay this so that AE is loaded first.
+require Term::ReadLine;
+use File::Spec;
+
+my $t = Term::ReadLine->new('AE');
+ok($t, "Created object");
+is($t->ReadLine, 'Term::ReadLine::Stub', 'Correct type');
+$t->tkRunning(1);
+
+my $text = 'some text';
+my $T = $text . "\n";
+my $w = AE::timer(0,1,sub { 
+pass("Event loop called");
+exit 0;
+});
+
+my $result = $t->readline('Do not press enter>');
+fail("Should not get here.");
diff --git a/dist/Term-ReadLine/t/AETk.t b/dist/Term-ReadLine/t/AETk.t
new file mode 100644
index 0000000000..9546a8c549
--- /dev/null
+++ b/dist/Term-ReadLine/t/AETk.t
@@ -0,0 +1,42 @@
+#!perl
+
+use Test::More;
+
+eval "use Tk; use AnyEvent; 1" or
+    plan skip_all => "AnyEvent and/or Tk is not installed.";
+
+# seeing as the entire point of this test is to test the event handler,
+# we need to mock as little as possible.  To keep things tightly controlled,
+# we'll use the Stub directly.
+BEGIN {
+    $ENV{PERL_RL} = 'Stub o=0';
+    # ensure AE uses Tk.
+    $ENV{PERL_ANYEVENT_MODEL} = 'Tk';
+}
+
+eval {
+    use File::Spec;
+    my $mw = MainWindow->new(); $mw->withdraw();
+    1;
+} or plan skip_all => "Tk can't start. DISPLAY not set?";
+
+plan tests => 3;
+
+# need to delay this so that AE is loaded first.
+require Term::ReadLine;
+use File::Spec;
+
+my $t = Term::ReadLine->new('AE/Tk');
+ok($t, "Created object");
+is($t->ReadLine, 'Term::ReadLine::Stub', 'Correct type');
+$t->tkRunning(1);
+
+my $text = 'some text';
+my $T = $text . "\n";
+my $w = AE::timer(0,1,sub { 
+pass("Event loop called");
+exit 0;
+});
+
+my $result = $t->readline('Do not press enter>');
+fail("Should not get here.");
diff --git a/dist/Term-ReadLine/t/Tk.t b/dist/Term-ReadLine/t/Tk.t
new file mode 100644
index 0000000000..e2412248f4
--- /dev/null
+++ b/dist/Term-ReadLine/t/Tk.t
@@ -0,0 +1,42 @@
+#!perl
+
+use Test::More;
+
+eval "use Tk; 1" or
+    plan skip_all => "Tk is not installed.";
+
+# seeing as the entire point of this test is to test the event handler,
+# we need to mock as little as possible.  To keep things tightly controlled,
+# we'll use the Stub directly.
+BEGIN {
+    $ENV{PERL_RL} = 'Stub o=0';
+}
+
+my $mw;
+eval {
+    use File::Spec;
+    $mw = MainWindow->new(); $mw->withdraw();
+    1;
+} or plan skip_all => "Tk can't start. DISPLAY not set?";
+
+# need to delay this so that Tk is loaded first.
+require Term::ReadLine;
+
+plan tests => 3;
+
+my $t = Term::ReadLine->new('Tk');
+ok($t, "Created object");
+is($t->ReadLine, 'Term::ReadLine::Stub', 'Correct type');
+$t->tkRunning(1);
+
+my $text = 'some text';
+my $T = $text . "\n";
+
+my $w = Tk::after($mw,0,
+                  sub {
+                      pass("Event loop called");
+                      exit 0;
+                  });
+
+my $result = $t->readline('Do not press enter>');
+fail("Should not get here.");