Changeset 9413

Timestamp:

2005-03-14T14:05:28+13:00 (19 years ago)

Author:

jrm21

Message:

if we are trying to automatically determine the encoding, look for a
unicode byte order marker and use it, instead of taking textcat's guess
for an iso-8859 encoding.

File:

• trunk/gsdl/perllib/plugins/BasPlug.pm (modified) (34 diffs)

trunk/gsdl/perllib/plugins/BasPlug.pm

@@ -6 +6 @@
 # University of Waikato, New Zealand.
 #
-# Copyright (C) 1999 New Zealand Digital Library Project
+# Copyright (C) 1999-2005 New Zealand Digital Library Project
 #
 # This program is free software; you can redistribute it and/or modify
@@ -36 +36 @@
 $SIG{__WARN__} = sub {warn($_[0]) unless ($_[0] =~ /Subroutine\s+\S+\sredefined/)};
 
+use strict; no strict 'subs';
+
 use File::Basename;
 
@@ -49 +51 @@
 use DateExtract;
 use ghtml;
-use gsprintf;
+use gsprintf 'gsprintf';
 use printusage;
 
 use GISBasPlug;
 
-@ISA = ( GISBasPlug );
+@BasPlug::ISA = ( GISBasPlug );
 
 my $unicode_list =
@@ -176 +178 @@
 
 
-sub gsprintf
-{
-    return &gsprintf::gsprintf(@_);
-}
 
 
@@ -198 +196 @@
 
     # XML output is always in UTF-8
-    &gsprintf::output_strings_in_UTF8;
-
-    &PrintUsage::print_xml_header();
+    gsprintf::output_strings_in_UTF8;
+
+    PrintUsage::print_xml_header();
     $self->print_xml();
 }
@@ -214 +212 @@
     return if (!defined($pluginoptions));
 
-    &gsprintf(STDERR, "<PlugInfo>\n");
-    &gsprintf(STDERR, "  <Name>$pluginoptions->{'name'}</Name>\n");
-    my $desc = &gsprintf::lookup_string($pluginoptions->{'desc'});
+    gsprintf(STDERR, "<PlugInfo>\n");
+    gsprintf(STDERR, "  <Name>$pluginoptions->{'name'}</Name>\n");
+    my $desc = gsprintf::lookup_string($pluginoptions->{'desc'});
     $desc =~ s/</&amp;lt;/g; # doubly escaped
     $desc =~ s/>/&amp;gt;/g;
     
-    &gsprintf(STDERR, "  <Desc>$desc</Desc>\n");
-    &gsprintf(STDERR, "  <Abstract>$pluginoptions->{'abstract'}</Abstract>\n");
-    &gsprintf(STDERR, "  <Inherits>$pluginoptions->{'inherits'}</Inherits>\n");
-    &gsprintf(STDERR, "  <Explodes>" . ($pluginoptions->{'explodes'} || "no") . "</Explodes>\n");
-    &gsprintf(STDERR, "  <Arguments>\n");
+    gsprintf(STDERR, "  <Desc>$desc</Desc>\n");
+    gsprintf(STDERR, "  <Abstract>$pluginoptions->{'abstract'}</Abstract>\n");
+    gsprintf(STDERR, "  <Inherits>$pluginoptions->{'inherits'}</Inherits>\n");
+    gsprintf(STDERR, "  <Explodes>" . ($pluginoptions->{'explodes'} || "no") . "</Explodes>\n");
+    gsprintf(STDERR, "  <Arguments>\n");
     if (defined($pluginoptions->{'args'})) {
     &PrintUsage::print_options_xml($pluginoptions->{'args'});
@@ -232 +230 @@
     $self->print_xml();
 
-    &gsprintf(STDERR, "  </Arguments>\n");
-    &gsprintf(STDERR, "</PlugInfo>\n");
+    gsprintf(STDERR, "  </Arguments>\n");
+    gsprintf(STDERR, "</PlugInfo>\n");
 }
 
@@ -291 +289 @@
     if ($isleafclass) {
     if (defined($plugindesc)) {
-        &gsprintf(STDERR, "$plugindesc\n\n");
-    }
-    &gsprintf(STDERR, " {common.usage}: plugin $pluginname [{common.options}]\n\n");
+        gsprintf(STDERR, "$plugindesc\n\n");
+    }
+    gsprintf(STDERR, " {common.usage}: plugin $pluginname [{common.options}]\n\n");
     }
 
@@ -302 +300 @@
 
     if ($isleafclass) {
-        &gsprintf(STDERR, " {common.specific_options}:\n");
+        gsprintf(STDERR, " {common.specific_options}:\n");
     }
     else {
-        &gsprintf(STDERR, " {common.general_options}:\n", $pluginname);
+        gsprintf(STDERR, " {common.general_options}:\n", $pluginname);
     }
 
@@ -376 +374 @@
              "allow_extra_options")) {
 
-    &gsprintf(STDERR, "\n{BasPlug.bad_general_option}\n", $plugin_name);
+    gsprintf(STDERR, "\n{BasPlug.bad_general_option}\n", $plugin_name);
         bless $self, $class;
     $self->print_txt_usage("");  # Use default resource bundle
@@ -667 +665 @@
 
     if ($self->is_recursive()) {
-    &gsprintf(STDERR, "{BasPlug.read_must_be_implemented}") && die "\n";
+    gsprintf(STDERR, "{BasPlug.read_must_be_implemented}") && die "\n";
     }
 
@@ -722 +720 @@
     if (!length ($text)) {
     my $plugin_name = ref ($self);
-    &gsprintf($outhandle, "$plugin_name: {BasPlug.file_has_no_text}\n", $filename) if $self->{'verbosity'};
+    gsprintf($outhandle, "$plugin_name: {BasPlug.file_has_no_text}\n", $filename) if $self->{'verbosity'};
 
     my $failhandle = $self->{'failhandle'};
-    &gsprintf($failhandle, "$file: " . ref($self) . ": {BasPlug.empty_file}\n");
+    gsprintf($failhandle, "$file: " . ref($self) . ": {BasPlug.empty_file}\n");
     # print $failhandle "$file: " . ref($self) . ": file contains no text\n";
     $self->{'num_not_processed'} ++;
@@ -777 +775 @@
     my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;
 
-    &gsprintf(STDERR, "BasPlug::process {common.must_be_implemented}\n") && die "\n";
+    gsprintf(STDERR, "BasPlug::process {common.must_be_implemented}\n") && die "\n";
     # die "Basplug::process function must be implemented in sub-class\n";
 
@@ -794 +792 @@
     {
     my $outhandle = $self->{'outhandle'};
-    &gsprintf($outhandle, "{BasPlug.read_denied}\n", $filename) if $self->{'verbosity'};
+    gsprintf($outhandle, "{BasPlug.read_denied}\n", $filename) if $self->{'verbosity'};
     # print $outhandle "Read permission denied for $filename\n" if $self->{'verbosity'};
     return;
@@ -801 +799 @@
     $$textref = "";
 
-    open (FILE, $filename) || (&gsprintf(STDERR, "BasPlug::read_file {BasPlug.could_not_open_for_reading} ($!)\n", $filename) && die "\n");
-    # open (FILE, $filename) || die "BasPlug::read_file could not open $filename for reading ($!)\n";
+    if (!open (FILE, $filename)) {
+    gsprintf(STDERR, "BasPlug::read_file {BasPlug.could_not_open_for_reading} ($!)\n", $filename);
+     die "\n";
+     }
 
     if ($encoding eq "ascii") {
@@ -868 +868 @@
         my $plugin_name = ref ($self);
         my $outhandle = $self->{'outhandle'};
-        &gsprintf($outhandle, "$plugin_name: {BasPlug.wrong_encoding}\n", $filename, $encoding, $extracted_encoding);
+        gsprintf($outhandle, "$plugin_name: {BasPlug.wrong_encoding}\n", $filename, $encoding, $extracted_encoding);
             # print $outhandle "$plugin_name: WARNING: $filename was read using $encoding encoding but ";
             # print $outhandle "appears to be encoded as $extracted_encoding.\n";
@@ -886 +886 @@
     my ($filename) = @_;
     my $outhandle = $self->{'outhandle'};
-
+    my $unicode_format = "";
     # read in file
-    open (FILE, $filename) || (&gsprintf(STDERR, "BasPlug::get_language_encoding {BasPlug.could_not_open_for_reading} ($!)\n", $filename) && die "\n"); # die "BasPlug::get_language_encoding could not open $filename for reading ($!)\n";
+    open (FILE, $filename) || (gsprintf(STDERR, "BasPlug::get_language_encoding {BasPlug.could_not_open_for_reading} ($!)\n", $filename) && die "\n"); # die "BasPlug::get_language_encoding could not open $filename for reading ($!)\n";
     undef $/;
     my $text = <FILE>;
@@ -894 +894 @@
     close FILE;
 
+    # check if first few bytes have a Byte Order Marker
+    my $bom=substr($text,0,2); # check 16bit unicode
+    if ($bom eq "\xff\xfe") { # little endian 16bit unicode
+    $unicode_format="unicode";
+    } elsif ($bom eq "\xfe\xff") { # big endian 16bit unicode
+    $unicode_format="unicode";
+    } else {
+    $bom=substr($text,0,3); # check utf-8
+    if ($bom eq "\xef\xbb\xbf") { # utf-8 coded FEFF bom
+        $unicode_format="utf8";
+#   } elsif ($bom eq "\xef\xbf\xbe") { # utf-8 coded FFFE bom. Error!?
+#       $unicode_format="utf8";
+    }
+    }
+
+
     # remove <title>stuff</title> -- as titles tend often to be in English
     # for foreign language documents
@@ -899 +915 @@
 
     # remove all HTML tags
-    $text =~ s/<[^>]*>//sg;
+    # XXX this doesn't match plugins derived from HTMLPlug (except ConvertTo)
+    if (ref($self) eq 'HTMLPlug' ||
+    (exists $self->{'converted_to'} && $self->{'converted_to'} eq 'HTML')){
+    $text =~ s/<[^>]*>//sg;
+    }
 
     # get the language/encoding
@@ -907 +927 @@
     # first one in the list - otherwise use the defaults
     if (scalar @$results > 3) {
-    # changed 12 Feb 2003 by jrm21
-    # use the most popular encoding at least... otherwise we might
-    # generate invalid archive files!
-    my %guessed_encodings = ();
-    foreach my $result (@$results) {
-        $result =~ /([^\-]+)$/;
-        my $enc=$1;
-        if (!defined($guessed_encodings{$enc})) {
-        $guessed_encodings{$enc}=0;
+    my $best_encoding="";
+    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;
+        }
+        $guessed_encodings{$enc}++;
         }
-        $guessed_encodings{$enc}++;
-    }
-    my $best_encoding="";
-    $guessed_encodings{""}=-1;
-    foreach my $enc (keys %guessed_encodings) {
-        if ($guessed_encodings{$enc} > $guessed_encodings{$best_encoding}){
-        $best_encoding=$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;
+        }
         }
     }
@@ -929 +952 @@
     if ($self->{'input_encoding'} ne 'auto') {
         if ($self->{'extract_language'} && $self->{'verbosity'}) {
-        &gsprintf($outhandle, "BasPlug: {BasPlug.could_not_extract_language}\n", $filename, $self->{'default_language'});
-        # print $outhandle "BasPlug: WARNING: language could not be extracted from $filename - ";
-        # print $outhandle "defaulting to $self->{'default_language'}\n";
+        gsprintf($outhandle,
+             "BasPlug: {BasPlug.could_not_extract_language}\n",
+             $filename, $self->{'default_language'});
         }       
         return ($self->{'default_language'}, $self->{'input_encoding'});
@@ -937 +960 @@
     } else {
         if ($self->{'verbosity'}) {
-        &gsprintf($outhandle, "BasPlug: {BasPlug.could_not_extract_language}\n", $filename, $self->{'default_language'});
-        # print $outhandle "BASPlug: WARNING: language could not be extracted from $filename - ";
-        # print $outhandle "defaulting to $self->{'default_language'}.\n";
+        gsprintf($outhandle,
+             "BasPlug: {BasPlug.could_not_extract_language}\n",
+             $filename, $self->{'default_language'});
         }
         return ($self->{'default_language'}, $best_encoding);
@@ -949 +972 @@
     if (!defined $language) {
     if ($self->{'verbosity'}) {
-        &gsprintf($outhandle, "BasPlug: {BasPlug.could_not_extract_language}\n", $filename, $self->{'default_language'});
-        # print $outhandle "BasPlug: WARNING: language could not be extracted from $filename - ";
-        # print $outhandle "defaulting to $self->{'default_language'}\n";
+        gsprintf($outhandle,
+             "BasPlug: {BasPlug.could_not_extract_language}\n",
+             $filename, $self->{'default_language'});
     }
     $language = $self->{'default_language'};
@@ -957 +980 @@
     if (!defined $encoding) {
     if ($self->{'verbosity'}) {
-        &gsprintf($outhandle, "BasPlug: {BasPlug.could_not_extract_encoding}\n", $filename, $self->{'default_encoding'});
-        # print $outhandle "BasPlug: WARNING: encoding could not be extracted from $filename - ";
-        # print $outhandle "defaulting to $self->{'default_encoding'}\n";
+        gsprintf($outhandle,
+             "BasPlug: {BasPlug.could_not_extract_encoding}\n",
+             $filename, $self->{'default_encoding'});
     }
     $encoding = $self->{'default_encoding'};
@@ -1078 +1101 @@
     my $outhandle = $self->{'outhandle'};
 
-    # print $outhandle " extracting email addresses ...\n" 
-    &gsprintf($outhandle, " {BasPlug.extracting_emails}...\n")
+    gsprintf($outhandle, " {BasPlug.extracting_emails}...\n")
     if ($self->{'verbosity'} > 2);
     
@@ -1090 +1112 @@
         push @email2, $address;
         $doc_obj->add_utf8_metadata ($thissection, "emailAddress", $address);
-        # print $outhandle "  extracting $address\n" 
-        &gsprintf($outhandle, "  {BasPlug.extracting} $address\n")
+        gsprintf($outhandle, "  {BasPlug.extracting} $address\n")
         if ($self->{'verbosity'} > 3);
     }
     }
-    # print $outhandle " done extracting email addresses.\n" 
-    &gsprintf($outhandle, " {BasPlug.done_email_extract}\n")
+    gsprintf($outhandle, " {BasPlug.done_email_extract}\n")
     if ($self->{'verbosity'} > 2);
 }
@@ -1128 +1148 @@
     my $thissection = $doc_obj->get_top_section();
     my $text = "";
-    my @list;
+    my $list;
 
     #loop through sections to gather whole doc
@@ -1146 +1166 @@
     if ($list){
         # if a list of kea keyphrases was returned (ie not empty)
-        &gsprintf(STDERR, "{BasPlug.keyphrases}: $list\n");
+        if ($self->{'verbosity'}) {
+        gsprintf(STDERR, "{BasPlug.keyphrases}: $list\n");
+        }
 
         #add metadata to top section
@@ -1216 +1238 @@
 
     # print $outhandle " extracting acronyms ...\n" 
-    &gsprintf($outhandle, " {BasPlug.extracting_acronyms}...\n")
+    gsprintf($outhandle, " {BasPlug.extracting_acronyms}...\n")
     if ($self->{'verbosity'} > 2);
 
@@ -1229 +1251 @@
         if ($thisAcro eq $acro->to_string()) {
         $seen_before = "true";
-        # print $outhandle "  already seen ". $acro->to_string() . "\n" 
-        &gsprintf($outhandle, " {BasPlug.already_seen} " . $acro->to_string() . "\n")
-            if ($self->{'verbosity'} >= 4);
+        if ($self->{'verbosity'} >= 4) {
+            gsprintf($outhandle, " {BasPlug.already_seen} " .
+                 $acro->to_string() . "\n");
+        }
         }
     }
@@ -1241 +1264 @@
         #do the normal acronym
         $doc_obj->add_utf8_metadata($thissection, "Acronym",  $acro->to_string());
-        # print $outhandle "  adding ". $acro->to_string() . "\n" 
-        &gsprintf($outhandle, " {BasPlug.adding} " . $acro->to_string() . "\n")
+        gsprintf($outhandle, " {BasPlug.adding} ".$acro->to_string()."\n")
         if ($self->{'verbosity'} > 3);
     }
     }
 
-    # print $outhandle " done extracting acronyms. \n" 
-    &gsprintf($outhandle, " {BasPlug.done_acronym_extract}\n")
+    gsprintf($outhandle, " {BasPlug.done_acronym_extract}\n")
     if ($self->{'verbosity'} > 2);
 }
@@ -1257 +1278 @@
     my $outhandle = $self->{'outhandle'};
 
-    # print $outhandle " marking up acronyms ...\n" 
-    &gsprintf($outhandle, " {BasPlug.marking_up_acronyms}...\n")
+    gsprintf($outhandle, " {BasPlug.marking_up_acronyms}...\n")
     if ($self->{'verbosity'} > 2);
 
@@ -1264 +1284 @@
     $text = &acronym::markup_acronyms($text, $self);
 
-    # print $outhandle " done marking up acronyms. \n" 
-    &gsprintf($outhandle, " {BasPlug.done_acronym_markup}\n")
+    gsprintf($outhandle, " {BasPlug.done_acronym_markup}\n")
     if ($self->{'verbosity'} > 2);
 
@@ -1285 +1304 @@
     my ($doc_obj, $filename) = @_;
 
+    my $top_section=$doc_obj->get_top_section();
+
     $filename =~ s/\.[^\\\/\.]+$/\.jpg/;
     if (-e $filename) {
     $doc_obj->associate_file($filename, "cover.jpg", "image/jpeg");
-    $doc_obj->add_utf8_metadata($thissection, "hascover",  1);
+    $doc_obj->add_utf8_metadata($top_section, "hascover",  1);
     } else {
     $filename =~ s/jpg$/JPG/;
     if (-e $filename) {
         $doc_obj->associate_file($filename, "cover.jpg", "image/jpeg");
-        $doc_obj->add_utf8_metadata($thissection, "hascover",  1);
+        $doc_obj->add_utf8_metadata($top_section, "hascover",  1);
     }
     }