A radically new version: it can now send mail to translators. Please read the comments at the beginning of the script for more info.

CVS version numbers

check_trans.pl: 1.12 -> 1.13

1 files changed, 316 insertions, 28 deletions

diff --git a/check_trans.pl b/check_trans.pl
index 827b17406d6..5a2964bc51b 100755
--- a/check_trans.pl
+++ b/check_trans.pl
@@ -1,6 +1,7 @@
 #!/usr/bin/perl -w
 
 # This is GPL'ed code, copyright 1998 Paolo Molaro <lupus@debian.org>.
+# Copyright 2000 Martin Quinson <mquinson@ens-lyon.fr>
 
 # Little utility to keep track of translations in the debian CVS repo.
 # Invoke as check_trans.pl [-v] [-d] [-l] [-q] [-s subtree] [language] 
@@ -11,9 +12,45 @@
 
 # Option:
 # 	-v	enable verbose mode
+#       -Q      enable quiet mode
 #	-d	output diff 
 #	-l	output log messages
 #	-q	don't whine about missing files
+#       -p      include only files matching <value>
+#       -s      check only subtree <value>
+
+# Options usefull when sending mails:
+#       -g      debuG
+#       -m      makes mails to translation maintainers
+#               PLEASE READ CARFULLY THE TEXT BELOW ABOUT MAKING MAILS !!
+#               (if -m is given, it must be followed by the default recipient)
+#               (it should be the list used for organisation)
+#               (I sent it to debian-l10n-french@lists.debian.org)
+#       -n      send mails of priority upper or equal to <value> 
+#               (ie, <value> must be 1 (monthly), 2 (weekly) or 3 (daily)
+
+# Making Mails
+#  If you want to, this script send mails to the maintainer of the mails.
+#  BEWARE, SOME PEOPLE DO NOT LIKE TO RECEIVE AUTOMATIC MAILS !!
+#  PREQUESITE:
+#  o To do so, you need two databases: 
+#     - one to see which translator maintains which file
+#       it must be named "./$langto/international/$langto/current_status.pl"
+#         with $langto equal to "french", "italian" or so
+#       Please refer to "webwml/french/international/french/current_status.pl"
+#        to have an example
+#     - one to get info about translators and the frequency at which they want to get
+#       mails. It must be named "webwml/$langto/international/$langto/translator.db.pl"
+#       Please refer to the french one for more info
+#  o You must also have the perl module called "MIME::Lite", which is not yet packaged.
+#      You can download it from your favorite CPAN...
+#  USAGE:
+#   - If you give the "-g" option, all mails are sent to the "default addressee" 
+#     (ie, the one given as value to the -m option), without respect to their
+#      normal addressee. It is usefull if you want to run it for your own,
+#      and for debugging.
+#   - With out it, it sends real mails to real addresses.
+#     BE SURE THE ADDRESSEES REALLY WANT TO GET THESE MAILS
 
 # If you do not specify a language on the command line, it will try to load
 # one from a file called language.conf, if such a file exists. That file
@@ -32,17 +69,43 @@
 
 use Getopt::Std;
 use IO::Handle;
+use strict;
+
+# options
+our $opt_d = 0;
+our $opt_s = '';
+our $opt_p = undef;
+our $opt_l = 0;
+our $opt_g = 0; 
+our $opt_m = '';
+our $opt_n = 5;
+our $opt_v;
+our $opt_q;
+our $opt_Q;
+
+# languages
+my $defaultlanguage;
+my $from;
+my $to;
+my $langto;
+
+# from db
+my $translations_status;
+my $translators;# the ref resulting of require
+my %translators;# the real hash
+
+# misc
+my @en; #english files
+my $showlog; # boolean
+#$maintainer = "debian-www\@lists.debian.org"; #adress of maintainer of this script
+my $maintainer = "mquinson\@ens-lyon.fr"; #adress of maintainer of this script
 
-$opt_d = 0;
-$opt_s = '';
-$opt_p = undef;
-$opt_l = 0;
-getopts('vdqs:p:l');
+getopts('vgdqQm:s:p:ln:');
 
 warn "Checking subtree $opt_s only\n" if $opt_v;
 
 # include only files matching $filename
-$filename = $opt_p || '(\.wml$)|(\.html$)';
+my $filename = $opt_p || '(\.wml$)|(\.html$)';
 
 # get configuration
 if (open CONF, "<language.conf")
@@ -62,6 +125,30 @@ $to = shift || $defaultlanguage;
 # Remove slash from end
 $to =~ s%/$%%;
 
+$langto=$to;
+$langto =~ s,^([^/]*).*$,$1,;
+if (-e "./$langto/international/$langto/current_status.pl" && 
+    -e "./$langto/international/$langto/translator.db.pl") {
+    print "READ PAGES DB: $langto/international/$langto/current_status.pl\n"
+       if $opt_v;
+    push(@INC,"./$langto/international/$langto");
+    require 'current_status.pl';
+    print "READ TRANSLATOR DB: $langto/international/$langto/translator.db.pl\n"
+       if $opt_v;
+    require 'translator.db.pl';
+    %translators=%{init_translators()};
+} else {
+    die "I need my DBs to send mails !\n Please read the comments in the script and try again\n" if $opt_m;
+}
+
+if ($opt_m) {
+    use MIME::Lite;
+    unless ($opt_n =~ m,[123],) {
+	die "Invalid priority. Please set -n value to 1, 2 or 3.\n".
+	    "(assuming you know what you're doing)\n";
+    }
+}
+
 $from = "$from/$opt_s";
 $to = "$to/$opt_s";
 
@@ -69,18 +156,162 @@ $to = "$to/$opt_s";
 
 $showlog = $opt_l;
 
+init_mails();
 foreach (@en) {
 	next if $_ =~ "template/debian";
 	my ($path, $tpath, $d);
 	$path = $_;
-	$path =~ s#CVS/Entries$##;
+	$path =~ s,CVS/Entries$,,;
 	$tpath = $path;
 	$tpath =~ s/^$from/$to/o;
-	$d = load_entries($_);
-	$ignore = load_ignorelist($tpath);
-	foreach $f (keys %$d) {
-		check_file("${tpath}$f", $d->{$f}) unless $$ignore{"${tpath}$f"};
+	my %d = %{load_entries($_)};
+	my $ignore = load_ignorelist($tpath);
+	foreach my $f (keys %{$d{"rev"}}) {
+	    check_file("${tpath}$f", 
+		       $d{"rev"}->{$f},
+		       get_translators_from_db("$tpath$f"))
+		unless $$ignore{"${tpath}$f"};
+	}
+}
+
+send_mails();
+
+sub verify_send {
+    # returns true whether we have to send this part to this guy
+    my $name=shift;
+    my $part=shift;
+    $name =~ s,<.*?>,,;
+    $name =~ s,^ *(.*?) *$,$1,;
+    print "$name is unknown\n" unless defined($translators{$name});
+#    print "pri=$opt_n ; maint_pri=${translators{$name}{$part}}\n";
+    return $opt_m # if we have to send any mail
+	&& defined($translators{$name})  # if this guy is known
+	&& defined($translators{$name}{$part}) # we know something about the wanted frequency
+	&& ($opt_n <= $translators{$name}{$part}); # check if the frequency is ok
+}
+
+
+
+sub get_translators_from_db {
+    my $id=shift;
+    my $res='';
+
+    $id=~ s,^$langto/,,;
+    $id=~ s/\.wml$//;
+    if (defined(%{$$translations_status{$id}})
+	&& defined ($$translations_status{$id}{'translation_maintainer'})) {
+	foreach my $n (sort @{$$translations_status{$id}{'translation_maintainer'}}) {
+	    $res .= " $n";
+	}
+    } else {
+	$res = "";
+    }
+    return $res;
+}
+
+sub init_mails {
+    return unless $opt_m;
+    foreach my $name (keys %translators) {
+	return if defined $translators{$name}{"msg"};
+	$translators{$name}{"msg"} = MIME::Lite->new(
+	   From    => "Script watching translation state <$maintainer>",
+           To      => ($opt_g ? $opt_m : $translators{$name}{"email"}),
+           Subject => ($name eq "list" ?
+	    "Translations for the debian web site unmaintained" :
+	    "Translations for the debian web site maintained by $name"
+            ),
+           Type    => 'multipart/mixed');
+	my $str= "Hello,\n".
+      	      "This is a automatically generated mail sent to you\n".
+	      "because you are the official translator of some pages\n".
+	      "in $langto of the Debian web site.\n".
+	      "\n".
+	      "I send you what I think you want. (ie what is in my DB).\n".
+	      " That is to say:\n";
+	foreach my $n (qw(summary logs diff file)) {
+	    $str.="   ".$n.": ".
+	    ($translators{$name}{$n} != 0 ?
+	     ($translators{$name}{$n} != 1 ?
+	      ($translators{$name}{$n} != 2 ?
+	       ($translators{$name}{$n} != 3 ?
+		"dunno (error in DB !!)":
+		"daily"):
+		"weekly"):
+		"monthly"):
+	     "never")."\n";
 	}
+	if ($name eq "list") {
+	    $str .= "   missing: ".($translators{$name}{"missing"} != 0 ?
+	     ($translators{$name}{"missing"} != 1 ?
+	      ($translators{$name}{"missing"} != 2 ?
+	       ($translators{$name}{"missing"} != 3 ?
+		"dunno (error in DB !!)":
+		"daily"):
+		"weekly"):
+		"monthly"):
+	     "never")."\n";
+	}
+	$str.="   Compression=".$translators{$name}{"compress"}."  (not implemented)\n\n";
+	$str.=" You can ask to change:\n".
+              "  - the frequency of these mails\n".
+	      "    (never, monthly, weekly, daily)\n".
+              "  - the parts you want\n".
+    	      "    - The list of the work to do in a summarized form\n".
+              "    - diff between the version you translated and the current one\n".
+              "    - log between the version you translated and the current one\n".
+              "    - the file you translated (to avoid to download it before to work)\n".
+              "  - your email adress\n".
+	      "  - the compression level (none,gzip or bzip2), even if I'll ignore it\n".
+              "    because this feature is not implemented yet ;)\n".
+	      "\n".
+	      "For more informations, contact your team coordinator, or\n".
+	      "the maintainer of this script ($maintainer).\n".
+	      "\n".
+	      "Thanks, and sorry for the annoyance.\n";
+
+        $translators{$name}{"msg"}->attach(
+           Type => 'TEXT',
+           Data => $str);
+	$translators{$name}{"send"}=0;
+    }
+}
+
+sub send_mails {
+    #Makes the mails and send them
+    return unless $opt_m;
+    foreach my $name (sort keys %translators) {
+	$translators{$name}{"msg"}->attach(
+                     Type     => 'TEXT',
+	             Filename => 'NeedToUpdate_summary',
+		     Data     => $translators{$name}{"part_summary"})
+	    if defined($translators{$name}{"part_summary"});
+	$translators{$name}{"msg"}->attach(
+		     Type     => 'TEXT',
+	             Filename => 'Missing_summary',
+		     Data     => $translators{$name}{"part_missing"})
+	    if defined($translators{$name}{"part_missing"});
+	foreach my $part (qw (file logs diff)) { 
+	    if (defined($translators{$name}{"part_$part"})) {
+		foreach my $file (sort keys %{$translators{$name}{"part_$part"}}) {
+		    $translators{$name}{"msg"}->attach(
+			 Type     => 'TEXT',
+	                 Filename => "$file.$part",
+			 Data     => $translators{$name}{"part_$part"}{$file});
+		}
+	    }
+	}
+	if ($translators{$name}{"send"}) {
+	    print "send mail to $name\n";
+	    if (($name =~ m,mquinson,) || ($opt_g && $opt_m eq $maintainer)) {
+		print "Well, detourned to $maintainer\n";
+		$translators{$name}{"msg"}->send;
+	    }
+#	    $translators{$name}{"msg"}->print_header;
+	    $translators{$name}{"msg"}->send;
+	} else {
+	    print "don't send mail to $name : nothing to say to him\n";
+	}   
+    }	
 }
 
 sub load_entries {
@@ -89,10 +320,10 @@ sub load_entries {
 	warn "Loading $name\n" if ($opt_v && !$opt_q);
 	open(F, $name) || die $!;
 	while(<F>) {
-		next unless m#^/#;
-		if ( m#^/([^/]+)/([^/]+)/# ) {
+		next unless m,^/,;
+		if ( m,^/([^/]+)/([^/]+)/, ) {
 			my($name, $rev) =($1, $2);
-			$data{$name} = $rev if $name =~ /$filename/o;
+			$data{"rev"}->{$name} = $rev if $name =~ /$filename/o;
 		}
 	}
 	close (F);
@@ -112,12 +343,46 @@ sub load_ignorelist {
 	return \%data;
 }
 
+sub add_part {
+    my $name = shift;
+    my $part = shift;
+    my $txt = shift; 
+    $name =~ s,<.*?>,,;
+    $name =~ s,^ *(.*?) *$,$1,;
+    if (verify_send($name,$part)) {
+	$translators{$name}{"part_$part"}.=$txt;
+	$translators{$name}{"send"}=1;
+    }
+}
+sub add_sub_part {
+    my $name = shift;
+    my $part = shift;
+    my $subpart=shift;
+    my $cmd = shift;
+    $name =~ s,<.*?>,,;
+    $name =~ s,^ *(.*?) *$,$1,;
+#    print "add_sub_part($name)(part=$part)($subpart):";
+    if (verify_send($name,$part)) {
+#	print "YES\n";
+	$translators{$name}{"part_$part"}{$subpart}.=`$cmd`;
+	$translators{$name}{"send"}=1;
+#	return;
+    }
+#    print "no\n";
+}
+	
+
+
 sub check_file {
-	my ($name, $revision) = @_;
+	my ($name, $revision, $translator) = @_;
 	my ($oldr, $oldname);
-	warn "Checking $name\n" if $opt_v;
+	warn "Checking $name english revision $revision\n" if $opt_v;
 	unless (-r $name) {
-		print "Missing $name\n" unless $opt_q;
+	        unless ($opt_q) {
+  		     print "Missing $name version $revision\n"
+		        unless $opt_Q;
+		     add_part("list","missing","Missing $name version $revision\n");
+		}
 		return;
 	}
 	open(F, $name) || die $!;
@@ -125,25 +390,48 @@ sub check_file {
 		if (/translation(\s+|=")([.0-9]*)("|\s*-->)/oi) {
 			warn "Found revision $2\n" if $opt_v;
 			$oldr = $2;
-			if ($oldr eq $revision) {
-				close(F);
-				return;
-			}
-			last;
+		}
+		if (/wml::debian::translation-check.*?maintainer(\s+|=")(.*)("|\s*-->)/oi) {
+		    warn "Translated by $2\n" if $opt_v;
+		    $translator=$2 if ($translator eq "");
+		}
+		if (/Translat(.*?): (.*)$/i) {
+		    warn "Translated by $2\n" if $opt_v;
+		    $translator=$2 if ($translator eq "");
 		}
 	}
 	close(F);
+	return if (defined($oldr) && ($oldr eq $revision));
+
+        $translator =~ s/^\s*(.*?)\s*/$1/;
+
+	$oldr ||= '1.1';
+	my $str  = "NeedToUpdate $name from version $oldr to version $revision";
+	$str .= " (maintainer: $translator)" if $translator;
+	$str .= "\n";
+	print $str unless $opt_Q;
+	$oldname = $name;
+	$oldname =~ s/^$to/$from/;
+	if ($opt_m) {
+	    $translator = "list" if ($translator eq "");
+	    add_part($translator,"summary",$str);
+	    add_sub_part($translator,"diff",$name,
+			 "cvs -z3 diff -u -r'$oldr' -r '$revision' '$oldname'");
+	    add_sub_part($translator,"logs",$name,
+			 "cvs -z3 log -r'$oldr:$revision' '$oldname'");
+	    add_sub_part($translator,"file",$name,
+			 "cat $name");
+	}
+	    
 	if ($opt_d) {
-		$oldr ||= '1.1';
-		$oldname = $name;
-		$oldname =~ s/^$to/$from/;
 		STDOUT->flush;
 		system("cvs -z3 log -r'$oldr:$revision' '$oldname'") if $showlog;
 		STDOUT->flush if $showlog;
 		system("cvs -z3 diff -u -r '$oldr' -r '$revision' '$oldname'");
 		STDOUT->flush;
-	} else {
-		print "NeedToUpdate $name to version $revision\n";
-	}
+	} 
 }
 
+
+
+