home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / perl5 / Debian / Defoma / User.pm < prev   
Encoding:
Perl POD Document  |  2006-06-17  |  2.4 KB  |  104 lines
  1. package Debian::Defoma::User;
  2.  
  3. use strict;
  4. use POSIX;
  5. use Exporter;
  6.  
  7. use vars qw(@EXPORT @EXPORT_OK @ISA);
  8.  
  9. use Debian::Defoma::Font;
  10. use Debian::Defoma::Common;
  11. import Debian::Defoma::Common qw(&readfile &writefile);
  12.  
  13. @ISA = qw(Exporter);
  14.  
  15. @EXPORT = qw(&defoma_user_update_dotfile);
  16. @EXPORT_OK = qw(&defoma_user_init &defoma_user_update_font);
  17.  
  18. my %SystemFontUpdateTime;
  19. my $SystemUpdateTime;
  20. my $SystemRoot = DEFOMA_TEST_DIR . "/var/lib/defoma";
  21.  
  22. sub defoma_user_init {
  23.     &Debian::Defoma::Configure::read_status_cache($SystemRoot);
  24.  
  25.     &Debian::Defoma::Configure::get_status(\%SystemFontUpdateTime,
  26.                        \$SystemUpdateTime);
  27.     
  28.     &Debian::Defoma::Configure::clear_app_info();
  29. }
  30.  
  31. sub defoma_user_update_font {
  32.     my %UserFontUpdateTime;
  33.     my $UserUpdateTime;
  34.  
  35.     &Debian::Defoma::Configure::get_status(\%UserFontUpdateTime,
  36.                        \$UserUpdateTime);
  37.  
  38.     my @cs = ();
  39.     foreach my $c (keys(%SystemFontUpdateTime)) {
  40.     unless (defined($UserFontUpdateTime{$c}) &&
  41.         $UserFontUpdateTime{$c} >= $SystemFontUpdateTime{$c}) {
  42.         push(@cs, $c);
  43.     }
  44.     }
  45.  
  46.     if (@cs) {
  47.     printm("Following font categories are updated in system: @cs");
  48.     printm("Updating ", USERLOGIN, "'s font caches...");
  49.  
  50.     foreach my $c (@cs) {
  51.         printm(" Updating category $c..");
  52.  
  53.         my $sfobj = new Debian::Defoma::FontCache($c, $SystemRoot);
  54.         $sfobj->read();
  55.         my $ufobj = defoma_font_get_object($c);
  56.         $ufobj->{updated} = 1;
  57.         
  58.         foreach my $f (keys(%{$ufobj->{cache_list}})) {
  59.         if (! exists($sfobj->{cache_list}->{$f}) &&
  60.             ! exists($ufobj->{ucache_list}->{$f})) {
  61.             defoma_font_unregister($c, $f);
  62.         }
  63.         }
  64.  
  65.         foreach my $f (keys(%{$sfobj->{cache_list}})) {
  66.         if (! exists($ufobj->{ucache_list}->{$f})) {
  67.             my @hints = split(' ', $sfobj->{cache_list}->{$f});
  68.             $Debian::Defoma::Font::Userspace = 0;
  69.             defoma_font_reregister($c, $f, @hints);
  70.         }
  71.         }
  72.     }
  73.     } else {
  74.     printm("All font categories are configured up-to-date for ",
  75.            USERLOGIN, ".");
  76.     }
  77. }
  78.     
  79. sub defoma_user_update_dotfile {
  80.     my $filename = shift;
  81.     my $begin = shift;
  82.     my $end = shift;
  83.  
  84.     my @r = readfile(HOMEDIR . "/$filename");
  85.     my @w = ();
  86.  
  87.     my $flag = 0;
  88.     foreach my $l (@r) {
  89.     if (defined($begin) && $begin ne '' && $begin eq $l) {
  90.         $flag = 1;
  91.     } elsif (defined($end) && $end ne '' && $end eq $l) {
  92.         $flag = 0;
  93.     } elsif ($flag == 0) {
  94.         push(@w, $l);
  95.     }
  96.     }
  97.  
  98.     push(@w, $begin, @_, $end);
  99.  
  100.     writefile(HOMEDIR . "/$filename", @w);
  101. }
  102.  
  103. 1;
  104.