##########################################################################################
#
#	MongerMail.pm
#	©2000, Perl Services
#
#	Easy access to send emails with files attached to them.
#
#	Requirements:		UNIX Server, Perl5+
#	Created:		December 11th, 2000
#	Author: 		Jim Melanson, Owner and Lead Programmer
#	Contact:		www.perlservices.com
#				Phone:		1-705-437-3283
#				Fax:		1-208-694-1613
#				E-Mail:		info@perlservices.com
#	File Name:		MongerFile.pm
#	Version:		1.0
#
##########################################################################################
#
#	This module was written to be placed into the directory you are working in
#	as opposed to installing it on the server. To use this module, place it in the
#	same directory as the script calling it. You can use this module to send an email
#	message or to send an e-mail message with attachments. Here are two samples:
#
#	Example 1 - Send an email message:
#
#	use MongerMail;
#	$mailprogram = "/usr/sbin/sendmail";
#	my $mail = new MongerMail($mailprogram);
#	$mail->to('someone@foo.com');
#	$mail->from('me@mydomain.com');
#	$mail->subject('Here is a test mailing');
#	$mail->content('This mailing was sent with MongerMail.\n\nA very useful utility distributed by Perl Services.\n\nThanks!');
#	$mail->send;
#
#	NOTE: Any of the arguments being passed to functions can be passed as variables.
#
#	NOTE: If you wanted to add CC or BCC recipients, then it is done like this:
#	$mail->cc('someonelse@anotherdomain.com');
#	$mail->bcc('friend1@foo.com', 'friend2@foo.com');
#
###########################################################################################
#
#	Example 2 - Sending an email message with two files attached.
#
#	use MongerMail;
#	$mailprogram = "/usr/sbin/sendmail";
#	my $mail = new MongerMail($mailprogram);
#	$mail->to('someone@foo.com');
#	$mail->from('me@mydomain.com');
#	$mail->subject('Here is a test mailing');
#	$mail->content('This mailing was sent with MongerMail.\n\nA very useful utility distributed by Perl Services.\n\nThanks!');
#	$mail->attachment('/usr/home/html/records/file1.txt', '/usr/home/html/records/file2.doc', '/usr/home/html/records/file3.jpg');
#	$mail->send;
#
###########################################################################################
#
#	Quid Pro Quo:
#
#	There are two things that you MUST do or the mailing will fail.
#
#	1.) When you create the new MongerMail object, you must pass the path to sendmail
#	    to the object.
#
#	2.) You can not add anything to the object after the $fh->send. The send function
#	    is what puts everything together and sends it out. Once the mailing is send,
#	    everything you have added is erased so you can start all over again with a new
#	    mailing without creating a new object. Feel free to create multiple objects if
#	    you feel it's necessary.
#
#	3.) You can turn off these object emptying, however, by specifying the no_erase
#	    method prior to calling the send method, in this manner:
#
#	$mail->no_erase;
#	$mail->send;
#
#	    The input parameters that ARE erased when you don't turn the erasing off are:
#	    to, from, cc, bcc, content and attachment. The subject is reset to the default
#	    of 'No Subject'.
#
###########################################################################################
#
#	Other methods you can call on this are:
#
#       $mail->html;
#       This will cause the content of the message body to be sent in HTML format.
#
#       $mail->no_html;
#       This will cause the content of the message body to be sent in plain text format.
#       This is the default setting of the module and only needs to be called if your
#       looping through a list of addresses and want some in HTML and some not in HTML
#
#	$mail->encoding([type]);
#	There are only two valid types of encoding. They are 'base64' and 'uuencode'. Note
#	that 'base64' is the default and you should never have to switch to 'uuencode' but
#	the option is there for you.
#
#	$mail->boundary([specifyboundary]);
#	The created object has a default generic boundary that you should not have to change.
#	However, if your an advanced user and want to specify your own boundary, it is there
#	for you to use.
#
#	For the purposes of debugging, you can check $mail->{error} after every method call.
#	If antying is incorrect or doesn't work right in the methods, $mail->{error} will
#	contain a descriptive error message.
#
############################################################################################

package MongerMail;

$VERSION     = "1.0";

require 5;
use Carp;

sub new {
    my ($pkg, $sendmail) = @_;
    if($sendmail =~ /\-t$/) {
	chop($sendmail); chop($sendmail);
    }
    $sendmail =~ s/ +//g;
    bless {
	sendmail => "$sendmail -t",
	error => '',
	to    => '',
	from  => '',
	cc    => '',
	bcc   => '',
	content => '',
        content_type => 'text/plain',
	no_erase   => 0,
	attachment => '',
	subject    => 'No subject',
	encoding   => 'base64',
	boundary   => 'Perl_Services_MongerMail-' . time,
	crlf	   => "\015\012",
    }, $pkg;
}

sub DESTROY {
    my $self = shift;
    for(keys %$self) {
	delete $self->{$_};
    }
    undef(%$self);
    undef $self;
}

sub attachment {
    my $self = shift;
    my @attachment = @_;
    foreach(@attachment) {
	$_ =~ s/ /\_/g;
	if(-e $_) {
	    if($_ =~ /.+\.\w+/) {
		if($self->{attachment}) {
		    $self->{attachment} .= ',';
		}
		$self->{attachment} .= $_;
	    }
	}
    }
    if($self->{attachment}) {
	return(1);
    } else {
	return(0);
    }
}

sub bcc {
    my $self = shift;
    my @bcc = @_;
    my $temp_bcc;
    foreach(@bcc) {
	if($_ =~ /[a-zA-Z1-9]/) {
	    if($self->_check_email($_)) {
		if($temp_bcc) {
		    $temp_bcc .= ' ';
		}
		$temp_bcc .= $_;
	    } else {
		if($bad_bcc) {
		    $bad_bcc .= ', ';
		}
		$bad_bcc .= $_;
	    }
	}
    }
    if($bad_bcc) {
	$self->{error} = "You attempted to BCC this mailing to the following address which were found to be in an invalid format: $bad_bcc";
    }
    if($temp_bcc) {
	$self->{bcc} = $temp_bcc;
	return(1);
    } else {
	if($self->{error}) {$self->{error} .= "\n\n"}
 	$self->{error} .= "You did not provide any validly formatted e-mail address to BCC this mailing to.";
	return(0);
    }
}

sub boundary {
    my $self = shift;
    my $boundary = shift;
    if($boundary =~ /[a-zA-Z1-9]/) {
	$self->{boundary} = $boundary;
	return(1);
    } else {
	$self->{boundary} = 'Perl_Services_MongerMail-' . time;
	return(0);
    }
}

sub cc {
    my $self = shift;
    my @cc = @_;
    my $temp_cc;
    foreach(@cc) {
	if($_ =~ /[a-zA-Z1-9]/) {
	    if($self->_check_email($_)) {
		if($temp_cc) {
		    $temp_cc .= ' ';
		}
		$temp_cc .= $_;
	    } else {
		if($bad_cc) {
		    $bad_cc .= ', ';
		}
		$bad_cc .= $_;
	    }
	}
    }
    if($bad_cc) {
	$self->{error} = "You attempted to CC this mailing to the following address which were found to be in an invalid format: $bad_cc";
    }
    if($temp_cc) {
	$self->{cc} = $temp_cc;
	return(1);
    } else {
	if($self->{error}) {$self->{error} .= "\n\n"}
 	$self->{error} .= "You did not provide any validly formatted e-mail address to CC this mailing to.";
	return(0);
    }
}

sub content {
    my $self = shift;
    my @content = @_;
    my $content = join("\n", @content);
    $self->{content} = $content;
    return(1);
}

sub encoding {
    my $self = shift;
    my $encoding = shift;
    if(($encoding eq 'base64') || ($encoding eq 'uuencode')) {
	$self->{encoding} = $encoding;
	return(1);
    } else {
	$self->{error} = "You attempted to assign an invalid encoding format. The only valid encoding formats are \'uuencode\' and \'base64\'. The \'base64\' format is the default encoding format.";
	return(0);
    }
}

sub from {
    my $self = shift;
    my $from = shift;
    if($from =~ /[a-zA-Z1-9]/) {
	if($self->_check_email($from)) {
	    $self->{from} = $from;
	    return(1);
	} else {
	    $self->{error} = "The email address you attempted to assign to the \"From\" field was not in a valid e-mail address format.";
	    return(0);
	}
    } else {
	$self->{error} = "You attempted to assign a null value to the \"From\" field.";
	return(0);
    }
}

sub html {
    $_[0]->{content_type} = 'text/html';
}

sub no_erase {
    my $self = shift;
    $self->{no_erase} = 1;
}

sub no_html {
    $_[0]->{content_type} = 'text/plain';
}

sub subject {
    my $self = shift;
    my $subject = shift;
    if($subject =~ /[a-zA-Z1-9]/) {
	$self->{subject} = $subject;
    } else {
	$self->{subject} = 'No subject';
    }
    return(1);
}

sub send {
    my $self = shift;
    if($self->{sendmail}) {
	if($self->{to}) {
	    if($self->{from}) {
		if(open(SEND, "|$self->{sendmail}")) {
		    print SEND "To: $self->{to}$self->{crlf}";
		    print SEND "From: $self->{from}$self->{crlf}";
		    print SEND "Cc: $self->{cc}$self->{crlf}" if $self->{cc};
		    print SEND "Bcc: $self->{bcc}$self->{crlf}" if $self->{bcc};
		    print SEND "Subject: $self->{subject}$self->{crlf}";
		    if($self->{boundary}) {
			print SEND "x-sender: $from$self->{crlf}";
			print SEND "x-mailer: Perl Services$self->{crlf}";
			print SEND "Mime-Version: 1.0$self->{crlf}";
			print SEND "Content-Type: multipart/mixed; boundary=\"$self->{boundary}\"$self->{crlf}$self->{crlf}";
			print SEND "--$self->{boundary}$self->{crlf}";
			print SEND "Content-Type: $self->{content_type}; charset=\"US-ASCII\"$self->{crlf}$self->{crlf}";
		    } else {
			print SEND $self->{crlf};
		    }
		    print SEND "$self->{content}\n\n" if $self->{content};
		    if($self->{attachment}) {
			if($self->{attachment} =~ /\,/) {
			    @attachments = split(/\,/, $self->{attachment});
			} else {
			    $attachments[0] = $self->{attachment};
			}
			foreach(@attachments) {
			    my $filepath = $_;
			    $filepath =~ /[\\\/:]([^\\\/:]+)$/g;
			    my $filename = $1;
			    if (-e $filepath) {
				my $encoded_content;
				if($self->{encoding} eq 'base64') {
			            print SEND "--$self->{boundary}$self->{crlf}";
				    print SEND "Content-type: application/octet-stream; name=\"$filename\"$self->{crlf}";
				    print SEND "Content-transfer-encoding: base64$self->{crlf}$self->{crlf}";
	                            if(open(ATTACHMENT, "<$filepath")) {
                                        flock(ATTACHMENT, '3');
	                                while ($bytes = read(ATTACHMENT, $line, 45)) {
		                            $length += $bytes;
		                            my $return = substr(pack('u', $line), 1);
		                            chop($return);
         	                            $return =~ tr| -_`|A-Za-z0-9+/A|;
	                                    my $buff = (3 - ($length % 3)) % 3;
	                                    substr($return, -$buff, $buff) = '=' x $buff;
	                                    $return =~ s/(.{76})/$1\n/g;
                                            print SEND $return;
	                                }
	                                close ATTACHMENT;
	                            }
                                    print SEND "$self->{crlf}";
				} else {
                                    print SEND "Attachment:\t$filename$self->{crlf}";
                                    print SEND "Encoding:\tUUEncoded$self->{crlf}";
				    print SEND "begin 600 $filename\n";
	                            if(open(ATTACHMENT, "<$filepath")) {
	                                flock(ATTACHMENT, '2');
	                                while(read(ATTACHMENT, $line, 45)) {
		                            my $return = pack("u", $line);
                                            print SEND $return;
	                                } 
	                                close(ATTACHMENT);
	                                return($return);
                                    }
				    print SEND "`\nend\n\n";
				}
			    } else {
				$self->{error} = "The file you wanted to attach does not exist. Check the file path.";
			    }
			}
		    }
   		    print SEND "--$self->{boundary}--$self->{crlf}";
    		    print SEND "$self->{crlf}.$self->{crlf}";
		    close(SEND);
		    unless($self->{no_erase} == 1) {
			$self->_erase;
		    }
		    return(1);
		} else {
		    $self->{error} = "Unable to open the mail program. Check the path to sendmail that you initialized MongerMail with.";
		    return(0);
		}
	    } else {
		$self->{error} = "You did not set a \"From\" address for the mailing. All mailings must have a validly formatted email address set with the \"from\" method.";
		return(0);
	    }
	} else {
	    $self->{error} = "You did not set a \"To\" address for the mailing. All mailings must have a validly formatted email address set with the \"to\" method.";
	    return(0);
	}
    } else {
	$self->{error} = "You did not specify an absolute path to sendmail. You must specify a path to sendmail when you first create the MongerMail object reference.";
        return(0);
    }
}

sub to {
    my $self = shift;
    my @to = @_;
    my $temp_to;
    foreach(@to) {
	if($_ =~ /[a-zA-Z1-9]/) {
	    if($self->_check_email($_)) {
		if($temp_to) {
		    $temp_to .= ' ';
		}
		$temp_to .= $_;
	    } else {
		if($bad_to) {
		    $bad_to .= ', ';
		}
		$bad_to .= $_;
	    }
	}
    }
    if($bad_to) {
	$self->{error} = "You attempted to send this mailing to the following address which were found to be in an invalid format: $bad_to";
    }
    if($temp_to) {
	$self->{to} = $temp_to;
	return(1);
    } else {
	if($self->{error}) {$self->{error} .= "\n\n"}
 	$self->{error} .= "You did not provide any validly formatted e-mail address to send this mailing to.";
	return(0);
    }
}

#Internal methods only. Do not access directly.

sub _attachment_size {
    my $self = shift;
    my $file = shift;
    if(-e $file) {
	my $size = -s $file;
	return($size);
    } else {
	$self->{error} = "The file you specified does not exist";
	return(0);
    }
}

sub _attachment_type {
    my $self = shift;
    my $file = shift;
    if(-B $file) {
	return('binary');
    }
    elsif(-T $file) {
	return('text');
    } else {
	return(0);
    }
}

sub _check_email {
    my $self     = shift;
    my $fe_email = shift;
    if($fe_email =~ /[a-zA-Z1-9]/) {
        if(($fe_email =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)|(\.$)/) ||
	   ($fe_email !~ /^.+@\[?(\w|[-.])+\.[a-zA-Z]{2,3}|[0-9]{1,3}\]?$/)) {
	    return(0);
        } else {
	    return(1);
	}
    } else {
    	return(0);
    }
}

sub _erase {
    my $self = shift;
    $self->{to}    => '',
    $self->{from}  => '',
    $self->{cc}    => '',
    $self->{bcc}   => '',
    $self->{content}    => '',
    $self->{attachment} => '',
    $self->{subject}    => 'No subject',
}



