diff options
Diffstat (limited to 'lib/Lintian/Check/Files/Locales.pm')
| -rw-r--r-- | lib/Lintian/Check/Files/Locales.pm | 204 |
1 files changed, 204 insertions, 0 deletions
diff --git a/lib/Lintian/Check/Files/Locales.pm b/lib/Lintian/Check/Files/Locales.pm new file mode 100644 index 0000000..e645a83 --- /dev/null +++ b/lib/Lintian/Check/Files/Locales.pm @@ -0,0 +1,204 @@ +# files/locales -- lintian check script -*- perl -*- + +# Copyright (C) 1998 Christian Schwarz and Richard Braakman +# Copyright (C) 2013 Niels Thykier <niels@thykier.net> +# Copyright (C) 2019 Adam D. Barratt <adam@adam-barratt.org.uk> +# Copyright (C) 2021 Felix Lechner +# +# Based in part on a shell script that was: +# Copyright (C) 2010 Raphael Geissert <atomo64@gmail.com> +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, you can find it on the World Wide +# Web at https://www.gnu.org/copyleft/gpl.html, or write to the Free +# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, +# MA 02110-1301, USA. + +package Lintian::Check::Files::Locales; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use JSON::MaybeXS; +use List::SomeUtils qw(first_value); +use Path::Tiny; + +const my $EMPTY => q{}; + +const my $ARROW => q{->}; + +const my $RESERVED => $EMPTY; +const my $SPECIAL => q{S}; + +const my %CONFUSING_LANGUAGES => ( + # Albanian is sq, not al: + 'al' => 'sq', + # Chinese is zh, not cn: + 'cn' => 'zh', + # Czech is cs, not cz: + 'cz' => 'cs', + # Danish is da, not dk: + 'dk' => 'da', + # Greek is el, not gr: + 'gr' => 'el', + # Indonesian is id, not in: + 'in' => 'id', +); + +const my %CONFUSING_COUNTRIES => ( + # UK != GB + 'en_UK' => 'en_GB', +); +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +has ISO639_3_by_alpha3 => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + local $ENV{LC_ALL} = 'C'; + + my $bytes = path('/usr/share/iso-codes/json/iso_639-3.json')->slurp; + my $json = decode_json($bytes); + + my %iso639_3; + for my $entry (@{$json->{'639-3'}}) { + + my $alpha_3 = $entry->{alpha_3}; + + $iso639_3{$alpha_3} = $entry; + } + + return \%iso639_3; + } +); + +has LOCALE_CODES => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + local $ENV{LC_ALL} = 'C'; + + my %CODES; + for my $entry (values %{$self->ISO639_3_by_alpha3}) { + + my $type = $entry->{type}; + + # https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=692548#10 + next + if $type eq $RESERVED || $type eq $SPECIAL; + + # also have two letters, ISO 639-1 + my $two_letters; + $two_letters = $entry->{alpha_2} + if exists $entry->{alpha_2}; + + $CODES{$two_letters} = $EMPTY + if length $two_letters; + + # three letters, ISO 639-2 + my $three_letters = $entry->{alpha_3}; + + # a value indicates that two letters are preferred + $CODES{$three_letters} = $two_letters || $EMPTY; + } + + return \%CODES; + } +); + +sub visit_installed_files { + my ($self, $item) = @_; + + return + unless $item->is_dir; + + return + unless $item->name =~ m{^ usr/share/locale/ ([^/]+) / $}x; + + my $folder = $1; + + # without encoding + my ($with_country) = split(m/[.@]/, $folder); + + # special exception + return + if $with_country eq 'l10n'; + + # without country code + my ($two_or_three, $country) = split(m/_/, $with_country); + + $country //= $EMPTY; + + return + unless length $two_or_three; + + # check some common language errors + if (exists $CONFUSING_LANGUAGES{$two_or_three}) { + + my $fixed = $folder; + $fixed =~ s{^ $two_or_three }{$CONFUSING_LANGUAGES{$two_or_three}}x; + + $self->pointed_hint('incorrect-locale-code', $item->pointer, $folder, + $ARROW,$fixed); + return; + } + + # check some common country errors + if (exists $CONFUSING_COUNTRIES{$with_country}) { + + my $fixed = $folder; + $fixed =~ s{^ $with_country }{$CONFUSING_COUNTRIES{$with_country}}x; + + $self->pointed_hint('incorrect-locale-code', $item->pointer, $folder, + $ARROW,$fixed); + return; + } + + # check known codes + if (exists $self->LOCALE_CODES->{$two_or_three}) { + + my $replacement = $self->LOCALE_CODES->{$two_or_three}; + return + unless length $replacement; + + # a value indicates that two letters are preferred + my $fixed = $folder; + $fixed =~ s{^ $two_or_three }{$replacement}x; + + $self->pointed_hint('incorrect-locale-code', $item->pointer, $folder, + $ARROW,$fixed); + + return; + } + + $self->pointed_hint('unknown-locale-code', $item->pointer, $folder); + + return; +} + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et |