"Fossies" - the Fresh Open Source Software Archive

Member "dpkg-1.19.7/scripts/Dpkg/Changelog/Entry.pm" (19 Apr 2019, 6966 Bytes) of package /linux/misc/dpkg_1.19.7.tar.xz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "Entry.pm" see the Fossies "Dox" file reference documentation.

    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;