1276 lines
38 KiB
Perl
1276 lines
38 KiB
Perl
# ==================================================================
|
|
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
|
#
|
|
# GT::Mail::BulkMail
|
|
# Author: Jason Rhinelander
|
|
# CVS Info : 087,071,086,086,085
|
|
# $Id: BulkMail.pm,v 1.51 2008/01/23 07:27:00 brewt Exp $
|
|
#
|
|
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
# ==================================================================
|
|
#
|
|
# Description: A simple bulk e-mail module to interface with either
|
|
# sendmail or SMTP.
|
|
#
|
|
# ==================================================================
|
|
|
|
package GT::Mail::BulkMail;
|
|
|
|
use Exporter;
|
|
use GT::Base;
|
|
use GT::Socket::Client;
|
|
use GT::Mail::Encoder;
|
|
use constants CRLF => "\015\012", CR => "\015", LF => "\012";
|
|
use strict;
|
|
use GT::AutoLoader;
|
|
use vars qw(@ISA $VERSION $AUTOLOAD @EXPORT_OK %EXPORT_TAGS $VALID_HOST $CRLF $CR $LF $noIPCOpen2);
|
|
|
|
eval "use IPC::Open2";
|
|
$noIPCOpen2++ if $@;
|
|
|
|
@ISA = qw(Exporter);
|
|
|
|
@EXPORT_OK = qw(RFC822_date quoted_printable quote_name unquote_name
|
|
$VALID_HOST CR LF CRLF $CR $LF $CRLF);
|
|
|
|
%EXPORT_TAGS = (
|
|
quoting => [ qw/quoted_printable quote_name unquote_name/ ],
|
|
crlf => [ qw/CR LF CRLF $CR $LF $CRLF/ ],
|
|
);
|
|
|
|
$VERSION = sprintf "%d.%03d", q$Revision: 1.51 $ =~ /(\d+)\.(\d+)/;
|
|
|
|
$VALID_HOST = '(?:[a-zA-Z0-9][a-zA-Z0-9-]*(?:\.[a-zA-Z0-9][a-zA-Z0-9-]*)*)';
|
|
|
|
$CR = CR;
|
|
$LF = LF;
|
|
$CRLF = CRLF;
|
|
|
|
sub DESTROY {
|
|
my $self = shift;
|
|
$self->_smtp_disconnect();# if $self->{smtp_connected};
|
|
$self->_sendmail_disconnect();# if $self->{sendmail_connected};
|
|
}
|
|
|
|
sub new {
|
|
my $this = shift;
|
|
my $class = ref($this) || $this;
|
|
my $self = { };
|
|
bless $self, $class;
|
|
$self->_init(@_);
|
|
return $self;
|
|
}
|
|
|
|
# Parses all passed options to new, such as -from, -name, -smtp, etc.
|
|
sub _init {
|
|
my $self = shift;
|
|
my %options = @_;
|
|
# These two should be first so that errors can be handled that the others might cause
|
|
$self->show_errors(delete $options{-show_errors}) if exists $options{-show_errors};
|
|
$self->error_code(delete $options{-error_code}) if exists $options{-error_code};
|
|
$self->from(delete $options{-from}) if exists $options{-from};
|
|
$self->name(delete $options{-name}) if exists $options{-name};
|
|
$self->subject(delete $options{-subject}) if exists $options{-subject};
|
|
$self->message(delete $options{-message}) if exists $options{-message};
|
|
$self->success(delete $options{-success}) if exists $options{-success};
|
|
$self->failure(delete $options{-failure}) if exists $options{-failure};
|
|
$self->messagepresend(delete $options{-messagepresend}) if exists $options{-messagepresend};
|
|
$self->subjectpresend(delete $options{-subjectpresend}) if exists $options{-subjectpresend};
|
|
$self->frompresend(delete $options{-frompresend}) if exists $options{-frompresend};
|
|
$self->namepresend(delete $options{-namepresend}) if exists $options{-namepresend};
|
|
$self->smtp_retries(0);
|
|
$self->smtp_retries(delete $options{-smtp_retries}) if exists $options{-smtp_retries};
|
|
$self->smtp_wait(2.5);
|
|
$self->smtp_wait(delete $options{-smtp_wait}) if exists $options{-smtp_wait};
|
|
$self->_method(\%options); # Figures out (sendmail or smtp) and (text or html)
|
|
if (keys %options) {
|
|
my $forgot_dash = 0;
|
|
for (keys %options) {
|
|
$self->_cause_error("Unknown parameter `$_'");
|
|
$forgot_dash++ if substr($_, 0, 1) ne '-';
|
|
}
|
|
die "Invalid parameters (" . join(", ", keys %options) . ") to new()" . ($forgot_dash ? " - perhaps you forgot the -dash?" : "");
|
|
}
|
|
}
|
|
|
|
# Tries to figure out whether to use sendmail, or SMTP to send the message by
|
|
# looking for the -smtp or -sendmail options.
|
|
# Also looks for -text or -html options
|
|
sub _method {
|
|
my ($self,$options) = splice @_,0,2;
|
|
|
|
if ($options->{-sendmail} and $options->{-smtp}) {
|
|
$self->_cause_error("Invalid method: Two mailing methods provided. Choose only smtp or sendmail");
|
|
delete $options->{-sendmail};
|
|
delete $options->{-smtp};
|
|
}
|
|
elsif ($options->{-sendmail}) {
|
|
$self->sendmail(delete $options->{-sendmail});
|
|
delete $options->{-smtp};
|
|
}
|
|
elsif ($options->{-smtp}) {
|
|
$self->smtp(delete $options->{-smtp});
|
|
delete $options->{-sendmail};
|
|
}
|
|
my $t = $options->{-text};
|
|
my $h = $options->{-html};
|
|
my $r = $options->{-raw};
|
|
|
|
if (($h and $r) or ($t and $r) or ($t and $h)) {
|
|
$self->_cause_error("Invalid mail format: Choose only one format to use.");
|
|
delete $options->{-text};
|
|
delete $options->{-html};
|
|
delete $options->{-raw};
|
|
}
|
|
elsif ($options->{-text}) {
|
|
$self->text(1);
|
|
delete $options->{-text};
|
|
delete $options->{-html};
|
|
delete $options->{-raw};
|
|
}
|
|
elsif ($options->{-html}) {
|
|
$self->html(1);
|
|
delete $options->{-html};
|
|
delete $options->{-text};
|
|
delete $options->{-raw};
|
|
}
|
|
elsif ($options->{-raw}) {
|
|
$self->raw(1);
|
|
delete $options->{-html};
|
|
delete $options->{-text};
|
|
delete $options->{-raw};
|
|
}
|
|
}
|
|
|
|
|
|
# This subroutine handles the creation of errors and prints them (if
|
|
# show_errors is set), and/or passes them to error_code (if set).
|
|
$COMPILE{_cause_error} = __LINE__ . <<'END_OF_SUB';
|
|
sub _cause_error {
|
|
my $self = shift;
|
|
my $error = shift;
|
|
warn ref($self)." Error: $error" if $self->{show_errors};
|
|
$self->{error_code}->($error) if ref $self->{error_code} eq 'CODE';
|
|
}
|
|
END_OF_SUB
|
|
|
|
# All of the following methods (down to _check_params) will return the current
|
|
# value of that parameter if called without arguments.
|
|
|
|
# Sets a code ref which will be called with an error message each time an
|
|
# error occurs.
|
|
$COMPILE{error_code} = __LINE__ . <<'END_OF_SUB';
|
|
sub error_code {
|
|
my $self = shift;
|
|
if (@_) {
|
|
if (ref $_[0] eq 'CODE') {
|
|
$self->{error_code} = shift;
|
|
}
|
|
else {
|
|
$self->_cause_error("Not a code reference passed to error_code");
|
|
}
|
|
}
|
|
else {
|
|
return $self->{error_code};
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
|
|
# Sets whether or not to print errors whenever an error occurs.
|
|
$COMPILE{show_errors} = __LINE__ . <<'END_OF_SUB';
|
|
sub show_errors {
|
|
my $self = shift;
|
|
if (@_) {
|
|
$self->{show_errors} = shift;
|
|
return;
|
|
}
|
|
return $self->{show_errors};
|
|
}
|
|
END_OF_SUB
|
|
|
|
# Sets the e-mail address of the sender. Takes one arg: The e-mail address of
|
|
# the sender.
|
|
sub from ($;$) {
|
|
my $self = shift;
|
|
if (@_) {
|
|
if (_is_valid_email($_[0])) {
|
|
$self->{from} = shift;
|
|
return 1;
|
|
}
|
|
else {
|
|
$self->_cause_error("Invalid e-mail address: `$_[0]'");
|
|
return;
|
|
}
|
|
}
|
|
else {
|
|
return $self->{from};
|
|
}
|
|
}
|
|
|
|
# Sets the presend code ref for the from field.
|
|
# Takes one argument: a code ref
|
|
$COMPILE{frompresend} = __LINE__ . <<'END_OF_SUB';
|
|
sub frompresend {
|
|
my $self = shift;
|
|
if (@_) {
|
|
$self->{frompresend} = shift if ref $_[0] eq 'CODE';
|
|
return;
|
|
}
|
|
else {
|
|
return $self->{frompresend};
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
# Sets the body of the message.
|
|
# Takes one argument: a string.
|
|
sub message ($;$) {
|
|
my $self = shift;
|
|
if (@_) {
|
|
$self->{message} = shift;
|
|
return;
|
|
}
|
|
return $self->{message};
|
|
}
|
|
|
|
# Sets a presend code ref for the body of the message.
|
|
# Takes a code ref as argument
|
|
$COMPILE{messagepresend} = __LINE__ . <<'END_OF_SUB';
|
|
sub messagepresend {
|
|
my $self = shift;
|
|
if (@_) {
|
|
$self->{messagepresend} = shift if ref $_[0] eq 'CODE';
|
|
return;
|
|
}
|
|
else {
|
|
return $self->{messagepresend};
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
# Sets the display name of the sender. Will be escaped and quoted.
|
|
# Without args, returns the name (not quoted, of course).
|
|
sub name ($;$) {
|
|
my $self = shift;
|
|
if (@_) {
|
|
if (_is_valid_name($_[0])) {
|
|
$self->{name} = quote_name(shift);
|
|
return 1;
|
|
}
|
|
else {
|
|
$self->_cause_error("Invalid name");
|
|
return;
|
|
}
|
|
}
|
|
else {
|
|
return unquote_name($self->{name});
|
|
}
|
|
}
|
|
|
|
# name presend - takes a code ref
|
|
$COMPILE{namepresend} = __LINE__ . <<'END_OF_SUB';
|
|
sub namepresend {
|
|
my $self = shift;
|
|
if (@_) {
|
|
$self->{namepresend} = shift if ref $_[0] eq 'CODE';
|
|
return;
|
|
}
|
|
else {
|
|
return $self->{namepresend};
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
# Sets the subject of the message
|
|
sub subject ($;$) {
|
|
my $self = shift;
|
|
if (@_) {
|
|
$self->{subject} = shift;
|
|
return;
|
|
}
|
|
else {
|
|
return $self->{subject};
|
|
}
|
|
}
|
|
|
|
# Sets the subject presend for the e-mail
|
|
$COMPILE{subjectpresend} = __LINE__ . <<'END_OF_SUB';
|
|
sub subjectpresend {
|
|
my $self = shift;
|
|
if (@_) {
|
|
$self->{subjectpresend} = shift if ref $_[0] eq 'CODE';
|
|
return;
|
|
}
|
|
else {
|
|
return ref $self->{success} eq 'CODE'
|
|
? $self->{success}
|
|
:($self->{success} = undef);
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
# Sets the number of times to attempt connection to the SMTP server before
|
|
# giving up.
|
|
sub smtp_retries ($;$) {
|
|
my $self = shift;
|
|
if (@_) {
|
|
my $retries = shift;
|
|
if (!$retries or $retries =~ /\D/) {
|
|
$self->{smtp_retries} = 0;
|
|
}
|
|
else {
|
|
$self->{smtp_retries} = $retries;
|
|
}
|
|
return;
|
|
}
|
|
return $self->{smtp_retries};
|
|
}
|
|
|
|
# Sets the wait time between SMTP connection reattempts.
|
|
sub smtp_wait ($;$) {
|
|
my $self = shift;
|
|
if (@_) {
|
|
my $wait = shift;
|
|
unless ($wait and $wait =~ /^\d+(?:\.\d+)?$/) {
|
|
$self->{smtp_wait} = 0;
|
|
}
|
|
else {
|
|
$self->{smtp_wait} = $wait;
|
|
}
|
|
return;
|
|
}
|
|
return $self->{smtp_wait};
|
|
}
|
|
|
|
# Sets that the format of the message should be plain text.
|
|
# Note that this does NOT set the text of the message!
|
|
$COMPILE{text} = __LINE__ . <<'END_OF_SUB';
|
|
sub text {
|
|
my $self = shift;
|
|
if (@_) {
|
|
$self->{format} = "text/plain" if $_[0];
|
|
return;
|
|
}
|
|
$self->{format} eq "text/plain";
|
|
}
|
|
END_OF_SUB
|
|
|
|
# Sets that the format of the message should be HTML
|
|
$COMPILE{html} = __LINE__ . <<'END_OF_SUB';
|
|
sub html {
|
|
my $self = shift;
|
|
if (@_) {
|
|
if ($_[0]) {
|
|
$self->{format} = "text/html";
|
|
}
|
|
else {
|
|
$self->{format} = "text/plain";
|
|
}
|
|
return;
|
|
}
|
|
$self->{format} eq "text/html";
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{raw} = __LINE__ . <<'END_OF_SUB';
|
|
sub raw {
|
|
my $self = shift;
|
|
if (@_) {
|
|
$self->{raw} = shift;
|
|
return;
|
|
}
|
|
$self->{raw};
|
|
}
|
|
END_OF_SUB
|
|
|
|
# Sets a code reference to be called when a message has (as far as the mailer
|
|
# can tell) been sent successfully.
|
|
$COMPILE{success} = __LINE__ . <<'END_OF_SUB';
|
|
sub success {
|
|
my $self = shift;
|
|
if (@_) {
|
|
$self->{success} = shift if ref $_[0] eq 'CODE';
|
|
return;
|
|
}
|
|
else {
|
|
return ref $self->{success} eq 'CODE'
|
|
? $self->{success}
|
|
:($self->{success} = undef);
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
# Sets a code reference to call when sending a message as failed.
|
|
$COMPILE{failure} = __LINE__ . <<'END_OF_SUB';
|
|
sub failure {
|
|
my $self = shift;
|
|
if (@_) {
|
|
$self->{failure} = shift if ref $_[0] eq 'CODE';
|
|
return;
|
|
}
|
|
else {
|
|
return ref $self->{failure} eq 'CODE'
|
|
? $self->{failure}
|
|
: ($self->{failure} = undef);
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
# Returns a list of custom headers that have been set
|
|
$COMPILE{headers} = __LINE__ . <<'END_OF_SUB';
|
|
sub headers {
|
|
my $self = shift;
|
|
wantarray ? %{$self->{header}} : $self->{header};
|
|
}
|
|
END_OF_SUB
|
|
|
|
# Adds a single custom header. The header must start with X-
|
|
$COMPILE{add_header} = __LINE__ . <<'END_OF_SUB';
|
|
sub add_header {
|
|
my $self = shift;
|
|
$self->_cause_error("Wrong number of arguments to add_header()") and return unless @_ == 2;
|
|
my ($k,$v) = splice @_,0,2;
|
|
$k =~ y/\x00-\x1f://d;
|
|
$v =~ s/\r?\n/$CRLF/g;
|
|
$v =~ s/(?:$CRLF){2,}/$CRLF/g;
|
|
$v =~ s/$CRLF$//;
|
|
if (($self->raw) || (substr($k,0,2) eq 'X-')) {
|
|
$self->{header}{$k} = $v;
|
|
}
|
|
else {
|
|
$self->_cause_error("Only X-* headers can be added");
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
# Adds multiple headers. This makes calls to add_header()
|
|
$COMPILE{add_headers} = __LINE__ . <<'END_OF_SUB';
|
|
sub add_headers {
|
|
my $self = shift;
|
|
$self->_cause_error("Wrong number of arguments to add_headers()") and return if @_ % 2;
|
|
while (@_) {
|
|
$self->add_header(splice @_,0,2);
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
# Deletes (and returns the value of) the header given.
|
|
$COMPILE{delete_header} = __LINE__ . <<'END_OF_SUB';
|
|
sub delete_header {
|
|
my $self = shift;
|
|
my $key = shift;
|
|
delete $self->{header}{$key};
|
|
}
|
|
END_OF_SUB
|
|
|
|
# Deletes (and returns the values of) the headers given.
|
|
$COMPILE{delete_headers} = __LINE__ . <<'END_OF_SUB';
|
|
sub delete_headers {
|
|
my $self = shift;
|
|
delete @{$self->{header}}{@_};
|
|
}
|
|
END_OF_SUB
|
|
|
|
# Sets the sending method to SMTP and sets the smtp server to the argument
|
|
# given.
|
|
$COMPILE{smtp} = __LINE__ . <<'END_OF_SUB';
|
|
sub smtp {
|
|
my $self = shift;
|
|
if (@_) {
|
|
my $smtp = shift;
|
|
chomp $smtp;
|
|
if ($smtp =~ /^$VALID_HOST\Z/) {
|
|
$self->{method} = "smtp";
|
|
delete $self->{sendmail};
|
|
$self->{smtp} = $smtp;
|
|
$self->{smtp_attempts} = 0;
|
|
$self->{smtp_connected} = 0;
|
|
delete $self->{handle_in};
|
|
delete $self->{handle_out};
|
|
delete $self->{smtp_supported};
|
|
return 1;
|
|
}
|
|
else {
|
|
$self->_cause_error("Bad SMTP server name provided ($smtp)");
|
|
return;
|
|
}
|
|
}
|
|
else {
|
|
return $self->{smtp};
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
# Sets the sending method to sendmail and sets the sendmail path to the
|
|
# argument given.
|
|
$COMPILE{sendmail} = __LINE__ . <<'END_OF_SUB';
|
|
sub sendmail {
|
|
my $self = shift;
|
|
if (@_) {
|
|
my $sendmail = shift;
|
|
my ($executable, $tags) = split ' ', $sendmail, 2;
|
|
if (-x $executable) {
|
|
$self->{method} = "sendmail";
|
|
if ($tags) {
|
|
$self->{sendmail_with_tags} = $self->{sendmail} = $sendmail;
|
|
# Using tags assumes that a method equivelant to -t is being used
|
|
$self->{no_sendmail_bs} = 1;
|
|
}
|
|
else {
|
|
$self->{sendmail} = $sendmail;
|
|
delete $self->{no_sendmail_bs};
|
|
}
|
|
return 1;
|
|
}
|
|
else {
|
|
$self->_cause_error("Cannot execute $sendmail");
|
|
return 0;
|
|
}
|
|
}
|
|
else {
|
|
return $self->{sendmail_with_tags} || $self->{sendmail};
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
# checks that there is enough information set to send the e-mail
|
|
sub _check_params {
|
|
my $self = shift;
|
|
my $errors = "";
|
|
unless ($self->{from}) {
|
|
$errors .= "`from' address not set. ";
|
|
}
|
|
elsif (not _is_valid_email($self->{from})) {
|
|
$errors .= "`$self->{from}' is not a valid e-mail address. ";
|
|
}
|
|
if ($self->{name} and not _is_valid_name($self->{name})) {
|
|
$errors .= "`$self->{name}' is not a valid name. ";
|
|
}
|
|
unless ($self->{$self->{method}}) {
|
|
$errors .= "No mail sending method set! ";
|
|
}
|
|
$errors and $self->_cause_error($errors . "Send aborted."), return;
|
|
return 1;
|
|
}
|
|
|
|
# Checks whether or not the provided e-mail address is valid.
|
|
$COMPILE{_is_valid_email} = __LINE__ . <<'END_OF_SUB';
|
|
sub _is_valid_email {
|
|
shift if ref $_[0];
|
|
my $email = shift;
|
|
return $email && $email =~ /^[\x21-\x7e]+\@$VALID_HOST$/;
|
|
}
|
|
END_OF_SUB
|
|
|
|
# Checks that a name is valid.
|
|
$COMPILE{_is_valid_name} = __LINE__ . <<'END_OF_SUB';
|
|
sub _is_valid_name {
|
|
shift if ref $_[0];
|
|
my $name = shift;
|
|
return not $name =~ y/\x20-\x7e//c; # 7-bit only with no control characters
|
|
}
|
|
END_OF_SUB
|
|
|
|
# Sends an e-mail. Takes multiple arguments: Any number of:
|
|
# - array references
|
|
# - code references
|
|
# - hash references
|
|
# - glob references
|
|
# See the perldoc of this file for more info
|
|
sub send {
|
|
my $self = shift;
|
|
unless ($self->_check_params) {
|
|
$self->_cause_error("Not all neccessary parameters provided. No emails sent.");
|
|
return;
|
|
}
|
|
else {
|
|
$self->{date} = RFC822_date(); # Just get it once rather than figuring it out each time.
|
|
if ($self->{method} eq 'smtp') {
|
|
$self->_smtp_connect();
|
|
}
|
|
elsif ($self->{method} eq 'sendmail') {
|
|
$self->_sendmail_connect();
|
|
}
|
|
for (@_) {
|
|
ref eq 'GLOB' and $self->_send_globref($_), next;
|
|
ref eq 'HASH' and $self->_send_hashref($_), next;
|
|
ref eq 'ARRAY' and $self->_send_arrayref($_), next;
|
|
ref eq 'CODE' and $self->_send_coderef($_), next;
|
|
$self->_cause_error("Invalid argument to ".ref($self)."->send()");
|
|
}
|
|
}
|
|
}
|
|
|
|
$COMPILE{_send_arrayref} = __LINE__ . <<'END_OF_SUB';
|
|
sub _send_arrayref {
|
|
my $self = shift;
|
|
my $array = shift;
|
|
for (@$array) {
|
|
$self->_send_one($_);
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_send_coderef} = __LINE__ . <<'END_OF_SUB';
|
|
sub _send_coderef {
|
|
my $self = shift;
|
|
my $code = shift;
|
|
my ($id,$email);
|
|
$id = "temp";
|
|
while ($id) {
|
|
($id, $email) = $code->() or last;
|
|
$self->_send_one($email ? ($id,$email) : $id);
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_send_globref} = __LINE__ . <<'END_OF_SUB';
|
|
sub _send_globref {
|
|
my $self = shift;
|
|
my $file = shift;
|
|
unless (defined fileno $file) {
|
|
$self->_cause_error("Glob reference passed to send is not an opened file");
|
|
return;
|
|
}
|
|
my $addr;
|
|
while ($addr = <$file>) {
|
|
$addr =~ s/\r?\n$//; # Allow for windows line ends on *nix systems
|
|
$self->_send_one($addr);
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_send_hashref} = __LINE__ . <<'END_OF_SUB';
|
|
sub _send_hashref {
|
|
my $self = shift;
|
|
my $hash = shift;
|
|
my ($id,$email);
|
|
$self->_send_one($id,$email) while ($id,$email) = each %$hash;
|
|
}
|
|
END_OF_SUB
|
|
|
|
# Sends a single e-mail message. Should not be called except by one of the 4
|
|
# subroutines above.
|
|
sub _send_one {
|
|
my $self = shift;
|
|
my ($id,$email) = @_ > 1 ? (splice @_,0,2) : ((shift) x 2);
|
|
substr($email,rindex($email,'@')) =~ y/A-Z/a-z/;
|
|
my $success;
|
|
my $from = ref $self->{frompresend} eq 'CODE'
|
|
? ($self->{frompresend}->($id,$self->{from}) || $self->{from})
|
|
: $self->{from};
|
|
$from =~ y/\x21-\x7e//cd;
|
|
my $name = ref $self->{namepresend} eq 'CODE'
|
|
? quote_name($self->{namepresend}->($id,unquote_name($self->{name}))) || $self->{name}
|
|
: $self->{name};
|
|
$name =~ y/\x20-\x7e//cd;
|
|
my $subject;
|
|
$subject = ref $self->{subjectpresend} eq 'CODE'
|
|
? ($self->{subjectpresend}->($id,$self->{subject}) || $self->{subject})
|
|
: $self->{subject};
|
|
$subject =~ y/\x20-\x7e//cd;
|
|
my $message = ref $self->{messagepresend} eq 'CODE'
|
|
? ($self->{messagepresend}->($id,$self->{message}) || $self->{message})
|
|
: $self->{message};
|
|
if ($self->{method}) {
|
|
if ($noIPCOpen2 || $self->{no_sendmail_bs} and $self->{method} eq 'sendmail') {
|
|
$success = $self->_sendmail_t_send($email,$from,$name,$subject,$message);
|
|
}
|
|
else {
|
|
$success = $self->_smtp_send($email,$from,$name,$subject,$message);
|
|
}
|
|
}
|
|
else {
|
|
$self->_cause_error("No mail sending method set!");
|
|
return;
|
|
}
|
|
if ($success and ref $self->{success} eq 'CODE') {
|
|
$self->{success}->($id);
|
|
}
|
|
elsif (!$success and ref $self->{failure} eq 'CODE') {
|
|
$self->{failure}->($id);
|
|
}
|
|
}
|
|
|
|
# Creates a connection to the STMP server
|
|
$COMPILE{_smtp_connect} = __LINE__ . <<'END_OF_SUB';
|
|
sub _smtp_connect {
|
|
my $self = shift;
|
|
$self->_smtp_disconnect if $self->{smtp_connected};
|
|
$self->{method} eq 'sendmail' and return $self->_sendmail_connect;
|
|
local $/ = CRLF;
|
|
local $\ = CRLF;
|
|
|
|
my $s;
|
|
$self->{smtp_connected} = 0;
|
|
|
|
while (not $self->{smtp_connected} and $self->{smtp_attempts}++ <= $self->{smtp_retries}) {
|
|
select(undef,undef,undef,$self->{smtp_wait}) if $self->{smtp_attempts} > 1
|
|
and $self->{smtp_wait} and $self->{smtp_wait} > 0;
|
|
|
|
$s = GT::Socket::Client->open(
|
|
host => $self->{smtp},
|
|
port => 25,
|
|
timeout => 10
|
|
) or $self->_cause_error("$self->{smtp}: Unable to connect: " . GT::Socket::Client->error);
|
|
|
|
$self->{handle_out} = $self->{handle_in} = $s;
|
|
$_ = <$s>;
|
|
unless (/^220/) {
|
|
$self->_cause_error("$self->{smtp}: Server not available: $_");
|
|
close $s;
|
|
next;
|
|
}
|
|
while (/^220-/) {
|
|
$_ = <$s>;
|
|
}
|
|
if (my $error = $self->_smtp_say_hi) {
|
|
$self->_cause_error("$self->{smtp}: $error");
|
|
close $s;
|
|
next;
|
|
}
|
|
$self->{smtp_connected} = 1;
|
|
}
|
|
return $self->{smtp_connected};
|
|
}
|
|
END_OF_SUB
|
|
|
|
# Disconnects from the SMTP server
|
|
sub _smtp_disconnect {
|
|
my $self = shift;
|
|
return $self->_sendmail_disconnect if $self->{method} eq 'sendmail';
|
|
local $/ = CRLF;
|
|
local $\ = CRLF;
|
|
my $in = $self->{handle_in};
|
|
my $out = $self->{handle_out};
|
|
if (defined $out) {
|
|
print $out "QUIT";
|
|
}
|
|
close $out;
|
|
close $in;
|
|
delete $self->{handle_out};
|
|
delete $self->{handle_in};
|
|
1;
|
|
}
|
|
|
|
# Does all the initialization required before sending a message
|
|
$COMPILE{_smtp_say_hi} = __LINE__ . <<'END_OF_SUB';
|
|
sub _smtp_say_hi {
|
|
my $self = shift;
|
|
my $in = $self->{handle_in};
|
|
my $out = $self->{handle_out};
|
|
local $/ = CRLF;
|
|
local $\ = CRLF;
|
|
print $out "EHLO localhost";
|
|
local $_ = <$in>;
|
|
return "No server response" unless defined;
|
|
if (/^5\d\d\s+(.*)/) { # Not ESMTP
|
|
delete $self->{smtp_esmtp};
|
|
print $out "HELO localhost";
|
|
$_ = <$in>;
|
|
return "No server response to HELO command (EHLO failed)" unless defined;
|
|
}
|
|
else {
|
|
$self->{smtp_esmtp}++;
|
|
}
|
|
s/$CRLF/\n/;
|
|
return "Invalid server response: $_" if !/^\d{3}/;
|
|
return "Server error: $_" if /^[45]/;
|
|
return if /^250 /; # Just a plain SMTP greeting
|
|
while (defined($_=<$in>) and /^250-/) { # 250- is a possible greeting, indicating more lines coming.
|
|
s/$CRLF/\n/;
|
|
/^(?:221|[45]\d\d)\s*(.*)/ and return "Server disconnected: $1";
|
|
}
|
|
!defined || /^(?:221|[45]\d\d)\s*(.*)/ and return "Server disconnected: $1";
|
|
return;
|
|
}
|
|
END_OF_SUB
|
|
|
|
# Actually sends the message using SMTP protocols.
|
|
$COMPILE{_smtp_send} = __LINE__ . <<'END_OF_SUB';
|
|
sub _smtp_send {
|
|
my ($self,$to,$from,$name,$subject,$message) = @_;
|
|
return unless _is_valid_email($to);
|
|
local $/ = CRLF;
|
|
local $\ = CRLF;
|
|
local $_;
|
|
|
|
unless ($self->{smtp_connected}) {
|
|
$self->_smtp_connect();
|
|
}
|
|
my $in = $self->{handle_in};
|
|
my $out = $self->{handle_out};
|
|
print $out "RSET";
|
|
$_ = <$in>;
|
|
s/$CRLF$//;
|
|
if (not defined or /^(?:221|[45]\d\d)\s*(.*)/) {
|
|
$self->_cause_error("Cannot reset connection: ".($1 || "No response from server").". Reconnecting");
|
|
$self->{smtp_attempts} = 0; # It could be that the server will only take one connection, although
|
|
# this defeats any advantage this module has over any module designed to send just one message.
|
|
unless ($self->_smtp_connect()) {
|
|
$self->_cause_error("Fatal: Could not reestablish connection");
|
|
die "Could not reestablish connection";
|
|
}
|
|
}
|
|
if (/^221\s*(.*)/) {
|
|
$self->_smtp_disconnect();
|
|
$self->_cause_error("Server disconnected: $1");
|
|
return;
|
|
}
|
|
|
|
my $return = $self->{header}->{'Return-Path'} || $from;
|
|
print $out "MAIL FROM: <$return>";
|
|
|
|
$_ = <$in>;
|
|
s/$CRLF$//;
|
|
if (/^221\s*(.*)/) {
|
|
$self->_smtp_disconnect();
|
|
$self->_cause_error("Server disconnected: $1");
|
|
return;
|
|
}
|
|
unless (/^250/) {
|
|
# The error message won't be helpful here (it will be a syntax error).
|
|
# The only way an error can occur here is for an invalid email address.
|
|
$self->_cause_error("From address (`$from') rejected by server ($_)");
|
|
# If the from was rejected once, it will be rejected again.
|
|
die "From address (`$from') rejected by server.";
|
|
}
|
|
print $out "RCPT TO: <$to>";
|
|
$_ = <$in>;
|
|
s/$CRLF$//;
|
|
if (/^221\s*(.*)/) {
|
|
$self->_smtp_disconnect;
|
|
$self->_cause_error("Server disconnected: $1. Attempting to reconnect...");
|
|
$self->{smtp_attempts} = 0;
|
|
unless ($self->_smtp_connect()) {
|
|
$self->_cause_error("Fatal error: Could not reestablish connection");
|
|
die "Could not reestablish connection";
|
|
}
|
|
return &_smtp_send; # redo this mail
|
|
}
|
|
unless (/^25[01]/) {
|
|
/^\d{3}\s*(.*)/;
|
|
$self->_cause_error("Recipient ($to) refused by server: $1");
|
|
return;
|
|
}
|
|
print $out "DATA";
|
|
$_ = <$in>;
|
|
s/$CRLF$//;
|
|
if (/^221\s*(.*)/) {
|
|
$self->_smtp_disconnect;
|
|
$self->_cause_error("Server disconnected: $1. Attempting to reconnect...");
|
|
$self->{smtp_attempts} = 0;
|
|
unless ($self->_smtp_connect) {
|
|
$self->_cause_error("Fatal error: Could not reestablish connection");
|
|
die "Could not reestablish connection";
|
|
}
|
|
return &_smtp_send; # redo this mail
|
|
}
|
|
unless (/^354/) {
|
|
$self->_cause_error("Invalid server response to DATA ($_). Attempting to reset and resend.");
|
|
return &_smtp_send;
|
|
}
|
|
my $perl_version = $^V ? (join ".",map ord, split //,$^V) : $];
|
|
$from = "$name <$from>" if defined $name and $name =~ /\S/;
|
|
print $out "Return-Path: $return";
|
|
print $out "Date: $self->{date}";
|
|
print $out "From: $from";
|
|
print $out "Subject: $subject";
|
|
print $out "To: $to";
|
|
print $out "MIME-Version: 1.0" unless exists $self->{header}->{'MIME-Version'};
|
|
print $out "Content-Transfer-Encoding: quoted-printable" unless exists $self->{header}->{'Content-Transfer-Encoding'};
|
|
print $out "Content-Type: $self->{format}" if $self->{format};
|
|
my $host = $self->{smtp} && $self->{smtp} ne 'localhost' && $self->{smtp} !~ /^\s*127\.\d+\.\d+\.\d+\s*$/ ? $self->{smtp} : $ENV{SERVER_NAME} && $ENV{SERVER_NAME} ne 'localhost' ? $ENV{SERVER_NAME} : '';
|
|
if ($host) {
|
|
print $out 'Message-Id: <' . time . '.' . $$ . rand(10000) . '@' . $host . '>';
|
|
}
|
|
while (my ($k,$v) = each(%{$self->{header}})) {
|
|
next if $k eq 'Return-Path' or $k eq 'X-Mailer' or $k eq 'Message-Id';
|
|
print $out "$k: $v";
|
|
}
|
|
print $out "";
|
|
$message =~ s/\015?\012/$CRLF/g if $self->{raw};
|
|
$message = quoted_printable($message) unless $self->{raw};
|
|
$message =~ s/^\./../gm;
|
|
print $out $message;
|
|
print $out ".";
|
|
$_ = <$in>;
|
|
return /^250/;
|
|
}
|
|
END_OF_SUB
|
|
|
|
# Establishes a sendmail -bs (emulates SMTP) connection via IPC::Open2
|
|
$COMPILE{_sendmail_connect} = __LINE__ . <<'END_OF_SUB';
|
|
sub _sendmail_connect {
|
|
my $self = shift;
|
|
local $/ = CRLF;
|
|
local $\ = CRLF;
|
|
my $in = \do { local *INPUT; *INPUT; };
|
|
my $out = \do { local *OUTPUT; *OUTPUT; };
|
|
$self->_smtp_disconnect if $self->{sendmail_pid} or $self->{smtp_connected};
|
|
my $pid = eval { open2($in,$out,"$self->{sendmail} -bs") };
|
|
|
|
$self->{handle_in} = $in;
|
|
$self->{handle_out} = $out;
|
|
if ($@) {
|
|
# Could not run sendmail at all
|
|
$self->_cause_error("Unable to open sendmail: $@");
|
|
return;
|
|
}
|
|
$_ = <$in>;
|
|
s/\n$//;
|
|
unless (/^220/) {
|
|
# sendmail can be run, but apparently it doesn't like the -bs option
|
|
$self->_cause_error("$self->{sendmail}: SMTP compatible mode not available: $_. Using -t mode instead.");
|
|
close $in;
|
|
close $out;
|
|
waitpid $pid,0;
|
|
$self->{no_sendmail_bs}++;
|
|
return 1;
|
|
}
|
|
while (/^220-/) {
|
|
$_ = <$in>;
|
|
}
|
|
if (my $error = $self->_smtp_say_hi) {
|
|
$self->_cause_error("Sendmail (SMTP mode) error: $error");
|
|
close $in;
|
|
close $out;
|
|
waitpid $pid,0;
|
|
return;
|
|
}
|
|
$self->{sendmail_pid} = $pid;
|
|
$self->{smtp_connected} = 1;
|
|
return 1;
|
|
}
|
|
END_OF_SUB
|
|
|
|
# Disconnects from sendmail (in sendmail -bs mode)
|
|
$COMPILE{_sendmail_disconnect} = __LINE__ . <<'END_OF_SUB';
|
|
sub _sendmail_disconnect {
|
|
my $self = shift;
|
|
my $in = $self->{handle_in};
|
|
my $out = $self->{handle_out};
|
|
my $pid = $self->{sendmail_pid};
|
|
close $in if $in;
|
|
close $out if $out;
|
|
waitpid $pid, 0 if $pid;
|
|
delete $self->{handle_in};
|
|
delete $self->{handle_out};
|
|
delete $self->{sendmail_pid};
|
|
delete $self->{smtp_connected};
|
|
1;
|
|
}
|
|
END_OF_SUB
|
|
|
|
# Sends with sendmail -t mode. This should only be called when IPC::Open2 is
|
|
# not available or sendmail does not support the -bs switch. It is intended as
|
|
# a backup solution only.
|
|
$COMPILE{_sendmail_t_send} = __LINE__ . <<'END_OF_SUB';
|
|
sub _sendmail_t_send {
|
|
my ($self,$to,$from,$name,$subject,$message) = splice @_,0,6;
|
|
local $/ = LF;
|
|
local $\ = LF;
|
|
return unless _is_valid_email($to);
|
|
local *SENDMAIL;
|
|
my $to_open = $self->{sendmail_with_tags} || "$self->{sendmail} -t -oi -odq";
|
|
unless (open(SENDMAIL, "| $to_open"))
|
|
{
|
|
$self->_cause_error("Can't run sendmail ($to_open): $!");
|
|
return;
|
|
}
|
|
my $return = $self->{header}->{'Return-Path'} || $from;
|
|
$from = "$name <$from>" if defined $name and $name =~ /\S/;
|
|
my $perl_version = $^V ? (join ".",map ord, split //,$^V) : $];
|
|
print SENDMAIL "Return-Path: $return";
|
|
print SENDMAIL "Date: $self->{date}";
|
|
print SENDMAIL "From: $from";
|
|
print SENDMAIL "Subject: $subject";
|
|
print SENDMAIL "To: $to";
|
|
print SENDMAIL "MIME-Version: 1.0" unless exists $self->{header}->{'MIME-Version'};
|
|
print SENDMAIL "Content-Transfer-Encoding: quoted-printable" unless exists $self->{header}->{'Content-Transfer-Encoding'};
|
|
print SENDMAIL "Content-Type: $self->{format}" if $self->{format};
|
|
my $host = $ENV{SERVER_NAME} && $ENV{SERVER_NAME} ne 'localhost' ? $ENV{SERVER_NAME} : '';
|
|
if ($host) {
|
|
print SENDMAIL 'Message-Id: <' . time . '.' . $$ . rand(10000) . '@' . $host . '>';
|
|
}
|
|
while (my ($k,$v) = each %{$self->{header}}) {
|
|
next if $k eq 'Return-Path' or $k eq 'X-Mailer' or $k eq 'Message-Id';
|
|
print SENDMAIL "$k: $v";
|
|
}
|
|
unless ($self->{raw}) {
|
|
$message = quoted_printable($message);
|
|
# quoted_printable returns a string with CRLF newlines
|
|
$message =~ s/$CRLF/$LF/gs;
|
|
}
|
|
$message =~ s/^\.$LF$/. $LF/gm;
|
|
print SENDMAIL $message;
|
|
close SENDMAIL;
|
|
!$?;
|
|
}
|
|
END_OF_SUB
|
|
|
|
# Returns the argument passed with quotes around it and special characters
|
|
# escaped for use in the From: line of an e-mail.
|
|
sub quote_name {
|
|
shift if ref $_[0]; # In case you call $self->quote_name($string);
|
|
my $toquote = shift;
|
|
$toquote =~ s/(?=[(")\\])/\\/g;
|
|
substr($toquote,0,0) = '"';
|
|
$toquote .= '"';
|
|
$toquote;
|
|
}
|
|
|
|
# unquotes (as per the above) the argument
|
|
$COMPILE{unquote_name} = __LINE__ . <<'END_OF_SUB';
|
|
sub unquote_name {
|
|
shift if ref $_[0];
|
|
my $tounquote = shift;
|
|
$tounquote =~ s/^"// and $tounquote =~ s/"$//;
|
|
$tounquote =~ s/\\(?=.)//g;
|
|
return $tounquote;
|
|
}
|
|
END_OF_SUB
|
|
|
|
# Takes a string and returns it in quoted-printable encoding.
|
|
sub quoted_printable {
|
|
shift if ref $_[0];
|
|
my $in = shift || "";
|
|
my $out;
|
|
GT::Mail::Encoder->gt_encode(encoding => 'quoted-printable', in => $in, out => sub { $out .= $_[0] });
|
|
$out;
|
|
}
|
|
|
|
# Returns an RFC822 compliant date.
|
|
sub RFC822_date (;$$) {
|
|
require GT::Date;
|
|
GT::Date->import(':timelocal');
|
|
shift if ref $_[0];
|
|
my $time = @_ ? shift : time;
|
|
my @lt = localtime($time);
|
|
my @ut = gmtime($time);
|
|
use integer;
|
|
my $tzs = (timegm(@lt) - timelocal(@lt));
|
|
my $tzh = $tzs / 3600;
|
|
my $tzm = $tzs % 60 / 60;
|
|
my $tz = 100*$tzh + 60*$tzm;
|
|
no integer;
|
|
sprintf(
|
|
"%s, %02d %s %04d %02d:%02d:%02d %+05d",
|
|
(qw/Sun Mon Tue Wed Thu Fri Sat/)[$lt[6]],
|
|
$lt[3],
|
|
(qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/)[$lt[4]],
|
|
$lt[5] + 1900,
|
|
@lt[2,1,0],
|
|
$tz
|
|
);
|
|
}
|
|
|
|
1;
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
GT::Mail::BulkMail - A (perhaps overly) simplified interface to sending bulk emails
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
$mailer = new GT::Mail::BulkMail;
|
|
$mailer->option("setting");
|
|
$mailer->otheroption("othersetting");
|
|
...
|
|
|
|
-- or --
|
|
|
|
$mailer = new GT::Mail::BulkMail(
|
|
-option => "setting",
|
|
-otheroption => "othersetting",
|
|
...
|
|
);
|
|
|
|
|
|
|
|
-- then --
|
|
|
|
|
|
sub subroutine {
|
|
# Code to generate the next e-mail address
|
|
}
|
|
open FILE, "email_list.txt";
|
|
%hash = ( 1 => 'some@fictional.address',
|
|
2 => 'who@knows.where'
|
|
);
|
|
@array = ('yet@another.fictional.address','and@one.more');
|
|
$mailer->send(\&subroutine,\*FILE,\%hash,\@array);
|
|
close FILE;
|
|
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
GT::Mail::BulkMail is a module to handle mass mailings. It is capable of
|
|
using either sendmail, or an SMTP server. It has the advantage of
|
|
not requiring multiple connections to the SMTP server.
|
|
|
|
=head1 REQUIREMENTS
|
|
|
|
Perl 5.004
|
|
|
|
=head2 METHODS
|
|
|
|
All methods can be specified at object creation time as an option with the:
|
|
S<-option =E<gt> value> syntax. For example, C<$mailer = new GT::Mail::BulkMail(-from =E<gt> "foo@bar.com")>
|
|
would have the same effect as: C<$mailer = new GT::Mail::BulkMail(); $mailer-E<gt>from("foo@bar.com")>
|
|
|
|
=over 4
|
|
|
|
=item smtp
|
|
|
|
Sets the SMTP server to use, and sets the object mail sending method to use SMTP. Takes
|
|
SMTP server as argument.
|
|
|
|
=item sendmail
|
|
|
|
Sets the sendmail executable to use. Takes the path to sendmail as the argument.
|
|
|
|
=item text
|
|
|
|
Specifies that the mail format is text. This translates into Content-type: text/plain.
|
|
This is the default format.
|
|
|
|
=item html
|
|
|
|
Specifies that the mail format is HTML. (Content-type: text/html)
|
|
|
|
=item headers
|
|
|
|
Returns any custom headers set as a hash reference in scalar context, or a hash in list context.
|
|
|
|
=item add_header
|
|
|
|
Adds a single header. This can be any header starting with "X-" (Note that X-Mailer headers
|
|
will be prepended with the GT::Mail::BulkMail X-Mailer header (which includes the perl version,
|
|
OS name, GT::Mail::BulkMail module and CVS versions, and the Gossamer Threads homepage)). Pass
|
|
two arguments: A key (header name) and a value (header value). For example, for
|
|
C<X-Foo: blah blah blah> you would use: $mailer->add_header("X-Foo" => "blah blah blah")
|
|
|
|
=item add_headers
|
|
|
|
Same as above, except it adds multiple headers. Has the same argument format. You would use:
|
|
$mailer->add_headers("X-Foo1" => "blah", "X-Foo2" => "blah blah");
|
|
|
|
=item delete_header
|
|
|
|
Deletes a single header. Pass the name of the header to delete.
|
|
|
|
=item delete_headers
|
|
|
|
Delete multiple headers. Pass a list of names of headers to delete.
|
|
|
|
=item from
|
|
|
|
Sets the "from" field of the e-mail. Must be set before $mailer-E<gt>send() can be called.
|
|
Must be set to an e-mail address. If this e-mail address is rejected by the SMTP server,
|
|
no e-mails will be sent.
|
|
|
|
=item name
|
|
|
|
Sets the "name" field of the e-mail. This affects what is displayed in the "From" field.
|
|
When sending the email, the actual field will be set to: C<"This name" E<lt>some@name.netE<gt>>.
|
|
Optional.
|
|
|
|
=item subject
|
|
|
|
Sets the subject of the message. If not specified, it will default to "(no subject)"
|
|
|
|
=item message
|
|
|
|
The body of the message. Can be left blank, but that seems rather pointless...
|
|
The message will be encoded using the quoted-printable format if it contains characters
|
|
outside the 7-bit range.
|
|
|
|
=item success
|
|
|
|
A code reference to be run for each and every successful e-mail sending.
|
|
Each call to this code reference will be given the e-mail address as the only argument
|
|
(unless using a message ID, which is discussed below). Optional.
|
|
|
|
=item failure
|
|
|
|
A code reference that will be run for any email addresses that cannot be sent. Each
|
|
call to this code reference will be given the ID or e-mail address as the argument
|
|
(message IDs are discussed below). Optional.
|
|
|
|
=item frompresend
|
|
|
|
=item namepresend
|
|
|
|
=item subjectpresend
|
|
|
|
=item messagepresend
|
|
|
|
A code reference that will be run before sending an e-mail. The 'from', 'name', 'subject',
|
|
or 'message' field will be sent to the code references (depending on which method called)
|
|
and whatever is returned will be used as the actual field for the email sent. This can be
|
|
used to parse fields to customize them for each recipient. The subroutine is called with
|
|
two arguments: (ID_OR_EMAIL, FIELD). If an ID is provided, it will be passed as the
|
|
first argument, otherwise the email address will be passed. The second argument is the
|
|
field itself. The field used in the actual email to the user will be the value returned by
|
|
the subroutine.
|
|
|
|
The default field (for the rest of the mailing) can be changed by directly modifying $_[1]
|
|
itself.
|
|
|
|
If the subroutine reference returns an undefined value, the mailer will use the actual field
|
|
instead. You can use this technique to only modify some messages, but not others.
|
|
|
|
Optional.
|
|
|
|
=item show_errors
|
|
|
|
If set to something true it will warn() on all errors. Optional. The default is turned on,
|
|
but can easily be changed by modifying the line '
|
|
|
|
=item error_code
|
|
|
|
Takes a code reference - the code reference will be called with the error as the argument
|
|
when an error occurs. Optional.
|
|
|
|
=item send
|
|
|
|
Takes any number of the following arguments:
|
|
|
|
=over 8
|
|
|
|
=item array reference
|
|
|
|
An array reference of a list of e-mail addresses to send to. After each message, either the
|
|
success or failure callback will be called with the e-mail address as the argument, and
|
|
possibly a message as the second argument.
|
|
|
|
=item hash reference
|
|
|
|
A hash reference of ID =E<gt> email pairs. For example,
|
|
123 =E<gt> 'someone@whoknows.com'. The value will be used as the e-mail address to send
|
|
to, and the key will be an identifier to pass into the success or failure callbacks.
|
|
|
|
=item glob reference
|
|
|
|
A glob reference to an open file. Make sure the file is opened before passing this!
|
|
The file should contain one e-mail address per line.
|
|
|
|
=item subroutine or code reference
|
|
|
|
You may pass a code reference, and it will be called for each e-mail address. It is
|
|
assumed that the subroutine will return one e-mail address each time called, and
|
|
that a return value of "undef" indicates that there are no more e-mail addresses.
|
|
The code reference could alternatively return two items - if it does, it is assumed that
|
|
the first is an ID code, and that the second is the email address. When a call to either
|
|
or the success or failure callbacks, the ID will be provided as the first argument
|
|
instead of the e-mail address itself.
|
|
|
|
One cool feature to note about using code refs is that you can call next() from within
|
|
the code reference and it will then recall the code reference for the next value.
|
|
|
|
=cut
|