CODEWITHSUNDEEP
perltkx
Jean-Francois T.
Jean-Francois T.

Reputation: 12920

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

Upvotes: 2

Views: 300

Answers (1)

Jean-Francois T.
Jean-Francois T.

Reputation: 12920

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 ($@);

}

Upvotes: 1

Related Questions