#!/usr/bin/perl -w

use strict;
use Getopt::Long;
use File::Copy;
use File::Basename;

my $config="/usr/local/share/t1lib-0.9/t1lib.config";

unless(GetOptions("config=s"=>\$config))
{
    print <<HELP;
$0: usage
    --config [file] t1lib config file
                   ($config)
HELP
    exit 1;
}

##########################################################
## Read the t1lib config file
open CFG, $config or die "Unable to open $config: $!\n";
my(@afm, @type1, $fontdatabase);
while(<CFG>)
{
    chomp;
    if(/^FONTDATABASE=(.+)$/)
    {
        $fontdatabase=$1;
    } elsif(/^AFM=(.+)$/)
    {
        @afm=grep {$_ ne '.'} split ':', $1;
    } elsif(/^TYPE1=(.+)$/)
    {
        @type1=grep {$_ ne '.'} split ':', $1;
    } 
}
close CFG;

##########################################################
## Find the equiv AFM dir for a font dir
my($match, %afm_equivs, $len, $common);
foreach my $fdir (@type1)
{
    $len=-1;
    $match='';
    foreach my $adir (@afm)
    {
        $common=common_prefix($fdir, $adir);
        if($len < $common)
        {
            $match=$adir;
            $len=$common;
        }
    }
    $afm_equivs{$fdir}=$match if $match;
}


##########################################################
## Scan for font files...
my(@fonts, @fontlist, %already, $font);
foreach my $dir (@type1)
{
    print "**** $dir\n";
    opendir FONTS, $dir or die "Unable to open $dir: $!\n";
    @fonts=readdir FONTS;
    closedir FONTS;
    @fonts=grep /\.pf[ab]$/, @fonts;

    foreach $font (@fonts)
    {
        next if $already{$font};
        build_afm($font, $dir, \@afm, \%afm_equivs);
        push @fontlist, $font;
        $already{$font}=1;
    }
}

##########################################################
## Build the FontDataBase
rename $fontdatabase, $fontdatabase.".bk" 
    or die "Unable to rename $fontdatabase to $fontdatabase.bk: $!\n";

open FDB, '>'.$fontdatabase
    or die "Unable to open $fontdatabase: $!\n";
print FDB join "\n", scalar(@fontlist), @fontlist, '';

close FDB;


##########################################################
sub build_afm
{
    my($font, $dir, $afmlist, $afm_equivs)=@_;
    my $afm;
    my $aname=$font;
    $aname=~s/\.pf[ab]$/.afm/;

    foreach my $adir (@$afmlist)
    {
        next unless(-e "$adir/$aname");
        $afm=$adir;
        last;        
    }

    $afm||=$afm_equivs->{$dir};
    $afm||=$afmlist->[0];           # this can't happen :)
    unless($afm)
    {
        die "Find the afm dir for $dir/$font\nLooked in ".join ", ", @$afmlist;
    }

    $afm.='/'.$aname;

    my $f_time=(stat("$dir/$font"))[9];
    if(-r $afm)
    {
        my $a_time=(stat($afm))[9];
        return if $a_time > $f_time;
    }

    print "Generating AFM for $dir/$font\n";
    my $a_src;
    open T1AFM, "type1afm $dir/$font|" 
        or die "Unable to launch type1afm: $!\n";
    while(<T1AFM>)
    {
        chomp;
        next unless(/Loading (.+?)\.pf[ab] ... finished/);
        $a_src=$1.'.afm';
    }
    close T1AFM;
    
    unless($a_src)
    {
        warn "Unable to produce AFM for $dir/$font\n";
        return;
    }
    copy($a_src, $afm) 
        or die "Unable to copy $a_src to $afm: $!\n";
    unlink $a_src
        or die "Unable to unlink $a_src: $!\n";
    print "AFM is $afm\n";
    return 1;
}

##########################################################
sub common_prefix
{
    my($one, $two)=@_;
    my $l=length($one);
    return $l if $two eq $one;
    $l=length($two) if $l > length($two);
    for(my $q=0; $q<$l ; $q++)
    {
        return $q if substr($one, $q, 1) ne substr($two, $q, 1);
    }
    return $l;
}