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 f4be162d18817759408e4e18df427ba5a049a559
Author: Dominique Dumont <d...@debian.org>
Date:   Thu Feb 11 21:20:09 2016 +0100

    copyright update: better handle files without info
    
    id 0 is used as a special id for files that contains no info.
    
    This enables to handle correctly packages like moar where all files have
    no (c) info, but all 3rd party have information: handlign files without
    info while coaslescing restores the balance
---
 lib/Config/Model/Dpkg/Copyright.pm                 | 43 ++++++++++++++++------
 lib/Dpkg/Copyright/Scanner.pm                      | 43 ++++++++++++----------
 .../rakudo-star/debian/fill.copyright.blanks.yml   |  4 +-
 3 files changed, 58 insertions(+), 32 deletions(-)

diff --git a/lib/Config/Model/Dpkg/Copyright.pm 
b/lib/Config/Model/Dpkg/Copyright.pm
index bb6ac43..1fd8642 100644
--- a/lib/Config/Model/Dpkg/Copyright.pm
+++ b/lib/Config/Model/Dpkg/Copyright.pm
@@ -66,10 +66,12 @@ sub update ($self, %args) {
 
     # explode new data and merge with existing entries
     my %new_split_files;
-    my @data;
+    my @data = (''); # id 0 is reserved for entries without info
     my %data_keys;
     foreach my $path ( sort keys $files->%* ) {
-        my ($c, $l) = $copyrights_by_id->[ $files->{$path} ]->@*;
+        my $id = $files->{$path};
+        next if $id == 0 and not defined $copyrights_by_id->[$id];
+        my ($c, $l) = $copyrights_by_id->[$id]->@*;
 
         my $new_data = dclone (delete $old_split_files{$path} || {} );
         my $old_cop = $new_data->{Copyright};
@@ -81,6 +83,14 @@ sub update ($self, %args) {
 
         # when all fails
         $new_data->{Copyright} ||= 'UNKNOWN';
+        $new_data->{License}{short_name} ||= 'UNKNOWN';
+
+        # skip when no info is found in original data
+        if ($id == 0
+            and $new_data->{Copyright} =~ /no-info-found|unknown/i
+            and $new_data->{License}{short_name} =~ /unknown/i) {
+            next;
+        }
 
         # create an inventory of different file copyright and license data
         my $dumper = Data::Dumper->new([$new_data])->Sortkeys(1)->Indent(0);
@@ -88,7 +98,9 @@ sub update ($self, %args) {
         my $d_key = $data_keys{$datum_dump};
         if (not defined $d_key) {
             push @data,$new_data;
-            $d_key = $data_keys{$datum_dump} = $#data;
+            # id 0 is special and is treated diffrently. It must not be used 
since
+            # entries without info are skipped. Hence @data was init with ('');
+            $d_key = $data_keys{$datum_dump} = $#data ;
         }
 
         # explode path in subpaths and store id pointing to copyright data in 
there
@@ -96,6 +108,7 @@ sub update ($self, %args) {
     }
 
     # at this point:
+    # * $copyrights_by_id is not longer used, its data and merged data are in 
@data
     # * @data contains a list of copyright/license data
     # * %new_split_files contains a tree matching a directory tree where each 
leaf
     #   is an integer index referencing
@@ -150,26 +163,34 @@ sub update ($self, %args) {
             $p =~ s/\.$/*/;
             my $old_data = delete $preserved_path{$p};
 
+            my $using_old_data = 0;
             if ($old_data) {
-                my $overridden = 1;
                 if ($datum->{Copyright} =~ /unknown|no-info-found/i) {
                     $self->_say( "keeping copyright dir data for $p");
                     $datum->{Copyright} = $old_data->{Copyright};
-                    $overridden = 0;
+                    $using_old_data = 1;
                 }
                 if ($datum->{License}{short_name} =~ /unknown|no-info-found/i) 
{
                     $self->_say( "keeping license dir data for $p");
                     $datum->{License}{short_name} = 
$old_data->{License}{short_name};
                     $datum->{License}{full_license} = 
$old_data->{License}{full_license};
-                    $overridden = 0;
+                    $using_old_data = 1;
                 }
-                $self->_say( "old dir data for $p overridden") if $overridden;
+                $self->_say( "old dir data for $p overridden by new data") 
unless $using_old_data;
             }
 
-            # skip writing data because it duplicates information
-            # found in directory above above (as shown the path ending
-            # with '/.')
-            next if $paths[0] =~ /\.$/;
+            if ($paths[0] =~ /\.$/) {
+                if ($using_old_data) {
+                    # fix path ending with '.' that contain merged info from 
old copyright file
+                    $paths[0] = $p;
+                } else {
+                    # skip writing data because it duplicates information
+                    # found in directory above above (as shown the path ending
+                    # with '/.')
+                    # $self->_say( "skipping redundant path ".$paths[0] );
+                    next;
+                }
+            }
         };
 
         my $path_str = $self->normalize_path(\@paths);
diff --git a/lib/Dpkg/Copyright/Scanner.pm b/lib/Dpkg/Copyright/Scanner.pm
index b12dcc0..72f2cb9 100644
--- a/lib/Dpkg/Copyright/Scanner.pm
+++ b/lib/Dpkg/Copyright/Scanner.pm
@@ -63,7 +63,7 @@ sub print_copyright ( %args ) {
         my ($id, @paths) = $p->@*;
         my ($c,$l) = $copyrights_by_id->[$id]->@*;
 
-        next if $c eq 'no-info-found';
+        next if $id == 0;
 
         # don't print directory info covered by same info in directory above
         next if $paths[0] =~ /\.$/;
@@ -199,7 +199,7 @@ sub scan_files ( %args ) {
 
     my %copyrights ;
     my $files = {};
-    my $id = 0;
+    my $id = 1;
 
     foreach my $line (sort @lines) {
         chomp $line;
@@ -267,8 +267,9 @@ sub scan_files ( %args ) {
         _warn "Path $f has no ".join(' or ', @no_info_found)." info. You may 
want to add a line in debian/fill.copyright.blanks.yml\n"
             if @no_info_found;
 
-        #say "Storing '$f' : '$c' '$l'";
-        $files->{$f} = $copyrights{$c}{$l} //= $id++;
+        my $has_info = @no_info_found < 2;
+        # say "Storing '$f' : '$c' '$l' has_info: $has_info id $id";
+        $files->{$f} = $copyrights{$c}{$l} //= ($has_info ? $id++ : 0);
     }
 
     my @notused = grep { ! $fill_blank_data->{$_}{used} and $_; } sort keys 
%$fill_blank_data ;
@@ -389,7 +390,7 @@ sub __pack_dir ($h, $pack, @path) {
 sub __squash_copyrights_years ($copyrights_by_id) {
 
     my %id_year_by_same_owner_license;
-    for (my $id = 0; $id < $copyrights_by_id->@* ; $id++ ) {
+    for (my $id = 1; $id < $copyrights_by_id->@* ; $id++ ) {
         my ($c,$l) = $copyrights_by_id->[$id]->@* ;
         #say "id $id: c $c l $l";
         my @owners ;
@@ -487,7 +488,7 @@ sub __squash ($h) {
         foreach my $name (sort keys %$h) {
             if ($name =~ $re) {
                 my $id = delete $h->{$name};
-                #say "del global lic info $name with ".Dumper($id);
+                # say "del global lic info $name with $id";
                 # using 1 means that info from this file is easy to override
                 $count{$id} = 1;
             };
@@ -506,7 +507,8 @@ sub __squash ($h) {
         my $id = (ref($item) and defined $item->{'*'}) ? $item->{'*'} : $item ;
 
         # do not count non squashable hashes (i.e. there's no main (c) info)
-        if (not ref ($id)) {
+        # do not count ids containing no information (id 0)
+        if (not ref ($id) and $id != 0) {
             $count{$id}//=0;
             $count{$id} ++;
         }
@@ -527,20 +529,23 @@ sub __squash ($h) {
 
     # all files associated to the most used (c) info are deleted to
     # be represented by '*' entry
-    foreach my $name (sort keys %$h) {
-        my $item = $h->{$name};
-        if (ref($item) and defined $item->{'*'} and $item->{'*'} == 
$main_license_id) {
-            # 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
-            delete $h->{$name} if $item == $main_license_id;
+    if (defined $main_license_id) {
+        foreach my $name (sort keys %$h) {
+            my $item = $h->{$name};
+            if (ref($item) and defined $item->{'*'} and $item->{'*'} == 
$main_license_id) {
+                # 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
+                delete $h->{$name} if $item == $main_license_id;
+            }
         }
+
+        # here's the '*' file representing the most used (c) info
+        $h->{'*'} //= $main_license_id;
     }
-    # here's the '*' file representing the most used (c) info
-    $h->{'*'} //= $main_license_id if defined $main_license_id;
 
     return $h;
 }
diff --git 
a/t/model_tests.d/dpkg-examples/rakudo-star/debian/fill.copyright.blanks.yml 
b/t/model_tests.d/dpkg-examples/rakudo-star/debian/fill.copyright.blanks.yml
index 63955a1..f4b0a08 100644
--- a/t/model_tests.d/dpkg-examples/rakudo-star/debian/fill.copyright.blanks.yml
+++ b/t/model_tests.d/dpkg-examples/rakudo-star/debian/fill.copyright.blanks.yml
@@ -6,5 +6,5 @@ README:
 debian:
   license: Artistic-2.0
 .*jquery.*:
-  skip: 1
- 
\ No newline at end of file
+  skip: 0
+

-- 
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

Reply via email to