Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Tk and waitVariable on tied variables

by Roger (Parson)
on Feb 16, 2004 at 04:56 UTC ( [id://329217]=perlquestion: print w/replies, xml ) Need Help??

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++; }

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; ...
    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;
    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
      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?

        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 :-)
      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++; }

      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++;

      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

      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?

        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.
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
      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.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://329217]
Approved by Old_Gray_Bear
Front-paged by Courage
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others imbibing at the Monastery: (9)
As of 2024-04-26 08:53 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found