Re: [PATCH] Integrated dpkg-parsechangelog processing into Dpkg::Changelog::parse_changelog()
New patches are attached.
On Thu, 17 Jan 2008, Frank Lichtenheld wrote:
> Two misleading points here:
> 1) $opt{libdir} is search first before the default directories, that
> isn't clear from the sentence.
> 2) The changelog format can also be autodetected from the changelog
> file.
Ok fixed:
The parsing itself is done by an external program (searched in the
following list of directories: $opt{libdir},
/usr/local/lib/dpkg/parsechangelog, /usr/lib/dpkg/parsechangelog) That
program is named according to the format that it's able to parse. By
default it's either "debian" or the format name lookep up in the 40 last
lines of the changelog itself (extracted with this perl regular expression
"\schangelog-format:\s+([0-9a-z]+)\W"). But it can be overriden
with $opt{changelogformat}. The program expects the content of the
changelog file on its standard input.
> > + my $pid = open(P, "-|");
>
> $pid can be undefined if the fork() failed. This should be checked.
Fixed.
> > +eval { # Do not fail if parser failed due to unsupported options
> > + $prev_changelog = parse_changelog(%options);
> > +};
> > +$bad_parser = 1 if ($@);
>
> That hunk really should go into the former patch. Or the hunk that
> introduces the code you fix should vanish from the former patch.
Yeah. Done.
> > + my $cur_uv = $sversion;
> > + my $prev_uv = $prev_changelog->{"Version"};
> > + $prev_uv =~ s/^\d+://;
> > + $cur_uv =~ s/-[^-]+$//;
> > + $prev_uv =~ s/-[^-]+$//;
> > + $include_tarball = ($cur_uv ne $prev_uv) ? 1 : 0;
>
> Could we please use Dpkg::Version here? And change it if it doesn't
> support something like this yet. No need to reinvent the wheel.
Funnily, we both know when we're lazy. At least mutual review remind us that we
shouldn't be too much lazy. :-)
I'll export parseversion from Dpkg::Version for now, but we should one day
create a Dpkg::Version object.
> > + $include_tarball = ($sversion =~ /-(0|1|0\.1)$/) ? 1 : 0;
> > + } else {
> > + # No previous entry means first upload, tarball required
> > + $include_tarball = 1;
> > + }
>
> Hmm, have you tested the latter case? (i.e. only one entry in the
> changelog). I suddenly recall there was something I wanted to fix there.
Yes, parse_changelog() returns undef as expected.
(While checking this I just see that the modified dpkg-parsechangelog doesn't
check the return value...)
> > +# Scan control info of all binary packages unless
> > +# we have a source only upload
> > +my @pkg;
> > +push @pkg, $control->get_packages() unless is_sourceonly;
>
> That is a behavioural change, right? Up to now, dpkg-genchanges
> includes all the descriptions in source-only uploads. I'm not sure this is
> a behaviour we need to keep, just making sure everyone is aware that we
> do.
Indeed. It also means that XC-* fields are not forwarded for source-only
uploads (but IMO, XC-* should only have an effect in the source part of the
control file in general, but that's another discussion).
We already don't include descriptions (and XC fields) of packages that have no
corresponding .deb file uploaded (even if they are valid packages that are
simply not built on the architecture of this upload). So this seemed like the
logical behaviour for a source only upload.
It's highly unlikely that we break anything with this change but on the other
hand, as a frequent reviewer of .changes files, I appreciate having
descriptions... so I'm wondering if we shouldn't change the behaviour in the
opposite direction (always include all descriptions of all binary packages even
those which are not uploaded).
Opinions?
Cheers,
--
Raphaël Hertzog
Le best-seller français mis à jour pour Debian Etch :
http://www.ouaza.com/livre/admin-debian/
>From bb4437d0ab971363582a7cb79f6fe02d7845ab21 Mon Sep 17 00:00:00 2001
From: Raphael Hertzog <hertzog@debian.org>
Date: Mon, 14 Jan 2008 22:39:48 +0100
Subject: [PATCH] Integrated dpkg-parsechangelog processing into Dpkg::Changelog::parse_changelog()
* scripts/Dpkg/Changelog.pm (parse_changelog): Rewrite it completely
to not call dpkg-parsechangelog but do the work of this program by itself.
* scripts/dpkg-parsechangelog.pl: Rewrote it to use the enhanced
parse_changelog() function.
* scripts/dpkg-genchanges.pl, script/dpkg-gencontrol.pl: Adapted to use
the modified parse_changelog().
* scripts/dpkg-gensymbols.pl, scripts/dpkg-source.pl: Likewise.
---
scripts/Dpkg/Changelog.pm | 113 +++++++++++++++++++++++++++++++++++----
scripts/dpkg-genchanges.pl | 7 ++-
scripts/dpkg-gencontrol.pl | 4 +-
scripts/dpkg-gensymbols.pl | 3 +-
scripts/dpkg-parsechangelog.pl | 98 ++++++++++++++--------------------
scripts/dpkg-source.pl | 4 +-
6 files changed, 155 insertions(+), 74 deletions(-)
diff --git a/scripts/Dpkg/Changelog.pm b/scripts/Dpkg/Changelog.pm
index 7d5b941..651ed42 100644
--- a/scripts/Dpkg/Changelog.pm
+++ b/scripts/Dpkg/Changelog.pm
@@ -39,7 +39,7 @@ use English;
use Dpkg;
use Dpkg::Gettext;
-use Dpkg::ErrorHandling qw(warning report syserr subprocerr);
+use Dpkg::ErrorHandling qw(warning report syserr subprocerr error);
use Dpkg::Cdata;
use Dpkg::Fields;
@@ -693,23 +693,112 @@ sub get_dpkg_changes {
=pod
-=head3 parse_changelog($file, $format, $since)
+=head3 my $fields = parse_changelog(%opt)
-Calls "dpkg-parsechangelog -l$file -F$format -v$since" and returns a
-Dpkg::Fields::Object with the values output by the program.
+This function will parse a changelog and return a Dpkg::Fields::Object
+with some summary information. It will return undef if the parser didn't
+return any data. If the parser failed, it will die.
+
+The parsing itself is done by an external program (searched in the
+following list of directories: $opt{libdir},
+/usr/local/lib/dpkg/parsechangelog, /usr/lib/dpkg/parsechangelog) That
+program is named according to the format that it's able to parse. By
+default it's either "debian" or the format name lookep up in the 40 last
+lines of the changelog itself (extracted with this perl regular expression
+"\schangelog-format:\s+([0-9a-z]+)\W"). But it can be overriden
+with $opt{changelogformat}. The program expects the content of the
+changelog file on its standard input.
+
+The changelog file that is parsed is debian/changelog by default but it
+can be overriden with $opt{file}.
+
+All the other keys in %opt are forwarded as parameter to the external
+parser. If the key starts with "-", it's passed as is. If not, it's passed
+as "--<key>". If the value of the corresponding hash entry is defined, then
+it's passed as the parameter that follows.
=cut
sub parse_changelog {
- my ($changelogfile, $changelogformat, $since) = @_;
+ my (%options) = @_;
+ my @parserpath = ("/usr/local/lib/dpkg/parsechangelog",
+ "$dpkglibdir/parsechangelog");
+ my $format = "debian";
+ my $changelogfile = "debian/changelog";
+ my $force = 0;
+
+ # Extract and remove options that do not concern the changelog parser
+ # itself (and that we shouldn't forward)
+ if (exists $options{"libdir"}) {
+ unshift @parserpath, $options{"libdir"};
+ delete $options{"libdir"};
+ }
+ if (exists $options{"file"}) {
+ $changelogfile = $options{"file"};
+ delete $options{"file"};
+ }
+ if (exists $options{"changelogformat"}) {
+ $format = $options{"changelogformat"};
+ delete $options{"changelogformat"};
+ $force = 1;
+ }
+ # XXX: For compatibility with old parsers, don't use --since but -v
+ # This can be removed later (in lenny+1 for example)
+ if (exists $options{"since"}) {
+ my $since = $options{"since"};
+ $options{"-v$since"} = undef;
+ delete $options{"since"};
+ }
+
+ # Extract the format from the changelog file if possible
+ unless($force or ($changelogfile eq "-")) {
+ open(P, "-|", "tail", "-n", "40", $changelogfile);
+ while(<P>) {
+ $format = $1 if m/\schangelog-format:\s+([0-9a-z]+)\W/;
+ }
+ close(P) or subprocerr(_g("tail of %s"), $changelogfile);
+ }
- my @exec = ('dpkg-parsechangelog');
- push(@exec, "-l$changelogfile");
- push(@exec, "-F$changelogformat") if defined($changelogformat);
- push(@exec, "-v$since") if defined($since);
+ # Find the right changelog parser
+ my $parser;
+ foreach my $dir (@parserpath) {
+ my $candidate = "$dir/$format";
+ next if not -e $candidate;
+ if (-x _) {
+ $parser = $candidate;
+ last;
+ } else {
+ warning(_g("format parser %s not executable"), $candidate);
+ }
+ }
+ error(_g("changelog format %s is unknown"), $format) if not defined $parser;
+
+ # Create the arguments for the changelog parser
+ my @exec = ($parser, "-l$changelogfile");
+ foreach (keys %options) {
+ if (m/^-/) {
+ # Options passed untouched
+ push @exec, $_;
+ } else {
+ # Non-options are mapped to long options
+ push @exec, "--$_";
+ }
+ push @exec, $options{$_} if defined($options{$_});
+ }
+
+ # Fork and call the parser
+ my $pid = open(P, "-|");
+ syserr(_g("fork for %s"), $parser) unless defined $pid;
+ if (not $pid) {
+ if ($changelogfile ne "-") {
+ open(STDIN, "<", $changelogfile) or
+ syserr(_g("cannot open %s"), $changelogfile);
+ }
+ exec(@exec) || syserr(_g("cannot exec format parser: %s"), $parser);
+ }
- open(PARSECH, "-|", @exec) || syserr(_g("fork for parse changelog"));
- my $fields = parsecdata(\*PARSECH, _g("parsed version of changelog"));
- close(PARSECH) || subprocerr(_g("parse changelog"));
+ # Get the output into a Dpkg::Fields::Object
+ my $fields = parsecdata(\*P, _g("output of changelog parser"));
+ close(P) or subprocerr(_g("changelog parser %s"), $parser);
return $fields;
}
diff --git a/scripts/dpkg-genchanges.pl b/scripts/dpkg-genchanges.pl
index e88092f..7c8d859 100755
--- a/scripts/dpkg-genchanges.pl
+++ b/scripts/dpkg-genchanges.pl
@@ -181,7 +181,12 @@ while (@ARGV) {
}
}
-my $changelog = parse_changelog($changelogfile, $changelogformat, $since);
+# Retrieve info from the current changelog entry
+my %options = (file => $changelogfile);
+$options{"changelogformat"} = $changelogformat if $changelogformat;
+$options{"since"} = $since if $since;
+my $changelog = parse_changelog(%options);
+# Other initializations
my $control = Dpkg::Control->new($controlfile);
my $fields = Dpkg::Fields::Object->new();
$substvars->set_version_substvars($changelog->{"Version"});
diff --git a/scripts/dpkg-gencontrol.pl b/scripts/dpkg-gencontrol.pl
index 6ae5c72..d6e8bef 100755
--- a/scripts/dpkg-gencontrol.pl
+++ b/scripts/dpkg-gencontrol.pl
@@ -121,7 +121,9 @@ while (@ARGV) {
}
}
-my $changelog = parse_changelog($changelogfile, $changelogformat);
+my %options = (file => $changelogfile);
+$options{"changelogformat"} = $changelogformat if $changelogformat;
+my $changelog = parse_changelog(%options);
$substvars->set_version_substvars($changelog->{"Version"});
$substvars->parse($varlistfile) if -e $varlistfile;
$substvars->set("binary:Version", $forceversion) if defined $forceversion;
diff --git a/scripts/dpkg-gensymbols.pl b/scripts/dpkg-gensymbols.pl
index 592ea25..ac3799d 100755
--- a/scripts/dpkg-gensymbols.pl
+++ b/scripts/dpkg-gensymbols.pl
@@ -15,7 +15,6 @@ use Dpkg::Changelog qw(parse_changelog);
textdomain("dpkg-dev");
-my $changelogfile = 'debian/changelog';
my $packagebuilddir = 'debian/tmp';
my $sourceversion;
@@ -109,7 +108,7 @@ if (exists $ENV{DPKG_GENSYMBOLS_CHECK_LEVEL}) {
}
if (not defined($sourceversion)) {
- my $changelog = parse_changelog($changelogfile);
+ my $changelog = parse_changelog();
$sourceversion = $changelog->{"Version"};
}
if (not defined($oppackage)) {
diff --git a/scripts/dpkg-parsechangelog.pl b/scripts/dpkg-parsechangelog.pl
index 1ae3da2..1821f2c 100755
--- a/scripts/dpkg-parsechangelog.pl
+++ b/scripts/dpkg-parsechangelog.pl
@@ -9,17 +9,11 @@ use POSIX qw(:errno_h);
use Dpkg;
use Dpkg::Gettext;
use Dpkg::ErrorHandling qw(warning error syserr subprocerr usageerr);
+use Dpkg::Changelog qw(parse_changelog);
textdomain("dpkg-dev");
-my $format ='debian';
-my $changelogfile = 'debian/changelog';
-my @parserpath = ("/usr/local/lib/dpkg/parsechangelog",
- "$dpkglibdir/parsechangelog");
-
-my $libdir;
-my $force;
-
+my %options;
sub version {
printf _g("Debian %s version %s.\n"), $progname, $version;
@@ -64,60 +58,50 @@ parser options:
"), $progname;
}
-my @ap = ();
while (@ARGV) {
last unless $ARGV[0] =~ m/^-/;
- $_= shift(@ARGV);
- if (m/^-L/ && length($_)>2) { $libdir=$POSTMATCH; next; }
- if (m/^-F([0-9a-z]+)$/) { $force=1; $format=$1; next; }
- push(@ap,$_);
- if (m/^-l/ && length($_)>2) { $changelogfile=$POSTMATCH; next; }
- m/^--$/ && last;
- m/^-[cfnostuv]/ && next;
- m/^--all$/ && next;
- m/^--(count|file|format|from|offset|since|to|until)(.*)$/ && do {
- push(@ap, shift(@ARGV)) unless $2;
- next;
- };
- if (m/^-(h|-help)$/) { &usage; exit(0); }
- if (m/^--version$/) { &version; exit(0); }
- &usageerr(_g("unknown option \`%s'"), $_);
-}
-
-@ARGV && usageerr(_g("%s takes no non-option arguments"), $progname);
-
-if (not $force and $changelogfile ne "-") {
- open(STDIN,"<", $changelogfile) ||
- syserr(_g("cannot open %s to find format"), $changelogfile);
- open(P,"-|","tail","-n",40) || syserr(_g("cannot fork"));
- while(<P>) {
- next unless m/\schangelog-format:\s+([0-9a-z]+)\W/;
- $format=$1;
- }
- close(P);
- $? && subprocerr(_g("tail of %s"), $changelogfile);
-}
-
-my ($pa, $pf);
-
-unshift(@parserpath, $libdir) if $libdir;
-for my $pd (@parserpath) {
- $pa= "$pd/$format";
- if (!stat("$pa")) {
- $! == ENOENT || syserr(_g("failed to check for format parser %s"), $pa);
- } elsif (!-x _) {
- warning(_g("format parser %s not executable"), $pa);
- } else {
- $pf= $pa;
+ $_ = shift(@ARGV);
+ if (m/^-L(.+)$/) {
+ $options{"libdir"} = $1;
+ } elsif (m/^-F([0-9a-z]+)$/) {
+ $options{"changelogformat"} = $1;
+ } elsif (m/^-l(.+)$/) {
+ $options{"file"} = $1;
+ } elsif (m/^--$/) {
last;
+ } elsif (m/^-([cfnostuv])(.*)$/) {
+ if (($1 eq "c") or ($1 eq "n")) {
+ $options{"count"} = $2;
+ } elsif ($1 eq "f") {
+ $options{"from"} = $2;
+ } elsif ($1 eq "o") {
+ $options{"offset"} = $2;
+ } elsif (($1 eq "s") or ($1 eq "v")) {
+ $options{"since"} = $2;
+ } elsif ($1 eq "t") {
+ $options{"to"} = $2;
+ } elsif ($1 eq "u") {
+ $options{"until"} = $2;
+ }
+ } elsif (m/^--(count|file|format|from|offset|since|to|until)(.*)$/) {
+ if ($2) {
+ $options{$1} = $2;
+ } else {
+ $options{$1} = shift(@ARGV);
+ }
+ } elsif (m/^--all$/) {
+ $options{"all"} = undef;
+ } elsif (m/^-(h|-help)$/) {
+ usage(); exit(0);
+ } elsif (m/^--version$/) {
+ version(); exit(0);
+ } else {
+ usageerr(_g("unknown option \`%s'"), $_);
}
}
-defined($pf) || error(_g("format %s unknown"), $pa);
+@ARGV && usageerr(_g("%s takes no non-option arguments"), $progname);
-if ($changelogfile ne "-") {
- open(STDIN,"<", $changelogfile)
- || syserr(_g("cannot open %s"), $changelogfile);
-}
-exec($pf,@ap) || syserr(_g("cannot exec format parser: %s"));
+my $fields = parse_changelog(%options);
+print tied(%$fields)->dump() if defined $fields;
diff --git a/scripts/dpkg-source.pl b/scripts/dpkg-source.pl
index 92e82bd..12355e1 100755
--- a/scripts/dpkg-source.pl
+++ b/scripts/dpkg-source.pl
@@ -291,7 +291,9 @@ if ($opmode eq 'build') {
$changelogfile= "$dir/debian/changelog" unless defined($changelogfile);
$controlfile= "$dir/debian/control" unless defined($controlfile);
- my $changelog = parse_changelog($changelogfile, $changelogformat);
+ my %options = (file => $changelogfile);
+ $options{"changelogformat"} = $changelogformat if $changelogformat;
+ my $changelog = parse_changelog(%options);
my $control = Dpkg::Control->new($controlfile);
my $fields = Dpkg::Fields::Object->new();
--
1.5.3.8
>From 9f91004a0dba5bb2d2eb5a5efd634f4b12f62e91 Mon Sep 17 00:00:00 2001
From: Raphael Hertzog <hertzog@debian.org>
Date: Mon, 14 Jan 2008 23:16:32 +0100
Subject: [PATCH] dpkg-genchanges: Enhance logic to decide if we include orig tarballs
By default, include orig tarballs only if the current upstream version
differs from the previous changelog entry. Closes: #28701
---
man/dpkg-genchanges.1 | 9 ++++-----
scripts/Dpkg/Version.pm | 2 +-
scripts/dpkg-genchanges.pl | 32 ++++++++++++++++++++++++++++++--
3 files changed, 35 insertions(+), 8 deletions(-)
diff --git a/man/dpkg-genchanges.1 b/man/dpkg-genchanges.1
index 37ab325..2662cca 100644
--- a/man/dpkg-genchanges.1
+++ b/man/dpkg-genchanges.1
@@ -35,11 +35,10 @@ included in the upload if any source is being generated (i.e.
haven't been used).
.TP
.B \-si
-By default, or if specified, the original source will be included if the
-version number ends in
-.BR \-0 " or " \-1 ,
-i.e. if the Debian revision part of the version number is
-.BR 0 " or " 1 .
+By default, or if specified, the original source will be included only if
+the upstream version number (the version without epoch and without Debian
+revision) differs from the upstream version number of the previous
+changelog entry.
.TP
.B \-sa
Forces the inclusion of the original source.
diff --git a/scripts/Dpkg/Version.pm b/scripts/Dpkg/Version.pm
index 3c1f01e..18dd312 100644
--- a/scripts/Dpkg/Version.pm
+++ b/scripts/Dpkg/Version.pm
@@ -25,7 +25,7 @@ use Dpkg::ErrorHandling qw(error);
use Exporter;
our @ISA = qw(Exporter);
-our @EXPORT_OK = qw(vercmp compare_versions check_version);
+our @EXPORT_OK = qw(vercmp compare_versions check_version parseversion);
=head1 NAME
diff --git a/scripts/dpkg-genchanges.pl b/scripts/dpkg-genchanges.pl
index 7c8d859..0255bcb 100755
--- a/scripts/dpkg-genchanges.pl
+++ b/scripts/dpkg-genchanges.pl
@@ -18,6 +18,7 @@ use Dpkg::Cdata;
use Dpkg::Substvars;
use Dpkg::Vars;
use Dpkg::Changelog qw(parse_changelog);
+use Dpkg::Version qw(parseversion);
textdomain("dpkg-dev");
@@ -111,7 +112,7 @@ Options:
-m<maintainer> override control's maintainer value.
-e<maintainer> override changelog's maintainer value.
-u<uploadfilesdir> directory with files (default is \`..').
- -si (default) src includes orig for debian-revision 0 or 1.
+ -si (default) src includes orig if new upstream.
-sa source includes orig src.
-sd source is diff and .dsc only.
-q quiet - no informational messages on stderr.
@@ -186,6 +187,15 @@ my %options = (file => $changelogfile);
$options{"changelogformat"} = $changelogformat if $changelogformat;
$options{"since"} = $since if $since;
my $changelog = parse_changelog(%options);
+# Change options to retrieve info of the former changelog entry
+delete $options{"since"};
+$options{"count"} = 1;
+$options{"offset"} = 1;
+my ($prev_changelog, $bad_parser);
+eval { # Do not fail if parser failed due to unsupported options
+ $prev_changelog = parse_changelog(%options);
+};
+$bad_parser = 1 if ($@);
# Other initializations
my $control = Dpkg::Control->new($controlfile);
my $fields = Dpkg::Fields::Object->new();
@@ -398,7 +408,25 @@ if (!is_binaryonly) {
$f2pri{$f} = $pri;
}
- if (($sourcestyle =~ m/i/ && $sversion !~ m/-(0|1|0\.1)$/ ||
+ # Compare upstream version to previous upstream version to decide if
+ # the .orig tarballs must be included
+ my $include_tarball;
+ if (defined($prev_changelog)) {
+ my %cur = parseversion($changelog->{"Version"});
+ my %prev = parseversion($prev_changelog->{"Version"});
+ $include_tarball = ($cur{"version"} ne $prev{"version"}) ? 1 : 0;
+ } else {
+ if ($bad_parser) {
+ # The parser doesn't support extracting a previous version
+ # Fallback to version check
+ $include_tarball = ($sversion =~ /-(0|1|0\.1)$/) ? 1 : 0;
+ } else {
+ # No previous entry means first upload, tarball required
+ $include_tarball = 1;
+ }
+ }
+
+ if ((($sourcestyle =~ m/i/ && not($include_tarball)) ||
$sourcestyle =~ m/d/) &&
grep(m/\.diff\.$comp_regex$/,@sourcefiles)) {
$origsrcmsg= _g("not including original source code in upload");
--
1.5.3.8
>From 95d2d447783322f8ab8938a939040146fc49e4a9 Mon Sep 17 00:00:00 2001
From: Raphael Hertzog <hertzog@debian.org>
Date: Wed, 16 Jan 2008 10:08:14 +0100
Subject: [PATCH] dpkg-genchanges: some code refactoring to simplify the code
* scripts/dpkg-genchanges.pl: Some code refactoring. Also fix the
generation of the Description field to not have duplicate description
in case of udeb (a single description per binary package is enough).
---
scripts/dpkg-genchanges.pl | 88 +++++++++++++++++++++-----------------------
1 files changed, 42 insertions(+), 46 deletions(-)
diff --git a/scripts/dpkg-genchanges.pl b/scripts/dpkg-genchanges.pl
index 0255bcb..1fc7787 100755
--- a/scripts/dpkg-genchanges.pl
+++ b/scripts/dpkg-genchanges.pl
@@ -259,58 +259,54 @@ foreach $_ (keys %{$src_fields}) {
}
}
-# Scan control info of all binary packages
-foreach my $pkg ($control->get_packages()) {
+# Scan control info of all binary packages unless
+# we have a source only upload
+my @pkg;
+push @pkg, $control->get_packages() unless is_sourceonly;
+foreach my $pkg (@pkg) {
my $p = $pkg->{"Package"};
my $a = $pkg->{"Architecture"};
+
+ if (not defined($p2f{$p})) {
+ # No files for this package... warn if it's unexpected
+ if ((debarch_eq('all', $a) and ($include & ARCH_INDEP)) ||
+ (grep(debarch_is($host_arch, $_), split(/\s+/, $a))
+ and ($include & ARCH_DEP))) {
+ warning(_g("package %s in control file but not in files list"),
+ $p);
+ }
+ next; # and skip it
+ }
+
+ my @f = @{$p2f{$p}}; # List of files for this binary package
+ $p2arch{$p} = $a;
+
foreach $_ (keys %{$pkg}) {
my $v = $pkg->{$_};
- if (!defined($p2f{$p}) && not is_sourceonly) {
- if ((debarch_eq('all', $a) and ($include & ARCH_INDEP)) ||
- (grep(debarch_is($host_arch, $_), split(/\s+/, $a))
- and ($include & ARCH_DEP))) {
- warning(_g("package %s in control file but not in files list"),
- $p);
- next;
+
+ if (m/^Description$/) {
+ $v = $1 if $v =~ m/^(.*)\n/;
+ my $desc = sprintf("%-10s - %-.65s", $p, $v);
+ $desc .= " (udeb)" if (grep(/\.udeb$/, @f));
+ push @descriptions, $desc;
+ } elsif (m/^Section$/) {
+ $f2seccf{$_} = $v foreach (@f);
+ } elsif (m/^Priority$/) {
+ $f2pricf{$_} = $v foreach (@f);
+ } elsif (s/^X[BS]*C[BS]*-//i) { # Include XC-* fields
+ $fields->{$_} = $v;
+ } elsif (m/^Architecture$/) {
+ if (grep(debarch_is($host_arch, $_), split(/\s+/, $v))
+ and ($include & ARCH_DEP)) {
+ $v = $host_arch;
+ } elsif (!debarch_eq('all', $v)) {
+ $v = '';
}
+ push(@archvalues,$v) unless !$v || $archadded{$v}++;
+ } elsif (m/^$control_pkg_field_regex$/ || m/^X[BS]+-/i) {
+ # Silently ignore valid fields
} else {
- my @f;
- @f = @{$p2f{$p}} if defined($p2f{$p});
- $p2arch{$p}=$a;
-
- if (m/^Description$/) {
- $v=$PREMATCH if $v =~ m/\n/;
- my %d;
- # dummy file to get each description at least once (e.g. -S)
- foreach my $f (("", @f)) {
- my $desc = sprintf("%-10s - %-.65s%s", $p, $v,
- $f =~ m/\.udeb$/ ? " (udeb)" : '');
- $d{$desc}++;
- }
- push @descriptions, keys %d;
- } elsif (m/^Section$/) {
- $f2seccf{$_} = $v foreach (@f);
- } elsif (m/^Priority$/) {
- $f2pricf{$_} = $v foreach (@f);
- } elsif (s/^X[BS]*C[BS]*-//i) { # Include XC-* fields
- $fields->{$_} = $v;
- } elsif (m/^Architecture$/) {
- if (not is_sourceonly) {
- if (grep(debarch_is($host_arch, $_), split(/\s+/, $v))
- and ($include & ARCH_DEP)) {
- $v = $host_arch;
- } elsif (!debarch_eq('all', $v)) {
- $v = '';
- }
- } else {
- $v = '';
- }
- push(@archvalues,$v) unless !$v || $archadded{$v}++;
- } elsif (m/^$control_pkg_field_regex$/ || m/^X[BS]+-/i) {
- # Silently ignore valid fields
- } else {
- unknown(_g("package's section of control info file"));
- }
+ unknown(_g("package's section of control info file"));
}
}
}
--
1.5.3.8
Reply to: