Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Sending HTML Mail

by neilwatson (Priest)
on May 08, 2002 at 19:15 UTC ( [id://165140]=sourcecode: print w/replies, xml ) Need Help??
Category: E-Mail Programs
Author/Contact Info Neil Watson
<a href="http://watson-wilson.ca>watso-wilson.ca
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: 


#!/usr/bin/perl

#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', 'mail.info', 'Sender', 'pid',
+ 'unix' or die "cannot tie $!";
$stderr->ExtendedSTDERR();

# 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
+nder);
my ($sendtime, $regex, $confirm, $from, $to, $testto, $subject, $bodyf
+ile, $htype);  

# administration monitoring email
my $sysadmin = 'sysadmin@example.com';

# 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
+et");

    # WHO
    print "\nWho will the message be From, e.g Sender <marketing\@exam
+ple.com>.\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 <marketing@example.com>';
    }elsif ($from eq '2'){
        $from = 'Web Report <marketing@example.com>';
    }elsif ($from !~ m/\@example\.com/){
        die "\n From must contain a example.com email address.  Exitin
+g.\n";
    }

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

    # RECIPIENTS
    $regex = qr/\.csv/;
    dirlist();
    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...";
        rcheck();
    }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
+)";
    }

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

    # TEXT OR HTML MAIL
    print "\nAre you sending text or html email?  Enter text or html: 
+";
    $htype = <STDIN>;
    chomp $htype;

    # BODY FILE
    if ($htype eq "html"){
        $regex = qr/\.html?/;
    }else { # must be a text file
        $regex = qr/\.txt/;
    }
    dirlist();
    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;

    check_header();
    body();
    to();

    # TEST MESSAGE AND APPROVAL
    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
        }else{
            $sendtime = 17;
        }
        # send warning to sysadmin
        admin() or die "admin() failed $!";
        sleep (($sendtime - $time[2]) * 3600);
        to();
    }else{
        die "Confirmation to send not given.  Exiting...\n";
        exit;
    }

# must be command line mode    
}else{

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

    check_header();
    body();
    to();
}

undef $stderr;
untie *STDERR;

###############
# SUBS
###############

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

# 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;
        }else{
            die "Could not get bodyfile $bodyfile\n" unless @body ;
        }

    # body is a local file    
    }else{
        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\
+n";

        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.'@example.com';
        mailout() or usage(), warn "$!\n";
        print STDERR "Messages sent successfully to mail server\n";
    }
}

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

    $sender->Open({
        smtp => $smtp,
        skip_bad_recipients => 'true',
        from => "market_bounce\@example.com",
        fake_from => $from,
        to => "subscribers\@example.com",
        bcc => $to, 
        encoding => "quoted-printable",
        subject => $subject,
        ctype => $htype,
        headers => "Errors-To: market_bounce\@example.com",
        }) or usage(), warn "Sender error: $sender, $Mail::Sender::Err
+or!\n";

    # body of email. USE Send only for plain/text messages
    if ($htype eq "text"){
        $sender->Send(@body) or usage(), warn "Sender error: $sender, 
+$Mail::Sender::Error!\n";
    }else{
        $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
+der::Error!\n";
}

# 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>){
        chomp;

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

        unless (Mail::CheckUser::check_email($_)){
            $invalid{$x} = $_;
        }
        $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 }
            $x++
        }
        print "Your recipient file has $error errors\n";
        print "The entire file may be corrupt.  You should check the e
+ntire file carefully\n";
        die;
    }
    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    
    }else{
        open (TO, "$to") or die "Could not open tofile: $to $!\n";
        while (<TO>){
            $recip++;
        }
        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

*END*

    $sender = new Mail::Sender;

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

        $sender->SendEnc(<<"*END*");
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

*END*

    $sender->Close or die "Sender error: $sender, $Mail::Sender::Error
+!\n";
}

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


#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>
[reply]
      I tried MIME::Lite. It installed OK but was giving me errors when I tried to use it.

      Neil Watson
      watson-wilson.ca

[reply]
        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.
[reply]
      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.
[reply]
        well if you got mutiple newsletters for multiple sites maybe ? :)

        An intellectual is someone whose mind watches itself.
        - Albert Camus
[reply]

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: sourcecode [id://165140]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others chilling in the Monastery: (3)
As of 2024-04-25 19:55 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found