dpkg/scripts/changelog/debian.pl

#!/usr/bin/perl
#
# parsechangelog/debian
#
# 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/>.

use strict;
use warnings;

use Getopt::Long qw(:config gnu_getopt auto_help);
use POSIX;

use Dpkg;
use Dpkg::Gettext;
use Dpkg::ErrorHandling;
use Dpkg::Changelog::Debian;

textdomain("dpkg-dev");

$progname = "parsechangelog/$progname";

sub version {
    printf _g("Debian %s version %s.\n"), $progname, $version;

    printf _g("
Copyright (C) 1996 Ian Jackson.
Copyright (C) 2005,2007 Frank Lichtenheld.");
    printf _g("
This is free software; see the GNU General Public License version 2 or
later for copying conditions. There is NO warranty.
");
}

sub usage {
    printf _g(
"Usage: %s [<option>...] [<changelogfile>]

Options:
    --help, -h                  print usage information
    --version, -V               print version information
    --label, -l <file>          name of the changelog file to
                                use in error messages
    --file <file>               changelog file to parse, defaults
                                to '-' (standard input)
    --format <outputformat>     see man page for list of available
                                output formats, defaults to 'dpkg'
                                for compatibility with dpkg-dev
    --since, -s, -v <version>   include all changes later than version
    --until, -u <version>       include all changes earlier than version
    --from, -f <version>        include all changes equal or later
                                than version
    --to, -t <version>          include all changes up to or equal
                                than version
    --count, -c, -n <number>    include <number> entries from the top
                                (or the tail if <number> is lower than 0)
    --offset, -o <number>       change the starting point for --count,
                                counted from the top (or the tail if
                                <number> is lower than 0)
    --all                       include all changes
"), $progname;
}

my ( $since, $until, $from, $to, $all, $count, $offset, $file, $label );
my $default_file = '-';
my $format = 'dpkg';
my %allowed_formats = (
    dpkg => 1,
    rfc822 => 1,
    );

sub set_format {
    my ($opt, $val) = @_;

    unless ($allowed_formats{$val}) {
	usageerr(_g('output format %s not supported'), $val );
    }

    $format = $val;
}

GetOptions( "file=s" => \$file,
	    "label|l=s" => \$label,
	    "since|v=s" => \$since,
	    "until|u=s" => \$until,
	    "from|f=s" => \$from,
	    "to|t=s" => \$to,
	    "count|c|n=i" => \$count,
	    "offset|o=i" => \$offset,
	    "help|h" => sub{usage();exit(0)},
	    "version|V" => sub{version();exit(0)},
	    "format=s" => \&set_format,
	    "all|a" => \$all,
	    )
    or do { usage(); exit(2) };

usageerr('too many arguments') if @ARGV > 1;

if (@ARGV) {
    if ($file && ($file ne $ARGV[0])) {
	usageerr(_g('more than one file specified (%s and %s)'),
		 $file, $ARGV[0] );
    }
    $file = $ARGV[0];
}

$file ||= $default_file;
$label ||= $file;
unless (defined($since) or defined($until) or defined($from) or
        defined($to) or defined($offset) or defined($count) or
        defined($all))
{
    $count = 1;
}
my %all = $all ? ( all => $all ) : ();
my $range = {
    since => $since, until => $until, from => $from, to => $to,
    count => $count, offset => $offset,
    %all
};

my $changes = Dpkg::Changelog::Debian->new(reportfile => $label, range => $range);

if ($file eq '-') {
    $changes->parse(\*STDIN, _g("<standard input>"))
	or error(_g('fatal error occured while parsing input'));
} else {
    $changes->load($file)
	or error(_g('fatal error occured while parsing %s'), $file);
}

eval qq{
    my \$output = \$changes->$format(\$range);
    print \$output if defined \$output;
};
if ($@) {
    error("%s", $@);
}