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 9e70c0abe6294b35f13186d3083e17dcef723c12
Author: Dominique Dumont <d...@debian.org>
Date:   Tue Nov 22 20:58:50 2016 +0100

    show file name in syntax error message
---
 lib/Config/Model/Backend/Dpkg/Control.pm   |  2 +-
 lib/Config/Model/Backend/Dpkg/Copyright.pm |  4 +--
 lib/Config/Model/Backend/Dpkg/Patch.pm     |  2 +-
 lib/Config/Model/Backend/DpkgSyntax.pm     | 51 ++++++++++++++++++------------
 4 files changed, 34 insertions(+), 25 deletions(-)

diff --git a/lib/Config/Model/Backend/Dpkg/Control.pm 
b/lib/Config/Model/Backend/Dpkg/Control.pm
index a079d6f..178e382 100644
--- a/lib/Config/Model/Backend/Dpkg/Control.pm
+++ b/lib/Config/Model/Backend/Dpkg/Control.pm
@@ -35,7 +35,7 @@ sub read {
 
     $logger->info("Parsing $args{file_path}");
     # load dpkgctrl file
-    my $c = $self -> parse_dpkg_file ($args{io_handle}, $args{check}, 1 ) ;
+    my $c = $self -> parse_dpkg_file ($args{file_path}, $args{io_handle}, 
$args{check}, 1 ) ;
 
     # fix Debian #735000: ask for infos for all packages not in cache in one 
go.
     $self->fill_package_cache ($c);
diff --git a/lib/Config/Model/Backend/Dpkg/Copyright.pm 
b/lib/Config/Model/Backend/Dpkg/Copyright.pm
index d391db1..9017678 100644
--- a/lib/Config/Model/Backend/Dpkg/Copyright.pm
+++ b/lib/Config/Model/Backend/Dpkg/Copyright.pm
@@ -42,10 +42,10 @@ sub read {
 
     my $check = $args{check} || 'yes';
 
-    $logger->info("Parsing $args{file}");
+    $logger->info("Parsing $args{file_path}");
 
     # load dpkgctrl file
-    my $c = $self -> parse_dpkg_file ($args{io_handle}, $check) ;
+    my $c = $self -> parse_dpkg_file ($args{file_path}, $args{io_handle}, 
$check, ) ;
     return 0 unless @$c ; # no sections in file
     
     my $root = $args{object} ;
diff --git a/lib/Config/Model/Backend/Dpkg/Patch.pm 
b/lib/Config/Model/Backend/Dpkg/Patch.pm
index 69078cd..28d6f4c 100644
--- a/lib/Config/Model/Backend/Dpkg/Patch.pm
+++ b/lib/Config/Model/Backend/Dpkg/Patch.pm
@@ -79,7 +79,7 @@ sub read {
     } ;
 
     if (@$header) {
-        $c = eval { $self->parse_dpkg_lines( $header, $check, 0, $store_stuff 
); };
+        $c = eval { $self->parse_dpkg_lines( $file_path, $header, $check, 0, 
$store_stuff ); };
         my $e = $@;
         if ( ref($e) and $e->isa('Config::Model::Exception::Syntax') ) {
             $e->parsed_file( $patch_file );
diff --git a/lib/Config/Model/Backend/DpkgSyntax.pm 
b/lib/Config/Model/Backend/DpkgSyntax.pm
index dbce871..fed8830 100644
--- a/lib/Config/Model/Backend/DpkgSyntax.pm
+++ b/lib/Config/Model/Backend/DpkgSyntax.pm
@@ -12,6 +12,7 @@ my $logger = get_logger("Backend::DpkgSyntax") ;
 
 sub parse_dpkg_file {
     my $self = shift ;
+    my $file_path = shift;
     my $fh = shift;
     my $check = shift || 'yes' ;
     my $comment_allowed = shift || 0 ;
@@ -20,14 +21,14 @@ sub parse_dpkg_file {
     chomp @lines ;
     $fh->close ;
     
-    $self->parse_dpkg_lines (\@lines, $check, $comment_allowed);
+    $self->parse_dpkg_lines ($file_path, \@lines, $check, $comment_allowed);
 }
 
 #
 # New subroutine "parse_dpkg_lines" extracted - Tue Jul 19 17:47:58 2011.
 #
 sub parse_dpkg_lines {
-    my ($self, $lines, $check, $comment_allowed, $handle_garbage) = @_ ;
+    my ($self, $file_path, $lines, $check, $comment_allowed, $handle_garbage) 
= @_ ;
 
     my $field;
     my $store_ref ;       # hold field data
@@ -58,7 +59,7 @@ sub parse_dpkg_lines {
             my ($field,$text) = split /\s*:\s*/,$l,2 ;
             $text =~ s/\s+$//;
             $key = $field ;
-            $logger->trace("line $line_nb start new field $key with '$text'");
+            $logger->trace("$file_path line $line_nb start new field $key with 
'$text'");
 
             # @$store_list will be used in a hash, where the $field is key
             # store value found, file line number, is value altered (used 
later, o for now)
@@ -68,7 +69,7 @@ sub parse_dpkg_lines {
             $store_ref = \$store_list->[$#$store_list][0] ;
         }
         elsif ( $key and $l =~ /^\s*$/ ) {     # first empty line after a 
section
-            $logger->trace("empty line $line_nb: starting new section");
+            $logger->trace("$file_path empty line $line_nb: starting new 
section");
             $key = '';
             push @res, $section_line, $store_list if @$store_list ; # don't 
store empty sections 
             $store_list = [] ;
@@ -83,19 +84,22 @@ sub parse_dpkg_lines {
         } 
         elsif ( $l =~ /^\s+\.$/) {   # line with a single dot
             $logger->trace("dot line: adding blank line to field $key");
-            _store_line($store_ref,"",$check,$line_nb) ;
+            _store_line($store_ref,$file_path,"",$check,$line_nb) ;
         }
         elsif ( $l =~ s/^\s//) {     # non empty line
             $logger->trace("text line: adding '$l' to field $key");
-            _store_line($store_ref,$l , $check,$line_nb);
+            _store_line($store_ref,$file_path,$l , $check,$line_nb);
         }
         elsif ($handle_garbage) {
             $handle_garbage->($l, $line_nb) ;
         }
         else {
             my $msg = "DpkgSyntax error: Invalid line (missing ':' ?) : $l" ;
-            Config::Model::Exception::Syntax -> throw ( message => $msg, 
parsed_line => $line_nb ) 
-                if $check eq 'yes' ; 
+            Config::Model::Exception::Syntax -> throw (
+                message => $msg,
+                parsed_file => $file_path,
+                parsed_line => $line_nb
+            ) if $check eq 'yes' ;
             $logger->error($msg) if $check eq 'skip';
         }
         $line_nb++;
@@ -112,30 +116,32 @@ sub parse_dpkg_lines {
             my $l = $res[$i*2];
             my $s = $res[$i*2 + 1];
             my %section_data = @$s;
-            
+
             $logger->debug("Parse result section $i, found:") ;
             foreach my $key (keys %section_data) {
                 $logger->debug( "$key: ". substr 
($section_data{$key}[0],0,35)) ;
             }
-            
         }
     }
 
-    $logger->warn("No section found") unless @res ;
-    
+    $logger->warn("No section found in file $file_path") unless @res ;
+
     return wantarray ? @res : \@res ;   
 }
 
 sub _store_line {
-    my ($store_ref,$line,$check,$line_nb) = @_ ;
+    my ($store_ref,$file_path,$line,$check,$line_nb) = @_ ;
     
     if (defined $store_ref) {
         $$store_ref .= "\n$line" ;
     }
     else {
         my $msg = "Did not find a keyword before: '$line''";
-        Config::Model::Exception::Syntax -> throw ( message => $msg, 
parsed_line => $line_nb ) 
-            if $check eq 'yes' ; 
+        Config::Model::Exception::Syntax -> throw (
+            message => $msg,
+            parsed_file => $file_path,
+            parsed_line => $line_nb
+        ) if $check eq 'yes' ; 
         $logger->error($msg) if $check eq 'skip';
     }
     
@@ -298,10 +304,12 @@ if you want this module shipped in its own distribution.
 
 =head1
 
-=head2 parse_dpkg_file ( file_handle, check, comment_allowed )
+=head2 parse_dpkg_file
 
-Read a control file from the file_handle and returns a nested list (or a list 
-ref) containing data from the file.
+Parameters: C<( file_path, file_handle, [ check, [ comment_allowed ]] )>
+
+Read a control file from C<file_handle> and returns a nested list (or
+a list ref) containing data from the file.
 
 The returned list is of the form :
 
@@ -315,7 +323,8 @@ The returned list is of the form :
    # etc ...
  ]
 
-check is C<yes>, C<skip> or C<no>.  C<comment_allowed> is boolean (default 0)
+C<check> is C<yes>, C<skip> or C<no> (default C<yes>).
+ C<comment_allowed> is boolean (default 0)
 
 When comments are provided in the dpkg files, the returned list is of
 the form :
@@ -328,9 +337,9 @@ the form :
    [ ... ]
  ]
 
+=head2 parse_dpkg_lines
 
-
-=head2 parse_dpkg_lines (lines, check, comment_allowed )
+Parameters: C< ( file_path, lines, check, comment_allowed ) >
 
 Parse the dpkg date from lines (which is an array ref) and return a data 
 structure like L<parse_dpkg_file>.

-- 
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

Reply via email to