lib/dpkg/tarfn.c: Kludge `tar_header_decode' to handle spurious `errno'.
[dpkg] / scripts / dpkg-parsechangelog.pl
1 #!/usr/bin/perl
2 #
3 # dpkg-parsechangelog
4 #
5 # Copyright © 1996 Ian Jackson
6 # Copyright © 2001 Wichert Akkerman
7 # Copyright © 2006-2012 Guillem Jover <guillem@debian.org>
8 #
9 # This program is free software; you can redistribute it and/or modify
10 # it under the terms of the GNU General Public License as published by
11 # the Free Software Foundation; either version 2 of the License, or
12 # (at your option) any later version.
13 #
14 # This program is distributed in the hope that it will be useful,
15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 # GNU General Public License for more details.
18 #
19 # You should have received a copy of the GNU General Public License
20 # along with this program. If not, see <https://www.gnu.org/licenses/>.
21
22 use strict;
23 use warnings;
24
25 use Dpkg ();
26 use Dpkg::Gettext;
27 use Dpkg::Getopt;
28 use Dpkg::ErrorHandling;
29 use Dpkg::Changelog::Parse;
30
31 textdomain('dpkg-dev');
32
33 my %options;
34 my $fieldname;
35
36 sub version {
37 printf g_("Debian %s version %s.\n"), $Dpkg::PROGNAME, $Dpkg::PROGVERSION;
38
39 printf g_('
40 This is free software; see the GNU General Public License version 2 or
41 later for copying conditions. There is NO warranty.
42 ');
43 }
44
45 sub usage {
46 printf g_(
47 'Usage: %s [<option>...]')
48 . "\n\n" . g_(
49 'Options:
50 -l <changelog-file> get per-version info from this file.
51 -F <changelog-format> force changelog format.
52 -S, --show-field <field> show the values for <field>.
53 -?, --help show this help message.
54 --version show the version.')
55 . "\n\n" . g_(
56 "Parser options:
57 --format <output-format>
58 set output format (defaults to 'dpkg').
59 --all include all changes.
60 -s, --since <version> include all changes later than <version>.
61 -v <version> ditto.
62 -u, --until <version> include all changes earlier than <version>.
63 -f, --from <version> include all changes equal or later than <version>.
64 -t, --to <version> include all changes up to or equal than <version>.
65 -c, --count <number> include <number> entries from the top (or tail
66 if <number> is lower than 0).
67 -n <number> ditto.
68 -o, --offset <number> change starting point for --count, counted from
69 the top (or tail if <number> is lower than 0).
70 "), $Dpkg::PROGNAME;
71 }
72
73 @ARGV = normalize_options(args => \@ARGV, delim => '--');
74
75 while (@ARGV) {
76 last unless $ARGV[0] =~ m/^-/;
77
78 my $arg = shift;
79
80 if ($arg eq '--') {
81 last;
82 } elsif ($arg eq '-L') {
83 warning(g_('-L is obsolete; it is without effect'));
84 } elsif ($arg eq '-F') {
85 $options{changelogformat} = shift;
86 usageerr(g_('bad changelog format name'))
87 unless length $options{changelogformat} and
88 $options{changelogformat} =~ m/^([0-9a-z]+)$/;
89 } elsif ($arg eq '--format') {
90 $options{format} = shift;
91 } elsif ($arg eq '-l' or $arg eq '--file') {
92 $options{file} = shift;
93 usageerr(g_('missing changelog filename'))
94 unless length $options{file};
95 } elsif ($arg eq '-S' or $arg eq '--show-field') {
96 $fieldname = shift;
97 } elsif ($arg eq '-c' or $arg eq '--count' or $arg eq '-n') {
98 $options{count} = shift;
99 } elsif ($arg eq '-f' or $arg eq '--from') {
100 $options{from} = shift;
101 } elsif ($arg eq '-o' or $arg eq '--offset') {
102 $options{offset} = shift;
103 } elsif ($arg eq '-s' or $arg eq '--since' or $arg eq '-v') {
104 $options{since} = shift;
105 } elsif ($arg eq '-t' or $arg eq '--to') {
106 $options{to} = shift;
107 } elsif ($arg eq '-u' or $arg eq '--until') {
108 ## no critic (ControlStructures::ProhibitUntilBlocks)
109 $options{until} = shift;
110 ## use critic
111 } elsif ($arg eq '--all') {
112 $options{all} = undef;
113 } elsif ($arg eq '-?' or $arg eq '--help') {
114 usage(); exit(0);
115 } elsif ($arg eq '--version') {
116 version(); exit(0);
117 } else {
118 usageerr(g_("unknown option '%s'"), $arg);
119 }
120 }
121 usageerr(g_('takes no non-option arguments')) if @ARGV;
122
123 my $count = 0;
124 my @fields = changelog_parse(%options);
125 foreach my $f (@fields) {
126 print "\n" if $count++;
127 if ($fieldname) {
128 print $f->{$fieldname} . "\n" if exists $f->{$fieldname};
129 } else {
130 print $f->output();
131 }
132 }