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