testautomation/tools/analyze/translate_res_file.pl

   1 #! /usr/bin/perl
   2
   3 #*************************************************************************
   4 #
   5 #   OpenOffice.org - a multi-platform office productivity suite
   6 #
   7 #   $RCSfile: translate_res_file.pl,v $
   8 #
   9 #   $Revision: 1.1 $
  10 #
  11 #   last change: $Author: andreschnabel $ $Date: 2007/02/18 12:01:54 $
  12 #
  13 #   The Contents of this file are made available subject to
  14 #   the terms of GNU Lesser General Public License Version 2.1.
  15 #
  16 #
  17 #     GNU Lesser General Public License Version 2.1
  18 #     =============================================
  19 #     Copyright 2005 by Sun Microsystems, Inc.
  20 #     901 San Antonio Road, Palo Alto, CA 94303, USA
  21 #
  22 #     This library is free software; you can redistribute it and/or
  23 #     modify it under the terms of the GNU Lesser General Public
  24 #     License version 2.1, as published by the Free Software Foundation.
  25 #
  26 #     This library is distributed in the hope that it will be useful,
  27 #     but WITHOUT ANY WARRANTY; without even the implied warranty of
  28 #     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  29 #     Lesser General Public License for more details.
  30 #
  31 #     You should have received a copy of the GNU Lesser General Public
  32 #     License along with this library; if not, write to the Free Software
  33 #     Foundation, Inc., 59 Temple Place, Suite 330, Boston,
  34 #     MA  02111-1307  USA
  35 #
  36 #*************************************************************************
  37 #
  38 #   short description :
  39 #     This Perl sciprt translates *.res files of qatesttool into human
  40 #     readable format
  41 #*************************************************************************
  42
  43 sub usage {
  44     print << "EOT";
  45
  46   $0 - translates *.res files of qatesttool into readable format
  47
  48   Synopsis:
  49      $0 [options] file...
  50
  51   Options:
  52      --help                  prints this message.
  53      --testtoolrc=filename   specifies .testtoolrc (default: \$HOME/.testtoolrc)
  54      --with-filename         inserts filename:linenumber:, which helps users go there with emacs
  55      --lang=language         specifies language defined in app.srs (default: \$LANG)
  56      --app_srs=filename      specifies resource file app.srs (default: ./app.srs)
  57      --with-color            outputs colored translated messages using ANSI color sequence code
  58
  59   Description:
  60     This Perl sciprt translates *.res files produced by qatesttool
  61     into human readable text file format.
  62
  63   Examples:
  64     perl translate_res_file.pl topten.res
  65
  66 EOT
  67 }
  68
  69 use Getopt::Long;
  70 $Opt_With_Filename = 0;
  71 $With_Color = 0;
  72
  73 use Env qw( LANG HOME );
  74 use Term::ANSIColor;
  75
  76 $BaseDir = undef;
  77 %Resource = ();
  78
  79 %LogType = qw( 0 RUN
  80            1 TEST_CASE
  81            2 ERROR
  82            3 CALL_STACK
  83            4 MESSAGE
  84            5 WARNING
  85            6 ASSERTION
  86            7 QA_ERROR
  87            8 ASSERTION_STACK
  88            );
  89
  90 %LogTypeColor = qw( 0 none
  91             1 none
  92             2 on_red
  93             3 none
  94             4 none
  95             5 on_yellow
  96             6 none
  97             7 on_cyan
  98             8 none
  99             );
 100
 101 sub substitution {
 102     my ($file, $lineno, $line) = @_;
 103     my ($id, $arg1, $arg2, $arg3) =
 104     ($line =~ m/\%ResId=([0-9]+)\%
 105      (?:\%Arg1=(.+?)\%)?
 106      (?:\%Arg2=(.+?)\%)?
 107      (?:\%Arg3=(.+?)\%)?/x);
 108     my $text = $Resource{$id};
 109     if (defined $text) {
 110     $text =~ s/\(\$Arg1\)/$arg1/ if ($text =~ m/\(\$Arg1\)/);
 111     $text =~ s/\(\$Arg2\)/$arg2/ if ($text =~ m/\(\$Arg2\)/);
 112     $text =~ s/\(\$Arg3\)/$arg3/ if ($text =~ m/\(\$Arg3\)/);
 113     return $text;
 114     }
 115     else {
 116     print STDERR "$file:$lineno: Unknown String: $line\n";
 117     }
 118 }
 119
 120 sub work {
 121     my $file = shift;
 122     my ($line, $lineno, $log_type);
 123     open FH, "$file" or die "$!: $file, stopped";
 124     while (<FH>) {
 125     unless (m/\A[0-9]+;/) {
 126         print;
 127         next;
 128     }
 129     chomp;
 130     s/(\r|\n)+\Z//;
 131     $lineno ++;
 132     $line = $_;
 133     my ($type, $_filename, $_lineno, $start, $end, $text) = split(m/;/, $_, 6);
 134     $text = "" unless defined $text;
 135     $text =~ s/(\%ResId=.+%)/ substitution($file, $lineno, $1) /e;
 136     #print "\n$line\n";
 137     $text =~ s/\A\"//;
 138     $text =~ s/\"\Z//;
 139     $log_type = $LogType{$type} || "Unknown LogType";
 140     if (defined $_filename and $_filename ne "") {
 141         $_filename =~ s/\A\~-//g;
 142         $_filename =~ s/\A\~/$BaseDir\//g if defined $BaseDir;
 143         $_filename =~ s{\\}{/}g;
 144         print "$_filename:$_lineno: " if $Opt_With_Filename;
 145     }
 146     if ($With_Color and $LogTypeColor{$type} ne "none") {
 147         print colored ("$log_type: $text", $LogTypeColor{$type});
 148         print "\n";
 149     }
 150     else {
 151         print "$log_type: $text\n";
 152     }
 153     }
 154     close FH;
 155 }
 156
 157 sub getBaseDir {
 158     my $file = shift;
 159     my $dir;
 160     open FH, "<", $file or do {
 161     warn "Warning: $!: $file; BaseDir substitution will be suppressed;";
 162     return undef;
 163     };
 164     while (<FH>) {
 165     if (m/\ABaseDir=(.*)/) {
 166         $dir = $1;
 167         chomp $dir;
 168         $dir =~ s/(\r|\n)+\Z//;
 169     }
 170     }
 171     close FH;
 172     return $dir;
 173 }
 174
 175 sub load_app_srs {
 176     my $file = shift;
 177     my $lang = shift;
 178     my $flag = undef;
 179     my ($id, $text, $fallback);
 180     my ($x);
 181     unless (defined $lang) {
 182     $lang = $LANG || "C";
 183     }
 184     $lang = substr($lang, 0, 2);
 185     $lang = "en-US" if $lang eq "en" or $lang eq "C";
 186     print $lang;
 187
 188     open FH, $file or die "Error: $!: $file, stopped";
 189     while (<FH>) {
 190     next if m/\A#/;
 191     if (m/\AString\s+([0-9]+)/) {
 192         $id = $1;
 193         $flag = 1;
 194         undef $text;
 195         next;
 196     }
 197     next unless $flag;
 198     if (m/\};/) {
 199         $text = $fallback unless defined $text;
 200         chomp $text;
 201         $text =~ s/\A\"//;
 202         $text =~ s/\"\Z//;
 203         $Resource{$id} = $text;
 204         #print "$id\t$text\n";
 205         undef $flag;
 206         next;
 207     }
 208     if (m/Text = "(.+?)";\Z/) {
 209         $fallback = $1;
 210         next;
 211     }
 212     if (m/Text\[ (.+?) \] = "(.+?)";\Z/) {
 213         $x = $1;
 214         $fallback = $text if ($x eq "en-US");
 215         $text = $2 if ($x eq $lang);
 216     }
 217     }
 218     close FH;
 219 }
 220
 221 sub main {
 222     my $opt_help;
 223     my $testtoolrc = "$HOME/.testtoolrc";
 224     my $language;
 225     my $app_srs = "app.srs";
 226     my $result = GetOptions ( "help"           => \$opt_help,
 227                   "testtoolrc=s"   => \$testtoolrc,
 228                   "with-filename"  => \$Opt_With_Filename,
 229                   "language=s"     => \$language,
 230                   "app_srs=s"      => \$app_srs,
 231                   "with-color"     => \$With_Color,
 232                   );
 233     if (scalar(@ARGV) <= 0 or !$result or $opt_help) {
 234     usage();
 235     exit;
 236     }
 237
 238     $BaseDir = getBaseDir($testtoolrc);
 239     load_app_srs($app_srs, $language);
 240     foreach $file (@ARGV) {
 241     print "$file\n";
 242     work($file);
 243     print "\n";
 244     }
 245 }
 246
 247 main();
 248
 249 __END__