r34213 - in /trunk/libanyevent-perl: ./ debian/ lib/ lib/AnyEvent/ lib/AnyEvent/Impl/
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Mon Apr 27 16:02:45 UTC 2009
Author: gregoa
Date: Mon Apr 27 16:02:39 2009
New Revision: 34213
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=34213
Log:
New upstream release.
Modified:
trunk/libanyevent-perl/Changes
trunk/libanyevent-perl/META.yml
trunk/libanyevent-perl/README
trunk/libanyevent-perl/debian/changelog
trunk/libanyevent-perl/lib/AnyEvent.pm
trunk/libanyevent-perl/lib/AnyEvent/DNS.pm
trunk/libanyevent-perl/lib/AnyEvent/Handle.pm
trunk/libanyevent-perl/lib/AnyEvent/Impl/EV.pm
trunk/libanyevent-perl/lib/AnyEvent/Impl/Event.pm
trunk/libanyevent-perl/lib/AnyEvent/Impl/EventLib.pm
trunk/libanyevent-perl/lib/AnyEvent/Impl/Glib.pm
trunk/libanyevent-perl/lib/AnyEvent/Impl/POE.pm
trunk/libanyevent-perl/lib/AnyEvent/Impl/Perl.pm
trunk/libanyevent-perl/lib/AnyEvent/Impl/Qt.pm
trunk/libanyevent-perl/lib/AnyEvent/Impl/Tk.pm
trunk/libanyevent-perl/lib/AnyEvent/Socket.pm
trunk/libanyevent-perl/lib/AnyEvent/Strict.pm
trunk/libanyevent-perl/lib/AnyEvent/Util.pm
Modified: trunk/libanyevent-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-perl/Changes?rev=34213&op=diff
==============================================================================
--- trunk/libanyevent-perl/Changes (original)
+++ trunk/libanyevent-perl/Changes Mon Apr 27 16:02:39 2009
@@ -1,4 +1,14 @@
Revision history for Perl extension AnyEvent.
+
+4.4 Sun Apr 26 20:12:33 CEST 2009
+ - implemented idle watchers, where applicable.
+ - AnyEvent->time died when Event backend was in use.
+ - fix a memleak in the Tk backend.
+ - sped up Tk timer handling.
+ - clip negative "after" values to 0 in AnyEvent::Impl::Event
+ to avoid spamming out warning messages.
+ - fix Qt timers without interval.
+ - avoid Qt zero-timeout specialcase, in old libqt's.
4.352 Mon Apr 20 16:31:11 CEST 2009
- fix AnyEvent::Strict error messages for child watchers.
Modified: trunk/libanyevent-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-perl/META.yml?rev=34213&op=diff
==============================================================================
--- trunk/libanyevent-perl/META.yml (original)
+++ trunk/libanyevent-perl/META.yml Mon Apr 27 16:02:39 2009
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: AnyEvent
-version: 4.352
+version: 4.4
abstract: ~
author: []
license: unknown
Modified: trunk/libanyevent-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-perl/README?rev=34213&op=diff
==============================================================================
--- trunk/libanyevent-perl/README (original)
+++ trunk/libanyevent-perl/README Mon Apr 27 16:02:39 2009
@@ -7,20 +7,27 @@
SYNOPSIS
use AnyEvent;
- my $w = AnyEvent->io (fh => $fh, poll => "r|w", cb => sub { ... });
-
+ # file descriptor readable
+ my $w = AnyEvent->io (fh => $fh, poll => "r", cb => sub { ... });
+
+ # one-shot or repeating timers
my $w = AnyEvent->timer (after => $seconds, cb => sub { ... });
my $w = AnyEvent->timer (after => $seconds, interval => $seconds, cb => ...
print AnyEvent->now; # prints current event loop time
print AnyEvent->time; # think Time::HiRes::time or simply CORE::time.
+ # POSIX signal
my $w = AnyEvent->signal (signal => "TERM", cb => sub { ... });
+ # child process exit
my $w = AnyEvent->child (pid => $pid, cb => sub {
my ($pid, $status) = @_;
...
});
+
+ # called when event loop idle (if applicable)
+ my $w = AnyEvent->idle (cb => sub { ... });
my $w = AnyEvent->condvar; # stores whether a condition was flagged
$w->send; # wake up current and all future recv's
@@ -402,6 +409,40 @@
# do something else, then wait for process exit
$done->recv;
+ IDLE WATCHERS
+ Sometimes there is a need to do something, but it is not so important to
+ do it instantly, but only when there is nothing better to do. This
+ "nothing better to do" is usually defined to be "no other events need
+ attention by the event loop".
+
+ Idle watchers ideally get invoked when the event loop has nothing better
+ to do, just before it would block the process to wait for new events.
+ Instead of blocking, the idle watcher is invoked.
+
+ Most event loops unfortunately do not really support idle watchers (only
+ EV, Event and Glib do it in a usable fashion) - for the rest, AnyEvent
+ will simply call the callback "from time to time".
+
+ Example: read lines from STDIN, but only process them when the program
+ is otherwise idle:
+
+ my @lines; # read data
+ my $idle_w;
+ my $io_w = AnyEvent->io (fh => \*STDIN, poll => 'r', cb => sub {
+ push @lines, scalar <STDIN>;
+
+ # start an idle watcher, if not already done
+ $idle_w ||= AnyEvent->idle (cb => sub {
+ # handle only one line, when there are lines left
+ if (my $line = shift @lines) {
+ print "handled when idle: $line";
+ } else {
+ # otherwise disable the idle watcher again
+ undef $idle_w;
+ }
+ });
+ });
+
CONDITION VARIABLES
If you are familiar with some event loops you will know that all of them
require you to run some blocking "loop", "run" or similar function that
Modified: trunk/libanyevent-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-perl/debian/changelog?rev=34213&op=diff
==============================================================================
--- trunk/libanyevent-perl/debian/changelog (original)
+++ trunk/libanyevent-perl/debian/changelog Mon Apr 27 16:02:39 2009
@@ -1,3 +1,9 @@
+libanyevent-perl (4.400-1) UNRELEASED; urgency=low
+
+ * New upstream release.
+
+ -- gregor herrmann <gregoa at debian.org> Mon, 27 Apr 2009 18:01:43 +0200
+
libanyevent-perl (4.352-1) unstable; urgency=low
* New upstream release.
Modified: trunk/libanyevent-perl/lib/AnyEvent.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-perl/lib/AnyEvent.pm?rev=34213&op=diff
==============================================================================
--- trunk/libanyevent-perl/lib/AnyEvent.pm (original)
+++ trunk/libanyevent-perl/lib/AnyEvent.pm Mon Apr 27 16:02:39 2009
@@ -8,20 +8,27 @@
use AnyEvent;
- my $w = AnyEvent->io (fh => $fh, poll => "r|w", cb => sub { ... });
-
+ # file descriptor readable
+ my $w = AnyEvent->io (fh => $fh, poll => "r", cb => sub { ... });
+
+ # one-shot or repeating timers
my $w = AnyEvent->timer (after => $seconds, cb => sub { ... });
my $w = AnyEvent->timer (after => $seconds, interval => $seconds, cb => ...
print AnyEvent->now; # prints current event loop time
print AnyEvent->time; # think Time::HiRes::time or simply CORE::time.
+ # POSIX signal
my $w = AnyEvent->signal (signal => "TERM", cb => sub { ... });
+ # child process exit
my $w = AnyEvent->child (pid => $pid, cb => sub {
my ($pid, $status) = @_;
...
});
+
+ # called when event loop idle (if applicable)
+ my $w = AnyEvent->idle (cb => sub { ... });
my $w = AnyEvent->condvar; # stores whether a condition was flagged
$w->send; # wake up current and all future recv's
@@ -412,6 +419,41 @@
# do something else, then wait for process exit
$done->recv;
+=head2 IDLE WATCHERS
+
+Sometimes there is a need to do something, but it is not so important
+to do it instantly, but only when there is nothing better to do. This
+"nothing better to do" is usually defined to be "no other events need
+attention by the event loop".
+
+Idle watchers ideally get invoked when the event loop has nothing
+better to do, just before it would block the process to wait for new
+events. Instead of blocking, the idle watcher is invoked.
+
+Most event loops unfortunately do not really support idle watchers (only
+EV, Event and Glib do it in a usable fashion) - for the rest, AnyEvent
+will simply call the callback "from time to time".
+
+Example: read lines from STDIN, but only process them when the
+program is otherwise idle:
+
+ my @lines; # read data
+ my $idle_w;
+ my $io_w = AnyEvent->io (fh => \*STDIN, poll => 'r', cb => sub {
+ push @lines, scalar <STDIN>;
+
+ # start an idle watcher, if not already done
+ $idle_w ||= AnyEvent->idle (cb => sub {
+ # handle only one line, when there are lines left
+ if (my $line = shift @lines) {
+ print "handled when idle: $line";
+ } else {
+ # otherwise disable the idle watcher again
+ undef $idle_w;
+ }
+ });
+ });
+
=head2 CONDITION VARIABLES
If you are familiar with some event loops you will know that all of them
@@ -890,7 +932,7 @@
use Carp;
-our $VERSION = 4.352;
+our $VERSION = 4.4;
our $MODEL;
our $AUTOLOAD;
@@ -933,7 +975,7 @@
);
our %method = map +($_ => 1),
- qw(io timer time now now_update signal child condvar one_event DESTROY);
+ qw(io timer time now now_update signal child idle condvar one_event DESTROY);
our @post_detect;
@@ -948,12 +990,12 @@
push @post_detect, $cb;
defined wantarray
- ? bless \$cb, "AnyEvent::Util::PostDetect"
+ ? bless \$cb, "AnyEvent::Util::postdetect"
: ()
}
}
-sub AnyEvent::Util::PostDetect::DESTROY {
+sub AnyEvent::Util::postdetect::DESTROY {
@post_detect = grep $_ != ${$_[0]}, @post_detect;
}
@@ -1052,7 +1094,7 @@
# default implementations for many methods
BEGIN {
- if (eval "use Time::HiRes (); time (); 1") {
+ if (eval "use Time::HiRes (); Time::HiRes::time (); 1") {
*_time = \&Time::HiRes::time;
# if (eval "use POSIX (); (POSIX::times())...
} else {
@@ -1067,7 +1109,7 @@
# default implementation for ->condvar
sub condvar {
- bless { @_ == 3 ? (_ae_cb => $_[2]) : () }, AnyEvent::CondVar::
+ bless { @_ == 3 ? (_ae_cb => $_[2]) : () }, "AnyEvent::CondVar"
}
# default implementation for ->signal
@@ -1123,10 +1165,10 @@
undef $SIG_EV{$signal};
};
- bless [$signal, $arg{cb}], "AnyEvent::Base::Signal"
-}
-
-sub AnyEvent::Base::Signal::DESTROY {
+ bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
+}
+
+sub AnyEvent::Base::signal::DESTROY {
my ($signal, $cb) = @{$_[0]};
delete $SIG_CB{$signal}{$cb};
@@ -1177,16 +1219,52 @@
&_sigchld;
}
- bless [$pid, $arg{cb}], "AnyEvent::Base::Child"
-}
-
-sub AnyEvent::Base::Child::DESTROY {
+ bless [$pid, $arg{cb}], "AnyEvent::Base::child"
+}
+
+sub AnyEvent::Base::child::DESTROY {
my ($pid, $cb) = @{$_[0]};
delete $PID_CB{$pid}{$cb};
delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} };
undef $CHLD_W unless keys %PID_CB;
+}
+
+# idle emulation is done by simply using a timer, regardless
+# of whether the proces sis idle or not, and not letting
+# the callback use more than 50% of the time.
+sub idle {
+ my (undef, %arg) = @_;
+
+ my ($cb, $w, $rcb) = $arg{cb};
+
+ $rcb = sub {
+ if ($cb) {
+ $w = _time;
+ &$cb;
+ $w = _time - $w;
+
+ # never use more then 50% of the time for the idle watcher,
+ # within some limits
+ $w = 0.0001 if $w < 0.0001;
+ $w = 5 if $w > 5;
+
+ $w = AnyEvent->timer (after => $w, cb => $rcb);
+ } else {
+ # clean up...
+ undef $w;
+ undef $rcb;
+ }
+ };
+
+ $w = AnyEvent->timer (after => 0.05, cb => $rcb);
+
+ bless \\$cb, "AnyEvent::Base::idle"
+}
+
+sub AnyEvent::Base::idle::DESTROY {
+ undef $${$_[0]};
}
package AnyEvent::CondVar;
Modified: trunk/libanyevent-perl/lib/AnyEvent/DNS.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-perl/lib/AnyEvent/DNS.pm?rev=34213&op=diff
==============================================================================
--- trunk/libanyevent-perl/lib/AnyEvent/DNS.pm (original)
+++ trunk/libanyevent-perl/lib/AnyEvent/DNS.pm Mon Apr 27 16:02:39 2009
@@ -37,7 +37,7 @@
use AnyEvent::Handle ();
use AnyEvent::Util qw(AF_INET6);
-our $VERSION = 4.352;
+our $VERSION = 4.4;
our @DNS_FALLBACK = (v208.67.220.220, v208.67.222.222);
Modified: trunk/libanyevent-perl/lib/AnyEvent/Handle.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-perl/lib/AnyEvent/Handle.pm?rev=34213&op=diff
==============================================================================
--- trunk/libanyevent-perl/lib/AnyEvent/Handle.pm (original)
+++ trunk/libanyevent-perl/lib/AnyEvent/Handle.pm Mon Apr 27 16:02:39 2009
@@ -16,7 +16,7 @@
=cut
-our $VERSION = 4.352;
+our $VERSION = 4.4;
=head1 SYNOPSIS
Modified: trunk/libanyevent-perl/lib/AnyEvent/Impl/EV.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-perl/lib/AnyEvent/Impl/EV.pm?rev=34213&op=diff
==============================================================================
--- trunk/libanyevent-perl/lib/AnyEvent/Impl/EV.pm (original)
+++ trunk/libanyevent-perl/lib/AnyEvent/Impl/EV.pm Mon Apr 27 16:02:39 2009
@@ -61,6 +61,12 @@
}
}
+sub idle {
+ my ($class, %arg) = @_;
+
+ EV::idle $arg{cb}
+}
+
sub one_event {
EV::loop EV::LOOP_ONESHOT;
}
Modified: trunk/libanyevent-perl/lib/AnyEvent/Impl/Event.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-perl/lib/AnyEvent/Impl/Event.pm?rev=34213&op=diff
==============================================================================
--- trunk/libanyevent-perl/lib/AnyEvent/Impl/Event.pm (original)
+++ trunk/libanyevent-perl/lib/AnyEvent/Impl/Event.pm Mon Apr 27 16:02:39 2009
@@ -27,7 +27,7 @@
use AnyEvent ();
-use Event qw(time); # we have to importt something to make Event use Time::HiRes
+use Event qw(unloop); # we have to import something to make Event use Time::HiRes
sub io {
my ($class, %arg) = @_;
@@ -38,12 +38,18 @@
sub timer {
my ($class, %arg) = @_;
+ $arg{after} = 0 if $arg{after} < 0;
bless \Event->timer (%arg, repeat => $arg{interval}), $class
}
sub signal {
my ($class, %arg) = @_;
bless \Event->signal (%arg), $class
+}
+
+sub idle {
+ my ($class, %arg) = @_;
+ bless \Event->idle (repeat => 1, min => 0, %arg), $class
}
sub DESTROY {
Modified: trunk/libanyevent-perl/lib/AnyEvent/Impl/EventLib.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-perl/lib/AnyEvent/Impl/EventLib.pm?rev=34213&op=diff
==============================================================================
--- trunk/libanyevent-perl/lib/AnyEvent/Impl/EventLib.pm (original)
+++ trunk/libanyevent-perl/lib/AnyEvent/Impl/EventLib.pm Mon Apr 27 16:02:39 2009
@@ -31,6 +31,11 @@
It also doesn't work around the Windows bug of not signalling TCP
connection failures.
+
+Event::Lib does not support idle watchers. They could be emulated using
+low-priority timers but as the priority range (and availability) is not
+queryable nor guaranteed, and the default priority is likely the lowest
+one, this module cannot use them.
Avoid Event::Lib if you can.
Modified: trunk/libanyevent-perl/lib/AnyEvent/Impl/Glib.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-perl/lib/AnyEvent/Impl/Glib.pm?rev=34213&op=diff
==============================================================================
--- trunk/libanyevent-perl/lib/AnyEvent/Impl/Glib.pm (original)
+++ trunk/libanyevent-perl/lib/AnyEvent/Impl/Glib.pm Mon Apr 27 16:02:39 2009
@@ -21,13 +21,14 @@
iteration, it also does so multiple times and rebuilds the poll list for
the kernel each time again, dynamically even.
-On the positive side, Glib generally works correctly, no quarrels there.
+On the positive side, and most importantly, Glib generally works
+correctly, no quarrels there.
If you create many watchers (as in: more than two), you might consider one
of the L<Glib::EV>, L<EV::Glib> or L<Glib::Event> modules that map Glib to
other, more efficient, event loops.
-This module uses the default Glib main context for all it's watchers.
+This module uses the default Glib main context for all its watchers.
=cut
@@ -50,11 +51,7 @@
push @cond, "in", "hup" if $arg{poll} eq "r";
push @cond, "out", "hup" if $arg{poll} eq "w";
- my $source = add_watch Glib::IO fileno $arg{fh}, \@cond, sub {
- &$cb;
- 1
- };
-
+ my $source = add_watch Glib::IO fileno $arg{fh}, \@cond, sub { &$cb; 1 };
bless \\$source, $class
}
@@ -73,6 +70,14 @@
}
: sub { &$cb; 0 };
+ bless \\$source, $class
+}
+
+sub idle {
+ my ($class, %arg) = @_;
+
+ my $cb = $arg{cb};
+ my $source = add Glib::Idle sub { &$cb; 1 };
bless \\$source, $class
}
Modified: trunk/libanyevent-perl/lib/AnyEvent/Impl/POE.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-perl/lib/AnyEvent/Impl/POE.pm?rev=34213&op=diff
==============================================================================
--- trunk/libanyevent-perl/lib/AnyEvent/Impl/POE.pm (original)
+++ trunk/libanyevent-perl/lib/AnyEvent/Impl/POE.pm Mon Apr 27 16:02:39 2009
@@ -243,6 +243,11 @@
This is just one place where it gets obvious how little the author of the
POE manpage understands.
+
+=item No idle events
+
+The POE-recommended workaround to this is apparently to use
+C<fork>. Consequently, idle watchera will have to be emulated by AnyEvent.
=back
@@ -297,7 +302,7 @@
},
},
);
- bless \\$session, AnyEvent::Impl::POE::
+ bless \\$session, "AnyEvent::Impl::POE"
}
sub timer {
@@ -318,7 +323,7 @@
},
},
);
- bless \\$session, AnyEvent::Impl::POE::
+ bless \\$session, "AnyEvent::Impl::POE"
}
sub signal {
@@ -341,7 +346,7 @@
},
},
);
- bless \\$session, AnyEvent::Impl::POE::
+ bless \\$session, "AnyEvent::Impl::POE"
}
sub child {
@@ -365,7 +370,7 @@
},
},
);
- bless \\$session, AnyEvent::Impl::POE::
+ bless \\$session, "AnyEvent::Impl::POE"
}
sub DESTROY {
Modified: trunk/libanyevent-perl/lib/AnyEvent/Impl/Perl.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-perl/lib/AnyEvent/Impl/Perl.pm?rev=34213&op=diff
==============================================================================
--- trunk/libanyevent-perl/lib/AnyEvent/Impl/Perl.pm (original)
+++ trunk/libanyevent-perl/lib/AnyEvent/Impl/Perl.pm Mon Apr 27 16:02:39 2009
@@ -91,7 +91,7 @@
use AnyEvent ();
use AnyEvent::Util ();
-our $VERSION = 4.352;
+our $VERSION = 4.4;
our ($NOW, $MNOW);
@@ -160,6 +160,7 @@
my $need_sort = 1e300; # when to re-sort timer list
my @timer; # list of [ abs-timeout, Timer::[callback] ]
+my @idle; # list of idle callbacks
# the pure perl mainloop
sub one_event {
@@ -175,7 +176,7 @@
if (@timer && $timer[0][0] <= $MNOW) {
do {
my $timer = shift @timer;
- $timer->[1]($timer) if $timer->[1];
+ $timer->[1] && $timer->[1]($timer);
} while @timer && $timer[0][0] <= $MNOW;
} else {
@@ -186,20 +187,21 @@
= (@timer && $timer[0][0] < $need_sort ? $timer[0][0] : $need_sort) - $MNOW;
$wait = $wait < MAXWAIT ? $wait + ROUNDUP : MAXWAIT;
-
- if ($fds = CORE::select
- $vec[0] = $fds[0][V],
- $vec[1] = $fds[1][V],
- AnyEvent::WIN32 ? $vec[2] = $fds[1][V] : undef,
- $wait
- ) {
- _update_clock;
-
+ $wait = 0 if @idle;
+
+ $fds = CORE::select
+ $vec[0] = $fds[0][V],
+ $vec[1] = $fds[1][V],
+ AnyEvent::WIN32 ? $vec[2] = $fds[1][V] : undef,
+ $wait;
+
+ _update_clock;
+
+ if ($fds) {
# buggy microshit windows errornously sets exceptfds instead of writefds
$vec[1] |= $vec[2] if AnyEvent::WIN32;
- # prefer write watchers, because they usually reduce
- # memory pressure.
+ # prefer write watchers, because they might reduce memory pressure.
for (1, 0) {
my $fds = $fds[$_];
@@ -216,7 +218,9 @@
}
} elsif (AnyEvent::WIN32 && $! == AnyEvent::Util::WSAEINVAL) {
# buggy microshit windoze asks us to route around it
- CORE::select undef, undef, undef, $wait;
+ CORE::select undef, undef, undef, $wait if $wait;
+ } elsif (!@timer || $timer[0][0] > $MNOW) {
+ $$$_ && $$$_->() for @idle = grep $$$_, @idle;
}
}
}
@@ -231,7 +235,7 @@
$arg{poll} eq "w",
$arg{cb},
# q-idx
- ], AnyEvent::Impl::Perl::Io::;
+ ], "AnyEvent::Impl::Perl::io";
my $fds = $fds[$self->[1]];
@@ -247,7 +251,7 @@
$self
}
-sub AnyEvent::Impl::Perl::Io::DESTROY {
+sub AnyEvent::Impl::Perl::io::DESTROY {
my ($self) = @_;
my $fds = $fds[$self->[1]];
@@ -296,6 +300,15 @@
$self
}
+sub idle {
+ my ($class, %arg) = @_;
+
+ push @idle, \\$arg{cb};
+ weaken ${$idle[-1]};
+
+ ${$idle[-1]}
+}
+
1;
=head1 SEE ALSO
Modified: trunk/libanyevent-perl/lib/AnyEvent/Impl/Qt.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-perl/lib/AnyEvent/Impl/Qt.pm?rev=34213&op=diff
==============================================================================
--- trunk/libanyevent-perl/lib/AnyEvent/Impl/Qt.pm (original)
+++ trunk/libanyevent-perl/lib/AnyEvent/Impl/Qt.pm Mon Apr 27 16:02:39 2009
@@ -22,6 +22,8 @@
Qt suffers from the same limitations as Event::Lib and Tk, the workaround
is also the same (duplicating file descriptors).
+
+Qt doesn't support idle events, so they are being emulated.
Avoid Qt if you can.
@@ -66,8 +68,8 @@
}
sub cb {
- this->start (this->{interval}, 1);
- (this->{cb})->();
+ this->start (this->{interval}, 1) if defined this->{interval};
+ this->{cb}->();
}
package AnyEvent::Impl::Qt;
@@ -89,7 +91,7 @@
# - adding a callback might destroy other callbacks
# - only one callback per fd/poll combination
my ($fh, $qt) = AnyEvent::_dupfh $arg{poll}, $arg{fh},
- Qt::SocketNotifier::Read (), Qt::SocketNotifier::Write();
+ Qt::SocketNotifier::Read (), Qt::SocketNotifier::Write ();
AnyEvent::Impl::Qt::Io $fh, $qt, $arg{cb}
}
@@ -97,8 +99,19 @@
sub timer {
my ($class, %arg) = @_;
- AnyEvent::Impl::Qt::Timer $arg{after} * 1000, $arg{interval} * 1000, $arg{cb}
+ # old Qt treats 0 timeout as "idle"
+ AnyEvent::Impl::Qt::Timer
+ $arg{after} * 1000 || 1,
+ $arg{interval} ? $arg{interval} * 1000 || 1 : undef,
+ $arg{cb}
}
+
+# newer Qt have no idle mode for timers anymore...
+#sub idle {
+# my ($class, %arg) = @_;
+#
+# AnyEvent::Impl::Qt::Timer 0, 0, $arg{cb}
+#}
sub one_event {
Qt::app->processOneEvent;
Modified: trunk/libanyevent-perl/lib/AnyEvent/Impl/Tk.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-perl/lib/AnyEvent/Impl/Tk.pm?rev=34213&op=diff
==============================================================================
--- trunk/libanyevent-perl/lib/AnyEvent/Impl/Tk.pm (original)
+++ trunk/libanyevent-perl/lib/AnyEvent/Impl/Tk.pm Mon Apr 27 16:02:39 2009
@@ -35,6 +35,11 @@
terminally broken on 64 bit, do not expect more than 10 or so watchers to
work on 64 bit machines).
+Note also that Tk event ids wrap around after 2**32 or so events, which on
+my machine can happen within less than 12 hours, after which Tk will stomp
+on random other events and kill them. So don't run Tk programs for more
+than an hour or so.
+
To be able to access the Tk event loop, this module creates a main
window and withdraws it immediately. This might cause flickering on some
platforms, but Tk perversely requires a window to be able to wait for file
@@ -68,10 +73,10 @@
$mw->fileevent ($fh, $tk => $arg{cb});
- bless [$fh, $tk], AnyEvent::Impl::Tk::Io::
+ bless [$fh, $tk], "AnyEvent::Impl::Tk::io"
}
-sub AnyEvent::Impl::Tk::Io::DESTROY {
+sub AnyEvent::Impl::Tk::io::DESTROY {
my ($fh, $tk) = @{$_[0]};
# work around another bug: watchers don't get removed when
@@ -85,29 +90,43 @@
my (undef, %arg) = @_;
my $cb = $arg{cb};
-
- my $self = bless \\$cb, AnyEvent::Impl::Tk::Timer::;
+ my $id;
if ($arg{interval}) {
my $ival = $arg{interval} * 1000;
- my $rcb; $rcb = sub {
- if ($cb) {
- $mw->after ($ival, $rcb);
- &$cb;
- }
+ my $rcb = sub {
+ $id = Tk::after $mw, $ival, [$_[0], $_[0]];
+ &$cb;
};
- $mw->after ($arg{after} * 1000, $rcb);
+ $id = Tk::after $mw, $arg{after} * 1000, [$rcb, $rcb];
} else {
- $mw->after ($arg{after} * 1000, sub {
- &$cb if $cb;
- });
+ # tk blesses $cb, thus the extra indirection
+ $id = Tk::after $mw, $arg{after} * 1000, sub { &$cb };
}
- $self
+ bless \\$id, "AnyEvent::Impl::Tk::after"
}
-sub AnyEvent::Impl::Tk::Timer::DESTROY {
- $${$_[0]} = undef;
+sub idle {
+ my (undef, %arg) = @_;
+
+ my $cb = $arg{cb};
+ my $id;
+ my $rcb = sub {
+ # in their endless stupidity, they decided to give repeating idle watchers
+ # strictly higher priority than timers :/
+ $id = Tk::after $mw, 0 => [sub {
+ $id = Tk::after $mw, idle => [$_[0], $_[0]];
+ }, $_[0]];
+ &$cb;
+ };
+
+ $id = Tk::after $mw, idle => [$rcb, $rcb];
+ bless \\$id, "AnyEvent::Impl::Tk::after"
+}
+
+sub AnyEvent::Impl::Tk::after::DESTROY {
+ Tk::after $mw, cancel => $${$_[0]};
}
sub one_event {
Modified: trunk/libanyevent-perl/lib/AnyEvent/Socket.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-perl/lib/AnyEvent/Socket.pm?rev=34213&op=diff
==============================================================================
--- trunk/libanyevent-perl/lib/AnyEvent/Socket.pm (original)
+++ trunk/libanyevent-perl/lib/AnyEvent/Socket.pm Mon Apr 27 16:02:39 2009
@@ -59,7 +59,7 @@
tcp_connect
);
-our $VERSION = 4.352;
+our $VERSION = 4.4;
=item $ipn = parse_ipv4 $dotted_quad
Modified: trunk/libanyevent-perl/lib/AnyEvent/Strict.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-perl/lib/AnyEvent/Strict.pm?rev=34213&op=diff
==============================================================================
--- trunk/libanyevent-perl/lib/AnyEvent/Strict.pm (original)
+++ trunk/libanyevent-perl/lib/AnyEvent/Strict.pm Mon Apr 27 16:02:39 2009
@@ -119,6 +119,20 @@
$class->SUPER::child (@_)
}
+sub idle {
+ my $class = shift;
+ my %arg = @_;
+
+ ref $arg{cb}
+ or croak "AnyEvent->idle called with illegal cb argument '$arg{cb}'";
+ delete $arg{cb};
+
+ croak "AnyEvent->idle called with unsupported parameter(s) " . join ", ", keys %arg
+ if keys %arg;
+
+ $class->SUPER::idle (@_)
+}
+
sub condvar {
my $class = shift;
my %arg = @_;
Modified: trunk/libanyevent-perl/lib/AnyEvent/Util.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-perl/lib/AnyEvent/Util.pm?rev=34213&op=diff
==============================================================================
--- trunk/libanyevent-perl/lib/AnyEvent/Util.pm (original)
+++ trunk/libanyevent-perl/lib/AnyEvent/Util.pm Mon Apr 27 16:02:39 2009
@@ -34,7 +34,7 @@
our @EXPORT = qw(fh_nonblocking guard fork_call portable_pipe portable_socketpair);
our @EXPORT_OK = qw(AF_INET6 WSAEWOULDBLOCK WSAEINPROGRESS WSAEINVAL WSAWOULDBLOCK);
-our $VERSION = 4.352;
+our $VERSION = 4.4;
BEGIN {
my $posix = 1 * eval { local $SIG{__DIE__}; require POSIX };
@@ -400,7 +400,7 @@
if (eval "use Guard 0.5; 1") {
*guard = \&Guard::guard;
} else {
- *AnyEvent::Util::Guard::DESTROY = sub {
+ *AnyEvent::Util::guard::DESTROY = sub {
local $@;
eval {
@@ -411,12 +411,12 @@
warn "runtime error in AnyEvent::guard callback: $@" if $@;
};
- *AnyEvent::Util::Guard::cancel = sub ($) {
+ *AnyEvent::Util::guard::cancel = sub ($) {
${$_[0]} = sub { };
};
*guard = sub (&) {
- bless \(my $cb = shift), AnyEvent::Util::Guard::
+ bless \(my $cb = shift), "AnyEvent::Util::guard"
}
}
}
More information about the Pkg-perl-cvs-commits
mailing list