#!/usr/bin/perl

BEGIN {
	($main::HOME = $ENV{'HOME'})
		or die "HOME not defined in environment!\n";
	push( @INC, "$main::HOME/lib" );
}

use strict;
use vars qw($debianroot @dists @components $verbose);

$debianroot = "/pub/Linux/debian";
@dists = qw(unstable);
@components = qw(main non-US/main);


while( @ARGV && $ARGV[0] =~ /^-/ ) {
	$_ = shift @ARGV;
	if (/^-v$/ || /^--verbose$/) {
		$verbose++;
	}
	else {
		die "Unknown option: $_\n";
	}
}

chdir( "$main::HOME/upload" ) or die "Can't cd to ~/upload: $!\n";

my @jobs = glob( "*.changes" );
my $job;
foreach $job (@jobs) {
	if (!open( F, "$job" )) {
		warn "Cannot open $job: $!\n";
		next;
	}
	my $changes_text;
	{ local($/); undef $/; $changes_text = <F>; }
	close( F );
	my @files = get_files_from_changes( $changes_text );
	my $in_arch = 1;
	foreach (@files) {
		if (!in_archive( $_ )) {
			$in_arch = 0;
			last;
		}
	}
	if (!$in_arch) {
		print "Not deleting $job\n" if $verbose;
		next;
	}

	(my $upload = $job) =~ s/\.changes$/.upload/;
	unlink @files, $job, $upload;
	print "Removed $job\n" if $verbose;
}


sub in_archive {
	my $fn = shift;
	my ($p, $v, $a) = split_debname($fn);
	my $afn = "${p}_${v}.deb";

	my ($dist, $comp);
	foreach $dist (@dists) {
		foreach $comp (@components) {
			my @found = glob("$debianroot/dists/$dist/$comp/binary-$a/*/$afn");
			return 1 if @found;
		}
	}
	return 0;
}

sub get_files_from_changes {
	my $changes_text = shift;
	my(@filelines, @files);
	
	$changes_text =~ /^Files:\s*\n((^[ 	]+.*\n)*)/m;
	@filelines = split( "\n", $1 );
	foreach (@filelines) {
		push( @files, (split( /\s+/, $_ ))[5] );
	}
	return @files;
}

sub split_debname {
	my $pkgv = shift;
	
	if ($pkgv !~ /^([a-zA-Z\d.+-]+)_([a-zA-Z\d:.~+-]+)(_([a-zA-Z\d-]+))?\.deb$/) {
		warn "Bad package name: $pkgv\n";
		return ("", "", "");
	}
	return ($1, $2, $4);
}