Your IP : 216.73.216.155

Current Path : /usr/share/defoma/scripts/
Upload File :
Current File : //usr/share/defoma/scripts/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);

my %UpdatedDirectories = ();

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 dirname {
   my $path = shift;

   $path =~ s/\/[^\/]*$//;
   return $path;
}

sub do_install_real {
  my $font = shift;
  my $id = shift;

  my $dir = dirname ($font);
  $UpdatedDirectories{$dir} = 1;
  return 0;
}

sub do_remove_real {
  my $font = shift;
  my $id = shift;

  my $dir = dirname ($font);
  $UpdatedDirectories{$dir} = 1;

  return 0;
}

sub fontconfig_dirs {
   my %dirs = ();
   
   system ('fc-cache', '-s');
   open my $file, "fc-list : file |" or return ();
   while (<$file>) {
   	my $dir = dirname ($_);
	if (!exists $dirs{$dir}) {
	    $dirs{$dir} = 1;
	}
    }
    close $file;
    return %dirs;
}

#
# Clean up from old fontconfig defoma mechanism which
# placed symlinks to each fontfile in the fontconfig.d directory
#
sub clean_oldstyle_dirs {
   opendir (DIR, $PkgDir) or return 1;
   my @dirs = grep { /^[^.]/ && -d "$PkgDir/$_" } readdir (DIR);
   closedir DIR;
   foreach my $dir (@dirs) {
       my $subdir = "$PkgDir/$dir";
       if (opendir (DIR, $subdir)) {
	  my @files = grep { /^[^.]/ && -l "$subdir/$_" } readdir (DIR);
	  closedir DIR;
	  foreach my $file (@files) {
	     if ( -l "$subdir/$file" ) {
	     	unlink "$subdir/$file";
	     }
	  }
	  rmdir $subdir;
       }
   }
}

sub term {
  return unless $Id;

  -e "/etc/fonts/fonts.conf" or return 0;
 
  clean_oldstyle_dirs ();
  #
  # Update modified directories
  #
  
  my @dirs = keys (%UpdatedDirectories);
  if (@dirs) {
      print "Updating fontconfig cache for @dirs\n";
      system ("fc-cache", "-f", @dirs);
      #
      # make sure caches leading to new directories are updated
      #
      system ("fc-cache", "-s");
  }
  
  # Empty our config file to see
  # which directories are reachable without it

  open my $smash_fh, '>', "$PkgDir/fonts.conf" or return 1;
  print $smash_fh <<EOF;
<?xml version="1.0"?>
<!DOCTYPE fontconfig SYSTEM "/etc/fonts/fonts.dtd">
<!-- autogenerated by fontconfig.defoma -->
<fontconfig>
</fontconfig>
EOF
  close $smash_fh;
  my %dirs = fontconfig_dirs ();

  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>
EOF

  # directories
  my %newdirs = ();

  foreach (defoma_id_get_font($Id, installed => type => 'SrI')) {
    my $dir = dirname($Id->{e_font}->[$_]);
    if (!exists $dirs{$dir} && !exists $newdirs{$dir}) {
       print $fh "   <dir>$dir</dir>\n";
       $newdirs{$dir} = 1;
    }
  }

  # 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", "-s");
  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;