Skip to content

Commit

Permalink
Enable support for $kernel->run_one_timeslice() under Tk. I had to
Browse files Browse the repository at this point in the history 
implement loop_do_timeslice() and replace Tk's MainLoop with a custom
one in loop_run().  I haven't tested this against the memory leak test
cases in rt.cpan.org, but I'm hoping this code (which is less twisty)
will solve those issues as well.
  • Loading branch information
@rcaputo
rcaputo committed Apr 23, 2005
1 parent 5bca0e5 commit f7f7546
Show file tree
Hide file tree
Showing 3 changed files with 92 additions and 153 deletions.
69 changes: 35 additions & 34 deletions lib/POE/Loop/Tk.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -69,16 +69,16 @@ sub loop_watch_filehandle {

# Start a filehandle watcher.

$poe_main_window->fileevent
( $handle,
$tk_mode,

# The handle is wrapped in quotes here to stringify it. For
# some reason, it seems to work as a filehandle anyway, and it
# breaks reference counting. For filehandles, then, this is
# truly a safe (strict ok? warn ok? seems so!) weak reference.
[ \&_loop_select_callback, $fileno, $mode ],
);
$poe_main_window->fileevent(
$handle,
$tk_mode,

# The handle is wrapped in quotes here to stringify it. For some
# reason, it seems to work as a filehandle anyway, and it breaks
# reference counting. For filehandles, then, this is truly a safe
# (strict ok? warn ok? seems so!) weak reference.
[ \&_loop_select_callback, $fileno, $mode ],
);

$_fileno_refcount[fileno $handle]++;
}
Expand All @@ -95,16 +95,16 @@ sub loop_ignore_filehandle {
# Tk's file watchers.

unless (--$_fileno_refcount[fileno $handle]) {
$poe_main_window->fileevent
( $handle,
$poe_main_window->fileevent(
$handle,

# It can only be MODE_RD or MODE_WR here (MODE_EX is checked a
# few lines up).
( ( $mode == MODE_RD ) ? 'readable' : 'writable' ),
# It can only be MODE_RD or MODE_WR here (MODE_EX is checked a
# few lines up).
( ( $mode == MODE_RD ) ? 'readable' : 'writable' ),

# Nothing here! Callback all gone!
''
);
# Nothing here! Callback all gone!
''
);
}

# Otherwise we have other things watching the handle. Go into Tk's
Expand All @@ -114,13 +114,13 @@ sub loop_ignore_filehandle {
else {
my $tk_file_io = tied( *$handle );
die "whoops; no tk file io object" unless defined $tk_file_io;
$tk_file_io->handler
( ( ( $mode == MODE_RD )
? Tk::Event::IO::READABLE()
: Tk::Event::IO::WRITABLE()
),
''
);
$tk_file_io->handler(
( ( $mode == MODE_RD )
? Tk::Event::IO::READABLE()
: Tk::Event::IO::WRITABLE()
),
''
);
}
}

Expand Down Expand Up @@ -160,15 +160,16 @@ sub loop_resume_filehandle {
my $tk_file_io = tied( *$handle );
die "whoops; no tk file io object" unless defined $tk_file_io;

$tk_file_io->handler( ( ( $mode == MODE_RD )
? Tk::Event::IO::READABLE()
: Tk::Event::IO::WRITABLE()
),
[ \&_loop_select_callback,
$fileno,
$mode,
]
);
$tk_file_io->handler(
( ( $mode == MODE_RD )
? Tk::Event::IO::READABLE()
: Tk::Event::IO::WRITABLE()
),
[ \&_loop_select_callback,
$fileno,
$mode,
]
);
}

# Tk filehandle callback to dispatch selects.
Expand Down
31 changes: 16 additions & 15 deletions lib/POE/Loop/TkActiveState.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -60,11 +60,11 @@ sub loop_finalize {

# This is "clever" in that it relies on each symbol on the left to
# be stringified by the => operator.
my %kernel_modes =
( MODE_RD => MODE_RD,
MODE_WR => MODE_WR,
MODE_EX => MODE_EX,
);
my %kernel_modes = (
MODE_RD => MODE_RD,
MODE_WR => MODE_WR,
MODE_EX => MODE_EX,
);

while (my ($mode_name, $mode_offset) = each(%kernel_modes)) {
my $bits = unpack('b*', $loop_vectors[$mode_offset]);
Expand Down Expand Up @@ -147,19 +147,20 @@ sub _poll_for_io {

if (@filenos) {
# Check filehandles, or wait for a period of time to elapse.
my $hits = select( my $rout = $loop_vectors[MODE_RD],
my $wout = $loop_vectors[MODE_WR],
my $eout = $loop_vectors[MODE_EX],
0,
);
my $hits = select(
my $rout = $loop_vectors[MODE_RD],
my $wout = $loop_vectors[MODE_WR],
my $eout = $loop_vectors[MODE_EX],
0,
);

if (ASSERT_FILES) {
if ($hits < 0) {
POE::Kernel::_trap("<fh> select error: $!")
unless ( ($! == EINPROGRESS) or
($! == EWOULDBLOCK) or
($! == EINTR)
);
POE::Kernel::_trap("<fh> select error: $!") unless (
($! == EINPROGRESS) or
($! == EWOULDBLOCK) or
($! == EINTR)
);
}
}

Expand Down
145 changes: 41 additions & 104 deletions lib/POE/Loop/TkCommon.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,10 @@ package POE::Kernel;

use strict;

my $_watcher_timer;
use Tk qw(DoOneEvent DONT_WAIT ALL_EVENTS);

my $_watcher_time;
my $_do_one_running = 0;

#------------------------------------------------------------------------------
# Signal handler maintenance functions.
Expand All @@ -46,16 +49,19 @@ sub loop_attach_uidestroy {

sub loop_resume_time_watcher {
my ($self, $next_time) = @_;
$next_time -= time();

if (defined $_watcher_timer) {
$_watcher_timer->cancel();
undef $_watcher_timer;
$self->loop_pause_time_watcher();

my $timeout = $next_time - time();
if ($timeout < 0) {
$_do_one_running = 0;
return;
}

$next_time = 0 if $next_time < 0;
$_watcher_timer =
$poe_main_window->after($next_time * 1000, [\&_loop_event_callback]);
$_do_one_running = 1;
$_watcher_time = $poe_main_window->after(
$timeout * 1000, [ sub { $_do_one_running = 0 } ]
);
}

sub loop_reset_time_watcher {
Expand All @@ -65,14 +71,12 @@ sub loop_reset_time_watcher {

sub loop_pause_time_watcher {
my $self = shift;
$_watcher_timer->cancel() if defined $_watcher_timer;
if (defined $_watcher_time) {
$_watcher_time->cancel();
$_watcher_time = undef;
}
}

# Tk's alarm callbacks seem to have the highest priority. That is, if
# $widget->after is constantly scheduled for a period smaller than the
# overhead of dispatching it, then no other events are processed.
# That includes afterIdle and even internal Tk events.

# TODO - Ton Hospel's Tk event loop doesn't mix alarms and immediate
# events. Rather, it keeps a list of immediate events and defers
# queuing of alarms to something else.
Expand All @@ -99,93 +103,6 @@ sub loop_pause_time_watcher {
# @immediate is exhausted. I suspect the semantics are similar to
# POE's queue anyway, however.

# Tk timer callback to dispatch events.

my $last_time = time();

sub _loop_event_callback {
if (TRACE_STATISTICS) {
# TODO - I'm pretty sure the startup time will count as an unfair
# amount of idleness.
#
# TODO - Introducing many new time() syscalls. Bleah.
$poe_kernel->_data_stat_add('idle_seconds', time() - $last_time);
}

$poe_kernel->_data_ev_dispatch_due();

# As was mentioned before, $widget->after() events can dominate a
# program's event loop, starving it of other events, including Tk's
# internal widget events. To avoid this, we'll reset the event
# callback from an idle event.

# Register the next timed callback if there are events left.

if ($poe_kernel->get_event_count()) {

# Cancel the Tk alarm that handles alarms.

if (defined $_watcher_timer) {
$_watcher_timer->cancel();
undef $_watcher_timer;
}

# Faster, more direct code is also broken since Tk alarms take
# precedence over everything else.

# my $next_time = $poe_kernel->get_next_event_time();
# if (defined $next_time) {
# $next_time -= time();
# $next_time = 0 if $next_time < 0;
#
# $_watcher_timer = $poe_main_window->after(
# $next_time * 1000,
# [\&_loop_event_callback]
# );
# }

# Slower, indirect code works.

$_watcher_timer = $poe_main_window->afterIdle(
[
sub {
$_watcher_timer->cancel();
undef $_watcher_timer;

my $next_time = $poe_kernel->get_next_event_time();
if (defined $next_time) {
$next_time -= time();
$next_time = 0 if $next_time < 0;

$_watcher_timer = $poe_main_window->after(
$next_time * 1000,
[\&_loop_event_callback]
);
}
}
],
);

# POE::Kernel's signal polling loop always keeps one event in the
# queue. We test for an idle kernel if the queue holds only one
# event. A more generic method would be to keep counts of user
# vs. kernel events, and GC the kernel when the user events drop
# to 0.

if ($poe_kernel->get_event_count() == $poe_kernel->_idle_queue_size()) {
$poe_kernel->_test_if_kernel_is_idle();
}
}

# Make sure the kernel can still run.
else {
$poe_kernel->_test_if_kernel_is_idle();
}

# And back to Tk, so we're in idle mode.
$last_time = time() if TRACE_STATISTICS;
}

#------------------------------------------------------------------------------
# Tk traps errors in an effort to survive them. However, since POE
# does not, this leaves us in a strange, inconsistent state. Here we
Expand Down Expand Up @@ -215,15 +132,35 @@ sub Tk::Error {
# The event loop itself.

sub loop_do_timeslice {
die "doing timeslices currently not supported in the Tk loop";
my $self = shift;

# Check for a hung kernel.
$self->_test_if_kernel_is_idle();

my $now;
$now = time() if TRACE_STATISTICS;

DoOneEvent(DONT_WAIT | ALL_EVENTS);
while ($_do_one_running) {
DoOneEvent(ALL_EVENTS);
}

$self->_data_stat_add('idle_seconds', time() - $now) if TRACE_STATISTICS;

# Dispatch whatever events are due.
$self->_data_ev_dispatch_due();
}

sub loop_run {
Tk::MainLoop();
my $self = shift;

# Run for as long as there are sessions to service.
while ($self->_data_ses_count()) {
$self->loop_do_timeslice();
}
}

sub loop_halt {
undef $_watcher_timer;
$poe_main_window->destroy();
}

Expand Down

0 comments on commit f7f7546

Please sign in to comment.