#!/usr/bin/perl -w

# This is a little utility designed to keep track of translations
# in the Debian web site CVS repository.
#
# Hacked to deal with manpages as well

# This is GPL'ed code.
# Copyright 1998 Paolo Molaro <lupus@debian.org>.
# Copyright 1999-2002 Peter Karlsson <peterk@debian.org>.
# Copyright 2000,2001 Martin Quinson <mquinson@ens-lyon.fr>.

# Invocation:
#   check_trans.pl [-vqQ]

# It needs to be run from the top level manpages directory.

# For example:
#   $ check_trans.pl -v italian
# You may also check only some subtrees as in:
#   $ check_trans.pl -s devel italian

# Options:
# 	-v		enable verbose mode
#	-q		just don't whine about missing files
#	-Q		enable really quiet mode

use strict;
use Getopt::Long;
use IO::Handle;
use Date::Parse;
use HTML::Table;

#    These modules reside under webwml/Perl
use lib ($0 =~ m|(.*)/|, $1 or ".") ."/../webwml/Perl";
use Local::Cvsinfo;
use Webwml::TransIgnore;
use Locale::Language;

our ($verbose, $opt_q, $opt_Q);

Getopt::Long::Configure("no_ignore_case", "bundling");
GetOptions(
	   'verbose|v' => \$verbose,
	   'quiet|q' => \$opt_q,
	   'really-quiet|Q' => \$opt_Q,
	  );

#  -Q implies -q
$opt_q = 1 if $opt_Q;

my $engcvs = Local::Cvsinfo->new();
$engcvs->options(
		 recursive => 1,
		 matchfile => [ '.' ],
		);

#   Global .transignore
my $globtrans = Webwml::TransIgnore->new(".");

# get list of languages
#my $mancvs = Local::Cvsinfo->new;
#$mancvs->readinfo("./");

# links to other languages' information
#my @langs = @{$mancvs->dirs()};

# language configuration
my $defaultlanguage = '';
if (exists $ENV{DWWW_LANG}) {
  $defaultlanguage = $ENV{DWWW_LANG};
} elsif (open CONF, "<language.conf") {
  $defaultlanguage = <CONF>;
  chomp $defaultlanguage;
  close CONF;
}
my $from = 'english';

my $to = shift || $defaultlanguage;
$to =~ s%/$%%;			# Remove slash from the end

die "Language not defined in DWW_LANG, language.conf or on command line\n"
  if $to eq '';

my @infofields = qw(
		    manpage encoding location build-source 
		    original original-cvs-revision
		    translatedinto translator
		   );

#   Build list of files in the English directory
$engcvs->readinfo($from);
foreach my $path (@{$engcvs->dirs()}) {
  my $tpath = $path;
  $tpath =~ s/^$from/$to/o;
  my $transignore = Webwml::TransIgnore->new($tpath);
  next unless $transignore->found();
  warn "Loading $tpath/.transignore\n" if $verbose;
  foreach (@{$transignore->local()}) {
    s/^$to/$from/o;
    $engcvs->removefile($_);
  }
}

#   Build list of files in the <lang> directory
my $l10ncvs = Local::Cvsinfo->new();
$l10ncvs->options(
		  recursive => 1,
		  matchfile => [ '.' ]
		 );
$l10ncvs->readinfo($to);
foreach my $tpath (@{$l10ncvs->dirs()}) {
  my $transignore = Webwml::TransIgnore->new($tpath);
  next unless $transignore->found();
  warn "Loading $tpath/.transignore\n" if $verbose;
  foreach (@{$transignore->local()}) {
    s/^$to/$from/o;
    $l10ncvs->removefile($_);
  }
}

#   Read INFOS files
my $infos = {};
my %eng2trans = ();
my %manpages = ();
my $validinfofields = join('|', @infofields);

warn "Checking English INFOS files\n" if $verbose;
foreach my $package (@{$engcvs->dirs()}) {
  open (INFOS, "< $package/INFOS") or next;
  while (<INFOS>) {
    s/\s*$//s;
    if (s/^manpage:\s*//i) {
      if (-f "$package/$_") {
	$manpages{"$package/$_"} = 1;
      } else {
	warn "$package/INFOS:$.: file $_ does not exist\n";
      }
    } elsif (m/^($validinfofields):\s*(.*)/oi || m/^  / || m/^$/) {
      #  Do nothing
    } else {
      warn "$package/INFOS:$.: unparseable line: $_\n";
    }
  }
  close (INFOS);
}
warn "Checking locale INFOS files\n" if $verbose;
foreach my $package (@{$l10ncvs->dirs()}) {
  my $opackage = $package;
  $opackage =~ s/^$to/$from/o;

  open (INFOS, "< $package/INFOS") or next;
  while (<INFOS>) {
    s/\s*$//s;
    if (s/^manpage:\s*//i) {
      warn "$package/INFOS:$.: file $_ does not exist\n" unless -f "$package/$_";
    } elsif (s/^original:\s*//i) {
      warn "$package/INFOS:$.: original file $_ does not exist\n" unless -f "$opackage/$_";
    } elsif (m/^($validinfofields):\s*(.*)/oi || m/^  / || m/^$/) {
      #  Do nothing
    } else {
      warn "$package/INFOS:$.: unparseable line: $_\n";
    }
  }
  close (INFOS);
}

foreach my $package (@{$l10ncvs->dirs()}) {
  my $pkgname = $package;
  $pkgname =~ s/^$to\///o;

  $infos->{$package} = {};
  open (INFOS, "< $package/INFOS") or next;
  my $manpage = '';
  my %entry = ();
  while (<INFOS>) {
    s/\s*$//s;
    if ($_ eq '') {
      if ($manpage) {
	$infos->{$package}->{$manpage} = {};
	foreach my $field (keys %entry) {
	  $infos->{$package}->{$manpage}->{$field} = $entry{$field};
	  #					print ("$package, $manpage, $field, $entry{$field}\n");
	}
	if (defined $entry{original}) {
	  $eng2trans{"$pkgname/$entry{original}"} = $manpage;
	} else {
	  warn "$package/INFOS: no Original field for document $manpage\n";
	}
      }
      $manpage = '';
      %entry = ();
    } elsif (s/^manpage:\s*//i) {
      $manpage = $_;
    } elsif (m/^($validinfofields):\s*(.*)/oi) {
      $entry{lc $1} = $2;
    }
  }
  if ($manpage) {
    $infos->{$package}->{$manpage} = {};
    foreach my $field (keys %entry) {
      $infos->{$package}->{$manpage}->{$field} = $entry{$field};
    }
    if (defined $entry{original}) {
      $eng2trans{"$pkgname/$entry{original}"} = $manpage;
    } else {
      warn "$package/INFOS: no Original field for document $manpage\n";
    }
  }
  close (INFOS);
}

my $htmlfile = "table.".language2code($to).".html";

open(TABLE, ">$htmlfile") or warn "can't open $htmlfile: $!\n";

print TABLE <<"EOF";
<html>
<head>
  <meta content="text/html; charset=ISO-8859-15"
  http-equiv="content-type">
  <title>Status of $to manpages</title>
</head>
<body>
  <h1>Translation status of the $to manpages</h1>
  This information is also available for:<br>
EOF

# links to other languages' information
my $mancvs = Local::Cvsinfo->new;
$mancvs->readinfo("./");
foreach my $lang (@{$mancvs->dirs()}) {
  my $fromlang = language2code($to);
  $lang =~ s%^\./%%;
  $lang = language2code($lang);
  my $htmlref = $htmlfile;
  $htmlref =~ s/$fromlang/$lang/;
  print (TABLE " [<a href=\"./$htmlref\">$lang</a>] ");
}
print (TABLE "<br>\n");

my %checkedfile;
my $table = new HTML::Table(-spacing => 2, -padding => 2);
my $oldpkgname = '';

#   Check the files in the English directory
foreach my $path (sort @{$engcvs->files()}) {
  my $pkgname = $path;
  $pkgname =~ s/^$from\///o;

  my @words = split(/\//, $path);
  my $newpkgname = $words[1];

  if ($oldpkgname ne $newpkgname) {
    print(TABLE $table) unless ($table->getTableCols == 0);
    print(TABLE "<h3>Package: <a href=\"http://packages.debian.org/cgi-bin/search_packages.pl?searchon=names&subword=1&version=all&release=all&keywords=$newpkgname\">$newpkgname</a></h3>\n");
    $table = new HTML::Table(-spacing => 2, -padding => 2);
    $table->addRow("Manpage", "Translator", "Based on", "Current version");
    $oldpkgname = $newpkgname;
  }

  my $tpath = $path;
  $tpath =~ s/^$from/$to/o;
  defined ($eng2trans{$pkgname}) or do {
    (my $docname = $path) =~ s/^.*\///;
    if (!$globtrans->is_global($docname)) {
      warn "Missing $tpath\n" unless $opt_q;
      add_row($path, $eng2trans{$pkgname}, 9);
    }
    next;
  };
  $checkedfile{$tpath} = 1;	# Remember which files we found here
  my $docname = $tpath;
  $docname =~ s{^(.*)/}{};
  my $package = $1;
  my $status = check_file($eng2trans{$pkgname}, $package, $path,
			  $engcvs->revision($path),
			  str2time($engcvs->date($path)));
  add_row($path, $eng2trans{$pkgname}, $status);
}

# end of webpage
print(TABLE $table) unless ($table->getTableCols == 0);

print TABLE <<"EOF";
<hr style="width: 100%; height: 2px;">
  <br>Comments: <a href=mailto:nahoo\@inicia.es>Rubén Porras</a><br>
  </body>
</html>
EOF

close(TABLE);

# Now check all the files in the translated directory as well, there may be
# some files that are not available in the English version.
foreach my $tpath (sort @{$l10ncvs->files()}) {
  next if defined $checkedfile{$tpath}; # Don't look at a file twice
  warn "$tpath does not match anything in English\n" if $verbose;
}

sub add_row {
  my ($path, $docname, $status) = @_;

  my $cvsweb = "http://cvs.alioth.debian.org/cgi-bin/cvsweb.cgi/manpages";
  my $cvsargs = "&amp;content-type=text/x-cvsweb-markup&amp;cvsroot=ddp";

  my $engrev = $engcvs->revision($path);

  my ($lang, $package, $man) = split(/\//, $path);

  defined $docname or $docname = $man;
  my $l10nman = "$to/$package/$docname";
  my $l10nref = $infos->{"$to/$package"}->{$docname}->{'original-cvs-revision'} || '--';

  my $l10nrev = $l10ncvs->revision($l10nman) || '--';

  my $translator = $infos->{"$to/$package"}->{$docname}->{'translator'} || '--';

  my $link = "<a href=\"$cvsweb/$l10nman?rev=$l10nrev$cvsargs\"><b>$l10nman</b></a>";
  my $l10nrevlink = "<a href=\"$cvsweb/$path?rev=$l10nref$cvsargs\"><b>$l10nref</b></a>";
  my $engrevlink = "<a href=\"$cvsweb/$path?rev=$engrev$cvsargs\"><b>$engrev</b></a>";

  if ($status == 9) {
    $l10nrevlink = "--";
    $link = $engrevlink;
    $link =~ s%<b>$engrev</b>%$from/$package/$docname%;
  }
  if ($status == 5) {
    $l10nrevlink = "--";
  }

  $table->addRow($link, $translator, $l10nrevlink, $engrevlink);

  my $rows = $table->getTableRows();
 SWITCH: {
    if ($status == 4) { $table->setRowBGColor($rows, 'gren');   last SWITCH;  }				# Up-to-date
    if ($status == 3) { $table->setRowBGColor($rows, 'yellow'); last SWITCH;  }				# Needs update
    if ($status == 5) { $table->setRowBGColor($rows, 'cyan');   last SWITCH;  }				# Unknown
    if ($status == 7) { $table->setRowBGColor($rows, 'grey');   last SWITCH;  }				# Obsolete
    if ($status == 9) { $table->setRowBGColor($rows, 'red');    last SWITCH;  }				# Untranslated
  }

}

sub check_file {
  my ($docname, $package, $fromname, $revision, $mtime) = @_;
  $revision ||= 'n/a';
  my ($oldr, $name, $original);
  warn "Checking $fromname, English revision $revision\n" if $verbose;
  $oldr = $infos->{$package}->{$docname}->{'original-cvs-revision'} || 0;
  warn "Found translation for $oldr\n" if $verbose and $oldr;
  $name = "$package/$docname";

  my $str;
  my $status = 8;		# Unknown
  (my $numrev)  = $revision =~ m/^1\.(\d+)$/; $numrev ||= "0";
  (my $numoldr) = $oldr =~ m/^1\.(\d+)$/; $numoldr ||= "0";

  if ($revision ne 'n/a') {
    # The original version of this file exists (English or
    # otherwise), compare the translated version number to
    # the original
    if (!$oldr) {
      $oldr = '1.0';
      $str = "Unknown status of $name (revision should be $revision)";
      $status = 5;		# Unknown
    } elsif ($oldr eq $revision) {
      $status = 4;		# Up-to-date
    } elsif ($numoldr > $numrev) {
      $str = "Broken revision number $oldr for $name, it should be $revision";
    } else {
      $str = "NeedToUpdate $name from version $oldr to version $revision";
      $status = 3;		# Needs update
    }
  } else {
    # There is no English file matching this one.
    if ($oldr eq '0') {
      # There is no translation-check header, so it must be the
      # original version, and is thus always up-to-date.
      $status = 4;		# Up-to-date
    } else {
      # There is a translation-check header referencing an English
      # version, which means that the English file has been removed.
      $status = 7;		# Obsolete
      $str = "Obsolete $name";
    }
  }

  if ($str && $oldr ne $revision) {
    $str .= "\n";
    print $str unless ($opt_Q);
  }
  return $status;
}