dpkg-genchanges: use Package-Type control field to detect udebs

* scripts/Dpkg/Fields.pm (find_custom_field, get_custom_field):
New function to handle custom fields (X[SBC]*-*).
* scripts/dpkg-genchanges.pl: Use Package-Type control field to
decide if a package is an udeb instead of relying on the file
extension of a generated package since that doesn't work when
generating source-only uploads for example.

ChangeLog

@@ -1,3 +1,12 @@
+2008-04-14  Raphael Hertzog  <hertzog@debian.org>
+
+	* scripts/Dpkg/Fields.pm (find_custom_field, get_custom_field):
+	New function to handle custom fields (X[SBC]*-*).
+	* scripts/dpkg-genchanges.pl: Use Package-Type control field to
+	decide if a package is an udeb instead of relying on the file
+	extension of a generated package since that doesn't work when
+	generating source-only uploads for example.
+
 2008-04-14  Raphael Hertzog  <hertzog@debian.org>
 
 	* scripts/Dpkg/Source/Patch.pm (_fail_not_same_type): Fix

debian/changelog

@@ -11,6 +11,9 @@ dpkg (1.14.19) UNRELEASED; urgency=low
     original tarball in the current extraction directory. Closes: #475668
   * Fix the dpkg-source error message about unrepresentable changes to
     source because the type of a file changed (new and old were inverted).
+  * Fix dpkg-genchanges to detect udeb based on Package-Type control
+    header instead of file extension analysis on uploaded files.
+    Closes: #476113
 
   [ Updated dpkg translations ]
   * Galician (Jacobo Tarrio).

scripts/Dpkg/Fields.pm

@@ -131,6 +131,33 @@ sub NEXTKEY {
     return undef;
 }
 
+=head2 tied(%hash)->find_custom_field($name)
+
+Scan the fields and look for a user specific field whose name matches the
+following regex: /X[SBC]+-$name/i. Return the name of the field found or
+undef if nothing has been found.
+
+=cut
+sub find_custom_field {
+    my ($self, $name) = @_;
+    foreach my $key (keys %{$self->[0]}) {
+        return $key if $key =~ /^X[SBC]*-\Q$name\E$/i;
+    }
+    return undef;
+}
+
+=head2 tied(%hash)->get_custom_field($name)
+
+Identify a user field and retrieve its value.
+
+=cut
+sub get_custom_field {
+    my ($self, $name) = @_;
+    my $key = $self->find_custom_field($name);
+    return $self->[0]->{$key} if defined $key;
+    return undef;
+}
+
 =head2 my $str = tied(%hash)->dump()
 =head2 tied(%hash)->dump($fh)
 

scripts/dpkg-genchanges.pl

@@ -276,13 +276,15 @@ foreach my $pkg ($control->get_packages()) {
     my $a = $pkg->{"Architecture"};
     my $d = $pkg->{"Description"} || "no description available";
     $d = $1 if $d =~ /^(.*)\n/;
+    my $pkg_type = $pkg->{"Package-Type"} ||
+                   tied(%$pkg)->get_custom_field("Package-Type") || "deb";
 
     my @f; # List of files for this binary package
     push @f, @{$p2f{$p}} if defined $p2f{$p};
 
     # Add description of all binary packages
     my $desc = sprintf("%-10s - %-.65s", $p, $d);
-    $desc .= " (udeb)" if (grep(/\.udeb$/, @f)); # XXX: Check Package-Type field instead
+    $desc .= " (udeb)" if $pkg_type eq "udeb";
     push @descriptions, $desc;
 
     if (not defined($p2f{$p})) {