summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRaphaël Hertzog <hertzog@debian.org>2009-10-25 17:54:06 +0100
committerRaphaël Hertzog <hertzog@debian.org>2009-10-31 22:42:11 +0100
commitdc5d755b0fe118938f7bba438fcf2e44461b0f65 (patch)
tree0b353c4c386e5d7cec35835f914356a75e45653c
parentd0d812c1d96f53fdabbb356a50fc3a11cd7ce04d (diff)
downloaddpkg-dc5d755b0fe118938f7bba438fcf2e44461b0f65.tar.gz
Move header/trailer checks in Dpkg::Changelog::Entry::Debian
-rw-r--r--scripts/Dpkg/Changelog/Debian.pm34
-rw-r--r--scripts/Dpkg/Changelog/Entry/Debian.pm59
2 files changed, 63 insertions, 30 deletions
diff --git a/scripts/Dpkg/Changelog/Debian.pm b/scripts/Dpkg/Changelog/Debian.pm
index f1af47ff6..2f28e5234 100644
--- a/scripts/Dpkg/Changelog/Debian.pm
+++ b/scripts/Dpkg/Changelog/Debian.pm
@@ -63,7 +63,6 @@ use warnings;
use Fcntl qw(:flock);
use English;
-use Date::Parse;
use Dpkg;
use Dpkg::Gettext;
@@ -148,25 +147,8 @@ sub parse {
last if $self->_abort_early;
}
$entry->set_part('header', $_);
- my %kvdone;
- for my $kv (split(/\s*,\s*/, $options)) {
- $kv =~ m/^([-0-9a-z]+)\=\s*(.*\S)$/i ||
- $self->_do_parse_error($file, $NR,
- sprintf(_g("bad key-value after \`;': \`%s'"), $kv));
- my $k = ucfirst $1;
- my $v = $2;
- $kvdone{$k}++ && $self->_do_parse_error($file, $NR,
- sprintf(_g("repeated key-value %s"), $k));
- if ($k eq 'Urgency') {
- $v =~ m/^([-0-9a-z]+)((\s+.*)?)$/i ||
- $self->_do_parse_error($file, $NR,
- _g("badly formatted urgency value"),
- $v);
- } elsif ($k =~ m/^X[BCS]+-/i) {
- } else {
- $self->_do_parse_error($file, $NR,
- sprintf(_g("unknown key-value key %s - copying to XS-%s"), $k, $k));
- }
+ foreach my $error ($entry->check_header()) {
+ $self->_do_parse_error($file, $NR, $error, $_);
}
$expect= 'start of change data';
@blanklines = ();
@@ -201,19 +183,11 @@ sub parse {
$self->_do_parse_error($file, $NR,
sprintf(_g("found trailer where expected %s"),
$expect), "$_");
- if ($3 ne ' ') {
- $self->_do_parse_error($file, $NR,
- _g( "badly formatted trailer line" ),
- "$_");
- }
$entry->set_part("trailer", $_);
$entry->extend_part("blank_after_changes", [ @blanklines ]);
@blanklines = ();
- $entry->{'Timestamp'} = str2time($4);
- unless (defined $entry->{'Timestamp'}) {
- $self->_do_parse_error( $file, $NR,
- sprintf(_g("couldn't parse date %s"),
- "$4"));
+ foreach my $error ($entry->check_header()) {
+ $self->_do_parse_error($file, $NR, $error, $_);
}
$expect = 'next heading or eof';
} elsif (m/^ \-\-/) {
diff --git a/scripts/Dpkg/Changelog/Entry/Debian.pm b/scripts/Dpkg/Changelog/Entry/Debian.pm
index ce3d30890..073ec046c 100644
--- a/scripts/Dpkg/Changelog/Entry/Debian.pm
+++ b/scripts/Dpkg/Changelog/Entry/Debian.pm
@@ -24,6 +24,8 @@ use Dpkg::Changelog::Entry;
use base qw(Exporter Dpkg::Changelog::Entry);
our @EXPORT_OK = qw($regex_header $regex_trailer);
+use Date::Parse;
+
use Dpkg::Control::Changelog;
use Dpkg::Version;
use Dpkg::Changelog qw(:util);
@@ -95,6 +97,63 @@ sub get_change_items {
return @items;
}
+=item my @errors = $entry->check_header()
+
+=item my @errors = $entry->check_trailer()
+
+Return a list of errors. Each item in the list is an error message
+describing the problem. If the empty list is returned, no errors
+have been found.
+
+=cut
+
+sub check_header {
+ my ($self) = @_;
+ my @errors;
+ if (defined($self->{header}) and $self->{header} =~ $regex_header) {
+ my $options = $4;
+ $options =~ s/^\s+//;
+ my %optdone;
+ foreach my $opt (split(/\s*,\s*/, $options)) {
+ unless ($opt =~ m/^([-0-9a-z]+)\=\s*(.*\S)$/i) {
+ push @errors, sprintf(_g("bad key-value after \`;': \`%s'"), $opt);
+ next;
+ }
+ my ($k, $v) = (ucfirst($1), $2);
+ if ($optdone{$k}) {
+ push @errors, sprintf(_g("repeated key-value %s"), $k);
+ }
+ $optdone{$k} = 1;
+ if ($k eq 'Urgency') {
+ push @errors, sprintf(_g("badly formatted urgency value: %s"), $v)
+ unless ($v =~ m/^([-0-9a-z]+)((\s+.*)?)$/i);
+ } elsif ($k =~ m/^X[BCS]+-/i) {
+ } else {
+ push @errors, sprintf(_g("unknown key-value %s"), $k);
+ }
+ }
+ } else {
+ push @errors, _g("the header doesn't match the expected regex");
+ }
+ return @errors;
+}
+
+sub check_trailer {
+ my ($self) = @_;
+ my @errors;
+ if (defined($self->{trailer}) and $self->{trailer} =~ $regex_trailer) {
+ if ($3 ne ' ') {
+ push @errors, _g("badly formatted trailer line");
+ }
+ unless (defined str2time($4)) {
+ push @errors, sprintf(_g("couldn't parse date %s"), $4);
+ }
+ } else {
+ push @errors, _g("the trailer doesn't match the expected regex");
+ }
+ return @errors;
+}
+
=item $entry->normalize()
Normalize the content. Strip whitespaces at end of lines, use a single