#!/usr/bin/perl

use strict;
use Font::TTF::Useall;
use IO::File;
use Pod::Usage;

# Can't use GetOpt variants because of the funky syntax of -m and -M  (see perlrun)

my (@modules, $prog, $opt_v, $output, $exe);

while(scalar (@ARGV) >= 0)
{
    my $arg = shift;
    if ($arg =~ /^-\?/o)
    {
        pod2usage( -verbose => 2, -noperldoc => 1);
        exit;
    }
    
    if ($arg =~ /^-([mM])([^-].*)$/o)
    { push @modules, [ $1, $2 ]; }  # Save -m or -M and their args for later
    elsif ($arg =~ /^-e$/o)
    { $prog .= shift() . "\n"; }    # Concatinate -e arguments -- that's the user's program.
    elsif ($arg =~ /^-o(.*)$/o)
    {
        die "Only one -o option allowed." if defined $output;
        $output = $1 || shift;      # Remember outputfile
    }
    elsif ($arg =~ m/^-v$/o)
    { $opt_v = 1; }
    else
    {
        unshift (@ARGV, $arg);
        last;
    }
}

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

# 'require' modules specified on -m or -M  -- this is intended to mimic what perl -m or perl -M does

foreach (@modules)
{
    my ($c, $m) = @{$_};    # $c is either 'm' or 'M'; $m is the module name plus any extra info user gave
    
    $m =~ s/^\s+//o;
    $m =~ s/\s+$//o;
    
    my $res;
        
    if ($m =~ /^(\S+)\s*=\s*(.*)$/o)        # 'module=something'
    {
        eval "\$res = require $1; $1->import(split(/,/,'$2'));" ;
    }
    elsif ($m =~ /^(\S+)\s+(.*)$/o)         # 'module something'
    {
        eval "\$res = require $1; $1->import($2);" ;
    }
    else                                    # 'module'  
    {
        eval "\$res = require $m; $m->import unless \$c eq 'm';"  ;
    }   
    die "Couldn't find module '$m'\n" unless $res;
}


# Open the font:
my ($f);

unless (defined $prog)
{
    # Take first next argument as a script
    $prog = shift @ARGV;
    my ($fh) = IO::File->new("< $prog") || die "Can't open '$prog': ";
    local $/;
    $prog = <$fh>;
    $fh->close;
}
{
    no strict;
    $exe = eval "sub{ $prog }" if ($prog ne "");
    die $@ if $@;
}
$output =~ s|\\|/|og;
my ($out_rep) = $output;
my ($i);
$out_rep =~ s/[?*]/'$m[' . ($i++) . ']'/oge;


foreach my $a (@ARGV)
{
    $a =~ s|\\|/|og;
    my ($sub) = $a;
    $sub =~ s/\*/([^.]*)/og;
    $sub =~ s/\?/(.?)/og;

    foreach my $infile (glob($a))
    {
        my (@m) = ($infile =~ m/$sub/g);
        my ($outfile);

        if ($output && -d $output)        # then get filename and append
        {
            if ($infile =~ m|[\\/]([^/\\]+)$|o)
            { $outfile = "$output/$1"; }
            else
            { $outfile = "$output/$infile"; }
        }
        elsif ($output)                  # replace wildcards with corresponding wildcard matches
        { $outfile = eval "\"$out_rep\""; }

        print STDERR "$infile -> $outfile\n" if ($opt_v);

        $f = Font::TTF::Font->open($infile) || die "Can't open font file '$infile': $!\n";

# Invoke user's script, if any:
        eval $exe->($infile, $outfile) if $prog;

# Write the resultant font if requested
        if ($outfile)
        {
            $f->update;
            $f->out($outfile) || die "Failed writing output font file '$outfile': $!\n";
        }
        $f->release;
    }
}

=head1 NAME

ttfeval - wrapper for short L<Font::TTF> hacks

=head1 SYNOPSIS

ttfeval [options] [progfile] infont.ttf ...

=head1 OPTIONS

=over 

=item B<-m>module

=item B<-M>module

=item B<-M>'module ...'

=item B<-[mM]>module=arg[,arg]...

=item B<-e> commandline

work essentially like the same options for Perl. If no B<-e> options are provided, the B<progfile> argument 
specifies the name of a file containing code to be executed. See L<perlrun>.

=item B<-o> outfont

Indicates that you want an output font written, and names the font file. May take globs or be a directory.

=item B<-?>

Verbose help.

=back

=head1 DESCRIPTION

ttfeval is a wrapper for those one- or two-line font hacks. It does
the work of including the Font::TTF module, opening the input font file, 
and optionally writing the output font file. You just supply the code in the middle.
For example, to list out all the glyph names of a font, use:

 ttfeval -e 'print join("\n",@{$f->{'post'}->read->{'VAL'}});' myfont.ttf

Like the perl command line, you can specify multiple B<-e> options to build up a 
multiline program, and you can include additional modules via the B<-m> and B<-M> options.

When the caller-supplied expression is executed, B<$f> holds the result of 
the Font::TTF::Font->open() function and elements of B<@ARGV> up to and including
the input font name have been deleted -- you can use any remaining arguments
for your own purposes.  B<@_> holds the names of the 
names of the input and optional output font files -- changing B<$_[0]> has no
effect, but setting or clearing B<$_[1]> will change the output.

Globbing of file names is permitted:

 ttfeval -e 'print $f->{'name'}->read->find_name(4) . "\n"' *.ttf

including the output name:

 ttfeval ... -o x*.ttf *.ttf

=head1 AUTHOR

Martin Hosken L<http://scripts.sil.org/FontUtils>.
(see CONTRIBUTORS for other authors).

=head1 LICENSING

Copyright (c) 1998-2016, SIL International (http://www.sil.org)

This script is released under the terms of the Artistic License 2.0.
For details, see the full text of the license in the file LICENSE.

=cut