/usr/share/perl5/Dpkg/Changelog/Debian.pm is in libdpkg-perl 1.18.4ubuntu1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 | # Copyright © 1996 Ian Jackson
# Copyright © 2005 Frank Lichtenheld <frank@lichtenheld.de>
# Copyright © 2009 Raphaël Hertzog <hertzog@debian.org>
# Copyright © 2012-2015 Guillem Jover <guillem@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 <https://www.gnu.org/licenses/>.
=encoding utf8
=head1 NAME
Dpkg::Changelog::Debian - parse Debian changelogs
=head1 DESCRIPTION
Dpkg::Changelog::Debian parses Debian changelogs as described in the Debian
policy (version 3.6.2.1 at the time of this writing). See section
L<"SEE ALSO"> for locations where to find this definition.
The parser tries to ignore most cruft like # or /* */ style comments,
CVS comments, vim variables, emacs local variables and stuff from
older changelogs with other formats at the end of the file.
NOTE: most of these are ignored silently currently, there is no
parser error issued for them. This should become configurable in the
future.
=cut
package Dpkg::Changelog::Debian;
use strict;
use warnings;
our $VERSION = '1.00';
use Dpkg::Gettext;
use Dpkg::File;
use Dpkg::Changelog qw(:util);
use Dpkg::Changelog::Entry::Debian qw(match_header match_trailer);
use parent qw(Dpkg::Changelog);
use constant {
FIRST_HEADING => g_('first heading'),
NEXT_OR_EOF => g_('next heading or end of file'),
START_CHANGES => g_('start of change data'),
CHANGES_OR_TRAILER => g_('more change data or trailer'),
};
my $ancient_delimiter_re = qr{
^
(?: # Ancient GNU style changelog entry with expanded date
(?:
\w+\s+ # Day of week (abbreviated)
\w+\s+ # Month name (abbreviated)
\d{1,2} # Day of month
\Q \E
\d{1,2}:\d{1,2}:\d{1,2}\s+ # Time
[\w\s]* # Timezone
\d{4} # Year
)
\s+
(?:.*) # Maintainer name
\s+
[<\(]
(?:.*) # Maintainer email
[\)>]
| # Old GNU style changelog entry with expanded date
(?:
\w+\s+ # Day of week (abbreviated)
\w+\s+ # Month name (abbreviated)
\d{1,2},?\s* # Day of month
\d{4} # Year
)
\s+
(?:.*) # Maintainer name
\s+
[<\(]
(?:.*) # Maintainer email
[\)>]
| # Ancient changelog header w/o key=value options
(?:\w[-+0-9a-z.]*) # Package name
\Q \E
\(
(?:[^\(\) \t]+) # Package version
\)
\;?
| # Ancient changelog header
(?:[\w.+-]+) # Package name
[- ]
(?:\S+) # Package version
\ Debian
\ (?:\S+) # Package revision
|
Changes\ from\ version\ (?:.*)\ to\ (?:.*):
|
Changes\ for\ [\w.+-]+-[\w.+-]+:?\s*$
|
Old\ Changelog:\s*$
|
(?:\d+:)?
\w[\w.+~-]*:?
\s*$
)
}xi;
=head1 METHODS
=over 4
=item $c->parse($fh, $description)
Read the filehandle and parse a Debian changelog in it. Returns the number
of changelog entries that have been parsed with success.
=cut
sub parse {
my ($self, $fh, $file) = @_;
$file = $self->{reportfile} if exists $self->{reportfile};
$self->reset_parse_errors;
$self->{data} = [];
$self->set_unparsed_tail(undef);
my $expect = FIRST_HEADING;
my $entry = Dpkg::Changelog::Entry::Debian->new();
my @blanklines = ();
my $unknowncounter = 1; # to make version unique, e.g. for using as id
local $_;
while (<$fh>) {
chomp;
if (match_header($_)) {
unless ($expect eq FIRST_HEADING || $expect eq NEXT_OR_EOF) {
$self->parse_error($file, $.,
sprintf(g_('found start of entry where expected %s'),
$expect), "$_");
}
unless ($entry->is_empty) {
push @{$self->{data}}, $entry;
$entry = Dpkg::Changelog::Entry::Debian->new();
last if $self->abort_early();
}
$entry->set_part('header', $_);
foreach my $error ($entry->check_header()) {
$self->parse_error($file, $., $error, $_);
}
$expect= START_CHANGES;
@blanklines = ();
} elsif (m/^(?:;;\s*)?Local variables:/io) {
last; # skip Emacs variables at end of file
} elsif (m/^vim:/io) {
last; # skip vim variables at end of file
} elsif (m/^\$\w+:.*\$/o) {
next; # skip stuff that look like a CVS keyword
} elsif (m/^\# /o) {
next; # skip comments, even that's not supported
} elsif (m{^/\*.*\*/}o) {
next; # more comments
} elsif (m/$ancient_delimiter_re/) {
# save entries on old changelog format verbatim
# we assume the rest of the file will be in old format once we
# hit it for the first time
$self->set_unparsed_tail("$_\n" . file_slurp($fh));
} elsif (m/^\S/) {
$self->parse_error($file, $., g_('badly formatted heading line'), "$_");
} elsif (match_trailer($_)) {
unless ($expect eq CHANGES_OR_TRAILER) {
$self->parse_error($file, $.,
sprintf(g_('found trailer where expected %s'), $expect), "$_");
}
$entry->set_part('trailer', $_);
$entry->extend_part('blank_after_changes', [ @blanklines ]);
@blanklines = ();
foreach my $error ($entry->check_trailer()) {
$self->parse_error($file, $., $error, $_);
}
$expect = NEXT_OR_EOF;
} elsif (m/^ \-\-/) {
$self->parse_error($file, $., g_('badly formatted trailer line'), "$_");
} elsif (m/^\s{2,}(?:\S)/) {
unless ($expect eq START_CHANGES or $expect eq CHANGES_OR_TRAILER) {
$self->parse_error($file, $., sprintf(g_('found change data' .
' where expected %s'), $expect), "$_");
if ($expect eq NEXT_OR_EOF and not $entry->is_empty) {
# lets assume we have missed the actual header line
push @{$self->{data}}, $entry;
$entry = Dpkg::Changelog::Entry::Debian->new();
$entry->set_part('header', 'unknown (unknown' . ($unknowncounter++) . ') unknown; urgency=unknown');
}
}
# Keep raw changes
$entry->extend_part('changes', [ @blanklines, $_ ]);
@blanklines = ();
$expect = CHANGES_OR_TRAILER;
} elsif (!m/\S/) {
if ($expect eq START_CHANGES) {
$entry->extend_part('blank_after_header', $_);
next;
} elsif ($expect eq NEXT_OR_EOF) {
$entry->extend_part('blank_after_trailer', $_);
next;
} elsif ($expect ne CHANGES_OR_TRAILER) {
$self->parse_error($file, $.,
sprintf(g_('found blank line where expected %s'), $expect));
}
push @blanklines, $_;
} else {
$self->parse_error($file, $., g_('unrecognized line'), "$_");
unless ($expect eq START_CHANGES or $expect eq CHANGES_OR_TRAILER) {
# lets assume change data if we expected it
$entry->extend_part('changes', [ @blanklines, $_]);
@blanklines = ();
$expect = CHANGES_OR_TRAILER;
}
}
}
unless ($expect eq NEXT_OR_EOF) {
$self->parse_error($file, $.,
sprintf(g_('found end of file where expected %s'),
$expect));
}
unless ($entry->is_empty) {
push @{$self->{data}}, $entry;
}
return scalar @{$self->{data}};
}
1;
__END__
=back
=head1 SEE ALSO
Dpkg::Changelog
Description of the Debian changelog format in the Debian policy:
L<https://www.debian.org/doc/debian-policy/ch-source.html#s-dpkgchangelog>.
=head1 CHANGES
=head2 Version 1.00 (dpkg 1.15.6)
Mark the module as public.
=head1 AUTHORS
Frank Lichtenheld, E<lt>frank@lichtenheld.deE<gt>
Raphaël Hertzog, E<lt>hertzog@debian.orgE<gt>
=cut
|