#!/usr/bin/perl

=pod

=head1 NAME

grip-catchup.pl - handle direct updates to testing

=head1 Description

Delays and bugs in unstable can lead to a package migrating into
Debian testing before the relevant package is in Grip unstable,
which then means that there is no suitable version to migrate into
Grip testing.

This script needs to be called with the name of the source package
that can be found in the filter repository for testing and then
gripped directly into Grip testing.

This is a slightly different version of proposed-updates.pl, but like
that script, the suite name itself cannot be altered.

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

=cut

use strict;
use warnings;
use Data::Dumper;
use File::Basename;
use POSIX qw(locale_h);
use Locale::gettext;
use Emdebian::Grip;
use Debian::Packages::Compare;

use vars qw/ $filter_name $grip_name $suite $base
 $noskip @archlist @locroots @lines $line %pkg @filter $have
 %debian %grip $go $mirror $our_version $mode @cmd /;

my $prog = basename($0);
$our_version = &scripts_version();
setlocale(LC_MESSAGES, "");
textdomain("emdebian-grip");

$mirror='http://ftp.uk.debian.org/debian'; # default
$filter_name = 'filter';
$grip_name = 'grip';
$suite = "testing";
$mode = "fail";
$base = '';
$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 (/^(-s|--source)$/) {
		push @cmd, shift;
		$mode = 'source';
	}
	elsif (/^(--filter-name)$/) {
		$filter_name = shift;
	}
	elsif (/^(--grip-name)$/) {
		$grip_name = shift;
	}
	else {
		die "$prog: "._g("Unknown option")." $_.\n";
	}
}

$base .= '/' if ("$base" !~ m:/$:);
if (not -d $base) {
	printf (_g("ERR: Please specify an existing directory for the base-path: %s\n"), $base);
	exit 1;
}

die (_g("ERR: no source package(s) specified.\n"))
	if ($mode eq "fail");

# add any remaining arguments as source packages.
while (scalar @ARGV > 0) {
	my $extra = shift;
	push @cmd, $extra;
}

&set_base($base);
&set_repo_names ($filter_name, $grip_name);
my $a = &get_archlist ($suite, $filter_name);
die (_g("unable to get architecture list\n")) if (not defined $a);
@archlist = @$a;
my $l = &get_locale_roots ($suite, 'locale');
die (_g("unable to get locale rootfs list\n")) if (not defined $l);
@locroots = @$l;
die(_g("no pkglist filter.\n"))
	if ( not -f "${base}${filter_name}/conf/pkglist" );

my $gript = &read_packages ($suite, $grip_name);
my $debt = &read_packages ($suite, $filter_name);
%debian = %$debt   if (defined $debt);
%grip   = %$gript  if (defined $gript);

my %build=();
my %migrate=();
my %seen=();

foreach my $query (sort @cmd) {
	if (not defined $debian{$query}{'Src'}) {
		printf (_g("INF: Cannot find %s in Debian %s. Skipping it.\n"), $query, $suite);
		next;
	}
	my $src = (defined $debian{$query}{'Src'}) ?
		$debian{$query}{'Src'} : $query;
	chomp ($src);
	$src =~ s/ //g;
	print "INF: Using $src as source package for '$query'.\n";
	my $prefix = convert_prefix ($src);
	my $ver = $debian{$src}{'source'};
	if (not defined $ver) {
		# Translators: first string is the package name, second the suite.
		my $msg = sprintf (_g("undefined Debian version for %s in %s"), $query, $suite);
		warn ($msg);
		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) {
		my $msg = sprintf (_g("%s not found\n"), $dsc);
		warn ($msg);
		next;
	}
	my $exists = $grip{$src}{'source'};
	$exists =~ s/em[0-9]$// if (defined $exists);
	if (defined $exists and ($ver eq $exists)) {
		$migrate{$query}=$exists;
		# Translators: strings are: source_package, version, suite, source_package.
		my $msg = sprintf (_g("ERR: %s (%s) exists in Grip %s - skipping '%s'.\n"),
			$src, $exists, $suite, $src);
	}
	printf(_g("INF: Checking %s (%s).\n"), $query, $exists)
		if (defined $exists);
	if (defined $grip{$query}) {
		my $exists = $grip{$query}{'source'};
		if (defined $exists) {
			$exists =~ s/em[0-9]$//;
			if ($exists eq $ver) {
				printf (_g("Skipping %s %s : %s\n"), $query, $ver, $exists);
				next;
			}
		}
	} else {
		printf (_g("Adding %s %s\n"), $query, $ver);
	}
	if (defined $go) {
		# subsequent changes are likely to repeat existing work.
		&grip_source ($src, $ver, $suite, 'source')
			unless (exists $seen{$src});
		$seen{$src}++;
		my $arch_hash = $debian{$query};
		my @arch_list = keys %$arch_hash;
		if ((scalar @arch_list == 1) and ($arch_list[0] eq 'source')) {
			&grip_binary($query, $ver, $suite, 'all');
		} else {
			foreach my $arch (sort @arch_list) {
				next if ($arch eq 'Src');
				next if ($arch eq 'source');
				&grip_binary ($query, $ver, $suite, $arch);
			}
		}
	} else {
		# subsequent changes are likely to repeat existing work.
		printf(_g("INF: Would grip %s (%s)\n"), $src, $ver)
			unless (exists $seen{$src});
		$seen{$src}++;
		my $arch_hash = $debian{$query};
		my @arch_list = keys %$arch_hash;
		if ((scalar @arch_list == 1) and ($arch_list[0] eq 'source')) {
			printf (_g("INF: Would grip %s (%s) {all}\n"), $query, $ver);
		} else {
			foreach my $arch (sort @arch_list) {
				next if ($arch eq 'Src');
				next if ($arch eq 'source');
				printf(_g("INF: Would grip %s (%s) {%s})\n"), $query, $ver, $arch);
			}
		}
	}
}
clean_incoming($grip_name);
exit 0;

=head1 Copyright and Licence

 Copyright (C) 2009-2010  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
{
	printf STDERR (_g("
%s - handle direct updates to testing
version %s

Syntax: %s -b PATH [OPTIONS] -s|--source PACKAGES...
        %s -?|-h|--help|--version

Commands:
-b|--base-path PATH:           path to the top level grip directory [required]
-s|--source  PACKAGES ... :    add source package(s) to the repository
-?|-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

Delays and bugs in unstable can lead to a package migrating into
Debian testing before the relevant package is in Grip unstable,
which then means that there is no suitable version to migrate into
Grip testing.

This script needs to be called with the name of a package (binary
or source) that can be found in the filter repository for testing and
then gripped directly into Grip testing.

This is a slightly different version of proposed-updates.pl, but like
that script, the suite name itself cannot be altered.

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

%s also updates the locale repository, shared by Emdebian
Grip and Emdebian Crush.

"), $prog, $our_version, $prog, $prog, $prog)
	or die ("$0: "._g("failed to write usage").": $!\n");
}
