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 7295ea5d9c0a54d1494b30f450c9ced43e539d70 Author: Dominique Dumont <d...@debian.org> Date: Wed May 20 18:42:34 2015 +0200 Copyright update: can replace old directory entries --- lib/Config/Model/Dpkg/Copyright.pm | 4 ++-- lib/Dpkg/Copyright/Scanner.pm | 10 ++++++++-- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/lib/Config/Model/Dpkg/Copyright.pm b/lib/Config/Model/Dpkg/Copyright.pm index d3cad02..86ca0d9 100644 --- a/lib/Config/Model/Dpkg/Copyright.pm +++ b/lib/Config/Model/Dpkg/Copyright.pm @@ -95,7 +95,7 @@ sub update ($self, %args) { # * %old_split_files contains paths no longer present. Useful to trace deleted files # implode files entries with same data index - __squash(\%new_split_files) ; + __squash(\%new_split_files, \%old_split_files) ; # pack files by copyright id my @packed = __pack_files(\%new_split_files); @@ -168,7 +168,7 @@ sub update ($self, %args) { # warn about old files foreach my $old_path (sort keys %old_split_files) { - # put back data matching an existing dir + # put back data matching an existing dir (data may be redundant or obsolete though) if ($old_path eq '*' or ($old_path =~ m!(.*)/\*$! and $current_dir->is_dir($1))) { say "Note: preserving entry '$old_path'"; $files_obj->fetch_with_id($old_path)->load_data( $old_split_files{$old_path} ); diff --git a/lib/Dpkg/Copyright/Scanner.pm b/lib/Dpkg/Copyright/Scanner.pm index f1e1db5..b9e2a05 100644 --- a/lib/Dpkg/Copyright/Scanner.pm +++ b/lib/Dpkg/Copyright/Scanner.pm @@ -339,7 +339,7 @@ sub __coalesce_copyright_years($entries, $owners) { # $h is a tree of hash matching the directory structure. Each leaf is a # copyright id. -sub __squash ($h) { +sub __squash ($h, $old_dirs = {}, $path = [] ) { my %count ; # count the number of times each (c) info is used in this directory. @@ -349,7 +349,7 @@ sub __squash ($h) { if (ref($item)) { # squash may return a plain id, or a hash with '*' => id , # or a non squashable hash - $h->{$name} = __squash($item); + $h->{$name} = __squash($item, $old_dirs, [ $path->@*, $name ]); } my $id = (ref($item) and defined $item->{'*'}) ? $item->{'*'} : $item ; @@ -390,6 +390,12 @@ sub __squash ($h) { # here's the '*' file representing the most used (c) info $h->{'*'} //= $max_id if defined $max_id; + # delete current directory entry + my $dir_path = join('/', $path->@*,'*'); + if ($old_dirs->{$dir_path}) { + say "Removing old entry $dir_path"; + delete $old_dirs->{$dir_path}; + } return $h; } -- 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