view release on metacpan or  search on metacpan

DoCommand.pm  view on Meta::CPAN

#=============================================================================
#
# Do a command asynchronously, for Perl/Tk
#
#-----------------------------------------------------------------------------

package Tk::DoCommand;
use vars qw/$VERSION/;
$VERSION = '0.1';

use Tk::widgets qw/ROText/;
use base qw/Tk::Derived Tk::ROText/;
use strict;
use warnings;

use Carp;
use IO::Handle;
use Proc::Killfam;

Construct Tk::Widget 'DoCommand';

sub ClassInit {
    my ($class, $mw) = @_;
    $class->SUPER::ClassInit($mw);
}

sub Populate {
    my ($w, $args) = @_;
    $w->SUPER::Populate($args);
    $w->{-finish} = 0;
    $w->{-pid} = undef;
    $w->OnDestroy( sub { $w->kill_command } );
    $w->ConfigSpecs(
        -command  => [qw/PASSIVE command Command/, 'ls; sleep 3; pwd'],
        'DEFAULT' => ['SELF']
    );
    return $w;
}

# Convienence method to get result text
sub get_output {
    my ($self) = @_;
    return $self->get('1.0' => 'end -1 chars');
}

# Return the pid of the process running the command
sub get_pid {
    my ($self) = @_;
    return $self->{-pid};
}

# Return a 2 element array of $? and $! from last command execution.
# Returns undef if the command is not done
sub get_status {
    my ($self) = @_;
    my $stat = $self->{-status};
    return (defined $stat ? @$stat : undef);

}

# Is the command done?
sub is_done {
    my ($self) = @_;
    return $self->{-finish};
}

# Nuke the command
sub kill_command {
    my ($self) = @_;

    $self->{-finish} = 1;
    my $h = $self->{-handle};