#!/usr/bin/perl -W
# Copyright (C) 2004 Marc Brockschmidt
# 
# This script is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.

use strict;
use File::Basename qw(dirname);
use File::Spec;
my (%unstable_version, @dupload_args, %src_cache);

#Get data:
while (<DATA>) {
	chomp;
	next if (/^$/ || /^\s*#/);
	my ($pkg, $ver) = split m!/!, $_, 2;
	$unstable_version{$pkg} = $ver;
}

my @changes_files;

for my $arg (@ARGV) {
	if (-f $arg && $arg =~ /\.changes$/) {
		push @changes_files, $arg;
	} elsif (-d $arg) {
		for (<$arg/*changes>) {
			push @changes_files, $_;
		}
	}

	push @dupload_args, $arg;
}

for my $changes (@changes_files) {
	chomp(my $pkg_distr = `grep ^Distribution $changes | cut -d : -f 2`);
	$changes =~ m/^(\S+)_([^_]+)_[^_]+\.changes$/;
	my ($pkg_name, $pkg_version) = ($1, $2);

	#Check version of source package:
	if ($unstable_version{$pkg_name}) {
		if (check_version($unstable_version{$pkg_name}, $pkg_version) == -1 &&
		  $pkg_distr !~ /experimental/) {	
			#OK, this version seems to be too new:
			print "It seems that $pkg_name/$pkg_version shouldn't be targeted at unstable.\n";
			print "Are you sure you want to upload? [yN] ";
			if (<STDIN> !~ /^y$/i) {
				print "Upload aborted!\n";
				exit 1;
			}
		}
	} else {
		#No unstable version defined:
		print "W: You haven't defined an unstable version for $pkg_name!\n";
	}

	#Now check the dependencies:
	my $dir = dirname($changes);
	my @tmp = `egrep "^ .\+deb\$" $changes`; #Get all debs
	my @debs;
	for (@tmp) {
		my $deb = File::Spec->catfile($dir, (split)[4]);
		push @debs, $deb if $deb;
	}

	my %broken_deps;

	for my $deb (@debs) {
		my $depends = `dpkg -I $deb | egrep "^ Depends" | cut -d " " -f 3-`;
		for my $dep (split /,\s*/, $depends) {
			my @dep = _split_dep($dep);
			#Remove epochs:
			$dep[1]->[1] =~ s/^\d+://;
			#only check libs:
			if ($dep[0] =~ /^lib/) {
				#Get the source package name:
				my $src_pkg;
				if ( $src_cache{$dep[0]}) {
					$src_pkg = $src_cache{$dep[0]};
				} else {
					$src_pkg = `apt-cache showsrc $dep[0] | egrep ^Package | head -n 1 | cut -d " " -f 2`;
					chomp($src_pkg);
					$src_cache{$dep[0]} = $src_pkg;
				}

				#Only check "our" packages:
				if ($unstable_version{$src_pkg} && $dep[1]->[1] &&
				  #Now check if there's a problem
				  check_version($unstable_version{$src_pkg}, $dep[1]->[1]) == -1 &&
				  $pkg_distr !~ /experimental/) {
				    #Save problematic dependencies to report them later: [hash to kick out dupes]
				  	$broken_deps{$dep[0]."/".$dep[1]->[1]} = 1;
				}
			}
		}
	}

	#Report problems and get the answer
	if (keys %broken_deps) {
		print "$pkg_name seems to be built against the following experimental lib(s):\n";
		print "\t$_\n" for (keys %broken_deps);
		print "Really upload? [yN] ";
		if (<STDIN> !~ /^y$/i) {
			print "Upload aborted!\n";
			exit 1;
		}		
	}
}

system("dupload", @dupload_args);

exit;

sub check_version {
	my ($ver_a, $ver_b) = @_;
	my @ver_a =	split /([^\d])/, $ver_a;
	my @ver_b = split /([^\d])/, $ver_b;

	for (my $i = 0; $i < @ver_a; $i++) {
		if ($ver_a[$i] ne $ver_b[$i]) {
			#a is lower than b if the current part of a is sorted
			#before the equal part of b
			if ($ver_a[$i] =~ /^\d+$/) {
				return -1 if ((sort ($ver_a[$i], $ver_b[$i]))[0] eq $ver_a[$i]);
			} else {
				return -1 if ($ver_a[$i] < $ver_b[$i]);
			}
			#they're not the same and a is not lower than b => b is higher than a:
			return 1;
		}
	}

	#All relevant parts are the same:
	return 0;
}

# splits "foo (>= 1.2.3) [!i386 ia64]" into
# ( "foo", [ ">=", "1.2.3" ], [ [ "i386", "ia64" ], 1 ], "" )
#                                                  ^^^   ^^
#                                 true, if ! was given   ||
#           rest (should always be "" for valid dependencies)
sub _split_dep {
	my $dep = shift;
	my ($pkg, $version, $darch) = ("", ["",""], [[],""]);

	$pkg = $1 if $dep =~ s/^\s*([^\s\[\(]+)\s*//;

	if (length $dep) {
		if ($dep =~ s/\s* \( \s* (<<|<=|<|=|>=|>>|>) \s* ([^(]+) \) \s*//x) {
			@$version = ($1, $2);
		}
		if ($dep && $dep =~ s/\s*\[([^\]]+)\]\s*//) {
			my $t = $1;
			$darch->[1] = 1 if ($t =~ s/!//g);
			$darch->[0] = [ split /\s+/, $t ];
		}
	}

	return ($pkg, $version, $darch, $dep);
}


__DATA__
atk1.0/1.6
bug-buddy/2.6
control-center/2.6
devhelp/0.9
eel2/2.6
epiphany-browser/1.2
file-roller/2.6
gconf2/2.6
gconf-editor/2.6
gedit/2.6
glade2/2.6
glib2.0/2.4
gnome-applets/2.6
gnome-desktop/2.6
gnome-games/2.6
gnome-keyring/0.2
gnome-netstatus/2.6
gnome-panel/2.6
gnome-session/2.6
gnome-system-monitor/2.6
gnome-terminal/2.6
gnome-themes/2.6
gnome-utils/2.6
gnome-vfs2/2.6
gtk+2.0/2.4
gtk-industrial-engine/0.2
gtk-smooth-engine/0.5
gtksourceview/1.0
libbonobo/2.6
libbonoboui/2.6
libgnome/2.6
libgnomecanvas/2.6
libgnomeprint/2.6
libgnomeprintui/2.6
libgnomeui/2.6
libgtop2/2.6
librsvg2/2.6
libwnck/2.6
metacity/2.8
nautilus/2.6
nautilus-cd-burner/2.6
orbit/2.10
pango1.0/1.4
yelp/2.6
zenity/2.6
