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 930ee33c0753dff5c863c68358bc5db278c79a9f Author: Dominique Dumont <d...@debian.org> Date: Sat Apr 4 11:22:49 2015 +0200 Copyright update: improved generation of single vs global licenses --- lib/Config/Model/Dpkg/Copyright.pm | 49 ++++++++++++++++++++++++++++---------- 1 file changed, 37 insertions(+), 12 deletions(-) diff --git a/lib/Config/Model/Dpkg/Copyright.pm b/lib/Config/Model/Dpkg/Copyright.pm index 06f25e4..e40c755 100644 --- a/lib/Config/Model/Dpkg/Copyright.pm +++ b/lib/Config/Model/Dpkg/Copyright.pm @@ -89,7 +89,8 @@ sub update ($self, %args) { # at this point: # * @data contains a list of copyright/license data - # * %new_split_files contains a tree matching a directory tree where each leaf is an integer index referencing + # * %new_split_files contains a tree matching a directory tree where each leaf + # is an integer index referencing # an entry in @data to get the correct copyright/license data # * %old_split_files contains paths no longer present. Useful to trace deleted files # implode files entries with same data index @@ -103,30 +104,47 @@ sub update ($self, %args) { # deleted or altered (when individual files are removed, renamed) is too complex. $files_obj->clear; + # count license useage to dedice whether to add a global license + # or a single entry. Skip unknown or public-domain licenses + my %lic_usage_count; + map { $lic_usage_count{$_}++ if $_ and not /unknown|public/i} + map {split /\s+or\s+/, $data[$_->[0]]->{License}{short_name} // ''; } + @packed ; + # load new data in config tree foreach my $p (@packed) { my ($id, @paths) = $p->@*; - my $datum = $data[$id]; + my $datum = dclone($data[$id]); my $path_str = $self->normalize_path(\@paths); my $l = $datum->{License}{short_name}; next unless $l ; - # FIXME: add boilerplate to trigger warning in model - my $text = "Please fill license $l from header of " . $paths[0]; - my $norm_path_str = $self->normalize_path(\@paths); # if full_license is not provided in datum, check global license(s) if (not $datum->{License}{full_license}) { my $ok = 0; - my $size = map { - $ok++ if $self->grab_value(qq!License:"$_" text!) ; - } split /\s+or\s+/,$l; - - if ($ok ne $size) { - say "Adding dummy license text for license $l for path @paths"; - $datum->{License}{full_license} = $text; + my @sub_licenses = split /\s+or\s+/,$l; + my $lic_count = 0; + my @empty_licenses = grep { + my $text = $self->grab_value(qq!License:"$_" text!) ; + $ok++ if $text; + $lic_count += $lic_usage_count{$_} // 0 ; + not $text; # to get list of empty licenses + } @sub_licenses; + + if ($ok ne @sub_licenses) { + my $filler = "Please fill license $l from header of @paths"; + if ($lic_count > 1 ) { + say "Adding dummy global license text for license $l for path @paths"; + map { $self->load(qq!License:"$_" text="$filler"!) } @empty_licenses ; + + } + else { + say "Adding dummy license text for license $l for path @paths"; + $datum->{License}{full_license} = $filler; + } } } @@ -134,6 +152,13 @@ sub update ($self, %args) { $files_obj->fetch_with_id($path_str)->load_data( $datum ); } + # delete global license without text + my $global_lic_obj = $self->fetch_element('License'); + foreach my $l ($global_lic_obj->fetch_all_indexes) { + $global_lic_obj->delete($l) + unless $global_lic_obj->fetch_with_id($l)->fetch_element_value('text'); + } + # put back debian data foreach my $deb_path (sort keys %debian_paths) { $files_obj->fetch_with_id($deb_path)->load_data( $debian_paths{$deb_path} ); -- 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