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