#! /usr/bin/perl
#
# ttf-dump-name-table.pl - dumps a name table of ttf and ttc font files
#
# Author: Takamichi Akiyama <tora@openoffice.org>
# Revision: 0.1  Novemer 19, 2006
# License: GNU LGPL
#
# References:
# http://search.cpan.org/~mhosken/Font-TTF-0.40/
# http://search.cpan.org/~mhosken/Font-TTF-0.40/lib/Font/TTF/Name.pm
# http://www.microsoft.com/OpenType/OTSpec/name.htm
# 
# Note:
# Use this script under the environment where UTF-8 is available.

use Font::TTF::Font;
use Font::TTF::Ttc;
use Encode;

sub work {
    my ($file, $t, $f) = @_;
    $f->{'name'}->read; 
    # $f->{'name'}{'strings'}[$number][$platform_id][$encoding_id]{$language_id};
    my $n = 0;
    foreach my $p_ref (@{$f->{'name'}{'strings'}}) {
	my $p = 0;
	foreach my $e_ref (@$p_ref) {
	    my $e = 0;
	    foreach my $l_ref (@$e_ref) {
		foreach my $l (keys %$l_ref) {
		    print join("\t", $file, $t, $n, $p, $e, $l,
			       Encode::encode("utf8", $$l_ref{$l})), "\n";
		}
		$e++;
	    }
	    $p++;
	}
	$n++;
    }
}

sub main {
    print join("\t", qw( file ttc number platform_id encoding_id language_id strings)), "\n";
    foreach my $file (@ARGV) {
	unless ($file =~ m/ttc\Z/i) {
	    my $f = Font::TTF::Font->open($file);
	    work($file, 0, $f);
	    $f->release;
	}
	else {
	    my $c = Font::TTF::Ttc->open($file);
	    my $n = 0;
	    foreach my $f (@{$c->{'directs'}}) {
		work($file, $n, $f);
		$n++;
	    }
	}		
    }
}

main();

__END__
