Re: Tk and waitVariable on tied variables

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

Comment on Re: Tk and waitVariable on tied variables Select or Download Code

Replies are listed 'Best First'.
Re: Re: Tk and waitVariable on tied variables by Roger (Parson) on Feb 16, 2004 at 10:37 UTC
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]
Re: Re: Re: Tk and waitVariable on tied variables by ant9000 (Monk) on Feb 16, 2004 at 11:40 UTC
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]
Re: Re: Re: Re: Tk and waitVariable on tied variables by xiper (Friar) on Feb 17, 2004 at 23:56 UTC
Well, i would have thought it's pretty obvious that's not the problem, as (if you'd run the program) when you press 'remote $wait++' the sub `stop` fires and $wait is incremented... See the output in my original post. Hmm, my perlport says that too, although i'd have to disagree. I've been sending & trapping signals on win32 for a while now and never noticed any real difference with unix... Update: perlport last update: v1.48, 02 February 2001 - that might explain it... use strict; $\|++; my @signal = sort grep( $_ ne 'KILL', keys( %SIG ) ); push( @signal, 'KILL' ); # SIGKILL last print "Signals: ", join( ', ', @signal ), "\n\n"; my $pid; unless( $pid = fork ) { foreach my $type ( @signal ) { $SIG{$type} = sub { print " SIG$type received!\n" }; } while( 1 ) { sleep 1 } } sleep 1; foreach ( @signal ) { print "Sending pid $pid a SIG$_...\n"; kill( $_, $pid ); sleep 1; } __END__ Signals: ABRT, ALRM, BREAK, CHLD, CLD, CONT, FPE, HUP, ILL, INT, NUM05 +, NUM06, NUM07, NUM10, NUM12, NUM16, NUM17, NUM18, NUM19, NUM24, PIPE +, QUIT, SEGV, STOP, TERM, KILL Sending pid -1336 a SIGABRT... SIGABRT received! Sending pid -1336 a SIGALRM... SIGALRM received! Sending pid -1336 a SIGBREAK... SIGQUIT received! Sending pid -1336 a SIGCHLD... SIGCLD received! Sending pid -1336 a SIGCLD... SIGCLD received! Sending pid -1336 a SIGCONT... SIGCONT received! Sending pid -1336 a SIGFPE... SIGFPE received! Sending pid -1336 a SIGHUP... SIGHUP received! Sending pid -1336 a SIGILL... SIGILL received! Sending pid -1336 a SIGINT... SIGINT received! Sending pid -1336 a SIGNUM05... SIGNUM05 received! Sending pid -1336 a SIGNUM06... SIGNUM06 received! Sending pid -1336 a SIGNUM07... SIGNUM07 received! Sending pid -1336 a SIGNUM10... SIGNUM10 received! Sending pid -1336 a SIGNUM12... SIGNUM12 received! Sending pid -1336 a SIGNUM16... SIGNUM16 received! Sending pid -1336 a SIGNUM17... SIGNUM17 received! Sending pid -1336 a SIGNUM18... SIGNUM18 received! Sending pid -1336 a SIGNUM19... SIGNUM19 received! Sending pid -1336 a SIGNUM24... SIGNUM24 received! Sending pid -1336 a SIGPIPE... SIGPIPE received! Sending pid -1336 a SIGQUIT... SIGQUIT received! Sending pid -1336 a SIGSEGV... SIGSEGV received! Sending pid -1336 a SIGSTOP... SIGSTOP received! Sending pid -1336 a SIGTERM... SIGTERM received! Sending pid -1336 a SIGKILL... (child dies) [download] - ><iper `use japh; print;` [download]	[reply] [d/l] [select]
Re: Re: Tk and waitVariable on tied variables by Roger (Parson) on Feb 16, 2004 at 12:27 UTC
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]
Re: Re: Re: Tk and waitVariable on tied variables by ant9000 (Monk) on Feb 16, 2004 at 13:41 UTC
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]