#!/usr/bin/perl

=head1 NAME

grip-overridereplace.pl - refresh a package to enact an override

=cut

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

use vars qw/ %tasks %overrides $uri $deb $z @list $suite $dir 
 $prog $our_version $base $grip_name $skip $file @archlist
 %matches $data $file $from $to $package $arch $name $cmpnt 
 @suites $overrides @list /;
 
=head1 Synopsis

 grip-overridereplace.pl -s|--suite STRING -b|--base-path PATH [-c|--component COMPONENT] [--grip-name STRING] BINARIES ...
 grip-overridereplace.pl -?|-h|--help|--version

 Commands:
 -s|--suite STRING:        Name of the distribution to override [required]
 -b|--base-path PATH:      path to the top level repository directory [required]

 -?|-h|--help|--version:   print this help message and exit

 Options:
    --grip-name STRING:    alternative name for the grip repository
 -c|--component COMPONENT: Section override from the Debian Packages file.
 
Only the specified binary package(s) will be affected, each architecture
in turn. Packages are copied out of pool/ into a temporary directory,
removed and then replaced into the architecture concerned.

Overrides take place in the Packages file, not within the binary package
itself - check the results by parsing the relevant Packages file, not
using the output of dpkg -I $deb or other .deb tools.

Note that overrides will need to be enacted for the versions in testing
as well, so repeat the process once you are happy with the effects.

Components that are supported by reprepro are read from the .deb Section
field but this can sometimes be out of step with the Section set by the
Debian ftp-master in the Packages file. Use the C<--component> option to
set a particular Section. If the relevant component has not been 
configured in reprepro for the Section name, C<main> will be used
instead.

=cut

$prog = basename ($0);
$our_version = &scripts_version();
$grip_name = "grip";

while( @ARGV ) {
	$_= shift( @ARGV );
	last if m/^--$/;
	if (!/^-/) {
		unshift(@ARGV,$_);
		last;
	}
	elsif (/^(-\?|-h|--help|--version)$/) {
		&usageversion();
		exit (0);
	}
	elsif (/^(-b|--base-path)$/) {
		$base = shift;
	}
	elsif (/^(-s|--suite)$/) {
		$suite = shift;
	}
	elsif (/^(-c|--component)$/) {
		$cmpnt = shift;
	}
	elsif (/^(--grip-name)$/) {
		$grip_name = shift;
	}
	else {
		die "$prog: Unknown option $_.\n";
	}
}

die "$prog: ERR: Please specify an existing directory for the base-path.\n"
	if (not defined $base);

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

&set_base($base);
&set_repo_names ('filter', $grip_name);
my $s = &get_suite_names($grip_name);
@suites = @$s;
# add any remaining arguments as source packages.
while (scalar @ARGV > 0)
{
	my $extra = shift;
	push @list, $extra;
}

die ("$prog: ERR: Specify a distribution name, not a codename. e.g. testing, not lenny.\n")
	if ((not defined $suite) or 
	(scalar (grep (/$suite/, @suites)) == 0));

die ("$prog: ERR: Cannot find Grip configuration directory.\n")
	if (not -d "${base}${grip_name}/conf/");

=head1 Description

Overrides need to be updated from time to time so this script provides
a way to implement overrides restrospectively.

Section / component overrides are read from the filter repository
Packages file  - use the C<--component> option to set other values. If
the component has not been configured in reprepro, C<main> is used
instead.

=cut

my $list = get_components ("$suite", "$grip_name");
if ((not defined $list) or (defined $cmpnt and (!grep(/^$cmpnt$/, @$list))))
{
	warn ("$prog: INF: Component '$cmpnt' is not configured for $grip_name:$suite in reprepro, using 'main'.\n");
	$cmpnt = "main";
}

my $a = &get_archlist ($suite, $grip_name);
die ("Unable to obtain list of supported architectures.\n")
	if (not defined $a);

die ("$prog: ERR: No binary package name specified.\n")
	if (scalar @list == 0);

$dir = `mktemp -t -d gripover.XXXXXX`;
chomp ($dir);
foreach $package (@list)
{
	
	$overrides = (&get_overrides("unstable", $grip_name));
	
	foreach $arch (@$a)
	{
		# always leave source intact
		next if ($arch eq 'source');
		$data = &get_single_package ($suite, $grip_name, $package, $arch);
		my $clist = get_components ('unstable', $grip_name);
		foreach my $cmpnt (@$clist)
		{
			$data = $data->{$cmpnt} if (exists $data->{$cmpnt});
		}
		if (not defined $data->{'Filename'})
		{
			print "$prog: ERR: Cannot find package '$package' on $arch\n";
			next;
		}
		$file = $data->{'Filename'};
		$name = $data->{'Package'};
		$cmpnt = $data->{'Section'};
		if ( -f "${base}${grip_name}/$file")
		{
			$from = "${base}${grip_name}/$file";
			$to = basename($file);
			chomp ($to);
			open (FROM, "$from") or die ("Cannot read $from: $!\n");
			my @f=<FROM>;
			close (FROM);
			open (TO, ">$dir/$to") or die ("Cannot write to $dir/$to: $!\n");
			print TO @f;
			close (TO);
		}
		$cmpnt = &switch_component ($data->{'Section'}, $data->{'Package'});
		# check the override file.
		my @check_ovr = grep (/^$name Section .*$/, @$overrides);
		if (scalar @check_ovr == 1)
		{
			$check_ovr[0] =~ /^$name Section (.*)$/;
			my $sec = $1;
			$cmpnt = ($sec eq "devel") ? "dev" : $sec;
		}
		$cmpnt = "main" if (scalar (grep(/$cmpnt/, "@$clist")) == 0);
		print "INF: Component: $cmpnt\n";
		if ( -f "$dir/$to")
		{
			print "Replacing $to for $arch into $suite using $cmpnt.\n";
			print "reprepro -v -A $arch -b ${base}${grip_name} remove $suite $name\n";
			system ("reprepro -v -A $arch -b ${base}${grip_name} remove $suite $name");
			print "reprepro -v -C $cmpnt -A $arch -b ${base}${grip_name} includedeb $suite $dir/*\n";
			system ("reprepro -v -C $cmpnt -A $arch -b ${base}${grip_name} includedeb $suite $dir/*");
			unlink ("$dir/$to");
		}
	}
}

rmdir ($dir);
exit 0;

sub get_overrides
{
	my (@lines, %u, @list, @ret, $conf, $stanza, $parser);
	my ($suite, $repo) = @_;
	$parser = new Parse::DebControl;
	my $input = "$base/$repo/conf/distributions";
	$input =~ s://:/:g;
	return undef unless (-f $input);
	$conf = $parser->parse_file("$input", {'stripComments' => 'true'});
	my @stanzas = @$conf;
	foreach $stanza (@stanzas)
	{
		if (($$stanza{'Codename'} eq "$suite")
			or ($$stanza{'Suite'} eq "$suite"))
		{
			my $line = $$stanza{'DebOverride'};
			@lines = split(' ', $line) if (defined $line);
		}
	}
	foreach my $l (@lines)
	{
		$u{$l}++;
	}
	@list = sort keys %u;
	foreach my $file (@list)
	{
		open (FILE, "${base}${repo}/conf/$file") or 
			die ("Cannot open override file: $file $!\n");
		my @l=<FILE>;
		close (FILE);
		chomp @l;
		push @ret, @l;
	}
	return \@ret;
}

sub usageversion
{
	print(STDERR <<END)
version $our_version

$prog -s|--suite STRING -b|--base-path PATH [-c|--component COMPONENT] [--grip-name STRING] BINARIES ...
$prog -?|-h|--help|--version

Commands:
-s|--suite STRING:         Name of the distribution to override [required]
-b|--base-path PATH:       path to the top level repository directory [required]

-?|-h|--help|--version:    print this help message and exit

Options:
    --grip-name STRING:    alternative name for the grip repository
 -c|--component COMPONENT: Section override from the Debian Packages file.

Only the specified binary package(s) will be affected, each architecture
in turn. Packages are copied out of pool/ into a temporary directory,
removed and then replaced into the architecture concerned.

Overrides take place in the Packages file, not within the binary package
itself - check the results by parsing the relevant Packages file, not
using the output of dpkg -I \$deb or other .deb tools.

Note that overrides will need to be enacted for the versions in testing
as well, so repeat the process once you are happy with the effects.

Source packages are never over-ridden.

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

=head1 Override usage with reprepro

Sections are not particularly reliable and may disappear completely in
future releases of Debian. Some packages are in the wrong sections and
will cause problems for users if left unchanged. One example is
C<xulrunner-1.9> which is an important dependency of iceweasel (the
Debian flavour of Firefox) but xulrunner-1.9 is C<Section: devel> for
an unknown reason. To prevent the need for every Grip user to need the
C<dev> repository to get a working web browser, an override is set in
the reprepro configuration. (See reprepro (1)).

Add the name of the override file to the distribution by editing
F<conf/distributions>:

 Origin: Debian
 Label: EmdebianGrip
 Suite: unstable
 Codename: sid
 ...
 DebOverride: override.sid.main

In the override file, set a more usable Section:

 xulrunner-1.9 Section web
 geany Section editors

It's worth setting a real Section (rather than assuming C<main>) in
case that component is added at a later date.

grip-overridereplace.pl will then use that override to allow the
package to be moved back from C<dev> into C<main> and F<reprepro>
will use the override file for future updates.

=head1 Copyright and Licence

 Copyright (C) 2007-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