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 <d...@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 _______________________________________________ Pkg-perl-cvs-commits mailing list Pkg-perl-cvs-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits