Changeset 9971

Timestamp:

2005-05-26T13:38:19+12:00 (19 years ago)

Author:

jrm21

Message:

text_from_part now takes an optional parameter with the part's headers.
tidied in a few places.

File:

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

trunk/gsdl/perllib/plugins/EMAILPlug.pm

@@ -148 +148 @@
 # This plugin splits the mbox mail files at lines starting with From<sp>
 # It is supposed to be "\n\nFrom ", but this isn't always used.
+# add \d{4} so that the line ends in a year (in case the text has an
+# unescaped "From " at the start of a line).
 sub get_default_split_exp {
-    return q^\nFrom .*\n^;
+    return q^\nFrom .*\d{4}\n^;
     
 }
@@ -410 +412 @@
 
     if ($mimetype eq "text/html") {
-    $$textref= $self->text_from_part("$Headers\n$$textref");
+    $$textref= $self->text_from_part($$textref, $Headers);
     } elsif ($mimetype ne "text/plain") {
     $self->{'doc_obj'} = $doc_obj; # in case we need to associate files...
@@ -619 +621 @@
     {
         $mimetype=$1;
+        $mimeinfo=$2;
         $mimetype =~ tr/[A-Z]/[a-z]/;
-        $mimeinfo=$2;
-        #if ($mimeinfo =~ /charset=\"([^\"]+)\"/) {
-        #   $charset = $1;
-        #}
+
         my $msg_text;
         if ($mimetype =~ m@multipart/@) {
@@ -629 +629 @@
                            $text);
         } else {
-        $msg_text=$self->text_from_part($text);
+        $msg_text=$self->text_from_part($text,$msg_header);
         }
 
@@ -753 +753 @@
                           $message_part_body);
         } else {
-        $message_part_body= $self->text_from_part($part_body);
+        $message_part_body=$self->text_from_part($part_body,
+                            $message_part_headers);
         $rfc822_formatted_body=text_into_html($message_part_body);
         }
@@ -863 +864 @@
 # Process a MIME part. Return "" if we can't decode it.
 # should only be called for parts with type "text/*" ?
+# Either pass the entire mime part (including the part's header),
+# or pass the mime part's text and optionally the part's header.
 sub text_from_part {
     my $self = shift;
     my $text = shift || '';
-    my $part_header = $text;
-
-    # check for empty part header (leading blank line)
-    if ($text =~ /^\s*\r?\n/) {
-    $part_header="Content-type: text/plain; charset=us-ascii";
-    } else {
-    $part_header =~ s/\r?\n\r?\n(.*)$//s;
-    $text=$1; if (!defined($text)) {$text="";}
-    }
-    $part_header =~ s/\r?\n[\t ]+/ /gs; #unfold
-    $part_header =~ /content\-type:\s*([\w\.\-\/]+).*?charset=\"?([^\;\"\s]+)\"?/is;
-    my $type=$1;
-    my $charset=$2;
-    if (!defined($type)) {$type="";}
-    if (!defined($charset)) {$charset="ascii";}
+    my $part_header = shift;
+
+    my $type="text/plain"; # default, overridden from part header
+    my $charset="ascii"; # default, overridden from part header
+
+    if (! $part_header) { # no header argument was given. check the body
+    $part_header = $text;
+    # check for empty part header (leading blank line)
+    if ($text =~ /^\s*\r?\n/) {
+        $part_header="Content-type: text/plain; charset=us-ascii";
+    } else {
+        $part_header =~ s/\r?\n\r?\n(.*)$//s;
+        $text=$1; if (!defined($text)) {$text="";}
+    }
+    $part_header =~ s/\r?\n[\t ]+/ /gs; #unfold
+    }
+
+    if ($part_header =~
+    /content\-type:\s*([\w\.\-\/]+).*?charset=\"?([^\;\"\s]+)\"?/is) {
+    $type=$1;
+    $charset=$2;
+    }
     my $encoding="";
     if ($part_header =~ /^content\-transfer\-encoding:\s*([^\s]+)/mis) {