Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Tk Dialog From Multiple POE Processes?

by cmv (Chaplain)
on Dec 17, 2009 at 19:53 UTC ( #813252=perlquestion: print w/ replies, xml ) Need Help??
cmv has asked for the wisdom of the Perl Monks concerning the following question:

Folks-

I have a Perl script using both Tk and POE, where Tk Dialog boxes are needed to ask the user questions. These dialog boxes can be originated from either the parent and/or (possibly multiple) children processes.

My current demonstration code (listed below) works fine when the dialog box is originated from the parent, but dies with various errors when the child tries to originate the dialog box. The most common error (under MacOSX) is:

X Error of failed request: BadIDChoice (invalid resource ID chosen fo +r this connection) Major opcode of failed request: 55 (X_CreateGC) Resource id in failed request: 0xa00005 Serial number of failed request: 575 Current serial number in output stream: 574
I usually have to do an xkill on the parent window to get rid of it (but not always).

My question is: How should I get the child to successfully get information from the user via a dialog box?

I'm pretty sure I'm just not working things correctly here. I'm guessing the child process has no idea who the parent's main window is, and I don't know how to get the child to create it's own main window. Also, I'm not sure if it might be better to simply have the child/children all asking the parent to ask the user for everything.

To work the sample code:
1.) Run the script
2.) Push the button, enter something, and click ok before 10 secs, to see the working stuff from the parent.
3.) Do nothing, and the child will try to ask you something after 10 seconds.

Please feel free to refactor my code if you are so inclined, so it can be used as an example in the POE cookbook.

Thanks!

-Craig

use strict; use warnings; # The "use Tk" MUST be before "use POE"... use Tk; use Tk::DialogBox; use POE; use POE::Wheel::Run; # Create GUI window... my $top = $::poe_main_window; $top->geometry('300x50'); $top->title("PID=$$"); $top->protocol('WM_DELETE_WINDOW', sub{exit}); # Create button to push... $top->Button(-text=>'Push Me', -command=>sub{ print STDERR "Asking User\n"; print STDERR "Got: ", AskUser("PID=$$"), "\n"; })->pack; my $session=_poeSetup(); # Go... $poe_kernel->run(); sub _poeSetup { my $session = POE::Session->create( inline_states=>{ KidOut => sub { my ($line, $wid) = @_[ARG0, ARG1]; my $child = $_[HEAP]{Kids}{WID}{$wid}; print STDERR $child->PID . " OUT: $line\n"; }, KidErr => sub { my ($line, $wid) = @_[ARG0, ARG1]; my $child = $_[HEAP]{Kids}{WID}{$wid}; print STDERR $child->PID . " ERR: $line\n"; }, KidClose => \&_DoClose, _start => sub { my $child = POE::Wheel::Run->new( Program => sub { system("sleep 10"); print STDERR "Asking User\n"; print STDERR "Got: ", AskUser("PID=$$"), "\n"; }, StdoutEvent => 'KidOut', StderrEvent => 'KidErr', CloseEvent => 'KidClose', ); $_[KERNEL]->sig_child($child->PID, '_DoSig'); $_[HEAP]{Kids}{WID}{$child->ID} = $child; $_[HEAP]{Kids}{PID}{$child->PID} = $child; } }, ); return($session); } ################################# # POE Session Supporting Routines ################################# sub _DoClose { my $wid = $_[ARG0]; my $child = $_[HEAP]{Kids}{WID}{$wid}; unless (defined $child) { print STDERR "wid $wid closed all pipes.\n"; return; } print STDERR "wid $wid closed all pipes.\n"; delete $_[HEAP]{Kids}{PID}{$child->PID}; } sub _DoSig { print STDERR "pid $_[ARG1] exited with status $_[ARG2].\n"; my $child = delete $_[HEAP]{Kids}{PID}{$_[ARG1]}; return unless defined $child; delete $_[HEAP]{Kids}{WID}{$child->ID}; } sub AskUser { my $txt = shift || 'No text passed'; print STDERR "$txt\n"; my $top = $::poe_main_window; # Create a dialog box to ask user something... my $d = $top->DialogBox( -title=>"$txt", -buttons=>['Ok', 'Cancel'], -default_button=>'Ok', ); # Add the entry widget where user will type the answer... my $e = $d->add('Entry', -width=>30, -show => '*')->pack; $d->add('Label', -text => "What is your favorite color?")->pack; my $ans = $d->Show(); # If user didn't say ok... if ($ans ne "Ok") { die( "I give up, exiting...\n") }; # Get & return what the user typed... my $pw = $e->get; return($pw); }

Comment on Tk Dialog From Multiple POE Processes?
Select or Download Code
Re: Tk Dialog From Multiple POE Processes?
by rcaputo (Chaplain) on Dec 17, 2009 at 22:00 UTC

    POE is a red herring.

    A child process cannot safely manipulate a GUI copied from the parent process. As both copies diverge, they will increasingly fight with each other over what the GUI should look like. As you've seen, eventually X will give up trying to make sense of multiple conflicting requests, and the program will fail.

    The parent process should do all GUI work. If child processes require GUI interaction, they should request the parent to do that for them. The parent process can then inform children of the user's input.

Re: Tk Dialog From Multiple POE Processes?
by zentara (Archbishop) on Dec 18, 2009 at 13:00 UTC
    ....rcaputo is right..... keep all Tk code confined to the parent..... if you spawn forked processes, create entirely new Tk mainloops in the fork.....you can have many forked off independent Tk windows....but they can't interact without advanced IPC.... see perldoc perlipc

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku
Solution Failure #1
by cmv (Chaplain) on Dec 18, 2009 at 19:54 UTC
    zentara++
    rcaputo++
    Thanks for the good advice!

    If I understand my options correctly, I have 2 choices:

  • Funnel all child GUI requests through the parent
  • Setup new Tk mainloops for each child

    My first attempt is trying to funnel all the child GUI requests through the parent (since I don't know how to startup new Tk mainloops for the children), but I'm having problems.

    I thought to create an event handler (KidAsk) in the parent, that would do the GUI request and return the result (see code below). Uncommenting the line labeled "Verification" verifies that the event handler works (when called from the parent).

    My problem seems to be how to get this event handler to fire from the child? I first tried the commented out line labeled "Question 1", but that doesn't work (I'm guessing because the child process can't fire an event in the parent?). Next I tried creating a new event (AskEvent) for the child, and mapping that to the parent's event (KidAsk) in the same way that StdoutEvent & friends are mapped (see lines labeled "Question 2"). Apparently adding new events isn't allowed in POE::Wheel::Run, as this fires a warning message.

    So, what is the best way to do this? Am I anywhere near close?

    Thanks

    -Craig

    use strict; use warnings; use Data::Dumper; # The "use Tk" MUST be before "use POE"... use Tk; use Tk::DialogBox; use POE; use POE::Wheel::Run; # Create GUI window... my $top = $::poe_main_window; $top->geometry('300x50'); $top->title("PID=$$"); $top->protocol('WM_DELETE_WINDOW', sub{exit}); # Create button to push... $top->Button(-text=>"Don't Push Me - WAIT", -command=>sub{ print STDERR "Parent Asking User\n"; print STDERR "Got: ", AskUser("PID=$$"), "\n"; })->pack; print STDERR "Parent PID=$$\n"; my $session=_poeSetup(); # Go... $poe_kernel->run(); sub _poeSetup { my $session = POE::Session->create( inline_states=>{ KidAsk => sub { print STDERR "GUI Request from Child...\n"; my $ret=AskUser("PID=$$"); print STDERR "Got: $ret\n"; return($ret); }, KidOut => sub { my ($heap, $line, $wid)=@_[HEAP, ARG0, ARG1]; my $child = $heap->{Kids}{WID}{$wid}; print STDERR $child->PID . " OUT: $line\n"; }, KidErr => sub { my ($heap, $line, $wid)=@_[HEAP, ARG0, ARG1]; my $child = $heap->{Kids}{WID}{$wid}; print STDERR $child->PID . " ERR: $line\n"; }, KidClose => \&_DoClose, _start => sub { my ($kernel, $heap) = @_[KERNEL, HEAP]; $kernel->alias_set('GUI'); my $child = POE::Wheel::Run->new( Program => sub { print STDERR "Sleeping..."; system("sleep 3"); print STDERR "GUI Request from $$\n"; # Question 1 my $ret = $kernel->post('GUI','KidAsk'); # Question 2 my $ret = $kernel->yield('AskEvent'); print STDERR "DONE: $ret\n"; system("tail -f /etc/profile"); }, StdoutEvent => 'KidOut', StderrEvent => 'KidErr', CloseEvent => 'KidClose', # Question 2 AskEvent => 'KidAsk', ); $kernel->sig_child($child->PID, '_DoSig'); $heap->{Kids}{WID}{$child->ID} = $child; $heap->{Kids}{PID}{$child->PID} = $child; # Verification $kernel->yield('KidAsk'); } }, ); return($session); } ################################# # POE Session Supporting Routines ################################# sub _DoClose { my $wid = $_[ARG0]; my $child = $_[HEAP]{Kids}{WID}{$wid}; unless (defined $child) { print STDERR "wid $wid closed all pipes.\n"; return; } print STDERR "wid $wid closed all pipes.\n"; delete $_[HEAP]{Kids}{PID}{$child->PID}; } sub _DoSig { print STDERR "pid $_[ARG1] exited with status $_[ARG2].\n"; my $child = delete $_[HEAP]{Kids}{PID}{$_[ARG1]}; return unless defined $child; delete $_[HEAP]{Kids}{WID}{$child->ID}; } sub AskUser { my $txt = shift || 'No text passed'; print STDERR "$txt\n"; my $top = $::poe_main_window; # Create a dialog box to ask for a password... my $d = $top->DialogBox( -title=>"$txt", -buttons=>['Ok', 'Cancel'], -default_button=>'Ok', ); # Add the entry widget where user will type password... my $e = $d->add('Entry', -width=>30, -show => '*')->pack; $d->add('Label', -text => "What is your favorite color?")->pack; my $ans = $d->Show(); # If user didn't say ok... if ($ans ne "Ok") { die( "I give up, exiting...\n") }; # Get & return what the user typed... my $pw = $e->get; return($pw); }

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://813252]
Approved by keszler
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (5)
As of 2014-08-23 06:24 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (172 votes), past polls