Roger has asked for the wisdom of the Perl Monks concerning the following question:

Dear monks, brother xiper has posted a question (329204) on using Tk's waitVariable with (MMF) tied variables. I will post the code here again.

use strict;
use Tk;
use Win32::MMF::Shareable;

print "Process starting...\n";

my $ns = tie my $wait, 'Win32::MMF::Shareable', 'wait' or die;
$wait = 0;

my $pid = fork;
if (!$pid)
{
  $SIG{HUP} = \&stop;
  while( 1 ) { print "tick()\n"; sleep 1 }
}

my $mw = MainWindow->new;
$mw->Button( -text => '$wait',                   -command => sub { pri
+nt "\$wait is $wait\n" } )->pack;
$mw->Button( -text => 'waitVariable( \\$wait )', -command => \&start )
+->pack;
$mw->Button( -text => 'local $wait++',           -command => \&stop  )
+->pack;
$mw->Button( -text => 'remote $wait++',          -command => sub{ kill
+( 'HUP', $pid ) } )->pack;

MainLoop;

kill( 'TERM', $pid );

sub start
{
  print "waiting for \$wait (was $wait)\n";
  $mw->waitVariable( \$wait );
  print "finished waiting for \$wait (is now $wait)\n";
}

sub stop
{
  print "\$wait++ by pid $$\n";
  $wait++;
}

[download]

Basically the code does a waitVariable on $wait, which should be updated by the child process upon receiving a 'HUP' signal. When I ran the code, the value of $wait was actually incremented by the child process, however the Tk's waitVariable didn't catch the updated variable, eventhough the value of the variable did change.

After hours of going through the Tk source, I couldn't figure out a sensible explanation to why this is happenning. I suspect it's because Tk's wait function goes too low level that it 'bypassed' the perl tie() handler and watches a local copy of the variable instead?

Can someone please give an explanation to this strangeness, and a possible cure? Thanks!

Replies are listed 'Best First'.
Re: Tk and waitVariable on tied variables
by ant9000 (Monk) on Feb 16, 2004 at 09:00 UTC
    I don't have your same environment, but as far as I can tell you should point your finger at Win32::MMF::Shareable, not at Tk.
    I've tried the following variation of your code: 
    ...
#use Win32::MMF::Shareable;
use ScalarTieTest;

print "Process starting...\n";

#my $ns = tie my $wait, 'Win32::MMF::Shareable', 'wait' or die;
my $ns = tie my $wait, 'ScalarTieTest', 'wait' or die;
...

    [download]
    where the module ScalarTieTest is just this quick'n'dirty hack: 
    package ScalarTieTest;
use Carp;
use strict;

sub TIESCALAR {
 my $class = shift;
 my $scalar = shift;
 carp "ScalarTieTest::TIESCALAR($scalar)";
 return bless \$scalar, $class;
}

sub FETCH {
 my $self = shift;
 confess "wrong type" unless ref $self;
 croak "usage error" if @_;
 carp "ScalarTieTest::FETCH()";
 return $$self;
}

sub STORE {
 my $self = shift;
 confess "wrong type" unless ref $self;
 my $new_scalar = shift;
 croak "usage error" if @_;
 carp "ScalarTieTest::STORE($new_scalar)";

 $$self=$new_scalar;
 return $new_scalar;
}

1;

    [download]
    Everything runs fine on my Linux Perl 5.6.1: this leaves me thinking that if you want to go through the source of something, you'd better dig into your IPC module's internals. A good starting point could be to add debugging info to all of the FETCH/STORE operations of the module.
    HTH,
    Ant9000
[reply]
[d/l]
[select]
      Hi ant9000, thanks for trying out the code. I tried your ScalarTieTest module with the Tk test script, and I get the exact same behaviour as my Shareable module. Something smells fishy here... Perhaps this problem is Windows specific, may be the kill 'HUP', $pid didn't work as expected on Windows platform?

[reply]
        I think you hit the right spot! This is from perlport man page: 
         "kill()" doesn't have the semantics of "raise()",
 i.e. it doesn't send a signal to the identified
 process like it does on Unix platforms.  Instead
 "kill($sig, $pid)" terminates the process identi­
 fied by $pid, and makes it exit immediately with
 exit status $sig.  As in Unix, if $sig is 0 and
 the specified process exists, it returns true
 without actually terminating it. (Win32)
        I can't tell you where to go from now, but at least you've found out what the problem is - and made me learn something, too :-)
[reply]
      Hi ant9000, I have modified the test program, this time I have confirmed that there is a 'bug?' inside Tk's waitVariable method.

      The main script
      use strict;
use Tk;
use Win32::MMF::Shareable;

print "Process starting...\n";

my $ns = tie my $wait, 'Win32::MMF::Shareable', 'wait' or die;
$wait = 0;

my $mw = MainWindow->new;
$mw->Button( -text => '$wait',                   -command => sub { pri
+nt "\$wait is $wait\n" } )->pack;
$mw->Button( -text => 'waitVariable( \\$wait )', -command => \&start )
+->pack;
$mw->Button( -text => 'local $wait++',           -command => \&stop  )
+->pack;
$mw->Button( -text => 'remote $wait++',          -command => sub{ syst
+em "tkremote.pl" } )->pack;

MainLoop;

sub start
{
  print "waiting for \$wait (was $wait)\n";
  $mw->waitVariable( \$wait );
  print "finished waiting for \$wait (is now $wait)\n";
}

sub stop
{
  print "\$wait++ by pid $$\n";
  $wait++;
}

      [download]

      And the child script -
      use strict;
use Tk;
use Win32::MMF::Shareable;

tie my $wait, 'Win32::MMF::Shareable', 'wait' or die;
print "Remote process $$ increment \$wait...\n";
$wait++;

      [download]

      And I have added debug message to the FETCH method in Shareable.pm. The following is the results I got:

      Process starting...                 # 3008 is pid of main

3008 FETCHING...                    # pressed waitVariable
waiting for $wait (was 0)

$wait++ by pid 3008                 # pressed local++
3008 FETCHING...
3008 FETCHING...
3008 FETCHING...
finished waiting for $wait (is now 1)

3008 FETCHING...
waiting for $wait (was 1)
Remote process 3808 increment $wait...  # pressed remote++
3808 FETCHING...             # remote process incremented $wait

3008 FETCHING...             # pressed 'wait'
$wait is 2

      [download]

      As you can see here, eventhough the remote process incremented the $wait variable, the Tk's waitVariable method skipped the FETCH of the tied variable.

      Any ideas?

[reply]
[d/l]
[select]
        You could try to add a debug line to STORE, too: that way, following the process should be easier; in any case, it seems that STORE gets called correctly by tkremote.pl, but that the tie interface is not notified when $wait changes.
        Well, I cannot solve your problem, but I might offer you a bunch of CPAN suggestions for a workaround:
        • Tie::Watch, implementing "watches" or callbacks over Perl variables (could be the module Tk is using under the hood, dunno)
        • Tie::Coupler, to couple scalars together (maybe this module "senses" changes better than Tk?)
        • Tie::RemoteVar, a mechanism for sharing variables that should be both easy to use and more portable than the one you're using.
        I have not actually tried any of those, but they seem a promising starting point.
[reply]
[d/l]
[select]
Re: Tk and waitVariable on tied variables
by JamesNC (Chaplain) on Feb 16, 2004 at 22:14 UTC
    I wouldn't be surprised if waitVariable is broken... interps, and fileevent are broken under Win32, Steve Lidie confessed this to me via e-mail while I was reading "Mastering Perl/Tk" and having problems ... his examples (ie..tkComics) weren't working on Win32. I banged my head on this one for a long time about a year ago. Threads won't work as expected and fork blows up. As far as I know, POE is the only way to solve these types of issues. I am curious if pTk or the few other Perl/Gui's have solved these issues on Win32. Try posting to the perl.tk newsgroup brother monk.
    JamesNC
[reply]
      Hi JamesNC, thanks for the info, I am now certain the problem can not be easily solved. I will try the perl.tk newsgroup when I get back home tonight.

[reply]

Back to Seekers of Perl Wisdom