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 d72f08a24a6a31009282bea9b22373ce6e9e27a3 Author: Dominique Dumont <d...@debian.org> Date: Fri Mar 20 13:48:37 2015 +0100 (c) scanner: coalesce (c) years for files in same dir with same owners and license --- lib/Dpkg/Copyright/Scanner.pm | 81 ++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 77 insertions(+), 4 deletions(-) diff --git a/lib/Dpkg/Copyright/Scanner.pm b/lib/Dpkg/Copyright/Scanner.pm index ffd59f1..d846408 100644 --- a/lib/Dpkg/Copyright/Scanner.pm +++ b/lib/Dpkg/Copyright/Scanner.pm @@ -130,7 +130,7 @@ sub scan_files ( %args ) { say "No copyright information found" unless keys %$files; # regroup %files hash: all leaves have same id -> wild card - my $squashed = __squash($files); + my $squashed = __squash($files, \@copyrights_by_id, \$id); # pack files by copyright id my @packed = __pack_files($files); @@ -215,9 +215,66 @@ sub __pack_dir ($h, $pack, @path) { push $pack->@*, map { [ $_, $pack_by_id{$_}->@* ]; } keys %pack_by_id ; } -# $h is a tree of hash matching the directory structure. Each leaf is a +# find ids that can be merged together in a single directory. +# I.e. merge entries with same license and same set of owners. In this +# case the years are merged together. +sub __squash_copyrights_years ($count, $copyrights_by_id, $top_id_ref) { + + my %id_year_by_same_owner_license; + foreach my $id ( sort keys $count->%* ) { + my ($c,$l) = $copyrights_by_id->[$id]->@* ; + #say "id $id: c $c l $l"; + my @owners ; + my @years ; + foreach my $line (split(/\n\s+/,$c)) { + my ($owner, @year) = __split_copyright($line); + push @owners, $owner; + push @years, join(',',@year); + } + my $k = join('|', $l, @owners); + $id_year_by_same_owner_license{$k} //= []; + push $id_year_by_same_owner_license{$k}->@*, [ $id, @years ]; + } + + my @merged_c_info; + # now detect where %id_year_by_same_owner_license references more + # than one id this means that several entries can be merge in a + # *new* id (to avoid cloberring data of other directories) + foreach my $owner_license (keys %id_year_by_same_owner_license) { + my @entries = $id_year_by_same_owner_license{$owner_license}->@* ; + next unless @entries > 1; + my ($l,@owners) = split /\|/, $owner_license; + my @ranges_of_years ; + my @ids; + SQUASH: + foreach my $entry (@entries) { + my ($id, @years) = $entry->@* ; + + for (my $i = 0; $i < @years; $i++) { + my $span = $ranges_of_years[$i] //= Array::IntSpan->new(); + last SQUASH unless $span; # bail out in case of problems + $span->set_range_as_string($years[$i], 1); + } + push @ids, $id; + } + my @squashed_c; + for (my $i=0; $i < @owners ; $i++) { + $ranges_of_years[$i]->consolidate(); + $squashed_c[$i] = $ranges_of_years[$i]->get_range_list.', '.$owners[$i]; + } + my $new_id = $$top_id_ref++; + $copyrights_by_id->[$new_id] = [ join("\n ",@squashed_c), $l ]; + foreach my $id (@ids) { + $merged_c_info[$id] = $new_id; # TODO: replace the old ids with news ids in the loop below + } + } + + return @merged_c_info; +} + + # $h is a tree of hash matching the directory structure. Each leaf is a # copyright id. -sub __squash ($h) { +sub __squash ($h, $copyrights_by_id, $top_id_ref) { my %count ; # count the number of times each (c) info is used in this directory. @@ -227,7 +284,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, $copyrights_by_id, $top_id_ref); } my $id = (ref($item) and defined $item->{'*'}) ? $item->{'*'} : $item ; @@ -238,6 +295,22 @@ sub __squash ($h) { } } + # works only on (c) referenced by %count, does not use paths + my @merged_c_info + = __squash_copyrights_years (\%count, $copyrights_by_id, $top_id_ref) ; + + foreach my $name (sort keys %$h) { + my $id = $h->{$name}; + next if ref ($id); + if ( my $new_id = $merged_c_info[$id] ) { + $h->{$name} = $new_id; + $count{$new_id}//=0; + $count{$new_id} ++; + $count{$id} --; + } + #say "$name: ", $copyrights_by_id->[$id][0]; + } + # find the most used (c) info in this directory my $max = 0; my $max_id; -- 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