Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister

Re: Perl/Tk and Threads

by gri6507 (Deacon)
on Jun 17, 2004 at 13:24 UTC ( #367607=note: print w/replies, xml ) Need Help??

in reply to Perl/Tk and Threads

One way to do it would be to fork off another process which would communicate to the parent through a socket and have the parent test the socket with select() in a repeat() event. Take a look at the code (untested snipets of an older app).

my $mw = MainWindow->new(); spawn_child(); $mw->repeat(100,\&read_child); sub read_child { my $rin = ""; vec($rin, fileno(CHILD), 1) = 1; my $err = $rin; for (0 .. 3) { # try to read from Child this many times before calli +ng it quits my ($nfound,$timeleft) = select($rin,undef,$err,0.001); print "$nfound." if ($debug > 1); while ($nfound) { # there is some data waiting to be read my $line = <CHILD>; ... ($nfound,$timeleft) = select($rin,undef,$err,0.0001); print ":$nfound" if ($debug > 1); } } print "\n" if ($debug > 1); } sub spawn_child { # parent process does only the GUI stuff all of the tester communica +tion # stuff hapens in the child only. The child sits around waiting for +the # parent to tell it to do something. The child does it, figures out +the # progress percentage, and informs the parent. The parent, upon rece +iving # this notification, update the GUI. socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC); CHILD->autoflush(1); PARENT->autoflush(1); die unless defined($childPid=fork()); if ($childPid){ close PARENT; return; } # child process close CHILD; my $use_mfg_mode = 0; Loop: while(my $line = <PARENT>){ my $update = ""; print "received from parent: $line" if ($debug); print PARENT "progress: $update\n"; } print "Child is done!\n" if ($debug); exit(); }

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://367607]
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (8)
As of 2018-06-22 11:53 GMT
Find Nodes?
    Voting Booth?
    Should cpanminus be part of the standard Perl release?

    Results (124 votes). Check out past polls.