diff options
author | Raphaël Hertzog <hertzog@debian.org> | 2009-10-25 17:54:06 +0100 |
---|---|---|
committer | Raphaël Hertzog <hertzog@debian.org> | 2009-10-31 22:42:11 +0100 |
commit | dc5d755b0fe118938f7bba438fcf2e44461b0f65 (patch) | |
tree | 0b353c4c386e5d7cec35835f914356a75e45653c | |
parent | d0d812c1d96f53fdabbb356a50fc3a11cd7ce04d (diff) | |
download | dpkg-dc5d755b0fe118938f7bba438fcf2e44461b0f65.tar.gz |
Move header/trailer checks in Dpkg::Changelog::Entry::Debian
-rw-r--r-- | scripts/Dpkg/Changelog/Debian.pm | 34 | ||||
-rw-r--r-- | scripts/Dpkg/Changelog/Entry/Debian.pm | 59 |
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 |