[SCM] Debian package checker branch, master, updated. 2.3.4-50-g7610c46
The following commit has been merged in the master branch:
commit 2b4f7bfa9fb8afb32003030118916a644e5c3add
Author: Raphael Geissert <atomo64@gmail.com>
Date: Wed Mar 3 23:55:09 2010 -0600
Introduce Lintian::Command::Simple to run commands without pipes
Running multiple asynchronous processes with Lintian::Command leads to
an extra overhead.
This new module should ease multiple tasks that don't require pipes
to/from Perl code or other special features provided by
Lintian::Command.
diff --git a/lib/Lintian/Command/Simple.pm b/lib/Lintian/Command/Simple.pm
new file mode 100644
index 0000000..7d9c7b9
--- /dev/null
+++ b/lib/Lintian/Command/Simple.pm
@@ -0,0 +1,227 @@
+# Copyright (C) 2010 Raphael Geissert <atomo64@gmail.com>
+#
+# This program is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by the Free
+# Software Foundation; either version 2 of the License, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
+# more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>.
+
+package Lintian::Command::Simple;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+Lintian::Command::Simple - Run commands without pipes
+
+=head1 SYNOPSIS
+
+ use Lintian::Command::Simple;
+
+ Lintian::Command::Simple::exec("echo", "hello world");
+
+ # Start a command in the background:
+ Lintian::Command::Simple::fork("sleep", 10);
+ print (Lintian::Command::Simple::wait())? "success" : "failure";
+
+ # Using the OO interface
+
+ my $cmd = Lintian::Command::Simple->new();
+
+ $cmd->exec("echo", "hello world");
+
+ $cmd->fork("sleep", 10);
+ print ($cmd->wait())? "success" : "failure";
+
+
+=head1 DESCRIPTION
+
+Lintian::Command::Simple allows running commands with the capability of
+running them "in the background" (asynchronously.)
+
+Pipes are not handled at all, except for those handled internally by
+the shell. See 'perldoc -f exec's note about shell metacharacters.
+If you want to pipe to/from Perl, look at Lintian::Command instead.
+
+A procedural and an Object-Oriented (from now on OO) interfaces are
+provided.
+
+It is possible to reuse an object to run multiple commands, but only
+after reaping the previous command.
+
+=item new()
+
+Creates a new Lintian::Command::Simple object and returns a reference
+to it.
+
+=cut
+
+sub new {
+ my ($class, $pkg) = @_;
+ my $self = {};
+ bless($self, $class);
+ return $self;
+}
+
+=item exec(command, argument [, ...])
+
+Executes the given C<command> with the given arguments and returns the
+status code as one would see it from a shell script.
+
+Being fair, the only advantage of this function (or method) over the
+CORE::system() function is the way the return status is reported.
+
+=cut
+
+sub exec {
+ my $self;
+
+ if (ref $_[0]) {
+ $self = shift;
+ return -1
+ if defined($self->{'pid'});
+ }
+
+ system(@_);
+
+ return $? >> 8;
+}
+
+=item fork(command, argument [, ...])
+
+Executes the given C<command> with the given arguments asynchronously
+and returns the process id of the child process.
+
+A return value of -1 indicates an error. This can either be a problem
+when calling CORE::fork() or when trying to run another command before
+calling wait() to reap the previous command.
+
+=cut
+
+sub fork {
+ my $self;
+
+ if (ref $_[0]) {
+ $self = shift;
+ return -1
+ if (defined($self->{'pid'}));
+ }
+
+ my $pid = fork();
+
+ if (not defined($pid)) {
+ # failed
+ return -1;
+ } elsif ($pid > 0) {
+ # parent
+
+ $self->{'pid'} = $pid
+ if (defined($self));
+
+ return $pid;
+ } else {
+ # child
+ close(STDIN);
+ open(STDIN, '<', '/dev/null');
+
+ CORE::exec @_ or die("Failed to exec '$_[0]': $!\n");
+ }
+}
+
+=item wait([pid])
+
+When called as a function:
+If C<pid> is specified, it waits until the given process (which must be
+a child of the current process) returns. If C<pid> is not specified, it
+waits for any child process to finish and returns.
+
+When called as a method:
+It takes no argument. It waits for the previously fork()ed process to
+return.
+
+The return value is either -1, probably indicating an error, or the
+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.
+
+=cut
+
+sub wait {
+ my ($self, $pid);
+
+ if (ref $_[0]) {
+ $self = shift;
+ $pid = $self->{'pid'};
+ } else {
+ $pid = shift;
+ }
+
+ if (defined($pid)) {
+ $self->{'pid'} = undef
+ if defined($self);
+ return (waitpid($pid, 0) == -1)? -1 : ($? >> 8);
+ } elsif (not defined($self)) {
+ return (wait() == -1)? -1 : ($? >> 8);
+ } else {
+ return -1;
+ }
+}
+
+=item pid()
+
+Only available under the OO interface, it returns the pid of a
+fork()ed process.
+
+After calling wait(), this method always returns undef.
+
+=cut
+
+sub pid {
+ my $self = shift;
+
+ return $self->{'pid'};
+}
+
+1;
+
+__END__
+
+=back
+=head1 TODO
+
+Provide the necessary methods to modify the environment variables of
+the to-be-executed commands. This would let us drop C<system_env> (from
+lib/Util.pm) and make C<exec> more useful.
+
+=head1 NOTES
+
+Unless specified by prefixing the package name, every reference to a
+function/method in this documentation refers to the functions/methods
+provided by this package itself.
+
+=head1 CAVEATS
+
+Combining asynchronous jobs from Lintian::Command and calls to wait()
+can lead to unexpected results.
+
+Calling wait() without a pid via the procedural interface can lead to
+processes started via the OO interface to be reaped. In this case, the
+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().
+
+=head1 AUTHOR
+
+Originally written by Raphael Geissert <atomo64@gmail.com> for Lintian.
+
+=cut
diff --git a/t/scripts/Lintian/Command/Simple/01-basic.t b/t/scripts/Lintian/Command/Simple/01-basic.t
new file mode 100644
index 0000000..06ba8c1
--- /dev/null
+++ b/t/scripts/Lintian/Command/Simple/01-basic.t
@@ -0,0 +1,10 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More tests => 3;
+
+BEGIN { use_ok('Lintian::Command::Simple'); }
+
+is(Lintian::Command::Simple::exec("true"), 0, 'Basic exec (true)');
+is(Lintian::Command::Simple::exec("false"), 1, 'Basic exec (false)');
diff --git a/t/scripts/Lintian/Command/Simple/02-OO-basic.t b/t/scripts/Lintian/Command/Simple/02-OO-basic.t
new file mode 100644
index 0000000..b814a53
--- /dev/null
+++ b/t/scripts/Lintian/Command/Simple/02-OO-basic.t
@@ -0,0 +1,14 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More tests => 3;
+
+use Lintian::Command::Simple;
+
+my $cmd;
+
+ok(eval { $cmd = Lintian::Command::Simple->new(); }, 'Create');
+
+is($cmd->exec("true"), 0, 'Basic exec (true)');
+is($cmd->exec("false"), 1, 'Basic exec (false)');
diff --git a/t/scripts/Lintian/Command/Simple/03-background.t b/t/scripts/Lintian/Command/Simple/03-background.t
new file mode 100644
index 0000000..a4eea79
--- /dev/null
+++ b/t/scripts/Lintian/Command/Simple/03-background.t
@@ -0,0 +1,31 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More tests => 9;
+
+use Lintian::Command::Simple;
+
+my $pid;
+
+$pid = Lintian::Command::Simple::fork("true");
+cmp_ok($pid, '>', 0, 'Basic fork (true)');
+
+is(waitpid($pid, 0), $pid, "Waiting for pid");
+is($?, 0, "Return status is 0");
+
+# Again but using helper function
+
+$pid = Lintian::Command::Simple::fork("true");
+cmp_ok($pid, '>', 0, 'Basic fork (true), take two');
+
+is(Lintian::Command::Simple::wait($pid), 0, "Waiting and checking return status");
+is(waitpid($pid, 0), -1, "Process was really reaped");
+
+# One more time, but without passing a pid to wait()
+
+$pid = Lintian::Command::Simple::fork("true");
+cmp_ok($pid, '>', 0, 'Basic fork (true), take three');
+
+is(Lintian::Command::Simple::wait(), 0, "Waiting and checking \$? of any child");
+is(wait(), -1, "Process was really reaped");
diff --git a/t/scripts/Lintian/Command/Simple/04-OO-background.t b/t/scripts/Lintian/Command/Simple/04-OO-background.t
new file mode 100644
index 0000000..48eb766
--- /dev/null
+++ b/t/scripts/Lintian/Command/Simple/04-OO-background.t
@@ -0,0 +1,26 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More tests => 6;
+
+use Lintian::Command::Simple;
+
+my ($cmd, $pid);
+
+$cmd = Lintian::Command::Simple->new();
+
+$pid = $cmd->fork("true");
+
+cmp_ok($pid, '>', 0, 'Basic fork (true)');
+is(waitpid($pid, 0), $pid, "Waiting for pid");
+is($?, 0, "Return status is 0");
+
+# Again but using helper function
+
+$cmd = Lintian::Command::Simple->new();
+$pid = $cmd->fork("true");
+
+cmp_ok($pid, '>', 0, 'Basic fork (true), take two');
+is($cmd->wait(), 0, "Waiting and checking return status");
+is(waitpid($pid, 0), -1, "Process was really reaped");
diff --git a/t/scripts/Lintian/Command/Simple/05-OO-errors.t b/t/scripts/Lintian/Command/Simple/05-OO-errors.t
new file mode 100644
index 0000000..d70cc8b
--- /dev/null
+++ b/t/scripts/Lintian/Command/Simple/05-OO-errors.t
@@ -0,0 +1,67 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More tests => 17;
+
+use Lintian::Command::Simple;
+
+my ($cmd, $pid);
+
+# Run a command via the procedural interface and make sure calling the
+# OO's interface wait() doesn't reap it (because the OO interface
+# should only deal with any command started with it)
+
+$pid = Lintian::Command::Simple::fork("true");
+
+$cmd = Lintian::Command::Simple->new();
+
+is($cmd->wait(), -1, "No job via OO interface, wait() returns -1");
+
+is(Lintian::Command::Simple::wait($pid), 0, "Checking \$? of the started child");
+
+# Run two commands in a row on the same object, without wait()ing
+
+$cmd = Lintian::Command::Simple->new();
+
+cmp_ok($cmd->fork("true"), '>', 0, 'Running one job is ok');
+is($cmd->fork("false"), -1, 'Running a second job is not');
+
+is($cmd->wait(), 0, "We wait() for the 'true' job");
+is(Lintian::Command::Simple::wait(), -1, "No other job is running");
+
+# Run two commands in a row on the same object, wait()ing
+
+$cmd = Lintian::Command::Simple->new();
+
+cmp_ok($cmd->fork("true"), '>', 0, 'Running one job is ok');
+is($cmd->wait(), 0, "We wait() for the 'true' job");
+
+cmp_ok($cmd->fork("false"), '>', 0, 'Running a second job is ok after wait()ing');
+is($cmd->wait(), 1, "We wait() for the 'true' job");
+
+# Just like the above cases, but combining a fork and an exec
+
+$cmd = Lintian::Command::Simple->new();
+
+cmp_ok($cmd->fork("true"), '>', 0, 'Running one job is ok');
+is($cmd->exec("false"), -1, 'Running exec() before wait()ing is not');
+
+is($cmd->wait(), 0, "We wait() for the 'true' job");
+
+# It can happen that a pid-less call to wait() reaps a job started by
+# an instance of the object. Make sure this case is handled nicely.
+
+$cmd = Lintian::Command::Simple->new();
+
+$cmd->fork("true");
+
+is(Lintian::Command::Simple::wait(), 0, 'Another wait() call reaps an OO job');
+
+is($cmd->wait(), -1, "We only know the job is gone, no return status");
+
+# But it was reaped anyway, so make sure it is possible to start
+# another job via the same object.
+
+cmp_ok($cmd->fork("true"), '>', 0, 'Running a second job is ok after foreign wait()');
+is($cmd->wait(), 0, "We wait() for the 'true' job");
diff --git a/t/scripts/Lintian/Command/Simple/06-return-status.t b/t/scripts/Lintian/Command/Simple/06-return-status.t
new file mode 100644
index 0000000..981ecfb
--- /dev/null
+++ b/t/scripts/Lintian/Command/Simple/06-return-status.t
@@ -0,0 +1,19 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More tests => 2;
+
+use Lintian::Command::Simple;
+
+my $pid;
+
+$pid = Lintian::Command::Simple::fork("false");
+
+is(Lintian::Command::Simple::wait($pid), 1, "Waiting with pid and checking return status");
+
+# One more time, but without passing a pid to wait()
+
+$pid = Lintian::Command::Simple::fork("false");
+
+is(Lintian::Command::Simple::wait(), 1, "Waiting without pid and checking return status");
diff --git a/t/scripts/Lintian/Command/Simple/07-OO-other-methods.t b/t/scripts/Lintian/Command/Simple/07-OO-other-methods.t
new file mode 100644
index 0000000..74e9acb
--- /dev/null
+++ b/t/scripts/Lintian/Command/Simple/07-OO-other-methods.t
@@ -0,0 +1,22 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More tests => 2;
+
+use Lintian::Command::Simple;
+
+my ($cmd, $pid);
+
+$cmd = Lintian::Command::Simple->new();
+
+$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
+
+$cmd->exec("true");
+isnt($cmd->pid(), $pid, 'pid() is no longer the old PID after exec()');
diff --git a/t/scripts/pod-coverage.t b/t/scripts/pod-coverage.t
index db371e9..4b472f0 100755
--- a/t/scripts/pod-coverage.t
+++ b/t/scripts/pod-coverage.t
@@ -16,6 +16,7 @@ our %MODULES =
'Lintian::Check' => [],
'Lintian::Collect' => [],
'Lintian::Command' => [],
+ 'Lintian::Command::Simple' => [],
'Lintian::Data' => [],
'Lintian::DepMap' => [],
'Lintian::Relation' => [ qr/^parse_element$/,
--
Debian package checker
Reply to: