[libconfig-model-dpkg-perl] 30/36: CMD::Copyright: added quiet param to update()

[dod at debian.org]

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 <dod at 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('', at 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