[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