File Coverage

File:lib/CheckSpelling/Homoglyph.pm
Coverage:100.0%

linestmtbrancondsubtimecode
1#! -*-perl-*-
2
3package CheckSpelling::Homoglyph;
4
5our $VERSION='0.1.0';
6our $flatten=0;
7
8
2
2
2
2
109138
3
4
use utf8;
9
2
2
2
2
168
1
461
use CheckSpelling::Util;
10
11my %homoglyph_map;
12my $homoglyphs;
13
14my %homoglyph_to_glyph;
15
16sub init {
17
16
16
220
    my ($file) = @_;
18
16
1
1
1
100
1
206
2
1
6
    return unless open (my $fh, '<:encoding(UTF-8)', $file);
19
15
798
    my $upper_pattern = CheckSpelling::Util::get_file_from_env_utf8('INPUT_UPPER_PATTERN', '[A-Z]');
20
15
37
    my $lower_pattern = CheckSpelling::Util::get_file_from_env_utf8('INPUT_LOWER_PATTERN', '[a-z]');
21
15
25
    my $punctuation_pattern = CheckSpelling::Util::get_file_from_env_utf8('INPUT_PUNCTUATION_PATTERN', q<'>);
22
15
40
    local $/ = "\n";
23
15
112
    while (<$fh>) {
24
692
100
908
        next if /^#/;
25
691
324
        s/^\\//;
26
691
100
1042
        next unless /^($upper_pattern|$lower_pattern|$punctuation_pattern)(.+)$/;
27
690
530
        my ($expected, $aliases) = ($1, $2);
28
690
758
        my @chars = split('', $aliases);
29
690
265
        my @unexpected_chars;
30
690
401
        for my $ch (@chars) {
31
16219
100
16938
            next if $ch =~ /$upper_pattern|$lower_pattern|$punctuation_pattern/;
32
16213
6803
            my %ref;
33
16213
5983
            my $known_aliases = \%ref;
34
16213
100
10918
            if (defined $homoglyph_map{$ch}) {
35
15042
6890
                $known_aliases = $homoglyph_map{$ch};
36            }
37
16213
8059
            $known_aliases->{$expected} = 1;
38
16213
12572
            $homoglyph_map{$ch} = $known_aliases;
39        }
40    }
41
15
73
    close $fh;
42
15
4320
    my @glyphs = sort keys %homoglyph_map;
43
15
432
    our $homoglyphs = join '', @glyphs;
44
15
10
    our %homoglyph_to_glyph;
45
15
10
    for my $ch (@glyphs) {
46
16212
16212
6472
8967
        my @known_aliases = keys %{$homoglyph_map{$ch}};
47
16212
100
8632
        if (scalar @known_aliases == 1) {
48
16211
9682
            $homoglyph_to_glyph{$ch} = $known_aliases[0];
49        } else {
50
1
1
            $homoglyph_to_glyph{$ch} = $ch;
51        }
52    }
53}
54
55sub dump_aliases {
56
1
1
565
    my $a;
57
1
1
    for my $ch (keys %homoglyph_map) {
58
14
6
        $a = $ch;
59
14
6
        my $b = $homoglyph_map{$a};
60
14
84
        print "$a: ".(join " ", (sort keys %$b))."\n";
61    }
62
1
1
    our $homoglyphs;
63
1
3
    print "\n"."homoglyphs: $homoglyphs\n";
64
1
1
    0;
65}
661;