/usr/share/perl5/Font/TTF/Dumper.pm is in libfont-ttf-perl 1.04-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 | package Font::TTF::Dumper;
=head1 NAME
Font::TTF::Dumper - Debug dump of a font datastructure, avoiding recursion on ' PARENT'
=head1 SYNOPSIS
use Font::TTF::Dumper;
# Print a table from the font structure:
print ttfdump($font->{$tag});
# Print font table with name
print ttfdump($font->{'head'}, 'head');
# Print one glyph's data:
print ttfdump($font->{'loca'}->read->{'glyphs'}[$gid], "glyph_$gid");
=head1 DESCRIPTION
Font::TTF data structures are trees created from hashes and arrays. When trying to figure
out how the structures work, sometimes it is helpful to use Data::Dumper on them. However,
many of the object structures have ' PARENT' links that refer back to the object's parent,
which means that Data::Dumper ends up dumping the whole font no matter what.
The purpose of this module is to do just one thing: invoke Data::Dumper with a
filter that skips over the ' PARENT' element of any hash.
To reduce output further, this module also skips over ' CACHE' elements and any
hash element whose value is a Font::TTF::Glyph or Font::TTF::Font object.
(Really should make this configurable.)
=cut
use strict;
use Data::Dumper;
use vars qw(@EXPORT @ISA);
require Exporter;
@ISA = qw( Exporter );
@EXPORT = qw( ttfdump );
my %skip = ( Font => 1, Glyph => 1 );
sub ttfdump
{
my ($var, $name) = @_;
my $res;
my $d = Data::Dumper->new([$var]);
$d->Names([$name]) if defined $name;
$d->Sortkeys(\&myfilter); # This is the trick to keep from dumping the whole font
$d->Indent(3); # I want array indicies
$d->Useqq(1); # Perlquote -- slower but there might be binary data.
$res = $d->Dump;
$d->DESTROY;
$res;
}
sub myfilter
{
my ($hash) = @_;
my @a = grep {
($_ eq ' PARENT' || $_ eq ' CACHE') ? 0 :
ref($hash->{$_}) =~ m/^Font::TTF::(.*)$/ ? !$skip{$1} :
1
} (keys %{$hash}) ;
# Sort numerically if that is reasonable:
return [ sort {$a =~ /\D/ || $b =~ /\D/ ? $a cmp $b : $a <=> $b} @a ];
}
1;
=head1 AUTHOR
Bob Hallissy L<Bob_Hallissy@sil.org>
=head1 LICENSING
Copyright (c) 1998-2013, SIL International (http://www.sil.org)
This module 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
|