First pass at adding key files
This commit is contained in:
dsainty
177
site/slowtwitch.com/cgi-bin/articles/admin/nph-email.cgi
Executable file
177
site/slowtwitch.com/cgi-bin/articles/admin/nph-email.cgi
Executable file
@@ -0,0 +1,177 @@
|
||||
#!/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<br>\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 <<HTML;
|
||||
<html>
|
||||
<head>
|
||||
<title>Sending Emails</title>
|
||||
<body bgcolor=white>
|
||||
@{[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.')]}
|
||||
<pre>Started at $started.
|
||||
|
||||
Sending emails ...
|
||||
|
||||
HTML
|
||||
}
|
||||
else {
|
||||
print <<TEXT;
|
||||
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 ...
|
||||
|
||||
TEXT
|
||||
}
|
||||
$mailer->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 ? "</pre>\n" : "\n";
|
||||
print qq{<font face="Tahoma,Arial,Helvetica" size=2><a href="admin.cgi?action=mailings">Return to View Mailings</a></font>
|
||||
</body>
|
||||
</html>} 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()};
|
||||
}
|
||||
}
|
||||
Reference in New Issue
Block a user