http://qs321.pair.com?node_id=165140
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";
#}

Back to Code Catacombs