Tk Form GUI / external process error

honyok has asked for the wisdom of the Perl Monks concerning the following question:

Esteemed scholars, I have finally made my Tk GUI a reality, but I have one annoying error. First - the gui includes a notebook tab for every program I wish to use; within each tab are input parameters required for each program; when the program button is pushed, it will generate a parameter script and initiate the program; a parameter history file is written to be recalled when the gui is next used; stdout/stderr from the external program are piped to a popup window. All of these are working quite well despite my limited experience.

The problem arises when I push the popup's "kill" button while it is executing the external program. I would like the gui to kill the external program ONLY and print a confirmation of such. Currently, I get the error:
Can't locate Tk/PRINT.pm in @INC (@INC contains: /usr/lib64/perl5/site_perl/5.8.8/x86_64-linux-thread-multi /usr/lib64/perl5/site_perl/5.8.7/x86_64-linux-thread-multi /usr/lib64/perl5/site_perl/5.8.6/x86_64-linux-thread-multi /usr/lib64/perl5/site_perl/5.8.5/x86_64-linux-thread-multi /usr/lib/perl5/site_perl/5.8.8 /usr/lib/perl5/site_perl/5.8.7 /usr/lib/perl5/site_perl/5.8.6 /usr/lib/perl5/site_perl/5.8.5 /usr/lib/perl5/site_perl /usr/lib64/perl5/vendor_perl/5.8.8/x86_64-linux-thread-multi /usr/lib64/perl5/vendor_perl/5.8.7/x86_64-linux-thread-multi /usr/lib64/perl5/vendor_perl/5.8.6/x86_64-linux-thread-multi /usr/lib64/perl5/vendor_perl/5.8.5/x86_64-linux-thread-multi /usr/lib/perl5/vendor_perl/5.8.8 /usr/lib/perl5/vendor_perl/5.8.7 /usr/lib/perl5/vendor_perl/5.8.6 /usr/lib/perl5/vendor_perl/5.8.5 /usr/lib/perl5/vendor_perl /usr/lib64/perl5/5.8.8/x86_64-linux-thread-multi /usr/lib/perl5/5.8.8 .) at /usr/lib64/perl5/site_perl/5.8.8/x86_64-linux-thread-multi/Tk/Widget.pm line 270.

Below the gui code is a sender script from Zentara that I use as a dummy program. Any suggestions? Thanks, yo.

#!/usr/bin/perl -w
use warnings;
use strict;
use Tk;
use Tk::NoteBook;
require Tk::Pane;
use Tie::IxHash;
use Tk::LabEntry;
use Tk::ErrorDialog;

my $mw = MainWindow->new;
$mw->geometry( "760x600");

###default hash
tie my %tools, 'Tie::IxHash',
'program1' => ordered_hash_ref ('parameter1' => 'A','parameter2' => 'B
+','parameter3' => 'Text','parameter4' => 'Y','parameter5' => 'N'),
'program2' => ordered_hash_ref ('parameter1' => '0.0','parameter2' => 
+'Y','parameter3' => 'C','parameter4' => '0.5');

## check for history files
for my $check (keys %tools){
    if ( -e ".${check}_history" ){
        open (CHECK,"<.${check}_history") or warn "$!\n";
                while (<CHECK>) {
            my @new=split(/ /);
            $tools{$check}=ordered_hash_ref (@new);
            }
        }
    close (CHECK);
}

## create notebook
my $book = $mw->NoteBook()->pack(-expand=>1,-fill=>'both');

#####program1#######
my $tab_cnt=1;
for my $tab (keys %tools){      
       ##create tab,scroll pane,frames
      my $tab_tab=$book->add("Sheet $tab_cnt", -label => "$tab");
      my $tab_spane=$tab_tab->Scrolled('Pane',-background=>'slate grey
+')->pack(-expand=>1, -fill=>'both');
     my $tab_frame1=$tab_spane->Frame(-background=>'blue')->pack(-side
+=>'left',-expand=>1,-fill=>'both',-padx=>15);
     my $tab_frame2=$tab_spane->Frame(-background=>'red')->pack(-side=
+>'top',-fill=>'x');
    $tab_cnt++;

       #create columns
         my $tab_column1 = $tab_frame1->Frame()->pack(-side=>'left',-e
+xpand=>1,-fill=>'both');
        my $tab_column2 = $tab_frame2->Frame()->pack(-side=>'right',-e
+xpand=>1,-fill=>'both');  

       ##now fill frames
    foreach my $parm ( keys %{$tools{$tab}}) {
        my $tab_test;
              $tab_test=$tab_column1->LabEntry(-label => "$parm=");
        $tab_test->Subwidget('entry')->configure(-textvariable => \$to
+ols{$tab}{$parm} );
        $tab_test->configure(-labelPack=>[-side=>'left']);
                $tab_test->pack(-anchor=>'e');
        }

####### buttons #############
my $push=$tab_tab->Button(-text => "\n       $tab       \n ",-command 
+=>[\&save_parms,$tab],-background=>'slate grey')->pack;
my $clear=$tab_tab->Button(-text => "Reset ",-command =>[\&reset_parms
+,$tab])->pack(-side=>'right');
}

MainLoop;

####################### subs #################################
## save parameters ##########

sub save_parms {

my $tab = shift;
my $date=`date '+%H%M%S_%m%d%y'`;
chomp $date;

#### stderr stdout dialog popup ###################
my $popup = Tk::MainWindow->new;
$popup->title("${tab}");
my $text = $popup->Scrolled('Text',-label => "Output/Errors",-width  =
+> 48,-height => 20,-background=>'slate grey');
  $text->pack(-expand=>1, -fill=>'both');
$| = 1;
  my $button = $popup->Button(
      -text => 'Kill',
      -command => [$popup=> 'destroy'],-background=>'slate grey');
  $button->pack;
my $write = $text->Subwidget( 'scrolled' );
tie *STDOUT, ref $write, $text;
tie *STDERR, ref $write, $text;
################################################     
my ($pipe,$job_list);
#script files
      open (my $parfile,"> ${tab}_${date}.sh") or warn "$!\n";
      print $parfile "#!/bin/bash\n";
        if ( "$tab" eq "program1"){print $parfile "program1 \n"}
        elsif ( "$tab" eq "program2"){print $parfile "program2 << EOD\
+n"}
        open (my $histfile,">.${tab}_history") or warn "$!\n";
        foreach my $parm ( keys %{$tools{$tab}} ) { 
            if (! $tools{$tab}{$parm}){print $parfile "#"}     
            print $parfile "# $parm=$tools{$tab}{$parm}\n";
            print $histfile "$parm $tools{$tab}{$parm} "}   
                   print $parfile "echo Job finished: `date`";
            close $parfile;
            close $histfile;
            `chmod 0777 *.sh`;
            open $pipe, "-|", "${tab}_${date}.sh 2>&1"
            or die "Can't execute $tab : $!\n";
            $text->fileevent(\*$pipe, readable => sub {
            if (sysread($pipe, my $buffer, 1024) > 0) {
            $text->insert('end', $buffer);
            $text->see('end');
            } else {
            $popup->fileevent(\*$pipe, 'readable', '');
            close $pipe;        
        }
      });
    }

################################

sub reset_parms{
my $tab=shift;
    unlink(".${tab}_history");
    exec "tools_generic.pl &";
    }
#############################

sub ordered_hash_ref {
    tie my %hash, 'Tie::IxHash', @_;
    return \%hash;
}
##############################
[download]

DUMMY PROGRAM

#!/usr/bin/perl
use warnings;
use strict;

$| = 1;
my $count = 0;
while(1){
 $count++;
 print "$count\n";
 warn "\tuh oh warning $count\n";
 sleep 1;
}
[download]

Comment on Tk Form GUI / external process error Select or Download Code

Replies are listed 'Best First'.
Re: Tk Form GUI / external process error by zentara (Archbishop) on Mar 26, 2009 at 14:32 UTC
What? No replies yet? You're lucky I'm still alive. :-) What you need to do is spawn your external process, so that you get a pid returned for the process spawned. Then you can "kill -9 ( me ducks :-) ) the pid from the parent process. Just choose a way to spawn the external process, and stuff the returned pid into a hash. Then you can retreive and kill that pid. You may also need to use Proc::KillFam, since often, the spawning first gets a shell, then the shell runs the program. But if you killfam the shell's pid, you get it's descendants too. I'm not really a human, but I play one on earth My Petition to the Great Cosmic Conciousness	[reply]
Re^2: Tk Form GUI / external process error by honyok (Sexton) on Mar 26, 2009 at 18:17 UTC
After trial/error, I'm very very close. I'm capturing the subprocess ID with the following: `$sub_pid= open $pipe, "-\|", "${tab}_${date}.sh 2>&1" or die "Can't exe +cute $tab : $!\n";` [download] then kill the process with: my $button = $popup->Button( -text => 'Kill', -command => [sub{`kill $sub_pid 2>&1` && warn "Can't kill subpro +cess: $sub_pid\n"}],-background=>'slate grey'); $button->pack; [download] Unfortunately $sub_pid returns 10523 rather than 10524. ps shows: PID TTY TIME CMD 10514 pts/6 00:00:00 tools_generic.p 10523 pts/6 00:00:00 program1_125919 10524 pts/6 00:00:00 program1 10525 pts/6 00:00:00 ps 26437 pts/6 00:00:00 bas I suppose this is a sub launching a sub? Therefore I must use KillFam? So close! honyok	[reply] [d/l] [select]
Re^3: Tk Form GUI / external process error by zentara (Archbishop) on Mar 26, 2009 at 20:16 UTC
Here is an example. Some commands need IPC::Open3, and you do "my $pid = open3(.....) #!/usr/bin/perl use warnings; use strict; use Tk; my $mw = MainWindow->new(-background => 'gray50'); my $text = $mw->Scrolled('Text')->pack(); my $pid; my $startb = $mw->Button( -text => 'Start', -command=> \&work, )->pack(); my $count = 0; my $label = $mw->Label(-textvariable=>\$count)->pack(); my $testtimer = $mw->repeat(500, sub { $count++} ); my $stopb = $mw->Button( -text => 'Exit', -command=>sub{ kill 9,$pid; exit; }, )->pack(); MainLoop; ##################################### sub work{ $startb->configure(-state=>'disabled'); use Fcntl; + my $flags; + #long 10 second delay between outputs $pid = open (my $fh, "top -b -d 10 \|" ) or warn "$!\n"; fcntl($fh, F_SETFL, O_NONBLOCK) \|\| die "$!\n"; # Set the non-block f +lags my $repeater; $repeater = $mw->repeat(10, sub { if(my $bytes = sysread( $fh, my $buf, 1024)){; $text->insert('end',$buf); $text->see('end'); } } ); } [download] P.S. Hurry with your questions, I won't be here for long...:-) I'm not really a human, but I play one on earth My Petition to the Great Cosmic Conciousness	[reply] [d/l]
Re^4: Tk Form GUI / external process error by honyok (Sexton) on Mar 27, 2009 at 14:08 UTC
Re^5: Tk Form GUI / external process error by zentara (Archbishop) on Mar 27, 2009 at 15:06 UTC
Re^2: Tk Form GUI / external process error by honyok (Sexton) on Mar 26, 2009 at 16:29 UTC
Zentara, the Immortal!! By "spawn" do you mean something like "fork"? Is there any way to capture the pid using the `open $pipe, "-\|", "${tab}_${date}.sh 2>&1"` method? Thank you. -honyok	[reply] [d/l]


Think about Loose Coupling
	PerlMonks