home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / perl5 / Debian / Defoma / FontCache.pm < prev    next >
Encoding:
Perl POD Document  |  2006-06-17  |  3.3 KB  |  183 lines
  1. package Debian::Defoma::FontCache;
  2. use strict;
  3. use POSIX;
  4. use FileHandle;
  5.  
  6. my $Rootdir = '';
  7.  
  8. sub initialize {
  9.     $Rootdir = shift;
  10. }
  11.  
  12. sub new {
  13.     my $class = shift;
  14.     my $c;
  15.  
  16.     my $o = {
  17.     category => shift,
  18.     updated => 0,
  19.     cache_list => {},
  20.     fcache_list => {},
  21.     ucache_list => {},
  22.     rootdir => shift
  23.     };
  24.  
  25.     $o->{rootdir} = $Rootdir unless (defined($o->{rootdir}));
  26.  
  27.     bless $o;
  28.     return $o;
  29. }
  30.  
  31. sub read {
  32.     my $o = shift;
  33.     my $c = $o->{category};
  34.     my $rootdir = $o->{rootdir};
  35.  
  36.     my $file = "$rootdir/$c.font-cache";
  37.     my $fh = new FileHandle($file, "r");
  38.     if (defined($fh)) {
  39.     while (<$fh>) {
  40.         chomp($_);
  41.         $_ =~ /^([^ ]+)[ ]+(.*)$/;
  42.         $o->{cache_list}->{$1} = $2;
  43.     }
  44.     $fh->close();
  45.     }
  46.     
  47.     $file = "$rootdir/$c.failed-font-cache";
  48.     $fh = new FileHandle($file, "r");
  49.     if (defined($fh)) {
  50.     while (<$fh>) {
  51.         chomp($_);
  52.         $_ =~ /^([^ ]+) ([^ ]+) ([^ ]+)$/;
  53.         unless (exists($o->{fcache_list}->{$1})) {
  54.         $o->{fcache_list}->{$1} = {};
  55.         }
  56.         $o->{fcache_list}->{$1}->{$2} = $3;
  57.     }
  58.     $fh->close();
  59.     }
  60.  
  61.     $file = "$rootdir/$c.user-font-cache";
  62.     $fh = new FileHandle($file, "r");
  63.     if (defined($fh)) {
  64.     while (<$fh>) {
  65.         chomp($_);
  66.         $o->{ucache_list}->{$_} = undef;
  67.     }
  68.     $fh->close();
  69.     }
  70.  
  71.     return 0;
  72. }
  73.  
  74. sub write {
  75.     my $o = shift;
  76.     my $c = $o->{category};
  77.     my $rootdir = $o->{rootdir};
  78.     my ($a, $max, $f);
  79.     my @fonts;
  80.  
  81.     my $file = "$rootdir/$c.font-cache";
  82.     my $fh = new FileHandle($file, "w");
  83.     if (defined($fh)) {
  84.     @fonts = keys(%{$o->{cache_list}});
  85.     foreach $f (@fonts) {
  86.         $fh->print($f, ' ', $o->{cache_list}->{$f}, "\n");
  87.     }
  88.     $fh->close();
  89.     }
  90.     unlink($file) unless(-s $file);
  91.  
  92.     $file = "$rootdir/$c.failed-font-cache";
  93.     $fh = new FileHandle($file, "w");
  94.     if (defined($fh)) {
  95.     @fonts = keys(%{$o->{fcache_list}});
  96.     foreach $f (@fonts) {
  97.         my @apps = keys(%{$o->{fcache_list}->{$f}});
  98.         foreach $a (@apps) {
  99.         $fh->print($f, ' ', $a, ' ', $o->{fcache_list}->{$f}->{$a},
  100.                "\n");
  101.         }
  102.     }
  103.     $fh->close();
  104.     }
  105.     unlink($file) unless(-s $file);
  106.  
  107.     $file = "$rootdir/$c.user-font-cache";
  108.     $fh = new FileHandle($file, "w");
  109.     if (defined($fh)) {
  110.     @fonts = keys(%{$o->{ucache_list}});
  111.     foreach $f (@fonts) {
  112.         $fh->print($f, "\n");
  113.     }
  114.     $fh->close();
  115.     }
  116.     unlink($file) unless(-s $file);
  117.  
  118.     return 0;
  119. }
  120.  
  121. sub add_font {
  122.     my $o = shift;
  123.     my $font = shift;
  124.     my @hints = @_;
  125.  
  126.     $o->{cache_list}->{$font} = join(' ', @hints);
  127.     $o->{updated} = 1;
  128.  
  129.     return 0;
  130. }
  131.  
  132. sub add_failed {
  133.     my $o = shift;
  134.     my $f = shift;
  135.     my $a = shift;
  136.     my $e = shift;
  137.  
  138.     $o->{fcache_list}->{$f} = {} unless (exists($o->{fcache_list}->{$f}));
  139.     $o->{fcache_list}->{$f}->{$a} = $e;
  140.     
  141.     return 0;
  142. }
  143.  
  144. sub add_user {
  145.     my $o = shift;
  146.     my $f = shift;
  147.  
  148.     $o->{ucache_list}->{$f} = undef;
  149. }
  150.  
  151. sub remove_font {
  152.     my $o = shift;
  153.     my $f = shift;
  154.  
  155.     delete($o->{cache_list}->{$f});
  156.     $o->{updated} = 1;
  157.  
  158.     return 0;
  159. }
  160.  
  161. sub remove_failed {
  162.     my $o = shift;
  163.     my $f = shift;
  164.     my $a = shift;
  165.  
  166.     if (exists($o->{fcache_list}->{$f}->{$a})) {
  167.     delete($o->{fcache_list}->{$f}->{$a});
  168.     return 1;
  169.     }
  170.     return 0;
  171. }
  172.  
  173. sub remove_user {
  174.     my $o = shift;
  175.     my $f = shift;
  176.  
  177.     if (exists($o->{ucache_list}->{$f})) {
  178.     delete($o->{ucache_list}->{$f});
  179.     }
  180. }
  181.  
  182. 1;
  183.