Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

RFC: POE & Tk Playing well with Children

by cmv (Chaplain)
on Jan 13, 2010 at 16:51 UTC ( #817225=perlmeditation: print w/ replies, xml ) Need Help??

Folks-

I'm looking for comments on how to spiffy-up the attached example for inclusion in the POE Cookbook.

My original question got stalled due to my inexperience with POE, and I took it as a quest to come up with a useful example that shows how multiple POE::Wheel processes can all work together with a Tk GUI.

This took me over a week to hack out, and I suspect may be a bit painful for POE experts to look at. I'd like to get suggestions on how to make this consistent, easy to read and understand, and suitable as a shining example for inclusion the POE Cookbook.

I'm also experimenting with a different way to format and comment the POE support routines. Let me know what you think.

Any and all comments are most welcome!

Thanks.

Update1: Removed startKid() per suggestion by LordVorp (#poe IRC) & added readmore tags
Update2: Minor formatting and additional cleanup (re:LordVorp)
Update3: Redo events to make them consistent and straightforward (re: devin)

-Craig

## # This Perl script forks a child process for each counter you create, # and updates the counters each time the child outputs to stdout. # It uses POE to manage all the work and Tk for the GUI. All GUI # work is done by the parent. This is meant to be an example of # how to use POE and Tk together with multiple child processes. # # This program is a modified version of: # http://poe.perl.org/?POE_Cookbook/Tk_Interfaces # Combined with: # http://poe.perl.org/?POE_Cookbook/Child_Processes_2 # use warnings; use strict; use Tk; # Tk always comes first use POE; use POE::Wheel::Run; # Pretty Colors... my @COLORS = ( qw(purple darkgreen brown blue red) ); my $TOTCOLORS = scalar(@COLORS); # Create the parent session that will drive the user interface. POE::Session->create( inline_states => { _start => \&ui_start, ev_addcounter => \&ui_addcounter, ev_kid_stdout => \&got_child_stdout, ev_sigchld => \&got_sigchld, ev_newcolor => \&newcolor, }, ); # Run the program until it is exited. $poe_kernel->run(); exit 0; ###################### # POE Support Routines ###################### sub ui_start { ########################## INITIAL UI SETUP my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP]; # Create Top Label Frame... my $topf = $poe_main_window->Frame()->pack; $topf->Label(-text => 'Total Counters: ' )->pack(-side => 'left'); $topf->Label(-textvariable => \$heap->{Label})->pack(-side => 'lef +t'); $heap->{Label} = 0; # Create Middle Counter Frame... $heap->{CountF} = $poe_main_window->Frame()->pack; # Create Bottom Counter Button Frame... my $bottomf = $poe_main_window->Frame()->pack(-side => 'bottom'); $bottomf->Button( -text => "Add Counter", -command => $session->postback("ev_addcounter") )->pack; } sub ui_addcounter { ##################### ADD A COUNTER my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP]; my $cframe = $heap->{CountF}; # New frame for this counter my %c; # New heap hash for counter # Create GUI Counter... $c{count} = 0; $c{gui} = $cframe->Label( -textvariable => \$c{count}, )->pack(-side => 'left'); # Start Child... $c{child} = POE::Wheel::Run->new( Program => \&child_work, StdoutEvent => "ev_kid_stdout", # Fire parent event on + stdout ); $kernel->sig_child($c{child}->PID => "ev_sigchld"); # Save Child in Heap... ${$heap->{Counters}}[$c{child}->ID] = \%c; $heap->{PID2SID}{$c{child}->PID} = $c{child}->ID; print STDERR "Parent($$) Forks Child (", $c{child}->PID, ")\n"; $heap->{Label}++; # Bump up GUI counter total } sub got_child_stdout { ################## HANDLE CHILD STDOUT my ($kern, $heap, $stdout, $id) = @_[KERNEL, HEAP, ARG0, ARG1]; $heap->{Counters}[$id]{count} = $stdout; # New count GUI Update if( ($stdout % $TOTCOLORS) == 0) { $kern->yield('ev_newcolor', $id, (($stdout/$TOTCOLORS)%$TOTCOLORS)-1, ); } } sub newcolor { ########################## HANDLE NEW COLOR REQUEST my ($heap, $id, $index) = @_[HEAP, ARG0, ARG1]; $heap->{Counters}[$id]{gui}->configure( -foreground=>$COLORS[$index], ); } sub got_sigchld { ####################### HANDLE CHILD DEATH my ($kern, $heap, $sig, $pid) = @_[KERNEL, HEAP, ARG0, ARG1]; print STDERR "Child ($pid) reaped with SIG$sig.....\n"; my $sessid = $heap->{PID2SID}{$pid}; $heap->{Counters}[$sessid]{gui}->packForget; delete($heap->{Counters}[$sessid]); } sub child_work { ######################## WORK FOR EACH CHILD TO DO # Be careful what you do here in perl, many tripwires about. Read: # http://search.cpan.org/~rcaputo/POE-1.283/lib/POE/Wheel/Run.pm#C +oderef_Execution_Side_Effects for my $c (1..100) { print "$c\n"; sleep 1; } }

Comment on RFC: POE & Tk Playing well with Children
Download Code
Re: RFC: POE & Tk Playing well with Children
by zentara (Archbishop) on Jan 14, 2010 at 12:16 UTC
    Just as a general comment:

    To me, it all seems about making 2 separate event loops work together. POE and Tk are event-loop systems, one needs to be the master, the other the slave. You make POE the master.

    You can make Tk run POE, or Tk run Gtk2, or POE run Gtk2, etc. .....many combinations are possible with timers calling the various iteration methods, like do_one_loop

    Just a tip for budding hackers out there, who may want to use some widget from one gui toolkit, in another foreign gui system :-)

    For instance, here is a Tk gui controlling a Gtk2 widget

    #!/usr/bin/perl -w use strict; use Gtk2; use Tk; my $mw = MainWindow->new(-title=>'Tk Window'); Gtk2->init; my $window = Gtk2::Window->new('toplevel'); $window->set_title('Gtk2 Window'); my $glabel = Gtk2::Label->new("This is a Gtk2 Label"); $window->add($glabel); $window->show_all; my $tktimer = $mw->repeat(10, sub{ Gtk2->main_iteration while Gtk2->events_pending; }); $mw->Button(-text=>' Quit ', -command => sub{exit} )->pack(); MainLoop;

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlmeditation [id://817225]
Front-paged by keszler
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others about the Monastery: (10)
As of 2014-08-22 18:43 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (163 votes), past polls