perltkx

Running an external command in Perl / Tkx without blocking the GUI (Windows)


I am trying to create an interface with Perl + Tkx which could run external commands while clicking on a button.

There are lot of documentaiton about how to proceed with the Tk module but few with Tkx.

I still have found a few like this one but I am not able to make it work for my example. In particular the posts include use of Tkx::open, Tkx::configure, and Tkx::fileevent... but I have not figured out how to combine them together.

Here is the code I am trying; when clicking on the button, and pressing a key to terminate the child process, Perl crahses with the error Free to wrong pool 16389d0 not 328e448 at C:/Perl/lib/Tcl.pm line 433..

Note: I am using ActivePerl 5.12.2.

use Tkx;
use strict;

my $mw = Tkx::widget->new(".");
my $button=$mw->new_ttk__button(-text => "Run", -command => [\&run_cmd, 0]);
$button->g_grid(-column => 0, -row => 0);
my $text = $mw->new_tk__text(-width => 32, -height => 16);
$text->configure(-state => "disabled");
$text->g_grid(-column => 0, -row => 1);
Tkx::MainLoop();

sub run_cmd {
    if (fork()==0) {
        system "pause";
        exit 0;
    }
}

Thanks


Solution

  • After spending almost 2 days on the problem I have finally found out the answer thanks to a post here with a code for Tcl that I adapted to Tkx.

    The solution is to use Tkx::open (in combination with its cousins "read" and "close").

    The code below can execute the command correctly without blocking the GUI but in most cases, I have not managed to retrieve the STDOUT and STDERR (it worked for running an application developped in java but not for systeminfo or diff -v).

    If anybody got an insight on it, don't hesitate to comment.

    Thanks

    use Tkx;
    use strict;
    use Data::Dumper;
    
    my ($stdout,$stderr);
    
    my $mw = Tkx::widget->new(".");
    my $button=$mw->new_ttk__button(-text => "Run", -command => [\&run_command, "systeminfo"]);
    $button->g_grid(-column => 0, -row => 0);
    my $text = $mw->new_tk__text(-width => 32, -height => 16);
    $text->insert("end", "Test\n");
    $text->g_grid(-column => 0, -row => 1);
    
    Tkx::MainLoop();
    print "STDOUT: $stdout\n\n","-"x24,"\nSTDERR: $stderr\n";
    
    
    sub run_command {
        my $cmd = shift;
        my $fh = Tkx::open("| $cmd", 'r') or die "$!";
        Tkx::fconfigure($fh, -blocking => 0);
        $stdout.=Tkx::read($fh);
        eval { Tkx::close($fh); };
        $stderr.=$@ if ($@);
    
    }