163 lines
3.3 KiB
Perl
163 lines
3.3 KiB
Perl
# -*- perl -*-
|
|
# Defoma configuration script for fontconfig
|
|
# Copyright © 2003 Angus Lees <gus@debian.org>
|
|
# This file is hereby placed into the public domain.
|
|
|
|
@ACCEPT_CATEGORIES = qw(type1 truetype cid);
|
|
# .. and any other categories supported by freetype
|
|
|
|
package fontconfig;
|
|
|
|
use Debian::Defoma::Common;
|
|
use Debian::Defoma::Id;
|
|
use Debian::Defoma::Subst;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
my $PkgDir = "$ROOTDIR/fontconfig.d";
|
|
my ($Id, $Sb);
|
|
|
|
sub init {
|
|
$Id ||= defoma_id_open_cache() or return 1;
|
|
$Sb ||= defoma_subst_open(rulename => 'fontconfig',
|
|
threshold => 70,
|
|
idobject => $Id) or return 1;
|
|
|
|
return 0;
|
|
}
|
|
|
|
sub register {
|
|
my $font = shift;
|
|
my $hints = parse_hints_start(@_);
|
|
|
|
return 1 unless $hints->{FontName};
|
|
|
|
my $priority = $hints->{Priority} || 20;
|
|
my ($fontname) = split / +/, $hints->{FontName};
|
|
my @alias = split / +/, $hints->{Alias} if $hints->{Alias};
|
|
|
|
defoma_id_register($Id, type => 'real', font => $font,
|
|
id => $fontname, priority => $priority,
|
|
hints => join(' ', @_));
|
|
|
|
foreach my $alias (@alias) {
|
|
defoma_id_register($Id, type => 'alias', font => $font,
|
|
id => $alias, priority => $priority,
|
|
origin => $fontname);
|
|
}
|
|
|
|
defoma_subst_register($Sb, $font, $fontname);
|
|
|
|
return 0;
|
|
}
|
|
|
|
sub unregister {
|
|
my $font = shift;
|
|
defoma_subst_unregister($Sb, $font);
|
|
defoma_id_unregister($Id, type => 'alias', font => $font);
|
|
defoma_id_unregister($Id, type => 'real', font => $font);
|
|
return 0;
|
|
}
|
|
|
|
sub do_install_real {
|
|
my $font = shift;
|
|
my $id = shift;
|
|
|
|
my $dir = $PkgDir . '/' . substr($id, 0, 1);
|
|
my $ext = $font =~ m|\.([^/.]+)$| ? ".$1" : '';
|
|
my $file = $id . $ext;
|
|
|
|
mkdir $dir;
|
|
symlink $font, "$dir/$file" or return 1;
|
|
|
|
return 0;
|
|
}
|
|
|
|
sub do_remove_real {
|
|
my $font = shift;
|
|
my $id = shift;
|
|
|
|
my $dir = $PkgDir . '/' . substr($id, 0, 1);
|
|
my $ext = $font =~ m|\.([^/.]+)$| ? ".$1" : '';
|
|
my $file = $id . $ext;
|
|
|
|
unlink "$dir/$file" or return 1;
|
|
rmdir $dir; # ignore failure
|
|
|
|
return 0;
|
|
}
|
|
|
|
sub term {
|
|
return unless $Id;
|
|
|
|
open my $fh, '>', "$PkgDir/fonts.conf" or return 1;
|
|
|
|
print $fh <<EOF;
|
|
<?xml version="1.0"?>
|
|
<!DOCTYPE fontconfig SYSTEM "/etc/fonts/fonts.dtd">
|
|
<!-- autogenerated by fontconfig.defoma -->
|
|
<fontconfig>
|
|
<dir>$PkgDir</dir>
|
|
EOF
|
|
|
|
# aliases
|
|
foreach (defoma_id_get_font($Id, installed => type => 'SaI')) {
|
|
print $fh <<EOF
|
|
<alias>
|
|
<family>$Id->{e_id}->[$_]</family>
|
|
<accept><family>$Id->{e_depid}->[$_]</family></accept>
|
|
</alias>
|
|
EOF
|
|
}
|
|
|
|
# substituded fonts
|
|
foreach (defoma_id_get_font($Id, installed => type => 'SSI')) {
|
|
print $fh <<EOF
|
|
<alias>
|
|
<family>$Id->{e_id}->[$_]</family>
|
|
<default><family>$Id->{e_depid}->[$_]</family></default>
|
|
</alias>
|
|
EOF
|
|
}
|
|
|
|
print $fh "</fontconfig>\n";
|
|
|
|
close $fh;
|
|
|
|
defoma_subst_close($Sb);
|
|
defoma_id_close_cache($Id);
|
|
|
|
system('fc-cache', $PkgDir);
|
|
|
|
return 0;
|
|
}
|
|
|
|
sub main {
|
|
my $cmd = shift;
|
|
|
|
if ($cmd eq 'init') {
|
|
init();
|
|
} elsif ($cmd eq 'register') {
|
|
return register(@_);
|
|
} elsif ($cmd eq 'unregister') {
|
|
return unregister(@_);
|
|
} elsif ($cmd eq 'do-install-real') {
|
|
return do_install_real(@_);
|
|
} elsif ($cmd eq 'do-remove-real') {
|
|
return do_remove_real(@_);
|
|
} elsif ($cmd eq 'term') {
|
|
return term(@_);
|
|
}
|
|
|
|
0;
|
|
}
|
|
|
|
no warnings;
|
|
|
|
*truetype = \&main;
|
|
*type1 = \&main;
|
|
*cid = \&main;
|
|
|
|
1;
|