[libconfig-model-dpkg-perl] 01/06: grab: better propagate check arg

[dod at debian.org]

This is an automated email from the git hooks/post-receive script.

dod pushed a commit to branch check-unused-licenses-live
in repository libconfig-model-dpkg-perl.

commit 4309b37d19c2b3c051dc97ed732402d65a0820f6
Author: Dominique Dumont <dod at debian.org>
Date:   Wed Aug 31 20:55:11 2016 +0200

    grab: better propagate check arg
    
    To limit the number of warnings shown during tests
---
 lib/Config/Model/Dpkg/Copyright.pm                    | 2 +-
 lib/Config/Model/Dpkg/Copyright/License.pm            | 6 ++++--
 lib/Config/Model/models/Dpkg/Copyright/FileLicense.pl | 6 ++++--
 3 files changed, 9 insertions(+), 5 deletions(-)

diff --git a/lib/Config/Model/Dpkg/Copyright.pm b/lib/Config/Model/Dpkg/Copyright.pm
index aeaad7e..de42af0 100644
--- a/lib/Config/Model/Dpkg/Copyright.pm
+++ b/lib/Config/Model/Dpkg/Copyright.pm
@@ -230,7 +230,7 @@ sub update ($self, %args) {
             my @sub_licenses = split /\s+or\s+/,$l;
             my $lic_count = 0;
             my @empty_licenses = grep {
-                my $text = $self->grab_value(qq!License:"$_" text!) ;
+                my $text = $self->grab_value(steps => qq!License:"$_" text!, check =>'no') ;
                 $ok++ if $text;
                 $lic_count += $lic_usage_count{$_} // 0 ;
                 not $text; # to get list of empty licenses
diff --git a/lib/Config/Model/Dpkg/Copyright/License.pm b/lib/Config/Model/Dpkg/Copyright/License.pm
index 8259942..e4eef66 100644
--- a/lib/Config/Model/Dpkg/Copyright/License.pm
+++ b/lib/Config/Model/Dpkg/Copyright/License.pm
@@ -59,10 +59,12 @@ sub _get_unused_licenses ($self, @licenses) {
     my %unused = map { $_ => 1 } @to_check;
     foreach my $path ($self->grab('- Files')->fetch_all_indexes) {
         my $lic = $self->grab(qq!- Files:"$path" License!);
-
         next if $lic->fetch_element_value("full_license"); # no need of a global License
 
-        my $names = $lic->fetch_element_value("short_name") ;
+        my $names = $lic->fetch_element_value(name => "short_name", check => "no") ;
+
+        next unless $names; # may be undef when user is filling values
+
         my @sub_licenses = split /[,\s]+(or|and)[,\s]+/,$names;
         map { delete $unused{$_}; } @sub_licenses;
     }
diff --git a/lib/Config/Model/models/Dpkg/Copyright/FileLicense.pl b/lib/Config/Model/models/Dpkg/Copyright/FileLicense.pl
index 9448f4d..920e987 100644
--- a/lib/Config/Model/models/Dpkg/Copyright/FileLicense.pl
+++ b/lib/Config/Model/models/Dpkg/Copyright/FileLicense.pl
@@ -99,7 +99,8 @@ license: abbrev exception(?)
 my $old = $_;
 s/BSD-?(\\d)/BSD-$1-clause/;
 my $lic = $self->grab(\'- - - License\');
-my $text = $self->grab_value(\'- full_license\');
+# no check to avoid unused license warning (which is not yet moved)
+my $text = $self->grab_value(steps => \'- full_license\', check => \'no\');
 $lic->move($old,$_) unless $text or $lic->defined($_);
 ',
             'msg' => 'Please use BSD-x-clause name, like BSD-3-clause'
@@ -107,7 +108,8 @@ $lic->move($old,$_) unless $text or $lic->defined($_);
           '(^|\\s)MIT(\\s|$)' => {
             'fix' => '# need to test if target exists before moving element
 my $lic = $self->grab(\'- - - License\');
-my $text = $self->grab_value(\'- full_license\');
+# no check to avoid unused license warning (which is not yet moved)
+my $text = $self->grab_value(steps => \'- full_license\', check => \'no\');
 $lic->move($_,\'Expat\') unless $text or $lic->defined(\'Expat\') ;
 $_ = \'Expat\';
 ',

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libconfig-model-dpkg-perl.git