#!/usr/bin/perl -w

# dl10n-nmu -- Scoring packages with long-standing po-debconf bugs
#
# Copyright (C) 2006 Thomas Huriaux
# Copyright (C) 2011 David Prévot <taffit@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.

use strict;

use Debian::L10n::Db;
use SOAP::Lite;
use POSIX qw(strftime);
my $generation_date = strftime('%a, %d %b %Y %H:%M:%S %z', gmtime);

# TODO: add an option
my $DB_FILE="/srv/i18n.debian.net/www/debian-l10n-material/data/unstable.gz";
my $POPCON="./data/by_inst";

print "Read the database...";
my $data = Debian::L10n::Db->new();
$data->read($DB_FILE);
print " done.\n";

my $packages = {};
my $bugs = {};
my $comments = {};
$comments->{removed} = "not in unstable";
$comments->{switch} = "not using po-debconf";
$comments->{normal} = "&nbsp;";
$comments->{nodebconf} = "not using debconf";


print "Starting SOAP query... ";
my $soap = SOAP::Lite->uri('Debbugs/SOAP')->proxy('http://bugs.debian.org/cgi-bin/soap.cgi')
           or die "failed: $!\n";
my $soap_bugs = $soap->get_bugs(tag=>'l10n')->result or die "failed: $!\n";
my $soap_status = $soap->get_status($soap_bugs)->result() or die "failed: $!\n";
print "done.\n";

my $pop = {};

open (POPCON, $POPCON);
while (my $line = <POPCON>) {
  if ($line =~ /^(\d+)\s+(\S+)\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+$/) {
    $pop->{$2} = (2 - $1 / 10000);
  }
}

foreach my $bug_nb (@$soap_bugs) {
  next if $soap_status->{$bug_nb}->{done};
  next if $soap_status->{$bug_nb}->{archived};
  my $pkg = $soap_status->{$bug_nb}->{source};
  $pkg = $soap_status->{$bug_nb}->{package} unless (defined $pkg and $pkg ne "");
  my $date = $soap_status->{$bug_nb}->{date};
  #these packages are skipped in the database
  next if ($pkg =~ /(kde-i18n|wordtrans|kernel-image-2\.4\.27-m68k|manpages|debian-med|pptpd)/);
  my @tags = $soap_status->{$bug_nb}->{tags};
  next if (grep ( /^fixed$/, @tags ));
  my $bug_title =  $soap_status->{$bug_nb}->{subject};
  $bugs->{$bug_nb} = $bug_title;
  $packages->{$pkg}->{score} = 0 unless (defined $packages->{$pkg});
  #search for debconf templates bug, adding Clytie's and Daniel's tests.
  if (($bug_title =~ /(debconf|template|INTL:vi$)/i) and ($bug_title !~ /Swedish PO-template translation/)) {
    unless ($pop->{$pkg}) {
      print "$pkg has no popcon score (maybe an udeb), use a low score 1\n";
      $pop->{$pkg} = 1;
    }
    my $coeff = 1;
    $coeff = 5 if ($bug_title =~ /Please switch to gettext-based debconf template/);
    if (not $bug_title eq "gdm does not use gettext-based debconf templates; see README.Debian") {
      $packages->{$pkg}->{score} += ((time - $date) / (60 * 60 * 24 * 7) * $coeff * $pop->{$pkg});
    }
    push (@{$packages->{$pkg}->{debconf}}, $bug_nb);
  } else {
    push (@{$packages->{$pkg}->{l10n}}, $bug_nb);
  }
}

my $orphaned = {};
$soap = SOAP::Lite->uri('Debbugs/SOAP')->proxy('http://bugs.debian.org/cgi-bin/soap.cgi')
	or die "Unable to connect to SOAP: $!\n";
$soap_bugs = $soap->get_bugs(
	package=>'wnpp')->result;
$soap_status = $soap->get_status($soap_bugs)->result() or die;

foreach my $bug_nb (@$soap_bugs) {
  my $bug_title =  $soap_status->{$bug_nb}->{subject};
  next unless defined $bug_title; # Bug sent without subject (#537751)
  if ($bug_title =~ /^O: ([+.a-z0-9-]+) -- .+$/) {
    $orphaned->{$1} = 1;
  }
}

my $removed = {};
$soap = SOAP::Lite->uri('Debbugs/SOAP')->proxy('http://bugs.debian.org/cgi-bin/soap.cgi')
	or die "Unable to connect to SOAP: $!\n";
$soap_bugs = $soap->get_bugs(
	package=>'ftp.debian.org')->result;
$soap_status = $soap->get_status($soap_bugs)->result() or die;

foreach my $bug_nb (@$soap_bugs) {
  my $bug_title = $soap_status->{$bug_nb}->{subject};
  next unless defined $bug_title; # Bug sent without subject (#537751)
  if ($bug_title =~ /^RM: ([+.a-z0-9-]+) -- .+$/) {
    $removed->{$1} = 1;
  }
}

foreach my $pkg (keys %$packages) {
  next if ($packages->{$pkg} == 0);
  $packages->{$pkg}->{maintainer} = 'Orphaned' if $orphaned->{$pkg};
  $packages->{$pkg}->{maintainer} = 'Pending for removal' if $removed->{$pkg};
  if (not $data->has_package($pkg)) {
    $packages->{$pkg}->{class} = "removed";
    $packages->{$pkg}->{maintainer} = "none";
  } elsif ($data->has_templates($pkg)) {
    $packages->{$pkg}->{class} = "switch";
  } elsif ($data->has_podebconf($pkg)) {
    $packages->{$pkg}->{class} = "normal";
  } else {
    $packages->{$pkg}->{class} = "nodebconf";
  }
  $packages->{$pkg}->{maintainer} = $data->maintainer($pkg) unless defined $packages->{$pkg}->{maintainer};
  if (defined $packages->{$pkg}->{maintainer}) {
    $packages->{$pkg}->{maintainer} =~ s/</&lt;/g;
    $packages->{$pkg}->{maintainer} =~ s/>/&gt;/g;
  } else {
  $packages->{$pkg}->{maintainer} = "(unknown)";
  }
}


#TODO: refactor printing code
#printing stuffs
###BY PACKAGE
open (FILE, ">html/nmu_bypackage.html");
print FILE "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n";
print FILE "<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"fr\">\n";
print FILE "<head>\n";
print FILE "  <title>Debian localization radar</title>\n";
print FILE "  <link href=\"nmu.css\" rel=\"stylesheet\" />\n";
print FILE "  <meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\" />\n";
print FILE "</head>\n";

print FILE "<body>\n";
print FILE "<img src=\"score.png\" alt=\"Score calculation formula\" />";
print FILE "  <table summary=\"rank of packages\">\n";
print FILE "    <tr><td>Package</td><td>Score</td><td>L10n bugs</td><td>Maintainer</td><td>Comment</td></tr>\n";

open (DATABASE, ">data/status.nmu");
foreach my $pkg (sort { $packages->{$b}->{score} <=> $packages->{$a}->{score} } keys %$packages) {
  next if ($packages->{$pkg}->{score} == 0);
  print DATABASE "Package: $pkg\n";
  print DATABASE "Score: ".int ($packages->{$pkg}->{score})."\n";
  print FILE "    <tr class=\"".$packages->{$pkg}->{class}."\">\n";
  print FILE "      <td>$pkg</td>\n";
  print FILE "      <td>".int ($packages->{$pkg}->{score})."</td>\n";
  print FILE "      <td>\n";
  if (defined @{$packages->{$pkg}->{debconf}}) {
    print DATABASE "Debconf: ";
    print FILE "        po-debconf bugs:\n";
    print FILE "        <ul>\n";
    foreach my $bug (@{$packages->{$pkg}->{debconf}}) {
      print FILE "          <li><a href=\"http://bugs.debian.org/$bug\">#$bug</a> -- $bugs->{$bug}</li>\n";
      print DATABASE "$bug ";
    }
    print DATABASE "\n";
    print FILE "        </ul>\n";
  }
  if (defined @{$packages->{$pkg}->{l10n}}) {
    print FILE "        other l10n bugs:\n";
    print FILE "        <ul>\n";
    print DATABASE "L10n: ";
    foreach my $bug (@{$packages->{$pkg}->{l10n}}) {
      print FILE "          <li><a href=\"http://bugs.debian.org/$bug\">#$bug</a> -- $bugs->{$bug}</li>\n";
      print DATABASE "$bug ";
    }
    print DATABASE "\n";
    print FILE "        </ul>\n";
  }
  print FILE "      </td>\n";
  print DATABASE "Maintainer: ".$packages->{$pkg}->{maintainer}."\n";
  print DATABASE "Class: ".$packages->{$pkg}->{class}."\n";
  print FILE "      <td>".$packages->{$pkg}->{maintainer}."</td>\n";
  print FILE "      <td>".$comments->{$packages->{$pkg}->{class}}."</td>";
  print FILE "    </tr>\n";
  print DATABASE "\n";
}

print FILE "  </table>\n";
print FILE "  <hr />\n";
print FILE "  <p><small>Generated on $generation_date</small></p>\n";
print FILE "  <p><small>Comments: <a href='mailto:debian-l10n-devel\@lists.alioth.debian.org'>Debian L10N Development Team</a></small></p>\n";
print FILE "</body>\n";
print FILE "</html>\n";
close (FILE);

###BY MAINTAINER
open (FILE, ">html/nmu_maintainer.html");
print FILE "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n";
print FILE "<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"fr\">\n";
print FILE "<head>\n";
print FILE "  <title>Debian localization radar</title>\n";
print FILE "  <link href=\"nmu.css\" rel=\"stylesheet\" />\n";
print FILE "  <meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\" />\n";
print FILE "</head>\n";

print FILE "<body>\n";
print FILE "<img src=\"score.png\" alt=\"Score calculation formula\" />";
print FILE "  <table summary=\"rank of packages\">\n";
print FILE "    <tr><td>Maintainer</td><td>Package</td><td>Score</td><td>L10n bugs</td><td>Comment</td></tr>\n";

foreach my $pkg (sort { $packages->{$a}->{maintainer} cmp $packages->{$b}->{maintainer} } keys %$packages) {
  next if ($packages->{$pkg}->{score} == 0);
  print FILE "    <tr class=\"".$packages->{$pkg}->{class}."\">\n";
  print FILE "      <td>".$packages->{$pkg}->{maintainer}."</td>\n";
  print FILE "      <td>$pkg</td>\n";
  print FILE "      <td>".int ($packages->{$pkg}->{score})."</td>\n";
  print FILE "      <td>\n";
  if (defined @{$packages->{$pkg}->{debconf}}) {
    print FILE "        po-debconf bugs:\n";
    print FILE "        <ul>\n";
    foreach my $bug (@{$packages->{$pkg}->{debconf}}) {
      print FILE "          <li><a href=\"http://bugs.debian.org/$bug\">#$bug</a> -- $bugs->{$bug}</li>\n";
    }
    print FILE "        </ul>\n";
  }
  if (defined @{$packages->{$pkg}->{l10n}}) {
    print FILE "        other l10n bugs:\n";
    print FILE "        <ul>\n";
    foreach my $bug (@{$packages->{$pkg}->{l10n}}) {
      print FILE "          <li><a href=\"http://bugs.debian.org/$bug\">#$bug</a> -- $bugs->{$bug}</li>\n";
    }
    print FILE "        </ul>\n";
  }
  print FILE "      </td>\n";
  print FILE "      <td>".$comments->{$packages->{$pkg}->{class}}."</td>";
  print FILE "    </tr>\n";
}

print FILE "  </table>\n";
print FILE "  <hr />\n";
print FILE "  <p><small>Generated on $generation_date</small></p>\n";
print FILE "  <p><small>Comments: <a href='mailto:debian-l10n-devel\@lists.alioth.debian.org'>Debian L10N Development Team</a></small></p>\n";
print FILE "</body>\n";
print FILE "</html>\n";
close (FILE);
close (DATABASE);

