#!/usr/bin/perl -w
#
# podebconf-report-po, Send outdated debconf po files to the last translator
# Copyright 2004 (C) Fabio Tranchitella <kobold@kobold.it>
#                    Denis Barbier <barbier@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 Library 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.
#

## Release information
my $PROGRAM = "podebconf-report-po";
my $VERSION = "0.04";

## Loaded modules, require libmail-sendmail-perl
use strict;
eval q{use Mail::Sendmail;};
die "$PROGRAM: This program requires the libmail-sendmail-perl package.\n".
    "$PROGRAM: Aborting!\n" if $@;
use MIME::Base64;
use MIME::QuotedPrint;
use Getopt::Long;
use POSIX;

## Global variables
my $HELP_ARG = 0;
my $VERSION_ARG = 0;
my $VERBOSE_ARG = 0;
my $FORCE_ARG = 0;
my $LANGUAGETEAM_ARG = 0;
my $SMTP_ARG = "";
my $TEMPLATE_ARG = "";
my $DEFAULT_ARG = 0;
my $PACKAGE_ARG = "";
my $FROM_ARG = "";
my $DEADLINE_ARG = "";
my $PODIR_ARG = "";

my $PODIR = '';
my @PODIRS = qw{../../debian/po ../debian/po debian/po};

my $CONTROL = '';
my @CONTROLS = qw{../../debian/control ../debian/control debian/control};

my $EDITOR = '/usr/bin/sensible-editor';
my $SMTP = '';

my $SUBJECT = "Please update debconf po translation for the package <package>";
my $BODY = "Hi,

you are noted as the last translator of the debconf translation for
<package>. The English template has been changed, and now a couple of
messages are marked \"fuzzy\" in your translation. I would be grateful
if you could take the time and update it. Please send the updated file
to me, or submit it as a wishlist bug against <package>.
<deadline>

Thanks,
";

## Handle options
GetOptions
(
 "help"            => \$HELP_ARG,
 "version"         => \$VERSION_ARG,
 "v|verbose"       => \$VERBOSE_ARG,
 "f|force"         => \$FORCE_ARG,
 "languageteam"    => \$LANGUAGETEAM_ARG,
 "smtp=s"          => \$SMTP_ARG,
 "template=s"      => \$TEMPLATE_ARG,
 "default"         => \$DEFAULT_ARG,
 "package=s"       => \$PACKAGE_ARG,
 "deadline=s"      => \$DEADLINE_ARG,
 "from=s"          => \$FROM_ARG,
 "podir=s"         => \$PODIR_ARG
 ) or &Help_InvalidOption;

&Help_PrintVersion if $VERSION_ARG;
&Help_PrintHelp if ($HELP_ARG);

## Try to find default editor
$EDITOR = $ENV{'EDITOR'} if exists($ENV{'EDITOR'});
$EDITOR = $ENV{'VISUAL'} if exists($ENV{'VISUAL'});

## Let's start to work ...
$SMTP = $SMTP_ARG if ($SMTP_ARG ne "");

my $i;

## Try to locate the po directory
if ($PODIR_ARG eq "") {
	foreach $i (@PODIRS) {
		$PODIR = $i if (-d $i);
	}
} else {
	$PODIR = $PODIR_ARG;
}

## Try to find the maintainer e-mail address and the package name
if ($PACKAGE_ARG eq "" or $FROM_ARG eq "") {
	foreach $i (@CONTROLS) {
		$CONTROL = $i if (-f $i);
	}

	if (-f $CONTROL) {
		##  Only read the first stanza
		local $/ = "\n\n";
		open (CNTRL, "< $CONTROL")
			or die "Unable to read $CONTROL: $!\n";
		my $text = <CNTRL>;
		close (CNTRL)
			or die "Unable to close $CONTROL: $!\n";
		if ($PACKAGE_ARG eq "" && $text =~ m/^Source: (.*)/mi) {
			$PACKAGE_ARG = $1;
		}

		if ($FROM_ARG eq "" && $text =~ m/^Maintainer: (.*)/mi) {
			$FROM_ARG = $1;
		}
	}
}
Verbose("Package: $PACKAGE_ARG\nMaintainer: $FROM_ARG");

if ($DEADLINE_ARG ne "") {
  $DEADLINE_ARG = "\nThe deadline for receiving the updated translation is $DEADLINE_ARG.";
}

## Apply the values to the subject and to the body of the message
$SUBJECT =~ s/<package>/$PACKAGE_ARG/ig;
$BODY =~ s/<package>/$PACKAGE_ARG/ig;
$BODY =~ s/<from>/$FROM_ARG/ig;
$BODY =~ s/<deadline>\n/$DEADLINE_ARG/ig;

die "Directory po not found, exiting.\n" if $PODIR eq "";

## Analize every file with .po extension in $PODIR ...
Verbose("Checking for po files in $PODIR");
opendir(DIR, $PODIR);
my @files = ();
foreach my $file (grep(/\.po$/, readdir(DIR))) {
	local $/ = "\n\n";
	open (PO, "< $PODIR/$file")
		or die "Unable to read $PODIR/$file: $!\n";
	while (<PO>)
	{
		#  Ignore header fields
		next if m/msgid ""\nmsgstr/s;
		#  Ignore outdated msgids
		next unless m/^msgid /m;
		if (m/^#, .*fuzzy/m) {
			push (@files, $file);
			last;
		}
	}
	close (PO)
		or die "Unable to close $PODIR/$file: $!\n";
}
closedir(DIR);
if (@files) {
	print "Outdated files: ".join(' ', @files)."\n";
} else {
	print "No outdated files\n";
	exit(0);
}

if ($TEMPLATE_ARG eq "") {
	$BODY = &OpenEditor($EDITOR) if not $DEFAULT_ARG;
} else {
	$BODY = &ReadFile($TEMPLATE_ARG);
}

$BODY = encode_qp($BODY);

my @mails = ();
foreach my $file (@files) {

	my $recipient = '';
	my $recipient_team = '';
	my $charset = '';
	local $/ = "\n\n";
	open (PO, "< $PODIR/$file")
		or die "Unable to read $PODIR/$file: $!\n";
	while (<PO>) {
		if (m/^msgid ""$/m) {
			if (m/^"Last-Translator: (.*?)(\\n)?"$/m) {
				$recipient = $1 if $1 ne 'FULL NAME <EMAIL@ADDRESS>';
			}
			if ($LANGUAGETEAM_ARG && m/^"Language-Team: (.*?)(\\n)?"$/m) {
				$recipient_team = $1 if $1 ne 'LANGUAGE <LL@li.org>';
			}
			if (m/^"Content-Type: .*; charset=(.*?)(\\n)?"$/m) {
				$charset = $1;
			}

			last;
		}
	}
	close (PO)
		or die "Unable to close $PODIR/$file: $!\n";
	if ($recipient eq '') {
		warn "Warning: $file:  Unable to determine last translator.\n";
		next;
	}
	print "  $file: $recipient";
	print ", $recipient_team" if $recipient_team ne "";
	print "\n";

	my $file_encoded = encode_base64(&ReadFile($PODIR . "/" . $file));
	my %mail = (
   			from => $FROM_ARG,
   			to => $recipient,
   			subject => $SUBJECT
   			);

	$mail{cc} = $recipient_team if $recipient_team ne "";

	$mail{smtp} = $SMTP if ($SMTP ne '');
	my $boundary = "=" . time() . "=";
	$mail{'content-type'} = "multipart/mixed; boundary=\"$boundary\"";
	$mail{body} = <<_EOF_;
--$boundary
Content-Type: text/plain; charset="us-ascii"
Content-Transfer-Encoding: quoted-printable

$BODY

--$boundary
Content-Type: text/x-gettext; name="$file"; charset="$charset"
Content-Transfer-Encoding: base64
Content-Disposition: attachment; filename="$file"

$file_encoded
--$boundary--
_EOF_

	push(@mails, \%mail);
}

if (!$FORCE_ARG) {
	print "Ready to send the emails, are you sure? [y/N] ";
	my $line = <>;
	chop $line;
	exit(0) if ($line ne "Y" and $line ne "y");
}

#  Make Perl compiler quiet
print $Mail::Sendmail::error if 0;
foreach my $mail (@mails) {
	sendmail(%{$mail}) || print "Couldn't send the email: $Mail::Sendmail::error\n";
}
exit(0);

###############################################################################

## Handle invalid arguments
sub OpenEditor
{
	my $editor = shift;

	my $body = "";
	my $opts = "";
	my $tmpnam = tmpnam();

	open (OUT, "> $tmpnam")
		or die ("Couldn't write $tmpnam: $!\nExiting!\n");
	print OUT $BODY;
	close(OUT)
		or die ("Couldn't close $tmpnam: $!\nExiting!\n");

	$opts = "-f" if ($editor eq "vim");
	system("$editor $opts $tmpnam");

	$body = &ReadFile($tmpnam) if (-f $tmpnam);
	unlink($tmpnam);

	return $body;
}

sub ReadFile
{
	my $file = shift;
	local $/ = undef;
	open(FILE, "< $file")
		or die ("Couldn't read $file: $!\nExiting!\n");
	my $body = <FILE>;
	close(FILE)
		or die ("Couldn't close $file: $!\nExiting!\n");
	return $body;
}

## Handle invalid arguments
sub Help_InvalidOption
{
	print STDERR "Try `${PROGRAM} --help' for more information.\n";
	exit 1;
}

## Print the usage message and exit
sub Help_PrintHelp
{
	print <<_EOF_;

Usage: ${PROGRAM} [OPTIONS]
Send outdated debconf po files to the last translators.

Options:
  --help                display this help and exit
  --version             display version information and exit
  -v, --verbose         display additional information
  -f, --force           send the email without confirmation
  --smtp=SERVER         specify SMTP server for mailing (default localhost)
  --template=TEMPLATE   specify file to use it as template for the emails
  --default             don't open the editor and use the template as is
  --package=PACKAGE     specify the name of the package
  --from=MAINTAINER     specify the name and the email address of the sender
  --deadline=DEADLINE   specify the deadline for receiving the updated
                        translations
  --languageteam        send the email also to the Language Team as carbon copy
  --podir=PODIR         specify where are located the po files

_EOF_
	exit 0;
}

## Print the version text and exit
sub Help_PrintVersion
{
	print <<_EOF_;
${PROGRAM} $VERSION
Copyright (C) 2004 Fabio Tranchitella and Denis Barbier.
This is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
_EOF_
	exit 0;
}

sub Verbose
{
	my $msg = shift;
	return unless $VERBOSE_ARG;
	$msg =~ s/^/**${PROGRAM}: /mg;
	print STDERR $msg."\n";
}
