#!/usr/bin/perl -w
#
# sa-wrapper.pl
#
# SpamAssassin sa-learn wrapper
# (c) Alexandre Jousset, 2004
#
# modified for use with procmailrc
# from Sven Neukirchner <sven@konabi.de>
#
# This script is GPL'd
#
# Time-stamp: <17 January 2004, 15:56>
# v1.0

use strict;
use MIME::Parser;

my $DEBUG =1;
my $LOGFILE= '/var/log/sa-learn.log';
my $UNPACK_DIR = '/var/spool/unpack';
my $SA_LEARN = '/usr/bin/sa-learn';

sub recurs
{
    my $ent = shift;

    if ($ent->head->mime_type eq 'message/rfc822')
    {
	  $ent->bodyhandle->print(\*OUT);
	  return;
    }

    my @parts = $ent->parts;

    if (@parts)
    {
	  map { recurs($_) } @parts;
    }
}


my $parser = new MIME::Parser;
$parser->extract_nested_messages(0);
$parser->output_dir($UNPACK_DIR);

my $entity;
eval
{
    $entity = $parser->parse(\*STDIN);

};

if ($@)
{
   die $@;
}
else
{
    if ($DEBUG)
    {

    	open(OUT, "|$SA_LEARN -D $ARGV[0] --single >$LOGFILE 2>&1")
        or die "Cannot pipe $SA_LEARN: $!";

    }
    else
    {
    	open(OUT, "|$SA_LEARN $ARGV[0] --single")
		or die "Cannot pipe $SA_LEARN: $!";
    }

    recurs($entity);
}

$parser->filer->purge;