[libconfig-model-dpkg-perl] 03/07: DpkgSyntax: deprecate write_dpkg_section in favor of format_dpkg_section

dod at debian.org dod at debian.org
Sat Sep 7 14:56:28 UTC 2013


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 b2b62b932617142bdfecb9d2a997e9defceb3442
Author: Dominique Dumont <dod at debian.org>
Date:   Thu Sep 5 19:36:13 2013 +0200

    DpkgSyntax: deprecate write_dpkg_section in favor of format_dpkg_section
---
 lib/Config/Model/Backend/DpkgSyntax.pm |   50 ++++++++++++++++++++++----------
 1 file changed, 35 insertions(+), 15 deletions(-)

diff --git a/lib/Config/Model/Backend/DpkgSyntax.pm b/lib/Config/Model/Backend/DpkgSyntax.pm
index d7caec6..4eeb651 100644
--- a/lib/Config/Model/Backend/DpkgSyntax.pm
+++ b/lib/Config/Model/Backend/DpkgSyntax.pm
@@ -147,48 +147,68 @@ sub write_dpkg_file {
     map { $self->write_dpkg_section($ioh,$_,$list_sep) } @$array_ref ;
 }
 
+# input is [ may_be_comment, keyword => value | value_list_ref, ... ]
 sub write_dpkg_section {
     my ($self, $ioh, $array_ref,$list_sep) = @_ ;
+    carp "write_dpkg_section is deprecated";
+    $ioh->print ( join("\n", $self->format_dpkg_section($ioh,$array_ref,$list_sep)), "\n\n" );
+}
+
+sub format_dpkg_section {
+    my ($self, $ioh, $array_ref,$list_sep) = @_ ;
+
+    my @lines ;
 
     my $i = 0;
     foreach (my $i=0; $i < @$array_ref; $i += 2 ) {
         while ($array_ref->[$i] =~ /^#/) {
             # print comment
-            $ioh->print($array_ref->[$i++],"\n") ; 
+            push @lines, $array_ref->[$i++] ;
         }
         my $name  = $array_ref->[$i] ;
         my $value = $array_ref->[$i + 1];
-        my $label = "$name:" ;
+
         if (ref ($value)) {
-            $label .= ' ';
-            my $sep = $list_sep ? $list_sep  : ",\n" ;
-            $sep .= ' ' x length ($label) if $sep =~ /\n$/ ;
-            $ioh -> print ($label.join( $sep, @$value ) . "\n");
+            my $sep = $list_sep // ",\n" ;
+            $sep .= ' ' x (length ($name) + 2) if $sep =~ /\n$/ ;
+
+            my $line0 = $self->format_label_line($name, shift @$value);
+            push @lines, join ($sep, $line0, @$value ) ;
         }
         else {
-            $ioh->print ($label) ;
-            $self->write_dpkg_text($ioh,$value) ;
+            push @lines, $self->format_dpkg_text($name, $value) ;
         }
     }
-    $ioh->print("\n");
+
+    return @lines;
 }
 
 sub write_dpkg_text {
     my ($self, $ioh, $text) = @_ ;
     carp "write_dpkg_text is deprecated";
-    $ioh->print ( join("\n", $self->format_dpkg_text($ioh,$text)), "\n" );
+    $ioh->print ( join("\n", $self->format_dpkg_text('',$text)), "\n" );
 }
+
 sub format_dpkg_text {
-    my ($self, $ioh, $text) = @_ ;
+    my ($self, $name, $text) = @_ ;
 
     return unless $text ;
     my @lines = split /\n/,$text ;
-    my $i = 0 ;
+    my $label_line = $self->format_label_line($name, shift @lines);
+
     foreach (@lines) {
-        s/^/ /gm;
-        s/^\s*$/ ./gm if $i++; # don't put '.' on first line if emtpy
+        s/^/ /gm; # insert leading white space
+        s/^\s*$/ ./gm ; # insert dot for empty lines
     }
-    return @lines ;
+    return ($label_line, @lines) ;
+}
+
+sub format_label_line {
+    my ($self, $name, $v0) = @_ ;
+    return $v0 unless $name;
+    my $label_line = $name.":";
+    $label_line .= ' '.$v0 if $v0 =~ /\S/;
+    return $label_line;
 }
 
 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