r44747 - in /branches/upstream/libpoe-loop-tk-perl: ./ current/ current/lib/ current/lib/POE/ current/lib/POE/Loop/ current/t/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Fri Sep 25 03:10:20 UTC 2009
Author: jawnsy-guest
Date: Fri Sep 25 03:10:09 2009
New Revision: 44747
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=44747
Log:
[svn-inject] Installing original source of libpoe-loop-tk-perl
Added:
branches/upstream/libpoe-loop-tk-perl/
branches/upstream/libpoe-loop-tk-perl/current/
branches/upstream/libpoe-loop-tk-perl/current/CHANGES
branches/upstream/libpoe-loop-tk-perl/current/MANIFEST
branches/upstream/libpoe-loop-tk-perl/current/MANIFEST.SKIP
branches/upstream/libpoe-loop-tk-perl/current/META.yml
branches/upstream/libpoe-loop-tk-perl/current/Makefile.PL
branches/upstream/libpoe-loop-tk-perl/current/README
branches/upstream/libpoe-loop-tk-perl/current/lib/
branches/upstream/libpoe-loop-tk-perl/current/lib/POE/
branches/upstream/libpoe-loop-tk-perl/current/lib/POE/Loop/
branches/upstream/libpoe-loop-tk-perl/current/lib/POE/Loop/Tk.pm
branches/upstream/libpoe-loop-tk-perl/current/lib/POE/Loop/TkActiveState.pm
branches/upstream/libpoe-loop-tk-perl/current/lib/POE/Loop/TkCommon.pm
branches/upstream/libpoe-loop-tk-perl/current/t/
branches/upstream/libpoe-loop-tk-perl/current/t/00_info.t
Added: branches/upstream/libpoe-loop-tk-perl/current/CHANGES
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpoe-loop-tk-perl/current/CHANGES?rev=44747&op=file
==============================================================================
--- branches/upstream/libpoe-loop-tk-perl/current/CHANGES (added)
+++ branches/upstream/libpoe-loop-tk-perl/current/CHANGES Fri Sep 25 03:10:09 2009
@@ -1,0 +1,55 @@
+=====================================
+2009-08-27T04:28:34.969753Z plt-1_302
+=====================================
+
+ 2009-08-27 04:26:09 (r2652) by rcaputo
+ polo-tk/lib/POE/Loop/TkActiveState.pm M; polo-tk/lib/POE/Loop/Tk.pm M;
+ polo-tk/lib/POE/Loop/TkCommon.pm M; polo-tk/Makefile.PL M
+
+ Add the info test we forgot to include.
+
+=====================================
+2009-08-26T15:39:28.802714Z plt-1_301
+=====================================
+
+ 2009-08-26 15:31:41 (r2645) by rcaputo
+ polo-tk/lib/POE/Loop/TkActiveState.pm M; polo-tk/lib/POE/Loop/Tk.pm M;
+ polo-tk/lib/POE/Loop/TkCommon.pm M; polo-tk/Makefile.PL M
+
+ Add POE::Test::Loops to configure_requires and build_requires.
+
+=====================================
+2009-08-26T02:33:50.734645Z plt-1_300
+=====================================
+
+ 2009-08-26 02:30:31 (r2638) by rcaputo; polo-tk/Makefile.PL M
+
+ We use the generic svn-log.perl, not the one included in POE.
+
+ 2009-08-25 17:05:17 (r2635) by rcaputo
+ polo-gtk/lib/POE/Loop A; polo-gtk/lib/POE/Loop/Gtk.pm A;
+ polo-tk/MANIFEST.SKIP A; polo-gtk/lib A; polo-gtk/MANIFEST A;
+ polo-gtk/MANIFEST.SKIP A; poe/lib/POE/Loop/TkActiveState.pm D;
+ polo-tk/Makefile.PL A; polo-tk/lib/POE A; polo-tk/lib/POE/Loop/Tk.pm A;
+ polo-gtk/Makefile.PL A; polo-tk/t/00_info.t A; polo-tk A;
+ poe/lib/POE/Loop/Gtk.pm D; polo-gtk/lib/POE A;
+ poe/lib/POE/Loop/TkCommon.pm D; polo-tk/lib/POE/Loop A; polo-tk/t A;
+ polo-gtk/README A; polo-event/lib/POE/Loop A; polo-gtk/t/00_info.t A;
+ polo-tk/MANIFEST A; polo-gtk A; polo-event/MANIFEST A; polo-event/lib
+ A; polo-gtk/t A; polo-event/MANIFEST.SKIP A;
+ polo-tk/lib/POE/Loop/TkActiveState.pm A; poe/mylib/Makefile-5005.pm M;
+ poe/lib/POE/Loop/Tk.pm D; polo-event/Makefile.PL A;
+ poe/lib/POE/Loop/Event.pm D; polo-event/lib/POE A; polo-tk/README A;
+ polo-event/README A; polo-event/lib/POE/Loop/Event.pm A;
+ polo-event/t/00_info.t A; polo-event A;
+ polo-tk/lib/POE/Loop/TkCommon.pm A; poe/MANIFEST M; polo-tk/lib A;
+ polo-event/t A
+
+ Create new project directories for POE::Loop::{Event,Tk,Gtk}. Moved
+ the loops to their new project directories. Configured the new
+ projects for CPAN distribution. Removed the event loops from POE's
+ distro configuration.
+
+==============
+End of Excerpt
+==============
Added: branches/upstream/libpoe-loop-tk-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpoe-loop-tk-perl/current/MANIFEST?rev=44747&op=file
==============================================================================
--- branches/upstream/libpoe-loop-tk-perl/current/MANIFEST (added)
+++ branches/upstream/libpoe-loop-tk-perl/current/MANIFEST Fri Sep 25 03:10:09 2009
@@ -1,0 +1,10 @@
+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
Added: branches/upstream/libpoe-loop-tk-perl/current/MANIFEST.SKIP
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpoe-loop-tk-perl/current/MANIFEST.SKIP?rev=44747&op=file
==============================================================================
--- branches/upstream/libpoe-loop-tk-perl/current/MANIFEST.SKIP (added)
+++ branches/upstream/libpoe-loop-tk-perl/current/MANIFEST.SKIP Fri Sep 25 03:10:09 2009
@@ -1,0 +1,29 @@
+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
+~$
Added: branches/upstream/libpoe-loop-tk-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpoe-loop-tk-perl/current/META.yml?rev=44747&op=file
==============================================================================
--- branches/upstream/libpoe-loop-tk-perl/current/META.yml (added)
+++ branches/upstream/libpoe-loop-tk-perl/current/META.yml Fri Sep 25 03:10:09 2009
@@ -1,0 +1,29 @@
+--- #YAML:1.0
+name: POE-Loop-Tk
+version: 1.302
+abstract: Tk event loop support for POE.
+author:
+ - Rocco Caputo <rcaputo at cpan.org>
+license: unknown
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+ POE::Test::Loops: 1.021
+build_requires:
+ ExtUtils::MakeMaker: 0
+ POE::Test::Loops: 1.021
+requires:
+ POE: 1.007
+ POE::Test::Loops: 1.021
+ Tk: 804.028
+resources:
+ license: http://dev.perl.org/licenses/
+ repository: https://poe.svn.sourceforge.net/svnroot/poe/trunk/polo-tk
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.54
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
Added: branches/upstream/libpoe-loop-tk-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpoe-loop-tk-perl/current/Makefile.PL?rev=44747&op=file
==============================================================================
--- branches/upstream/libpoe-loop-tk-perl/current/Makefile.PL (added)
+++ branches/upstream/libpoe-loop-tk-perl/current/Makefile.PL Fri Sep 25 03:10:09 2009
@@ -1,0 +1,109 @@
+#!/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 <rcaputo at cpan.org>',
+ 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://poe.svn.sourceforge.net/svnroot/poe/trunk/polo-tk'
+ ),
+ },
+ },
+ dist => {
+ COMPRESS => 'gzip -9f',
+ SUFFIX => 'gz',
+ PREOP => (
+ 'svn-log.perl --tags ^plt- | ' .
+ '/usr/bin/tee ./$(DISTNAME)-$(VERSION)/CHANGES > ./CHANGES'
+ ),
+ },
+ clean => { FILES => 't/poe_loop_tk/*.t t/poe_loop_tk' },
+ test => { TESTS => 't/*.t t/poe_loop_tk/*.t' },
+
+ CONFIGURE_REQUIRES => {
+ 'ExtUtils::MakeMaker' => 0,
+ 'POE::Test::Loops' => 1.021,
+ },
+
+ META_MERGE => {
+ build_requires => {
+ 'POE::Test::Loops' => 1.021,
+ },
+ },
+
+ PREREQ_PM => {
+ 'POE' => 1.007,
+ 'POE::Test::Loops' => 1.021,
+ 'Tk' => 804.028,
+ },
+);
+
+1;
Added: branches/upstream/libpoe-loop-tk-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpoe-loop-tk-perl/current/README?rev=44747&op=file
==============================================================================
--- branches/upstream/libpoe-loop-tk-perl/current/README (added)
+++ branches/upstream/libpoe-loop-tk-perl/current/README Fri Sep 25 03:10:09 2009
@@ -1,0 +1,12 @@
+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!
Added: branches/upstream/libpoe-loop-tk-perl/current/lib/POE/Loop/Tk.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpoe-loop-tk-perl/current/lib/POE/Loop/Tk.pm?rev=44747&op=file
==============================================================================
--- branches/upstream/libpoe-loop-tk-perl/current/lib/POE/Loop/Tk.pm (added)
+++ branches/upstream/libpoe-loop-tk-perl/current/lib/POE/Loop/Tk.pm Fri Sep 25 03:10:09 2009
@@ -1,0 +1,239 @@
+# Tk-Perl event loop bridge for POE::Kernel.
+
+package POE::Loop::Tk;
+
+use vars qw($VERSION);
+$VERSION = '1.302'; # NOTE - Should be #.### (three decimal places)
+
+# Include common things.
+use POE::Loop::PerlSignals;
+use POE::Loop::TkCommon;
+
+use Tk 800.021;
+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<POE::Loop>.
+
+=head1 DESCRIPTION
+
+POE::Loop::Tk implements the interface documented in L<POE::Loop>.
+Therefore it has no documentation of its own. Please see L<POE::Loop>
+for more details.
+
+POE::Loop::Tk is one of two versions of the Tk event loop bridge. The
+other, L<POE::Loop::TkActiveState> accommodates behavior differences
+in ActiveState's build of Tk. Both versions share common code in
+L<POE::Loop::TkCommon>. POE::Loop::Tk dynamically selects the
+appropriate bridge code based on the runtime enviroment.
+
+=head1 SEE ALSO
+
+L<POE>, L<POE::Loop>, L<Tk>, L<POE::Loop::TkCommon>,
+L<POE::Loop::PerlSignals>.
+
+=head1 AUTHORS & LICENSING
+
+Please see L<POE> for more information about authors, contributors,
+and POE's licensing.
+
+=cut
+
+# rocco // vim: ts=2 sw=2 expandtab
+# TODO - Edit.
Added: branches/upstream/libpoe-loop-tk-perl/current/lib/POE/Loop/TkActiveState.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpoe-loop-tk-perl/current/lib/POE/Loop/TkActiveState.pm?rev=44747&op=file
==============================================================================
--- branches/upstream/libpoe-loop-tk-perl/current/lib/POE/Loop/TkActiveState.pm (added)
+++ branches/upstream/libpoe-loop-tk-perl/current/lib/POE/Loop/TkActiveState.pm Fri Sep 25 03:10:09 2009
@@ -1,0 +1,289 @@
+# 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.302'; # 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 "<rc> 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(
+ "<fh> ,----- SELECT BITS IN -----\n",
+ "<fh> | READ : ", unpack('b*', $loop_vectors[MODE_RD]), "\n",
+ "<fh> | WRITE : ", unpack('b*', $loop_vectors[MODE_WR]), "\n",
+ "<fh> | EXPEDITE: ", unpack('b*', $loop_vectors[MODE_EX]), "\n",
+ "<fh> `--------------------------\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("<fh> select error: $!") unless (
+ ($! == EINPROGRESS) or
+ ($! == EWOULDBLOCK) or
+ ($! == EINTR)
+ );
+ }
+ }
+
+ if (TRACE_FILES) {
+ if ($hits > 0) {
+ POE::Kernel::_warn "<fh> select hits = $hits\n";
+ }
+ elsif ($hits == 0) {
+ POE::Kernel::_warn "<fh> select timed out...\n";
+ }
+ POE::Kernel::_warn(
+ "<fh> ,----- SELECT BITS OUT -----\n",
+ "<fh> | READ : ", unpack('b*', $rout), "\n",
+ "<fh> | WRITE : ", unpack('b*', $wout), "\n",
+ "<fh> | EXPEDITE: ", unpack('b*', $eout), "\n",
+ "<fh> `---------------------------\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(
+ "<fh> found pending rd selects: ",
+ join( ', ', sort { $a <=> $b } @rd_selects ),
+ "\n"
+ );
+ }
+ if (@wr_selects) {
+ POE::Kernel::_warn(
+ "<sl> found pending wr selects: ",
+ join( ', ', sort { $a <=> $b } @wr_selects ),
+ "\n"
+ );
+ }
+ if (@ex_selects) {
+ POE::Kernel::_warn(
+ "<sl> 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(
+ "<fh> 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<POE::Loop>.
+
+=head1 DESCRIPTION
+
+POE::Loop::TkActiveState implements the interface documented in
+L<POE::Loop>. Therefore it has no documentation of its own. Please
+see L<POE::Loop> 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<POE>, L<POE::Loop>, L<Tk>, L<POE::Loop::Tk>,
+L<POE::Loop::PerlSignals>
+
+=head1 AUTHORS & LICENSING
+
+Please see L<POE> for more information about authors, contributors,
+and POE's licensing.
+
+=cut
+
+# rocco // vim: ts=2 sw=2 expandtab
+# TODO - Edit.
Added: branches/upstream/libpoe-loop-tk-perl/current/lib/POE/Loop/TkCommon.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpoe-loop-tk-perl/current/lib/POE/Loop/TkCommon.pm?rev=44747&op=file
==============================================================================
--- branches/upstream/libpoe-loop-tk-perl/current/lib/POE/Loop/TkCommon.pm (added)
+++ branches/upstream/libpoe-loop-tk-perl/current/lib/POE/Loop/TkCommon.pm Fri Sep 25 03:10:09 2009
@@ -1,0 +1,191 @@
+# 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.302'; # 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 ", at _)."\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();
+ my $now;
+ $now = time() if TRACE_STATISTICS;
+
+ DoOneEvent(ALL_EVENTS);
+
+ $self->_data_stat_add('idle_seconds', time() - $now) if TRACE_STATISTICS;
+
+ # 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<POE::Loop>.
+
+=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<POE::Loop> for more details.
+
+=head1 SEE ALSO
+
+L<POE>, L<POE::Loop>, L<Tk>, L<POE::Loop::Tk>,
+L<POE::Loop::TkActiveState>
+
+=head1 AUTHORS & LICENSING
+
+Please see L<POE> for more information about authors, contributors,
+and POE's licensing.
+
+=cut
+
+# rocco // vim: ts=2 sw=2 expandtab
+# TODO - Edit.
Added: branches/upstream/libpoe-loop-tk-perl/current/t/00_info.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpoe-loop-tk-perl/current/t/00_info.t?rev=44747&op=file
==============================================================================
--- branches/upstream/libpoe-loop-tk-perl/current/t/00_info.t (added)
+++ branches/upstream/libpoe-loop-tk-perl/current/t/00_info.t Fri Sep 25 03:10:09 2009
@@ -1,0 +1,9 @@
+#!/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");
+
More information about the Pkg-perl-cvs-commits
mailing list