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 f16c0ae46f89770b30876ad54e50b71ddafb6793 Author: Dominique Dumont <d...@debian.org> Date: Sat Oct 17 18:03:20 2015 +0200 CMD::Copyright: added quiet param to update() ...in order to reduce the number of message during tests --- lib/Config/Model/Dpkg/Copyright.pm | 39 +++++++++++++++++++++++++++++--------- 1 file changed, 30 insertions(+), 9 deletions(-) diff --git a/lib/Config/Model/Dpkg/Copyright.pm b/lib/Config/Model/Dpkg/Copyright.pm index afa0ecc..b655c47 100644 --- a/lib/Config/Model/Dpkg/Copyright.pm +++ b/lib/Config/Model/Dpkg/Copyright.pm @@ -35,10 +35,15 @@ sub normalize_path ($self,$path) { my $dumper = Config::Model::DumpAsData->new; +sub _say ($self,$msg) { + say $msg unless $self->{quiet}; +} + # $args{in} can contains the output of licensecheck (for tests) sub update ($self, %args) { my $files_obj = $self->grab("Files"); + $self->{quiet} = $args{quiet} // 0; # explode existing path data to track deleted paths my %old_split_files; @@ -69,7 +74,7 @@ sub update ($self, %args) { my $new_data = dclone (delete $old_split_files{$path} || {} ); my $old_cop = $new_data->{Copyright}; my $old_lic = $new_data->{License}{short_name}; - # say "load '$path' with '$c' ('$l') old '$old_cop' ('$old_lic')"; + # $self->_say( "load '$path' with '$c' ('$l') old '$old_cop' ('$old_lic')"); # clobber old data $new_data->{Copyright} = $c if ($c !~ /no-info-found|UNKNOWN/ or not $old_cop); $new_data->{License}{short_name} = $l if ($l ne 'UNKNOWN' or not $old_lic); @@ -104,7 +109,7 @@ sub update ($self, %args) { $preserved_path{$old_path} = delete $old_split_files{$old_path}; } else { - say "Note: '$old_path' was removed from new upstream source"; + $self->_say( "Note: '$old_path' was removed from new upstream source" ); } } @@ -140,7 +145,7 @@ sub update ($self, %args) { my $p = $paths[0]; $p =~ s/\.$/*/; my $old_data = delete $preserved_path{$p}; - say "old dir data for $p overridden" if $old_data; + $self->_say( "old dir data for $p overridden") if $old_data; # skip writing data because it duplicates information # found in directory above above (as shown the path ending @@ -169,12 +174,12 @@ sub update ($self, %args) { 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"; + $self->_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"; + $self->_say( "Adding dummy license text for license $l for path @paths"); $datum->{License}{full_license} = $filler; } } @@ -193,7 +198,7 @@ sub update ($self, %args) { # put back preserved data foreach my $old_path (sort keys %preserved_path) { - say "Note: preserving entry '$old_path'" ; + $self->_say( "Note: preserving entry '$old_path'"); $files_obj->fetch_with_id($old_path)->load_data( $preserved_path{$old_path} ); } @@ -206,7 +211,7 @@ sub update ($self, %args) { my $debian = $current_dir->child('debian'); # may be missing in test environment if ($debian->is_dir) { my @fixes = $current_dir->child('debian')->children(qr/fix\.scanned\.copyright$/); - say "Note: loading @fixes fixes from copyright fix files" if @fixes; + $self->_say( "Note: loading @fixes fixes from copyright fix files") if @fixes; foreach my $fix ( @fixes) { my @l = grep { /[^\s]/ } grep { ! m!^(#|//)! } $fix->lines_utf8; $self->load( join('',@l) ); @@ -232,7 +237,7 @@ sub _prune_old_dirs ($self, $h, $old_dirs, $path = [] ) { # delete current directory entry my $dir_path = join('/', $path->@*,'.'); if ($old_dirs->{$dir_path}) { - say "Removing old entry $dir_path"; + $self->_say( "Removing old entry $dir_path" ); delete $old_dirs->{$dir_path}; } } @@ -240,7 +245,7 @@ sub _prune_old_dirs ($self, $h, $old_dirs, $path = [] ) { sub fill_global_license ($self, $l, $text) { - #say "Adding global license $l"; + #$self->_say( "Adding global license $l"); # handle the case where license is something like GPL-2 or GPL-3 my @names = $l =~ / or / ? split / or /, $l : ($l); @@ -408,6 +413,22 @@ Files entries are sorted and the new C<debian/copyright> is generated. =back +=head1 update ( %args ) + +Updates data using the output +L<Dpkg::Copyright::Scanner/"scan_files ( %args )">. + +Parameters in C<%args>: + +=over + +=item quiet + +set to 1 to suppress progress messages. Should be used only in tests. + +=back + +Otherwise, C<%args> is passed to C<scan_files> =head1 AUTHOR -- 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