[libconfig-model-dpkg-perl] 04/33: Copyright backend: improve error message when header is missing
dod at debian.org
dod at debian.org
Mon Mar 30 17:41:35 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 904f7e8b93ec7688c7db7407dcb7d9bda281e6f7
Author: Dominique Dumont <dod at debian.org>
Date: Tue Mar 24 20:50:07 2015 +0100
Copyright backend: improve error message when header is missing
---
lib/Config/Model/Backend/Dpkg/Copyright.pm | 14 +++++++++-----
1 file changed, 9 insertions(+), 5 deletions(-)
diff --git a/lib/Config/Model/Backend/Dpkg/Copyright.pm b/lib/Config/Model/Backend/Dpkg/Copyright.pm
index c50b57a..323b5b7 100644
--- a/lib/Config/Model/Backend/Dpkg/Copyright.pm
+++ b/lib/Config/Model/Backend/Dpkg/Copyright.pm
@@ -70,7 +70,7 @@ sub read {
my %section = map { (lc($_),$h{$_}) ; } keys %h ;
$logger->debug("section nb $section_nb has fields: ".join(' ',keys %section)) ;
- # Some people use 'File' to declare copyright info for a sinble file.
+ # Some people use 'File' to declare copyright info for a single file.
# While this is correct grammatically, it tends to be PITA
if (my $file_section = delete $section{file}) {
$logger->warn("Found File section. This one is converted in Files section (mind the plural)");
@@ -190,8 +190,11 @@ sub read {
my $lic_node = $root->fetch_element('Global-License') ;
_store_license_info ($lic_node, $key, $v, $a, $check);
}
+ elsif ( $key eq 'Files' ) {
+ die "Error: unexpected 'Files' field in header section of copyright (line $l). Did you forget the header section?";
+ }
elsif (my $found = $object->find_element($key, case => 'any')) {
- _store_file_info($object,$found,$key, $v, $check)
+ _store_file_info('Header',$l,$object,$found,$key, $v, $check)
}
else {
# try anyway to trigger an error message
@@ -219,7 +222,7 @@ sub read {
_store_license_info ($lic_node, $key, $v, $a, $check);
}
elsif (my $found = $object->find_element($key, case => 'any')) {
- _store_file_info($object,$found,$key, $v, $check);
+ _store_file_info('File',$l,$object,$found,$key, $v, $check);
}
else {
# try anyway to trigger an error message
@@ -263,12 +266,13 @@ sub _store_line {
}
sub _store_file_info {
- my ($object,$target_name,$key, $v, $check) = @_;
+ my ($section, $l,$object, $target_name,$key, $v, $check) = @_;
my $target = $object->fetch_element($target_name) ;
my $type = $target->get_type ;
my $dispatcher = $type eq 'leaf' ? $target->value_type : $type ;
- my $f = $store_dispatch{$dispatcher} || die "unknown dispatcher for element type '$key'";
+ my $f = $store_dispatch{$dispatcher}
+ || die "Error in $section section (line $l): unexpected '$key' field\n";
$f->($target,$v,$check) ;
$target->notify_change(note => $a, really => 1 ) if $a ;
}
--
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