ddts-script v. 0.1.3
Bonjour,
Et hop encore quelques bogues (merci à Antoine Hulin pour le premier,
le suivant en découle).
changelog :
version 0.1.3
- bugs fix:
- change: use an instruction block for `map' in `parse_translation'
thanks to Antoine Hulin to have made me discover this bug
- change: remove commments when sending translation
- change: use real language when sending mail (instead of `fr')
- change: debug subroutine names
La rustine est en attachement, le script complet et toujours là :
http://perso.wanadoo.fr/nico.bertol/ddts/ddts-script.txt
a+
Nicolas
--
--- ddts-script_0.1.2.txt Thu Nov 15 19:17:48 2001
+++ ddts-script_0.1.3.txt Fri Nov 16 11:55:24 2001
@@ -208,7 +208,7 @@
=cut
-my $version = "0.1.2";
+my $version = "0.1.3";
# Test if configuration as been made
if (! -d $tr_dir) {
@@ -359,7 +359,7 @@
my $description;
- $debug>2 && print "get_header\n";
+ $debug>2 && print "get_description\n";
$debug>3 && print " file: $file\n";
open PKG, $file || die "Can't read `$file': $!";
@@ -376,13 +376,29 @@
return ($description);
}
+# Get langage
+sub get_langage {
+ my $file = shift;
+
+ $debug>2 && print "get_langage\n";
+ $debug>3 && print " file: $file\n";
+
+ open PKG, "$file" || die "Can't read `$file': $!";
+ 0, until (($_ = <PKG>) =~ /^($comment--)?Description-(..(_..)?): /);
+ close PKG || die "Can't close `$file': $!";
+
+ $debug>4 && print " $2\n";
+
+ return ($2);
+}
+
# Get translation
sub get_translation {
my $file = shift;
my $translation;
- $debug>2 && print "get_header\n";
+ $debug>2 && print "get_translation\n";
$debug>3 && print " file: $file\n";
open PKG, "$file" || die "Can't read `$file': $!";
@@ -644,8 +660,8 @@
."Description: $description";
if ((defined $db_translation) && ($translation ne $db_translation)) {
my @diff = split("\n", &superdiff("Description-$langage\: $db_translation", "Description-$langage\: $translation"));
- @diff = map (s/^$comment\+//, @diff); # remove comments of parts
- @diff = map (s/^$comment-/$comment /, @diff); # change comments of old translation
+ @diff = map { /^$comment\+/?$_=$':$_ } @diff; # remove comments of parts
+ @diff = map { /^$comment-/?$_="$comment $'":$_ } @diff; # change comments of old translation
print PKG join("\n", @diff)."\n";
} else {
print PKG "Description-$langage\: $translation";
@@ -1020,6 +1036,7 @@
}
my $header = &get_header("$tr_dir/$file.$tr_e");
+ my $language = &get_langage("$tr_dir/$file.$tr_e");
my $boundary = "----------=_".scalar(time)."-$$-".$BCount++;
my @bugs = &get_btsclose($header);
my @messages = &get_references($header);
@@ -1028,7 +1045,7 @@
print SENDMAIL "From: $mail_addr\n"
."To: ".($debug==9?"$mail_addr":$mail_ddts)."\n";
print SENDMAIL "Cc: $mail_addr\n" if ($mail_self eq "yes");
- print SENDMAIL "Subject: nothing fr $file\n"
+ print SENDMAIL "Subject: nothing $language $file\n"
."In-Reply-To: ".$messages[0]."\n"
."References: ".join(" ", @messages)."\n"
."Mime-Version: 1.0\n"
@@ -1041,8 +1058,10 @@
."Content-Transfer-Encoding: $mail_enc\n"
."Content-Disposition: attachment; filename=\"$file\"\n\n";
print SENDMAIL join("\n", @bugs)."\n" unless (@bugs == 0);
- print SENDMAIL &get_all("$tr_dir/$file.$tr_e")
- ."\n\n"
+ print SENDMAIL $header
+ ."Description: ".&get_description("$tr_dir/$file.$tr_e")
+ ."Description-$language\: ".&uncomment(&get_translation("$tr_dir/$file.$tr_e"), "# |$comment")
+ ."\n"
."--$boundary--\n\n";
close SENDMAIL || die "Can't run sendmail: $!";
@@ -1069,6 +1088,7 @@
}
my $header = &get_header("$rev_dir/$file");
+ my $language = &get_langage("$tr_dir/$file.$tr_e");
my $boundary = "----------=_".scalar(time)."-$$-".$BCount++;
my @messages = &get_references($header);
@@ -1076,7 +1096,7 @@
print SENDMAIL "From: $mail_addr\n"
."To: ".($debug==9?"$mail_addr":$mail_ddts)."\n";
print SENDMAIL "Cc: $mail_addr\n" if ($mail_self eq "yes");
- print SENDMAIL "Subject: nothing fr $file\n"
+ print SENDMAIL "Subject: nothing $language $file\n"
."In-Reply-To: ".$messages[0]."\n"
."Mime-Version: 1.0\n"
."Content-Type: multipart/mixed; boundary=\"$boundary\"\n"
Reply to: