# ================================================================== # 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 => "$GList::error" }) 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 => "$results->{error}" }) 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;