Changeset 3132 for trunk/gsdl/perllib/plugins/EMAILPlug.pm

Timestamp:

2002-05-22T17:27:41+12:00 (22 years ago)

Author:

jrm21

Message:

Try to determine the encoding used in the headers in case it is not ascii.
(rfc-822 says it should be).

File:

• trunk/gsdl/perllib/plugins/EMAILPlug.pm (modified) (8 diffs)

trunk/gsdl/perllib/plugins/EMAILPlug.pm

@@ -140 +140 @@
     $$textref = $1;
     
-    # See if headers include non-ascii - RFC says whole header should be ascii.
-# not yet implemented, as we don't know what character set is the
-# user's default... We can do textcat to guess, or we can just choose
-# one of the charset fields later in the document (if there are any...)
-#    if ($Headers =~ /([[:^ascii:]])/) {
-#    }
-
     # Unfold headers - see rfc822
     $Headers =~ s/\r?\n[\t\ ]+/ /gs;
@@ -155 +148 @@
     $raw{$name} = "No $name value";
     }
+
+    # Get a default encoding for the header - RFC says should be ascii...
+    my $default_heading_encoding="iso_8859_1";
+
+    # We don't know what character set is the user's default...
+    # We could use textcat to guess... for now we'll look at mime content-type
+#    if ($Headers =~ /([[:^ascii:]])/) {
+#    }
+    if ($Headers =~ /^Content\-type:.*charset=\"?([a-z0-9\-_]+)/mi) {
+    $default_header_encoding=$1;
+    $default_header_encoding =~ s@\-@_@g;
+    $default_header_encoding =~ tr/A-Z/a-z/;
+    }
+
 
     # Examine each line of the headers
@@ -179 +186 @@
 
     # decode headers if stored using =?<charset>?[BQ]?<data>?= (rfc2047)
-    if ($value =~ /=\?/) {
+    if ($value =~ /=\?.*\?[BbQq]\?.*\?=/) {
         my $original_value=$value;
         my $encoded=$value;
@@ -201 +208 @@
         $value .= $decoded_data;
           } # end of while loop
-
+        
         # get any trailing characters
-        $self->convert2unicode("iso_8859_1", \$encoded);
+        $self->convert2unicode($default_header_encoding, \$encoded);
         $value.=$encoded;
 
         if ($value =~ /^\s*$/) { # we couldn't extract anything...
-          $self->convert2unicode("iso_8859_1", \$original_value);
+          $self->convert2unicode($default_header_encoding,
+                     \$original_value);
           $value=original_value;
         }
-    } # end of if =?...?=
+    } else { # end of if =?...?=
+        $self->convert2unicode($default_header_encoding, \$value);
+    }
+
+
     
     # Store the metadata
@@ -283 +295 @@
     my $mimetype="text/plain";
     my $mimeinfo="";
-    my $charset = "iso_8859_1";
+    my $charset = $default_header_encoding;
     # Do MIME and encoding stuff. Allow \s in mimeinfo in case there is
     # more than one parameter given to Content-type.
@@ -375 +387 @@
 
     # Convert problem characters into HTML symbols
-    $text =~ s/&/&amp;/go;
-    $text =~ s/</&lt;/go;
-    $text =~ s/>/&gt;/go;
-    $text =~ s/\"/&quot;/go;
+    $text =~ s/&/&amp;/g;
+    $text =~ s/</&lt;/g;
+    $text =~ s/>/&gt;/g;
+    $text =~ s/\"/&quot;/g;
 
     # convert email addresses and URIs into links
@@ -392 +404 @@
 
     # Clean up whitespace and convert \n charaters to <BR> or <P>
-    $text =~ s/ +/ /go;
-    $text =~ s/\s*$//o; 
-    $text =~ s/^\s*//o; 
-    $text =~ s/\n/\n<BR>/go;
-    $text =~ s/<BR>\s*<BR>/<P>/go;
+    $text =~ s/ +/ /g;
+    $text =~ s/\s*$//g; 
+    $text =~ s/^\s*//g;
+    $text =~ s/\n/\n<br>/g;
+    $text =~ s/<br>\s*<br>/<p>/gi;
 
     return $text;
@@ -644 +656 @@
 # Process a MIME part. Return "" if we can't decode it.
 sub text_from_part {
-    my $self = shift(@_);
-    my $text=shift;
+    my $self = shift;
+    my $text=shift || '';
     my $part_header=$text;
     # check for empty part header (leading blank line)