##
# 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 => 'left');
    $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#Coderef_Execution_Side_Effects
    for my $c (1..100) {
        print "$c\n";
        sleep 1;
    }
}