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"