[libconfig-model-dpkg-perl] 06/10: de-duplicate prune license functionality

[dod at debian.org]

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

dod pushed a commit to branch master
in repository libconfig-model-dpkg-perl.

commit 54dc2ea9618e86752400135698bb628929f84603
Author: Dominique Dumont <dod at debian.org>
Date:   Sun Sep 18 18:12:33 2016 +0200

    de-duplicate prune license functionality
---
 lib/Config/Model/Dpkg/Copyright.pm         | 19 +------------------
 lib/Config/Model/Dpkg/Copyright/License.pm | 27 +++++++++++++++++----------
 2 files changed, 18 insertions(+), 28 deletions(-)

diff --git a/lib/Config/Model/Dpkg/Copyright.pm b/lib/Config/Model/Dpkg/Copyright.pm
index de42af0..2aae235 100644
--- a/lib/Config/Model/Dpkg/Copyright.pm
+++ b/lib/Config/Model/Dpkg/Copyright.pm
@@ -287,7 +287,7 @@ sub update ($self, %args) {
     # normalized again after all the modifications
     $self->load("Files:.sort");
 
-    $self->prune_unused_global_licenses;
+    $self->fetch_element("License")-> prune_unused_licenses;
 
     $self->instance->clear_changes; # too many changes to show users
     $self->notify_change(note => "updated copyright from source file"); # force a save
@@ -303,23 +303,6 @@ sub update ($self, %args) {
     return @msgs;
 }
 
-sub prune_unused_global_licenses ($self) {
-    my %global_license = map { $_ => 1 } $self->fetch_element("License")->fetch_all_indexes;
-
-    foreach my $path ($self->fetch_element('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 @sub_licenses = split /\s+or\s+/,$names;
-        map { delete $global_license{$_}; } @sub_licenses;
-    }
-
-    foreach my $obsolete_lic (sort keys %global_license) {
-        say "Deleting unused global license $obsolete_lic";
-        $self->load(qq!License:-"$obsolete_lic"!);
-    }
-}
-
 sub _apply_fix_scan_copyright_file ($self, $current_dir) {
     # read a debian/fix.scanned.copyright file to patch scanned data
     my $debian = $current_dir->child('debian'); # may be missing in test environment
diff --git a/lib/Config/Model/Dpkg/Copyright/License.pm b/lib/Config/Model/Dpkg/Copyright/License.pm
index e4eef66..ca706eb 100644
--- a/lib/Config/Model/Dpkg/Copyright/License.pm
+++ b/lib/Config/Model/Dpkg/Copyright/License.pm
@@ -74,20 +74,27 @@ sub _get_unused_licenses ($self, @licenses) {
 
 sub check_unused_licenses ($self,$error, $warn, $fix = 0, $silent = 0) {
 
+    if ($fix) {
+        return $self->prune_unused_licenses($silent);
+    }
+
     my @unused = sort keys $self->_get_unused_licenses()->%*;
 
     return unless @unused;
 
-    if ($fix) {
-        say "Deleting unused license: @unused" unless $silent;
-        foreach my $lic (@unused) {
-            $self->delete("$lic");
-        }
-    }
-    else {
-        my $msg =  "Unused license: @unused";
-        push $warn->@*, $msg;
-    }
+    my $msg =  "Unused license: @unused";
+    push $warn->@*, $msg;
 }
 
+sub prune_unused_licenses ($self, $silent = 0) {
+
+    my @unused = sort keys $self->_get_unused_licenses()->%*;
+
+    return unless @unused;
+
+    say "Deleting unused license: @unused" unless $silent;
+    foreach my $lic (@unused) {
+        $self->delete("$lic");
+    }
+}
 1;

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