[SCM] Debian package checker branch, master, updated. 2.5.0-rc2-122-g12888e8
The following commit has been merged in the master branch:
commit fa4bd7cb729fa148ccbf4b60bda9ba616e3f9992
Author: Niels Thykier <niels@thykier.net>
Date: Thu Jan 13 16:57:32 2011 +0100
Replaced unpack-changes-l1
unpack-changes-l1 has been replaced by collection scripts and a little
perl sub (in Lab::Package) to create a the base dir and symlink the
changes file. The old unpack() sub has been renamed to _unpack() and
now is called by the new create_entry() if Lintian still needs the
unpack script for the given $pkg_type.
diff --git a/frontend/lintian b/frontend/lintian
index a5a9c93..842efae 100755
--- a/frontend/lintian
+++ b/frontend/lintian
@@ -1093,8 +1093,8 @@ foreach my $pkg_info ($schedule->get_all) {
# Ensure it has been unpacked
- unless ($lpkg->unpack()){
- warning("could not unpack package to desired level",
+ unless ($lpkg->create_entry()){
+ warning("could not create the package entry in the lab",
"skipping $action of $long_type package $pkg");
$exit_code = 2;
next PACKAGE;
diff --git a/lib/Lab/Package.pm b/lib/Lab/Package.pm
index 9d334bd..29766bf 100644
--- a/lib/Lab/Package.pm
+++ b/lib/Lab/Package.pm
@@ -143,7 +143,73 @@ sub delete_lab_entry {
=pod
-=item $lpkg->unpack()
+=item $lpkg->entry_exists()
+
+Returns a truth value if the lab-entry exists.
+
+=cut
+
+sub entry_exists(){
+ my ($self) = @_;
+ my $pkg_type = $self->{pkg_type};
+ my $base_dir = $self->{base_dir};
+
+ # If we have a positive unpack level, something exists
+ return 1 if ($self->{_unpack_level} > 0);
+
+ # Check if the relevant symlink exists.
+ if ($pkg_type eq 'changes'){
+ return 1 if ( -l "$base_dir/changes");
+ }
+
+ # No unpack level and no symlink => the entry does not
+ # exist or it is too broken in its current state.
+ return 0;
+}
+
+=pod
+
+=item $lpkg->create_entry()
+
+Creates a minimum lab-entry, in which collections and checks
+can be run. Note if it already exists, then this will do
+nothing.
+
+=cut
+
+sub create_entry(){
+ my ($self) = @_;
+ my $pkg_type = $self->{pkg_type};
+ my $base_dir = $self->{base_dir};
+ my $pkg_path = $self->{pkg_path};
+ my $link;
+ my $madedir = 0;
+ # It already exists.
+ return 1 if ($self->entry_exists());
+ # We still use the "legacy" unpack for some things.
+ return $self->_unpack() unless ($pkg_type eq 'changes');
+
+ unless (-d $base_dir) {
+ mkdir($base_dir, 0777) or return 0;
+ $madedir = 1;
+ }
+ $link = "$base_dir/changes";
+ unless (symlink($pkg_path, $link)){
+ # "undo" the mkdir if the symlink fails.
+ rmdir($base_dir) if($madedir);
+ return 0;
+ }
+ # Set the legacy "_unpack_level"
+ $self->{_unpack_level} = 1;
+ return 1;
+}
+
+
+=pod
+
+=item $lpkg->_unpack()
+
+DEPRECATED
Runs the unpack script for the type of package. This is
deprecated but remains until all the unpack scripts have
@@ -151,7 +217,7 @@ been replaced by coll scripts.
=cut
-sub unpack {
+sub _unpack {
my ($self) = @_;
my $level = $self->{_unpack_level};
my $base_dir = $self->{base_dir};
@@ -175,12 +241,11 @@ sub unpack {
if (($pkg_type eq 'binary') || ($pkg_type eq 'udeb')) {
Lintian::Command::Simple::run("$ENV{LINTIAN_ROOT}/unpack/unpack-binpkg-l1", $base_dir, $pkg_path) == 0
or return 0;
- } elsif ($pkg_type eq 'changes') {
- Lintian::Command::spawn({}, ["$ENV{LINTIAN_ROOT}/unpack/unpack-changes-l1", $base_dir, $pkg_path])
- or return 0;
- } else {
+ } elsif ($pkg_type eq 'source') {
Lintian::Command::Simple::run("$ENV{LINTIAN_ROOT}/unpack/unpack-srcpkg-l1", $base_dir, $pkg_path) == 0
or return 0;
+ } else {
+ fail("_unpack does not know how to handle $pkg_type");
}
$self->{_unpack_level} = 1;
diff --git a/unpack/unpack-changes-l1 b/unpack/unpack-changes-l1
deleted file mode 100755
index b80548f..0000000
--- a/unpack/unpack-changes-l1
+++ /dev/null
@@ -1,53 +0,0 @@
-#!/usr/bin/perl
-# unpack-changes-l1 -- lintian unpack script (changes file level 1)
-#
-# syntax: unpack-changes-l1 <base-dir> <changes-file>
-#
-# Note, that <changes-file> must be specified with absolute path.
-
-# Copyright (C) 1998 Christian Schwarz
-# Copyright (C) 2010 Adam D. Barratt
-#
-# 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.
-
-use strict;
-use vars qw($verbose);
-
-($#ARGV == 1) or die "syntax: unpack-changes-l1 <base-dir> <changes-file>";
-my $base_dir = shift;
-my $file = shift;
-
-# import perl libraries
-use lib "$ENV{'LINTIAN_ROOT'}/lib";
-use Util;
-
-# stat $file
-(my @stat = stat $file) or fail("$file: cannot stat: $!");
-
-# create directory in lab
-print "N: Creating directory $base_dir ...\n" if $verbose;
-mkdir("$base_dir", 0777) or fail("mkdir $base_dir: $!");
-
-symlink($file,"$base_dir/changes") or fail("cannot symlink changes file: $!");
-
-exit 0;
-
-# Local Variables:
-# indent-tabs-mode: nil
-# cperl-indent-level: 4
-# End:
-# vim: syntax=perl sw=4 sts=4 ts=4 et shiftround
--
Debian package checker
Reply to: