Просмотр исходного кода

Move header/trailer checks in Dpkg::Changelog::Entry::Debian

Raphaël Hertzog лет назад: 16
Родитель
Сommit
dc5d755b0f
2 измененных файлов с 63 добавлено и 30 удалено
  1. 4 30
      scripts/Dpkg/Changelog/Debian.pm
  2. 59 0
      scripts/Dpkg/Changelog/Entry/Debian.pm

+ 4 - 30
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/^ \-\-/) {

+ 59 - 0
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