POE-Loop-Tk-1.305/000755 000765 000024 00000000000 12205265663 013551 5ustar00trocstaff000000 000000 POE-Loop-Tk-1.305/CHANGES000644 000765 000024 00000002156 12205265663 014550 0ustar00trocstaff000000 000000 ================================ 2013-08-21 21:38:31 -0400 v1_305 ================================ commit bee132638d02a74c2307603caad7e99652f70dc5 Author: Rocco Caputo Date: Wed Aug 21 21:38:31 2013 -0400 Bump version for release. commit d04814c23d282343673cb8ec514490306f3ad38b Author: Rocco Caputo Date: Wed Aug 21 19:31:42 2013 -0400 Freshen up Makefile.PL and the documentation. commit 658b10e8c9a9d62155bae9eed75eb7504f788e20 Author: Rocco Caputo Date: Sun Aug 11 22:09:01 2013 -0400 Remove vestigial runtime statistics call. Instrumenting that could would have failed. The method it's calling no longer exists. commit 1c62375b1407988d6c59020847c8669446c3a31c Author: Rocco Caputo Date: Tue Sep 7 22:08:29 2010 -0400 Promote subproject files to top level. commit c340f2cbcec378e6e87b61c079755e2abe34d4c4 Author: Larwan Berke Date: Wed Apr 7 16:03:43 2010 -0400 Typo fix in POD, reported by jawnsy@irc ============== End of Excerpt ============== POE-Loop-Tk-1.305/lib/000755 000765 000024 00000000000 12205265662 014316 5ustar00trocstaff000000 000000 POE-Loop-Tk-1.305/Makefile.PL000644 000765 000024 00000005026 12205246651 015522 0ustar00trocstaff000000 000000 #!/usr/bin/perl # rocco // vim: ts=2 sw=2 expandtab use warnings; use strict; use ExtUtils::MakeMaker; use POE::Test::Loops; # Switch to default behavior if STDIN isn't a tty. unless (-t STDIN) { warn( "\n", "=============================================\n\n", "STDIN is not a terminal. Assuming --default.\n\n", "=============================================\n\n", ); push @ARGV, "--default"; } # Remind the user she can use --default. unless (grep /^--default$/, @ARGV) { warn( "\n", "=============================================\n\n", "Prompts may be bypassed by running:\n", " $^X $0 --default\n\n", "=============================================\n\n", ); } # Should we skip the network tests? my $prompt = ( "Some of POE::Loop::Tk's tests require a\n" . "functional network. You can skip these network\n" . "tests if you'd like.\n\n" . "Would you like to skip the network tests?" ); my $ret = "n"; if (grep /^--default$/, @ARGV) { print $prompt, " [$ret] $ret\n\n"; } else { $ret = prompt($prompt, "n"); } my $marker = 'run_network_tests'; unlink $marker; unless ($ret =~ /^Y$/i) { open(TOUCH,"+>$marker") and close TOUCH; } print "\n"; ### Touch files that will be generated at "make dist" time. ### ExtUtils::MakeMaker and Module::Build will complain about them if ### they aren't present now. open(TOUCH, ">>CHANGES") and close TOUCH; open(TOUCH, ">>META.yml") and close TOUCH; POE::Test::Loops::generate( 't', [ 'POE::Loop::Tk' ], 0 ); WriteMakefile( NAME => 'POE::Loop::Tk', AUTHOR => 'Rocco Caputo ', ABSTRACT => 'Tk event loop support for POE.', VERSION_FROM => 'lib/POE/Loop/Tk.pm', META_ADD => { resources => { license => 'http://dev.perl.org/licenses/', repository => ( 'https://github.com/rcaputo/poe-loop-tk.git' ), }, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', PREOP => ( 'git-log.pl | ' . '/usr/bin/tee ./$(DISTNAME)-$(VERSION)/CHANGES > ./CHANGES' ), }, clean => { FILES => 't/poe_loop_tk/*.t t/poe_loop_tk ' . $marker }, test => { TESTS => 't/*.t t/poe_loop_tk/*.t' }, CONFIGURE_REQUIRES => { 'ExtUtils::MakeMaker' => 0, 'POE::Test::Loops' => 1.352, }, META_MERGE => { build_requires => { 'POE::Test::Loops' => 1.352, }, }, PREREQ_PM => { 'POE' => 1.356, 'Tk' => 804.031, }, ); 1; POE-Loop-Tk-1.305/MANIFEST000644 000765 000024 00000000345 12205265663 014704 0ustar00trocstaff000000 000000 CHANGES MANIFEST MANIFEST.SKIP META.yml Makefile.PL README lib/POE/Loop/Tk.pm lib/POE/Loop/TkCommon.pm lib/POE/Loop/TkActiveState.pm t/00_info.t META.json Module JSON meta-data (added by MakeMaker) POE-Loop-Tk-1.305/MANIFEST.SKIP000644 000765 000024 00000000424 11440552131 015434 0ustar00trocstaff000000 000000 CVS \.\# \.bak$ \.cvsignore \.gz$ \.orig$ \.patch$ \.ppd$ \.rej$ \.rej$ \.svn \.swo$ \.swp$ ^Makefile$ ^Makefile\.old$ ^\. ^_Inline ^_build ^blib/ ^comptest ^cover_db ^coverage\.report$ ^docs ^pm_to_blib$ ^poe_report\.xml$ run_network_tests test-output\.err$ t/[23]0_.*\.t ~$ POE-Loop-Tk-1.305/META.json000644 000765 000024 00000002231 12205265663 015170 0ustar00trocstaff000000 000000 { "abstract" : "Tk event loop support for POE.", "author" : [ "Rocco Caputo " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.72, CPAN::Meta::Converter version 2.132140", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "POE-Loop-Tk", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0", "POE::Test::Loops" : "1.352" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0", "POE::Test::Loops" : "1.352" } }, "runtime" : { "requires" : { "POE" : "1.356", "Tk" : "804.031" } } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "url" : "https://github.com/rcaputo/poe-loop-tk.git" } }, "version" : "1.305" } POE-Loop-Tk-1.305/META.yml000644 000765 000024 00000001230 12205265662 015015 0ustar00trocstaff000000 000000 --- abstract: 'Tk event loop support for POE.' author: - 'Rocco Caputo ' build_requires: ExtUtils::MakeMaker: 0 POE::Test::Loops: 1.352 configure_requires: ExtUtils::MakeMaker: 0 POE::Test::Loops: 1.352 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.72, CPAN::Meta::Converter version 2.132140' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: POE-Loop-Tk no_index: directory: - t - inc requires: POE: 1.356 Tk: 804.031 resources: license: http://dev.perl.org/licenses/ repository: https://github.com/rcaputo/poe-loop-tk.git version: 1.305 POE-Loop-Tk-1.305/README000644 000765 000024 00000000727 11440552131 014424 0ustar00trocstaff000000 000000 POE supports nearly any event loop imaginable through POE::Loop plugin modules. POE::Loop::Tk is the plugin support for the Tk graphical toolkit's event loop. See http://search.cpan.org/search?query=POE%3A%3ALoop&mode=module for a list of other event loops POE supports. POE::Loop documents the generic API for all POE::Loop subclasses. You are invited to implement this API for your favorite event loop. Kudos, bug reports, and patches are also welcome. Thank you! POE-Loop-Tk-1.305/t/000755 000765 000024 00000000000 12205265662 014013 5ustar00trocstaff000000 000000 POE-Loop-Tk-1.305/t/00_info.t000644 000765 000024 00000000264 11440552131 015422 0ustar00trocstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More tests => 1; use_ok( 'POE' ); # idea from Test::Harness, thanks! diag("Testing POE $POE::VERSION, Perl $], $^X on $^O"); POE-Loop-Tk-1.305/lib/POE/000755 000765 000024 00000000000 12205265662 014741 5ustar00trocstaff000000 000000 POE-Loop-Tk-1.305/lib/POE/Loop/000755 000765 000024 00000000000 12205265662 015652 5ustar00trocstaff000000 000000 POE-Loop-Tk-1.305/lib/POE/Loop/Tk.pm000644 000765 000024 00000014260 12205265621 016564 0ustar00trocstaff000000 000000 # Tk-Perl event loop bridge for POE::Kernel. package POE::Loop::Tk; use vars qw($VERSION); $VERSION = '1.305'; # NOTE - Should be #.### (three decimal places) # Include common things. use POE::Loop::PerlSignals; use POE::Loop::TkCommon; use Tk 800.031; use 5.00503; =for poe_tests sub skip_tests { return "Tk needs a DISPLAY (set one today, okay?)" unless ( (defined $ENV{DISPLAY} and length $ENV{DISPLAY}) or $^O eq "MSWin32" ); my $test_name = shift; if ($test_name eq "k_signals_rerun" and $^O eq "MSWin32") { return "This test crashes Perl when run with Tk on $^O"; } return "Tk tests require the Tk module" if do { eval "use Tk"; $@ }; my $m = eval { Tk::MainWindow->new() }; if ($@) { my $why = $@; $why =~ s/ at .*//; return "Tk couldn't be initialized: $why"; } return; } =cut # Everything plugs into POE::Kernel. package POE::Kernel; use strict; # Hand off to POE::Loop::TkActiveState if we're running under # ActivePerl. BEGIN { if ($^O eq "MSWin32") { require POE::Loop::TkActiveState; POE::Loop::TkActiveState->import(); die "not really dying"; } } my @_fileno_refcount; #------------------------------------------------------------------------------ # Loop construction and destruction. sub loop_initialize { my $self = shift; $poe_main_window = Tk::MainWindow->new(); die "could not create a main Tk window" unless defined $poe_main_window; $self->signal_ui_destroy($poe_main_window); } sub loop_finalize { my $self = shift; $self->loop_ignore_all_signals(); } #------------------------------------------------------------------------------ # Maintain filehandle watchers. sub loop_watch_filehandle { my ($self, $handle, $mode) = @_; my $fileno = fileno($handle); my $tk_mode; if ($mode == MODE_RD) { $tk_mode = 'readable'; } elsif ($mode == MODE_WR) { $tk_mode = 'writable'; } else { # The Tk documentation implies by omission that expedited # filehandles aren't, uh, handled. This is part 1 of 2. confess "Tk does not support expedited filehandles"; } # 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 ], ); $_fileno_refcount[fileno $handle]++; } sub loop_ignore_filehandle { my ($self, $handle, $mode) = @_; # The Tk documentation implies by omission that expedited # filehandles aren't, uh, handled. This is part 2 of 2. confess "Tk does not support expedited filehandles" if $mode == MODE_EX; # The fileno refcount just dropped to 0. Remove the handle from # Tk's file watchers. unless (--$_fileno_refcount[fileno $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' ), # Nothing here! Callback all gone! '' ); } # Otherwise we have other things watching the handle. Go into Tk's # undocumented guts to disable just this watcher without hosing the # entire fileevent thing. 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() ), '' ); } } sub loop_pause_filehandle { my ($self, $handle, $mode) = @_; my $tk_mode; if ($mode == MODE_RD) { $tk_mode = Tk::Event::IO::READABLE(); } elsif ($mode == MODE_WR) { $tk_mode = Tk::Event::IO::WRITABLE(); } else { # The Tk documentation implies by omission that expedited # filehandles aren't, uh, handled. This is part 2 of 2. confess "Tk does not support expedited filehandles"; } # Use an internal work-around to fileevent quirks. my $tk_file_io = tied( *$handle ); die "whoops; no tk file io object" unless defined $tk_file_io; $tk_file_io->handler($tk_mode, ""); } sub loop_resume_filehandle { my ($self, $handle, $mode) = @_; my $fileno = fileno($handle); # The Tk documentation implies by omission that expedited # filehandles aren't, uh, handled. This is part 2 of 2. confess "Tk does not support expedited filehandles" if $mode == MODE_EX; # Use an internal work-around to fileevent quirks. 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 filehandle callback to dispatch selects. sub _loop_select_callback { my ($fileno, $mode) = @_; $poe_kernel->_data_handle_enqueue_ready($mode, $fileno); $poe_kernel->_test_if_kernel_is_idle(); } 1; __END__ =head1 NAME POE::Loop::Tk - a bridge that allows POE to be driven by Tk =head1 SYNOPSIS See L. use Tk; use POE; # Rest of your program here. =head1 DESCRIPTION POE::Loop::Tk replaces POE's internal event loop with the Tk module. This allows programs to use both POE and Tk at the same time. POE::Loop::Tk implements the interface documented in L. Therefore it has no documentation of its own. Please see L for more details. POE::Loop::Tk is one of two versions of the Tk event loop bridge. The other, L accommodates behavior differences in ActiveState's build of Tk. Both versions share common code in L. POE::Loop::Tk dynamically selects the appropriate event loop bridge based on the runtime environment. =head1 SEE ALSO L, L, L, L, L. =head1 AUTHORS & LICENSING POE::Loop::Tk is Copyright 1998-2013 Rocco Caputo. All rights reserved. POE::Loop::Tk is free software; you may redistribute it and/or modify it under the same terms as Perl itself. =cut # rocco // vim: ts=2 sw=2 expandtab # TODO - Edit. POE-Loop-Tk-1.305/lib/POE/Loop/TkActiveState.pm000644 000765 000024 00000017340 12205265621 020723 0ustar00trocstaff000000 000000 # Tk-Perl event loop bridge for POE::Kernel. # Dummy package so the version is indexed properly. package POE::Loop::TkActiveState; use vars qw($VERSION); $VERSION = '1.305'; # NOTE - Should be #.### (three decimal places) # Merge things into POE::Loop::Tk. package POE::Loop::Tk; # Include common things. use POE::Loop::PerlSignals; use POE::Loop::TkCommon; use Tk 800.021; use 5.00503; # Everything plugs into POE::Kernel. package POE::Kernel; use strict; use Errno qw(EINPROGRESS EWOULDBLOCK EINTR); # select() vectors. They're stored in an array so that the MODE_* # offsets can refer to them. This saves some code at the expense of # clock cycles. # # [ $select_read_bit_vector, (MODE_RD) # $select_write_bit_vector, (MODE_WR) # $select_expedite_bit_vector (MODE_EX) # ]; my @loop_vectors = ("", "", ""); # A record of the file descriptors we are actively watching. my %loop_filenos; my @_fileno_refcount; my $_handle_poller; #------------------------------------------------------------------------------ # Loop construction and destruction. sub loop_initialize { my $self = shift; $poe_main_window = Tk::MainWindow->new(); die "could not create a main Tk window" unless defined $poe_main_window; $self->signal_ui_destroy($poe_main_window); # Initialize the vectors as vectors. @loop_vectors = ( '', '', '' ); vec($loop_vectors[MODE_RD], 0, 1) = 0; vec($loop_vectors[MODE_WR], 0, 1) = 0; vec($loop_vectors[MODE_EX], 0, 1) = 0; $_handle_poller = $poe_main_window->after(100, [\&_poll_for_io]); } sub loop_finalize { my $self = shift; # 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, ); while (my ($mode_name, $mode_offset) = each(%kernel_modes)) { my $bits = unpack('b*', $loop_vectors[$mode_offset]); if (index($bits, '1') >= 0) { POE::Kernel::_warn " LOOP VECTOR LEAK: $mode_name = $bits\a\n"; } } $self->loop_ignore_all_signals(); } #------------------------------------------------------------------------------ # Maintain filehandle watchers. sub loop_watch_filehandle { my ($self, $handle, $mode) = @_; my $fileno = fileno($handle); vec($loop_vectors[$mode], $fileno, 1) = 1; $loop_filenos{$fileno} |= (1<<$mode); } sub loop_ignore_filehandle { my ($self, $handle, $mode) = @_; my $fileno = fileno($handle); vec($loop_vectors[$mode], $fileno, 1) = 0; $loop_filenos{$fileno} &= ~(1<<$mode); } sub loop_pause_filehandle { my ($self, $handle, $mode) = @_; my $fileno = fileno($handle); vec($loop_vectors[$mode], $fileno, 1) = 0; $loop_filenos{$fileno} &= ~(1<<$mode); } sub loop_resume_filehandle { my ($self, $handle, $mode) = @_; my $fileno = fileno($handle); vec($loop_vectors[$mode], $fileno, 1) = 1; $loop_filenos{$fileno} |= (1<<$mode); } # This is the select loop itself. We do a Bad Thing here by polling # for socket activity, but it's necessary with ActiveState's Tk. # # TODO We should really stop the poller when there are no handles to # watch and resume it as needed. sub _poll_for_io { if (defined $_handle_poller) { $_handle_poller->cancel(); $_handle_poller = undef; } # Determine which files are being watched. my @filenos = (); while (my ($fd, $mask) = each(%loop_filenos)) { push(@filenos, $fd) if $mask; } if (TRACE_FILES) { POE::Kernel::_warn( " ,----- SELECT BITS IN -----\n", " | READ : ", unpack('b*', $loop_vectors[MODE_RD]), "\n", " | WRITE : ", unpack('b*', $loop_vectors[MODE_WR]), "\n", " | EXPEDITE: ", unpack('b*', $loop_vectors[MODE_EX]), "\n", " `--------------------------\n" ); } # Avoid looking at filehandles if we don't need to. TODO The added # code to make this sleep is non-optimal. There is a way to do this # in fewer tests. if (@filenos) { # There are filehandles to poll, so do so. if (@filenos) { # Check filehandles, or wait for a period of time to elapse. my $hits = CORE::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(" select error: $!") unless ( ($! == EINPROGRESS) or ($! == EWOULDBLOCK) or ($! == EINTR) ); } } if (TRACE_FILES) { if ($hits > 0) { POE::Kernel::_warn " select hits = $hits\n"; } elsif ($hits == 0) { POE::Kernel::_warn " select timed out...\n"; } POE::Kernel::_warn( " ,----- SELECT BITS OUT -----\n", " | READ : ", unpack('b*', $rout), "\n", " | WRITE : ", unpack('b*', $wout), "\n", " | EXPEDITE: ", unpack('b*', $eout), "\n", " `---------------------------\n" ); } # If select has seen filehandle activity, then gather up the # active filehandles and synchronously dispatch events to the # appropriate handlers. if ($hits > 0) { # This is where they're gathered. It's a variant on a neat # hack Silmaril came up with. my (@rd_selects, @wr_selects, @ex_selects); foreach (@filenos) { push(@rd_selects, $_) if vec($rout, $_, 1); push(@wr_selects, $_) if vec($wout, $_, 1); push(@ex_selects, $_) if vec($eout, $_, 1); } if (TRACE_FILES) { if (@rd_selects) { POE::Kernel::_warn( " found pending rd selects: ", join( ', ', sort { $a <=> $b } @rd_selects ), "\n" ); } if (@wr_selects) { POE::Kernel::_warn( " found pending wr selects: ", join( ', ', sort { $a <=> $b } @wr_selects ), "\n" ); } if (@ex_selects) { POE::Kernel::_warn( " found pending ex selects: ", join( ', ', sort { $a <=> $b } @ex_selects ), "\n" ); } } if (ASSERT_FILES) { unless (@rd_selects or @wr_selects or @ex_selects) { POE::Kernel::_trap( " found no selects, with $hits hits from select???\n" ); } } # Enqueue the gathered selects, and flag them as temporarily # paused. They'll resume after dispatch. @rd_selects and $poe_kernel->_data_handle_enqueue_ready(MODE_RD, @rd_selects); @wr_selects and $poe_kernel->_data_handle_enqueue_ready(MODE_WR, @wr_selects); @ex_selects and $poe_kernel->_data_handle_enqueue_ready(MODE_EX, @ex_selects); } } } # Dispatch whatever events are due. $poe_kernel->_data_ev_dispatch_due(); # Reset the poller. $_handle_poller = $poe_main_window->after(100, [\&_poll_for_io]); } 1; __END__ =head1 NAME POE::Loop::TkActiveState - a POE/Tk bridge for ActiveState's Tk =head1 SYNOPSIS See L. =head1 DESCRIPTION POE::Loop::TkActiveState implements the interface documented in L. Therefore it has no documentation of its own. Please see L for more details. This version of POE::Loop::Tk handles unique behavioral differences discovered in ActiveState's build of Tk. It will be selected automatically based on the runtime environment. =head1 SEE ALSO L, L, L, L, L =head1 AUTHORS & LICENSING Please see L for more information about authors, contributors, and POE's licensing. =cut # rocco // vim: ts=2 sw=2 expandtab # TODO - Edit. POE-Loop-Tk-1.305/lib/POE/Loop/TkCommon.pm000644 000765 000024 00000011072 12205265621 017733 0ustar00trocstaff000000 000000 # The common bits of our system-specific Tk event loops. This is # everything but file handling. # Empty package to appease perl. package POE::Loop::TkCommon; # Include common signal handling. use POE::Loop::PerlSignals; use vars qw($VERSION); $VERSION = '1.305'; # NOTE - Should be #.### (three decimal places) use Tk 800.021; use 5.00503; # Everything plugs into POE::Kernel. package POE::Kernel; use strict; use Tk qw(DoOneEvent DONT_WAIT ALL_EVENTS); my $_watcher_time; #------------------------------------------------------------------------------ # Signal handler maintenance functions. sub loop_attach_uidestroy { my ($self, $window) = @_; $window->OnDestroy( sub { if ($self->_data_ses_count()) { $self->_dispatch_event( $self, $self, EN_SIGNAL, ET_SIGNAL, [ 'UIDESTROY' ], __FILE__, __LINE__, undef, time(), -__LINE__ ); } } ); } #------------------------------------------------------------------------------ # Maintain time watchers. sub loop_resume_time_watcher { my ($self, $next_time) = @_; $self->loop_pause_time_watcher(); my $timeout = $next_time - time(); if ( $timeout < 0 ) { $timeout = "idle"; } else { $timeout *= 1000; } $_watcher_time = $poe_main_window->after( $timeout, [ sub { } ] ); } sub loop_reset_time_watcher { my ($self, $next_time) = @_; $self->loop_resume_time_watcher($next_time); } sub loop_pause_time_watcher { my $self = shift; if (defined $_watcher_time) { $_watcher_time->cancel() if $_watcher_time->can("cancel"); $_watcher_time = undef; } } # 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. # # sub loop { # # Extra test without alarm handling makes alarm priority normal # (@immediate && run_signals), # DoOneEvent(DONT_WAIT | FILE_EVENTS | WINDOW_EVENTS) while # (@immediate && run_signals), !@loops && DoOneEvent; # return shift @loops; # } # # The immediate events are dispatched in a chunk between calls to Tk's # event loop. He uses a double buffer: As events are processed in # @immediate, new ones go into a different list. Once @immediate is # exhausted, the second list is copied in. # # The double buffered queue means that @immediate is alternately # exhausted and filled. It's impossible to fill @immediate while it's # being processed, so sub handle_foo { yield("foo") } won't run # forever. # # This has a side effect of deferring any alarms until after # @immediate is exhausted. I suspect the semantics are similar to # POE's queue anyway, however. #------------------------------------------------------------------------------ # Tk traps errors in an effort to survive them. However, since POE # does not, this leaves us in a strange, inconsistent state. Here we # re-trap the errors and rethrow them as UIDESTROY. sub Tk::Error { my $window = shift; my $error = shift; if (Tk::Exists($window)) { my $grab = $window->grab('current'); $grab->Unbusy if defined $grab; } chomp($error); POE::Kernel::_warn "Tk::Error: $error\n " . join("\n ",@_)."\n"; if ($poe_kernel->_data_ses_count()) { $poe_kernel->_dispatch_event( $poe_kernel, $poe_kernel, EN_SIGNAL, ET_SIGNAL, [ 'UIDESTROY' ], __FILE__, __LINE__, undef, time(), -__LINE__ ); } } #------------------------------------------------------------------------------ # The event loop itself. sub loop_do_timeslice { my $self = shift; # Check for a hung kernel. $self->_test_if_kernel_is_idle(); DoOneEvent(ALL_EVENTS); # Dispatch whatever events are due. Update the next dispatch time. $self->_data_ev_dispatch_due(); } sub loop_run { 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 { # Do nothing. } 1; __END__ =head1 NAME POE::Loop::TkCommon - common code between the POE/Tk event loop bridges =head1 SYNOPSIS See L. =head1 DESCRIPTION POE::Loop::TkCommon is a mix-in class that supports common features between POE::Loop::Tk and POE::Loop::TkActiveState. All Tk bridges implement the interface documented in POE::Loop. Therefore, please see L for more details. =head1 SEE ALSO L, L, L, L, L =head1 AUTHORS & LICENSING Please see L for more information about authors, contributors, and POE's licensing. =cut # rocco // vim: ts=2 sw=2 expandtab # TODO - Edit.