Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw

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 exploiting the Monastery: (12)
As of 2017-01-23 11:01 GMT
Find Nodes?
    Voting Booth?
    Do you watch meteor showers?

    Results (192 votes). Check out past polls.