#! /usr/bin/perl

#   build-maintainerdb - convert several Packages files to maintainer database
#   Copyright (c) 1998,9,2001,3,4,6  Martin Schulze <joey@debian.org>
#   Copyright (C) 2007 Joerg Jaspert <joerg@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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

#   Todo:
#    . Read maintainer changes from overrides file(s), need to rub
#      out all existing entries

use strict;
use warnings;
use DB_File;

use lib '../lib';

use Deb::Versions;

# read the configuration
if (!open (C, "../config.sh")) {
    print "\nInternal Error: Cannot open configuration file.\n\n";
    exit 0;
}
my $topdir = "/org/packages.debian.org";
while (<C>) {
    $topdir = $1 if (/^\s*topdir="?(.*)"?\s*$/);
}
close (C);

my $maildomain = "packages.debian.org";
my $ptsdomain = "packages.qa.debian.org";


my $maintainerfile = "$topdir/../ftp.root/debian/indices/Maintainers";
my $maintainerdb = "$topdir/conf/maintainer";
my $overridefile = "$topdir/conf/maintainerdb.override";
my @postcall = ( "/usr/sbin/postmap", $maintainerdb );
my $opt_verbose = 0;
my $dbdir = "$topdir/files/db";

my %maint;
my %binsrc;

# Lets take pdo database input files for the source mapping
sub read_bin_src_mapping
{
    tie my %src_packages, 'DB_File', "$dbdir/sources_small.db",
    O_RDONLY, 0666, $DB_BTREE
	or die "couldn't tie DB $dbdir/sources_small.db: $!";
    tie my %src2bin, 'DB_File', "$dbdir/sources_packages.db",
    O_RDONLY, 0666, $DB_BTREE
	or die "couldn't open $dbdir/sources_packages.db: $!";

    my %bin;
    while (my ($source, $data) = each %src_packages) {
	my @src = map { [ split(/\s+/) ] } split( /\0/, $data );
	my $newest = (sort( { version_cmp($b->[-1],$a->[-1]) } @src))[0];
	my ($section, $version) = @{$newest}[2,5];
	
	my $bin_data = $src2bin{$source};
	unless ($bin_data) {
	    warn "no binary data found for $source\n";
	    # source packages without binaries have most
	    # likely been succeded
	    next;
	}
	
	my @bin = map { [ split(/\s+/) ] } split( /\0/, $bin_data );
	my %seen;
	foreach (@bin) {
	    my ($pkg, $ver) = @{$_}[2,3];
	    next if $seen{"$pkg/$ver"}++; # weed out multiple arches/suites faster
	    if ($bin{$pkg}
		&& ($bin{$pkg}{source} ne $source)
		&& (version_cmp($bin{$pkg}{version},$ver) > 0)) {
		next;
	    } else {
		$bin{$pkg} = { version => $ver, source => $source,
			       target => "$section" };
		$binsrc{$pkg} = $source;
	    }
	}
	$binsrc{$source} = $source;
    }
}

sub package_maintainer
{
    my $pkg = shift;
    my $login = shift;
    my $addr = shift;
    my $home = "/debian/home/$login";

    if (-d $home) {
	if (-f "$home/.forward-$pkg") {
	    return "$login-$pkg\@master.debian.org";
	}
    }
    return $addr;
}

sub read_maintainer
{
    my $file = shift;
    my $package;
    my $maintainer;
    my $maint;

    open (F, "$file") || die "Can't open $file, $!";
    printf "Reading %s\n", $file if ($opt_verbose);
    while (<F>) {
	next if (/^#/);
	next if (/^$/);
	/(\S+)\s+(.*)/;
	$package=$1; $maint=$2;
	if (! exists $maint{$package}) {
	    printf "  EVAL (%s, \"%s\")\n", $package, $maint if ($opt_verbose > 2);

		if (exists $maint{$package}) {
		    $maint{$package} .= " ";
		    printf "  EXPAND (%s)\n", $package if ($opt_verbose > 2);
		}
		if ($maint =~ /.*<(.*)>/) {
		    $maint{$package} .= $1;
		    printf "  ADD (%s, %s)\n", $package, $1 if ($opt_verbose > 2);
		} elsif ($maint =~ /\s*(\S+)\s+\(.*\)/) {
		    $maint{$package} .= $1;
		    printf "  ADD (%s, %s)\n", $package, $1 if ($opt_verbose > 2);
		} else {
		    $maint{$package} .= $maint;
		    printf "  ADD (%s, %s)\n", $package, $maint if ($opt_verbose > 2);
		}

	    printf "  %s: %s\n", $package, $maint{$package} if ($opt_verbose > 1);

# Short what? Whats this supposed to do, except creating new (and 99% broken) something -> email mappings?
# 	    my $pkgshort = "";
# 	    if ($package =~ /(.*[^\d\.]+)([\d\.]*\d)$/) {
# 		$pkgshort = $1;
# 		print "Short what? $pkgshort (long is $package)\n";
# 		$maint{$pkgshort} = $maint{$package} if (! exists $maint{$pkgshort});
# 		printf "  %s: %s\n", $pkgshort, $maint{$package} if ($opt_verbose > 1);
# 	    }
# 	    if ($maint{$package} =~ /([^\@]+)\@(master\.)?debian\.org/) {
# 		my $addrsave = $maint{$package} if ($opt_verbose > 1);
# 		$maint{$package} = package_maintainer ($package, $1, $maint{$package});
# 		printf "  Changed to %s\n", $maint{$package} if ($opt_verbose > 1 && ($addrsave ne $maint{$package}));
# 		if (length ($pkgshort) > 0) {
# 		    $maint{$pkgshort} = package_maintainer ($pkgshort, $1, $maint{$pkgshort});
# 		}
# 	    }
	} else {
	    printf "Skipping double $package\n" if ($opt_verbose);
	    printf "LINE: $_" if ($opt_verbose > 2);
	}
    }
    close (F);
}



sub write_maintainer
{
    my $file = shift;

    printf "Writing to %s.new\n", $file if ($opt_verbose > 0);
    open (CONF, ">$file.new") || die "Can't open $file.new, $!";
    my $forward;
    foreach my $package (sort(keys(%maint))) {
# It is possible that we do not know a source package -> in that case fall back to old behaviour
# and only mail the maintainer. Can happen when pdo doesnt know the suite the source is in, like
# it doesnt know oldstable-proposed-updates at date of writing this code.
	$forward = "$maint{$package}";
	if ($binsrc{$package}) {
	    $forward .= ", $binsrc{$package}_contact\@$ptsdomain";
	}
	printf "%s -> %s\n", $package, $forward if ($opt_verbose);
	printf CONF "%s@%s\t%s\n", $package, $maildomain, $forward;
#	printf "%s -> %s and pts: %s\n", $package, $maint{$package}, $binsrc{$package} if ($opt_verbose);
#	printf CONF "%s@%s\t%s, %s_contact@%s\n", $package, $maildomain, $maint{$package}, $binsrc{$package}, $ptsdomain;
    }
    close (CONF);
    printf "Renaming to %s\n", $file if ($opt_verbose > 0);
    system "mv -f $file.new $file";
    printf "Executing @postcall\n" if ($opt_verbose > 0);
    system @postcall;
}

sub help
{
    print "build-maintainerdb - Build the maintainer db for packages.debian.org.\n";
    print "-d     debug, changes output file to ./maintainerdb\n";
    print "-h     This help\n";
    print "-v     Increase verbosity by 1\n";
    print "-vv    Increase verbosity by 2\n";
    print "-vvv   Increase verbosity by 3\n";
}

# 
# Main program
#
while ($#ARGV > -1) {
    if ($ARGV[0] eq "-v") {
	$opt_verbose++;
    } elsif ($ARGV[0] eq "-vv") {
	$opt_verbose+= 2;
    } elsif ($ARGV[0] eq "-vvv") {
	$opt_verbose+= 3;
    } elsif ($ARGV[0] eq "-h") {
	help();
    } elsif ($ARGV[0] eq "-d") {
	$maintainerdb = "./maintainerdb";
    }
    shift;
}

&read_bin_src_mapping();

&read_maintainer ($overridefile);
&read_maintainer ($maintainerfile);

&write_maintainer ($maintainerdb);