deb-rev version 0.1
Bonjour,
C'est le même que ddts-rev, sauf qu'il sert pour les fichiers de
l'architecture cvs placés dans french/
Il marche tout pareil : avec les mêmes bogues, et même certainement des
nouveaux :)
La doc est fausse (premier nouveau bogue)
Pour l'utiliser, il faut paramètrer ~/.deb-rev (merci encore à Denis)
Il recrée l'architecture cvs dans $home
Pour envoyer les corrections, pour le moment, il faut être dans le
répertoire les contenant.
ATTENTION :
Traducteurs, pour que les relecteurs puissent l'utiliser, le sujet de
votre demande de relecture doit se terminer par le sous-répertoire de
french/ dans lequel sont placés les documents attachés pour relecture.
Par exemple :
Subject: blablabla /Bugs/
^ ^pas d'espace à la fin
^ « / » optionnel
pour les documents french/Bugs/Access.wml
french/Bugs/Developer.wml
Une limite pour les envois : il n'est pas possible d'envoyer des
documents venant de répertoires différents, il faut faire un message par
répertoire, chaque message pouvant contenir autant de fichiers attachés
que vous le souhaitez.
Les deux principales choses à faire :
- chercher récursivement dans tous les sous-répertoires de $home des
corrections à envoyer ;
- faire un script pour les traducteurs pour envoyer les demandes de
relectures dans le bon format, avec recherche récursive dans leur
répertoire racine de traduction.
a+
Nicolas
--
# where to put all the files
# Things you MUST change
$home="/home/nico/Mail/rel/french";
$tmp="/tmp";
$mail_from='Nicolas Bertolissio <nico.bertol@wanadoo.fr>';
$mail_begin="Bonjour,\n\n"
."Tu trouveras en attachement un fichier diff entre la version que tu as\n"
."postée sur la liste et une version corrigée par mes soins de ce document\n"
."Si tu es d'accord avec les corrections, merci de poster une version\n"
."corrigée sur la liste. Dans le cas contraire, n'hésite pas à me\n"
."contacter.\n";
#."Si tu n'es pas d'accord avec mes corrections, contacte-moi.\n";
$mail_end="\na+\n\nNicolas\n";
#! /usr/bin/perl -w
use strict;
### Config part
# Things you must change in $HOME/.ddts-rev
my ($home, $tmp, $mail_from, $mail_begin, $mail_end);
# Things you can change
my $debug=1; # level of verbosity 0..3
my $desc_ok="DescOk.txt"; # filename for ok description list
my $comment=">> "; # comment string
my $linenumber="ligne %d :"; # new comment line, must contain %d
my $sendnew="no"; # if set to "yes", send the new description
my $selfsend="yes"; # if set to "yes", you will be sent a copy of outgoing mails
my $mail_title="[relecture] %s"; # must contain %s
my $mail_enc="8bits";
my $mail_charset="iso-8859-1";
my $todo="todo"; # extention of files waiting for a review (*)
my $rev="relu"; # extention of files you already reviewed
my $new="newmail"; # extention of newly created mail files (*)
my $mail="mail"; # extention of ready to be sent mail files
my $sent="sent"; # extention of mails sent (*)
chomp (my $path=`pwd`);
my $conffile = $ENV{HOME}."/.deb-rev";
die 'You must define $home, $tmp, $mail_from, $mail_begin and $mail_end Perl variables in $HOME/.ded-rev' unless -r $conffile;
scalar eval `cat $conffile`;
my $var;
foreach (qw(home tmp mail_from mail_begin mail_end)) {
eval "\$var = \$$_";
die "\$$_ not defined in \$HOME/.deb-rev" unless $var ne '';
}
# files in category marked with (*) are automatically generated.
# Don't edit them, change their name before it.
### End of the config part
=head1 NAME
deb-rev - a tool to ease the work of reviewer of debian l10n lists
=head1 SYNOPSIS
ddeb-rev [parse|mail|clean|stats]
=head1 DESCRIPTION
This program helps the reviewer of document translation with the debian l10n lists.
Here is the basical review process if you use this tool:
=over 4
=item o You get documents from the debian l10n list, containing translations.
Pass this mail to the standard input of this script, providing the I<parse> option.
It will create two files called I<doc-name> and I<doc-name.todo> for each translation
in the mail. The first one is the unchanged translation, for internal use.
The second is a template to ease your review.
=item o You do your review
For that, rename I<doc-name.todo> to I<pkg-doc.relu>. Then, change the translation
found there, and add any comments you want in line starting with:
'>> '
=item o You're done with the review and want to send your work to translators back.
Call the script with the I<mail> option. It will make a diff of your version and
the translators one. If the two versions are equal, nothing will be done. Else,
the script will send a mail in mime format with three parts:
=over 4
=item - the comments you've put in the comment lines
=item - the version resulting of your review
If the variable $sendnew is set to "yes"
=item - the diff between your version and the translator one.
=back
Then, the script will show you the resulting mail, and prompt you if you want to
send it or not. Be carfull with sending mails. Please make sure you are really
done with the review before.
Lastly, the script will save the sent mail to I<doc-name.sent> to make sure
the mail won't be sent several times if you run the script several times.
=item o clean your workspace
Calling the script with the I<clean> option removes all temp files like *~ ones,
or the ones created internally. If I<doc-name.todo> and I<doc-name.relu> both
exists, the script will remove the first. So, be carfull when using this option...
=item o stats gives statistics
Print some statistics about the descriptions review process
=back
=cut
my $version="0.1";
# Test if configuration as been made
if (! -d $home) {
mkdir $home || die "Can't create $home. Is the script configured?";
}
# Remove $path/$file
# Print the corresponding message
sub remove {
my($path, $file)=@_;
if (-e "$path/$file") {
print "Removing $file\n";
unlink "$path/$file" || die "Can't remove $file: $!";
}
}
# Extract translator address
# ddts report id
# original translation
# from $path/$file
sub pkg2tmptransid {
my $tmp="";
my ($path, $file)=@_;
open PKG, "$path/$file" || die "Can't read $file: $!";
chomp(my $translator=<PKG>);
$translator =~ s/Translator: //;
$debug && print "Translator: $translator\n";
chomp(my $reportid=<PKG>);
$reportid =~ s/debian Id: //;
$debug && print "debian Id: $reportid\n";
$tmp .= $_ while <PKG>;
close PKG || die "Can't close $file: $!";
return ($tmp, $translator, $reportid);
}
# Extract comments
# new version
# from $path/$file
sub rev2newcomment {
my $com="";
my $new="";
my $linecount=0;
my $lastline=0;
my ($path, $file)=@_;
open REV, "$path/$file" || die "Can't read $file: $!";
# discard translator adress and ddts report id
<REV>; <REV>;
while (<REV>) {
if (/^$comment/) {
if ($linecount!=$lastline) {
$lastline=$linecount;
$com.= "\n".sprintf($linenumber, $linecount)."\n";
}
$com.= $';
} else {
$new .= $_;
$linecount++;
}
}
close REV || die "Can't close $file: $!";
return ($new, $com);
}
sub parse_report {
my $path; # cvs path
my $translator; # translator address
my $debId; # Message-Id field
my $boundary; # mime boundary
# Read the mail header
# Get the translator name
# Get the 'Message-Id:' field so we can use 'In-Reply-To:' when sending email
while (<>) {
last if (/^$/);
if (/^from: /i) {
chomp($translator = $');
$debug && print "Translator: $translator\n";
}
if (/^subject: /i) {
chomp($path = $');
$path .= $1 while (($_=<>)=~/^\s+(.*)$/);
$path .= "\n";
$path =~ /\s\/?(\S*)$/;
$path = $1;
$debug && print "Home: $home\n";
$debug && print "Path: $path\n";
mkdir "$home/$path" || die "Can't create directory $home/$path: $!";
}
if (/^message-id: /i) {
chomp($debId = $');
$debug && print "Message-Id: $debId\n";
}
if (/boundary=\"(.*)\"/i) {
chomp($boundary = $1);
$debug && print "boundary: $boundary\n";
}
}
0, until (<> =~ /^--$boundary/); # find beginning of message
while (1) {
# get file name
my $file; # file name
until (defined $file) {
last unless defined($_=<>);
$file=$1 if /filename=\"(.*)\"/;
};
last unless defined $file;
$debug && print "filename: $file\n";
# go to beginning of part
0, until (<> =~ /^$/);
# get part
my $text = "Translator: $translator\n"
."debian Id: $debId\n";
$text .= $_ until (($_=<>) =~ /^--$boundary/);
open FILE, ">$home/$path/$file" || die "Can't create $path/$file: $!";
open TODO, ">$home/$path/$file.$todo" || die "Can't create $path/$file.$todo: $!";
print FILE $text;
print TODO $text;
close TODO || die "Can't write $path/$file.$todo: $!";
close FILE || die "Can't write $path/$file: $!";
# Move rev to rev.old
if (-e "$home/$path/$file.$rev") {
print "Moving $path/$file.$rev -> $path/$file.$rev.old\n";
rename "$home/$path/$file.$rev", "$home/$path/$file.$rev.old";
# If description eq last review rename $file.$todo in $file.$rev
# so the reviewer won't spend time with it
my($temp) = &pkg2tmptransid("$home/$path", "$file");
my($correct) = &rev2newcomment("$home/$path", "$file.$rev.old");
if ($temp eq $correct) {
print "$path/$file is ok\n";
&remove ("$home/$path", "$file.$rev.old");
print "Moving $path/$file.$todo -> $path/$file.$rev\n";
rename "$home/$path/$file.$todo", "$home/$path/$file.$rev";
}
}
&remove("$home/$path", "$file.$sent");
}
}
# Diff two strings
# $name is only provided for debugging purposes
sub diff {
my $diff="";
my ($name, $orig, $dest)=@_;
open ORIG, ">$tmp/$name" || die "Can't create temp file $name: $!";
print ORIG $orig;
close ORIG || die "Can't write temp file $name: $!";
open DEST,">$tmp/$name.new" || die "Can't create temp file $name.new: $!";
print DEST $dest;
close DEST || die "Can't write temp file $name.new: $!";
system "diff -u $tmp/$name $tmp/$name.new > $tmp/$name.diff" || die "Can't run diff: $!";
open DIFF, "$tmp/$name.diff" || die "Can't open temp file $name.diff: $!";
$diff .= $_ while <DIFF>;
close DIFF || die "Can't close temp file $name.diff: $!";
unlink "$tmp/$name" || die "Can't remove temp file $name:$!";
unlink "$tmp/$name.new" || die "Can't remove temp file $name.new:$!";
unlink "$tmp/$name.diff" || die "Can't remove temp file $name.diff:$!";
return $diff;
}
sub make_mails {
my $boundary;
my $BCount=0;
opendir (PKGLIST,$path) || die "Cannot read the content of $path: $!";
open OK, ">$path/$desc_ok" || die "Can't create $desc_ok: $!";
foreach (readdir(PKGLIST)) {
next if /\.$todo$/;
next if /\.$rev$/;
next if /\.$new$/;
next if /\.$mail$/;
next if /\.$sent$/;
next if /^\./;
my $pkg = $_;
if (-e "$path/$pkg.$mail") {
my $text = "";
open MAIL, "$path/$pkg.$mail" || die "Can't open $pkg.$mail: $!";
$text .= $_ while <MAIL>;
close MAIL || die "Can't close $pkg.$mail: $!";
print "Here is the mail:\n$text\nDo you want to send it [Y/n] ?\n";
if (!(<> =~ /^[nN]/)) {
rename "$path/$pkg.$mail", "$path/$pkg.$sent";
open SENDMAIL,"| /usr/lib/sendmail -t -oi -oem" || die "Can't run sendmail: $!";
print SENDMAIL $text;
close SENDMAIL || die "Can't run sendmail: $!";
print "Mail sent\n";
} else {
print "Mail not sent\n";
}
next;
}
if (-e "$path/$pkg.$rev" && -e "$path/$pkg") {
if (-e "$path/$pkg.$sent") {
print "$pkg.$sent exists. I won't send the same mail twice\n";
next;
}
if (-e "$path/$pkg.$new") {
print "$pkg.$new exists. rename it to $pkg.$mail to send it\n";
next;
}
$boundary="----------=_".scalar(time)."-$$-".$BCount++;
my($temp, $translator, $reportid) = &pkg2tmptransid("$path", "$pkg");
my($correct, $comment) = &rev2newcomment("$path", "$pkg.$rev");
# build the mail
my $text = "From: $mail_from\n"
."To: ".($debug>1?$mail_from:$translator)."\n";
$text .= "Cc: $mail_from\n" if ($selfsend eq "yes");
$text .= "Subject: ".sprintf ($mail_title, substr($path, length($home)+1)."/$pkg")."\n"
."In-Reply-To: $reportid\n"
."Mime-Version: 1.0\n"
."Content-Type: multipart/mixed; boundary=\"$boundary\"\n"
."Content-Disposition: inline\n"
."Content-Transfer-Encoding: $mail_enc\n"
."User-Agent: ddts review helper\n\n\n"
."--$boundary\n"
."Content-Type: text/plain; charset=$mail_charset\n"
."Content-Disposition: inline\n"
."Content-Transfer-Encoding: $mail_enc\n\n"
.$mail_begin;
$text .= $comment;
$text .= $mail_end;
if ($sendnew eq "yes") {
$text .= "\n\n"
."--$boundary\n"
."Content-Type: text/plain; charset=$mail_charset\n"
."Content-Disposition: attachment; filename=\"$pkg.new\"\n\n"
.$correct;
}
$text .= "\n\n"
."--$boundary\n"
."Content-Type: text/plain; charset=$mail_charset\n"
."Content-Disposition: attachment; filename=\"$pkg.diff\"\n\n";
if ($temp eq $correct) {
# empty diff
print OK $pkg."\n";
} else {
# puts the diff
$text .= &diff($pkg, $temp, $correct);
# Ends the mime stuff
$text .= "--$boundary--\n\n";
print "Here is the mail:\n$text\nDo you want to send it [Y/n] ?\n";
if (!(<> =~ /^[nN]/)) {
open SENT, ">$path/$pkg.$sent" || die "Can't create $pkg.$sent: $!";
print SENT $text;
close SENT || die "Can't write $pkg.$sent: $!";
open SENDMAIL,"| /usr/lib/sendmail -t -oi -oem" || die "Can't run sendmail: $!";
print SENDMAIL $text;
close SENDMAIL || die "Can't run sendmail: $!";
print "Mail sent\n";
} else {
open MAIL, ">$path/$pkg.$new" || die "Can't create $pkg.$new: $!";
print MAIL $text;
close MAIL || die "Can't write $pkg.$new: $!";
print "Mail saved as $pkg.$new\n";
}
}
}
}
close OK || die "Can't write $desc_ok: $!";
closedir PKGLIST || die "Cannot read the content of $path: $!";
}
# remove $pkg.$rm if $pkg.$e also exists in $path
# print corresponding message
sub test_remove {
my($path, $pkg, $e, $rm)=@_;
if (-e "$path/$pkg.$e" && -e "$path/$pkg.$rm") {
print "Removing $pkg.$rm\n";
unlink "$path/$pkg.$rm" || die "Can't remove $pkg.$rm: $!";
}
}
sub clean {
opendir (PKGLIST,$path) || die "Can't read the content of $path: $!";
foreach (readdir(PKGLIST)) {
&remove_tmp ("$path", "$_", "") if /~$/;
next if /\.$todo$/;
next if /\.$rev$/;
next if /\.$new$/;
next if /\.$mail$/;
next if /\.$sent$/;
next if /^\./;
my $pkg = $_;
&test_remove ("$path", "$pkg", "$rev", "$todo");
&test_remove ("$path", "$pkg", "$rev", "$rev.old");
&test_remove ("$path", "$pkg", "$mail", "$new");
&test_remove ("$path", "$pkg", "$sent", "$mail");
}
closedir PKGLIST || die "Can't close $path: $!";
}
sub statistics {
my $count_pkg=0;
my $count_todo=0;
my $count_relu=0;
my $count_new=0;
my $count_mail=0;
my $count_sent=0;
my $count_ok=0;
my $l=0; # length of longest figure for nice formatting
opendir (PKGLIST,$path) || die "Can't read the content of $path: $!";
foreach (readdir(PKGLIST)) {
next if /\.$todo$/;
next if /\.$rev$/;
next if /\.$new$/;
next if /\.$mail$/;
next if /\.$sent$/;
next if /^\./;
my $pkg = $_;
if ((-e "$path/$pkg.$rev" || -e "$path/$pkg.$todo") && -e "$path/$pkg") {
$count_pkg++;
$count_todo++ if (-e "$path/$pkg.$todo");
$count_new++ if (-e "$path/$pkg.$new");
$count_mail++ if (-e "$path/$pkg.$mail");
$count_relu++ if (-e "$path/$pkg.$rev");
$count_sent++ if (-e "$path/$pkg.$sent");
}
}
closedir PKGLIST || die "Can't close $path: $!";
if (-e "$path/$desc_ok") {
open OK, "$path/$desc_ok" || die "Can't open $desc_ok: $!";
$count_ok++ while (<OK>);
close OK || die "Can't close $desc_ok: $!";
}
$l = $_>$l?$_:$l foreach ($count_pkg, $count_todo, $count_relu, $count_new, $count_mail, $count_sent, $count_ok);
$l = length $l;
printf ("new mail: %${l}d\n", $count_new);
printf (" to send: %${l}d\n", $count_mail);
printf (" sent: %${l}d\n", $count_sent);
printf (" ok: %${l}d\n", $count_ok);
print (" ------"."-"x$l."\n");
printf ("reviewed: %${l}d\n", $count_relu);
printf (" todo: %${l}d\n", $count_todo);
print ("=========="."="x$l."\n");
printf (" total: %${l}d\n", $count_pkg);
}
my $cmd=shift || '';
if ($cmd eq "parse") {
&parse_report();
} elsif ($cmd eq "mail") {
&make_mails();
} elsif ($cmd eq "clean") {
&clean();
} elsif ($cmd eq "stats") {
&statistics();
} else {
my $me=$0;
$me=~s,^.*?/([^/]*)$,$1,;
die "Usage $me [parse|mail|clean]\n"
." parse: read a ddts from the standard input and change the files in $home\n"
." mail: create the pkg.newmail files which you should edit and send\n"
." clean: remove : \n"
." - *~\n"
." - the $todo when a $rev exists\n"
." - all tmp files (.diff, .new, .tmp)\n"
."\n$me version $version\n";
}
=head1 AUTHORS
Nicolas Bertolissio <nico.bertol@wanadoo.fr>
=cut
Reply to: