Выполнение внешней команды в Perl / Tkx без блокировки графического интерфейса (Windows)
Я пытаюсь создать интерфейс с Perl + Tkx, который может запускать внешние команды при нажатии на кнопку.
Существует много документов о том, как работать с модулем Tk, но мало с Tkx.
Я все еще нашел несколько таких, как этот, но я не могу заставить это работать для моего примера. В частности, посты включают использование Tkx:: open, Tkx:: configure и Tkx:: fileevent... но я не выяснил, как их объединить.
Вот код, который я пробую; при нажатии на кнопку и нажатии клавиши для завершения дочернего процесса Perl выдает ошибку Free to wrong pool 16389d0 not 328e448 at C:/Perl/lib/Tcl.pm line 433.
,
Примечание: я использую 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;
}
}
Спасибо
1 ответ
Потратив почти 2 дня на эту проблему, я наконец-то нашел ответ благодаря посту с кодом для Tcl, который я адаптировал для Tkx.
Решение заключается в использовании Tkx::open
(в сочетании с его двоюродными братьями "читать" и "закрыть").
Приведенный ниже код может выполнить команду правильно, не блокируя GUI, но в большинстве случаев мне не удалось получить STDOUT и STDERR (это работало для запуска приложения, разработанного в Java, но не для systeminfo
или же diff -v
).
Если кто-то понял это, не стесняйтесь комментировать.
Спасибо
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 ($@);
}