Merge branch 'master' of git://git.debian.org/git/dpkg/dpkg into sourcev3

Conflicts:

	debian/dpkg-dev.install
	scripts/dpkg-source.pl

ChangeLog

@@ -1,3 +1,152 @@
+2008-01-14  Raphael Hertzog  <hertzog@debian.org>
+
+	* scripts/dpkg-genchanges.pl, scripts/dpkg-gencontrol.pl,
+	scripts/dpkg-source.pl: Hint Perl into using UTF-8 for output
+	on *.dsc, *.changes and DEBIAN/control files. Updated some open() calls
+	for more consistency and added binmode() calls for filehandles that
+	handle only binary data.
+
+2008-01-13  Raphael Hertzog  <hertzog@debian.org>
+
+	* scripts/Dpkg/Fields.pm: Drop public function
+	set_fields_importance() in favor of a method on
+	Dpkg::Fields::Object. Integrate	public function
+	sort_field_by_importance() in the output() method where it was
+	used.
+	* scripts/Dpkg/Changelog.pm, scripts/dpkg-genchanges.pl,
+	scripts/dpkg-gencontrol.pl, scripts/dpkg-source.pl: Updated to use
+	the set_field_importance() method instead of the removed function.
+	* scripts/Dpkg/Control.pm: Update pod documentation to refer to
+	Dpkg::Fields::Object instead of the invalid Dpkg::Cdata::Object.
+
+2008-01-13  Frank Lichtenheld  <djpig@debian.org>
+
+	* scripts/Dpkg/Fields.pm (dump): Allow to omit the
+	filehandle argument. If the function is called in
+	non-void context, also remove the printed string
+	to the caller. Together this avoids having to fiddle
+	with filehandles if the caller doesn't want to.
+	(output): Likewise.
+	* scripts/Dpkg/Changelog.pm (data2rfc822): Simplify
+	using this new behaviour.
+
+	* scripts/t/600_Dpkg_Changelog.t: Add a new changelog
+	'fields' that tests the handling of the different fields
+	in the dpkg format.
+
+	* scripts/Dpkg/Changelog.pm: Replace all field hashes
+	with Dpkg::Changelog::Entry objects.
+	(Dpkg::Changelog::Entry): Base on Dpkg::Fields::Object.
+	(data2rfc822): Use Dpkg::Fields::Object->output and fix
+	handling of user-defined fields.
+	(data2rfc822_mult): Merge into data2rfc822 (autodetect
+	whether the argument is an object or an array of object).
+	* scripts/Dpkg/Changelog/Debian.pm: Adapt for
+	Dpkg::Changelog::Entry changes.
+	* scripts/t/600_Dpkg_Changelog.t: Likewise.
+
+2008-01-12  Raphael hertzog  <hertzog@debian.org>
+
+	* scripts/Dpkg/Fields.pm, scripts/dpkg-source.pl: Add support of
+	Dm-Upload-Allowed field. It automatically ends up in the dsc.
+
+2008-01-12  Raphael hertzog  <hertzog@debian.org>
+
+	* scripts/Dpkg/Fields.pm: Define variables containing
+	authoritative list of fields for debian/control (one for source
+	stanza, one for package stanza).
+	* scripts/dpkg-genchanges.pl, scripts/dpkg-gencontrol.pl,
+	scripts/dpkg-source.pl: Use the new variables to properly ignore
+	valid fields. Some related cleanup.
+
+2008-01-11  Raphael Hertzog  <hertzog@debian.org>
+
+	* scripts/dpkg-gencontrol.pl: Also force version in ${binary:Version}
+	if dpkg-gencontrol -v<version> is used. That way we're consistent
+	with the definition of that variable in deb-substvars(5).
+
+2008-01-10  Raphael Hertzog  <hertzog@debian.org>
+
+	* debian/control: Add a "Breaks: dpkg-dev (= 1.14.13),
+	dpkg-dev (= 1.14.14)" on dpkg to force upgrade of those dpkg-dev
+	versions that would break with the move of the compression related
+	variables from Dpkg.pm into Dpkg/Compression.pm.
+
+2008-01-08  Raphael Hertzog  <hertzog@debian.org>
+
+	* scripts/Dpkg/Version.pm: Import missing error function from
+	Dpkg::ErrorHandling.
+
+	* scripts/po/POTFILES.in: Add many modules containing translatable
+	strings.
+
+	* scripts/Dpkg/Changelog.pm (parse_changelog): New function to
+	replace controllib's parsechangelog.
+
+	* scripts/dpkg-buildpackage.pl, scripts/dpkg-checkbuilddeps.pl,
+	scripts/dpkg-genchanges.pl, scripts/dpkg-gencontrol.pl,
+	scripts/dpkg-gensymbols.pl, scripts/dpkg-source.pl: Update scripts to use
+	Dpkg::Changelog::parse_changelog instead of the old controllib.pl's
+	parsechangelog. With this last change controllib.pl is no more used by
+	any script.
+
+	* scripts/controllib.pl: Removed as it's no more used by any
+	script.
+
+	* debian/dpkg-dev.install: Add missing modules.
+
+2008-01-08  Frank Lichtenheld  <djpig@debian.org>
+
+	* scripts/dpkg-parsechangelog.pl: Make the
+	-L option actually work (it's only been eleven
+	years...)
+	
+	* scripts/Dpkg/ErrorHandling.pm (report): export.
+
+2008-01-08  Raphael Hertzog  <hertzog@debian.org>
+
+	* scripts/Dpkg/Cdata.pm, scripts/Dpkg/Control.pm: Add two new
+	module to parse and manipulate files like debian/control.
+	* scripts/t/600_Dpkg_Control.t,
+	scripts/t/600_Dpkg_Control/control-1: Add non-regression tests for
+	Dpkg::Control and Dpkg::Cdata.
+	* scripts/dpkg-checkbuilddeps.pl, scripts/dpkg-genchanges.pl,
+	scripts/dpkg-gencontrol.pl, scripts/dpkg-gensymbols.pl,
+	scripts/dpkg-shlibdeps.pl, scripts/dpkg-source.pl: Update scripts
+	to use the new modules Dpkg::Cdata, Dpkg::Control,
+	Dpkg::Fields::Object and Dpkg::Substvars.
+
+	* scripts/Dpkg/Version.pm (check_version): New function replacing
+	checkversion of controllib.pl.
+	* scripts/dpkg-source.pl, scripts/dpkg-buildpackage.pl: Use the
+	new check_version.
+
+	* scripts/Dpkg/Vars.pm (set_source_package): New function to set
+	and check the global variable $sourcepackage (replacing
+	controllib's setsourcepackage).
+	* scripts/dpkg-genchanges.pl, scripts/dpkg-gencontrol.pl,
+	scripts/dpkg-source.pl: Use the new set_source_package.
+
+	* scripts/dpkg-distaddfile.pl, scripts/dpkg-gencontrol.pl: Delete
+	the chown(getfowner(), ...) on new files. It doesn't seem to do
+	anything useful anymore as it got dropped from several other
+	scripts over the years without problems.
+
+	* scripts/dpkg-source.pl: Integrate readmd5sum from controllib here
+	as it's the only user of that function.
+
+	* scripts/controllib.pl: Get rid of everything except
+	parsechangelog and its dependencies (parsecdata, syntax) that are
+	still needed.
+
+	* scripts/Makefile.am: Include all the new files in the
+	distributed tarball.
+
+2008-01-08  Raphael Hertzog  <hertzog@debian.org>
+
+	* scripts/Dpkg/ErrorHandling.pm (syntaxerr): New function to
+	replace the syntax() function in controllib.pl.
+
 2008-01-07  Guillem Jover  <guillem@debian.org>
 
 	* scripts/dpkg-genchanges.pl: Ignore Homepage field in binary package

debian/changelog

@@ -4,13 +4,49 @@ dpkg (1.14.16) UNRELEASED; urgency=low
   * Add build-essential as an implicit Build-Depends in dpkg-checkbuilddeps.
     Closes: #402901
   * Do not warn about unrecognized Homepage field in binary package stanzas
-    in dpkg-genchanges and dpkg-source.
+    in dpkg-genchanges and dpkg-source. Closes: #460309
+
+  [ Frank Lichtenheld ]
+  * Make the -L option of dpkg-parsechangelog actually work (it's
+    only been eleven years...)
+  * Import the code from my external Parse::DebianChangelog as
+    Dpkg::Changelog and Dpkg::Changelog::Debian. Using this
+    from parsechangelog/debian adds the following requested
+    features:
+     - Option to use a non-lossy format. Closes: #95579
+     - Various options to better control how many entries
+       should be displayed. Closes: #226932
+
+  [ Raphael Hertzog ]
+  * Replaced all the remaining code in controllib.pl by new modules. All
+    scripts have been adjusted to use the new modules and controllib.pl has
+    been removed.
+  * The code to parse debian/control is available in a perl module
+    Dpkg::Control. Closes: #26554
+  * Temporarily add a Breaks: dpkg-dev (= 1.14.13), dpkg-dev (= 1.14.14) on
+    dpkg for the convenience of sid users. Closes: #459815
+  * Update dpkg-source(1) to explain better what the directory after -b is.
+    Closes: #323606
+  * Also force version in ${binary:Version} if dpkg-gencontrol -v<version>
+    is used. That way we're consistent with the definition of that variable
+    in deb-substvars(5). Closes: #433477
+  * Add support of Dm-Upload-Allowed field. Closes: #453400
+
+  [ Updated manpages translations ]
+  * Fix typo in French. Closes: #460021
+  * German (Helge Kreutzmann).
 
   [ Updated dpkg translations ]
   * Basque (Piarres Beobide). Closes: #459565
   * French (Christian Perrier).
+  * German, Basque, Norwegian Bokmål, Swedish, Vietnamese, Simplified Chinese,
+    Galician unfuzzied.
+  * Russian (Yuri Kozlov). Closes: #460708
+
+  [ Updated scripts translations ]
+  * Russian (Yuri Kozlov). Closes: #460708
 
- -- Guillem Jover <guillem@debian.org>  Mon, 07 Jan 2008 12:39:36 +0200
+ -- Jacobo Tarrio <jtarrio@debian.org>  Sat, 12 Jan 2008 12:27:22 +0000
 
 dpkg (1.14.15) unstable; urgency=low
 

debian/control

@@ -18,6 +18,7 @@ Package: dpkg
 Architecture: any
 Essential: yes
 Pre-Depends: ${shlibs:Depends}, coreutils (>= 5.93-1)
+Breaks: dpkg-dev (= 1.14.13), dpkg-dev (= 1.14.14)
 Conflicts: sysvinit (<< 2.82-1), dpkg-iasearch (<< 0.11), dpkg-static,
  dpkg-dev (<< 1.14.6)
 Replaces: dpkg-doc-ja, dpkg-static, manpages-de (<= 0.4-3),

debian/dpkg-dev.install

@@ -15,7 +15,6 @@ usr/bin/dpkg-scanpackages
 usr/bin/dpkg-scansources
 usr/bin/dpkg-shlibdeps
 usr/bin/dpkg-source
-usr/lib/dpkg/controllib.pl
 usr/lib/dpkg/parsechangelog
 usr/share/locale/*/LC_MESSAGES/dpkg-dev.mo
 usr/share/man/*/*/822-date.1
@@ -64,12 +63,18 @@ usr/share/man/*/*/dpkg-source.1
 usr/share/man/*/dpkg-source.1
 usr/share/perl5/Dpkg/Arch.pm
 usr/share/perl5/Dpkg/BuildOptions.pm
-usr/share/perl5/Dpkg/Source
+usr/share/perl5/Dpkg/Cdata.pm
 usr/share/perl5/Dpkg/Compression.pm
-usr/share/perl5/Dpkg/ErrorHandling.pm
+usr/share/perl5/Dpkg/Control.pm
+usr/share/perl5/Dpkg/Changelog.pm
+usr/share/perl5/Dpkg/Changelog/Debian.pm
 usr/share/perl5/Dpkg/Deps.pm
+usr/share/perl5/Dpkg/ErrorHandling.pm
 usr/share/perl5/Dpkg/Fields.pm
 usr/share/perl5/Dpkg/Path.pm
 usr/share/perl5/Dpkg/Shlibs
 usr/share/perl5/Dpkg/Shlibs.pm
+usr/share/perl5/Dpkg/Source
+usr/share/perl5/Dpkg/Substvars.pm
+usr/share/perl5/Dpkg/Vars.pm
 usr/share/perl5/Dpkg/Version.pm

debian/usertags

@@ -63,6 +63,7 @@ dpkg-distaddfile	[DPKG-DISTADDFILE]
 dpkg-divert		[DPKG-DIVERT]
 dpkg-genchanges		[DPKG-GENCHANGES]
 dpkg-gencontrol		[DPKG-GENCONTROL]
+dpkg-gensymbols		[DPKG-GENCSYMBOLS]
 dpkg-name		[DPKG-NAME]
 dpkg-parsechangelog	[DPKG-PARSECHANGELOG]
 dpkg-query		[DPKG-QUERY]
@@ -101,6 +102,7 @@ usercategory dpkg-program
   + dpkg-divert [tag=dpkg-divert]
   + dpkg-genchanges [tag=dpkg-genchanges]
   + dpkg-gencontrol [tag=dpkg-gencontrol]
+  + dpkg-gensymbols [tag=dpkg-gensymbols]
   + dpkg-name [tag=dpkg-name]
   + dpkg-parsechangelog [tag=dpkg-parsechangelog]
   + dpkg-query [tag=dpkg-query]

man/ChangeLog

@@ -1,3 +1,25 @@
+2008-01-13  Frank Lichtenheld  <djpig@debian.org>
+
+	* dpkg-parsechangelog.1: Document the new
+	command line options.
+
+2008-01-12  Raphael Hertzog  <hertzog@debian.org>
+
+	* dpkg-shlibdeps.1: Fix a typo reported by Helge Kreutzmann.
+	* po/*.po: Likewise to avoid fuzzy strings.
+
+2008-01-12  Helge Kreutzmann  <debian@helgefjell.de>
+
+	* po/de.po: Updated to 1352t0f34u.
+
+2008-01-10  Raphael Hertzog  <hertzog@debian.org>
+
+	* dpkg-source.1: Explain better the first parameter of the -b option.
+
+2008-01-10  Christian Perrier  <bubulle@debian.org>
+
+	* fr.po: Fix typo
+
 2008-01-07  Guillem Jover  <guillem@debian.org>
 
 	* po/dpkg-man.pot: Regenerated.

man/dpkg-parsechangelog.1

@@ -1,4 +1,4 @@
-.TH dpkg\-parsechangelog 1 "2007-03-07" "Debian Project" "dpkg utilities"
+.TH dpkg\-parsechangelog 1 "2008-01-13" "Debian Project" "dpkg utilities"
 .SH NAME
 dpkg\-parsechangelog \- parse Debian changelog files
 .
@@ -25,17 +25,91 @@ from a special line near the bottom of the changelog or failing that
 defaults to the debian standard format.
 .TP
 .BI \-L libdir
-FIXME not used in the source!?
-.TP
-.BI \-v version
-Use changelog information from all versions strictly later than
-.IR version .
+Specify an additional directory to search for parser scripts.
+This directory is searched before the default directories
+which are currently
+.BR /usr/local/lib/dpkg/parsechangelog " and "
+.BR /usr/lib/dpkg/parsechangelog .
 .TP
 .BR \-h ", " \-\-help
 Show the usage message and exit.
 .TP
 .BR \-\-version
 Show the version and exit.
+.SS Parser Options
+The following options can be used to influence the output of
+the changelog parser, e.g. the range of entries or the format
+of the output. They need to supported by the parser script
+in question. See also \fBCAVEATS\fP.
+.TP
+.BI \-\-format " outputformat"
+Set the output format. Currently supported values are
+.IR dpkg " and " rfc822 .
+\fIdpkg\fP is the classic output format (from before this
+option existed) and the default. It consists of one paragraph
+in Debian control format (see \fBdeb-control\fP(5)). If more
+than one entry is requested, most fields are taken from the
+latest entry, except otherwise stated:
+.RS
+.TP
+.BR Source: " <pkg name>"
+.TP
+.BR Version: " <version>"
+.TP
+.BR Distribution: " <target distribution>"
+.TP
+.BR Urgency: " <urgency>"
+The highest urgency of all included entries is used.
+.TP
+.BR Maintainer: " <author>"
+.TP
+.BR Date: " <date>"
+.TP
+.BR Closes: " <bug number>"
+The Closes fields of all included entries are merged.
+.TP
+.BR Changes: " <changelog entries>"
+The text of all changelog entries is concatenated. To make
+this field a valid Debian control format multiline field
+empty lines are replaced with a single full stop and all lines
+is intended by one space character. The exact content depends
+on the changelog format.
+.RE
+.IP
+There might be additional user-defined fields present.
+.IP
+The \fBrfc822\fP format uses the same fields but outputs
+a separate paragraph for each changelog entry so that all
+metadata for each entry is preserved.
+.TP
+.BR \-\-since ", " \-s ", " \-v " \fIversion\fP"
+include all changes later than \fIversion\fP.
+.TP
+.BR \-\-until ", " \-u " \fIversion\fP"
+include all changes earlier than \fIversion\fP.
+.TP
+.BR \-\-from ", " \-f " \fIversion\fP"
+include all changes equal or later than \fIversion\fP.
+.TP
+.BR \-\-to ", " \-t " \fIversion\fP"
+include all changes up to or equal than \fIversion\fP.
+.TP
+.BR \-\-count ", " \-c ", " \-n " \fInumber\fI"
+include \fInumber\fP entries from the top (or the tail
+if \fInumber\fP is lower than 0).
+.TP
+.BR \-\-offset ", " \-o " \fInumber\fP"
+change the starting point for \-\-count, counted from the top
+(or the tail if \fInumber\fP is lower than 0).
+.TP
+.B \-\-all
+include all changes.
+.
+.SH CAVEATS
+All \fBParser Options\fP except for \-v are only supported in
+\fBdpkg\fP, version 1.14.16 and later. Third party parsers for
+changelog formats other than \fIdebian\fP might not support
+all options.
 .
 .SH FILES
 .TP
@@ -49,6 +123,8 @@ number itself.
 Copyright (C) 1995-1996 Ian Jackson
 .br
 Copyright (C) 2000 Wichert Akkerman
+.br
+Copyright (C) 2007, 2008 Frank Lichtenheld
 .sp
 This is free software; see the GNU General Public Licence version 2 or later
 for copying conditions. There is NO WARRANTY.

man/dpkg-shlibdeps.1

@@ -231,7 +231,7 @@ can be obtained by not linking this library to this binary.
 
 Furthermore, in some cases, this will lead to a non-versioned dependency
 on the library that could have been avoided if the binary was only linked
-against the library that it really uses. The exception to this rule is
+against libraries that it really uses. The exception to this rule is
 when several binaries are linked against the same set of libraries but
 each binary only uses a subset of those. You will have warnings on
 individual binaries, but the set of libraries needed at the package level

man/dpkg-source.1

@@ -45,7 +45,8 @@ will inherit its group ownership.
 .RI "\fB\-b\fP " directory " [" orig-directory | orig-targz |\(aq\(aq]
 Build a source package. One or two non-option arguments should
 be supplied. The first is taken as the name of the directory
-containing the unpacked source tree. If a second argument is supplied
+containing the debianized source tree (i.e. with a debian sub-directory
+and maybe changes to the original files). If a second argument is supplied
 it should be the name of the original source directory or tarfile or
 the empty string if the package is a Debian-specific one and so has no
 Debianisation diffs. If no second argument is supplied then

man/po/de.add

@@ -1,6 +1,6 @@
 PO4A-HEADER:mode=after;position=^\.TH;beginboundary=^\.SH "SIEHE AUCH"
 .SH ÜBERSETZUNG
-Die deutsche Übersetzung wurde 2004, 2006, 2007 von Helge Kreutzmann
+Die deutsche Übersetzung wurde 2004, 2006, 2007, 2008 von Helge Kreutzmann
 <debian@helgefjell.de> und 2007 von Florian Rehnisch <eixman@gmx.de> 
 angefertigt. Diese Übersetzung ist Freie Dokumentation; lesen Sie die
 GNU General Public License Version 2 oder neuer für die Kopierbedingungen.

man/po/de.po

@@ -6,7 +6,7 @@ msgid ""
 msgstr ""
 "Project-Id-Version: dpkg man pages\n"
 "POT-Creation-Date: 2008-01-07 11:52+0200\n"
-"PO-Revision-Date: 2007-12-22 00:22+0100\n"
+"PO-Revision-Date: 2008-01-12 18:27+0100\n"
 "Last-Translator: Helge Kreutzmann <debian@helgefjell.de>\n"
 "Language-Team: de <debian-l10n-german@lists.debian.org>\n"
 "MIME-Version: 1.0\n"
@@ -896,7 +896,6 @@ msgstr "B<Depends:> E<lt>PaketlisteE<gt>"
 
 # type: Plain text
 #: ../../man/deb-control.5:115
-#, fuzzy
 msgid ""
 "List of packages that are required for this package to provide a non-trivial "
 "amount of functionality. The package maintenance software will not allow a "
@@ -907,13 +906,16 @@ msgid ""
 "removal, the prerm script of a package is run before those of the packages "
 "listed in its Depends: field."
 msgstr ""
-"Liste von Paketen die benötigt werden, damit dieses Paket eine nicht-"
+"Liste von Paketen, die benötigt werden, damit dieses Paket eine nicht-"
 "triviale Menge an Funktionen anbieten kann. Die Paketverwaltungssoftware "
 "wird es nicht erlauben, dass ein Paket installiert wird, falls die in seinem "
 "B<Depends>-Feld aufgeführten Pakete nicht installiert sind (zumindestens "
-"nicht ohne Verwendung der »Force«-Optionen) und wird das postinst-Skript der "
-"in dem Depends:-Feld aufgeführten Pakete vor denen der Pakete die von diesen "
-"abhängen ausführen, und die prerm-Skripte vorher."
+"nicht ohne Verwendung der »Force«-Optionen). Bei einer Installation werden "
+"Postinst-Skripte von Paketen, die im Feld »Depends:« aufgeführt sind, vor "
+"den Postinst-Skripte der eigentlichen Pakete ausgeführt. Bei der "
+"gegenteiligen Operation, der Paket-Entfernung, wird das Prerm-Skript eines "
+"Paketes vor den Prerm-Skripten der Pakete ausgeführt, die im Feld »Depends:« "
+"aufgeführt sind."
 
 # type: TP
 #: ../../man/deb-control.5:115
@@ -4594,9 +4596,9 @@ msgstr "dpkg-buildpackage"
 
 # type: TH
 #: ../../man/dpkg-buildpackage.1:1
-#, fuzzy, no-wrap
+#, no-wrap
 msgid "2008-01-03"
-msgstr "2007-01-24"
+msgstr "2008-01-03"
 
 # type: Plain text
 #: ../../man/dpkg-buildpackage.1:4
@@ -4736,7 +4738,6 @@ msgstr "B<-j>I<Auftr
 
 # type: Plain text
 #: ../../man/dpkg-buildpackage.1:60
-#, fuzzy
 msgid ""
 "Number of jobs allowed to be run simultaneously, equivalent to the B<make>"
 "(1)  option of the same name. Will add itself to the MAKEFLAGS environment "
@@ -4752,8 +4753,9 @@ msgstr ""
 "folgenden Aufrufe von make diese Option erben werden. Fügt auch "
 "B<parallel=>I<Aufträge> zu der Umgebungsvariablen DEB_BUILD_OPTIONS hinzu, "
 "was es debian/rules-Dateien erlaubt, diese Information für eigene Zwecke zu "
-"verwenden. Falls die Option B<-j> nicht angegeben wird, wird der "
-"existierende Wert für B<parallel> beachtet und zu den MAKEFLAGS hinzugefügt."
+"verwenden. Der Eintrag B<parallel=>I<Aufträge> in der Umgebungsvariablen "
+"DEB_BUILD_OPTIONS überschreibt den Wert von B<-j>, falls diese Option "
+"angegeben ist."
 
 # type: TP
 #: ../../man/dpkg-buildpackage.1:60 ../../man/dpkg-genchanges.1:50
@@ -7473,7 +7475,6 @@ msgstr "debian/*/DEBIAN/symbols"
 
 # type: Plain text
 #: ../../man/dpkg-shlibdeps.1:59
-#, fuzzy
 msgid ""
 "Shared library information generated by the current build process that also "
 "invoked B<dpkg-shlibdeps>.  They are generated by B<dpkg-gensymbols>(1).  "
@@ -7483,7 +7484,9 @@ msgid ""
 msgstr ""
 "Informationen über Laufzeitbibliotheken, die vom aktuellen Bauprozess "
 "erstellt werden, der auch B<dpkg-shlibdeps> aufruft. Sie werden von B<dpkg-"
-"gensymbols>(1) erstellt."
+"gensymbols>(1) erstellt. Sie werden nur verwendet, falls die Bibliothek im "
+"Bau-Baum des Pakets gefunden wird. Die Symbol-Datei im Bau-Baum hat Vorrang "
+"gegenüber Symbol-Dateien aus anderen Binärpaketen."
 
 # type: IP
 #: ../../man/dpkg-shlibdeps.1:59
@@ -7547,6 +7550,11 @@ msgid ""
 "field and use this version if it's higher than the minimal version computed "
 "by scanning symbols."
 msgstr ""
+"Als Sicherheitsmaßnahme kann eine Symbols-Datei ein Meta-Informationsfeld "
+"I<Build-Depends-Package> enthalten. B<dpkg-shlibdeps> extrahiert dann die "
+"minimale Version, die von dem korrespondierenden Paket im Feld Build-Depends "
+"benötigt wird, und verwendet diese Version, falls sie höher ist als die "
+"minimale Version, die beim Durchsuchen der Symbole ermittelt wurde."
 
 # type: SS
 #: ../../man/dpkg-shlibdeps.1:81
@@ -7609,7 +7617,6 @@ msgstr "debian/*/DEBIAN/shlibs"
 
 # type: Plain text
 #: ../../man/dpkg-shlibdeps.1:98
-#, fuzzy
 msgid ""
 "Shared library information generated by the current build process that also "
 "invoked B<dpkg-shlibdeps>.  They are only used if the library is found in a "
@@ -7617,8 +7624,10 @@ msgid ""
 "over shlibs files from other binary packages."
 msgstr ""
 "Informationen über Laufzeitbibliotheken, die vom aktuellen Bauprozess "
-"erstellt werden, der auch B<dpkg-shlibdeps> aufruft. Sie werden von B<dpkg-"
-"gensymbols>(1) erstellt."
+"erstellt werden, der auch B<dpkg-shlibdeps> aufruft. Sie werden nur "
+"verwendet, falls die Bibliothek im Bau-Verzeichnis eines Pakets gefunden "
+"wird. Die Shilbs-Datei in diesem Bau-Verzeichnis hat gegenüber Shlibs-Dateien "
+"von anderen Binärpaketen Vorrang."
 
 # type: IP
 #: ../../man/dpkg-shlibdeps.1:98
@@ -7830,9 +7839,9 @@ msgstr ""
 
 # type: TP
 #: ../../man/dpkg-shlibdeps.1:188
-#, fuzzy, no-wrap
+#, no-wrap
 msgid "B<-S>I<pkgbuilddir>"
-msgstr "B<-P>I<Paketbauverzeichnis>"
+msgstr "B<-S>I<Paketbauverzeichnis>"
 
 # type: Plain text
 #: ../../man/dpkg-shlibdeps.1:195
@@ -7843,6 +7852,12 @@ msgid ""
 "can use this option multiple times: directories will be tried in the same "
 "order before directories of other binary packages."
 msgstr ""
+"Schauen beim Versuch, eine Bibliothek zu finden, zuerst in "
+"I<Paketbauverzeichnis>. Dies ist nützlich, wenn das Quellpaket mehrere "
+"Spielarten der gleichen Bibliothek baut und Sie sicherstellen wollen, dass "
+"Sie die Abhängigkeit aus einem bestimmten Binärpaket erhalten. Sie können "
+"diese Option mehrfach verwenden: Verzeichnisse werden in der gleichen "
+"Reihenfolge vor Verzeichnissen anderer Binärpakete probiert."
 
 # type: TP
 #: ../../man/dpkg-shlibdeps.1:195
@@ -7925,11 +7940,10 @@ msgstr ""
 
 # type: Plain text
 #: ../../man/dpkg-shlibdeps.1:239
-#, fuzzy
 msgid ""
 "Furthermore, in some cases, this will lead to a non-versioned dependency on "
 "the library that could have been avoided if the binary was only linked "
-"against the library that it really uses. The exception to this rule is when "
+"against libraries that it really uses. The exception to this rule is when "
 "several binaries are linked against the same set of libraries but each "
 "binary only uses a subset of those. You will have warnings on individual "
 "binaries, but the set of libraries needed at the package level is the same "
@@ -7937,7 +7951,7 @@ msgid ""
 msgstr ""
 "Desweiteren führt dies in einigen Fällen zu einer unversionierten "
 "Abhängigkeit auf diese Bibliothek, die vermieden werden könnte, falls das "
-"Programm nur gegen Bibliotheken gelint wäre, die es wirklich verwendet. Die "
+"Programm nur gegen Bibliotheken gelinkt wäre, die es wirklich verwendet. Die "
 "Ausnahme dieser Regel liegt dann vor, wenn mehrere Programme gegen den "
 "gleichen Satz an Bibliotheken gelinkt sind, aber jedes Programm nur eine "
 "Teilmenge davon verwendet. Sie werden für die einzelnen Programme "
@@ -7975,7 +7989,6 @@ msgstr "B<konnte Bibliothek >I<SONAME-der-Bibliothek>B< ben
 
 # type: Plain text
 #: ../../man/dpkg-shlibdeps.1:262
-#, fuzzy
 msgid ""
 "The I<binary> uses a library called I<library-soname> but B<dpkg-shlibdeps> "
 "has been unable to find the library.  B<dpkg-shlibdeps> creates a list of "
@@ -7996,13 +8009,14 @@ msgstr ""
 "so.conf aufgeführte Verzeichnisse, in der Umgebungsvariable LD_LIBRARY_PATH "
 "aufgeführte Verzeichnisse und standardmäßige öffentliche Verzeichnisse (/"
 "lib, /usr/lib, /lib32, /usr/lib32, /lib64, /usr/lib64). Dann prüft es "
-"diejenigen Verzeichnisse im Bau-Baum des Pakets, die die DEBIAN/shlibs-Datei "
-"enthalten und schließlich im Wurzelverzeichnis. Falls die Bibliothek nicht "
-"in einem dieser Verzeichnisse gefunden wird, erhalten Sie diesen Fehler."
+"diese Verzeichnisse im Bau-Baum des analysierten Pakets, in den mit der "
+"Kommandozeilenoption -S angegebenen Paketbauverzeichnisse, in anderen "
+"Paketbau-Bäumen, die eine DEBIAN/shlibs- oder DEBIAN/symbols-Datei "
+"enthalten und schließlich im Wurzelverzeichnis. Falls die Bibliothek nicht in "
+"einem dieser Verzeichnisse gefunden wird, erhalten Sie diesen Fehler."
 
 # type: Plain text
 #: ../../man/dpkg-shlibdeps.1:268
-#, fuzzy
 msgid ""
 "If the library not found is in a private directory of the same package, then "
 "you want to add the directory to LD_LIBRARY_PATH. If it's in another binary "
@@ -8010,12 +8024,13 @@ msgid ""
 "this package is already created and that LD_LIBRARY_PATH contains the "
 "appropriate directory if it also is in a private directory."
 msgstr ""
-"Falls sich die Bibliothek in einem privaten Verzeichnis des gleichen Pakets "
-"befindet, müssen Sie das Verzeichnis zu LD_LIBRARY_PATH hinzufügen. Falls "
-"sie sich in einem anderen gerade zu bauenden Paket befindet, müssen Sie "
-"sicherstellen, dass die »shlibs«-Datei dieses Pakets bereits erstellt ist und "
-"dass LD_LIBRARY_PATH das geeignete Verzeichnis enthält, falls die Bibliothek "
-"zudem in einem privaten Verzeichnis liegt."
+"Falls sich die nicht-gefundene Bibliothek in einem privaten Verzeichnis des "
+"gleichen Pakets befindet, müssen Sie das Verzeichnis zu LD_LIBRARY_PATH "
+"hinzufügen. Falls sie sich in einem anderen gerade zu bauenden Paket "
+"befindet, müssen Sie sicherstellen, dass die »shlibs/symbols«-Datei dieses "
+"Pakets bereits erstellt ist und dass LD_LIBRARY_PATH das geeignete "
+"Verzeichnis enthält, falls die Bibliothek zudem in einem privaten Verzeichnis "
+"liegt."
 
 # type: TP
 #: ../../man/dpkg-shlibdeps.1:268
@@ -9773,7 +9788,7 @@ msgstr ""
 #: ../../man/dselect.1:180
 #, no-wrap
 msgid "install"
-msgstr ""
+msgstr "Installieren"
 
 # type: Plain text
 #: ../../man/dselect.1:182
@@ -9789,6 +9804,12 @@ msgid ""
 "before installation, or fetched when needed.  Some access methods may also "
 "remove packages that were marked for removal."
 msgstr ""
+"Die konfigurierte Zugriffsmethode wird installierbare oder für ein Upgrade "
+"verfügbare Pakete aus den relevanten Depots holen und dann mittels B<dpkg> "
+"installieren. Abhängig von der Implementation der Zugriffsmethode können "
+"alle Pakete vor der Installation bereits geholt werden, oder bei Bedarf "
+"geholt werden. Bei einigen Zugriffsmethoden werden auch Pakete entfernt, die "
+"zur Entfernung markiert wurden."
 
 # type: Plain text
 #: ../../man/dselect.1:196

man/po/es.po

@@ -7843,7 +7843,7 @@ msgstr ""
 msgid ""
 "Furthermore, in some cases, this will lead to a non-versioned dependency on "
 "the library that could have been avoided if the binary was only linked "
-"against the library that it really uses. The exception to this rule is when "
+"against libraries that it really uses. The exception to this rule is when "
 "several binaries are linked against the same set of libraries but each "
 "binary only uses a subset of those. You will have warnings on individual "
 "binaries, but the set of libraries needed at the package level is the same "

man/po/fr.po

@@ -1748,7 +1748,7 @@ msgstr ""
 #: ../../man/deb-substvars.5:52
 #, no-wrap
 msgid "B<source:Version>"
-msgstr "B<Source:Version>"
+msgstr "B<source:Version>"
 
 # type: Plain text
 #: ../../man/deb-substvars.5:55
@@ -7823,7 +7823,7 @@ msgstr ""
 msgid ""
 "Furthermore, in some cases, this will lead to a non-versioned dependency on "
 "the library that could have been avoided if the binary was only linked "
-"against the library that it really uses. The exception to this rule is when "
+"against libraries that it really uses. The exception to this rule is when "
 "several binaries are linked against the same set of libraries but each "
 "binary only uses a subset of those. You will have warnings on individual "
 "binaries, but the set of libraries needed at the package level is the same "

man/po/hu.po

@@ -6685,7 +6685,7 @@ msgstr ""
 msgid ""
 "Furthermore, in some cases, this will lead to a non-versioned dependency on "
 "the library that could have been avoided if the binary was only linked "
-"against the library that it really uses. The exception to this rule is when "
+"against libraries that it really uses. The exception to this rule is when "
 "several binaries are linked against the same set of libraries but each "
 "binary only uses a subset of those. You will have warnings on individual "
 "binaries, but the set of libraries needed at the package level is the same "

man/po/ja.po

@@ -7314,7 +7314,7 @@ msgstr ""
 msgid ""
 "Furthermore, in some cases, this will lead to a non-versioned dependency on "
 "the library that could have been avoided if the binary was only linked "
-"against the library that it really uses. The exception to this rule is when "
+"against libraries that it really uses. The exception to this rule is when "
 "several binaries are linked against the same set of libraries but each "
 "binary only uses a subset of those. You will have warnings on individual "
 "binaries, but the set of libraries needed at the package level is the same "

man/po/pl.po

@@ -7851,7 +7851,7 @@ msgstr ""
 msgid ""
 "Furthermore, in some cases, this will lead to a non-versioned dependency on "
 "the library that could have been avoided if the binary was only linked "
-"against the library that it really uses. The exception to this rule is when "
+"against libraries that it really uses. The exception to this rule is when "
 "several binaries are linked against the same set of libraries but each "
 "binary only uses a subset of those. You will have warnings on individual "
 "binaries, but the set of libraries needed at the package level is the same "

man/po/pt_BR.po

@@ -6840,7 +6840,7 @@ msgstr ""
 msgid ""
 "Furthermore, in some cases, this will lead to a non-versioned dependency on "
 "the library that could have been avoided if the binary was only linked "
-"against the library that it really uses. The exception to this rule is when "
+"against libraries that it really uses. The exception to this rule is when "
 "several binaries are linked against the same set of libraries but each "
 "binary only uses a subset of those. You will have warnings on individual "
 "binaries, but the set of libraries needed at the package level is the same "

man/po/ru.po

@@ -6971,7 +6971,7 @@ msgstr ""
 msgid ""
 "Furthermore, in some cases, this will lead to a non-versioned dependency on "
 "the library that could have been avoided if the binary was only linked "
-"against the library that it really uses. The exception to this rule is when "
+"against libraries that it really uses. The exception to this rule is when "
 "several binaries are linked against the same set of libraries but each "
 "binary only uses a subset of those. You will have warnings on individual "
 "binaries, but the set of libraries needed at the package level is the same "

man/po/sv.po

@@ -7740,7 +7740,7 @@ msgstr ""
 msgid ""
 "Furthermore, in some cases, this will lead to a non-versioned dependency on "
 "the library that could have been avoided if the binary was only linked "
-"against the library that it really uses. The exception to this rule is when "
+"against libraries that it really uses. The exception to this rule is when "
 "several binaries are linked against the same set of libraries but each "
 "binary only uses a subset of those. You will have warnings on individual "
 "binaries, but the set of libraries needed at the package level is the same "

po/ChangeLog

@@ -1,3 +1,11 @@
+2008-01-14  Yuri Kozlov  <kozlov.y@gmail.com>
+
+	* ru.po: Updated to 928t.
+
+2008-01-12  Jacobo Tarrio  <jtarrio@debian.org>
+
+	* gl.po: Updated to 928f.
+
 2008-01-07  Christian Perrier  <bubulle@debian.org>
 
 	* de.po, eu.po, fr.po, nb.po, sv.po, vi.po, zh_CN.po:

po/gl.po

@@ -8,7 +8,7 @@ msgstr ""
 "Project-Id-Version: dpkg\n"
 "Report-Msgid-Bugs-To: debian-dpkg@lists.debian.org\n"
 "POT-Creation-Date: 2008-01-07 11:55+0200\n"
-"PO-Revision-Date: 2007-10-14 14:29+0100\n"
+"PO-Revision-Date: 2008-01-12 12:25+0000\n"
 "Last-Translator: Jacobo Tarrío <jtarrio@debian.org>\n"
 "Language-Team: Galician <proxecto@trasno.net>\n"
 "MIME-Version: 1.0\n"
@@ -3892,9 +3892,9 @@ msgid "failed to exec rm -rf"
 msgstr "non se puido executar rm -rf"
 
 #: dpkg-deb/info.c:99
-#, fuzzy, c-format
+#, c-format
 msgid "realloc failed (%zu bytes)"
-msgstr "a chamada a realloc fallou (%ld bytes)"
+msgstr "a chamada a realloc fallou (%zu bytes)"
 
 #: dpkg-deb/info.c:108
 msgid "info_spew"
@@ -5368,13 +5368,13 @@ msgid "Current `best' version is %s."
 msgstr "A versión \"mellor\" actual é %s."
 
 #: scripts/update-alternatives.pl:232
-#, fuzzy, perl-format
+#, perl-format
 msgid ""
 "warning: %s is supposed to be a symlink to %s, \n"
 "or nonexistent; however, readlink failed: %s"
 msgstr ""
-"aviso: suponse que %s é unha ligazón simbólica a %s\n"
-"  (ou que non existe); nembargantes, non se puido ler a ligazón: %s"
+"aviso: suponse que %s é unha ligazón simbólica a %s, \n"
+"ou que non existe; nembargantes, non se puido ler a ligazón: %s"
 
 #: scripts/update-alternatives.pl:244
 #, perl-format
@@ -5387,7 +5387,7 @@ msgid "Updating %s (%s) to point to %s."
 msgstr "A actualizar %s (%s) para que apunte a %s."
 
 #: scripts/update-alternatives.pl:256
-#, fuzzy, perl-format
+#, perl-format
 msgid "Using '%s' to provide '%s'."
 msgstr "A empregar \"%s\" para fornecer \"%s\"."
 

po/ru.po

@@ -3,13 +3,13 @@
 # Copyright (C) 1999 Michael Sobolev
 #
 # Michael Sobolev <mss@transas.com>, 1999.
-# Yuri Kozlov <kozlov.y@gmail.com>, 2004, 2005, 2006, 2007.
+# Yuri Kozlov <kozlov.y@gmail.com>, 2004, 2005, 2006, 2007, 2008.
 msgid ""
 msgstr ""
-"Project-Id-Version: 1.14.7\n"
+"Project-Id-Version: 1.14.15\n"
 "Report-Msgid-Bugs-To: debian-dpkg@lists.debian.org\n"
 "POT-Creation-Date: 2008-01-07 11:55+0200\n"
-"PO-Revision-Date: 2007-10-11 21:01+0400\n"
+"PO-Revision-Date: 2008-01-14 21:05+0300\n"
 "Last-Translator: Yuri Kozlov <kozlov.y@gmail.com>\n"
 "Language-Team: Russian <debian-l10n-russian@lists.debian.org>\n"
 "MIME-Version: 1.0\n"
@@ -3942,9 +3942,9 @@ msgid "failed to exec rm -rf"
 msgstr "не удалось выполнить команду rm -rf"
 
 #: dpkg-deb/info.c:99
-#, fuzzy, c-format
+#, c-format
 msgid "realloc failed (%zu bytes)"
-msgstr "функции realloc не удалось выделить %ld байт(а) памяти"
+msgstr "отказ функции realloc (%zu байт)"
 
 #: dpkg-deb/info.c:108
 msgid "info_spew"
@@ -5425,13 +5425,13 @@ msgid "Current `best' version is %s."
 msgstr "Текущая `лучшая' версия: %s."
 
 #: scripts/update-alternatives.pl:232
-#, fuzzy, perl-format
+#, perl-format
 msgid ""
 "warning: %s is supposed to be a symlink to %s, \n"
 "or nonexistent; however, readlink failed: %s"
 msgstr ""
-"предупреждение: %s предположительно является символической ссылкой на %s\n"
-" (или на не существующую); однако, readlink завершился неудачно: %s"
+"предупреждение: предполагалось, что %s является символической ссылкой на %s\n"
+"или не существует; однако, функция readlink завершилась неудачно: %s"
 
 #: scripts/update-alternatives.pl:244
 #, perl-format
@@ -5444,7 +5444,7 @@ msgid "Updating %s (%s) to point to %s."
 msgstr "Обновляется %s (%s), указывающая на %s."
 
 #: scripts/update-alternatives.pl:256
-#, fuzzy, perl-format
+#, perl-format
 msgid "Using '%s' to provide '%s'."
 msgstr "Используется `%s' для предоставления `%s'."
 
@@ -5684,14 +5684,3 @@ msgstr "не удалось установить %s как %s: %s"
 #, perl-format
 msgid "Serious problem: %s"
 msgstr "Серьёзная проблема: %s"
-
-#~ msgid "unable to ensure %s nonexistent: %s"
-#~ msgstr "не удалось убедиться в не существовании %s: %s"
-
-#~ msgid ""
-#~ "warning: %s is supposed to be a slave symlink to\n"
-#~ " %s, or nonexistent; however, readlink failed: %s"
-#~ msgstr ""
-#~ "предупреждение: %s предположительно является подчинённой символической\n"
-#~ "ссылкой на %s, или на несуществующую; однако, readlink завершилась "
-#~ "неудачно: %s"

scripts/Dpkg/Cdata.pm

@@ -0,0 +1,124 @@
+# Copyright 2007 Raphaël Hertzog <hertzog@debian.org>
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+package Dpkg::Cdata;
+
+use strict;
+use warnings;
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling qw(syntaxerr);
+use Dpkg::Fields;
+
+use Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(parsecdata);
+
+=head1 NAME
+
+Dpkg::Cdata - parse and manipulate a block of RFC822-like fields
+
+=head1 DESCRIPTION
+
+The Dpkg::Cdata module exports one function 'parsecdata' that reads a
+block of data (usually a block following the debian/control format)
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item $obj = Dpkg::Cdata::parsecdata($input, $file, %options)
+
+$input is a filehandle, $file is the name of the file corresponding to
+$input. %options can contain two parameters: allow_pgp=>1 allows the parser
+to extrac the block of a data in a PGP-signed message (defaults to 0),
+and allow_duplicate=>1 ask the parser to not fail when it detects
+duplicate fields.
+
+The return value is a reference to a tied hash (Dpkg::Fields::Object) that
+can be used to access the various fields.
+
+=cut
+sub parsecdata {
+    my ($input, $file, %options) = @_;
+
+    $options{allow_pgp} = 0 unless exists $options{allow_pgp};
+    $options{allow_duplicate} = 0 unless exists $options{allow_duplicate};
+
+    my $paraborder = 1;
+    my $fields = undef;
+    my $cf = ''; # Current field
+    my $expect_pgp_sig = 0;
+    while (<$input>) {
+	s/\s*\n$//;
+	next if (m/^$/ and $paraborder);
+	next if (m/^#/);
+	$paraborder = 0;
+	if (m/^(\S+?)\s*:\s*(.*)$/) {
+	    unless (defined $fields) {
+		my %f;
+		tie %f, "Dpkg::Fields::Object";
+		$fields = \%f;
+	    }
+	    if (exists $fields->{$1}) {
+		unless ($options{allow_duplicate}) {
+		    syntaxerr($file, sprintf(_g("duplicate field %s found"), capit($1)));
+		}
+	    }
+	    $fields->{$1} = $2;
+	    $cf = $1;
+	} elsif (m/^\s+\S/) {
+	    length($cf) || syntaxerr($file, _g("continued value line not in field"));
+	    $fields->{$cf} .= "\n$_";
+	} elsif (m/^-----BEGIN PGP SIGNED MESSAGE/) {
+	    $expect_pgp_sig = 1;
+	    if ($options{allow_pgp}) {
+		# Skip PGP headers
+		while (<$input>) {
+		    last if m/^$/;
+		}
+	    } else {
+		syntaxerr($file, _g("PGP signature not allowed here"));
+	    }
+	} elsif (m/^$/) {
+	    if ($expect_pgp_sig) {
+		# Skip empty lines
+		$_ = <$input> while defined($_) && $_ =~ /^\s*$/;
+		length($_) ||
+                    syntaxerr($file, _g("expected PGP signature, found EOF after blank line"));
+		s/\n$//;
+		m/^-----BEGIN PGP SIGNATURE/ ||
+		    syntaxerr($file,
+			sprintf(_g("expected PGP signature, found something else \`%s'"), $_));
+		# Skip PGP signature
+		while (<$input>) {
+		    last if m/^-----END PGP SIGNATURE/;
+		}
+		length($_) ||
+                    syntaxerr($file, _g("unfinished PGP signature"));
+	    }
+	    last; # Finished parsing one block
+	} else {
+	    syntaxerr($file, _g("line with unknown format (not field-colon-value)"));
+	}
+    }
+    return $fields;
+}
+
+=back
+
+=cut
+1;

scripts/Dpkg/Changelog.pm

@@ -0,0 +1,773 @@
+#
+# Dpkg::Changelog
+#
+# Copyright © 2005, 2007 Frank Lichtenheld <frank@lichtenheld.de>
+#
+#    This program is free software; you can redistribute it and/or modify
+#    it under the terms of the GNU General Public License as published by
+#    the Free Software Foundation; either version 2 of the License, or
+#    (at your option) any later version.
+#
+#    This program is distributed in the hope that it will be useful,
+#    but WITHOUT ANY WARRANTY; without even the implied warranty of
+#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#    GNU General Public License for more details.
+#
+#    You should have received a copy of the GNU General Public License
+#    along with this program; if not, write to the Free Software
+#    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
+#
+
+=head1 NAME
+
+Dpkg::Changelog
+
+=head1 DESCRIPTION
+
+to be written
+
+=head2 Functions
+
+=cut
+
+package Dpkg::Changelog;
+
+use strict;
+use warnings;
+
+use English;
+
+use Dpkg;
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling qw(warning report syserr subprocerr);
+use Dpkg::Cdata;
+use Dpkg::Fields;
+
+use base qw(Exporter);
+
+our %EXPORT_TAGS = ( 'util' => [ qw(
+                find_closes
+                data2rfc822
+                data2rfc822_mult
+                get_dpkg_changes
+		parse_changelog
+) ] );
+our @EXPORT_OK = @{$EXPORT_TAGS{util}};
+
+=pod
+
+=head3 init
+
+Creates a new object instance. Takes a reference to a hash as
+optional argument, which is interpreted as configuration options.
+There are currently no supported general configuration options, but
+see the other methods for more specific configuration options which
+can also specified to C<init>.
+
+If C<infile> or C<instring> are specified (see L<parse>), C<parse()>
+is called from C<init>. If a fatal error is encountered during parsing
+(e.g. the file can't be opened), C<init> will not return a
+valid object but C<undef>!
+
+=cut
+
+sub init {
+    my $classname = shift;
+    my $config = shift || {};
+    my $self = {};
+    bless( $self, $classname );
+
+    $config->{verbose} = 1 if $config->{debug};
+    $self->{config} = $config;
+
+    $self->reset_parse_errors;
+
+    if ($self->{config}{infile} || $self->{config}{instring}) {
+	defined($self->parse) or return undef;
+    }
+
+    return $self;
+}
+
+=pod
+
+=head3 reset_parse_errors
+
+Can be used to delete all information about errors ocurred during
+previous L<parse> runs. Note that C<parse()> also calls this method.
+
+=cut
+
+sub reset_parse_errors {
+    my ($self) = @_;
+
+    $self->{errors}{parser} = [];
+}
+
+sub _do_parse_error {
+    my ($self, $file, $line_nr, $error, $line) = @_;
+    shift;
+
+    push @{$self->{errors}{parser}}, [ @_ ];
+
+    unless ($self->{config}{quiet}) {
+	if ($line) {
+	    warning("%20s(l$NR): $error\nLINE: $line", $file);
+	} else {
+	    warning("%20s(l$NR): $error", $file);
+	}
+    }
+}
+
+=pod
+
+=head3 get_parse_errors
+
+Returns all error messages from the last L<parse> run.
+If called in scalar context returns a human readable
+string representation. If called in list context returns
+an array of arrays. Each of these arrays contains
+
+=over 4
+
+=item 1.
+
+the filename of the parsed file or C<String> if a string was
+parsed directly
+
+=item 2.
+
+the line number where the error occurred
+
+=item 3.
+
+an error description
+
+=item 4.
+
+the original line
+
+=back
+
+NOTE: This format isn't stable yet and may change in later versions
+of this module.
+
+=cut
+
+sub get_parse_errors {
+    my ($self) = @_;
+
+    if (wantarray) {
+	return @{$self->{errors}{parser}};
+    } else {
+	my $res = "";
+	foreach my $e (@{$self->{errors}{parser}}) {
+	    if ($e->[3]) {
+		$res .= report(_g('warning'),_g("%s(l%s): %s\nLINE: %s"), @$e );
+	    } else {
+		$res .= report(_g('warning'),_g("%s(l%s): %s"), @$e );
+	    }
+	}
+	return $res;
+    }
+}
+
+sub _do_fatal_error {
+    my ($self, $msg, @msg) = @_;
+
+    $self->{errors}{fatal} = report(_g('fatal error'), $msg, @msg);
+    warning($msg, @msg) unless $self->{config}{quiet};
+}
+
+=pod
+
+=head3 get_error
+
+Get the last non-parser error (e.g. the file to parse couldn't be opened).
+
+=cut
+
+sub get_error {
+    my ($self) = @_;
+
+    return $self->{errors}{fatal};
+}
+
+=pod
+
+=head3 data
+
+C<data> returns an array (if called in list context) or a reference
+to an array of Dpkg::Changelog::Entry objects which each
+represent one entry of the changelog.
+
+This method supports the common output options described in
+section L<"COMMON OUTPUT OPTIONS">.
+
+=cut
+
+sub data {
+    my ($self, $config) = @_;
+
+    my $data = $self->{data};
+    if ($config) {
+	$self->{config}{DATA} = $config if $config;
+	$data = $self->_data_range( $config ) or return undef;
+    }
+    return @$data if wantarray;
+    return $data;
+}
+
+sub __sanity_check_range {
+    my ( $data, $from, $to, $since, $until, $start, $end ) = @_;
+
+    if (($$start || $$end) && ($$from || $$since || $$to || $$until)) {
+	warning(_g( "you can't combine 'count' or 'offset' with any other range option" ));
+	$$from = $$since = $$to = $$until = '';
+    }
+    if ($$from && $$since) {
+	warning(_g( "you can only specify one of 'from' and 'since', using 'since'" ));
+	$$from = '';
+    }
+    if ($$to && $$until) {
+	warning(_g( "you can only specify one of 'to' and 'until', using 'until'" ));
+	$$to = '';
+    }
+    if ($$since && ($data->[0]{Version} eq $$since)) {
+	warning(_g( "'since' option specifies most recent version, ignoring" ));
+	$$since = '';
+    }
+    if ($$until && ($data->[$#{$data}]{Version} eq $$until)) {
+	warning(_g( "'until' option specifies oldest version, ignoring" ));
+	$$until = '';
+    }
+    $$start = 0 if $$start < 0;
+    return if $$start > $#$data;
+    $$end = $#$data if $$end > $#$data;
+    return if $$end < 0;
+    $$end = $$start if $$end < $$start;
+    #TODO: compare versions
+    return 1;
+}
+
+sub _data_range {
+    my ($self, $config) = @_;
+
+    my $data = $self->data or return undef;
+
+    return [ @$data ] if $config->{all};
+
+    my $since = $config->{since} || '';
+    my $until = $config->{until} || '';
+    my $from = $config->{from} || '';
+    my $to = $config->{to} || '';
+    my $count = $config->{count} || 0;
+    my $offset = $config->{offset} || 0;
+
+    return if $offset and not $count;
+    if ($offset > 0) {
+	$offset -= ($count < 0);
+    } elsif ($offset < 0) {
+	$offset = $#$data + ($count > 0) + $offset;
+    } else {
+	$offset = $#$data if $count < 0;
+    }
+    my $start = my $end = $offset;
+    $start += $count+1 if $count < 0;
+    $end += $count-1 if $count > 0;
+
+    return unless __sanity_check_range( $data, \$from, \$to,
+					\$since, \$until,
+					\$start, \$end );
+
+
+    unless ($from or $to or $since or $until or $start or $end) {
+	return [ @$data ] if $config->{default_all} and not $count;
+	return [ $data->[0] ];
+    }
+
+    return [ @{$data}[$start .. $end] ] if $start or $end;
+
+    my @result;
+
+    my $include = 1;
+    $include = 0 if $to or $until;
+    foreach (@$data) {
+	my $v = $_->{Version};
+	$include = 1 if $v eq $to;
+	last if $v eq $since;
+
+	push @result, $_ if $include;
+
+	$include = 1 if $v eq $until;
+	last if $v eq $from;
+    }
+
+    return \@result;
+}
+
+sub _abort_early {
+    my ($self) = @_;
+
+    my $data = $self->data or return;
+    my $config = $self->{config} or return;
+
+#    use Data::Dumper;
+#    warn "Abort early? (\$# = $#$data)\n".Dumper($config);
+
+    return if $config->{all};
+
+    my $since = $config->{since} || '';
+    my $until = $config->{until} || '';
+    my $from = $config->{from} || '';
+    my $to = $config->{to} || '';
+    my $count = $config->{count} || 0;
+    my $offset = $config->{offset} || 0;
+
+    return if $offset and not $count;
+    return if $offset < 0 or $count < 0;
+    if ($offset > 0) {
+	$offset -= ($count < 0);
+    }
+    my $start = my $end = $offset;
+    $end += $count-1 if $count > 0;
+
+    unless ($from or $to or $since or $until or $start or $end) {
+	return if not $count;
+	return 1 if @$data;
+    }
+
+    return 1 if ($start or $end)
+	and $start < @$data and $end < @$data;
+
+    return unless $since or $from;
+    foreach (@$data) {
+	my $v = $_->{Version};
+
+	return 1 if $v eq $since;
+	return 1 if $v eq $from;
+    }
+
+    return;
+}
+
+=pod
+
+=head3 dpkg
+
+(and B<dpkg_str>)
+
+C<dpkg> returns a hash (in list context) or a hash reference
+(in scalar context) where the keys are field names and the values are
+field values. The following fields are given:
+
+=over 4
+
+=item Source
+
+package name (in the first entry)
+
+=item Version
+
+packages' version (from first entry)
+
+=item Distribution
+
+target distribution (from first entry)
+
+=item Urgency
+
+urgency (highest of all printed entries)
+
+=item Maintainer
+
+person that created the (first) entry
+
+=item Date
+
+date of the (first) entry
+
+=item Closes
+
+bugs closed by the entry/entries, sorted by bug number
+
+=item Changes
+
+content of the the entry/entries
+
+=back
+
+C<dpkg_str> returns a stringified version of this hash. The fields are
+ordered like in the list above.
+
+Both methods support the common output options described in
+section L<"COMMON OUTPUT OPTIONS">.
+
+=head3 dpkg_str
+
+See L<dpkg>.
+
+=cut
+
+our ( @CHANGELOG_FIELDS, %CHANGELOG_FIELDS );
+our ( @URGENCIES, %URGENCIES );
+BEGIN {
+    @CHANGELOG_FIELDS = qw(Source Version Distribution
+                           Urgency Maintainer Date Closes Changes
+                           Timestamp Header Items Trailer
+                           Urgency_comment Urgency_lc);
+    tie %CHANGELOG_FIELDS, 'Dpkg::Fields::Object';
+    %CHANGELOG_FIELDS = map { $_ => 1 } @CHANGELOG_FIELDS;
+    @URGENCIES = qw(low medium high critical emergency);
+    my $i = 1;
+    %URGENCIES = map { $_ => $i++ } @URGENCIES;
+}
+
+sub dpkg {
+    my ($self, $config) = @_;
+
+    $self->{config}{DPKG} = $config if $config;
+
+    $config = $self->{config}{DPKG} || {};
+    my $data = $self->_data_range( $config ) or return undef;
+
+    my $f = new Dpkg::Changelog::Entry;
+    foreach my $field (qw( Urgency Source Version
+			   Distribution Maintainer Date )) {
+	$f->{$field} = $data->[0]{$field};
+    }
+    # handle unknown fields
+    foreach my $field (keys %{$data->[0]}) {
+	next if $CHANGELOG_FIELDS{$field};
+	$f->{$field} = $data->[0]{$field};
+    }
+
+    $f->{Changes} = get_dpkg_changes( $data->[0] );
+    $f->{Closes} = [ @{$data->[0]{Closes}} ];
+
+    my $first = 1; my $urg_comment = '';
+    foreach my $entry (@$data) {
+	$first = 0, next if $first;
+
+	my $oldurg = $f->{Urgency} || '';
+	my $oldurgn = $URGENCIES{$f->{Urgency}} || -1;
+	my $newurg = $entry->{Urgency_lc} || '';
+	my $newurgn = $URGENCIES{$entry->{Urgency_lc}} || -1;
+	$f->{Urgency} = ($newurgn > $oldurgn) ? $newurg : $oldurg;
+	$urg_comment .= $entry->{Urgency_comment};
+
+	$f->{Changes} .= "\n .".get_dpkg_changes( $entry );
+	push @{$f->{Closes}}, @{$entry->{Closes}};
+
+	# handle unknown fields
+	foreach my $field (keys %$entry) {
+	    next if $CHANGELOG_FIELDS{$field};
+	    next if exists $f->{$field};
+	    $f->{$field} = $entry->{$field};
+	}
+    }
+
+    $f->{Closes} = join " ", sort { $a <=> $b } @{$f->{Closes}};
+    $f->{Urgency} .= $urg_comment;
+
+    return %$f if wantarray;
+    return $f;
+}
+
+sub dpkg_str {
+    return data2rfc822(scalar dpkg(@_));
+}
+
+=pod
+
+=head3 rfc822
+
+(and B<rfc822_str>)
+
+C<rfc822> returns an array of hashes (in list context) or a reference
+to this array (in scalar context) where each hash represents one entry
+in the changelog. For the format of such a hash see the description
+of the L<"dpkg"> method (while ignoring the remarks about which
+values are taken from the first entry).
+
+C<rfc822_str> returns a stringified version of this array.
+
+Both methods support the common output options described in
+section L<"COMMON OUTPUT OPTIONS">.
+
+=head3 rfc822_str
+
+See L<rfc822>.
+
+=cut
+
+sub rfc822 {
+    my ($self, $config) = @_;
+
+    $self->{config}{RFC822} = $config if $config;
+
+    $config = $self->{config}{RFC822} || {};
+    my $data = $self->_data_range( $config ) or return undef;
+    my @out_data;
+
+    foreach my $entry (@$data) {
+	my $f = new Dpkg::Changelog::Entry;
+	foreach my $field (qw( Urgency Source Version
+			       Distribution Maintainer Date )) {
+	    $f->{$field} = $entry->{$field};
+	}
+
+	$f->{Urgency} .= $entry->{Urgency_Comment};
+	$f->{Changes} = get_dpkg_changes( $entry );
+	$f->{Closes} = join " ", sort { $a <=> $b } @{$entry->{Closes}};
+
+	# handle unknown fields
+	foreach my $field (keys %$entry) {
+	    next if $CHANGELOG_FIELDS{$field};
+	    $f->{$field} = $entry->{$field};
+	}
+
+	push @out_data, $f;
+    }
+
+    return @out_data if wantarray;
+    return \@out_data;
+}
+
+sub rfc822_str {
+    return data2rfc822(scalar rfc822(@_));
+}
+
+=pod
+
+=head1 COMMON OUTPUT OPTIONS
+
+The following options are supported by all output methods,
+all take a version number as value:
+
+=over 4
+
+=item since
+
+Causes changelog information from all versions strictly
+later than B<version> to be used.
+
+=item until
+
+Causes changelog information from all versions strictly
+earlier than B<version> to be used.
+
+=item from
+
+Similar to C<since> but also includes the information for the
+specified B<version> itself.
+
+=item to
+
+Similar to C<until> but also includes the information for the
+specified B<version> itself.
+
+=back
+
+The following options also supported by all output methods but
+don't take version numbers as values:
+
+=over 4
+
+=item all
+
+If set to a true value, all entries of the changelog are returned,
+this overrides all other options.
+
+=item count
+
+Expects a signed integer as value. Returns C<value> entries from the
+top of the changelog if set to a positive integer, and C<abs(value)>
+entries from the tail if set to a negative integer.
+
+=item offset
+
+Expects a signed integer as value. Changes the starting point for
+C<count>, either counted from the top (positive integer) or from
+the tail (negative integer). C<offset> has no effect if C<count>
+wasn't given as well.
+
+=back
+
+Some examples for the above options. Imagine an example changelog with
+entries for the versions 1.2, 1.3, 2.0, 2.1, 2.2, 3.0 and 3.1.
+
+            Call                               Included entries
+ C<E<lt>formatE<gt>({ since =E<gt> '2.0' })>  3.1, 3.0, 2.2
+ C<E<lt>formatE<gt>({ until =E<gt> '2.0' })>  1.3, 1.2
+ C<E<lt>formatE<gt>({ from =E<gt> '2.0' })>   3.1, 3.0, 2.2, 2.1, 2.0
+ C<E<lt>formatE<gt>({ to =E<gt> '2.0' })>     2.0, 1.3, 1.2
+ C<E<lt>formatE<gt>({ count =E<gt> 2 }>>      3.1, 3.0
+ C<E<lt>formatE<gt>({ count =E<gt> -2 }>>     1.3, 1.2
+ C<E<lt>formatE<gt>({ count =E<gt> 3,
+		      offset=E<gt> 2 }>>      2.2, 2.1, 2.0
+ C<E<lt>formatE<gt>({ count =E<gt> 2,
+		      offset=E<gt> -3 }>>     2.0, 1.3
+ C<E<lt>formatE<gt>({ count =E<gt> -2,
+		      offset=E<gt> 3 }>>      3.0, 2.2
+ C<E<lt>formatE<gt>({ count =E<gt> -2,
+		      offset=E<gt> -3 }>>     2.2, 2.1
+
+Any combination of one option of C<since> and C<from> and one of
+C<until> and C<to> returns the intersection of the two results
+with only one of the options specified.
+
+=head1 UTILITY FUNCTIONS
+
+=head3 find_closes
+
+Takes one string as argument and finds "Closes: #123456, #654321" statements
+as supported by the Debian Archive software in it. Returns all closed bug
+numbers in an array reference.
+
+=cut
+
+sub find_closes {
+    my $changes = shift;
+    my @closes = ();
+
+    while ($changes &&
+	   ($changes =~ /closes:\s*(?:bug)?\#?\s?\d+(?:,\s*(?:bug)?\#?\s?\d+)*/ig)) {
+	push(@closes, $& =~ /\#?\s?(\d+)/g);
+    }
+
+    @closes = sort { $a <=> $b } @closes;
+    return \@closes;
+}
+
+=pod
+
+=head3 data2rfc822
+
+Takes a single argument, either a Dpkg::Changelog::Entry object
+or a reference to an array of such objects.
+
+Returns the data in RFC822 format as string.
+
+=cut
+
+sub data2rfc822 {
+    my ($data) = @_;
+
+    if (ref($data) eq "ARRAY") {
+	my @rfc822 = ();
+
+	foreach my $entry (@$data) {
+	    push @rfc822, data2rfc822($entry);
+	}
+
+	return join "\n", @rfc822;
+    } else {
+	my $rfc822_str = $data->output;
+
+	return $rfc822_str;
+    }
+}
+
+=pod
+
+=head3 get_dpkg_changes
+
+Takes a Dpkg::Changelog::Entry object as first argument.
+
+Returns a string that is suitable for using it in a C<Changes> field
+in the output format of C<dpkg-parsechangelog>.
+
+=cut
+
+sub get_dpkg_changes {
+    my $changes = "\n ".($_[0]->{Header}||'')."\n .\n".($_[0]->{Changes}||'');
+    chomp $changes;
+    $changes =~ s/^ $/ ./mgo;
+    return $changes;
+}
+
+=pod
+
+=head3 parse_changelog($file, $format, $since)
+
+Calls "dpkg-parsechangelog -l$file -F$format -v$since"  and returns a
+Dpkg::Fields::Object with the values output by the program.
+
+=cut
+sub parse_changelog {
+    my ($changelogfile, $changelogformat, $since) = @_;
+
+    my @exec = ('dpkg-parsechangelog');
+    push(@exec, "-l$changelogfile");
+    push(@exec, "-F$changelogformat") if defined($changelogformat);
+    push(@exec, "-v$since") if defined($since);
+
+    open(PARSECH, "-|", @exec) || syserr(_g("fork for parse changelog"));
+    my $fields = parsecdata(\*PARSECH, _g("parsed version of changelog"));
+    close(PARSECH) || subprocerr(_g("parse changelog"));
+    return $fields;
+}
+
+=head1 NAME
+
+Dpkg::Changelog::Entry - represents one entry in a Debian changelog
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=cut
+
+package Dpkg::Changelog::Entry;
+
+sub new {
+    my ($classname) = @_;
+
+    tie my %entry, 'Dpkg::Fields::Object';
+    tied(%entry)->set_field_importance(@CHANGELOG_FIELDS);
+    my $entry = \%entry;
+    bless $entry, $classname;
+}
+
+sub is_empty {
+    my ($self) = @_;
+
+    return !($self->{Changes}
+	     || $self->{Source}
+	     || $self->{Version}
+	     || $self->{Maintainer}
+	     || $self->{Date});
+}
+
+sub output {
+    my $self = shift;
+    return tied(%$self)->output(@_);
+}
+
+1;
+__END__
+
+=head1 AUTHOR
+
+Frank Lichtenheld, E<lt>frank@lichtenheld.deE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright E<copy> 2005, 2007 by Frank Lichtenheld
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
+
+=cut

scripts/Dpkg/Changelog/Debian.pm

@@ -0,0 +1,358 @@
+#
+# Dpkg::Changelog::Debian
+#
+# Copyright 1996 Ian Jackson
+# Copyright 2005 Frank Lichtenheld <frank@lichtenheld.de>
+#
+#    This program is free software; you can redistribute it and/or modify
+#    it under the terms of the GNU General Public License as published by
+#    the Free Software Foundation; either version 2 of the License, or
+#    (at your option) any later version.
+#
+#    This program is distributed in the hope that it will be useful,
+#    but WITHOUT ANY WARRANTY; without even the implied warranty of
+#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#    GNU General Public License for more details.
+#
+#    You should have received a copy of the GNU General Public License
+#    along with this program; if not, write to the Free Software
+#    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
+#
+
+=head1 NAME
+
+Dpkg::Changelog::Debian - parse Debian changelogs
+
+=head1 SYNOPSIS
+
+    use Parse::DebianChangelog;
+
+    my $chglog = Parse::DebianChangelog->init( { infile => 'debian/changelog',
+                                                 HTML => { outfile => 'changelog.html' } );
+    $chglog->html;
+
+    # the following is semantically equivalent
+    my $chglog = Parse::DebianChangelog->init();
+    $chglog->parse( { infile => 'debian/changelog' } );
+    $chglog->html( { outfile => 'changelog.html' } );
+
+    my $changes = $chglog->dpkg_str( { since => '1.0-1' } );
+    print $changes;
+
+=head1 DESCRIPTION
+
+Dpkg::Changelog::Debian parses Debian changelogs as described in the Debian
+policy (version 3.6.2.1 at the time of this writing). See section
+L<"SEE ALSO"> for locations where to find this definition.
+
+The parser tries to ignore most cruft like # or /* */ style comments,
+CVS comments, vim variables, emacs local variables and stuff from
+older changelogs with other formats at the end of the file.
+NOTE: most of these are ignored silently currently, there is no
+parser error issued for them. This should become configurable in the
+future.
+
+=head2 METHODS
+
+=cut
+
+package Dpkg::Changelog::Debian;
+
+use strict;
+use warnings;
+
+use Fcntl qw( :flock );
+use English;
+use Date::Parse;
+
+use Dpkg;
+use Dpkg::Gettext;
+use Dpkg::Changelog qw( :util );
+use base qw(Dpkg::Changelog);
+
+=pod
+
+=head3 parse
+
+Parses either the file named in configuration item C<infile> or the string
+saved in configuration item C<instring>.
+Accepts a hash ref as optional argument which can contain configuration
+items.
+
+Returns C<undef> in case of error (e.g. "file not found", B<not> parse
+errors) and the object if successful. If C<undef> was returned, you
+can get the reason for the failure by calling the L<get_error> method.
+
+=cut
+
+sub parse {
+    my ($self, $config) = @_;
+
+    foreach my $c (keys %$config) {
+	$self->{config}{$c} = $config->{$c};
+    }
+
+    my ($fh, $file);
+    if ($file = $self->{config}{infile}) {
+	open $fh, '<', $file or do {
+	    $self->_do_fatal_error( _g("can't open file %s: %s"),
+					$file, $! );
+	    return undef;
+	};
+    } elsif (my $string = $self->{config}{instring}) {
+	eval { require IO::String };
+	if ($@) {
+	    $self->_do_fatal_error( _g("can't load IO::String: %s"),
+					$@ );
+	    return undef;
+	}
+	$fh = IO::String->new( $string );
+	$file = 'String';
+    } else {
+	$self->_do_fatal_error(_g('no changelog file specified'));
+	return undef;
+    }
+
+    $self->reset_parse_errors;
+
+    $self->{data} = [];
+
+# based on /usr/lib/dpkg/parsechangelog/debian
+    my $expect='first heading';
+    my $entry = new Dpkg::Changelog::Entry;
+    my $blanklines = 0;
+    my $unknowncounter = 1; # to make version unique, e.g. for using as id
+
+    while (<$fh>) {
+	s/\s*\n$//;
+#	printf(STDERR "%-39.39s %-39.39s\n",$expect,$_);
+	if (m/^(\w[-+0-9a-z.]*) \(([^\(\) \t]+)\)((\s+[-0-9a-z]+)+)\;/i) {
+	    unless ($expect eq 'first heading'
+		    || $expect eq 'next heading or eof') {
+		$entry->{ERROR} = [ $file, $NR,
+				    sprintf(_g("found start of entry where expected %s"),
+					    $expect), "$_" ];
+		$self->_do_parse_error(@{$entry->{ERROR}});
+	    }
+	    unless ($entry->is_empty) {
+		$entry->{'Closes'} = find_closes( $entry->{Changes} );
+#		    print STDERR, Dumper($entry);
+		push @{$self->{data}}, $entry;
+		$entry = new Dpkg::Changelog::Entry;
+		last if $self->_abort_early;
+	    }
+	    {
+		$entry->{'Source'} = "$1";
+		$entry->{'Version'} = "$2";
+		$entry->{'Header'} = "$_";
+		($entry->{'Distribution'} = "$3") =~ s/^\s+//;
+		$entry->{'Changes'} = $entry->{'Urgency_comment'} = '';
+		$entry->{'Urgency'} = $entry->{'Urgency_lc'} = 'unknown';
+	    }
+	    (my $rhs = $POSTMATCH) =~ s/^\s+//;
+	    my %kvdone;
+#	    print STDERR "RHS: $rhs\n";
+	    for my $kv (split(/\s*,\s*/,$rhs)) {
+		$kv =~ m/^([-0-9a-z]+)\=\s*(.*\S)$/i ||
+		    $self->_do_parse_error($file, $NR,
+					   sprintf(_g("bad key-value after \`;': \`%s'"), $kv));
+		my $k = ucfirst $1;
+		my $v = $2;
+		$kvdone{$k}++ && $self->_do_parse_error($file, $NR,
+							sprintf(_g("repeated key-value %s"), $k));
+		if ($k eq 'Urgency') {
+		    $v =~ m/^([-0-9a-z]+)((\s+.*)?)$/i ||
+			$self->_do_parse_error($file, $NR,
+					      _g("badly formatted urgency value"),
+					      $v);
+		    $entry->{'Urgency'} = "$1";
+		    $entry->{'Urgency_lc'} = lc("$1");
+		    $entry->{'Urgency_comment'} = "$2";
+		} elsif ($k =~ m/^X[BCS]+-/i) {
+		    # Extensions - XB for putting in Binary,
+		    # XC for putting in Control, XS for putting in Source
+		    $entry->{$k}= $v;
+		} else {
+		    $self->_do_parse_error($file, $NR,
+					   sprintf(_g("unknown key-value key %s - copying to XS-%s"), $k, $k));
+		    $entry->{"XS-$k"} = $v;
+		}
+	    }
+	    $expect= 'start of change data';
+	    $blanklines = 0;
+	} elsif (m/^(;;\s*)?Local variables:/io) {
+	    last; # skip Emacs variables at end of file
+	} elsif (m/^vim:/io) {
+	    last; # skip vim variables at end of file
+	} elsif (m/^\$\w+:.*\$/o) {
+	    next; # skip stuff that look like a CVS keyword
+	} elsif (m/^\# /o) {
+	    next; # skip comments, even that's not supported
+	} elsif (m,^/\*.*\*/,o) {
+	    next; # more comments
+	} elsif (m/^(\w+\s+\w+\s+\d{1,2} \d{1,2}:\d{1,2}:\d{1,2}\s+[\w\s]*\d{4})\s+(.*)\s+(<|\()(.*)(\)|>)/o
+		 || m/^(\w+\s+\w+\s+\d{1,2},?\s*\d{4})\s+(.*)\s+(<|\()(.*)(\)|>)/o
+		 || m/^(\w[-+0-9a-z.]*) \(([^\(\) \t]+)\)\;?/io
+		 || m/^([\w.+-]+)(-| )(\S+) Debian (\S+)/io
+		 || m/^Changes from version (.*) to (.*):/io
+		 || m/^Changes for [\w.+-]+-[\w.+-]+:?$/io
+		 || m/^Old Changelog:$/io
+		 || m/^(?:\d+:)?\w[\w.+~-]*:?$/o) {
+	    # save entries on old changelog format verbatim
+	    # we assume the rest of the file will be in old format once we
+	    # hit it for the first time
+	    $self->{oldformat} = "$_\n";
+	    $self->{oldformat} .= join "", <$fh>;
+	} elsif (m/^\S/) {
+	    $self->_do_parse_error($file, $NR,
+				  _g("badly formatted heading line"), "$_");
+	} elsif (m/^ \-\- (.*) <(.*)>(  ?)((\w+\,\s*)?\d{1,2}\s+\w+\s+\d{4}\s+\d{1,2}:\d\d:\d\d\s+[-+]\d{4}(\s+\([^\\\(\)]\))?)$/o) {
+	    $expect eq 'more change data or trailer' ||
+		$self->_do_parse_error($file, $NR,
+				       sprintf(_g("found trailer where expected %s"),
+					       $expect), "$_");
+	    if ($3 ne '  ') {
+		$self->_do_parse_error($file, $NR,
+				       _g( "badly formatted trailer line" ),
+				       "$_");
+	    }
+	    $entry->{'Trailer'} = $_;
+	    $entry->{'Maintainer'} = "$1 <$2>" unless $entry->{'Maintainer'};
+	    unless($entry->{'Date'} && defined $entry->{'Timestamp'}) {
+		$entry->{'Date'} = "$4";
+		$entry->{'Timestamp'} = str2time($4);
+		unless (defined $entry->{'Timestamp'}) {
+		    $self->_do_parse_error( $file, $NR,
+					    sprintf(_g("couldn't parse date %s"),
+						    "$4"));
+		}
+	    }
+	    $expect = 'next heading or eof';
+	} elsif (m/^ \-\-/) {
+	    $entry->{ERROR} = [ $file, $NR,
+				_g( "badly formatted trailer line" ), "$_" ];
+	    $self->_do_parse_error(@{$entry->{ERROR}});
+#	    $expect = 'next heading or eof'
+#		if $expect eq 'more change data or trailer';
+	} elsif (m/^\s{2,}(\S)/) {
+	    $expect eq 'start of change data'
+		|| $expect eq 'more change data or trailer'
+		|| do {
+		    $self->_do_parse_error($file, $NR,
+					   sprintf(_g("found change data where expected %s"),
+						   $expect), "$_");
+		    if (($expect eq 'next heading or eof')
+			&& !$entry->is_empty) {
+			# lets assume we have missed the actual header line
+			$entry->{'Closes'} = find_closes( $entry->{Changes} );
+#		    print STDERR, Dumper($entry);
+			push @{$self->{data}}, $entry;
+			$entry = Dpkg::Changelog::Entry->init();
+			$entry->{Source} =
+			    $entry->{Distribution} = $entry->{Urgency} =
+			    $entry->{Urgency_LC} = 'unknown';
+			$entry->{Version} = 'unknown'.($unknowncounter++);
+			$entry->{Urgency_Comment} = '';
+			$entry->{ERROR} = [ $file, $NR,
+					    sprintf(_g("found change data where expected %s"),
+						    $expect), "$_" ];
+		    }
+		};
+	    $entry->{'Changes'} .= (" \n" x $blanklines)." $_\n";
+	    if (!$entry->{'Items'} || ($1 eq '*')) {
+		$entry->{'Items'} ||= [];
+		push @{$entry->{'Items'}}, "$_\n";
+	    } else {
+		$entry->{'Items'}[-1] .= (" \n" x $blanklines)." $_\n";
+	    }
+	    $blanklines = 0;
+	    $expect = 'more change data or trailer';
+	} elsif (!m/\S/) {
+	    next if $expect eq 'start of change data'
+		|| $expect eq 'next heading or eof';
+	    $expect eq 'more change data or trailer'
+		|| $self->_do_parse_error($file, $NR,
+					  sprintf(_g("found blank line where expected %s"),
+						  $expect));
+	    $blanklines++;
+	} else {
+	    $self->_do_parse_error($file, $NR, _g( "unrecognised line" ),
+				   "$_");
+	    ($expect eq 'start of change data'
+		|| $expect eq 'more change data or trailer')
+		&& do {
+		    # lets assume change data if we expected it
+		    $entry->{'Changes'} .= (" \n" x $blanklines)." $_\n";
+		    if (!$entry->{'Items'}) {
+			$entry->{'Items'} ||= [];
+			push @{$entry->{'Items'}}, "$_\n";
+		    } else {
+			$entry->{'Items'}[-1] .= (" \n" x $blanklines)." $_\n";
+		    }
+		    $blanklines = 0;
+		    $expect = 'more change data or trailer';
+		    $entry->{ERROR} = [ $file, $NR, _g( "unrecognised line" ),
+					"$_" ];
+		};
+	}
+    }
+
+    $expect eq 'next heading or eof'
+	|| do {
+	    $entry->{ERROR} = [ $file, $NR,
+				sprintf(_g("found eof where expected %s"),
+					$expect) ];
+	    $self->_do_parse_error( @{$entry->{ERROR}} );
+	};
+    unless ($entry->is_empty) {
+	$entry->{'Closes'} = find_closes( $entry->{Changes} );
+	push @{$self->{data}}, $entry;
+    }
+
+    if ($self->{config}{infile}) {
+	close $fh or do {
+	    $self->_do_fatal_error( _g("can't close file %s: %s"),
+				    $file, $!);
+	    return undef;
+	};
+    }
+
+#    use Data::Dumper;
+#    print Dumper( $self );
+
+    return $self;
+}
+
+1;
+__END__
+
+=head1 SEE ALSO
+
+Dpkg::Changelog
+
+Description of the Debian changelog format in the Debian policy:
+L<http://www.debian.org/doc/debian-policy/ch-source.html#s-dpkgchangelog>.
+
+=head1 AUTHOR
+
+Frank Lichtenheld, E<lt>frank@lichtenheld.deE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2005 by Frank Lichtenheld
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
+
+=cut

scripts/Dpkg/Control.pm

@@ -0,0 +1,169 @@
+# Copyright 2007 Raphaël Hertzog <hertzog@debian.org>
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+package Dpkg::Control;
+
+use strict;
+use warnings;
+
+use Dpkg::Cdata;
+use Dpkg::ErrorHandling qw(syserr syntaxerr);
+use Dpkg::Gettext;
+
+=head1 NAME
+
+Dpkg::Control - parse files like debian/control
+
+=head1 DESCRIPTION
+
+It provides an object to access data of files that follow the same
+syntax than debian/control.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item $c = Dpkg::Control->new($file)
+
+Create a new Dpkg::Control object for $file. If $file is omitted, it parses
+debian/control.
+
+=cut
+sub new {
+    my ($this, $arg) = @_;
+    my $class = ref($this) || $this;
+    my $self = {
+	'source' => undef,
+	'packages' => [],
+    };
+    bless $self, $class;
+    if ($arg) {
+	$self->parse($arg);
+    } else {
+	$self->parse("debian/control");
+    }
+    return $self;
+}
+
+=item $c->reset()
+
+Resets what got read.
+
+=cut
+sub reset {
+    my $self = shift;
+    $self->{source} = undef;
+    $self->{packages} = [];
+}
+
+=item $c->parse($file)
+
+Parse the content of $file. Exits in case of errors.
+
+=cut
+sub parse {
+    my ($self, $file) = @_;
+    $self->reset();
+    # Parse
+    open(CDATA, "<", $file) || syserr(_g("cannot read %s"), $file);
+    my $cdata = parsecdata(\*CDATA, $file);
+    return if not defined $cdata;
+    $self->{source} = $cdata;
+    unless (exists $cdata->{Source}) {
+	syntaxerr($file, _g("first block lacks a source field"));
+    }
+    while (1) {
+	$cdata = parsecdata(\*CDATA, $file);
+	last if not defined $cdata;
+	push @{$self->{packages}}, $cdata;
+	unless (exists $cdata->{Package}) {
+	    syntaxerr($file, _g("block lacks a package field"));
+	}
+    }
+    close(CDATA);
+}
+
+=item $c->get_source()
+
+Returns a reference to a hash containing the fields concerning the
+source package. The hash is tied to Dpkg::Fields::Object.
+
+=cut
+sub get_source {
+    my $self = shift;
+    return $self->{source};
+}
+
+=item $c->get_pkg_by_idx($idx)
+
+Returns a reference to a hash containing the fields concerning the binary
+package numbered $idx (starting at 1). The hash is tied to
+Dpkg::Fields::Object.
+
+=cut
+sub get_pkg_by_idx {
+    my ($self, $idx) = @_;
+    return $self->{packages}[--$idx];
+}
+
+=item $c->get_pkg_by_name($name)
+
+Returns a reference to a hash containing the fields concerning the binary
+package named $name. The hash is tied to Dpkg::Fields::Object.
+
+=cut
+sub get_pkg_by_name {
+    my ($self, $name) = @_;
+    foreach my $pkg (@{$self->{packages}}) {
+	return $pkg if ($pkg->{Package} eq $name);
+    }
+    return undef;
+}
+
+
+=item $c->get_packages()
+
+Returns a list containing the hashes for all binary packages.
+
+=cut
+sub get_packages {
+    my $self = shift;
+    return @{$self->{packages}};
+}
+
+=item $c->dump($filehandle)
+
+Dump the content into a filehandle.
+
+=cut
+sub dump {
+    my ($self, $fh) = @_;
+    tied(%{$self->{source}})->dump($fh);
+    foreach my $pkg (@{$self->{packages}}) {
+	print $fh "\n";
+	tied(%{$pkg})->dump($fh);
+    }
+}
+
+=back
+
+=head1 AUTHOR
+
+Raphael Hertzog <hertzog@debian.org>.
+
+=cut
+
+1;

scripts/Dpkg/ErrorHandling.pm

@@ -5,7 +5,8 @@ use Dpkg::Gettext;
 
 use base qw(Exporter);
 our @EXPORT_OK = qw(warning warnerror error failure unknown syserr internerr
-                    subprocerr usageerr $warnable_error $quiet_warnings);
+                    subprocerr usageerr syntaxerr report
+		    $warnable_error $quiet_warnings);
 
 our $warnable_error = 1;
 our $quiet_warnings = 0;
@@ -89,4 +90,9 @@ sub usageerr(@)
     exit(2);
 }
 
+sub syntaxerr {
+    my ($file, $msg) = @_;
+    error(_g("syntax error in %s at line %d: %s"), $file, $., $msg);
+}
+
 1;

scripts/Dpkg/Fields.pm

@@ -4,37 +4,222 @@ use strict;
 use warnings;
 
 use Exporter;
+use Dpkg::Deps qw(@src_dep_fields @pkg_dep_fields);
+
 our @ISA = qw(Exporter);
-our @EXPORT_OK = qw(capit set_field_importance sort_field_by_importance);
+our @EXPORT_OK = qw(capit %control_src_fields %control_pkg_fields
+    $control_src_field_regex $control_pkg_field_regex);
+our %EXPORT_TAGS = ('list' => [qw(%control_src_fields %control_pkg_fields
+			$control_src_field_regex $control_pkg_field_regex)]);
+
+# Some variables (list of fields)
+our %control_src_fields;
+our %control_pkg_fields;
+$control_src_fields{$_} = 1 foreach (qw(Bugs Dm-Upload-Allowed
+    Homepage Origin Maintainer Priority Section Source Standards-Version
+    Uploaders Vcs-Browser Vcs-Arch Vcs-Bzr Vcs-Cvs Vcs-Darcs Vcs-Git Vcs-Hg
+    Vcs-Mtn Vcs-Svn));
+$control_src_fields{$_} = 1 foreach (@src_dep_fields);
+$control_pkg_fields{$_} = 1 foreach (qw(Architecture Bugs Description Essential
+    Homepage Installer-Menu-Item Kernel-Version Package Package-Type
+    Priority Section Subarchitecture Tag));
+$control_pkg_fields{$_} = 1 foreach (@pkg_dep_fields);
+
+our $control_src_field_regex = "(?:" . join("|", keys %control_src_fields) . ")";
+our $control_pkg_field_regex = "(?:" . join("|", keys %control_pkg_fields) . ")";
 
+# Some functions
 sub capit {
     my @pieces = map { ucfirst(lc) } split /-/, $_[0];
     return join '-', @pieces;
 }
 
-my %fieldimps;
+package Dpkg::Fields::Object;
 
-sub set_field_importance(@)
-{
-    my @fields = @_;
-    my $i = 1;
+=head1 OTHER OBJECTS
+
+=head2 Dpkg::Fields::Object
+
+This object is used to tie a hash. It implements hash-like functions by
+normalizing the name of fields received in keys (using
+Dpkg::Fields::capit). It also stores the order in which fields have been
+added in order to be able to dump them in the same order.
+
+=cut
+use Tie::Hash;
+our @ISA = qw(Tie::ExtraHash Tie::Hash);
+
+use Dpkg::ErrorHandling qw(internerr syserr);
+
+# Import capit
+Dpkg::Fields->import('capit');
+
+# $self->[0] is the real hash
+# $self->[1] is an array containing the ordered list of keys
+# $self->[2] is an hash describing the relative importance of each field
+# (used to sort the output).
+
+=head2 Dpkg::Fields::Object->new()
+
+Return a reference to a tied hash implementing storage of simple
+"field: value" mapping as used in many Debian-specific files.
 
-    grep($fieldimps{$_} = $i++, @fields);
+=cut
+sub new {
+    my $hash = {};
+    tie %{$hash}, 'Dpkg::Fields::Object';
+    return $hash;
 }
 
-sub sort_field_by_importance($$)
-{
-    my ($a, $b) = @_;
+sub TIEHASH  {
+    my $class = shift;
+    return bless [{}, [], {}], $class;
+}
+
+sub FETCH {
+    my ($self, $key) = @_;
+    $key = capit($key);
+    return $self->[0]->{$key} if exists $self->[0]->{$key};
+    return undef;
+}
+
+sub STORE {
+    my ($self, $key, $value) = @_;
+    $key = capit($key);
+    if (not exists $self->[0]->{$key}) {
+	push @{$self->[1]}, $key;
+    }
+    $self->[0]->{$key} = $value;
+}
 
-    if (defined $fieldimps{$a} && defined $fieldimps{$b}) {
-	$fieldimps{$a} <=> $fieldimps{$b};
-    } elsif (defined($fieldimps{$a})) {
-	-1;
-    } elsif (defined($fieldimps{$b})) {
-	1;
+sub EXISTS {
+    my ($self, $key) = @_;
+    $key = capit($key);
+    return exists $self->[0]->{$key};
+}
+
+sub DELETE {
+    my ($self, $key) = @_;
+    $key = capit($key);
+    if (exists $self->[0]->{$key}) {
+	delete $self->[0]->{$key};
+	@{$self->[1]} = grep { $_ ne $key } @{$self->[1]};
+	return 1;
     } else {
-	$a cmp $b;
+	return 0;
+    }
+}
+
+sub FIRSTKEY {
+    my $self = shift;
+    foreach (@{$self->[1]}) {
+	return $_ if exists $self->[0]->{$_};
+    }
+}
+
+sub NEXTKEY {
+    my ($self, $last) = @_;
+    my $found = 0;
+    foreach (@{$self->[1]}) {
+	if ($found) {
+	    return $_ if exists $self->[0]->{$_};
+	} else {
+	    $found = 1 if $_ eq $last;
+	}
+    }
+    return undef;
+}
+
+=head2 my $str = tied(%hash)->dump()
+=head2 tied(%hash)->dump($fh)
+
+Dump the raw content of the hash either as a string or to a filehandle.
+
+=cut
+sub dump {
+    my ($self, $fh) = @_;
+    my $str = "";
+    foreach (@{$self->[1]}) {
+	if (exists $self->[0]->{$_}) {
+	    print $fh "$_: " . $self->[0]->{$_} . "\n" if $fh;
+	    $str .= "$_: " . $self->[0]->{$_} . "\n" if defined wantarray;
+	}
+    }
+    return $str;
+}
+
+=head2 tied(%hash)->set_field_importance(@fields)
+
+Define the order in which fields will be displayed in the output() method.
+
+=cut
+sub set_field_importance {
+    my ($self, @fields) = @_;
+    my $i = 1;
+
+    $self->[2] = {};
+    $self->[2]{$_} = $i++ foreach (@fields);
+}
+
+=head2 tied(%hash)->output($fh, $substvars)
+
+If $fh is defined, print the fields on the $fh filehandle after
+substitution of variables defined in the Dpkg::Substvars object.
+
+Also returns the string of what would printed on the filehandle.
+
+=cut
+sub output {
+    my ($self, $fh, $substvars) = @_;
+    my $str = "";
+    my $imp = $self->[2]; # Hash of relative importance
+
+    # Add substvars to refer to other fields
+    if (defined($substvars)) {
+	foreach my $f (keys %{$self->[0]}) {
+	    $substvars->set("F:$f", $self->[0]->{$f});
+	}
+    }
+
+    my @keys = sort {
+	if (defined $imp->{$a} && defined $imp->{$b}) {
+	    $imp->{$a} <=> $imp->{$b};
+	} elsif (defined($imp->{$a})) {
+	    -1;
+	} elsif (defined($imp->{$b})) {
+	    1;
+	} else {
+	    $a cmp $b;
+	}
+    } keys %{$self->[0]};
+
+    foreach my $f (@keys) {
+        my $v = $self->[0]->{$f};
+        if (defined($substvars)) {
+            $v = $substvars->substvars($v);
+        }
+        $v =~ m/\S/ || next; # delete whitespace-only fields
+        $v =~ m/\n\S/ &&
+            internerr(_g("field %s has newline then non whitespace >%s<"),
+                      $f, $v);
+        $v =~ m/\n[ \t]*\n/ &&
+            internerr(_g("field %s has blank lines >%s<"), $f, $v);
+        $v =~ m/\n$/ &&
+            internerr(_g("field %s has trailing newline >%s<"), $f, $v);
+        if (defined($substvars)) {
+           $v =~ s/,[\s,]*,/,/g;
+           $v =~ s/^\s*,\s*//;
+           $v =~ s/\s*,\s*$//;
+        }
+        $v =~ s/\$\{\}/\$/g;
+	if ($fh) {
+	    print $fh "$f: $v\n" || syserr(_g("write error on control data"));
+	}
+	if (defined wantarray) {
+	    $str .= "$f: $v\n";
+	}
     }
+    return $str;
 }
 
 1;

scripts/Dpkg/Substvars.pm

@@ -0,0 +1,185 @@
+# Copyright 2007 Raphaël Hertzog <hertzog@debian.org>
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+package Dpkg::Substvars;
+
+use strict;
+use warnings;
+
+use Dpkg qw($version);
+use Dpkg::Arch qw(get_host_arch);
+use Dpkg::ErrorHandling qw(error warning);
+use Dpkg::Gettext;
+
+use POSIX qw(:errno_h);
+use English;
+
+my $maxsubsts = 50;
+
+=head1 NAME
+
+Dpkg::Substvars - handle variable substitution in strings
+
+=head1 DESCRIPTION
+
+It provides some an object which is able to substitute variables in
+strings.
+
+=head1 METHODS
+
+=over 8
+
+=item my $s = Dpkg::Substvars->new($file)
+
+Create a new object that can do substitutions. By default it contains
+generic substitutions like ${Newline}, ${Space}, ${Tab}, ${dpkg:Version},
+${dpkg:Upstream-Version} and ${Arch}.
+
+Additional substitutions will be read from the $file passed as parameter.
+
+=cut
+sub new {
+    my ($this, $arg) = @_;
+    my $class = ref($this) || $this;
+    my $self = {
+	"Newline" => "\n",
+	"Space" => " ",
+	"Tab" => "\t",
+	"dpkg:Version" => $version,
+	"dpkg:Upstream-Version" => $version,
+	"Arch" => get_host_arch(),
+    };
+    $self->{'dpkg:Upstream-Version'} =~ s/-[^-]+$//;
+    bless $self, $class;
+    if ($arg) {
+        $self->parse($arg);
+    }
+    return $self;
+}
+
+=item $s->set($key, $value)
+
+Add/replace a substitution.
+
+=cut
+sub set {
+    my ($self, $key, $value) = @_;
+    $self->{$key} = $value;
+}
+
+=item $s->get($key)
+
+Get the value of a given substitution.
+
+=cut
+sub get {
+    my ($self, $key) = @_;
+    return $self->{$key};
+}
+
+=item $s->delete($key)
+
+Remove a given substitution.
+
+=cut
+sub delete {
+    my ($self, $key) = @_;
+    return delete $self->{$key};
+}
+
+=item $s->parse($file)
+
+Add new substitutions read from $file.
+
+=cut
+sub parse {
+    my ($self, $varlistfile) = @_;
+    $varlistfile="./$varlistfile" if $varlistfile =~ m/\s/;
+    if (open(SV, "<", $varlistfile)) {
+	binmode(SV);
+	while (<SV>) {
+	    next if m/^\#/ || !m/\S/;
+	    s/\s*\n$//;
+	    m/^(\w[-:0-9A-Za-z]*)\=/ ||
+		error(_g("bad line in substvars file %s at line %d"),
+		      $varlistfile, $.);
+	    $self->{$1} = $';
+	}
+	close(SV);
+    } elsif ($! != ENOENT ) {
+	error(_g("unable to open substvars file %s: %s"), $varlistfile, $!);
+    }
+}
+
+=item $s->set_version_substvars($version)
+
+Defines ${binary:Version}, ${source:Version} and
+${source:Upstream-Version} based on the given version string.
+
+=cut
+sub set_version_substvars {
+    my ($self, $version) = @_;
+
+    $self->{'binary:Version'} = $version;
+    $self->{'source:Version'} = $version;
+    $self->{'source:Version'} =~ s/\+b[0-9]+$//;
+    $self->{'source:Upstream-Version'} = $version;
+    $self->{'source:Upstream-Version'} =~ s/-[^-]*$//;
+
+    # XXX: Source-Version is now deprecated, remove in the future.
+    $self->{'Source-Version'} = $version;
+}
+
+=item $newstring = $s->substvars($string)
+
+Substitutes variables in $string and return the result in $newstring.
+
+=cut
+sub substvars {
+    my ($self, $v) = @_;
+    my $lhs;
+    my $vn;
+    my $rhs = '';
+    my $count = 0;
+
+    while ($v =~ m/\$\{([-:0-9a-z]+)\}/i) {
+        # If we have consumed more from the leftover data, then
+        # reset the recursive counter.
+        $count = 0 if (length($POSTMATCH) < length($rhs));
+
+        $count < $maxsubsts ||
+            error(_g("too many substitutions - recursive ? - in \`%s'"), $v);
+        $lhs = $PREMATCH; $vn = $1; $rhs = $POSTMATCH;
+        if (defined($self->{$vn})) {
+            $v = $lhs . $self->{$vn} . $rhs;
+            $count++;
+        } else {
+            warning(_g("unknown substitution variable \${%s}"), $vn);
+            $v = $lhs . $rhs;
+        }
+    }
+    return $v;
+}
+
+=back
+
+=head1 AUTHOR
+
+Raphael Hertzog <hertzog@debian.org>.
+
+=cut
+
+1;

scripts/Dpkg/Vars.pm

@@ -0,0 +1,53 @@
+# Copyright 2007 Raphaël Hertzog <hertzog@debian.org>
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+package Dpkg::Vars;
+
+use strict;
+use warnings;
+
+use Dpkg::ErrorHandling qw(error);
+use Dpkg::Gettext;
+
+use Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw($sourcepackage set_source_package);
+
+our $sourcepackage;
+
+sub check_package_name {
+    my $name = shift || '';
+    $name =~ m/[^-+.0-9a-z]/o &&
+        error(_g("source package name `%s' contains illegal character `%s'"),
+              $name, $&);
+    $name =~ m/^[0-9a-z]/o ||
+        error(_g("source package name `%s' starts with non-alphanum"), $name);
+}
+
+sub set_source_package {
+    my $v = shift;
+
+    check_package_name($v);
+    if (defined($sourcepackage)) {
+        $v eq $sourcepackage ||
+            error(_g("source package has two conflicting values - %s and %s"),
+                  $sourcepackage, $v);
+    } else {
+        $sourcepackage = $v;
+    }
+}
+
+1;

scripts/Dpkg/Version.pm

@@ -21,9 +21,11 @@ package Dpkg::Version;
 use strict;
 use warnings;
 
+use Dpkg::ErrorHandling qw(error);
+
 use Exporter;
 our @ISA = qw(Exporter);
-our @EXPORT_OK = qw(vercmp compare_versions);
+our @EXPORT_OK = qw(vercmp compare_versions check_version);
 
 =head1 NAME
 
@@ -192,6 +194,17 @@ sub compare_versions ($$$)
     }
 }
 
+=item check_version($version)
+
+Check the version string and fails it it's invalid.
+
+=cut
+sub check_version ($) {
+    my $version = shift || '';
+    $version =~ m/[^-+:.0-9a-zA-Z~]/o &&
+        error(_g("version number contains illegal character `%s'"), $&);
+}
+
 =back
 
 =head1 AUTHOR

scripts/Makefile.am

@@ -69,7 +69,14 @@ EXTRA_DIST = \
 	t/200_Dpkg_Shlibs/objdump.ls \
 	t/300_Dpkg_BuildOptions.t \
 	t/400_Dpkg_Deps.t \
-	t/500_Dpkg_Path.t
+	t/500_Dpkg_Path.t \
+	t/600_Dpkg_Changelog.t \
+	t/600_Dpkg_Changelog/countme \
+	t/600_Dpkg_Changelog/fields \
+	t/600_Dpkg_Changelog/misplaced-tz \
+	t/600_Dpkg_Changelog/shadow \
+	t/700_Dpkg_Control.t \
+	t/700_Dpkg_Control/control-1
 
 CLEANFILES = \
 	$(bin_SCRIPTS) $(sbin_SCRIPTS) $(changelog_SCRIPTS) \
@@ -79,23 +86,25 @@ perllibdir = $(PERL_LIBDIR)
 nobase_dist_perllib_DATA = \
 	Dpkg/Arch.pm \
 	Dpkg/BuildOptions.pm \
+	Dpkg/Cdata.pm \
+	Dpkg/Changelog.pm \
+	Dpkg/Changelog/Debian.pm \
 	Dpkg/Compression.pm \
-	Dpkg/ErrorHandling.pm \
+	Dpkg/Control.pm \
 	Dpkg/Deps.pm \
+	Dpkg/ErrorHandling.pm \
 	Dpkg/Fields.pm \
 	Dpkg/Gettext.pm \
 	Dpkg/Path.pm \
 	Dpkg/Shlibs.pm \
 	Dpkg/Shlibs/Objdump.pm \
 	Dpkg/Shlibs/SymbolFile.pm \
+	Dpkg/Substvars.pm \
+	Dpkg/Vars.pm \
 	Dpkg/Version.pm \
 	Dpkg/Source/VCS/git.pm \
 	Dpkg.pm
 
-dist_pkglib_SCRIPTS = \
-	controllib.pl
-
-
 do_perl_subst = sed -e "s:^\#![:space:]*/usr/bin/perl:\#!$(PERL):" \
 		    -e "s:\$$dpkglibdir[[:space:]]*=[[:space:]]*['\"][^'\"]*['\"]:\$$dpkglibdir=\"$(pkglibdir)\":" \
 		    -e "s:\$$pkgdatadir[[:space:]]*=[[:space:]]*['\"][^'\"]*['\"]:\$$pkgdatadir=\"$(pkgdatadir)\":" \

scripts/changelog/debian.pl

@@ -3,35 +3,24 @@
 use strict;
 use warnings;
 
+use Getopt::Long qw(:config gnu_getopt auto_help);
+use POSIX;
+
 use Dpkg;
 use Dpkg::Gettext;
-use Dpkg::ErrorHandling qw(error internerr usageerr);
-use Dpkg::Fields qw(set_field_importance);
-
-push(@INC,$dpkglibdir);
-require 'controllib.pl';
-
-our %f;
+use Dpkg::ErrorHandling qw(usageerr failure);
+use Dpkg::Changelog::Debian;
 
 textdomain("dpkg-dev");
 
-my $controlfile = 'debian/control';
-my $changelogfile = 'debian/changelog';
-my $fileslistfile = 'debian/files';
-my $since = '';
-my %mapkv = (); # XXX: for future use
-
-my @changelog_fields = qw(Source Version Distribution Urgency Maintainer
-                          Date Closes Changes);
-
 $progname = "parsechangelog/$progname";
 
-
 sub version {
     printf _g("Debian %s version %s.\n"), $progname, $version;
 
     printf _g("
-Copyright (C) 1996 Ian Jackson.");
+Copyright (C) 1996 Ian Jackson.
+Copyright (C) 2005,2007 Frank Lichtenheld.");
     printf _g("
 This is free software; see the GNU General Public Licence version 2 or
 later for copying conditions. There is NO warranty.
@@ -40,152 +29,95 @@ later for copying conditions. There is NO warranty.
 
 sub usage {
     printf _g(
-"Usage: %s [<option>]
+"Usage: %s [<option>...] [<changelogfile>]
 
 Options:
-  -l<changelog>       use <changelog> as the file name when reporting.
-  -v<versionsince>    print changes since <versionsince>.
-  -h, --help          print this help message.
-      --version       print program version.
+    --help, -h                  print usage information
+    --version, -V               print version information
+    --file, -l <file>           changelog file to parse, defaults
+                                to 'debian/changelog'
+    --format <outputformat>     see man page for list of available
+                                output formats, defaults to 'dpkg'
+                                for compatibility with dpkg-dev
+    --since, -s, -v <version>   include all changes later than version
+    --until, -u <version>       include all changes earlier than version
+    --from, -f <version>        include all changes equal or later
+                                than version
+    --to, -t <version>          include all changes up to or equal
+                                than version
+    --count, -c, -n <number>    include <number> entries from the top
+                                (or the tail if <number> is lower than 0)
+    --offset, -o <number>       change the starting point for --count,
+                                counted from the top (or the tail if
+                                <number> is lower than 0)
+    --all                       include all changes
 "), $progname;
 }
 
-while (@ARGV) {
-    $_=shift(@ARGV);
-    if (m/^-v(.+)$/) {
-        $since= $1;
-    } elsif (m/^-l(.+)$/) {
-        $changelogfile = $1;
-    } elsif (m/^-(h|-help)$/) {
-        &usage; exit(0);
-    } elsif (m/^--version$/) {
-        &version; exit(0);
-    } else {
-        &usageerr(sprintf(_g("unknown option \`%s'"), $_));
+my ( $since, $until, $from, $to, $all, $count, $offset, $file );
+my $default_file = 'debian/changelog';
+my $format = 'dpkg';
+my %allowed_formats = (
+    dpkg => 1,
+    rfc822 => 1,
+    );
+
+sub set_format {
+    my ($opt, $val) = @_;
+
+    unless ($allowed_formats{$val}) {
+	usageerr(_g('output format %s not supported'), $val );
     }
+
+    $format = $val;
 }
 
-my %urgencies;
-my $i = 1;
-grep($urgencies{$_} = $i++, qw(low medium high critical emergency));
-
-my $expect = 'first heading';
-my $blanklines;
-
-while (<STDIN>) {
-    s/\s*\n$//;
-#    printf(STDERR "%-39.39s %-39.39s\n",$expect,$_);
-    if (m/^(\w[-+0-9a-z.]*) \(([^\(\) \t]+)\)((\s+[-+0-9a-z.]+)+)\;/i) {
-        if ($expect eq 'first heading') {
-            $f{'Source'}= $1;
-            $f{'Version'}= $2;
-            $f{'Distribution'}= $3;
-            &error(_g("-v<since> option specifies most recent version")) if
-                $2 eq $since;
-            $f{'Distribution'} =~ s/^\s+//;
-        } elsif ($expect eq 'next heading or eof') {
-            last if $2 eq $since;
-            $f{'Changes'}.= " .\n";
-        } else {
-            &clerror(sprintf(_g("found start of entry where expected %s"), $expect));
-        }
-	my $rhs = $';
-	$rhs =~ s/^\s+//;
-	my %kvdone;
-	for my $kv (split(/\s*,\s*/, $rhs)) {
-            $kv =~ m/^([-0-9a-z]+)\=\s*(.*\S)$/i ||
-                &clerror(sprintf(_g("bad key-value after \`;': \`%s'"), $kv));
-	    my $k = (uc substr($1, 0, 1)).(lc substr($1, 1));
-	    my $v = $2;
-            $kvdone{$k}++ && &clwarn(sprintf(_g("repeated key-value %s"), $k));
-            if ($k eq 'Urgency') {
-                $v =~ m/^([-0-9a-z]+)((\s+.*)?)$/i ||
-                    &clerror(_g("badly formatted urgency value"));
-
-		my $newurg = lc $1;
-		my $oldurg;
-		my $newurgn = $urgencies{lc $1};
-		my $oldurgn;
-		my $newcomment = $2;
-		my $oldcomment;
-
-                $newurgn ||
-                    &clwarn(sprintf(_g("unknown urgency value %s - comparing very low"), $newurg));
-                if (defined($f{'Urgency'})) {
-                    $f{'Urgency'} =~ m/^([-0-9a-z]+)((\s+.*)?)$/i ||
-                        &internerr(sprintf(_g("urgency >%s<"), $f{'Urgency'}));
-                    $oldurg= lc $1;
-                    $oldurgn= $urgencies{lc $1}; $oldcomment= $2;
-                } else {
-                    $oldurgn= -1;
-                    $oldcomment= '';
-                }
-                $f{'Urgency'}=
-                    (($newurgn > $oldurgn ? $newurg : $oldurg).
-                     $oldcomment.
-                     $newcomment);
-            } elsif (defined($mapkv{$k})) {
-                $f{$mapkv{$k}}= $v;
-            } elsif ($k =~ m/^X[BCS]+-/i) {
-                # Extensions - XB for putting in Binary,
-                # XC for putting in Control, XS for putting in Source
-                $f{$k}= $v;
-            } else {
-                &clwarn(sprintf(_g("unknown key-value key %s - copying to %s"), $k, "XS-$k"));
-                $f{"XS-$k"}= $v;
-            }
-        }
-        $expect= 'start of change data'; $blanklines=0;
-        $f{'Changes'}.= " $_\n .\n";
-    } elsif (m/^\S/) {
-        &clerror(_g("badly formatted heading line"));
-    } elsif (m/^ \-\- (.*) <(.*)>  ((\w+\,\s*)?\d{1,2}\s+\w+\s+\d{4}\s+\d{1,2}:\d\d:\d\d\s+[-+]\d{4}(\s+\([^\\\(\)]\))?)$/) {
-        $expect eq 'more change data or trailer' ||
-            &clerror(sprintf(_g("found trailer where expected %s"), $expect));
-        $f{'Maintainer'}= "$1 <$2>" unless defined($f{'Maintainer'});
-        $f{'Date'}= $3 unless defined($f{'Date'});
-#        $f{'Changes'}.= " .\n $_\n";
-        $expect= 'next heading or eof';
-        last if $since eq '';
-    } elsif (m/^ \-\-/) {
-        &clerror(_g("badly formatted trailer line"));
-    } elsif (m/^\s{2,}\S/) {
-        $expect eq 'start of change data' || $expect eq 'more change data or trailer' ||
-            &clerror(sprintf(_g("found change data where expected %s"), $expect));
-        $f{'Changes'}.= (" .\n"x$blanklines)." $_\n"; $blanklines=0;
-        $expect= 'more change data or trailer';
-    } elsif (!m/\S/) {
-        next if $expect eq 'start of change data' || $expect eq 'next heading or eof';
-        $expect eq 'more change data or trailer' ||
-            &clerror(sprintf(_g("found blank line where expected %s"), $expect));
-        $blanklines++;
-    } else {
-        &clerror(_g("unrecognised line"));
+GetOptions( "file|l=s" => \$file,
+	    "since|v=s" => \$since,
+	    "until|u=s" => \$until,
+	    "from|f=s" => \$from,
+	    "to|t=s" => \$to,
+	    "count|c|n=i" => \$count,
+	    "offset|o=i" => \$offset,
+	    "help|h" => sub{usage();exit(0)},
+	    "version|V" => sub{version();exit(0)},
+	    "format=s" => \&set_format,
+	    "all|a" => \$all,
+	    )
+    or do { usage(); exit(2) };
+
+usageerr('too many arguments') if @ARGV > 1;
+
+if (@ARGV) {
+    if ($file && ($file ne $ARGV[0])) {
+	usageerr(_g('more than one file specified (%s and %s)'),
+		 $file, $ARGV[0] );
     }
+    $file = $ARGV[0];
 }
 
-$expect eq 'next heading or eof' || die sprintf(_g("found eof where expected %s"), $expect);
-
-$f{'Changes'} =~ s/\n$//;
-$f{'Changes'} =~ s/^/\n/;
-
-my @closes;
+my $changes = Dpkg::Changelog::Debian->init();
 
-while ($f{'Changes'} =~ /closes:\s*(?:bug)?\#?\s?\d+(?:,\s*(?:bug)?\#?\s?\d+)*/ig) {
-  push(@closes, $& =~ /\#?\s?(\d+)/g);
+$file ||= $default_file;
+unless ($since or $until or $from or $to or
+	$offset or $count or $all) {
+    $count = 1;
 }
-$f{'Closes'} = join(' ',sort { $a <=> $b} @closes);
-
-set_field_importance(@changelog_fields);
-outputclose();
-
-sub clerror
-{
-    &error(sprintf(_g("%s, at file %s line %d"), $_[0], $changelogfile, $.));
+my @all = $all ? ( all => $all ) : ();
+my $opts = { since => $since, until => $until,
+	     from => $from, to => $to,
+	     count => $count, offset => $offset,
+	     @all };
+
+if ($file eq '-') {
+    my @input = <STDIN>;
+    $changes->parse({ instring => join('', @input), %$opts })
+	or failure(_g('fatal error occured while parsing input'));
+} else {
+    $changes->parse({ infile => $file, %$opts })
+	or failure(_g('fatal error occured while parsing %s'),
+		   $file );
 }
 
-sub clwarn
-{
-    &warn(sprintf(_g("%s, at file %s line %d"), $_[0], $changelogfile, $.));
-}
 
+eval("print \$changes->${format}_str(\$opts)");

scripts/controllib.pl

@@ -1,332 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use English;
-use POSIX qw(:errno_h);
-use Dpkg;
-use Dpkg::Gettext;
-use Dpkg::ErrorHandling qw(warning error failure internerr syserr subprocerr);
-use Dpkg::Arch qw(get_host_arch debarch_is);
-use Dpkg::Fields qw(capit sort_field_by_importance);
-
-textdomain("dpkg-dev");
-
-our $sourcepackage; # - name of sourcepackage
-our %f;             # - fields ???
-our %fi;            # - map of fields values. keys are of the form "S# key"
-                    #   where S is source (L is changelog, C is control)
-                    #   and # is an index
-our %p2i;           # - map from datafile+packagename to index in controlfile
-                    #   (used if multiple packages can be listed). Key is
-                    #   "S key" where S is the source and key is the packagename
-
-my $maxsubsts = 50;
-our %substvar;      # - map with substitution variables
-
-my $parsechangelog = 'dpkg-parsechangelog';
-
-sub getfowner
-{
-    my $getlogin = getlogin();
-    if (!defined($getlogin)) {
-	open(SAVEIN, "<&STDIN");
-	open(STDIN, "<&STDERR");
-
-	$getlogin = getlogin();
-
-	close(STDIN);
-	open(STDIN, "<&SAVEIN");
-	close(SAVEIN);
-    }
-    if (!defined($getlogin)) {
-	open(SAVEIN, "<&STDIN");
-	open(STDIN, "<&STDOUT");
-
-	$getlogin = getlogin();
-
-	close(STDIN);
-	open(STDIN, "<&SAVEIN");
-	close(SAVEIN);
-    }
-
-    my @fowner;
-    if (defined($ENV{'LOGNAME'})) {
-	@fowner = getpwnam($ENV{'LOGNAME'});
-	if (!@fowner) {
-	    die(sprintf(_g('unable to get login information for username "%s"'), $ENV{'LOGNAME'}));
-	}
-    } elsif (defined($getlogin)) {
-	@fowner = getpwnam($getlogin);
-	if (!@fowner) {
-	    die(sprintf(_g('unable to get login information for username "%s"'), $getlogin));
-	}
-    } else {
-	warning(_g('no utmp entry available and LOGNAME not defined; ' .
-	           'using uid of process (%d)'), $<);
-	@fowner = getpwuid($<);
-	if (!@fowner) {
-	    die (sprintf(_g('unable to get login information for uid %d'), $<));
-	}
-    }
-    @fowner = @fowner[2,3];
-
-    return @fowner;
-}
-
-sub substvars {
-    my ($v) = @_;
-    my $lhs;
-    my $vn;
-    my $rhs = '';
-    my $count = 0;
-
-    while ($v =~ m/\$\{([-:0-9a-z]+)\}/i) {
-        # If we have consumed more from the leftover data, then
-        # reset the recursive counter.
-        $count= 0 if (length($POSTMATCH) < length($rhs));
-
-        $count < $maxsubsts ||
-            error(_g("too many substitutions - recursive ? - in \`%s'"), $v);
-        $lhs=$`; $vn=$1; $rhs=$';
-        if (defined($substvar{$vn})) {
-            $v= $lhs.$substvar{$vn}.$rhs;
-            $count++;
-        } else {
-	    warning(_g("unknown substitution variable \${%s}"), $vn);
-            $v= $lhs.$rhs;
-        }
-    }
-    return $v;
-}
-
-sub outputclose {
-    my ($varlistfile) = @_;
-
-    for my $f (keys %f) {
-	$substvar{"F:$f"} = $f{$f};
-    }
-
-    &parsesubstvars($varlistfile) if (defined($varlistfile));
-
-    for my $f (sort sort_field_by_importance keys %f) {
-	my $v = $f{$f};
-	if (defined($varlistfile)) {
-	    $v= &substvars($v);
-	}
-        $v =~ m/\S/ || next; # delete whitespace-only fields
-	$v =~ m/\n\S/ &&
-	    internerr(_g("field %s has newline then non whitespace >%s<"),
-	              $f, $v);
-	$v =~ m/\n[ \t]*\n/ &&
-	    internerr(_g("field %s has blank lines >%s<"), $f, $v);
-	$v =~ m/\n$/ &&
-	    internerr(_g("field %s has trailing newline >%s<"), $f, $v);
-	if (defined($varlistfile)) {
-	   $v =~ s/,[\s,]*,/,/g;
-	   $v =~ s/^\s*,\s*//;
-	   $v =~ s/\s*,\s*$//;
-	}
-        $v =~ s/\$\{\}/\$/g;
-        print("$f: $v\n") || &syserr(_g("write error on control data"));
-    }
-
-    close(STDOUT) || &syserr(_g("write error on close control data"));
-}
-
-sub parsecontrolfile {
-    my $controlfile = shift;
-
-    $controlfile="./$controlfile" if $controlfile =~ m/^\s/;
-
-    open(CDATA, "< $controlfile") ||
-        error(_g("cannot read control file %s: %s"), $controlfile, $!);
-    binmode(CDATA);
-    my $indices = parsecdata(\*CDATA, 'C', 1,
-			     sprintf(_g("control file %s"), $controlfile));
-    $indices >= 2 || &error(_g("control file must have at least one binary package part"));
-
-    for (my $i = 1; $i < $indices; $i++) {
-        defined($fi{"C$i Package"}) ||
-            error(_g("per-package paragraph %d in control " .
-                     "info file is missing Package line"), $i);
-    }
-    defined($fi{"C Source"}) ||
-        &error(_g("source paragraph in control info file is ".
-                       "missing Source line"));
-
-}
-
-my $substvarsparsed = 0;
-sub parsesubstvars {
-    my $varlistfile = shift;
-
-    if (length($varlistfile) && !$substvarsparsed) {
-        $varlistfile="./$varlistfile" if $varlistfile =~ m/\s/;
-        if (open(SV,"< $varlistfile")) {
-            binmode(SV);
-            while (<SV>) {
-                next if m/^\#/ || !m/\S/;
-                s/\s*\n$//;
-                m/^(\w[-:0-9A-Za-z]*)\=/ ||
-                    error(_g("bad line in substvars file %s at line %d"),
-                          $varlistfile, $.);
-                $substvar{$1}= $';
-            }
-            close(SV);
-        } elsif ($! != ENOENT ) {
-            error(_g("unable to open substvars file %s: %s"), $varlistfile, $!);
-        }
-        $substvarsparsed = 1;
-    }
-}
-
-sub parsechangelog {
-    my ($changelogfile, $changelogformat, $since) = @_;
-
-    defined(my $c = open(CDATA, "-|")) || syserr(_g("fork for parse changelog"));
-    if ($c) {
-	binmode(CDATA);
-	parsecdata(\*CDATA, 'L', 0, _g("parsed version of changelog"));
-	close(CDATA);
-	$? && subprocerr(_g("parse changelog"));
-    } else {
-	binmode(STDOUT);
-	my @al = ($parsechangelog);
-        push(@al,"-l$changelogfile");
-        push(@al, "-F$changelogformat") if defined($changelogformat);
-        push(@al, "-v$since") if defined($since);
-        exec(@al) || &syserr("exec parsechangelog $parsechangelog");
-    }
-}
-
-sub init_substvars
-{
-    $substvar{'Format'} = 1.7;
-    $substvar{'Newline'} = "\n";
-    $substvar{'Space'} = " ";
-    $substvar{'Tab'} = "\t";
-
-    # XXX: Source-Version is now deprecated, remove in the future.
-    $substvar{'Source-Version'}= $fi{"L Version"};
-    $substvar{'binary:Version'} = $fi{"L Version"};
-    $substvar{'source:Version'} = $fi{"L Version"};
-    $substvar{'source:Version'} =~ s/\+b[0-9]+$//;
-    $substvar{'source:Upstream-Version'} = $fi{"L Version"};
-    $substvar{'source:Upstream-Version'} =~ s/-[^-]*$//;
-
-    $substvar{"dpkg:Version"} = $version;
-    $substvar{"dpkg:Upstream-Version"} = $version;
-    $substvar{"dpkg:Upstream-Version"} =~ s/-[^-]+$//;
-}
-
-sub init_substvar_arch()
-{
-    $substvar{'Arch'} = get_host_arch();
-}
-
-sub checkpackagename {
-    my $name = shift || '';
-    $name =~ m/[^-+.0-9a-z]/o &&
-        error(_g("source package name `%s' contains illegal character `%s'"),
-              $name, $&);
-    $name =~ m/^[0-9a-z]/o ||
-        error(_g("source package name `%s' starts with non-alphanum"), $name);
-}
-
-sub checkversion {
-    my $version = shift || '';
-    $version =~ m/[^-+:.0-9a-zA-Z~]/o &&
-        error(_g("version number contains illegal character `%s'"), $&);
-}
-
-sub setsourcepackage {
-    my $v = shift;
-
-    checkpackagename( $v );
-    if (defined($sourcepackage)) {
-        $v eq $sourcepackage ||
-            error(_g("source package has two conflicting values - %s and %s"),
-                  $sourcepackage, $v);
-    } else {
-        $sourcepackage= $v;
-    }
-}
-
-sub readmd5sum {
-    (my $md5sum = shift) or return;
-    $md5sum =~ s/^([0-9a-f]{32})\s*\*?-?\s*\n?$/$1/o
-        || failure(_g("md5sum gave bogus output `%s'"), $md5sum);
-    return $md5sum;
-}
-
-# XXX: Should not be a global!!
-my $whatmsg;
-
-sub parsecdata {
-    my ($cdata, $source, $many);
-    ($cdata, $source, $many, $whatmsg) = @_;
-
-    # many=0: ordinary control data like output from dpkg-parsechangelog
-    # many=1: many paragraphs like in source control file
-    # many=-1: single paragraph of control data optionally signed
-
-    my $index = '';
-    my $cf = '';
-    my $paraborder = 1;
-
-    while (<$cdata>) {
-        s/\s*\n$//;
-	next if (m/^$/ and $paraborder);
-	next if (m/^#/);
-	$paraborder=0;
-        if (m/^(\S+?)\s*:\s*(.*)$/) {
-	    $cf = $1;
-	    my $v = $2;
-            $cf= &capit($cf);
-            $fi{"$source$index $cf"}= $v;
-            $fi{"o:$source$index $cf"}= $1;
-            if (lc $cf eq 'package') { $p2i{"$source $v"}= $index; }
-        } elsif (m/^\s+\S/) {
-            length($cf) || &syntax(_g("continued value line not in field"));
-            $fi{"$source$index $cf"}.= "\n$_";
-        } elsif (m/^-----BEGIN PGP/ && $many<0) {
-            $many == -2 && syntax(_g("expected blank line before PGP signature"));
-	    while (<$cdata>) {
-		last if m/^$/;
-	    }
-            $many= -2;
-        } elsif (m/^$/) {
-	    $paraborder = 1;
-            if ($many>0) {
-                $index++; $cf='';
-            } elsif ($many == -2) {
-		$_ = <$cdata> while defined($_) && $_ =~ /^\s*$/;
-                length($_) ||
-                    &syntax(_g("expected PGP signature, found EOF after blank line"));
-                s/\n$//;
-                m/^-----BEGIN PGP/ ||
-                    &syntax(sprintf(_g("expected PGP signature, found something else \`%s'"), $_));
-                $many= -3; last;
-            } else {
-		while (<$cdata>) {
-		    /^\s*$/ ||
-			&syntax(_g("found several \`paragraphs' where only one expected"));
-		}
-            }
-        } else {
-            &syntax(_g("line with unknown format (not field-colon-value)"));
-        }
-    }
-    $many == -2 && &syntax(_g("found start of PGP body but no signature"));
-    if (length($cf)) { $index++; }
-    $index || &syntax(_g("empty file"));
-    return $index;
-}
-
-sub syntax {
-    error(_g("syntax error in %s at line %d: %s"), $whatmsg, $., $_[0]);
-}
-
-1;

scripts/dpkg-buildpackage.pl

@@ -12,9 +12,7 @@ use Dpkg::ErrorHandling qw(warning error failure syserr subprocerr usageerr
                            $warnable_error);
 use Dpkg::BuildOptions;
 use Dpkg::Compression;
-
-push (@INC, $dpkglibdir);
-require 'controllib.pl';
+use Dpkg::Version qw(check_version);
 
 textdomain("dpkg-dev");
 
@@ -282,7 +280,7 @@ sub mustsetvar {
 
 my $pkg = mustsetvar($changes{source}, _g('source package'));
 my $version = mustsetvar($changes{version}, _g('source version'));
-checkversion($version);
+check_version($version);
 
 my $maintainer;
 if ($changedby) {

scripts/dpkg-checkbuilddeps.pl

@@ -10,11 +10,7 @@ use Dpkg::Gettext;
 use Dpkg::ErrorHandling qw(error);
 use Dpkg::Arch qw(get_host_arch);
 use Dpkg::Deps;
-
-push(@INC,$dpkglibdir);
-require 'controllib.pl';
-
-our %fi;
+use Dpkg::Control;
 
 textdomain("dpkg-dev");
 
@@ -46,7 +42,8 @@ if ($want_help) {
 
 my $controlfile = shift || "debian/control";
 
-parsecontrolfile($controlfile);
+my $control = Dpkg::Control->new($controlfile);
+my $fields = $control->get_source();
 
 my $facts = parse_status("$admindir/status");
 my (@unmet, @conflicts);
@@ -54,24 +51,24 @@ my (@unmet, @conflicts);
 push @unmet, build_depends('Implicit-Build-Depends',
                            Dpkg::Deps::parse('build-essential'), $facts);
 
-if (defined($fi{"C Build-Depends"})) {
+if (defined($fields->{"Build-Depends"})) {
 	push @unmet, build_depends('Build-Depends',
-                                   Dpkg::Deps::parse($fi{"C Build-Depends"},
+                                   Dpkg::Deps::parse($fields->{"Build-Depends"},
                                         reduce_arch => 1), $facts);
 }
-if (defined($fi{"C Build-Conflicts"})) {
+if (defined($fields->{"C Build-Conflicts"})) {
 	push @conflicts, build_conflicts('Build-Conflicts',
-                                         Dpkg::Deps::parse($fi{"C Build-Conflicts"},
+                                         Dpkg::Deps::parse($fields->{"Build-Conflicts"},
                                             reduce_arch => 1, union => 1), $facts);
 }
-if (! $binary_only && defined($fi{"C Build-Depends-Indep"})) {
+if (! $binary_only && defined($fields->{"Build-Depends-Indep"})) {
 	push @unmet, build_depends('Build-Depends-Indep',
-                                   Dpkg::Deps::parse($fi{"C Build-Depends-Indep"},
+                                   Dpkg::Deps::parse($fields->{"Build-Depends-Indep"},
                                         reduce_arch => 1), $facts);
 }
-if (! $binary_only && defined($fi{"C Build-Conflicts-Indep"})) {
+if (! $binary_only && defined($fields->{"Build-Conflicts-Indep"})) {
 	push @conflicts, build_conflicts('Build-Conflicts-Indep',
-                                         Dpkg::Deps::parse($fi{"C Build-Conflicts-Indep"},
+                                         Dpkg::Deps::parse($fields->{"Build-Conflicts-Indep"},
                                             reduce_arch => 1, union => 1), $facts);
 }
 

scripts/dpkg-distaddfile.pl

@@ -9,9 +9,6 @@ use Dpkg;
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling qw(error syserr usageerr);
 
-push(@INC,$dpkglibdir);
-require 'controllib.pl';
-
 textdomain("dpkg-dev");
 
 my $fileslistfile = 'debian/files';
@@ -63,8 +60,6 @@ my ($file, $section, $priority) = @ARGV;
 
 $fileslistfile="./$fileslistfile" if $fileslistfile =~ m/^\s/;
 open(Y,"> $fileslistfile.new") || &syserr(_g("open new files list file"));
-chown(getfowner(), "$fileslistfile.new") 
-		|| &syserr(_g("chown new files list file"));
 if (open(X,"< $fileslistfile")) {
     while (<X>) {
         s/\n$//;

scripts/dpkg-genchanges.pl

@@ -11,16 +11,13 @@ use Dpkg::Gettext;
 use Dpkg::ErrorHandling qw(warning error failure unknown internerr syserr
                            subprocerr usageerr);
 use Dpkg::Arch qw(get_host_arch debarch_eq debarch_is);
-use Dpkg::Fields qw(capit set_field_importance sort_field_by_importance);
+use Dpkg::Fields qw(:list capit);
 use Dpkg::Compression;
-
-push(@INC,$dpkglibdir);
-require 'controllib.pl';
-
-our (%f, %fi);
-our %p2i;
-our %substvar;
-our $sourcepackage;
+use Dpkg::Control;
+use Dpkg::Cdata;
+use Dpkg::Substvars;
+use Dpkg::Vars;
+use Dpkg::Changelog qw(parse_changelog);
 
 textdomain("dpkg-dev");
 
@@ -36,6 +33,8 @@ my $varlistfile = 'debian/substvars';
 my $uploadfilesdir = '..';
 my $sourcestyle = 'i';
 my $quiet = 0;
+my $host_arch = get_host_arch();
+my $changes_format = "1.7";
 
 my %f2p;           # - file to package map
 my %p2f;           # - package to file map, has entries for "packagename"
@@ -64,6 +63,8 @@ my $forcemaint;
 my $forcechangedby;
 my $since;
 
+my $substvars = Dpkg::Substvars->new();
+
 use constant SOURCE     => 1;
 use constant ARCH_DEP   => 2;
 use constant ARCH_INDEP => 4;
@@ -169,7 +170,7 @@ while (@ARGV) {
     } elsif (m/^-U([^\=:]+)$/) {
         $remove{$1}= 1;
     } elsif (m/^-V(\w[-:0-9A-Za-z]*)[=:]/) {
-	$substvar{$1}= $POSTMATCH;
+	$substvars->set($1, $POSTMATCH);
     } elsif (m/^-(h|-help)$/) {
         &usage; exit(0);
     } elsif (m/^--version$/) {
@@ -179,8 +180,10 @@ while (@ARGV) {
     }
 }
 
-parsechangelog($changelogfile, $changelogformat, $since);
-parsecontrolfile($controlfile);
+my $changelog = parse_changelog($changelogfile, $changelogformat, $since);
+my $control = Dpkg::Control->new($controlfile);
+my $fields = Dpkg::Fields::Object->new();
+$substvars->set_version_substvars($changelog->{"Version"});
 
 if (not is_sourceonly) {
     open(FL,"<",$fileslistfile) || &syserr(_g("cannot read files list file"));
@@ -221,28 +224,31 @@ if (not is_sourceonly) {
     close(FL);
 }
 
-for $_ (keys %fi) {
-    my $v = $fi{$_};
-
-    if (s/^C //) {
-	if (m/^Source$/) {
-	    setsourcepackage($v);
-	}
-	elsif (m/^Section$|^Priority$/i) { $sourcedefault{$_}= $v; }
-	elsif (m/^Maintainer$/i) { $f{$_}= $v; }
-	elsif (s/^X[BS]*C[BS]*-//i) { $f{$_}= $v; }
-	elsif (m/^X[BS]+-/i ||
-	       m/^Build-(Depends|Conflicts)(-Indep)?$/i ||
-	       m/^(Standards-Version|Uploaders|Homepage|Origin|Bugs)$/i ||
-	       m/^Vcs-(Browser|Arch|Bzr|Cvs|Darcs|Git|Hg|Mtn|Svn)$/i) {
-	}
-	else { &unknown(_g('general section of control info file')); }
-    } elsif (s/^C(\d+) //) {
-	my $i = $1;
-	my $p = $fi{"C$i Package"};
-	my $a = $fi{"C$i Architecture"};
-	my $host_arch = get_host_arch();
+# Scan control info of source package
+my $src_fields = $control->get_source();
+foreach $_ (keys %{$src_fields}) {
+    my $v = $src_fields->{$_};
+    if (m/^Source$/) {
+	set_source_package($v);
+    } elsif (m/^Section$|^Priority$/i) {
+	$sourcedefault{$_} = $v;
+    } elsif (m/^Maintainer$/i) {
+	$fields->{$_} = $v;
+    } elsif (s/^X[BS]*C[BS]*-//i) { # Include XC-* fields
+	$fields->{$_} = $v;
+    } elsif (m/^X[BS]+-/i || m/^$control_src_field_regex$/i) {
+	# Silently ignore valid fields
+    } else {
+	unknown(_g('general section of control info file'));
+    }
+}
 
+# Scan control info of all binary packages
+foreach my $pkg ($control->get_packages()) {
+    my $p = $pkg->{"Package"};
+    my $a = $pkg->{"Architecture"};
+    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))
@@ -270,61 +276,58 @@ for $_ (keys %fi) {
 		$f2seccf{$_} = $v foreach (@f);
 	    } elsif (m/^Priority$/) {
 		$f2pricf{$_} = $v foreach (@f);
-	    } elsif (s/^X[BS]*C[BS]*-//i) {
-		$f{$_}= $v;
+	    } 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= '';
+			$v = '';
 		    }
 		} else {
 		    $v = '';
 		}
 		push(@archvalues,$v) unless !$v || $archadded{$v}++;
-	    } elsif (m/^(Package|Package-Type|Kernel-Version|Essential)$/ ||
-	             m/^(Homepage|Tag|Installer-Menu-Item|Subarchitecture)$/i ||
-	             m/^(Pre-Depends|Depends|Recommends|Suggests|Provides)$/ ||
-	             m/^(Enhances|Conflicts|Breaks|Replaces)$/ ||
-		     m/^X[BS]+-/i) {
+	    } 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"));
 	    }
 	}
-    } elsif (s/^L //) {
-        if (m/^Source$/i) {
-	    setsourcepackage($v);
-        } elsif (m/^Maintainer$/i) {
-	    $f{"Changed-By"}=$v;
-        } elsif (m/^(Version|Changes|Urgency|Distribution|Date|Closes)$/i) {
-            $f{$_}= $v;
-        } elsif (s/^X[BS]*C[BS]*-//i) {
-            $f{$_}= $v;
-        } elsif (!m/^X[BS]+-/i) {
-            &unknown(_g("parsed version of changelog"));
-        }
-    } elsif (m/^o:.*/) {
-    } else {
-	internerr("value from nowhere, with key >%s< and value >%s<",
-                  $_, $v);
+    }
+}
+
+# Scan fields of dpkg-parsechangelog
+foreach $_ (keys %{$changelog}) {
+    my $v = $changelog->{$_};
+    if (m/^Source$/i) {
+	set_source_package($v);
+    } elsif (m/^Maintainer$/i) {
+	$fields->{"Changed-By"} = $v;
+    } elsif (m/^(Version|Changes|Urgency|Distribution|Date|Closes)$/i) {
+	$fields->{$_} = $v;
+    } elsif (s/^X[BS]*C[BS]*-//i) {
+	$fields->{$_} = $v;
+    } elsif (!m/^X[BS]+-/i) {
+	unknown(_g("parsed version of changelog"));
     }
 }
 
 if ($changesdescription) {
-    $f{'Changes'}= '';
+    $fields->{'Changes'} = '';
     open(X,"<",$changesdescription) || &syserr(_g("read changesdescription"));
     while(<X>) {
         s/\s*\n$//;
         $_= '.' unless m/\S/;
-        $f{'Changes'}.= "\n $_";
+        $fields->{'Changes'}.= "\n $_";
     }
 }
 
 for my $pa (keys %pa2f) {
     my ($pp, $aa) = (split / /, $pa);
-    defined($p2i{"C $pp"}) ||
+    defined($control->get_pkg_by_name($pp)) ||
 	warning(_g("package %s listed in files list but not in control info"),
 	        $pp);
 }
@@ -354,9 +357,6 @@ for my $p (keys %p2f) {
     }
 }
 
-&init_substvars;
-init_substvar_arch();
-
 my $origsrcmsg;
 
 if (!is_binaryonly) {
@@ -371,14 +371,15 @@ if (!is_binaryonly) {
 	warning(_g("missing Priority for source files"));
     }
 
-    (my $sversion = $substvar{'source:Version'}) =~ s/^\d+://;
+    (my $sversion = $substvars->get('source:Version')) =~ s/^\d+://;
     $dsc= "$uploadfilesdir/${sourcepackage}_${sversion}.dsc";
     open(CDATA, "<", $dsc) || syserr(_g("cannot open .dsc file %s"), $dsc);
     push(@sourcefiles,"${sourcepackage}_${sversion}.dsc");
 
-    parsecdata(\*CDATA, 'S', -1, sprintf(_g("source control file %s"), $dsc));
+    my $dsc_fields = parsecdata(\*CDATA, sprintf(_g("source control file %s"), $dsc),
+				allow_pgp => 1);
 
-    my $files = $fi{'S Files'};
+    my $files = $dsc_fields->{'Files'};
     for my $file (split(/\n /, $files)) {
         next if $file eq '';
         $file =~ m/^([0-9a-f]{32})[ \t]+\d+[ \t]+([0-9a-zA-Z][-+:.,=0-9a-zA-Z_~]+)$/
@@ -410,25 +411,25 @@ if (!is_binaryonly) {
 print(STDERR "$progname: $origsrcmsg\n") ||
     &syserr(_g("write original source message")) unless $quiet;
 
-$f{'Format'}= $substvar{'Format'};
+$fields->{'Format'} = $changes_format;
 
-if (!defined($f{'Date'})) {
+if (!defined($fields->{'Date'})) {
     chomp(my $date822 = `date -R`);
     $? && subprocerr("date -R");
-    $f{'Date'}= $date822;
+    $fields->{'Date'}= $date822;
 }
 
-$f{'Binary'}= join(' ',grep(s/C //,keys %p2i));
+$fields->{'Binary'} = join(' ', map { $_->{'Package'} } $control->get_packages());
 
 unshift(@archvalues,'source') unless is_binaryonly;
 @archvalues = ('all') if $include == ARCH_INDEP;
 @archvalues = grep {!debarch_eq('all',$_)} @archvalues
     unless $include & ARCH_INDEP;
-$f{'Architecture'}= join(' ',@archvalues);
+$fields->{'Architecture'} = join(' ',@archvalues);
 
-$f{'Description'}= "\n ".join("\n ",sort @descriptions);
+$fields->{'Description'} = "\n ".join("\n ",sort @descriptions);
 
-$f{'Files'}= '';
+$fields->{'Files'} = '';
 
 my %filedone;
 
@@ -451,34 +452,36 @@ for my $f (@sourcefiles, @fileslistfiles) {
     defined($md5sum{$f}) && $md5sum{$f} ne $md5sum &&
         error(_g("md5sum of source file %s (%s) is different from md5sum " .
                  "in %s (%s)"), $uf, $md5sum, $dsc, $md5sum{$f});
-    $f{'Files'}.= "\n $md5sum $size $f2sec{$f} $f2pri{$f} $f";
+    $fields->{'Files'}.= "\n $md5sum $size $f2sec{$f} $f2pri{$f} $f";
 }
 
-$f{'Source'}= $sourcepackage;
-if ($f{'Version'} ne $substvar{'source:Version'}) {
-    $f{'Source'} .= " ($substvar{'source:Version'})";
+$fields->{'Source'}= $sourcepackage;
+if ($fields->{'Version'} ne $substvars->get('source:Version')) {
+    $fields->{'Source'} .= " (" . $substvars->get('source:Version') . ")";
 }
 
-$f{'Maintainer'} = $forcemaint if defined($forcemaint);
-$f{'Changed-By'} = $forcechangedby if defined($forcechangedby);
+$fields->{'Maintainer'} = $forcemaint if defined($forcemaint);
+$fields->{'Changed-By'} = $forcechangedby if defined($forcechangedby);
 
 for my $f (qw(Version Distribution Maintainer Changes)) {
-    defined($f{$f}) ||
+    defined($fields->{$f}) ||
         error(_g("missing information for critical output field %s"), $f);
 }
 
 for my $f (qw(Urgency)) {
-    defined($f{$f}) ||
+    defined($fields->{$f}) ||
         warning(_g("missing information for output field %s"), $f);
 }
 
 for my $f (keys %override) {
-    $f{capit($f)} = $override{$f};
+    $fields->{$f} = $override{$f};
 }
 for my $f (keys %remove) {
-    delete $f{capit($f)};
+    delete $fields->{$f};
 }
 
-set_field_importance(@changes_fields);
-outputclose();
+binmode(STDOUT, ":utf8");
+$substvars->parse($varlistfile) if -e $varlistfile;
+tied(%{$fields})->set_field_importance(@changes_fields);
+tied(%{$fields})->output(\*STDOUT, $substvars);
 

scripts/dpkg-gencontrol.pl

@@ -11,15 +11,11 @@ use Dpkg::ErrorHandling qw(warning error failure unknown internerr syserr
                            subprocerr usageerr);
 use Dpkg::Arch qw(get_host_arch debarch_eq debarch_is);
 use Dpkg::Deps qw(@pkg_dep_fields %dep_field_type);
-use Dpkg::Fields qw(capit set_field_importance);
-
-push(@INC,$dpkglibdir);
-require 'controllib.pl';
-
-our %substvar;
-our (%f, %fi);
-our %p2i;
-our $sourcepackage;
+use Dpkg::Fields qw(:list capit);
+use Dpkg::Control;
+use Dpkg::Substvars;
+use Dpkg::Vars;
+use Dpkg::Changelog qw(parse_changelog);
 
 textdomain("dpkg-dev");
 
@@ -44,6 +40,7 @@ my %remove;
 my %override;
 my $oppackage;
 my $package_type = 'deb';
+my $substvars = Dpkg::Substvars->new();
 
 
 sub version {
@@ -83,12 +80,6 @@ Options:
 "), $progname;
 }
 
-sub spfileslistvalue($)
-{
-    return $f{$_[0]} || '-';
-}
-
-
 while (@ARGV) {
     $_=shift(@ARGV);
     if (m/^-p([-+0-9a-z.]+)$/) {
@@ -116,7 +107,7 @@ while (@ARGV) {
     } elsif (m/^-U([^\=:]+)$/) {
         $remove{$1}= 1;
     } elsif (m/^-V(\w[-:0-9A-Za-z]*)[=:]/) {
-        $substvar{$1}= $';
+        $substvars->set($1, $');
     } elsif (m/^-T/) {
         $varlistfile= $';
     } elsif (m/^-n/) {
@@ -130,120 +121,111 @@ while (@ARGV) {
     }
 }
 
-parsechangelog($changelogfile, $changelogformat);
-parsesubstvars($varlistfile);
-parsecontrolfile($controlfile);
+my $changelog = parse_changelog($changelogfile, $changelogformat);
+$substvars->set_version_substvars($changelog->{"Version"});
+$substvars->parse($varlistfile) if -e $varlistfile;
+$substvars->set("binary:Version", $forceversion) if defined $forceversion;
+my $control = Dpkg::Control->new($controlfile);
+my $fields = Dpkg::Fields::Object->new();
 
-my $myindex;
+my $pkg;
 
 if (defined($oppackage)) {
-    defined($p2i{"C $oppackage"}) ||
-        error(_g("package %s not in control info"), $oppackage);
-    $myindex= $p2i{"C $oppackage"};
+    $pkg = $control->get_pkg_by_name($oppackage);
+    defined($pkg) || error(_g("package %s not in control info"), $oppackage);
 } else {
-    my @packages = grep(m/^C /, keys %p2i);
+    my @packages = map { $_->{'Package'} } $control->get_packages();
     @packages==1 ||
         error(_g("must specify package since control info has many (%s)"),
               "@packages");
-    $myindex=1;
+    $pkg = $control->get_pkg_by_idx(1);
 }
 
-#print STDERR "myindex $myindex\n";
-
 my %pkg_dep_fields = map { $_ => 1 } @pkg_dep_fields;
 
-for $_ (keys %fi) {
-    my $v = $fi{$_};
-
-    if (s/^C //) {
-#print STDERR "G key >$_< value >$v<\n";
-	if (m/^(Origin|Bugs|Maintainer)$/) {
-	    $f{$_} = $v;
-	} elsif (m/^(Section|Priority|Homepage)$/) {
-	    # Binary package stanzas can override these fields
-	    $f{$_} ||= $v;
-	} elsif (m/^Source$/) {
-	    setsourcepackage($v);
-	}
-        elsif (s/^X[CS]*B[CS]*-//i) { $f{$_}= $v; }
-	elsif (m/^X[CS]+-/i ||
-	       m/^Build-(Depends|Conflicts)(-Indep)?$/i ||
-	       m/^(Standards-Version|Uploaders)$/i ||
-	       m/^Vcs-(Browser|Arch|Bzr|Cvs|Darcs|Git|Hg|Mtn|Svn)$/i) {
-	}
-        else { $_ = "C $_"; &unknown(_g('general section of control info file')); }
-    } elsif (s/^C$myindex //) {
-#print STDERR "P key >$_< value >$v<\n";
-        if (m/^(Package|Package-Type|Description|Homepage|Tag|Essential)$/ ||
-            m/^(Section$|Priority)$/ ||
-            m/^(Subarchitecture|Kernel-Version|Installer-Menu-Item)$/) {
-            $f{$_}= $v;
-        } elsif (exists($pkg_dep_fields{$_})) {
-	    # Delay the parsing until later
-        } elsif (m/^Architecture$/) {
-	    my $host_arch = get_host_arch();
-
-            if (debarch_eq('all', $v)) {
-                $f{$_}= $v;
-            } else {
-		my @archlist = split(/\s+/, $v);
-		my @invalid_archs = grep m/[^\w-]/, @archlist;
-		warning(ngettext("`%s' is not a legal architecture string.",
-		                 "`%s' are not legal architecture strings.",
-		                 scalar(@invalid_archs)),
-		        join("' `", @invalid_archs))
-		    if @invalid_archs >= 1;
-		grep(debarch_is($host_arch, $_), @archlist) ||
-		    error(_g("current host architecture '%s' does not " .
-		             "appear in package's architecture list (%s)"),
-		          $host_arch, "@archlist");
-		$f{$_} = $host_arch;
-            }
-        } elsif (s/^X[CS]*B[CS]*-//i) {
-            $f{$_}= $v;
-        } elsif (!m/^X[CS]+-/i) {
-            $_ = "C$myindex $_"; &unknown(_g("package's section of control info file"));
-        }
-    } elsif (m/^C\d+ /) {
-#print STDERR "X key >$_< value not shown<\n";
-    } elsif (s/^L //) {
-#print STDERR "L key >$_< value >$v<\n";
-        if (m/^Source$/) {
-	    setsourcepackage($v);
-        } elsif (m/^Version$/) {
-            $sourceversion= $v;
-	    $f{$_} = $v unless defined($forceversion);
-        } elsif (m/^(Maintainer|Changes|Urgency|Distribution|Date|Closes)$/) {
-        } elsif (s/^X[CS]*B[CS]*-//i) {
-            $f{$_}= $v;
-        } elsif (!m/^X[CS]+-/i) {
-            $_ = "L $_"; &unknown(_g("parsed version of changelog"));
-        }
-    } elsif (m/o:/) {
+# Scan source package
+my $src_fields = $control->get_source();
+foreach $_ (keys %{$src_fields}) {
+    my $v = $src_fields->{$_};
+    if (m/^(Origin|Bugs|Maintainer|Section|Priority|Homepage)$/) {
+	$fields->{$_} = $v;
+    } elsif (m/^Source$/) {
+	set_source_package($v);
+    } elsif (s/^X[CS]*B[CS]*-//i) { # Include XB-* fields
+	$fields->{$_} = $v;
+    } elsif (m/^X[CS]+-/i || m/^$control_src_field_regex$/i) {
+	# Silently ignore valid fields
     } else {
-        internerr(_g("value from nowhere, with key >%s< and value >%s<"), $_, $v);
+	unknown(_g('general section of control info file'));
+    }
+}
+
+# Scan binary package
+foreach $_ (keys %{$pkg}) {
+    my $v = $pkg->{$_};
+    if (exists($pkg_dep_fields{$_})) {
+	# Delay the parsing until later
+    } elsif (m/^Architecture$/) {
+	my $host_arch = get_host_arch();
+
+	if (debarch_eq('all', $v)) {
+	    $fields->{$_} = $v;
+	} else {
+	    my @archlist = split(/\s+/, $v);
+	    my @invalid_archs = grep m/[^\w-]/, @archlist;
+	    warning(ngettext("`%s' is not a legal architecture string.",
+			     "`%s' are not legal architecture strings.",
+			     scalar(@invalid_archs)),
+		    join("' `", @invalid_archs))
+		if @invalid_archs >= 1;
+	    grep(debarch_is($host_arch, $_), @archlist) ||
+		error(_g("current host architecture '%s' does not " .
+			 "appear in package's architecture list (%s)"),
+		      $host_arch, "@archlist");
+	    $fields->{$_} = $host_arch;
+	}
+    } elsif (m/^$control_pkg_field_regex$/) {
+	$fields->{$_} = $v;
+    } elsif (s/^X[CS]*B[CS]*-//i) { # Include XB-* fields
+	$fields->{$_} = $v;
+    } elsif (!m/^X[CS]+-/i) {
+	unknown(_g("package's section of control info file"));
     }
 }
 
-$f{'Version'} = $forceversion if defined($forceversion);
+# Scan fields of dpkg-parsechangelog
+foreach $_ (keys %{$changelog}) {
+    my $v = $changelog->{$_};
+
+    if (m/^Source$/) {
+	set_source_package($v);
+    } elsif (m/^Version$/) {
+	$sourceversion = $v;
+	$fields->{$_} = $v unless defined($forceversion);
+    } elsif (m/^(Maintainer|Changes|Urgency|Distribution|Date|Closes)$/) {
+    } elsif (s/^X[CS]*B[CS]*-//i) {
+	$fields->{$_} = $v;
+    } elsif (!m/^X[CS]+-/i) {
+	unknown(_g("parsed version of changelog"));
+    }
+}
 
-&init_substvars;
-init_substvar_arch();
+$fields->{'Version'} = $forceversion if defined($forceversion);
 
 # Process dependency fields in a second pass, now that substvars have been
 # initialized.
 
 my $facts = Dpkg::Deps::KnownFacts->new();
-$facts->add_installed_package($f{'Package'}, $f{'Version'});
-if (exists $fi{"C$myindex Provides"}) {
-    my $provides = Dpkg::Deps::parse(substvars($fi{"C$myindex Provides"}),
+$facts->add_installed_package($fields->{'Package'}, $fields->{'Version'});
+if (exists $pkg->{"Provides"}) {
+    my $provides = Dpkg::Deps::parse($substvars->substvars($pkg->{"Provides"}),
                                      reduce_arch => 1, union => 1);
     if (defined $provides) {
 	foreach my $subdep ($provides->get_deps()) {
 	    if ($subdep->isa('Dpkg::Deps::Simple')) {
 		$facts->add_provided_package($subdep->{package},
                         $subdep->{relation}, $subdep->{version},
-                        $f{'Package'});
+                        $fields->{'Package'});
 	    }
 	}
     }
@@ -251,10 +233,9 @@ if (exists $fi{"C$myindex Provides"}) {
 
 my (@seen_deps);
 foreach my $field (@pkg_dep_fields) {
-    my $key = "C$myindex $field";
-    if (exists $fi{$key}) {
+    if (exists $pkg->{$field}) {
 	my $dep;
-	my $field_value = substvars($fi{$key});
+	my $field_value = $substvars->substvars($pkg->{$field});
 	if ($dep_field_type{$field} eq 'normal') {
 	    $dep = Dpkg::Deps::parse($field_value, use_arch => 1,
                                      reduce_arch => 1);
@@ -269,36 +250,36 @@ foreach my $field (@pkg_dep_fields) {
 	    $dep->simplify_deps($facts);
 	}
 	$dep->sort();
-	$f{$field} = $dep->dump();
-	delete $f{$field} unless $f{$field}; # Delete empty field
+	$fields->{$field} = $dep->dump();
+	delete $fields->{$field} unless $fields->{$field}; # Delete empty field
     }
 }
 
 for my $f (qw(Package Version)) {
-    defined($f{$f}) || error(_g("missing information for output field %s"), $f);
+    defined($fields->{$f}) || error(_g("missing information for output field %s"), $f);
 }
 for my $f (qw(Maintainer Description Architecture)) {
-    defined($f{$f}) || warning(_g("missing information for output field %s"), $f);
+    defined($fields->{$f}) || warning(_g("missing information for output field %s"), $f);
 }
-$oppackage= $f{'Package'};
+$oppackage = $fields->{'Package'};
 
-$package_type = $f{'Package-Type'} if (defined($f{'Package-Type'}));
+$package_type = $fields->{'Package-Type'} if (defined($fields->{'Package-Type'}));
 
 if ($package_type ne 'udeb') {
     for my $f (qw(Subarchitecture Kernel-Version Installer-Menu-Item)) {
         warning(_g("%s package with udeb specific field %s"), $package_type, $f)
-            if defined($f{$f});
+            if defined($fields->{$f});
     }
 }
 
-my $verdiff = $f{'Version'} ne $substvar{'source:Version'} ||
-              $f{'Version'} ne $sourceversion;
+my $verdiff = $fields->{'Version'} ne $substvars->get('source:Version') ||
+              $fields->{'Version'} ne $sourceversion;
 if ($oppackage ne $sourcepackage || $verdiff) {
-    $f{'Source'}= $sourcepackage;
-    $f{'Source'}.= " ($substvar{'source:Version'})" if $verdiff;
+    $fields->{'Source'} = $sourcepackage;
+    $fields->{'Source'} .= " (" . $substvars->get('source:Version') . ")" if $verdiff;
 }
 
-if (!defined($substvar{'Installed-Size'})) {
+if (!defined($substvars->get('Installed-Size'))) {
     defined(my $c = open(DU, "-|")) || syserr(_g("fork for du"));
     if (!$c) {
         chdir("$packagebuilddir") ||
@@ -313,35 +294,34 @@ if (!defined($substvar{'Installed-Size'})) {
     $? && subprocerr(_g("du in \`%s'"), $packagebuilddir);
     $duo =~ m/^(\d+)\s+\.$/ ||
         failure(_g("du gave unexpected output \`%s'"), $duo);
-    $substvar{'Installed-Size'}= $1;
+    $substvars->set('Installed-Size', $1);
 }
-if (defined($substvar{'Extra-Size'})) {
-    $substvar{'Installed-Size'} += $substvar{'Extra-Size'};
+if (defined($substvars->get('Extra-Size'))) {
+    my $size = $substvars->get('Extra-Size') + $substvars->get('Installed-Size');
+    $substvars->set('Installed-Size', $size);
 }
-if (defined($substvar{'Installed-Size'})) {
-    $f{'Installed-Size'}= $substvar{'Installed-Size'};
+if (defined($substvars->get('Installed-Size'))) {
+    $fields->{'Installed-Size'} = $substvars->get('Installed-Size');
 }
 
 for my $f (keys %override) {
-    $f{capit($f)} = $override{$f};
+    $fields->{$f} = $override{$f};
 }
 for my $f (keys %remove) {
-    delete $f{capit($f)};
+    delete $fields->{$f};
 }
 
 $fileslistfile="./$fileslistfile" if $fileslistfile =~ m/^\s/;
-open(Y,"> $fileslistfile.new") || &syserr(_g("open new files list file"));
+open(Y, ">", "$fileslistfile.new") || &syserr(_g("open new files list file"));
 binmode(Y);
-chown(getfowner(), "$fileslistfile.new") 
-		|| &syserr(_g("chown new files list file"));
-if (open(X,"< $fileslistfile")) {
+if (open(X, "<", $fileslistfile)) {
     binmode(X);
     while (<X>) {
         chomp;
         next if m/^([-+0-9a-z.]+)_[^_]+_([\w-]+)\.(a-z+) /
                 && ($1 eq $oppackage)
 	        && ($3 eq $package_type)
-	        && (debarch_eq($2, $f{'Architecture'})
+	        && (debarch_eq($2, $fields->{'Architecture'})
 		    || debarch_eq($2, 'all'));
         print(Y "$_\n") || &syserr(_g("copy old entry to new files list file"));
     }
@@ -349,31 +329,37 @@ if (open(X,"< $fileslistfile")) {
 } elsif ($! != ENOENT) {
     &syserr(_g("read old files list file"));
 }
-my $sversion = $f{'Version'};
+my $sversion = $fields->{'Version'};
 $sversion =~ s/^\d+://;
-$forcefilename = sprintf("%s_%s_%s.%s", $oppackage, $sversion, $f{'Architecture'},
+$forcefilename = sprintf("%s_%s_%s.%s", $oppackage, $sversion, $fields->{'Architecture'},
 			 $package_type)
 	   unless ($forcefilename);
-print(Y &substvars(sprintf("%s %s %s\n", $forcefilename, 
-                           &spfileslistvalue('Section'), &spfileslistvalue('Priority'))))
+print(Y $substvars->substvars(sprintf("%s %s %s\n", $forcefilename,
+				      $fields->{'Section'} || '-',
+				      $fields->{'Priority'} || '-')))
     || &syserr(_g("write new entry to new files list file"));
 close(Y) || &syserr(_g("close new files list file"));
 rename("$fileslistfile.new",$fileslistfile) || &syserr(_g("install new files list file"));
 
 my $cf;
+my $fh_output;
 if (!$stdout) {
     $cf= "$packagebuilddir/DEBIAN/control";
     $cf= "./$cf" if $cf =~ m/^\s/;
-    open(STDOUT,"> $cf.new") ||
+    open($fh_output, ">:utf8", "$cf.new") ||
         syserr(_g("cannot open new output control file \`%s'"), "$cf.new");
-    binmode(STDOUT);
+} else {
+    $fh_output = \*STDOUT;
+    binmode(STDOUT, ":utf8");
 }
 
-set_field_importance(@control_fields);
-outputclose($varlistfile);
+tied(%{$fields})->set_field_importance(@control_fields);
+tied(%{$fields})->output($fh_output, $substvars);
 
 if (!$stdout) {
+    close($fh_output);
     rename("$cf.new", "$cf") ||
         syserr(_g("cannot install output control file \`%s'"), $cf);
 }
 
+

scripts/dpkg-gensymbols.pl

@@ -10,16 +10,11 @@ use Dpkg::Shlibs::Objdump;
 use Dpkg::Shlibs::SymbolFile;
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling qw(warning error syserr usageerr);
+use Dpkg::Control;
+use Dpkg::Changelog qw(parse_changelog);
 
 textdomain("dpkg-dev");
 
-push(@INC, $dpkglibdir);
-require 'controllib.pl';
-
-our (%f, %fi);
-our %p2i;
-
-my $controlfile = 'debian/control';
 my $changelogfile = 'debian/changelog';
 my $packagebuilddir = 'debian/tmp';
 
@@ -114,17 +109,16 @@ if (exists $ENV{DPKG_GENSYMBOLS_CHECK_LEVEL}) {
 }
 
 if (not defined($sourceversion)) {
-    parsechangelog($changelogfile);
-    $sourceversion = $fi{"L Version"};
+    my $changelog = parse_changelog($changelogfile);
+    $sourceversion = $changelog->{"Version"};
 }
 if (not defined($oppackage)) {
-    parsecontrolfile($controlfile);
-    my @packages = grep(m/^C /, keys %p2i);
+    my $control = Dpkg::Control->new();
+    my @packages = map { $_->{'Package'} } $control->get_packages();
     @packages == 1 ||
 	error(_g("must specify package since control info has many (%s)"),
 	      "@packages");
     $oppackage = $packages[0];
-    $oppackage =~ s/^C //;
 }
 
 my $symfile = Dpkg::Shlibs::SymbolFile->new();

scripts/dpkg-parsechangelog.pl

@@ -3,6 +3,7 @@
 use strict;
 use warnings;
 
+use English;
 use POSIX;
 use POSIX qw(:errno_h);
 use Dpkg;
@@ -16,7 +17,7 @@ my $changelogfile = 'debian/changelog';
 my @parserpath = ("/usr/local/lib/dpkg/parsechangelog",
                   "$dpkglibdir/parsechangelog");
 
-my $libdir;	# XXX: Not used!?
+my $libdir;
 my $force;
 
 
@@ -39,11 +40,27 @@ sub usage {
 
 Options:
   -l<changelogfile>        get per-version info from this file.
-  -v<sinceversion>         include all changes later than version.
   -F<changelogformat>      force change log format.
   -L<libdir>               look for change log parsers in <libdir>.
   -h, --help               show this help message.
       --version            show the version.
+
+parser options:
+    --format <outputformat>     see man page for list of available
+                                output formats, defaults to 'dpkg'
+                                for compatibility with dpkg-dev
+    --since, -s, -v <version>   include all changes later than version
+    --until, -u <version>       include all changes earlier than version
+    --from, -f <version>        include all changes equal or later
+                                than version
+    --to, -t <version>          include all changes up to or equal
+                                than version
+    --count, -c, -n <number>    include <number> entries from the top
+                                (or the tail if <number> is lower than 0)
+    --offset, -o <number>       change the starting point for --count,
+                                counted from the top (or the tail if
+                                <number> is lower than 0)
+    --all                       include all changes
 "), $progname;
 }
 
@@ -51,24 +68,28 @@ my @ap = ();
 while (@ARGV) {
     last unless $ARGV[0] =~ m/^-/;
     $_= shift(@ARGV);
-    if (m/^-L/ && length($_)>2) { $libdir=$'; next; }
+    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=$'; next; }
+    if (m/^-l/ && length($_)>2) { $changelogfile=$POSTMATCH; next; }
     m/^--$/ && last;
-    m/^-v/ && next;
+    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("unknown option \`$_'");
+    &usageerr(_g("unknown option \`%s'"), $_);
 }
 
 @ARGV && usageerr(_g("%s takes no non-option arguments"), $progname);
-$changelogfile= "./$changelogfile" if $changelogfile =~ m/^\s/;
 
 if (not $force and $changelogfile ne "-") {
-    open(STDIN,"< $changelogfile") ||
-        error(_g("cannot open %s to find format: %s"), $changelogfile, $!);
-    open(P,"tail -n 40 |") || die sprintf(_g("cannot fork: %s"), $!)."\n";
+    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;
@@ -79,6 +100,7 @@ if (not $force and $changelogfile ne "-") {
 
 my ($pa, $pf);
 
+unshift(@parserpath, $libdir) if $libdir;
 for my $pd (@parserpath) {
     $pa= "$pd/$format";
     if (!stat("$pa")) {
@@ -90,11 +112,12 @@ for my $pd (@parserpath) {
 	last;
     }
 }
-        
+
 defined($pf) || error(_g("format %s unknown"), $pa);
 
 if ($changelogfile ne "-") {
-    open(STDIN,"< $changelogfile") || die sprintf(_g("cannot open %s: %s"), $changelogfile, $!)."\n";
+    open(STDIN,"<", $changelogfile)
+	|| syserr(_g("cannot open %s: %s"), $changelogfile);
 }
-exec($pf,@ap); die sprintf(_g("cannot exec format parser: %s"), $!)."\n";
+exec($pf,@ap) || syserr(_g("cannot exec format parser: %s"));
 

scripts/dpkg-shlibdeps.pl

@@ -18,9 +18,7 @@ use Dpkg::Shlibs::SymbolFile;
 use Dpkg::Arch qw(get_host_arch);
 use Dpkg::Fields qw(capit);
 use Dpkg::Deps;
-
-push(@INC,$dpkglibdir);
-require 'controllib.pl';
+use Dpkg::Control;
 
 # By increasing importance
 my @depfields = qw(Suggests Recommends Depends Pre-Depends);
@@ -92,10 +90,10 @@ foreach (@ARGV) {
 
 scalar keys %exec || usageerr(_g("need at least one executable"));
 
-our %fi;
-parsecontrolfile("debian/control");
-my $build_depends = defined($fi{"C Build-Depends"}) ?
-		    $fi{"C Build-Depends"} : "";
+my $control = Dpkg::Control->new();
+my $fields = $control->get_source();
+my $build_depends = defined($fields->{"Build-Depends"}) ?
+		    $fields->{"Build-Depends"} : "";
 my $build_deps = Dpkg::Deps::parse($build_depends, reduce_arch => 1);
 
 my %dependencies;

scripts/dpkg-source.pl

@@ -10,8 +10,14 @@ use Dpkg::ErrorHandling qw(warning warnerror error failure unknown
                            $warnable_error $quiet_warnings);
 use Dpkg::Arch qw(debarch_eq);
 use Dpkg::Deps qw(@src_dep_fields %dep_field_type);
-use Dpkg::Fields qw(capit set_field_importance);
+use Dpkg::Fields qw(:list capit);
 use Dpkg::Compression;
+use Dpkg::Cdata;
+use Dpkg::Control;
+use Dpkg::Substvars;
+use Dpkg::Version qw(check_version);
+use Dpkg::Vars;
+use Dpkg::Changelog qw(parse_changelog);
 
 my @filesinarchive;
 my %dirincluded;
@@ -19,7 +25,7 @@ my %notfileobject;
 my $fn;
 my $ur;
 
-my $varlistfile;
+my $varlistfile = "debian/substvars";
 my $controlfile;
 my $changelogfile;
 my $changelogformat;
@@ -100,26 +106,20 @@ my %dirtocreate;	 # used by checkdiff
 
 my @tar_ignore;
 
+my $substvars = Dpkg::Substvars->new();
+
 use POSIX;
 use Fcntl qw (:mode);
 use English;
 use File::Temp qw (tempfile);
 use Cwd;
 
-push (@INC, $dpkglibdir);
-require 'controllib.pl';
-
-our (%f, %fi);
-our $sourcepackage;
-our %substvar;
-our @src_dep_fields;
-
 textdomain("dpkg-dev");
 
 my @dsc_fields = (qw(Format Source Binary Architecture Version Origin
-                     Maintainer Uploaders Homepage Standards-Version
-                     Vcs-Browser Vcs-Arch Vcs-Bzr Vcs-Cvs Vcs-Darcs
-                     Vcs-Git Vcs-Hg Vcs-Mtn Vcs-Svn),
+		     Maintainer Uploaders Dm-Upload-Allowed Homepage
+		     Standards-Version Vcs-Browser Vcs-Arch Vcs-Bzr
+		     Vcs-Cvs Vcs-Darcs Vcs-Git Vcs-Hg Vcs-Mtn Vcs-Svn),
                   @src_dep_fields);
 
 
@@ -257,9 +257,9 @@ while (@ARGV && $ARGV[0] =~ m/^-/) {
             $tar_ignore_default_pattern_done = 1;
         }
     } elsif (m/^-V(\w[-:0-9A-Za-z]*)[=:]/) {
-        $substvar{$1}= $POSTMATCH;
+        $substvars->set($1, $POSTMATCH);
     } elsif (m/^-T/) {
-        $varlistfile= $POSTMATCH;
+	$varlistfile = $POSTMATCH;
     } elsif (m/^-(h|-help)$/) {
         &usage; exit(0);
     } elsif (m/^--version$/) {
@@ -293,45 +293,53 @@ if ($opmode eq 'build') {
     $changelogfile= "$dir/debian/changelog" unless defined($changelogfile);
     $controlfile= "$dir/debian/control" unless defined($controlfile);
     
-    parsechangelog($changelogfile, $changelogformat);
-    parsecontrolfile($controlfile);
-    $f{"Format"}= $compression eq 'gzip' ? $def_dscformat : '2.0';
-    &init_substvars;
+    my $changelog = parse_changelog($changelogfile, $changelogformat);
+    my $control = Dpkg::Control->new($controlfile);
+    my $fields = Dpkg::Fields::Object->new();
+
+    $fields->{"Format"} = $compression eq 'gzip' ? $def_dscformat : '2.0';
 
     my @sourcearch;
     my %archadded;
     my $archspecific = 0; # XXX: Not used?!
-    my %packageadded;
     my @binarypackages;
 
-    for $_ (keys %fi) {
-        my $v = $fi{$_};
+    # Scan control info of source package
+    my $src_fields = $control->get_source();
+    foreach $_ (keys %{$src_fields}) {
+	my $v = $src_fields->{$_};
+	if (m/^Source$/i) {
+	    set_source_package($v);
+	} elsif (m/^(Standards-Version|Origin|Maintainer|Homepage)$/i ||
+		 m/^Dm-Upload-Allowed$/i ||
+		 m/^Vcs-(Browser|Arch|Bzr|Cvs|Darcs|Git|Hg|Mtn|Svn)$/i) {
+	    $fields->{$_} = $v;
+	} elsif (m/^Uploaders$/i) {
+	    ($fields->{$_} = $v) =~ s/[\r\n]//g; # Merge in a single-line
+	} elsif (m/^Build-(Depends|Conflicts)(-Indep)?$/i) {
+	    my $dep;
+	    my $type = $dep_field_type{capit($_)};
+	    $dep = Dpkg::Deps::parse($v, union =>  $type eq 'union');
+	    error(_g("error occurred while parsing %s"), $_) unless defined $dep;
+	    my $facts = Dpkg::Deps::KnownFacts->new();
+	    $dep->simplify_deps($facts);
+	    $dep->sort();
+	    $fields->{$_} = $dep->dump();
+	} elsif (s/^X[BC]*S[BC]*-//i) { # Include XS-* fields
+	    $fields->{$_} = $v;
+	} elsif (m/^$control_src_field_regex$/i || m/^X[BC]+-/i) {
+	    # Silently ignore valid fields
+	} else {
+	    unknown(_g('general section of control info file'));
+	}
+    }
 
-        if (s/^C //) {
-	    if (m/^Source$/i) {
-		setsourcepackage($v);
-	    } elsif (m/^(Format|Standards-Version|Origin|Maintainer|Homepage)$/i ||
-	             m/^Vcs-(Browser|Arch|Bzr|Cvs|Darcs|Git|Hg|Mtn|Svn)$/i) {
-		$f{$_}= $v;
-	    }
-	    elsif (m/^Uploaders$/i) { ($f{$_}= $v) =~ s/[\r\n]//g; }
-	    elsif (m/^Build-(Depends|Conflicts)(-Indep)?$/i) {
-		my $dep;
-		my $type = $dep_field_type{capit($_)};
-		$dep = Dpkg::Deps::parse($v, union =>  $type eq 'union');
-		error(_g("error occurred while parsing %s"), $_) unless defined $dep;
-		my $facts = Dpkg::Deps::KnownFacts->new();
-		$dep->simplify_deps($facts);
-		$dep->sort();
-		$f{$_}= $dep->dump();
-	    }
-            elsif (s/^X[BC]*S[BC]*-//i) { $f{$_}= $v; }
-            elsif (m/^(Section|Priority|Files|Bugs)$/i || m/^X[BC]+-/i) { }
-            else { &unknown(_g('general section of control info file')); }
-        } elsif (s/^C(\d+) //) {
-	    my $i = $1;
-	    my $p = $fi{"C$i Package"};
-            push(@binarypackages,$p) unless $packageadded{$p}++;
+    # Scan control info of binary packages
+    foreach my $pkg ($control->get_packages()) {
+	my $p = $pkg->{'Package'};
+	push(@binarypackages,$p);
+	foreach $_ (keys %{$pkg}) {
+	    my $v = $pkg->{$_};
             if (m/^Architecture$/) {
 		if (debarch_eq($v, 'any')) {
                     @sourcearch= ('any');
@@ -357,36 +365,33 @@ if ($opmode eq 'build') {
                         }
                 }
                 }
-                $f{'Architecture'}= join(' ',@sourcearch);
-            } elsif (s/^X[BC]*S[BC]*-//i) {
-                $f{$_}= $v;
-            } elsif (m/^(Package|Package-Type|Essential|Kernel-Version)$/ ||
-                     m/^(Homepage|Subarchitecture|Installer-Menu-Item)$/i ||
-                     m/^(Pre-Depends|Depends|Provides)$/i ||
-                     m/^(Recommends|Suggests|Conflicts|Replaces)$/i ||
-                     m/^(Breaks|Enhances|Description|Tag|Section|Priority)$/i ||
-                     m/^X[BC]+-/i) {
-            } else {
-                &unknown(_g("package's section of control info file"));
-            }
-        } elsif (s/^L //) {
-            if (m/^Source$/) {
-		setsourcepackage($v);
-            } elsif (m/^Version$/) {
-		checkversion( $v );
-                $f{$_}= $v;
-            } elsif (s/^X[BS]*C[BS]*-//i) {
-                $f{$_}= $v;
-            } elsif (m/^(Maintainer|Changes|Urgency|Distribution|Date|Closes)$/i ||
-                     m/^X[BS]+-/i) {
+                $fields->{'Architecture'}= join(' ',@sourcearch);
+            } elsif (s/^X[BC]*S[BC]*-//i) { # Include XS-* fields
+                $fields->{$_} = $v;
+            } elsif (m/^$control_pkg_field_regex$/ ||
+                     m/^X[BC]+-/i) { # Silently ignore valid fields
             } else {
-                &unknown(_g("parsed version of changelog"));
+                unknown(_g("package's section of control info file"));
             }
-        } elsif (m/^o:.*/) {
-        } else {
-	    internerr(_g("value from nowhere, with key >%s< and value >%s<"),
-	              $_, $v);
-        }
+	}
+    }
+
+    # Scan fields of dpkg-parsechangelog
+    foreach $_ (keys %{$changelog}) {
+        my $v = $changelog->{$_};
+
+	if (m/^Source$/) {
+	    set_source_package($v);
+	} elsif (m/^Version$/) {
+	    check_version($v);
+	    $fields->{$_} = $v;
+	} elsif (s/^X[BS]*C[BS]*-//i) {
+	    $fields->{$_} = $v;
+	} elsif (m/^(Maintainer|Changes|Urgency|Distribution|Date|Closes)$/i ||
+		 m/^X[BS]+-/i) {
+	} else {
+	    unknown(_g("parsed version of changelog"));
+	}
     }
     
     my $vcs;
@@ -422,26 +427,26 @@ if ($opmode eq 'build') {
         usageerr(_g("source handling style -s%s not allowed with -b"),
 		$sourcestyle);
 
-    $f{'Binary'}= join(', ',@binarypackages);
-    for my $f (keys %override) {
-	$f{capit($f)} = $override{$f};
+    $fields->{'Binary'}= join(', ', @binarypackages);
+    foreach my $f (keys %override) {
+	$fields->{$f} = $override{$f};
     }
 
     for my $f (qw(Version)) {
-	defined($f{$f}) ||
+	defined($fields->{$f}) ||
 	    error(_g("missing information for critical output field %s"), $f);
     }
     for my $f (qw(Maintainer Architecture Standards-Version)) {
-	defined($f{$f}) ||
+	defined($fields->{$f}) ||
 	    warning(_g("missing information for output field %s"), $f);
     }
     defined($sourcepackage) || &error(_g("unable to determine source package name !"));
-    $f{'Source'}= $sourcepackage;
+    $fields->{'Source'} = $sourcepackage;
     for my $f (keys %remove) {
-	delete $f{capit($f)};
+	delete $fields->{$f};
     }
 
-    my $version = $f{'Version'};
+    my $version = $fields->{'Version'};
     $version =~ s/^\d+://;
     my $upstreamversion = $version;
     $upstreamversion =~ s/-[^-]*$//;
@@ -552,7 +557,7 @@ if ($opmode eq 'build') {
 
 	$tarname= $origtargz || "$basename.orig.tar.$comp_ext";
 	if ($tarname =~ /\Q$basename\E\.orig\.tar\.($comp_regex)/) {
-	    if (($1 ne 'gz') && ($f{'Format'} < 2)) { $f{'Format'} = '2.0' };
+	    if (($1 ne 'gz') && ($fields->{'Format'} < 2)) { $fields->{'Format'} = '2.0' };
 	} else {
 	    warning(_g(".orig.tar name %s is not <package>_<upstreamversion>" .
 	               ".orig.tar (wanted %s)"),
@@ -605,7 +610,7 @@ if ($opmode eq 'build') {
         
     }
     
-    addfile("$tarname");
+    addfile($fields, "$tarname");
 
     if ($sourcestyle =~ m/[kpKP]/) {
 
@@ -799,7 +804,7 @@ if ($opmode eq 'build') {
         }
         close(FIND); $? && subprocerr("find on $dirname");
 
-	&addfile($diffname);
+	addfile($fields, $diffname);
 
     }
 
@@ -810,11 +815,13 @@ if ($opmode eq 'build') {
     printf(_g("%s: building %s in %s")."\n",
            $progname, $sourcepackage, "$basenamerev.dsc")
         || &syserr(_g("write building message"));
-    open(STDOUT, "> $basenamerev.dsc") ||
+    open(DSC, ">:utf8", "$basenamerev.dsc") ||
         syserr(_g("create %s"), "$basenamerev.dsc");
 
-    set_field_importance(@dsc_fields);
-    outputclose($varlistfile);
+    $substvars->parse($varlistfile) if -e $varlistfile;
+    tied(%{$fields})->set_field_importance(@dsc_fields);
+    tied(%{$fields})->output(\*DSC, $substvars);
+    close(DSC);
 
     if ($ur) {
         printf(STDERR _g("%s: unrepresentable changes to source")."\n",
@@ -847,7 +854,7 @@ if ($opmode eq 'build') {
     }
 
     my $is_signed = 0;
-    open(DSC, "< $dsc") || error(_g("cannot open .dsc file %s: %s"), $dsc, $!);
+    open(DSC, "<", $dsc) || error(_g("cannot open .dsc file %s: %s"), $dsc, $!);
     while (<DSC>) {
 	next if /^\s*$/o;
 	$is_signed = 1 if /^-----BEGIN PGP SIGNED MESSAGE-----$/o;
@@ -878,31 +885,31 @@ if ($opmode eq 'build') {
 	warning(_g("extracting unsigned source package (%s)"), $dsc);
     }
 
-    open(CDATA, "< $dsc") || error(_g("cannot open .dsc file %s: %s"), $dsc, $!);
-    parsecdata(\*CDATA, 'S', -1, sprintf(_g("source control file %s"), $dsc));
+    open(CDATA, "<", $dsc) || error(_g("cannot open .dsc file %s: %s"), $dsc, $!);
+    my $fields = parsecdata(\*CDATA, sprintf(_g("source control file %s"), $dsc),
+			    allow_pgp => 1);
     close(CDATA);
 
     for my $f (qw(Source Version Files)) {
-        defined($fi{"S $f"}) ||
+        defined($fields->{$f}) ||
             error(_g("missing critical source control field %s"), $f);
     }
 
     my $dscformat = $def_dscformat;
-    if (defined $fi{'S Format'}) {
-	if (not handleformat($fi{'S Format'})) {
-	    error(_g("Unsupported format of .dsc file (%s)"), $fi{'S Format'});
+    if (defined $fields->{'Format'}) {
+	if (not handleformat($fields->{'Format'})) {
+	    error(_g("Unsupported format of .dsc file (%s)"), $fields->{'Format'});
 	}
-        $dscformat=$fi{'S Format'};
+        $dscformat=$fields->{'Format'};
     }
 
-    $sourcepackage = $fi{'S Source'}; # XXX: should use setsourcepackage??
-    checkpackagename( $sourcepackage );
+    set_source_package($fields->{'Source'});
 
-    my $version = $fi{'S Version'};
+    my $version = $fields->{'Version'};
     my $baseversion;
     my $revision;
 
-    checkversion( $version );
+    check_version($version);
     $version =~ s/^\d+://;
     if ($version =~ m/-([^-]+)$/) {
         $baseversion= $`; $revision= $1;
@@ -910,7 +917,7 @@ if ($opmode eq 'build') {
         $baseversion= $version; $revision= '';
     }
 
-    my $files = $fi{'S Files'};
+    my $files = $fields->{'Files'};
     my @tarfiles;
     my $difffile;
     my $debianfile;
@@ -1190,7 +1197,7 @@ sub checkstats {
     my ($f) = @_;
     my @s;
     my $m;
-    open(STDIN, "< $dscdir/$f") || syserr(_g("cannot read %s"), "$dscdir/$f");
+    open(STDIN, "<", "$dscdir/$f") || syserr(_g("cannot read %s"), "$dscdir/$f");
     (@s = stat(STDIN)) || syserr(_g("cannot fstat %s"), "$dscdir/$f");
     $s[7] == $size{$f} || error(_g("file %s has size %s instead of expected %s"),
                                 $f, $s[7], $size{$f});
@@ -1198,7 +1205,7 @@ sub checkstats {
     $m = readmd5sum( $m );
     $m eq $md5sum{$f} || error(_g("file %s has md5sum %s instead of expected %s"),
                                $f, $m, $md5sum{$f});
-    open(STDIN,"</dev/null") || &syserr(_g("reopen stdin from /dev/null"));
+    open(STDIN, "<", "/dev/null") || &syserr(_g("reopen stdin from /dev/null"));
 }
 
 sub erasedir {
@@ -1646,6 +1653,7 @@ sub forkgzipwrite {
 
     open(GZIPFILE, ">", $_[0]) || syserr(_g("create file %s"), $_[0]);
     pipe(GZIPREAD,GZIP) || &syserr(_g("pipe for gzip"));
+    binmode(GZIP);
     defined($cgz= fork) || &syserr(_g("fork for gzip"));
     if (!$cgz) {
 	open(STDIN,"<&",\*GZIPREAD) || &syserr(_g("reopen gzip pipe"));
@@ -1673,6 +1681,7 @@ sub forkgzipread {
 
     open(GZIPFILE, "<", $_[0]) || syserr(_g("read file %s"), $_[0]);
     pipe(GZIP, GZIPWRITE) || syserr(_g("pipe for %s"), $prog);
+    binmode(GZIP);
     defined($cgz = fork) || syserr(_g("fork for %s"), $prog);
     if (!$cgz) {
 	open(STDOUT, ">&", \*GZIPWRITE) || syserr(_g("reopen %s pipe"), $prog);
@@ -1693,7 +1702,7 @@ sub reapgzip {
 
 my %added_files;
 sub addfile {
-    my ($filename)= @_;
+    my ($fields, $filename)= @_;
     $added_files{$filename}++ &&
         internerr(_g("tried to add file `%s' twice"), $filename);
     stat($filename) || syserr(_g("could not stat output file `%s'"), $filename);
@@ -1701,7 +1710,7 @@ sub addfile {
     my $md5sum= `md5sum <$filename`;
     $? && &subprocerr("md5sum $filename");
     $md5sum = readmd5sum( $md5sum );
-    $f{'Files'}.= "\n $md5sum $size $filename";
+    $fields->{'Files'}.= "\n $md5sum $size $filename";
 }
 
 # replace \ddd with their corresponding character, refuse \ddd > \377
@@ -1724,3 +1733,10 @@ sub deoctify {
     return join("", @_);
 } }
 
+sub readmd5sum {
+    (my $md5sum = shift) or return;
+    $md5sum =~ s/^([0-9a-f]{32})\s*\*?-?\s*\n?$/$1/o
+        || failure(_g("md5sum gave bogus output `%s'"), $md5sum);
+    return $md5sum;
+}
+

scripts/po/ChangeLog

@@ -1,3 +1,11 @@
+2008-01-14  Cyril Brulebois  <cyril.brulebois@enst-bretagne.fr>
+
+	* fr.po: Fix spelling error.
+
+2008-01-14  Yuri Kozlov  <kozlov.y@gmail.com>
+
+	* ru.po: Updated to 483t.
+
 2008-01-07  Guillem Jover  <guillem@debian.org>
 
 	* dpkg-dev.pot: Regenerated.

scripts/po/POTFILES.in

@@ -1,7 +1,6 @@
 # This is the list of all source files with translatable strings.
 
 scripts/822-date.pl
-scripts/controllib.pl
 scripts/dpkg-architecture.pl
 scripts/dpkg-buildpackage.pl
 scripts/dpkg-checkbuilddeps.pl
@@ -16,8 +15,16 @@ scripts/dpkg-shlibdeps.pl
 scripts/dpkg-source.pl
 scripts/changelog/debian.pl
 scripts/Dpkg/Arch.pm
+scripts/Dpkg/Cdata.pm
+scripts/Dpkg/Changelog.pm
+scripts/Dpkg/Changelog/Debian.pm
+scripts/Dpkg/Control.pm
+scripts/Dpkg/Deps.pm
+scripts/Dpkg/ErrorHandling.pm
+scripts/Dpkg/Fields.pm
 scripts/Dpkg/Shlibs.pm
 scripts/Dpkg/Shlibs/Objdump.pm
 scripts/Dpkg/Shlibs/SymbolFile.pm
+scripts/Dpkg/Substvars.pm
+scripts/Dpkg/Vars.pm
 scripts/Dpkg/Version.pm
-scripts/Dpkg/ErrorHandling.pm

scripts/po/fr.po

@@ -1588,7 +1588,7 @@ msgstr "pas d'informations de dépendance trouvées pour %s (utilisé par %s)."
 #: scripts/dpkg-shlibdeps.pl:244
 #, perl-format
 msgid "symbol %s used by %s found in none of the libraries."
-msgstr "symbole %s utilisé par %s trouvé dans aucun des bibliothèques."
+msgstr "symbole %s utilisé par %s trouvé dans aucune des bibliothèques."
 
 #: scripts/dpkg-shlibdeps.pl:257
 #, perl-format

scripts/t/600_Dpkg_Changelog.t

@@ -0,0 +1,259 @@
+# -*- perl -*-
+
+use strict;
+use warnings;
+
+use File::Basename;
+
+BEGIN {
+    my $no_examples = 3;
+    my $no_err_examples = 1;
+    my $no_tests = $no_examples * 4
+	+ $no_err_examples * 2
+	+ 24 # countme
+	+  2 # fields
+	+ 24;
+
+    require Test::More;
+    import Test::More tests => $no_tests;
+}
+BEGIN {
+    use_ok('Dpkg::Changelog');
+    use_ok('Dpkg::Changelog::Debian');
+};
+
+my $srcdir = $ENV{srcdir} || '.';
+$srcdir .= '/t/600_Dpkg_Changelog';
+
+#########################
+
+my $test = Dpkg::Changelog::Debian->init( { infile => '/nonexistant',
+					    quiet => 1 } );
+ok( !defined($test), "fatal parse errors lead to init() returning undef");
+
+my $save_data;
+foreach my $file ("$srcdir/countme", "$srcdir/shadow", "$srcdir/fields") {
+
+    my $changes = Dpkg::Changelog::Debian->init( { infile => $file,
+						   quiet => 1 } );
+    my $errors = $changes->get_parse_errors();
+    my $basename = basename( $file );
+
+#    use Data::Dumper;
+#    diag(Dumper($changes));
+
+    ok( !$errors, "Parse example changelog $file without errors" );
+
+    my @data = $changes->data;
+
+    ok( @data, "data is not empty" );
+
+    my $str = $changes->dpkg_str();
+
+#    is( $str, `dpkg-parsechangelog -l$file`,
+#	'Output of dpkg_str equal to output of dpkg-parsechangelog' );
+
+    if ($file eq "$srcdir/countme") {
+	$save_data = $changes->rfc822_str({ all => 1 });
+
+	# test range options
+	cmp_ok( @data, '==', 7, "no options -> count" );
+	my $all_versions = join( '/', map { $_->{Version} } @data);
+
+	sub check_options {
+	    my ($changes, $data, $options, $count, $versions,
+		$check_name) = @_;
+
+	    my @cnt = $changes->data( $options );
+	    cmp_ok( @cnt, '==', $count, "$check_name -> count" );
+	    if ($count == @$data) {
+		is_deeply( \@cnt, $data, "$check_name -> returns all" );
+
+	    } else {
+		is( join( "/", map { $_->{Version} } @cnt),
+		    $versions, "$check_name -> versions" );
+	    }
+	}
+
+	check_options( $changes, \@data,
+		       { count => 3 }, 3, '2:2.0-1/1:2.0~rc2-3/1:2.0~rc2-2',
+		       'positve count' );
+	check_options( $changes, \@data,
+		       { count => -3 }, 3,
+		       '1:2.0~rc2-1sarge2/1:2.0~rc2-1sarge1/1.5-1',
+		       'negative count' );
+	check_options( $changes, \@data,
+		       { count => 1 }, 1, '2:2.0-1',
+		       'count 1' );
+	check_options( $changes, \@data,
+		       { count => 1, default_all => 1 }, 1, '2:2.0-1',
+		       'count 1 (d_a 1)' );
+	check_options( $changes, \@data,
+		       { count => -1 }, 1, '1.5-1',
+		       'count -1' );
+
+	check_options( $changes, \@data,
+		       { count => 3, offset => 2 }, 3,
+		       '1:2.0~rc2-2/1:2.0~rc2-1sarge3/1:2.0~rc2-1sarge2',
+		       'positve count + positive offset' );
+	check_options( $changes, \@data,
+		       { count => -3, offset => 4 }, 3,
+		       '1:2.0~rc2-3/1:2.0~rc2-2/1:2.0~rc2-1sarge3',
+		       'negative count + positive offset' );
+
+	check_options( $changes, \@data,
+		       { count => 4, offset => 5 }, 2,
+		       '1:2.0~rc2-1sarge1/1.5-1',
+		       'positve count + positive offset (>max)' );
+	check_options( $changes, \@data,
+		       { count => -4, offset => 2 }, 2,
+		       '2:2.0-1/1:2.0~rc2-3',
+		       'negative count + positive offset (<0)' );
+
+	check_options( $changes, \@data,
+		       { count => 3, offset => -4 }, 3,
+		       '1:2.0~rc2-1sarge3/1:2.0~rc2-1sarge2/1:2.0~rc2-1sarge1',
+		       'positve count + negative offset' );
+	check_options( $changes, \@data,
+		       { count => -3, offset => -3 }, 3,
+		       '1:2.0~rc2-3/1:2.0~rc2-2/1:2.0~rc2-1sarge3',
+		       'negative count + negative offset' );
+
+	check_options( $changes, \@data,
+		       { count => 5, offset => -2 }, 2,
+		       '1:2.0~rc2-1sarge1/1.5-1',
+		       'positve count + negative offset (>max)' );
+	check_options( $changes, \@data,
+		       { count => -5, offset => -4 }, 3,
+		       '2:2.0-1/1:2.0~rc2-3/1:2.0~rc2-2',
+		       'negative count + negative offset (<0)' );
+
+	check_options( $changes, \@data,
+		       { count => 7 }, 7, '',
+		       'count 7 (max)' );
+	check_options( $changes, \@data,
+		       { count => -7 }, 7, '',
+		       'count -7 (-max)' );
+	check_options( $changes, \@data,
+		       { count => 10 }, 7, '',
+		       'count 10 (>max)' );
+	check_options( $changes, \@data,
+		       { count => -10 }, 7, '',
+		       'count -10 (<-max)' );
+
+	check_options( $changes, \@data,
+		       { from => '1:2.0~rc2-1sarge3' }, 4,
+		       '2:2.0-1/1:2.0~rc2-3/1:2.0~rc2-2/1:2.0~rc2-1sarge3',
+		       'from => "1:2.0~rc2-1sarge3"' );
+	check_options( $changes, \@data,
+		       { since => '1:2.0~rc2-1sarge3' }, 3,
+		       '2:2.0-1/1:2.0~rc2-3/1:2.0~rc2-2',
+		       'since => "1:2.0~rc2-1sarge3"' );
+	check_options( $changes, \@data,
+		       { to => '1:2.0~rc2-1sarge2' }, 3,
+		       '1:2.0~rc2-1sarge2/1:2.0~rc2-1sarge1/1.5-1',
+		       'to => "1:2.0~rc2-1sarge2"' );
+	check_options( $changes, \@data,
+		       { until => '1:2.0~rc2-1sarge2' }, 2,
+		       '1:2.0~rc2-1sarge1/1.5-1',
+		       'until => "1:2.0~rc2-1sarge2"' );
+	#TODO: test combinations
+    }
+    if ($file eq "$srcdir/fields") {
+	my $str = $changes->dpkg_str({ all => 1 });
+	my $expected = 'Source: fields
+Version: 2.0-0etch1
+Distribution: stable
+Urgency: high
+Maintainer: Frank Lichtenheld <frank@lichtenheld.de>
+Date: Sun, 13 Jan 2008 15:49:19 +0100
+Closes: 1000000 1111111 1111111 2222222 2222222
+Changes: 
+ fields (2.0-0etch1) stable; urgency=low
+ .
+   * Upload to stable (Closes: #1111111, #2222222)
+ .
+ fields (2.0-1) unstable; urgency=medium
+ .
+   * Upload to unstable (Closes: #1111111, #2222222)
+ .
+ fields (2.0~b1-1) unstable; urgency=low,xc-userfield=foobar
+ .
+   * Beta
+ .
+ fields (1.0) experimental; urgency=high
+ .
+   * First upload (Closes: #1000000)
+Xc-Userfield: foobar
+';
+	cmp_ok($str,'eq',$expected,"fields handling");
+
+	$str = $changes->dpkg_str({ offset => 1, count => 2 });
+	$expected = 'Source: fields
+Version: 2.0-1
+Distribution: unstable
+Urgency: medium
+Maintainer: Frank Lichtenheld <djpig@debian.org>
+Date: Sun, 12 Jan 2008 15:49:19 +0100
+Closes: 1111111 2222222
+Changes: 
+ fields (2.0-1) unstable; urgency=medium
+ .
+   * Upload to unstable (Closes: #1111111, #2222222)
+ .
+ fields (2.0~b1-1) unstable; urgency=low,xc-userfield=foobar
+ .
+   * Beta
+Xc-Userfield: foobar
+';
+	cmp_ok($str,'eq',$expected,"fields handling 2");
+
+    }
+
+#     if ($file eq 'Changes') {
+# 	my $v = $data[0]->Version;
+# 	$v =~ s/[a-z]$//;
+# 	cmp_ok( $v, 'eq', $Parse::DebianChangelog::VERSION,
+# 		'version numbers in module and Changes match' );
+#     }
+
+    my $oldest_version = $data[-1]->{Version};
+    $str = $changes->dpkg_str({ since => $oldest_version });
+
+#    is( $str, `dpkg-parsechangelog -v$oldest_version -l$file`,
+#	'Output of dpkg_str equal to output of dpkg-parsechangelog' )
+#	or diag("oldest_version=$oldest_version");
+
+    $str = $changes->rfc822_str();
+
+    ok( 1 );
+
+    $str = $changes->rfc822_str({ since => $oldest_version });
+
+    ok( 1 );
+}
+
+open CHANGES, '<', "$srcdir/countme";
+my $string = join('',<CHANGES>);
+
+my $str_changes = Dpkg::Changelog::Debian->init( { instring => $string,
+						   quiet => 1 } );
+my $errors = $str_changes->get_parse_errors();
+ok( !$errors,
+    "Parse example changelog $srcdir/countme without errors from string" );
+
+my $str_data = $str_changes->rfc822_str({ all => 1 });
+is( $str_data, $save_data,
+    "Compare result of parse from string with result of parse from file" );
+
+
+foreach my $test (( [ "$srcdir/misplaced-tz", 6 ])) {
+
+    my $file = shift @$test;
+    my $changes = Dpkg::Changelog::Debian->init( { infile => $file,
+						   quiet => 1 } );
+    my @errors = $changes->get_parse_errors();
+
+    ok( @errors, 'errors occoured' );
+    is_deeply( [ map { $_->[1] } @errors ], $test, 'check line numbers' );
+}

scripts/t/600_Dpkg_Changelog/countme

@@ -0,0 +1,41 @@
+countme (2:2.0-1) unstable; urgency=low
+
+  * Final
+
+ -- Frank Lichtenheld <frank@lichtenheld.de>  Tue,  4 Oct 2005 01:49:05 +0200
+
+countme (1:2.0~rc2-3) unstable; urgency=low
+
+  * kadabra
+
+ -- Frank Lichtenheld <frank@lichtenheld.de>  Tue,  4 Oct 2005 01:48:05 +0200
+
+countme (1:2.0~rc2-2) unstable; urgency=low
+
+  * Abra
+
+ -- Frank Lichtenheld <frank@lichtenheld.de>  Tue,  4 Oct 2005 01:47:48 +0200
+
+countme (1:2.0~rc2-1sarge3) unstable; urgency=low
+
+  * Baz
+
+ -- Frank Lichtenheld <frank@lichtenheld.de>  Tue,  4 Oct 2005 01:47:19 +0200
+
+countme (1:2.0~rc2-1sarge2) unstable; urgency=low
+
+  * Bar
+
+ -- Frank Lichtenheld <frank@lichtenheld.de>  Tue,  4 Oct 2005 01:47:08 +0200
+
+countme (1:2.0~rc2-1sarge1) unstable; urgency=low
+
+  * Foo
+
+ -- Frank Lichtenheld <frank@lichtenheld.de>  Tue,  4 Oct 2005 01:46:49 +0200
+
+countme (1.5-1) unstable; urgency=low
+
+  * Initial
+
+ -- Frank Lichtenheld <frank@lichtenheld.de>  Thu, 01 Jan 1970 00:00:00 +0000

scripts/t/600_Dpkg_Changelog/fields

@@ -0,0 +1,23 @@
+fields (2.0-0etch1) stable; urgency=low
+
+  * Upload to stable (Closes: #1111111, #2222222)
+
+ -- Frank Lichtenheld <frank@lichtenheld.de>  Sun, 13 Jan 2008 15:49:19 +0100
+
+fields (2.0-1) unstable; urgency=medium
+
+  * Upload to unstable (Closes: #1111111, #2222222)
+
+ -- Frank Lichtenheld <djpig@debian.org>  Sun, 12 Jan 2008 15:49:19 +0100
+
+fields (2.0~b1-1) unstable; urgency=low,xc-userfield=foobar
+
+  * Beta
+
+ -- Frank Lichtenheld <frank@lichtenheld.de>  Sun, 11 Jan 2008 15:49:19 +0100
+
+fields (1.0) experimental; urgency=high
+
+  * First upload (Closes: #1000000)
+
+ -- Frank Lichtenheld <djpig@debian.org>  Sun, 10 Jan 2008 15:49:19 +0100

scripts/t/600_Dpkg_Changelog/misplaced-tz

@@ -0,0 +1,12 @@
+error-tz (1.1-1) unstable; urgency=low
+
+  * 
+
+ -- Frank Lichtenheld <djpig@debian.org>  Mon, 16 Jul 2007 02:54:18 +0200
++0200
+
+error-tz (1.0-1) unstable; urgency=low
+
+  * 
+
+ -- Frank Lichtenheld <djpig@debian.org>  Mon, 16 Jul 2007 02:54:18 +0200

scripts/t/700_Dpkg_Control.t

@@ -0,0 +1,63 @@
+# -*- mode: cperl;-*-
+
+use Test::More tests => 9;
+
+use strict;
+use warnings;
+use IO::String;
+
+use_ok('Dpkg::Control');
+
+my $srcdir = $ENV{srcdir} || '.';
+$srcdir .= '/t/700_Dpkg_Control';
+
+my $c = Dpkg::Control->new("$srcdir/control-1");
+
+my $io = IO::String->new();
+$c->dump($io);
+is(${$io->string_ref()},
+'Source: mysource
+My-Field-One: myvalue1
+My-Field-Two: myvalue2
+Long-Field: line1
+ line 2 line 2 line 2
+ line 3 line 3 line 3
+Empty-Field: 
+
+Package: mypackage1
+Depends: libc6
+
+Package: mypackage2
+Depends: hello
+
+Package: mypackage3
+Depends: hello
+Description: short one
+ long one
+ very long one
+', "Dump of $srcdir/control-1");
+
+my $src = $c->get_source();
+is($src->{'my-field-one'}, 'myvalue1', "Access field through badly capitalized field name");
+is($src->{'long-field'}, 
+'line1
+ line 2 line 2 line 2
+ line 3 line 3 line 3', "Get multi-line field");
+is($src->{'Empty-field'}, "", "Get empty field");
+
+my $pkg = $c->get_pkg_by_idx(1);
+is($pkg->{package}, 'mypackage1', 'Name of first package');
+
+$pkg = $c->get_pkg_by_name("mypackage3");
+is($pkg->{package}, 'mypackage3', 'Name of third package');
+is($pkg->{Depends}, 'hello', 'Name of third package');
+
+$pkg = $c->get_pkg_by_idx(2);
+$io = IO::String->new();
+tied(%{$pkg})->dump($io);
+
+is(${$io->string_ref()},
+'Package: mypackage2
+Depends: hello
+', "Dump of second binary package of $srcdir/control-1");
+

scripts/t/700_Dpkg_Control/control-1

@@ -0,0 +1,22 @@
+Source: mysource
+# This is a comment
+my-field-one: myvalue1
+my-field-two: myvalue2
+long-field: line1
+ line 2 line 2 line 2
+ line 3 line 3 line 3
+empty-field: 
+     
+# First package
+Package: mypackage1
+Depends: libc6
+
+# Second package
+Package: mypackage2
+Depends: hello
+
+Package: mypackage3
+Depends: hello
+Description: short one
+ long one
+ very long one