Changeset 16554 for gsdl/trunk/perllib/textcat.pm

Timestamp:

2008-07-25T16:51:50+12:00 (16 years ago)

Author:

ak19

Message:

Added subroutines classify_cached and clear_cache. The first of these is called by BasePlugin's filepath_to_utf8 subroutine. Textcat now caches results when called with classify_cached() which can be useful for small strings (like filenames) so that textcat need not be performed repeatedly on the same strings.

File:

• gsdl/trunk/perllib/textcat.pm (modified) (6 diffs)

gsdl/trunk/perllib/textcat.pm

@@ -43 +43 @@
 my $non_word_characters = '0-9\s';
 
+# caching related
+my %cache = (); # map of cached text-strings each to array of char-encodings
+my $MAX_CACHE_SIZE = 1000;
+
 sub new {
     my $class = shift (@_);
+    my ($tmp_f, $tmp_t, $tmp_u) = @_;
+
     my $self = {};
 
@@ -70 +76 @@
 
     $self->{'languages'} = \@languages;
+
+    $self->{'opt_f'} = defined($tmp_f) ? $tmp_f : $opt_f;
+    $self->{'opt_t'} = defined($tmp_t) ? $tmp_t : $opt_t;
+    $self->{'opt_u'} = defined($tmp_u) ? $tmp_u : $opt_u;
+    $self->{'max_cache_size'} = $MAX_CACHE_SIZE;
+
     return bless $self, $class;
 }
@@ -82 +94 @@
 
 sub classify {
-    my ($self, $inputref)=@_;
+    my ($self, $inputref, $opt_freq, $opt_factor, $opt_top)=@_;
+    
+    $self->{'opt_f'} = $opt_freq if defined $opt_freq;
+    $self->{'opt_u'} = $opt_factor if defined $opt_factor;
+    $self->{'opt_t'} = $opt_top if defined $opt_top;
+    
     my %results = ();
-    my $maxp = $opt_t;
+    my $maxp = $self->{'opt_t'};
 
     # create ngrams for input.
@@ -108 +125 @@
   
     my @answers=(shift(@results));
-    while (@results && $results{$results[0]} < ($opt_u *$a)) {
+    while (@results && $results{$results[0]} < ($self->{'opt_u'} *$a)) {
     @answers=(@answers,shift(@results));
     }
 
     return \@answers;
+}
+
+# Same as above, but caches textcat results for subsequent use.
+# The cache is a map of the string to the corresponding array of results 
+# returned by textcat of the possible filename-encodings for that string.
+# Use this method for short strings (such as filenames) rather than huge text
+# files. The cache will be cleared when the max_cache_size is reached, which
+# is MAX_CACHE_SIZE by default or can be specified as a parameter. The cache
+# can also be cleared by a call to clear_cache.
+sub classify_cached {
+    my ($self, $inputref, $opt_freq, $opt_factor, $opt_top, $max_size_of_cache)=@_;
+    $self->{'max_cache_size'} = $max_size_of_cache if defined $max_size_of_cache;
+    
+    # if not already in the cache, work it out and put it there
+    if (!defined $cache{$$inputref}) 
+    {
+    if (scalar (keys %cache) >= $self->{'max_cache_size'}) {
+        $self->clear_cache();
+    }
+##  print STDERR "$$inputref is not yet in the cache\n";
+    $cache{$$inputref} = $self->classify($inputref, $opt_freq, $opt_factor, $opt_top);
+    } else {
+##  print STDERR "$$inputref is already in the cache\n";
+    }
+
+##    print STDERR "Count of elements in cache is now: ".scalar (keys %cache)."\n";
+
+    # return cached array of encodings for the given string
+    return $cache{$$inputref}; 
+}
+
+# Clears the cache (a map of strings to the textcat results for each string).
+sub clear_cache {
+    my $self = shift (@_);
+
+    %cache = undef; # does this suffice to release memory?
+    %cache = ();
 }
 
@@ -138 +192 @@
     }
 
-    map { if ($ngram->{$_} <= $opt_f) { delete $ngram->{$_}; }
+    map { if ($ngram->{$_} <= $self->{'opt_f'}) { delete $ngram->{$_}; }
       } keys %$ngram;
   
@@ -145 +199 @@
     # times slower..., although it would be somewhat nicer (unique result)
     my @sorted = sort { $ngram->{$b} <=> $ngram->{$a} } keys %$ngram;
-    splice(@sorted,$opt_t) if (@sorted > $opt_t); 
+    splice(@sorted,$self->{'opt_t'}) if (@sorted > $self->{'opt_t'}); 
     return \@sorted;
 }