Side by Side Diff: LocaleTester.pm
Issue 29562599:
Issue 5751 - Removing legacy gecko support (Closed)
Patch Set: Rebasing, addressing comments
Created Oct. 5, 2017, 10:05 a.m.
| Left: | ||
| Right: |
Use n/p to move between diff chunks;
N/P to move between comments.
« no previous file with comments
|
« no previous file
|
build.py » ('j')
|
build.py » ('J')
Toggle Intra-line Diffs ('i') | Expand Comments ('e') | Collapse Comments ('c') | Hide Comments ('s')
Toggle Intra-line Diffs ('i') | Expand Comments ('e') | Collapse Comments ('c') | Hide Comments ('s')
| OLD | NEW |
|---|---|
| (Empty) | |
| 1 # This Source Code Form is subject to the terms of the Mozilla Public | |
| 2 # License, v. 2.0. If a copy of the MPL was not distributed with this | |
| 3 # file, You can obtain one at http://mozilla.org/MPL/2.0/. | |
| 4 | |
| 5 package LocaleTester; | |
| 6 | |
| 7 use strict; | |
| 8 use warnings; | |
| 9 | |
| 10 my %keepAccessKeys = map {$_ => $_} ( | |
| 11 'ja-JP', | |
| 12 'ja', | |
| 13 'ko-KR', | |
| 14 'ko', | |
| 15 'zh-CN', | |
| 16 'zh-TW', | |
| 17 ); | |
| 18 | |
| 19 my @placeholders = ( | |
| 20 '?1?', | |
| 21 '?2?', | |
| 22 '?3?', | |
| 23 '?4?', | |
| 24 '?5?', | |
| 25 '?6?', | |
| 26 '?7?', | |
| 27 '?8?', | |
| 28 '?9?', | |
| 29 '--', | |
| 30 '%S', | |
| 31 '[link]', | |
| 32 '[/link]', | |
| 33 ); | |
| 34 | |
| 35 sub testLocales | |
| 36 { | |
| 37 my %params = @_; | |
| 38 die "Need at least one locale path to work on" unless exists($params{paths}) & & %{$params{paths}}; | |
| 39 $params{mustDiffer} = [] unless exists($params{mustDiffer}); | |
| 40 $params{mustEqual} = [] unless exists($params{mustEqual}); | |
| 41 $params{ignoreUntranslated} = [] unless exists($params{ignoreUntranslated}); | |
| 42 $params{lengthRestrictions} = {} unless exists($params{lengthRestrictions}); | |
| 43 | |
| 44 my @locales = sort {$a cmp $b} (exists($params{locales}) && @{$params{locales} } ? @{$params{locales}} : makeLocaleList($params{paths})); | |
| 45 | |
| 46 my $referenceLocale = readLocaleFiles($params{paths}, "en-US"); | |
| 47 | |
| 48 foreach my $locale (@locales) | |
| 49 { | |
| 50 my $currentLocale = $locale eq "en-US" ? $referenceLocale : readLocaleFiles( $params{paths}, $locale); | |
| 51 | |
| 52 compareLocales($locale, $currentLocale, $referenceLocale) unless $currentLoc ale == $referenceLocale; | |
| 53 | |
| 54 foreach my $entry (@{$params{mustDiffer}}) | |
| 55 { | |
| 56 my %values = (); | |
| 57 foreach my $key (@$entry) | |
| 58 { | |
| 59 my ($dir, $file, $name) = split(/:/, $key); | |
| 60 next unless exists($currentLocale->{"$dir:$file"}) && exists($currentLoc ale->{"$dir:$file"}{$name}) && $currentLocale->{"$dir:$file"}{$name} =~ /\S/; | |
| 61 my $value = lc($currentLocale->{"$dir:$file"}{$name}); | |
| 62 | |
| 63 print "$locale: Values for '$values{$value}' and '$key' are identical, m ust differ\n" if exists $values{$value}; | |
| 64 $values{$value} = $key; | |
| 65 } | |
| 66 } | |
| 67 | |
| 68 foreach my $entry (@{$params{mustEqual}}) | |
| 69 { | |
| 70 my $stdValue; | |
| 71 my $stdName; | |
| 72 foreach my $key (@$entry) | |
| 73 { | |
| 74 my ($dir, $file, $name) = split(/:/, $key); | |
| 75 next unless exists($currentLocale->{"$dir:$file"}) && exists($currentLoc ale->{"$dir:$file"}{$name}); | |
| 76 my $value = lc($currentLocale->{"$dir:$file"}{$name}); | |
| 77 | |
| 78 $stdValue = $value unless defined $stdValue; | |
| 79 $stdName = $key unless defined $stdName; | |
| 80 print "$locale: Values for '$stdName' and '$key' differ, must be equal\n " if $value ne $stdValue; | |
| 81 } | |
| 82 } | |
| 83 | |
| 84 foreach my $key (keys %{$params{lengthRestrictions}}) | |
| 85 { | |
| 86 my $maxLength = $params{lengthRestrictions}{$key}; | |
| 87 my ($dir, $file, $name) = split(/:/, $key); | |
| 88 print "$locale: Value of '$key' is too long, must not be longer than $maxL ength characters\n" if exists($currentLocale->{"$dir:$file"}) && exists($current Locale->{"$dir:$file"}{$name}) && length($currentLocale->{"$dir:$file"}{$name}) > $maxLength; | |
| 89 } | |
| 90 | |
| 91 foreach my $file (keys %$currentLocale) | |
| 92 { | |
| 93 my $fileData = $currentLocale->{$file}; | |
| 94 foreach my $key (keys %$fileData) | |
| 95 { | |
| 96 if (($key =~ /\.accesskey$/ || $key =~ /\.key$/) && length($fileData->{$ key}) != 1) | |
| 97 { | |
| 98 print "$locale: Length of accesskey '$file:$key' isn't 1 character\n"; | |
| 99 } | |
| 100 | |
| 101 if ($key =~ /\.accesskey$/) | |
| 102 { | |
| 103 if (exists($keepAccessKeys{$locale})) | |
| 104 { | |
| 105 if (exists($referenceLocale->{$file}{$key}) && lc($fileData->{$key}) ne lc($referenceLocale->{$file}{$key})) | |
| 106 { | |
| 107 print "$locale: Accesskey '$file:$key' should be the same as in th e reference locale\n"; | |
| 108 } | |
| 109 } | |
| 110 else | |
| 111 { | |
| 112 my $labelKey = $key; | |
| 113 $labelKey =~ s/\.accesskey$/.label/; | |
| 114 if (exists($fileData->{$labelKey}) && $fileData->{$labelKey} !~ /\Q$ fileData->{$key}/i) | |
| 115 { | |
| 116 print "$locale: Accesskey '$file:$key' not found in the correspond ing label '$file:$labelKey'\n"; | |
| 117 } | |
| 118 } | |
| 119 } | |
| 120 | |
| 121 if ($currentLocale != $referenceLocale && $locale ne "en-GB" && exists($ referenceLocale->{$file}{$key}) && length($fileData->{$key}) > 1 && $fileData->{ $key} eq $referenceLocale->{$file}{$key}) | |
| 122 { | |
| 123 my $ignore = 0; | |
| 124 foreach my $re (@{$params{ignoreUntranslated}}) | |
| 125 { | |
| 126 $ignore = 1 if "$file:$key" =~ $re; | |
| 127 } | |
| 128 print "$locale: Value of '$file:$key' is the same as in the reference locale, probably an untranslated string\n" unless $ignore; | |
| 129 } | |
| 130 | |
| 131 if ($currentLocale != $referenceLocale && exists($referenceLocale->{$fil e}{$key})) | |
| 132 { | |
| 133 foreach my $placeholder (@placeholders) | |
| 134 { | |
| 135 print "$locale: Placeholder '$placeholder' missing in '$file:$key'\n " if index($referenceLocale->{$file}{$key}, $placeholder) >= 0 && index($current Locale->{$file}{$key}, $placeholder) < 0; | |
| 136 } | |
| 137 } | |
| 138 } | |
| 139 } | |
| 140 } | |
| 141 } | |
| 142 | |
| 143 sub makeLocaleList | |
| 144 { | |
| 145 my $paths = shift; | |
| 146 | |
| 147 my %locales = (); | |
| 148 foreach my $dir (keys %$paths) | |
| 149 { | |
| 150 opendir(local* DIR, $paths->{$dir}) or next; | |
| 151 my @locales = grep {!/[^\w\-]/ && !-e("$paths->{$dir}/$_/.incomplete")} read dir(DIR); | |
| 152 $locales{$_} = 1 foreach @locales; | |
| 153 closedir(DIR); | |
| 154 } | |
| 155 return keys %locales; | |
| 156 } | |
| 157 | |
| 158 sub readFile | |
| 159 { | |
| 160 my $file = shift; | |
| 161 | |
| 162 open(local *FILE, "<", $file) || die "Could not read file '$file'"; | |
| 163 binmode(FILE); | |
| 164 local $/; | |
| 165 my $result = <FILE>; | |
| 166 close(FILE); | |
| 167 | |
| 168 print "Byte Order Mark found in file '$file'\n" if $result =~ /\xEF\xBB\xBF/; | |
| 169 print "File '$file' is not valid UTF-8\n" unless (utf8::decode($result)); | |
| 170 | |
| 171 return $result; | |
| 172 } | |
| 173 | |
| 174 sub parseDTDFile | |
| 175 { | |
| 176 my $file = shift; | |
| 177 | |
| 178 my %result = (); | |
| 179 | |
| 180 my $data = readFile($file); | |
| 181 | |
| 182 my $S = qr/[\x20\x09\x0D\x0A]/; | |
| 183 my $Name = qr/[A-Za-z_:][\w.\-:]*/; | |
| 184 my $Reference = qr/&$Name;|&#\d+;|&#x[\da-fA-F]+;/; | |
| 185 my $PEReference = qr/%$Name;/; | |
| 186 my $EntityValue = qr/\"((?:[^%&\"]|$PEReference|$Reference)*)\"|'((?:[^%&']|$P EReference|$Reference)*)'/; | |
| 187 | |
| 188 sub processEntityValue | |
| 189 { | |
| 190 my $text = shift; | |
| 191 $text =~ s/&#(\d+);/chr($1)/ge; | |
| 192 $text =~ s/&#x([\da-fA-F]+);/chr(hex($1))/ge; | |
| 193 $text =~ s/'/'/g; | |
| 194 return $text; | |
| 195 } | |
| 196 | |
| 197 # Remove comments | |
| 198 $data =~ s/<!--([^\-]|-[^\-])*-->//gs; | |
| 199 | |
| 200 # Process entities | |
| 201 while ($data =~ /<!ENTITY$S+($Name)$S+$EntityValue$S*>/gs) | |
| 202 { | |
| 203 my ($name, $value) = ($1, $2 || $3); | |
| 204 $result{$name} = processEntityValue($value); | |
| 205 } | |
| 206 | |
| 207 # Remove entities | |
| 208 $data =~ s/<!ENTITY$S+$Name$S+$EntityValue$S*>//gs; | |
| 209 | |
| 210 # Remove spaces | |
| 211 $data =~ s/^\s+//gs; | |
| 212 $data =~ s/\s+$//gs; | |
| 213 $data =~ s/\s+/ /gs; | |
| 214 | |
| 215 print "Unrecognized data in file '$file': $data\n" if $data ne ''; | |
| 216 | |
| 217 return \%result; | |
| 218 } | |
| 219 | |
| 220 sub parsePropertiesFile | |
| 221 { | |
| 222 my $file = shift; | |
| 223 | |
| 224 my %result = (); | |
| 225 | |
| 226 my $data = readFile($file); | |
| 227 while ($data =~ /^(.*)$/mg) | |
| 228 { | |
| 229 my $line = $1; | |
| 230 | |
| 231 # ignore comments | |
| 232 next if $line =~ /^\s*[#!]/; | |
| 233 | |
| 234 if ($line =~ /=/) | |
| 235 { | |
| 236 my ($key, $value) = split(/=/, $line, 2); | |
| 237 $result{$key} = $value; | |
| 238 } | |
| 239 elsif ($line =~ /\S/) | |
| 240 { | |
| 241 print "Unrecognized data in file '$file': $line\n"; | |
| 242 } | |
| 243 } | |
| 244 close(FILE); | |
| 245 | |
| 246 return \%result; | |
| 247 } | |
| 248 | |
| 249 sub readLocaleFiles | |
| 250 { | |
| 251 my $paths = shift; | |
| 252 my $locale = shift; | |
| 253 | |
| 254 my %result = (); | |
| 255 foreach my $dir (keys %$paths) | |
| 256 { | |
| 257 opendir(local *DIR, "$paths->{$dir}/$locale") or next; | |
| 258 foreach my $file (readdir(DIR)) | |
| 259 { | |
| 260 if ($file =~ /(.*)\.dtd$/) | |
| 261 { | |
| 262 $result{"$dir:$1"} = parseDTDFile("$paths->{$dir}/$locale/$file"); | |
| 263 } | |
| 264 elsif ($file =~ /(.*)\.properties$/) | |
| 265 { | |
| 266 $result{"$dir:$1"} = parsePropertiesFile("$paths->{$dir}/$locale/$file") ; | |
| 267 } | |
| 268 } | |
| 269 closedir(DIR); | |
| 270 } | |
| 271 | |
| 272 return \%result; | |
| 273 } | |
| 274 | |
| 275 sub compareLocales | |
| 276 { | |
| 277 my ($locale, $current, $reference) = @_; | |
| 278 | |
| 279 my %hasFile = (); | |
| 280 foreach my $file (keys %$current) | |
| 281 { | |
| 282 unless (exists($reference->{$file})) | |
| 283 { | |
| 284 print "$locale: Extra file '$file'\n"; | |
| 285 next; | |
| 286 } | |
| 287 $hasFile{$file} = 1; | |
| 288 | |
| 289 my %hasValue = (); | |
| 290 foreach my $key (keys %{$current->{$file}}) | |
| 291 { | |
| 292 unless (exists($reference->{$file}{$key})) | |
| 293 { | |
| 294 print "$locale: Extra value '$file:$key'\n"; | |
| 295 next; | |
| 296 } | |
| 297 $hasValue{$key} = 1; | |
| 298 } | |
| 299 | |
| 300 foreach my $key (keys %{$reference->{$file}}) | |
| 301 { | |
| 302 unless (exists($current->{$file}{$key})) | |
| 303 { | |
| 304 print "$locale: Missing value '$file:$key'\n"; | |
| 305 next; | |
| 306 } | |
| 307 } | |
| 308 } | |
| 309 | |
| 310 foreach my $file (keys %$reference) | |
| 311 { | |
| 312 unless (exists($current->{$file})) | |
| 313 { | |
| 314 print "$locale: Missing file '$file'\n"; | |
| 315 next; | |
| 316 } | |
| 317 } | |
| 318 } | |
| 319 | |
| 320 1; | |
| OLD | NEW |
