debian/fontconfig.defoma

   1 # -*- perl -*-
   2 # Defoma configuration script for fontconfig
   3 # Copyright © 2003 Angus Lees <gus@debian.org>
   4 # This file is hereby placed into the public domain.
   5
   6 @ACCEPT_CATEGORIES = qw(type1 truetype cid);
   7 # .. and any other categories supported by freetype
   8
   9 package fontconfig;
  10
  11 use Debian::Defoma::Common;
  12 use Debian::Defoma::Id;
  13 use Debian::Defoma::Subst;
  14
  15 use strict;
  16 use warnings;
  17
  18 my $PkgDir = "$ROOTDIR/fontconfig.d";
  19 my ($Id, $Sb);
  20
  21 sub init {
  22   $Id ||= defoma_id_open_cache() or return 1;
  23   $Sb ||= defoma_subst_open(rulename => 'fontconfig',
  24                             threshold => 70,
  25                             idobject => $Id) or return 1;
  26
  27   return 0;
  28 }
  29
  30 sub register {
  31   my $font = shift;
  32   my $hints = parse_hints_start(@_);
  33
  34   return 1 unless $hints->{FontName};
  35
  36   my $priority = $hints->{Priority} || 20;
  37   my ($fontname) = split / +/, $hints->{FontName};
  38   my @alias = split / +/, $hints->{Alias} if $hints->{Alias};
  39
  40   defoma_id_register($Id, type => 'real', font => $font,
  41                      id => $fontname, priority => $priority,
  42                      hints => join(' ', @_));
  43
  44   foreach my $alias (@alias) {
  45     defoma_id_register($Id, type => 'alias', font => $font,
  46                        id => $alias, priority => $priority,
  47                        origin => $fontname);
  48   }
  49
  50   defoma_subst_register($Sb, $font, $fontname);
  51
  52   return 0;
  53 }
  54
  55 sub unregister {
  56   my $font = shift;
  57   defoma_subst_unregister($Sb, $font);
  58   defoma_id_unregister($Id, type => 'alias', font => $font);
  59   defoma_id_unregister($Id, type => 'real', font => $font);
  60   return 0;
  61 }
  62
  63 sub do_install_real {
  64   my $font = shift;
  65   my $id = shift;
  66
  67   my $dir = $PkgDir . '/' . substr($id, 0, 1);
  68   my $ext = $font =~ m|\.([^/.]+)$| ? ".$1" : '';
  69   my $file = $id . $ext;
  70
  71   mkdir $dir;
  72   symlink $font, "$dir/$file" or return 1;
  73
  74   return 0;
  75 }
  76
  77 sub do_remove_real {
  78   my $font = shift;
  79   my $id = shift;
  80
  81   my $dir = $PkgDir . '/' . substr($id, 0, 1);
  82   my $ext = $font =~ m|\.([^/.]+)$| ? ".$1" : '';
  83   my $file = $id . $ext;
  84
  85   unlink "$dir/$file" or return 1;
  86   rmdir $dir;                   # ignore failure
  87
  88   return 0;
  89 }
  90
  91 sub term {
  92   return unless $Id;
  93
  94   open my $fh, '>', "$PkgDir/fonts.conf" or return 1;
  95
  96   print $fh <<EOF;
  97 <?xml version="1.0"?>
  98 <!DOCTYPE fontconfig SYSTEM "/etc/fonts/fonts.dtd">
  99 <!-- autogenerated by fontconfig.defoma -->
 100 <fontconfig>
 101    <dir>$PkgDir</dir>
 102 EOF
 103
 104   # aliases
 105   foreach (defoma_id_get_font($Id, installed => type => 'SaI')) {
 106     print $fh <<EOF
 107    <alias>
 108       <family>$Id->{e_id}->[$_]</family>
 109       <accept><family>$Id->{e_depid}->[$_]</family></accept>
 110    </alias>
 111 EOF
 112   }
 113
 114   # substituded fonts
 115   foreach (defoma_id_get_font($Id, installed => type => 'SSI')) {
 116     print $fh <<EOF
 117    <alias>
 118       <family>$Id->{e_id}->[$_]</family>
 119       <default><family>$Id->{e_depid}->[$_]</family></default>
 120    </alias>
 121 EOF
 122   }
 123
 124   print $fh "</fontconfig>\n";
 125
 126   close $fh;
 127
 128   defoma_subst_close($Sb);
 129   defoma_id_close_cache($Id);
 130
 131   system('fc-cache', $PkgDir);
 132
 133   return 0;
 134 }
 135
 136 sub main {
 137   my $cmd = shift;
 138
 139   if ($cmd eq 'init') {
 140     init();
 141   } elsif ($cmd eq 'register') {
 142     return register(@_);
 143   } elsif ($cmd eq 'unregister') {
 144     return unregister(@_);
 145   } elsif ($cmd eq 'do-install-real') {
 146     return do_install_real(@_);
 147   } elsif ($cmd eq 'do-remove-real') {
 148     return do_remove_real(@_);
 149   } elsif ($cmd eq 'term') {
 150     return term(@_);
 151   }
 152
 153   0;
 154 }
 155
 156 no warnings;
 157
 158 *truetype  = \&main;
 159 *type1     = \&main;
 160 *cid       = \&main;
 161
 162 1;