[libconfig-model-dpkg-perl] 08/11: updated patch parser...

dod at debian.org dod at debian.org
Fri Jan 13 13:01:40 UTC 2017


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 efe5b241fdc2749130d7ef32df4461a8474f468d
Author: Dominique Dumont <dod at debian.org>
Date:   Thu Jan 12 13:13:30 2017 +0100

    updated patch parser...
    
    for new data structure provided by DpkgSyntax
---
 lib/Config/Model/Backend/Dpkg/Patch.pm | 41 +++++++++++++++++++++++-----------
 1 file changed, 28 insertions(+), 13 deletions(-)

diff --git a/lib/Config/Model/Backend/Dpkg/Patch.pm b/lib/Config/Model/Backend/Dpkg/Patch.pm
index 8df9038..aec9ded 100644
--- a/lib/Config/Model/Backend/Dpkg/Patch.pm
+++ b/lib/Config/Model/Backend/Dpkg/Patch.pm
@@ -1,12 +1,18 @@
-
 package Config::Model::Backend::Dpkg::Patch;
 
-use 5.10.1 ;
+use strict;
+use warnings;
 use Mouse;
 
 extends 'Config::Model::Backend::Any';
 
 with 'Config::Model::Backend::DpkgSyntax';
+with 'Config::Model::Backend::DpkgStoreRole';
+
+use 5.20.1;
+
+use feature qw/postderef signatures/;
+no warnings qw/experimental::postderef experimental::signatures/;
 
 use Carp;
 use Config::Model::Exception;
@@ -100,38 +106,47 @@ sub read {
     }
 
     my $description_holder;
-    my $description_text ;
+    my @description_text ;
     while (@$c) {
         my ( $section_line, $section ) = splice @$c, 0, 2;
         foreach ( my $i = 0 ; $i < $#$section ; $i += 2 ) {
             my $key = $section->[$i];
-            my ( $v, $l, $a, @comments ) = @{ $section->[ $i + 1 ] };
+            my $v_ref = $section->[ $i + 1 ];
             if ( my $found = $node->find_element( $key, case => 'any' ) ) {
                 my $elt = $found ;
-                my $to_store = $v;
+                my $to_store = $v_ref;
                 if ($found =~ /^Subject|Description$/) {
                     $description_holder = $found;
                     $elt = 'Synopsis';
-                    ($to_store, $description_text)= split /\n+/, $v, 2 ;
+                    $to_store = [ shift $v_ref->@* ];
+                    push @description_text, $v_ref->@*;
                 }
 
-                $logger->debug("storing $elt  value: $to_store");
-                $node->fetch_element($elt)->store( value => $to_store, check => $check );
+                my $elt_obj = $node->fetch_element($elt);
+                if ($node->element_type($elt) eq 'list') {
+                    $self->store_section_list_element ( $logger, $elt_obj, $check, $to_store);
+                }
+                else {
+                    $self->store_section_leaf_element ( $logger, $elt_obj, $check, $to_store);
+                }
             }
             else {
-                $stuff{$section_line} = "$key: $v";
+                $stuff{$section_line} = "$key: ".join("\n", map {$_->[0]} $v_ref->@*)."\n";
             }
         }
     }
 
     my $k = 0;
+    push @description_text,''; # force a newline between description and salvaged lines
+
+    # add salvaged lines in the order they were found
+    push @description_text, map { [$stuff{$_}, $_, ''] } sort { $a <=> $b ;} keys %stuff ;
 
-    my @desc_lines = map { my $pre = ( $k + 1 == $_ ? '' : "\n"); $k = $_; $pre.$stuff{$_} }
-        sort { $a <=> $b ;} keys %stuff ;
-    my $desc = ($description_text || '') .join( "\n", @desc_lines );
     $description_holder //= 'Description';
-    $node->fetch_element($description_holder)->store( value => $desc, check => $check );
+    my $elt_obj = $node->fetch_element($description_holder);
+    $self->store_section_leaf_element ( $logger, $elt_obj, $check, \@description_text);
 
+    # at last, save the "meat" of the patch
     $node->fetch_element('diff')->store(join('',@$diff));
 
     return 1;

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