File: dumpstrings.pl

package info (click to toggle)
abiword 3.0.8%2Bds-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 64,532 kB
  • sloc: cpp: 477,427; ansic: 16,754; makefile: 5,785; xml: 4,014; yacc: 1,818; lex: 1,104; perl: 812; python: 413; php: 183; sh: 169
file content (86 lines) | stat: -rwxr-xr-x 2,285 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
#!/usr/bin/perl
#
# This program analyzes the strings and dumps out a HTML
# page with information about those strings.
#
use CGI qw/-no_debug :standard/;

sub PrintTime {
    my($RetTime, $StartTimeArg, $sec, $minute, $hour, $mday, $mon, $year);
    
    ($sec,$minute,$hour,$mday,$mon,$year) = localtime();
    $mon++; # month is 0 based.
    
    printf("%04d-%02d-%02d %02d:%02d:00", 1900+$year,$mon,$mday,$hour,$minute);
}

my $lang = 'en-US';
$missing{$lang} = 0;

foreach my $file (qw(./src/wp/ap/xp/ap_String_Id.h ./src/af/xap/xp/xap_String_Id.h)) {
  open(STRINGS, "< $file" )
    or die "Cannot open $file";
  
  while (<STRINGS>) {
    next unless /^\s*dcl\s*\((\w+)\s*,\s*\"(.*)\"/;
    my ($dlg,$string) = ($1,$2);
    $dlgs{$dlg}{$lang} = $string;
  }
  
  close(STRINGS);
}

## Read in each of the other language files 
## and process them apropriatly
$stringsdir = "./po";
my @lang;
if(scalar @ARGV) {
  @lang = @ARGV;
} else {
  opendir(DIR, $stringsdir) || die "can't opendir $stringsdir: $!";
  @lang = grep { s/\.strings//  } readdir(DIR);
  closedir DIR;
}

foreach my $lang (@lang) {
  open(STRINGS, "< $stringsdir/$lang.strings") 
    or die "Cannot open $stringsdir/$lang.strings";

  $missing{$lang} = 0;

  while (<STRINGS>) {
    next unless /^(\w*)=\"(.*)\"/;
    my ($dlg,$string) = ($1,$2);
    $dlgs{$dlg}{$lang} = $string;
  }
}

@lang = sort @lang;
unshift(@lang, 'en-US');

## Determine global missing counts
print STDERR "Missing strings:\n";
$selected_langs=join ":",@ARGV;
foreach my $dlg (keys %dlgs) {
  foreach my $lang (@lang) {
    if ($dlgs{$dlg}{"en-US"} && not $dlgs{$dlg}{$lang}) {
      print STDERR "$lang: $dlg\n" if $selected_langs =~ $lang;
      $missing{$lang}++; 
    }
  }
}

## Overall Percent Complete
my $dlg_count = keys %dlgs;
foreach my $lang (@lang) {
  warn("$lang: $missing{$lang}\n");
  my $percent = sprintf("%3d%", (($dlg_count - $missing{$lang}) / $dlg_count) * 100);
  push ( @td, td( [ b( ($lang =~ "en-US" ? $lang : a({href=>"http://www.abisource.com/dev/strings/".$lang.".po"},$lang))) , $percent == 100 ? b($percent) : $percent ]),"\n");
}
print
  table({ border => 1, cellspacing => 0 }, Tr( [ th(['Language', 'Status']), @td ] )),"\n";

print "<br/>\n";
print "Last generated at<br/>";
&PrintTime;
print "\n";