On Thu, Jan 27, 2005 at 11:51:45AM +0100, Fabio Tranchitella wrote:
> Il giorno mer, 26-01-2005 alle 22:01 +0100, Denis Barbier ha scritto:
> > Hi Fabio,
> > I would like to fix these bugs. Will you have time soon to provide a
> > patch? Otherwise I will work on them.
>
> Hi Denis,
> I've prepared the patch two weeks ago but I've missed to send it to
> the bts, sorry. Here there is a patch for #288532, #292472 and #288533.
Ok, I made many cosmetic changes to the code, I believe it is more
structured now.
> Now podebconf-report-po:
> - uses the DEBMAIL environment variable to override the submitter
> of the emails (if available).
> - allows the editing of mail headers (subject, from and whatever else),
> - allows to set the reply-to field to a bug report in BTS (--bts)
> - can send a bug against the package to warn the maintainer about
> the outdated translations of the package (--report, very useful
> in combination with --bts to track the replies of the translators)
I renamed --report into --submit. The other visible change is that
translation teams are no more Cc'ed but put in the To: field. The
reason is that I did not know what to do if a Cc header was also present
in mail comments.
Can you please test
http://people.debian.org/~barbier/tmp/po-debconf_0.8.19_all.deb
? Here is the podebconf-report-po script.
Denis
#!/usr/bin/perl -w
# podebconf-report-po, Send outdated debconf PO files to the last translator
# Copyright (C) 2004, 2005 Fabio Tranchitella <[EMAIL PROTECTED]>
# Denis Barbier <[EMAIL PROTECTED]>
#
# 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.06";
## 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 $SUBMIT_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 = (exists($ENV{'DEBEMAIL'}) ? $ENV{'DEBEMAIL'} : "");
my $BTS_ARG = "";
my $DEADLINE_ARG = "";
my $PODIR_ARG = "";
my @TOPDIRS = qw{../.. .. .};
my $PODIR = '';
my $EDITOR = '/usr/bin/sensible-editor';
## Default templates
my $comments = "# Lines beginning with a number sign are comments, they are
removed when
# sending mails. If a line is composed of a # followed by a 'Name: Value'
# pair, it is interpreted as a mail header field and is passed to your mail
# transport agent. You can edit/add/remove those header fields.";
my $SUBJECT_TRANSLATOR = "Please update debconf PO translation for the package
<package>";
my $BODY_TRANSLATOR = $comments. "
#
# From: <from>
# Subject: <subject>
# Reply-To: <reply-to>
#
# This mail will be sent to the following people:
<filelist>
Hi,
you are noted as the last translator of the debconf translation for
<package>. The English template has been changed, and now some messages
are marked \"fuzzy\" in your translation or are missing.
I would be grateful if you could take the time and update it.
<reply>
<deadline>
Thanks,
";
my $SUBJECT_SUBMIT = "debconf PO translations for the package <package> are
outdated";
my $BODY_SUBMIT = $comments. "
#
# From: <from>
# Subject: <subject>
Package: <package>
Version: N/A
Severity: wishlist
Tags: l10n
The following debconf translations are outdated:
<filelist>
Translators, please send your translations to this bugreport.
<deadline>
Thanks,
";
my $SUBJECT = '';
my $BODY = '';
## Handle options
GetOptions
(
"help" => \$HELP_ARG,
"version" => \$VERSION_ARG,
"v|verbose" => \$VERBOSE_ARG,
"f|force" => \$FORCE_ARG,
"podir=s" => \$PODIR_ARG,
"smtp=s" => \$SMTP_ARG,
"template=s" => \$TEMPLATE_ARG,
"default" => \$DEFAULT_ARG,
"languageteam" => \$LANGUAGETEAM_ARG,
"package=s" => \$PACKAGE_ARG,
"deadline=s" => \$DEADLINE_ARG,
"from=s" => \$FROM_ARG,
"bts=s" => \$BTS_ARG,
"submit" => \$SUBMIT_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'});
## Try to locate the PO directory
if ($PODIR_ARG eq "") {
foreach my $d (@TOPDIRS) {
$PODIR = "$d/debian/po" if (-d "$d/debian/po");
}
} else {
$PODIR = $PODIR_ARG;
}
die "Directory po not found, exiting!\n" if $PODIR eq "";
die "Wrong argument: $PODIR is not a directory!\n" unless -d $PODIR;
## Try to find the maintainer e-mail address and the package name
if ($PACKAGE_ARG eq "" or $FROM_ARG eq "") {
my $CONTROL = '';
foreach my $d (@TOPDIRS) {
$CONTROL = "$d/debian/control" if (-f "$d/debian/control");
}
if ($CONTROL eq '') {
foreach my $d (@TOPDIRS) {
$CONTROL = "$d/debian/control.in" if (-f
"$d/debian/control.in");
}
}
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: (.*)/m) {
$PACKAGE_ARG = $1;
}
if ($FROM_ARG eq "" && $text =~ m/^Maintainer: (.*)/m) {
$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.";
}
my $REPLY = '';
if ($BTS_ARG =~ m/^\d+$/) {
$BTS_ARG .= "[EMAIL PROTECTED]";
$REPLY = "Please respect the Reply-To: field and send your updated
translation to\n$BTS_ARG.";
} else {
$REPLY = "Please send the updated file to me, or submit it as a
wishlist bug\nagainst <package>.";
}
if ($SUBMIT_ARG) {
$BODY = $BODY_SUBMIT;
$SUBJECT = $SUBJECT_SUBMIT;
} else {
$BODY = $BODY_TRANSLATOR;
$SUBJECT = $SUBJECT_TRANSLATOR;
}
## Apply the values to the subject and to the body of the message
$SUBJECT =~ s/<package>/$PACKAGE_ARG/g;
$BODY =~ s/<reply>/$REPLY/g;
$BODY =~ s/<reply-to>/$BTS_ARG/g;
$BODY =~ s/\n# Reply-To: \n/\n/;
$BODY =~ s/<subject>/$SUBJECT/g;
$BODY =~ s/<package>/$PACKAGE_ARG/g;
$BODY =~ s/<from>/$FROM_ARG/g;
$BODY =~ s/\n<deadline>/$DEADLINE_ARG/g;
## Check every file with .po extension in $PODIR ...
Verbose("Checking for PO files in $PODIR");
opendir(DIR, $PODIR);
my $poFiles = {};
foreach my $poFile (grep(/\.po$/, readdir(DIR))) {
local $/ = "\n\n";
$poFiles->{$poFile} = {};
my $outdated = 0;
my $found_header = 0;
open (PO, "< $PODIR/$poFile")
or die "Unable to read $PODIR/$poFile: $!\n";
while (<PO>) {
if ($found_header == 0 && m/msgid ""\nmsgstr/s) {
$found_header = 1;
if (m/^"Last-Translator: (.*?)(\\n)?"$/m) {
$poFiles->{$poFile}->{translator} = $1
if $1 ne 'FULL NAME <[EMAIL
PROTECTED]>';
} else {
warn "Warning: $poFile: Unable to determine
last translator. Skipping file!\n";
last;
}
if (m/^"Content-Type: .*; charset=(.*?)(\\n)?"$/m) {
$poFiles->{$poFile}->{charset} = $1;
} else {
warn "Warning: $poFile: Unable to determine
charset. Skipping file!\n";
last;
}
if ($LANGUAGETEAM_ARG && m/^"Language-Team:
(.*?)(\\n)?"$/m) {
$poFiles->{$poFile}->{team} = $1
if $1 ne 'LANGUAGE <[EMAIL PROTECTED]>';
}
next;
}
# Ignore outdated msgids
next unless m/^msgid /m;
# Check for fuzzy or missing translations
if (m/^#, .*fuzzy/m or m/\nmsgstr ""$/s) {
$outdated = 1;
last;
}
}
close (PO)
or die "Unable to close $PODIR/$poFile: $!\n";
delete $poFiles->{$poFile} unless $outdated;
}
closedir(DIR);
if (keys %$poFiles) {
print "Outdated files: ".join(' ', keys %$poFiles)."\n";
} else {
print "No outdated files\n";
exit(0);
}
my $filelist = '';
if ($SUBMIT_ARG) {
$filelist = join(' ', keys %$poFiles)."\n";
} else {
foreach my $poFile (keys %$poFiles) {
$filelist .= '### ' . $poFile . ': ' .
$poFiles->{$poFile}->{translator};
$filelist .= ', ' . $poFiles->{$poFile}->{team} if
defined($poFiles->{$poFile}->{team});
$filelist .= "\n";
}
# Remove non-ASCII characters
$filelist =~ s/[\x80-\xff]/?/g;
}
$BODY =~ s/<filelist>\n/$filelist/g;
my %headers = ();
if ($TEMPLATE_ARG eq "") {
$BODY = &OpenEditor($EDITOR, $BODY) if not $DEFAULT_ARG;
} else {
$BODY = &ReadFile($TEMPLATE_ARG);
}
%headers = &ParseHeaders($BODY);
$BODY = &RemoveHeaders($BODY);
my @mails = ();
if ($SUBMIT_ARG) {
$BODY =~ s/<filelist>/$filelist/g;
my %mail = (
From => $FROM_ARG,
To => "[EMAIL PROTECTED]",
Subject => $SUBJECT
);
$mail{body} = encode_qp($BODY);
@mails = (\%mail);
} else {
$BODY = encode_qp($BODY);
foreach my $file (keys %$poFiles) {
my $file_encoded = encode_base64(&ReadFile($PODIR . "/" .
$file));
my %mail = (
From => $FROM_ARG,
To => $poFiles->{$file}->{translator},
Subject => $SUBJECT
);
$mail{To} .= ", ". $poFiles->{$file}->{team}
if defined $poFiles->{$file}->{team};
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="$poFiles->{$file}->{charset}"
Content-Transfer-Encoding: base64
Content-Disposition: attachment; filename="$file"
$file_encoded
--$boundary--
_EOF_
push(@mails, \%mail);
}
}
# Add mail headers
foreach my $refmail (@mails) {
foreach my $h (keys(%headers)) {
$refmail->{$h} = $headers{$h};
}
$refmail->{smtp} = $SMTP_ARG if ($SMTP_ARG ne '');
}
if (!$FORCE_ARG) {
if ($SUBMIT_ARG) {
print "Ready to send the bug report against the package
$PACKAGE_ARG, are you sure? [y/N] ";
} else {
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 . $Mail::Sendmail::error if 0;
foreach my $mail (@mails) {
sendmail(%{$mail}) || print "Couldn't send the email:
$Mail::Sendmail::error\n";
}
exit(0);
###############################################################################
sub OpenEditor
{
my $editor = shift;
my $body = shift;
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 ParseHeaders
{
my $body = shift;
my %headers = ();
while ($body =~ s/^#\s*([^\n]*)\n//s) {
my $comment = $1;
if ($comment =~ m/^([^:\n]+):\s*([^\n]+)\n$/) {
$headers{$1} = $2;
}
}
return %headers;
}
sub RemoveHeaders
{
my $body = shift;
# First remove comments
1 while $body =~ s/^#[^\n]*\n//s;
# Optional empty lines
$body =~ s/^\s+//s;
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
--podir=DIRECTORY specify where are located the PO files
--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
--submit send a bug report against the package with a report
of the outdated debconf translations
--bts=BUGNUMBER specify the Debian bug number to set as reply-to
_EOF_
exit 0;
}
## Print the version text and exit
sub Help_PrintVersion
{
print <<_EOF_;
${PROGRAM} $VERSION
Copyright (C) 2004, 2005 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";
}
