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"

Répondre à