dpkg/scripts/Dpkg/Changelog/Entry.pm

# 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 <http://www.gnu.org/licenses/>.

package Dpkg::Changelog::Entry;

use strict;
use warnings;

our $VERSION = "1.00";

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 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;
}

=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;