EBDT と EBLC を削除する

windows perl

どう見ても現実逃避＆チラ裏です。本当に（ry

#!/usr/bin/perl

use strict;
use warnings;
use POSIX qw( ceil );

my $handle;
if (@ARGV) {
    open $handle, '<', $ARGV[0]
        or die $!;
}
else {
    $handle = \*STDIN;
}
binmode $handle;

my $src_header = read_header($handle);

my $dst_header = trans_header($src_header);

write_header(\*STDOUT, $dst_header);

copy_bodies(\*STDOUT, $dst_header, $handle, $src_header);

close $handle;

exit();

sub read_header {
    my ($src)  = @_;
    my $header = {};
    my $buf;

    read $src, $buf, 4  or  die $!;
    $header->{version} = $buf;

    read $src, $buf, 2+2+2+2  or  die $!;
    ($header->{numTables},
     $header->{searchRange},
     $header->{entrySelector},
     $header->{rangeShift})
        = unpack 'nnnn', $buf;

    my $numTables = $header->{numTables};

    $header->{table} = {};
    $header->{tags}  = [];

    while ($numTables -- > 0) {
        read $src, $buf, 4+4+4+4  or  die $!;
        my $tag = substr $buf, 0, 4, '';
        my ($checkSum, $offset, $length)
            = unpack 'NNN', $buf;

        $header->{table}->{$tag}
            = {
                tag      => $tag,
                checkSum => $checkSum,
                offset   => $offset,
                length   => $length,
            };

        push @{ $header->{tags} }, $tag;
    }

    return $header;
}

sub trans_header {
    my $header = clone_header($_[0]);

    $header->{numTables} -= 2;

    $header->{entrySelector}
        = ceil(log $header->{numTables} / log 2);

    $header->{searchRange}
        = (1 << $header->{entrySelector}) * 16;

    $header->{rangeShift}
        = $header->{numTables} * 16
          - $header->{searchRange};

    my $ebdt = $header->{table}->{EBDT};
    my $eblc = $header->{table}->{EBLC};

    die 'EBDT does not exist'
        if ! defined $ebdt || ! defined $eblc;

    $header->{tags}
        = [
            sort {
                $header->{table}->{$a}->{offset}
                    <=>
                $header->{table}->{$b}->{offset}
            }
            grep {
                $_ ne 'EBDT' && $_ ne 'EBLC'
            }
            @{ $header->{tags} }
          ];

    my $length
        = 4+2+2+2+2 + (4+4+4+4) * $header->{numTables};
    $header->{length} = ceil($length / 4) * 4;
    $header->{trail}  = $header->{length} - $length;

    my $offset = $header->{length};
    foreach my $tag (@{ $header->{tags} }) {
        my $table = $header->{table}->{$tag};

        $table->{offset} = $offset;

        $offset += $table->{length};
        $offset += 3 - ($offset + 3) % 4;
    }

    return $header;
}

sub clone_header {
    my ($src) = @_;
#   use Storable qw( dclone );
#   return dclone($_[0]);

    my $dst = { %$src };

    $dst->{tags} = [ @{ $src->{tags} } ];

    $dst->{table} = {};
    while (my ($tag, $table) = each %{ $src->{table} }) {
        $dst->{table}->{$tag} = { %$table };
    }

    return $dst;
}

sub write_header {
    my ($dst, $header) = @_;

    print {$dst} $header->{version};

    print {$dst}
        pack 'nnnn', $header->{numTables},
                     $header->{searchRange},
                     $header->{entrySelector},
                     $header->{rangeShift};

    foreach my $tag (@{ $header->{tags} }) {
        my $table = $header->{table}->{$tag};

        print {$dst} $tag;
        print {$dst}
            pack 'NNN', $table->{checkSum},
                        $table->{offset},
                        $table->{length};
    }

    print {$dst} "\x00" x $header->{trail};
}

sub copy_bodies {
    my ($dst_handle, $dst_header, $src_handle, $src_header) = @_;

    my $offset = tell $src_handle;

    foreach my $tag (@{ $dst_header->{tags} }) {
        my $table = $src_header->{table}->{$tag};

#       seek $src_handle, $table->{offset} - $offset, 1  or  die $!;
        skip_handle($src_handle, $table->{offset} - $offset);
        $offset = $table->{offset};

        copy_handle($dst_handle, $src_handle, $table->{length});
        $offset += $table->{length};

        my $trail = 3 - ($table->{length} + 3) % 4;
        print {$dst_handle} "\x00" x $trail;
    }
}

sub skip_handle {
    my ($src, $length) = @_;
    my $buf;
    my $unit = 4096;

    while ($length > 0) {
        $unit = $length if $length < $unit;

        read $src, $buf, $unit  or  die $!;

        $length -= $unit;
    }
}

sub copy_handle {
    my ($dst, $src, $length) = @_;
    my $buf;
    my $unit = 4096;

    while ($length > 0) {
        $unit = $length if $length < $unit;

        read $src, $buf, $unit  or  die $!;
        print {$dst} $buf;

        $length -= $unit;
    }
}

使い方は読めばわかりますが

% perl remove_ebdt.pl foobar.ttf > removed.ttf

結果については一切保証しません。

  • どう考えても C で書くべきだけど手元に環境ネー
  • ARGV ってハンドルとしての有用性はイマイチだけどスマートなやり方忘れた；要復習
  • non-seekable なのに対応するのがちょっと大変だった
  • 最初 4 byte alignment 忘れてたんでえらいめに

参考 URL