Dem
Dem

Reputation: 53

Perl Tk: When calling external scripts, how to prevent other buttons to be clicked?

OS: Linux ( Scientific Linux ) Language and version: Perl 5.24

1.When I click a button the calls an external script like

$mw->Button(-command => sub { 
   $value = \`/root/desktop/script.pl\`; chomp($value); 
} )-> grind();
  1. A GUI of the external script will pop out and let me fill up values.

  2. I am not done yet with the external script but I "rapidly click" a button from the main script (that will pop out a window if I clicked it, but only after the external script is closed).

  3. I closed the external script.

  4. Massive numbers of windows pops-out one at a time from the main script after I closed the external script.

How to prevent the massive popout of windows from other buttons/widgets after closing the external script I called?

Upvotes: 1

Views: 120

Answers (1)

Grant McLean
Grant McLean

Reputation: 7018

Here's a script that disables all buttons before launching a command and then re-enables them when the command exits:

#!/usr/bin/perl

use 5.010;
use strict;
use warnings;

use Tk;
use Tk::Table;
use IO::Handle;
use Data::Dumper;

my $mw= tkinit;

my @buttons;

push @buttons, $mw->Button(
    -text     => 'Button One',
    -command  => \&action_one,
)->pack;

push @buttons, $mw->Button(
    -text     => 'Button Two',
    -command  => \&action_two,
)->pack;

push @buttons, $mw->Button(
    -text     => 'Button Three',
    -command  => \&action_three,
)->pack;

MainLoop;

exit;


sub action_one {
    run_external_command('xclock');
}


sub action_two {
    run_external_command('xcalc');
}


sub action_three {
    run_external_command('xlogo');
}

sub run_external_command {
    disable_buttons();
    open my $fh, '-|', @_;
    $mw->fileevent($fh, 'readable', sub { command_read($fh) });
}


sub command_read {
    my($fh) = @_;

    my $buf = '';
    if ( sysread($fh, $buf, 4096) ) {
        print "Read: '$buf'";
    }
    else {
        close($fh);
        enable_buttons();
    }
}


sub disable_buttons {
    foreach my $b (@buttons) {
        $b->configure(-state => 'disabled');
    }
}


sub enable_buttons {
    foreach my $b (@buttons) {
        $b->configure(-state => 'normal');
    }
}

Upvotes: 2

Related Questions