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

[download]
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);
}

[download]

In reply to Tk Dialog From Multiple POE Processes? by cmv

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.