Issue 5751 - Removing legacy gecko support

LocaleTester.pm

-# This Source Code Form is subject to the terms of the Mozilla Public
-# License, v. 2.0. If a copy of the MPL was not distributed with this
-# file, You can obtain one at http://mozilla.org/MPL/2.0/.
-
-package LocaleTester;
-
-use strict;
-use warnings;
-
-my %keepAccessKeys = map {$_ => $_} (
-  'ja-JP',
-  'ja',
-  'ko-KR',
-  'ko',
-  'zh-CN',
-  'zh-TW',
-);
-
-my @placeholders = (
-  '?1?',
-  '?2?',
-  '?3?',
-  '?4?',
-  '?5?',
-  '?6?',
-  '?7?',
-  '?8?',
-  '?9?',
-  '--',
-  '%S',
-  '[link]',
-  '[/link]',
-);
-
-sub testLocales
-{
-  my %params = @_;
-  die "Need at least one locale path to work on" unless exists($params{paths}) && %{$params{paths}};
-  $params{mustDiffer} = [] unless exists($params{mustDiffer});
-  $params{mustEqual} = [] unless exists($params{mustEqual});
-  $params{ignoreUntranslated} = [] unless exists($params{ignoreUntranslated});
-  $params{lengthRestrictions} = {} unless exists($params{lengthRestrictions});
-
-  my @locales = sort {$a cmp $b} (exists($params{locales}) && @{$params{locales}} ? @{$params{locales}} : makeLocaleList($params{paths}));
-
-  my $referenceLocale = readLocaleFiles($params{paths}, "en-US");
-
-  foreach my $locale (@locales)
-  {
-    my $currentLocale = $locale eq "en-US" ? $referenceLocale : readLocaleFiles($params{paths}, $locale);
-
-    compareLocales($locale, $currentLocale, $referenceLocale) unless $currentLocale == $referenceLocale;
-
-    foreach my $entry (@{$params{mustDiffer}})
-    {
-      my %values = ();
-      foreach my $key (@$entry)
-      {
-        my ($dir, $file, $name) = split(/:/, $key);
-        next unless exists($currentLocale->{"$dir:$file"}) && exists($currentLocale->{"$dir:$file"}{$name}) && $currentLocale->{"$dir:$file"}{$name} =~ /\S/;
-        my $value = lc($currentLocale->{"$dir:$file"}{$name});
-
-        print "$locale: Values for '$values{$value}' and '$key' are identical, must differ\n" if exists $values{$value};
-        $values{$value} = $key;
-      }
-    }
-
-    foreach my $entry (@{$params{mustEqual}})
-    {
-      my $stdValue;
-      my $stdName;
-      foreach my $key (@$entry)
-      {
-        my ($dir, $file, $name) = split(/:/, $key);
-        next unless exists($currentLocale->{"$dir:$file"}) && exists($currentLocale->{"$dir:$file"}{$name});
-        my $value = lc($currentLocale->{"$dir:$file"}{$name});
-
-        $stdValue = $value unless defined $stdValue;
-        $stdName = $key unless defined $stdName;
-        print "$locale: Values for '$stdName' and '$key' differ, must be equal\n" if $value ne $stdValue;
-      }
-    }
-
-    foreach my $key (keys %{$params{lengthRestrictions}})
-    {
-      my $maxLength = $params{lengthRestrictions}{$key};
-      my ($dir, $file, $name) = split(/:/, $key);
-      print "$locale: Value of '$key' is too long, must not be longer than $maxLength characters\n" if exists($currentLocale->{"$dir:$file"}) && exists($currentLocale->{"$dir:$file"}{$name}) && length($currentLocale->{"$dir:$file"}{$name}) > $maxLength;
-    }
-
-    foreach my $file (keys %$currentLocale)
-    {
-      my $fileData = $currentLocale->{$file};
-      foreach my $key (keys %$fileData)
-      {
-        if (($key =~ /\.accesskey$/ || $key =~ /\.key$/) && length($fileData->{$key}) != 1)
-        {
-          print "$locale: Length of accesskey '$file:$key' isn't 1 character\n";
-        }
-
-        if ($key =~ /\.accesskey$/)
-        {
-          if (exists($keepAccessKeys{$locale}))
-          {
-            if (exists($referenceLocale->{$file}{$key}) && lc($fileData->{$key}) ne lc($referenceLocale->{$file}{$key}))
-            {
-              print "$locale: Accesskey '$file:$key' should be the same as in the reference locale\n";
-            }
-          }
-          else
-          {
-            my $labelKey = $key;
-            $labelKey =~ s/\.accesskey$/.label/;
-            if (exists($fileData->{$labelKey}) && $fileData->{$labelKey} !~ /\Q$fileData->{$key}/i)
-            {
-              print "$locale: Accesskey '$file:$key' not found in the corresponding label '$file:$labelKey'\n";
-            }
-          }
-        }
-
-        if ($currentLocale != $referenceLocale && $locale ne "en-GB" && exists($referenceLocale->{$file}{$key}) && length($fileData->{$key}) > 1 && $fileData->{$key} eq $referenceLocale->{$file}{$key})
-        {
-          my $ignore = 0;
-          foreach my $re (@{$params{ignoreUntranslated}})
-          {
-            $ignore = 1 if "$file:$key" =~ $re;
-          }
-          print "$locale: Value of '$file:$key' is the same as in the reference locale, probably an untranslated string\n" unless $ignore;
-        }
-
-        if ($currentLocale != $referenceLocale && exists($referenceLocale->{$file}{$key}))
-        {
-          foreach my $placeholder (@placeholders)
-          {
-            print "$locale: Placeholder '$placeholder' missing in '$file:$key'\n" if index($referenceLocale->{$file}{$key}, $placeholder) >= 0 && index($currentLocale->{$file}{$key}, $placeholder) < 0;
-          }
-        }
-      }
-    }
-  }
-}
-
-sub makeLocaleList
-{
-  my $paths = shift;
-
-  my %locales = ();
-  foreach my $dir (keys %$paths)
-  {
-    opendir(local* DIR, $paths->{$dir}) or next;
-    my @locales = grep {!/[^\w\-]/ && !-e("$paths->{$dir}/$_/.incomplete")} readdir(DIR);
-    $locales{$_} = 1 foreach @locales;
-    closedir(DIR);
-  }
-  return keys %locales;
-}
-
-sub readFile
-{
-  my $file = shift;
-
-  open(local *FILE, "<", $file) || die "Could not read file '$file'";
-  binmode(FILE);
-  local $/;
-  my $result = <FILE>;
-  close(FILE);
-
-  print "Byte Order Mark found in file '$file'\n" if $result =~ /\xEF\xBB\xBF/;
-  print "File '$file' is not valid UTF-8\n" unless (utf8::decode($result));
-
-  return $result;
-}
-
-sub parseDTDFile
-{
-  my $file = shift;
-
-  my %result = ();
-
-  my $data = readFile($file);
-
-  my $S = qr/[\x20\x09\x0D\x0A]/;
-  my $Name = qr/[A-Za-z_:][\w.\-:]*/;
-  my $Reference = qr/&$Name;|&#\d+;|&#x[\da-fA-F]+;/;
-  my $PEReference = qr/%$Name;/;
-  my $EntityValue = qr/\"((?:[^%&\"]|$PEReference|$Reference)*)\"|'((?:[^%&']|$PEReference|$Reference)*)'/;
-
-  sub processEntityValue
-  {
-    my $text = shift;
-    $text =~ s/&#(\d+);/chr($1)/ge;
-    $text =~ s/&#x([\da-fA-F]+);/chr(hex($1))/ge;
-    $text =~ s/&apos;/'/g;
-    return $text;
-  }
-
-  # Remove comments
-  $data =~ s/<!--([^\-]|-[^\-])*-->//gs;
-
-  # Process entities
-  while ($data =~ /<!ENTITY$S+($Name)$S+$EntityValue$S*>/gs)
-  {
-    my ($name, $value) = ($1, $2 || $3);
-    $result{$name} = processEntityValue($value);
-  }
-
-  # Remove entities
-  $data =~ s/<!ENTITY$S+$Name$S+$EntityValue$S*>//gs;
-
-  # Remove spaces
-  $data =~ s/^\s+//gs;
-  $data =~ s/\s+$//gs;
-  $data =~ s/\s+/ /gs;
-
-  print "Unrecognized data in file '$file': $data\n" if $data ne '';
-
-  return \%result;
-}
-
-sub parsePropertiesFile
-{
-  my $file = shift;
-
-  my %result = ();
-
-  my $data = readFile($file);
-  while ($data =~ /^(.*)$/mg)
-  {
-    my $line = $1;
-
-    # ignore comments
-    next if $line =~ /^\s*[#!]/;
-
-    if ($line =~ /=/)
-    {
-      my ($key, $value) = split(/=/, $line, 2);
-      $result{$key} = $value;
-    }
-    elsif ($line =~ /\S/)
-    {
-      print "Unrecognized data in file '$file': $line\n";
-    }
-  }
-  close(FILE);
-
-  return \%result;
-}
-
-sub readLocaleFiles
-{
-  my $paths = shift;
-  my $locale = shift;
-
-  my %result = ();
-  foreach my $dir (keys %$paths)
-  {
-    opendir(local *DIR, "$paths->{$dir}/$locale") or next;
-    foreach my $file (readdir(DIR))
-    {
-      if ($file =~ /(.*)\.dtd$/)
-      {
-        $result{"$dir:$1"} = parseDTDFile("$paths->{$dir}/$locale/$file");
-      }
-      elsif ($file =~ /(.*)\.properties$/)
-      {
-        $result{"$dir:$1"} = parsePropertiesFile("$paths->{$dir}/$locale/$file");
-      }
-    }
-    closedir(DIR);
-  }
-
-  return \%result;
-}
-
-sub compareLocales
-{
-  my ($locale, $current, $reference) = @_;
-
-  my %hasFile = ();
-  foreach my $file (keys %$current)
-  {
-    unless (exists($reference->{$file}))
-    {
-      print "$locale: Extra file '$file'\n";
-      next;
-    }
-    $hasFile{$file} = 1;
-
-    my %hasValue = ();
-    foreach my $key (keys %{$current->{$file}})
-    {
-      unless (exists($reference->{$file}{$key}))
-      {
-        print "$locale: Extra value '$file:$key'\n";
-        next;
-      }
-      $hasValue{$key} = 1;
-    }
-
-    foreach my $key (keys %{$reference->{$file}})
-    {
-      unless (exists($current->{$file}{$key}))
-      {
-        print "$locale: Missing value '$file:$key'\n";
-        next;
-      }
-    }
-  }
-
-  foreach my $file (keys %$reference)
-  {
-    unless (exists($current->{$file}))
-    {
-      print "$locale: Missing file '$file'\n";
-      next;
-    }
-  }
-}
-
-1;