[libconfig-model-dpkg-perl] 01/05: extract node_to_section from Dpkg control backend

[dod at debian.org]

This is an automated email from the git hooks/post-receive script.

dod pushed a commit to annotated tag debian/2.104
in repository libconfig-model-dpkg-perl.

commit 242bbf460a785abede4ed974d54989505f716fc1
Author: Dominique Dumont <dod at debian.org>
Date:   Wed Nov 22 20:06:31 2017 +0100

    extract node_to_section from Dpkg control backend
    
    this function is moved to DpkgSyntax module
---
 lib/Config/Model/Backend/Dpkg/Control.pm | 45 +---------------------------
 lib/Config/Model/Backend/DpkgSyntax.pm   | 50 ++++++++++++++++++++++++++++++++
 2 files changed, 51 insertions(+), 44 deletions(-)

diff --git a/lib/Config/Model/Backend/Dpkg/Control.pm b/lib/Config/Model/Backend/Dpkg/Control.pm
index 4953739..efd3d23 100644
--- a/lib/Config/Model/Backend/Dpkg/Control.pm
+++ b/lib/Config/Model/Backend/Dpkg/Control.pm
@@ -239,50 +239,7 @@ sub package_spec ( $self, $node ) {
     # the accept condition)
     my @list = $node->get_element_name;
     _re_order(\@list, \@move_after);
-
-    my @section ;
-    my $description_ref ;
-    foreach my $elt ( @list ) {
-        my $type = $node->element_type($elt) ;
-        my $elt_obj = $node->fetch_element($elt) ;
-
-        my $c = $elt_obj->annotation ;
-        push @section, map {'# '.$_} split /\n/,$c if $c ;
-
-        if ($type eq 'hash') {
-            die "package_spec: unexpected hash type in ".$node->name." element $elt\n" ;
-        }
-        elsif ($type eq 'list') {
-            my @v;
-            my @indexes = $elt_obj->fetch_all_indexes;
-
-            foreach my $idx (@indexes) {
-                my $value_obj = $elt_obj->fetch_with_id($idx);
-                my $value = $value_obj->fetch;
-                next unless defined $value;
-
-                my $note = $value_obj->annotation;
-                my $comment = $note ? join ("\n",map {'# '.$_} split /\n/,$note ) : undef;
-                push @v, $comment ? [ $value, $comment ] : $value;
-            }
-            push @section, $elt , \@v if @v;
-        }
-        elsif ($elt eq 'Synopsis') {
-            my $v = $node->fetch_element_value($elt) ;
-            push @section, 'Description' , $v ; # mandatory field
-            $description_ref = \$section[$#section] ;
-        }
-        elsif ($elt eq 'Description') {
-            # annotation attached to Description is written as a
-            # comment *after* the Description block
-            $$description_ref .= "\n".$node->fetch_element_value($elt) ; # mandatory field
-        }
-        else {
-            my $v = $node->fetch_element_value($elt) ;
-            push @section, $elt , $v if $v ;
-        }
-    }
-    return @section ;
+    return $self->node_to_section($node, \@list)
 }
 
 
diff --git a/lib/Config/Model/Backend/DpkgSyntax.pm b/lib/Config/Model/Backend/DpkgSyntax.pm
index 8dfe6bb..d8d4423 100644
--- a/lib/Config/Model/Backend/DpkgSyntax.pm
+++ b/lib/Config/Model/Backend/DpkgSyntax.pm
@@ -261,6 +261,56 @@ sub format_label_line {
     return $label_line;
 }
 
+sub node_to_section ($self, $node, $elt_list = [ $node->get_element_names ]) {
+
+    my @section ;
+    my $description_ref ;
+    foreach my $elt ( $elt_list->@* ) {
+        my $type = $node->element_type($elt) ;
+        my $elt_obj = $node->fetch_element($elt) ;
+
+        my $c = $elt_obj->annotation ;
+        push @section, map {'# '.$_} split /\n/,$c if $c ;
+
+        if ($type eq 'hash') {
+            die "package_spec: unexpected hash type in ".$node->name." element $elt\n" ;
+        }
+        elsif ($type eq 'list') {
+            my @v;
+            my @indexes = $elt_obj->fetch_all_indexes;
+
+            foreach my $idx (@indexes) {
+                my $value_obj = $elt_obj->fetch_with_id($idx);
+                my $value = $value_obj->fetch;
+                next unless defined $value;
+
+                my $note = $value_obj->annotation;
+                my $comment = $note ? join ("\n",map {'# '.$_} split /\n/,$note ) : undef;
+                push @v, $comment ? [ $value, $comment ] : $value;
+            }
+            push @section, $elt , \@v if @v;
+        }
+        elsif ($type eq 'check_list') {
+            my $v = $node->fetch_element($elt)->fetch ;
+            push @section, $elt , $v if $v ;
+        }
+        elsif ($elt eq 'Synopsis') {
+            my $v = $node->fetch_element_value($elt) ;
+            push @section, 'Description' , $v ; # mandatory field
+            $description_ref = \$section[$#section] ;
+        }
+        elsif ($elt eq 'Description') {
+            # annotation attached to Description is written as a
+            # comment *after* the Description block
+            $$description_ref .= "\n".$node->fetch_element_value($elt) ; # mandatory field
+        }
+        else {
+            my $v = $node->fetch_element_value($elt) ;
+            push @section, $elt , $v if $v ;
+        }
+    }
+    return @section ;
+}
 1;
 
 __END__

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libconfig-model-dpkg-perl.git