#!/opt/bin/perl
#$TEST = 1;
$| = 1;
#
# CHANGE HISTORY:
# ...
# 990430 - added ability to use list or List_name for one or more
# lists added -text check to if, added type check for html/text
# checkboxes now works on nearly every form, except html/text
# checkboxes need to both be called "type" - abk
# 990430 fixed bug in if exception statement (repeat $list =~)-abk
# 990430 prob with lsoft one email method, switched to mult emails
# checked on webref, wrks-abk
# 990501 - redid @lists/@types loop, now handles all our forms
# except newslinx forms must have two "type" fields (html/text)
# can handle both long and short fields names:
#
# one or more lists named all "list" or all "List_Name"
# email or Email_Address
# action or Action
# type (for HTML and TEXT checkboxes)
# upper case or lower case lists (input) output as lower case
#
# caution: you need to be consistent throughout your form
# for multiple newsletters, the field name should either be all
# "list" or "List_Name" not both in one form. - abk
#
# simplified version, requires type field, use example form below:
#
#
http://www.webreference.com/signupform.html
#
# one or more lists named all "list" or all "List_Name"
# email or Email_Address
# action or Action
# type (for HTML and TEXT checkboxes)
# upper case or lower case lists (input) output as lower case
#
# can handle newsletter names with or without -html and -text
# and with talk for discussion lists).
#
# with no suffix (i.e., webreference-update) and no type it
# defaults to text (i.e. creates webreference-update-text)
#
# with suffix of -html -text or ends with talk it uses the list
# name as is (i.e., newslinx-html or WDVL-TALK, or ECTALK)
#
# when "type" is set to html, text or both html and text
# this script assumes list name has no suffix and appends, i.e.,
# internetday -> internetday-html AND internetday-text (if both
# HTML and TEXT type checkboxes are checked.) if suffix exists
# it ignores type.
#
# caution: you need to be consistent throughout your form
# for multiple newsletters, the field name should either be all
# "list" or "List_Name" not both in one form. - abk
#
# 990514 - TG (Tom Germain): substituted pipe to sendmail with
# direct smtp connect to Lyris
# server.
# 990928 lc type for smtp array ref bug - abk-ecc
# 991019 - changed to sendmail method, on-off to join-leave
# fixed text on bug - avk
# 991117 - Added write to file on E-Mail entry, and removed
# cc: to softquad - dmr
# 991220 - went open source
use CGI;
#>>>>T.G 990723>>>
#hostname for smtp [Lyris server]
my(%SMTP,%SMTP_FLG,%HDL,%H);
$SMTP{text} = 'list4.internet.com';
$SMTP{html} = 'list3.internet.com';
$HDL{text} = 'S1';
$HDL{html} = 'S2';
#local hostname
$LOCALHOST = 'webreference.com';
#<<<<<<<<
$path = $ENV{'HTTP_REFERER'};
$path2 = "http://e-newsletters.internet.com/thankyou_new.html";
CGI::ReadParse();
$query = new CGI;
$email = $in{'Email_Address'} || $in{'email'};
@lists = $query->param('list');
@list_name = $query->param('List_Name');
if (@list_name) {@lists = @list_name};
$action = $in{'Action'} || $in{'action'};
@types = $query->param('type');
$action =~ tr/A-Z/a-z/;
$typeyes = "no";
$listtemp = "";
$onoff = "";
$emailfile = "/www/webref/control/sublist.txt";
$name = "Anonymous";
# Greetings
if ($email eq "enter e-mail") {
print "Content-type: text/html\n\n";
print "<H2>Oops! Try again gentle subscriber</H2>";
print "You gotta enter your e-mail address here, not just hit subscribe!<br>";
print "Please go back to <B><A HREF='$path' TARGET='_top'>$path</A></B> ";
print "and make sure this is complete.";
exit;
}
if ($email eq "") {
print "Content-type: text/html\n\n";
print "<H2>Oops! Blank e-mail, eeek!</H2>";
print "You forgot to enter your email address.<br>";
print "Please go back to <B><A HREF='$path' TARGET='_top'>$path</A></B> ";
print "and make sure this is complete.";
exit;
}
if ($email =~ /^([\w.-]+@(?:[-\w]+\.)+[a-zA-Z]{2,3})$/) {
$email = $1; # Untaint it
} else {
print "Content-type: text/html\n\n";
print "<H2>Hey! Invalid email, try again</H2>";
print "You entered an invalid email address.<br>";
print "Please go back to <B><A HREF='$path' TARGET='_top'>$path</A></B> ";
print "and make sure you enter an email of the form name\@domain.xxx. ";
print "Thanks.";
exit;
}
if (@lists < 1){
print "Content-type: text/html\n\n";
print "<H2>Hey! You didn't choose a newsletter, try again</H2>";
exit;
}
if ($action eq "unsubscribe") {
$onoff = "leave-";
} else {
$onoff = "join-";
}
foreach $list (@lists) {
#
# 990715 this loop moved inside main loop for old forms - abk
# it accepts old style list names as checkboxes
# and defaults to -text if no suffix
#
$list =~ tr/A-Z/a-z/;
if($list =~ /\-(html)$/ || $list =~ /\-(text)$/ || $list =~ /talk$/)
{
$type = $1;
if(!$type){$type = 'text';}
#&debug(">>>>$type");
}
else {
if (@types > 0){$typeyes = "yes";}
else {
$list = $list . "-text";
$type = 'text';}
}
if ($typeyes eq "yes") {
foreach $type (@types) {
$type = lc($type);
$listtemp = $list . "-" . $type;
$listtemp = lc($listtemp);
$listtemp2 = $onoff . $listtemp . "\@" . $SMTP{$type};
open (MAIL, "|/usr/lib/sendmail -t -oi");
print MAIL<<END8;
From: $email
To: $listtemp2
Subject:
Mime-Version: 1.0
Content-Type: text/plain; charset="us-ascii"
Precedence: list
$action $list
END8
close MAIL;
}
open (MAIL, "|/usr/lib/sendmail -t -oi");
print MAIL<<END7;
From: youremail\@domain.com
To: $email
Subject: Subscribe and Win Contest Entry
Mime-Version: 1.0
Content-Type: text/plain; charset="us-ascii"
Precedence: list
Welcome! You've been entered into
***INSERT YOUR SHIT HERE****
***POST LINK TO SECRET GARDEN NONESENSE****
Thank again,
the webmaster
END7
close MAIL;
open(LOGFILE,"+<$emailfile");
flock(LOGFILE,2);
seek(LOGFILE,0,2);
print LOGFILE ("$email\n");
close(LOGFILE);
}
else
{
$listtemp2 = $onoff . $list . "\@" . $SMTP{$type};
open (MAIL, "|/usr/lib/sendmail -t -oi");
print MAIL<<END9;
From: $email
To: $listtemp2
Subject:
Mime-Version: 1.0
Content-Type: text/plain; charset="us-ascii"
Precedence: list
$action $list
END9
close MAIL;
open(LOGFILE,"+<$emailfile");
flock(LOGFILE,2);
seek(LOGFILE,0,2);
print LOGFILE ("$email\n");
close(LOGFILE);
}
} #next list
print "Location: $path2\n\n";
# code below uunec with above redirect but left for future use
if ($action eq "subscribe") {
print <<END1;
<html>
<head>
<meta HTTP-EQUIV="Refresh" CONTENT="0; URL=$path2">
<title>$list List Subscribe Results</title>
</head>
<body bgcolor=ffffff>
<h1 align=center>Newsletter Subscription Results</h1>
<BLOCKQUOTE>
<center>
Thank you $email, for<br>
your request to join the
END1
foreach $list (@lists) {
print "$list, ";
}
print <<END3;
list(s).</center>
<P>Your request has been submitted for
approval. You should receive an email shortly that
will confirm your subscription request.</P>
<P>You'll now be sent back to <B><A HREF="$path2"
TARGET="_top">$path2</A></B>.</P>
<center>
<font size=1> Copyright © 1999-2000 Jupitermedia Corp. .</font>
</center>
</BLOCKQUOTE>
</body>
</html>
END3
}
if ($action eq "unsubscribe" or $action eq "SIGNOFF") {
$name="";
print <<END4;
<html>
<head>
<meta HTTP-EQUIV="Refresh" CONTENT="0; URL=$path2">
<title>$list list unsubscribe results</title>
</head>
<body bgcolor="#ffffff">
<center>
<h1 align=center>$list list unsubscribe results</h1>
<BLOCKQUOTE>
<center>
ThankYou $email, for your interest in
END4
foreach $list (@lists) {
print "$list, ";
}
print <<END5;
list(s).</center>
<br>
Your request has been submitted for processing.
You should receive an email shortly that
will confirm that you have been unsubscribed from the list(s).
<br>
back to <B><A HREF="$path2" TARGET="_top">$path2</A></B>
<br>
<center>
<font size=1>
© Copyright © 1999-2000 Jupitermedia Corp. .</font>
</blockquote>
</body>
</html>
END5
}
exit;