File Coverage

blib/lib/Mail/Salsa.pm

Criterion	Covered	Total	%
statement	24	63	38.1
branch	0	14	0.0
condition	0	3	0.0
subroutine	8	10	80.0
pod	1	2	50.0
total	33	92	35.8

#
# Mail/Salsa.pm
# Last Modification: Fri May 28 19:22:47 WEST 2010
#
# Copyright (c) 2010 Henrique Dias .
# All rights reserved.
# This module is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
package Mail::Salsa;

use 5.008000;
use strict;
use warnings;

require Exporter;
use AutoLoader qw(AUTOLOAD);
use Mail::Salsa::Config;
use Mail::Salsa::Utils;
use Mail::Salsa::Logs qw(logs);
use MIME::Explode;

our @ISA = qw(Exporter);

our %EXPORT_TAGS = ( 'all' => [ qw() ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw();
our $VERSION = '0.15';

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $self  = {
		headers     => {},
		message     => undef,
		action      => "",
		list        => "",
		list_dir    => "",
		logs_dir    => "",
		tmp_dir     => "/tmp",
		archive_dir => "",
		queue_dir   => "",
		smtp_server => [],
		from        => "",
		config      => {},
		@_
	};
	bless ($self, $class);
	my $action = ucfirst(lc($self->{'action'}));
	$action or return(undef);
	delete($self->{'action'});

	my $fh = $self->{'filehandle'};
	my $line_from = <$fh>;
	my ($from) = ($line_from =~ /^From +([^ ]+) +/);
	$from or return(undef);
	$self->{'from'} = lc($from);
	$self->parse_stream();
	delete($self->{'filehandle'});
	TEST: {
		unless($action eq "Admin") {
			if(-e (my $cf = Mail::Salsa::Utils::file_path($self->{'list'}, $self->{'list_dir'}, "configuration.txt"))) {
				$self->{'config'} = Mail::Salsa::Config::get_config(
					file     => $cf,
					defaults => {
						'title'            => "",
						'prefix'           => "",
						'subscribe'        => "y",
						'unsubscribe'      => "y",
						'max_message_size' => 0,
						'stamp_life'       => "1m",
						'archive'          => "n",
						'header'           => "n",
						'footer'           => "n",
						'language'         => "en",
						'localnet'         => [],
					},
				);
			} else {
				my ($name, $domain) = split(/\@/, $self->{'list'});
				Mail::Salsa::Utils::tplsendmail(
					smtp_server => $self->{'smtp_server'},
					label       => "LIST_NOT_ACTIVE",
					lang        => $self->{'config'}->{'language'},
					vars        => {
						master => "salsa-master\@$domain",
						from   => "$name\-owner\@$domain",
						to     => $self->{'from'},
						list   => $self->{'list'},
					}
				);
				last TEST;
			}
		}
		eval("use Mail::Salsa::Action::$action;\nMail::Salsa::Action::$action\-\>new(\%\{\$self\});\n");
		$self->logs("[eval] $@", "errors") if($@);
	}
	Mail::Salsa::Utils::clean_dir($self->{'tmp_dir'});
	return($self);
}

sub parse_stream {
	my $self = shift;

	my $id = (my $tmp_dir = "");
	do {
		$id = Mail::Salsa::Utils::generate_id();
		$tmp_dir = join("/", $self->{'tmp_dir'}, $id);
	} until(!(-d $tmp_dir));

	$self->{'tmp_dir'} = $tmp_dir;
	my $filename = ($self->{'message'} = join("/", $tmp_dir, "$id\.msg"));
	my $explode = MIME::Explode->new(
		output_dir     => $tmp_dir,
		mkdir          => 0700,
		decode_subject => 1,
		content_types  => ["text/plain"],
		types_action   => "include"
	);
	open(OUTPUT, ">", $filename) or die("Couldn't open $filename for writing: $!\n");
	eval {
		$self->{'headers'} = $explode->parse($self->{'filehandle'}, \*OUTPUT);
	};
	$self->logs("[eval] $@", "errors") if($@);
	close(OUTPUT);
	return();
}

1;
__END__