File Coverage

blib/lib/Mail/Send/Loop.pm

Criterion	Covered	Total	%
statement	12	240	5.0
branch	0	76	0.0
condition	0	65	0.0
subroutine	4	15	26.6
pod	6	11	54.5
total	22	407	5.4

package Mail::Send::Loop;

# h2xs -O -AX -n Mail::Send::Loop -v 0.1

use strict;
use warnings;

use IO::Socket;
use MIME::Lite;

require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Mail::Send::Loop ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(

);

our $VERSION = '0.3';


# -----
my $EOF = "\x0d\x0a";
my $SMTP_DATA = "DATA" . $EOF;
my $SMTP_QUIT = "QUIT" . $EOF;

my $debug = 1;
my $recv_data;
my %gMediaTypes;
my $gCOUNT;

sub new {
	my ($unknown, %usr_parms)= @_;
	my $class = ref($unknown) ? ref($unknown) : $unknown;

	my %obj_parms ;
	while(my($k, $v) = each %usr_parms){
		$obj_parms{lc($k)} = $v;
	}

    my $self = {};

	$self->{mail_host}	= $obj_parms{mail_host};
	$self->{mail_port}	= $obj_parms{mail_port}	|| 25;
	$self->{greeting}   = $obj_parms{greeting}  || 'test.net';
	$self->{debug}		= $obj_parms{debug};
	$self->{senders}	= $obj_parms{senders};
	$self->{recipients}	= $obj_parms{recipients};
	$self->{mail_mode}	= $obj_parms{mail_mode} || '1tom';	# in 1 TCP session, how many emails sent
	$self->{mail_count} = $obj_parms{mail_count}|| '0';		# 0 run once, # > 0, only send # of emails, -1 endless loop

	if( defined $self->{debug}){
		$debug = 1;
	}else{
		undef $debug;
	}

	&readMediaTypes(\%gMediaTypes);

    bless $self, $class;
	$self;
}

sub setDebug(){
    my $self   = shift;
	my $status = shift;

	if( $status =~ /(off|0|disable)/i ){
		undef $debug;
	}else{
		$debug = 1;
	}
}

sub emailMode(){
    my $self = shift;
	my $mode = shift || '';

	if( $mode =~ /(1tom|1to1)/i ){
		$self->{mail_mode} = $mode;
	}
	return $self->{mail_mode};
}

sub sendMail_EML(){
    my $self = shift;
	my $emlf = shift;
	my $mailSender = shift;
	my $recepient  = shift;

	if( ! -e $emlf ){
		print "  Error: Cannot find $emlf\n";
		return 0;
	}

	open(INPUT, $emlf);
	my $content = do { local $/;  };
	close INPUT;
	#$content =~ s/\x0a\./\x0a\.\./sg;			# . at beginning of the line need be 2

	my $mail_socket = &createMailSocket($self->{mail_host}, $self->{mail_port}, $self->{greeting});

	$gCOUNT++;
	&sendMail_OneTcpSession(\$mail_socket, $mailSender, $recepient, $content);

	&closeMailSocket(\$mail_socket);

	return 1;
}

sub sendMail_AllFilesInFolder(){
    my $self = shift;
	my %usr_parms = @_;

	my $mail_folder = $usr_parms{mail_folder};
	my $mail_mode   = $usr_parms{mail_mode}    || $self->{mail_mode};
	my $mail_subject= $usr_parms{mail_subject} || "send the file as attachment";
	my $mail_text_bd= $usr_parms{mail_txt_body}|| "this is a test email with MIME attachment";
	my $greeting    = $usr_parms{greeting}     || $self->{greeting};
	my $sender_list = $usr_parms{senders}      || $self->{senders};
	my $rpient_list = $usr_parms{recipients}   || $self->{recipients};
	my $mail_count  = $usr_parms{mail_count}   || $self->{mail_count};

	if(! $sender_list || ! $rpient_list){
		print "  Error: please define sender and recipient lists!\n";
		exit;
	}

	$gCOUNT =0;

	my $mail_host   = $self->{mail_host};
	my $mail_port   = $self->{mail_port};

	my @files = glob("$mail_folder/*.*");

	my $socketClosed;   # TRUE or FALSE

	# when 0, send all files only once
	$self->{mail_count} = $mail_count	if( $mail_count =~ /^\d+$/ );
	$self->{mail_count} = scalar @files	if( $mail_count == 0);

	my $mail_socket;
	$mail_socket = &createMailSocket($mail_host, $mail_port, $greeting) if($mail_mode =~ /1tom/i);

	while(1){
		my @mailSender = ( @{$sender_list} ) x (int(scalar @files / scalar @{$sender_list}) + 1 ) ;
		my @recepients = ( @{$rpient_list} ) x (int(scalar @files / scalar @{$rpient_list}) + 1 ) ;

		foreach(@files){
			my $org = $_;

			$gCOUNT++;

			$mail_socket = &createMailSocket($mail_host, $mail_port, $greeting) if($mail_mode =~ /1to1/i);

			if($org =~ /\.eml$/i){
				open(INPUT, $org) or die "Could not open file: org\n";
				my $content = do { local $/;  };
				close INPUT;

				&sendMail_OneTcpSession(\$mail_socket, shift @mailSender, shift @recepients, $content);

			}else{
				my $mSender    = shift @mailSender;
				my $mRecepient = shift @recepients;

				### Create the multipart container
				my $msg = MIME::Lite->new (
					From    => $mSender,
					To      => $mRecepient,
					Subject => "$mail_subject: $mail_mode " . $gCOUNT,
					Type    =>'multipart/mixed'
				) or die "Error creating multipart container: $!\n";

				$org =~ /(.*)\.(.*)$/i;
				my $ext = lc($2);
				#print "$ext  $gMediaTypes{$ext} \n";

				### Add the text message part
				$msg->attach (
					Type => 'TEXT',
					Data => $mail_text_bd
				) or die "Error adding the text message part: $!\n";

				$msg->attach (
					Type 	 => $gMediaTypes{$ext},
					Path 	 => $org,
					Filename => $org,
					Disposition => 'attachment'
				) or die "Error adding $org: $!\n";

				&sendMail_OneTcpSession(\$mail_socket, $mSender, $mRecepient, $msg->as_string);
			}

			if($self->{mail_count} == $gCOUNT){
				&closeMailSocket(\$mail_socket);
				$socketClosed = 1;
				goto MAIL_CLOSE;
			}

			&closeMailSocket(\$mail_socket) if($mail_mode =~ /1to1/i);
		}
	}

	MAIL_CLOSE:
	&closeMailSocket(\$mail_socket) if($mail_mode =~ /1tom/i && $socketClosed != 1);

	$self->{mail_count} = 0;
	return $gCOUNT;
}

sub sendMail_LoopAllUsers(){
    my $self = shift;
	my %usr_parms = @_;

	my $mail_body   = $usr_parms{mail_body};
	my $mail_mode   = $usr_parms{mail_mode}    || $self->{mail_mode};
	my $greeting    = $usr_parms{greeting}     || $self->{greeting};
	my $sender_list = $usr_parms{senders}      || $self->{senders};
	my $rpient_list = $usr_parms{recipients}   || $self->{recipients};
	my $mail_count  = $usr_parms{mail_count}   || $self->{mail_count};

	my $mail_host   = $self->{mail_host};
	my $mail_port   = $self->{mail_port};

	if(! $sender_list || ! $rpient_list || ! $mail_body){
		print "  Error: please define sender, recipient lists and email body!\n";
		exit;
	}

	$gCOUNT =0;

	my $socketClosed;

	# when 0, send all files only once
	$self->{mail_count} = $mail_count if( $mail_count =~ /^\d+$/ );
	$self->{mail_count} = ( scalar @{$sender_list} ) * ( scalar @{$rpient_list} ) if( $mail_count == 0);

	my $mail_socket;
	$mail_socket = &createMailSocket($mail_host, $mail_port, $greeting) if($mail_mode =~ /1tom/i);

	while(1){

		foreach(@{$sender_list}){
			my $sender = $_;

			foreach(@{$rpient_list}){

				$mail_socket = &createMailSocket($mail_host, $mail_port, $greeting) if($mail_mode =~ /1to1/i);

				$gCOUNT++;
				&sendMail_OneTcpSession(\$mail_socket, $sender, $_, $mail_body);

				if($self->{mail_count} == $gCOUNT){
					&closeMailSocket(\$mail_socket);
					$socketClosed = 1;
					goto MAIL_CLOSE;
				}

				&closeMailSocket(\$mail_socket) if($mail_mode =~ /1to1/i);
			}
		}
	}

	MAIL_CLOSE:
	&closeMailSocket(\$mail_socket) if($mail_mode =~ /1tom/i && $socketClosed != 1);

	$self->{mail_count} = 0;
	return $gCOUNT;
}

sub sendMail_OneTcpSession(){
	my $SOCKET     = shift;
	my $mailf_addr = shift;
	my $rcptT_addr = shift;
	my $mail_body  = shift;

	my $mail_socket = ${$SOCKET};

	my $mail_from = "MAIL FROM: " . $mailf_addr . $EOF;
	my $rcpt_to   = "RCPT TO: "   . $rcptT_addr . $EOF;

	#MAIL FROM
	$mail_socket->send($mail_from);
	$mail_socket->recv($recv_data, 1024);
	if( $recv_data !~ /^250/){
		print "  Error: $mail_from->$recv_data";
		close $mail_socket;
	}
	&dbg_print("$mail_from->$recv_data");

	#RCPT TO
	$mail_socket->send($rcpt_to);
	$mail_socket->recv($recv_data, 1024);
	if( $recv_data !~ /^250/){
		print "  Error: $rcpt_to\t\t->$recv_data";
		close $mail_socket;
	}
	&dbg_print("$rcpt_to->$recv_data");

	#DATA
	$mail_socket->send($SMTP_DATA);
	$mail_socket->recv($recv_data, 1024);
	if( $recv_data !~ /^354/){
		print "  Error: $SMTP_DATA->$recv_data";
		close $mail_socket;
	}
	&dbg_print("$SMTP_DATA->$recv_data");

	$mail_socket->send( $mail_body . "$EOF\.$EOF");
	$mail_socket->recv($recv_data, 1024);
	if( $recv_data !~ /^250/){
		print "  Error: Mail Body->$recv_data";
		close $mail_socket;
	}
	&dbg_print("Mail Body->$recv_data " . ' email length: ' . length($mail_body) . "\t $gCOUNT sent");
}

sub createMailSocket(){
	my $mail_host = shift || "127.0.0.1";
	my $mail_port = shift || "25";
	my $greeting = shift || "test.net";

	my $smtp_EHLO = "HELO $greeting" . $EOF;

	my $mail_socket = new IO::Socket::INET (
		PeerAddr  => $mail_host,
		PeerPort  => $mail_port,
		Proto     => 'tcp',
		)
	or die "Couldn't connect to Server\n";

	#Greeting
	$mail_socket->recv($recv_data, 1024);
	print "Greeting->$recv_data" if($debug);

	#EHLO
	$mail_socket->send($smtp_EHLO);
	$mail_socket->recv($recv_data, 1024);
	if( $recv_data !~ /^250/){
		print "  Error: $smtp_EHLO->$recv_data";
		close $mail_socket;
	}
	&dbg_print("$smtp_EHLO->$recv_data");
	return $mail_socket;
}

sub closeMailSocket(){
	my $SOCKET  = shift;
	my $mail_socket = ${$SOCKET};

	#QUIT
	$mail_socket->send( $SMTP_QUIT );
	$mail_socket->recv($recv_data, 1024);
	if( $recv_data !~ /^221/){
		print "  Error: QUIT->$recv_data";
		close $mail_socket;
	}
	&dbg_print("QUIT->$recv_data");
	print "\n";

	close $mail_socket;
}

sub dbg_print(){
	my $str = shift;

	$str =~ s/\x0d//g;
	$str =~ s/\x0a//g;
	print "  INFO : $str\n" if($debug);
}

sub readMediaTypes(){
	my $mediaType = shift;		# reference to hash

	my $mediaFile;
	foreach(@INC){
		if(-e "$_/LWP/media.types") {
			$mediaFile = "$_/LWP/media.types";
			last;
		}
	}

	open(MIME, $mediaFile);
	while(){
		chomp $_;
		next if($_ =~ /^#/);

		my $line = $_;
		my @part = split /\s+/, $line;
		next if(scalar @part < 2);

		#print "$line\n";

		my $last = scalar @part - 1;
		foreach( @part[1..$last] ){
			${$mediaType}{lc($_)} = $part[0];
		}
	}
	close MIME;
	#print sort values %{$mediaType};

	${$mediaType}{xlsx} = 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet';
	${$mediaType}{docx} = 'application/vnd.openxmlformats-officedocument.wordprocessingml.document';
	${$mediaType}{pptx} = 'application/vnd.openxmlformats-officedocument.presentationml.presentation';
	${$mediaType}{db}   = 'application/binary';		# Thumbs.db
}

1;
__END__