[SCM] Debian package checker branch, master, updated. 2.3.4-50-g7610c46
The following commit has been merged in the master branch:
commit d799233d09c57f3202333205465b868bec12bc80
Author: Raphael Geissert <atomo64@gmail.com>
Date: Sat Mar 20 19:05:27 2010 -0600
Add support to easily handle multiple async processes
diff --git a/lib/Lintian/Command/Simple.pm b/lib/Lintian/Command/Simple.pm
index 7d9c7b9..2c5aab1 100644
--- a/lib/Lintian/Command/Simple.pm
+++ b/lib/Lintian/Command/Simple.pm
@@ -92,6 +92,9 @@ sub exec {
system(@_);
+ $self->{'status'} = $?
+ if defined $self;
+
return $? >> 8;
}
@@ -113,6 +116,8 @@ sub fork {
$self = shift;
return -1
if (defined($self->{'pid'}));
+
+ $self->{'status'} = undef;
}
my $pid = fork();
@@ -136,7 +141,7 @@ sub fork {
}
}
-=item wait([pid])
+=item wait([pid|hashref])
When called as a function:
If C<pid> is specified, it waits until the given process (which must be
@@ -152,24 +157,104 @@ return status of the process as it would be seen from a shell script.
See 'perldoc -f wait' for more details about the possible meanings of
-1.
+
+To reap one from many:
+
+When starting multiple processes asynchronously, it is common to wait
+until the first is done. While the CORE::wait() function is usually
+used for that very pourpose, it does not provide the desired results
+when the processes were started via the OO interface.
+
+To help with this task, wait() can take a hash ref where the value of
+each entry is an instance of Lintian::Command::Simple. The key of each
+entry is irrelevant and is not used for any pourpose.
+
+Under this mode, wait() waits until any child process is done and if the
+deceased process is one of the set passed via the hash ref it marks it
+as reaped and stores the return status.
+The results and return value are undefined when under this mode wait()
+"accidentally" reaps a process not started by one of the objects passed
+in the hash ref.
+
+The return value in scalar context is the instance of the object that
+started the now deceased process. In list context, the key and value
+(i.e. the object instance) are returned.
+Whenever CORE::wait() would return -1, wait() returns undef or a null
+value so that it is safe to:
+
+ while($cmd = Lintian::Command::Simple::wait(\%hash)) { something; }
+
+The same is true whenever the hash reference points to an empty hash.
+
+Passing any other kind of reference or value as arguments has undefined
+results.
+
=cut
sub wait {
my ($self, $pid);
- if (ref $_[0]) {
+ if (ref $_[0] eq "Lintian::Command::Simple") {
$self = shift;
$pid = $self->{'pid'};
} else {
$pid = shift;
}
- if (defined($pid)) {
+ if (defined($pid) && !ref $pid) {
$self->{'pid'} = undef
if defined($self);
- return (waitpid($pid, 0) == -1)? -1 : ($? >> 8);
+
+ my $ret = waitpid($pid, 0);
+ my $status = $?;
+
+ $self->{'status'} = $?
+ if defined($self);
+
+ return ($ret == -1)? -1 : $status >> 8;
+ } elsif (defined($pid)) {
+ # in this case $pid is a ref (must be a hash ref)
+ # rename it accordingly:
+ my $jobs = $pid;
+ $pid = 0;
+
+ my ($reaped_pid, $reaped_status);
+
+ # count the number of members and reset the internal hash iterator
+ if (scalar keys %$jobs == 0) {
+ if (wantarray) {
+ return ();
+ } else {
+ return undef;
+ }
+ }
+
+ $reaped_pid = CORE::wait();
+ $reaped_status = $?;
+
+ if ($reaped_pid == -1) {
+ if (wantarray) {
+ return ();
+ } else {
+ return undef;
+ }
+ }
+
+ while (my ($k, $cmd) = each %$jobs) {
+ next unless (defined($cmd->pid()) && $reaped_pid == $cmd->pid());
+
+ $cmd->status($reaped_status)
+ or die("internal error: object of pid $reaped_pid " .
+ "failed to recognise its termination\n");
+
+ if (wantarray) {
+ return ($k, $cmd);
+ } else {
+ return $cmd;
+ }
+ }
} elsif (not defined($self)) {
- return (wait() == -1)? -1 : ($? >> 8);
+ return (CORE::wait() == -1)? -1 : ($? >> 8);
} else {
return -1;
}
@@ -190,6 +275,37 @@ sub pid {
return $self->{'pid'};
}
+=item status()
+
+Only available under the OO interface, it returns the return status of
+the fork()ed or exec()uted process.
+
+When used on async processes, it is only defined after calling wait().
+
+B<Note>: it is also the method internally used by wait() to set the return
+status in some cases.
+
+=cut
+
+sub status {
+ my $self = shift;
+ my $status = shift;
+
+ # Externally set the return status.
+ # It performs a sanity check by making sure the executed command is
+ # indeed done.
+ if (defined($status)) {
+ my $rstatus = $self->wait();
+
+ return 0 if ($rstatus != -1);
+
+ $self->{'status'} = $status;
+ return 1;
+ }
+
+ return (defined $self->{'status'})? $self->{'status'} >> 8 : undef;
+}
+
1;
__END__
@@ -218,7 +334,8 @@ object that started the reaped process won't be able to determine the
return status, which can affect the rest of the application.
As a general advise, the procedural and OO interfaces should not be
-combined when using fork().
+combined when using fork(). Unless, of course, you are calling wait()
+with a hash ref.
=head1 AUTHOR
diff --git a/t/scripts/Lintian/Command/Simple/07-OO-other-methods.t b/t/scripts/Lintian/Command/Simple/07-OO-other-methods.t
index 74e9acb..0d1f01c 100644
--- a/t/scripts/Lintian/Command/Simple/07-OO-other-methods.t
+++ b/t/scripts/Lintian/Command/Simple/07-OO-other-methods.t
@@ -2,7 +2,7 @@
use strict;
use warnings;
-use Test::More tests => 2;
+use Test::More tests => 10;
use Lintian::Command::Simple;
@@ -10,13 +10,42 @@ my ($cmd, $pid);
$cmd = Lintian::Command::Simple->new();
+# pid():
+
+is($cmd->pid(), undef, 'pid() returns undef without fork()');
+
$pid = $cmd->fork("true");
is($cmd->pid(), $pid, 'pid() returns PID after fork()');
$cmd->wait();
-# Using an object to run exec() should not preserve the old pid.
-# However, this test should never fail if we wait()ed for the old process
+is($cmd->pid(), undef, 'pid() returns undef after wait()');
+
+# status():
+
+$cmd = Lintian::Command::Simple->new();
+
+is($cmd->status(), undef, 'status() returns undef without fork()');
+
+$cmd->fork("true");
+is($cmd->status(), undef, 'status() returns undef without wait()');
+
+$cmd->wait();
+
+is($cmd->status(), 0, 'status() is 0 after wait()');
+
+$cmd->fork("false");
+is($cmd->status(), undef, 'status() returns undef after another fork()');
+
+$cmd->wait();
+
+is($cmd->status(), 1, 'status() is 1 after wait()');
+
+# status() with exec()
+
+$cmd = Lintian::Command::Simple->new();
$cmd->exec("true");
-isnt($cmd->pid(), $pid, 'pid() is no longer the old PID after exec()');
+is($cmd->status(), 0, "status() returns 0 for exec(true)");
+$cmd->exec("false");
+is($cmd->status(), 1, "status() returns 1 for exec(false)");
diff --git a/t/scripts/Lintian/Command/Simple/08-multiple-jobs.t b/t/scripts/Lintian/Command/Simple/08-multiple-jobs.t
new file mode 100644
index 0000000..e90a5b3
--- /dev/null
+++ b/t/scripts/Lintian/Command/Simple/08-multiple-jobs.t
@@ -0,0 +1,62 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More tests => 13;
+
+use Lintian::Command::Simple;
+
+my $cmd;
+my $c = 4;
+my %jobs;
+
+while ($c) {
+ $cmd = Lintian::Command::Simple->new();
+ $cmd->fork("sleep", 1);
+ $jobs{$c} = $cmd;
+ $c--;
+}
+
+while ($cmd = Lintian::Command::Simple::wait(\%jobs)) {
+ is($cmd->status(), 0, "One job terminated successfully");
+ $c++;
+}
+
+is($c, 4, "4 jobs were started, 4 reaped");
+
+# again, but in list context
+
+while ($c) {
+ $cmd = Lintian::Command::Simple->new();
+ $cmd->fork("sleep", 1);
+ $jobs{"Job $c"} = $cmd;
+ $c--;
+}
+
+my $name;
+while (($name, $cmd) = Lintian::Command::Simple::wait(\%jobs)) {
+ is($cmd->status(), 0, "$name terminated successfully");
+ $c++;
+}
+
+is($c, 4, "4 more jobs were started, 4 reaped");
+
+# Make sure the case of an empty hash is handled properly
+# (i.e. undef is returned and no process is reaped)
+
+%jobs = ();
+my $pid = Lintian::Command::Simple::fork("true");
+is(Lintian::Command::Simple::wait(\%jobs), undef,
+ "With an empty hash ref, wait() returns undef");
+
+is(Lintian::Command::Simple::wait($pid), 0,
+ "With an empty hash ref, wait() doesn't reap");
+
+# Again but now in list context
+
+%jobs = ();
+$pid = Lintian::Command::Simple::fork("true");
+is(my @list = Lintian::Command::Simple::wait(\%jobs), 0,
+ "With an empty hash ref, in list context wait() returns null");
+
+
--
Debian package checker
Reply to: