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 <d...@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,@comment) - $list_obj->clear(); - - my $idx = 0; - my @list_comment; - foreach my $v_info ( $v_ref->@* ) { - if (ref $v_info) { - my ($v,$l,$note,@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,@v,@comment,@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,@comment) + $list_obj->clear(); + + my $idx = 0; + my @list_comment; + foreach my $v_info ( $v_ref->@* ) { + if (ref $v_info) { + my ($v,$l,$note,@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,@v,@comment,@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 _______________________________________________ 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