15.4.1. fileevent Syntax

$mw->fileevent(handle, operation => callback);

handle is a Perl file handle, which may be a reference to a glob (\*STDIN), the return value from IO::Handle, etc.

operation may be readable or writable.

callback is a standard callback or the empty string "". The callback is invoked when the file is readable/writable. If callback is the empty string, the callback is canceled.

15.4.2. Tk::ExecuteCommand

Figure 15-1. Tk::ExecuteCommand in action

sub Populate {

    my($self, $args) = @_;

    $self->SUPER::Populate($args);

    my $f1 = $self->Frame->pack;
    $f1->LabEntry(
        -label => 'Command to Execute',
        -labelPack => [qw/-side left/],
        -textvariable => \$self->{-command},
    )->pack(qw/-side left/);

    my $doit = $f1->Button(-text => 'Do It!')->pack(qw/-side left/);
    $self->Advertise('doit' => $doit);
    $self->_reset_doit_button;

    $self->Frame->pack(qw/pady 10/);
    $self->Label(-text => 'Command\'s stdout and stderr')->pack;

    my $text = $self->Scrolled('ROText', -wrap => 'none');
    $text->pack(qw/-expand 1 -fill both/); 
    $self->Advertise('text' => $text);
    $self->OnDestroy([$self => 'kill_command']);

    $self->{-finish} = 0;

    $self->ConfigSpecs(
        -command => [qw/METHOD command Command/, 'sleep 5; pwd'],
    );

} # end Populate

sub command {

    my($self, $command) = @_;
    $self->{-command} = $command;

} # end command

When the "Do It" Button is pressed, it begins flashing and continues to do so until the command has completed or is canceled. We use a Tcl/Tk idiom of rescheduling a timer callback that alternates the Button's background color. The first time through, the Button's background color is $val1, but the subsequent after callback reverses the colors so that $interval milliseconds later, the background changes to $val2. When the command finishes, no further timer callbacks are queued, and the flashing ceases.

sub _flash_doit {

    # Flash "Do It" by alternating its background color.

    my($self, $option, $val1, $val2, $interval) = @_;

    if ($self->{-finish} == 0) {
			$self->Subwidget('doit')->configure($option => $val1);
			$self->idletasks;
			$self->after($interval, [\&_flash_doit, $self, $option, $val2,
            $val1, $interval]);
    }

} # end _flash_doit

Here's a private method that reads command output and inserts it into the Text widget. It calls kill_command to perform cleanup operations when the command completes or the user clicks on the "Cancel" Button.

sub _read_stdout {

    # Called when input is available for the output window.  Also checks
    # to see if the user has clicked Cancel.

    my($self) = @_;

    if ($self->{-finish}) {
			$self->kill_command;
    } else {
			my $h = $self->{-handle};
			if ( sysread $h, $_, 4096 ) {
			    my $t = $self->Subwidget('text');
			    $t->insert('end', $_);
			    $t->yview('end');
			} else {
			    $self->{-finish} = 1;
			}
    }
			
} # end _read_stdout

The private method _reset_doit_button ensures that the "Do It" button is properly configured to start a new command. Besides setting the Button's text and appearance, it also configures the callback so that, once pressed, the Button is disabled (preventing a possible race condition), and command execution begins.

Notice it's not sufficient to use cget to fetch the background color, because the Button may have been flashing by alternating its background color. The only sure-fire way is to use configure and fetch the original default color from the configuration specifications. All Tk options are described by a five element array containing the option name, resource database name, class name, default value, and current value. The "Do It" Button's specifications might look like this:

-background background Background #d9d9d9 cyan

sub _reset_doit_button {

    # Establish normal "Do It" button parameters.

    my($self) = @_;

    my $doit = $self->Subwidget('doit');
    my $doit_bg = ($doit->configure(-background))[3];

    $doit->configure(
        -text       => 'Do It',
        -relief     => 'raised',
        -background => $doit_bg,
        -state      => 'normal',
        -command    => [sub {
            my($self) = @_;
            $self->{-finish} = 0;
            $self->Subwidget('doit')->configure(
                -text   => 'Working ...',
                -relief => 'sunken',
                -state  => 'disabled'
            );
            $self->execute_command;
        }, $self],
    );

} # end _reset_doit_button

Here are all the public methods. execute_command creates a new file handle and stores it in an instance variable. Then it uses a pipe-open to execute the command, redirecting STDERR to STDOUT. If the open fails, the error is posted in the Text widget. The file handle is unbuffered, so data can be read as quickly as possible, and the readable fileevent is created. The "Do It" button is reconfigured into the "Cancel" button, and we start it flashing.

sub execute_command {

    # Execute the command and capture stdout/stderr.

    my($self) = @_;
    
    my $h = IO::Handle->new;
    die "IO::Handle->new failed." unless defined $h;
    $self->{-handle} = $h;

    $self->{-pid} = open $h, $self->{-command} . ' 2>&1 |';
    if (not defined $self->{-pid}) {
			$self->Subwidget('text')->insert('end',
                 "'" . $self->{-command} . "' : $!\n");
			$self->kill_command;
			return;
    }
    $h->autoflush(1);
    $self->fileevent($h, 'readable' => [\&_read_stdout, $self]);

    my $doit = $self->Subwidget('doit');
    $doit->configure(
        -text    => 'Cancel',
        -relief  => 'raised',
        -state   => 'normal',
        -command => [\&kill_command, $self],
    );

    my $doit_bg = ($doit->configure(-background))[3];
    $self->_flash_doit(-background => $doit_bg, qw/cyan 500/);
    
} # end execute_command

kill_command sets the finish flag so that the flash and fileevent handlers know to quit. It releases resources by clearing the fileevent handler, killing the command and all its children, and closing the file handle. Then it resets "Do It."

sub kill_command {
    
    # A click on the blinking Cancel button resumes normal operations.

    my($self) = @_;

    $self->{-finish} = 1;
    my $h = $self->{-handle};
    return unless defined $h;
    $self->fileevent($h, 'readable' => ''); # clear handler
    killfam 'TERM', $self->{-pid} if defined $self->{-pid};
    close $h;
    $self->_reset_doit_button;

} # end kill_command

1;

15.4.3. An MPG Player—tkmpg123

Figure 15-2. Apple's iTunes Player

Figure 15-3. Play and pause images

We start by creating an Audio::Play::MPG123 instance, $player, and retrieving the player's input file handle, $phand, which we'll tie to a fileevent handler. The mpg123 library has its own event loop, and when $phand is readable, we must empty the mpg123 event queue in order to keep the music playing.

$player = Audio::Play::MPG123->new;
$phand = $player->IN;

    my $in_hand = sub {
	$player->poll(0);
	$mw->update;
	if ($player->state == 0) {
	    $player->stop;
	    $mw->fileevent(\$phand, 'readable' => '');
	    $mw->afterCancel($info_tid);
	    $mw->afterCancel($time_tid);
	}
    };
    $mw->fileevent(\$phand, 'readable' => $in_hand);

}

Figure 15-4. tkmpg123 playing a tune