package SSF::Forward;
# $Revision: 00001 $
# $Source: /home/glaess/perl/imap-filter/lib/SSF/Forward.pm $
# $Id: Holger Glaess $
use strict;
use warnings;
#
use English '-no_match_vars';
use Carp;

use feature qw/switch/;
no if $] >= 5.018, warnings => 'experimental';

use Data::Dumper;

#use MIME::Tools;
#MIME::Tools->debugging(1);
#MIME::Tools->quiet(0);

use MIME::Parser;
#use MIME::Body;
use MIME::Entity;

use vars qw($VERSION $DEBUG @ISA @EXPORT $entity);
BEGIN {
require Exporter;
@ISA = qw(Exporter);


@EXPORT = qw( FORWARD ) ;

$VERSION = '0.01';

sub new {
	my ($class,$args) = @_;
	my $self = {};
	if ( ( $args->{debug} ) && ( $args->{'debug'} =~ /^(?:true|1)$/smx ) ) {
		$DEBUG='1';
		MIME::Tools->debugging(1);
		MIME::Tools->quiet(0);
	}
	$class = ref($class) || $class;
	bless $self,$class;
	return $self;
} # end sub new

sub FORWARD {
my ( $self,$args ) = @_;
my $debug = $DEBUG;

#print Dumper $args;


my $msg ;
map { $msg .= $_ ; } @ { $args->{message} } ;

# first create parser objekt 
my $parser = new MIME::Parser;
#$parser->decode_headers(1);
#$parser->ignore_errors(1);
#$parser->output_to_core(1);
$parser->output_under('mimemail');


# parse mail to extract From,To,Subject
my $parsedmsg = \$parser->parse_data( $msg ) or print $parser->last_error . "\n" ;
#${$parsedmsg}->dump_skeleton;


#get email headers
my $header = ${$parsedmsg}->head();
my $from = $header->get('From');
$from =~ s/(?:\s|\t)*//smxg ;

my $to = $header->get('To');
$to =~ s/(?:\s|\t)*//smxg ;

my $subject = $header->get('Subject') ;
$subject =~ s/(?:\s|\t)*$//smxg ;

my $fwdsubject = '[FWD]';
if ( $subject ) { $fwdsubject .= $subject ; }
#my $date = _date2str ();
#my $time = _time2str ();


#hgl
$entity = MIME::Entity->build(
        Type    =>      'multipart/mixed',
        From        => $args->{from},
        To          => $args->{to},
        Subject     => $fwdsubject,
        'X-Mailer'  => "SSF $VERSION",
        Description     =>      'forwarded mail by SSF',
);



# In Skeleton output Body-path -> attach path =>

#${$parsedmsg}->dump_skeleton ;
#print ${$parsedmsg}->parts(0)->parts . "\n";
#exit;
if ( ${$parsedmsg}->parts > 0 ) {
	_multi_part_body (${$parsedmsg},$debug) ;
} else {
	_single_part_body (${$parsedmsg},$debug);
}

if ( $debug ) {
	$entity->dump_skeleton;
}
$entity->smtpsend(Host => $args->{mailserver} ) ;

return ;
}


sub _handle_mime_block {
my ( $body,$debug ) = @_;

#$body->dump_skeleton;


 my $mimepart = MIME::Entity->build (
                                Type    =>      $body->mime_type,
                                Data    =>      $body->body,
                                Top     =>      1,
                        );


if ( $body->parts(0)->parts > 0 ) {

	my $part = _handle_mime_block ( $body->parts(0), $debug ) ;
	$mimepart->add_part ( ${$part} );

} else {
                $mimepart->attach ( Type => $body->parts(0)->mime_type,
                        Data => $body->parts(0)->body,
                        Path => $body->parts(0)->bodyhandle->path,
		);
}

	for my $p ( 1 .. $body->parts - 1 ) {
		$mimepart->attach ( Type => $body->parts($p)->mime_type,
       			Data => $body->parts($p)->body,
                        Path => $body->parts($p)->bodyhandle->path,
		);
	}

#$mimepart->dump_skeleton;
return \$mimepart ;
}

sub _multi_part_body {
my ( $body,$debug ) = @_;
if ( $debug ) { print "[DBG]multi part body\n"; }
my @CA = caller 1;

my $caller = $CA[4];
#print Dumper $caller;



for my $p ( 0 .. $body->parts - 1 ) {
#	$body->parts($p)->parts->dump_skeleton;
	if ( $body->parts($p)->parts > 0 ) {
		if ( $debug ) { print "[DBG]part $p have " . $body->parts($p)->parts . " parts create mime part\n"; }
			my $mimepart = _handle_mime_block ( $body->parts($p), $debug );
			#$mimepart->dump_skeleton;
			$entity->add_part ( ${$mimepart} ) ;
			#${$entity}->dump_skeleton;

		} else {
			if ( $debug ) { print "[DBG]part $p ist single part attach to entity\n"; }
				_single_part_body ($body->parts($p) , $debug );
			}
#
		}
	}	
	return;
}

sub _single_part_body {
my ( $body,$debug ) = @_;

	$entity->attach ( Type => $body->mime_type,
                       Data => $body->body,
                       Path => $body->bodyhandle->path,
	);
	return ;
}

1;