chiark - git - mdw - dpkg/blob - scripts/Dpkg/Changelog/Entry.pm

   1 # Copyright © 2009 Raphaël Hertzog <hertzog@debian.org>
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  15
  16 package Dpkg::Changelog::Entry;
  17
  18 use strict;
  19 use warnings;
  20
  21 our $VERSION = '1.01';
  22
  23 use Carp;
  24
  25 use Dpkg::Gettext;
  26 use Dpkg::ErrorHandling;
  27 use Dpkg::Control::Changelog;
  28
  29 use overload
  30     '""' => \&output,
  31     'eq' => sub { defined($_[1]) and "$_[0]" eq "$_[1]" },
  32     fallback => 1;
  33
  34 =encoding utf8
  35
  36 =head1 NAME
  37
  38 Dpkg::Changelog::Entry - represents a changelog entry
  39
  40 =head1 DESCRIPTION
  41
  42 This object represents a changelog entry. It is composed
  43 of a set of lines with specific purpose: an header line, changes lines, a
  44 trailer line. Blank lines can be between those kind of lines.
  45
  46 =head1 METHODS
  47
  48 =over 4
  49
  50 =item $entry = Dpkg::Changelog::Entry->new()
  51
  52 Creates a new object. It doesn't represent a real changelog entry
  53 until one has been successfully parsed or built from scratch.
  54
  55 =cut
  56
  57 sub new {
  58     my $this = shift;
  59     my $class = ref($this) || $this;
  60
  61     my $self = {
  62         header => undef,
  63         changes => [],
  64         trailer => undef,
  65         blank_after_header => [],
  66         blank_after_changes => [],
  67         blank_after_trailer => [],
  68     };
  69     bless $self, $class;
  70     return $self;
  71 }
  72
  73 =item $str = $entry->output()
  74
  75 =item "$entry"
  76
  77 Get a string representation of the changelog entry.
  78
  79 =item $entry->output($fh)
  80
  81 Print the string representation of the changelog entry to a
  82 filehandle.
  83
  84 =cut
  85
  86 sub _format_output_block {
  87     my $lines = shift;
  88     return join('', map { $_ . "\n" } @{$lines});
  89 }
  90
  91 sub output {
  92     my ($self, $fh) = @_;
  93     my $str = '';
  94     $str .= $self->{header} . "\n" if defined($self->{header});
  95     $str .= _format_output_block($self->{blank_after_header});
  96     $str .= _format_output_block($self->{changes});
  97     $str .= _format_output_block($self->{blank_after_changes});
  98     $str .= $self->{trailer} . "\n" if defined($self->{trailer});
  99     $str .= _format_output_block($self->{blank_after_trailer});
 100     print { $fh } $str if defined $fh;
 101     return $str;
 102 }
 103
 104 =item $entry->get_part($part)
 105
 106 Return either a string (for a single line) or an array ref (for multiple
 107 lines) corresponding to the requested part. $part can be
 108 "header, "changes", "trailer", "blank_after_header",
 109 "blank_after_changes", "blank_after_trailer".
 110
 111 =cut
 112
 113 sub get_part {
 114     my ($self, $part) = @_;
 115     croak "invalid part of changelog entry: $part" unless exists $self->{$part};
 116     return $self->{$part};
 117 }
 118
 119 =item $entry->set_part($part, $value)
 120
 121 Set the value of the corresponding part. $value can be a string
 122 or an array ref.
 123
 124 =cut
 125
 126 sub set_part {
 127     my ($self, $part, $value) = @_;
 128     croak "invalid part of changelog entry: $part" unless exists $self->{$part};
 129     if (ref($self->{$part})) {
 130         if (ref($value)) {
 131             $self->{$part} = $value;
 132         } else {
 133             $self->{$part} = [ $value ];
 134         }
 135     } else {
 136         $self->{$part} = $value;
 137     }
 138 }
 139
 140 =item $entry->extend_part($part, $value)
 141
 142 Concatenate $value at the end of the part. If the part is already a
 143 multi-line value, $value is added as a new line otherwise it's
 144 concatenated at the end of the current line.
 145
 146 =cut
 147
 148 sub extend_part {
 149     my ($self, $part, $value, @rest) = @_;
 150     croak "invalid part of changelog entry: $part" unless exists $self->{$part};
 151     if (ref($self->{$part})) {
 152         if (ref($value)) {
 153             push @{$self->{$part}}, @$value;
 154         } else {
 155             push @{$self->{$part}}, $value;
 156         }
 157     } else {
 158         if (defined($self->{$part})) {
 159             if (ref($value)) {
 160                 $self->{$part} = [ $self->{$part}, @$value ];
 161             } else {
 162                 $self->{$part} .= $value;
 163             }
 164         } else {
 165             $self->{$part} = $value;
 166         }
 167     }
 168 }
 169
 170 =item $is_empty = $entry->is_empty()
 171
 172 Returns 1 if the changelog entry doesn't contain anything at all.
 173 Returns 0 as soon as it contains something in any of its non-blank
 174 parts.
 175
 176 =cut
 177
 178 sub is_empty {
 179     my $self = shift;
 180     return !(defined($self->{header}) || defined($self->{trailer}) ||
 181              scalar(@{$self->{changes}}));
 182 }
 183
 184 =item $entry->normalize()
 185
 186 Normalize the content. Strip whitespaces at end of lines, use a single
 187 empty line to separate each part.
 188
 189 =cut
 190
 191 sub normalize {
 192     my $self = shift;
 193     if (defined($self->{header})) {
 194         $self->{header} =~ s/\s+$//g;
 195         $self->{blank_after_header} = [''];
 196     } else {
 197         $self->{blank_after_header} = [];
 198     }
 199     if (scalar(@{$self->{changes}})) {
 200         s/\s+$//g foreach @{$self->{changes}};
 201         $self->{blank_after_changes} = [''];
 202     } else {
 203         $self->{blank_after_changes} = [];
 204     }
 205     if (defined($self->{trailer})) {
 206         $self->{trailer} =~ s/\s+$//g;
 207         $self->{blank_after_trailer} = [''];
 208     } else {
 209         $self->{blank_after_trailer} = [];
 210     }
 211 }
 212
 213 =item $src = $entry->get_source()
 214
 215 Return the name of the source package associated to the changelog entry.
 216
 217 =cut
 218
 219 sub get_source {
 220     return;
 221 }
 222
 223 =item $ver = $entry->get_version()
 224
 225 Return the version associated to the changelog entry.
 226
 227 =cut
 228
 229 sub get_version {
 230     return;
 231 }
 232
 233 =item @dists = $entry->get_distributions()
 234
 235 Return a list of target distributions for this version.
 236
 237 =cut
 238
 239 sub get_distributions {
 240     return;
 241 }
 242
 243 =item $fields = $entry->get_optional_fields()
 244
 245 Return a set of optional fields exposed by the changelog entry.
 246 It always returns a Dpkg::Control object (possibly empty though).
 247
 248 =cut
 249
 250 sub get_optional_fields {
 251     return Dpkg::Control::Changelog->new();
 252 }
 253
 254 =item $urgency = $entry->get_urgency()
 255
 256 Return the urgency of the associated upload.
 257
 258 =cut
 259
 260 sub get_urgency {
 261     return;
 262 }
 263
 264 =item $maint = $entry->get_maintainer()
 265
 266 Return the string identifying the person who signed this changelog entry.
 267
 268 =cut
 269
 270 sub get_maintainer {
 271     return;
 272 }
 273
 274 =item $time = $entry->get_timestamp()
 275
 276 Return the timestamp of the changelog entry.
 277
 278 =cut
 279
 280 sub get_timestamp {
 281     return;
 282 }
 283
 284 =item $time = $entry->get_timepiece()
 285
 286 Return the timestamp of the changelog entry as a Time::Piece object.
 287
 288 This function might return undef if there was no timestamp.
 289
 290 =cut
 291
 292 sub get_timepiece {
 293     return;
 294 }
 295
 296 =item $str = $entry->get_dpkg_changes()
 297
 298 Returns a string that is suitable for usage in a C<Changes> field
 299 in the output format of C<dpkg-parsechangelog>.
 300
 301 =cut
 302
 303 sub get_dpkg_changes {
 304     my $self = shift;
 305     my $header = $self->get_part('header') // '';
 306     $header =~ s/\s+$//;
 307     return "\n$header\n\n" . join("\n", @{$self->get_part('changes')});
 308 }
 309
 310 =back
 311
 312 =head1 CHANGES
 313
 314 =head2 Version 1.01 (dpkg 1.18.8)
 315
 316 New method: $entry->get_timepiece().
 317
 318 =head2 Version 1.00 (dpkg 1.15.6)
 319
 320 Mark the module as public.
 321
 322 =cut
 323
 324 1;