home *** CD-ROM | disk | FTP | other *** search
/ ftp.f-secure.com / 2014.06.ftp.f-secure.com.tar / ftp.f-secure.com / support / hotfix / fsis / IS-SpamControl.fsfix / iufssc / lib / Mail / SpamAssassin / AICache.pm next >
Text File  |  2006-11-29  |  4KB  |  180 lines
  1. # <@LICENSE>
  2. # Licensed to the Apache Software Foundation (ASF) under one or more
  3. # contributor license agreements.  See the NOTICE file distributed with
  4. # this work for additional information regarding copyright ownership.
  5. # The ASF licenses this file to you under the Apache License, Version 2.0
  6. # (the "License"); you may not use this file except in compliance with
  7. # the License.  You may obtain a copy of the License at:
  8. # 
  9. #     http://www.apache.org/licenses/LICENSE-2.0
  10. # 
  11. # Unless required by applicable law or agreed to in writing, software
  12. # distributed under the License is distributed on an "AS IS" BASIS,
  13. # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  14. # See the License for the specific language governing permissions and
  15. # limitations under the License.
  16. # </@LICENSE>
  17.  
  18. =head1 NAME
  19.  
  20. Mail::SpamAssassin::AICache - provide access to cached information for
  21. ArchiveIterator
  22.  
  23. =head1 SYNOPSIS
  24.  
  25. =head1 DESCRIPTION
  26.  
  27. This module allows ArchiveIterator to use cached atime information instead of
  28. having to read every message separately.
  29.  
  30. =head1 PUBLIC METHODS
  31.  
  32. =over 4
  33.  
  34. =cut
  35.  
  36. package Mail::SpamAssassin::AICache;
  37.  
  38. use File::Spec;
  39. use File::Path;
  40. use File::Basename;
  41.  
  42. use strict;
  43. use warnings;
  44.  
  45. =item new()
  46.  
  47. Generates a new cache object.
  48.  
  49. =cut
  50.  
  51. sub new {
  52.   my $class = shift;
  53.   $class = ref($class) || $class;
  54.  
  55.   my $self = shift;
  56.   if (!defined $self) { $self = {}; }
  57.  
  58.   $self->{cache} = {};
  59.   $self->{dirty} = 0;
  60.   $self->{prefix} ||= '/';
  61.  
  62.   my $use_cache = 1;
  63.  
  64.   # be sure to use rel2abs() here, since otherwise relative paths
  65.   # are broken by the prefix stuff
  66.   if ($self->{type} eq 'dir') {
  67.     $self->{cache_file} = File::Spec->catdir(
  68.                 $self->{prefix},
  69.                 File::Spec->rel2abs($self->{path}),
  70.                 '.spamassassin_cache');
  71.  
  72.     $self->{cache_mtime} = (stat($self->{cache_file}))[9] || 0;
  73.   }
  74.   else {
  75.     my @split = File::Spec->splitpath($self->{path});
  76.     $self->{cache_file} = File::Spec->catdir(
  77.                 $self->{prefix},
  78.                 File::Spec->rel2abs($split[1]),
  79.                 join('_', '.spamassassin_cache', $self->{type}, $split[2]));
  80.  
  81.     $self->{cache_mtime} = (stat($self->{cache_file}))[9] || 0;
  82.  
  83.     # for mbox and mbx, verify whether mtime on cache file is >= mtime of
  84.     # messages file.  if it is, use it, otherwise don't.
  85.     if ((stat($self->{path}))[9] > $self->{cache_mtime}) {
  86.       $use_cache = 0;
  87.     }
  88.   }
  89.   $self->{cache_file} = File::Spec->canonpath($self->{cache_file});
  90.  
  91.   # go ahead and read in the cache information
  92.   if ($use_cache && open(CACHE, $self->{cache_file})) {
  93.     while(defined($_=<CACHE>)) {
  94.       my($k,$v) = split(/\t/, $_);
  95.       next unless (defined $k && defined $v);
  96.       $self->{cache}->{$k} = $v;
  97.     }
  98.     close(CACHE);
  99.   }
  100.  
  101.   bless($self,$class);
  102.   $self;
  103. }
  104.  
  105. sub count {
  106.   my ($self) = @_;
  107.   return keys %{$self->{cache}};
  108. }
  109.  
  110. sub check {
  111.   my ($self, $name) = @_;
  112.  
  113.   return $self->{cache} unless $name;
  114.  
  115.   return if ($self->{type} eq 'dir' && (stat($name))[9] > $self->{cache_mtime});
  116.  
  117.   $name = $self->canon($name);
  118.   return $self->{cache}->{$name};
  119. }
  120.  
  121. sub update {
  122.   my ($self, $name, $date) = @_;
  123.  
  124.   return unless $name;
  125.   $name = $self->canon($name);
  126.  
  127.   # if information is different than cached version, set dirty and update
  128.   if (!exists $self->{cache}->{$name} || $self->{cache}->{$name} != $date) {
  129.     $self->{cache}->{$name} = $date;
  130.     $self->{dirty} = 1;
  131.   }
  132. }
  133.  
  134. sub finish {
  135.   my ($self) = @_;
  136.  
  137.   # Cache is dirty, so write out new file
  138.   if ($self->{dirty})
  139.   {
  140.     # create enclosing dir tree, if required
  141.     eval {
  142.       mkpath(dirname($self->{cache_file}));
  143.     };
  144.     if ($@) {
  145.       warn "Can't mkpath for AI cache file (".$self->{cache_file}."): $@ $!";
  146.     }
  147.  
  148.     if (open(CACHE, ">" . $self->{cache_file})) {
  149.       while(my($k,$v) = each %{$self->{cache}}) {
  150.     print CACHE "$k\t$v\n";
  151.       }
  152.       close(CACHE);
  153.     }
  154.     else {
  155.       warn "Can't write AI cache file (".$self->{cache_file}."): $!";
  156.     }
  157.   }
  158.  
  159.   return undef;
  160. }
  161.  
  162. sub canon {
  163.   my ($self, $name) = @_;
  164.  
  165.   if ($self->{type} eq 'dir') {
  166.     # strip off dirs, just look at filename
  167.     $name = (File::Spec->splitpath($name))[2];
  168.   }
  169.   else {
  170.     # we may get in a "/path/mbox.offset", so trim to just offset as necessary
  171.     $name =~ s/^.+\.(\d+)$/$1/;
  172.   }
  173.   return $name;
  174. }
  175.  
  176. # ---------------------------------------------------------------------------
  177.  
  178. 1;
  179. __END__
  180.