Bug#699083: lintian: optimize t/tests suite
On 2013-01-30 14:12, Niels Thykier wrote:
> [...]
With this second patch on top of the previous one, the t/tests suite
goes from:
real 9m22.148s
user 58m8.566s
sys 6m45.349s
to:
real 8m19.918s
user 44m29.099s
sys 6m22.116s
The kfreebsd-utils packages (15 binaries, 5 udebs, 1 dsc) goes from 51s
to 28 user time (at -j9). At -j1 I can now process them at 35s-36s
instead of 51s wall time.
>
> I have come up with a prototype patch that reduces some overhead in the
> unpacker. It changes the call-interface between Lintian and the
> collections, so I figured I would send it to a review before pushing it.
>
> AFAICT, collections were once sh scripts (as were checks)[1]. Over time
> all of our checks and collections have been rewritten into pure Perl and
> now takes advantage of our Perl modules. So currently, we do not need
> the "external process" interface like we used to. By abusing the fact
> that collections are written in Perl, we can greatly reduce the
> overhead of spawning the collections.
>
> I have opt'ed for keeping the old "fork+exec" interface; I'd like to
> keep this option around for now as it is currently the only place we can
> use "foreign" languages (which may come in handy in the future). Also,
> it allowed me to be lazy and only convert a subset of the collections... :)
>
> To get a feeling of the improvement works on real data we get...
>
fields-wrong-section:
* master branch: 14.815s 32.818s 4.628s
* first patch: 13.259s 20.733s 3.312s
* both patches: 10.876s 10.257s 3.068s
>
> Running Lintian on all our t/tests artifacts[3], this patch reduces the
> user time with about 6 minutes. That is a drop from ~21 to ~15 minutes
> in time's output. Real time seems to have dropped to 5m 30s from 6m
> {0..30}s.
>
This seems to have dropped to (still at -9):
real 3m35.615s
user 3m36.146s
sys 2m3.744s
> Comments appreciated,
> ~Niels
>
> [...]
I would still appreciate comments. Even if it is just confirming that I
am not seeing things (or pulling numbers out of my hat).
~Niels
>From 2ca02585a3c57a546d0edc88fa359e8f383a877e Mon Sep 17 00:00:00 2001
From: Niels Thykier
Date: Thu, 31 Jan 2013 00:08:12 +0100
Subject: [PATCH 2/2] coll/*: Convert the rest of the collections to perl-coll
Signed-off-by: Niels Thykier
---
collection/bin-pkg-control | 12 +++++++++---
collection/bin-pkg-control.desc | 1 +
collection/changelog-file | 12 ++++++++++--
collection/changelog-file.desc | 1 +
collection/copyright-file | 12 +++++++++---
collection/copyright-file.desc | 1 +
collection/debfiles | 12 ++++++++++--
collection/debfiles.desc | 1 +
collection/debian-readme | 12 ++++++++++--
collection/debian-readme.desc | 1 +
collection/diffstat | 14 +++++++++++---
collection/diffstat.desc | 1 +
collection/doc-base-files | 11 +++++++++--
collection/doc-base-files.desc | 1 +
collection/index | 15 +++++++++++----
collection/index.desc | 2 +-
collection/init.d | 11 +++++++++--
collection/init.d.desc | 1 +
collection/menu-files | 12 ++++++++++--
collection/menu-files.desc | 1 +
collection/override-file | 12 ++++++++++--
collection/override-file.desc | 1 +
collection/scripts | 11 +++++++++--
collection/scripts.desc | 1 +
collection/src-orig-index | 21 ++++++++++++++++-----
collection/src-orig-index.desc | 3 +--
collection/unpacked | 14 +++++++++++---
collection/unpacked.desc | 1 +
28 files changed, 158 insertions(+), 40 deletions(-)
diff --git a/collection/bin-pkg-control b/collection/bin-pkg-control
index 6325973..97e9c50 100755
--- a/collection/bin-pkg-control
+++ b/collection/bin-pkg-control
@@ -19,6 +19,8 @@
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301, USA.
+package Lintian::coll::bin_pkg_control;
+
use strict;
use warnings;
@@ -26,8 +28,8 @@ use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Command qw(spawn reap);
use Lintian::Util qw(delete_dir fail);
-($#ARGV == 2) or fail 'syntax: bin-pkg-control ';
-my ($pkg, $type, $dir) = @ARGV;
+sub collect {
+my ($pkg, $type, $dir) = @_;
my (@jobs, $job);
if ( -e "$dir/control"){
@@ -74,7 +76,11 @@ unlink "$dir/control.tar" or fail "unlink control.tar: $!";
spawn({ fail => 'error' },
['chmod', '-R', 'u+rX,o-w', "$dir/control"]);
-exit 0;
+}
+
+collect (@ARGV) if $0 =~ m,(?:^|/)bin-pkg-control$,;
+
+1;
# Local Variables:
# indent-tabs-mode: nil
diff --git a/collection/bin-pkg-control.desc b/collection/bin-pkg-control.desc
index b5e08f6..7406c40 100644
--- a/collection/bin-pkg-control.desc
+++ b/collection/bin-pkg-control.desc
@@ -3,3 +3,4 @@ Info: This script extracts the contents of control.tar into the control/
and creates control-index as well.
Type: binary, udeb
Version: 2
+Interface: perl-coll
diff --git a/collection/changelog-file b/collection/changelog-file
index ade55c1..416d6c1 100755
--- a/collection/changelog-file
+++ b/collection/changelog-file
@@ -19,14 +19,16 @@
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301, USA.
+package Lintian::coll::changelog_file;
+
use strict;
use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Util qw(fail gunzip_file);
-($#ARGV == 2) or fail('syntax: changelog-file ');
-my ($pkg, $type, $dir) = @ARGV;
+sub collect {
+my ($pkg, $type, $dir) = @_;
unlink "$dir/changelog" or fail "cannot remove changelog file: $!"
if -e "$dir/changelog" or -l "$dir/changelog";
@@ -129,6 +131,12 @@ if (-f $news) {
}
}
+}
+
+collect (@ARGV) if $0 =~ m,(?:^|/)changelog-file$,;
+
+1;
+
# Local Variables:
# indent-tabs-mode: nil
# cperl-indent-level: 4
diff --git a/collection/changelog-file.desc b/collection/changelog-file.desc
index caa6950..4a5021d 100644
--- a/collection/changelog-file.desc
+++ b/collection/changelog-file.desc
@@ -6,3 +6,4 @@ Info: This script copies the changelog file and
Type: binary
Version: 1
Needs-Info: unpacked
+Interface: perl-coll
diff --git a/collection/copyright-file b/collection/copyright-file
index b77afaf..20ff5db 100755
--- a/collection/copyright-file
+++ b/collection/copyright-file
@@ -19,6 +19,8 @@
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301, USA.
+package Lintian::coll::copyright_file;
+
use strict;
use warnings;
@@ -27,8 +29,8 @@ use Lintian::Util qw(fail gunzip_file touch_file);
use File::Copy qw(copy);
-($#ARGV == 2) or fail 'syntax: copyright-file ';
-my ($pkg, $type, $dir) = @ARGV;
+sub collect {
+my ($pkg, $type, $dir) = @_;
if ( -e "$dir/copyright" ) {
unlink "$dir/copyright" or fail "unlink copyright: $!";
@@ -56,7 +58,11 @@ if (-l $file) {
touch_file ("$dir/copyright");
}
-exit 0;
+}
+
+collect (@ARGV) if $0 =~ m,(?:^|/)copyright-file$,;
+
+1;
# Local Variables:
# indent-tabs-mode: nil
diff --git a/collection/copyright-file.desc b/collection/copyright-file.desc
index beda287..d8e7610 100644
--- a/collection/copyright-file.desc
+++ b/collection/copyright-file.desc
@@ -5,3 +5,4 @@ Info: This script copies the copyright file of a package into the
Type: binary
Version: 1
Needs-Info: unpacked
+Interface: perl-coll
diff --git a/collection/debfiles b/collection/debfiles
index 48d25f8..059f474 100755
--- a/collection/debfiles
+++ b/collection/debfiles
@@ -19,6 +19,8 @@
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301, USA.
+package Lintian::coll::debfiles;
+
use strict;
use warnings;
@@ -26,8 +28,8 @@ use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Util qw(copy_dir delete_dir fail);
-($#ARGV == 2) or fail 'syntax: debfiles ';
-my ($pkg, $type, $dir) = @ARGV;
+sub collect {
+my ($pkg, $type, $dir) = @_;
-e "$dir/unpacked" or fail 'debfiles invoked with wrong dir argument';
@@ -52,6 +54,12 @@ if ( -l "$dir/unpacked/debian" ) {
copy_dir ("$dir/unpacked/debian/", "$dir/debfiles")
or fail("cannot copy unpacked/debian to debfiles: $!");
+}
+
+collect (@ARGV) if $0 =~ m,(?:^|/)debfiles$,;
+
+1;
+
# Local Variables:
# indent-tabs-mode: nil
# cperl-indent-level: 4
diff --git a/collection/debfiles.desc b/collection/debfiles.desc
index 18c7e92..35c9611 100644
--- a/collection/debfiles.desc
+++ b/collection/debfiles.desc
@@ -5,3 +5,4 @@ Info: This script collects files shipped in the source of the
Type: source
Version: 1
Needs-Info: unpacked
+Interface: perl-coll
diff --git a/collection/debian-readme b/collection/debian-readme
index 177dc38..48e5cc3 100755
--- a/collection/debian-readme
+++ b/collection/debian-readme
@@ -19,14 +19,16 @@
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301, USA.
+package Lintian::coll::debian_readme;
+
use strict;
use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Util qw(fail gunzip_file touch_file);
-($#ARGV == 2) or fail 'syntax: debian-readme ';
-my ($pkg, $type, $dir) = @ARGV;
+sub collect {
+my ($pkg, $type, $dir) = @_;
if ( -f "$dir/README.Debian") {
unlink "$dir/README.Debian" or fail "Could not remove old README.Debian: $!";
@@ -60,6 +62,12 @@ if (not defined $file) {
or fail("cannot link $file to README.Debian: $!");
}
+}
+
+collect (@ARGV) if $0 =~ m,(?:^|/)debian-readme$,;
+
+1;
+
# Local Variables:
# indent-tabs-mode: nil
# cperl-indent-level: 4
diff --git a/collection/debian-readme.desc b/collection/debian-readme.desc
index 0fd103d..5e35524 100644
--- a/collection/debian-readme.desc
+++ b/collection/debian-readme.desc
@@ -5,3 +5,4 @@ Info: This script copies the README.Debian file of a package into
Type: binary
Version: 1
Needs-Info: unpacked
+Interface: perl-coll
diff --git a/collection/diffstat b/collection/diffstat
index 31a313b..6906fbc 100755
--- a/collection/diffstat
+++ b/collection/diffstat
@@ -25,14 +25,16 @@
# perl code will be perl modules, so only one perl interpreter
# need be started.
+package Lintian::coll::diffstat;
+
use strict;
use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Util qw(fail get_dsc_info gunzip_file);
-($#ARGV == 2) or fail 'syntax: diffstat ';
-my ($pkg, undef, $dir) = @ARGV;
+sub collect {
+my ($pkg, undef, $dir) = @_;
my $data;
my $ver;
@@ -47,7 +49,7 @@ unlink "$dir/debian-patch" or fail "cannot unlink debian-patch: $!"
$ver =~ s/^\d://; #Remove epoch for this
my $diff_file = "$dir/${pkg}_${ver}.diff.gz";
-exit 0 unless (-f $diff_file);
+return unless (-f $diff_file);
gunzip_file($diff_file, "$dir/debian-patch");
@@ -66,6 +68,12 @@ while () {
close DIFF or fail("cannot close pipe to diffstat on debian-patch: $!");
close STAT or fail("error writing diffstat file: $!");
+}
+
+collect (@ARGV) if $0 =~ m,(?:^|/)diffstat$,;
+
+1;
+
# Local Variables:
# indent-tabs-mode: nil
# cperl-indent-level: 4
diff --git a/collection/diffstat.desc b/collection/diffstat.desc
index a714306..69f79e8 100644
--- a/collection/diffstat.desc
+++ b/collection/diffstat.desc
@@ -4,3 +4,4 @@ Info: This script extracts the Debian diff of a source package, and runs
diffstat on it, leaving the result in the diffstat output file
Type: source
Version: 1
+Interface: perl-coll
diff --git a/collection/doc-base-files b/collection/doc-base-files
index d9aeec1..d2e38da 100755
--- a/collection/doc-base-files
+++ b/collection/doc-base-files
@@ -20,14 +20,16 @@
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301, USA.
+package Lintian::coll::doc_base_files;
+
use strict;
use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Util qw(copy_dir delete_dir fail);
-($#ARGV == 2) or fail 'syntax: doc-base-files ';
-my ($pkg, $type, $dir) = @ARGV;
+sub collect {
+my ($pkg, $type, $dir) = @_;
if ( -e "$dir/doc-base") {
delete_dir ("$dir/doc-base")
@@ -41,6 +43,11 @@ if ( -d "$dir/unpacked/usr/share/doc-base") {
# no doc-base directory
mkdir ("$dir/doc-base", 0777) or fail "cannot mkdir doc-base: $!";
}
+}
+
+collect (@ARGV) if $0 =~ m,(?:^|/)doc-base-files$,;
+
+1;
# Local Variables:
# indent-tabs-mode: nil
diff --git a/collection/doc-base-files.desc b/collection/doc-base-files.desc
index ee4652d..c222f97 100644
--- a/collection/doc-base-files.desc
+++ b/collection/doc-base-files.desc
@@ -5,3 +5,4 @@ Info: This script copies the contents of /usr/share/doc-base into the
Type: binary
Version: 1
Needs-Info: unpacked
+Interface: perl-coll
diff --git a/collection/index b/collection/index
index 304e82e..7934afa 100755
--- a/collection/index
+++ b/collection/index
@@ -23,6 +23,8 @@
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301, USA.
+package Lintian::coll::index;
+
use strict;
use warnings;
@@ -33,8 +35,8 @@ use Lintian::Command qw(spawn reap);
use Lintian::Processable::Package;
use Lintian::Util qw(fail get_dsc_info);
-($#ARGV == 2) or fail 'syntax: index ';
-my ($pkg, $type, $dir) = @ARGV;
+sub collect {
+my ($pkg, $type, $dir) = @_;
unlink "$dir/index" or fail "Could not unlink index: $!"
if -e "$dir/index";
@@ -44,7 +46,7 @@ unlink "$dir/index-errors" or fail "Could not unlink index-errors: $!"
if -e "$dir/index-errors";
if ($type ne 'source') {
- index_deb();
+ index_deb ($dir);
} else {
chdir "$dir/unpacked"
or fail "chdir $dir/unpacked: $!";
@@ -61,10 +63,11 @@ if ($type ne 'source') {
'|', ['sort', '-k', '6'], '|', ['gzip', '-9c']);
}
-exit 0;
+}
# Creates an index for binary packages
sub index_deb {
+ my ($dir) = @_;
my (@jobs, $job);
foreach my $file (qw(index index-errors index-owner-id)) {
@@ -101,6 +104,10 @@ sub index_deb {
return 1;
}
+collect (@ARGV) if $0 =~ m,(?:^|/)index$,;
+
+1;
+
# Local Variables:
# indent-tabs-mode: nil
# cperl-indent-level: 4
diff --git a/collection/index.desc b/collection/index.desc
index 904e0b4..a46e86f 100644
--- a/collection/index.desc
+++ b/collection/index.desc
@@ -3,4 +3,4 @@ Info: This script create an index file of the contents of a package.
Type: source, binary, udeb
Needs-Info: unpacked [source]
Version: 4
-
+Interface: perl-coll
diff --git a/collection/init.d b/collection/init.d
index ddc27d2..204d8d8 100755
--- a/collection/init.d
+++ b/collection/init.d
@@ -19,14 +19,16 @@
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301, USA.
+package Lintian::coll::init_d;
+
use strict;
use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Util qw(copy_dir delete_dir fail);
-($#ARGV == 2) or fail('syntax: init.d ');
-my ($pkg, $type, $dir) = @ARGV;
+sub collect {
+my ($pkg, $type, $dir) = @_;
if (-e "$dir/init.d") {
delete_dir ("$dir/init.d")
@@ -40,6 +42,11 @@ if (-d "$dir/unpacked/etc/init.d") {
# no etc/init.d
mkdir ("$dir/init.d", 0777) or fail "cannot mkdir init.d: $!";
}
+}
+
+collect (@ARGV) if $0 =~ m,(?:^|/)init\.d$,;
+
+1;
# Local Variables:
# indent-tabs-mode: nil
diff --git a/collection/init.d.desc b/collection/init.d.desc
index d56c188..34a5826 100644
--- a/collection/init.d.desc
+++ b/collection/init.d.desc
@@ -5,3 +5,4 @@ Info: This script copies the etc/init.d directory into the lintian
Type: binary
Version: 1
Needs-Info: unpacked
+Interface: perl-coll
diff --git a/collection/menu-files b/collection/menu-files
index 15fc69a..13290e6 100755
--- a/collection/menu-files
+++ b/collection/menu-files
@@ -19,14 +19,16 @@
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301, USA.
+package Lintian::coll::menu_files;
+
use strict;
use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Util qw(copy_dir delete_dir fail);
-($#ARGV == 2) or fail('syntax: menu-files ');
-my ($pkg, $type, $dir) = @ARGV;
+sub collect {
+my ($pkg, $type, $dir) = @_;
if ( -e "$dir/menu") {
delete_dir ("$dir/menu")
@@ -50,6 +52,12 @@ while (my ($shortn, $path) = each %dirs) {
}
}
+}
+
+collect (@ARGV) if $0 =~ m,(?:^|/)menu-files$,;
+
+1;
+
# Local Variables:
# indent-tabs-mode: nil
# cperl-indent-level: 4
diff --git a/collection/menu-files.desc b/collection/menu-files.desc
index cce2451..5ff531d 100644
--- a/collection/menu-files.desc
+++ b/collection/menu-files.desc
@@ -4,3 +4,4 @@ Info: This script copies the contents of /usr/lib/menu into the lintian menu/ di
Type: binary
Version: 2
Needs-Info: unpacked
+Interface: perl-coll
diff --git a/collection/override-file b/collection/override-file
index 2256267..e647b46 100755
--- a/collection/override-file
+++ b/collection/override-file
@@ -20,14 +20,16 @@
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301, USA.
+package Lintian::coll::override_file;
+
use strict;
use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Util qw(fail gunzip_file);
-($#ARGV == 2) or fail('syntax: override-file ');
-my ($pkg, $type, $dir) = @ARGV;
+sub collect {
+my ($pkg, $type, $dir) = @_;
-d "$dir/unpacked" or fail 'override-file invoked with wrong dir argument';
@@ -61,6 +63,12 @@ if (not defined $file) {
or fail("cannot link $file to override: $!");
}
+}
+
+collect (@ARGV) if $0 =~ m,(?:^|/)override-file$,;
+
+1;
+
# Local Variables:
# indent-tabs-mode: nil
# cperl-indent-level: 4
diff --git a/collection/override-file.desc b/collection/override-file.desc
index 8f481e8..2485aaa 100644
--- a/collection/override-file.desc
+++ b/collection/override-file.desc
@@ -5,3 +5,4 @@ Info: This script copies the override file of a package into the
Type: binary, udeb, source
Version: 1
Needs-Info: unpacked
+Interface: perl-coll
diff --git a/collection/scripts b/collection/scripts
index d78c657..2136991 100755
--- a/collection/scripts
+++ b/collection/scripts
@@ -19,6 +19,8 @@
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301, USA.
+package Lintian::coll::scripts;
+
use strict;
use warnings;
@@ -26,7 +28,8 @@ use lib "$ENV{'LINTIAN_ROOT'}/lib/";
use Lintian::Collect;
use Lintian::Util qw(fail);
-my ($pkg, $type, $dir) = @ARGV;
+sub collect {
+my ($pkg, $type, $dir) = @_;
my $info = Lintian::Collect->new ($pkg, $type, $dir);
open SCRIPTS, '>', "$dir/scripts" or fail "cannot open scripts output file: $!";
@@ -85,7 +88,11 @@ for $file (readdir CONTROL) {
closedir(CONTROL);
close(SCRIPTS) or fail("cannot write control-scripts file: $!");
-exit 0;
+}
+
+collect (@ARGV) if $0 =~ m,(?:^|/)scripts$,;
+
+1;
# Local Variables:
# indent-tabs-mode: nil
diff --git a/collection/scripts.desc b/collection/scripts.desc
index 31be29a..63e46c0 100644
--- a/collection/scripts.desc
+++ b/collection/scripts.desc
@@ -8,3 +8,4 @@ Info: This script scans a binary package for scripts that start with #! and
Type: binary, udeb
Version: 1
Needs-Info: unpacked, bin-pkg-control, index
+Interface: perl-coll
diff --git a/collection/src-orig-index b/collection/src-orig-index
index 08b585a..197affe 100755
--- a/collection/src-orig-index
+++ b/collection/src-orig-index
@@ -19,6 +19,8 @@
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301, USA.
+package Lintian::coll::src_orig_index;
+
use strict;
use warnings;
@@ -30,8 +32,8 @@ use Lintian::Command qw(spawn);
use Lintian::Processable::Package;
use Lintian::Util qw(fail);
-($#ARGV == 2) or fail 'syntax: src-orig-index ';
-my ($pkg, $type, $dir) = @ARGV;
+sub collect {
+my ($pkg, $type, $dir) = @_;
my $info = Lintian::Collect->new ($pkg, $type, $dir);
if ( -f "$dir/orig-index.gz" ) {
@@ -44,13 +46,12 @@ if ( -f "$dir/orig-index.gz" ) {
if ($info->native) {
link "$dir/index.gz", "$dir/orig-index.gz"
or fail "link index.gz orig-index.gz: $!";
- exit 0
+ return;
}
index_orig ($info);
-exit 0;
-
+}
# returns all (orig) tarballs.
sub gather_tarballs {
@@ -191,3 +192,13 @@ sub index_orig {
'|', ['gzip', '--best', '-c']);
return 1;
}
+
+collect (@ARGV) if $0 =~ m,(?:^|/)src-orig-index$,;
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/collection/src-orig-index.desc b/collection/src-orig-index.desc
index 9b1d114..9d2ebd4 100644
--- a/collection/src-orig-index.desc
+++ b/collection/src-orig-index.desc
@@ -3,5 +3,4 @@ Info: This script create an index file of the contents of the orig tarballs.
Type: source
Needs-Info: index
Version: 1
-
-
+Interface: perl-coll
diff --git a/collection/unpacked b/collection/unpacked
index 87e0203..4a5d503 100755
--- a/collection/unpacked
+++ b/collection/unpacked
@@ -20,6 +20,8 @@
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301, USA.
+package Lintian::coll::unpacked;
+
use strict;
use warnings;
@@ -27,8 +29,8 @@ use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Command qw(spawn);
use Lintian::Util qw(check_path delete_dir fail);
-($#ARGV == 2) or fail('syntax: unpacked ');
-my ($pkg, $type, $dir) = @ARGV;
+sub collect {
+my ($pkg, $type, $dir) = @_;
if (-d "$dir/unpacked/") {
delete_dir ("$dir/unpacked/") or
@@ -40,7 +42,7 @@ if (-f "$dir/unpacked-errors") {
}
# If we are asked to only remove the files stop right here
if ($type =~ m/^remove-/) {
- exit 0;
+ return;
}
if ($type eq 'source') {
@@ -91,6 +93,8 @@ if ($type eq 'source') {
['chmod', '-R', 'u+rwX,go-w', "$dir/unpacked"]);
}
+}
+
sub libdpkg_unpack_dsc {
my ($dsc, $target) = @_;
my $opt = {
@@ -120,6 +124,10 @@ sub can_use_dpkg_source{
return check_path('dpkg-source');
}
+collect (@ARGV) if $0 =~ m,(?:^|/)unpacked$,;
+
+1;
+
# Local Variables:
# indent-tabs-mode: nil
# cperl-indent-level: 4
diff --git a/collection/unpacked.desc b/collection/unpacked.desc
index 871abb7..a52cd5b 100644
--- a/collection/unpacked.desc
+++ b/collection/unpacked.desc
@@ -4,3 +4,4 @@ Info: This script unpacks the package under the unpacked/ directory
Type: binary, udeb, source
Version: 1
Auto-Remove: yes
+Interface: perl-coll
--
1.7.10.4
Reply to: