Code Index:

package Tk::ExecuteCommand
__END__
EOF

NAME

Tk::ExecuteCommand - execute a command asynchronously (non-blocking).

SYNOPSIS

 $exec = $parent->ExecuteCommand;

DESCRIPTION

Tk::ExecuteCommand runs a command yet still allows Tk events to flow. All command output and errors are displayed in a window.

This ExecuteCommand mega widget is composed of an LabEntry widget for command entry, a "Do It" Button that initiates command execution, and a ROText widget that collects command execution output.

While the command is executing, the "Do It" Button changes to a "Cancel" Button that can prematurely kill the executing command. The kill_command method does the same thing programmatically.

The primary benefit of this widget is the ability to execute system commands asynchronously without blocking Tk's event loop. The widget doesn't even have to be managed (pack/grid), see the EXAMPLES section.

OPTIONS

-command: The command to execute asynchronously.
-entryWidth: Character width of command Entry widget.
-height: Character height of the ROText widget.
-label: Label text for command Entry widget.
-text: Label text for "Do It!" Button.
-width: Character width of the ROText widget.

METHODS

$exec->execute_command;: Initiates command execution.
$exec->get_status;: Returns a 2 element array of $? and $! from last command execution.
$exec->kill_command;: Terminates the command. This subroutine is called automatically via an OnDestroy handler when the ExecuteCommand widget goes away.
$exec->terse_gui;: packForgets all but the minimal ROText widget. Currently, this action cannot be rescinded.

ADVERISED SUBWIDGETS

Component subwidgets can be accessed via the Subwidget method. Valid subwidget names are listed below.

Name: command, Class: LabEntry: Refers to the command LabEntry widget.
Name: doit, Class: Button: Refers to the command execution Button.
Name: spacer, Class: Frame: Refers to the spacer Frame separating the Entry and ROText widgets.
Name: label, Class: Label: Refers to the Label across the top of the ROText widget.
Name: text, Class: ROText: Refers to the ROText widget that collects command execution output.

EXAMPLES

 $ec = $mw->ExecuteCommand(
     -command    => '',
     -entryWidth => 50,
     -height     => 10,
     -label      => '',
     -text       => 'Execute',
 )->pack;
 $ec->configure(-command => 'mtx -f /dev/sch0 load 1 0');
 $ec->execute_command;
 $ec->bell;
 $ec->update;

 =================================================================

 # More complicated example to read AC temps via snmpget. The target
 # air conditioner IPs have been changed to protect them ;)

 #!/usr/local/bin/perl
 use Tk;
 use Tk::ExecuteCommand;
 use subs qw/ init main read_acs sys /;
 use strict;
 use warnings;

 # Globals.

 my $ec;                                 # ExecuteCommand widget
 my @gauges;                             # list of AC NGauge widgets
 my $interval;                           # interval between SNMP scans, seconds
 my $mw;                                 # MainWindow
 my $snmp_liebert_temperature_actual;    # temperature, actual reading
 my $snmp_liebert_temperature_tolerance; # temperature, desired tolerance
 my $snmp_liebert_temperature_setting;   # temperature, desired setting
 my $snmp_root;                          # snmpget/snmpset dirname
 my $temp_tolerance_factor;              # tolerance value * factor = degrees

 init;
 main;

 sub init {

     $mw = MainWindow->new;
     $ec = $mw->ExecuteCommand;

     $interval = 2;

     $snmp_root = '/usr/bin';
     $snmp_liebert_temperature_setting   = '.1.3.6.1.4.1.476.1.42.3.4.1.2.1.0';
     $snmp_liebert_temperature_tolerance = '.1.3.6.1.4.1.476.1.42.3.4.1.2.2.0';
     $snmp_liebert_temperature_actual    = '.1.3.6.1.4.1.476.1.42.3.4.1.2.3.1.3.1';

     $gauges[0] = {-ac => 'some-ip-1'};
     $gauges[1] = {-ac => 'some-ip-2'};

 } # end init

 sub main {

     read_acs;
     MainLoop;

 } # end main

 sub read_acs {

     my( $stat, @temperature, @humidity );

     foreach my $g ( @gauges ) {
	 my $ac_ip = $g->{ -ac } . '.some.domain.name';

	 ( $stat, @temperature ) = sys "$snmp_root/snmpget $ac_ip communityname  $snmp_liebert_temperature_setting $snmp_liebert_temperature_tolerance $snmp_liebert_temperature_actual";
	 die "Cannot get temperature data for AC '$ac_ip': $stat." if $stat or $#temperature != 2;
	 print "stat=$stat, data=@temperature.\n";

     } # forend all air conditioners

     $mw->after( $interval * 1000 => \&read_acs );

 } # end read_acs

 sub sys {

     # Execute a command asynchronously and return its status and output.

     my $cmd = shift;

     $ec->configure( -command => $cmd );
     my $t = $ec->Subwidget( 'text' ); # ROText widget
     $t->delete( '1.0' => 'end' );
     $ec->execute_command;
     return ($ec->get_status)[0], split /\n/, $t->get( '1.0' => 'end -1 chars' );

 } # end sys

KEYWORDS

exec, command, fork, asynchronous, non-blocking, widget

COPYRIGHT

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.