webwml/webwml/stattrans.pl

#! /usr/bin/perl

#   webwml-stattrans - Debian Web site Translation Statistics
#   Copyright (c) 2001  Martin Schulze <joey@debian.org> and others

#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.

#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.

#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

use POSIX qw(strftime);
use Getopt::Std;
$| = 1;

$opt_h = "/org/www.debian.org/debian.org/devel/website/stats";
$opt_w = "/org/www.debian.org/webwml";
$opt_p = "*.wml";
$opt_t = "Debian Web site Translation Statistics";
$opt_v = 0;
$opt_d = "u";
getopts('hwptv');
%config = (
           'htmldir' => $opt_h,
           'wmldir'  => $opt_w,
           'wmlpat'  => $opt_p,
           'title'   => $opt_t,
           'verbose' => $opt_v,
           'diff'    => $opt_d,
           );

$max_versions = 5;
$min_versions = 1;

# from english/template/debian/languages.wml
# TODO: Needs to be synced frequently or fixed so it's automatic
my %langs = ( english    => "en",
              hellas     => "el",
              turkish    => "tr",
              romanian   => "ro",
              esperanto  => "eo",
              finnish    => "fi",
              portuguese => "pt",
              danish     => "da",
              french     => "fr",
              dutch      => "nl",
              german     => "de",
              italian    => "it",
              spanish    => "es",
              korean     => "ko",
              japanese   => "ja",
              croatian   => "hr",
              chinese    => "zh",
              swedish    => "sv",
              polish     => "pl",
              norwegian  => "no",
              russian    => "ru",
              hungarian  => "hu",
              );

$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>";


$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 "";
}

# Count wml files in given directory
#
sub getwmlfiles
{
    my $lang = shift;
    my $cmd  = "find $config{'wmldir'}/$lang -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;

    print "$lang " if ($config{verbose});

    die if (! -d "$config{'wmldir'}/$lang");
    open (FIND, "$cmd|") || die "Can't read from $cmd";
    while (<FIND>) {
        next if (/\/sitemap\.wml/);
        next if (/\/template\//);
        next if (/\/MailingLists\/(un)?subscribe\.wml/);
        chomp;
        $file = substr ($_, $cutfrom);
        $file =~ s/\.wml$//;
        $wmlfiles{$lang} .= " " . $file;
        if ($is_english) {
            $version{"$lang/$file"} = get_cvs_version ("$config{'wmldir'}/$lang", "$file.wml");
        } else {
            $version{"$lang/$file"} = get_translation_version ("$config{'wmldir'}/$lang", "$file.wml");
        }
        $count++;
    }
    close (FIND);
    $wmlfiles{$lang} .= " ";
    $wml{$lang} = $count;
}         

sub get_color
{
    my $percent = shift;

    if ((255 - ($percent * (255/75))) < 0) {
        return sprintf ("#%02x%02x00", 255 - ($percent * (255/100)), $percent * (255/100));
    } else {
        return sprintf ("#%02x%02x00", 255 - ($percent * (255/75)), $percent * (255/100));
    }
}

sub check_translation
{
    my ($translation, $version, $file) = @_;
    my @version_numbers, $major_number, $last_number;
    my @translation_numbers, $major_translated_number, $last_translated_number;

    if ($version ne "" && $translation ne "") {
        @version_numbers = split /\./,$version;
        $major_number = @version_numbers[0];
        $last_number = pop @version_numbers;
        die "Invalid CVS revision for $file: $version\n"
            unless ($major_number =~ /\d+/ && $last_number =~ /\d+/);

        @translation_numbers = split /\./,$translation;
        $major_translated_number = @translation_numbers[0];
        $last_translated_number = pop @translation_numbers;
        die "Invalid translation revision for $file: $translation\n"
            unless ($major_translated_number =~ /\d+/ && $last_translated_number =~ /\d+/);

        # Here we compare the original version with the translated one and print
        # a note for the user if their first or last numbers are too far apart
        # From translation-check.wml

        if ($version eq "") {
            return "The original no longer exists";
        } elsif ( $major_number != $major_translated_number ) {
            return "This translation is too out of date";
        } elsif ( $last_number - $last_translated_number >= $max_versions ) {
            return "This translation is too out of date";
        } elsif ( $last_number - $last_translated_number >= $min_versions ) {
            return "The original is newer than this translation";
        }
    }
    return "";
}

print "Collecting data in: " if ($config{'verbose'});
getwmlfiles ('english');
foreach $lang (keys %langs) {
    next if ($lang eq "english");
    getwmlfiles ($lang);
}
print "\n" if ($config{'verbose'});

# =============== Create HTML files ===============
mkdir ($config{'htmldir'}, 2775) if (! -d $config{'htmldir'});

@sorted_english = sort (split (/ /, $wmlfiles{'english'}));

print "Creating files: " if ($config{'verbose'});
foreach $lang (sort (keys %langs)) {
    $l = $langs{$lang};
    print "$l.html " if ($config{'verbose'});
    $l = "zh-cn" if ($l eq "zh"); # kludge

    $t_body = $u_body = $o_body = "";

    foreach $file (@sorted_english) {
        next if ($file eq "");
        # Translated pages
        if (index ($wmlfiles{$lang}, " $file ") >= 0) {
                $t_body .= sprintf ("<a href=\"/%s.%s.html\">%s</a><br>\n",
                          $file, $l, $file);
                $translated{$lang}++;
                next if ($lang eq "english");
                # Outdated translations
                $msg = check_translation ($version{"$lang/$file"}, $version{"english/$file"}, "$lang/$file");
                if (length ($msg)) {
                        $o_body .= "<tr>";
                        $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>", $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 .= "</tr>\n";
                        $outdated{$lang}++;
                }
        }
        # Untranslated pages
        else {
                $u_body .= sprintf ("<a href=\"/%s\">%s</a><br>", $file, $file);
                $untranslated{$lang}++;
        }
    }

# this is where we discard the files that the translation directory contains
# but which don't exist in the English directory
#   print "extra files: ".$wml{$lang}-$translated{$lang}."\n";
    $wml{$lang} = $translated{$lang};
    $translated{$lang} = $translated{$lang} - $outdated{$lang};

    $percent_a{$lang} = $wml{$lang}/$wml{english} * 100;
    $percent_t{$lang} = $translated{$lang}/$wml{english} * 100;
    $percent_o{$lang} = $outdated{$lang}/$wml{english} * 100;
    $percent_u{$lang} = $untranslated{$lang}/$wml{english} * 100;

    if (open (HTML, ">$config{'htmldir'}/$l.html")) {
        printf HTML "<html><head><title>%s: %s</title></head><body bgcolor=#ffffff>\n", $config{'title'}, $lang;

        $color = get_color ($percent_a{$lang});

        printf HTML "<table width=100%% cellpadding=2 cellspacing=0 bgcolor=%s>\n", $color;

        printf HTML "<tr><td colspan=4><h1 align=center>%s: %s</h1></td></tr>", $config{'title'}, $lang;

        print HTML "<tr>\n";
        printf HTML "<td align=center width=25%%><b>%d files (%d%%) translated</b></td>", $wml{$lang}, $percent_a{$lang};
        printf HTML "<td align=center width=25%%><b>%d files (%d%%) up to date</b></td>", $translated{$lang}, $percent_t{$lang};
        printf HTML "<td align=center width=25%%><b>%d files (%d%%) outdated</b></td>", $outdated{$lang}, $percent_o{$lang};
        printf HTML "<td align=center width=25%%><b>%d files (%d%%) not translated</b></td>", $untranslated{$lang}, $percent_u{$lang};
        print HTML "</tr>\n";
        print HTML "</table>\n";

        print HTML "<p><a href=\"./\">Index</a><p>\n";
        print HTML "<p><a href=\"../\">Working on the website</a><p>\n";

        if ($o_body) {
            print HTML "<h3>Outdated translations:</h3>";
            print HTML "<table border=0 cellpadding=1 cellspacing=1>\n";
            print HTML "<tr><th>File</th><th>Translated</th><th>English</th><th>Comment</th>";
            if ($opt_d eq "u") { print HTML "<th>Unified diff</th>"; }
            elsif ($opt_d eq "h") { print HTML "<th>Colored diff</th>"; }
            else { print HTML "<th>Diff</th>"; }
            print HTML "</tr>\n";
            print HTML $o_body;
            print HTML "</table>\n";
        }
        if ($u_body) {
            print HTML "<h3>Pages not translated:</h3>";
            print HTML $u_body;
        }
        if ($t_body) {
            print HTML "<h3>Translations up to date:</h3>";
            print HTML $t_body;
        }

        print HTML "</table>\n";
        print HTML "<hr><address>Compiled at $date</address>\n";
        print HTML "</body></html>";
        close (HTML);
    }
}
print "\n" if ($config{'verbose'});

# =============== Creating index.html ===============
print "Creating index.html... " if ($config{'verbose'});

open (HTML, ">$config{'htmldir'}/index.html")
    || die "Can't open $config{'htmldir'}/index.html";

printf HTML "<html>\n<head><title>%s</title></head>\n<body bgcolor=#ffffff>\n", $config{'title'};
printf HTML "<h1 align=center>%s</h1>\n", $config{'title'};

print HTML $border_head;
print HTML "<table width=100% border=0 bgcolor=\"#cdc9c9\">\n";
print HTML "<tr><th>Language</th><th>Translations</th><th>Up to date</th><th>Outdated</th><th>Not translated</th></tr>\n";
foreach $lang (sort (keys %langs)) {
    $l = $langs{$lang};
    $l = "zh-cn" if ($l eq "zh"); # kludge

    $color = get_color ($percent_a{$lang});

    print HTML "<tr>";
    printf HTML "<td><a href=\"%s.html\">%s</a> (%s)</td>", $l, $lang, $l;
    printf HTML "<td bgcolor=\"%s\" align=right>%d (%d%%)</td>", $color, $wml{$lang}, $percent_a{$lang};
    if ($l ne "en") {
      printf HTML "<td align=right>%d (%d%%)</td>", $translated{$lang}, $percent_t{$lang};
      printf HTML "<td align=right>%d (%d%%)</td>", $outdated{$lang}, $percent_o{$lang};
      printf HTML "<td align=right>%d (%d%%)</td>", $untranslated{$lang}, $percent_u{$lang};
    } else {
      print HTML "<td align=right>-</td><td align=right>-</td><td align=right>-</td>";
    }
    print HTML "</tr>\n",
}

print HTML "</tr></table>";
print HTML $border_foot;

print HTML "</table>\n";
print HTML "<p><hr noshade size=1 width=100%>\n";
print HTML "<p>Created with <a href=\"http://cvs.debian.org/webwml/stattrans.pl?cvsroot=webwml\">webwml-stattrans</a> at $date\n";
print HTML "</body></html>\n";
close (HTML);

print "done.\n" if ($config{'verbose'});

# Note:
#   Translated pages on ll.html may be higher than in index.html.
#   This is due to the fact that some english pages were removed.

# printf "%s\n", join ("\n", keys %version);
# printf "%s - %s\n", $version{'german/devel/index'}, $version{'english/devel/index'};
1	joy	1.1	#! /usr/bin/perl
2
3	joy	1.11	# webwml-stattrans - Debian Web site Translation Statistics
4	joy	1.1	# Copyright (c) 2001 Martin Schulze <joey@debian.org> and others
5
6			# This program is free software; you can redistribute it and/or modify
7			# it under the terms of the GNU General Public License as published by
8			# the Free Software Foundation; either version 2 of the License, or
9			# (at your option) any later version.
10
11			# This program is distributed in the hope that it will be useful,
12			# but WITHOUT ANY WARRANTY; without even the implied warranty of
13			# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14			# GNU General Public License for more details.
15
16			# You should have received a copy of the GNU General Public License
17			# along with this program; if not, write to the Free Software
18	joy	1.6	# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
19	joy	1.1
20			use POSIX qw(strftime);
21	joy	1.6	use Getopt::Std;
22	joy	1.7	$\| = 1;
23	joy	1.1
24	joy	1.6	$opt_h = "/org/www.debian.org/debian.org/devel/website/stats";
25			$opt_w = "/org/www.debian.org/webwml";
26			$opt_p = "*.wml";
27	joy	1.11	$opt_t = "Debian Web site Translation Statistics";
28	joy	1.6	$opt_v = 0;
29	joy	1.12	$opt_d = "u";
30	joy	1.6	getopts('hwptv');
31	joy	1.1	%config = (
32	joy	1.6	'htmldir' => $opt_h,
33			'wmldir' => $opt_w,
34			'wmlpat' => $opt_p,
35			'title' => $opt_t,
36			'verbose' => $opt_v,
37	joy	1.12	'diff' => $opt_d,
38	joy	1.1	);
39
40			$max_versions = 5;
41			$min_versions = 1;
42
43	joy	1.4	# from english/template/debian/languages.wml
44	joy	1.6	# TODO: Needs to be synced frequently or fixed so it's automatic
45	joy	1.1	my %langs = ( english => "en",
46			hellas => "el",
47			turkish => "tr",
48			romanian => "ro",
49			esperanto => "eo",
50			finnish => "fi",
51			portuguese => "pt",
52			danish => "da",
53			french => "fr",
54			dutch => "nl",
55			german => "de",
56			italian => "it",
57			spanish => "es",
58			korean => "ko",
59			japanese => "ja",
60			croatian => "hr",
61			chinese => "zh",
62			swedish => "sv",
63			polish => "pl",
64			norwegian => "no",
65			russian => "ru",
66			hungarian => "hu",
67			);
68
69	joy	1.4	$border_head = "<table width=95% align=center border=0 cellpadding=0 cellspacing=0><tr bgcolor=#000000><td>"
70	joy	1.1	."<table width=100% border=0 cellpadding=0 cellspacing=1><tr bgcolor=#ffffff><td>";
71			$border_foot = "</td></tr></table></td></tr></table>";
72
73
74			$date = strftime "%a %b %e %H:%M:%S %Y %z", localtime;
75
76			sub get_cvs_version
77			{
78			my ($dir, $wmlfile) = @_;
79			my $file;
80			my @comp;
81			my $version;
82
83			@comp = split (/\//, "$dir/$wmlfile");
84			pop @comp;
85			$dir = join ("/", @comp);
86
87			@comp = split (/\//, "$wmlfile");
88			$file = pop @comp;
89
90			if (open (CVS,"$dir/CVS/Entries")) {
91			while (<CVS>) {
92			($version) = $_ =~ m,/\Q$file\E/([\d\.]*),;
93			last if $version;
94			}
95			}
96
97			return $version;
98			}
99
100			sub get_translation_version
101			{
102			my ($dir, $file) = @_;
103			my $checktrans;
104
105			if (open (F, "$dir/$file")) {
106			$checktrans = 0;
107			while (<F>) {
108			chomp;
109			if (/^\#use wml::debian::translation-check/) {
110			$checktrans = 1;
111			return $1 if ($_ =~ /translation="([^\" ]+)"/);
112			last;
113			}
114			}
115			close (F);
116			}
117			return "";
118			}
119
120			# Count wml files in given directory
121			#
122			sub getwmlfiles
123			{
124			my $lang = shift;
125			my $cmd = "find $config{'wmldir'}/$lang -name \"$config{'wmlpat'}\"";
126			my $cutfrom = length ($config{'wmldir'})+length($lang)+2;
127			my $count = 0;
128			my $is_english = ($lang eq "english")?1:0;
129			my $file, $v;
130
131	joy	1.7	print "$lang " if ($config{verbose});
132
133			die if (! -d "$config{'wmldir'}/$lang");
134	joy	1.1	open (FIND, "$cmd\|") \|\| die "Can't read from $cmd";
135			while (<FIND>) {
136			next if (/\/sitemap\.wml/);
137			next if (/\/template\//);
138			next if (/\/MailingLists\/(un)?subscribe\.wml/);
139			chomp;
140			$file = substr ($_, $cutfrom);
141			$file =~ s/\.wml$//;
142	joy	1.7	$wmlfiles{$lang} .= " " . $file;
143	joy	1.1	if ($is_english) {
144			$version{"$lang/$file"} = get_cvs_version ("$config{'wmldir'}/$lang", "$file.wml");
145			} else {
146			$version{"$lang/$file"} = get_translation_version ("$config{'wmldir'}/$lang", "$file.wml");
147			}
148			$count++;
149			}
150			close (FIND);
151	joy	1.7	$wmlfiles{$lang} .= " ";
152			$wml{$lang} = $count;
153	joy	1.1	}
154
155			sub get_color
156			{
157			my $percent = shift;
158
159			if ((255 - ($percent * (255/75))) < 0) {
160			return sprintf ("#%02x%02x00", 255 - ($percent * (255/100)), $percent * (255/100));
161			} else {
162			return sprintf ("#%02x%02x00", 255 - ($percent * (255/75)), $percent * (255/100));
163			}
164			}
165
166			sub check_translation
167			{
168			my ($translation, $version, $file) = @_;
169			my @version_numbers, $major_number, $last_number;
170			my @translation_numbers, $major_translated_number, $last_translated_number;
171
172			if ($version ne "" && $translation ne "") {
173			@version_numbers = split /\./,$version;
174			$major_number = @version_numbers[0];
175			$last_number = pop @version_numbers;
176			die "Invalid CVS revision for $file: $version\n"
177			unless ($major_number =~ /\d+/ && $last_number =~ /\d+/);
178
179			@translation_numbers = split /\./,$translation;
180			$major_translated_number = @translation_numbers[0];
181			$last_translated_number = pop @translation_numbers;
182			die "Invalid translation revision for $file: $translation\n"
183			unless ($major_translated_number =~ /\d+/ && $last_translated_number =~ /\d+/);
184
185			# Here we compare the original version with the translated one and print
186			# a note for the user if their first or last numbers are too far apart
187			# From translation-check.wml
188
189			if ($version eq "") {
190			return "The original no longer exists";
191			} elsif ( $major_number != $major_translated_number ) {
192			return "This translation is too out of date";
193			} elsif ( $last_number - $last_translated_number >= $max_versions ) {
194			return "This translation is too out of date";
195			} elsif ( $last_number - $last_translated_number >= $min_versions ) {
196			return "The original is newer than this translation";
197			}
198			}
199			return "";
200			}
201
202	joy	1.7	print "Collecting data in: " if ($config{'verbose'});
203	joy	1.1	getwmlfiles ('english');
204	joy	1.7	foreach $lang (keys %langs) {
205			next if ($lang eq "english");
206			getwmlfiles ($lang);
207	joy	1.1	}
208			print "\n" if ($config{'verbose'});
209
210			# =============== Create HTML files ===============
211	joy	1.10	mkdir ($config{'htmldir'}, 2775) if (! -d $config{'htmldir'});
212	joy	1.1
213	joy	1.7	@sorted_english = sort (split (/ /, $wmlfiles{'english'}));
214	joy	1.1
215	joy	1.7	print "Creating files: " if ($config{'verbose'});
216	joy	1.1	foreach $lang (sort (keys %langs)) {
217			$l = $langs{$lang};
218	joy	1.7	print "$l.html " if ($config{'verbose'});
219	joy	1.8	$l = "zh-cn" if ($l eq "zh"); # kludge
220
221			$t_body = $u_body = $o_body = "";
222	joy	1.4
223			foreach $file (@sorted_english) {
224			next if ($file eq "");
225			# Translated pages
226	joy	1.7	if (index ($wmlfiles{$lang}, " $file ") >= 0) {
227	joy	1.4	$t_body .= sprintf ("<a href=\"/%s.%s.html\">%s</a><br>\n",
228			$file, $l, $file);
229			$translated{$lang}++;
230	joy	1.8	next if ($lang eq "english");
231	joy	1.4	# Outdated translations
232			$msg = check_translation ($version{"$lang/$file"}, $version{"english/$file"}, "$lang/$file");
233			if (length ($msg)) {
234	joy	1.12	$o_body .= "<tr>";
235			$o_body .= sprintf "<td><a href=\"/%s.%s.html\">%s</a></td>", $file, $l, $file;
236			$o_body .= sprintf "<td>%s</td>", $version{"$lang/$file"};
237			$o_body .= sprintf "<td>%s</td>", $version{"english/$file"};
238			$o_body .= sprintf "<td>%s</td>", $msg;
239			$o_body .= sprintf "<td>  <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"};
240			$o_body .= "</tr>\n";
241	joy	1.4	$outdated{$lang}++;
242			}
243			}
244			# Untranslated pages
245			else {
246			$u_body .= sprintf ("<a href=\"/%s\">%s</a><br>", $file, $file);
247			$untranslated{$lang}++;
248			}
249			}
250	joy	1.6
251	joy	1.8	# this is where we discard the files that the translation directory contains
252			# but which don't exist in the English directory
253			# print "extra files: ".$wml{$lang}-$translated{$lang}."\n";
254			$wml{$lang} = $translated{$lang};
255	joy	1.6	$translated{$lang} = $translated{$lang} - $outdated{$lang};
256
257	joy	1.7	$percent_a{$lang} = $wml{$lang}/$wml{english} * 100;
258			$percent_t{$lang} = $translated{$lang}/$wml{english} * 100;
259			$percent_o{$lang} = $outdated{$lang}/$wml{english} * 100;
260			$percent_u{$lang} = $untranslated{$lang}/$wml{english} * 100;
261	joy	1.4
262	joy	1.1	if (open (HTML, ">$config{'htmldir'}/$l.html")) {
263	joy	1.7	printf HTML "<html><head><title>%s: %s</title></head><body bgcolor=#ffffff>\n", $config{'title'}, $lang;
264	joy	1.1
265	joy	1.7	$color = get_color ($percent_a{$lang});
266	joy	1.1
267			printf HTML "<table width=100%% cellpadding=2 cellspacing=0 bgcolor=%s>\n", $color;
268
269	joy	1.7	printf HTML "<tr><td colspan=4><h1 align=center>%s: %s</h1></td></tr>", $config{'title'}, $lang;
270	joy	1.1
271	joy	1.4	print HTML "<tr>\n";
272	joy	1.7	printf HTML "<td align=center width=25%%><b>%d files (%d%%) translated</b></td>", $wml{$lang}, $percent_a{$lang};
273			printf HTML "<td align=center width=25%%><b>%d files (%d%%) up to date</b></td>", $translated{$lang}, $percent_t{$lang};
274			printf HTML "<td align=center width=25%%><b>%d files (%d%%) outdated</b></td>", $outdated{$lang}, $percent_o{$lang};
275			printf HTML "<td align=center width=25%%><b>%d files (%d%%) not translated</b></td>", $untranslated{$lang}, $percent_u{$lang};
276	joy	1.8	print HTML "</tr>\n";
277			print HTML "</table>\n";
278	joy	1.1
279	joy	1.3	print HTML "<p><a href=\"./\">Index</a><p>\n";
280			print HTML "<p><a href=\"../\">Working on the website</a><p>\n";
281	joy	1.1
282	joy	1.4	if ($o_body) {
283			print HTML "<h3>Outdated translations:</h3>";
284	joy	1.1	print HTML "<table border=0 cellpadding=1 cellspacing=1>\n";
285	joy	1.12	print HTML "<tr><th>File</th><th>Translated</th><th>English</th><th>Comment</th>";
286			if ($opt_d eq "u") { print HTML "<th>Unified diff</th>"; }
287			elsif ($opt_d eq "h") { print HTML "<th>Colored diff</th>"; }
288			else { print HTML "<th>Diff</th>"; }
289			print HTML "</tr>\n";
290	joy	1.4	print HTML $o_body;
291	joy	1.1	print HTML "</table>\n";
292			}
293	joy	1.4	if ($u_body) {
294			print HTML "<h3>Pages not translated:</h3>";
295			print HTML $u_body;
296	joy	1.1	}
297	joy	1.4	if ($t_body) {
298			print HTML "<h3>Translations up to date:</h3>";
299			print HTML $t_body;
300	joy	1.1	}
301
302			print HTML "</table>\n";
303			print HTML "<hr><address>Compiled at $date</address>\n";
304			print HTML "</body></html>";
305			close (HTML);
306			}
307			}
308	joy	1.7	print "\n" if ($config{'verbose'});
309	joy	1.1
310			# =============== Creating index.html ===============
311	joy	1.7	print "Creating index.html... " if ($config{'verbose'});
312	joy	1.1
313			open (HTML, ">$config{'htmldir'}/index.html")
314			\|\| die "Can't open $config{'htmldir'}/index.html";
315
316	joy	1.3	printf HTML "<html>\n<head><title>%s</title></head>\n<body bgcolor=#ffffff>\n", $config{'title'};
317	joy	1.4	printf HTML "<h1 align=center>%s</h1>\n", $config{'title'};
318	joy	1.1
319			print HTML $border_head;
320	joy	1.4	print HTML "<table width=100% border=0 bgcolor=\"#cdc9c9\">\n";
321	joy	1.8	print HTML "<tr><th>Language</th><th>Translations</th><th>Up to date</th><th>Outdated</th><th>Not translated</th></tr>\n";
322	joy	1.1	foreach $lang (sort (keys %langs)) {
323			$l = $langs{$lang};
324	joy	1.8	$l = "zh-cn" if ($l eq "zh"); # kludge
325	joy	1.4
326	joy	1.7	$color = get_color ($percent_a{$lang});
327	joy	1.4
328			print HTML "<tr>";
329			printf HTML "<td><a href=\"%s.html\">%s</a> (%s)</td>", $l, $lang, $l;
330	joy	1.7	printf HTML "<td bgcolor=\"%s\" align=right>%d (%d%%)</td>", $color, $wml{$lang}, $percent_a{$lang};
331	joy	1.6	if ($l ne "en") {
332	joy	1.7	printf HTML "<td align=right>%d (%d%%)</td>", $translated{$lang}, $percent_t{$lang};
333			printf HTML "<td align=right>%d (%d%%)</td>", $outdated{$lang}, $percent_o{$lang};
334			printf HTML "<td align=right>%d (%d%%)</td>", $untranslated{$lang}, $percent_u{$lang};
335	joy	1.6	} else {
336	joy	1.7	print HTML "<td align=right>-</td><td align=right>-</td><td align=right>-</td>";
337	joy	1.6	}
338	joy	1.4	print HTML "</tr>\n",
339	joy	1.1	}
340
341			print HTML "</tr></table>";
342			print HTML $border_foot;
343
344	joy	1.3	print HTML "</table>\n";
345	joy	1.4	print HTML "<p><hr noshade size=1 width=100%>\n";
346			print HTML "<p>Created with <a href=\"http://cvs.debian.org/webwml/stattrans.pl?cvsroot=webwml\">webwml-stattrans</a> at $date\n";
347	joy	1.3	print HTML "</body></html>\n";
348	joy	1.1	close (HTML);
349
350	joy	1.7	print "done.\n" if ($config{'verbose'});
351	joy	1.1
352			# Note:
353			# Translated pages on ll.html may be higher than in index.html.
354			# This is due to the fact that some english pages were removed.
355
356			# printf "%s\n", join ("\n", keys %version);
357			# printf "%s - %s\n", $version{'german/devel/index'}, $version{'english/devel/index'};