mainly tk fixes

Changes

@@ -4,8 +4,18 @@ Revision history for POE
 ========================
 
 Changes marked with "(!!!)" may break backward compatibility.
-Versions with "_xx" subversions are internal test releases.  Most
-subversions are available from <http://www.newts.org/~troc/poe.html>.
+
+Changes marked with "(???)" are informational.
+
+Version numbers have four fields: X.YYZZAA
+
+  X  is the interface version, currently 0 as public interfaces gel.
+  YY is the major revision number.
+  ZZ is the minor revision number.  It's 00 for public CPAN releases,
+     or nonzero for beta web site releases.
+  AA is a testing revision.  It's usually 00, which means the tarball
+     is a public release.  Nonzero versions are limited alpha level
+     releases (development snapshots) for specific testers.
 
 [ Hey, Rocco, don't forget to assign a tag to the release after you
   make dist on it!  0.0910 is ``v0_0910''!  For example:
@@ -16,24 +26,89 @@ subversions are available from <http://www.newts.org/~troc/poe.html>.
 
 ,----- To Do -----
 |
-| After 0.11
+| Why does samples/tk.perl leak memory, and how can I fix it?
 |
-| Filter::HTTPD test.
-| Wheel::ListenAccept rewrite & tests.
+| caller() calls in POE::Kernel report POE::Kernel lines.  They
+| should follow the call chain out to someone else's code.
+|
+| Write a Filter::HTTPD test.
+|
+| Wheel::ListenAccept is way behind SocketFactory's listen/accept
+| code.  Migrate SocketFactory's code to ListenAccept, and write
+| a test based on IO::Socket::INET sockets.
 |
 | Add new newlines to Filter::Line.
 |
 | Split the samples out into a separate distribution.
+|
 | Revise the POE web pages.
 |
+| Move the POE mailing list, which seems to have fallen on hard times.
+|
 `-----------------
 
+
 0.1101 2000.??.??
 -----------------
 
-Added samples/neural-net.perl.  Someone on IRC was lamenting over
-perl's threads, and he needed parallel computing for a neural network
-he wanted to write, so I wrote this prototype/tutorial for him.  Not
+This public release also contains the changes found in private testing
+releases 0.110001 and 0.110002.  Please see the changes in those
+revisions as well.
+
+A peculiar sort of memory corruption is occurring when POE 0.11 is
+running under perl 5.6.0 (not perl-current, it seems) and Perl/Tk
+800.021 (and 800.022).  One specific string encounters a substitution,
+in the same place but at random times.  It seems that its "->"
+substring is being changed into "-<", which causes samples/tk.perl to
+fail quietly.  Changing the substring to "-!>" `fixes' the problem, as
+does removing the arrow altogether (which is what I eventually did).
+I don't know why it's happening, and close scrutiny seems to make the
+problem go away.
+
+
+0.110002 2000.07.23
+-------------------
+
+This is a private testing release for a single person.
+
+Tweak samples/tk.perl.  Add labels to the different fields, add a
+counter to run in the background when the window loses its focus, and
+add a _default state to catch misnamed events.  This is part of a bug
+hunt in Wheel::FollowTail.
+
+It seems to be a Bad Thing to set a Tk callback from a Tk callback of
+the same type.  I had discovered this early on with the Tk afterIdle()
+callback that drives POE's FIFO queue, but the problem didn't occur
+with the Tk after() callback that drives POE's alarms.  Well, the
+deadlock does occur for alarms, but it only happens when they're
+scheduled for sooner than the current callback returns.  I've changed
+the Tk after() callback to reset itself from a Tk afterIdle()
+callback, making this a two-phase sort of flip-flop thing like the
+afterIdle() callback.  (The afterIdle() callback resets itself from an
+after() callback scheduled for 0us hence.)
+
+Added debugging and coverage code to the MANIFEST: lib/Devel/Null.pm;
+lib/Devel/Trace.pm; lib/coverage.perl.
+
+
+0.110001 2000.07.21
+-------------------
+
+This is a private testing release for a single person.
+
+Supply a Tk::Event::IO::SEEK in Wheel::FollowTail, since FollowTail
+needs sysseek, which calls SEEK, and Tk::Event::IO doesn't include
+one.  Use sysseek in FollowTail to clear the eof indicator, but wrap
+it in a block eval for times when one oughtn't be seeking.
+
+sysseek(2) can seek back past the start of a file on some systems.  Do
+some extra gyrations in Wheel::FollowTail to prevent its SeekBack
+parameter (or the default) from seeking back farther than the file's
+start.
+
+Added samples/neural-net.perl.  Crysflame was lamenting over perl's
+threads, and he needed parallel computing for a neural network he
+wanted to write, so I wrote this prototype/tutorial for him.  Not
 knowing much about neural networks, it's pretty useless.  It does show
 off POE for pseudo-concurrency, though.
 

MANIFEST

@@ -29,6 +29,9 @@ POE/Wheel/ListenAccept.pm
 POE/Wheel/ReadWrite.pm
 POE/Wheel/SocketFactory.pm
 README
+lib/coverage.perl
+lib/Devel/Null.pm
+lib/Devel/Trace.pm
 lib/MyOtherFreezer.pm
 lib/TestSetup.pm
 samples/create.perl

lib/POE.pm

@@ -7,7 +7,7 @@ use strict;
 use Carp;
 
 use vars qw($VERSION);
-$VERSION = '0.1101';
+$VERSION = '0.110002';
 
 sub import {
   my $self = shift;

lib/POE/Kernel.pm

@@ -1482,7 +1482,10 @@ sub run {
 }
 
 #------------------------------------------------------------------------------
-# Tk support.
+# Tk support.  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.
 
 # Tk idle callback to dispatch FIFO states.  This steals a big chunk
 # of code from POE::Kernel::run().  Make this function's guts a macro
@@ -1531,22 +1534,41 @@ sub _tk_alarm_callback {
 
   {% dispatch_due_alarms %}
 
+  # 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 alarm
+  # callback from an idle event.
+
   # Register the next timed callback if there are alarms left.
 
   if (@{$self->[KR_ALARMS]}) {
 
+    # Cancel the Tk alarm that handles alarms.
+
     if (defined $self->[KR_WATCHER_TIMER]) {
       $self->[KR_WATCHER_TIMER]->cancel();
       $self->[KR_WATCHER_TIMER] = undef;
     }
 
-    my $next_time = $self->[KR_ALARMS]->[0]->[ST_TIME] - time();
-    $next_time = 0 if $next_time < 0;
+    # Replace it with an idle event that will reset the alarm.
 
     $self->[KR_WATCHER_TIMER] =
-      $poe_tk_main_window->after( $next_time * 1000,
-                                  \&_tk_alarm_callback
-                                );
+      $poe_tk_main_window->afterIdle
+        ( sub {
+            $self->[KR_WATCHER_TIMER]->cancel();
+            $self->[KR_WATCHER_TIMER] = undef;
+
+            if (@{$self->[KR_ALARMS]}) {
+              my $next_time = $self->[KR_ALARMS]->[0]->[ST_TIME] - time();
+              $next_time = 0 if $next_time < 0;
+
+              $self->[KR_WATCHER_TIMER] =
+                $poe_tk_main_window->after( $next_time * 1000,
+                                            \&_tk_alarm_callback
+                                          );
+            }
+          }
+        );
   }
 
   # Make sure the kernel can still run.
@@ -2000,7 +2022,6 @@ sub _enqueue_alarm {
     # If using Tk and the alarm queue now has only one event, then
     # register a Tk timed callback to dispatch it when it becomes due.
     if ( POE_HAS_TK and @{$self->[KR_ALARMS]} == 1 ) {
-
       if (defined $self->[KR_WATCHER_TIMER]) {
         $self->[KR_WATCHER_TIMER]->cancel();
         $self->[KR_WATCHER_TIMER] = undef;
@@ -2148,7 +2169,7 @@ sub alarm {
   # If using Tk and the alarm queue is empty, then discard the Tk
   # alarm callback.
   if (POE_HAS_TK and @{$self->[KR_ALARMS]} == 0) {
-    # -><- Remove the idle handler.
+    # -><- Remove the alarm handler.  Is this necessary?
   }
 
   # If using Event and the alarm queue is empty, then ensure that the

lib/POE/Wheel/FollowTail.pm

@@ -9,6 +9,23 @@ use POE;
 
 sub CRIMSON_SCOPE_HACK ($) { 0 }
 
+# Turn on tracing.  A lot of debugging occurred just after 0.11.
+sub TRACE () { 0 }
+
+# Tk doesn't provide a SEEK method, as of 800.022
+BEGIN {
+  if (exists $INC{'Tk.pm'}) {
+    eval <<'    EOE';
+      sub Tk::Event::IO::SEEK {
+        my $o = shift;
+        $o->wait(Tk::Event::IO::READABLE);
+        my $h = $o->handle;
+        sysseek($h, shift, shift);
+      }
+    EOE
+  }
+}
+
 #------------------------------------------------------------------------------
 
 sub new {
@@ -33,13 +50,14 @@ sub new {
                         : 1
                       );
 
-  my $seek_back = ( (exists $params{'SeekBack'})
-                    ? $params{'SeekBack'}
+  my $seek_back = ( ( exists($params{SeekBack})
+                      and defined($params{SeekBack})
+                    )
+                    ? $params{SeekBack}
                     : 4096
                   );
   $seek_back = 0 if $seek_back < 0;
 
-
   my $self = bless { handle      => $handle,
                      driver      => $driver,
                      filter      => $filter,
@@ -57,9 +75,21 @@ sub new {
   $poe_kernel->select($handle, $self->{state_read});
 
   # Try to position the file pointer before the end of the file.  This
-  # is so we can "tail -f" an existing file.
-
-  eval { seek($handle, -$seek_back, SEEK_END); };
+  # is so we can "tail -f" an existing file.  FreeBSD, at least,
+  # allows sysseek to go before the beginning of a file.  Trouble
+  # ensues at that point, causing the file never to be read again.
+  # This code does some extra work to prevent seeking beyond the start
+  # of a file.
+
+  eval {
+    my $end = sysseek($handle, 0, SEEK_END);
+    if (defined($end) and ($end < $seek_back)) {
+      sysseek($handle, 0, SEEK_SET);
+    }
+    else {
+      sysseek($handle, -$seek_back, SEEK_END);
+    }
+  };
 
   # Discard partial input chunks unless a SeekBack was specified.
   unless (exists $params{SeekBack}) {
@@ -88,13 +118,15 @@ sub _define_states {
   my $driver        = $self->{driver};
   my $event_input   = \$self->{event_input};
   my $event_error   = \$self->{event_error};
-  my $state_wake    = $self->{state_wake} = $self . ' -> alarm';
-  my $state_read    = $self->{state_read} = $self . ' -> select read';
+  my $state_wake    = $self->{state_wake} = $self . ' alarm';
+  my $state_read    = $self->{state_read} = $self . ' select read';
   my $poll_interval = $self->{interval};
   my $handle        = $self->{handle};
 
   # Define the read state.
 
+  TRACE and do { warn $state_read; };
+
   $poe_kernel->state
     ( $state_read,
       sub {
@@ -103,33 +135,46 @@ sub _define_states {
                                         # subroutine starts here
         my ($k, $ses, $hdl) = @_[KERNEL, SESSION, ARG0];
 
+        $k->select_read($hdl);
+
+        eval { sysseek($hdl, 0, SEEK_CUR); };
+        $! = 0;
+
+        TRACE and do { warn time . " read ok\n"; };
+
         if (defined(my $raw_input = $driver->get($hdl))) {
+          TRACE and do { warn time . " raw input\n"; };
           foreach my $cooked_input (@{$filter->get($raw_input)}) {
+            TRACE and do { warn time . " cooked input\n"; };
             $k->call($ses, $$event_input, $cooked_input);
           }
         }
 
-        $k->select_read($hdl);
-
         if ($!) {
+          TRACE and do { warn time . " error: $!\n"; };
           $$event_error && $k->call($ses, $$event_error, 'read', ($!+0), $!);
         }
-        else {
-          $k->delay($state_wake, $poll_interval);
-        }
+
+        TRACE and do { warn time . " set delay\n"; };
+        $k->delay($state_wake, $poll_interval);
       }
     );
 
   # Define the alarm state that periodically wakes the wheel and
   # retries to read from the file.
 
+  TRACE and do { warn $state_wake; };
+
   $poe_kernel->state
     ( $state_wake,
       sub {
                                         # prevents SEGV
         0 && CRIMSON_SCOPE_HACK('<');
                                         # subroutine starts here
         my $k = $_[KERNEL];
+
+        TRACE and do { warn time . " wake up and select the handle\n"; };
+
         $k->select_read($handle, $state_read);
       }
     );
@@ -206,8 +251,9 @@ POE::Wheel - POE FollowTail Protocol Logic
 This wheel follows the end of an ever-growing file, perhaps a log
 file, and generates events whenever new data appears.  It is a
 read-only wheel, so it does not include a put() method.  It uses
-tell() and seek() functions, so it's only suitable for plain files.
-It won't tail pipes or consoles.
+sysseek(2) wrapped in eval { }, so it should work okay on all sorts of
+files.  That is, if perl supports select(2)'ing them on the underlying
+operating system.
 
 =head1 PUBLIC METHODS
 
@@ -260,7 +306,9 @@ ErrorState
 
 The ErrorState event contains the name of the state that will be
 called when a file error occurs.  The FollowTail wheel knows what to
-do with EAGAIN, so it's not considered a true error.
+do with EAGAIN, so it's not considered a true error.  FollowTail will
+continue running even on an error, so it's up to the Session to stop
+things if that's what it wants.
 
 The ARG0 parameter contains the name of the function that failed.
 ARG1 and ARG2 contain the numeric and string versions of $! at the

lib/POE/Wheel/ListenAccept.pm

@@ -73,7 +73,7 @@ sub _define_accept_state {
   my $handle       = $self->{handle};
                                         # register the select-read handler
   $poe_kernel->state
-    ( $self->{'state read'} =  $self . ' -> select read',
+    ( $self->{'state read'} =  $self . ' select read',
       sub {
                                         # prevents SEGV
         0 && CRIMSON_SCOPE_HACK('<');

lib/POE/Wheel/ReadWrite.pm

@@ -152,7 +152,7 @@ sub _define_write_state {
   # Register the select-write handler.
 
   $poe_kernel->state
-    ( $self->[STATE_WRITE] = $self . ' -> select write',
+    ( $self->[STATE_WRITE] = $self . ' select write',
       sub {                             # prevents SEGV
         0 && CRIMSON_SCOPE_HACK('<');
                                         # subroutine starts here
@@ -231,7 +231,7 @@ sub _define_read_state {
     my $event_error  = \$self->[EVENT_ERROR];
 
     $poe_kernel->state
-      ( $self->[STATE_READ] = $self . ' -> select read',
+      ( $self->[STATE_READ] = $self . ' select read',
         sub {
                                         # prevents SEGV
           0 && CRIMSON_SCOPE_HACK('<');