[libconfig-model-dpkg-perl] 25/33: Copyright update: perform update on complete file list ...
dod at debian.org
dod at debian.org
Mon Mar 30 17:41:44 UTC 2015
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 <dod at 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 (holzherr at 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 (holzherr at 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
More information about the Pkg-perl-cvs-commits
mailing list