Blob Blame History Raw
#!/usr/bin/perl
# a coverage script
# depends on Unicode::UCD and Font::TTF
# by Martin Hosken
# small tweaks by Nicolas Spalinger

use Font::TTF::Font;
use Unicode::UCD qw(charblocks charblock charscripts charscript);
use Getopt::Std;

getopts('s');

my $blocks, $stats;

if ($opt_s)
{
    $blocks = charscripts;
}
else
{
    $blocks = charblocks;
}

foreach (keys %{$blocks})
{
    foreach $r (@{$blocks->{$_}})
    { $stats->{$_}[0] += ($r->[1] - $r->[0]) + 1; }
}

$f = Font::TTF::Font->open($ARGV[0]) || die "Can't open font $ARGV[0]";
$cmap = $f->{'cmap'}->read->find_ms->{'val'};

foreach $c (keys %{$cmap})
{
    $r = $opt_s ? charscript($c) : charblock($c);
    $stats->{$r}[1]++;
}

foreach (sort keys %{$stats})
{
    next unless ($_ && $stats->{$_}[1]);
    printf "%s: %d/%d (%.2f%%)\n", $_, $stats->{$_}[1], $stats->{$_}[0], $stats->{$_}[1] / $stats->{$_}[0] * 100.;
}