Выполнение внешней команды в 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 ($@);

}
Другие вопросы по тегам