debian/fontconfig.defoma

# -*- 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;