View of /DadaFork/DADA/Mail/Send.pm
Parent Directory
| 
Revision Log
Revision:
2260 -
(
download)
Sat Jan 13 22:53:39 2007 UTC (17 years, 3 months ago) by
pje
File size: 58468 byte(s)
Correct off-by-one error
package DADA::Mail::Send;
=pod
=head1 NAME
DADA::Mail::Send
=head1 SYNOPSIS
use DADA::Mail::Send
my $mh = DADA::Mail::Send->new;
Mail Routines for the Dada Mail MLM, UC?
=head1 DESCRIPTION
Cool name huh? You have found the heart of the beast, this is where ALL mailings will find
themselves, one way or another, let's see if we can get this all straightened out so you
can customize this to your heart's delight. Follow me...
First off, there are TWO different ways mailings happen, either by sending one e-mail, using
the send() method, or when sending to a group, using the bulk_send() method. This is
somewhat of a fib, since mailings called by bulk_send() actually use the send() method to
do its dirty work. Well, that is, if you're not using a SMTP feature, then both the send()
and bulk_send() have their own way of doing it... kinda.
You create a single address object like so:
my $mh = DADA::Mail::Send->new(\%list_info);
my %mailing = (
To => 'justin@example.com',
From => 'alex@example.com',
Subject => 'party over here!',
Body => 'yo yo yo, wheres the flava at? we need some action!',
);
$mh->bulk_send(%mailing);
Pretty fricken hard eh?
Well, it can get a bit harder than that, but thats a pretty stripped down version,
If you wanted, you could theoretically use this as a do all mail sender + all the features
that are in the Guts.pm module. Its pretty easy to make some crazy... stuff once you've got a
handle on it.
=cut
use Fcntl qw(
LOCK_SH
O_RDONLY
O_CREAT
);
my $dbi_obj;
use DADA::Config qw(!:DEFAULT);
use DADA::App::Guts;
use DADA::Logging::Usage;
my $log = new DADA::Logging::Usage;;
use strict;
use vars qw($AUTOLOAD);
use Carp qw(croak carp);
use Fcntl qw(:DEFAULT :flock O_WRONLY O_TRUNC O_CREAT LOCK_EX );
my %allowed = (
list_info => {},
list_type => 'list',
bulk_test => 0,
#bulk_start_email => undef,
#bulk_send_sending_file => undef,
bulk_start_num => 0,
do_not_send_to => [],
ignore_schedule_bulk_mailings => 0,
saved_message => undef,
also_send_to => [],
im_bulk_sending => 0,
num_subscribers => undef,
restart_with => undef,
);
=pod
=head1 new
my $mh = DADA::Mail::Send->new(-list => $list_info_hashref);
=head1 Default Headers
DADA::Mail::Send has a wide variety of both e-mail headers you can send to it. you do this
through either the B<send()> or B<bulksend()> methods
=over 4
=item * From
This should hold where the e-mail is from. Tricky, eh?
example:
From => '"Alex Skazat" <alex@example.com>',
=item * To
Mail Header, This should hold where the e-mail is going to,
example:
To => '"Justin Simoni" <justin@example.com>',
=item * Bcc
This is used as a "Blank Carbon Copy", meaning a copygoes to whoever is
specified in the Bcc header, without it showing up in the To's header.
B<DO NOT USE THIS FOR BULK MAILING> Send one 100,000 emails, some poor fella
is going to get 100,000 copies
example: same as the To or From
=item * Return-Path
Specifies what address an e-mail will get sent to when someone replies to an e-mail address.
Sometimes works, sometimes doesn't, very fluky, better to set with the sendmail '-f' flag
example:
'Return-Path' => 'justin@example.com',
=item * Reply-To
Very similar to the Return-Path,
=item * Errors-To
Mail Header, specifies where errors, like if the e-mail address you're trying to send
isn't real, or their mailbox is full, a message I<supposed> to use this address
to mail the error to.
example:
'Errors-To' => 'errors@example.com',
=item * Precedence
Mail Header, sets the so called 'precedence' of a bulk message, the valid values are
list, bulk and junk. Certain e-mail clients may use this to filter out spam, or
list messages,
example:
Precedence => 'junk',
default is list.
=item * Content-type
sets the content type of the email message, something like text/plain or text/html, it tells the mail reader how to
show the mail message. This is also where you can specify certain character sets, since not everyone uses english as their first language,
like:
Content-type => 'text/html; charset=us-ascii';
=item * Content-Disposition
(ah hem) "Whether a MIME body part is to be shown inline or is an attachment; can also indicate a suggested filename for use when saving an attachment to a file."
example:
'Content-Disposition => 'inline; filename="index.html"',
=item * Content-Transfer-Encoding
(ah hem) "Coding method used in a MIME message body."
example:
'Content-Transfer-Encoding' => 7bit',
you could also say 'base64', '8bit' or 'quote-printable'
=item * MIME-Version
this specifies what MIME version your using, usually this is set as 1.0, without setting a MIMIE version HTML e-mails don't come out well,
example:
'MIME-Version' => '1.0',
=item * List
This can be a mail header, Dada Mail uses it internally to say what list is sending bulk messages, the list name is important to fetch all sorts of things, write temp files, etc,
example List => 'my list',
=item * Mailing List Headers
Theres a whole slew of Mailing List related headers, that are pretty self-explainatory:
List-Archive
List-Digest
List-Help
List-ID
List-Owner
List-Post
List-Subscribe
List-Unsubscribe
List-URL
=item * References
this tag is used by popular Mail readers to figure out how different messages are related.
This isn't used in Dada Mail, but it may one day for its archives, this usually holds a weird numerical value,
=item * In-Reply-To
Again, this is used by mail readers to keep track of e-mail messages.
=item * Subject
The subject of your message
example:
Subject => 'mail server is about to explode',
=item * Body
This is the body message, usually I make the value before hand, and stick the variable in, like this:
my $Body = <<EOF
Help!
I'm trapped in a peanut butter factory,
The only way I can communicate with the
real world is by sending messages inside
peanut butter containers.
Bob,
EOF
;
Body => $Body,
This really isn't a mail header, but this is how you get the Body of a message to Dada Mail
=back
B<Please Note>
In earlier versions of this module, certain key/value pairs were passed to this script to change the way mailings were done. No more. Settings that afect mailings are either passed in the hash ref you passed to new() or, by some handy dandy methods
=head1 Handy Dandy Methods
These methods are used to change how Dada Mail sends mostly Bulk messages, these are the fun ones,
=over 4
=item * do_not_send_to
This ones kinda cool, give it a reference to an array of addresses you do not want sent the email.
you could also specify your entire black list. The possibilities, kids, are endless.
example: $mh->do_not_send_to(['justin@example.com', 'alex@example.com']);
This array ref is then passed to MailingList::*::\ function that makes the actual list to send to. Basically create_bulk_sending_file weeds out the emails in a list we don't want to send to
=item * bulk_test
This is a magical paramater that, when changed to one, will only send bulk messages to the list owner. "What's the point of that?" well, it'll set up DADA::Mail::Send as I<if> it was sending a bulk message, instread of being in "send one message mode" This makes sure all your configs are peachy keen. 1 for test, nothing for no test,
=back
=cut
# these are all the headers Dada Mail understands.
# if you don't WANT a header shown, in ANY
# message, simple take it outta here.
my %defaults = %DADA::Config::EMAIL_HEADERS;
my @default_headers = @DADA::Config::EMAIL_HEADERS_ORDER;
sub new {
my $that = shift;
my $class = ref($that) || $that;
my $self = {
_permitted => \%allowed,
%allowed,
};
bless $self, $class;
my $list_info = shift;
$self->{list_info} = $list_info;
$self->_init;
return $self;
}
sub AUTOLOAD {
my $self = shift;
my $type = ref($self)
or croak "$self is not an object";
my $name = $AUTOLOAD;
$name =~ s/.*://; #strip fully qualifies portion
unless (exists $self -> {_permitted} -> {$name}) {
croak "Can't access '$name' field in object of class $type";
}
if(@_) {
return $self->{$name} = shift;
} else {
return $self->{$name};
}
}
sub _init {
my $self = shift;
$self->{mj_log} = $log;
if($self->{list_info}->{use_domain_sending_tunings} == 1) {
if($self->{list_info}->{domain_sending_tunings}) {
my $tunings = eval($self->{list_info}->{domain_sending_tunings});
my $lookup_tunings = {};
# let's make this into an easier-to-look-up-format:
foreach my $tune(@$tunings){
if($tune->{domain}){ # only real thingy needed...
$lookup_tunings->{$tune->{domain}} = {};
foreach my $in_tune(keys %$tune){
# next if $in_tune eq 'domain';
$lookup_tunings->{$tune->{domain}}->{$in_tune} = $tune->{$in_tune};
}
}
}
$self->{domain_specific_tunings} = $lookup_tunings;
}
}
}
=pod
=head2 return_headers
my %headers = $mh->return_headers($string);
This is a funky little subroutine that'll take a string that holds the
header of a mail message, and gives you back a hash of all the headers
separated, each key in the hash holds a different header, so if I say
my $mh = DADA::Mail::Send -> new();
my %headers = $mh -> return_headers($header_glob);
I can then say:
my $to = $headers{To};
This subroutine is used quite a bit to take out put from the MIME::Lite
module, which allows you to get the whole header with its header_to_string()
subroutine and hack it up into something Dada Mail can use.
=cut
sub return_headers {
my $self = shift;
#get the blob
my $header_blob = shift || "";
#init a new %hash
my %new_header;
# split.. logically
my @logical_lines = split /\n(?!\s)/, $header_blob;
# make the hash
foreach my $line(@logical_lines) {
my ($label, $value) = split(/:\s*/, $line, 2);
$new_header{$label} = $value;
}
return %new_header;
}
=pod
=head2 clean_headers
%squeaky_clean_headers = $mh->clean_headers(%these_be_the_heaers);
this method does a little munging to the mail headers for better absorbtion; basically, it changes the case of some of the mail headers so everyone's on the same page
=cut
sub clean_headers {
my $self = shift;
my %mail_headers = @_;
if((exists($mail_headers{'Content-Type'})) && ($mail_headers{'Content-Type'} ne "")){
$mail_headers{'Content-type'} = $mail_headers{'Content-Type'};
delete($mail_headers{'Content-Type'});
}
$mail_headers{'Content-Transfer-Encoding'} = $mail_headers{'Content-transfer-encoding'}
if defined $mail_headers{'Content-transfer-encoding'};
$mail_headers{'Content-Base'} = $mail_headers{'Content-base'}
if defined $mail_headers{'Content-base'};
$mail_headers{'Cc'} = $mail_headers{'CC'}
if defined $mail_headers{'CC'};
foreach(keys %mail_headers){
my $tmp_h = $mail_headers{$_};
if($tmp_h){
$tmp_h =~ s/\n$//;
$mail_headers{$_} = $tmp_h;
}
}
delete($mail_headers{'X-Mailer}'})
if exists $mail_headers{'X-Mailer}'};
return %mail_headers;
}
=pod
=head2 send
This method sends an email, it takes a hash of the mail headers, plus the body of the message:
$mh->send(To => 'justin@example.com',
From => 'secret@admirer.com',
Subject => 'smooch!',
Body => 'you are so cute, you little Perl Coder you'
);
=cut
sub send {
require Email::Address;
my $self = shift;
my %fields = (
%defaults,
$self->_make_general_headers,
$self->_make_list_headers,
@_
);
# This makes a local copy of the list settings.
my $local_li = {};
foreach(keys %{$self->{list_info}}){
$local_li->{$_} = $self->{list_info}->{$_};
}
# This copies over domain-specific tunings for sending...
my ($email_address, $email_domain) = split('@', $fields{To});
# damn that's weird.
if($self->{list_info}->{use_domain_sending_tunings} == 1) {
if($self->{domain_specific_tunings}->{$email_domain}->{domain} eq $email_domain){
foreach(keys %{$self->{domain_specific_tunings}->{$email_domain}}){
$local_li->{$_} = $self->{domain_specific_tunings}->{$email_domain}->{$_};
}
}
}
# and back to your regularly scheduled send() subroutine...
%fields = $self->clean_headers(%fields);
# TODO I don't know what $tmp_body is!
my $tmp_body = $defaults{Body};
$tmp_body =~ s/\[program_url\]/$DADA::Config::PROGRAM_URL/g;
# or this!
$defaults{Body} = $tmp_body;
unless($self->im_bulk_sending == 1){
$fields{Body} =~ s/\[list\]/$local_li->{list}/g;
$fields{Body} =~ s/\[list_name\]/$local_li->{list_name}/g;
}
%fields = $self->_strip_fields(%fields)
if ($local_li->{strip_message_headers} == 1);
my $recipient_for_log = $fields{To};
# write the header, if its set.
$fields{'Content-type'} .= '; charset='. $local_li->{charset_value}
if(
(defined($local_li->{charset_value})) &&
(defined($fields{'Content-type'})) &&
($fields{'Content-type'} !~ /charset\=/) #ie, wasn't set before.
);
if($local_li->{print_return_path_header} == 1){
if($local_li->{verp_return_path} == 1){
$fields{'Return-Path'} = '<'. $self->_verp($fields{To}) .'>';
}else{
$fields{'Return-Path'} = '<'. $local_li->{admin_email} . '>';
}
}
if($local_li->{smtp_server} ne "" &&
$local_li->{send_via_smtp} == 1 &&
$local_li->{smtp_engine} eq "net_smtp"
){
$self->_pop_before_smtp;
my $host;
if($local_li->{set_smtp_sender} == 1){
$host = $local_li->{admin_email};
} else {
$host = $local_li->{list_owner_email};
}
$host =~ s/(.*?)\@//;
eval {
my $mailer;
my %mailer_params = (
Hello => $host,
Host => $local_li->{smtp_server},
Timeout => 60,
Port => $local_li->{smtp_port},
(
($DADA::Config::CPAN_DEBUG_SETTINGS{NET_SMTP} == 1) ?
(
Debug => 1,
) :
()
),
);
if($local_li->{use_smtp_ssl} == 1){
require Net::SMTP::SSL;
$mailer = new Net::SMTP::SSL(%mailer_params);
}else {
require Net::SMTP;
$mailer = new Net::SMTP(%mailer_params);
}
# authing can fail, although the message may still go through
# to the SMTP server, since sometimes SASL AUTH isn't required, but is
# attempted anyways.
if($local_li->{use_sasl_smtp_auth} == 1){
$mailer->auth(
$local_li->{sasl_smtp_username},
$self->_cipher_decrypt($local_li->{sasl_smtp_password})
) or carp 'Problems sending SASL authorization to SMTP server, make sure your credentials (username, password) are correct.';
}
my $to;
if( $local_li->{set_to_header_to_list_address} == 1 &&
$local_li->{group_list} == 1 &&
# Don't understand this:
$fields{from_bulk_send} == 1 &&
defined($local_li->{discussion_pop_email}
) # safegaurd?
){
# This is who it's going to.
$to = $fields{To};
# This is what we're going to say we are...
$fields{To} = $local_li->{discussion_pop_email};
} else {
# um, nevermind.
$to = $fields{To};
}
# why wouldn't it be defined?
if (defined($to)){;
eval { $to = (Email::Address->parse($to))[0]->address; }
}
#if(!$to){
# $to = $fields{To};
#}
my $smtp_msg = '';
foreach my $field (@default_headers){
$smtp_msg .= "$field: $fields{$field}\n"
if( (defined $fields{$field}) &&
($fields{$field} ne "")
);
}
$smtp_msg .= "\n";
$smtp_msg .= $fields{Body} . "\n";
my $FROM_error_flag = 0;
my $FROM_error = "problems sending FROM:<> command to SMTP server.";
if($local_li->{set_smtp_sender} == 1){
if($local_li->{verp_return_path}){
if(!$mailer->mail($self->_verp($to))){
carp $FROM_error;
$FROM_error_flag++;
}
}else{
if(!$mailer->mail($local_li->{admin_email})){
carp $FROM_error;
$FROM_error_flag++;
}
}
} else {
if($local_li->{verp_return_path}){
if(!$mailer->mail($self->_verp($to))){
carp $FROM_error;
$FROM_error_flag++;
}
}else{
if(!$mailer->mail($local_li->{list_owner_email})){
carp $FROM_error;
$FROM_error_flag++;
}
}
}
if(! $FROM_error_flag){
if($mailer->to($to)){
if($mailer->data){
if($mailer->datasend($smtp_msg)){
if($mailer->dataend){
# oh hey, everything worked!
}else{
carp "problems completing sending message to SMTP server.";
}
}else{
carp "problems sending message to SMTP server.";
}
}else{
carp "problems sending DATA command to SMTP server.";
}
} else{
carp "problems sending, 'RCPT TO:<>' command to SMTP server.";
}
} else{
carp $FROM_error;
}
$mailer->reset()
or carp 'problems sending, "RSET" command to SMTP server.';
$mailer->quit
or carp "problems 'QUIT'ing SMTP server.";
}; # end of the eval block.
if($@){ # Something went wrong when trying to send...
carp "Problems sending via SMTP: $!";
}
}else{
my $live_mailing_settings;
# carp ' $fields{To} ' . $fields{To};
my $plain_to_address = $fields{To}; #holds something like, me@you.com
if (defined($plain_to_address)){;
eval { $plain_to_address = (Email::Address->parse($plain_to_address))[0]->address; }
} else {
carp "couldn't strip, 'to' address!";
}
if($DADA::Config::MAIL_SETTINGS =~ /\-f/){
carp "$DADA::Config::PROGRAM_NAME $DADA::Config::VER, \$DADA::Config::MAIL_SETTINGS variable already has the -f flag set ($DADA::Config::MAIL_SETTINGS), not setting again $!";
$live_mailing_settings = $DADA::Config::MAIL_SETTINGS;
}elsif($local_li->{add_sendmail_f_flag} == 1){
if($local_li->{verp_return_path} == 1){
$live_mailing_settings = $DADA::Config::MAIL_SETTINGS . ' -f'. $self->_verp($plain_to_address);
}else{
$live_mailing_settings = $DADA::Config::MAIL_SETTINGS . ' -f'. $local_li->{admin_email};
}
}else{
$live_mailing_settings = $DADA::Config::MAIL_SETTINGS;
}
if( $local_li->{set_to_header_to_list_address} == 1 &&
$local_li->{group_list} == 1 &&
$fields{from_bulk_send} == 1 &&
defined($local_li->{discussion_pop_email}) # safegaurd?
){
$live_mailing_settings =~ s/\-t//; # remove any, "-t" flags...
$live_mailing_settings .= ' ' . $plain_to_address;
$fields{To} = $local_li->{discussion_pop_email};
}
$live_mailing_settings = make_safer($live_mailing_settings);
# pipe it to sendmail.. $DADA::Config::MAIL_SETTINGS is set in the Config.pm file... worth a good look.
carp "MAIL is already open....?"
if (defined fileno *FH);
open(MAIL,$live_mailing_settings) or $self->_send_die($fields{Debug});
print MAIL 'Return-Path: ' . $fields{'Return-Path'} . "\n"
if $fields{'Return-Path'};
foreach my $field (@default_headers){
print MAIL "$field: $fields{$field}\n"
if( (defined $fields{$field}) &&
($fields{$field} ne "") &&
($field ne 'Return-Path')
);
}
print MAIL "\n";
print MAIL $fields{Body} . "\n";
close(MAIL)
or carp "$DADA::Config::PROGRAM_NAME $DADA::Config::VER Warning: didn't close pipe to '$live_mailing_settings' - $!";
}
$self->{mj_log}->mj_log($local_li->{list}, 'Mail Sent', "Recipient:$recipient_for_log, Subject:$fields{Subject}")
if $DADA::Config::LOG{mailings};
return 1;
$local_li = $self->{list_info};
}
sub smtp_test {
my $self = shift;
require DADA::Security::Password;
my $filename = time . '_' . DADA::Security::Password::generate_rand_string();
open(SMTPTEST, ">$DADA::Config::TMP/$filename") or die "That didn't work.";
*STDERR = *SMTPTEST;
my $orig_debug = $DADA::Config::CPAN_DEBUG_SETTINGS{NET_SMTP};
$DADA::Config::CPAN_DEBUG_SETTINGS{NET_SMTP} = 1;
$self->send(
To => $self->{list_info}->{list_owner_email},
From => $self->{list_info}->{list_owner_email},
Subject => "SMTP Test Email",
Body => "This message is sent out to test SMTP mailing...",
);
close(SMTPTEST);
$DADA::Config::CPAN_DEBUG_SETTINGS{NET_SMTP} = $orig_debug;
open(RESULTS, "<$DADA::Config::TMP/$filename")
or die "that didn't work $!";
my $msg = do { local $/; <RESULTS> };
close(RESULTS);
my @r_l = split("\n", $msg);
my $report = [];
foreach my $l(@r_l){
if($l =~ m/502 unimplemented/i){
push (@$report, {line => $l, message => 'SASL Authentication may not be available on this SMTP server - try POP-before-SMTP Authentication.'});
}elsif($l =~ m/250\-AUTH PLAIN LOGIN|250 AUTH LOGIN PLAIN|250\-AUTH\=LOGIN PLAIN/i){
push (@$report, {line => $l, message => 'Looks like Plain SASL Authentication is Supported!'});
}elsif($l =~ m/535 Incorrect authentication data|535 authorization failed/i){
push (@$report, {line => $l, message => 'Looks like there\'s something wrong with your username/password - double check that you entered them right.'});
}elsif($l =~ m/Authentication succeeded|OK Authenticated/i){
push (@$report, {line => $l, message => 'Looks like we logged in OK!'});
}elsif($l =~ m/235 ok\, go ahead/i){
push (@$report, {line => $l, message =>'Looks like we logged in OK!'});
}elsif($l =~ m/auth not available/i){
push (@$report, {line => $l, message =>'Looks like we tried to log in, but our login was rejected for some reason.!'});
}
}
return ($msg, \@r_l, $report);
}
=pod
=head2 bulk_send
Sends a message to everyone on your list, (that you specified, by passing a hash ref with the list settings.. right?)
Takes the same arguments as send()
returns (for now) the Message-ID of the message being sent.
You can use this as the key for an archived message (let's say)
=cut
sub restart_bulk_send {
my $self = shift;
my $id = shift;
my $type = shift;
croak "no id!" if ! $id;
croak "no type!" if ! $type;
$self->list_type($type); # that should take care of the type...
$self->{mj_log}->mj_log(
$self->{list_info}->{list},
"Restarting List Sending",
"Internal ID: " . $id,
"Tupe: " . $type,
) if $DADA::Config::LOG{mass_mailings};
$self->{mj_log}->close_log if $DADA::Config::LOG{mass_mailings};
$self->restart_with($id);
$self->bulk_send();
}
sub bulk_send {
my $self = shift;
my %fields = (
%defaults,
$self->_make_general_headers,
$self->_make_list_headers,
@_);
$self->im_bulk_sending(1);
%fields = $self->clean_headers(%fields);
$defaults{Body} =~ s/\[program_url\]/$DADA::Config::PROGRAM_URL/g;
require DADA::MailingList::Subscribers;
$DADA::MailingList::Subscribers::dbi_obj = $dbi_obj;
my $lh = DADA::MailingList::Subscribers->new(-List => $self->{list_info}->{list});
my $path_to_list = undef;
my $total_sending_out_num = undef;
my $bsf_errors = {};
require DADA::Mail::MailOut;
my $mailout = DADA::Mail::MailOut->new( { -List => $self->{list_info}->{list} } );
if($self->restart_with){
# Shazzam!
$mailout->associate_with_id($self->restart_with);
# Seems like we should still be able to do this if basically if the lock is unlocked...
if($mailout->should_be_restarted){
my $raw_msg = $mailout->reload($self->list_type);
my ($raw_header, $raw_body) = split(/\n\n/, $raw_msg, 2);
%fields = $self->return_headers($raw_header);
$fields{Body} = $raw_body;
} else {
croak "Attempt to reload a message which does not have a stalled process - check before attempting!";
}
}else {
$mailout->create({
-fields => {%fields},
-list_type => $self->list_type,
-mh_obj => $self,
});
}
# This is so awkwardly placed...
if($self->list_type eq 'invitelist'){
my $lh = DADA::MailingList::Subscribers->new(-List => $self->{list_info}->{list});
$lh->remove_this_listtype(-Type=> 'invitelist');
}
# I don't know why this is here...
my $num_subscribers = $lh->num_subscribers;
$self->num_subscribers($num_subscribers);
my $status = $mailout->status;
if($status->{percent_done} >= 100){
carp "dude, status says >= 100% - am I missing something?!";
return;
}
if($status->{is_batch_locked} == 1){
carp "Sending process is currently locked, not resending message until lock is unlock or seen as stale...";
return;
}
# how many messages get sent between batches?
my $letters = 1;
if(defined($self->{list_info}->{bulk_send_amount})){
$letters = $self->{list_info}->{bulk_send_amount}; # why am I making this its own variable?!
}
# we need to create a new file that has the subscribers and their pin
# number. Those two things will be separated with a '::' so we can split
# it apart later.
undef $lh;
my $pid;
FORK: {
if ($pid = fork) {
$self->{mj_log}->mj_log(
$self->{list_info}->{list},
'Message pid: ' . $pid,
"Subject:".$fields{Subject}
) if $DADA::Config::LOG{mass_mailings};
$self->{mj_log}->close_log
if $DADA::Config::LOG{mass_mailings};
$self->_log_sub_count(
-msg_id => $fields{'Message-ID'},
-num_subscribers => $num_subscribers,
);
# save a copy of the message for later pickup.
$self->saved_message($self->_massaged_for_archive(\%fields));
return $fields{'Message-ID'};
} elsif (defined $pid) { # $pid is zero here if defined
if($DADA::Config::NULL_DEVICE){
open(STDIN, ">>$DADA::Config::NULL_DEVICE") or carp "couldn't open '$DADA::Config::NULL_DEVICE' - $!";
open(STDOUT, ">>$DADA::Config::NULL_DEVICE") or carp "couldn't open '$DADA::Config::NULL_DEVICE' - $!";
}
setpgrp;
#warn "starting the sending process.";
# child here
# parent process pid is available with getppid
my $mailing;
my $n_letters = $letters;
my $n_people = 0;
#my $sleep_num = 0;
my $send_body = $fields{Body};
#my $batch_num = 1;
# this is annoyingly complicated
my $mail_info;
my $list_pin;
my $mailing_count;
my $stop_email;
my $mailing_amount;
# let's take count of the start time
# DEV: The below line is being replaced, since the starting of the entire mailing,
# MAY be different then the starting of this part of the mailing.
# Sneeky, eh?
#
# my $mail_start_time = time;
#
# Here's what we're replacing it with:
#
my $mail_start_time = $status->{first_access};
#
# pretty sure $status is still in affect...
my ($ssec, $smin, $shour, $sday, $smonth, $syear) = (localtime($mail_start_time))[0,1,2,3,4,5];
my $log_mail_start_time = sprintf("Mailing Started: %02d/%02d/%02d %02d:%02d:%02d", $smonth+1, $sday, $syear+1900, $shour, $smin, $ssec);
# $log_mail_start_time isn't used until about 200 lines. Perchance we should move this?!
# ok, now lets open that list up
#warn ' $mailout->subscriber_list ' . $mailout->subscriber_list;
my $somethings_wrong = 0;
sysopen(MAILLIST, $mailout->subscriber_list, O_RDONLY|O_CREAT, $DADA::Config::FILE_CHMOD ) or
croak "$DADA::Config::PROGRAM_NAME $DADA::Config::VER Error: can't open mailing list to send a Mailing List Message: $!";
flock(MAILLIST, LOCK_EX) or $somethings_wrong = 1;
if($somethings_wrong == 1){
carp "temporary sending file is locked - another process sending the message?! exiting sending process...";
exit(0);
}
my $check_restart_state = 0;
# only check the state IF we need to, otherwise, skip the check and save some cycles.
if($self->restart_with){
$check_restart_state = 1;
}
#warn "locking batch...";
$mailout->batch_lock;
# while we have people on the list..
while(defined($mail_info = <MAILLIST>)){
chomp($mail_info);
# get the email, and its pin...
my @ml_info = split('::', $mail_info);
my $mailing = $ml_info[0];
# keep count of how many people we have
$mailing_count++;
# $mailing_count is used exactly one place. WTF?
# only start sending at a point where we're supposed to...
# so wait - mailing count starts at 1?
if($check_restart_state == 1){
if($self->restart_with){
if($mailout->counter_at > ($mailing_count - 1)){
# warn "skipping $mailing_count...";
next;
} else {
$check_restart_state = 0;
}
}
}
# This is new - see the note in the 2nd if statement below.
$stop_email = $mailing;
my $mailing_body = $send_body;
# find the email, pin
$mailing_body = $self->_merge_fields(-body => $mailing_body,
-merge_fields => \@ml_info,
-mail_fields => \%fields,
);
$fields{Body} = $mailing_body ;
$fields{To} = $mailing;
# Debug Information, Always nice
$fields{Debug} = {
-Messages_Sent => $n_people,
-Last_Email => $mailing,
-Message_Subject => $fields{Subject},
-List_File => $path_to_list,
-List_File_Size => -s"$path_to_list"
};
$self->send(%fields, from_bulk_send => 1); # The from_bulk_mail is a hack.
$mailout->countsubscriber;
$n_people++;
if($self->{list_info}->{enable_bulk_batching} == 1){
if($n_people == $n_letters){
my $batch_status = $mailout->status;
if($DADA::Config::LOG{mass_mailings}){
my $batch_log_message = "Subject:$fields{Subject}, Start Time: $log_mail_start_time";
foreach(keys %$batch_status){
next if $_ eq 'email_fields';
$batch_log_message .= ' ' . $_ . ': ' . $batch_status->{$_};
}
$self->{mj_log}->mj_log(
$self->{list_info}->{list},
'Batch Successfully Completed', $batch_log_message
);
$self->{mj_log}->close_log
}
if($self->{list_info}->{restart_mailings_after_each_batch} != 1) {
if(! $self->{list_info}->{bulk_sleep_amount}){
$self->{list_info}->{bulk_sleep_amount} = 1;
}
sleep $self->{list_info}->{bulk_sleep_amount};
} else {
#warn "closing mail list, unlocking batching lock, exiting...";
close(MAILLIST)
or carp "Problems closing the temporary sending file (" . $mailout->subscriber_list ."), Reason: $!";
$mailout->unlock_batch_lock;
# We only want to, exit(0) if we have more mailings to go.
# If we don't have any more to do, we have to do all the
# cleanup, so let's not go quite yet.
if($batch_status->{total_sent_out} < $batch_status->{total_sending_out_num}){ # We have more mailings to do.
exit(0);
}
}
# DEV NOTE: All these variables don't make any sense to me.
# It's severily complicated and I'm certain I haven't a clue what's going on.
# Honestly.
#
# keep a count on how many batches we had.
# $batch_num++;
# and figure out where we are in this batch.
$n_letters+=$letters;
#$sleep_num++;
}
}
} # while(defined($mail_info = <MAILLIST>)){
#warn "I'm still here!";
my $ending_status = $mailout->status; # most likely safe to called status() as much as I'd like...
# Old, crufty, complicated stuff...
$mailing_amount = $mailing_count;
my $mail_end_time = time;
my ($dsec, $dmin, $dhour, $dday, $dmonth, $dyear) = (localtime($mail_end_time))[0,1,2,3,4,5];
# These sorts of lines need their own subroutine...
my $log_mail_end_time = sprintf("Mailing Completed: %02d/%02d/%02d %02d:%02d:%02d", $dmonth+1, $dday, $dyear+1900, $dhour, $dmin, $dsec);
if( $self->{list_info}->{get_finished_notification} == 1){
$self->_email_batched_finished_notification(
-fields => \%fields,
-start_time => $mail_start_time,
-end_time => $mail_end_time,
-emails_sent => $ending_status->{total_sent_out},
-last_email => $stop_email,
);
}
# End Old, Complicated, Crufty Stuff....
$self->{mj_log}->mj_log(
$self->{list_info}->{list},
'List Mailing Completed',
"subject:$fields{Subject}, $log_mail_start_time, $log_mail_end_time, Mailing Amount:$mailing_amount"
) if $DADA::Config::LOG{mass_mailings};
$self->{mj_log}->close_log
if $DADA::Config::LOG{mass_mailings};
#warn "closing mailist.";
close(MAILLIST)
or carp "Problems closing the temporary sending file (" . $mailout->subscriber_list ."), Reason: $!";
#warn "unlocking batch..";
$mailout->unlock_batch_lock;
#warn "Cleaning up my mess...";
$mailout->clean_up;
#warn "exiting...";
exit(0);
} elsif ($! =~ /No more process/) {
# EAGAIN, supposedly recoverable fork error
sleep 5;
redo FORK;
} else {
# weird fork error
croak "$DADA::Config::PROGRAM_NAME $DADA::Config::VER Error in Mail.pm, Unable to Fork new process to mass e-mail list message: $!\n";
}
}
}
sub _domain_for_smtp {
my $self = shift;
my ($user, $domain) = split('@', $self->{list_info}->{list_owner_email});
return $domain;
}
sub _strip_fields {
my $self = shift;
my %fields = @_;
require Mail::Address;
if(my $to_temp = (Mail::Address->parse($fields{To}))[0]){
$fields{To} = $to_temp->address();
}
if(my $from_temp = (Mail::Address->parse($fields{From}))[0]){
$fields{From} = $from_temp->address();
}
return %fields;
}
=pod
=head2 _make_general_headers
(private)
return a hash containing:
=over
=item * From
Currently makes From: with only the list owner's address - should be changed in the future
=item * Reply-To
Set to whatever From: is set to
=item * Errors-To
Off, by default, gets set to the admin_email if print_errors_to_header is set to '1'
=item * Message-ID
This requires Net::Domain (included with the distro - I hope this doesn't break things...)
Format:
# time + random number + sender, woot!
'time' is whatever format is created by DADA::App::Guts::message_id() This is
done for backwards compatibility sake. Example:
Message-ID: <20031227013306.20240243.user@domain.com>
It's easily seen that this was sent at 12/27/2003
=back
=cut
sub _make_general_headers {
my $self = shift;
my %gh;
if($self->{list_info}->{list}){
# PHRASE, ADDRESS, [ COMMENT ]
require Mail::Address;
#hack
#Mail::Address should.. *Address* (pun) this, but it doesn't... why? why? why?
# Why, it's a bug in Mail::Address, and it's not getting fixed... grr!
my $ln = $self->{list_info}->{list_name};
$ln = DADA::App::Guts::escape_for_sending($ln);
#/hack
# NOTE: There is a module called, Email::Address that is supposed
# to solve the problems of Mail::Address, althouigh more testing
# has to be done.
my $From_obj = Mail::Address->new($ln , $self->{list_info}->{list_owner_email});
$gh{From} = $From_obj->format;
$gh{'Reply-To'} = $From_obj->format;
# Deprecated.
if($self->{list_info}->{print_errors_to_header} == 1){
my $Errors_To_obj = Mail::Address->new(undef, $self->{list_info}->{admin_email});
$gh{'Errors-To'} = $Errors_To_obj->format;
}
# time + random number + sender, woot!
require DADA::Security::Password;
my $ran_number = DADA::Security::Password::generate_rand_string('1234567890');
$gh{'Message-ID'} = '<' . DADA::App::Guts::message_id() . '.'. $ran_number . '@' . $From_obj->host . '>';
if($self->{list_info}->{use_habeas_headers} == 1){
require DADA::Security::Password;
$gh{'X-Habeas-SWE-1'} = DADA::Security::Password::rot13('jvagre vagb fcevat');
$gh{'X-Habeas-SWE-2'} = DADA::Security::Password::rot13('oevtugyl nagvpvcngrq');
$gh{'X-Habeas-SWE-3'} = DADA::Security::Password::rot13('yvxr Unornf FJR (gz)');
$gh{'X-Habeas-SWE-4'} = DADA::Security::Password::rot13('Pbclevtug 2002 Unornf (gz)');
$gh{'X-Habeas-SWE-5'} = DADA::Security::Password::rot13('Fraqre Jneenagrq Rznvy (FJR) (gz). Gur fraqre bs guvf');
$gh{'X-Habeas-SWE-6'} = DADA::Security::Password::rot13('rznvy va rkpunatr sbe n yvprafr sbe guvf Unornf');
$gh{'X-Habeas-SWE-7'} = DADA::Security::Password::rot13('jneenag znex jneenagf gung guvf vf n Unornf Pbzcyvnag');
$gh{'X-Habeas-SWE-8'} = DADA::Security::Password::rot13('Zrffntr (UPZ) naq abg fcnz. Cyrnfr ercbeg hfr bs guvf');
$gh{'X-Habeas-SWE-9'} = DADA::Security::Password::rot13('znex va fcnz gb <uggc://jjj.unornf.pbz/ercbeg/>.');
}
}
return %gh;
}
sub _make_list_headers {
my $self = shift;
my %lh;
if($self->{list_info}->{list}){
if($self->{list_info}->{print_list_headers} != 0){
$lh{List} = $self->{list_info}->{list};
$lh{'List-URL'} = '<' . $DADA::Config::PROGRAM_URL . '/list/'.$self->{list_info}->{list} . '/>';
$lh{'List-Unsubscribe'} = '<' . $DADA::Config::PROGRAM_URL . '/u/' . $self->{list_info}->{list} . '/>';
$lh{'List-Subscribe'} = '<' . $DADA::Config::PROGRAM_URL . '/s/' . $self->{list_info}->{list} . '/>';
$lh{'List-Owner'} = '<' . $self->{list_info}->{list_owner_email}.'>';
if($self->{list_info}->{show_archives} ne "0"){
$lh{'List-Archive'} = '<' . $DADA::Config::PROGRAM_URL.'/archive/'. $self->{list_info}->{list} . '/>';
}
# http://www.faqs.org/rfcs/rfc2369.html
if($self->{list_info}->{group_list} == 1 && $self->{list_info}->{discussion_pop_email}){
$lh{'List-Post'} = '<mailto:' . $self->{list_info}->{discussion_pop_email} . '>';
}
# http://www.faqs.org/rfcs/rfc2111.html
eval "require Net::Domain";
if(!$@){
my $domain = undef;
$domain = Net::Domain::hostfqdn() ||
carp "no domain found for: Net::Domain::hostfqdn()";
$domain ||= 'localhost'; # not sure about this one, I believe if you use localhost, you need a random # as well...
$lh{'List-ID'} = '<' . $self->{list_info}->{list} .'.'. $domain .'>';
}else{
carp "Net::Domain should be installed!";
}
}
}
return %lh;
}
sub _cipher_decrypt {
my $self = shift;
my $str = shift;
require DADA::Security::Password; # why wasn't this here before?!
return DADA::Security::Password::cipher_decrypt($self->{list_info}->{cipher_key}, $str);
}
sub _pop_before_smtp {
my $self = shift;
require DADA::Security::Password;
my %args = (-pop3_server => $self->{list_info}->{pop3_server},
-pop3_username => $self->{list_info}->{pop3_username},
-pop3_password => $self->_cipher_decrypt($self->{list_info}->{pop3_password}),
@_);
if(($self->{list_info}->{use_pop_before_smtp} == 1) &&
($args{-pop3_server}) &&
($args{-pop3_username}) &&
($args{-pop3_password})){
$args{-pop3_server} = make_safer($args{-pop3_server});
$args{-pop3_username} = make_safer($args{-pop3_username});
$args{-pop3_password} = make_safer($args{-pop3_password});
my $messagecount = undef;
my $pop = undef;
return undef if ! $args{-pop3_server};
return undef if ! $args{-pop3_username};
return undef if ! $args{-pop3_password};
eval {require Net::POP3};
if(!$@){
$pop = Net::POP3->new($args{-pop3_server},
(
($DADA::Config::CPAN_DEBUG_SETTINGS{NET_POP3} == 1) ?
(Debug => 1, ) :
()
),
);
if($pop){
eval {require Digest::MD5};
if(!$@){
$messagecount = $pop->apop($args{-pop3_username},$args{-pop3_password});
if(!$messagecount){
$pop = Net::POP3->new($args{-pop3_server},
(
($DADA::Config::CPAN_DEBUG_SETTINGS{NET_POP3} == 1) ?
(Debug => 1, ) :
()
),
);
$messagecount = $pop->login($args{-pop3_username},$args{-pop3_password});
}
}else{
$messagecount = $pop->login($args{-pop3_username},$args{-pop3_password});
}
return $messagecount;
}else{
return undef;
}
}else{
carp("Cannot find Net::POP3, is it installed? - $!");
return undef;
}
}
}
sub _email_batched_finished_notification {
my $self = shift;
my %args = (-fields => {},
-start_time => undef,
-end_time => undef,
-emails_sent => undef,
-last_email => undef,
@_);
my $fields = $args{-fields};
my %done_mailing = $self->_make_general_headers;
$done_mailing{To} = $self->{list_info}->{list_owner_email};
$done_mailing{Subject} = $self->{list_info}->{list_name} . ' Mailing Complete. - ' . $fields->{Subject};
my $formatted_start_time;
my $formatted_end_time;
if($args{-start_time}){
my ($s_sec, $s_min, $s_hour, $s_day, $s_month, $s_year) = (localtime($args{-start_time}))[0,1,2,3,4,5];
$formatted_start_time = sprintf("%02d/%02d/%02d %02d:%02d:%02d", $s_month+1, $s_day, $s_year+1900, $s_hour, $s_min, $s_sec);
}
if($args{-end_time}){
my ($e_sec, $e_min, $e_hour, $e_day, $e_month, $e_year) = (localtime($args{-end_time}))[0,1,2,3,4,5];
$formatted_end_time = sprintf("%02d/%02d/%02d %02d:%02d:%02d", $e_month+1, $e_day, $e_year+1900, $e_hour, $e_min, $e_sec);
}
my $total_time = $self->_formatted_runtime(($args{-end_time} - $args{-start_time}));
my $done_body = "Your List Mailing has been successful!\n";
$done_body .= '_' x 72 . "\n\n";
$done_body .= "Your mailing has reached: $args{-emails_sent} e-mail address(es)\n\n"
if $args{-emails_sent};
$done_body .= 'Mailing Started: ' . $formatted_start_time . "\n"
if $args{-start_time};
$done_body .= 'Mailing Ended: ' . $formatted_end_time . "\n"
if $args{-end_time};
$done_body .= "Total Mailing Time: " . $total_time . "\n"
if defined($total_time) && defined($args{-start_time}) && defined($args{-end_time});
$done_body .= 'Last Email sent to: ' . $args{-last_email} . "\n"
if $args{-last_email};
$done_body .= "\nA copy of your Mailing List Message has been attached.\n"
if $fields->{Body};
$done_body .= "\n-" . $DADA::Config::PROGRAM_NAME . "\n\n";
require MIME::Lite;
my $msg = MIME::Lite->new(Type => 'multipart/mixed',
From => $done_mailing{From},
To => $done_mailing{To}
);
$msg->attach(Type => 'TEXT',
Data => $done_body,
Disposition => 'inline',
);
my $att;
foreach(keys %$fields){
next if $_ eq 'Body';
$att .= $_ . ': ' . $fields->{$_} . "\n"
if defined($fields->{$_}) && $fields->{$_} ne "";
}
$att .= "\n" . $fields->{Body};
$msg->attach(Type => 'message/rfc822',
Disposition => "inline",
Data => $att);
my %new_headers = $self->return_headers($msg->header_as_string);
$done_mailing{Body} = $msg->body_as_string;
$self->send(%new_headers, %done_mailing);
}
sub _send_die {
my $self = shift;
my $debug = shift;
my $report;
if($debug){
$report = "$DADA::Config::PROGRAM_NAME $DADA::Config::VER Mass Mailing Error! INFORMATION: Messages Sent: $debug->{-Messages_Sent}, Mailing Failed At Address: $debug->{-Last_Email}, Message Subject: $debug->{-Message_Subject}, Using List File: $debug->{-List_File}, List File Size: $debug->{-List_File_Size} bytes, Details: $!";
croak($report);
}else{
croak("$DADA::Config::PROGRAM_NAME $DADA::Config::VER Error: can't pipe to mail program using settings: '$DADA::Config::MAIL_SETTINGS': $!\n");
}
}
sub _merge_fields_string {
my $self = shift;
my @merge_fields = split(',', $self->{list_info}->{merge_fields});
my $merge_fields;
foreach(@merge_fields){
$merge_fields .= '::' . '\['.$_.'\]';
}
return $merge_fields;
}
sub _merge_fields_array_ref {
my $self = shift;
my @merge_fields = split(',', $self->{list_info}->{merge_fields});
my $merge_fields = [];
foreach(@merge_fields){
push(@$merge_fields, '['.$_.']');
}
return $merge_fields;
}
sub _verp {
my $self = shift;
my $to = shift;
croak "no email passed!"
if ! $to;
require Mail::Address;
require Mail::Verp;
if(my $to_temp = (Mail::Address->parse($to))[0]){
$to = $to_temp->address();
}
my $mv = Mail::Verp->new;
$mv->separator($DADA::Config::MAIL_VERP_SEPARATOR );
if($self->{list_info}->{set_smtp_sender} == 1){
return $mv->encode( $self->{list_info}->{admin_email}, $to );
}else{
return $mv->encode( $self->{list_info}->{list_owner_email}, $to );
}
}
sub _merge_fields {
my $self = shift;
my %args = (-body => undef,
-merge_fields => [],
-mail_fields => {},
@_);
$args{-body} =~ s/\[email\]/$args{-merge_fields}->[0]/g;
$args{-body} =~ s/\[email_name\]/$args{-merge_fields}->[1]/g;
$args{-body} =~ s/\[email_domain\]/$args{-merge_fields}->[2]/g;
$args{-body} =~ s/\[pin\]/$args{-merge_fields}->[3]/g;
$args{-body} =~ s/\[list\]/$args{-merge_fields}->[4]/g; # the list short name.
$args{-body} =~ s/\[list_name\]/$args{-merge_fields}->[5]/g; # the list name.
my @merge_fields = split(',', $self->{list_info}->{merge_fields});
my $i;
my $message_id = $args{-mail_fields}->{'Message-ID'};
$message_id =~ s/\<|\>//g;
$message_id =~ s/\.(.*)//; #greedy
$args{-body} =~ s/\[message_id\]/$message_id/g;
# or,
#$args{-body} =~ s/\[message_id\]/$args{-merge_fields}->[6]/g; # the list name.
# I guess...
$args{-body} = $self->redirect_tags(-string => $args{-body}, -mid => $message_id) if $self->{list_info}->{clickthrough_tracking} == 1;
for($i=0;$i<=$#merge_fields;$i++){
$args{-body} =~ s/\[$merge_fields[$i]\]/$args{-merge_fields}->[$i+7]/g;
}
return $args{-body};
}
sub redirect_tags {
my $self = shift;
my %args = (-string => undef,
-mid => undef,
@_);
my $s = $args{-string};
my $mid = $args{-mid};
$mid =~ s/\<|\>//g;
$mid =~ s/\.(.*)//; #greedy
$s =~ s/\[redirect\=(.*?)\]/&DADA::Mail::Send::redirect_encode($self, $1, $mid)/eg;
return $s;
}
sub redirect_encode {
my ($self, $url, $mid) = @_;
$mid =~ s/\<|\>//g;
$mid =~ s/\.(.*)//; #greedy
my $k = '';
if($url =~ m/^http:\/\//){
$url =~ s/^http:\/\///;
$k = 'h';
}elsif($url =~ m/^https:\/\//){
$url =~ s/^https:\/\///;
$k = 's';
}
my $e_url;
eval {require URI::Escape};
if(!$@){
$e_url = URI::Escape::uri_escape($url, "\200-\377");
}else{
$e_url = DADA::App::Guts::uriescape($url);
}
$e_url =~ s/\?/%3F/g;
return $DADA::Config::PROGRAM_URL . '/r/' . $self->{list_info}->{list} . '/' . $k . '/' . $mid . '/' . $e_url . '/';
}
sub _formatted_runtime {
my $self = shift;
my $d = shift;
my @int = (
[ 'second', 1 ],
[ 'minute', 60 ],
[ 'hour', 60*60 ],
[ 'day', 60*60*24 ],
[ 'week', 60*60*24*7 ],
[ 'month', 60*60*24*30.5 ],
[ 'year', 60*60*24*30.5*12 ]
);
my $i = $#int;
my @r;
while ( ($i>=0) && ($d) )
{
if ($d / $int[$i] -> [1] >= 1)
{
push @r, sprintf "%d %s%s",
$d / $int[$i] -> [1],
$int[$i]->[0],
( sprintf "%d", $d / $int[$i] -> [1] ) > 1
? 's'
: '';
}
$d %= $int[$i] -> [1];
$i--;
}
my $runtime = join ", ", @r if @r;
return $runtime;
}
sub _massaged_for_archive {
my $self = shift;
my $fields = shift;
my $msg;
foreach(@DADA::Config::EMAIL_HEADERS_ORDER){
next if $_ eq 'Body';
next if $_ eq 'Message'; # Do I need this?!
$msg .= $_ . ': ' . $fields->{$_} . "\n"
if((defined $fields->{$_}) && ($fields->{$_} ne ""));
}
$msg .= "\n" . $fields->{Body};
return $msg;
}
sub _log_sub_count {
my $self = shift;
my %args = (-msg_id => undef,
-num_subscribers => undef,
@_
);
return
if $self->bulk_test;
return
if $self->{list_info}->{enable_subscriber_count_logging} != 1;
my $msg_id = $args{-msg_id};
$msg_id =~ s/\<|\>//g;
$msg_id =~ s/\.(.*)//;
my $num_subscribers = $args{-num_subscribers};
require DADA::Logging::Clickthrough;
my $r = DADA::Logging::Clickthrough->new($self->{list_info}->{list});
$r->sc_log($msg_id, $num_subscribers);
}
sub bulk_test_recipient {
my $self = shift;
my $test_recipient = shift;
if(! $test_recipient){
if(! $self->{test_recipient}){
return $self->{list_info}->{list_owner_email};
# warn "sending over the list owner as the test recipient..";
}else{
#warn "sending over " . $self->{test_recipient};
return $self->{test_recipient};
}
}else{
if(DADA::App::Guts::check_for_valid_email($test_recipient) == 0){
$self->{test_recipient} = $test_recipient;
}else{
# warn "Test Recipient, '$test_recipient' is not a valid email address!";
}
}
}
sub DESTROY {
# DESTROY ALL ASTROMEN!
my $self = shift;
}
1;
=pod
=head1 COPYRIGHT
Copyright (c) 1999 - 2006 Justin Simoni
me - justinsimoni.com
http://justinsimoni.com
All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
=cut