[libconfig-model-dpkg-perl] 07/09: Dpkg::Patch: fix handling of Subject body (free form text below header)
dod at debian.org
dod at debian.org
Fri May 8 08:51:41 UTC 2015
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 7d2bf9dbf9d9a2d8d9d4b21754950554bec9228b
Author: Dominique Dumont <dod at debian.org>
Date: Thu May 7 20:29:07 2015 +0200
Dpkg::Patch: fix handling of Subject body (free form text below header)
---
lib/Config/Model/Backend/Dpkg/Patch.pm | 72 +++++++++++++++++++++++-------
t/model_tests.d/dpkg-patch-examples/moarvm | 29 ++++++++++++
t/model_tests.d/dpkg-patch-test-conf.pl | 16 +++++--
t/model_tests.d/dpkg-patches-test-conf.pl | 3 ++
4 files changed, 101 insertions(+), 19 deletions(-)
diff --git a/lib/Config/Model/Backend/Dpkg/Patch.pm b/lib/Config/Model/Backend/Dpkg/Patch.pm
index 2f33e25..e6b5e26 100644
--- a/lib/Config/Model/Backend/Dpkg/Patch.pm
+++ b/lib/Config/Model/Backend/Dpkg/Patch.pm
@@ -97,25 +97,39 @@ sub read {
if @$c > 4; # $c contains [ line_nb, section_ref ]
}
+ my $description_holder;
+ my $description_text ;
while (@$c) {
my ( $section_line, $section ) = splice @$c, 0, 2;
foreach ( my $i = 0 ; $i < $#$section ; $i += 2 ) {
my $key = $section->[$i];
my ( $v, $l, $a, @comments ) = @{ $section->[ $i + 1 ] };
if ( my $found = $node->find_element( $key, case => 'any' ) ) {
- my @elt = ($found);
- $v .= join( "\n", @stuff ) if $found eq 'Subject';
- my @v = ( $found eq 'Description' ) ? ( split /\n/, $v, 2 ) : ($v);
- unshift @elt, 'Synopsis' if $found eq 'Description';
- foreach (@elt) {
- my $sub_v = shift @v;
- next unless defined $sub_v;
- $logger->debug("storing $_ value: $sub_v");
- $node->fetch_element($_)->store( value => $sub_v, check => $check );
+ my $elt = $found ;
+ my $to_store = $v;
+ if ($found =~ /^Subject|Description$/) {
+ $description_holder = $found;
+ $elt = 'Synopsis';
+ ($to_store, $description_text)= split /\n+/, $v, 2 ;
}
+
+ $logger->debug("storing $elt value: $to_store");
+ $node->fetch_element($elt)->store( value => $to_store, check => $check );
+ }
+ else {
+ $stuff{$section_line} = "$key: $v";
}
}
}
+
+ my $k = 0;
+
+ if ($description_holder) {
+ my @desc_lines = map { my $pre = ( $k + 1 == $_ ? '' : "\n"); $k = $_; $pre.$stuff{$_} }
+ sort { $a <=> $b ;} keys %stuff ;
+ my $desc = ($description_text || '') .join( "\n", @desc_lines );
+ $node->fetch_element($description_holder)->store( value => $desc, check => $check );
+ }
$node->fetch_element('diff')->store(join('',@$diff));
return 1;
@@ -146,6 +160,8 @@ sub write {
message => "cannot write patch $patch_file" );
$io->binmode(":utf8");
+ my $subject_body;
+ my $diff;
foreach my $elt ( $node -> get_element_name ) {
my $elt_obj = $node->fetch_element($elt) ;
my $type = $node->element_type($elt) ;
@@ -159,14 +175,32 @@ sub write {
next unless defined $v and $v;
if ($elt eq 'Synopsis') {
- my $long_description = $node->fetch_element_value('Description') ;
- $v .= "\n" . $long_description if $long_description ;
- $io->print("Description: ");
- $self->write_dpkg_text($io,$v) ;
+ my $synopsis = $v ;
+ my $description_body = $node->fetch_element_value('Description') ;
+ $subject_body = $node->fetch_element_value('Subject') ;
+
+ if ($description_body and $subject_body) {
+ die "Write error: cannot have both Subject body and description body";
+ }
+ elsif ($description_body) {
+ my $to_write = $synopsis . "\n" . $description_body ;
+ $io->print("Description: ");
+ $self->write_dpkg_text($io, $to_write) ;
+ }
+ elsif ($subject_body) {
+ # DEP-3: When Subject is used, it is expected that the
+ # long description is outside of the structured
+ # fields.
+ $io->print("Subject: ");
+ $self->write_dpkg_text($io, $synopsis) ;
+ }
+ else {
+ $io->print("Description: ");
+ $self->write_dpkg_text($io, $synopsis) ;
+ }
}
- elsif ($elt eq 'Description') { } # done in Synopsis
- elsif ($elt eq 'diff' ) {
- $io->print($node->fetch_element_value('diff')) ;
+ elsif ($elt eq 'Description' or $elt eq 'Subject' or $elt eq 'diff') {
+ # first 2 are handled with Synopsis. diff is handled below
}
else {
$io->print("$elt: ");
@@ -175,6 +209,12 @@ sub write {
}
}
+ if ($subject_body) {
+ $io->print($subject_body."\n");
+ }
+
+ $io->print($node->fetch_element_value('diff')) ;
+
return 1;
}
diff --git a/t/model_tests.d/dpkg-patch-examples/moarvm b/t/model_tests.d/dpkg-patch-examples/moarvm
new file mode 100644
index 0000000..e4ecc31
--- /dev/null
+++ b/t/model_tests.d/dpkg-patch-examples/moarvm
@@ -0,0 +1,29 @@
+From: Paul Cochrane <paul at liekut.de>
+Date: Fri Apr 24 00:14:41 2015 +0200
+Subject: Patch Configure.pl to determine version string correctly
+
+The initial value of the version for MoarVM is found by looking at the
+contents of the VERSION file. If we are in a git working copy, however,
+then the latest tag is used as the version number. Unfortunately, in the
+Debian repo, this tag isn't the one that MoarVM is expecting. Thus for
+Debian packaging it is correct to only use the contents of the VERSION file.
+---
+ Configure.pl | 5 -----
+ 1 file changed, 5 deletions(-)
+
+diff --git a/Configure.pl b/Configure.pl
+index 38b08dc..b227eed 100644
+--- a/Configure.pl
++++ b/Configure.pl
+@@ -117,11 +117,6 @@ if (open(my $fh, '<', 'VERSION')) {
+ $VERSION = <$fh>;
+ close($fh);
+ }
+-# .git is a file and not a directory in submodule
+-if (-e '.git' && open(my $GIT, '-|', "git describe --tags")) {
+- $VERSION = <$GIT>;
+- close($GIT);
+-}
+ chomp $VERSION;
+ $config{version} = $VERSION;
+ $config{versionmajor} = $VERSION =~ /^(\d+)/ ? $1 : 0;
diff --git a/t/model_tests.d/dpkg-patch-test-conf.pl b/t/model_tests.d/dpkg-patch-test-conf.pl
index ed1e7a0..1104f09 100644
--- a/t/model_tests.d/dpkg-patch-test-conf.pl
+++ b/t/model_tests.d/dpkg-patch-test-conf.pl
@@ -11,12 +11,15 @@ eval { require AptPkg::Config; };
$skip = ( $@ or not -r '/etc/debian_version' ) ? 1 : 0;
@tests = (
- {
+ {
name => 'libperl5i' ,
config_file => $conf_file_name,
apply_fix => 1 ,
check => {
- 'Synopsis' => 'Some patch',
+ 'Synopsis' => qr/test TODO/,
+ 'Subject' => qr/utf8/,
+ 'Subject' => qr/879/,
+ 'Subject' => qr/2012/,
'Bug:0' => 'https://github.com/schwern/perl5i/issues/218',
'Bug:1' => 'https://github.com/schwern/perl5i/issues/219',
'Origin' => 'https://github.com/doherty/perl5i',
@@ -24,7 +27,14 @@ $skip = ( $@ or not -r '/etc/debian_version' ) ? 1 : 0;
},
# file_check_sub => $del_home,
- }
+ },
+ {
+ name => 'moarvm' ,
+ config_file => $conf_file_name,
+ check => {
+ 'Synopsis' => qr/Configure.pl/,
+ }
+ },
);
diff --git a/t/model_tests.d/dpkg-patches-test-conf.pl b/t/model_tests.d/dpkg-patches-test-conf.pl
index 7ae7c06..7aafec2 100644
--- a/t/model_tests.d/dpkg-patches-test-conf.pl
+++ b/t/model_tests.d/dpkg-patches-test-conf.pl
@@ -16,6 +16,9 @@ $skip = ( $@ or not -r '/etc/debian_version' ) ? 1 : 0;
# required to skip the bad patch (non dep-3)
load_check => 'no',
load_warnings => [ qr/Ignoring patch/ ],
+ check => {
+ 'patches:tweak-defaults Synopsis' => 'Tweak defaults values for Debian'
+ },
load => 'patches:~mail-like-patch',
# bad patch is skipped by config-model but is not removed from patch set
# hence the 2nd instance must also skip the bad patch
--
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