#!/usr/local/bin/perl
# ==================================================================
# Gossamer Links - enhanced directory management system
#
# Website : http://gossamer-threads.com/
# Support : http://gossamer-threads.com/scripts/support/
# CVS Info : 087,071,086,086,085
# Revision : $Id: nph-email.cgi,v 1.46 2005/07/12 00:55:19 brewt Exp $
#
# Copyright (c) 2001 Gossamer Threads Inc. All Rights Reserved.
# Redistribution in part or in whole strictly prohibited. Please
# see LICENSE file for full details.
# ==================================================================
BEGIN { local $@; eval { require Time::HiRes; import Time::HiRes qw/time/; }; }
use strict;
use lib '/var/home/slowtwitch/slowtwitch.com/cgi-bin/articles/admin';
use Links qw/$DB $IN $CFG/;
use GT::Mail::BulkMail;
use vars qw(%info $extra $Is_CGI);
$| = 1;
local $SIG{__DIE__} = \&Links::fatal;
Links::init('/var/home/slowtwitch/slowtwitch.com/cgi-bin/articles/admin');
Links::init_admin();
$Is_CGI = $ENV{REQUEST_METHOD};
main();
sub main {
# -------------------------------------------------------------------
# Figure out who to send email to.
#
my $ID = $Is_CGI ? $IN->param('emailsto') : shift(@ARGV);
unless ($Is_CGI or $ID) {
print "Usage: $0 mailing_id
$0 will attempt to send all the e-mails associated with that ID.\n";
exit 1;
}
unless (defined $ID and length $ID) {
die "No Mailing ID passed to nph-email!";
}
my $mail = $DB->table('MailingIndex')->select({ Mailing => $ID })->fetchrow_hashref;
if (! $mail) {
die "Invalid Mailing ID passed to nph-email!";
}
my %mail = %$mail;
my $presend = sub { Links::user_page ('', \%info, { string => $_[1] }) };
my $sent = 0;
$extra = $DB->table('MailingIndex')->select({ Mailing => $ID },['extra'])->fetchrow_array;
my $success = sub {
print ++$sent % 20 ? ". " : ". $sent sent
\n";
$DB->table('EmailMailings')->update({ 'Sent' => 1 }, { ID => shift });
};
my $faults = 0;
my $failure = sub {
$faults++;
my $mailID = shift;
my $sentstr = " . " x $sent;
print "\nThere was an error while sending the email to ";
print $DB->table('EmailMailings')->select({ ID => $mailID },['Email'])->fetchrow_arrayref()->[0];
$DB->table('EmailMailings')->update({ 'Sent' => 1 }, { ID => $mailID });
print "\n";
print $sentstr;
};
# BulkMail won't encode the name or subject for us. However, since we don't
# know what character set the input is, this will assume (actually
# GT::Mail::Parts::encode_mimewords) that the character set is iso-8859-1.
if ($mail{name} !~ /\x20-\x7e/) {
require GT::Mail::Parts;
$mail{name} = GT::Mail::Parts::encode_mimewords($mail{name});
}
if ($mail{subject} !~ /\x20-\x7e/) {
require GT::Mail::Parts;
$mail{subject} = GT::Mail::Parts::encode_mimewords($mail{subject});
}
my $mailer = GT::Mail::BulkMail->new(
-show_errors => 1,
-from => $mail{mailfrom},
-name => $mail{name},
-subject => $mail{subject},
-message => $mail{message},
-success => $success,
-failure => $failure,
-text => $mail{messageformat} eq 'text',
-html => $mail{messageformat} eq 'html',
-sendmail => $CFG->{db_mail_path},
-smtp => $CFG->{db_smtp_server},
);
if (!$extra or $extra ne 'none') {
$mailer->subjectpresend($presend);
$mailer->messagepresend($presend);
}
my $get_cols = ['ID','Email'];
push @$get_cols, 'LinkID' if $extra and $extra eq 'Links';
my $sth = $DB->table('EmailMailings')->select($get_cols => { Mailing => $ID, Sent => 0 });
my $next = sub {
my @row = $sth->fetchrow_array;
return unless @row;
get_info(@row);
return @row;
};
my $start = time();
my $started = scalar localtime;
print $IN->header(-nph => $CFG->{nph_headers});
if ($Is_CGI) {
print <
Sending Emails
@{[Links::header ('Sending Emails ...', 'Gossamer Links is now going to send the emails in the associated mailing. Please be patient, this can take a while depending on the speed of the mail server and the number of recipients.')]}
Started at $started.
Sending emails ...
HTML
}
else {
print <send($next);
my $finished = time;
$DB->table('MailingIndex')->update({ done => int($finished) }, { Mailing => $ID });
print "$sent sent.";# if $sent % 20;
printf ("\n\nMailing complete (%.2f s)\n\n", $finished - $start);
print $Is_CGI ? "\n" : "\n";
print qq{Return to View Mailings
} if $Is_CGI;
}
sub get_info {
# -------------------------------------------------------------------
# get_info sets %info with substitution information for a mailing ID.
# Substitution information is always set for the 'Users' table, as well as
# whatever is set in the table in the mailing index's 'index' field.
# Takes two arguments: The mailing ID for the MailingIndex table, and the email
# ID of the user in question. The Table must have a Username field.
# There is an exception: If the global "$extra" is set to "none", %info will
# be emptied.
#
my $email = $_[1];
my $link_id = $_[2];
if (!defined $email or $extra and $extra eq 'none') {
%info = ();
return;
}
if (!$extra or $extra eq 'Users') {
if ($DB->table('Users')->count({ Email => $email })) {
%info = %{$DB->table('Users')->select({ Email => $email })->fetchrow_hashref};
}
else {
%info = ();
}
}
else {
%info = %{$DB->table('Links', 'Users')->select({ 'Links.ID' => $link_id })->fetchrow_hashref()};
}
}