1 #! /usr/bin/perl -w

     2 #############################################################################

     3 ##

     4 ## Copyright (C) 2010 Nokia Corporation and/or its subsidiary(-ies).

     5 ## All rights reserved.

     6 ## Contact: Nokia Corporation (qt-info@nokia.com)

     7 ##

     8 ## This file is part of the translations module of the Qt Toolkit.

     9 ##

    10 ## $QT_BEGIN_LICENSE:LGPL$

    11 ## No Commercial Usage

    12 ## This file contains pre-release code and may not be distributed.

    13 ## You may use this file in accordance with the terms and conditions

    14 ## contained in the Technology Preview License Agreement accompanying

    15 ## this package.

    16 ##

    17 ## GNU Lesser General Public License Usage

    18 ## Alternatively, this file may be used under the terms of the GNU Lesser

    19 ## General Public License version 2.1 as published by the Free Software

    20 ## Foundation and appearing in the file LICENSE.LGPL included in the

    21 ## packaging of this file.  Please review the following information to

    22 ## ensure the GNU Lesser General Public License version 2.1 requirements

    23 ## will be met: http://www.gnu.org/licenses/old-licenses/lgpl-2.1.html.

    24 ##

    25 ## In addition, as a special exception, Nokia gives you certain additional

    26 ## rights.  These rights are described in the Nokia Qt LGPL Exception

    27 ## version 1.1, included in the file LGPL_EXCEPTION.txt in this package.

    28 ##

    29 ## If you have questions regarding the use of this file, please contact

    30 ## Nokia at qt-info@nokia.com.

    31 ##

    32 ##

    33 ##

    34 ##

    35 ##

    36 ##

    37 ##

    38 ##

    39 ## $QT_END_LICENSE$

    40 ##

    41 #############################################################################

    42 

    43 

    44 use strict;

    45 

    46 my @groups = ("qt", "assistant", "designer", "linguist", "qt_help", "qtconfig", "qvfb");

    47 

    48 my %scores = ();

    49 my %langs = ();

    50 

    51 my $files = join("\n", <*_??.ts>);

    52 my $res = `xmlpatterns -param files=\"$files\" check-ts.xq`;

    53 for my $i (split(/ /, $res)) {

    54   $i =~ /^([^.]+)\.ts:(.*)$/;

    55   my ($fn, $pc) = ($1, $2);

    56   for my $g (@groups) {

    57     if ($fn =~ /^${g}_((.._)?..)$/) {

    58       my $lang = $1;

    59       $scores{$g}{$lang} = $pc;

    60       $langs{$lang} = 1;

    61       last;

    62     }

    63   }

    64 }

    65 

    66 my $code = "";

    67 

    68 print "L10n  ";

    69 for my $g (@groups) {

    70   print " ".$g." ";

    71 }

    72 print "\n";

    73 for my $lang (sort(keys(%langs))) {

    74   printf "%-5s ", $lang;

    75   my $qt = 1;

    76   my $rest = 1;

    77   my $line = "";

    78   for my $g (@groups) {

    79     my $pc = $scores{$g}{$lang};

    80     $pc = "0" if !defined($pc);

    81     if (int($pc) < 98 or !$qt) {

    82       if ($g eq "qt") {

    83         $qt = 0;

    84       } else {

    85         $rest = 0;

    86       }

    87     } else {

    88       $line .= " ".$g."_".$lang.".ts";

    89     }

    90     printf " %-".(length($g)+1)."s", $pc;

    91   }

    92   if ($qt) {

    93     $code .= " \\\n   ".$line;

    94     if (!$rest) {

    95       print "   (partial)";

    96     }

    97   } else {

    98     print "   (excluded)";

    99   }

   100   print "\n";

   101 }

   102 

   103 my $fn = "translations.pro";

   104 my $nfn = $fn."new";

   105 open IN, $fn or die;

   106 open OUT, ">".$nfn or die;

   107 while (1) {

   108   $_ = <IN>;

   109   last if (/^TRANSLATIONS /);

   110   print OUT $_;

   111 }

   112 while ($_ =~ /\\\n$/) {

   113   $_ = <IN>;

   114 }

   115 print OUT "TRANSLATIONS =".$code."\n";

   116 while (<IN>) {

   117   print OUT $_;

   118 }

   119 close OUT;

   120 close IN;

   121 rename $nfn, $fn;