ddts-script v. 0.1.3

[Nicolas Bertolissio <nico.bertol@wanadoo.fr>]

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"