Commit | Line | Data |
---|---|---|
1479465f GJ |
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 | } |