The following commit has been merged in the master branch:
commit 750c5b4d630aa7b8aa72b1b6d621b7eb5eb70093
Author: Raphaël Hertzog <[email protected]>
Date: Sun Oct 18 22:36:20 2009 +0200
Dpkg::Changelog::Entry, Dpkg::Control::Changelog: new modules
Dpkg::Changelog::Entry is a somewhat generic representation of a
changelog entry. It offers an interface exporting the basic information
that we need to extract for dpkg-parsechangelog.
Dpkg::Changelog::Entry::Debian is the implementation of this
interface for the typical Debian changelog entry.
Dpkg::Control::Changelog is the object representing the
information exported by dpkg-parsechangelog. It starts empty
as a simple Dpkg::Control of type CTRL_CHANGELOG.
Those new modules are not yet used by the Dpkg::Changelog modules.
diff --git a/scripts/Dpkg/Changelog/Entry.pm b/scripts/Dpkg/Changelog/Entry.pm
new file mode 100644
index 0000000..4cd78a0
--- /dev/null
+++ b/scripts/Dpkg/Changelog/Entry.pm
@@ -0,0 +1,284 @@
+# Copyright © 2009 Raphaël Hertzog <[email protected]>
+#
+# 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::Changelog::Entry;
+
+use strict;
+use warnings;
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::Control::Changelog;
+
+use overload
+ '""' => \&output;
+
+=head1 NAME
+
+Dpkg::Changelog::Entry - represents a changelog entry
+
+=head1 DESCRIPTION
+
+This object represents a changelog entry. It is composed
+of a set of lines with specific purpose: an header line, changes lines, a
+trailer line. Blank lines can be between those kind of lines.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item my $entry = Dpkg::Changelog::Entry->new()
+
+Creates a new object. It doesn't represent a real changelog entry
+until one has been successfully parsed or built from scratch.
+
+=cut
+
+sub new {
+ my ($this) = @_;
+ my $class = ref($this) || $this;
+
+ my $self = {
+ 'header' => undef,
+ 'changes' => [],
+ 'trailer' => undef,
+ 'blank_after_header' => [],
+ 'blank_after_changes' => [],
+ 'blank_after_trailer' => [],
+ };
+ bless $self, $class;
+ return $self;
+}
+
+=item my $str = $entry->output()
+=item "$entry"
+
+Get a string representation of the changelog entry.
+
+=item $entry->output($fh)
+
+Print the string representation of the changelog entry to a
+filehandle.
+
+=cut
+
+sub output {
+ my ($self, $fh) = @_;
+ my $str = '';
+ sub _block {
+ my $lines = shift;
+ return join('', map { $_ . "\n" } @{$lines});
+ }
+ $str .= $self->{header} . "\n" if defined($self->{header});
+ $str .= _block($self->{blank_after_header});
+ $str .= _block($self->{changes});
+ $str .= _block($self->{blank_after_changes});
+ $str .= $self->{trailer} . "\n" if defined($self->{trailer});
+ $str .= _block($self->{blank_after_trailer});
+ print $fh $str if defined $fh;
+ return $str;
+}
+
+=item $entry->get_part($part)
+
+Return either a string (for a single line) or an array ref (for multiple
+lines) corresponding to the requested part. $part can be
+"header, "changes", "trailer", "blank_after_header",
+"blank_after_changes", "blank_after_trailer".
+
+=cut
+
+sub get_part {
+ my ($self, $part) = @_;
+ internerr("invalid part of changelog entry: %s") unless exists
$self->{$part};
+ return $self->{$part};
+}
+
+=item $entry->set_part($part, $value)
+
+Set the value of the corresponding part. $value can be a string
+or an array ref.
+
+=cut
+
+sub set_part {
+ my ($self, $part, $value) = @_;
+ internerr("invalid part of changelog entry: %s") unless exists
$self->{$part};
+ if (ref($self->{$part})) {
+ if (ref($value)) {
+ $self->{$part} = $value;
+ } else {
+ $self->{$part} = [ $value ];
+ }
+ } else {
+ $self->{$part} = $value;
+ }
+}
+
+=item $entry->extend_part($part, $value)
+
+Concatenate $value at the end of the part. If the part is already a
+multi-line value, $value is added as a new line otherwise it's
+concatenated at the end of the current line.
+
+=cut
+
+sub extend_part {
+ my ($self, $part, $value, @rest) = @_;
+ internerr("invalid part of changelog entry: %s") unless exists
$self->{$part};
+ if (ref($self->{$part})) {
+ if (ref($value)) {
+ push @{$self->{$part}}, @$value;
+ } else {
+ push @{$self->{$part}}, $value;
+ }
+ } else {
+ if (defined($self->{$part})) {
+ if (ref($value)) {
+ $self->{$part} = [ $self->{$part}, @$value ];
+ } else {
+ $self->{$part} .= $value;
+ }
+ } else {
+ $self->{$part} = $value;
+ }
+ }
+}
+
+=item $is_empty = $entry->is_empty()
+
+Returns 1 if the changelog entry doesn't contain anything at all.
+Returns 0 as soon as it contains something in any of its non-blank
+parts.
+
+=cut
+
+sub is_empty {
+ my ($self) = @_;
+ return !(defined($self->{header}) || defined($self->{trailer}) ||
+ scalar(@{$self->{changes}}));
+}
+
+=item $entry->normalize()
+
+Normalize the content. Strip whitespaces at end of lines, use a single
+empty line to separate each part.
+
+=cut
+
+sub normalize {
+ my ($self) = @_;
+ if (defined($self->{header})) {
+ $self->{header} =~ s/\s+$//g;
+ $self->{blank_after_header} = [''];
+ } else {
+ $self->{blank_after_header} = [];
+ }
+ if (scalar(@{$self->{changes}})) {
+ s/\s+$//g foreach @{$self->{changes}};
+ $self->{blank_after_changes} = [''];
+ } else {
+ $self->{blank_after_changes} = [];
+ }
+ if (defined($self->{trailer})) {
+ $self->{trailer} =~ s/\s+$//g;
+ $self->{blank_after_trailer} = [''];
+ } else {
+ $self->{blank_after_trailer} = [];
+ }
+}
+
+=item my $src = $entry->get_source()
+
+Return the name of the source package associated to the changelog entry.
+
+=cut
+
+sub get_source {
+ return undef;
+}
+
+=item my $ver = $entry->get_version()
+
+Return the version associated to the changelog entry.
+
+=cut
+
+sub get_version {
+ return undef;
+}
+
+=item my @dists = $entry->get_distributions()
+
+Return a list of target distributions for this version.
+
+=cut
+
+sub get_distributions {
+ return () if wantarray;
+ return undef;
+}
+
+=item $fields = $entry->get_optional_fields()
+
+Return a set of optional fields exposed by the changelog entry.
+It always returns a Dpkg::Control object (possibly empty though).
+
+=cut
+
+sub get_optional_fields {
+ return Dpkg::Control::Changelog->new();
+}
+
+=item $urgency = $entry->get_urgency()
+
+Return the urgency of the associated upload.
+
+=cut
+
+sub get_urgency {
+ return undef;
+}
+
+=item my $maint = $entry->get_maintainer()
+
+Return the string identifying the person who signed this changelog entry.
+
+=cut
+
+sub get_maintainer {
+ return undef;
+}
+
+=item my $time = $entry->get_timestamp()
+
+Return the timestamp of the changelog entry.
+
+=cut
+
+sub get_timestamp {
+ return undef;
+}
+
+=back
+
+=head1 AUTHOR
+
+Raphaël Hertzog <[email protected]>.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Changelog/Entry/Debian.pm
b/scripts/Dpkg/Changelog/Entry/Debian.pm
new file mode 100644
index 0000000..82312ff
--- /dev/null
+++ b/scripts/Dpkg/Changelog/Entry/Debian.pm
@@ -0,0 +1,156 @@
+# Copyright © 2009 Raphaël Hertzog <[email protected]>
+#
+# 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::Changelog::Entry::Debian;
+
+use strict;
+use warnings;
+
+use Exporter;
+use Dpkg::Changelog::Entry;
+use base qw(Exporter Dpkg::Changelog::Entry);
+our @EXPORT_OK = qw($regex_header $regex_trailer);
+
+use Dpkg::Control::Changelog;
+use Dpkg::Version;
+use Dpkg::Changelog qw(:util);
+
+=head1 NAME
+
+Dpkg::Changelog::Entry::Debian - represents a Debian changelog entry
+
+=head1 DESCRIPTION
+
+This object represents a Debian changelog entry. It implements the
+generic interface Dpkg::Changelog::Entry. Only functions specific to this
+implementation are described below.
+
+=head1 VARIABLES
+
+$regex_header, $regex_trailer are two regular expressions that can be used
+to match a line and know whether it's a valid header/trailer line.
+
+The matched content for $regex_header is the source package name ($1), the
+version ($2), the target distributions ($3) and the options on the rest
+of the line ($4). For $regex_trailer, it's the maintainer name ($1), its
+email ($2), some blanks ($3) and the timestamp ($4).
+
+=cut
+
+my $name_chars = qr/[-+0-9a-z.]/i;
+our $regex_header = qr/^(\w$name_chars*) \(([^\(\)
\t]+)\)((?:\s+$name_chars+)+)\;(.*)$/i;
+our $regex_trailer = qr/^ \-\- (.*) <(.*)>(
?)((\w+\,\s*)?\d{1,2}\s+\w+\s+\d{4}\s+\d{1,2}:\d\d:\d\d\s+[-+]\d{4}(\s+\([^\\\(\)]\))?)\s*$/o;
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item $entry->normalize()
+
+Normalize the content. Strip whitespaces at end of lines, use a single
+empty line to separate each part.
+
+=cut
+
+sub normalize {
+ my ($self) = @_;
+ $self->SUPER::normalize();
+ #XXX: recreate header/trailer
+}
+
+sub get_source {
+ my ($self) = @_;
+ if (defined($self->{header}) and $self->{header} =~ $regex_header) {
+ return $1;
+ }
+ return undef;
+}
+
+sub get_version {
+ my ($self) = @_;
+ if (defined($self->{header}) and $self->{header} =~ $regex_header) {
+ return Dpkg::Version->new($2) || $2;
+ }
+ return undef;
+}
+
+sub get_distributions {
+ my ($self) = @_;
+ if (defined($self->{header}) and $self->{header} =~ $regex_header) {
+ my $value = $3;
+ $value =~ s/^\s+//;
+ my @dists = split(/\s+/, $value);
+ return @dists if wantarray;
+ return $dists[0];
+ }
+ return () if wantarray;
+ return undef;
+}
+
+sub get_optional_fields {
+ my ($self) = @_;
+ my $f = Dpkg::Control::Changelog->new();
+ if (defined($self->{header}) and $self->{header} =~ $regex_header) {
+ my $options = $4;
+ $options =~ s/^\s+//;
+ foreach my $opt (split(/\s*,\s*/, $options)) {
+ if ($opt =~ m/^([-0-9a-z]+)\=\s*(.*\S)$/i) {
+ $f->{$1} = $2;
+ }
+ }
+ }
+ my $closes = find_closes(join("\n", @{$self->{changes}}));
+ if (@$closes) {
+ $f->{Closes} = join(" ", @$closes);
+ }
+ return $f;
+}
+
+sub get_urgency {
+ my ($self) = @_;
+ my $f = $self->get_optional_fields();
+ if (exists $f->{Urgency}) {
+ $f->{Urgency} =~ s/\s.*$//;
+ return lc($f->{Urgency});
+ }
+ return undef;
+}
+
+sub get_maintainer {
+ my ($self) = @_;
+ if (defined($self->{trailer}) and $self->{trailer} =~ $regex_trailer) {
+ return "$1 <$2>";
+ }
+ return undef;
+}
+
+sub get_timestamp {
+ my ($self) = @_;
+ if (defined($self->{trailer}) and $self->{trailer} =~ $regex_trailer) {
+ return $4;
+ }
+ return undef;
+}
+
+=back
+
+=head1 AUTHOR
+
+Raphaël Hertzog <[email protected]>.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/Control/Changelog.pm
b/scripts/Dpkg/Control/Changelog.pm
new file mode 100644
index 0000000..75771d2
--- /dev/null
+++ b/scripts/Dpkg/Control/Changelog.pm
@@ -0,0 +1,59 @@
+# Copyright © 2009 Raphaël Hertzog <[email protected]>
+
+# 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::Changelog;
+
+use strict;
+use warnings;
+
+use Dpkg::Control;
+use base 'Dpkg::Control';
+
+=head1 NAME
+
+Dpkg::Control::Changelog - represent info fields output by dpkg-parsechangelog
+
+=head1 DESCRIPTION
+
+This object derives directly from Dpkg::Control with the type
+CTRL_CHANGELOG.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item $c = Dpkg::Control::Changelog->new()
+
+Create a new empty set of changelog related fields.
+
+=cut
+
+sub new {
+ my $this = shift;
+ my $class = ref($this) || $this;
+ my $self = Dpkg::Control->new(type => CTRL_CHANGELOG, @_);
+ return bless $self, $class;
+}
+
+=back
+
+=head1 AUTHOR
+
+Raphael Hertzog <[email protected]>.
+
+=cut
+
+1;
diff --git a/scripts/Makefile.am b/scripts/Makefile.am
index 74d8699..edfb640 100644
--- a/scripts/Makefile.am
+++ b/scripts/Makefile.am
@@ -91,9 +91,12 @@ nobase_dist_perllib_DATA = \
Dpkg/BuildOptions.pm \
Dpkg/Changelog.pm \
Dpkg/Changelog/Debian.pm \
+ Dpkg/Changelog/Entry.pm \
+ Dpkg/Changelog/Entry/Debian.pm \
Dpkg/Checksums.pm \
Dpkg/Compression.pm \
Dpkg/Control.pm \
+ Dpkg/Control/Changelog.pm \
Dpkg/Control/Fields.pm \
Dpkg/Control/Info.pm \
Dpkg/Control/Hash.pm \
diff --git a/scripts/po/POTFILES.in b/scripts/po/POTFILES.in
index 8eecddb..1aa1b9b 100644
--- a/scripts/po/POTFILES.in
+++ b/scripts/po/POTFILES.in
@@ -17,8 +17,11 @@ scripts/changelog/debian.pl
scripts/Dpkg/Arch.pm
scripts/Dpkg/Changelog.pm
scripts/Dpkg/Changelog/Debian.pm
+scripts/Dpkg/Changelog/Entry.pm
+scripts/Dpkg/Changelog/Entry/Debian.pm
scripts/Dpkg/Checksums.pm
scripts/Dpkg/Control.pm
+scripts/Dpkg/Control/Changelog.pm
scripts/Dpkg/Control/Fields.pm
scripts/Dpkg/Control/Info.pm
scripts/Dpkg/Control/Hash.pm
--
dpkg's main repository
--
To UNSUBSCRIBE, email to [email protected]
with a subject of "unsubscribe". Trouble? Contact [email protected]
