Index: third_party/dpkg-dev/scripts/Dpkg/Changelog/Entry.pm |
diff --git a/third_party/dpkg-dev/scripts/Dpkg/Changelog/Entry.pm b/third_party/dpkg-dev/scripts/Dpkg/Changelog/Entry.pm |
new file mode 100644 |
index 0000000000000000000000000000000000000000..3277ab65667e8cf9d1534c1e6bcce5b952843725 |
--- /dev/null |
+++ b/third_party/dpkg-dev/scripts/Dpkg/Changelog/Entry.pm |
@@ -0,0 +1,306 @@ |
+# 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/>. |
+ |
+package Dpkg::Changelog::Entry; |
+ |
+use strict; |
+use warnings; |
+ |
+our $VERSION = '1.00'; |
+ |
+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; |
+ |
+=encoding utf8 |
+ |
+=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 _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) = @_; |
+ 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; |
+} |
+ |
+=item my $ver = $entry->get_version() |
+ |
+Return the version associated to the changelog entry. |
+ |
+=cut |
+ |
+sub get_version { |
+ return; |
+} |
+ |
+=item my @dists = $entry->get_distributions() |
+ |
+Return a list of target distributions for this version. |
+ |
+=cut |
+ |
+sub get_distributions { |
+ return; |
+} |
+ |
+=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; |
+} |
+ |
+=item my $maint = $entry->get_maintainer() |
+ |
+Return the string identifying the person who signed this changelog entry. |
+ |
+=cut |
+ |
+sub get_maintainer { |
+ return; |
+} |
+ |
+=item my $time = $entry->get_timestamp() |
+ |
+Return the timestamp of the changelog entry. |
+ |
+=cut |
+ |
+sub get_timestamp { |
+ return; |
+} |
+ |
+=item my $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) = @_; |
+ my $header = $self->get_part('header') || ''; |
+ $header =~ s/\s+$//; |
+ return "\n$header\n\n" . join("\n", @{$self->get_part('changes')}); |
+} |
+ |
+=back |
+ |
+=head1 AUTHOR |
+ |
+Raphaël Hertzog <hertzog@debian.org>. |
+ |
+=cut |
+ |
+1; |