Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer

Sending HTML Mail

by neilwatson (Priest)
on May 08, 2002 at 19:15 UTC ( #165140=sourcecode: print w/replies, xml ) Need Help??
Category: E-Mail Programs
Author/Contact Info Neil Watson
<a href=">
Description: The marketing department sends HTML newsletters to customers and investors. They are currently using a desktop email client (sounds like outhouse) that gives inconsistant results.

This script simpifies things:


#Neil H Watson on Sun May 11 09:22:55 EDT 2003
#usage:  sender -f <from address> -t <to address (file allowed)> -s <s
+ubject> -b <body file> -h <header type "text" or "html">
#or sender -i for interactive mode

use strict;
use warnings;
use Getopt::Std;
use Mail::Sender;
use Term::ANSIColor;
use LWP::Simple;
use Cwd;
use Tie::Syslog;
use Mail::CheckUser;

# log STDERR to syslog
my $stderr = tie *STDERR, 'Tie::Syslog', '', 'Sender', 'pid',
+ 'unix' or die "cannot tie $!";

# get username
my $user = getpwuid $<;

# log if an interrupt is caught
$SIG{INT}  = \&sig;  
$SIG{QUIT} = \&sig;  
$SIG{TERM} = \&sig;  

print STDERR "Started by $user";

my (@time, %filelist, $x, $tempto, @body, $key, @to, $top, $count, $se
my ($sendtime, $regex, $confirm, $from, $to, $testto, $subject, $bodyf
+ile, $htype);  

# administration monitoring email
my $sysadmin = '';

# what smtp host will send the mailing
my $smtp = "mail"; 

my %opt= ( #set default options
    f => "x",
    t => "x",
    s => "x",
    b => "x",
    h => "x",
    i => "n");

getopts("f:t:s:b:h:i", \%opt); 

# go to interactive mode
if ($opt{i} ne "n"){
    print color("yellow"), "Entering Interactive mode\n\n", color("res

    # WHO
    print "\nWho will the message be From, e.g Sender <marketing\@exam>.\n";
    print color("yellow"), "1. Sender\n2. Web Report\n or, type someth
+ing: ", color("reset");
    $from = <STDIN>;
    chomp $from;
    if ($from eq '1'){
        $from = 'Sender <>';
    }elsif ($from eq '2'){
        $from = 'Web Report <>';
    }elsif ($from !~ m/\@example\.com/){
        die "\n From must contain a email address.  Exitin

    print "\nEnter the Subject for your message: ";
    $subject = <STDIN>;
    chomp $subject;

    $regex = qr/\.csv/;
    print "\nEnter the name of the recipient file or, select a number 
+from the above file list or, email addresses separated by commas: ";
    $to = <STDIN>;
    chomp $to; 
    if ($to =~ m/^\d+$/){
        $to = $filelist{$to};
        # check recipient file for import errors (e.g. ,,,,,)
        print "\nChecking recipient file.  Please wait...";
    }elsif ($to !~ m/\@/){ #if to is a file check for existance
        -e $to or die "\nThe file $to does not exist (check for a typo

    print "\nEnter testing email addresses, separated by commas: ";
    $testto = <STDIN>;
    chomp $testto;

    print "\nAre you sending text or html email?  Enter text or html: 
    $htype = <STDIN>;
    chomp $htype;

    if ($htype eq "html"){
        $regex = qr/\.html?/;
    }else { # must be a text file
        $regex = qr/\.txt/;
    print "\nEnter the name of the file containing the body of your me
+ssage or,\n";
    print "the URL of the body file starting with http:// or,\n";
    print "select a number from the above file list: ";
    $bodyfile = <STDIN>;
    chomp $bodyfile; 
    if ($bodyfile =~ m/^\d+$/){
        $bodyfile = $filelist{$bodyfile};

    # send test email
    $tempto = $to;
    $to = $testto;


    print "\nA test message has been sent to your email address.\n";
    print "If you are happy with it, type \"Yes, I want to send this m
+ail now\" to send the mail to the real recipients.\n";
    print color("yellow"), "WARNING: Once you type \"Yes, I want to se
+nd this mail now\", the sending of this message CANNOT be stopped: ",
+ color("reset");
    $confirm = <STDIN>;
    chomp $confirm;

    # if confirmed, send messages
    if ($confirm eq "Yes, I want to send this mail now"){
        $to = $tempto;
        print "\nSending Messages...\n\n";

        # fork and free the user
        fork && exit;

        # do not send until 17:00 or
        # do not send for at least 2 hours
        @time = localtime();

        # if time is less than 2 hours before 17:00
        # then add two hours to send time
        if ($time[2] >= 15){
            $sendtime = $time[2]+2;
        # else send time is at 17 hours
            $sendtime = 17;
        # send warning to sysadmin
        admin() or die "admin() failed $!";
        sleep (($sendtime - $time[2]) * 3600);
        die "Confirmation to send not given.  Exiting...\n";

# must be command line mode    

    $from = $opt{f};
    $to = $opt{t};
    $subject = $opt{s};
    $bodyfile = $opt{b};
    $htype = $opt{h};


undef $stderr;
untie *STDERR;


# grabs file list for user to select
sub dirlist {
    opendir(DIR, ".") or die "can't open dir name $!";
    while (defined(my $file = readdir(DIR))){
        if ($file =~ m/$regex/){
            print color("yellow"), $x,": ",$file,"\n", color("reset");
            $filelist{$x} = $file;

# prints usage on errors
sub usage {
    print "Error\n";
    print "Usage:  sender -f <from address> -t <to address (file allow
+ed)> ";
    print "-s <subject> -b <body file> -h <header type text or html>";
    print "\nOR\nsender -i for interactive mode\n\n";

#determine proper hearder type
sub check_header {
    chomp $htype; 
    if ($htype eq "text"){
        $htype = "text/plain";
    } elsif ($htype eq "html"){
        $htype = "text/html";
    } else {
            usage(), die "Error: wrong hearder ($htype given) type.  O
+nly text or html allowed.\n\n";

#create body string
sub body{

    # body is found at URL
    if ($bodyfile =~ m/^http/i){
        if (defined get $bodyfile){
            @body = get $bodyfile;
            die "Could not get bodyfile $bodyfile\n" unless @body ;

    # body is a local file    
        open BODY, "$bodyfile" or usage(), die "Could not open bodyfil
+e: $bodyfile\n";
            while (<BODY>){
                # chomp();
                # $_ = $_."\r";
                $_ =~ s/\w+$/\n/g;
                push @body, $_;
                # $body .= $_;
        close BODY;

#create to header and mail 
sub to {
    #if to is a single address
    if ($to =~ m/\@/){
        mailout() or usage(), warn "$!\n";

    } else { # to is a file

        open (TO, "$to") or usage(), die "Could not open tofile:  $to\

        while (<TO>){
            chomp $_; 
            push @to, $_;
            $count ++;

            #spits bcc into small chuncks
            if ($count == 80){
                $to = join ",", @to;
                mailout() or usage(), warn "$!\n";
                $count = 0;
                @to = ();
        $to = join ",", @to;
        $to .= ','.$user.'';
        mailout() or usage(), warn "$!\n";
        print STDERR "Messages sent successfully to mail server\n";

# build email and send
sub mailout {
    $sender = new Mail::Sender;

        smtp => $smtp,
        skip_bad_recipients => 'true',
        from => "market_bounce\",
        fake_from => $from,
        to => "subscribers\",
        bcc => $to, 
        encoding => "quoted-printable",
        subject => $subject,
        ctype => $htype,
        headers => "Errors-To: market_bounce\",
        }) or usage(), warn "Sender error: $sender, $Mail::Sender::Err

    # body of email. USE Send only for plain/text messages
    if ($htype eq "text"){
        $sender->Send(@body) or usage(), warn "Sender error: $sender, 
        $sender->SendEnc(@body) or usage(), warn "Sender error: $sende
+r, $Mail::Sender::Error!\n";

    # send email
    $sender->Close or usage(), warn "Sender error: $sender, $Mail::Sen

# check recipient file for import errors (e.g. ,,,,,)
sub rcheck{
    my (%invalid, $key, $error, $str);

    open TO, $to or die "Cannot open file $to $!";
    $x = 1;
    print "\n";

    # we want to syntax check recipients only.  No network checks.
    $Mail::CheckUser::Skip_Network_Checks = 'true';

    while (<TO>){

        # remove extra windows white space that may
        # upset error message printing
        $_ =~ s/\s*$//g;

        unless (Mail::CheckUser::check_email($_)){
            $invalid{$x} = $_;
    close TO;

    # were there errors?
    $error = keys %invalid;
    $x = 1;
    if ($error > 1){
        foreach $key (sort {$a<=>$b} keys %invalid){
            $str = "The email address $invalid{$key} in your recipient
+ file $to at line $key is invalid.\n";
            print STDOUT $str;
            print STDERR $str;

            # print only the first 10 errors
            if ($x > 10){ last }
        print "Your recipient file has $error errors\n";
        print "The entire file may be corrupt.  You should check the e
+ntire file carefully\n";
    print "\nRecipient list looks good. Continuing";

# send warning mail to sysadmin
sub admin {

    my $now = localtime; # timestamp
    my $pid = $$; # get PID in case you need to kill
    my $time = $sendtime." hours ".$time[1]." minutes"; # time mailing
+ will go out
    my $pwd = cwd; # get pwd
    my $recip; # number of recipients

    # to contains actual addresses
    if ($to =~ m/\@/){
        $recip = scalar (() = $to =~ m/\@/g);
    # to is a file    
        open (TO, "$to") or die "Could not open tofile: $to $!\n";
        while (<TO>){
        close (TO);

    # log information
    print STDERR (<<"*END*");

$now Sender log for
user = $user
PID = $pid
Scheduled sending time = $time
PWD = $pwd
bodyfile = $bodyfile
Recipient file = $to
Recipients = $recip


    $sender = new Mail::Sender;

        smtp => $smtp,
        to => $sysadmin,
        from => "$user\",
        encoding => "quoted-printable",
        subject => "Sender mailing scheduled",
        }) or die "Sender error: $sender, $Mail::Sender::Error!\n";

A sender process is scheculed to send a mailing:

user = $user
PID = $pid
Scheduled sending time = $time
PWD = $pwd
bodyfile = $bodyfile
Recipient file = $to
Recipients = $recip
Fake from = $from


    $sender->Close or die "Sender error: $sender, $Mail::Sender::Error

sub sig { 
    print STDERR "Died by Interrupt: @_, $!\n";

#for debugging
#sub mailout{
#    print "$to\n\n";

Replies are listed 'Best First'.
Re: Sending HTML Mail
by yodabjorn (Monk) on May 08, 2002 at 21:18 UTC
    <shameless plug>
    i just posted my code for doin a verry similar thing, but using Mail::Bulkmail, MIME::Lite, and multiple servers for speed. (74k emails in 23 minutes with 3 servers) you might want to check it out here:
    forking/envleloping/Mulipart Mime Newsletter Mailer
    supports mutiple lists of addys and subject files as well as multipart mime attachments etc.. etc.. </shameless plug>
      I tried MIME::Lite. It installed OK but was giving me errors when I tried to use it.

      Neil Watson

        what kind of errors.

        there are a lot of nodes here on MIME::Lite(CPAN LINK)

        Try MIME::Lite for one good perlmonks discussion on it.
      supports mutiple lists of addys and subject files as well I realize I'm late, but why on earth would you want that? It sounds like a spam-tool to me. Mind you - I really don't mind opt-in newsletters, but I hate spam with a passion.
        well if you got mutiple newsletters for multiple sites maybe ? :)

        An intellectual is someone whose mind watches itself.
        - Albert Camus
Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://165140]
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (6)
As of 2017-01-23 11:11 GMT
Find Nodes?
    Voting Booth?
    Do you watch meteor showers?

    Results (192 votes). Check out past polls.