From 1757478ae658a89400792db79651ccbf4a422ed2 Mon Sep 17 00:00:00 2001
From: jluehrs2 <jluehrs2@uiuc.edu>
Date: Fri, 17 Aug 2007 18:26:04 -0500
Subject: make kill block on the subprocess death by default, and allow sending
 signals other than TERM

---
 lib/IO/Pty/Easy.pm | 22 ++++++++++++++++++----
 t/002-spawn.t      |  6 ------
 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;
-- 
cgit v1.2.3-54-g00ecf