From 2b90b17e375c4cbfb5c2061a6b703baab391fb81 Mon Sep 17 00:00:00 2001 From: Bas Zoetekouw Date: Thu, 18 Sep 2008 16:21:31 +0000 Subject: Rewrite of the check_desc_trans.pl script: abstract all VCS functionality into VCS_CVS.pm and clean up the script. CVS version numbers check_desc_trans.pl: 1.3 -> 1.4 --- check_desc_trans.pl | 319 +++++++++++++++++++++++++++++++++++----------------- 1 file changed, 213 insertions(+), 106 deletions(-) (limited to 'check_desc_trans.pl') diff --git a/check_desc_trans.pl b/check_desc_trans.pl index 65cf382da62..d869bda4227 100755 --- a/check_desc_trans.pl +++ b/check_desc_trans.pl @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # Check translation status for mailing list descriptions. Since these files # aren't WML files, the translation data is stored in a separate file in @@ -15,125 +15,232 @@ # are missing, which files are outdated, and if there are files translating # files that are no longer in the English directory. # -# There are no command line parameters. - -# Originally written 2002-10-05 by Peter Krefting -# © Copyright 2002-2008 Software in the public interest, Inc. -# This program is released under the GNU General Public License, v2. +# The language to check can be specified on the command line, in +# language.conf, or in the DWWW_LANG environment variable. +# +# Originally written 2002-10-05 by Peter Karlsson +# © Copyright 2002-2007 Software in the public interest, Inc. +# Complete rewrite 2008 by Bas Zoetekouw +# © Copyright 2008 by Bas Zoetekouw +# +# This program is free software; you can redistribute it and/or modify it +# under the terms of version 2 of the GNU General Public License as published +# by the Free Software Foundation. +# # $Id$ -# Get configuration -if (exists $ENV{DWWW_LANG}) +use FindBin; +use lib "$FindBin::Bin/Perl"; + +use File::Basename; +use File::Spec::Functions; +use File::Find::Rule; +use List::MoreUtils qw{ uniq }; +use Term::ANSIColor; + +use Local::VCS_CVS ':all'; + +use strict; +use warnings; + +# Get language configuration +my $language; +if ( $ARGV[0] ) +{ + $language = $ARGV[0]; +} +elsif (exists $ENV{DWWW_LANG}) { $language = $ENV{DWWW_LANG}; } -elsif (open CONF, ") + while ( my $line = <$conf> ) { - next if /^#/; - chomp; - $language = $_, next unless defined $language; + next if $line =~ /^#/; + chomp $line ; + $language = $line; + last; } + + close $conf; } die "Language not defined in DWWW_LANG or language.conf\n" unless defined $language; +die "Language `$language' doesn't exist\n" + unless -d $language; # Counters -$old = 0; -$uptodate = 0; -$unknown = 0; -$needtranslation = 0; - -# Start-up -$directory = 'MailingLists/desc'; -&process($directory); - -# Results -print $needtranslation, " need to be translated.\n" if $needtranslation; -print $old, " need to be updated.\n" if $old; -print $uptodate, " are up to date.\n" if $uptodate; -print $unknown, " are orphaned.\n" if $unknown; - -sub process +my $old = 0; +my $uptodate = 0; +my $unknown = 0; +my $needtranslation = 0; + +# directories +my $directory = catdir( 'MailingLists' , 'desc' ); +my $srcdir = catdir( 'english', $directory ); +my $destdir = catdir( $language, $directory ); + +# read svn info about files in source dir +my %revision_info = vcs_path_info( $srcdir, 'recursive' => 1 ); + +# read the translation-check files in dest dir +my %transcheck = read_transcheck( $destdir ); + +# check all files +my ($nr_uptodate,$nr_old,$nr_needtrans,$nr_obsolete,$nr_error) = + check_all( $language, $directory, \%transcheck, \%revision_info ); + +# print results +print "\nResults:\n"; +printf " %3i are up to date.\n", $nr_uptodate; +printf " %3i need to be updated.\n", $nr_old; +printf " %3i need to be translated.\n", $nr_needtrans; +printf " %3i are obsolete.\n", $nr_obsolete; +printf " %3i are broken.\n", $nr_error; + +exit 0; + + +#============================================================ + + +# read in all transcheck files under the specified directory +sub read_transcheck +{ + my $dir = shift or die("No directory specified"); + + # get a listof all translation-check files + my @files = File::Find::Rule->file()->name('translation-check')->in($dir); + + my %info; + foreach my $file (@files) + { + my $thisdir = dirname $file; + + # TODO: use a nice File::Spec function for this + $thisdir =~ s{^$dir/*}{} ; + + open( my $fd, '<', $file ) or die("Can't open `$file': $!\n"); + while ( my $line = <$fd> ) + { + chomp $line; + + # skip comments and empty lines + next if $line =~ m{^#}; + next if $line =~ m{^\s+$}; + + # read the file name and the revision from the file + my ($listfile,$revision) = split( /\s+/, $line, 2 ); + warn "Couldn't parse line $. of $file\n" unless $revision; + + # prepend the directory name, if needed + my $thefile = $thisdir ? catfile( $thisdir, $listfile ) : $listfile; + + # save the data + $info{ $thefile } = $revision; + } + close( $fd ); + } + + return %info; + +} + + +# check all translations +sub check_all { - my $curdir = shift; - my $source = 'english/' . $curdir; - my $destination = $language . '/' . $curdir; - - my %sourcefile; - my @subdirs; - - print "Checking $curdir\n"; - - # Read the Entries file for the source directory - open CVS, $source . '/CVS/Entries' - or die "Cannot read $source/CVS/Entries: $!\n"; - - while () - { - next if /README/; - if (m[^/([^/]+)/([0-9\.]+)/]) - { - $sourcefile{$1} = $2; - } - elsif (m[^D/([^/]+)/]) - { - push @subdirs, $1; - } - } - close CVS; - - # Read the translation-check file for the destination directory - if (open CHECK, $destination . '/translation-check') - { - # Get data for the entries and compare - while () - { - if (/^([^\s]+)\s*([0-9\.]+)$/) - { - print "Ghost entry $destination/$1\n" - unless -f "$destination/$1"; - if (defined $sourcefile{$1}) - { - my ($file, $oldrev, $newrev) = ($1, $2, $sourcefile{$1}); - if ($oldrev ne $newrev) - { - $old ++; - print "Need to update $destination/$file from ", - $oldrev, " to ", $newrev, "\n"; - } - else - { - $uptodate ++; - } - delete $sourcefile{$1}; - } - else - { - print "Unknown translated file: $destination/$1\n"; - $unknown ++; - } - } - } - foreach $untranslated (keys %sourcefile) - { - print "Untranslated file: $destination/$untranslated ", - $sourcefile{$untranslated}, "\n"; - $needtranslation ++; - } - } - else - { - warn "Cannot read $destination/translation-check: $!\nDirectory skipped\n"; - } - - - # Process subdirs - foreach $subdir (@subdirs) - { - &process($curdir . '/' . $subdir); - } + my $lang = shift or die("No language specified"); + my $dir = shift or die("No directory specified"); + my $files = shift or die("No transcheck files specified"); + my $revinfo = shift or die("No revision info specified"); + + die("Language `$lang' doesn't exists\n") unless -d $lang; + + my $source = catdir( 'english', $dir ); + my $destination = catdir( $lang, $dir ); + + # create a list of all files (note that the filenames are relative to the + # english and translated mailinglist directories) + my @allfiles = sort {$a cmp $b} uniq( keys %$files, keys %$revinfo ); + + # counters + my ($nr_uptodate,$nr_old,$nr_obsolete,$nr_needtrans,$nr_error) = (0,0,0,0,0); + + foreach my $file ( @allfiles ) + { + # special case, this doesn't need to be translated + next if $file eq 'README'; + + my $file_english = catfile( 'english', $dir, $file ); + my $file_transl = catfile( $lang, $dir, $file ); + + # check if the info from vcs and from the fs are consistent + if ( -e $file_english and not exists $revinfo->{$file} ) + { + warn "$file: english version found, but no revision info available!\n"; + next; + } + # check if the info from translation-check and from the fs are consistent + if ( -e $file_transl and not exists $files->{$file} ) + { + warn "$file: $lang version found, but not found in a translation-check file!\n"; + next; + } + + # now check for out-of-dateness and other things + if ( -e $file_english and -e $file_transl ) + { + # needs update + if ( vcs_cmp_rev( $files->{$file}, $revinfo->{$file}->{'cmt_rev'} ) == -1 ) + { + $nr_old++; + print color('blue'), $file, color('reset'); + printf ": needs to be updated from revision %s to revison %s\n", + $files->{$file}, $revinfo->{$file}->{'cmt_rev'}; + } + # translated file is too new + elsif ( vcs_cmp_rev( $files->{$file}, $revinfo->{$file}->{'cmt_rev'} ) == -1 ) + { + $nr_error++; + print color('blue'), $file, color('reset'); + printf ": %s revision %s is larger than english revision %s\n", + $lang, $files->{$file}, $revinfo->{$file}->{'cmt_rev'}; + } + # up to date! + else + { + $nr_uptodate++; + } + } + # file not translated yet + elsif ( -e $file_english ) + { + $nr_needtrans++; + print color('blue'), $file, color('reset'); + printf ": need to translate revision %s\n", $revinfo->{$file}->{'cmt_rev'}; + } + # translation exists, but original has been removed + elsif ( -e $file_transl ) + { + $nr_obsolete++; + print color('blue'), $file, color('reset'); + print ": no english file found!\n"; + } + # weirdness + else + { + $nr_error++; + print color('blue'), $file, color('reset'); + print ": Woopsie, neither english nor $lang file found\n"; + next; + } + } + + return ($nr_uptodate,$nr_old,$nr_needtrans,$nr_obsolete,$nr_error); } + +__END__ -- cgit v1.2.3