#!/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.; }