[libconfig-model-dpkg-perl] 02/11: Copyright update: override existing data with data found in directory...

[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 4b77725048ab8e6650d8f1da4f60496b1f689b4d
Author: Dominique Dumont <dod at debian.org>
Date:   Sun Jun 28 21:11:46 2015 +0200

    Copyright update: override existing data with data found in directory...
    
    The overridden data is the © and license info most often found in the
    directory.
    
    THis is not ideal as some directory have LICENSE.txt files which are not
    scanned by licensecheck.
---
 lib/Config/Model/Dpkg/Copyright.pm | 11 +++++++++++
 lib/Dpkg/Copyright/Scanner.pm      | 11 +++++++----
 2 files changed, 18 insertions(+), 4 deletions(-)

diff --git a/lib/Config/Model/Dpkg/Copyright.pm b/lib/Config/Model/Dpkg/Copyright.pm
index 41a18d4..d39dc33 100644
--- a/lib/Config/Model/Dpkg/Copyright.pm
+++ b/lib/Config/Model/Dpkg/Copyright.pm
@@ -131,6 +131,17 @@ sub update ($self, %args) {
     # load new data in config tree
     foreach my $p (@packed) {
         my ($id, @paths) = $p->@*;
+
+        if ($paths[0] =~ /\.$/) {
+            if (@paths > 1) {
+                die "Internal error: can't have dir path with file path: @paths";
+            }
+            my $p = $paths[0];
+            $p =~ s/\.$/*/;
+            my $old_data = delete $preserved_path{$p};
+            say "old dir data for $p overridden" if $old_data;
+            next;
+        };
         my $datum = dclone($data[$id]);
         my $path_str = $self->normalize_path(\@paths);
         my $l = $datum->{License}{short_name};
diff --git a/lib/Dpkg/Copyright/Scanner.pm b/lib/Dpkg/Copyright/Scanner.pm
index 14b458d..36ec096 100644
--- a/lib/Dpkg/Copyright/Scanner.pm
+++ b/lib/Dpkg/Copyright/Scanner.pm
@@ -62,6 +62,10 @@ sub print_copyright ( %args ) {
         my ($c,$l) = $copyrights_by_id->[$id]->@*;
 
         next if $c eq 'no-info-found';
+
+        # don't print directory info covered by same info in directory above
+        next if $paths[0] =~ /\.$/;
+
         push @out,
             "Files: ", join($whitespace_list_delimiter, @paths )."\n",
             "Copyright: $c\n",
@@ -377,10 +381,9 @@ sub __squash ($h) {
     foreach my $name (sort keys %$h) {
         my $item = $h->{$name};
         if (ref($item) and defined $item->{'*'} and $item->{'*'} == $max_id) {
-            # delete ./item/* which is covered by ./*
-            delete $item->{'*'};
-            # delete ./item if no files with different (c) info are there
-            delete $h->{$name} unless keys $h->{$name}->%*;
+            # rename item/* to item/. when covered by ./*
+            # this is a "weak" directory info which is handled specially
+            $item->{'.'} = delete $item->{'*'};
         }
         if (not ref ($item)) {
             # delete file that is represented by '*' entry

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