#!/usr/bin/perl -w

# debtags-updatecontrol -- Update Tag: headers in debian/control
#
# Copyright (C) 2006  Enrico Zini <enrico@debian.org>
#
# This program 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 2 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, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

use strict;
use warnings;
use File::Temp qw/tempfile/;

my $WGET='/usr/bin/wget';

# Compute a tag patch between two tag sets
sub tagdiff (\@\@)
{
	my ($tags1, $tags2) = @_;
	my @tags1 = @$tags1;
	my @tags2 = @$tags2;
	my @res;
	while (@tags1 or @tags2)
	{
		if (not @tags1)
		{
			push @res, "+".shift(@tags2);
		}
		elsif (not @tags2)
		{
			push @res, "-".shift(@tags1);
		}
		else
		{
			if ($tags1[0] lt $tags2[0])
			{
				push @res, "-".shift(@tags1);
			}
			elsif ($tags1[0] gt $tags2[0])
			{
				push @res, "+".shift(@tags2);
			}
			else
			{
				shift(@tags1);
				shift(@tags2);
			}
		}
	}
	return @res;
}

# Apply a tag patch to a tag set
sub tagpatch (\@\@)
{
	my ($tags, $patch) = @_;
	my %tags = map { $_ => 1 } @$tags;
	for my $change (@$patch)
	{
		if (substr($change, 0, 1) eq '+')
		{
			$tags{substr($change, 1)} = 1;
		} elsif (substr($change, 0, 1) eq '-') {
			delete $tags{substr($change, 1)};
		} else {
			warn "Ignoring invalid change $change";
		}
	}
	return sort keys %tags;
}

# Reverse a change: change + with - or - with +
sub reverse_change ($)
{
	my $change = shift;
	if (substr($change, 0, 1) eq '+')
	{
		return '-'.substr($change, 1);
	} elsif (substr($change, 0, 1) eq '-') {
		return '+'.substr($change, 1);
	} else {
		warn "Not reversing invalid change $change";
		return $change;
	}
}

# Prompt the user.  The function is called passing the text to use as the
# prompt, the default answer if the user just presses enter, then a hash
# mapping all accepted answers to their descriptions.
# 
# The function will internally handle an extra '?' possible answer, to which it
# responds with help on the available options.
#
# The function guarantees that the result is either the default answer or one
# of the accepted answers in the hash.
#
# Example:
#   my $ans = prompt ">", 'y', y => 'yes, do it (default)', n => 'forget about it'
sub prompt ($$@)
{
	my $prompt = shift;
	my $default = shift;
	my @items = @_;
	my %items = @items;
	while (1)
	{
		print $prompt;
		my $ans = <STDIN>;
		chop($ans);
		if (lc($ans) eq '?')
		{
			my @i = @items;
			print "\n";
			while (@i)
			{
				print shift(@i), ": ", shift(@i), "\n";
			}
			print "?: help\n\n";
		} elsif (exists $items{lc($ans)}) {
			return lc($ans);
		} elsif ($ans eq '') {
			return $default;
		}
	}
}

# Internal function to read the tag vocabulary in order to reimplement
# 'debtags tagshow'.  This should disappear when the startup time of debtags
# will become very short.
my %voc;
sub read_vocabulary
{
	open VOC, '/var/lib/debtags/vocabulary' or die "Cannot open /var/lib/debtags/vocabulary: $!";
	local $/="\n\n";
	while (my $entry = <VOC>)
	{
		$voc{$1} = $entry if $entry =~ /^Tag: ([^\n]+)/;
	}
	close VOC;
}

read_vocabulary();

# Since the temporary files disappear after closing them, set autoflush mode,
# so that we know that all the data is inside the temporary files even if we
# haven't closed them.
$| = 1;

# Go through all the tag changes and ask for approval
open IN, "debian/control" or die "Cannot open debian/control: $!";

# Write the edited control file into a temprary file
my ($out, $outname) = tempfile( DIR=>'debian/', UNLINK=>1);
$out or die "Cannot create a temporary file: $!";

# Resulting approved list of tags
my %tags;

# Resulting list of changes to submit to the debtags repository
my %fixes;

# Will be set to 1 if there are changes to the tags in debian/control
my $edited = 0;

my $package;
while (<IN>)
{
	chop;
	if (/^Package:\s*([a-z0-9+.-]+)/)
	{
		$package = $1;
		print $out $_, "\n";
	}
	elsif (/^Tag:\s*(.*?)\s*$/)
	{
		die "Tag: header before Package: header at debian/control:$."
			if not defined $package;
		my @tags = split(/,\s*/, $1);
		my @origtags = sort @tags;
		my $newtags = `$WGET -q -O- http://debtags.alioth.debian.org/cgi-bin/taglist.cgi/$package`;
		die "wget failed downloading the tag list for $package" if $? != 0;
		my @newtags = sort split("\n", $newtags);
		my @diff = tagdiff(@origtags, @newtags);
		my @approved;
		my @fixes;
		if (@diff)
		{
			print "Changes for $package: ", join(', ', @diff), "\n\n";
			for my $change (@diff)
			{
				my $tag = substr($change, 1);
				print " * Current change: $change\n\n";
				print $voc{$tag};
				#system "debtags", "tagshow", $tag;
				my $action = prompt "Do you approve $change? (Y/n/i/q/?) ", 'y',
					y => "approve the change",
					n => "reject the change and notify the central database of the error",
					i => "ignore this change without notifying the central database",
					q => "quit";
				if ($action eq 'y')
				{
					push @approved, $change;
				} elsif ($action eq 'n') {
					push @fixes, reverse_change($change);
				} elsif ($action eq 'i') {
				} elsif ($action eq 'q') {
					exit 0;
				}
			}
			$tags{$package} = [tagpatch(@origtags, @approved)];

			# Check if the tagset actually changed, to set the
			# edited flag
			if (not $edited)
			{
				my @t = tagdiff(@origtags, @{$tags{$package}});
				$edited = 1 if @t;
			}
		} else {
			$tags{$package} = [@origtags];
		}
		$fixes{$package} = [@fixes] if @fixes;
		print $out "Tag: ", join(', ', @{$tags{$package}}), "\n";
	}
	else
	{
		print $out $_, "\n";
	}
}

close IN;

# If we made it safely so far, we can now replace the old debian/control with
# the edited version
if ($edited)
{
	rename $outname, "debian/control" or die "Cannot replace the old debian/control with the new contents: $!";
}

close $out;

#for my $pkg (keys %tags)
#{
#	print "Tag: ", join(', ', @{$tags{$pkg}}), "\n";
#}

# Prepare the tag patch with the manual fixes and submit it if the user wants
if (%fixes)
{
	print "Patch to submit to the Debtags central database:\n\n";

	my ($out, $outname) = tempfile( "debtags-patch-XXXXXX", DIR=>'./', UNLINK=>0);
	$out or die "Cannot create a temporary file for the tag patch: $!";
	for my $pkg (keys %fixes)
	{
		print "$pkg: ", join(', ', @{$fixes{$pkg}}), "\n";
		print $out "$pkg: ", join(', ', @{$fixes{$pkg}}), "\n";
	}
	close($out);

	print "\n";
	my $action = prompt "Should I send it? (Y/n/?) ", 'y',
		y => "send the patch",
		n => "do not send the patch and leave it saved as $outname";
	if ($action eq 'y')
	{
		system 'debtags', 'submit', $outname
			and die "debtags had problems sending the patch $outname.";
		unlink $outname or die "Cannot delete $outname: $!";
	} else {
		print "The corrections have been saved in the file $outname.\n";
	}
}

exit 0;