Subject: [PATCH 11/25] Replace .changes parsing code with a Lintian::Schedule() call

From: Adam D. Barratt <[email-masked]>
Date: Wed, 6 Jan 2010 16:22:31 +0000

---
 frontend/lintian |  164 +-----------------------------------------------------
 1 files changed, 1 insertions(+), 163 deletions(-)

diff --git a/frontend/lintian b/frontend/lintian
index 12a5bf9..bbe583a 100755
--- a/frontend/lintian
+++ b/frontend/lintian
@@ -766,169 +766,7 @@ while (my $arg = shift) {
 	}
 	# .changes file?
 	elsif ($arg =~ /\.changes$/) {
-	    # get directory and filename part of $arg
-	    my ($arg_dir, $arg_name) = $arg =~ m,(.*)/([^/]+)$,;
-
-	    v_msg("Processing changes file $arg_name ...");
-
-	    my ($data) = read_dpkg_control($arg);
-	    if (not defined $data) {
-		warning("$arg is a zero-byte file, skipping");
-		next;
-	    }
-	    $TAGS->file_start($arg, $arg_name, '', '', 'binary');
-
-	    # If we don't have a Format key, something went seriously wrong.
-	    # Tag the file and skip remaining processing.
-	    if (!$data->{'format'}) {
-		tag('malformed-changes-file');
-		next;
-	    }
-
-	    # Description is mandated by dak, but only makes sense if binary
-	    # packages are included.  Don't tag pure source uploads.
-	    if (!$data->{'description'} && $data->{'architecture'} ne 'source') {
-		tag("no-description-in-changes-file");
-	    }
-
-	    # check distribution field
-	    if (defined $data->{distribution}) {
-		my $ubuntu_dists = Lintian::Data->new ('changelog-file/ubuntu-dists');
-		my $ubuntu_regex = join('|', $ubuntu_dists->all);
-		my @distributions = split /\s+/o, $data->{distribution};
-		for my $distribution (@distributions) {
-		    if ($distribution eq 'UNRELEASED') {
-			# ignore
-		    } elsif ($data->{version} =~ /ubuntu|$ubuntu_regex/
-			 or $distribution =~ /$ubuntu_regex/) {
-			if ($distribution !~ /^($ubuntu_regex)(-(proposed|updates|backports|security))?$/ ) {
-			    tag("bad-ubuntu-distribution-in-changes-file",
-				$distribution);
-			}
-		    } elsif (! (($distribution eq 'oldstable')
-				 or ($distribution eq 'stable')
-				 or ($distribution eq 'testing')
-				 or ($distribution eq 'unstable')
-				 or ($distribution eq 'experimental')
-				 or ($distribution =~ /^\w+-backports$/)
-				 or ($distribution =~ /^\w+-proposed-updates$/)
-				 or ($distribution =~ /^\w+-security$/))
-			    ) {
-			# bad distribution entry
-			tag("bad-distribution-in-changes-file",
-			    $distribution);
-		    }
-		}
-
-		if ($#distributions > 0) {
-		    tag("multiple-distributions-in-changes-file",
-			$data->{'distribution'});
-		}
-	    }
-
-	    # Urgency is only recommended by Policy.
-	    if (!$data->{'urgency'}) {
-		tag("no-urgency-in-changes-file");
-	    } else {
-		my $urgency = lc $data->{'urgency'};
-		$urgency =~ s/ .*//;
-		unless ($urgency =~ /^(low|medium|high|critical|emergency)$/i) {
-		    tag("bad-urgency-in-changes-file", $data->{'urgency'});
-		}
-	    }
-
-	    # Changed-By is optional in Policy, but if set, must be
-	    # syntactically correct.  It's also used by dak.
-	    if ($data->{'changed-by'}) {
-		check_maintainer($data->{'changed-by'}, 'changed-by');
-	    }
-
-	    # process all listed `files:'
-	    my %files;
-
-	    my $file_list = $data->{files} || '';
-	    for ( split /\n/, $file_list ) {
-		chomp;
-		s/^\s+//o;
-		next if $_ eq '';
-
-		my ($md5sum,$size,$section,$priority,$file) = split(/\s+/o, $_);
-
-		next if ($file =~ m,/,);
-
-		$files{$file}{md5} = $md5sum;
-		$files{$file}{size} = $size;
-
-		# check section
-		if (($section eq 'non-free') or ($section eq 'contrib')) {
-		    tag( "bad-section-in-changes-file", $file, $section );
-		}
-
-	    }
-
-	    foreach my $alg (qw(sha1 sha256)) {
-		my $list = $data->{"checksums-$alg"} || '';
-		for ( split /\n/, $list ) {
-		    chomp;
-		    s/^\s+//o;
-		    next if $_ eq '';
-
-		    my ($checksum,$size,$file) = split(/\s+/o, $_);
-		    $files{$file}{$alg} = $checksum;
-		    if ($files{$file}{size} != $size) {
-			tag( "file-size-mismatch-in-changes-file", $file,
-			     "$files{$file}{size} != $size" );
-		    }
-		}
-	    }
-
-
-	    foreach my $file (keys %files) {
-		my $filename = $arg_dir . '/' . $file;
-
-		# check size
-		if (not -f $filename) {
-		    warning("$file does not exist, exiting");
-		    exit 2;
-		}
-		my $size = -s _;
-		if ($size ne $files{$file}{size}) {
-		    tag( "file-size-mismatch-in-changes-file", $file,
-			 "$files{$file}{size} != $size");
-		}
-
-		# check checksums
-		if ($check_checksums or $file =~ /\.dsc$/) {
-		    foreach my $alg (qw(md5 sha1 sha256)) {
-			next unless exists $files{$file}{$alg};
-
-			my $real_checksum = get_file_checksum($alg, $filename);
-
-			if ($real_checksum ne $files{$file}{$alg}) {
-			    tag( "checksum-mismatch-in-changes-file", $alg, $file );
-			}
-		    }
-		}
-
-		# process file?
-		if ($file =~ /\.dsc$/) {
-		    $schedule->add_dsc($filename);
-		} elsif ($file =~ /\.deb$/) {
-		    $schedule->add_deb('b', $filename);
-		} elsif ($file =~ /\.udeb$/) {
-		    $schedule->add_deb('u', $filename);
-		}
-	    }
-
-	    unless ($exit_code) {
-		my $stats = $TAGS->statistics($arg);
-		if ($stats->{types}{E}) {
-		    $exit_code = 1;
-		} elsif ($fail_on_warnings && $stats->{types}{W}) {
-		    $exit_code = 1;
-		}
-	    }
-
+	    $schedule->add_changes($arg);
 	} else {
 	    fail("bad package file name $arg (neither .deb, .udeb or .dsc file)");
 	}
-- 
1.6.6