--- /dev/null
+#!/usr/bin/env perl
+use 5.010;
+use strict;
+use warnings;
+
+use Data::Dump 'pp';
+use Font::TTF::Font;
+
+my ($ttfuri, $outfile) = @ARGV;
+$ttfuri or die "usage error\n";
+
+for ($outfile || ()) {
+ !-e $_ or die "Output file $outfile already exists\n";
+ open my $output, '>', $_ or die "Cannot write to $outfile: $!\n";
+ select $output;
+}
+
+my %FONTID = (
+ 'Times New Roman' => 'times',
+ 'DejaVu Sans' => 'dv ss',
+ 'DejaVu Serif' => 'dv serif',
+ 'DejaVu Sans Mono'=> 'dv mono',
+ 'Code2000' => 'c2k',
+ 'GNU Unifont' => 'guf',
+ 'Droid Sans' => 'droid',
+ 'Droid Serif' => 'droid serif',
+ 'Droid Sans Mono' => 'droid mono',
+);
+
+{
+ my $ttf = Font::TTF::Font->open($ttfuri)
+ or die "Cannot open truetype in $ttfuri: $!";
+
+ my $ttfname = ($ttfuri =~ m{([^/.]+) (?:[.]ttf)? \z}msx)[0];
+ my $ttfmeta = $ttf->{name}->read;
+ my %meta = (
+ source => $ttfuri =~ m{(^/usr/.+ | [^/]+) \z}msx,
+ name => $ttfmeta->find_name(4) || $ttfname,
+ revision => $ttf->{head}->{fontRevision},
+ version => scalar $ttfmeta->find_name(5),
+ copyright=> scalar $ttfmeta->find_name(0),
+ license => $ttfmeta->find_name(14) || undef,
+ date => (map {
+ $_ && eval {
+ require Time::Piece;
+ Time::Piece->new($_)->datetime;
+ }
+ } $ttf->{head}->getdate),
+ );
+ $meta{id} = $FONTID{ $meta{name} } // lc $ttfname;
+ say pp(\%meta), ',';
+
+ my $support = $ttf->{cmap}->find_ms->{val};
+ warn scalar keys %$support, " characters read from $ttfname\n";
+ say pp(sort { $a <=> $b } keys %$support);
+}
+
+__END__
+
+=head1 NAME
+
+mkttfinfo - Extract character coverage and metadata in TrueType font
+
+=head1 SYNOPSIS
+
+ mkttfinfo <font.ttf> [<output.inc.pl>]
+
+=head1 AUTHOR
+
+Mischa POSLAWSKY <perl@shiar.org>
+
+=head1 LICENSE
+
+Licensed under the GNU Affero General Public License version 3.
+