Changeset 17213 for gsdl/trunk/perllib/plugins/ReadTextFile.pm

Timestamp:

2008-09-08T13:41:13+12:00 (16 years ago)

Author:

ak19

Message:

Significant changes to subroutine get_language_encoding to better work out the encoding and language of a file's contents. In those cases where the encoding of a text's contents is already known, performs a textcat restricted on the known encoding. Corresponding changes have been made to textcat.pm

File:

• gsdl/trunk/perllib/plugins/ReadTextFile.pm (modified) (5 diffs)

gsdl/trunk/perllib/plugins/ReadTextFile.pm

@@ -296 +296 @@
 }
 
+
 # Uses textcat to work out the encoding and language of the text in 
 # $filename. All html tags are removed before processing.
@@ -307 +308 @@
     my $best_encoding = "";
     
+
     # read in file
     if (!open (FILE, $filename)) {
@@ -356 +358 @@
     elsif ($head =~ m/<meta http-equiv.*content-type.*charset=(.+?)\"/si) {            
         $best_encoding = $1;
-#       print STDERR "**** meta tag found, encoding is: $best_encoding\n";
     }
     if ($best_encoding) { # we extracted an encoding
@@ -371 +372 @@
     }
 
-    # get the language/encoding
-    $self->{'textcat'} = new textcat() if (!defined($self->{'textcat'}));
-#    my $results = $self->{'textcat'}->classify(\$text);
-    my $results = $self->{'textcat'}->classify_cached_filecontents(\$text, $filename);
-
-    # if textcat returns 3 or less possibilities we'll use the 
-    # first one in the list - otherwise use the defaults
-    if (scalar @$results > 3) {
-    if ($unicode_format) { # in case the first had a BOM
-        $best_encoding=$unicode_format;
-    } else {
-        my %guessed_encodings = ();
-        foreach my $result (@$results) {
-        $result =~ /([^\-]+)$/;
-        my $enc=$1;
-        if (!defined($guessed_encodings{$enc})) {
-            $guessed_encodings{$enc}=0;
+    # don't need to do textcat if we know the encoding now AND don't need to extract language
+    if($found_html_encoding && !$self->{'extract_language'}) { # encoding specified in html file
+    $best_language = $self->{'default_language'};
+    }
+
+    else { # need to use textcat to get either the language, or get both language and encoding
+    $self->{'textcat'} = new textcat() if (!defined($self->{'textcat'}));
+    
+    if($found_html_encoding) { # know encoding, find language by limiting search to known encoding
+        my $results = $self->{'textcat'}->classify_contents_for_encoding(\$text, $filename, $best_encoding);
+        
+        my $language;
+        ($language) = $results->[0] =~ m/^([^-]*)(?:-(?:.*))?$/ if (scalar @$results > 0);
+
+        if (!defined $language || scalar @$results > 3) {
+        # if there were too many results even when restricting results by encoding,
+        # or if there were no results, use default language with the known encoding
+        $best_language = $self->use_default_language($filename);
+        } 
+        else { # fewer than 3 results means textcat is more certain, use the first result
+        $best_language = $language;     
+        } 
+    }
+    else { # don't know encoding or language yet, therefore we use textcat
+        my $results = $self->{'textcat'}->classify_contents(\$text, $filename);
+        
+        # if textcat returns 3 or less possibilities we'll use the first one in the list
+        if (scalar @$results <= 3) { # results will be > 0 when we don't constrain textcat by an encoding
+        my ($language, $encoding) = $results->[0] =~ m/^([^-]*)(?:-(.*))?$/;
+
+        $language = $self->use_default_language($filename) unless defined $language;
+        $encoding = $self->use_default_encoding($filename) unless defined $encoding;
+
+        $best_language = $language;
+        $best_encoding = $encoding;
+        }
+        else { # if (scalar @$results > 3) {
+        if ($unicode_format) { # in case the first had a BOM
+            $best_encoding=$unicode_format;
         }
-        $guessed_encodings{$enc}++;
-        }
-
-        $guessed_encodings{""}=-1; # for default best_encoding of ""
-        foreach my $enc (keys %guessed_encodings) {
-        if ($guessed_encodings{$enc} >
-            $guessed_encodings{$best_encoding}){
-            $best_encoding=$enc;
+        else {
+            # Find the most frequent encoding in the textcat results returned
+            # Returns "" if there's no encoding more frequent than another
+            $best_encoding = $self->{'textcat'}->most_frequent_encoding($results);
+        }
+        
+        if ($best_encoding eq "") { # encoding still not set, use defaults
+            $best_language = $self->use_default_language($filename);
+            $best_encoding = $self->use_default_encoding($filename);
+        }
+        elsif (!$self->{'extract_language'}) { # know encoding but don't need to discover language
+            $best_language = $self->use_default_language($filename);
+        }
+        else { # textcat again using the most frequent encoding or the $unicode_format set above
+            $results = $self->{'textcat'}->classify_contents_for_encoding(\$text, $filename, $best_encoding);
+            my $language;
+            ($language) = $results->[0] =~ m/^([^-]*)(?:-(.*))?$/ if (scalar @$results > 0);
+            if (!defined $language || scalar @$results > 3) { 
+            # if no result or too many results, use default language for the encoding previously found
+            $best_language = $self->use_default_language($filename);
+            }
+            else { # fewer than 3 results, use the language of the first result
+            $best_language = $language;
+            }
         }
         }
     }
-
-    if ($self->{'input_encoding'} ne 'auto') {
-        if ($self->{'extract_language'} && ($self->{'verbosity'}>2)) {
-        gsprintf($outhandle,
-             "ReadTextFile: {ReadTextFile.could_not_extract_language}\n",
-             $filename, $self->{'default_language'});
-        }       
-        $best_language = $self->{'default_language'};
-        if (!$found_html_encoding) {
-        $best_encoding = $self->{'input_encoding'};
-        }
-
-    } else {
-        if ($self->{'verbosity'}>2) {
-        gsprintf($outhandle,
-             "ReadTextFile: {ReadTextFile.could_not_extract_language}\n",
-             $filename, $self->{'default_language'});
-        }
-        $best_language = $self->{'default_language'};
-    }
-    } else { # <= 3 suggestions
-    my ($language, $encoding) = $results->[0] =~ /^([^-]*)(?:-(.*))?$/;
-    if (!defined $language) {
-        if ($self->{'verbosity'}>2) {
-        gsprintf($outhandle,
-            "ReadTextFile: {ReadTextFile.could_not_extract_language}\n",
-            $filename, $self->{'default_language'});
-        }
-        $language = $self->{'default_language'};
-    }
-    if (!defined $encoding) {
-        if ($self->{'verbosity'}>2) {
-        gsprintf($outhandle,
-            "ReadTextFile: {ReadTextFile.could_not_extract_encoding}\n",
-            $filename, $self->{'default_encoding'});
-        }
-        $encoding = $self->{'default_encoding'};
-    }
-    $best_language = $language;
-    if (! $best_encoding ) { # may already be set... eg from html meta tag
-        $best_encoding = $encoding;
-    }
-    }
+    }
+
+    if($best_encoding eq "" || $best_language eq "") {
+    print STDERR "****Shouldn't happen: encoding and/or language still not set. Using defaults.\n";
+    $best_encoding = $self->use_default_encoding($filename) if $best_encoding eq "";
+    $best_language = $self->use_default_language($filename) if $best_language eq "";
+    }
+#    print STDERR "****Content language: $best_language; Encoding: $best_encoding.\n";
+
 
     if ($best_encoding =~ /^iso_8859/ && &unicode::check_is_utf8($text)) {
@@ -480 +485 @@
 
 
+sub use_default_language {
+    my $self = shift (@_);
+    my ($filename) = @_;
+
+    if ($self->{'verbosity'}>2) {
+    gsprintf($self->{'outhandle'},
+         "ReadTextFile: {ReadTextFile.could_not_extract_language}\n",
+         $filename, $self->{'default_language'});
+    }
+    return $self->{'default_language'};
+}
+
+sub use_default_encoding {
+    my $self = shift (@_);
+    my ($filename) = @_;
+
+    if ($self->{'verbosity'}>2) {
+    gsprintf($self->{'outhandle'},
+         "ReadTextFile: {ReadTextFile.could_not_extract_encoding}\n",
+         $filename, $self->{'default_encoding'});
+    }
+    return $self->{'default_encoding'};
+}
 
 # Overridden by exploding plugins (eg. ISISPlug)