The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#! /usr/bin/perl
# Dump a font table structure

use strict;
use Font::TTF::Font;
use Font::TTF::Scripts::AP;
use Font::TTF::Scripts::Volt;
use Font::TTF::Dumper;
use Pod::Usage;
use Getopt::Std;

our ($opt_a, $opt_t, $opt_v);

getopts('a:t:v:');

unless (defined $ARGV[0])
{
    pod2usage( -verbose => 2, -noperldoc => 1);
    exit;
}



my ($f, $fv, $ap);

if ($opt_t =~ /\bTSIV\b/ || $opt_v)
{
    $fv = Font::TTF::Scripts::Volt->read_font($ARGV[0], $opt_a) || die "Can't read font '$ARGV[0]': $!\n";
    $f = $fv->{'font'};
}
elsif ($opt_a)
{
    $ap = Font::TTF::Scripts::AP->read_font($ARGV[0], $opt_a) || die "Can't read font '$ARGV[0]': $!\n";
    $f = $ap->{'font'};
}
else
{
    $f = Font::TTF::Font->open($ARGV[0]) || die "Can't open font file '$ARGV[0]': $!\n";
}

my @tags;

if ($opt_t)
{   @tags = map {pack('A4',$_)} split(/\s*[,\s]\s*/, $opt_t); }
else
{   
    @tags = grep {length($_) == 4} keys %{$f};
    push @tags, 'TSIV' if ($opt_v && $opt_t !~ /\bTSIV\b/);
    @tags = sort @tags;
    push @tags, 'AP' if $opt_a;
}

foreach (@tags)
{
    next unless $_;
    if ($_ eq 'TSIV')
    {
        if ($opt_v)
        {
            my $volt_text;
            my ($inf) = IO::File->new("< $opt_v") || die "Can't open file $opt_v";
            while (<$inf>)
            { $volt_text .= $_; }
            $inf->close;
            print Font::TTF::Dumper::ttfdump($fv->parse_volt($volt_text), $_);
        }
        elsif (defined $f->{'TSIV'})
        { print Font::TTF::Dumper::ttfdump($fv->parse_volt(), $_);  }
        else
        { warn "Font doesn't contain a table with tag '$_'\n"; }
    }
    elsif (length($_) == 4 and exists $f->{$_})
    {
        $f->{$_}->read;
        print Font::TTF::Dumper::ttfdump(\$f->{$_}, $_); 
    }
    elsif ($_ eq 'AP')
    {
        print Font::TTF::Dumper::ttfdump($ap, "AP");
    }
    else
    {
        warn "Font doesn't contain a table with tag '$_'\n";
    }
}


=head1 TITLE

dumpfont - dump table structures from L<Font::TTF::Font>

=head1 SYNOPSIS

     dumpfont [-t taglist] [-a attach.xml] [-v voltsource.vtp] font.ttf

Opens the fontfile with Font::TTF::Font->open and then uses L<Data::Dumper> to pretty-print 
the resultant data structures for one or more font tables to STDOUT.

C<taglist> is a comma-or space-separated list of tags specifying which tables to dump.
If -a is supplied then C<taglist> may contain 'AP' to request dump of the attachment
point structure. If -v is supplied or if the font has a 'TSIV' table, then the
VOLT source will first be parsed then dumped. If -t not provided, dumps all tables. 

By design, dumpfont silently ignores any ' PARENT' or ' CACHE' elements, as well as
any element whose value is a Font::TTF::Font object, in any of the data structures. 

=cut