[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index] [Thread Index]

[SCM] Debian package checker branch, master, updated. 2.5.11-119-ge291ee4



The following commit has been merged in the master branch:
commit 16719dbe6fa5edd21950ef73cb250e4f12772cc8
Author: Niels Thykier <niels@thykier.net>
Date:   Sun Jan 27 17:31:30 2013 +0100

    L::CheckScript: Add load_check method
    
    Add a new method to handle loading of the check (i.e. require +
    finding the run-sub).
    
    Signed-off-by: Niels Thykier <niels@thykier.net>

diff --git a/lib/Lintian/CheckScript.pm b/lib/Lintian/CheckScript.pm
index 409363a..0e85894 100644
--- a/lib/Lintian/CheckScript.pm
+++ b/lib/Lintian/CheckScript.pm
@@ -94,6 +94,8 @@ sub new {
 
     $self->{'script_path'} = $dir . '/' . $self->{'name'};
 
+    $self->{'script_run'} = undef; # init'ed with $self->load_check later
+
     if ($self->{'type'}//'ALL' ne 'ALL') {
         $self->{'type-table'} = {};
         for my $t (split /\s*,\s*/o, $self->{'type'}) {
@@ -191,6 +193,36 @@ sub tags {
     return keys %{ $self->{'tag-table'}};
 }
 
+=item $cs->load_check
+
+Attempts to load the check.  On failure, the load error will be
+propagated to the caller.  On success it returns normally.
+
+=cut
+
+sub load_check {
+    my ($self) = @_;
+    return if defined $self->{'script_run'};
+    # Special-case: has no perl module
+    return if $self->name eq 'lintian';
+    my $cs_path = $self->{'script_path'};
+    my $cs_pkg = $self->{'script_pkg'};
+    my $run;
+
+    require $cs_path;
+
+    {
+        # minimal "no strict refs" scope.
+        no strict 'refs';
+        $run = \&{'Lintian::' . $cs_pkg . '::run'}
+            if defined &{'Lintian::' . $cs_pkg . '::run'};
+    }
+    die "$cs_path does not have a run-sub.\n"
+        unless defined $run;
+    $self->{'script_run'} = $run;
+    return;
+}
+
 =item $cs->run_check ($proc, $group)
 
 Run the check on C<$proc>, which is in the
@@ -205,25 +237,27 @@ itself calls die/croak/fail/etc.
 Returns normally on success; the return value has no semantic meaning
 and is currently C<undef>.
 
+NB: load_check can be used to determine if the check itself is
+loadable.
+
 =cut
 
 sub run_check {
     my ($self, $proc, $group) = @_;
-    my $cs_pkg = $self->{'script_pkg'};
-    my $cs_path = $self->{'script_path'};
-
-    require $cs_path;
-
+    # Special-case: has no perl module
+    return if $self->name eq 'lintian';
     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);
+    my $cs_run = $self->{'script_run'};
+    unless (defined $cs_run) {
+        $self->load_check;
+        $cs_run = $self->{'script_run'};
     }
+
+    $cs_run->(@args);
     return;
 }
 

-- 
Debian package checker


Reply to: