File: testcharset.pl

package info (click to toggle)
0ad 0.0.23.1-2
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 78,292 kB
  • sloc: cpp: 245,166; ansic: 200,249; python: 13,754; sh: 6,104; perl: 4,620; makefile: 977; xml: 810; java: 533; ruby: 229; erlang: 46; pascal: 30; sql: 21; tcl: 4
file content (79 lines) | stat: -rw-r--r-- 1,997 bytes parent folder | download | duplicates (10)
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
# Tests the characters contained within entity template XML files (most usefully
# their <SpecificName>s) against the characters included in the bitmap font subset,
# and against the glyph data in the fonts themselves.
# When unsupported characters are reported, you should either edit the XML files
# to avoid them (e.g. use a codepoint that better corresponds to the character,
# or use a NFC or NFD version of the character) or add them to charset.txt.

use strict;
use warnings;

use File::Find;

my $vfsroot = '../../../binaries/data/mods';

sub find_entities
{
    my @files;
    my $find_process = sub {
        return $File::Find::prune = 1 if $_ eq '.svn';
        my $n = $File::Find::name;
        return if /~$/;
        return unless -f $_;
        push @files, $n;
    };
    find({ wanted => $find_process }, "$vfsroot/public/simulation/templates");

    return @files;
}

open my $c, "charset.txt" or die $!;
binmode $c, ":utf8";
my %chars;
@chars{split //, do { local $/; <$c> }} = ();

$chars{"\r"} = undef;
$chars{"\n"} = undef;
$chars{"\t"} = undef;

my %fontchars;
{
    open my $f, 'python dumpfontchars.py|' or die $!;
    while (<$f>)
    {
        my ($name, @chars) = split;
        push @chars, 0x0009, 0x000A, 0x000D;
        @{$fontchars{$name}}{map chr($_), @chars} = ();
    }
}

delete $chars{chr(0x301)};

for my $fn (sort(find_entities()))
{
    open my $f, "<", $fn or die $!;
    binmode $f, ":utf8";
    my %fchars;
    @fchars{split //, do { local $/; <$f> }} = ();
    for (sort keys %fchars)
    {
        my @missing;
        if (not exists $chars{$_})
        {
            push @missing, 'charset';
        }
        for my $font (sort keys %fontchars)
        {
            if (not exists $fontchars{$font}{$_})
            {
                push @missing, $font;
            }
        }
        if (@missing)
        {
            printf "%s\n# Missing char U+%04X from %s\n\n", $fn, ord($_), (join ', ', @missing);
        }
    }
}

print "Done.\n";