Sending Email with Perl/Tk

				
=**************************************
= Name: Sending Email with Perl/Tk
= Description:This is a simple Perl/Tk application that will send Email using the Net::SMTP module. So if you ever wondered about Creating a GUI to send email, then check this out.
= By: Randy McCleary
=
=This code is copyrighted and has= limited warranties.Please see http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=540&lngWId=6=for details.=**************************************

#!/usr/bin/perl -w
#######################################################
## This is a simple Perl/Tk application that will send
## Email using a visual GUI Form and SMTP.
#######################################################
	
use strict;
use Tk;
use Tk::Dialog;
use Net::SMTP;
	
#############################################
## Here is where we set will the Constant 
## values, that are used to send the Email
## $MailHost - HostName or IP Address
## $FromEmail - Email address sending from
## $FromName - Name sending from, will show
## in Inbox as the from name.
#############################################
my $MailHost = 'mailhost';
my $FromEmail = 'my_email_address@yahoo.com';
my $FromName = 'Email Tester';
	
my $frmMain = MainWindow->new;
$frmMain->title("SendEmail");
$frmMain->geometry("525x441+8+8");
	
	
######################################
## Create the Labels and the Text
## Entries.
######################################	
my $lblTo = $frmMain->Label(
				-anchor => "w", 
				-text => "To:", 
				-background => "#D4D0C8", 
				-cursor => "", 
				-font => "Tahoma 10 bold", 
				-foreground => "#140F7B"
				);
	
my $lblSubject = $frmMain->Label(
				-anchor => "w", 
				-text => "Subject:", 
				-background => "#D4D0C8", 
				-cursor => "", 
				-font => "Tahoma 10 bold",
				-foreground => "#140F7B"
				);
	
my $txtTo = $frmMain->Entry(
				-borderwidth => 1, 
				-cursor => "", 
				-font => "Tahoma 8 normal", 
				-foreground => "#000000", 
				-relief => "sunken"
				);
	
my $txtSubject = $frmMain->Entry(
				-borderwidth => 1, 
				-cursor => "", 
				-font => "Tahoma 8 normal", 
				-foreground => "#000000", 
				-relief => "sunken"
				);
	
my $txtBody = $frmMain->Text(
				-borderwidth => 1, 
				-font => "Tahoma 8 normal", 
				-relief => "solid"
				);
	
	
######################################
## Place the Labels and Text Entries
## on the form.
######################################	
$lblTo->place(
		 -width => 96, 
		 -height => 24, 
		 -x => 40, 
		 -y => 32
		 );
	
$lblSubject->place(
		 -width => 96, 
		 -height => 24, 
		 -x => 40, 
		 -y => 64
		 );
	
$txtTo->place(
		 -width => 264, 
		 -height => 24, 
		 -x => 144, 
		 -y => 32
		 );
	
$txtSubject->place(
		 -width => 264, 
		 -height => 24, 
		 -x => 144, 
		 -y => 64
		 );
	
$txtBody->place(
		 -width => 432, 
		 -height => 256, 
		 -x => 40, 
		 -y => 128
		 );
	
	
###################################
## Create the command buttons
###################################
my $cmdSend = $frmMain->Button(
				-activebackground => "#FFFCBF", 
				-activeforeground => "#E30229", 
				-background => "#FFFFFF", 
				-borderwidth => 1, 
				-text => "Send",
				-command => sub{SendMail()}, 
				-cursor => "", 
				-font => "Tahoma 8 bold", 
				-foreground => "#140F7B", 
				-relief => "solid"
				);
	
my $cmdClear = $frmMain->Button(
				-activebackground => "#FFFCBF", 
				-activeforeground => "#E30229", 
				-background => "#FFFFFF", 
				-borderwidth => 1, 
				-text => "Clear", 
				-command => sub{Clear()},
				-cursor => "", 
				-font => "Tahoma 8 bold", 
				-foreground => "#140F7B", 
				-relief => "solid"
				);
	
my $cmdExit = $frmMain->Button(
				-activebackground => "#FFFCBF", 
				-activeforeground => "#E30229", 
				-background => "#FFFFFF", 
				-borderwidth => 1, 
				-text => "Exit", 
				-cursor => "", 
				-font => "Tahoma 8 bold", 
				-command => [$frmMain => 'destroy'],
				 -foreground => "#140F7B", 
				-relief => "solid"
				);
	
	
######################################
## Place the command buttons
######################################	
$cmdSend->place(
		 -width => 96, 
		 -height => 32, 
		 -x => 88, 
		 -y => 400
		 );
	
$cmdClear->place(
		 -width => 96, 
		 -height => 32, 
		 -x => 200, 
		 -y => 400
		 );
	
$cmdExit->place(
		 -width => 96, 
		 -height => 32, 
		 -x => 312, 
		 -y => 400
		 );
	
MainLoop;
	
############################ SUBS ################################
	
	
##################################################################
## Sub: Calculate
## Description: This sub will clear all the Text Entries
##################################################################
sub Clear {
	$txtTo->delete(0, 'end');
	$txtSubject->delete(0, 'end');
	$txtBody->delete('1.0', 'end');
}
	
##################################################################
## Sub: SendMail
## Description: This sub will get all the input data and Sends 
## out the email message. It also checks to make sure your
## sending to a valid e-mail address and shows dialogs.
##################################################################
sub SendMail {
	my $ToEmail = $txtTo->get;
	my $Subject = $txtSubject->get;
	my $Body = $txtBody->get('1.0', 'end');
	my $smtp = Net::SMTP->new($MailHost);
	my $dialog = '';
	
	if (IsEmail($ToEmail) == 1) {
		$smtp->mail($FromEmail);
		$smtp->to($ToEmail);
		$smtp->data();
		$smtp->datasend("To: $ToEmail\n");
		$smtp->datasend("Subject: $Subject\n");
		$smtp->datasend("From: $FromName <$FromEmail> \n");
		$smtp->datasend("$Body\n\n\n");
		$smtp->datasend("Message Sent by Perl Application\n");
		$smtp->dataend();
		$smtp->quit();
		
		$dialog = $frmMain->Dialog(
					 -title => "SendEmail: Message Sent",
					 -text => "The message was successfully sent to $ToEmail",
					 -buttons => ["OK"]);
		$dialog->Show();
	}
	else {
		$dialog = $frmMain->Dialog(
					 -title => "SendEmail: Message Not Sent",
					 -text => "You must specify a Valid Email address to send to.\n",
					 -buttons => ["OK"]);
		$dialog->Show();
	}
}
	
	
##################################################################
## Sub Name: IsEmail.
## Description: This sub validates the input to check to see if
## the input is a valid format of an e-mail address.
## Example: webmaster@msn.com.
##################################################################
sub IsEmail {
	my $InputString = shift;
	
	
	if ($InputString =~ /^[\w.]+@\w[\w.-]+\w\.[A-Za-z]{2,4}$/) {
		return 1;
	}
	else {
		return 0;
	}
}