New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Term::ReadLine should use have a generic event loop hook #11875
Comments
From darin.mcbride@shaw.caCreated by darin.mcbride@shaw.caTerm::ReadLine only allows the Tk event loop to be called during The only downside of this patch is that users currently using TRL with Tk Inline Patchdiff -u -r Term-ReadLine-1.07.orig/blib/lib/Term/ReadLine.pm Term-ReadLine-1.07/blib/lib/Term/ReadLine.pm
--- Term-ReadLine-1.07.orig/blib/lib/Term/ReadLine.pm 2011-07-07 09:10:31.000000000 -0600
+++ Term-ReadLine-1.07/blib/lib/Term/ReadLine.pm 2012-01-17 13:06:11.000000000 -0700
@@ -109,10 +109,10 @@
=over 12
-=item C<tkRunning>
+=item C<AERunning>
-makes Tk event loop run when waiting for user input (i.e., during
-C<readline> method).
+makes AnyEvent event loop run when waiting for user input (i.e., during
+C<readline> method). C<tkRunning> is an alias for this.
=item C<ornaments>
@@ -161,7 +161,7 @@
use strict;
package Term::ReadLine::Stub;
-our @ISA = qw'Term::ReadLine::Tk Term::ReadLine::TermCap';
+our @ISA = qw'Term::ReadLine::AE Term::ReadLine::TermCap';
$DB::emacs = $DB::emacs; # To peacify -w
our @rl_term_set;
@@ -175,9 +175,8 @@
my ($in,$out,$str) = @$self;
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;
+ $self->register_AE
+ if $Term::ReadLine::toloop;
#$str = scalar <$in>;
$str = $self->get_line;
utf8::upgrade($str)
@@ -296,7 +295,7 @@
eval "use Term::ReadLine::Gnu;";
} elsif ($which =~ /\bperl\b/i) {
eval "use Term::ReadLine::Perl;";
- } elsif ($which =~ /^(Stub|TermCap|Tk)$/) {
+ } elsif ($which =~ /^(Stub|TermCap|AE)$/) {
# it is already in memory to avoid false exception as seen in:
# PERL_RL=Stub perl -e'$SIG{__DIE__} = sub { print @_ }; require Term::ReadLine'
} else {
@@ -357,41 +356,50 @@
}
-package Term::ReadLine::Tk;
+package Term::ReadLine::AE;
-our($count_handle, $count_DoOne, $count_loop);
-$count_handle = $count_DoOne = $count_loop = 0;
+our $cv;
+our $fe;
-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;
+# for the other modules to use
+if (not defined &Tk::DoOneEvent)
+{
+ *Tk::DoOneEvent = sub {
+ die "what?"; # this shouldn't be called.
+ }
}
-sub register_Tk {
- my $self = shift;
- $Term::ReadLine::registered++
- or Tk->fileevent($self->IN,'readable',\&handle);
+sub AE_loop {
+ my $self = shift;
+ $cv = AE::cv();
+ $cv->recv();
+}
+# backwards compatibility
+*Tk_loop = \&AE_loop;
+
+sub register_AE {
+ my $self = shift;
+ $fe ||= AE::io($self->IN, 0, sub { $cv->send() });
}
+# backwards compatibility
+*register_Tk = \®ister_AE;
-sub tkRunning {
+sub AErunning {
$Term::ReadLine::toloop = $_[1] if @_ > 1;
$Term::ReadLine::toloop;
}
+# backwards compatibility
+*tkRunning = \&AErunning;
sub get_c {
my $self = shift;
- $self->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent;
+ $self->AE_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->AE_loop if $Term::ReadLine::toloop;
my $in = $self->IN;
local ($/) = "\n";
return scalar <$in>;
Inline Patchdiff -u -r Term-ReadLine-1.07.orig/lib/Term/ReadLine.pm Term-ReadLine-1.07/lib/Term/ReadLine.pm
--- Term-ReadLine-1.07.orig/lib/Term/ReadLine.pm 2011-07-07 09:10:31.000000000 -0600
+++ Term-ReadLine-1.07/lib/Term/ReadLine.pm 2012-01-17 13:08:39.000000000 -0700
@@ -109,10 +109,10 @@
=over 12
-=item C<tkRunning>
+=item C<AERunning>
-makes Tk event loop run when waiting for user input (i.e., during
-C<readline> method).
+makes AnyEvent event loop run when waiting for user input (i.e., during
+C<readline> method). C<tkRunning> is an alias for this.
=item C<ornaments>
@@ -161,7 +161,7 @@
use strict;
package Term::ReadLine::Stub;
-our @ISA = qw'Term::ReadLine::Tk Term::ReadLine::TermCap';
+our @ISA = qw'Term::ReadLine::AE Term::ReadLine::TermCap';
$DB::emacs = $DB::emacs; # To peacify -w
our @rl_term_set;
@@ -175,9 +175,8 @@
my ($in,$out,$str) = @$self;
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;
+ $self->register_AE
+ if $Term::ReadLine::toloop;
#$str = scalar <$in>;
$str = $self->get_line;
utf8::upgrade($str)
@@ -296,7 +295,7 @@
eval "use Term::ReadLine::Gnu;";
} elsif ($which =~ /\bperl\b/i) {
eval "use Term::ReadLine::Perl;";
- } elsif ($which =~ /^(Stub|TermCap|Tk)$/) {
+ } elsif ($which =~ /^(Stub|TermCap|AE)$/) {
# it is already in memory to avoid false exception as seen in:
# PERL_RL=Stub perl -e'$SIG{__DIE__} = sub { print @_ }; require Term::ReadLine'
} else {
@@ -357,41 +356,51 @@
}
-package Term::ReadLine::Tk;
+package Term::ReadLine::AE;
-our($count_handle, $count_DoOne, $count_loop);
-$count_handle = $count_DoOne = $count_loop = 0;
+our $cv;
+our $fe;
-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;
+# for the other modules to use to check if it exists,
+# should be eventually removed.
+if (not defined &Tk::DoOneEvent)
+{
+ *Tk::DoOneEvent = sub {
+ die "what?"; # this shouldn't be called.
+ }
}
-sub register_Tk {
- my $self = shift;
- $Term::ReadLine::registered++
- or Tk->fileevent($self->IN,'readable',\&handle);
+sub AE_loop {
+ my $self = shift;
+ $cv = AE::cv();
+ $cv->recv();
+}
+# backwards compatibility
+*Tk_loop = \&AE_loop;
+
+sub register_AE {
+ my $self = shift;
+ $fe ||= AE::io($self->IN, 0, sub { $cv->send() });
}
+# backwards compatibility
+*register_Tk = \®ister_AE;
-sub tkRunning {
+sub AErunning {
$Term::ReadLine::toloop = $_[1] if @_ > 1;
$Term::ReadLine::toloop;
}
+# backwards compatibility
+*tkRunning = \&AErunning;
sub get_c {
my $self = shift;
- $self->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent;
+ $self->AE_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->AE_loop if $Term::ReadLine::toloop;
my $in = $self->IN;
local ($/) = "\n";
return scalar <$in>; Perl Info
|
From @cpansproutOn Tue Jan 17 12:27:38 2012, dmcbride wrote:
Couldn’t you detect whether Tk is installed without AnyEvent, and fall -- Father Chrysostomos |
The RT System itself - Status changed from 'new' to 'open' |
From @dmcbrideOn Tuesday January 17 2012 1:09:03 PM you wrote:
Yes. I guess the first question is whether anyone with the diff -u -r Term-ReadLine-1.07.orig/lib/Term/ReadLine.pm Term- =item C<tkRunning> -makes Tk event loop run when waiting for user input (i.e., during =item C<ornaments> @@ -176,8 +177,7 @@ package Term::ReadLine::Tk; -our($count_handle, $count_DoOne, $count_loop); -sub register_Tk { sub tkRunning { sub get_c { sub get_line { |
From [Unknown Contact. See original ticket]On Tuesday January 17 2012 1:09:03 PM you wrote:
Yes. I guess the first question is whether anyone with the diff -u -r Term-ReadLine-1.07.orig/lib/Term/ReadLine.pm Term- =item C<tkRunning> -makes Tk event loop run when waiting for user input (i.e., during =item C<ornaments> @@ -176,8 +177,7 @@ package Term::ReadLine::Tk; -our($count_handle, $count_DoOne, $count_loop); -sub register_Tk { sub tkRunning { sub get_c { sub get_line { |
From @cpansproutOn Tue Jan 17 20:33:48 2012, dmcbride@cpan.org wrote:
Not being a user of the module, it’s hard for me to say that I’m Is there any way you can write tests for this, either using a dummy -- Father Chrysostomos |
From @dmcbrideOn Tuesday January 17 2012 1:09:03 PM you wrote:
Yes. I guess the first question is whether anyone with the power/authority to diff -u -r Term-ReadLine-1.07.orig/lib/Term/ReadLine.pm Term- =item C<tkRunning> -makes Tk event loop run when waiting for user input (i.e., during =item C<ornaments> @@ -176,8 +177,7 @@ package Term::ReadLine::Tk; -our($count_handle, $count_DoOne, $count_loop); -sub register_Tk { sub tkRunning { sub get_c { sub get_line { |
1 similar comment
From @dmcbrideOn Tuesday January 17 2012 1:09:03 PM you wrote:
Yes. I guess the first question is whether anyone with the power/authority to diff -u -r Term-ReadLine-1.07.orig/lib/Term/ReadLine.pm Term- =item C<tkRunning> -makes Tk event loop run when waiting for user input (i.e., during =item C<ornaments> @@ -176,8 +177,7 @@ package Term::ReadLine::Tk; -our($count_handle, $count_DoOne, $count_loop); -sub register_Tk { sub tkRunning { sub get_c { sub get_line { |
From joelz@pobox.comOn Tue, Jan 17, 2012 at 12:27:39PM -0800, Darin McBride wrote:
Hi Darin, I am author of a Audio::Nama, a Tk application that uses While I don't really understand how event loops work, So I wonder, will it be sufficient to patch Second, I wonder, why change the existing API? Third, if such patches were proposed, I would want A final note, Audio::Nama already uses AnyEvent, As far as I understand, the Tk event loop will Bonus questions: Does any know if tkRunning setting supports If so, it may be necessary that these sister implementations All this is written in theoretical ignorance, but with Regards, Joel Roth
-- |
From darin.mcbride@shaw.caMy apologies for the duplicate posts... apparently the delay on email was On Wednesday January 18 2012 1:40:21 AM you wrote:
Looking through the T::RL::G code, it calls $self->register_Tk, which is in
Perhaps. However, at worst, the Tk mode won't be affected.
The existing API isn't changed, but my answer to that is that AE is both more
My issue here is merely that the existing tests seem less than adequate. I've
I'm curious as to how you would receive events registered wtih Event while In other words, as far as I can tell, today, T::RL will only spin a Tk loop.
Right - by switching T::RL to use AE (or at least default to it when it's
One of my "test that I didn't break anything" scripts is using Tk::after just
More testing == good. (But too much testing == unreasonable delay) Since my
:-) Thanks! |
From @nwc10On Wed, Jan 18, 2012 at 07:27:35AM -0700, Darin McBride wrote:
And more portable? Or less portable? Given the author in question, and his preferences for how he spends his time ie I'd love to see AnyEvent as an option, even the default. But I don't feel Nicholas Clark |
From @TuxOn Wed, 18 Jan 2012 15:39:58 +0000, Nicholas Clark <nick@ccl4.org>
You are so capable of writing my opinion way better that I would have -- |
From @nwc10On Wed, Jan 18, 2012 at 04:43:11PM +0100, H.Merijn Brand wrote:
I had 3 or 4 edits to get it right. Portability is a trade off. And if one is putting in portability for platforms one doesn't know, hasn't So it's not wrong not to do it. [Abigail has made similar valid arguments But there's more than one way to express this :-/ Nicholas Clark |
From darin.mcbride@shaw.caOn Wednesday January 18 2012 7:40:35 AM Nicholas Clark via RT wrote:
Tk is not a hard dependency at the moment, unless you want an event loop. AE It's a soft dependency: if you want to use AE, T::RL should be able to support So, other than a lack of automated unit tests, I see the revised patch as one As for portability, I have no idea. According to cpantesters, AE seems to |
From @nwc10On Wed, Jan 18, 2012 at 10:32:08AM -0700, Darin McBride wrote:
It does. I'd missed that this was in the revised patch. Thanks. Nicholas Clark |
From joelz@pobox.comOn Wed, Jan 18, 2012 at 07:27:35AM -0700, Darin McBride wrote:
I use Event in a situation that the app runs without loaded
I'm glad no one told *me* that! :-) A T::RL based command prompt seems to run fine alongside
Ouch! This is an audio app that might record or play for
Seems to be going both ways. :-) -- |
From darin.mcbride@shaw.caOn Wednesday January 18 2012 10:13:48 AM you wrote:
Yeah, I'm very curious. Are you running multi-threaded? That should do it,
You've piqued my curiosity. :-) Here's the test I've been running, it's as I assume that if I moved the Event loop to one thread and the Tk loop (or #!/usr/bin/perl use strict; use Event; my $esc; my $t = 0; my $x = $term->readline('> '); |
From @rcaputoOn Jan 18, 2012, at 10:39, Nicholas Clark wrote:
Interoperability requires cooperation from the author, and he's been known to break it for modules he doesn't like. Ask Paul Evans and/or Matt Trout about this: https://metacpan.org/source/MLEHMANN/AnyEvent-6.13/lib/AnyEvent.pm#L1396 -- |
From @cpansproutOn Wed Jan 18 12:53:06 2012, rcaputo wrote:
Tying %INC could solve that. :-) -- Father Chrysostomos |
From darin.mcbride@shaw.caOn Wednesday January 18 2012 12:53:07 PM you wrote:
We have more than one developer in our community who has issues with their So, I suppose before we stray entirely off-topic, is it the opinion of someone Also, do the tests need to conform to core-modules-only (plus AE and Tk), or |
From @cpansproutOn Wed Jan 18 15:21:51 2012, dmcbride wrote:
Unless you can get someone else familiar with this to sign off on the
It would make testing easier if you could avoid non-core modules (fewer It would make testing even easier if you could use a mock object -- Father Chrysostomos |
From vadim.konovalov@alcatel-lucent.com
what most event loops it do support? Actually, when looking into ./lib/Term/ReadLine.pm and seeking IMO this should not be there - you support your favourite GUI but This Term::ReadLine::Tk should be on CPAN and not in the CORE. Regards, |
From @demerphqOn 18 January 2012 21:52, Rocco Caputo <rcaputo@pobox.com> wrote:
Wow. IMO the author of IO::Async::Loop::AnyEvent should just redefine But if they do are we going to see an arms race over what modules you I consider the piece of code you pointed out to most unperlish, and an IMO AnyEvent should be removed from CPAN until this code is removed, Yves -- |
From @leonerdOn Thu, Jan 19, 2012 at 07:06:11AM +0100, Konovalov, Vadim (Vadim)** CTR ** wrote:
+1 This has no business in core's Term::ReadLine. Anyone who wants -- leonerd@leonerd.org.uk |
From @leonerdOn Thu, Jan 19, 2012 at 01:01:39PM +0100, demerphq wrote:
I'm not going to get into a silly childish arms-race over this issue. MLEHMANN is upset because I found a way to layer IO::Async atop AnyEvent He choses not to do that, thus forcing me to peek inside, and so he gets
Which again is why I'm not going to get into an arms race as it will
That seems a -little- OTT as a response, surely? Perhaps a far better See also http://leonerds-code.blogspot.com/2011/05/wearing-two-hats.html TMTOWTDI, after all... -- leonerd@leonerd.org.uk |
From @demerphqOn 19 January 2012 17:42, Paul LeoNerd Evans <leonerd@leonerd.org.uk> wrote:
Yeah, its probably OTT as a response. And I am glad you aren't going I guess I shouldn't let it bother me, but it just seems wrong to do I actually checked to see if Larry Wall had said anything relevant from perlstyle: · Be nice. Seems to me that the code we are discussing violates both. cheers, * http://www.goodreads.com/quotes/show/81807 -- |
From @MonsPaul, I know, Marc is very hard man to talk, but why don’t you and Marc Your ::Loop::AnyEvent goes into AE's internals. It's not a good point of You abuse Marc's module, so he insert a protection from abusing. If I know, that something on CPAN will not work, or will work badly with my Just try to talk with him and many users of AE and IO::Async will win On Thu, Jan 19, 2012 at 4:42 AM, Paul LeoNerd Evans
-- |
From @demerphqOn 19 January 2012 18:08, Vladimir V. Perepelitsa <inthrax@gmail.com> wrote:
This is a gift culture. Its not up to the giver to determine how the It is also not Perlish to prevent someone from doing something that It seems to me that if the module warned, perhaps something like "You But forbidding someone to use a module because you want to use another
If that is your attitude you should hide your code away and make sure It simply is not YOUR problem what happens when someone decides to do
Of course it is always better to talk about things. Hopefully they can cheers, -- |
From @Mons
That's a bit another problem. So I respect that point of author. And if I'm an author of "gun", then I Of course, there are some smart users of our modules, that will do things
Completely agree
-- |
From @LeontOn Thu, Jan 19, 2012 at 6:08 PM, Vladimir V. Perepelitsa
Define 'abusing': AFAIK Paul didn't actually break anyone else's code, Leon |
From schmorp@schmorp.deOn Thu, Feb 02, 2012 at 04:28:16PM +0000, Paul LeoNerd Evans <leonerd@leonerd.org.uk> wrote:
I have explained to you that it can't be done, becaue AnyEvent can only offer
Well, did not "warn" you at all - I pointed out that your module creates You ignored that, so I added a diagnostic to warn users that they should
So you disagree that three weeks is not "long before", ok, granted, I
Of course I did, until people started to suffer, and I got the burden of
Bullshit, this is what I wrote: It's morally wrong, and I will certainly not help you making the That doesn't mean I was looking for ways to prevent you continuing along Now, that mail was 3kb in size, in which I explained why your approach is However, since the very approach is wrong, it can't be fixed by any simple
Well, you admitted you ignored me, so what's your point?
I did. You didnt like the solution and the explanation, so it is your Sorry, but saying you didn't bother with a reply is not my idea of trying
I explained in many ways why the approach is wrong.
Bullshit, the module was broken from the very beginning, and causing
Not everything that limps along is an analogy. What I did was simply add a diagnostic because your module breaks othe
Condvars stop working, as well as programs using other event loops than
Well, your module *is not fixable*, it's broken by design. I have explained to you what needs to be done to actually make IO::Async use That's not my problem, sorry.
See my other mail, it can't be solved by the design you choose, and the
Good, then how about doing so?
It does not work "at the time of the writing" vecause one_event wasn't
I think you fundamentally misunderstand AnyEvent - you think AnyEvent is just AnyEvent is just an adaptor to existing event loops. It does not block, like
When people run into problems and I have to waste my time debugging your code And if you don't want me to support it, what exatcly is your problem? I do
I can change it into a warning if that makes you happy, but that will not fix In any case, if that is all you wanted, you could have mentioned that - I
At least in firefox that just gives me the AnyEvent manpage - presumably You probably need to be more specific - if you refer to: # IO::Async::Loop::AnyEvent is extremely evil, refuse to work with it then please read what I wrote: "It does not and has not implemented any Your event loop is called IO::Async (actually an event framework), and it AnyEvent is supposed to work just fine with IO::Async as event loop - -- |
From @ap* Marc Lehmann <schmorp@schmorp.de> [2012-02-02 20:55]:
Marc, an option to resolve is to add an interface similar to what Plack By analogy IOALoopAE could mention in POD that it requires `one_event` That way AE could support *common* event loop semantics instead of just Effectively AE already does that – I do not recall what it was but there Regards, |
From schmorp@schmorp.deOn Thu, Feb 02, 2012 at 04:26:40PM +0100, Leon Timmermans <fawaka@gmail.com> wrote:
That's true (but in the meantime, has been explained).
Well, keep in mind: 1. perl5-porters is not the place to discuss this thing, it's simply off-topic
And keep in mind that this impression comes from what other people said, What pisses me off is that Rocco can spread fud on p5p and people like Really, don't you think people here were awfully quick to make up their mind I am trying to clarify things, but why do you want to drag out this fud I don't.
I have never done that, nor do I have the power to enforce that, so please
All that is wrong is IO::Async::Loop::AnyEvent being buggy by design and Unlike others, I am acting in good faith here, trying to discuss things So, one last time, keep in mind that I didn't drag this onto p5p, that p5p is However, reactions like yours do piss me off. You find it ok to change p5p Sorry, not so - I have the (moral) right to correct when people spread That might be your style, but not mine. And as such, I reserve the right to print warnings or fatal out in any way I -- |
From @tseeOn 02/03/2012 02:32 AM, Marc Lehmann wrote:
There are many things I disagree about with you, Marc, including the In the context, I would like to kindly suggest that this thread pass Thank you. [1] But that's a detail I do not care to discuss at length. [2] Within limits. I draw the line at, for example, racism, or malware. |
From schmorp@schmorp.deOn Fri, Feb 03, 2012 at 08:07:56AM +0100, Steffen Mueller <smueller@cpan.org> wrote:
Why else would somebody (Rocco) post fabricated statements ot this list to At the very least that's his campaign, or give me another reason why Rocco And it even worked with a few people (fortunately not too many) here.
While I don't read his mail the same waa as you apparently (he didn't only
This is not a just flamewar - Rocco abused this list to slander my person I fully agree that discussing the actual issues on this list is wrong,
I have a very similar view on that too. Seems that the closest thing to Perl developers asking for modules to be removed because of their personal -- |
From @rjbsI don't care who started it. This thread is over. -- |
From @nwc10On Wed Feb 01 10:58:27 2012, mst@shadowcat.co.uk wrote:
Agree, because what we have now is tested, and better than what we had
Yes, it would be nice to avoid a visible intermediate step. Nicholas Clark |
@cpansprout - Status changed from 'resolved' to 'open' |
From @rcaputoOn Mon Feb 06 05:15:27 2012, nicholas wrote:
Challenge accepted. See attachment. Patched directly against blead. |
From @rcaputoany-loop.patchcommit 0f3f478ba6fa705f85c7d09f25c68de98fff73c6
Author: Rocco Caputo <rcaputo@cpan.org>
Date: Sun Feb 19 00:16:50 2012 -0500
[perl #108470] Make Term::ReadLine compatible with any event loop.
Refactored readline() so its implementation may be used by any event
loop without necessarily revising applications to use a different
event loop than they already may have implemented.
diff --git a/dist/Term-ReadLine/lib/Term/ReadLine.pm b/dist/Term-ReadLine/lib/Term/ReadLine.pm
index aead1cc..32e0824 100644
--- a/dist/Term-ReadLine/lib/Term/ReadLine.pm
+++ b/dist/Term-ReadLine/lib/Term/ReadLine.pm
@@ -111,9 +111,12 @@ additional methods:
=item C<tkRunning>
-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.
+makes Tk's event loop run when waiting for user input (i.e., during
+the C<readline> method).
+
+Term::ReadLine supports any event loop, including unpubished ones and
+simple IO::Select loops without the need to rewrite existing code for
+any particular framework. See IN(), print_prompt(), and get_line().
=item C<ornaments>
@@ -128,11 +131,59 @@ standout, last two to make the input line standout.
takes two arguments which are input filehandle and output filehandle.
Switches to use these filehandles.
+=item C<print_prompt>
+
+prints a prompt and returns immediately. readline() uses it to print
+its prompt before calling get_line(). See L</"Using Event Loops"> for
+an example of its use.
+
+=item C<get_line>
+
+gets a line of input from the terminal. If Tk is used and tkRunning()
+has been set, then get_line() will dispatch Tk events while waiting
+for a line of input. The full readline() API is a print_prompt() call
+followed immediately by get_input(). See L</"Using Event Loops">.
+
=back
One can check whether the currently loaded ReadLine package supports
these methods by checking for corresponding C<Features>.
+=head1 Using Event Loops
+
+Term::ReadLine provides IN(), print_prompt(), and get_line() so that
+it may be used by any event loop that can watch for input on a file
+handle. This includes most event loops including ones that haven't
+been published.
+
+Term::ReadLine's readline() method prints a prompt and returns a line
+of input got from its input filehandle:
+
+ sub readline {
+ my ($self,$prompt) = @_;
+ $self->print_prompt($prompt);
+ $self->get_line();
+ }
+
+A Tk readline function may be implemented by having Tk dispatch its
+own events between the time the prompt is printed and the line is got.
+This example function dispatches Tk events while Term::ReadLine waits
+for console input. It can completely replace Term::ReadLine's
+existing Tk support.
+
+ sub tk_read_line {
+ my ($term, $prompt) = @_;
+ $term->print_prompt($prompt);
+
+ my $got_input;
+ Tk->fileevent($term->IN, 'readable', sub { $got_input = 1 });
+ Tk::DoOneEvent(0) until $got_input;
+
+ return $term->get_line();
+ }
+
+Other event loops are equally possible.
+
=head1 EXPORTS
None
@@ -168,25 +219,17 @@ $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 print_prompt {
+ my ($self, $prompt) = @_;
+ my $out = $self->[1];
+ print $out $rl_term_set[0], $prompt, $rl_term_set[1], $rl_term_set[2];
+}
sub ReadLine {'Term::ReadLine::Stub'}
sub readline {
- my $self = shift;
- my ($in,$out,$str) = @$self;
- 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;
- #$str = scalar <$in>;
- $str = $self->get_line;
- 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;
- $str;
+ my ($self,$prompt) = @_;
+ $self->print_prompt($prompt);
+ $self->get_line();
}
sub addhistory {}
@@ -359,70 +402,56 @@ sub ornaments {
package Term::ReadLine::Tk;
-# 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});
- };
-
-}
+# This package inserts a Tk->fileevent() before the diamond operator.
+# The Tk watcher dispatches Tk events until the filehandle returned by
+# the$term->IN() accessor becomes ready for reading. It's assumed
+# that the diamond operator will return a line of input immediately at
+# that point.
+#
+# Any event loop can use $term-IN() and $term->readline() directly
+# without adding code for any event loop specifically to this.
+
+my ($giveup);
+
+# maybe in the future the Tk-specific aspects will be removed.
+sub Tk_loop{
+ Tk::DoOneEvent(0) until $giveup;
+ $giveup = 0;
+};
+
+sub register_Tk {
+ my $self = shift;
+ $Term::ReadLine::registered++
+ or Tk->fileevent($self->IN,'readable',sub { $giveup = 1});
+};
sub tkRunning {
$Term::ReadLine::toloop = $_[1] if @_ > 1;
$Term::ReadLine::toloop;
}
-sub get_c {
- my $self = shift;
- $self->Tk_loop if $Term::ReadLine::toloop;
- return getc $self->IN;
-}
+sub PERL_UNICODE_STDIN () { 0x0001 }
sub get_line {
my $self = shift;
- $self->Tk_loop if $Term::ReadLine::toloop;
- my $in = $self->IN;
+ my ($in,$out,$str) = @$self;
+
+ if ($Term::ReadLine::toloop) {
+ $self->register_Tk if not $Term::ReadLine::registered;
+ $self->Tk_loop;
+ }
+
local ($/) = "\n";
- return scalar <$in>;
+ $str = <$in>;
+
+ 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;
+
+ $str;
}
1;
diff --git a/dist/Term-ReadLine/t/AE.t b/dist/Term-ReadLine/t/AE.t
deleted file mode 100644
index d0515dc..0000000
--- a/dist/Term-ReadLine/t/AE.t
+++ /dev/null
@@ -1,33 +0,0 @@
-#!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
deleted file mode 100644
index 9546a8c..0000000
--- a/dist/Term-ReadLine/t/AETk.t
+++ /dev/null
@@ -1,42 +0,0 @@
-#!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/TkExternal.t b/dist/Term-ReadLine/t/TkExternal.t
new file mode 100644
index 0000000..7c4cf69
--- /dev/null
+++ b/dist/Term-ReadLine/t/TkExternal.t
@@ -0,0 +1,59 @@
+#!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');
+
+# This test will dispatch Tk events externally.
+$t->tkRunning(0);
+
+my $text = 'some text';
+my $T = $text . "\n";
+
+my $w = Tk::after($mw,0,
+ sub {
+ pass("Event loop called");
+ exit 0;
+ });
+
+my $result = tk_readline($t, 'Do not press enter>');
+fail("Should not get here.");
+
+# A Tk-dispatching readline that doesn't require Tk (or any other
+# event loop) support to be hard-coded into Term::ReadLine.
+
+sub tk_readline {
+ my ($term, $prompt) = @_;
+
+ $term->print_prompt($prompt);
+
+ my $got_input;
+ Tk->fileevent($term->IN, 'readable', sub { $got_input = 1 });
+ Tk::DoOneEvent(0) until $got_input;
+
+ return $term->get_line();
+}
|
From @cpansproutOn Sat Feb 18 21:33:01 2012, rcaputo wrote:
I would very much like to see this in 5.15.8, but unfortunately I am -- Father Chrysostomos |
From [Unknown Contact. See original ticket]Thanks, applied as fc013e9 with some subsequent manifest fixups. |
@rjbs - Status changed from 'open' to 'resolved' |
From @CorionAm 19.02.2012 07:47, schrieb Father Chrysostomos via RT:
Thanks, applied (with small whitespace editing) as Unfortunately, I didn't apply the patch through `git am` but through -max |
From darin.mcbride@shaw.caOn Sunday February 19 2012 7:10:08 AM you wrote:
I'm wondering if anyone actually tested this with the example programs I #!/usr/bin/perl use strict; use EV; my $esc; my $t = 0; sub tk_read_line { my $x = tk_read_line($term,'> '); This doesn't show the prompt. The text I type is in normal font (T::RL::P That's because you're bypassing the mechanisms that the underlying Instead, providing a way to override the get_line and get_c functions (it must |
@rjbs - Status changed from 'resolved' to 'open' |
From darin.mcbride@shaw.caOne more attempt. This is tested against ::Perl and ::Gnu and ::Stub, more This is against blead. Thanks, Corion, for the help in IRC getting it as a The usage is entirely different than Rocco's patch because it didn't work with After this actually gets accepted and the dust settles, I will likely open |
From darin.mcbride@shaw.caae.patchdiff --git a/dist/Term-ReadLine/lib/Term/ReadLine.pm b/dist/Term-ReadLine/lib/Term/ReadLine.pm
index 7262596..3cf4bd4 100644
--- a/dist/Term-ReadLine/lib/Term/ReadLine.pm
+++ b/dist/Term-ReadLine/lib/Term/ReadLine.pm
@@ -111,12 +111,38 @@ additional methods:
=item C<tkRunning>
-makes Tk's event loop run when waiting for user input (i.e., during
-the C<readline> method).
+makes Tk event loop run when waiting for user input (i.e., during
+C<readline> method).
-Term::ReadLine supports any event loop, including unpubished ones and
-simple IO::Select loops without the need to rewrite existing code for
-any particular framework. See IN(), print_prompt(), and get_line().
+=item C<event_loop>
+
+Registers call-backs to wait for user input (i.e., during C<readline>
+method). This supercedes tkRunning.
+
+The first call-back registered is the call back for waiting. It is
+expected that the callback will call the current event loop until
+there is something waiting to get on the input filehandle.
+
+The second call-back registered is the call back for registration. The
+input filehandle (often STDIN, but not necessarily) will be passed in.
+
+For example, with AnyEvent:
+
+ my ($cv, $fe);
+ $term->event_loop(sub {
+ $cv = AE::cv();
+ $cv->recv();
+ }, sub {
+ my $fh = shift;
+ $fe ||= AE::io($fh, 0, sub { $cv->send() });
+ });
+
+Note that $fe must not go out of scope while $term is still in scope,
+or the io watcher will terminate. Similar concerns may exist for other
+event loops.
+
+The second call-back is optional if you register your callback prior to
+the call to $term-E<gt>readline.
=item C<ornaments>
@@ -131,59 +157,11 @@ standout, last two to make the input line standout.
takes two arguments which are input filehandle and output filehandle.
Switches to use these filehandles.
-=item C<print_prompt>
-
-prints a prompt and returns immediately. readline() uses it to print
-its prompt before calling get_line(). See L</"Using Event Loops"> for
-an example of its use.
-
-=item C<get_line>
-
-gets a line of input from the terminal. If Tk is used and tkRunning()
-has been set, then get_line() will dispatch Tk events while waiting
-for a line of input. The full readline() API is a print_prompt() call
-followed immediately by get_input(). See L</"Using Event Loops">.
-
=back
One can check whether the currently loaded ReadLine package supports
these methods by checking for corresponding C<Features>.
-=head1 Using Event Loops
-
-Term::ReadLine provides IN(), print_prompt(), and get_line() so that
-it may be used by any event loop that can watch for input on a file
-handle. This includes most event loops including ones that haven't
-been published.
-
-Term::ReadLine's readline() method prints a prompt and returns a line
-of input got from its input filehandle:
-
- sub readline {
- my ($self,$prompt) = @_;
- $self->print_prompt($prompt);
- $self->get_line();
- }
-
-A Tk readline function may be implemented by having Tk dispatch its
-own events between the time the prompt is printed and the line is got.
-This example function dispatches Tk events while Term::ReadLine waits
-for console input. It can completely replace Term::ReadLine's
-existing Tk support.
-
- sub tk_read_line {
- my ($term, $prompt) = @_;
- $term->print_prompt($prompt);
-
- my $got_input;
- Tk->fileevent($term->IN, 'readable', sub { $got_input = 1 });
- Tk::DoOneEvent(0) until $got_input;
-
- return $term->get_line();
- }
-
-Other event loops are equally possible.
-
=head1 EXPORTS
None
@@ -219,17 +197,25 @@ $DB::emacs = $DB::emacs; # To peacify -w
our @rl_term_set;
*rl_term_set = \@Term::ReadLine::TermCap::rl_term_set;
-sub print_prompt {
- my ($self, $prompt) = @_;
- my $out = $self->[1];
- print $out $rl_term_set[0], $prompt, $rl_term_set[1], $rl_term_set[2];
-}
+sub PERL_UNICODE_STDIN () { 0x0001 }
sub ReadLine {'Term::ReadLine::Stub'}
sub readline {
- my ($self,$prompt) = @_;
- $self->print_prompt($prompt);
- $self->get_line();
+ my $self = shift;
+ my ($in,$out,$str) = @$self;
+ 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;
+ #$str = scalar <$in>;
+ $str = $self->get_line;
+ 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;
+ $str;
}
sub addhistory {}
@@ -407,22 +393,35 @@ package Term::ReadLine::Tk;
# the$term->IN() accessor becomes ready for reading. It's assumed
# that the diamond operator will return a line of input immediately at
# that point.
-#
-# Any event loop can use $term-IN() and $term->readline() directly
-# without adding code for any event loop specifically to this.
my ($giveup);
# maybe in the future the Tk-specific aspects will be removed.
sub Tk_loop{
- Tk::DoOneEvent(0) until $giveup;
- $giveup = 0;
+ if (ref $Term::ReadLine::toloop)
+ {
+ $Term::ReadLine::toloop->[0]->();
+ }
+ else
+ {
+ Tk::DoOneEvent(0) until $giveup;
+ $giveup = 0;
+ }
};
sub register_Tk {
my $self = shift;
- $Term::ReadLine::registered++
- or Tk->fileevent($self->IN,'readable',sub { $giveup = 1});
+ unless ($Term::ReadLine::registered++)
+ {
+ if (ref $Term::ReadLine::toloop)
+ {
+ $Term::ReadLine::toloop->[1]->($self->IN) if $Term::ReadLine::toloop->[1];
+ }
+ else
+ {
+ Tk->fileevent($self->IN,'readable',sub { $giveup = 1});
+ }
+ }
};
sub tkRunning {
@@ -430,6 +429,25 @@ sub tkRunning {
$Term::ReadLine::toloop;
}
+sub event_loop {
+ shift;
+
+ # T::RL::Gnu and T::RL::Perl check that this exists, if not,
+ # it doesn't call the loop. Those modules will need to be
+ # fixed before this can be removed.
+ if (not defined &Tk::DoOneEvent)
+ {
+ *Tk::DoOneEvent = sub {
+ die "what?"; # this shouldn't be called.
+ }
+ }
+
+ # store the callback in toloop, again so that other modules will
+ # recognise it and call us for the loop.
+ $Term::ReadLine::toloop = [ @_ ] if @_ > 1;
+ $Term::ReadLine::toloop;
+}
+
sub PERL_UNICODE_STDIN () { 0x0001 }
sub get_line {
diff --git a/dist/Term-ReadLine/t/AE.t b/dist/Term-ReadLine/t/AE.t
new file mode 100644
index 0000000..8fccecb
--- /dev/null
+++ b/dist/Term-ReadLine/t/AE.t
@@ -0,0 +1,43 @@
+#!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');
+
+my ($cv, $fe);
+$t->event_loop(
+ sub {
+ $cv = AE::cv();
+ $cv->recv();
+ }, sub {
+ my $fh = shift;
+ $fe ||= AE::io($fh, 0, sub { $cv->send() });
+ }
+ );
+
+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 0000000..80bab63
--- /dev/null
+++ b/dist/Term-ReadLine/t/AETk.t
@@ -0,0 +1,52 @@
+#!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');
+my ($cv, $fe);
+$t->event_loop(
+ sub {
+ $cv = AE::cv();
+ $cv->recv();
+ }, sub {
+ my $fh = shift;
+ $fe ||= AE::io($fh, 0, sub { $cv->send() });
+ }
+ );
+
+
+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/TkExternal.t b/dist/Term-ReadLine/t/TkExternal.t
deleted file mode 100644
index 7c4cf69..0000000
--- a/dist/Term-ReadLine/t/TkExternal.t
+++ /dev/null
@@ -1,59 +0,0 @@
-#!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');
-
-# This test will dispatch Tk events externally.
-$t->tkRunning(0);
-
-my $text = 'some text';
-my $T = $text . "\n";
-
-my $w = Tk::after($mw,0,
- sub {
- pass("Event loop called");
- exit 0;
- });
-
-my $result = tk_readline($t, 'Do not press enter>');
-fail("Should not get here.");
-
-# A Tk-dispatching readline that doesn't require Tk (or any other
-# event loop) support to be hard-coded into Term::ReadLine.
-
-sub tk_readline {
- my ($term, $prompt) = @_;
-
- $term->print_prompt($prompt);
-
- my $got_input;
- Tk->fileevent($term->IN, 'readable', sub { $got_input = 1 });
- Tk::DoOneEvent(0) until $got_input;
-
- return $term->get_line();
-}
|
From @dmcbrideI hope this is the last one. This is still a patch against blead. It I plan on publishing a separate CPAN distribution with no (or little) real |
From @dmcbridefull.patchdiff --git a/dist/Term-ReadLine/lib/Term/ReadLine.pm b/dist/Term-ReadLine/lib/Term/ReadLine.pm
index 7262596..cb463a7 100644
--- a/dist/Term-ReadLine/lib/Term/ReadLine.pm
+++ b/dist/Term-ReadLine/lib/Term/ReadLine.pm
@@ -111,12 +111,48 @@ additional methods:
=item C<tkRunning>
-makes Tk's event loop run when waiting for user input (i.e., during
-the C<readline> method).
+makes Tk event loop run when waiting for user input (i.e., during
+C<readline> method).
-Term::ReadLine supports any event loop, including unpubished ones and
-simple IO::Select loops without the need to rewrite existing code for
-any particular framework. See IN(), print_prompt(), and get_line().
+=item C<event_loop>
+
+Registers call-backs to wait for user input (i.e., during C<readline>
+method). This supercedes tkRunning.
+
+The first call-back registered is the call back for waiting. It is
+expected that the callback will call the current event loop until
+there is something waiting to get on the input filehandle. The parameter
+passed in is the return value of the second call back.
+
+The second call-back registered is the call back for registration. The
+input filehandle (often STDIN, but not necessarily) will be passed in.
+
+For example, with AnyEvent:
+
+ $term->event_loop(sub {
+ my $data = shift;
+ $data->[1] = AE::cv();
+ $data->[1]->recv();
+ }, sub {
+ my $fh = shift;
+ my $data = [];
+ $data->[0] = AE::io($fh, 0, sub { $data->[1]->send() });
+ $data;
+ });
+
+The second call-back is optional if the call back is registered prior to
+the call to $term-E<gt>readline.
+
+Deregistration is done in this case by calling event_loop with C<undef>
+as its parameter:
+
+ $term->event_loop(undef);
+
+This will cause the data array ref to be removed, allowing normal garbage
+collection to clean it up. With AnyEvent, that will cause $data->[0] to
+be cleaned up, and AnyEvent will automatically cancel the watcher at that
+time. If another loop requires more than that to clean up a file watcher,
+that will be up to the caller to handle.
=item C<ornaments>
@@ -131,59 +167,11 @@ standout, last two to make the input line standout.
takes two arguments which are input filehandle and output filehandle.
Switches to use these filehandles.
-=item C<print_prompt>
-
-prints a prompt and returns immediately. readline() uses it to print
-its prompt before calling get_line(). See L</"Using Event Loops"> for
-an example of its use.
-
-=item C<get_line>
-
-gets a line of input from the terminal. If Tk is used and tkRunning()
-has been set, then get_line() will dispatch Tk events while waiting
-for a line of input. The full readline() API is a print_prompt() call
-followed immediately by get_input(). See L</"Using Event Loops">.
-
=back
One can check whether the currently loaded ReadLine package supports
these methods by checking for corresponding C<Features>.
-=head1 Using Event Loops
-
-Term::ReadLine provides IN(), print_prompt(), and get_line() so that
-it may be used by any event loop that can watch for input on a file
-handle. This includes most event loops including ones that haven't
-been published.
-
-Term::ReadLine's readline() method prints a prompt and returns a line
-of input got from its input filehandle:
-
- sub readline {
- my ($self,$prompt) = @_;
- $self->print_prompt($prompt);
- $self->get_line();
- }
-
-A Tk readline function may be implemented by having Tk dispatch its
-own events between the time the prompt is printed and the line is got.
-This example function dispatches Tk events while Term::ReadLine waits
-for console input. It can completely replace Term::ReadLine's
-existing Tk support.
-
- sub tk_read_line {
- my ($term, $prompt) = @_;
- $term->print_prompt($prompt);
-
- my $got_input;
- Tk->fileevent($term->IN, 'readable', sub { $got_input = 1 });
- Tk::DoOneEvent(0) until $got_input;
-
- return $term->get_line();
- }
-
-Other event loops are equally possible.
-
=head1 EXPORTS
None
@@ -219,17 +207,25 @@ $DB::emacs = $DB::emacs; # To peacify -w
our @rl_term_set;
*rl_term_set = \@Term::ReadLine::TermCap::rl_term_set;
-sub print_prompt {
- my ($self, $prompt) = @_;
- my $out = $self->[1];
- print $out $rl_term_set[0], $prompt, $rl_term_set[1], $rl_term_set[2];
-}
+sub PERL_UNICODE_STDIN () { 0x0001 }
sub ReadLine {'Term::ReadLine::Stub'}
sub readline {
- my ($self,$prompt) = @_;
- $self->print_prompt($prompt);
- $self->get_line();
+ my $self = shift;
+ my ($in,$out,$str) = @$self;
+ 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;
+ #$str = scalar <$in>;
+ $str = $self->get_line;
+ 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;
+ $str;
}
sub addhistory {}
@@ -407,22 +403,35 @@ package Term::ReadLine::Tk;
# the$term->IN() accessor becomes ready for reading. It's assumed
# that the diamond operator will return a line of input immediately at
# that point.
-#
-# Any event loop can use $term-IN() and $term->readline() directly
-# without adding code for any event loop specifically to this.
my ($giveup);
# maybe in the future the Tk-specific aspects will be removed.
sub Tk_loop{
- Tk::DoOneEvent(0) until $giveup;
- $giveup = 0;
+ if (ref $Term::ReadLine::toloop)
+ {
+ $Term::ReadLine::toloop->[0]->($Term::ReadLine::toloop->[2]);
+ }
+ else
+ {
+ Tk::DoOneEvent(0) until $giveup;
+ $giveup = 0;
+ }
};
sub register_Tk {
my $self = shift;
- $Term::ReadLine::registered++
- or Tk->fileevent($self->IN,'readable',sub { $giveup = 1});
+ unless ($Term::ReadLine::registered++)
+ {
+ if (ref $Term::ReadLine::toloop)
+ {
+ $Term::ReadLine::toloop->[2] = $Term::ReadLine::toloop->[1]->($self->IN) if $Term::ReadLine::toloop->[1];
+ }
+ else
+ {
+ Tk->fileevent($self->IN,'readable',sub { $giveup = 1});
+ }
+ }
};
sub tkRunning {
@@ -430,6 +439,25 @@ sub tkRunning {
$Term::ReadLine::toloop;
}
+sub event_loop {
+ shift;
+
+ # T::RL::Gnu and T::RL::Perl check that this exists, if not,
+ # it doesn't call the loop. Those modules will need to be
+ # fixed before this can be removed.
+ if (not defined &Tk::DoOneEvent)
+ {
+ *Tk::DoOneEvent = sub {
+ die "what?"; # this shouldn't be called.
+ }
+ }
+
+ # store the callback in toloop, again so that other modules will
+ # recognise it and call us for the loop.
+ $Term::ReadLine::toloop = [ @_ ] if @_ > 1;
+ $Term::ReadLine::toloop;
+}
+
sub PERL_UNICODE_STDIN () { 0x0001 }
sub get_line {
diff --git a/dist/Term-ReadLine/t/AE.t b/dist/Term-ReadLine/t/AE.t
new file mode 100644
index 0000000..8fccecb
--- /dev/null
+++ b/dist/Term-ReadLine/t/AE.t
@@ -0,0 +1,43 @@
+#!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');
+
+my ($cv, $fe);
+$t->event_loop(
+ sub {
+ $cv = AE::cv();
+ $cv->recv();
+ }, sub {
+ my $fh = shift;
+ $fe ||= AE::io($fh, 0, sub { $cv->send() });
+ }
+ );
+
+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 0000000..80bab63
--- /dev/null
+++ b/dist/Term-ReadLine/t/AETk.t
@@ -0,0 +1,52 @@
+#!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');
+my ($cv, $fe);
+$t->event_loop(
+ sub {
+ $cv = AE::cv();
+ $cv->recv();
+ }, sub {
+ my $fh = shift;
+ $fe ||= AE::io($fh, 0, sub { $cv->send() });
+ }
+ );
+
+
+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/TkExternal.t b/dist/Term-ReadLine/t/TkExternal.t
deleted file mode 100644
index 7c4cf69..0000000
--- a/dist/Term-ReadLine/t/TkExternal.t
+++ /dev/null
@@ -1,59 +0,0 @@
-#!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');
-
-# This test will dispatch Tk events externally.
-$t->tkRunning(0);
-
-my $text = 'some text';
-my $T = $text . "\n";
-
-my $w = Tk::after($mw,0,
- sub {
- pass("Event loop called");
- exit 0;
- });
-
-my $result = tk_readline($t, 'Do not press enter>');
-fail("Should not get here.");
-
-# A Tk-dispatching readline that doesn't require Tk (or any other
-# event loop) support to be hard-coded into Term::ReadLine.
-
-sub tk_readline {
- my ($term, $prompt) = @_;
-
- $term->print_prompt($prompt);
-
- my $got_input;
- Tk->fileevent($term->IN, 'readable', sub { $got_input = 1 });
- Tk::DoOneEvent(0) until $got_input;
-
- return $term->get_line();
-}
|
From @rjbsThis is now in smoke-me/rjbs/readline-loop before merging. |
From @rjbsThis has been smoked, bugfixed, and merged, and everyone involved seems happy. Darin is |
From [Unknown Contact. See original ticket]This has been smoked, bugfixed, and merged, and everyone involved seems happy. Darin is |
@rjbs - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#108470 (status was 'resolved')
Searchable as RT108470$
The text was updated successfully, but these errors were encountered: