package Html;

use strict;
use utf8;


=head1 NAME

dl10n-spider -- crawl translator mailing lists (and BTS) for status updates

=head1 SYNOPSIS

dl10n-spider [options] lang+

=head1 DESCRIPTION

This script parses the debian-l10n-E<lt>languageE<gt> mailing list
archives. It looks for emails which title follow a specific format
indicating what the author intend to translate, or the current status of
his work on this translation.

Those informations are saved to a dl10n database which can then be used to
build a l10n coordination page or any other useless statistics.

=cut

use LWP::UserAgent;
use Digest::MD5 qw(md5_base64);
use Debian::L10n::Db;
use Time::Local 'timelocal';
use File::Path;

use Data::Dumper;


my $VERSION = "1.0";				# External Version Number

my $Status_file='./data/status.$lang';

my $DEFAULT_YEAR    = 2002;			# Message on french ML introducing the syntax for the first time
my $DEFAULT_MONTH   = 3;
my $DEFAULT_MESSAGE = 112;

my $Web_agent =  LWP::UserAgent -> new;


my %Status = (
	taf  => 0,
	maj  => 1,
	itt  => 2,
	itr  => 20,
	rfr  => 3,
	lcfc => 4,
	bts  => 5,
	fix  => 6,
	wontfix  => 7,
	done => 8,
	hold => 9,
	);

my %Status_syn = (
	ddr  => 'rfr',
	relu => 'lcfc',
	);

my %Type_syn = (
	'debian-installer' => 'podebconf',	# debian-installer is a sub-category
	'debconf-po'       => 'podebconf',	# typo
	'po-debconf'       => 'podebconf',	# That's the way it should be witten in DB
	'po-man'           => 'man',      	# nobody uses po4a so far, but it may come
	);

my %LanguageList = (
	ar    => 'arabic',
	ca    => 'catalan',
	cs    => 'czech',
	de    => 'german',
	en    => 'english',
	es    => 'spanish',
	fr    => 'french',
	gl    => 'galician',
	nl    => 'dutch',
#	pt    => 'portuguese',
	pt_BR => 'portuguese',
	ro    => 'romanian',
	ru    => 'russian',
	sk    => 'slovak',
	sv    => 'swedish',
	tr    => 'turkish',
	all   => 'all',
	);
my %Language = (
	ar => 'arabic',
	ca => 'catalan',
	cs => 'czech',
	de => 'german',
	en => 'english',
	es => 'spanish',
	fr => 'french',
	gl => 'galician',
	nl => 'dutch',
#	pt => 'portuguese',
	pt_BR => 'brazilian',
	ro => 'romanian',
	ru => 'russian',
	sk => 'slovak',
	sv => 'swedish',
	tr => 'turkish',
	all => 'all',
	);

=head2 check_bts

check_bts searches in the BTS for open bugs, it fixes the bug submission date
if necessary, checks whether the bug is fixed or closed or not and updates the
database accordingly.

=cut

sub by_date($$$) {
	my $db   = shift;
	my $lang = shift;
	my $fh   = shift;

	print $fh <<EOF
<table rules="groups" frame="box" style="border:white;">
  <thead>
    <tr>
      <th><a href="$lang.by_package.html">Package</a></th>
      <th><a href="$lang.by_type.html">Type</a></th>
      <th>File</th>
      <th><a href="$lang.by_translator.html">Translator</a></th>
      <th><a href="$lang.by_status.html">Status</a></th>
      <th>Date</th>
      <th>Message</th>
      <th><a href="$lang.by_bug.html">Bug</a></th>
    </tr>
  </thead>

EOF
	;
	my %t;
	foreach my $pkg (sort (grep { $db->has_status($_) } $db->list_packages())) {
		my %list = ();

		# Only keep the last status per pkg#$type#$file (no history)
		foreach my $statusline (@{$db->status($pkg)}) {
			my ($type, $file, $date, $status, $translator, $list, $url, $bug_nb) = @{$statusline};
			$list{"$type#$file"} = $statusline;
		}

		foreach my $k (keys %list) {
			my ($type, $file, $date, $status, $translator, $list, $url, $bug_nb) = @{$list{$k}};

			$date =~ s/^(\d\d\d\d)-(\d\d)-(\d\d).*$/$1$2$3/;

			push @{$t{$date}{$pkg}{$type}{$file}}, $list{$k};
		}
	}
	foreach my $date (sort keys %t) {
		my $curdate = $date;
		$curdate =~ s/^(\d\d\d\d)(\d\d)(\d\d)$/$1-$2-$3/;
		print $fh <<EOF
  <tbody>
    <!--tr>
      <td colspan="8"><h3>$curdate</h3></td>
    </tr-->
EOF
		;
		foreach my $pkg (sort keys %{$t{$date}}) {
			foreach my $type (sort keys %{$t{$date}{$pkg}}) {
				foreach my $file (sort keys %{$t{$date}{$pkg}{$type}}) {
					foreach my $statusline (@{$t{$date}{$pkg}{$type}{$file}}) {
						my ($stype, $sfile, $sdate, $status, $translator, $list, $url, $bug_nb) = @{$statusline};

						$sdate =~ s/\ \+0000//;

						$translator = "" if $status eq "taf";
						$translator = "" if $status eq "todo";
						$translator = "" if $status eq "maj";

						$list =~ /^(\d\d\d\d)-(\d\d)-(\d\d\d\d\d)$/;
						$list = "<a href=\"http://lists.debian.org/debian-l10n-$LanguageList{$lang}/$1/debian-l10n-$LanguageList{$lang}-$1$2/msg$3.html\">[$1-$2-$3]</a>";

						$bug_nb = $bug_nb ? "<a href=\"http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=$bug_nb\">#$bug_nb</a>"
						                  : "";
						print $fh <<EOF
	  <tr class="$status">
	    <td>$pkg</td>
	    <td>$type</td>
	    <td>$file</td>
	    <td>$translator</td>
	    <td>$status</td>
	    <td>$sdate</td>
	    <td>$list</td>
	    <td>$bug_nb</td>
	  </tr>
EOF
						;
					}
				}
			}
		}
		print $fh <<EOF
  </tbody>
EOF
		;
	}
	print $fh <<EOF
</table>
EOF
	;
}

sub by_bug($$$) {
	my $db   = shift;
	my $lang = shift;
	my $fh   = shift;

	print $fh <<EOF
<table rules="groups" frame="box" style="border:white;">
  <thead>
    <tr>
      <th><a href="$lang.by_package.html">Package</a></th>
      <th><a href="$lang.by_type.html">Type</a></th>
      <th>File</th>
      <th><a href="$lang.by_translator.html">Translator</a></th>
      <th><a href="$lang.by_status.html">Status</a></th>
      <th><a href="$lang.by_date.html">Date</a></th>
      <th>Message</th>
      <th>Bug</th>
    </tr>
  </thead>

EOF
	;

	my %t;

	foreach my $pkg (sort (grep { $db->has_status($_) } $db->list_packages())) {
		my %list = ();

		# Only keep the last status per pkg#$type#$file (no history)
		foreach my $statusline (@{$db->status($pkg)}) {
			my ($type, $file, $date, $status, $translator, $list, $url, $bug_nb) = @{$statusline};
			$list{"$type#$file"} = $statusline;
		}

		foreach my $k (keys %list) {
			my ($type, $file, $date, $status, $translator, $list, $url, $bug_nb) = @{$list{$k}};

			next unless $bug_nb;

			push @{$t{$bug_nb}{$pkg}{$type}{$file}}, $list{$k};
		}
	}

	foreach my $bug_nb (sort keys %t) {
		print $fh <<EOF
  <tbody>
    <!--tr>
      <td colspan="8"><h3><a href=\"http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=$bug_nb\">#$bug_nb</a></h3></td>
    </tr-->
EOF
		;
		foreach my $pkg (sort keys %{$t{$bug_nb}}) {
			foreach my $type (sort keys %{$t{$bug_nb}{$pkg}}) {
				foreach my $file (sort keys %{$t{$bug_nb}{$pkg}{$type}}) {
					foreach my $statusline (@{$t{$bug_nb}{$pkg}{$type}{$file}}) {
						my ($stype, $sfile, $date, $status, $translator, $list, $url, $sbug_nb) = @{$statusline};

						$date =~ s/\ \+0000//;

						$list =~ /^(\d\d\d\d)-(\d\d)-(\d\d\d\d\d)$/;
						$list = "<a href=\"http://lists.debian.org/debian-l10n-$LanguageList{$lang}/$1/debian-l10n-$LanguageList{$lang}-$1$2/msg$3.html\">[$1-$2-$3]</a>";

						$sbug_nb = $sbug_nb ? "<a href=\"http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=$sbug_nb\">#$sbug_nb</a>"
						                  : "";
						print $fh <<EOF
	  <tr class="$status">
	    <td>$pkg</td>
	    <td>$type</td>
	    <td>$file</td>
	    <td>$translator</td>
	    <td>$status</td>
	    <td>$date</td>
	    <td>$list</td>
	    <td>$sbug_nb</td>
	  </tr>
EOF
						;
					}
				}
			}
		}
		print $fh <<EOF
  </tbody>
EOF
		;
	}
	print $fh <<EOF
</table>
EOF
	;
}

sub by_translator($$$) {
	my $db   = shift;
	my $lang = shift;
	my $fh   = shift;

	print $fh <<EOF
<table rules="groups" frame="box" style="border:white;">
  <thead>
    <tr>
      <th><a href="$lang.by_package.html">Package</a></th>
      <th><a href="$lang.by_type.html">Type</a></th>
      <th>File</th>
      <th>Translator</th>
      <th><a href="$lang.by_status.html">Status</a></th>
      <th><a href="$lang.by_date.html">Date</a></th>
      <th>Message</th>
      <th><a href="$lang.by_bug.html">Bug</a></th>
    </tr>
  </thead>

EOF
	;
	my %t;

	foreach my $pkg (sort (grep { $db->has_status($_) } $db->list_packages())) {
		my %list = ();

		# Only keep the last status per pkg#$type#$file (no history)
		foreach my $statusline (@{$db->status($pkg)}) {
			my ($type, $file, $date, $status, $translator, $list, $url, $bug_nb) = @{$statusline};
			$list{"$type#$file"} = $statusline;
		}

		foreach my $k (keys %list) {
			my ($type, $file, $date, $status, $translator, $list, $url, $bug_nb) = @{$list{$k}};

			$translator = "" if $status eq "taf";
			$translator = "" if $status eq "todo";
			$translator = "" if $status eq "maj";

			push @{$t{$translator}{$pkg}{$type}{$file}}, $list{$k};
		}
	}

	foreach my $translator (sort keys %t) {
		my $anchor = $translator;
		$anchor =~ s/\s//g;

		print $fh <<EOF
  <tbody>
    <tr>
      <td colspan="8"><h3 id="$anchor"><a href="$lang.by_translator.html#$anchor">$translator</a></h3></td>
    </tr>
EOF
		;
		foreach my $pkg (sort keys %{$t{$translator}}) {
			foreach my $type (sort keys %{$t{$translator}{$pkg}}) {
				foreach my $file (sort keys %{$t{$translator}{$pkg}{$type}}) {
					my $lastline = "";
					foreach my $statusline (@{$t{$translator}{$pkg}{$type}{$file}}) {
						my ($stype, $sfile, $date, $status, $stranslator, $list, $url, $bug_nb) = @{$statusline};

						$date =~ s/\ \+0000//;

						$list =~ /^(\d\d\d\d)-(\d\d)-(\d\d\d\d\d)$/;
						$list = "<a href=\"http://lists.debian.org/debian-l10n-$LanguageList{$lang}/$1/debian-l10n-$LanguageList{$lang}-$1$2/msg$3.html\">[$1-$2-$3]</a>";

						$bug_nb = $bug_nb ? "<a href=\"http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=$bug_nb\">#$bug_nb</a>"
						                  : "";
						if ("#$pkg#$type#$file" ne $lastline) {
							$lastline = "#$pkg#$type#$file";
							print $fh <<EOF
	  <tr class="$status" style="border-top: thin solid black">
	    <td>$pkg</td>
	    <td>$type</td>
	    <td>$file</td>
EOF
							;
						} else {
							print $fh <<EOF
	  <tr class="$status">
	    <td colspan=3></td>
EOF
							;
						}
						print $fh <<EOF
	    <td>$translator</td>
	    <td>$status</td>
	    <td>$date</td>
	    <td>$list</td>
	    <td>$bug_nb</td>
	  </tr>
EOF
						;
					}
				}
			}
		}
		print $fh <<EOF
  </tbody>
EOF
		;
	}
	print $fh <<EOF
</table>
EOF
	;
}

sub by_type($$$) {
	my $db   = shift;
	my $lang = shift;
	my $fh   = shift;

	print $fh <<EOF
<table rules="groups" frame="box" style="border:white;">
  <thead>
    <tr>
      <th><a href="$lang.by_package.html">Package</a></th>
      <th>Type</th>
      <th>File</th>
      <th><a href="$lang.by_translator.html">Translator</a></th>
      <th><a href="$lang.by_status.html">Status</a></th>
      <th><a href="$lang.by_date.html">Date</a></th>
      <th>Message</th>
      <th><a href="$lang.by_bug.html">Bug</a></th>
    </tr>
  </thead>

EOF
	;
	my %t;
	foreach my $pkg (sort (grep { $db->has_status($_) } $db->list_packages())) {
		my %list = ();

		foreach my $statusline (@{$db->status($pkg)}) {
			my ($type, $file, $date, $status, $translator, $list, $url, $bug_nb) = @{$statusline};

			push @{$t{$type}{$pkg}{$file}}, $statusline;
		}
	}

	foreach my $type (sort keys %t) {
		my $anchor = $type;

		print $fh <<EOF
  <tbody>
    <tr>
      <td colspan="8"><h3 id="$anchor"><a href="$lang.by_type.html#$anchor">$type</a></h3></td>
    </tr>
EOF
		;
		foreach my $pkg (sort keys %{$t{$type}}) {
			foreach my $file (sort keys %{$t{$type}{$pkg}}) {
				my $lastline = "";
				foreach my $statusline (@{$t{$type}{$pkg}{$file}}) {
					my ($stype, $sfile, $date, $status, $translator, $list, $url, $bug_nb) = @{$statusline};

					$date =~ s/\ \+0000//;

					$list =~ /^(\d\d\d\d)-(\d\d)-(\d\d\d\d\d)$/;
					$list = "<a href=\"http://lists.debian.org/debian-l10n-$LanguageList{$lang}/$1/debian-l10n-$LanguageList{$lang}-$1$2/msg$3.html\">[$1-$2-$3]</a>";

					$bug_nb = $bug_nb ? "<a href=\"http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=$bug_nb\">#$bug_nb</a>"
							  : "";
					if ("#$pkg#$type#$file" ne $lastline) {
						$lastline = "#$pkg#$type#$file";
						print $fh <<EOF
	  <tr class="$status" style="border-top: thin solid black">
	    <td>$pkg</td>
	    <td>$type</td>
	    <td>$file</td>
EOF
						;
					} else {
						print $fh <<EOF
	  <tr class="$status">
	    <td colspan=3></td>
EOF
						;
					}
					print $fh <<EOF
	    <td>$translator</td>
	    <td>$status</td>
	    <td>$date</td>
	    <td>$list</td>
	    <td>$bug_nb</td>
	  </tr>
EOF
					;
				}
			}
		}
		print $fh <<EOF
  </tbody>
EOF
		;
	}
	print $fh <<EOF
</table>
EOF
	;
}

sub by_status($$$) {
	my $db   = shift;
	my $lang = shift;
	my $fh   = shift;

	print $fh <<EOF
<table rules="groups" frame="box" style="border:white;">
  <thead>
    <tr>
      <th><a href="$lang.by_package.html">Package</a></th>
      <th><a href="$lang.by_type.html">Type</a></th>
      <th>File</th>
      <th><a href="$lang.by_translator.html">Translator</a></th>
      <th>Status</th>
      <th><a href="$lang.by_date.html">Date</a></th>
      <th>Message</th>
      <th><a href="$lang.by_bug.html">Bug</a></th>
    </tr>
  </thead>

EOF
	;

	my %t;

	foreach my $pkg (sort (grep { $db->has_status($_) } $db->list_packages())) {
		my %list = ();

		# Only keep the last status per pkg#$type#$file (no history)
		foreach my $statusline (@{$db->status($pkg)}) {
			my ($type, $file, $date, $status, $translator, $list, $url, $bug_nb) = @{$statusline};
			$list{"$type#$file"} = $statusline;
		}

		foreach my $k (keys %list) {
			my ($type, $file, $date, $status, $translator, $list, $url, $bug_nb) = @{$list{$k}};

			push @{$t{$status}{$pkg}{$type}{$file}}, $list{$k};
		}
	}

	my %s = reverse %Status;
	foreach my $score (sort keys %s) {
		my $status = $s{$score};
		my $anchor = $status;

		print $fh <<EOF
  <tbody>
    <tr>
      <td colspan="8"><h3 id="$anchor"><a href="$lang.by_status.html#$anchor">$status</a></h3></td>
    </tr>
EOF
		;
		foreach my $pkg (sort keys %{$t{$status}}) {
			foreach my $type (sort keys %{$t{$status}{$pkg}}) {
				foreach my $file (sort keys %{$t{$status}{$pkg}{$type}}) {
					foreach my $statusline (@{$t{$status}{$pkg}{$type}{$file}}) {
						my ($stype, $sfile, $date, $sstatus, $translator, $list, $url, $bug_nb) = @{$statusline};

						$date =~ s/\ \+0000//;

						$list =~ /^(\d\d\d\d)-(\d\d)-(\d\d\d\d\d)$/;
						$list = "<a href=\"http://lists.debian.org/debian-l10n-$LanguageList{$lang}/$1/debian-l10n-$LanguageList{$lang}-$1$2/msg$3.html\">[$1-$2-$3]</a>";

						$bug_nb = $bug_nb ? "<a href=\"http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=$bug_nb\">#$bug_nb</a>"
						                  : "";
						print $fh <<EOF
	  <tr class="$status">
	    <td>$pkg</td>
	    <td>$type</td>
	    <td>$file</td>
	    <td>$translator</td>
	    <td>$status</td>
	    <td>$date</td>
	    <td>$list</td>
	    <td>$bug_nb</td>
	  </tr>
EOF
						;
					}
				}
			}
		}
		print $fh <<EOF
  </tbody>
EOF
		;
	}
	print $fh <<EOF
</table>
EOF
	;
}

sub by_package($$$) {
	my $db   = shift;
	my $lang = shift;
	my $fh   = shift;

	print $fh <<EOF
<table rules="groups" frame="box" style="border:white;">
  <thead>
    <tr>
      <th>Package</th>
      <th><a href="$lang.by_type.html">Type</a></th>
      <th>File</th>
      <th><a href="$lang.by_translator.html">Translator</a></th>
      <th><a href="$lang.by_status.html">Status</a></th>
      <th><a href="$lang.by_date.html">Date</a></th>
      <th>Message</th>
      <th><a href="$lang.by_bug.html">Bug</a></th>
    </tr>
  </thead>

EOF
	;

	my %t;

	foreach my $pkg (sort (grep { $db->has_status($_) } $db->list_packages())) {
		my %list = ();

		foreach my $statusline (@{$db->status($pkg)}) {
			my ($type, $file, $date, $status, $translator, $list, $url, $bug_nb) = @{$statusline};

			push @{$t{$pkg}{$type}{$file}}, $statusline;
		}
	}

	foreach my $pkg (sort keys %t) {
		my $anchor = $pkg;

		print $fh <<EOF
  <tbody>
    <tr>
      <td colspan="8"><h3 id="$anchor"><a href="$lang.by_package.html#$anchor">$pkg</a></h3></td>
    </tr>
EOF
		;
		foreach my $type (sort keys %{$t{$pkg}}) {
			foreach my $file (sort keys %{$t{$pkg}{$type}}) {
				my $lastline = "";
				foreach my $statusline (@{$t{$pkg}{$type}{$file}}) {
					my ($stype, $sfile, $date, $status, $translator, $list, $url, $bug_nb) = @{$statusline};

					$date =~ s/\ \+0000//;

					$list =~ /^(\d\d\d\d)-(\d\d)-(\d\d\d\d\d)$/;
					$list = "<a href=\"http://lists.debian.org/debian-l10n-$LanguageList{$lang}/$1/debian-l10n-$LanguageList{$lang}-$1$2/msg$3.html\">[$1-$2-$3]</a>";

					$bug_nb = $bug_nb ? "<a href=\"http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=$bug_nb\">#$bug_nb</a>"
							  : "";
					if ("#$pkg#$type#$file" ne $lastline) {
						$lastline = "#$pkg#$type#$file";
						print $fh <<EOF
	  <tr class="$status" style="border-top: thin solid black">
	    <td>$pkg</td>
	    <td>$type</td>
	    <td>$file</td>
EOF
						;
					} else {
						print $fh <<EOF
	  <tr class="$status">
	    <td colspan=3></td>
EOF
						;
					}
					print $fh <<EOF
	    <td>$translator</td>
	    <td>$status</td>
	    <td>$date</td>
	    <td>$list</td>
	    <td>$bug_nb</td>
	  </tr>
EOF
					;
				}
			}
		}
		print $fh <<EOF
  </tbody>
EOF
		;
	}
	print $fh <<EOF
</table>
EOF
	;
}

sub html($@) {
	$Status_file  = shift || $Status_file;
	$_            = shift || 'all';

	my @langs;
	if (m/^all$/i) {
		@langs = keys %Language;
	} else {
		@langs = ($_, @_);
	}

	while (my $lang = shift @langs) {
		die "Html.pm: Lang '$lang' unknown. Please update \%Language.\n" unless $Language{$lang};
		my $db = Debian::L10n::Db->new();
		my $dbName = "$Status_file";			# FIXME add $lang if not provided in command line FIXME
		   $dbName =~ s/\$lang/$lang/g;
		if (-e $dbName) {
			$db->read($dbName, 0);
		} else {
			warn "Cannot find $dbName";
			next;
		}
		mkpath ("include", 02775) or die "Cannot create include directory\n" unless (-d "include");

		open FH, ">include/$lang.by_package.inc"	or die "Cannot open by_package.inc: $!";
		by_package ($db, $lang, *FH);
		close FH;

		open FH, ">include/$lang.by_type.inc"	or die "Cannot open by_type.inc: $!";
		by_type ($db, $lang, *FH);
		close FH;

		open FH, ">include/$lang.by_translator.inc"	or die "Cannot open by_translator.inc: $!";
		by_translator ($db, $lang, *FH);
		close FH;

		open FH, ">include/$lang.by_status.inc"	or die "Cannot open by_status.inc: $!";
		by_status ($db, $lang, *FH);
		close FH;

		open FH, ">include/$lang.by_bug.inc"	or die "Cannot open by_bug.inc: $!";
		by_bug ($db, $lang, *FH);
		close FH;

		open FH, ">include/$lang.by_date.inc"	or die "Cannot open by_date.inc: $!";
		by_date ($db, $lang, *FH);
		close FH;
	}
}

=head1 LICENSE

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.

=head1 COPYRIGHT (C)

 2003,2004 Tim Dijkstra
 2004 Nicolas Bertolissio
 2004 Martin Quinson
 2008 Nicolas François

=cut

1;
