develooper Front page | perl.perl5.porters | Postings from January 2012

[perl #108470] Term::ReadLine should use AE instead of Tk for event looping

From:
Darin McBride
Date:
January 17, 2012 23:59
Subject:
[perl #108470] Term::ReadLine should use AE instead of Tk for event looping
Message ID:
rt-3.6.HEAD-14510-1326832058-201.108470-75-0@perl.org
# New Ticket Created by  Darin McBride 
# Please include the string:  [perl #108470]
# in the subject line of all future correspondence about this issue. 
# <URL: https://rt.perl.org:443/rt3/Ticket/Display.html?id=108470 >



This is a bug report for perl from darin.mcbride@shaw.ca,
generated with the help of perlbug 1.39 running under perl 5.12.4.


-----------------------------------------------------------------
[Please describe your issue here]

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.

The only downside of this patch is that users currently using TRL with Tk
will need to install AE, too.

diff -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 = \&register_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>;
Only in Term-ReadLine-1.07/blib/man3: Term::ReadLine.3pm
diff -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 = \&register_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>;



[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
    category=library
    severity=wishlist
    module=Term::ReadLine
---
Site configuration information for perl 5.12.4:

Configured by Gentoo at Wed Sep 28 07:02:37 MDT 2011.

Summary of my perl5 (revision 5 version 12 subversion 4) configuration:
   
  Platform:
    osname=linux, osvers=2.6.39-gentoo-r3, archname=x86_64-linux-thread-multi
    uname='linux naboo 2.6.39-gentoo-r3 #1 smp sun jul 17 07:13:38 mdt 2011 x86_64 intel(r) core(tm) i7 cpu 930 @ 2.80ghz genuineintel gnulinux '
    config_args='-des -Duseshrplib -Darchname=x86_64-linux-thread -Dcc=x86_64-pc-linux-gnu-gcc -Doptimize=-O3 -pipe -march=core2 -Dldflags=-Wl,-O1 -Wl,--as-needed -Dprefix=/usr -Dsiteprefix=/usr -Dvendorprefix=/usr -Dscriptdir=/usr/bin -Dprivlib=/usr/lib64/perl5/5.12.4 -Darchlib=/usr/lib64/perl5/5.12.4/x86_64-linux-thread-multi -Dsitelib=/usr/lib64/perl5/site_perl/5.12.4 -Dsitearch=/usr/lib64/perl5/site_perl/5.12.4/x86_64-linux-thread-multi -Dvendorlib=/usr/lib64/perl5/vendor_perl/5.12.4 -Dvendorarch=/usr/lib64/perl5/vendor_perl/5.12.4/x86_64-linux-thread-multi -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dsiteman1dir=/usr/share/man/man1 -Dsiteman3dir=/usr/share/man/man3 -Dvendorman1dir=/usr/share/man/man1 -Dvendorman3dir=/usr/share/man/man3 -Dman1ext=1 -Dman3ext=3pm -Dlibperl=libperl.so.5.12.4 -Dlocincpth=  -Duselargefiles -Dd_semctl_semun -Dcf_by=Gentoo -Dmyhostname=localhost -Dperladmin=root@localhost -Dinstallusrbinperl=n -Ud_csh -Uusenm -Di_ndbm -Di_gdbm 
 -Di_db -Dusethreads -DDEBUGGING=none -Dinc_version_list=5.12.3/x86_64-linux-thread-multi 5.12.3 5.12.2/x86_64-linux-thread-multi 5.12.2 5.12.1/x86_64-linux-thread-multi 5.12.1 5.12.0/x86_64-linux-thread-multi 5.12.0  -Dlibpth=/usr/local/lib64 /lib64 /usr/lib64'
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=define, usemultiplicity=define
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=define, use64bitall=define, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='x86_64-pc-linux-gnu-gcc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -fno-strict-aliasing -pipe -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O3 -pipe -march=core2',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -fno-strict-aliasing -pipe'
    ccversion='', gccversion='4.5.3', gccosandvers=''
    intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='x86_64-pc-linux-gnu-gcc', ldflags ='-Wl,-O1 -Wl,--as-needed'
    libpth=/usr/local/lib64 /lib64 /usr/lib64
    libs=-lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lpthread -lc -lgdbm_compat
    perllibs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
    libc=/lib/libc-2.12.2.so, so=so, useshrplib=true, libperl=libperl.so.5.12.4
    gnulibc_version='2.12.2'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
    cccdlflags='-fPIC', lddlflags='-shared -O3 -pipe -march=core2 -Wl,-O1 -Wl,--as-needed'

Locally applied patches:
    0001-gentoo_MakeMaker-RUNPATH.diff
    0002-gentoo_config_over.diff
    0003-gentoo_cpan_definstalldirs.diff
    0004-gentoo_cpanplus_definstalldirs.diff
    0005-gentoo_create-libperl-soname.diff
    0006-gentoo_MakeMaker-delete_packlist.diff
    0007-fixes_8d66b3f9_h2hp_fix.diff
    0008-fixes_f178b03b_h2ph_using_deprecated_goto.diff
    0009-gentoo_mod-paths.diff
    0010-gentoo_enc2xs.diff
    0011-gentoo_IO-Compress_AutoLoader_dropped_from_Compress-Zlib.diff
    0012-gentoo_drop-fstack-protector.diff

---
@INC for perl 5.12.4:
    /etc/perl
    /usr/lib64/perl5/site_perl/5.12.4/x86_64-linux-thread-multi
    /usr/lib64/perl5/site_perl/5.12.4
    /usr/lib64/perl5/vendor_perl/5.12.4/x86_64-linux-thread-multi
    /usr/lib64/perl5/vendor_perl/5.12.4
    /usr/lib64/perl5/site_perl/5.12.3/x86_64-linux-thread-multi
    /usr/lib64/perl5/site_perl/5.12.3
    /usr/lib64/perl5/site_perl/5.12.2/x86_64-linux-thread-multi
    /usr/lib64/perl5/site_perl/5.12.2
    /usr/lib64/perl5/site_perl
    /usr/lib64/perl5/vendor_perl/5.12.3/x86_64-linux-thread-multi
    /usr/lib64/perl5/vendor_perl/5.12.3
    /usr/lib64/perl5/vendor_perl/5.12.2/x86_64-linux-thread-multi
    /usr/lib64/perl5/vendor_perl/5.12.2
    /usr/lib64/perl5/vendor_perl
    /usr/lib64/perl5/5.12.4/x86_64-linux-thread-multi
    /usr/lib64/perl5/5.12.4
    /usr/local/lib/site_perl
    .

---
Environment for perl 5.12.4:
    HOME=/home/dmcbride
    LANG=en_US.utf8
    LANGUAGE=
    LC_ALL=en_US.utf8
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/usr/local/bin:/home/dmcbride/bin:/usr/lib/distcc/bin:/usr/bin:/bin:/opt/bin:/usr/x86_64-pc-linux-gnu/i686-pc-linux-gnu/gcc-bin/4.5.3:/usr/x86_64-pc-linux-gnu/gcc-bin/4.5.3:/share/cvs/bin:/usr/games/bin:/share/bin:/share/darin/bin:/share/cvs/work/shared
    PERL5LIB (unset)
    PERL_BADLANG (unset)
    SHELL=/bin/bash




nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About