[SCM] Debian package checker branch, master, updated. 2.2.6-51-gda155b5
The following commit has been merged in the master branch:
commit 40f6bd3423658bb34018e948f743f1a85f362e12
Author: Raphael Geissert <atomo64@gmail.com>
Date: Sun Mar 1 14:32:37 2009 -0600
Run collection scripts in parallel
Add a 'kill' function to Lintian::Command to kill one or multiple
processes started by spawn. reap() now can also take multiple $opts.
Run all collect scripts of a given order in parallel using this
capability.
diff --git a/frontend/lintian b/frontend/lintian
index 7505b1b..192ecfc 100755
--- a/frontend/lintian
+++ b/frontend/lintian
@@ -634,7 +634,7 @@ require Lintian::Schedule;
require Lintian::Output;
import Lintian::Output qw(:messages);
require Lintian::Command;
-import Lintian::Command qw(spawn);
+import Lintian::Command qw(spawn reap);
require Lintian::Check;
import Lintian::Check qw(check_maintainer);
@@ -1330,6 +1330,7 @@ require Checker;
require Lintian::Collect;
my %overrides;
+my @pending_jobs;
PACKAGE:
foreach my $pkg_info ($schedule->get_all) {
my ($type, $pkg, $ver, $arch, $file) =
@@ -1339,6 +1340,10 @@ foreach my $pkg_info ($schedule->get_all) {
Tags::set_pkg( $file, $pkg, $ver, $arch, $long_type );
+ # Kill pending jobs, if any
+ Lintian::Command::kill(@pending_jobs);
+ undef @pending_jobs;
+
# determine base directory
my $base = "$LINTIAN_LAB/$long_type/$pkg";
unless ($base =~ m,^/,) {
@@ -1432,8 +1437,10 @@ foreach my $pkg_info ($schedule->get_all) {
}
if (($action eq 'unpack') or ($action eq 'check')) { # collect info
+ my $current_order = -1;
for my $coll (sort by_collection_order keys %unpack_infos) {
my $ci = $collection_info{$coll};
+ my %run_opts = ('description' => $coll);
# current type?
next unless ($ci->{'type'} =~ m/$type/);
@@ -1458,16 +1465,35 @@ foreach my $pkg_info ($schedule->get_all) {
next PACKAGE;
}
+ $current_order = $ci->{'order'}
+ if ($current_order == -1);
+ if ($current_order != $ci->{'order'}) {
+ debug_msg(1, "Waiting for jobs from order $current_order ...");
+ # wait until the jobs of the previous order finish:
+ reap(@pending_jobs);
+ undef @pending_jobs;
+ $current_order = $ci->{'order'};
+ }
+
# collect info
remove_status_file($base);
debug_msg(1, "Collecting info: $coll ...");
- unless (spawn({}, ["$LINTIAN_ROOT/collection/$ci->{'script'}", $pkg, $long_type])) {
+ unless (spawn(\%run_opts,
+ ["$LINTIAN_ROOT/collection/$ci->{'script'}",
+ $pkg,
+ $long_type,
+ '&'])) {
warning("collect info $coll about package $pkg: $?",
"skipping $action of $long_type package $pkg");
$exit_code = 2;
next PACKAGE;
}
+ push @pending_jobs, \%run_opts;
}
+ # wait until all the jobs finish
+ debug_msg(1, "Waiting for jobs from order $current_order ...");
+ reap(@pending_jobs);
+ undef @pending_jobs;
}
if ($action eq 'check') { # read override file
diff --git a/lib/Lintian/Command.pm b/lib/Lintian/Command.pm
index 2eefb15..32f7cdf 100644
--- a/lib/Lintian/Command.pm
+++ b/lib/Lintian/Command.pm
@@ -27,9 +27,9 @@ BEGIN {
use base qw(Exporter);
our @EXPORT = ();
-our @EXPORT_OK = qw(spawn reap);
+our @EXPORT_OK = qw(spawn reap kill);
-use IPC::Run qw(run harness);
+use IPC::Run qw(run harness kill_kill);
=head1 NAME
@@ -157,25 +157,25 @@ sub spawn {
}
$opts->{fail} ||= 'exception';
- my ($out, $pipe);
+ my ($out, $background);
my (@out, @in, @err);
if ($opts->{pipe_in}) {
@in = ('<pipe', $opts->{pipe_in});
- $pipe = 1;
+ $background = 1;
} else {
$opts->{in} ||= \undef;
@in = ('<', $opts->{in});
}
if ($opts->{pipe_out}) {
@out = ('>pipe', $opts->{pipe_out});
- $pipe = 1;
+ $background = 1;
} else {
$opts->{out} ||= \$out;
@out = ('>', $opts->{out});
}
if ($opts->{pipe_err}) {
@err = ('2>pipe', $opts->{pipe_err});
- $pipe = 1;
+ $background = 1;
} else {
$opts->{err} ||= \*STDERR;
@err = ('2>', $opts->{err});
@@ -185,13 +185,20 @@ sub spawn {
# print STDERR Dumper($opts, \@cmds);
eval {
if (@cmds == 1) {
- $opts->{harness} = harness($cmds[0], @in, @out, @err);
+ my $cmd = pop @cmds;
+ my $last = pop @$cmd;
+ # Support shell-style "command &"
+ if ($last eq '&') {
+ $background = 1;
+ } else {
+ push @$cmd, $last;
+ }
+ $opts->{harness} = harness($cmd, @in, @out, @err);
} else {
my $first = shift @cmds;
$opts->{harness} = harness($first, @in, @cmds, @out, @err);
}
-
- if ($pipe) {
+ if ($background) {
$opts->{success} = $opts->{harness}->start;
} else {
$opts->{success} = $opts->{harness}->run;
@@ -220,12 +227,13 @@ sub spawn {
return $opts->{success};
}
-=head 2 C<reap($opts)>
+=head 2 C<reap($opts[, $opts[,...]])>
-If you used one of the C<pipe_*> options to spawn(), you will need to wait
-for your child processes to finish. For this you can use the reap() function,
+If you used one of the C<pipe_*> options to spawn() or used the shell-style "&"
+operator to send the process to the background, you will need to wait for your
+child processes to finish. For this you can use the reap() function,
which you can call with the $opts hash reference you gave to spawn() and which
-will do the right thing.
+will do the right thing. Multiple $opts can be passed.
Note however that this function will not close any of the pipes for you, so
you probably want to do that first before calling this function.
@@ -250,30 +258,50 @@ All other keys are probably just ignored.
=cut
sub reap {
- my ($opts) = @_;
+ my $status;
+ while (my $opts = shift @_) {
+ next unless defined($opts->{harness});
+
+ eval {
+ $opts->{success} = $opts->{harness}->finish;
+ };
+ if ($@) {
+ require Util;
+ Util::fail($@) if $opts->{fail} ne 'never';
+ $opts->{success} = 0;
+ $opts->{exception} = $@;
+ } elsif ($opts->{fail} eq 'error'
+ and !$opts->{success}) {
+ require Util;
+ if ($opts->{description}) {
+ Util::fail("$opts->{description} failed with error code ".
+ $opts->{harness}->result);
+ } else {
+ Util::fail("command failed with error code ".
+ $opts->{harness}->result);
+ }
+ }
+ $status |= $opts->{success};
+ }
+ return $status;
+}
- return unless defined($opts->{harness});
+=head 2 C<kill($opts[, $opts[, ...]])>
- eval {
- $opts->{success} = $opts->{harness}->finish;
- };
- if ($@) {
- require Util;
- Util::fail($@) if $opts->{fail} ne 'never';
- $opts->{success} = 0;
- $opts->{exception} = $@;
- } elsif ($opts->{fail} eq 'error'
- and !$opts->{success}) {
- require Util;
- if ($opts->{description}) {
- Util::fail("$opts->{description} failed with error code ".
- $opts->{harness}->result);
- } else {
- Util::fail("command failed with error code ".
- $opts->{harness}->result);
- }
+This is a simple wrapper around the kill_kill function. It doesn't allow
+any customisation, but takes an $opts hash ref and SIGKILLs the process
+two seconds after SIGTERM is sent. If multiple hash refs are passed it
+executes kill_kill on each of them. The return status is the ORed value of
+all the executions of kill_kill.
+
+=cut
+
+sub kill {
+ my $status;
+ while (my $opts = shift @_) {
+ $status |= kill_kill($opts->{'harness'}, grace => 2);
}
- return $opts->{success};
+ return $status;
}
1;
--
Debian package checker
Reply to: