# This is a generic script to retrieve messages
# and add records to an SQL database

use OLE;
use Net::POP3;
use Win32::ADO;
use Data::Dumper;

# Set defaults for parameters
$config_file = 'd:\\perlscripts\\mail2sql.cfg';
$datasource = "mailarchive";
$user="user";
$password="password";

# Display some console string
print "\nMAIL2SQL ... updating database.\n\n";

# Read config info from file
get_config($config_file, \%config);


# Open the databases
$ado_data = CreateObject OLE "ADODB.Connection" or die "Cannot create ADODB connection";
$ado_data->Open( "$datasource", "$user", "$password" );

# Open the mailbox
my $pop = Net::POP3->new($config{server}, Timeout => 30) or
	die "Can't connect to mail server ($server)\n";
$pop->login($config{mailbox}, $config{password});

# For each message
$records = 0;
$records_ok = 0;
my $messages = $pop->list();
if( $messages ) {
    while(my ($msgid, $size) = each %$messages) {
		undef $body;
        $msg = $pop->get($msgid);
		foreach (@$msg) {
			s/'//g;							# Remove all ''s
			($from) = /^From: (.*)$/ if /^From:/;
			($subject) = /^Subject: (.*)$/ if /^Subject:/;
			$body .= $_ if defined $body;
			$body = "" if /^$/ and !$body;;
            #($body) =~ s/=20/ /g; # remove all occurances of =20
        }

        ($from_name, $from_email) = ($from =~ /(.*) <(.*)>/);
        sql_update();
		$pop->delete($msgid);
     }
} else {
	print "No records to process in mailbox.\n";
}

$pop->quit;
$ado_data->close;

#--------------------
sub get_config () {
#--------------------
	my $file_name = shift;
	my $rec = shift;
	my $var, $val;

	$$rec{filename} = $file_name;
	open(IN, "<$file_name") or die "Error opening config file: $file_name. $!\n";
	while (<IN>) {
		next if /^#/;
		next if /^$/;
		if ($var eq 'reply' && $_ !~ /=/) {
			$$rec{$var} .= $_;
			next;
		}
		($var, $val) = split(/\s*=\s*/);
		$var = lc $var;
		if ($var ne 'reply') {
			chomp $val;
			chop  $val if /\r$/;
		}
		$$rec{$var} = $val;
		#print "** $var = [$val]\n";
	}
	close IN;
}

#==================
sub sql_update {
#==================

	# Set the dateformat to d/m/y
	$dmy = "SET DATEFORMAT dmy";

	# Add record to sql database
    $sql = "INSERT data " .
           "(fromname, fromemail, subject, body) " .
           "VALUES ('$from_name', '$from_email', '$subject', '$body')";
	#print "SQL = $sql\n";
    my $RS = $ado_data->Execute($sql);

	# Test for errors
	$records++;
	if ($RS) {
		$records_ok++;
	} else {
        sql_errors($ado_data, $sql);
	}
}

#==================
sub sql_errors() {
#==================
	my $ado		= shift;
	my $msg		= shift;
	my $message	= "";

	$subject = "RE: $subject";
	$message .= "$body \n";
	$Errors = $ado->Errors();
	$message .= "SQL Errors:\n";
	foreach $error (keys %$Errors) {
		$message .= $error->{Description} . "\n";
	}
	$message .= "\nOffending SQL statement: $msg\n";
	sendmail($config{sender}, $config{notify}, $subject, $message);
}

#==================
sub sendmail {
#==================
	my $sender  = shift;
	my $recip   = shift;
	my $subject = shift;
	my $message = shift;

    use Net::SMTP;
    $smtp = Net::SMTP->new($config{server});	# connect to an SMTP server
    print "*** Error   ***   Problems connecting to mail server: $server\n" if !$smtp;

    $smtp->mail( $sender );				# use the sender's address here
    $smtp->to( $recip );				# recipient's address
    $smtp->data();						# Start the mail

    # Send the header.
    $smtp->datasend("To: $recip\n");
    $smtp->datasend("From: $sender\n");
    $smtp->datasend("Subject: $subject\n");
    $smtp->datasend("\n");

    # Send the body.
    $smtp->datasend($message);
    $response = $smtp->dataend();       # Finish sending the mail
    $smtp->quit;                        # Close the SMTP connection
	if (!$response) {
        print "*** Error   ***   Problems sending data to mail server: $server\n";
	} else {
		print "Results have been successfully sent to [$recip]\n";
	}
}






















































