Update these scripts to use modules found under Perl/

CVS version numbers

check_trans.pl: 1.35 -> 1.36 
stattrans.pl: 1.23 -> 1.24 
touch_translations.pl: 1.8 -> 1.9

3 files changed, 156 insertions, 262 deletions

diff --git a/check_trans.pl b/check_trans.pl
index 3b61813ed26..bf785845a91 100755
--- a/check_trans.pl
+++ b/check_trans.pl
@@ -76,6 +76,12 @@ use Getopt::Std;
 use IO::Handle;
 use Date::Parse;
 
+#    These modules reside under webwml/Perl
+use lib ($0 =~ m|(.*)/|, $1 or ".") ."/Perl";
+use Local::Cvsinfo;
+use Webwml::TransCheck;
+use Webwml::TransIgnore;
+
 # TODO:
 # get the revisions from $lang/intl/$lang so diffing works
 # need to quote dirnames?
@@ -88,13 +94,6 @@ my %translators;# the real hash
 
 # misc hardcoded things
 my $maintainer = "mquinson\@ens-lyon.fr"; # the default e-mail at which to bitch :-)
-my $ignorables = " "
-		."/sitemap.wml "
-		."/MailingLists/subscribe.wml "
-		."/MailingLists/unsubscribe.wml "
-		."/international/l10n/data/countries.wml "
-		."/international/l10n/scripts/l10nheader.wml "
-		; # $ignorables must begin and end with a space!
 
 # options (note: with perl 5.6, this could change to our())
 use vars qw($opt_C $opt_M $opt_Q $opt_d $opt_g $opt_l $opt_m $opt_n $opt_p $opt_q $opt_s $opt_t $opt_v);
@@ -122,7 +121,20 @@ die "you can't have both verbose and quiet, doh!\n" if (($opt_v) && ($opt_Q));
 warn "Checking subtree $opt_s only\n" if (($opt_v) && ($opt_s));
 
 # include only files matching $filename
-my $filename = $opt_p || '(\.wml$)|(\.html$)';
+my $filename = $opt_p || '\.(w|ht)ml$';
+
+my $cvs = Local::Cvsinfo->new();
+$cvs->options(
+	recursive => 1,
+	matchfile => [ $filename ],
+	skipdir   => [ "template" ],
+);
+#   This object is used to retrieve information when original is
+#   not English
+my $altcvs = $cvs->new();
+
+#   Global .transignore
+my $globtrans = Webwml::TransIgnore->new(".");
 
 # Go to desired directory
 chdir($opt_C) || die "Cannot go to $opt_C\n";
@@ -172,22 +184,28 @@ init_mails();
 
 print "\$translations = {\n" if $opt_t eq 'perl';
 
-foreach (split(/\n/, `find $from -name Entries -print`)) {
-	next if $_ =~ "template/debian"; # hardcoded
+$cvs->readinfo($from);
+foreach my $path (@{$cvs->dirs()}) {
+	my $tpath = $path;
+	$tpath =~ s/^$from/$to/o;
+	my $transignore = Webwml::TransIgnore->new($tpath);
+	next unless $transignore->found();
+	warn "Loading $tpath/.transignore\n" if $opt_v;
+	foreach (@{$transignore->local()}) {
+		s/^$to/$from/o;
+		$cvs->removefile($_);
+	}
+}
+
+foreach (sort @{$cvs->files()}) {
 	my ($path, $tpath);
 	$path = $_;
-	$path =~ s,CVS/Entries$,,;
 	$tpath = $path;
 	$tpath =~ s/^$from/$to/o;
-	my $d = load_entries($_);
-	my $ignore = load_ignorelist($tpath);
-	foreach my $f (keys %$d) {
-	    check_file("${tpath}$f", 
-		       $d->{$f}->{'rev'},
-		       $d->{$f}->{'mtime'},
-		       get_translators_from_db("$tpath$f"))
-		unless $$ignore{"${tpath}$f"};
-	}
+	check_file($tpath, 
+		       $cvs->revision($path),
+		       str2time($cvs->date($path)),
+		       get_translators_from_db($tpath));
 }
 
 print "}; 1;\n" if $opt_t eq 'perl';
@@ -345,40 +363,6 @@ sub send_mails {
     }	
 }
 
-sub load_entries {
-	my ($list) = shift;
-	my $data = {};
-	my ($name, $rev, $date);
-	warn "Loading $list\n" if $opt_v;
-	open(F, $list) || die $!;
-	while(<F>) {
-		next unless m,^/,;
-		if (($name, $rev, $date) = (m,^/([^/]+)/([^/]+)/([^/]+)/,)) {
-			if ($name =~ /$filename/o) {
-				$data->{$name} = {
-				    rev     => $rev,
-				    mtime   => str2time($date),
-				};
-			}
-		}
-	}
-	close (F);
-	return $data;
-}
-
-sub load_ignorelist {
-	my ($dir) = shift;
-	my (%data);
-	open(F, "${dir}.transignore") || return \%data;
-	warn "Loading ${dir}.transignore\n" if $opt_v;
-	while(<F>) {
-		chomp;
-		$data{"$dir$_"} = 1;
-	}
-	close (F);
-	return \%data;
-}
-
 sub add_part {
     my $name = shift;
     my $part = shift;
@@ -418,8 +402,8 @@ sub check_file {
         $docname =~ s#^$langto/##;
         $docname =~ s#\.wml$##;
 	unless (-r $name) {
-		(my $iname = $name) =~ s/$to//;
-		if (index($ignorables, " $iname ") < 0) {
+		(my $iname = $name) =~ s/^$to\///;
+		if ($globtrans->is_global($iname)) {
 		  unless (($opt_q) || ($opt_Q)) {
                      if ($opt_t eq 'perl') {
   	               print "'$docname' => {\n\t'type' => 'Web',\n";
@@ -437,57 +421,30 @@ sub check_file {
 		}
 		return;
 	}
-	open(F, $name) || die $!;
-	while(<F>) {
-		if (/wml::debian::translation-check/) {
-			if (/translation="([^"]+)"/) {
-				$oldr = $1;
-				warn "Found translation for $oldr\n" if $opt_v;
-			}
-			if (/maintainer="([^"]+)"/) {
-				$translator = $1;
-				warn "Translated by $translator\n" if $opt_v;
-			}
-			if (/original="([^"]+)"/) {
-				$original = $1;
-				warn "Original is $original\n" if $opt_v;
-			}
-			last;
-		}
-		# the following old style cases should be removed eventually
-		if (/translation\s+([.0-9]*)\s*-->/i) {
-			$oldr = $1;
-			warn "Found translation for $oldr\n" if $opt_v;
-		}
-		if (/Translat(.*?): (.*)$/i) {
-		    $translator=$2 if ($translator eq "");
-		    warn "Translated by $translator\n" if $opt_v;
-		}
-		last if (($oldr) && ($translator));
-	}
-	close(F);
-
-	if ((!$oldr) && ($name =~ /$langto\/international\/$langto/i)) {
-	    (my $ename = $name) =~ s/$to/$from/;
-	    open FE, $ename || die $!;
-	    while (<FE>) {
-		if (/wml::debian::translation-check/) {
-		    if (/translation="([^"]+)"/) {
-			$oldr = $1;
-			warn "Found translation for $1\n" if $opt_v;
-		    }
-		    if (/original="([^"]+)"/) {
-			$original = $1;
-			warn "Original is $1\n" if $opt_v;
-		    }
-		    last;
-		}
-	    }
-	    close FE;
+	my $transcheck = Webwml::TransCheck->new($name);
+	$oldr       = $transcheck->revision();
+	$translator = $transcheck->maintainer() || "";
+	$original   = $transcheck->original();
+	warn "Found translation for $oldr\n" if $opt_v and $oldr;
+	warn "Translated by $translator\n"   if $opt_v and $translator;
+	warn "Original is $original\n"       if $opt_v and $original;
+	#  The following test was in check_trans.pl and has been
+	#  removed, I do not understand what it was intended for
+	#  if ((!$oldr) && ($name =~ /$langto\/international\/$langto/i))
+	if ($original) {
+		my ($fromname, $fromdir);
+		$fromname = $name;
+		$fromname =~ s{^[^/]+}{$original};
+		$fromdir  = $fromname;
+		$fromdir  =~ s{/+[^/]+$}{};
+		$altcvs->reset();
+		$altcvs->readinfo($fromdir, matchfile => [$fromname]);
+		$revision = $altcvs->revision($fromname);
+		warn "Original is $original, revision $revision\n" if $opt_v;
 	}
 
-        $translator =~ s/^\s+//;
-        $translator =~ s/\s+$//;
+	$translator =~ s/^\s+//;
+	$translator =~ s/\s+$//;
 
 	my $str;
 	my $status = 8;
diff --git a/stattrans.pl b/stattrans.pl
index 0c521ce3206..0566a7339d4 100755
--- a/stattrans.pl
+++ b/stattrans.pl
@@ -19,6 +19,14 @@
 
 use POSIX qw(strftime);
 use Getopt::Std;
+
+#    These modules reside under webwml/Perl
+use lib ($0 =~ m|(.*)/|, $1 or ".") ."/Perl";
+use Local::Cvsinfo;
+use Webwml::Langs;
+use Webwml::TransCheck;
+use Webwml::TransIgnore;
+
 $| = 1;
 
 $opt_h = "/org/www.debian.org/debian.org/devel/website/stats";
@@ -29,6 +37,11 @@ $opt_v = 0;
 $opt_d = "u";
 $opt_l = undef;
 getopts('h:w:p:t:vd:l:');
+#  Replace filename globbing by Perl regexps
+$opt_p =~ s/\,/\\./g;
+$opt_p =~ s/\?/./g;
+$opt_p =~ s/\*/.*/g;
+$opt_p =~ s/$/\$/g;
 %config = (
 	   'htmldir' => $opt_h,
 	   'wmldir'  => $opt_w,
@@ -38,37 +51,32 @@ getopts('h:w:p:t:vd:l:');
 	   'diff'    => $opt_d,
 	   );
 
-$max_versions = 5;
-$min_versions = 1;
+my $l = Webwml::Langs->new($opt_w);
+my %langs = $l->name_iso();
+
+my $transignore = Webwml::TransIgnore->new($opt_w);
+
+my $cvs = Local::Cvsinfo->new();
+$cvs->options(
+        recursive => 1,
+        matchfile => [ $config{'wmlpat'} ],
+        skipdir   => [ "template" ],
+);
+$cvs->readinfo("$config{'wmldir'}/english");
+foreach (@{$transignore->global()}) {
+        $cvs->removefile("$config{'wmldir'}/english/$_");
+}
 
-# from english/template/debian/languages.wml
-# TODO: Needs to be synced frequently or fixed so it's automatic
-my %langs = ( english    => "en",
-#             arabic     => "ar",
-              catalan    => "ca",
-              danish     => "da",
-              german     => "de",
-              greek      => "el",
-              esperanto  => "eo",
-              spanish    => "es",
-              finnish    => "fi",
-              french     => "fr",
-              croatian   => "hr",
-              hungarian  => "hu",
-              italian    => "it",
-              japanese   => "ja",
-              korean     => "ko",
-              dutch      => "nl",
-              norwegian  => "no",
-              polish     => "pl",
-              portuguese => "pt",
-              romanian   => "ro",
-              russian    => "ru",
-              swedish    => "sv",
-              turkish    => "tr",
-              chinese    => "zh",
+my $altcvs = Local::Cvsinfo->new();
+$altcvs->options(
+        recursive => 1,
+        matchfile => [ $config{'wmlpat'} ],
+        skipdir   => [ "template" ],
 );
 
+$max_versions = 5;
+$min_versions = 1;
+
 $border_head = "<table width=95% align=center border=0 cellpadding=0 cellspacing=0><tr bgcolor=#000000><td>"
               ."<table width=100% border=0 cellpadding=0 cellspacing=1><tr bgcolor=#ffffff><td>";
 $border_foot = "</td></tr></table></td></tr></table>";
@@ -76,49 +84,7 @@ $border_foot = "</td></tr></table></td></tr></table>";
 
 $date = strftime "%a %b %e %H:%M:%S %Y %z", localtime;
 
-sub get_cvs_version
-{
-    my ($dir, $wmlfile) = @_;
-    my $file;
-    my @comp;
-    my $version;
-
-    @comp = split (/\//, "$dir/$wmlfile");
-    pop @comp;
-    $dir = join ("/", @comp);
-
-    @comp = split (/\//, "$wmlfile");
-    $file = pop @comp;
-
-    if (open (CVS,"$dir/CVS/Entries")) {
-	while (<CVS>) {
-	    ($version) = $_ =~ m,/\Q$file\E/([\d\.]*),;
-	    last if $version;
-	}
-    }
-
-    return $version;
-}
-
-sub get_translation_version
-{
-    my ($dir, $file) = @_;
-    my $checktrans;
-
-    if (open (F, "$dir/$file")) {
-	$checktrans = 0;
-	while (<F>) {
-	    chomp;
-	    if (/^\#use wml::debian::translation-check/) {
-		$checktrans = 1;
-		return $1 if ($_ =~ /translation="([^\" ]+)"/);
-		last;
-	    }
-	}
-	close (F);
-    }
-    return "";
-}
+my %original;
 
 # Count wml files in given directory
 #
@@ -126,30 +92,43 @@ sub getwmlfiles
 {
     my $lang = shift;
     my $dir = "$config{'wmldir'}/$lang";
-    my $cmd = "find $dir -name \"$config{'wmlpat'}\"";
     my $cutfrom = length ($config{'wmldir'})+length($lang)+2;
     my $count = 0;
     my $is_english = ($lang eq "english")?1:0;
     my $file, $v;
+    my @listfiles;
 
     print "$lang " if ($config{verbose});
     die "$0: can't find $dir!\n" if (! -d "$dir");
-    open (FIND, "$cmd|") || die "Can't read from $cmd";
-    while (<FIND>) {
- 	# XXX this list of exceptions needs to be maintained XXX
-	next if (/\/sitemap\.wml/);
-	next if (/\/template\//);
-	next if (/\/MailingLists\/(un)?subscribe\.wml/);
-	next if (/\/international\/l10n\/scripts\/l10nheader\.wml/);
-	chomp;
-	$file = substr ($_, $cutfrom);
+    if ($is_english) {
+        @listfiles = @{$cvs->files()};
+    } else {
+        $altcvs->reset();
+        $altcvs->readinfo($dir);
+        @listfiles = @{$altcvs->files()};
+    }
+    foreach my $f (@listfiles) {
+	$file = substr ($f, $cutfrom);
+	next if $transignore->is_global($file);
 	$file =~ s/\.wml$//;
 	$wmlfiles{$lang} .= " " . $file;
+	my $transcheck = Webwml::TransCheck->new("$dir/$file.wml");
 	if ($is_english) {
-	    $version{"$lang/$file"} = get_cvs_version ($dir, "$file.wml");
+	    if ($original{$file}) {
+	        $version{"$lang/$file"} = $transcheck->revision();
+	    } else {
+	        $version{"$lang/$file"} = $cvs->revision($f);
+	    }
 	} else {
-	    $version{"$lang/$file"} = get_translation_version ($dir, "$file.wml");
+	    if ($transcheck->revision()) {
+	        $version{"$lang/$file"} = $transcheck->revision();
+	        $original{$file} ||= $transcheck->original();
+	    } else {
+	        $version{"$lang/$file"} = $altcvs->revision($f);
+                $original{$file} = $lang;
+            }
 	}
+	$version{"$lang/$file"} ||= "1.1";
 	$count++;
     }
     close (FIND);
@@ -206,14 +185,14 @@ sub check_translation
 
 print "Collecting data in: " if ($config{'verbose'});
 if ($opt_l) {
-  getwmlfiles ('english');
   getwmlfiles ($opt_l);
-} else {
   getwmlfiles ('english');
+} else {
   foreach $lang (keys %langs) {
     next if ($lang eq "english");
     getwmlfiles ($lang);
   }
+  getwmlfiles ('english');
 }
 print "\n" if ($config{'verbose'});
 
@@ -223,10 +202,9 @@ mkdir ($config{'htmldir'}, 02775) if (! -d $config{'htmldir'});
 @sorted_english = sort (split (/ /, $wmlfiles{'english'}));
 
 print "Creating files: " if ($config{'verbose'});
-my @search_in = ();
+my @search_in;
 if ($opt_l) {
-  push @search_in, 'english';
-  push @search_in, $opt_l;
+  @search_in = ( 'english', $opt_l );
 } else {
   @search_in = sort keys %langs;
 }
@@ -238,7 +216,7 @@ foreach $lang (@search_in) {
     $t_body = $u_body = $o_body = "";
 
     foreach $file (@sorted_english) {
-        next if ($file eq "");
+	next if ($file eq "");
 	# Translated pages
 	if (index ($wmlfiles{$lang}, " $file ") >= 0) {
 		if ($file eq "devel/wnpp/wnpp") {
@@ -246,10 +224,10 @@ foreach $lang (@search_in) {
 		} else {
 		    	$t_body .= sprintf "<a href=\"/%s.%s.html\">%s</a><br>\n", $file, $l, $file;
 		}
-    		$translated{$lang}++;
-		next if ($lang eq "english");
+		$translated{$lang}++;
+		$orig = $original{$file} || "english";
 		# Outdated translations
-		$msg = check_translation ($version{"$lang/$file"}, $version{"english/$file"}, "$lang/$file");
+		$msg = check_translation ($version{"$lang/$file"}, $version{"$orig/$file"}, "$lang/$file");
 		if (length ($msg)) {
 			$o_body .= "<tr>";
 			if ($file eq "devel/wnpp/wnpp") {
@@ -258,9 +236,9 @@ foreach $lang (@search_in) {
 				$o_body .= sprintf "<td><a href=\"/%s.%s.html\">%s</a></td>", $file, $l, $file;
 			}
 			$o_body .= sprintf "<td>%s</td>", $version{"$lang/$file"};
-			$o_body .= sprintf "<td>%s</td>", $version{"english/$file"};
+			$o_body .= sprintf "<td>%s</td>", $version{"$orig/$file"};
 			$o_body .= sprintf "<td>%s</td>", $msg;
-			$o_body .= sprintf "<td>&nbsp;&nbsp;<a href=\"http://cvs.debian.org/webwml/english/%s.wml.diff\?r1=%s\&r2=%s\&cvsroot=webwml\&diff_format=%s\">%s -> %s</a></td>", $file, $version{"$lang/$file"}, $version{"english/$file"}, $config{'diff_type'}, $version{"$lang/$file"}, $version{"english/$file"};
+			$o_body .= sprintf "<td>&nbsp;&nbsp;<a href=\"http://cvs.debian.org/webwml/$orig/%s.wml.diff\?r1=%s\&r2=%s\&cvsroot=webwml\&diff_format=%s\">%s -> %s</a></td>", $file, $version{"$lang/$file"}, $version{"$orig/$file"}, $config{'diff_type'}, $version{"$lang/$file"}, $version{"$orig/$file"};
 			$o_body .= "</tr>\n";
     			$outdated{$lang}++;
 		}
diff --git a/touch_translations.pl b/touch_translations.pl
index 6519075f093..125bcfc692f 100755
--- a/touch_translations.pl
+++ b/touch_translations.pl
@@ -20,37 +20,11 @@
 #	- compare both major and minor revision number
 #	- think of a better way to check when the file has been rebuilt last
 
-
-# This should contain all languages
-%langs = (
-#	"ar" => "arabic",
-	"ca" => "catalan",
-	"zh" => "chinese",
-	"hr" => "croatian",
-	"cs" => "czech",
-	"da" => "danish",
-	"nl" => "dutch",
-	"en" => "english",
-	"eo" => "esperanto",
-	"fi" => "finnish",
-	"fr" => "french",
-	"de" => "german",
-	"el" => "greek",
-	"hu" => "hungarian",
-	"it" => "italian",
-	"ja" => "japanese",
-	"ko" => "korean",
-	"no" => "norwegian",
-	"pl" => "polish",
-	"pt" => "portuguese",
-	"ro" => "romanian",
-	"ru" => "russian",
-	"sk" => "slovak",
-	"es" => "spanish",
-	"sv" => "swedish",
-	"tr" => "turkish");
-
-@langs = values(%langs);
+#    These modules reside under webwml/Perl
+use lib ($0 =~ m|(.*)/|, $1 or ".") ."/Perl";
+use Local::Cvsinfo;
+use Webwml::Langs;
+use Webwml::TransCheck;
 
 # Set this to 1 for debugging
 $debug = 0;
@@ -98,24 +72,22 @@ sub when_forced {
     }
 }
 
+#   We call constructor without argument.  It means there must be a
+#   CVS/Repository file or program will abort.
+my $l = Webwml::Langs->new();
+my %langs = $l->iso_name();
+my @langs = $l->names();
+
 $argfile = $ARGV[0] or die "Invalid number of arguments";
 die "Invalid number of arguments" unless $ARGV[1];
 $arglang = $langs{$ARGV[1]} or die "Invalid lang argument: $ARGV[1]";
-$argfile =~ m+(.*)/(.*)\.wml+ or die "pattern does not match";
+$argfile =~ m+(.*)/(.*\.wml)+ or die "pattern does not match";
 my ($path, $file) = ($1, $2);
 
-# Get the revision of the original file
-my $origrev;
-if (open FILE, "${path}/CVS/Entries") {
-  while (<FILE>) {
-    if (m,^/$file.wml/([^/]+)/,) {
-        $origrev = $1;
-        last;
-    }
-  }
-} else {
-    $origrev = "1.0";
-}
+my $cvs = Local::Cvsinfo->new();
+$cvs->options(matchfile => [ $file ]);
+$cvs->readinfo($path);
+my $origrev = $cvs->revision($argfile) || "1.0";
 
 foreach $lang (@langs) {
     next if ($lang eq $arglang);
@@ -126,25 +98,12 @@ foreach $lang (@langs) {
     $transfile =~ s+$arglang+$lang+ or die "wrong argument: pattern does not match file: $transfile";
 
     # Parse the translated file
-    open FILE, "$transfile" or next;
-    while (<FILE>) { 
-        if (/translation-check translation="([.0-9]*)"\s*(.*)/oi) {
-            $langrev = $1;
-            my $stuff = $2;
-            if ($stuff =~ /original="([^"]+)"/) {
-                $original = $1;
-            }
-            if ($stuff =~ /maxdelta="([^"]+)"/) {
-                $maxdelta = $1;
-            }
-            if ($stuff =~ /mindelta="([^"]+)"/) {
-                $mindelta = $1;
-            }
-            last;
-        }
-    }
-    close FILE;
-    next if not defined $langrev;
+    my $transcheck = Webwml::TransCheck->new($transfile);
+    next unless $transcheck->revision();
+    $langrev  = $transcheck->revision();
+    $original = $transcheck->original();
+    $maxdelta = $transcheck->maxdelta() if $transcheck->maxdelta();
+    $mindelta = $transcheck->mindelta() if $transcheck->mindelta();
     # TODO - would cause unspecified results if 1. changed to 2.
     $origrev =~ s/1\.//;
     $langrev =~ s/1\.//;