Adding upstream version 1.22.4.upstream/1.22.4

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

1 files changed, 324 insertions, 0 deletions

diff --git a/scripts/Dpkg/Changelog/Entry.pm b/scripts/Dpkg/Changelog/Entry.pm
new file mode 100644
index 0000000..e572909
--- /dev/null
+++ b/scripts/Dpkg/Changelog/Entry.pm
@@ -0,0 +1,324 @@
+# Copyright © 2009 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, see <https://www.gnu.org/licenses/>.
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Changelog::Entry - represents a changelog entry
+
+=head1 DESCRIPTION
+
+This class represents a changelog entry. It is composed
+of a set of lines with specific purpose: a header line, changes lines, a
+trailer line. Blank lines can be between those kind of lines.
+
+=cut
+
+package Dpkg::Changelog::Entry 1.01;
+
+use strict;
+use warnings;
+
+use Carp;
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::Control::Changelog;
+
+use overload
+    '""' => \&output,
+    'eq' => sub { defined($_[1]) and "$_[0]" eq "$_[1]" },
+    fallback => 1;
+
+=head1 METHODS
+
+=over 4
+
+=item $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 = shift;
+    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 $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 _format_output_block {
+    my $lines = shift;
+    return join('', map { $_ . "\n" } @{$lines});
+}
+
+sub output {
+    my ($self, $fh) = @_;
+    my $str = '';
+    $str .= $self->{header} . "\n" if defined($self->{header});
+    $str .= _format_output_block($self->{blank_after_header});
+    $str .= _format_output_block($self->{changes});
+    $str .= _format_output_block($self->{blank_after_changes});
+    $str .= $self->{trailer} . "\n" if defined($self->{trailer});
+    $str .= _format_output_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) = @_;
+    croak "invalid part of changelog entry: $part" 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) = @_;
+    croak "invalid part of changelog entry: $part" 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) = @_;
+    croak "invalid part of changelog entry: $part" 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 = shift;
+    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 = shift;
+    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 $src = $entry->get_source()
+
+Return the name of the source package associated to the changelog entry.
+
+=cut
+
+sub get_source {
+    return;
+}
+
+=item $ver = $entry->get_version()
+
+Return the version associated to the changelog entry.
+
+=cut
+
+sub get_version {
+    return;
+}
+
+=item @dists = $entry->get_distributions()
+
+Return a list of target distributions for this version.
+
+=cut
+
+sub get_distributions {
+    return;
+}
+
+=item $ctrl = $entry->get_optional_fields()
+
+Return a set of optional fields exposed by the changelog entry.
+It always returns a L<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;
+}
+
+=item $maint = $entry->get_maintainer()
+
+Return the string identifying the person who signed this changelog entry.
+
+=cut
+
+sub get_maintainer {
+    return;
+}
+
+=item $time = $entry->get_timestamp()
+
+Return the timestamp of the changelog entry.
+
+=cut
+
+sub get_timestamp {
+    return;
+}
+
+=item $time = $entry->get_timepiece()
+
+Return the timestamp of the changelog entry as a L<Time::Piece> object.
+
+This function might return undef if there was no timestamp.
+
+=cut
+
+sub get_timepiece {
+    return;
+}
+
+=item $str = $entry->get_dpkg_changes()
+
+Returns a string that is suitable for usage in a C<Changes> field
+in the output format of C<dpkg-parsechangelog>.
+
+=cut
+
+sub get_dpkg_changes {
+    my $self = shift;
+    my $header = $self->get_part('header') // '';
+    $header =~ s/\s+$//;
+    return "\n$header\n\n" . join("\n", @{$self->get_part('changes')});
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.01 (dpkg 1.18.8)
+
+New method: $entry->get_timepiece().
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;