hs12
changeset 11 1fccf68e52c6
parent 10 af315e1a9b1e
child 12 62cd5aef2cfa
--- a/hs12	Wed Sep 05 14:52:16 2007 +0000
+++ b/hs12	Wed Sep 05 23:15:45 2007 +0000
@@ -1,36 +1,40 @@
 #! /usr/bin/perl
+
 use strict;
 use warnings;
 
 use Fatal qw(:void select);
 use File::Temp qw(tempfile);
-use Smart::Comments;
+use if $ENV{DEBUG} => "Smart::Comments";
 
 sub print_message(*$);
 sub read_message();
 sub pass_mime($);
 sub forward_to_boundary($*);
-sub read_header(*);
-sub process(*$);
+sub read_header(*$);
+sub process(*$$);
 
 MAIN: {
     my $message = read_message();
     my $tmpout  = tempfile();
-    my $stdout  = select $tmpout;
+    my $stdout  = select $tmpout;    # print ab jetzt ins tmpout
 
     seek($message, 0, 0);
-    process($message, undef);
+    process($message, undef, undef);
 
     # spit out everthing
     select $stdout;
     seek($tmpout, 0, 0);
 
-    {    # the tmpout may contain only parts of the message
-            # to avoid unnessesary copy actioins
+    # now output the stuff collected in tmpout
+    # and the rest of the message
+    {
         local $/ = \10240;
         print while <$tmpout>;
         print while <$message>;
     }
+
+    exit 0;
 }
 
 sub print_message(*$) {
@@ -46,27 +50,36 @@
     }
 }
 
-sub process(*$) {
-    my ($m,      $boundary) = shift;
-    my ($header, %header)   = read_header($m);
-    my $mime;
+sub process(*$$) {
+    my ($m, $boundary, $mime_version) = @_;
+    my ($header, %header) = read_header($m, $boundary);
+    my $mime_type;
 
-    if (    $header{"mime-version"}
+    $mime_version ||= $header{"mime-version"};
+
+    ### $header
+
+    if (    $mime_version
         and $header{"content-type"})
     {
-        ($mime, undef, $boundary) = (
+        ($mime_type, undef, $boundary) = (
             $header{"content-type"} =~ /^(.*?); # mime type
 	      (?:.*(?:boundary=(['"])(.*?)\2))? # eventuell noch mehr
 	    /x
         );
     }
 
-    if (!$mime or pass_mime($mime)) {
+    if (not $mime_type or pass_mime($mime_type)) {
+        warn "passing: " . ($mime_type ? $mime_type : "no mime_type") . "\n";
         print $header;
         print_message($m, $boundary);
         return;
     }
+    else {
+        warn "not just passing: $mime_type\n";
+    }
 
+    process($m, $boundary, $mime_version);
 
 }
 
@@ -86,19 +99,27 @@
 
 # in:	current message file handle
 # out:	($orignal_header, %parsed_header)
-sub read_header(*) {
-    my $msg = shift;
-    my ($from, $h);
+sub read_header(*$) {
+    my ($msg, $start) = @_;
+    my $h = "";
 
-    local $_ = <$msg>;
-    $from = /^from\s/i ? $_ : "";
+    if (defined $start) {
+        while (<$msg>) {
+            $h .= $_;
+            last if /^--$start\s*$/;
+        }
+    }
 
-    while (<$msg>) { $h .= $_; last if /^\s*$/ }
-    $_ = $h;
+    while (<$msg>) {
+        $h .= $_;
+        last if /^\s*$/;
+    }
+
+    $_ = $h;    # unmodified header (excl. $from)
 
     s/\r?\n\s+(?=\S)/ /gm;    # continuation lines
     s/^(\S+):/\L$1:/gm;       # header fields to lower case
 
-    return ("$from$h", ":unix_from:" => split(/^(\S+):\s*/m, "$from$_"));
+    return ($h, ":unix_from:" => split(/^(\S+):\s*/m, $_));
 }
 __END__