[SCM] Debian package checker branch, master, updated. 2.5.10-104-gb03e884

["Niels Thykier" <niels@thykier.net>]

The following commit has been merged in the master branch:
commit b03e8842a34c18117082a91028ee69eca0b06ee1
Author: Niels Thykier <niels@thykier.net>
Date:   Sat Aug 4 12:08:32 2012 +0200

    L::CheckScript: Add method to run the check
    
    Signed-off-by: Niels Thykier <niels@thykier.net>

diff --git a/frontend/lintian b/frontend/lintian
index bc7a02f..cd8a4cf 100755
--- a/frontend/lintian
+++ b/frontend/lintian
@@ -1402,7 +1402,6 @@ sub process_group {
         my $pkg_path = $proc->pkg_path();
         my $pkg_arch = $proc->pkg_arch();
         my $lpkg = $proc->lab_pkg();
-        my $info = $proc->info();
         my $base = $lpkg->base_dir();
 
         $TAGS->file_start($pkg_path, $pkg_name, $pkg_ver, $pkg_arch, $pkg_type);
@@ -1426,17 +1425,19 @@ sub process_group {
             next if (!$cs->is_check_type ($pkg_type) || $check eq 'lintian');
 
             debug_msg(1, "Running check: $check ...");
-            my $returnvalue = _run_check ($cs, $pkg_name, $pkg_type, $info, $proc, $group);
-            # Set exit_code correctly if there was not yet an exit code
-            $exit_code = $returnvalue unless $exit_code;
+            eval {
+                $cs->run_check ($lpkg, $group);
+            };
+            my $err = $@;
             my $tres = $finish_timer->($timer);
-            debug_msg(1, "Finished check: $check$tres");
-
-            if ($returnvalue == 2) {
+            if ($err) {
+                print STDERR $err;
+                print STDERR "internal error: cannot run $check check on package $pkg_name\n";
                 warning("skipping $action of $pkg_type package $pkg_name");
                 $exit_code = 2;
                 next PROC;
             }
+            debug_msg(1, "Finished check: $check$tres");
         }
 
         unless ($exit_code) {
@@ -1740,28 +1741,6 @@ sub _update_profile {
     }
 }
 
-sub _run_check {
-    my ($cs, $pkg_name, @args) = @_;
-    my $check = $cs->name;
-    my $ret = 0;
-    my $cs_pkg = $cs->script_pkg;
-
-    require "$opt{'LINTIAN_ROOT'}/checks/$check";
-
-    {
-        # minimal "no strict refs" scope.
-        no strict 'refs';
-        eval { &{'Lintian::' . $cs_pkg . '::run'}($pkg_name, @args); };
-    }
-
-    if ( $@ ) {
-        print STDERR $@;
-        print STDERR "internal error: cannot run $check check on package $pkg_name\n";
-        $ret = 2;
-    }
-    return $ret;
-}
-
 # }}}
 
 # {{{ Exit handler.
diff --git a/lib/Lintian/CheckScript.pm b/lib/Lintian/CheckScript.pm
index 082301a..0597b5e 100644
--- a/lib/Lintian/CheckScript.pm
+++ b/lib/Lintian/CheckScript.pm
@@ -21,6 +21,8 @@ package Lintian::CheckScript;
 use strict;
 use warnings;
 
+use Cwd qw(realpath);
+use File::Basename qw(dirname);
 use base 'Class::Accessor';
 
 use Carp qw(croak);
@@ -71,10 +73,13 @@ sub new {
     my ($class, $file) = @_;
     my ($header, @tags) = read_dpkg_control ($file);
     my $self;
+    my $dir;
     unless ($header->{'check-script'}) {
         croak "Missing Check-Script field in $file";
     }
-
+    $dir = realpath ($file)
+        or croak "Cannot resolve $file: $!";
+    $dir = dirname ($dir);
 
     $self = {
         'name' => $header->{'check-script'},
@@ -87,6 +92,8 @@ sub new {
     $self->{'script_pkg'} =~ s,/,::,go;
     $self->{'script_pkg'} =~ s,[-.],_,go;
 
+    $self->{'script_path'} = $dir . '/' . $self->{'name'};
+
     if ($self->{'type'}//'ALL' ne 'ALL') {
         $self->{'type-table'} = {};
         for my $t (split /\s*,\s*/o, $self->{'type'}) {
@@ -111,11 +118,6 @@ sub new {
 Returns the "name" of the check script.  This is the value in the
 Check-Script field in the file.
 
-=item $cs->script_pkg
-
-Returns the perl "package" name for the script.  Used by the frontend
-to run the check.
-
 =item $cs->type
 
 Returns the value stored in the "Type" field of the file.  For the
@@ -131,7 +133,7 @@ Returns the value of the Abbrev field from the desc file.
 
 =cut
 
-Lintian::CheckScript->mk_ro_accessors (qw(name script_pkg type abbrev));
+Lintian::CheckScript->mk_ro_accessors (qw(name type abbrev));
 
 =item needs_info
 
@@ -184,6 +186,42 @@ sub tags {
     return keys %{ $self->{'tag-table'}};
 }
 
+=item $cs->run_check ($proc, $group)
+
+Run the check on C<$proc>, which is in the
+L<group|Lintian::ProcessableGroup> C<$group>.  C<$proc> should be
+a L<lab entry|Lintian::Lab::Entry> and must have the proper
+collections run on it prior to calling this method (See
+L<Lintian::Unpacker>).
+
+The method may error out if loading the check failed or if the check
+itself calls die/croak/fail/etc.
+
+Returns normally on success; the return value has no semantic meaning
+and is currently C<undef>.
+
+=cut
+
+sub run_check {
+    my ($self, $proc, $group) = @_;
+    my $cs_pkg = $self->{'script_pkg'};
+    my $cs_path = $self->{'script_path'};
+
+    require $cs_path;
+
+    my @args = ($proc->pkg_name,
+                $proc->pkg_type,
+                $proc->info,
+                $proc,
+                $group);
+    {
+        # minimal "no strict refs" scope.
+        no strict 'refs';
+        &{'Lintian::' . $cs_pkg . '::run'}(@args);
+    }
+    return;
+}
+
 =back
 
 =head1 AUTHOR

-- 
Debian package checker