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 ebe9a3760ca850c4db87732774ed1ed454d6ca99 Author: Dominique Dumont <d...@debian.org> Date: Wed Dec 17 08:26:18 2014 +0100 clarified code and added comments --- lib/Dpkg/Copyright/Scanner.pm | 44 +++++++++++++++++++++++++++---------------- 1 file changed, 28 insertions(+), 16 deletions(-) diff --git a/lib/Dpkg/Copyright/Scanner.pm b/lib/Dpkg/Copyright/Scanner.pm index 8a23dea..55c7b34 100644 --- a/lib/Dpkg/Copyright/Scanner.pm +++ b/lib/Dpkg/Copyright/Scanner.pm @@ -121,6 +121,7 @@ sub scan_files { return @copyright_data; } +#in each directory, pack files that have the same copyright/license information sub __pack ($h, $pack, @path) { my $old_id ; foreach my $file (sort keys %$h) { @@ -138,25 +139,30 @@ sub __pack ($h, $pack, @path) { } } +# $h is a tree of hash matching the directory structure. Each leaf is a +# copyright id. sub __squash ($h) { my %count ; - foreach my $file (sort keys %$h) { - my $id = $h->{$file}; - if (ref($id)) { - # squash may return a plain id, or a hash with '*' => id , or a non squashable hash - $h->{$file} = __squash($id); - } - if (ref($id) and defined $id->{'*'}) { - $id = $id->{'*'}; + # count the number of times each (c) info is used in this directory. + # (including the main (c) info of each subdirectory) + foreach my $name (sort keys %$h) { + my $item = $h->{$name}; + if (ref($item)) { + # squash may return a plain id, or a hash with '*' => id , + # or a non squashable hash + $h->{$name} = __squash($item); } - # do not count non squashable hashes + 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)) { $count{$id}//=0; $count{$id} ++; } } + # find the most used (c) info in this directory my $max = 0; my $max_id; foreach my $id (sort keys %count) { @@ -166,16 +172,22 @@ sub __squash ($h) { } } - foreach my $file (sort keys %$h) { - my $id = $h->{$file}; - if (ref($id) and defined $id->{'*'} and $id->{'*'} == $max_id) { - delete $id->{'*'}; - delete $h->{$file} unless keys $h->{$file}->%*; + # 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->{'*'} == $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}->%*; } - if (not ref ($id)) { - delete $h->{$file} if $id == $max_id; + if (not ref ($item)) { + # delete file that is represented by '*' entry + delete $h->{$name} if $item == $max_id; } } + # here's the '*' file representing the most used (c) info $h->{'*'} = $max_id ; 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