[libconfig-model-dpkg-perl] 03/11: extracted 2 methods in a role
dod at debian.org
dod at debian.org
Fri Jan 13 13:01:39 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 4faa9a5e35181b19d1ccd92076aacbc993097871
Author: Dominique Dumont <dod at debian.org>
Date: Sat Jan 7 19:46:20 2017 +0100
extracted 2 methods in a role
---
lib/Config/Model/Backend/Dpkg/Control.pm | 67 ++++-------------------------
lib/Config/Model/Backend/DpkgStoreRole.pm | 70 +++++++++++++++++++++++++++++++
2 files changed, 77 insertions(+), 60 deletions(-)
diff --git a/lib/Config/Model/Backend/Dpkg/Control.pm b/lib/Config/Model/Backend/Dpkg/Control.pm
index d35da18..14fc872 100644
--- a/lib/Config/Model/Backend/Dpkg/Control.pm
+++ b/lib/Config/Model/Backend/Dpkg/Control.pm
@@ -10,6 +10,7 @@ no warnings qw/experimental::postderef experimental::signatures/;
extends 'Config::Model::Backend::Any';
with 'Config::Model::Backend::DpkgSyntax';
+with 'Config::Model::Backend::DpkgStoreRole';
use Carp;
use Config::Model::Exception ;
@@ -21,7 +22,7 @@ use Config::Model::Dpkg::Dependency;
my $logger = get_logger("Backend::Dpkg::Control") ;
sub suffix { return '' ; }
-
+use XXX;
sub read {
my $self = shift ;
my %args = @_ ;
@@ -163,77 +164,23 @@ sub store_section_element_in_tree {
my $type = $node->element_type($found);
if ( $type eq 'list' ) {
- $self->store_section_list_element ( $elt_obj, $check, $v_ref);
+ $self->store_section_list_element ( $logger, $elt_obj, $check, $v_ref);
}
elsif ($found eq 'Description' and $elt_obj) {
my ($synopsis_ref, @desc_ref) = $v_ref->@*;
- $self->store_section_leaf_element ($node->fetch_element('Synopsis'), $check, [$synopsis_ref]);
- $self->store_section_leaf_element ($node->fetch_element('Description'), $check, \@desc_ref);
+ $self->store_section_leaf_element ( $logger, $node->fetch_element('Synopsis'), $check, [$synopsis_ref]);
+ $self->store_section_leaf_element ( $logger, $node->fetch_element('Description'), $check, \@desc_ref);
}
elsif ($elt_obj ) {
- $self->store_section_leaf_element ( $elt_obj, $check, $v_ref);
+ $self->store_section_leaf_element ( $logger, $elt_obj, $check, $v_ref);
}
else {
# try anyway to trigger an error message
my $unexpected_obj = $node->fetch_element($key);
- $self->store_section_leaf_element ( $unexpected_obj, $check, $v_ref);
- }
-}
-
-sub store_section_list_element ($self, $list_obj, $check, $v_ref) {
- # v_ref is a list of ($value, $line_nb ,$note, at comment)
- $list_obj->clear();
-
- my $idx = 0;
- my @list_comment;
- foreach my $v_info ( $v_ref->@* ) {
- if (ref $v_info) {
- my ($v,$l,$note, at c) = @$v_info;
- # $v can be ' foo,' or 'foo, bar, baz'. This depends on input format
- # there can only be one comment for all these values (constrained by syntax)
- $v =~ s/\s*,\s*$//;
- $v =~ s/^\s+//;
- my @items = split /\s*,\s*/, $v;
- my $comment = join("\n", @c);
- my $item_idx = 0;
-
- foreach my $item (@items) {
- $logger->debug( "list store $idx:'$item'" . ($comment ? " comment '$comment'" : ''));
- my $elt_obj = $list_obj->fetch_with_id($idx++);
- $elt_obj->store( $item, check => $check );
- $elt_obj->annotation($comment) if $comment and $item_idx++ == 0;
- $elt_obj->notify_change(note => $note, really => 1) if $note ;
- }
- }
- else {
- push @list_comment, $v_info;
- }
+ $self->store_section_leaf_element ( $logger, $unexpected_obj, $check, $v_ref);
}
- $list_obj->annotation(@list_comment) if @list_comment;
}
-sub store_section_leaf_element ($self, $elt_obj, $check, $v_ref) {
- # v_ref is a list of (@comment , [ value, $line_nb ,$note ] )
-
- my ($l, at v, at comment, at note);
- foreach my $v_item ( $v_ref ->@* ) {
- if (ref $v_item) {
- push @v, $v_item->[0];
- $l //= $v_item->[1]; # use only first indicated line number
- push @note, $v_item->[2];
- }
- else {
- push @comment, $ v_item;
- }
- }
- my $v = join("\n", @v);
- my $note = join("\n", @note);
-
- $logger->debug("storing ",$elt_obj->element_name," value: $v");
- $elt_obj->store( value => $v, check => $check );
- $elt_obj->annotation(@comment) if @comment ;
- $elt_obj->notify_change(note => $note, really => 1) if $note ;
-}
sub write {
my $self = shift ;
diff --git a/lib/Config/Model/Backend/DpkgStoreRole.pm b/lib/Config/Model/Backend/DpkgStoreRole.pm
new file mode 100644
index 0000000..f8dffee
--- /dev/null
+++ b/lib/Config/Model/Backend/DpkgStoreRole.pm
@@ -0,0 +1,70 @@
+package Config::Model::Backend::DpkgStoreRole ;
+
+use strict;
+use warnings;
+use Mouse::Role;
+
+use Carp;
+use Config::Model::Exception ;
+use Log::Log4perl qw(get_logger :levels);
+use 5.20.0;
+
+use feature qw/postderef signatures/;
+no warnings qw/experimental::postderef experimental::signatures/;
+
+sub store_section_list_element ($self, $logger, $list_obj, $check, $v_ref) {
+ # v_ref is a list of ($value, $line_nb ,$note, at comment)
+ $list_obj->clear();
+
+ my $idx = 0;
+ my @list_comment;
+ foreach my $v_info ( $v_ref->@* ) {
+ if (ref $v_info) {
+ my ($v,$l,$note, at c) = @$v_info;
+ # $v can be ' foo,' or 'foo, bar, baz'. This depends on input format
+ # there can only be one comment for all these values (constrained by syntax)
+ $v =~ s/\s*,\s*$//;
+ $v =~ s/^\s+//;
+ my @items = split /\s*,\s*/, $v;
+ my $comment = join("\n", @c);
+ my $item_idx = 0;
+
+ foreach my $item (@items) {
+ $logger->debug( "list store $idx:'$item'" . ($comment ? " comment '$comment'" : ''));
+ my $elt_obj = $list_obj->fetch_with_id($idx++);
+ $elt_obj->store( $item, check => $check );
+ $elt_obj->annotation($comment) if $comment and $item_idx++ == 0;
+ $elt_obj->notify_change(note => $note, really => 1) if $note ;
+ }
+ }
+ else {
+ push @list_comment, $v_info;
+ }
+ }
+ $list_obj->annotation(@list_comment) if @list_comment;
+}
+
+sub store_section_leaf_element ($self, $logger, $elt_obj, $check, $v_ref) {
+ # v_ref is a list of (@comment , [ value, $line_nb ,$note ] )
+
+ my ($l, at v, at comment, at note);
+ foreach my $v_item ( $v_ref ->@* ) {
+ if (ref $v_item) {
+ push @v, $v_item->[0];
+ $l //= $v_item->[1]; # use only first indicated line number
+ push @note, $v_item->[2];
+ }
+ else {
+ push @comment, $ v_item;
+ }
+ }
+ my $v = join("\n", @v);
+ my $note = join("\n", @note);
+
+ $logger->debug("storing ",$elt_obj->element_name," value: $v");
+ $elt_obj->store( value => $v, check => $check );
+ $elt_obj->annotation(@comment) if @comment ;
+ $elt_obj->notify_change(note => $note, really => 1) if $note ;
+}
+
+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