[SCM] Debian package checker branch, master, updated. 2.5.10-58-gdab6222
The following commit has been merged in the master branch:
commit dab6222c3a859787c170dee955d1dd4f2527d44f
Author: Niels Thykier <niels@thykier.net>
Date: Wed Jul 18 16:19:15 2012 +0200
lintian: Refactor unpacking into a separate class
Signed-off-by: Niels Thykier <niels@thykier.net>
diff --git a/debian/changelog b/debian/changelog
index cebb864..cb23782 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -60,6 +60,7 @@ lintian (2.5.11) UNRELEASED; urgency=low
+ [NT] Fix synopsis for --no-cfg option in the help output.
+ [NT] Remove chdir calls for checks.
+ [NT] Retire depreciated command line and config options.
+ + [NT] Refactor unpackaging into Lintian::Unpacker.
* lib/Lintian/Collect{,/Source}.pm:
+ [NT] Add optional parameter to field (and X_field)
@@ -74,6 +75,8 @@ lintian (2.5.11) UNRELEASED; urgency=low
+ [NT] Always use Dpkg::Vendor to determine the default
vendor. Previously dpkg-vendor would be preferred if
available.
+ * lib/Lintian/Unpacker.pm:
+ + [NT] New file.
* man/lintian.pod.in:
+ [NT] Remove documentation about removed options.
diff --git a/frontend/lintian b/frontend/lintian
index 03236eb..0abb619 100755
--- a/frontend/lintian
+++ b/frontend/lintian
@@ -633,6 +633,7 @@ require Lintian::ProcessablePool;
require Lintian::Profile;
require Lintian::Tags;
import Lintian::Tags qw(tag);
+require Lintian::Unpacker;
if (defined $experimental_output_opts) {
my %opts = map { split(/=/) } split( /,/, $experimental_output_opts );
@@ -1131,7 +1132,8 @@ debug_msg(1,
# Now action is always either "check" or "unpack"
# these two variables are used by process_package
# and need to persist between invocations.
-my %running_jobs;
+my $unpacker = Lintian::Unpacker->new (\%collection_info, $collmap,
+ \%requested_unpack, $opt{'jobs'});
my %overrides;
foreach my $gname (sort $pool->get_group_names()) {
@@ -1190,14 +1192,11 @@ if (keys %$ign_over) {
# }}}
-# Wait for any remaining jobs - %running_jobs will usually be empty here
+# Wait for any remaining jobs - There will usually not be any
# unless we had an issue examining the last package. We patiently wait
# for them here; if the user cannot be bothered to wait, he/she can send
# us a signal and the END handler will kill any remaining jobs.
-while (my ($coll, undef) = Lintian::Command::Simple::wait(\%running_jobs)) {
- delete $running_jobs{$coll};
-}
-%running_jobs = ();
+$unpacker->wait_for_jobs;
exit $exit_code;
@@ -1275,12 +1274,22 @@ sub _get_lpkg {
return $lpkg;
}
+sub prep_unpack_error {
+ my ($group, $lpkg) = @_;
+ my $err = $!;
+ my $pkg_type = $lpkg->pkg_type;
+ my $pkg_name = $lpkg->pkg_name;
+ warning ("could not create the package entry in the lab: $err",
+ "skipping $action of $pkg_type package $pkg_name");
+ $exit_code = 2;
+ $group->remove_processable ($lpkg);
+ return;
+}
+
sub unpack_group {
my ($group) = @_;
- my %worklists;
- my %job_data = ();
- my $groupid;
- my $jobs = $opt{'jobs'};
+ my @lpkgs = ();
+ my $errhandler = sub { prep_unpack_error ($group, @_) };
foreach my $proc ($group->get_processables()){
my $pkg_name = $proc->pkg_name();
@@ -1289,9 +1298,6 @@ sub unpack_group {
my $pkg_arch = $proc->pkg_arch();
my $lpkg = _get_lpkg ($proc);
my $base;
- my $info;
- my $changed = 0;
- my $cmap = $collmap->clone;
if (!defined $lpkg) {
my $err = '.';
@@ -1301,181 +1307,91 @@ sub unpack_group {
$group->remove_processable($proc);
next;
}
+
+ push @lpkgs, $lpkg;
+
# determine base directory
$base = $lpkg->base_dir();
debug_msg(1, "Unpacking $pkg_name $pkg_ver [$pkg_arch] ($pkg_type) in $base");
- $cmap->initialise();
-
- if ($lpkg->exists) {
- # It already exists - only collect what we need.
- # - $collmap has everything we need, but in some cases more than that.
- my %need = ();
- my @check = keys %requested_unpack;
- while (my $cname = pop @check) {
- my $coll = $collection_info{$cname};
- # Skip collections not relevant to us (they will never
- # be finished and we do not want to use their
- # dependencies if they are the only ones using them)
- next unless $coll->is_type ($pkg_type);
- next if $lpkg->is_coll_finished ($cname, $coll->version);
- $need{$cname} = 1;
- push @check, $coll->needs_info;
- }
- while (1) {
- my @s = grep { not $need{$_} } $cmap->selectable;
- last if not @s;
- $cmap->satisfy (@s);
- }
- } elsif (not $lpkg->create){
- # Cannot create the entry? Skip
- warning("could not create the package entry in the lab: $!",
- "skipping $action of $pkg_type package $pkg_name");
- $exit_code = 2;
- $group->remove_processable($proc);
- next;
- } else {
- # created
- $changed = 1;
- }
-
- $groupid = $proc->pkg_src . '/' . $proc->pkg_src_version
- unless defined $groupid;
# We only need this if we are checking the package later
$proc->lab_pkg($lpkg) unless $proc->isa ('Lintian::Lab::Entry');
- $worklists{$lpkg->identifier} = {
- 'collmap' => $cmap,
- 'lab-entry' => $lpkg,
- 'changed' => $changed
- };
}
+ # Kill pending jobs, if any
+ $unpacker->kill_jobs;
+ $unpacker->reset_worklist;
+
# Stop here if there is nothing list for us to do
- return unless %worklists;
+ return unless $unpacker->prepare_tasks ($errhandler, @lpkgs);
- # Kill pending jobs, if any
- Lintian::Command::Simple::kill(\%running_jobs);
- %running_jobs = ();
-
-
- while (1) {
- my $newjobs = 0;
- my $nohang = 0;
- PROC:
- foreach my $proc ($group->get_processables){
- my $procid = $proc->identifier;
- my $wlist = $worklists{$procid};
- my $cmap = $wlist->{'collmap'};
- my $lpkg = $wlist->{'lab-entry'};
- my $pkg_name = $lpkg->pkg_name;
- my $pkg_type = $lpkg->pkg_type;
- my $pkg_ver = $lpkg->pkg_version;
- my $pkg_arch = $lpkg->pkg_arch;
- my $base = $lpkg->base_dir;
- foreach my $coll ($cmap->selectable) {
- my $ci = $collection_info{$coll};
-
- # current type?
- unless ($ci->is_type ($pkg_type)) {
- $cmap->satisfy ($coll);
- next;
- }
+ my %timers = ();
+ my %hooks = (
+ 'coll-hook' => sub { coll_hook ($group, \%timers, @_); },
+ 'finish-hook' => \&finish_hook,
+ );
- # check if it has been run previously
- if ($lpkg->is_coll_finished ($coll, $ci->version)) {
- $cmap->satisfy ($coll);
- next;
- }
- # Not run before (or out of date)
- $lpkg->_clear_coll_status($coll);
-
- # collect info
- $cmap->select ($coll);
- $wlist->{'changed'} = 1;
- debug_msg(1, "Collecting info: $coll for $procid ...");
- my $cmd = Lintian::Command::Simple->new();
- unless ($cmd->background ($ci->script_path, $pkg_name, $pkg_type, $base) > 0) {
- warning("collect info $coll about package $pkg_name failed",
- "skipping $action of $pkg_type package $pkg_name");
- $exit_code = 2;
- $group->remove_processable ($lpkg);
- delete $worklists{$proc->identifier};
- # Lets not start any more jobs for this processable
- last;
- }
- $running_jobs{$cmd->pid} = $cmd;
- $job_data{$cmd->pid} = [$ci, $cmap, $lpkg, $start_timer->()];
- if ($jobs) {
- # Have we hit the limit of running jobs?
- last PROC if scalar keys %running_jobs >= $jobs;
- }
- }
- }
- # wait until a job finishes to run its branches, if any, or skip
- # this package if any of the jobs failed.
- debug_msg(1, "Reaping done jobs ... unpack group $groupid");
-
- while (my ($key, $cmd) = Lintian::Command::Simple::wait(\%running_jobs, $nohang)) {
- my $jdata = $job_data{$key};
- my (undef, undef, $lpkg) = @$jdata;
- my $res;
- delete $running_jobs{$key};
- delete $job_data{$key};
-
- # Check if the processable has been dropped due other errors.
- next unless exists $worklists{$lpkg->identifier};
-
- $res = finished_coll ($key, $cmd, $jdata);
- if ($res < 0) {
- $group->remove_processable ($lpkg);
- delete $worklists{$lpkg->identifier};
- next;
- }
- $newjobs += $res;
- $nohang = 1 if $res;
- }
- debug_msg(1, "Reap done jobs ... unpack group $groupid");
-
- # Stop when there are no running jobs and no new pending ones.
- unless (%running_jobs or $newjobs) {
- # No more running jobs and no new jobs have become available...
- # It is not quite sufficient, so ensure that all jobs have in
- # fact been run.
- my $done = 1;
- foreach my $wlist (values %worklists) {
- my $cmap = $wlist->{'collmap'};
- if ($cmap->pending) {
- $done = 0;
- last;
- }
- }
- last if $done;
- }
- }
+ $unpacker->process_tasks (\%hooks);
+}
- foreach my $proc ($group->get_processables) {
- my $lpkg = _get_lpkg ($proc);
- my $wlist = $worklists{$proc->identifier};
- my $changed = 1;
- $changed = $wlist->{'changed'} if $wlist;
+sub finish_hook {
+ my ($lpkg, $state, $changed) = @_;
+ if ($state eq 'sf-error') {
+ # The status file could not be written; give a warning.
+ my $err = $!;
+ my $pkg_name = $lpkg->pkg_name;
+ warning ("could not create status file for package $pkg_name: $err");
+ } elsif ($state eq 'unchanged' or $state eq 'changed') {
+ # If we are only unpacking stuff, auto-remove colls
+ # immediately.
if ($action ne 'check') {
# we are done now - start auto-cleaning
if (!$keep_lab) {
my $ret = auto_clean_package($lpkg);
+ # We don't have to remove it from the group if it
+ # fails as we are pretty much done.
$exit_code = 2 if $ret < 0;
- $changed = 1 if $ret;
+ $changed->() if $ret;
}
}
- if ($changed) {
- # All successful, make sure to record it so we do not unpack the same package
- # in a later run (mostly for archive-wide checks).
- unless ($lpkg->update_status_file) {
- my $pkg_name = $lpkg->pkg_name;
- warning("could not create status file for package $pkg_name: $!");
- }
+ }
+}
+
+sub coll_hook {
+ my ($group, $timers, $lpkg, $event, $cs, $pid, $exitval) = @_;
+ my $coll = $cs->name;
+ my $procid = $lpkg->identifier;
+
+ if ($event eq 'start') {
+ if ($pid < 0) {
+ # failed
+ my $pkg_name = $lpkg->pkg_name;
+ my $pkg_type = $lpkg->pkg_type;
+ warning ("collect info $coll about package $pkg_name failed",
+ "skipping $action of $pkg_type package $pkg_name");
+ $exit_code = 2;
+ $group->remove_processable ($lpkg);
+ } else {
+ # Success
+ $timers->{$pid} = $start_timer->();
+ debug_msg (1, "Collecting info: $coll for $procid ...");
+ }
+ } elsif ($event eq 'finish') {
+ if ($exitval) {
+ # Failed
+ my $pkg_name = $lpkg->pkg_name;
+ my $pkg_type = $lpkg->pkg_type;
+ warning ("collect info $coll about package $pkg_name failed");
+ warning ("skipping $action of $pkg_type package $pkg_name");
+ $exit_code = 2;
+ $group->remove_processable ($lpkg);
+ } else {
+ # success
+ my $tres = $finish_timer->($timers->{$pid});
+ debug_msg (1, "Collection script $coll for $procid done$tres");
}
}
- return 1;
+ return;
}
sub process_group {
@@ -1848,31 +1764,6 @@ sub _run_check {
return $ret;
}
-sub finished_coll {
- my ($jobid, $job, $job_data) = @_;
- my ($ci, $cmap, $lpkg, $timer) = @$job_data;
- my $coll = $ci->name;
- if ($job->status() == 0) {
- my $tres = $finish_timer->($timer);
- my $procid = $lpkg->identifier;
-
- $lpkg->_mark_coll_finished($coll, $ci->version)
- or fail ("cannot mark $coll for $procid as complete: $!");
-
- debug_msg (1, "Collection script $coll for $procid done$tres");
- } else {
- my $pkg_name = $lpkg->pkg_name;
- my $pkg_type = $lpkg->pkg_type;
- warning ("collect info $coll about package $pkg_name failed");
- warning ("skipping $action of $pkg_type package $pkg_name");
- $exit_code = 2;
- return -1;
- }
-
- $cmap->satisfy ($coll);
- return $cmap->selectable;
-}
-
# }}}
# {{{ Exit handler.
@@ -1885,10 +1776,7 @@ sub END {
$SIG{'QUIT'} = 'DEFAULT';
# Kill any remaining jobs.
- if(%running_jobs) {
- Lintian::Command::Simple::kill(\%running_jobs);
- %running_jobs = ();
- }
+ $unpacker->kill_jobs if $unpacker;
$LAB->close if $LAB;
}
diff --git a/lib/Lintian/Unpacker.pm b/lib/Lintian/Unpacker.pm
new file mode 100644
index 0000000..b1f7ad0
--- /dev/null
+++ b/lib/Lintian/Unpacker.pm
@@ -0,0 +1,477 @@
+# Copyright (C) 2012 Niels Thykier <niels@thykier.net>
+#
+# 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, you can find it on the World Wide
+# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+package Lintian::Unpacker;
+
+use strict;
+use warnings;
+
+use Carp qw(croak);
+
+use base 'Class::Accessor';
+
+use Lintian::Command::Simple;
+
+=head1 NAME
+
+Lintian::Unpacker -- Job handler to unpack collections
+
+=head1 SYNOPSIS
+
+ use Lintian::DepMap;
+ use Lintian::Unpacker;
+
+ my $done = 1;
+ my $joblimit = 4;
+ my $collmap = Lintian::DepMap->new;
+ my %coll = ();
+ my %requested = ( 'debfiles' => 1 );
+ # Map node names from $collmap to their Lintian::CollScript
+ # instance in %coll.
+ my $unpacker = Lintian::Unpacker->new (\%coll, $collmap,
+ \%requested, $joblimit);
+
+ while (1) {
+ my $errhandler = sub {}; # Insert hook
+ my @lpkgs = (); # List of Lintian::Lab::Entry instances
+ $unpacker->reset_worklist;
+ next unless $unpacker->prepare_tasks ($errhandler, @lpkgs);
+
+ my %hooks = (
+ 'coll-hook' => sub {}, # Insert hook
+ 'finish-hook' => sub {}, # Insert hook
+ );
+ $unpacker->process_tasks ();
+ last if $done;
+ }
+
+=head1 DESCRIPTION
+
+An unpacker class to extract data from lab entries and make it
+available via L<Lintian::Collect>.
+
+=head1 CLASS METHODS
+
+=over 4
+
+=item new (COLLTABLE, COLLMAP, REQUESTED[, JOBLIMIT])
+
+Creates a new unpacker.
+
+COLLTABLE is a table mapping collection names to their
+L<Lintian::CollScript> instances.
+
+COLLMAP is a L<Lintian::DepMap> decribing the dependencies between the
+collections.
+
+REQUESTED is a hash table containing requested collections. The
+values are ignored, only the keys are considered. For existing
+entries, as few collections as possible will be processed. The
+collections mentioned in REQUESTED are considered required.
+
+JOBLIMIT is the max number of jobs to be run in parallel. Can be
+changed with the L</jobs> method later.
+
+=cut
+
+
+sub new {
+ my ($class, $colltable, $collmap, $requested, $jobs) = @_;
+ my $ccmap = $collmap->clone;
+ $jobs //= 0;
+ my $self = {
+ 'colltable' => $colltable,
+ 'collmap' => $ccmap,
+ 'jobs' => $jobs,
+ 'requested' => $requested,
+ 'running-jobs' => {},
+ 'worktable' => {},
+ };
+ # Initialise our copy
+ $ccmap->initialise;
+ bless $self, $class;
+ return $self;
+}
+
+=back
+
+=head1 INSTANCE METHODS
+
+=over 4
+
+=item prepare_tasks (ERRHANDLER, LAB-ENTRY...)
+
+Prepare a number of L<lab entries|Lintian::Lab::Entry> for unpacking.
+
+The ERRHANDLER should be a code ref, which will be invoked in case
+that an entry is not in in the laboratory and cannot be created (via
+the create method). It is invoked once per failed entry giving the
+entry as first (and only) argument.
+
+If ERRHANDLER returns normally, the entry is skipped (and will not be
+unpacked later). If ERRHANDLER croaks/dies/etc., the method will
+attempt to update the status file for any entry it created before
+passing back the error to the caller (via die).
+
+LAB-ENTRY is an array of lab entries to be processed. They must be
+instances of L<Lintian::Lab::Entry>, but do not have to exists. They
+will be created as needed.
+
+If at least one entry did not cause an error, it returns a truth
+value. Otherwise, it returns C<undef>.
+
+NB: The status file is not updated for created entries on successful
+return. It should either be done by running the process_tasks method
+or manually.
+
+=cut
+
+sub prepare_tasks {
+ my ($self, $errorhandler, @lpkgs) = @_;
+ my $collmap = $self->{'collmap'};
+ my $colls = $self->{'colltable'};
+ my $requested = $self->{'requested'};
+ my %worklists = ();
+ foreach my $lpkg (@lpkgs) {
+ my $changed = 0;
+ my $cmap = $collmap->clone;
+
+ if ($lpkg->exists) {
+ # It already exists - only collect what we need.
+ # - $collmap has everything we need, but in some cases more than that.
+ my %need = ();
+ my @check;
+ my $pkg_type = $lpkg->pkg_type;
+ @check = keys %$requested if defined $requested;
+ @check = keys %$colls unless defined $requested;
+ while (my $cname = pop @check) {
+ my $coll = $colls->{$cname};
+ # Skip collections not relevant to us (they will never
+ # be finished and we do not want to use their
+ # dependencies if they are the only ones using them)
+ next unless $coll->is_type ($pkg_type);
+ next if $lpkg->is_coll_finished ($cname, $coll->version);
+ $need{$cname} = 1;
+ push @check, $coll->needs_info;
+ }
+ # skip it, unless we need to unpack something.
+ next unless %need;
+ while (1) {
+ my @s = grep { not $need{$_} } $cmap->selectable;
+ last if not @s;
+ $cmap->satisfy (@s);
+ }
+ } elsif (not $lpkg->create){
+ eval {
+ $errorhandler->($lpkg);
+ };
+ if ($@) {
+ # The error handler croaked; attempt to write status
+ # files for entries we created.
+ my $err = $@;
+ foreach my $wlist (values %worklists) {
+ next unless $wlist->{'changed'};
+ my $lpkg = $wlist->{'lab-entry'};
+ # igore errors; there is not much we can do about
+ # it here.
+ $lpkg->update_status_file;
+ }
+ # ... and pass back the error.
+ die $err;
+ }
+ next;
+ } else {
+ # created
+ $changed = 1;
+ }
+
+ $worklists{$lpkg->identifier} = {
+ 'collmap' => $cmap,
+ 'lab-entry' => $lpkg,
+ 'changed' => $changed
+ };
+ }
+ return unless %worklists;
+ $self->{'worktable'} = \%worklists;
+ return 1;
+}
+
+=item process_tasks (HOOKS)
+
+Process the current tasks. This method blocks until all tasks and
+jobs have terminated.
+
+The return value is unspecified.
+
+HOOKS (if given) is a hashref of hooks. The following hooks are available:
+
+=over 4
+
+=item coll-hook (LPKG, EVENT, COLL, PID[, STATUS])
+
+Called each time a new collection job is started or finished.
+
+LPKG is the L<entry|Lintian::lab::Entry> it is applied to. COLL is
+the L<collection|Lintian::CollScript> being applied. EVENT is either
+"start" for a new job or "finish" for a job terminating.
+
+PID is the process id of the job. If EVENT is "start" this can be -1
+to signal a failure.
+
+STATUS is the exit status of the finishing job. It is only available
+if EVENT is "finish" and if STATUS is non-zero is considered an error.
+
+=item finish-hook (LPKG, STATE[, CHANGED])
+
+Called once or twice for each entry processed at the end of the run.
+The LPKG is the L<entry|Lintian::Lab::Entry> being processed.
+
+For the first call, STATE is one of "changed" (the entry has been
+modified), "unchanged" (the entry was unmodified) or "failed" (at
+least one collection could not be applied). Note that a "failed"
+entry may (or may not) be "changed" depending on where the failure
+happened.
+
+In the first call is done before the status file is written and the
+hook may alter the entry at this point (e.g. auto-remove unused
+collections). If it does so CHANGED should be invoked as a code-ref
+to inform the unpacker of the change.
+
+The second call only happens for entries that has been changed (one
+way or another). STATE will be one of "sf-success" or "sf-error",
+which determined on whether or not status file update was successful.
+On errors (i.e. "sf-error"), $! will contain the error.
+
+=back
+
+=cut
+
+sub process_tasks {
+ my ($self, $hooks) = @_;
+ my $worklists = $self->{'worktable'};
+ my $running_jobs = $self->{'running-jobs'};
+ my $colls = $self->{'colltable'};
+ my $jobs = $self->jobs;
+
+ $hooks //= {};
+ my $coll_hook = $hooks->{'coll-hook'};
+ my $finish_hook = $hooks->{'finish-hook'};
+ my %job_data = ();
+ my %failed = ();
+
+ while (1) {
+ my $newjobs = 0;
+ my $nohang = 0;
+ PROC:
+ foreach my $procid (keys %$worklists){
+ # Skip if failed
+ next if exists $failed{$procid};
+ my $wlist = $worklists->{$procid};
+ my $cmap = $wlist->{'collmap'};
+ my $lpkg = $wlist->{'lab-entry'};
+ my $pkg_name = $lpkg->pkg_name;
+ my $pkg_type = $lpkg->pkg_type;
+ my $base = $lpkg->base_dir;
+ foreach my $coll ($cmap->selectable) {
+ my $cs = $colls->{$coll};
+
+ # current type?
+ unless ($cs->is_type ($pkg_type)) {
+ $cmap->satisfy ($coll);
+ next;
+ }
+
+ # check if it has been run previously
+ if ($lpkg->is_coll_finished ($coll, $cs->version)) {
+ $cmap->satisfy ($coll);
+ next;
+ }
+ # Not run before (or out of date)
+ $lpkg->_clear_coll_status($coll);
+
+ # collect info
+ $cmap->select ($coll);
+ $wlist->{'changed'} = 1;
+ my $cmd = Lintian::Command::Simple->new;
+ my $pid = $cmd->background ($cs->script_path, $pkg_name, $pkg_type, $base);
+ $coll_hook->($lpkg, 'start', $cs, $pid) if $coll_hook;
+ if ($pid < 0) {
+ # failed - Lets not start any more jobs for this processable
+ $failed{$lpkg->identifier} = 1;
+ last;
+ }
+ $running_jobs->{$pid} = $cmd;
+ $job_data{$pid} = [$cs, $cmap, $lpkg];
+ if ($jobs) {
+ # Have we hit the limit of running jobs?
+ last PROC if scalar keys %$running_jobs >= $jobs;
+ }
+ }
+ }
+ # wait until a job finishes to run its branches, if any, or skip
+ # this package if any of the jobs failed.
+
+ while (my ($pid, $cmd) = Lintian::Command::Simple::wait ($running_jobs, $nohang)) {
+ my $jdata = $job_data{$pid};
+ my ($cs, $cmap, $lpkg) = @$jdata;
+ my $res;
+ delete $running_jobs->{$pid};
+ delete $job_data{$pid};
+
+ my $status = $cmd->status;
+
+ $coll_hook->($lpkg, 'finish', $cs, $pid, $status)
+ if $coll_hook;
+
+ if ($status) {
+ # failed ...
+ $failed{$lpkg->identifier} = 1;
+ next;
+ }
+
+ my $coll = $cs->name;
+ # The collection was success
+ $lpkg->_mark_coll_finished ($coll, $cs->version);
+ $cmap->satisfy ($coll);
+ # If the entry is marked as failed, don't break the loop
+ # for it.
+ next if exists $failed{$lpkg->identifier};
+ my $new = $cmap->selectable;
+ if ($new) {
+ $newjobs += $new;
+ $nohang = 1;
+ }
+ }
+
+ # Stop when there are no running jobs and no new pending ones.
+ unless (%$running_jobs or $newjobs) {
+ # No more running jobs and no new jobs have become available...
+ # It is not quite sufficient, so ensure that all jobs have in
+ # fact been run.
+ my $done = 1;
+ foreach my $procid (keys %$worklists) {
+ # Failed ones do not count...
+ next if $failed{$procid};
+ my $cmap = $worklists->{$procid}->{'collmap'};
+ if ($cmap->pending) {
+ $done = 0;
+ last;
+ }
+ }
+ last if $done;
+ }
+ }
+
+ foreach my $procid (keys %$worklists) {
+ my $wlist = $worklists->{$procid};
+ my $lpkg = $wlist->{'lab-entry'};
+ my $changed = $wlist->{'changed'};
+ my $state = 'unchanged';
+ $state = 'changed' if $changed;
+ $state = 'failed' if exists $failed{$procid};
+ $finish_hook->($lpkg, $state, sub { $changed = 1 })
+ if $finish_hook;
+ if ($changed) {
+ $state = 'sf-error';
+ if ($lpkg->update_status_file) {
+ $state = 'sf-success';
+ }
+ $finish_hook->($lpkg, $state)
+ if $finish_hook;
+ }
+ }
+}
+
+=item reset_worklist
+
+Wait for all running jobs (see L</wait_for_jobs>) and discard the
+current worklist.
+
+=cut
+
+sub reset_worklist {
+ my ($self) = @_;
+ $self->wait_for_jobs;
+ $self->{'worktable'} = {}
+}
+
+=item wait_for_jobs
+
+Block and wait for all running jobs to terminate. Usually this is not
+neeed unless process_tasks was interrupted somehow.
+
+=cut
+
+sub wait_for_jobs {
+ my ($self) = @_;
+ my $running = $self->{'running-jobs'};
+ if (%{ $running }) {
+ while (my ($key, undef) = Lintian::Command::Simple::wait ($running)) {
+ delete $running->{$key};
+ }
+ $self->{'running-jobs'} = {}
+ }
+}
+
+=item kill_jobs
+
+Forcefully terminate all running jobs. Usually this is not neeed
+unless process_tasks was interrupted somehow.
+
+=cut
+
+sub kill_jobs {
+ my ($self) = @_;
+ my $running = $self->{'running-jobs'};
+ if (%{ $running }) {
+ Lintian::Command::Simple::kill ($running);
+ $self->{'running-jobs'} = {}
+ }
+}
+
+=item jobs
+
+Returns or sets the max number of jobs to be processed in parallel.
+
+If the limit is 0, then there is no limit for the number of parallel
+jobs.
+
+=cut
+
+Lintian::Unpacker->mk_accessors (qw(jobs));
+
+=back
+
+=head1 AUTHOR
+
+Originally written by Niels Thykier <niels@thykier.net> for Lintian.
+
+=head1 SEE ALSO
+
+lintian(1), Lintian::CollScript(3), Lintian::Lab::Entry(3)
+
+=cut
+
+1;
+
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
--
Debian package checker
Reply to: