#!/usr/bin/perl
#######################################################################
# snowlistDB - database operations
#
# $Id: snowlistDB 196 2004-10-21 19:27:03Z kiza $
#
# Read mail from STDIN, parse and add to database.
# Database maintenance, cleanup.
#
# Copyright Oliver Feiler 2004 <kiza@gmx.net>
# http://kiza.kcore.de/software/snowlist/
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#######################################################################

use FindBin qw($Bin);
use lib "$Bin";

use Encode qw/encode decode/;

use strict;
use MIME::Parser;
use Text::Iconv;
use DBI;
use SnowlistConfig;

#######################################################################

my($listid) = $ARGV[0];
my($config) = SnowlistConfig::LoadConfig($listid);

my $dbh = db_connect($config);
my $insert_sth = $dbh->prepare(q{
        INSERT INTO messages
        (msg_listid, msg_from, msg_date, msg_subject, msg_body, msg_thread) VALUES
        (?         , ?       , ?       , ?          , ?       , ?         )
});
my $parser = new MIME::Parser;

sub get_text_part($) {
    my ($entity) = @_;

    my $mime_type = $entity->head->mime_type;

    if ($mime_type =~ /^multipart\//) {
        for my $part ($entity->parts) {
            my $text = get_text_part($part);
            return $text if $text;
        }
        die "No text part found";
    } elsif ($mime_type =~ /^(text\/|message\/)/) {
        my $charset = $entity->head->mime_attr('content-type.charset') || 'US-ASCII';
        my $body = $entity->bodyhandle->as_string;

        return encode('UTF-8', decode($charset, $body));
    }

    die "Unknown MIME-Type: $mime_type";
}

sub import_entity ($) {
	my($entity) = @_;
	my($subject, $from, $date, $body, $thread);

	my $body = get_text_part($entity);

	$subject = decode('MIME-Header', $entity->head->get("Subject"));
	$from = decode('MIME-Header', $entity->head->get("From"));
	$date = $entity->head->get("Date");
        
	# Remove email addresses
	$from =~ s/[\w+_.-]+\@[\w.-]+/\[EMAIL REMOVED\]/g;
	$body =~ s/[\w+_.-]+\@[\w.-]+/\[EMAIL REMOVED\]/g;
        
	chomp($subject, $from, $date);
	$thread = $subject;
	$thread =~ s/^(Re|Fwd|AW|WL): //i;
	$insert_sth->execute($listid, $from, $date, $subject, $body, $thread);
}

$parser->output_to_core(1);
my $entity = $parser->parse(\*STDIN);
import_entity($entity);

$dbh->disconnect;
