#!/usr/bin/perl

=pod

=head1 NAME

proposed-updates.pl - handle updates to stable

=head1 Description

The stable release cannot be altered except at point releases.
Instead, stable-proposed-updates is used to hold packages that need
updates in the stable release. These updates are then migrated into
stable as a single collection when a point release is made.

proposed-updates.pl tries to track the updates to stable in Debian
and apply them in Emdebian Grip. The actual migration of the updated
packages into the stable release is a separate process.

proposed-updates.pl checks the details of stable-proposed-updates in
the filter repository against the equivalent Grip repository and
either migrates an existing package from testing or builds the updated
version from the version in the filter repository.

Most of the work is done in Emdebian::Grip.

=cut

use strict;
use warnings;
use Data::Dumper;
use File::Basename;
use Emdebian::Grip;
use Debian::Packages::Compare;

use vars qw/ $filter_name $grip_name $suite $base
 $noskip @archlist @locroots @lines $line %pkg @filter $have
 %debianstable %gripstable %gripupdate $go $mirror
 $our_version %debupdate %griptesting /;

my $prog = basename($0);
$our_version = &scripts_version();

$mirror='http://ftp.uk.debian.org/debian'; # default
$filter_name = 'filter';
$grip_name = 'grip';
$suite = "stable";
$base = '/opt/reprepro/';
$go = 1; # define to make changes in repositories.

while( @ARGV ) {
	$_= shift( @ARGV );
	last if m/^--$/;
	if (!/^-/) {
		unshift(@ARGV,$_);
		last;
	}
	elsif (/^(-\?|-h|--help|--version)$/) {
		&usageversion();
		exit (0);
	}
	elsif (/^(-m|--mirror)$/) {
		$mirror = shift;
	}
	elsif (/^(-b|--base-path)$/) {
		$base = shift;
	}
	elsif (/^(-n|--dry-run)$/) {
		undef $go;
	}
	elsif (/^(--filter-name)$/) {
		$filter_name = shift;
	}
	elsif (/^(--grip-name)$/) {
		$grip_name = shift;
	}
	else {
		die "$prog: Unknown option $_.\n";
	}
}

$base .= '/' if ("$base" !~ m:/$:);
die "ERR: Please specify an existing directory for the base-path: $base\n"
	if (not -d $base);

&set_base($base);
&set_repo_names ($filter_name, $grip_name);
my $a = &get_archlist ($suite, $filter_name);
die ("ERR: unable to read architecture list.\n") if (not defined $a);
@archlist = @$a;
my $l = &get_locale_roots ($suite, 'locale');
die ("ERR: unable to read components list for locales.\n")
	if (not defined $l);
@locroots = @$l;

die("ERROR: No pkglist filter file.\n")
	if ( not -f "${base}${filter_name}/conf/pkglist" );

my $debf  = &read_packages ('stable', $filter_name);
my $gripf = &read_packages ('stable', $grip_name);
my $gript = &read_packages ('testing', $grip_name);
my $updatedeb = &read_packages ('stable-proposed-updates', $filter_name);
my $updategrip = &read_packages ('stable-proposed-updates', $grip_name);
%debianstable = %$debf   if (defined $debf);
%gripstable   = %$gripf  if (defined $gripf);
%gripupdate   = %$updategrip  if (defined $updategrip);
%griptesting  = %$gript  if (defined $gript);
%debupdate    = %$updatedeb if (defined $updatedeb);
my $bin_query = &get_missing_binaries('stable-proposed-updates','filter','grip');
my $stable_query = &get_missing_binaries('stable', 'filter', 'grip');
my %build=();
my %migrate=();
my %seen=();

# begin the work.
foreach my $query (sort keys %$bin_query)
{
	delete $$bin_query{$query}{'arm'}
		if (exists $$bin_query{$query}{'arm'});
	delete $$bin_query{$query}
		if (scalar keys %{$$bin_query{$query}} == 0);
}
print "INF: Found " . scalar keys (%$bin_query) . " packages to be checked . . .\n";
foreach my $query (sort keys %$bin_query)
{
	next;
	if (exists $gripupdate{$query}) {
		my $e = $gripupdate{$query};
		my $list = collate_version ($e);
		my $emver = $$list[0];
		if (not defined $emver) {
			use Data::Dumper;
			print Dumper ($gripupdate{$query});
			next;
		}
		print "ERR: $query ($emver) occurs in proposed-updates already.\n";
		$emver =~ s/em[0-9]$//;
		my $d = $debianstable{$query};
		my $dlist = collate_version ($d);
		my $debver = $$dlist[0];
		delete $$bin_query{$query} if ($emver eq $debver);
	}
}
my %sort;
foreach my $query (sort keys %$bin_query) {
	$sort{$debianstable{$query}{'Src'}}++;
}
foreach my $query (sort keys %$stable_query) {
	$sort{$debianstable{$query}{'Src'}}++;
}
print "INF: ".scalar (keys %sort) ." source packages to check. Please wait . . . \n";
print join (", ", (sort keys %sort))."\n";

foreach my $query (sort keys %sort) {
	next if (not defined $debianstable{$query}{'Src'});
	my $src = (defined $debianstable{$query}{'Src'}) ?
		$debianstable{$query}{'Src'} : $query;
	chomp ($src);
	$src =~ s/ //g;
	my $prefix = convert_prefix ($src);
	my $ver = $$bin_query{$query}{'amd64'}{'filter'};
	if (not defined $ver) {
		foreach my $arch (sort keys (%{$$bin_query{$query}})) {
			$ver = $$bin_query{$query}{$arch}{'filter'}
				if (not defined $ver);
		}
		foreach my $arch (sort keys (%{$$stable_query{$query}})) {
			$ver = $$bin_query{$query}{$arch}{'filter'}
				if (not defined $ver);
		}
	}
	if (not defined $ver) {
		print ("undefined version for $query\n");
		next;
	}
	next if ($query eq "acpi-support-base");
	# strip epochs
	$ver =~ s/^[0-9]://;
	# strip binNMU's
	$ver =~ s/\+b[0-9]$//;
	my $dsc = "${base}filter/pool/main/${prefix}/${src}/${src}_${ver}.dsc";
	if (not -f $dsc) {
		warn "ERR: $dsc not found for $query\n";
		print "INF: Try adding the source package '$src' using em_autogrip.\n";
		next;
	}
	# cannot use grip_binary here if the package already exists.
	foreach my $arch (sort @archlist) {
		next if ($arch eq 'source');
		next if ($arch eq 'arm');
		next if (defined $gripupdate{$query}{$arch});
		if (not defined $griptesting{$query}{$arch}) {
			$build{$query}{$ver}=$dsc;
			next;
		}
		my $exists = $griptesting{$query}{$arch};
		$exists =~ s/em[0-9]$//;
		if ($ver eq $exists) {
			$migrate{$query}=$exists;
			next;
		}
		$build{$query}{$ver}=$dsc;
	}
}
if (not defined $go)
{
	foreach my $query (sort keys %build) {
		my $ver = join (" ", keys (%{$build{$query}}));
		print $query . "\n\tTo process    : $ver\n";
		print "\t".$build{$query}{$ver}."\n";
		my $fs = (defined $debianstable{$query}{'i386'}) ?
			$debianstable{$query}{'i386'} : "missing";
		print             "\tFilter stable = $fs\n";
		my $fu = (defined $debupdate{$query}{'i386'}) ?
			$debupdate{$query}{'i386'} : "missing";
		print             "\tFilter update = $fu\n";
		my $gs = (defined $gripstable{$query}{'i386'}) ?
			$gripstable{$query}{'i386'} : "missing";
		print             "\tGrip   stable = $gs\n";
		my $gu = (defined $gripupdate{$query}{'i386'}) ? 
			$gripupdate{$query}{'i386'} : "missing";
		print             "\tGrip   update = $gu\n";
	}
	print "INF: Done.\n";
	exit 0;
}
foreach my $query (sort keys %migrate)
{
	my $v = $migrate{$query};
	my $to = 'stable-proposed-updates';
	my $src = (defined $debianstable{$query}{'Src'}) ?
		$debianstable{$query}{'Src'} : $query;
	chomp ($src);
	$src =~ s/ //g;
	print "Migrating $src ($v) into $grip_name $to.\n";
	print "reprepro -v -b ${base}${grip_name} copysrc $to testing $src $v\n"
		if (not defined $go);
	system ("reprepro -v -b ${base}${grip_name} copysrc $to testing $src $v")
		if (defined $go);
}
foreach my $query (sort keys %build)
{
	my $h = $build{$query};
	my @a = keys %$h;
	my $ver = $a[0];
	my $dsc = $build{$query}{$ver};
	my $src = (defined $debianstable{$query}{'Src'}) ?
		$debianstable{$query}{'Src'} : $query;
	chomp ($src);
	$src =~ s/ //g;
	if (defined $gripupdate{$query}) {
		my $exists = $gripupdate{$query}{'armel'};
		if (defined $exists) {
			$exists =~ s/em[0-9]$//;
			print "Skipping $query $ver : $exists\n";
			next if ($exists eq $ver);
		}
	} elsif (defined $griptesting{$query}) {
		print "Need to build $query $ver\n";
	} else {
		print "Adding $query $ver\n";
	}
	if (defined $go) {
		# subsequent changes are likely to repeat existing work.
		&grip_source ($src, $ver, 'stable-proposed-updates', 'source')
			unless (exists $seen{$src});
		$seen{$src}++;
		my $arch_hash = $$bin_query{$query};
		my @arch_list = keys %$arch_hash;
		if ((scalar @arch_list == 1) and ($arch_list[0] eq 'source')) {
			&grip_binary($query, $ver, 'stable-proposed-updates', 'all');
		} else {
			foreach my $arch (sort @arch_list) {
				&grip_binary ($query, $ver, 'stable-proposed-updates', $arch);
			}
		}
	}
}
clean_incoming($grip_name);
print "INF: Done.\n";
exit 0;

=head1 Copyright and Licence

 Copyright (C) 2009  Neil Williams <codehelp@debian.org>

 This package is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
 the Free Software Foundation; either version 3 of the License, or
 (at your option) any later version.

 This program is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of
 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 GNU General Public License for more details.

 You should have received a copy of the GNU General Public License
 along with this program.  If not, see <http://www.gnu.org/licenses/>.

=cut

sub usageversion
{
	print(STDERR <<END)
$prog - handle updates to stable
version $our_version

Syntax: $prog -b PATH [OPTIONS]
        $prog -?|-h|--help|--version

Commands:
-b|--base-path PATH:           path to the top level grip directory [required]
-?|-h|--help|--version:        print this help message and exit

Options:
-n|--dry-run:                  check which packages would be processed
-m|--mirror MIRROR:            use a different Debian mirror for updates
                                [default: http://ftp.uk.debian.org/debian]
   --filter-name STRING:       alternative name for the filter repository
   --grip-name STRING:         alternative name for the grip repository

The default is to update all the packages currently in Debian as updates
for the stable release (stable-proposed-updates), in all architectures.

$prog will only handle stable and stable-proposed-updates.

$prog also updates the locale repository, shared by Emdebian
Grip and Emdebian Crush.

END
	or die "$0: failed to write usage: $!\n";
}

# a little jiggery-pokery to get the version
# from the hash in a collated manner.
sub collate_version
{
	my $e = shift;
	my @list = values %$e;
	my %h=();
	foreach my $l (@list) {
		next if (not defined $l);
		next if ($l !~ /^[0-9]/);
		$h{$l}++;
	}
	@list=();
	@list = sort keys %h;
	return \@list;
}
