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 e24508fef6bf10aad2848c85298e86219145a320 Author: Dominique Dumont <d...@debian.org> Date: Sat Mar 28 15:35:56 2015 +0100 Copyright update: perform update on complete file list ... .. and pack files after that --- lib/Config/Model/Dpkg/Copyright.pm | 50 ++++++++++++---------- lib/Dpkg/Copyright/Scanner.pm | 48 ++++++++++----------- .../debian/fix.scanned.copyright | 3 +- .../debian/fix.scanned.copyright | 3 +- t/model_tests.d/dpkg-test-conf.pl | 4 +- 5 files changed, 56 insertions(+), 52 deletions(-) diff --git a/lib/Config/Model/Dpkg/Copyright.pm b/lib/Config/Model/Dpkg/Copyright.pm index a769ac9..d25bf37 100644 --- a/lib/Config/Model/Dpkg/Copyright.pm +++ b/lib/Config/Model/Dpkg/Copyright.pm @@ -37,8 +37,6 @@ my $dumper = Config::Model::DumpAsData->new; # $args{in} can contains the output of licensecheck (for tests) sub update ($self, %args) { - my @copyright_data = scan_files( %args ); - my $files_obj = $self->grab("Files"); # explode existing path data to track deleted paths @@ -58,32 +56,33 @@ sub update ($self, %args) { } } + my ($files, $copyrights_by_id) = scan_files( %args ); + # explode new data and merge with existing entries my %new_split_files; my @data; my %data_keys; - foreach my $data (@copyright_data) { - my ($paths, $c, $l) = $data->@*; + foreach my $path ( keys $files->%* ) { + my ($c, $l) = $copyrights_by_id->[ $files->{$path} ]->@*; #say "load '@$paths' with '$c' ('$l')"; - foreach my $path (@$paths) { - my $new_data = delete $old_split_files{$path} || {} ; - # clobber old data - $new_data->{Copyright} = $c unless $c eq 'no-info-found'; - $new_data->{License}{short_name} = $l unless $l eq 'UNKNOWN'; - - # create an inventory of different file copyright and license data - my $dumper = Data::Dumper->new([$new_data])->Sortkeys(1); - my $datum_dump = $dumper->Dump; - my $d_key; - if (not $d_key = $data_keys{$datum_dump}) { - push @data,$new_data; - $data_keys{$datum_dump} = $d_key = $#data; - } - - # explode path in subpaths - __create_tree_leaf_from_paths(\%new_split_files, $path, $d_key); + my $new_data = delete $old_split_files{$path} || {} ; + # clobber old data + $new_data->{Copyright} = $c if ($c ne 'no-info-found' or not $new_data->{Copyright}); + my $old_lic = $new_data->{License}{short_name}; + $new_data->{License}{short_name} = $l if ($l ne 'UNKNOWN'); + + # create an inventory of different file copyright and license data + my $dumper = Data::Dumper->new([$new_data])->Sortkeys(1); + my $datum_dump = $dumper->Dump; + my $d_key; + if (not $d_key = $data_keys{$datum_dump}) { + push @data,$new_data; + $data_keys{$datum_dump} = $d_key = $#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); } # at this point: @@ -139,7 +138,14 @@ sub update ($self, %args) { # warn about old files foreach my $old_path (sort keys %old_split_files) { - say "Note: $old_path was removed from new upstream source"; + # put back data matching an existing dir + if ($old_path eq '*' or ($old_path =~ m!(.*)/\*$! and -d $1)) { + say "Note: preserving entry '$old_path'"; + $files_obj->fetch_with_id($old_path)->load_data( $old_split_files{$old_path} ); + } + else { + say "Note: '$old_path' was removed from new upstream source"; + } } # read a debian/fix.scanned.copyright file to patch scanned data diff --git a/lib/Dpkg/Copyright/Scanner.pm b/lib/Dpkg/Copyright/Scanner.pm index 8ecc141..15a288c 100644 --- a/lib/Dpkg/Copyright/Scanner.pm +++ b/lib/Dpkg/Copyright/Scanner.pm @@ -35,16 +35,30 @@ my $whitespace_list_delimiter = $ENV{'whitespace_list_delimiter'} || "\n "; # You should have received a copy of the GNU General Public License # along with this program. If not, see <http://www.gnu.org/licenses/>. -sub print_copyright ( %args ){ - my @copyright_data = scan_files(%args); +sub print_copyright ( %args ) { + my ($files, $copyrights_by_id) = scan_files(%args); + + # split file path and fill recursive hash, leaf is id + my $split_files = {}; + foreach my $path (keys %$files) { + __create_tree_leaf_from_paths ($split_files,$path,$files->{$path}); + } + + # regroup %files hash: all leaves have same id -> wild card + __squash($split_files); + + # pack files by copyright id + my @packed = __pack_files($split_files); my @out ; - foreach my $data (@copyright_data) { - my ($paths, $c, $l) = $data->@*; + foreach my $p (@packed) { + my ($id, @paths) = $p->@*; + my ($c,$l) = $copyrights_by_id->[$id]->@*; + next if $c eq 'no-info-found'; push @out, - "Files: ", join($whitespace_list_delimiter, $paths->@* )."\n", + "Files: ", join($whitespace_list_delimiter, @paths )."\n", "Copyright: $c\n", "License: $l\n", "\n"; } @@ -126,30 +140,12 @@ sub scan_files ( %args ) { say "No copyright information found" unless keys %$files; my $merged_c_info = __squash_copyrights_years (\@copyrights_by_id) ; + # replace the old ids with news ids __swap_merged_ids($files, $merged_c_info); - # split file path and fill recursive hash, leaf is id - my $split_files = {}; - foreach my $path (keys %$files) { - __create_tree_leaf_from_paths ($split_files,$path,$files->{$path}); - } - - # regroup %files hash: all leaves have same id -> wild card - __squash($split_files); - - # pack files by copyright id - my @packed = __pack_files($split_files); - - my @copyright_data; - - foreach my $p (@packed) { - my ($id, @paths) = $p->@*; - my ($c,$l) = $copyrights_by_id[$id]->@*; - push @copyright_data, [ \@paths, $c, $l ]; - } - - return @copyright_data; + # stop here for update ... + return ($files, \@copyrights_by_id) ; } sub __split_copyright ($c) { diff --git a/t/model_tests.d/dpkg-examples/pan-copyright-upgrade-update-more/debian/fix.scanned.copyright b/t/model_tests.d/dpkg-examples/pan-copyright-upgrade-update-more/debian/fix.scanned.copyright index 29d1ede..a2a0f26 100644 --- a/t/model_tests.d/dpkg-examples/pan-copyright-upgrade-update-more/debian/fix.scanned.copyright +++ b/t/model_tests.d/dpkg-examples/pan-copyright-upgrade-update-more/debian/fix.scanned.copyright @@ -1,3 +1,4 @@ ! copyright Files:"pan/general/map-vector.h" Copyright=~"s/\n.*Addison-Wesley//" ! copyright Files:~pan/gui/e-charset.c Copyright=~"s/\s\(.*\)//" -! copyright Files:"pan/gui/license.h" Copyright=~"s/\s*,\s*Inc.*//s" \ No newline at end of file +! copyright Files:"pan/gui/license.h" Copyright=~"s/\s*,\s*Inc.*//s" +! copyright Files:"uulib/*" Copyright=~"s/\s+The.*//" diff --git a/t/model_tests.d/dpkg-examples/pan-copyright-upgrade-update/debian/fix.scanned.copyright b/t/model_tests.d/dpkg-examples/pan-copyright-upgrade-update/debian/fix.scanned.copyright index 29d1ede..a2a0f26 100644 --- a/t/model_tests.d/dpkg-examples/pan-copyright-upgrade-update/debian/fix.scanned.copyright +++ b/t/model_tests.d/dpkg-examples/pan-copyright-upgrade-update/debian/fix.scanned.copyright @@ -1,3 +1,4 @@ ! copyright Files:"pan/general/map-vector.h" Copyright=~"s/\n.*Addison-Wesley//" ! copyright Files:~pan/gui/e-charset.c Copyright=~"s/\s\(.*\)//" -! copyright Files:"pan/gui/license.h" Copyright=~"s/\s*,\s*Inc.*//s" \ No newline at end of file +! copyright Files:"pan/gui/license.h" Copyright=~"s/\s*,\s*Inc.*//s" +! copyright Files:"uulib/*" Copyright=~"s/\s+The.*//" diff --git a/t/model_tests.d/dpkg-test-conf.pl b/t/model_tests.d/dpkg-test-conf.pl index d852a1a..c0dfd7e 100644 --- a/t/model_tests.d/dpkg-test-conf.pl +++ b/t/model_tests.d/dpkg-test-conf.pl @@ -84,7 +84,7 @@ my $del_home = sub { => '2002, Martin Holzherr (holzh...@infobrain.com).', 'copyright Files:pan/general/sorted-vector.h License short_name' => 'public-domain', # entry "uulib/fptools.c\n uulib/fptools.h"is packed by update - qq'copyright Files:"uulib/*" Copyright' => 'Unknown', + qq'copyright Files:"uulib/*" Copyright' => '1994-2001, Frank Pilhofer.', }, wr_check => { "copyright License:GPL-2 text" => {value => undef, mode => 'custom'}, @@ -107,7 +107,7 @@ my $del_home = sub { 'copyright Files:pan/general/sorted-vector.h Copyright' => '2002, Martin Holzherr (holzh...@infobrain.com).', 'copyright Files:pan/general/sorted-vector.h License short_name' => 'public-domain', - qq'copyright Files:"uulib/*" Copyright' => 'Unknown', + qq'copyright Files:"uulib/*" Copyright' => '1994-2001, Frank Pilhofer.', }, wr_check => { "copyright License:GPL-2 text" => {value => undef, mode => 'custom'}, -- 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