[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