view release on metacpan or  search on metacpan

scripts/ttf2woff  view on Meta::CPAN

#!/usr/bin/perl

use strict;
use Font::TTF::Font;
use IO::String;
use Getopt::Std;
use Pod::Usage;
use Compress::Zlib;

my %opts;
our ($if);
my ($string);
our ($CHAIN_CALL);
my ($ofh);

unless ($CHAIN_CALL)
{
    getopts('chm:p:v:', \%opts);

    unless (defined $ARGV[1] || defined $opts{'h'})
    {
        pod2usage(1);
        exit;
    }

    if ($opts{'h'})
    {
        pod2usage( -verbose => 2, -noperldoc => 1);
        exit;
    }

    $if = Font::TTF::Font->open($ARGV[0]);
}

my $iswoff = exists $if->{' WOFF'};
# For now, just quit if input font is already a woff.
# Someone else may want to add this functionality later
# but it will involve decompressing tables to confirm the checksums

die "input font is already a woff font\n" if $iswoff;

if ($opts{'c'})
{
	# Force checksum recalcuation by copying font
	
	# If font has non-empty DSIG, delete it first:
	my $dsig = $if->{'DSIG'};
	delete $if->{'DSIG'} if ($dsig && !$dsig->isempty);
	
	#Copy the rest of the font to string file:
    my ($tfh) = IO::String->new($string);
    my (@tlist) = sort {$if->{$a}{' OFFSET'} <=> $if->{$b}{' OFFSET'}}
                    grep(length($_) == 4, keys %{$if});
    $if->out($tfh, @tlist);
    
    # release original font to free up memory:
    $if->{'DSIG'} = $dsig if $dsig;
    $if->release;
    
    # Now open copied font:
    $tfh = IO::String->new($string);
    $if = Font::TTF::Font->open($tfh);
}

my $cWarnings = 0;

$ofh = IO::File->new("> $ARGV[1]") || die "Can't open $ARGV[1] for writing";
binmode $ofh;

# re-read the header to initialize font-wide csum

my ($msum);

my $ntables = 0;
map {$ntables++ if length($_) == 4} keys %{$if};
$if->{' INFILE'}->seek($if->{' OFFSET'}, 0);
$if->{' INFILE'}->read($msum, 12 + $ntables * 16);
$msum = unpack('%32N*', $msum); 

my (%whdr);
my (@tlist) = sort {$if->{$a}{' OFFSET'} <=> $if->{$b}{' OFFSET'}}
                    grep(length($_) == 4, keys %{$if});
my (@trmap) = sort {$tlist[$a] cmp $tlist[$b]} (0 .. $#tlist);
my ($t, @tmap);
foreach (@trmap) { $tmap[$_] = $t++; }
$whdr{'num'} = scalar @tlist;
$whdr{'total'} =  12 + $whdr{'num'} * 16;
if ($opts{'v'})
{
    ($whdr{'major'}, $whdr{'minor'}) = ($opts{v} =~ /(\d+)(?:\.(\d+))/);
}
out_whdr($ofh, \%whdr);
my ($curroffset) = align4($ofh, $ofh->tell());
for (my $i = 0; $i < $whdr{'num'}; $i++)
{
    my (%d);
    my ($n) = $tlist[$i];
    my ($t) = $if->{$n};
    my ($idat, $odat);
    my ($csum);

    $whdr{'dir'}[$tmap[$i]] = \%d;
    $whdr{'total'} += ($t->{' LENGTH'} + 3) & ~3;
    $d{'tag'} = $n;
    $d{'offset'} = $curroffset;
    $d{'orglen'} = $t->{' LENGTH'};
    $d{'csum'} = $t->{' CSUM'};
    if ($t->{' OFFSET'} & 3)
    { warn "table '$n' isn't long-aligned\n"; $cWarnings++;}
    $t->{' INFILE'}->seek($t->{' OFFSET'}, 0);
    $t->{' INFILE'}->read($idat, $t->{' LENGTH'});
    # Pad string and verify checksum:
    $odat = $idat;
    $odat .= substr("\000" x 4, $t->{' LENGTH'} & 3) if  $t->{' LENGTH'} & 3; 
    $csum = unpack('%32N*', $odat); 
    if ($n eq 'head')
    {