[libconfig-model-dpkg-perl] 01/04: Merge old directory data into new file data

[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 e4b5a3d42eb50babb84f05f1b5605dbf83b7d1a4
Author: Dominique Dumont <dod at debian.org>
Date:   Fri Feb 12 18:30:51 2016 +0100

    Merge old directory data into new file data
    
    this is now possible because files without info are available at this
    stage.
---
 lib/Config/Model/Dpkg/Copyright.pm | 50 +++++++++++++++++++++++++++-----------
 1 file changed, 36 insertions(+), 14 deletions(-)

diff --git a/lib/Config/Model/Dpkg/Copyright.pm b/lib/Config/Model/Dpkg/Copyright.pm
index 1fd8642..c1b04aa 100644
--- a/lib/Config/Model/Dpkg/Copyright.pm
+++ b/lib/Config/Model/Dpkg/Copyright.pm
@@ -39,6 +39,22 @@ sub _say ($self,$msg) {
     say $msg unless $self->{quiet};
 }
 
+sub _get_old_data ($old_split_files, $old_split_dirs, $path) {
+    my $data = delete $old_split_files->{$path};
+
+    if (not $data) {
+        foreach my $dir (reverse sort keys $old_split_dirs->%*) {
+            my $re = $dir;
+            $re =~ s/\*$//;
+            if ($path =~ /^$re/) {
+                $data = $old_split_dirs->{$dir}; # do not delete
+                last;
+            }
+        }
+    }
+    return defined $data ? dclone($data) : {};
+}
+
 # $args{in} can contains the output of licensecheck (for tests)
 sub update ($self, %args) {
 
@@ -47,6 +63,7 @@ sub update ($self, %args) {
 
     # explode existing path data to track deleted paths
     my %old_split_files;
+    my %old_split_dirs;
     my %debian_paths;
     foreach my $paths_str ($files_obj->fetch_all_indexes) {
         my $node = $files_obj->fetch_with_id($paths_str) ;
@@ -58,6 +75,7 @@ sub update ($self, %args) {
         else {
             foreach my $path ($self->split_path($paths_str)) {
                 $old_split_files{$path} = $data ;
+                $old_split_dirs{$path} = $data if $path =~ /\*$/;
             }
         }
     }
@@ -86,23 +104,27 @@ sub update ($self, %args) {
         $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
+        my $d_key;
+        if ( $new_data->{Copyright} =~ /no-info-found|unknown/i
             and $new_data->{License}{short_name} =~ /unknown/i) {
-            next;
+            $data[0] //= $new_data;
+            $d_key = 0;
         }
-
-        # create an inventory of different file copyright and license data
-        my $dumper = Data::Dumper->new([$new_data])->Sortkeys(1)->Indent(0);
-        my $datum_dump = $dumper->Dump;
-        my $d_key = $data_keys{$datum_dump};
-        if (not defined $d_key) {
-            push @data,$new_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 ;
+        else {
+            # create an inventory of different file copyright and license data
+            # this works like $copyrights_by_id but takes into account data coming
+            # from old copyright file like comments
+            my $dumper = Data::Dumper->new([$new_data])->Sortkeys(1)->Indent(0);
+            my $datum_dump = $dumper->Dump;
+            $d_key = $data_keys{$datum_dump};
+
+            if (not defined $d_key) {
+                push @data,$new_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
         __create_tree_leaf_from_paths(\%new_split_files, $path, $d_key);
     }

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