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 6301aab78214a2298b161f254da84b568833bcde Author: Dominique Dumont <d...@debian.org> Date: Mon Mar 23 13:35:53 2015 +0100 Scanner: globally squash copyright that have same owners and licenses --- lib/Dpkg/Copyright/Scanner.pm | 53 +++++++++++++++--------------- t/scanner/examples/pan.out | 23 ++++--------- t/scanner/examples/sdl2.out | 6 ++-- t/scanner/squash_copyright_years.t | 67 ++++++++++++++++++++++++++++++++++++++ 4 files changed, 104 insertions(+), 45 deletions(-) diff --git a/lib/Dpkg/Copyright/Scanner.pm b/lib/Dpkg/Copyright/Scanner.pm index d846408..f8975af 100644 --- a/lib/Dpkg/Copyright/Scanner.pm +++ b/lib/Dpkg/Copyright/Scanner.pm @@ -105,8 +105,9 @@ sub scan_files ( %args ) { $c =~ s/(\d+)\s*-\s*(\d+)/$1-$2/g; $c =~ s/\b(\d{4}),?\s+([\S^\d])/$1, $2/g; $c =~ s/\s+by\s+//g; - $c =~ s/all\s+rights?\s+reserved//gi; + $c =~ s/all\s+rights?\s+reserved[\s\.]*//gi; $c = 'no-info-found' if $c =~ /^\*No/; + $c =~ s/^\s+|\s+$//g; $c = __pack_copyright($c); @@ -129,8 +130,10 @@ sub scan_files ( %args ) { say "No copyright information found" unless keys %$files; + __squash_copyrights_years ($files, \@copyrights_by_id) ; + # regroup %files hash: all leaves have same id -> wild card - my $squashed = __squash($files, \@copyrights_by_id, \$id); + my $squashed = __squash($files); # pack files by copyright id my @packed = __pack_files($files); @@ -218,10 +221,10 @@ sub __pack_dir ($h, $pack, @path) { # 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) { +sub __squash_copyrights_years ($files, $copyrights_by_id) { my %id_year_by_same_owner_license; - foreach my $id ( sort keys $count->%* ) { + for (my $id = 0; $id < $#$copyrights_by_id; $id++ ) { my ($c,$l) = $copyrights_by_id->[$id]->@* ; #say "id $id: c $c l $l"; my @owners ; @@ -251,6 +254,7 @@ sub __squash_copyrights_years ($count, $copyrights_by_id, $top_id_ref) { my ($id, @years) = $entry->@* ; for (my $i = 0; $i < @years; $i++) { + last SQUASH if $years[$i] =~ /[^\d,\s-]/; 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); @@ -262,19 +266,32 @@ sub __squash_copyrights_years ($count, $copyrights_by_id, $top_id_ref) { $ranges_of_years[$i]->consolidate(); $squashed_c[$i] = $ranges_of_years[$i]->get_range_list.', '.$owners[$i]; } - my $new_id = $$top_id_ref++; + + my $new_id = @$copyrights_by_id + @merged_c_info ; $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 + $merged_c_info[$id] = $new_id; } } + # replace the old ids with news ids + __swap_merged_ids($files, \@merged_c_info); +} - return @merged_c_info; +sub __swap_merged_ids ($files, $merged_c_info) { + foreach my $name (sort keys %$files) { + my $item = $files->{$name}; + if (ref($item)) { + __swap_merged_ids($item,$merged_c_info); + } + elsif (my $new_id = $merged_c_info->[$item]) { + $files->{$name} = "$new_id" ; + } + } } - # $h is a tree of hash matching the directory structure. Each leaf is a +# $h is a tree of hash matching the directory structure. Each leaf is a # copyright id. -sub __squash ($h, $copyrights_by_id, $top_id_ref) { +sub __squash ($h) { my %count ; # count the number of times each (c) info is used in this directory. @@ -284,7 +301,7 @@ sub __squash ($h, $copyrights_by_id, $top_id_ref) { if (ref($item)) { # squash may return a plain id, or a hash with '*' => id , # or a non squashable hash - $h->{$name} = __squash($item, $copyrights_by_id, $top_id_ref); + $h->{$name} = __squash($item); } my $id = (ref($item) and defined $item->{'*'}) ? $item->{'*'} : $item ; @@ -295,22 +312,6 @@ sub __squash ($h, $copyrights_by_id, $top_id_ref) { } } - # 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; diff --git a/t/scanner/examples/pan.out b/t/scanner/examples/pan.out index f405e16..9921c76 100644 --- a/t/scanner/examples/pan.out +++ b/t/scanner/examples/pan.out @@ -1,5 +1,9 @@ Files: * -Copyright: 2002-2006, Charles Kerr <char...@rebelbase.com> +Copyright: 1994-2001, Frank Pilhofer. The author may +License: GPL-2+ + +Files: pan/* +Copyright: 2002-2007, Charles Kerr <char...@rebelbase.com> License: GPL-2 Files: pan/data/cert-store.cc @@ -8,11 +12,6 @@ Copyright: 2011, Heinrich Müller <henm...@src.gnome.org> 2002-2006, Charles Kerr <char...@rebelbase.com> License: GPL-2 -Files: pan/data/parts.cc - pan/data/parts.h -Copyright: 2002-2007, Charles Kerr <char...@rebelbase.com> -License: GPL-2 - Files: pan/general/e-util.cc pan/general/e-util.h Copyright: 2000, 2001, Ximian, Inc @@ -26,12 +25,12 @@ Copyright: 2007, Calin Culianu <ca...@ajvar.org> License: LGPL-2+ Files: pan/general/map-vector.h -Copyright: 2001, by Andrei Alexandrescu +Copyright: 2001, Andrei Alexandrescu , 2001. Addison-Wesley License: UNKNOWN Files: pan/general/sorted-vector.h -Copyright: 2002, Martin Holzherr (holzh...@infobrain.com). All rights reserved +Copyright: 2002, Martin Holzherr (holzh...@infobrain.com). License: public-domain Files: pan/gui/e-action-combo-box.c @@ -56,10 +55,6 @@ Copyright: 1989, 1991, Free Software Foundation, Inc.\n\ , the software, and\n\ License: UNKNOWN -Files: pan/gui/profiles-dialog.cc -Copyright: 2002, Charles Kerr <char...@rebelbase.com> -License: GPL-2 - Files: pan/gui/xface.c Copyright: , messages are not removed, and no monies are exchanged , James Ashton - Sydney University - June 1990 @@ -106,10 +101,6 @@ Copyright: 2011, Heinrich Müller <henm...@src.gnome.org> 2002, vjt (irssi project) License: GPL-2 -Files: uulib/* -Copyright: 1994-2001, by Frank Pilhofer. The author may -License: GPL-2+ - Files: uulib/crc32.c Copyright: 1995-2005, Mark Adler License: Zlib diff --git a/t/scanner/examples/sdl2.out b/t/scanner/examples/sdl2.out index 41255d6..7e744c0 100644 --- a/t/scanner/examples/sdl2.out +++ b/t/scanner/examples/sdl2.out @@ -21,7 +21,7 @@ Copyright: 1997-2014, Sam Lantinga <slou...@libsdl.org> License: Zlib Files: src/libm/* -Copyright: 1993, by Sun Microsystems, Inc. All rights reserved +Copyright: 1993, Sun Microsystems, Inc. License: UNKNOWN Files: src/libm/math_libm.h @@ -61,7 +61,7 @@ License: Zlib Files: src/test/SDL_test_md5.c Copyright: 1997-2014, Sam Lantinga <slou...@libsdl.org> - 1990, RSA Data Security, Inc. All rights reserved. ** + 1990, RSA Data Security, Inc. ** License: Zlib Files: src/video/x11/edid-parse.c @@ -70,7 +70,7 @@ License: Expat Files: src/video/x11/imKStoUCS.c src/video/x11/imKStoUCS.h -Copyright: 1994-2003, The XFree86 Project, Inc. All Rights Reserved +Copyright: 1994-2003, The XFree86 Project, Inc. License: Expat Files: test/* diff --git a/t/scanner/squash_copyright_years.t b/t/scanner/squash_copyright_years.t new file mode 100644 index 0000000..2bb636a --- /dev/null +++ b/t/scanner/squash_copyright_years.t @@ -0,0 +1,67 @@ +# -*- cperl -*- +use strict; +use warnings; +use 5.010; + +use Test::More; # see done_testing() +use Test::Differences; +use YAML::Tiny; + +require_ok( 'Dpkg::Copyright::Scanner' ); + +# __pack_copyright tests +my @tests = ( + [ + 'dir with squashable copyright', + "--- +pan: + data: + article-cache.cc: 4 + article-cache.h: 4 + article.cc: 6 + article.h: 6 + cert-store.cc: 5 + data.cc: 4 + data.h: 4 +", + "--- +pan: + data: + article-cache.cc: 4 + article-cache.h: 4 + article.cc: 10 + article.h: 10 + cert-store.cc: 10 + data.cc: 4 + data.h: 4 +" ], +); + +my @copyright_by_id = ( + [ 'GPL', '2002, foo'], + [ 'GPL', '2003, bar1'], + [ 'GPL', '2003, bar2'], + [ 'GPL', '2003, bar3'], + [ 'GPL', '2003, bar4'], + [ 'GPL', '2003, bar5'], + [ 'GPL', '2003, bar5'], + [ 'GPL', '2003, bar7'], + [ 'GPL', '2003, bar8'], + [ 'GPL', '2003, bar9'] +); + + + +foreach my $t (@tests) { + my ($label,$in,$expect) = @$t; + my $h = Load($in); + Dpkg::Copyright::Scanner::__squash_copyrights_years($h, \@copyright_by_id); + eq_or_diff( + $h, + ref($expect) ? $expect : Load($expect), + "__squash_copyrights_years $label" + ); +} + + +done_testing(); -- 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