From b60dd40238e682dc3d405c6f6d0e42572cca27f2 Mon Sep 17 00:00:00 2001 From: Darin McBride Date: Sun, 29 Jan 2012 20:45:44 -0800 Subject: [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. --- dist/Term-ReadLine/lib/Term/ReadLine.pm | 82 ++++++++++++++++++++++----------- dist/Term-ReadLine/t/AE.t | 33 +++++++++++++ dist/Term-ReadLine/t/AETk.t | 42 +++++++++++++++++ dist/Term-ReadLine/t/Tk.t | 42 +++++++++++++++++ 4 files changed, 172 insertions(+), 27 deletions(-) create mode 100644 dist/Term-ReadLine/t/AE.t create mode 100644 dist/Term-ReadLine/t/AETk.t create mode 100644 dist/Term-ReadLine/t/Tk.t (limited to 'dist') 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 -makes Tk event loop run when waiting for user input (i.e., during -C method). +makes an event loop run when waiting for user input (i.e., during +C method). If AnyEvent is loaded, it is used, otherwise Tk +is used. =item C @@ -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."); -- cgit v1.2.1