[libconfig-model-dpkg-perl] 02/04: Better handle errors in fix.scanned.copyright file

[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 599982dc5f482fb18de240a7c225b77cdc1bb8a7
Author: Dominique Dumont <dod at debian.org>
Date:   Fri Feb 12 18:50:18 2016 +0100

    Better handle errors in fix.scanned.copyright file
---
 lib/Config/Model/Dpkg/Copyright.pm | 32 ++++++++++++++++++++++----------
 1 file changed, 22 insertions(+), 10 deletions(-)

diff --git a/lib/Config/Model/Dpkg/Copyright.pm b/lib/Config/Model/Dpkg/Copyright.pm
index c1b04aa..9ca8765 100644
--- a/lib/Config/Model/Dpkg/Copyright.pm
+++ b/lib/Config/Model/Dpkg/Copyright.pm
@@ -268,16 +268,7 @@ sub update ($self, %args) {
         $files_obj->fetch_with_id($deb_path)->load_data( $debian_paths{$deb_path} );
     }
 
-    # read a debian/fix.scanned.copyright file to patch scanned data
-    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$/);
-        $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) );
-        }
-    }
+    $self->_apply_fix_scan_copyright_file($current_dir) ;
 
     # normalized again after all the modifications
     $self->load("Files:.sort");
@@ -292,6 +283,27 @@ sub update ($self, %args) {
     return @msgs;
 }
 
+sub _apply_fix_scan_copyright_file ($self, $current_dir) {
+    # read a debian/fix.scanned.copyright file to patch scanned data
+    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$/);
+        $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;
+            eval { $self->load( join('', at l) ); };
+            my $e = $@;
+            if ($e) {
+                my $msg = $e->full_message;
+                Config::Model::Exception::User->throw(
+                    object => $self,
+                    message => "Error while applying fix.scanned.copyright file:\n\t".$msg
+                );
+            }
+        }
+    }
+}
+
 sub _prune_old_dirs ($self, $h, $old_dirs, $path = [] ) {
 
     # recurse in the data structure

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libconfig-model-dpkg-perl.git