#! /usr/bin/perl

use strict;

use DBI;

my $outputdir = shift || die("outputdir?\n");

my $dbh_udd = DBI->connect("dbi:Pg:service=udd");

my $query = q{

select
	p2.source as brokensrc,
	p2.package as brokenpkg,
	p2.version as brokenvers,
	p2.architecture as brokenarch,
	d,
	p3.package,
	p3.version,
	p3.architecture,
	p3.source
from
	(

		select
			source,
			package,
			version,
			d,
			regexp_replace(regexp_replace(d,'\s*\(.*\)\s*',''),':any$','') deppkg,
			-- add + to the version, so '<=' can be handled just like '<<'
			debversion(regexp_replace(d,'.*\s+\(\s*<[=<]\s*(.*)\)\s*','\1+')) depvers,
			architecture
		from
			(
				select
					package,
					version,
					architecture,
					source,
					regexp_split_to_table(depends,E',\\\\s*') as d,
					depends
				from
					packages
				where
						release=(select release from releases where role='testing')
					and (depends like '%<%')
			) p
		where
				(d like '%<%')
			-- TODO This skips alternative deps. Usually that's ok.
			and (d not like '%|%')
	) p2,
	packages p3
where
		p3.package = p2.deppkg
	and	p3.version >= p2.depvers
	and p2.source != p3.source -- filter upper limits within same source
	and p3.release='sid'
	and (
				p2.architecture = p3.architecture
			or	p2.architecture = 'all'
		)
order by
	p3.source,
	p3.package,
	p2.package,
	p2.architecture

};

my $sth = $dbh_udd->prepare($query);
$sth->execute;
my $packages = {};
while (my $row = $sth->fetchrow_hashref()) {
	$packages->{$row->{"package"}} = $row->{"source"};
}

foreach my $pkg (sort keys %$packages) {
	my $tracker = "auto-upperlimit-$pkg";
	my $filename = "$outputdir/$tracker.ben";
	my $source = $packages->{$pkg};
	my $re_pkg = quotemeta($pkg);
	my $re_source = quotemeta($source);
	my $cfg = qq{
title = "$tracker";
is_affected = .depends ~ /$re_pkg \\(</ | .source ~ /^$re_source\$/;
is_good = !.uninstallable ~ /yes/;
is_bad = .uninstallable ~ /yes/;
#export = false;
notes = "Tracker for packages depending on $pkg with an upper limit

This tracker was setup by a very simple automated tool.
";
};
	open(CFG,"> $filename") or die("failed to open $cfg\n");
	print CFG $cfg;
	close(CFG);

}

