diff options
author | jluehrs2 <jluehrs2@uiuc.edu> | 2007-08-17 18:26:04 -0500 |
---|---|---|
committer | jluehrs2 <jluehrs2@uiuc.edu> | 2007-08-17 18:26:04 -0500 |
commit | 1757478ae658a89400792db79651ccbf4a422ed2 (patch) | |
tree | 7e1183c17b31766a8d7e761e8d86dc45a15bf31d | |
parent | 76a624b683ffa3ad213d8d9a711a82c0f9cbcb82 (diff) | |
download | io-pty-easy-1757478ae658a89400792db79651ccbf4a422ed2.tar.gz io-pty-easy-1757478ae658a89400792db79651ccbf4a422ed2.zip |
make kill block on the subprocess death by default, and allow sending signals other than TERM
-rw-r--r-- | lib/IO/Pty/Easy.pm | 22 | ||||
-rw-r--r-- | t/002-spawn.t | 6 | ||||
-rw-r--r-- | t/010-read-write.t | 1 |
3 files changed, 18 insertions, 11 deletions
diff --git a/lib/IO/Pty/Easy.pm b/lib/IO/Pty/Easy.pm index 36acd9a..64e09e8 100644 --- a/lib/IO/Pty/Easy.pm +++ b/lib/IO/Pty/Easy.pm @@ -260,17 +260,23 @@ sub is_active { =head2 kill() -Kills the process currently running on the pty (if any). After this call, C<read()> and C<write()> will fail, and a new process can be created on the pty with C<spawn()> once C<is_active> returns false. +Sends a signal to the process currently running on the pty (if any). Optionally blocks until the process dies. -Returns 1 if a process was actually killed, and 0 otherwise. +C<kill()> takes two optional arguments. The first is the signal to send, in any format that the perl C<kill()> command recognizes (defaulting to "TERM"). The second is a boolean argument, where false means to block until the process dies, and true means to just send the signal and return. + +Returns 1 if a process was actually signaled, and 0 otherwise. =cut sub kill { my $self = shift; + my ($sig, $non_blocking) = @_; + $sig = "TERM" unless defined $sig; + + my $kills = kill $sig => $self->{pid} if $self->is_active; + $self->_wait_for_inactive unless $non_blocking; - # SIGCHLD should take care of undefing pid - kill TERM => $self->{pid} if $self->is_active; + return $kills; } # }}} @@ -295,6 +301,14 @@ sub close { } # }}} +# _wait_for_inactive() {{{ +sub _wait_for_inactive { + my $self = shift; + + 1 while $self->is_active; +} +# }}} + # Ending documentation {{{ =head1 SEE ALSO diff --git a/t/002-spawn.t b/t/002-spawn.t index 9b61437..c023857 100644 --- a/t/002-spawn.t +++ b/t/002-spawn.t @@ -9,14 +9,8 @@ $pty->spawn("$^X -ple ''"); ok($pty->is_active, "spawning a subprocess"); ok(kill(0 => $pty->{pid}), "subprocess actually exists"); $pty->kill; -TODO: { -local $TODO = "kill() needs to block"; ok(!$pty->is_active, "killing a subprocess"); -} $pty->spawn("$^X -ple ''"); $pty->close; -TODO: { -local $TODO = "kill() needs to block"; ok(!$pty->is_active, "auto-killing a pty with close()"); -} ok(!defined($pty->{pty}), "closing a pty after a spawn"); diff --git a/t/010-read-write.t b/t/010-read-write.t index d538fe8..fdc1bb6 100644 --- a/t/010-read-write.t +++ b/t/010-read-write.t @@ -12,4 +12,3 @@ like($pty->read, qr/testing/, "basic read/write testing"); # if the perl script ends with a subprocess still running, the test will exit # with the exit status of the signal that the subprocess dies with, so we have to wait for the subprocess to finish before exiting. $pty->kill; -1 while $pty->is_active; |