#!/usr/bin/perl
#{([

use strict;
use Font::TTF::Font;
use Pod::Usage;
use Getopt::Long;
use IO::String;

our $VERSION = 0.03;    # BH      2009-02-02
#		Added -update option (to force update of one or more tables)
#			(Had to change inport code to use memory files so update could work)
#   $VERSION = 0.02;    # BH      2008-06-27     
#		Added -list option (outputs a list of tables from input font).
#   $VERSION = 0.01;    # BH      2007-11-04     First release


# Regarding $CHAIN_CALL
#
# I've got some code to handle chaining, but it won't work yet so don't try it. Several things need to be fixed:
# - When processing an export, the incoming font must first be updated. Then realize that the the desired 
#   table may have been modified by previous program in the chain, which means the ' dat' isn't valid. 
#   To obtain a valid ' dat', the table's out() function  must be called (perhaps using IO::String). 
# - When processing an import, need to figure out a way that programs subsequent to us use the
#   replaced ' dat' value rather than read from the font. Perhaps we go ahead and read() the table using
#   IO::String

our $CHAIN_CALL;

my (@exports, @imports, @deletes, @updates, $textmode, $list);

my $f;

unless ($CHAIN_CALL)
{
    my $help;
    
    GetOptions (
        'export=s' =>  \@exports,
        'import=s' =>  \@imports,
        'delete|remove=s' => \@deletes,
		'update=s' =>	\@updates,
        'text'  =>      \$textmode,
        'list'  =>      \$list,
        'help|?'   =>   \$help) or pod2usage(2);
        
    pod2usage( -verbose => 2, -noperldoc => 1) if $help;

    pod2usage(-msg => "missing infile.ttf parameter\n", -verbose => 1) unless defined $ARGV[0];

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

}

# Delete and update are special because:
#   There are magic words like "graphite"
#   it doesn't have the tag=fname format, so allow it to have be simple list.
# While we're at it, go ahead and trim and pad the tags
foreach my $tag (\@deletes, \@updates)
{
	@{$tag} = map {sprintf('%-4.4s', $_)} grep {$_} split(/[\s,;]+/, join(',', (map { 
        s/\bgraphite\b/ Silf Feat Gloc Glat Sill Sile /oi; 
        s/\bvolt\b/ TSIV TSID TSIP TSIS /oi;
        s/\bopentype\b/ GDEF GSUB GPOS /oi;
    $_ } (@{$tag}))));
}

# First, read data to be imported and save it for later

my %importeddata;

if ($list)
{
    map {print "$_\n"} (sort grep {length($_) == 4} keys %{$f})
}


for (@imports)
{
    # Parse the tag=fname value, making up a suitable name if needed.
    
    my ($tag, $fname) = m/^([^=]{1,4})(?:=(.*))?$/o;
    unless (defined ($tag))
    {
        warn "Do not understand \"-import $_\" -- ignoring\n";
        next;
    }
    $fname = "$ARGV[0].$tag.dat" unless $fname;
    $fname =~ s/[\\\/:*?"<>|]//oig;      # "Characters disallowed in filenames
    
    # Pad and trim table tag
    $tag = sprintf('%-4.4s', $tag);
    
    # Slurp in and save the data to go into the font table:
    open (IN, $fname) or die "Cannot open file '$fname' for reading. ";
    local $/ = undef;		# slurp mode for read:
    binmode IN unless $textmode;
    $importeddata{$tag} = <IN>;
    close IN;
}    

# Now that we've read all the input files (which may also be output files!), we can do the export:

for (@exports)
{
    # Parse the tag=fname value, making up a suitable name if needed.
    
    my ($tag, $fname) = m/^([^=]{1,4})(?:=(.*))?$/o;
    unless (defined ($tag))
    {
        warn "Do not understand \"-export $_\" -- ignoring\n";
        next;
    }

    $fname = "$ARGV[0].$tag.dat" unless $fname;
    $fname =~ s/[\\\/:*?"<>|]//oig;      # "Characters disallowed in filenames
    
    # Pad and trim table tag
    $tag = sprintf('%-4.4s', $tag);

    # Check that the table exists
    unless (defined $f->{$tag})
    {
        warn "Tag $tag not defined in input font -- export request ignored\n";
        next;
    }

    # Get the data directly

    # OK, I don't use read_dat() because tables like head and maxp have already
    # been read and thus read_dat() will noop. 
    # If we ever implement CHAIN_CALL this has got to be fixed up, but for 
    # now we can hack it:

    my $dat;
    $f->{$tag}{' INFILE'}->seek($f->{$tag}{' OFFSET'}, 0);
    $f->{$tag}{' INFILE'}->read($dat, $f->{$tag}{' LENGTH'});

    # Export the table
    open(OUT, ">" . $fname) or die "Couldn't open '$fname' for writing. ";
    if ($textmode)
    {
        # Seems there ought to be a better way to do this, but I have no idea
        # what the font table uses for line ending conventions, so i brute force
        # convert anything to \n then let iolayers fix it up
        $dat =~ s/\r\n|\n\r|[\r\n]/\n/g;
	}
    else
    {
        binmode(OUT);
    }
    print OUT $dat;
    close OUT;
}


# Remove tables the user doesn't want:

for my $tag (@deletes)
{
    delete $f->{$tag} if defined $f->{$tag};
}

# Complete import of tables

for my $tag (keys %importeddata)
{
    # Create, if it doesn't exist, the tables we are going to replace
    $f->{$tag} = Font::TTF::Table->new (PARENT => $f, NAME => $tag); # unless exists $f->{$tag};
    
    # Use in-memory file
    my $fh = IO::String->new($importeddata{$tag}) ;
    unless ($fh)
    {
    	warn "Couldn't open memory file for $tag ";
    	next;
    }
    binmode $fh;
    $f->{$tag}{' INFILE'} = $fh;
    $f->{$tag}{' OFFSET'} = 0;
    $f->{$tag}{' LENGTH'} = bytes::length($importeddata{$tag});
    
    # Now we can set the data
    # $f->{$tag}{' dat'} = $importeddata{$tag};
    # $f->{$tag}{' read'} = 0;    # Make sure ' dat' is written to file. (Fix this up for CHAIN_CALL)
}

# Finally rebuild any tables in the update list

my $needupdate;
for my $tag (@updates)
{
	next unless defined $f->{$tag};
	$needupdate=1;
	$f->{$tag}->read->dirty;
	if ($tag eq 'glyf')
	{
		# Special processing for glyf table: read and dirty every glyph
		for my $gid (0 .. $f->{'head'}{'maxGlyphs'}-1)
		{
			$f->{'loca'}{'glyphs'}[$gid]->read_dat;
		}
	}
}
$f->update if $needupdate;

unless ($CHAIN_CALL)
{ 
    $f->out($ARGV[1]) || die "Can't write to font file '$ARGV[1]'. Do you have it installed?" if defined $ARGV[1]; 
}



#])}

__END__

=head1 TITLE

ttftable - import, export, or delete TrueType font tables

=head1 SYNOPSIS

ttftable [options] infile.ttf [outfile.ttf]

Opens infile.ttf for reading, optionally imports, exports, and/or deletes tables from the font, 
then writes the modified font to outfile.ttf if provided.

=head1 OPTIONS

  -export tag          Name of table to export to default datafile
  -export "tag=fname"  Name of table to export and optional datafile name
  -import tag          Name of table to import from default datafile
  -import "tag=fname"  Name of table to import and optional datafile name
  -delete tag[,tag...] List of tables to remove from font
  -update tag[,tag...] Force a re-build of the named tables 
  -list                Write a list of table tags from infile.ttf to STDOUT
  -text                Use text mode i/o for datafiles 
  -help                Help

Option names may be abbreviated; -export, -import, and -delete options may be repeated.
    
=head1 DESCRIPTION

After opening font file infile.ttf, ttftable can export one or more of the 
truetype tables to separate files, import one or more font tables from 
separate files, and/or delete specified tables from the font. 

Changes are written to outfile.ttf if supplied.

Tables are identified by their four-character tag. For the -delete and -update options,
more than one table tag can be supplied, and the following (case 
insensitive) magic words can also be used:

  graphite  delete SIL Graphite tables (Silf Feat Gloc Glat Sill Sile)
  volt      delete Microsoft VOLT tables (TSIV TSID TSIP TSIS)
  opentype  delete OpenTYpe tables (GDEF GSUB GPOS)

The parameter to -export and -import is a table tag optionally followed by
equals sign and a filename. If the filename is not provided, ttftable
makes up a file name by appending ".I<tagname>.dat" to the input
font file name. CAUTION: Windows users should
include quotes around parameters of the form tag=fname.

-update is a debugging tool that forces the named tables to be read in detail, then
"dirties" them, and finally updates the font. This should bring the font into consistent 
state if it wasn't before. Note that updating the 'glyf' table will cause every 
glyph to be read and parsed and then reconstructed, taking significantly more time.

Font tables such as TSIV that contain text use various conventions for line ending. 
During -export, the -text option will convert any line-endings in the font data to what is needed by 
your platform. During -import, the -text option simply converts your platform line endings
to newline (\n) character, which may not be what you want, so use with caution.

Arrangements of command lines options that import and export the same
table and/or the same data file will "do the right thing" except that
external files can contain only one table.

=cut
