880 lines
31 KiB
Perl
880 lines
31 KiB
Perl
# ==================================================================
|
|
# Gossamer List - enhanced mailing list management system
|
|
#
|
|
# Website : http://gossamer-threads.com/
|
|
# Support : http://gossamer-threads.com/scripts/support/
|
|
# CVS Info :
|
|
# Revision : $Id: User.pm,v 1.49 2004/10/14 22:57:54 bao Exp $
|
|
#
|
|
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
# Redistribution in part or in whole strictly prohibited. Please
|
|
# see LICENSE file for full details.
|
|
# ==================================================================
|
|
#
|
|
|
|
package GList::User;
|
|
# ==================================================================
|
|
|
|
use strict;
|
|
use GList qw/:objects :user_type $DEBUG/;
|
|
use GT::AutoLoader;
|
|
|
|
sub process {
|
|
#-------------------------------------------------------------------
|
|
# Determine what to do
|
|
#
|
|
my $do = shift;
|
|
|
|
my $action = _determine_action($do) or die "Error: Invalid Action! ($do)";
|
|
|
|
my ($tpl, $results) = GT::Plugins->dispatch($CFG->{priv_path}.'/lib/GList/Plugins', $action, \&$action);
|
|
$tpl ||= 'user_login.html';
|
|
GList::display($tpl, $results);
|
|
}
|
|
|
|
$COMPILE{user_click} = __LINE__ . <<'END_OF_SUB';
|
|
sub user_click {
|
|
#--------------------------------------------------------------------
|
|
# Track number of clicks
|
|
#
|
|
my $id = $IN->param('mailing');
|
|
my $url = $IN->param('url') || "$CFG->{cgi_url}/glist.cgi";
|
|
my $db = $DB->table('MailingIndex');
|
|
if ($db->count({ mli_id => $id })) {
|
|
$db->update({ mli_num_clicked => \'mli_num_clicked + 1' }, { mli_id => $id });
|
|
}
|
|
print $IN->header( -url => $url );
|
|
return;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{user_open} = __LINE__ . <<'END_OF_SUB';
|
|
sub user_open {
|
|
#--------------------------------------------------------------------
|
|
# Track number of users who open message
|
|
#
|
|
my $code = $IN->param('eml_code');
|
|
my $mailing = $IN->param('mailing');
|
|
my $db = $DB->table('EmailMailings');
|
|
if ($code and $mailing and $db->count({ eml_mailing_id_fk => $mailing, eml_code => $code, eml_opened => 0 })) {
|
|
$db->update({ eml_opened => time }, { eml_mailing_id_fk => $mailing, eml_code => $code });
|
|
$DB->table('MailingIndex')->update({ mli_num_opened => \'mli_num_opened + 1' }, { mli_id => $mailing });
|
|
}
|
|
if (open DATA, "$CFG->{image_path}/pics/1pixel.gif") {
|
|
print $IN->header({
|
|
'-type' => 'image/gif',
|
|
'-Content-Length' => -s "$CFG->{image_path}/pics/1pixel.gif",
|
|
});
|
|
binmode STDOUT;
|
|
binmode DATA;
|
|
my $buffer;
|
|
print $buffer while (read(DATA, $buffer, 50000));
|
|
close DATA;
|
|
}
|
|
return;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{user_signup} = __LINE__ . <<'END_OF_SUB';
|
|
sub user_signup {
|
|
# -------------------------------------------------------------------
|
|
# User Sign-up
|
|
#
|
|
return ('user_login.html', { msg => GList::language('USR_SIGNUP_DISABLE') }) if (!$CFG->{signup_enable});
|
|
|
|
return ('user_signup.html') if ($IN->param('form'));
|
|
|
|
my $cgi = $IN->get_hash();
|
|
|
|
my $error = _signup_check($cgi);
|
|
return ('user_signup.html', { msg => $error }) if ($error);
|
|
|
|
$cgi->{usr_password} = GList::encrypt($cgi->{usr_password});
|
|
$cgi->{usr_date_format}||= "%yyyy%-%mm%-%dd%";
|
|
$cgi->{usr_bounce_email} = $cgi->{usr_email};
|
|
$cgi->{usr_reply_email} = $cgi->{usr_email};
|
|
$cgi->{usr_limit_list} = $CFG->{signup_limit_list} || 10;
|
|
$cgi->{usr_limit_sublist}= $CFG->{signup_limit_sublist} || 10;
|
|
$cgi->{usr_limit_email30}= $CFG->{signup_limit_email30} || 100;
|
|
$cgi->{usr_type} = (!$CFG->{signup_email_validate} and !$CFG->{signup_admin_validate}) ? LIMITED_USER : UNVALIDATED_USER;
|
|
my $info = $cgi;
|
|
|
|
# if it requires email validate
|
|
if ($CFG->{signup_email_validate}) {
|
|
my $val_code = join '', ('a'..'z', 'A'..'Z', 0..9)[map rand(62), 1 .. 30];
|
|
$cgi->{usr_validate_code} = "GT$val_code";
|
|
$info->{validate_code} = $val_code;
|
|
}
|
|
|
|
GList::add('Users', 'usr', $cgi);
|
|
return ('user_signup.html', { msg => "<font color=red><b>$GList::error</b></font>" }) if ($GList::error);
|
|
|
|
# Send a validate email
|
|
my $msg = GList::language('USR_SIGNUP_SUCCESSFUL');
|
|
if ($CFG->{signup_email_validate}) {
|
|
foreach (keys %{$CFG->{admin}}) {
|
|
next if (!$_);
|
|
$info->{admin_email} = $CFG->{admin}->{$_}->[1]; last;
|
|
}
|
|
|
|
my ($head, $body) = _parse_file('account_validation.eml', $info);
|
|
GList::send($head, { text => $body });
|
|
$msg = GList::language('USR_SIGNUP_EMAIL_SUCCESSFUL');
|
|
}
|
|
return ('user_login.html', { msg => $msg });
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{user_account_validate} = __LINE__ . <<'END_OF_SUB';
|
|
sub user_account_validate {
|
|
#----------------------------------------------------------
|
|
# User validate
|
|
#
|
|
my $id = $IN->param('id');
|
|
my $db = $DB->table('Users');
|
|
my $found= $db->count({ usr_validate_code => $id });
|
|
return ('user_login.html', { msg => GList::language('USR_VALIDATE_FAILED') }) unless ($found);
|
|
|
|
# if it requires admin validate
|
|
my %hash = (usr_validate_code => '', usr_type => LIMITED_USER);
|
|
if ($CFG->{signup_admin_validate}) {
|
|
$hash{usr_type} = UNVALIDATED_USER;
|
|
}
|
|
$db->update(\%hash, { usr_validate_code => $id });
|
|
return ('user_login.html', { msg => GList::language('USR_VALIDATE_SUCCESSFUL') });
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{user_login} = __LINE__ . <<'END_OF_SUB';
|
|
sub user_login {
|
|
# --------------------------------------------------------
|
|
# Logs a user in, and creates a session ID.
|
|
#
|
|
|
|
if (!defined $IN->param('username') or !defined $IN->param('password')) {
|
|
return ('user_login.html', { msg => GList::language('LOG_IN', GList::_load_global('site_title')) });
|
|
}
|
|
|
|
my $username = $IN->param('username') || shift;
|
|
my $password = $IN->param('password') || shift;
|
|
|
|
# Make sure we have both a username and password.
|
|
return ('user_login.html', { msg => GList::language('LOG_ERROR') }) if (!$username or !$password);
|
|
|
|
unless (GList::test_connection()) { # Database connection is failed
|
|
if (GList::Authenticate::auth('admin_valid_user', { username => $username, password => $password })) {
|
|
my $session = GList::Authenticate::auth('admin_create_session', { username => $username });
|
|
if ($session) {
|
|
$USER->{admin_user} = $username;
|
|
$USER->{admin_pass} = $password;
|
|
$USER->{session_id} = $session->{session_id};
|
|
$USER->{use_cookie} = $session->{use_cookie};
|
|
require GList::Admin;
|
|
return GList::Admin::admin_initial_sql();
|
|
}
|
|
}
|
|
return ('user_login.html', { msg => GList::language('LOG_ERROR') });
|
|
}
|
|
|
|
# Check that the user exists, and that the password is valid.
|
|
my $user = GList::init_user($username, $password);
|
|
return ('user_login.html', { msg => GList::language('LOG_DEACTIVATE') }) if ($user and $user == 1);
|
|
return ('user_login.html', { msg => GList::language('LOG_NOT_EMAIL_VALIDATED') }) if ($user and $user == 2);
|
|
return ('user_login.html', { msg => GList::language('LOG_NOT_ADMIN_VALIDATED') }) if ($user and $user == 3);
|
|
return ('user_login.html', { msg => GList::language('LOG_ERROR') }) if (ref $user ne 'HASH');
|
|
|
|
# Store the session in either a cookie or url based.
|
|
my $results = GList::Authenticate::auth('create_session', { username => $user->{usr_username} });
|
|
|
|
return ('user_login.html', { msg => "<font color=red><b>$results->{error}</b></font>" }) if ($results->{error});
|
|
$USER->{session_id} = $results->{session_id};
|
|
$USER->{use_cookie} = $results->{use_cookie};
|
|
|
|
_cleanup_files();
|
|
|
|
if ($USER->{usr_updated}) {
|
|
$MN_SELECTED = 1;
|
|
require GList::Message;
|
|
return GList::Message::msg_home(GList::language('LOG_WELCOME', "$USER->{pro_first_name} $USER->{pro_last_name}"));
|
|
}
|
|
else {
|
|
$MN_SELECTED = 5;
|
|
require GList::Profile;
|
|
return GList::Profile::pro_profile(GList::language('LOG_UPDATE_REMIND'));
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{user_logout} = <<'END_OF_SUB';
|
|
sub user_logout {
|
|
#-----------------------------------------------------------
|
|
#
|
|
require GList::Authenticate;
|
|
GList::Authenticate::auth('delete_session');
|
|
return ('user_login.html', { msg => GList::language('LOG_LOGGED_OFF', GList::_load_global('site_title')) });
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{user_remind} = __LINE__ . <<'END_OF_SUB';
|
|
sub user_remind {
|
|
#---------------------------------------------------------
|
|
# Send password to a user
|
|
#
|
|
|
|
#------------demo code-----------
|
|
|
|
return ('user_remind_form.html') if (!defined $IN->param('email'));
|
|
|
|
my $email = $IN->param('email');
|
|
return ('user_remind_form.html', { msg => GList::language('LOG_REM_ERROR') }) unless ($email);
|
|
|
|
my $db = $DB->table('Users');
|
|
my $user = $db->get({ usr_email => $email });
|
|
return ('user_remind_form.html', { msg => GList::language('LOG_REM_NOT_FOUND') }) if (!$user);
|
|
|
|
# Get Administrator info
|
|
my $info;
|
|
my $admin = $db->get({ usr_type => LIMITED_USER });
|
|
if ($admin) {
|
|
$info->{admin_email} = $admin->{usr_email};
|
|
}
|
|
|
|
my @letters = (0 .. 9, 'a' .. 'z', 'A' .. 'Z');
|
|
my $temp = '';
|
|
for (1 .. 6) { $temp .= $letters[rand @letters]; }
|
|
my $temp_enc = GList::encrypt($temp);
|
|
$db->update({ usr_password => $temp_enc }, { usr_username => $user->{usr_username} });
|
|
|
|
$info->{usr_username} = $user->{usr_username};
|
|
$info->{usr_email} = $user->{usr_email};
|
|
$info->{usr_password} = $temp;
|
|
$info->{usr_name} = "$user->{pro_first_name} $user->{pro_last_name}";
|
|
$info->{usr_name} ||= $user->{usr_username};
|
|
|
|
my ($head, $body) = _parse_file('remindme.eml', $info);
|
|
GList::send($head, { text => $body });
|
|
|
|
return ('user_login.html', { msg => GList::language('LOG_REM_SUCCESS', $email) });
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{user_validate} = __LINE__ . <<'END_OF_SUB';
|
|
sub user_validate {
|
|
#-----------------------------------------------------------
|
|
# Validate a subscriber
|
|
#
|
|
|
|
my $admin = $db->get({ usr_type => LIMITED_USER });
|
|
if ($admin) {
|
|
$info->{admin_email} = $admin->{usr_email};
|
|
}
|
|
|
|
my @letters = (0 .. 9, 'a' .. 'z', 'A' .. 'Z');
|
|
my $temp = '';
|
|
for (1 .. 6) { $temp .= $letters[rand @letters]; }
|
|
my $temp_enc = GList::encrypt($temp);
|
|
$db->update({ usr_password => $temp_enc }, { usr_username => $user->{usr_username} });
|
|
|
|
$info->{usr_username} = $user->{usr_username};
|
|
$info->{usr_email} = $user->{usr_email};
|
|
$info->{usr_password} = $temp;
|
|
$info->{usr_name} = "$user->{pro_first_name} $user->{pro_last_name}";
|
|
$info->{usr_name} ||= $user->{usr_username};
|
|
|
|
my ($head, $body) = _parse_file('remindme.eml', $info);
|
|
GList::send($head, { text => $body });
|
|
|
|
return ('user_login.html', { msg => GList::language('LOG_REM_SUCCESS', $email) });
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{user_validate} = __LINE__ . <<'END_OF_SUB';
|
|
sub user_validate {
|
|
#-----------------------------------------------------------
|
|
# Validate a subscriber
|
|
#
|
|
|
|
#------------demo code-----------
|
|
|
|
my $id = $IN->param('id');
|
|
my $db = $DB->table('Subscribers');
|
|
my $info = $db->get({ sub_val_code => $id });
|
|
|
|
return ('error_form.html', { msg => GList::language('LOG_VAL_ERROR') }) if (!$info);
|
|
return ('error_form.html', { msg => GList::language('LOG_VAL_ERROR2') }) if ($info->{sub_validated});
|
|
|
|
$db->update({ sub_validated => '1' }, { sub_val_code => $id });
|
|
|
|
my $lst_info = $DB->table('Lists')->get($info->{sub_list_id_fk});
|
|
return ('user_success_form.html', { msg => GList::language('LOG_VALIDATED') }) if (!$lst_info->{lst_url_validate_success});
|
|
|
|
print $IN->header( -url => $lst_info->{lst_url_validate_success} );
|
|
return;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{user_subscribe} = __LINE__ . <<'END_OF_SUB';
|
|
sub user_subscribe {
|
|
#-----------------------------------------------------------
|
|
# Subscribe a email address
|
|
#
|
|
# get subscribe success URLs
|
|
my $url_success = "$CFG->{static_url}/page/subscribe_success.html";
|
|
my $url_failure = "$CFG->{static_url}/page/subscribe_failure.html";
|
|
# get the hash for this CGI instance
|
|
my $cgi = $IN->get_hash();
|
|
my $demo = 0;
|
|
# errors if we don't have an accurate list ID
|
|
return ('error_form.html', { msg => GList::language('LOG_SUBSCRIBE_ERROR') }) unless ($cgi->{lid});
|
|
|
|
#------------demo code-----------
|
|
# $demo = 1;
|
|
|
|
# Get the relevant table lsits (Subscribers). StopLists is the unknown one--doesn't look like it's used anymore
|
|
my $db_sub = $DB->table('Subscribers');
|
|
my $db_stl = $DB->table('StopLists');
|
|
my $wild_cards = GList::wild_cards();
|
|
my $email;
|
|
if ($cgi->{eml_code}) {
|
|
my $eml = $DB->table('EmailMailings')->get({ eml_code => $cgi->{eml_code} });
|
|
$email = lc $eml->{eml_email};
|
|
}
|
|
else {
|
|
$email = lc $cgi->{email};
|
|
}
|
|
|
|
# if there's an array of IDs, loop over them
|
|
if (ref $cgi->{lid} eq 'ARRAY') {
|
|
foreach my $id (@{$cgi->{lid}}) {
|
|
my $info = $DB->table('Lists')->get($id);
|
|
next unless ($info);
|
|
|
|
my $error = _check_subscriber($email, $id, $db_stl, $wild_cards);
|
|
next if ($error);
|
|
|
|
# if it has been subscribed to the list
|
|
next if ($db_sub->count({ sub_email => $email, sub_list_id_fk => $id }));
|
|
|
|
my ($template, $data) = _generate_info($info, $email, $cgi->{name});
|
|
next unless ($data);
|
|
|
|
$db_sub->insert($data);
|
|
if ($template and !$demo) { # sending a confirmation or validation email
|
|
GList::send($template->{head}, { text => $template->{body} });
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
my $info = $DB->table('Lists')->get($cgi->{lid});
|
|
return ('error_form.html', { msg => GList::language('LOG_SUBSCRIBE_ERROR2', $cgi->{lid}, GList::_load_global('site_title')) }) if (!$info);
|
|
|
|
$url_success = $info->{lst_url_subscribe_success} if ($info->{lst_url_subscribe_success});
|
|
$url_failure = $info->{lst_url_subscribe_failure} if ($info->{lst_url_subscribe_failure});
|
|
my $error = _check_subscriber($email, $info->{lst_id}, $db_stl, $wild_cards);
|
|
return ('error_form.html', { msg => $error }) if ($error);
|
|
|
|
# if it has been subscribed to the list
|
|
if ($db_sub->count({ sub_email => $email, sub_list_id_fk => $cgi->{lid} })) {
|
|
print $IN->header( -url => $url_failure );
|
|
return;
|
|
}
|
|
|
|
my ($template, $data) = _generate_info($info, $email, $cgi->{name});
|
|
unless ($data) {
|
|
print $IN->header( -url => $url_failure );
|
|
return;
|
|
}
|
|
$db_sub->insert($data);
|
|
|
|
if ($template and !$demo) { # sending a confirmation or validation email
|
|
GList::send($template->{head}, { text => $template->{body} });
|
|
}
|
|
}
|
|
|
|
print $IN->header( -url => $url_success );
|
|
return;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{user_rm} = __LINE__ . <<'END_OF_SUB';
|
|
sub user_rm {
|
|
user_unsubscribe();
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{user_unsubscribe} = __LINE__ . <<'END_OF_SUB';
|
|
sub user_unsubscribe {
|
|
#-----------------------------------------------------------
|
|
# Unsubscribe a email address
|
|
#
|
|
my $url_success = "$CFG->{static_url}/page/unsubscribe_success.html";
|
|
my $url_failure = "$CFG->{static_url}/page/unsubscribe_failure.html";
|
|
|
|
my ($info, $email);
|
|
# Gets hash from $IN? -> Global variable that's defined as what? I think it's the whole query parameter
|
|
my $cgi = $IN->get_hash();
|
|
# Get subscribers table -> We'll need this
|
|
my $db_sub = $DB->table('Subscribers');
|
|
# If lid is an array, return it as such, otherwise return the single array as an array
|
|
my $lists = (ref $cgi->{lid} eq 'ARRAY') ? $cgi->{lid} : [$cgi->{lid}];
|
|
# if this $cgi global has an eml_code (it should if cliked from a link)
|
|
if ($cgi->{eml_code}) {
|
|
# Get the e-mail Mailings table and then get the EML_CODE equal to this one
|
|
# eml_code is equal to the hash that's sent -> Can use this again
|
|
my $eml = $DB->table('EmailMailings')->get({ eml_code => $cgi->{eml_code} });
|
|
# From the eml-code (hash), get the actual e-maile lowercased (this is probably a row)
|
|
$email = lc $eml->{eml_email};
|
|
}
|
|
else {
|
|
# Otherwise if not clicked from this, we're just going to try to get the e-mail from this instance
|
|
$email = lc $cgi->{email};
|
|
}
|
|
|
|
# If we don't have an e-mail, go to the failure url
|
|
if (!$email or $#$lists < 0) {
|
|
print $IN->header( -url => $url_failure );
|
|
return;
|
|
}
|
|
|
|
# This looks like it gets at the meat
|
|
|
|
# make sure we have our SQL condition command
|
|
require GT::SQL::Condition;
|
|
|
|
# Look/create new for sub_email with e-mail
|
|
my $cd = GT::SQL::Condition->new(sub_email => '=' => $email);
|
|
|
|
# if we only have one entry in our list
|
|
if ($#$lists == 0) {
|
|
# From "Lists" get our value
|
|
$info = $DB->table('Lists')->get($lists->[0]);
|
|
# if no results, return an error
|
|
return ('error_form.html', { msg => GList::language('LOG_SUBSCRIBE_ERROR2', $lists->[0]) }) if (!$info);
|
|
|
|
# depending on $info, go to success/failure ($info dpeendent failure/success)
|
|
$url_success = $info->{lst_url_unsubscribe_success} if ($info->{lst_url_unsubscribe_success});
|
|
$url_failure = $info->{lst_url_unsubscribe_failure} if ($info->{lst_url_unsubscribe_failure});
|
|
|
|
# to our foreign key list add this e-mail
|
|
$cd->add(sub_list_id_fk => '=' => $lists->[0]);
|
|
}
|
|
else {
|
|
# same thing as above, just do it if we have any in the list
|
|
$cd->add(sub_list_id_fk => 'IN' => $lists);
|
|
}
|
|
|
|
# if we didn't do any adding, go to the failure
|
|
if (!$db_sub->count($cd)) {
|
|
print $IN->header( -url => $url_failure );
|
|
return;
|
|
}
|
|
# looks like this is in testing
|
|
#------------demo code-----------
|
|
# return ('user_success_form.html', { msg => GList::language('LOG_UNSUBS_SUCCESS', $info->{lst_title}) });
|
|
|
|
# from "Subscribers", delete this added unsubscription
|
|
if ($db_sub->delete($cd)) {
|
|
# from our #info get the unsubscribe tempalte
|
|
if ($info->{lst_unsubs_template}) {
|
|
# get the e-mail from this info and lowercase and send
|
|
$info->{sub_email} = lc $cgi->{email};
|
|
# now parse and unsubscribe
|
|
my $unsubs_template = _parse($info, $info->{lst_unsubs_template});
|
|
# from template, send the header/body of the unsubscription
|
|
GList::send($unsubs_template->{head}, { text => $unsubs_template->{body} });
|
|
}
|
|
}
|
|
# go to success
|
|
print $IN->header( -url => $url_success );
|
|
return;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{user_move} = __LINE__ . << 'END_OF_SUB';
|
|
sub user_move {
|
|
#-----------------------------------------------------------
|
|
# Remove a subscription and then create a new one
|
|
#
|
|
#----------------------------------
|
|
# First, let's get the list information we're moving
|
|
#----------------------------------
|
|
my $cgi = $IN->get_hash();
|
|
my @values = split('-', $cgi->{from_to_lid});
|
|
my $element_count = scalar(@values);
|
|
|
|
# If invalid params, return an error
|
|
return ('error_form.html', { msg => GList::language('LOG_ERROR') }) unless ($element_count == 2);
|
|
|
|
my $unsub = $values[0];
|
|
my $sub = $values[1];
|
|
|
|
#----------------------------------
|
|
# Prepare the unsubscription and do so
|
|
#----------------------------------
|
|
$cgi->{lid} = $unsub;
|
|
|
|
my $url_success = "$CFG->{static_url}/page/unsubscribe_success.html";
|
|
my $url_failure = "$CFG->{static_url}/page/unsubscribe_failure.html";
|
|
|
|
my ($info, $email);
|
|
my $db_sub = $DB->table('Subscribers');
|
|
my $lists = (ref $cgi->{lid} eq 'ARRAY') ? $cgi->{lid} : [$cgi->{lid}];
|
|
if ($cgi->{eml_code}) {
|
|
my $eml = $DB->table('EmailMailings')->get({ eml_code => $cgi->{eml_code} });
|
|
$email = lc $eml->{eml_email};
|
|
}
|
|
else {
|
|
$email = lc $cgi->{email};
|
|
}
|
|
|
|
# If we don't have an e-mail, go to the failure url
|
|
if (!$email or $#$lists < 0) {
|
|
print $IN->header( -url => $url_failure );
|
|
return;
|
|
}
|
|
|
|
require GT::SQL::Condition;
|
|
|
|
# Look/create new for sub_email with e-mail
|
|
my $cd = GT::SQL::Condition->new(sub_email => '=' => $email);
|
|
|
|
# if we only have one entry in our list
|
|
if ($#$lists == 0) {
|
|
$info = $DB->table('Lists')->get($lists->[0]);
|
|
return ('error_form.html', { msg => GList::language('LOG_SUBSCRIBE_ERROR2', $lists->[0]) }) if (!$info);
|
|
|
|
$url_success = $info->{lst_url_unsubscribe_success} if ($info->{lst_url_unsubscribe_success});
|
|
$url_failure = $info->{lst_url_unsubscribe_failure} if ($info->{lst_url_unsubscribe_failure});
|
|
|
|
$cd->add(sub_list_id_fk => '=' => $lists->[0]);
|
|
}
|
|
else {
|
|
$cd->add(sub_list_id_fk => 'IN' => $lists);
|
|
}
|
|
|
|
if (!$db_sub->count($cd)) {
|
|
print $IN->header( -url => $url_failure );
|
|
return;
|
|
}
|
|
|
|
# Remove them from this list
|
|
my $unsubs_template;
|
|
if ($db_sub->delete($cd)) {
|
|
# from our #info get the unsubscribe tempalte
|
|
if ($info->{lst_unsubs_template}) {
|
|
# get the e-mail from this info and lowercase and send
|
|
$info->{sub_email} = lc $cgi->{email};
|
|
# now parse and unsubscribe
|
|
$unsubs_template = _parse($info, $info->{lst_unsubs_template});
|
|
}
|
|
}
|
|
|
|
#----------------------------------
|
|
# Success means we proceed with the subscription
|
|
#----------------------------------
|
|
|
|
# Prepare the subscription and so so
|
|
$cgi->{lid} = $sub;
|
|
|
|
# get subscribe success URLs
|
|
$url_success = "$CFG->{static_url}/page/subscribe_success.html";
|
|
$url_failure = "$CFG->{static_url}/page/subscribe_failure.html";
|
|
my $demo = 0;
|
|
# errors if we don't have an accurate list ID
|
|
return ('error_form.html', { msg => GList::language('LOG_SUBSCRIBE_ERROR') }) unless ($cgi->{lid});
|
|
|
|
# Get the relevant table lsits (Subscribers). StopLists is the unknown one--doesn't look like it's used anymore
|
|
my $db_stl = $DB->table('StopLists');
|
|
my $wild_cards = GList::wild_cards();
|
|
|
|
# if there's an array of IDs, loop over them
|
|
if (ref $cgi->{lid} eq 'ARRAY') {
|
|
foreach my $id (@{$cgi->{lid}}) {
|
|
$info = $DB->table('Lists')->get($id);
|
|
next unless ($info);
|
|
|
|
my $error = _check_subscriber($email, $id, $db_stl, $wild_cards);
|
|
next if ($error);
|
|
|
|
# if it has been subscribed to the list
|
|
next if ($db_sub->count({ sub_email => $email, sub_list_id_fk => $id }));
|
|
|
|
my ($template, $data) = _generate_info($info, $email, $cgi->{name});
|
|
next unless ($data);
|
|
|
|
$db_sub->insert($data);
|
|
if ($template and !$demo) { # sending a confirmation or validation email
|
|
GList::send($template->{head}, { text => $template->{body} });
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
$info = $DB->table('Lists')->get($cgi->{lid});
|
|
return ('error_form.html', { msg => GList::language('LOG_SUBSCRIBE_ERROR2', $cgi->{lid}, GList::_load_global('site_title')) }) if (!$info);
|
|
|
|
$url_success = $info->{lst_url_subscribe_success} if ($info->{lst_url_subscribe_success});
|
|
$url_failure = $info->{lst_url_subscribe_failure} if ($info->{lst_url_subscribe_failure});
|
|
my $error = _check_subscriber($email, $info->{lst_id}, $db_stl, $wild_cards);
|
|
return ('error_form.html', { msg => $error }) if ($error);
|
|
|
|
# if it has been subscribed to the list
|
|
if ($db_sub->count({ sub_email => $email, sub_list_id_fk => $cgi->{lid} })) {
|
|
print $IN->header( -url => $url_failure );
|
|
return;
|
|
}
|
|
|
|
my ($template, $data) = _generate_info($info, $email, $cgi->{name});
|
|
unless ($data) {
|
|
print $IN->header( -url => $url_failure );
|
|
return;
|
|
}
|
|
$db_sub->insert($data);
|
|
|
|
if ($template and !$demo) { # sending a confirmation or validation email
|
|
GList::send($template->{head}, { text => $template->{body} });
|
|
}
|
|
}
|
|
|
|
if ($unsubs_template) {
|
|
# from template, send the header/body of the unsubscription
|
|
GList::send($unsubs_template->{head}, { text => $unsubs_template->{body} });
|
|
}
|
|
|
|
print $IN->header( -url => $url_success );
|
|
|
|
return;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_generate_info} = __LINE__ . <<'END_OF_SUB';
|
|
sub _generate_info {
|
|
my ($info, $email, $name) = @_;
|
|
my %data = ( sub_email => $email, sub_name => $name, sub_created => time, sub_list_id_fk => $info->{lst_id}, sub_user_id_fk => $info->{lst_user_id_fk} );
|
|
$info->{sub_email} = $email;
|
|
$info->{sub_name} = $name;
|
|
|
|
my $template;
|
|
if ($info->{lst_opt}) {
|
|
my $val_code = join '', ('a'..'z', 'A'..'Z', 0..9)[map rand(62), 1 .. 30];
|
|
$data{sub_validated} = '0';
|
|
$data{sub_val_code} = "GT$val_code";
|
|
$info->{validate_code} = $val_code;
|
|
$template = _parse($info, $info->{lst_opt_template});
|
|
}
|
|
elsif ($info->{lst_subs_template}) {
|
|
$template = _parse($info, $info->{lst_subs_template});
|
|
}
|
|
return ($template, \%data);
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_signup_check} = __LINE__ . <<'END_OF_SUB';
|
|
sub _signup_check {
|
|
#-------------------------------------------------------------------
|
|
#
|
|
my $data = shift;
|
|
|
|
my $db = $DB->table('Users');
|
|
my $refix = $CFG->{signup_username_regex} || '^[\w\-\.]{3,}$';
|
|
|
|
length $data->{usr_username} < 3 and return GList::language('USR_SIGNUP_USERNAME_INVALID');
|
|
$data->{usr_username} =~ /$refix/ or return GList::language('USR_INVALID');
|
|
$db->count({ usr_username => $data->{usr_username} }) and return GList::language('USR_SIGNUP_USERNAME_TAKEN');
|
|
length $data->{usr_password} < 4 and return GList::language('ADM_PWD_INVALID');
|
|
$data->{usr_password} ne $data->{con_password} and return GList::language('USR_SIGNUP_CONFIRM_PASS');
|
|
$data->{usr_email} =~ /.@\S+\.\S+$/ or return GList::language('USR_SIGNUP_EMAIL_INVALID', $data->{usr_email});
|
|
$db->count({ usr_email => $data->{usr_email} }) and return GList::language('USR_SIGNUP_EMAIL_INUSE', $data->{usr_email});
|
|
|
|
if ($CFG->{signup_restricted_email} and ref $CFG->{signup_restricted_email} eq 'ARRAY') {
|
|
foreach my $e (@{$CFG->{signup_restricted_email}}) {
|
|
$data->{usr_email} eq $e and return GList::language('USR_SIGNUP_EMAIL_RESTRICTED', $data->{usr_email});
|
|
}
|
|
}
|
|
return;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_check_subscriber} = __LINE__ . <<'END_OF_SUB';
|
|
sub _check_subscriber {
|
|
#-----------------------------------------------------------------
|
|
#
|
|
my ($email, $lst_id, $db_stl, $wild_cards) = @_;
|
|
|
|
# trim blank spaces
|
|
if ($email) {
|
|
$email =~ s,^\s+,,g;
|
|
$email =~ s,\s+$,,g;
|
|
}
|
|
|
|
return GList::language('USR_SUB_OVERLIMIT') if (GList::check_limit('sublist', $lst_id));
|
|
return GList::language('USR_SUB_INVALID_EMAIL') if ($email !~ /^(?:(?:.+\@.+\..+)|\s*)$/ or $email =~ /\s/ );
|
|
return GList::language('USR_SUB_STOPLIST') if ($db_stl->count({ stl_email => $email }));
|
|
foreach (@$wild_cards) {
|
|
my $e = $_->[0];
|
|
my $re = quotemeta $e;
|
|
$re =~ s/\\\*/.*/;
|
|
$re =~ s/\\\?/./;
|
|
return GList::language('USR_SUB_STOPLIST') if ($email =~ /$re/i);
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_parse} = __LINE__ . <<'END_OF_SUB';
|
|
sub _parse {
|
|
#-----------------------------------------------------------
|
|
# Load email template
|
|
#
|
|
my ($info, $name) = @_;
|
|
|
|
require GList::Template;
|
|
my $db = $DB->table('EmailTemplates');
|
|
my $template = $db->get({ tpl_user_id_fk => $info->{lst_user_id_fk}, tpl_name => $name });
|
|
return if (!$template);
|
|
|
|
my $sth = $DB->table('Users')->select({ usr_username => $info->{lst_user_id_fk} });
|
|
return unless $sth;
|
|
|
|
my $uinfo = $sth->fetchrow_hashref;
|
|
@{$info}{keys %$uinfo} = (values %$uinfo);
|
|
|
|
foreach (keys %$template) {
|
|
$template->{$_} = GList::Template->parse(
|
|
"string",
|
|
[$info],
|
|
{
|
|
string => $template->{$_},
|
|
disable => { functions => 1 }
|
|
}
|
|
);
|
|
}
|
|
|
|
my $headers;
|
|
if ($template->{tpl_extra}) {
|
|
for (split /\s*\n\s*/, $template->{tpl_extra}) { # This will weed out any blank lines
|
|
my ($key, $value) = split /\s*:\s*/, $_, 2;
|
|
$headers->{$key} = $value if $key and $value;
|
|
}
|
|
}
|
|
$headers->{From} = $template->{tpl_from};
|
|
$headers->{To} = $template->{tpl_to};
|
|
$headers->{Subject} = $template->{tpl_subject};
|
|
|
|
return { body => $template->{tpl_body}, head => $headers };
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_parse_file} = __LINE__ . <<'END_OF_SUB';
|
|
sub _parse_file {
|
|
my ($file, $info) = @_;
|
|
require GT::Mail::Editor;
|
|
require GList::Template;
|
|
|
|
my $tpl = GT::Mail::Editor->new( dir => "$CFG->{priv_path}/templates", template => $CFG->{template_set} );
|
|
$tpl->load($file);
|
|
|
|
my %head;
|
|
my $headers = $tpl->headers;
|
|
while (my ($k, $v) = each %$headers) {
|
|
my $val = $v;
|
|
$val = GList::Template->parse(
|
|
"string",
|
|
[$info],
|
|
{
|
|
string => $val,
|
|
disable => { functions => 1 }
|
|
}
|
|
);
|
|
$head{$k} = $val;
|
|
}
|
|
my $body = GList::Template->parse(
|
|
"string",
|
|
[$info],
|
|
{
|
|
string => $tpl->{body},
|
|
disable => { functions => 1 }
|
|
}
|
|
);
|
|
return (\%head, $body);
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_cleanup_files} = __LINE__ . <<'END_OF_SUB';
|
|
sub _cleanup_files {
|
|
#----------------------------------------------------------
|
|
# Clear out old temporary attachments.
|
|
#
|
|
my $second = $CFG->{session_exp} * 3600 || 3600;
|
|
opendir (DIR, "$CFG->{priv_path}/tmp") or die GList::language('DIR_OPEN_ERR', "$CFG->{priv_path}/tmp");
|
|
my @files = readdir(DIR);
|
|
closedir (DIR);
|
|
foreach my $file (@files) {
|
|
my $full_file = "$CFG->{priv_path}/tmp/$file";
|
|
next if ( -d $full_file );
|
|
|
|
if ( (-M _) * 86400 > $second ) {
|
|
$full_file =~ /(.*)/;
|
|
$full_file = $1;
|
|
unlink $full_file;
|
|
}
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_todo} = __LINE__ . <<'END_OF_SUB';
|
|
sub _todo {
|
|
#---------------------------------------------------------------------------
|
|
#
|
|
my $do = shift;
|
|
my %actions = (
|
|
user_open => 1,
|
|
user_click => 1,
|
|
user_signup => 1,
|
|
user_remind => 1,
|
|
user_validate => 1,
|
|
user_subscribe => 1,
|
|
user_rm => 1,
|
|
user_unsubscribe=> 1,
|
|
user_account_validate => 1,
|
|
# add in account updating
|
|
user_move => 1
|
|
);
|
|
if (exists $actions{$do}) {
|
|
return 1;
|
|
}
|
|
return;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_determine_action} = __LINE__ . <<'END_OF_SUB';
|
|
sub _determine_action {
|
|
#----------------------------------------------------------------------------
|
|
# Check valid action
|
|
#
|
|
my $action = shift || undef;
|
|
return if ( !$action );
|
|
return 'user_login' if ( !$USER and !_todo($action) );
|
|
|
|
my %valid = (
|
|
map { $_ => 1 } qw(
|
|
user_open
|
|
user_click
|
|
user_signup
|
|
user_login
|
|
user_logout
|
|
user_remind
|
|
user_validate
|
|
user_subscribe
|
|
user_rm
|
|
user_unsubscribe
|
|
user_account_validate
|
|
# Add in ability to update account
|
|
user_move
|
|
)
|
|
);
|
|
exists $valid{$action} and return $action;
|
|
return;
|
|
}
|
|
END_OF_SUB
|
|
|
|
1;
|